real_topologyScript.sml

1(* ========================================================================= *)
2(*                                                                           *)
3(*                Elementary Topology in Euclidean Space (R^1)               *)
4(*                                                                           *)
5(*        (c) Copyright, John Harrison 1998-2015                             *)
6(*        (c) Copyright, Valentina Bruno 2010                                *)
7(*        (c) Copyright, Marco Maggesi 2014-2015                             *)
8(*        (c) Copyright 2015,                                                *)
9(*                       Muhammad Qasim,                                     *)
10(*                       Osman Hasan,                                        *)
11(*                       Hardware Verification Group,                        *)
12(*                       Concordia University                                *)
13(*            Contact:  <m_qasi@ece.concordia.ca>                            *)
14(*                                                                           *)
15(*    Note: This theory was ported from HOL Light                            *)
16(* ========================================================================= *)
17
18Theory real_topology
19Ancestors
20  num prim_rec combin quotient arithmetic real real_sigma pair
21  bool pred_set option sum list topology metric nets wellorder
22  cardinal permutes iterate
23Libs
24  numLib unwindLib tautLib jrhUtils InductiveDefinition mesonLib
25  realLib hurdUtils
26
27val std_ss' = std_ss -* ["lift_disj_eq", "lift_imp_disj"];
28
29fun METIS ths tm = prove(tm,METIS_TAC ths);
30
31val DISC_RW_KILL = DISCH_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN
32                   POP_ASSUM K_TAC;
33
34fun ASSERT_TAC tm = SUBGOAL_THEN tm STRIP_ASSUME_TAC;
35val ASM_ARITH_TAC = REPEAT (POP_ASSUM MP_TAC) THEN ARITH_TAC;
36
37(* Minimal hol-light compatibility layer *)
38val ASM_REAL_ARITH_TAC = REAL_ASM_ARITH_TAC; (* realLib *)
39val IMP_CONJ           = CONJ_EQ_IMP;        (* cardinalTheory *)
40val FINITE_SUBSET      = SUBSET_FINITE_I;    (* pred_setTheory *)
41val SUM_ABS            = SUM_ABS';           (* iterateTheory *)
42val SUM_ABS_LE         = SUM_ABS_LE';        (* iterateTheory *)
43val SUM_EQ             = SUM_EQ';            (* iterateTheory *)
44val SUM_LE             = SUM_LE';            (* iterateTheory *)
45
46Overload "*_c"[local,inferior] = “pred_set$CROSS”;
47val _ = temp_set_fixity "*_c" (Infixl 600)
48
49(* experimental overloads *)
50Overload uncountable           = “\s. ~countable s”
51Overload UNCOUNTABLE[inferior] = “uncountable”
52
53(* ------------------------------------------------------------------------- *)
54
55(* |- !P Q. (!x. P x) /\ (!x. Q x) <=> !x. P x /\ Q x *)
56Theorem AND_FORALL_THM = GSYM FORALL_AND_THM
57
58Theorem EXISTS_IN_INSERT:
59   !P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ ?x. x IN s /\ P x
60Proof
61  REWRITE_TAC[IN_INSERT] THEN MESON_TAC[]
62QED
63
64Theorem DEPENDENT_CHOICE_FIXED:
65   !P R a:'a. P 0 a /\ (!n x. P n x ==> ?y. P (SUC n) y /\ R n x y) ==>
66          ?f. (f 0 = a) /\ (!n. P n (f n)) /\ (!n. R n (f n) (f(SUC n)))
67Proof
68  REPEAT STRIP_TAC THEN KNOW_TAC ``(?f. (f 0 = (a:'a)) /\
69    (!n. f(SUC n) = (@y. P (SUC n) y /\ R n (f n) y)))`` THENL
70  [RW_TAC std_ss [num_Axiom], ALL_TAC] THEN
71  STRIP_TAC THEN EXISTS_TAC ``f:num->'a`` THEN ASM_REWRITE_TAC [] THEN
72  ONCE_REWRITE_TAC[METIS [] ``(!n. P n (f n)) = (!n. (\n. P n (f n)) n)``] THEN
73  GEN_REWR_TAC LAND_CONV
74   [MESON[num_CASES] ``(!n. P n) <=> P 0 /\ !n. P(SUC n)``] THEN
75  ASM_SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN INDUCT_TAC THEN METIS_TAC[]
76QED
77
78Theorem DEPENDENT_CHOICE:
79   !P R:num->'a->'a->bool. (?a. P 0 a) /\
80   (!n x. P n x ==> ?y. P (SUC n) y /\ R n x y) ==>
81   ?f. (!n. P n (f n)) /\ (!n. R n (f n) (f(SUC n)))
82Proof
83  MESON_TAC[DEPENDENT_CHOICE_FIXED]
84QED
85
86Theorem BIGUNION_MONO_IMAGE:
87   (!x. x IN s ==> f x SUBSET g x) ==>
88    BIGUNION(IMAGE f s) SUBSET BIGUNION(IMAGE g s)
89Proof
90  SET_TAC[]
91QED
92(** proof without SET_TAC
93    RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE]
94 >> rename1 `y IN s`
95 >> Q.EXISTS_TAC `y` >> ASM_REWRITE_TAC []
96 >> FIRST_X_ASSUM irule
97 >> ASM_REWRITE_TAC []
98 *)
99
100Theorem BIGUNION_MONO:
101   (!x. x IN s ==> ?y. y IN t /\ x SUBSET y) ==> BIGUNION s SUBSET BIGUNION t
102Proof
103  SET_TAC[]
104QED
105(** proof without SET_TAC
106    rpt STRIP_TAC
107 >> RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION]
108 >> rename1 `x IN y`
109 >> Q.PAT_X_ASSUM `!x. x IN s ==> P` (MP_TAC o (Q.SPEC `y`))
110 >> RW_TAC std_ss [SUBSET_DEF]
111 >> rename1 `z IN t`
112 >> Q.EXISTS_TAC `z` >> ASM_REWRITE_TAC []
113 >> POP_ASSUM MATCH_MP_TAC
114 >> ASM_REWRITE_TAC []
115 *)
116
117(* ------------------------------------------------------------------------- *)
118(* Linear functions.                                                         *)
119(* ------------------------------------------------------------------------- *)
120
121Definition linear[nocompute]:
122  linear (f:real->real) <=>
123        (!x y. f(x + y) = f(x) + f(y)) /\
124        (!c x. f(c * x) = c * f(x))
125End
126
127(* Courtesy to Thomas Sewell for providing this proof (first) on Slack
128
129   NOTE: The explicit-form of linear functions (linear_repr and linear_alt) does
130         NOT hold in higher dimensional spaces, e.g. (f:real['M]->real['N]), cf.
131         vec_linear_def in examples/vectorScript.sml (ported from HOL-Light).
132
133         However, the theorem linear_repr is necessary in limTheory to show the
134         equivalence between the old and new definitions of "differentiable":
135
136         |- !f x. f differentiable_at x <=> f differentiable (at x)
137 *)
138Theorem linear_lemma[local]:
139  (!c x. f(c * x) = c * f(x)) ==> ?l. f = (\x. l * x)
140Proof
141  rw []
142  \\ qexists_tac `f 1`
143  \\ rw [FUN_EQ_THM]
144  \\ metis_tac [linear, REAL_MUL_RID]
145QED
146
147Theorem linear_repr :
148    !f. linear f <=> ?l. f = \x. l * x
149Proof
150    Q.X_GEN_TAC ‘f’
151 >> EQ_TAC
152 >> rw [linear, linear_lemma]
153 >> REAL_ARITH_TAC
154QED
155
156(* In fact, only the part ‘!c x. f(c * x) = c * f(x))’ is primitive.
157
158   This theorem may simplify some theorems below, but it only holds for
159   one-dimensional linear functions (I believe). --Chun Tian, 11 nov 2022.
160 *)
161Theorem linear_alt_cmul :
162    !f. linear f <=> !c x. f(c * x) = c * f(x)
163Proof
164    Q.X_GEN_TAC ‘f’
165 >> EQ_TAC >- rw [linear]
166 >> rw [linear_repr]
167 >> MATCH_MP_TAC linear_lemma >> art []
168QED
169
170Theorem LINEAR_SCALING:
171   !c. linear(\x:real. c * x)
172Proof
173 SIMP_TAC std_ss [linear] THEN REAL_ARITH_TAC
174QED
175
176Theorem LINEAR_COMPOSE_CMUL:
177   !f c. linear f ==> linear (\x. c * f(x))
178Proof
179  SIMP_TAC std_ss [linear] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC
180QED
181
182Theorem LINEAR_COMPOSE_NEG:
183   !f. linear f ==> linear (\x. -(f(x)))
184Proof
185  SIMP_TAC std_ss [linear] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC
186QED
187
188Theorem LINEAR_COMPOSE_ADD:
189   !f g. linear f /\ linear g ==> linear (\x. f(x) + g(x))
190Proof
191  SIMP_TAC std_ss [linear] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC
192QED
193
194Theorem LINEAR_COMPOSE_SUB:
195   !f g. linear f /\ linear g ==> linear (\x. f(x) - g(x))
196Proof
197  SIMP_TAC std_ss [linear] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC
198QED
199
200Theorem LINEAR_COMPOSE:
201   !f g. linear f /\ linear g ==> linear (g o f)
202Proof
203  SIMP_TAC std_ss [linear, o_THM]
204QED
205
206Theorem LINEAR_ID:
207   linear (\x. x)
208Proof
209  SIMP_TAC std_ss [linear]
210QED
211
212Theorem LINEAR_ZERO:
213   linear (\x. 0)
214Proof
215  SIMP_TAC std_ss [linear] THEN CONJ_TAC THEN REAL_ARITH_TAC
216QED
217
218Theorem LINEAR_NEGATION:
219   linear (\x. -x)
220Proof
221  SIMP_TAC std_ss [linear] THEN REAL_ARITH_TAC
222QED
223
224Theorem LINEAR_COMPOSE_SUM:
225   !f s. FINITE s /\ (!a. a IN s ==> linear(f a))
226         ==> linear(\x. sum s (\a. f a x))
227Proof
228  GEN_TAC THEN REWRITE_TAC[GSYM AND_IMP_INTRO] THEN GEN_TAC THEN
229  KNOW_TAC
230    ``((!a. a IN s ==> linear (f a)) ==> linear (\x. sum s (\a. f a x))) =
231     (\s. (!a. a IN s ==> linear (f a)) ==> linear (\x. sum s (\a. f a x))) s``
232  THENL [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
233  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
234  SIMP_TAC std_ss [SUM_CLAUSES, LINEAR_ZERO] THEN REPEAT STRIP_TAC THEN
235  KNOW_TAC ``(linear (\x. f e x + sum s (\a. f a x))) =
236              linear (\x. (\x. f e x) x + (\x. sum s (\a. f a x)) x)`` THENL
237  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
238  MATCH_MP_TAC LINEAR_COMPOSE_ADD THEN METIS_TAC [IN_INSERT]
239QED
240
241Theorem LINEAR_MUL_COMPONENT:
242   !f:real->real v.
243     linear f ==> linear (\x. f(x) * v)
244Proof
245  SIMP_TAC std_ss [linear] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC
246QED
247
248Theorem LINEAR_0:
249   !f. linear f ==> (f(0) = 0)
250Proof
251  METIS_TAC [REAL_MUL_LZERO, linear]
252QED
253
254Theorem LINEAR_CMUL:
255   !f c x. linear f ==> (f(c * x) = c * f(x))
256Proof
257  SIMP_TAC std_ss [linear]
258QED
259
260Theorem LINEAR_NEG:
261   !f x. linear f ==> (f(-x) = -(f x))
262Proof
263  ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN SIMP_TAC std_ss [LINEAR_CMUL]
264QED
265
266Theorem LINEAR_ADD:
267   !f x y. linear f ==> (f(x + y) = f(x) + f(y))
268Proof
269  SIMP_TAC std_ss [linear]
270QED
271
272Theorem LINEAR_SUB:
273   !f x y. linear f ==> (f(x - y) = f(x) - f(y))
274Proof
275  SIMP_TAC std_ss [real_sub, LINEAR_ADD, LINEAR_NEG]
276QED
277
278Theorem LINEAR_SUM:
279   !f g s. linear f /\ FINITE s ==> (f(sum s g) = sum s (f o g))
280Proof
281  GEN_TAC THEN GEN_TAC THEN SIMP_TAC std_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM] THEN
282  DISCH_TAC THEN GEN_TAC THEN
283  KNOW_TAC ``(f (sum s g) = sum s (f o g)) =
284          (\s. (f (sum s g) = sum s (f o g))) s`` THENL
285  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
286  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
287  SIMP_TAC std_ss [SUM_CLAUSES] THEN FIRST_ASSUM(fn th =>
288    SIMP_TAC std_ss [MATCH_MP LINEAR_0 th, MATCH_MP LINEAR_ADD th, o_THM])
289QED
290
291Theorem LINEAR_SUM_MUL:
292   !f s c v.
293        linear f /\ FINITE s
294        ==> (f(sum s (\i. c i * v i)) = sum s (\i. c(i) * f(v i)))
295Proof
296  SIMP_TAC std_ss [LINEAR_SUM, o_DEF, LINEAR_CMUL]
297QED
298
299Theorem lemma[local]:
300   x = sum {1..1} (\i. x * &i)
301Proof
302  REWRITE_TAC [SUM_SING_NUMSEG] THEN BETA_TAC THEN REAL_ARITH_TAC
303QED
304
305Theorem LINEAR_BOUNDED:
306   !f:real->real. linear f ==> ?B. !x. abs(f x) <= B * abs(x)
307Proof
308  REPEAT STRIP_TAC THEN EXISTS_TAC
309   ``sum{1:num..1:num} (\i. abs((f:real->real)(&i)))`` THEN
310  GEN_TAC THEN
311  GEN_REWR_TAC (LAND_CONV o funpow 2 RAND_CONV) [lemma] THEN
312  ASM_SIMP_TAC std_ss [LINEAR_SUM, FINITE_NUMSEG] THEN
313  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
314  MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC [FINITE_NUMSEG, IN_NUMSEG] THEN
315  BETA_TAC THEN ONCE_REWRITE_TAC [REAL_MUL_COMM] THEN
316  ASM_SIMP_TAC std_ss [o_DEF, ABS_MUL, LINEAR_CMUL] THEN
317  METIS_TAC [REAL_LE_RMUL, ABS_POS, REAL_LE_LT, REAL_MUL_COMM]
318QED
319
320Theorem LINEAR_BOUNDED_POS:
321   !f:real->real. linear f ==> ?B. &0 < B /\ !x. abs(f x) <= B * abs(x)
322Proof
323  REPEAT STRIP_TAC THEN
324  FIRST_ASSUM(X_CHOOSE_TAC ``B:real`` o MATCH_MP LINEAR_BOUNDED) THEN
325  EXISTS_TAC ``abs(B) + &1:real`` THEN CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
326  GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `x:real`) THEN
327  MATCH_MP_TAC(REAL_ARITH ``a <= b ==> x <= a ==> x <= b:real``) THEN
328  MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
329  REAL_ARITH_TAC
330QED
331
332Theorem SYMMETRIC_LINEAR_IMAGE:
333   !f s. (!x. x IN s ==> -x IN s) /\ linear f
334          ==> !x. x IN (IMAGE f s) ==> -x IN (IMAGE f s)
335Proof
336  SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
337  SIMP_TAC std_ss [GSYM LINEAR_NEG] THEN SET_TAC[]
338QED
339
340(* ------------------------------------------------------------------------- *)
341(* Bilinear functions.                                                       *)
342(* ------------------------------------------------------------------------- *)
343
344Definition bilinear[nocompute]:
345  bilinear f <=> (!x. linear(\y. f x y)) /\ (!y. linear(\x. f x y))
346End
347
348Theorem BILINEAR_SWAP:
349   !op:real->real->real.
350        bilinear(\x y. op y x) <=> bilinear op
351Proof
352  SIMP_TAC std_ss [bilinear, ETA_AX] THEN METIS_TAC[]
353QED
354
355Theorem BILINEAR_LADD:
356   !h x y z. bilinear h ==> (h (x + y) z = (h x z) + (h y z))
357Proof
358  SIMP_TAC std_ss [bilinear, linear]
359QED
360
361Theorem BILINEAR_RADD:
362   !h x y z. bilinear h ==> (h x (y + z) = (h x y) + (h x z))
363Proof
364  SIMP_TAC std_ss [bilinear, linear]
365QED
366
367Theorem BILINEAR_LMUL:
368   !h c x y. bilinear h ==> (h (c * x) y = c * (h x y))
369Proof
370  SIMP_TAC std_ss [bilinear, linear]
371QED
372
373Theorem BILINEAR_RMUL:
374   !h c x y. bilinear h ==> (h x (c * y) = c * (h x y))
375Proof
376  SIMP_TAC std_ss [bilinear, linear]
377QED
378
379Theorem BILINEAR_LNEG:
380   !h x y. bilinear h ==> (h (-x) y = -(h x y))
381Proof
382  ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN SIMP_TAC std_ss [BILINEAR_LMUL]
383QED
384
385Theorem BILINEAR_RNEG:
386   !h x y. bilinear h ==> (h x (-y) = -(h x y))
387Proof
388  ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN SIMP_TAC std_ss [BILINEAR_RMUL]
389QED
390
391Theorem BILINEAR_LZERO:
392   !h x. bilinear h ==> (h (0) x = 0)
393Proof
394  ONCE_REWRITE_TAC[REAL_ARITH ``(x = 0:real) <=> (x + x = x)``] THEN
395  SIMP_TAC std_ss [GSYM BILINEAR_LADD, REAL_ADD_LID]
396QED
397
398Theorem BILINEAR_RZERO:
399   !h x. bilinear h ==> (h x (0) = 0)
400Proof
401  ONCE_REWRITE_TAC[REAL_ARITH ``(x = 0:real) <=> (x + x = x)``] THEN
402  SIMP_TAC std_ss [GSYM BILINEAR_RADD, REAL_ADD_LID]
403QED
404
405Theorem BILINEAR_LSUB:
406   !h x y z. bilinear h ==> (h (x - y) z = (h x z) - (h y z))
407Proof
408  SIMP_TAC std_ss [real_sub, BILINEAR_LNEG, BILINEAR_LADD]
409QED
410
411Theorem BILINEAR_RSUB:
412   !h x y z. bilinear h ==> (h x (y - z) = (h x y) - (h x z))
413Proof
414  SIMP_TAC std_ss [real_sub, BILINEAR_RNEG, BILINEAR_RADD]
415QED
416
417Theorem lemma[local]:
418   !s t. s CROSS t = {(x,y) | x IN s /\ y IN t}
419Proof
420  REWRITE_TAC [CROSS_DEF] THEN
421  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD]
422QED
423
424Theorem BILINEAR_SUM:
425   !h:real->real->real.
426       bilinear h /\ FINITE s /\ FINITE t
427       ==> (h (sum s f) (sum t g) = sum (s CROSS t) (\(i,j). h (f i) (g j)))
428Proof
429  REPEAT GEN_TAC THEN REWRITE_TAC [bilinear] THEN
430  KNOW_TAC ``(!x. linear (\y. h:real->real->real x y)) = (!x. linear (h x))`` THENL
431  [METIS_TAC [ETA_AX], ALL_TAC] THEN DISC_RW_KILL THEN
432  ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN
433  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
434  KNOW_TAC ``((!y. linear (\x. h:real->real->real x y)) /\ FINITE s) =
435             ((!y. linear (\x. h x y) /\ FINITE s))`` THENL
436  [SIMP_TAC std_ss [LEFT_AND_FORALL_THM], ALL_TAC] THEN
437  DISC_RW_KILL THEN DISCH_TAC THEN
438  FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_SUM o SPEC_ALL) THEN
439  SIMP_TAC std_ss [] THEN
440  ASM_SIMP_TAC std_ss [LINEAR_SUM, o_DEF, SUM_SUM_PRODUCT] THEN
441  SIMP_TAC std_ss [lemma]
442QED
443
444Theorem lemma[local]:
445   !x. x = sum {1:num..1:num} (\i. x * &i)
446Proof
447  REWRITE_TAC [SUM_SING_NUMSEG] THEN BETA_TAC THEN REAL_ARITH_TAC
448QED
449
450Theorem BILINEAR_BOUNDED:
451   !h:real->real->real.
452        bilinear h ==> ?B. !x y. abs(h x y) <= B * abs(x) * abs(y)
453Proof
454  REPEAT STRIP_TAC THEN
455  EXISTS_TAC ``sum ({1:num..1:num} CROSS {1:num..1:num})
456                  (\ (i,j). abs((h:real->real->real)
457                                (&i) (&j)))`` THEN
458  REPEAT GEN_TAC THEN GEN_REWR_TAC
459   (LAND_CONV o RAND_CONV o BINOP_CONV) [lemma] THEN
460  ASM_SIMP_TAC std_ss [BILINEAR_SUM, FINITE_NUMSEG] THEN
461  ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c = b * c * a:real``] THEN
462  REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_ABS_LE THEN
463  SIMP_TAC std_ss [FINITE_CROSS, FINITE_NUMSEG, FORALL_PROD, IN_CROSS] THEN
464  REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
465  ASM_SIMP_TAC std_ss [BILINEAR_LMUL, ABS_MUL] THEN
466  ASM_SIMP_TAC std_ss [BILINEAR_RMUL, ABS_MUL, REAL_MUL_ASSOC] THEN
467  METIS_TAC [REAL_LE_LT]
468QED
469
470Theorem BILINEAR_BOUNDED_POS:
471   !h. bilinear h
472       ==> ?B. &0 < B /\ !x y. abs(h x y) <= B * abs(x) * abs(y)
473Proof
474  REPEAT STRIP_TAC THEN
475  FIRST_ASSUM(X_CHOOSE_TAC ``B:real`` o MATCH_MP BILINEAR_BOUNDED) THEN
476  EXISTS_TAC ``abs(B) + &1:real`` THEN CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
477  REPEAT GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPECL [`x:real`, `y:real`]) THEN
478  MATCH_MP_TAC(REAL_ARITH ``a <= b ==> x <= a ==> x <= b:real``) THEN
479  REPEAT(MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
480         SIMP_TAC std_ss [ABS_POS, REAL_LE_MUL]) THEN
481  REAL_ARITH_TAC
482QED
483
484Theorem BILINEAR_SUM_PARTIAL_SUC:
485   !f g h:real->real->real m n.
486        bilinear h
487        ==> (sum {m..n} (\k. h (f k) (g(k + 1) - g(k))) =
488                if m <= n then h (f(n + 1)) (g(n + 1)) - h (f m) (g m) -
489                               sum {m..n} (\k. h (f(k + 1) - f(k)) (g(k + 1)))
490                else 0)
491Proof
492  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
493  GEN_TAC THEN INDUCT_TAC THEN
494  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [SUM_TRIV_NUMSEG, NOT_LESS_EQ] THEN
495  ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THENL
496   [COND_CASES_TAC THEN ASM_SIMP_TAC arith_ss [] THENL
497     [ASM_SIMP_TAC std_ss [BILINEAR_RSUB, BILINEAR_LSUB] THEN REAL_ARITH_TAC,
498      FULL_SIMP_TAC std_ss [bilinear, linear]], FULL_SIMP_TAC std_ss [bilinear, linear],
499  POP_ASSUM MP_TAC THEN REWRITE_TAC [LE] THEN
500  DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL [ALL_TAC, ASM_REWRITE_TAC []] THEN
501  ASM_SIMP_TAC std_ss [GSYM NOT_LESS, SUM_TRIV_NUMSEG, ARITH_PROVE ``n < SUC n``] THEN
502  ASM_SIMP_TAC std_ss [GSYM ADD1, ADD_CLAUSES] THEN
503  ASM_SIMP_TAC std_ss [BILINEAR_RSUB, BILINEAR_LSUB] THEN REAL_ARITH_TAC,
504  ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [LE] THEN
505  REWRITE_TAC [DE_MORGAN_THM] THEN
506  ASM_SIMP_TAC std_ss [GSYM NOT_LESS, SUM_TRIV_NUMSEG, ARITH_PROVE ``n < SUC n``] THEN
507  ASM_SIMP_TAC std_ss [GSYM ADD1, ADD_CLAUSES] THEN
508  ASM_SIMP_TAC std_ss [BILINEAR_RSUB, BILINEAR_LSUB] THEN REAL_ARITH_TAC
509QED
510
511Theorem BILINEAR_SUM_PARTIAL_PRE:
512   !f g h:real->real->real m n.
513        bilinear h
514        ==> (sum {m..n} (\k. h (f k) (g(k) - g(k - 1))) =
515                if m <= n then h (f(n + 1)) (g(n)) - h (f m) (g(m - 1)) -
516                               sum {m..n} (\k. h (f(k + 1) - f(k)) (g(k)))
517                else 0)
518Proof
519  REPEAT STRIP_TAC THEN
520  FIRST_ASSUM(MP_TAC o ISPECL [``f:num->real``, ``\k. (g:num->real)(k - 1)``,
521                 ``m:num``, ``n:num``] o MATCH_MP BILINEAR_SUM_PARTIAL_SUC) THEN
522  BETA_TAC THEN REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
523  COND_CASES_TAC THEN REWRITE_TAC[]
524QED
525
526(* ------------------------------------------------------------------------- *)
527(* A bit of linear algebra.                                                  *)
528(* ------------------------------------------------------------------------- *)
529
530Definition subspace[nocompute]:
531 subspace s <=>
532        (0:real) IN s /\
533        (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\
534        (!c x. x IN s ==> (c * x) IN s)
535End
536
537Definition span[nocompute]:
538  span s = subspace hull s
539End
540
541Definition dependent[nocompute]:
542 dependent s <=> ?a. a IN s /\ a IN span(s DELETE a)
543End
544
545Definition independent[nocompute]:
546 independent s <=> ~(dependent s)
547End
548
549(* ------------------------------------------------------------------------- *)
550(* Closure properties of subspaces.                                          *)
551(* ------------------------------------------------------------------------- *)
552
553Theorem SUBSPACE_UNIV:
554   subspace(UNIV:real->bool)
555Proof
556  REWRITE_TAC[subspace, IN_UNIV]
557QED
558
559Theorem SUBSPACE_IMP_NONEMPTY:
560   !s. subspace s ==> ~(s = {})
561Proof
562  REWRITE_TAC[subspace] THEN SET_TAC[]
563QED
564
565Theorem SUBSPACE_0:
566   subspace s ==> (0:real) IN s
567Proof
568  SIMP_TAC std_ss [subspace]
569QED
570
571Theorem SUBSPACE_ADD:
572   !x y s. subspace s /\ x IN s /\ y IN s ==> (x + y) IN s
573Proof
574  SIMP_TAC std_ss [subspace]
575QED
576
577Theorem SUBSPACE_MUL:
578   !x c s. subspace s /\ x IN s ==> (c * x) IN s
579Proof
580  SIMP_TAC std_ss [subspace]
581QED
582
583Theorem SUBSPACE_NEG:
584   !x s. subspace s /\ x IN s ==> (-x) IN s
585Proof
586  METIS_TAC [REAL_ARITH ``-x = -(&1) * x:real``, SUBSPACE_MUL]
587QED
588
589Theorem SUBSPACE_SUB:
590   !x y s. subspace s /\ x IN s /\ y IN s ==> (x - y) IN s
591Proof
592  SIMP_TAC std_ss [real_sub, SUBSPACE_ADD, SUBSPACE_NEG]
593QED
594
595Theorem SUBSPACE_SUM:
596   !s f t. subspace s /\ FINITE t /\ (!x. x IN t ==> f(x) IN s)
597           ==> (sum t f) IN s
598Proof
599  SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
600  GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
601  ONCE_REWRITE_TAC [METIS [] ``!t. ((!x. x IN t ==> f x IN s) ==> sum t f IN s) =
602                               (\t. (!x. x IN t ==> f x IN s) ==> sum t f IN s) t``] THEN
603  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
604  ASM_SIMP_TAC std_ss [SUM_CLAUSES, SUBSPACE_0, IN_INSERT, SUBSPACE_ADD]
605QED
606
607Theorem SUBSPACE_LINEAR_IMAGE:
608   !f s. linear f /\ subspace s ==> subspace(IMAGE f s)
609Proof
610  SIMP_TAC std_ss [subspace, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
611  SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
612  METIS_TAC [linear, LINEAR_0]
613QED
614
615Theorem SUBSPACE_LINEAR_PREIMAGE:
616   !f s. linear f /\ subspace s ==> subspace {x | f(x) IN s}
617Proof
618  SIMP_TAC std_ss [subspace, GSPECIFICATION] THEN
619  METIS_TAC [linear, LINEAR_0]
620QED
621
622Theorem SUBSPACE_TRIVIAL:
623   subspace {0}
624Proof
625  SIMP_TAC std_ss [subspace, IN_SING] THEN CONJ_TAC THEN REAL_ARITH_TAC
626QED
627
628Theorem SUBSPACE_INTER:
629   !s t. subspace s /\ subspace t ==> subspace (s INTER t)
630Proof
631  REWRITE_TAC[subspace, IN_INTER] THEN METIS_TAC []
632QED
633
634Theorem SUBSPACE_BIGINTER:
635   !f. (!s. s IN f ==> subspace s) ==> subspace(BIGINTER f)
636Proof
637  SIMP_TAC std_ss [subspace, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM, IN_BIGINTER]
638QED
639
640Theorem LINEAR_INJECTIVE_0_SUBSPACE:
641   !f:real->real s.
642        linear f /\ subspace s
643         ==> ((!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) <=>
644              (!x. x IN s /\ (f x = 0) ==> (x = 0)))
645Proof
646  REPEAT STRIP_TAC THEN
647  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_SUB_0] THEN
648  ASM_SIMP_TAC std_ss [GSYM LINEAR_SUB] THEN
649  METIS_TAC [REAL_SUB_RZERO, SUBSPACE_SUB, SUBSPACE_0]
650QED
651
652Theorem SUBSPACE_UNION_CHAIN:
653   !s t:real->bool.
654        subspace s /\ subspace t /\ subspace(s UNION t)
655         ==> s SUBSET t \/ t SUBSET s
656Proof
657  REPEAT STRIP_TAC THEN REWRITE_TAC [SET_RULE
658   ``s SUBSET t \/ t SUBSET s <=>
659    ~(?x y. x IN s /\ ~(x IN t) /\ y IN t /\ ~(y IN s))``] THEN
660  STRIP_TAC THEN SUBGOAL_THEN ``(x + y:real) IN (s UNION t)`` MP_TAC THENL
661   [MATCH_MP_TAC SUBSPACE_ADD THEN ASM_REWRITE_TAC[] THEN ASM_SET_TAC[],
662    REWRITE_TAC[IN_UNION, DE_MORGAN_THM] THEN
663    METIS_TAC [SUBSPACE_SUB, REAL_ARITH
664     ``((x + y) - x:real = y) /\ ((x + y) - y:real = x)``]]
665QED
666
667(* ------------------------------------------------------------------------- *)
668(* Lemmas.                                                                   *)
669(* ------------------------------------------------------------------------- *)
670
671Theorem SPAN_SPAN:
672   !s. span(span s) = span s
673Proof
674  REWRITE_TAC[span, HULL_HULL]
675QED
676
677Theorem SPAN_MONO:
678   !s t. s SUBSET t ==> span s SUBSET span t
679Proof
680  REWRITE_TAC[span, HULL_MONO]
681QED
682
683Theorem SUBSPACE_SPAN:
684   !s. subspace(span s)
685Proof
686  GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC P_HULL THEN
687  SIMP_TAC std_ss [subspace, IN_BIGINTER]
688QED
689
690Theorem SPAN_CLAUSES:
691   (!a s. a IN s ==> a IN span s) /\
692   ((0) IN span s) /\
693   (!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s) /\
694   (!x c s. x IN span s ==> (c * x) IN span s)
695Proof
696  MESON_TAC[span, HULL_SUBSET, SUBSET_DEF, SUBSPACE_SPAN, subspace]
697QED
698
699Theorem SPAN_INDUCT:
700   !s h. (!x. x IN s ==> x IN h) /\ subspace h ==> !x. x IN span(s) ==> h(x)
701Proof
702  REWRITE_TAC[span] THEN MESON_TAC[SUBSET_DEF, HULL_MINIMAL, IN_DEF]
703QED
704
705Theorem SPAN_EMPTY:
706   span {} = {0}
707Proof
708  REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_UNIQUE THEN
709  SIMP_TAC std_ss [subspace, SUBSET_DEF, IN_SING, NOT_IN_EMPTY] THEN
710  REPEAT STRIP_TAC THEN REAL_ARITH_TAC
711QED
712
713Theorem INDEPENDENT_EMPTY:
714   independent {}
715Proof
716  REWRITE_TAC[independent, dependent, NOT_IN_EMPTY]
717QED
718
719Theorem INDEPENDENT_NONZERO:
720   !s. independent s ==> ~(0 IN s)
721Proof
722  REWRITE_TAC[independent, dependent] THEN MESON_TAC[SPAN_CLAUSES]
723QED
724
725Theorem INDEPENDENT_MONO:
726   !s t. independent t /\ s SUBSET t ==> independent s
727Proof
728  REWRITE_TAC[independent, dependent] THEN
729  ASM_MESON_TAC[SPAN_MONO, SUBSET_DEF, IN_DELETE]
730QED
731
732Theorem DEPENDENT_MONO:
733   !s t:real->bool. dependent s /\ s SUBSET t ==> dependent t
734Proof
735  ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> ~r /\ q ==> ~p`] THEN
736  REWRITE_TAC[GSYM independent, INDEPENDENT_MONO]
737QED
738
739Theorem SPAN_SUBSPACE:
740   !b s. b SUBSET s /\ s SUBSET (span b) /\ subspace s ==> (span b = s)
741Proof
742  MESON_TAC[SUBSET_ANTISYM, span, HULL_MINIMAL]
743QED
744
745Theorem SPAN_INDUCT_ALT:
746   !s h. h(0) /\
747         (!c x y. x IN s /\ h(y) ==> h(c * x + y))
748          ==> !x:real. x IN span(s) ==> h(x)
749Proof
750  REPEAT GEN_TAC THEN DISCH_TAC THEN
751  FIRST_ASSUM(MP_TAC o prove_nonschematic_inductive_relations_exist bool_monoset o concl) THEN
752  DISCH_THEN(X_CHOOSE_THEN ``g:real->bool`` STRIP_ASSUME_TAC) THEN
753  SUBGOAL_THEN ``!x:real. x IN span(s) ==> g(x)``
754   (fn th => METIS_TAC [th]) THEN
755  MATCH_MP_TAC SPAN_INDUCT THEN SIMP_TAC std_ss [subspace, GSPECIFICATION] THEN
756  SIMP_TAC std_ss [IN_DEF, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
757  ONCE_REWRITE_TAC [METIS [] ``(g x ==> g (c * x)) = (\c x:real. g x ==> g (c * x)) c x``] THEN
758  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM] THEN
759  REPEAT CONJ_TAC THENL
760  [METIS_TAC [IN_DEF, REAL_ADD_LID, REAL_ADD_ASSOC, REAL_ADD_SYM,
761                REAL_MUL_LID, REAL_MUL_RZERO],
762   METIS_TAC [IN_DEF, REAL_ADD_LID, REAL_ADD_ASSOC, REAL_ADD_SYM,
763                REAL_MUL_LID, REAL_MUL_RZERO],
764   ONCE_REWRITE_TAC [METIS [] ``!x. (!y. g y ==> g (x + y)) =
765                              (\x. !y. g y ==> g (x + y)) (x:real)``] THEN
766   FIRST_X_ASSUM MATCH_MP_TAC THEN
767   SIMP_TAC std_ss [REAL_ADD_LDISTRIB, REAL_MUL_ASSOC] THEN
768   ASM_MESON_TAC [IN_DEF, REAL_ADD_LID, REAL_ADD_ASSOC, REAL_ADD_SYM,
769                REAL_MUL_LID, REAL_MUL_RZERO],
770   ONCE_REWRITE_TAC [METIS [] ``(!x. g (x * y)) =
771                            (\y.!x. g (x * y)) (y:real)``] THEN
772   FIRST_X_ASSUM MATCH_MP_TAC THEN
773   SIMP_TAC std_ss [REAL_ADD_LDISTRIB, REAL_MUL_ASSOC] THEN
774   ASM_MESON_TAC [IN_DEF, REAL_ADD_LID, REAL_ADD_ASSOC, REAL_ADD_SYM,
775                  REAL_MUL_LID, REAL_MUL_RZERO]]
776QED
777
778(* ------------------------------------------------------------------------- *)
779(* Individual closure properties.                                            *)
780(* ------------------------------------------------------------------------- *)
781
782Theorem SPAN_SUPERSET:
783   !x. x IN s ==> x IN span s
784Proof
785  MESON_TAC[SPAN_CLAUSES]
786QED
787
788Theorem SPAN_INC:
789   !s. s SUBSET span s
790Proof
791  REWRITE_TAC[SUBSET_DEF, SPAN_SUPERSET]
792QED
793
794Theorem SPAN_UNION_SUBSET:
795   !s t. span s UNION span t SUBSET span(s UNION t)
796Proof
797  REWRITE_TAC[span, HULL_UNION_SUBSET]
798QED
799
800Theorem SPAN_UNIV:
801   span univ(:real) = univ(:real)
802Proof
803  SIMP_TAC std_ss [SPAN_INC, SET_RULE ``UNIV SUBSET s ==> (s = UNIV)``]
804QED
805
806Theorem SPAN_0:
807   (0) IN span s
808Proof
809  MESON_TAC[SUBSPACE_SPAN, SUBSPACE_0]
810QED
811
812Theorem SPAN_ADD:
813   !x y s. x IN span s /\ y IN span s ==> (x + y) IN span s
814Proof
815  MESON_TAC[SUBSPACE_SPAN, SUBSPACE_ADD]
816QED
817
818Theorem SPAN_MUL:
819   !x c s. x IN span s ==> (c * x) IN span s
820Proof
821  MESON_TAC[SUBSPACE_SPAN, SUBSPACE_MUL]
822QED
823
824Theorem SPAN_MUL_EQ:
825   !x:real c s. ~(c = &0) ==> ((c * x) IN span s <=> x IN span s)
826Proof
827  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC std_ss [SPAN_MUL] THEN
828  SUBGOAL_THEN ``(inv(c) * c * x:real) IN span s`` MP_TAC THENL
829   [REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC std_ss [SPAN_MUL],
830    ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_LID]]
831QED
832
833Theorem SPAN_NEG:
834   !x s. x IN span s ==> (-x) IN span s
835Proof
836  MESON_TAC[SUBSPACE_SPAN, SUBSPACE_NEG]
837QED
838
839Theorem SPAN_NEG_EQ:
840   !x s. -x IN span s <=> x IN span s
841Proof
842  MESON_TAC[SPAN_NEG, REAL_NEG_NEG]
843QED
844
845Theorem SPAN_SUB:
846   !x y s. x IN span s /\ y IN span s ==> (x - y) IN span s
847Proof
848  MESON_TAC[SUBSPACE_SPAN, SUBSPACE_SUB]
849QED
850
851Theorem SPAN_SUM:
852   !s f t. FINITE t /\ (!x. x IN t ==> f(x) IN span(s))
853           ==> (sum t f) IN span(s)
854Proof
855  MESON_TAC[SUBSPACE_SPAN, SUBSPACE_SUM]
856QED
857
858Theorem SPAN_ADD_EQ:
859   !s x y. x IN span s ==> ((x + y) IN span s <=> y IN span s)
860Proof
861  MESON_TAC[SPAN_ADD, SPAN_SUB, REAL_ARITH ``(x + y) - x:real = y``]
862QED
863
864Theorem SPAN_EQ_SELF:
865   !s. (span s = s) <=> subspace s
866Proof
867  GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSPACE_SPAN], ALL_TAC] THEN
868  DISCH_TAC THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
869  ASM_REWRITE_TAC[SUBSET_REFL, SPAN_INC]
870QED
871
872Theorem SPAN_SUBSET_SUBSPACE:
873   !s t:real->bool. s SUBSET t /\ subspace t ==> span s SUBSET t
874Proof
875  MESON_TAC[SPAN_MONO, SPAN_EQ_SELF]
876QED
877
878Theorem SURJECTIVE_IMAGE_EQ:
879   !s t. (!y. y IN t ==> ?x. f x = y) /\ (!x. (f x) IN t <=> x IN s)
880         ==> (IMAGE f s = t)
881Proof
882  SET_TAC[]
883QED
884
885Theorem SUBSPACE_TRANSLATION_SELF:
886   !s a. subspace s /\ a IN s ==> (IMAGE (\x. a + x) s = s)
887Proof
888  REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
889  FIRST_ASSUM(SUBST1_TAC o SYM o REWRITE_RULE [GSYM SPAN_EQ_SELF]) THEN
890  ASM_SIMP_TAC std_ss [SPAN_ADD_EQ, SPAN_CLAUSES] THEN
891  REWRITE_TAC[REAL_ARITH ``(a + x:real = y) <=> (x = y - a)``, EXISTS_REFL]
892QED
893
894Theorem SUBSPACE_TRANSLATION_SELF_EQ:
895   !s a:real. subspace s ==> ((IMAGE (\x. a + x) s = s) <=> a IN s)
896Proof
897  REPEAT STRIP_TAC THEN EQ_TAC THEN
898  ASM_SIMP_TAC std_ss [SUBSPACE_TRANSLATION_SELF] THEN
899  DISCH_THEN(MP_TAC o AP_TERM ``\s. (a:real) IN s``) THEN
900  SIMP_TAC std_ss [] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
901  REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC ``0:real`` THEN
902  ASM_MESON_TAC[subspace, REAL_ADD_RID]
903QED
904
905Theorem SUBSPACE_SUMS:
906   !s t. subspace s /\ subspace t
907         ==> subspace {x + y | x IN s /\ y IN t}
908Proof
909  SIMP_TAC std_ss [subspace, FORALL_IN_GSPEC, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
910  SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN REPEAT STRIP_TAC THENL
911   [ASM_MESON_TAC[REAL_ADD_LID],
912    ONCE_REWRITE_TAC[REAL_ARITH
913     ``(x + y) + (x' + y'):real = (x + x') + (y + y')``] THEN
914    ASM_MESON_TAC[],
915    REWRITE_TAC[REAL_ADD_LDISTRIB] THEN ASM_MESON_TAC[]]
916QED
917
918Theorem SPAN_UNION:
919   !s t. span(s UNION t) = {x + y:real | x IN span s /\ y IN span t}
920Proof
921  REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
922   [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
923    SIMP_TAC std_ss [SUBSPACE_SUMS, SUBSPACE_SPAN] THEN
924    SIMP_TAC std_ss [SUBSET_DEF, IN_UNION, GSPECIFICATION, EXISTS_PROD] THEN
925    X_GEN_TAC ``x:real`` THEN STRIP_TAC THENL
926     [MAP_EVERY EXISTS_TAC [``x:real``, ``0:real``] THEN
927      ASM_SIMP_TAC std_ss [SPAN_SUPERSET, SPAN_0, REAL_ADD_RID],
928      MAP_EVERY EXISTS_TAC [``0:real``, ``x:real``] THEN
929      ASM_SIMP_TAC std_ss [SPAN_SUPERSET, SPAN_0, REAL_ADD_LID]],
930    SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC] THEN
931    REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN
932    ASM_MESON_TAC[SPAN_MONO, SUBSET_UNION, SUBSET_DEF]]
933QED
934
935(* ------------------------------------------------------------------------- *)
936(* Equality in Cauchy-Schwarz and triangle inequalities.                     *)
937(* ------------------------------------------------------------------------- *)
938
939Theorem ABS_CAUCHY_SCHWARZ_EQ:
940   !x:real y. (x * y = abs(x) * abs(y)) <=> (abs(x) * y = abs(y) * x)
941Proof
942   REPEAT GEN_TAC THEN ASM_CASES_TAC ``0 <= x:real`` THEN
943  (ASM_CASES_TAC ``0 <= y:real``) THEN ASM_REWRITE_TAC [abs] THENL
944  [ASM_REAL_ARITH_TAC, ALL_TAC, ALL_TAC, ASM_REAL_ARITH_TAC] THEN
945  ((MP_TAC o SPECL [``x:real``,``y:real``]) REAL_LT_TOTAL THEN STRIP_TAC THEN
946  TRY (ASM_REAL_ARITH_TAC)) THEN COND_CASES_TAC THEN EQ_TAC THEN
947  TRY (ASM_REAL_ARITH_TAC)
948QED
949
950Theorem ABS_CAUCHY_SCHWARZ_ABS_EQ:
951   !x:real y. (abs(x * y) = abs(x) * abs(y)) <=>
952                (abs(x) * y = abs(y) * x) \/ (abs(x) * y = -abs(y) * x)
953Proof
954  SIMP_TAC std_ss [REAL_ARITH ``&0 <= a ==> ((abs x = a) <=> (x = a) \/ (-x = a:real))``,
955           REAL_LE_MUL, ABS_POS, REAL_MUL_RNEG] THEN
956  REAL_ARITH_TAC
957QED
958
959Theorem REAL_EQ_LINV:   !x. (-x = (x :real)) <=> (x = 0)
960Proof
961    GEN_TAC
962 >> REWRITE_TAC [SYM (Q.SPECL [`x`, `-x`, `x`] REAL_EQ_LADD)]
963 >> REWRITE_TAC [REAL_ADD_RINV, REAL_DOUBLE]
964 >> RW_TAC real_ss [REAL_ENTIRE]
965QED
966
967Theorem REAL_EQ_RINV:   !x. ((x :real) = -x) <=> (x = 0)
968Proof
969    GEN_TAC
970 >> REWRITE_TAC [SYM (Q.SPECL [`x`, `x`, `-x`] REAL_EQ_LADD)]
971 >> REWRITE_TAC [REAL_ADD_RINV, REAL_DOUBLE]
972 >> RW_TAC real_ss [REAL_ENTIRE]
973QED
974
975(* this proof is too advanced in realScript *)
976Theorem ABS_TRIANGLE_EQ:
977    !x y:real. (abs(x + y) = abs(x) + abs(y)) <=> (abs(x) * y = abs(y) * x)
978Proof
979    rpt GEN_TAC
980 >> ASM_CASES_TAC ``0 <= x:real``
981 >> ASM_CASES_TAC ``0 <= y:real``
982 >> ASM_REWRITE_TAC [abs]
983 >- ( `0 <= x + y` by PROVE_TAC [REAL_LE_ADD] \\
984      ASM_SIMP_TAC bool_ss [] >> REAL_ARITH_TAC )
985 >| [ (* goal 1 (of 3) *)
986      Cases_on `0 <= x + y`
987      >- ( ASM_SIMP_TAC bool_ss [REAL_EQ_LADD, Once REAL_MUL_SYM] \\
988           EQ_TAC >- PROVE_TAC [] \\
989           REWRITE_TAC [REAL_EQ_RMUL] \\
990           STRIP_TAC >> FULL_SIMP_TAC bool_ss [REAL_ADD_LID] ) \\
991      ASM_SIMP_TAC bool_ss [REAL_NEG_ADD, REAL_EQ_RADD, Once REAL_MUL_SYM] \\
992      `(-x = x) = (x = 0)` by PROVE_TAC [REAL_EQ_LINV] \\
993      POP_ASSUM (REWRITE_TAC o wrap) \\
994      REWRITE_TAC [REAL_EQ_RMUL] \\
995      EQ_TAC >- PROVE_TAC [] \\
996      STRIP_TAC \\
997      `y = 0` by PROVE_TAC [REAL_EQ_RINV] \\
998      FULL_SIMP_TAC bool_ss [REAL_ADD_RID],
999      (* goal 2 (of 3) *)
1000      Cases_on `0 <= x + y`
1001      >- ( ASM_SIMP_TAC bool_ss [REAL_EQ_RADD, Once REAL_MUL_SYM] \\
1002           EQ_TAC >- PROVE_TAC [] \\
1003           REWRITE_TAC [REAL_EQ_LMUL] \\
1004           reverse STRIP_TAC >- ( MATCH_MP_TAC EQ_SYM >> ASM_REWRITE_TAC [] ) \\
1005           REWRITE_TAC [REAL_EQ_RINV] \\
1006           FULL_SIMP_TAC bool_ss [REAL_ADD_RID] ) \\
1007      FULL_SIMP_TAC bool_ss [REAL_NEG_ADD] \\
1008      REWRITE_TAC [REAL_EQ_LADD, REAL_EQ_LINV, Once REAL_MUL_SYM] \\
1009      EQ_TAC >- RW_TAC real_ss [] \\
1010      REWRITE_TAC [REAL_EQ_LMUL, REAL_EQ_LINV] >> STRIP_TAC \\
1011      FULL_SIMP_TAC bool_ss [REAL_ADD_LID],
1012      (* goal 3 (of 3) *)
1013      Know `~(0 <= x + y)`
1014      >- (FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
1015          PROVE_TAC [REAL_LT_ADD2, REAL_ADD_RID]) \\
1016      DISCH_TAC >> ASM_SIMP_TAC bool_ss [] \\
1017      REWRITE_TAC [REAL_NEG_ADD] \\
1018      PROVE_TAC [REAL_NEG_RMUL, REAL_MUL_SYM] ]
1019QED
1020
1021Theorem DIST_TRIANGLE_EQ:
1022   !x y z:real. (dist(x,z) = dist(x,y) + dist(y,z)) <=>
1023                (abs (x - y) * (y - z) = abs (y - z) * (x - y))
1024Proof
1025  REWRITE_TAC[GSYM ABS_TRIANGLE_EQ, dist] THEN REAL_ARITH_TAC
1026QED
1027
1028(* ------------------------------------------------------------------------- *)
1029(* Collinearity.                                                             *)
1030(* ------------------------------------------------------------------------- *)
1031
1032val _ = hide "collinear";
1033
1034Definition collinear[nocompute]:
1035 collinear s <=> ?u. !x y:real. x IN s /\ y IN s ==> ?c. x - y = c * u
1036End
1037
1038Theorem COLLINEAR_SUBSET:
1039   !s t. collinear t /\ s SUBSET t ==> collinear s
1040Proof
1041  REWRITE_TAC[collinear] THEN SET_TAC[]
1042QED
1043
1044Theorem COLLINEAR_EMPTY:
1045   collinear {}
1046Proof
1047  REWRITE_TAC[collinear, NOT_IN_EMPTY]
1048QED
1049
1050Theorem COLLINEAR_SING:
1051   !x:real. collinear {x}
1052Proof
1053  SIMP_TAC std_ss [collinear, IN_SING, REAL_SUB_REFL] THEN
1054  METIS_TAC [REAL_MUL_LZERO]
1055QED
1056
1057Theorem COLLINEAR_2:
1058   !x y:real. collinear {x;y}
1059Proof
1060  REPEAT GEN_TAC THEN REWRITE_TAC[collinear, IN_INSERT, NOT_IN_EMPTY] THEN
1061  EXISTS_TAC ``x - y:real`` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
1062   [EXISTS_TAC ``&0:real``, EXISTS_TAC ``&1:real``,
1063    EXISTS_TAC ``- &1:real``, EXISTS_TAC ``&0:real``] THEN
1064  REAL_ARITH_TAC
1065QED
1066
1067Theorem COLLINEAR_SMALL:
1068   !s. FINITE s /\ CARD s <= 2 ==> collinear s
1069Proof
1070  REWRITE_TAC[ARITH_PROVE ``s <= 2 <=> (s = 0) \/ (s = 1) \/ (s = 2:num)``] THEN
1071  REWRITE_TAC[LEFT_AND_OVER_OR, GSYM HAS_SIZE] THEN
1072  REWRITE_TAC [ONE, TWO, HAS_SIZE_CLAUSES] THEN
1073  REPEAT STRIP_TAC THEN
1074  ASM_REWRITE_TAC[COLLINEAR_EMPTY, COLLINEAR_SING, COLLINEAR_2]
1075QED
1076
1077Theorem COLLINEAR_3:
1078   !x y z. collinear {x;y;z} <=> collinear {0;x - y;z - y}
1079Proof
1080  REPEAT GEN_TAC THEN
1081  SIMP_TAC std_ss [collinear, FORALL_IN_INSERT, CONJ_EQ_IMP,
1082                   RIGHT_FORALL_IMP_THM, NOT_IN_EMPTY] THEN
1083  AP_TERM_TAC THEN ABS_TAC THEN
1084  METIS_TAC [REAL_ARITH ``x - y = (x - y) - 0:real``,
1085             REAL_ARITH ``y - x = 0 - (x - y:real)``,
1086             REAL_ARITH ``x - z:real = (x - y) - (z - y)``]
1087QED
1088
1089Theorem COLLINEAR_LEMMA:
1090   !x y:real. collinear {0;x;y} <=>
1091                   (x = 0) \/ (y = 0) \/ ?c. y = c * x
1092Proof
1093  REPEAT GEN_TAC THEN
1094  MAP_EVERY ASM_CASES_TAC [``x:real = 0``, ``y:real = 0``] THEN
1095  TRY(ONCE_REWRITE_TAC [INSERT_COMM] THEN
1096      ASM_REWRITE_TAC[INSERT_INSERT, COLLINEAR_SING, COLLINEAR_2] THEN NO_TAC) THEN
1097  ASM_REWRITE_TAC[collinear] THEN EQ_TAC THENL
1098   [DISCH_THEN(X_CHOOSE_THEN ``u:real``
1099     (fn th => MP_TAC(SPECL [``x:real``, ``0:real``] th) THEN
1100                MP_TAC(SPECL [``y:real``, ``0:real``] th))) THEN
1101    REWRITE_TAC[IN_INSERT, REAL_SUB_RZERO] THEN
1102    DISCH_THEN(X_CHOOSE_THEN ``e:real`` SUBST_ALL_TAC) THEN
1103    DISCH_THEN(X_CHOOSE_THEN ``d:real`` SUBST_ALL_TAC) THEN
1104    EXISTS_TAC ``e / d:real`` THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
1105    RULE_ASSUM_TAC(REWRITE_RULE[REAL_ENTIRE, DE_MORGAN_THM]) THEN
1106    ASM_SIMP_TAC real_ss [REAL_DIV_RMUL],
1107    STRIP_TAC THEN EXISTS_TAC ``x:real`` THEN ASM_REWRITE_TAC[] THEN
1108    REWRITE_TAC[IN_INSERT, NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
1109    ASM_REWRITE_TAC[] THENL
1110     [EXISTS_TAC ``&0:real``, EXISTS_TAC ``- &1:real``, EXISTS_TAC ``-c:real``,
1111      EXISTS_TAC ``&1:real``, EXISTS_TAC ``&0:real``, EXISTS_TAC ``&1 - c:real``,
1112      EXISTS_TAC ``c:real``, EXISTS_TAC ``c - &1:real``, EXISTS_TAC ``&0:real``] THEN
1113    REAL_ARITH_TAC]
1114QED
1115
1116Theorem COLLINEAR_LEMMA_ALT:
1117   !x y. collinear {0;x;y} <=> (x = 0) \/ ?c. y = c * x
1118Proof
1119  REWRITE_TAC[COLLINEAR_LEMMA] THEN METIS_TAC [REAL_MUL_LZERO]
1120QED
1121
1122Theorem ABS_CAUCHY_SCHWARZ_EQUAL:
1123   !x y:real. (abs(x * y) = abs(x) * abs(y)) <=> collinear {0;x;y}
1124Proof
1125  REPEAT GEN_TAC THEN REWRITE_TAC[ABS_CAUCHY_SCHWARZ_ABS_EQ] THEN
1126  MAP_EVERY ASM_CASES_TAC [``x:real = 0``, ``y:real = 0``] THEN
1127  TRY(ONCE_ASM_REWRITE_TAC [INSERT_COMM] THEN
1128      ASM_REWRITE_TAC[INSERT_INSERT, COLLINEAR_SING, COLLINEAR_2, ABS_0,
1129                      REAL_MUL_LZERO, REAL_MUL_RZERO] THEN NO_TAC) THEN
1130  ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN EQ_TAC THENL
1131   [STRIP_TAC THENL
1132     [EXISTS_TAC ``y / x:real``, EXISTS_TAC ``y / x:real``] THEN
1133    ASM_SIMP_TAC std_ss [REAL_DIV_RMUL],
1134    ASM_REAL_ARITH_TAC]
1135QED
1136
1137Theorem MUL_CAUCHY_SCHWARZ_EQUAL:
1138   !x y:real.
1139        ((x * y) pow 2 = (x * x) * (y * y)) <=>
1140        collinear {0;x;y}
1141Proof
1142  REWRITE_TAC[GSYM ABS_CAUCHY_SCHWARZ_EQUAL] THEN
1143  REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
1144   ``&0 <= y /\ ((u:real = v) <=> (x = abs y)) ==> ((u = v) <=> (x = y:real))``) THEN
1145  SIMP_TAC std_ss [ABS_POS, REAL_LE_MUL] THEN
1146  REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[POW_MUL, GSYM POW_2] THEN
1147  REWRITE_TAC [POW_2] THEN REAL_ARITH_TAC
1148QED
1149
1150Theorem COLLINEAR_3_EXPAND:
1151   !a b c:real. collinear{a;b;c} <=> ((a = c) \/ ?u. b = u * a + (&1 - u) * c)
1152Proof
1153  REPEAT GEN_TAC THEN
1154  ONCE_REWRITE_TAC[SET_RULE ``{a;b;c} = {a;c;b}``] THEN
1155  ONCE_REWRITE_TAC[COLLINEAR_3] THEN
1156  REWRITE_TAC[COLLINEAR_LEMMA, REAL_SUB_0] THEN
1157  ASM_CASES_TAC ``a:real = c`` THEN ASM_REWRITE_TAC[] THEN
1158  ASM_CASES_TAC ``b:real = c`` THEN
1159  ASM_REWRITE_TAC[REAL_ARITH ``u * c + (&1 - u) * c = c:real``] THENL
1160   [EXISTS_TAC ``&0:real`` THEN REAL_ARITH_TAC,
1161     AP_TERM_TAC THEN ABS_TAC THEN REAL_ARITH_TAC]
1162QED
1163
1164Theorem COLLINEAR_TRIPLES:
1165   !s a b:real.
1166        ~(a = b)
1167        ==> (collinear(a INSERT b INSERT s) <=>
1168             !x. x IN s ==> collinear{a;b;x})
1169Proof
1170  REPEAT STRIP_TAC THEN EQ_TAC THENL
1171   [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1172     (REWRITE_RULE[CONJ_EQ_IMP] COLLINEAR_SUBSET)) THEN
1173    ASM_SET_TAC[],
1174    ONCE_REWRITE_TAC[SET_RULE ``{a;b;x} = {a;x;b}``] THEN
1175    ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN DISCH_TAC THEN
1176    SUBGOAL_THEN
1177     ``!x:real. x IN (a INSERT b INSERT s) ==> ?u. x = u * a + (&1 - u) * b``
1178    MP_TAC THENL
1179     [ASM_SIMP_TAC real_ss [FORALL_IN_INSERT] THEN CONJ_TAC THENL
1180       [EXISTS_TAC ``&1:real`` THEN REAL_ARITH_TAC,
1181        EXISTS_TAC ``&0:real`` THEN REAL_ARITH_TAC],
1182      POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
1183      REWRITE_TAC[collinear] THEN EXISTS_TAC ``b - a:real`` THEN
1184      MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
1185      FIRST_X_ASSUM(fn th => MP_TAC(SPEC ``x:real`` th) THEN MP_TAC(SPEC
1186        ``y:real`` th)) THEN
1187      ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
1188      ASM_REWRITE_TAC[REAL_ARITH
1189       ``(u * a + (&1 - u) * b) - (v * a + (&1 - v) * b):real =
1190         (v - u) * (b - a)``] THEN
1191      METIS_TAC []]]
1192QED
1193
1194Theorem COLLINEAR_4_3:
1195   !a b c d:real.
1196        ~(a = b)
1197        ==> (collinear {a;b;c;d} <=> collinear{a;b;c} /\ collinear{a;b;d})
1198Proof
1199  REPEAT STRIP_TAC THEN
1200  MP_TAC(ISPECL [``{c:real;d}``, ``a:real``, ``b:real``]
1201    COLLINEAR_TRIPLES) THEN
1202  ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
1203  SIMP_TAC real_ss [FORALL_IN_INSERT, NOT_IN_EMPTY]
1204QED
1205
1206Theorem COLLINEAR_3_TRANS:
1207   !a b c d:real.
1208        collinear{a;b;c} /\ collinear{b;c;d} /\ ~(b = c) ==> collinear{a;b;d}
1209Proof
1210  REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
1211  EXISTS_TAC ``{b:real;c;a;d}`` THEN ASM_SIMP_TAC std_ss [COLLINEAR_4_3] THEN
1212  CONJ_TAC THENL [ALL_TAC, SET_TAC[]] THEN
1213  ONCE_ASM_REWRITE_TAC [SET_RULE ``{b;c;a} = {a;b;c}``] THEN METIS_TAC []
1214QED
1215
1216(* ------------------------------------------------------------------------- *)
1217(* Between-ness.                                                             *)
1218(* ------------------------------------------------------------------------- *)
1219
1220Definition between[nocompute]:
1221 between x (a,b) <=> (dist(a,b) = dist(a,x) + dist(x,b))
1222End
1223
1224Theorem BETWEEN_REFL:
1225   !a b. between a (a,b) /\ between b (a,b) /\ between a (a,a)
1226Proof
1227  REWRITE_TAC[between, dist] THEN REAL_ARITH_TAC
1228QED
1229
1230Theorem BETWEEN_REFL_EQ:
1231   !a x. between x (a,a) <=> (x = a)
1232Proof
1233  REWRITE_TAC[between, dist] THEN REAL_ARITH_TAC
1234QED
1235
1236Theorem BETWEEN_SYM:
1237   !a b x. between x (a,b) <=> between x (b,a)
1238Proof
1239  REWRITE_TAC[between, dist] THEN REAL_ARITH_TAC
1240QED
1241
1242Theorem BETWEEN_ANTISYM:
1243   !a b c. between a (b,c) /\ between b (a,c) ==> (a = b)
1244Proof
1245  REWRITE_TAC[between, dist] THEN REAL_ARITH_TAC
1246QED
1247
1248Theorem BETWEEN_TRANS:
1249   !a b c d. between a (b,c) /\ between d (a,c) ==> between d (b,c)
1250Proof
1251  REWRITE_TAC[between, dist] THEN REAL_ARITH_TAC
1252QED
1253
1254Theorem BETWEEN_TRANS_2:
1255   !a b c d. between a (b,c) /\ between d (a,b) ==> between a (c,d)
1256Proof
1257  REWRITE_TAC[between, dist] THEN REAL_ARITH_TAC
1258QED
1259
1260Theorem BETWEEN_ABS:
1261   !a b x:real.
1262     between x (a,b) <=> (abs(x - a) * (b - x) = abs(b - x) * (x - a))
1263Proof
1264  REPEAT GEN_TAC THEN REWRITE_TAC[between, DIST_TRIANGLE_EQ] THEN
1265  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN REAL_ARITH_TAC
1266QED
1267
1268Theorem BETWEEN_IMP_COLLINEAR:
1269   !a b x:real. between x (a,b) ==> collinear {a;x;b}
1270Proof
1271  REPEAT GEN_TAC THEN ASM_CASES_TAC ``x:real = a`` THENL
1272  [ONCE_REWRITE_TAC[COLLINEAR_3, BETWEEN_ABS] THEN
1273   DISCH_TAC THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA, REAL_SUB_REFL] THEN
1274   ASM_REAL_ARITH_TAC,
1275   ONCE_REWRITE_TAC[COLLINEAR_3, BETWEEN_ABS] THEN
1276   DISCH_TAC THEN ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN
1277   DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC ``(b - x) / (a - x:real)`` THEN
1278   RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_ARITH
1279                   ``(x <> a) = ((a - x) <> 0:real)``]) THEN
1280   ASM_SIMP_TAC real_ss [REAL_DIV_RMUL]]
1281QED
1282
1283Theorem COLLINEAR_BETWEEN_CASES:
1284   !a b c:real.
1285        collinear {a;b;c} <=>
1286        between a (b,c) \/ between b (c,a) \/ between c (a,b)
1287Proof
1288  REPEAT STRIP_TAC THEN EQ_TAC THENL
1289   [REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
1290    ASM_CASES_TAC ``c:real = a`` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN
1291    STRIP_TAC THEN ASM_REWRITE_TAC[between, dist] THEN
1292    ASM_REAL_ARITH_TAC,
1293    DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (MP_TAC o MATCH_MP
1294      BETWEEN_IMP_COLLINEAR)) THEN
1295    METIS_TAC[INSERT_COMM]]
1296QED
1297
1298Theorem COLLINEAR_DIST_BETWEEN:
1299   !a b x. collinear {x;a;b} /\
1300           dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
1301           ==> between x (a,b)
1302Proof
1303  SIMP_TAC std_ss [COLLINEAR_BETWEEN_CASES, between, dist] THEN REAL_ARITH_TAC
1304QED
1305
1306Theorem COLLINEAR_1:
1307   !s:real->bool. collinear s
1308Proof
1309  GEN_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
1310  EXISTS_TAC ``(0:real) INSERT (1:real) INSERT s`` THEN
1311  CONJ_TAC THENL [ALL_TAC, SET_TAC[]] THEN
1312  W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN
1313  REWRITE_TAC[REAL_ARITH ``0 <> 1:real``] THEN DISCH_THEN SUBST1_TAC THEN
1314  REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN
1315  REWRITE_TAC[between, dist, ABS_N] THEN
1316  REAL_ARITH_TAC
1317QED
1318
1319(* ------------------------------------------------------------------------- *)
1320(* Midpoint between two points.                                              *)
1321(* ------------------------------------------------------------------------- *)
1322
1323Definition midpoint[nocompute]:
1324 midpoint(a,b) = inv(&2:real) * (a + b)
1325End
1326
1327Theorem MIDPOINT_REFL: !x. midpoint(x,x) = x
1328Proof
1329  REWRITE_TAC[midpoint, REAL_DOUBLE, REAL_MUL_ASSOC] THEN
1330  SIMP_TAC std_ss [REAL_MUL_LINV, REAL_ARITH ``2 <> 0:real``] THEN
1331  REAL_ARITH_TAC
1332QED
1333
1334Theorem MIDPOINT_SYM:
1335   !a b. midpoint(a,b) = midpoint(b,a)
1336Proof
1337  METIS_TAC[midpoint, REAL_ADD_SYM]
1338QED
1339
1340Theorem DIST_MIDPOINT:
1341   !a b. (dist(a,midpoint(a,b)) = dist(a,b) / &2) /\
1342         (dist(b,midpoint(a,b)) = dist(a,b) / &2) /\
1343         (dist(midpoint(a,b),a) = dist(a,b) / &2) /\
1344         (dist(midpoint(a,b),b) = dist(a,b) / &2)
1345Proof
1346  REWRITE_TAC[midpoint, dist] THEN
1347  SIMP_TAC std_ss [REAL_EQ_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
1348  ONCE_REWRITE_TAC [GSYM ABS_N] THEN
1349  REWRITE_TAC [GSYM ABS_MUL, REAL_SUB_RDISTRIB] THEN REWRITE_TAC [ABS_N] THEN
1350  ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c = a * c * b:real``] THEN
1351  SIMP_TAC std_ss [REAL_MUL_LINV, REAL_ARITH ``2 <> 0:real``] THEN
1352  REAL_ARITH_TAC
1353QED
1354
1355Theorem MIDPOINT_EQ_ENDPOINT:
1356   !a b. ((midpoint(a,b) = a) <=> (a = b)) /\
1357         ((midpoint(a,b) = b) <=> (a = b)) /\
1358         ((a = midpoint(a,b)) <=> (a = b)) /\
1359         ((b = midpoint(a,b)) <=> (a = b))
1360Proof
1361  REWRITE_TAC[midpoint] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
1362  REWRITE_TAC [GSYM real_div] THEN
1363  SIMP_TAC std_ss
1364    [REAL_EQ_RDIV_EQ, REAL_EQ_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
1365  REAL_ARITH_TAC
1366QED
1367
1368Theorem BETWEEN_MIDPOINT:
1369   !a b. between (midpoint(a,b)) (a,b) /\ between (midpoint(a,b)) (b,a)
1370Proof
1371  REWRITE_TAC[between, midpoint] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
1372  REWRITE_TAC [dist, GSYM real_div] THEN
1373  ONCE_REWRITE_TAC [REAL_ARITH ``a / 2 - b = a / 2 - b * 1:real``] THEN
1374  ONCE_REWRITE_TAC [REAL_ARITH ``b - a / 2 = b * 1 - a / 2:real``] THEN
1375  REWRITE_TAC [
1376    METIS [REAL_DIV_REFL, REAL_ARITH ``2 <> 0:real``] ``1 = 2/2:real``] THEN
1377  REWRITE_TAC [real_div, REAL_MUL_ASSOC, real_sub] THEN
1378  REWRITE_TAC [REAL_ARITH ``-(a * b) = -a * b:real``] THEN
1379  REWRITE_TAC [GSYM real_div] THEN SIMP_TAC std_ss [REAL_DIV_ADD] THEN
1380  REWRITE_TAC [real_div, ABS_MUL] THEN
1381  SIMP_TAC std_ss [ABS_N, ABS_INV, REAL_ARITH ``2 <> 0:real``] THEN
1382  REWRITE_TAC [GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC [GSYM real_div] THEN
1383  SIMP_TAC std_ss [REAL_EQ_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
1384  REAL_ARITH_TAC
1385QED
1386
1387Theorem MIDPOINT_LINEAR_IMAGE:
1388   !f a b. linear f ==> (midpoint(f a,f b) = f(midpoint(a,b)))
1389Proof
1390  SIMP_TAC std_ss [midpoint, LINEAR_ADD, LINEAR_CMUL]
1391QED
1392
1393Theorem COLLINEAR_MIDPOINT:
1394   !a b. collinear{a;midpoint(a,b);b}
1395Proof
1396  REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3_EXPAND, midpoint] THEN
1397  DISJ2_TAC THEN REWRITE_TAC [REAL_ARITH ``u * a + (1 - u) * b =
1398                                           a * u - b * u + b:real``] THEN
1399  EXISTS_TAC ``inv &2:real`` THEN GEN_REWR_TAC LAND_CONV [REAL_MUL_SYM] THEN
1400  REWRITE_TAC [REAL_ADD_RDISTRIB] THEN
1401  GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
1402  REWRITE_TAC [GSYM real_div] THEN REAL_ARITH_TAC
1403QED
1404
1405Theorem MIDPOINT_COLLINEAR:
1406   !a b c:real.
1407     a <> c ==>
1408     ((b = midpoint(a,c)) <=> collinear{a;b;c} /\ (dist(a,b) = dist(b,c)))
1409Proof
1410  REPEAT STRIP_TAC THEN
1411  MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> (a <=> c)) ==> (a <=> b /\ c)`) THEN
1412  SIMP_TAC std_ss [COLLINEAR_MIDPOINT] THEN
1413  ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
1414  STRIP_TAC THEN ASM_REWRITE_TAC[midpoint, dist] THEN
1415  REWRITE_TAC
1416   [REAL_ARITH ``a - (u * a + (&1 - u) * c) = (&1 - u) * (a - c:real)``,
1417    REAL_ARITH ``(u * a + (&1 - u) * c) - c = u * (a - c:real)``] THEN
1418  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
1419  SIMP_TAC std_ss [REAL_EQ_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
1420  ASM_REAL_ARITH_TAC
1421QED
1422
1423(* ------------------------------------------------------------------------ *)
1424(*  MISC                                                                    *)
1425(* ------------------------------------------------------------------------ *)
1426
1427Theorem SPAN_BREAKDOWN:
1428   !b s a:real. b IN s /\ a IN span s ==> ?k. (a - k * b) IN span(s DELETE b)
1429Proof
1430  SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
1431  REPEAT GEN_TAC THEN DISCH_TAC THEN
1432  ONCE_REWRITE_TAC [METIS []
1433   ``(?k:real. a - k * b IN span (s DELETE b)) =
1434     (\a. ?k. a - k * b IN span (s DELETE b)) a``] THEN
1435  MATCH_MP_TAC SPAN_INDUCT THEN
1436  SIMP_TAC std_ss [subspace, GSPECIFICATION] THEN CONJ_TAC THENL
1437   [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC ``x:real = b``, ALL_TAC] THEN
1438  ASM_SIMP_TAC std_ss [IN_DEF] THENL
1439  [EXISTS_TAC ``1:real`` THEN SIMP_TAC real_ss [] THEN
1440   ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN REWRITE_TAC [SPAN_CLAUSES],
1441   EXISTS_TAC ``0:real`` THEN SIMP_TAC real_ss [] THEN
1442   ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN MATCH_MP_TAC SPAN_SUPERSET THEN
1443   ASM_SET_TAC [],
1444   ALL_TAC] THEN REPEAT CONJ_TAC THENL
1445   [EXISTS_TAC ``0:real`` THEN SIMP_TAC real_ss [] THEN
1446    ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN REWRITE_TAC [SPAN_CLAUSES],
1447    REPEAT STRIP_TAC THEN EXISTS_TAC ``k + k':real`` THEN
1448    ONCE_REWRITE_TAC [REAL_ARITH
1449     ``(x + y - (k + k') * b) = ((x - k * b) + (y - k' * b:real))``] THEN
1450    ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN
1451    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM SPECIFICATION]) THEN
1452    METIS_TAC [SPAN_ADD],
1453    REPEAT STRIP_TAC THEN EXISTS_TAC ``c * k:real`` THEN
1454    ONCE_REWRITE_TAC [
1455      REAL_ARITH ``(c * x - (c * k) * y = c * (x - k * y:real))``] THEN
1456    ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN
1457    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM SPECIFICATION]) THEN
1458    METIS_TAC [SPAN_CLAUSES]]
1459QED
1460
1461Theorem IN_SPAN_INSERT:
1462   !a b:real s. a IN span(b INSERT s) /\ ~(a IN span s)
1463   ==> b IN span(a INSERT s)
1464Proof
1465  REPEAT STRIP_TAC THEN
1466  MP_TAC(ISPECL [``b:real``, ``(b:real) INSERT s``, ``a:real``]
1467    SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN
1468  DISCH_THEN(X_CHOOSE_THEN ``k:real`` MP_TAC) THEN
1469  ASM_CASES_TAC ``k = &0:real`` THEN
1470  ASM_REWRITE_TAC[REAL_ARITH ``a - &0 * b = a:real``, DELETE_INSERT] THENL
1471   [ASM_MESON_TAC[SPAN_MONO, SUBSET_DEF, DELETE_SUBSET], ALL_TAC] THEN
1472  DISCH_THEN(MP_TAC o SPEC ``inv(k:real)`` o MATCH_MP SPAN_MUL) THEN
1473  ASM_SIMP_TAC real_ss [REAL_SUB_LDISTRIB, REAL_MUL_ASSOC, REAL_MUL_LINV] THEN
1474  DISCH_TAC THEN SUBST1_TAC(REAL_ARITH
1475   ``b:real = inv(k) * a - (inv(k) * a - b)``) THEN
1476  MATCH_MP_TAC SPAN_SUB THEN
1477  FULL_SIMP_TAC std_ss [SPAN_CLAUSES, IN_INSERT, SUBSET_DEF, IN_DELETE,
1478                        SPAN_MONO] THEN
1479  POP_ASSUM MP_TAC THEN ABBREV_TAC ``y = inv k * a - b:real`` THEN
1480  SPEC_TAC (``y:real``, ``y:real``) THEN REWRITE_TAC [GSYM SUBSET_DEF] THEN
1481  MATCH_MP_TAC SPAN_MONO THEN ASM_SET_TAC []
1482QED
1483
1484Theorem INDEPENDENT_INSERT:
1485   !a:real s. independent(a INSERT s) <=>
1486    if a IN s then independent s else independent s /\ ~(a IN span s)
1487Proof
1488  REPEAT GEN_TAC THEN ASM_CASES_TAC ``(a:real) IN s`` THEN
1489  ASM_SIMP_TAC std_ss [SET_RULE ``x IN s ==> (x INSERT s = s)``] THEN
1490  EQ_TAC THENL
1491   [DISCH_TAC THEN CONJ_TAC THENL
1492     [ASM_MESON_TAC[INDEPENDENT_MONO, SUBSET_DEF, IN_INSERT],
1493      POP_ASSUM MP_TAC THEN REWRITE_TAC[independent, dependent] THEN
1494      ASM_MESON_TAC[IN_INSERT, SET_RULE
1495        ``~(a IN s) ==> ((a INSERT s) DELETE a = s)``]],
1496    ALL_TAC] THEN
1497  SIMP_TAC std_ss [independent, dependent, NOT_EXISTS_THM] THEN
1498  STRIP_TAC THEN X_GEN_TAC ``b:real`` THEN
1499  REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC ``b:real = a`` THEN
1500  ASM_SIMP_TAC std_ss [
1501    SET_RULE ``~(a IN s) ==> ((a INSERT s) DELETE a = s)``] THEN
1502  ASM_SIMP_TAC std_ss [SET_RULE ``~(a IN s) /\ ~(b = a)
1503     ==> ((a INSERT s) DELETE b = a INSERT (s DELETE b))``] THEN
1504  ASM_MESON_TAC[IN_SPAN_INSERT, SET_RULE
1505    ``b IN s ==> (b INSERT (s DELETE b) = s)``]
1506QED
1507
1508Theorem INDEPENDENT_SING:
1509   !x. independent {x} <=> ~(x = 0)
1510Proof
1511  REWRITE_TAC[INDEPENDENT_INSERT, NOT_IN_EMPTY, SPAN_EMPTY] THEN
1512  REWRITE_TAC[INDEPENDENT_EMPTY] THEN SET_TAC[]
1513QED
1514
1515Theorem INDEPENDENT_STDBASIS:
1516   independent {i:real | 1 <= i /\ i <= 1}
1517Proof
1518 REWRITE_TAC [REAL_LE_ANTISYM, GSPEC_EQ2] THEN
1519 REWRITE_TAC [INDEPENDENT_SING] THEN REAL_ARITH_TAC
1520QED
1521
1522Theorem SPANNING_SUBSET_INDEPENDENT:
1523   !s t:real->bool.
1524        t SUBSET s /\ independent s /\ s SUBSET span(t) ==> (s = t)
1525Proof
1526  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
1527  ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET_DEF] THEN
1528  X_GEN_TAC ``a:real`` THEN DISCH_TAC THEN
1529  UNDISCH_TAC ``independent s`` THEN DISCH_TAC THEN
1530  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [independent]) THEN
1531  SIMP_TAC std_ss [dependent, NOT_EXISTS_THM] THEN
1532  DISCH_THEN(MP_TAC o SPEC ``a:real``) THEN ASM_REWRITE_TAC[] THEN
1533  ASM_MESON_TAC[SPAN_MONO, SUBSET_DEF, IN_DELETE]
1534QED
1535
1536Theorem IN_SPAN_DELETE:
1537   !a b s.
1538         a IN span s /\ ~(a IN span (s DELETE b))
1539         ==> b IN span (a INSERT (s DELETE b))
1540Proof
1541  ASM_MESON_TAC[IN_SPAN_INSERT, SPAN_MONO, SUBSET_DEF, IN_INSERT, IN_DELETE]
1542QED
1543
1544Theorem SPAN_TRANS:
1545   !x y:real s. x IN span(s) /\ y IN span(x INSERT s) ==> y IN span(s)
1546Proof
1547  REPEAT STRIP_TAC THEN
1548  MP_TAC(SPECL [``x:real``, ``(x:real) INSERT s``, ``y:real``]
1549         SPAN_BREAKDOWN) THEN
1550  ASM_SIMP_TAC std_ss [IN_INSERT] THEN
1551  DISCH_THEN(X_CHOOSE_THEN ``k:real`` STRIP_ASSUME_TAC) THEN
1552  SUBST1_TAC(REAL_ARITH ``y:real = (y - k * x) + k * x``) THEN
1553  MATCH_MP_TAC SPAN_ADD THEN ASM_SIMP_TAC std_ss [SPAN_MUL] THEN
1554  ASM_MESON_TAC[SPAN_MONO, SUBSET_DEF, IN_INSERT, IN_DELETE]
1555QED
1556
1557Theorem EXCHANGE_LEMMA:
1558   !s t:real->bool.
1559        FINITE t /\ independent s /\ s SUBSET span t
1560        ==> ?t'. t' HAS_SIZE (CARD t) /\
1561                 s SUBSET t' /\ t' SUBSET (s UNION t) /\ s SUBSET (span t')
1562Proof
1563  REPEAT GEN_TAC THEN
1564  completeInduct_on `CARD(t DIFF s :real->bool)` THEN
1565  GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN FULL_SIMP_TAC std_ss [] THEN
1566  POP_ASSUM K_TAC THEN
1567  KNOW_TAC ``(!m. m < CARD (t:real->bool DIFF s) ==>
1568    !t:real->bool s:real->bool. (m = CARD (t DIFF s)) ==>
1569      FINITE t /\ independent s /\ s SUBSET span t ==>
1570      ?t'. t' HAS_SIZE CARD t /\ s SUBSET t' /\ t' SUBSET s UNION t /\
1571        s SUBSET span t') ==>
1572    (!t'':real->bool s':real->bool. (CARD (t'' DIFF s') < CARD (t DIFF s)) ==>
1573      FINITE t'' /\ independent s' /\ s' SUBSET span t'' ==>
1574      ?t'. t' HAS_SIZE CARD t'' /\ s' SUBSET t' /\ t' SUBSET s' UNION t'' /\
1575        s' SUBSET span t')`` THENL
1576  [METIS_TAC [], ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN DISCH_TAC] THEN
1577  ASM_CASES_TAC ``(s:real->bool) SUBSET t`` THENL
1578   [ASM_MESON_TAC[HAS_SIZE, SUBSET_UNION], ALL_TAC] THEN
1579  ASM_CASES_TAC ``t SUBSET (s:real->bool)`` THENL
1580   [ASM_MESON_TAC[SPANNING_SUBSET_INDEPENDENT, HAS_SIZE], ALL_TAC] THEN
1581  STRIP_TAC THEN UNDISCH_TAC ``~(t SUBSET s:real->bool)`` THEN DISCH_TAC THEN
1582  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [SUBSET_DEF]) THEN
1583  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP] THEN
1584  DISCH_THEN(X_CHOOSE_THEN ``b:real`` STRIP_ASSUME_TAC) THEN
1585  ASM_CASES_TAC ``s SUBSET span(t DELETE (b:real))`` THENL
1586   [FIRST_X_ASSUM(MP_TAC o
1587     SPECL [``t DELETE (b:real)``, ``s:real->bool``]) THEN
1588    ASM_REWRITE_TAC[SET_RULE ``s DELETE a DIFF t = (s DIFF t) DELETE a``] THEN
1589    ASM_SIMP_TAC arith_ss [CARD_DELETE, FINITE_DIFF, IN_DIFF, FINITE_DELETE,
1590                 CARD_EQ_0, ARITH_PROVE ``n - 1 < n <=> ~(n = 0:num)``] THEN
1591    KNOW_TAC ``t DIFF s <> {}:real->bool`` THENL
1592     [UNDISCH_TAC ``~((s:real->bool) SUBSET t)`` THEN ASM_SET_TAC[],
1593      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
1594    DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
1595    EXISTS_TAC ``(b:real) INSERT u`` THEN
1596    ASM_SIMP_TAC std_ss [SUBSET_INSERT, INSERT_SUBSET, IN_UNION] THEN
1597    CONJ_TAC THENL
1598     [UNDISCH_TAC ``(u:real->bool) HAS_SIZE CARD(t:real->bool) - 1`` THEN
1599      SIMP_TAC std_ss [HAS_SIZE, FINITE_EMPTY, FINITE_INSERT, CARD_EMPTY,
1600                       CARD_INSERT] THEN
1601      STRIP_TAC THEN COND_CASES_TAC THENL
1602       [ASM_MESON_TAC[SUBSET_DEF, IN_UNION, IN_DELETE], ALL_TAC] THEN
1603      ASM_MESON_TAC[ARITH_PROVE ``~(n = 0) ==> (SUC(n - 1) = n)``,
1604                    CARD_EQ_0, MEMBER_NOT_EMPTY], ALL_TAC] THEN
1605    CONJ_TAC THENL
1606     [UNDISCH_TAC ``u SUBSET s UNION (t DELETE (b:real))`` THEN SET_TAC[],
1607      ASM_MESON_TAC[SUBSET_DEF, SPAN_MONO, IN_INSERT]],
1608    ALL_TAC] THEN
1609  UNDISCH_TAC ``~(s SUBSET span (t DELETE (b:real)))`` THEN
1610  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET_DEF] THEN
1611  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP] THEN
1612  DISCH_THEN(X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
1613  SUBGOAL_THEN ``~(a:real = b)`` ASSUME_TAC THENL
1614    [ASM_MESON_TAC[], ALL_TAC] THEN
1615  SUBGOAL_THEN ``~((a:real) IN t)`` ASSUME_TAC THENL
1616   [ASM_MESON_TAC[IN_DELETE, SPAN_CLAUSES], ALL_TAC] THEN
1617  FIRST_X_ASSUM(MP_TAC o SPECL
1618   [``(a:real) INSERT (t DELETE b)``, ``s:real->bool``]) THEN
1619  KNOW_TAC ``CARD ((a INSERT t DELETE b) DIFF s) < CARD (t DIFF s:real->bool)``
1620  THENL
1621   [ASM_SIMP_TAC std_ss [SET_RULE
1622     ``a IN s ==> ((a INSERT (t DELETE b)) DIFF s = (t DIFF s) DELETE b)``] THEN
1623    KNOW_TAC ``(b:real) IN (t DIFF s)``
1624      THENL [METIS_TAC [IN_DIFF], DISCH_TAC] THEN
1625    KNOW_TAC ``FINITE (t DIFF s:real->bool)``
1626      THENL [METIS_TAC [FINITE_DIFF], ALL_TAC] THEN
1627    SIMP_TAC std_ss [CARD_DELETE] THEN ASM_REWRITE_TAC [] THEN DISCH_TAC THEN
1628    ASM_SIMP_TAC std_ss [ARITH_PROVE ``n - 1 < n <=> ~(n = 0:num)``, CARD_EQ_0,
1629                 FINITE_DIFF] THEN
1630    UNDISCH_TAC ``~((s:real->bool) SUBSET t)`` THEN ASM_SET_TAC[],
1631    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
1632  KNOW_TAC ``FINITE ((a:real) INSERT t DELETE b) /\
1633             s SUBSET span (a INSERT t DELETE b)`` THENL
1634   [ASM_SIMP_TAC std_ss [FINITE_EMPTY, FINITE_INSERT, FINITE_DELETE] THEN
1635    REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN
1636    DISCH_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC ``b:real`` THEN
1637    ASM_MESON_TAC[IN_SPAN_DELETE, SUBSET_DEF, SPAN_MONO,
1638                  SET_RULE ``t SUBSET (b INSERT (a INSERT (t DELETE b)))``],
1639    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
1640  DISCH_THEN (X_CHOOSE_TAC ``u:real->bool``) THEN
1641  EXISTS_TAC ``u:real->bool`` THEN
1642  POP_ASSUM MP_TAC THEN
1643  ASM_SIMP_TAC std_ss [HAS_SIZE, CARD_EMPTY, CARD_INSERT, CARD_DELETE,
1644                       FINITE_DELETE,
1645                       IN_DELETE, ARITH_PROVE ``(SUC(n - 1) = n) <=> ~(n = 0)``,
1646                       CARD_EQ_0] THEN
1647  UNDISCH_TAC ``(b:real) IN t`` THEN ASM_SET_TAC[]
1648QED
1649
1650Theorem CARD_STDBASIS:
1651   CARD {1:real} = 1
1652Proof
1653   MESON_TAC[CARD_SING]
1654QED
1655
1656Theorem INDEPENDENT_SPAN_BOUND:
1657   !s t. FINITE t /\ independent s /\ s SUBSET span(t)
1658         ==> FINITE s /\ CARD(s) <= CARD(t)
1659Proof
1660  REPEAT GEN_TAC THEN DISCH_TAC THEN
1661  FIRST_ASSUM(MP_TAC o MATCH_MP EXCHANGE_LEMMA) THEN
1662  ASM_MESON_TAC[HAS_SIZE, CARD_SUBSET, SUBSET_FINITE_I]
1663QED
1664
1665Theorem INDEPENDENT_BOUND:
1666   !s:real->bool.
1667        independent s ==> FINITE s /\ CARD(s) <= 1:num
1668Proof
1669  REPEAT GEN_TAC THEN DISCH_TAC THEN
1670  ONCE_REWRITE_TAC[GSYM CARD_STDBASIS] THEN
1671  MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN
1672  KNOW_TAC ``span {1} = univ(:real)`` THENL
1673  [SIMP_TAC std_ss [EXTENSION, span, hull, IN_BIGINTER, IN_UNIV] THEN
1674   SIMP_TAC std_ss [SING_SUBSET, GSPECIFICATION, subspace] THEN
1675   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [GSYM REAL_MUL_RID] THEN
1676   FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [],
1677   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
1678  ASM_REWRITE_TAC[FINITE_SING, SUBSET_UNIV]
1679QED
1680
1681Theorem MAXIMAL_INDEPENDENT_SUBSET_EXTEND:
1682   !s v:real->bool. s SUBSET v /\ independent s ==> ?b. s SUBSET b /\ b SUBSET v /\
1683   independent b /\ v SUBSET (span b)
1684Proof
1685  REPEAT GEN_TAC THEN
1686  completeInduct_on ` 1n - CARD(s:real->bool)` THEN
1687  GEN_TAC THEN DISCH_TAC THEN FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
1688  REPEAT STRIP_TAC THEN
1689  ASM_CASES_TAC ``v SUBSET (span(s:real->bool))`` THENL
1690   [ASM_MESON_TAC[SUBSET_REFL], ALL_TAC] THEN
1691  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [SUBSET_DEF]) THEN
1692  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP] THEN
1693  DISCH_THEN(X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
1694  KNOW_TAC ``(!(m :num). m < 1n - CARD (s :real -> bool) ==>
1695        !(s :real -> bool). (m = 1n - CARD s) ==>
1696          s SUBSET (v :real -> bool) /\ independent s ==>
1697          ?(b :real -> bool).
1698            s SUBSET b /\ b SUBSET v /\ independent b /\ v SUBSET span b) ==>
1699        !s'. (1 - CARD s' < 1 - CARD s) ==> s' SUBSET v /\ independent s' ==>
1700          ?b. s' SUBSET b /\ b SUBSET v /\ independent b /\ v SUBSET span b`` THENL
1701  [METIS_TAC [], ASM_REWRITE_TAC [] THEN DISCH_TAC] THEN
1702  FIRST_X_ASSUM(MP_TAC o SPEC ``(a:real) INSERT s``) THEN
1703  REWRITE_TAC[AND_IMP_INTRO] THEN
1704  KNOW_TAC ``1 - CARD (a INSERT s) < 1 - CARD s /\ a INSERT s SUBSET v /\
1705              independent (a INSERT s:real->bool)`` THENL
1706   [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
1707             MESON_TAC[INSERT_SUBSET]] THEN
1708  SUBGOAL_THEN ``independent ((a:real) INSERT s)`` ASSUME_TAC THENL
1709   [ASM_REWRITE_TAC[INDEPENDENT_INSERT, COND_ID], ALL_TAC] THEN
1710  ASM_REWRITE_TAC[INSERT_SUBSET] THEN
1711  MATCH_MP_TAC(ARITH_PROVE ``(b = a + 1) /\ b <= n ==> n - b < n - a:num``) THEN
1712  ASM_SIMP_TAC std_ss [CARD_EMPTY, CARD_INSERT, INDEPENDENT_BOUND] THEN
1713  METIS_TAC[SPAN_SUPERSET, ADD1]
1714QED
1715
1716Theorem MAXIMAL_INDEPENDENT_SUBSET:
1717   !v:real->bool. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b)
1718Proof
1719  MP_TAC(SPEC ``EMPTY:real->bool`` MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
1720  REWRITE_TAC[EMPTY_SUBSET, INDEPENDENT_EMPTY]
1721QED
1722
1723Theorem SPAN_BREAKDOWN_EQ:
1724   !a:real s. (x IN span(a INSERT s) <=> (?k. (x - k * a) IN span s))
1725Proof
1726  REPEAT STRIP_TAC THEN EQ_TAC THENL
1727   [DISCH_THEN(MP_TAC o CONJ(SET_RULE ``(a:real) IN (a INSERT s)``)) THEN
1728    DISCH_THEN(MP_TAC o MATCH_MP SPAN_BREAKDOWN) THEN
1729    DISCH_THEN (X_CHOOSE_TAC ``k:real``) THEN EXISTS_TAC ``k:real`` THEN
1730    POP_ASSUM MP_TAC THEN SPEC_TAC(``x - k * a:real``,``y:real``) THEN
1731    REWRITE_TAC[GSYM SUBSET_DEF] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[],
1732    DISCH_THEN(X_CHOOSE_TAC ``k:real``) THEN
1733    SUBST1_TAC(REAL_ARITH ``x = (x - k * a) + k * a:real``) THEN
1734    MATCH_MP_TAC SPAN_ADD THEN
1735    ASM_MESON_TAC[SPAN_MONO, SUBSET_DEF, IN_INSERT, SPAN_CLAUSES]]
1736QED
1737
1738Theorem LINEAR_INDEPENDENT_EXTEND_LEMMA:
1739   !f b. FINITE b ==> independent b ==>
1740    ?g:real->real. (!x y. x IN span b /\ y IN span b ==>
1741     (g(x + y) = g(x) + g(y))) /\ (!x c. x IN span b ==>
1742     (g(c * x) = c * g(x))) /\ (!x. x IN b ==> (g x = f x))
1743Proof
1744  GEN_TAC THEN
1745  ONCE_REWRITE_TAC [METIS []
1746   ``!b. (independent b ==>
1747  ?g. (!x y. x IN span b /\ y IN span b ==> (g (x + y) = g x + g y)) /\
1748    (!x c. x IN span b ==> (g (c * x) = c * g x)) /\
1749    !x. x IN b ==> (g x = f x)) =
1750    (\b. independent b ==>
1751  ?g. (!x y. x IN span b /\ y IN span b ==> (g (x + y) = g x + g y)) /\
1752    (!x c. x IN span b ==> (g (c * x) = c * g x)) /\
1753    !x. x IN b ==> (g x = f x)) b``] THEN
1754  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
1755  REWRITE_TAC[NOT_IN_EMPTY, INDEPENDENT_INSERT] THEN CONJ_TAC THENL
1756   [REPEAT STRIP_TAC THEN EXISTS_TAC ``(\x. 0):real->real`` THEN
1757    SIMP_TAC std_ss [SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN REAL_ARITH_TAC,
1758    ALL_TAC] THEN
1759  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
1760  MAP_EVERY X_GEN_TAC [``b:real->bool``, ``a:real``] THEN
1761  REWRITE_TAC [AND_IMP_INTRO] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
1762  REWRITE_TAC [CONJ_EQ_IMP] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
1763  DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC [AND_IMP_INTRO] THEN
1764  DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1765  DISCH_THEN(X_CHOOSE_THEN ``g:real->real`` STRIP_ASSUME_TAC) THEN
1766  ABBREV_TAC ``h = \z:real. @k. (z - k * a) IN span b`` THEN
1767  SUBGOAL_THEN ``!z:real. z IN span(a INSERT b)
1768                    ==> (z - h(z) * a) IN span(b) /\
1769                        !k. (z - k * a) IN span(b) ==> (k = h(z))``
1770  MP_TAC THENL
1771   [GEN_TAC THEN DISCH_TAC THEN
1772    MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1773     [EXPAND_TAC "h" THEN CONV_TAC SELECT_CONV THEN
1774      ASM_MESON_TAC[SPAN_BREAKDOWN_EQ],
1775      ALL_TAC] THEN
1776    SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO] THEN GEN_TAC THEN
1777    DISCH_THEN(MP_TAC o MATCH_MP SPAN_SUB) THEN
1778    REWRITE_TAC[REAL_ARITH ``(z - a * v) - (z - b * v) = (b - a) * v:real``] THEN
1779    ASM_CASES_TAC ``k = (h:real->real) z`` THEN ASM_REWRITE_TAC[] THEN
1780    DISCH_THEN(MP_TAC o SPEC ``inv(k - (h:real->real) z)`` o
1781               MATCH_MP SPAN_MUL) THEN
1782    ASM_SIMP_TAC real_ss [REAL_MUL_LINV, REAL_MUL_ASSOC, REAL_SUB_0],
1783    ALL_TAC] THEN
1784  SIMP_TAC std_ss [TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
1785  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO] THEN
1786  DISCH_THEN (MP_TAC o SIMP_RULE std_ss [FORALL_AND_THM]) THEN STRIP_TAC THEN
1787  EXISTS_TAC ``\z:real. h(z) * (f:real->real)(a) + g(z - h(z) * a)`` THEN
1788  ONCE_REWRITE_TAC [CONJ_SYM] THEN REPEAT CONJ_TAC THENL
1789   [MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
1790    SUBGOAL_THEN ``(h:real->real)(x + y) = h(x) + h(y)`` ASSUME_TAC THENL
1791     [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1792      REWRITE_TAC[REAL_ARITH
1793       ``(x + y) - (k + l) * a = (x - k * a) + (y - l * a:real)``] THEN
1794      CONJ_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_REWRITE_TAC[] THEN
1795      ASM_SIMP_TAC std_ss [],
1796      ALL_TAC] THEN
1797    ASM_SIMP_TAC std_ss [REAL_ARITH
1798       ``(x + y) - (k + l) * a = (x - k * a) + (y - l * a:real)``] THEN
1799    ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC,
1800    MAP_EVERY X_GEN_TAC [``x:real``, ``c:real``] THEN STRIP_TAC THEN
1801    SUBGOAL_THEN ``(h:real->real)(c * x) = c * h(x)`` ASSUME_TAC THENL
1802     [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1803      REWRITE_TAC[REAL_ARITH
1804       ``c * x - (c * k) * a = c * (x - k * a:real)``] THEN
1805      CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_REWRITE_TAC[] THEN
1806      ASM_SIMP_TAC std_ss [],
1807      ALL_TAC] THEN
1808    ASM_SIMP_TAC std_ss [REAL_ARITH
1809       ``c * x - (c * k) * a = c * (x - k * a:real)``] THEN
1810    ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC,
1811    ALL_TAC] THEN
1812  X_GEN_TAC ``x:real`` THEN SIMP_TAC std_ss [IN_INSERT] THEN
1813  DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL
1814   [SUBGOAL_THEN ``&1:real = h(a:real)`` (SUBST1_TAC o SYM) THENL
1815     [FIRST_X_ASSUM MATCH_MP_TAC, ALL_TAC] THEN
1816    REWRITE_TAC[REAL_ARITH ``a - &1 * a = 0:real``, SPAN_0] THENL
1817     [ASM_MESON_TAC[SPAN_SUPERSET, SUBSET_DEF, IN_INSERT], ALL_TAC] THEN
1818    UNDISCH_TAC ``!x y:real. x IN span b /\ y IN span b ==>
1819                        ((g:real->real) (x + y) = g x + g y)`` THEN
1820    DISCH_TAC THEN SIMP_TAC std_ss [] THEN
1821    FIRST_X_ASSUM(MP_TAC o SPECL [``0:real``, ``0:real``]) THEN
1822    SIMP_TAC real_ss [SPAN_0, REAL_ADD_LID] THEN
1823    REWRITE_TAC[REAL_ARITH ``(a = a + a) <=> (a = 0:real)``] THEN
1824    DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC,
1825    ALL_TAC] THEN
1826  SUBGOAL_THEN ``&0:real = h(x:real)`` (SUBST1_TAC o SYM) THENL
1827   [FIRST_X_ASSUM MATCH_MP_TAC, ALL_TAC] THEN
1828  SIMP_TAC std_ss [REAL_ADD_LID, REAL_MUL_LZERO, REAL_SUB_RZERO] THEN
1829  ASM_MESON_TAC[SUBSET_DEF, IN_INSERT, SPAN_SUPERSET]
1830QED
1831
1832Theorem LINEAR_INDEPENDENT_EXTEND:
1833   !f b. independent b ==> ?g:real->real. linear g /\ (!x. x IN b ==> (g x = f x))
1834Proof
1835  REPEAT STRIP_TAC THEN
1836  MP_TAC(ISPECL [``b:real->bool``, ``univ(:real)``]
1837           MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
1838  ASM_SIMP_TAC std_ss [SUBSET_UNIV, UNIV_SUBSET] THEN
1839  REWRITE_TAC[EXTENSION, IN_UNIV] THEN
1840  DISCH_THEN(X_CHOOSE_THEN ``c:real->bool`` STRIP_ASSUME_TAC) THEN
1841  MP_TAC(ISPECL [``f:real->real``, ``c:real->bool``]
1842    LINEAR_INDEPENDENT_EXTEND_LEMMA) THEN
1843  ASM_SIMP_TAC std_ss [INDEPENDENT_BOUND, linear] THEN
1844  ASM_MESON_TAC[SUBSET_DEF]
1845QED
1846
1847Theorem SUBSPACE_KERNEL:
1848   !f. linear f ==> subspace {x | f(x) = 0}
1849Proof
1850  SIMP_TAC std_ss [subspace, GSPECIFICATION] THEN
1851  SIMP_TAC std_ss [LINEAR_ADD, LINEAR_CMUL, REAL_ADD_LID, REAL_MUL_RZERO] THEN
1852  MESON_TAC[LINEAR_0]
1853QED
1854
1855Theorem LINEAR_EQ_0_SPAN:
1856   !f:real->real b. linear f /\ (!x. x IN b ==> (f(x) = 0))
1857   ==> !x. x IN span(b) ==> (f(x) = 0)
1858Proof
1859  REPEAT GEN_TAC THEN STRIP_TAC THEN RULE_ASSUM_TAC(SIMP_RULE std_ss [IN_DEF]) THEN
1860  ONCE_REWRITE_TAC [METIS [] ``(f x = 0) = (\x. (f:real->real) x = 0) x``] THEN
1861  MATCH_MP_TAC SPAN_INDUCT THEN ASM_SIMP_TAC std_ss [IN_DEF] THEN
1862  MP_TAC(ISPEC ``f:real->real`` SUBSPACE_KERNEL) THEN ASM_REWRITE_TAC[] THEN
1863  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN
1864  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_DEF]
1865QED
1866
1867Theorem LINEAR_EQ_0:
1868   !f b s. linear f /\ s SUBSET (span b) /\
1869   (!x. x IN b ==> (f(x) = 0)) ==> !x. x IN s ==> (f(x) = 0)
1870Proof
1871  MESON_TAC[LINEAR_EQ_0_SPAN, SUBSET_DEF]
1872QED
1873
1874Theorem LINEAR_EQ:
1875   !f g b s. linear f /\ linear g /\ s SUBSET (span b) /\
1876    (!x. x IN b ==> (f(x) = g(x))) ==> !x. x IN s ==> (f(x) = g(x))
1877Proof
1878  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN STRIP_TAC THEN
1879  ONCE_REWRITE_TAC [METIS [] ``(f x - g x = 0) = ((\x. (f:real->real) x - g x) x = 0)``] THEN
1880  MATCH_MP_TAC LINEAR_EQ_0 THEN SIMP_TAC std_ss [] THEN METIS_TAC[LINEAR_COMPOSE_SUB]
1881QED
1882
1883Theorem LINEAR_EQ_STDBASIS:
1884   !f:real->real g. linear f /\ linear g /\
1885   (!i. 1 <= i /\ i <= 1 ==> (f i = g i)) ==> (f = g)
1886Proof
1887  REPEAT STRIP_TAC THEN
1888  SUBGOAL_THEN ``!x. x IN UNIV ==> ((f:real->real) x = g x)``
1889   (fn th => MP_TAC th THEN SIMP_TAC std_ss [FUN_EQ_THM, IN_UNIV]) THEN
1890  MATCH_MP_TAC LINEAR_EQ THEN
1891  EXISTS_TAC ``{i :real | 1 <= i /\ i <= 1}`` THEN
1892  ASM_SIMP_TAC std_ss [SUBSET_REFL, GSPECIFICATION] THEN
1893  REWRITE_TAC [REAL_LE_ANTISYM, GSPEC_EQ2] THEN
1894  KNOW_TAC ``span {1} = univ(:real)`` THENL
1895  [ALL_TAC, SIMP_TAC std_ss [SUBSET_REFL]] THEN
1896  SIMP_TAC std_ss [EXTENSION, span, hull, IN_BIGINTER, IN_UNIV] THEN
1897  SIMP_TAC std_ss [SING_SUBSET, GSPECIFICATION, subspace] THEN
1898  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [GSYM REAL_MUL_RID] THEN
1899  FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []
1900QED
1901
1902Theorem LINEAR_INJECTIVE_LEFT_INVERSE:
1903   !f:real->real. linear f /\ (!x y. (f x = f y) ==> (x = y))
1904                  ==> ?g. linear g /\ (g o f = (\x. x))
1905Proof
1906  REWRITE_TAC[INJECTIVE_LEFT_INVERSE] THEN REPEAT STRIP_TAC THEN
1907  SUBGOAL_THEN ``?h. linear(h:real->real) /\
1908                    !x. x IN IMAGE (f:real->real) {i | 1 <= i /\ i <= 1}
1909                  ==> (h x = g x)`` MP_TAC THENL
1910  [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
1911   SIMP_TAC std_ss [REAL_LE_ANTISYM, GSPEC_EQ2, IMAGE_SING] THEN
1912   SIMP_TAC std_ss [INDEPENDENT_SING] THEN
1913   KNOW_TAC ``?g. !x. g ((f:real->real) x) = x`` THENL
1914   [METIS_TAC [], REWRITE_TAC [GSYM INJECTIVE_LEFT_INVERSE] THEN DISCH_TAC] THEN
1915   FULL_SIMP_TAC std_ss [linear] THEN KNOW_TAC ``0 = (f:real->real) 0`` THENL
1916   [UNDISCH_TAC ``!c x. (f:real->real) (c * x) = c * f x`` THEN
1917    DISCH_THEN (MP_TAC o SPECL [``0:real``, ``0:real``]) >> rw [],
1918    DISCH_TAC THEN ONCE_ASM_REWRITE_TAC []] THEN DISCH_TAC THEN
1919   UNDISCH_TAC ``!x y. ((f:real->real) x = f y) ==> (x = y)`` THEN
1920   DISCH_THEN (MP_TAC o SPECL [``1:real``,``0:real``]) THEN
1921   POP_ASSUM MP_TAC THEN rw [],
1922   DISCH_THEN (X_CHOOSE_TAC ``h:real->real``) THEN EXISTS_TAC ``h:real->real`` THEN
1923   POP_ASSUM MP_TAC THEN
1924   ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN STRIP_TAC THEN
1925   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
1926   ASM_SIMP_TAC std_ss [LINEAR_ID, LINEAR_COMPOSE, LINEAR_ID, o_THM] THEN
1927   ASM_MESON_TAC[]]
1928QED
1929
1930Definition dim[nocompute]:
1931  dim v = @n. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
1932                   b HAS_SIZE n
1933End
1934
1935Theorem BASIS_EXISTS:
1936   !v. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\ b HAS_SIZE (dim v)
1937Proof
1938  GEN_TAC THEN REWRITE_TAC[dim] THEN CONV_TAC SELECT_CONV THEN
1939  MESON_TAC[MAXIMAL_INDEPENDENT_SUBSET, HAS_SIZE, INDEPENDENT_BOUND]
1940QED
1941
1942Theorem INDEPENDENT_CARD_LE_DIM:
1943   !v b:real->bool. b SUBSET v /\ independent b ==> FINITE b /\ CARD(b) <= dim v
1944Proof
1945  METIS_TAC[BASIS_EXISTS, INDEPENDENT_SPAN_BOUND, HAS_SIZE, SUBSET_TRANS]
1946QED
1947
1948Theorem CARD_GE_DIM_INDEPENDENT:
1949   !v b:real->bool. b SUBSET v /\ independent b /\ dim v <= CARD(b)
1950        ==> v SUBSET (span b)
1951Proof
1952  REPEAT STRIP_TAC THEN
1953  SUBGOAL_THEN ``!a:real. ~(a IN v /\ ~(a IN span b))`` MP_TAC THENL
1954   [ALL_TAC, SET_TAC[]] THEN
1955  X_GEN_TAC ``a:real`` THEN STRIP_TAC THEN
1956  SUBGOAL_THEN ``independent((a:real) INSERT b)`` ASSUME_TAC THENL
1957   [METIS_TAC[INDEPENDENT_INSERT], ALL_TAC] THEN
1958  MP_TAC(ISPECL [``v:real->bool``, ``(a:real) INSERT b``]
1959                INDEPENDENT_CARD_LE_DIM) THEN
1960  ASM_SIMP_TAC std_ss [INSERT_SUBSET, CARD_EMPTY, CARD_INSERT, INDEPENDENT_BOUND] THEN
1961  METIS_TAC[SPAN_SUPERSET, SUBSET_DEF, ARITH_PROVE
1962    ``x <= y ==> ~(SUC y <= x)``]
1963QED
1964
1965Theorem SPAN_EXPLICIT:
1966   !(p:real -> bool). span p =
1967    {y | ?s u. FINITE s /\ s SUBSET p /\ (sum s (\v. u v * v) = y)}
1968Proof
1969  GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
1970   [ALL_TAC,
1971    SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN
1972    REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
1973    MATCH_MP_TAC SPAN_SUM THEN ASM_REWRITE_TAC[] THEN
1974    ASM_MESON_TAC[SPAN_SUPERSET, SPAN_MUL]] THEN
1975  SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN
1976  ONCE_REWRITE_TAC [METIS []
1977   ``(?s u. FINITE s /\ (!x. x IN s ==> x IN p) /\ (sum s (\v. u v * v) = x)) =
1978     (\x. ?s u. FINITE s /\ (!x. x IN s ==> x IN p) /\ (sum s (\v. u v * v) = x)) x``] THEN
1979  MATCH_MP_TAC SPAN_INDUCT_ALT THEN SIMP_TAC std_ss [] THEN CONJ_TAC THENL
1980   [EXISTS_TAC ``{}:real->bool`` THEN
1981    SIMP_TAC std_ss [FINITE_EMPTY, FINITE_INSERT, SUM_CLAUSES,
1982     EMPTY_SUBSET, NOT_IN_EMPTY], ALL_TAC] THEN
1983  MAP_EVERY X_GEN_TAC [``c:real``, ``x:real``, ``y:real``] THEN
1984  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1985  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
1986  MAP_EVERY X_GEN_TAC [``s:real->bool``, ``u:real->real``] THEN
1987  STRIP_TAC THEN EXISTS_TAC ``(x:real) INSERT s`` THEN
1988  EXISTS_TAC ``\y. if y = x then (if x IN s then (u:real->real) y + c else c)
1989                  else u y`` THEN
1990  ASM_SIMP_TAC std_ss [FINITE_INSERT, IN_INSERT, SUM_CLAUSES] THEN
1991  CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
1992  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
1993  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
1994   [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
1995     ``x IN s ==> (s = x INSERT (s DELETE x))``)) THEN
1996    ASM_SIMP_TAC std_ss [SUM_CLAUSES, FINITE_INSERT, FINITE_DELETE, IN_DELETE] THEN
1997    MATCH_MP_TAC(REAL_ARITH
1998      ``(y = z) ==> ((c + d) * x + y = d * x + (c * x + z:real))``),
1999    AP_TERM_TAC] THEN
2000  MATCH_MP_TAC SUM_EQ THEN METIS_TAC[IN_DELETE]
2001QED
2002
2003Theorem DEPENDENT_EXPLICIT:
2004   !p. dependent (p:real -> bool) <=>
2005       ?s u. FINITE s /\ s SUBSET p /\ (?v. v IN s /\ ~(u v = &0)) /\
2006             (sum s (\v. u v * v) = 0)
2007Proof
2008  GEN_TAC THEN SIMP_TAC std_ss [dependent, SPAN_EXPLICIT, GSPECIFICATION] THEN
2009  SIMP_TAC std_ss [GSYM RIGHT_EXISTS_AND_THM, GSYM LEFT_EXISTS_AND_THM] THEN
2010  EQ_TAC THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THENL
2011   [MAP_EVERY X_GEN_TAC [``s:real->bool``, ``u:real->real``] THEN
2012    STRIP_TAC THEN ABBREV_TAC ``a = sum s (\v. (u:real->real) v * v)`` THEN
2013    MAP_EVERY EXISTS_TAC
2014     [``(a:real) INSERT s``,
2015      ``\y. if y = a then - &1 else (u:real->real) y``,
2016      ``a:real``] THEN
2017    ASM_REWRITE_TAC[IN_INSERT, INSERT_SUBSET, FINITE_INSERT] THEN
2018    CONJ_TAC THENL [ASM_SET_TAC[], ASM_SIMP_TAC real_ss []] THEN
2019    ASM_SIMP_TAC std_ss [SUM_CLAUSES] THEN
2020    COND_CASES_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
2021    REWRITE_TAC[REAL_ARITH ``(-&1 * a + s = 0) <=> (a = s:real)``] THEN
2022    FIRST_X_ASSUM(fn th => GEN_REWR_TAC LAND_CONV [SYM th]) THEN
2023    MATCH_MP_TAC SUM_EQ THEN ASM_SET_TAC[],
2024    MAP_EVERY X_GEN_TAC [``s:real->bool``, ``u:real->real``, ``a:real``] THEN
2025    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
2026     [``s DELETE (a:real)``,
2027      ``\i. -((u:real->real) i) / (u (a:real))``] THEN
2028    ASM_SIMP_TAC std_ss [SUM_DELETE, FINITE_DELETE] THEN
2029    KNOW_TAC ``sum s (\v. -u v / (u:real->real) a * v) - -u a / u a * a = a`` THENL
2030    [REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2031     REWRITE_TAC [REAL_MUL_ASSOC] THEN SIMP_TAC real_ss [SUM_RMUL, SUM_NEG'] THEN
2032     RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_MUL_SYM]) THEN ASM_REWRITE_TAC [] THEN
2033     ASM_SIMP_TAC real_ss [REAL_MUL_LNEG, GSYM REAL_MUL_ASSOC,
2034                           REAL_MUL_RNEG, REAL_MUL_RZERO] THEN
2035     ASM_SIMP_TAC real_ss [REAL_MUL_RINV], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
2036    ASM_SET_TAC []]
2037QED
2038
2039Theorem INDEPENDENT_INJECTIVE_IMAGE_GEN :
2040   !(f:real->real) s. independent s /\ linear f /\
2041     (!x y. x IN span s /\ y IN span s /\ (f(x) = f(y)) ==> (x = y))
2042    ==> independent (IMAGE f s)
2043Proof
2044  REPEAT GEN_TAC THEN
2045  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
2046  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
2047  SIMP_TAC std_ss' [independent, DEPENDENT_EXPLICIT] THEN
2048  REWRITE_TAC[CONJ_ASSOC, FINITE_SUBSET_IMAGE] THEN DISCH_TAC THEN
2049  KNOW_TAC ``(?s':real->bool u:real->real. (FINITE s' /\ s' SUBSET s) /\
2050      (?v. v IN IMAGE f s' /\ ~(u v = &0)) /\
2051      (sum (IMAGE f s') (\v. u v * v) = 0))`` THENL
2052  [METIS_TAC [], POP_ASSUM K_TAC] THEN
2053  SIMP_TAC std_ss [EXISTS_IN_IMAGE, LEFT_IMP_EXISTS_THM] THEN
2054  MAP_EVERY X_GEN_TAC [``t:real->bool``, ``u:real->real``] THEN
2055  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
2056  MAP_EVERY EXISTS_TAC
2057   [``t:real->bool``, ``(u:real->real) o (f:real->real)``] THEN
2058  ASM_REWRITE_TAC[o_THM] THEN
2059  FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
2060   [MATCH_MP_TAC SPAN_SUM THEN ASM_SIMP_TAC std_ss [] THEN
2061    REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
2062    MATCH_MP_TAC SPAN_SUPERSET THEN ASM_SET_TAC[],
2063    REWRITE_TAC[SPAN_0],
2064    ASM_SIMP_TAC std_ss [LINEAR_SUM] THEN
2065    FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN
2066    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN
2067    W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhand o snd) THEN
2068    ASM_SIMP_TAC std_ss [o_DEF] THEN ASM_SIMP_TAC std_ss [LINEAR_CMUL] THEN
2069    DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SPAN_SUPERSET, SUBSET_DEF]]
2070QED
2071
2072Theorem INDEPENDENT_INJECTIVE_IMAGE:
2073   !f:real->real s. independent s /\ linear f /\
2074     (!x y. (f(x) = f(y)) ==> (x = y)) ==> independent (IMAGE f s)
2075Proof
2076  REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
2077  ASM_MESON_TAC[]
2078QED
2079
2080Theorem SPAN_LINEAR_IMAGE :
2081    !f:real->real s. linear f ==> (span(IMAGE f s) = IMAGE f (span s))
2082Proof
2083  REPEAT STRIP_TAC THEN GEN_REWR_TAC I [EXTENSION] THEN
2084  X_GEN_TAC ``x:real`` THEN EQ_TAC THENL
2085   [ONCE_REWRITE_TAC [METIS [] ``x IN IMAGE f (span s) <=>
2086                            (\x. x IN IMAGE f (span s)) x``] THEN
2087    SPEC_TAC(``x:real``, ``x:real``) THEN MATCH_MP_TAC SPAN_INDUCT THEN
2088    SIMP_TAC std_ss [SET_RULE ``(\x. x IN s) = s``] THEN
2089    ASM_SIMP_TAC std_ss [SUBSPACE_SPAN, SUBSPACE_LINEAR_IMAGE] THEN
2090    SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
2091    MESON_TAC[SPAN_SUPERSET, SUBSET_DEF],
2092    SPEC_TAC(``x:real``, ``x:real``) THEN SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
2093    ONCE_REWRITE_TAC [METIS [] ``f x IN span (IMAGE f s) <=>
2094                            (\x. f x IN span (IMAGE f s)) x``] THEN
2095    MATCH_MP_TAC SPAN_INDUCT THEN
2096    SIMP_TAC std_ss [SET_RULE ``(\x. f x IN span(s)) = {x | f(x) IN span s}``] THEN
2097    ASM_SIMP_TAC std_ss [SUBSPACE_LINEAR_PREIMAGE, SUBSPACE_SPAN] THEN
2098    SIMP_TAC std_ss [GSPECIFICATION] THEN
2099    MESON_TAC[SPAN_SUPERSET, SUBSET_DEF, IN_IMAGE]]
2100QED
2101
2102(* ------------------------------------------------------------------------- *)
2103(* An injective map real->real is also surjective.                       *)
2104(* ------------------------------------------------------------------------- *)
2105
2106Theorem LINEAR_INJECTIVE_IMP_SURJECTIVE:
2107   !f:real->real. linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
2108                 ==> !y. ?x. f(x) = y
2109Proof
2110  REPEAT STRIP_TAC THEN
2111  MP_TAC(ISPEC ``univ(:real)`` BASIS_EXISTS) THEN
2112  REWRITE_TAC[SUBSET_UNIV, HAS_SIZE] THEN
2113  DISCH_THEN(X_CHOOSE_THEN ``b:real->bool`` STRIP_ASSUME_TAC) THEN
2114  SUBGOAL_THEN ``UNIV SUBSET span(IMAGE (f:real->real) b)`` MP_TAC THENL
2115   [MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
2116    ASM_MESON_TAC[INDEPENDENT_INJECTIVE_IMAGE, LESS_EQ_REFL,
2117                  SUBSET_UNIV, CARD_IMAGE_INJ],
2118    ASM_SIMP_TAC std_ss [SPAN_LINEAR_IMAGE] THEN
2119    ASM_MESON_TAC[SUBSET_DEF, IN_IMAGE, IN_UNIV]]
2120QED
2121
2122(* ------------------------------------------------------------------------- *)
2123(* Left-invertible linear transformation has a lower bound.                  *)
2124(* ------------------------------------------------------------------------- *)
2125
2126Theorem LINEAR_INVERTIBLE_BOUNDED_BELOW_POS:
2127   !f:real->real g. linear f /\ linear g /\ (g o f = I)
2128   ==> ?B. &0 < B /\ !x. B * abs(x) <= abs(f x)
2129Proof
2130  REPEAT STRIP_TAC THEN
2131  MP_TAC(ISPEC ``g:real->real`` LINEAR_BOUNDED_POS) THEN
2132  ASM_REWRITE_TAC[] THEN
2133  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
2134  EXISTS_TAC ``inv B:real`` THEN ASM_SIMP_TAC real_ss [REAL_LT_INV_EQ] THEN
2135  X_GEN_TAC ``x:real`` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2136  EXISTS_TAC ``inv(B) * abs(((g:real->real) o (f:real->real)) x)`` THEN
2137  CONJ_TAC THENL [ASM_SIMP_TAC real_ss [I_THM, REAL_LE_REFL], ALL_TAC] THEN
2138  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
2139  ASM_SIMP_TAC real_ss [o_THM, REAL_LE_LDIV_EQ] THEN
2140  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]
2141QED
2142
2143Theorem LINEAR_INVERTIBLE_BOUNDED_BELOW:
2144   !f:real->real g. linear f /\ linear g /\ (g o f = I) ==>
2145   ?B. !x. B * abs(x) <= abs(f x)
2146Proof
2147  MESON_TAC[LINEAR_INVERTIBLE_BOUNDED_BELOW_POS]
2148QED
2149
2150Theorem LINEAR_INJECTIVE_BOUNDED_BELOW_POS:
2151   !f:real->real. linear f /\ (!x y. (f x = f y) ==> (x = y))
2152    ==> ?B. &0 < B /\ !x. abs(x) * B <= abs(f x)
2153Proof
2154  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2155  MATCH_MP_TAC LINEAR_INVERTIBLE_BOUNDED_BELOW_POS THEN
2156  METIS_TAC[LINEAR_INJECTIVE_LEFT_INVERSE, I_THM]
2157QED
2158
2159(* ------------------------------------------------------------------------- *)
2160(* Consequences of independence or spanning for cardinality.                 *)
2161(* ------------------------------------------------------------------------- *)
2162
2163Theorem SPAN_CARD_GE_DIM:
2164   !v b:real->bool. v SUBSET (span b) /\ FINITE b ==> dim(v) <= CARD(b)
2165Proof
2166  METIS_TAC[BASIS_EXISTS, INDEPENDENT_SPAN_BOUND, HAS_SIZE, SUBSET_TRANS]
2167QED
2168
2169Theorem BASIS_CARD_EQ_DIM:
2170   !v b. b SUBSET v /\ v SUBSET (span b) /\ independent b
2171   ==> FINITE b /\ (CARD b = dim v)
2172Proof
2173  METIS_TAC[LESS_EQUAL_ANTISYM, INDEPENDENT_CARD_LE_DIM, SPAN_CARD_GE_DIM]
2174QED
2175
2176Theorem BASIS_HAS_SIZE_DIM:
2177   !v b. independent b /\ (span b = v) ==> b HAS_SIZE (dim v)
2178Proof
2179  REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN
2180  MATCH_MP_TAC BASIS_CARD_EQ_DIM THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
2181  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_INC]
2182QED
2183
2184Theorem DIM_UNIQUE:
2185   !v b. b SUBSET v /\ v SUBSET (span b) /\ independent b /\ b HAS_SIZE n
2186        ==> (dim v = n)
2187Proof
2188  MESON_TAC[BASIS_CARD_EQ_DIM, HAS_SIZE]
2189QED
2190
2191Theorem DIM_LE_CARD:
2192   !s. FINITE s ==> dim s <= CARD s
2193Proof
2194  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
2195  ASM_REWRITE_TAC[SPAN_INC, SUBSET_REFL]
2196QED
2197
2198(* ------------------------------------------------------------------------- *)
2199(* Standard bases are a spanning set, and obviously finite.                  *)
2200(* ------------------------------------------------------------------------- *)
2201
2202Theorem SPAN_STDBASIS:
2203   span {i :real | 1 <= i /\ i <= 1} = UNIV
2204Proof
2205  REWRITE_TAC [REAL_LE_ANTISYM, GSPEC_EQ2] THEN
2206  SIMP_TAC std_ss [EXTENSION, span, hull, IN_BIGINTER, IN_UNIV] THEN
2207  SIMP_TAC std_ss [SING_SUBSET, GSPECIFICATION, subspace] THEN
2208  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [GSYM REAL_MUL_RID] THEN
2209  FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []
2210QED
2211
2212Theorem HAS_SIZE_STDBASIS:
2213   {i :real | 1 <= i /\ i <= 1} HAS_SIZE 1
2214Proof
2215  REWRITE_TAC [REAL_LE_ANTISYM, GSPEC_EQ2, HAS_SIZE] THEN
2216  REWRITE_TAC [FINITE_SING, CARD_SING]
2217QED
2218
2219(* ------------------------------------------------------------------------- *)
2220(* More lemmas about dimension.                                              *)
2221(* ------------------------------------------------------------------------- *)
2222
2223Theorem DIM_UNIV:
2224   dim univ(:real) = 1:num
2225Proof
2226  MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC ``{i :real | &1 <= i /\ i <= &1}`` THEN
2227  REWRITE_TAC[SUBSET_UNIV, SPAN_STDBASIS, HAS_SIZE_STDBASIS, INDEPENDENT_STDBASIS]
2228QED
2229
2230Theorem DIM_SUBSET:
2231   !s t:real->bool. s SUBSET t ==> dim(s) <= dim(t)
2232Proof
2233  MESON_TAC[BASIS_EXISTS, INDEPENDENT_SPAN_BOUND, SUBSET_DEF, HAS_SIZE]
2234QED
2235
2236Theorem DIM_SUBSET_UNIV:
2237   !s:real->bool. dim(s) <= 1n
2238Proof
2239  GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
2240  MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]
2241QED
2242
2243(* ------------------------------------------------------------------------- *)
2244(* Open and closed sets                                                      *)
2245(* ------------------------------------------------------------------------- *)
2246
2247(* new definition *)
2248Definition euclidean_def :
2249    euclidean = mtop mr1
2250End
2251Overload euclideanreal[inferior] = “euclidean” (* HOL-Light compatible *)
2252
2253(* |- mtop mr1 = euclidean *)
2254Theorem MTOPOLOGY_REAL_EUCLIDEAN_METRIC = SYM euclidean_def
2255
2256(* new definition *)
2257Definition euclidean_open_def :
2258    Open = open_in euclidean
2259End
2260Overload "open" = “Open”
2261
2262(* old definition as an equivalent theorem *)
2263Theorem open_def :
2264    !s. Open s <=> !x. x IN s ==> ?e. &0 < e /\ !x'. dist(x',x) < e ==> x' IN s
2265Proof
2266    rw [euclidean_def, MTOP_OPEN, euclidean_open_def, dist_def, IN_APP,
2267        Once METRIC_SYM]
2268QED
2269
2270(* old definition as an equivalent theorem *)
2271Theorem euclidean :
2272    euclidean = topology open
2273Proof
2274    rw [euclidean_def, mtop]
2275 >> AP_TERM_TAC (* eliminated ‘topology’ *)
2276 >> rw [FUN_EQ_THM, open_def, dist_def, IN_APP, Once METRIC_SYM]
2277QED
2278
2279fun convert thm =
2280    REWRITE_RULE [GSYM euclidean_open_def] (Q.ISPEC ‘euclidean’ thm);
2281
2282(* |- open {} *)
2283Theorem OPEN_EMPTY = convert OPEN_IN_EMPTY
2284
2285Theorem OPEN_UNIV:
2286   open univ(:real)
2287Proof
2288  REWRITE_TAC[open_def, IN_UNIV] THEN MESON_TAC[REAL_LT_01]
2289QED
2290
2291(* |- !s t. open s /\ open t ==> open (s INTER t) *)
2292Theorem OPEN_INTER = convert OPEN_IN_INTER
2293
2294(* NOTE: added top quantifier for ‘f’ *)
2295Theorem OPEN_BIGUNION :
2296    !f. (!s. s IN f ==> open s) ==> open (BIGUNION f)
2297Proof
2298    REWRITE_TAC [open_def, IN_BIGUNION] >> MESON_TAC []
2299QED
2300
2301Theorem OPEN_EXISTS_IN:
2302   !P Q:'a->real->bool.
2303        (!a. P a ==> open {x | Q a x}) ==> open {x | ?a. P a /\ Q a x}
2304Proof
2305  REPEAT STRIP_TAC THEN
2306  SUBGOAL_THEN ``open(BIGUNION {{x | Q (a:'a) (x:real)} | P a})`` MP_TAC THENL
2307   [MATCH_MP_TAC OPEN_BIGUNION THEN ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN
2308    METIS_TAC [], MATCH_MP_TAC (TAUT `(a <=> b) ==> a ==> b`) THEN AP_TERM_TAC THEN
2309    SIMP_TAC std_ss [EXTENSION, IN_BIGUNION, GSPECIFICATION] THEN
2310    SET_TAC[]]
2311QED
2312
2313Theorem OPEN_EXISTS:
2314   !Q:'a->real->bool. (!a. open {x | Q a x}) ==> open {x | ?a. Q a x}
2315Proof
2316  MP_TAC(ISPEC ``\x:'a. T`` OPEN_EXISTS_IN) THEN REWRITE_TAC[]
2317QED
2318
2319Theorem OPEN_IN :
2320    !s. open s <=> open_in euclidean s
2321Proof
2322    rw [euclidean_open_def]
2323QED
2324
2325Theorem TOPSPACE_EUCLIDEAN :
2326    topspace euclidean = univ(:real)
2327Proof
2328    rw [TOPSPACE_MTOP, euclidean_def]
2329QED
2330
2331Theorem TOPSPACE_EUCLIDEAN_SUBTOPOLOGY:
2332   !s. topspace (subtopology euclidean s) = s
2333Proof
2334  REWRITE_TAC[TOPSPACE_EUCLIDEAN, TOPSPACE_SUBTOPOLOGY, INTER_UNIV]
2335QED
2336
2337Theorem OPEN_IN_REFL:
2338   !s:real->bool. open_in (subtopology euclidean s) s
2339Proof
2340  REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL, TOPSPACE_EUCLIDEAN, SUBSET_UNIV]
2341QED
2342
2343(* new definition *)
2344Definition euclidean_closed_def :
2345    Closed = closed_in euclidean
2346End
2347Overload closed = “Closed”
2348
2349(* old definition as an equivalent theorem *)
2350Theorem closed_def :
2351    !s. Closed s <=> open (UNIV DIFF s)
2352Proof
2353    rw [euclidean_closed_def, closed_in, euclidean_open_def, TOPSPACE_EUCLIDEAN]
2354QED
2355
2356Theorem CLOSED_IN_REFL:
2357   !s:real->bool. closed_in (subtopology euclidean s) s
2358Proof
2359  REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY_REFL, TOPSPACE_EUCLIDEAN, SUBSET_UNIV]
2360QED
2361
2362Theorem CLOSED_IN :
2363    !s. closed s <=> closed_in euclidean s
2364Proof
2365    rw [euclidean_closed_def]
2366QED
2367
2368(* |- !s t. open s /\ open t ==> open (s UNION t) *)
2369Theorem OPEN_UNION = convert OPEN_IN_UNION
2370
2371Theorem OPEN_SUB_OPEN :
2372    !s. open s <=> !x. x IN s ==> ?t. open t /\ x IN t /\ t SUBSET s
2373Proof
2374    rw [euclidean_open_def, Once OPEN_SUBOPEN, IN_APP]
2375 >> METIS_TAC []
2376QED
2377
2378Theorem CLOSED_EMPTY:
2379   closed {}
2380Proof
2381  REWRITE_TAC[CLOSED_IN, CLOSED_IN_EMPTY]
2382QED
2383
2384Theorem CLOSED_UNIV:
2385   closed(UNIV:real->bool)
2386Proof
2387  REWRITE_TAC[CLOSED_IN, GSYM TOPSPACE_EUCLIDEAN, CLOSED_IN_TOPSPACE]
2388QED
2389
2390Theorem CLOSED_UNION:
2391   !s t. closed s /\ closed t ==> closed(s UNION t)
2392Proof
2393  REWRITE_TAC[CLOSED_IN, CLOSED_IN_UNION]
2394QED
2395
2396Theorem CLOSED_INTER:
2397   !s t. closed s /\ closed t ==> closed(s INTER t)
2398Proof
2399  REWRITE_TAC[CLOSED_IN, CLOSED_IN_INTER]
2400QED
2401
2402Theorem CLOSED_BIGINTER:
2403   !f. (!s:real->bool. s IN f ==> closed s) ==> closed(BIGINTER f)
2404Proof
2405  REWRITE_TAC[CLOSED_IN] THEN REPEAT STRIP_TAC THEN
2406  ASM_CASES_TAC ``f:(real->bool)->bool = {}`` THEN
2407  ASM_SIMP_TAC std_ss [CLOSED_IN_BIGINTER, BIGINTER_EMPTY] THEN
2408  REWRITE_TAC[GSYM TOPSPACE_EUCLIDEAN, CLOSED_IN_TOPSPACE]
2409QED
2410
2411Theorem CLOSED_FORALL_IN:
2412   !P Q:'a->real->bool.
2413        (!a. P a ==> closed {x | Q a x}) ==> closed {x | !a. P a ==> Q a x}
2414Proof
2415  REPEAT STRIP_TAC THEN
2416  SUBGOAL_THEN ``closed(BIGINTER {{x | Q (a:'a) (x:real)} | P a})`` MP_TAC THENL
2417   [MATCH_MP_TAC CLOSED_BIGINTER THEN ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC],
2418    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN SIMP_TAC std_ss [BIGINTER_GSPEC] THEN
2419    SET_TAC[]]
2420QED
2421
2422Theorem CLOSED_FORALL:
2423   !Q:'a->real->bool. (!a. closed {x | Q a x}) ==> closed {x | !a. Q a x}
2424Proof
2425  MP_TAC(ISPEC ``\x:'a. T`` CLOSED_FORALL_IN) THEN REWRITE_TAC[]
2426QED
2427
2428Theorem OPEN_CLOSED:
2429   !s:real->bool. open s <=> closed(UNIV DIFF s)
2430Proof
2431  SIMP_TAC std_ss [OPEN_IN, CLOSED_IN, TOPSPACE_EUCLIDEAN, SUBSET_UNIV,
2432           OPEN_IN_CLOSED_IN_EQ]
2433QED
2434
2435Theorem OPEN_DIFF:
2436   !s t. open s /\ closed t ==> open(s DIFF t)
2437Proof
2438  REWRITE_TAC[OPEN_IN, CLOSED_IN, OPEN_IN_DIFF]
2439QED
2440
2441Theorem CLOSED_DIFF:
2442   !s t. closed s /\ open t ==> closed(s DIFF t)
2443Proof
2444  REWRITE_TAC[OPEN_IN, CLOSED_IN, CLOSED_IN_DIFF]
2445QED
2446
2447Theorem OPEN_BIGINTER:
2448    !s. FINITE s /\ (!t. t IN s ==> open t) ==> (open (BIGINTER s))
2449Proof
2450  REWRITE_TAC [GSYM AND_IMP_INTRO] THEN GEN_TAC THEN
2451  KNOW_TAC `` (!t. t IN s ==> open t) ==> open (BIGINTER s) <=>
2452         (\x. (!t. t IN x ==> open t) ==> open (BIGINTER x)) s`` THENL
2453  [SIMP_TAC std_ss [GSPECIFICATION] THEN DISCH_TAC THEN
2454   ASM_REWRITE_TAC [], ALL_TAC] THEN DISC_RW_KILL THEN
2455   MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
2456   REWRITE_TAC [BIGINTER_INSERT, BIGINTER_EMPTY, OPEN_UNIV,
2457   IN_INSERT] THEN MESON_TAC [OPEN_INTER]
2458QED
2459
2460Theorem CLOSED_BIGUNION:
2461   !s. FINITE s /\ (!t. t IN s ==> closed t) ==> closed(BIGUNION s)
2462Proof
2463  REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
2464  KNOW_TAC ``!s. ((!t. t IN s ==> closed t) ==> closed(BIGUNION s)) <=>
2465             (\s. (!t. t IN s ==> closed t) ==> closed(BIGUNION s)) s`` THENL
2466  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
2467  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
2468  REWRITE_TAC[BIGUNION_INSERT, BIGUNION_EMPTY, CLOSED_EMPTY, IN_INSERT] THEN
2469  MESON_TAC[CLOSED_UNION]
2470QED
2471
2472(* ------------------------------------------------------------------------- *)
2473(* Open and closed balls.                                                    *)
2474(* ------------------------------------------------------------------------- *)
2475
2476(* new definition based on metricTheory *)
2477Definition ball_def :
2478    ball = metric$B(mr1)
2479End
2480
2481(* old definition now becomes a theorem *)
2482Theorem ball :
2483    !x e. ball(x,e) = {y | dist(x,y) < e}
2484Proof
2485    RW_TAC std_ss [ball_def, dist_def, metricTheory.ball,
2486                   Once EXTENSION, GSPECIFICATION]
2487 >> rw [IN_APP]
2488QED
2489
2490(* |- !x e. 0 < e ==> neigh euclidean (ball (x,e),x) *)
2491Theorem ball_neigh =
2492        BALL_NEIGH |> Q.ISPEC ‘mr1’
2493                   |> REWRITE_RULE [GSYM euclidean_def, GSYM ball_def]
2494
2495Definition cball_def :
2496    cball = mcball mr1
2497End
2498
2499Theorem cball :
2500    !x e. cball(x,e) = {y | dist(x,y) <= e}
2501Proof
2502    rw [cball_def, dist_def, mcball, MSPACE]
2503QED
2504
2505Definition sphere[nocompute]:
2506  sphere(x,e) = { y | dist(x,y) = e}
2507End
2508
2509Theorem IN_BALL:
2510   !x y e. y IN ball(x,e) <=> dist(x,y) < e
2511Proof
2512  REPEAT GEN_TAC THEN FULL_SIMP_TAC std_ss [ball, GSPECIFICATION]
2513QED
2514
2515Theorem IN_CBALL:
2516   !x y e. y IN cball(x,e) <=> dist(x,y) <= e
2517Proof
2518  REPEAT GEN_TAC THEN FULL_SIMP_TAC std_ss [cball, GSPECIFICATION]
2519QED
2520
2521Theorem IN_SPHERE:
2522   !x y e. y IN sphere(x,e) <=> (dist(x,y) = e)
2523Proof
2524  REPEAT GEN_TAC THEN FULL_SIMP_TAC std_ss [sphere, GSPECIFICATION]
2525QED
2526
2527Theorem IN_BALL_0:
2528   !x e. x IN ball(0,e) <=> abs(x) < e
2529Proof
2530  REWRITE_TAC [IN_BALL, dist, REAL_SUB_LZERO, ABS_NEG]
2531QED
2532
2533Theorem IN_CBALL_0:
2534   !x e. x IN cball(0,e) <=> abs(x) <= e
2535Proof
2536  REWRITE_TAC[IN_CBALL, dist, REAL_SUB_LZERO, ABS_NEG]
2537QED
2538
2539Theorem IN_SPHERE_0:
2540   !x e. x IN sphere(0,e) <=> (abs(x) = e)
2541Proof
2542  REWRITE_TAC[IN_SPHERE, dist, REAL_SUB_LZERO, ABS_NEG]
2543QED
2544
2545Theorem BALL_TRIVIAL:
2546   !x. ball(x,&0) = {}
2547Proof
2548  REWRITE_TAC[EXTENSION, IN_BALL, IN_SING, NOT_IN_EMPTY, dist] THEN REAL_ARITH_TAC
2549QED
2550
2551Theorem CBALL_TRIVIAL:
2552   !x. cball(x,&0) = {x}
2553Proof
2554  REWRITE_TAC[EXTENSION, IN_CBALL, IN_SING, NOT_IN_EMPTY, dist] THEN REAL_ARITH_TAC
2555QED
2556
2557Theorem CENTRE_IN_CBALL:
2558   !x e. x IN cball(x,e) <=> &0 <= e
2559Proof
2560  MESON_TAC[IN_CBALL, DIST_REFL]
2561QED
2562
2563Theorem BALL_SUBSET_CBALL:
2564   !x e. ball(x,e) SUBSET cball(x,e)
2565Proof
2566  REWRITE_TAC[IN_BALL, IN_CBALL, SUBSET_DEF] THEN REAL_ARITH_TAC
2567QED
2568
2569Theorem SPHERE_SUBSET_CBALL:
2570   !x e. sphere(x,e) SUBSET cball(x,e)
2571Proof
2572  REWRITE_TAC[IN_SPHERE, IN_CBALL, SUBSET_DEF] THEN REAL_ARITH_TAC
2573QED
2574
2575Theorem SUBSET_BALL:
2576   !x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)
2577Proof
2578  REWRITE_TAC[SUBSET_DEF, IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]
2579QED
2580
2581Theorem SUBSET_CBALL:
2582   !x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)
2583Proof
2584  REWRITE_TAC[SUBSET_DEF, IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]
2585QED
2586
2587Theorem BALL_MAX_UNION:
2588    !a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)
2589Proof
2590    rpt GEN_TAC
2591 >> REWRITE_TAC [IN_BALL, IN_UNION, EXTENSION, dist]
2592 >> GEN_TAC >> Q.ABBREV_TAC `b = abs (a - x)`
2593 >> REWRITE_TAC [REAL_LT_MAX]
2594QED
2595
2596Theorem BALL_MIN_INTER:
2597    !a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)
2598Proof
2599    rpt GEN_TAC
2600 >> REWRITE_TAC [IN_BALL, IN_INTER, EXTENSION, dist]
2601 >> GEN_TAC >> Q.ABBREV_TAC `b = abs (a - x)`
2602 >> REWRITE_TAC [REAL_LT_MIN]
2603QED
2604
2605Theorem CBALL_MAX_UNION:
2606    !a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)
2607Proof
2608    rpt GEN_TAC
2609 >> REWRITE_TAC [IN_CBALL, IN_UNION, EXTENSION, dist]
2610 >> GEN_TAC >> Q.ABBREV_TAC `b = abs (a - x)`
2611 >> REWRITE_TAC [REAL_LE_MAX]
2612QED
2613
2614Theorem CBALL_MIN_INTER:
2615    !x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)
2616Proof
2617    rpt GEN_TAC
2618 >> REWRITE_TAC [EXTENSION, IN_INTER, IN_CBALL, dist]
2619 >> Q.X_GEN_TAC `a` >> Q.ABBREV_TAC `b = abs (x - a)`
2620 >> REWRITE_TAC [REAL_LE_MIN]
2621QED
2622
2623Theorem BALL_TRANSLATION:
2624   !a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))
2625Proof
2626  REPEAT GEN_TAC THEN REWRITE_TAC [EXTENSION, IN_BALL, IN_IMAGE, dist] THEN
2627  GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC ``x' - a:real`` THEN
2628  RW_TAC std_ss [REAL_SUB_ADD2] THEN
2629  ASM_REWRITE_TAC [REAL_ARITH ``x - (x' - a) = a + x - x':real``],
2630  RW_TAC std_ss [] THEN
2631  METIS_TAC [REAL_ARITH ``a - (b + c) = a - b - c:real``, REAL_ADD_SUB]]
2632QED
2633
2634Theorem CBALL_TRANSLATION:
2635   !a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))
2636Proof
2637  REPEAT GEN_TAC THEN REWRITE_TAC [EXTENSION, IN_CBALL, IN_IMAGE, dist] THEN
2638  GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC ``x' - a:real`` THEN
2639  RW_TAC std_ss [REAL_SUB_ADD2] THEN
2640  ASM_REWRITE_TAC [REAL_ARITH ``x - (x' - a) = a + x - x':real``],
2641  RW_TAC std_ss [] THEN
2642  METIS_TAC [REAL_ARITH ``a - (b + c) = a - b - c:real``, REAL_ADD_SUB]]
2643QED
2644
2645Theorem SPHERE_TRANSLATION:
2646   !a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))
2647Proof
2648  REPEAT GEN_TAC THEN REWRITE_TAC [EXTENSION, IN_SPHERE, IN_IMAGE, dist] THEN
2649  GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC ``x' - a:real`` THEN
2650  RW_TAC std_ss [REAL_SUB_ADD2] THEN
2651  ASM_REWRITE_TAC [REAL_ARITH ``x - (x' - a) = a + x - x':real``],
2652  RW_TAC std_ss [] THEN
2653  METIS_TAC [REAL_ARITH ``a - (b + c) = a - b - c:real``, REAL_ADD_SUB]]
2654QED
2655
2656Theorem BALL_LINEAR_IMAGE:
2657   !f:real->real x r.
2658        linear f /\ (!y. ?x. f x = y) /\ (!x. abs(f x) = abs x)
2659        ==> (ball(f x,r) = IMAGE f (ball(x,r)))
2660Proof
2661  REWRITE_TAC[ball] THEN
2662  SIMP_TAC std_ss [linear, IN_IMAGE, dist, EXTENSION, GSPECIFICATION] THEN
2663  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
2664  [UNDISCH_TAC ``!y. ?x. (f:real->real) x = y`` THEN DISCH_TAC THEN
2665   POP_ASSUM (MP_TAC o SPEC ``x':real``) THEN STRIP_TAC THEN
2666   EXISTS_TAC ``x'':real`` THEN GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN
2667   ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``!x. abs ((f:real->real) x) = abs x`` THEN
2668   DISCH_THEN (MP_TAC o SYM o SPEC ``x - x'':real``) THEN DISCH_TAC THEN
2669   ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``!x y. (f:real->real) (x + y) = f x + f y`` THEN
2670   DISCH_THEN (MP_TAC o SPECL [``x:real``, ``-x'':real``]) THEN
2671   REWRITE_TAC [GSYM real_sub] THEN DISCH_TAC THEN
2672   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ARITH ``-x = -1 * x:real``] THEN
2673   UNDISCH_TAC ``!c x. f (c * x) = c * (f:real->real) x`` THEN
2674   DISCH_THEN (MP_TAC o SPECL [``-1:real``,``x'':real``]) THEN ASM_REAL_ARITH_TAC,
2675   ASM_REWRITE_TAC [real_sub] THEN REWRITE_TAC [REAL_ARITH ``-(f:real->real) x = -1 * f x``] THEN
2676   UNDISCH_TAC ``!c x. f (c * x) = c * (f:real->real) x`` THEN
2677   DISCH_THEN (MP_TAC o SYM o SPECL [``-1:real``,``x'':real``]) THEN DISCH_TAC THEN
2678   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ARITH ``-1 * x:real = -x``] THEN
2679   UNDISCH_TAC ``!x y. (f:real->real) (x + y) = f x + f y`` THEN
2680   DISCH_THEN (MP_TAC o SYM o SPECL [``x:real``, ``-x'':real``]) THEN DISCH_TAC THEN
2681   ASM_REWRITE_TAC [GSYM real_sub]]
2682QED
2683
2684Theorem CBALL_LINEAR_IMAGE:
2685   !f:real->real x r.
2686        linear f /\ (!y. ?x. f x = y) /\ (!x. abs(f x) = abs x)
2687        ==> (cball(f x,r) = IMAGE f (cball(x,r)))
2688Proof
2689  REWRITE_TAC[cball] THEN
2690  SIMP_TAC std_ss [linear, IN_IMAGE, dist, EXTENSION, GSPECIFICATION] THEN
2691  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
2692  [UNDISCH_TAC ``!y. ?x. (f:real->real) x = y`` THEN DISCH_TAC THEN
2693   POP_ASSUM (MP_TAC o SPEC ``x':real``) THEN STRIP_TAC THEN
2694   EXISTS_TAC ``x'':real`` THEN GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN
2695   ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``!x. abs ((f:real->real) x) = abs x`` THEN
2696   DISCH_THEN (MP_TAC o SYM o SPEC ``x - x'':real``) THEN DISCH_TAC THEN
2697   ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``!x y. (f:real->real) (x + y) = f x + f y`` THEN
2698   DISCH_THEN (MP_TAC o SPECL [``x:real``, ``-x'':real``]) THEN
2699   REWRITE_TAC [GSYM real_sub] THEN DISCH_TAC THEN
2700   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ARITH ``-x = -1 * x:real``] THEN
2701   UNDISCH_TAC ``!c x. f (c * x) = c * (f:real->real) x`` THEN
2702   DISCH_THEN (MP_TAC o SPECL [``-1:real``,``x'':real``]) THEN ASM_REAL_ARITH_TAC,
2703   ASM_REWRITE_TAC [real_sub] THEN REWRITE_TAC [REAL_ARITH ``-(f:real->real) x = -1 * f x``] THEN
2704   UNDISCH_TAC ``!c x. f (c * x) = c * (f:real->real) x`` THEN
2705   DISCH_THEN (MP_TAC o SYM o SPECL [``-1:real``,``x'':real``]) THEN DISCH_TAC THEN
2706   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ARITH ``-1 * x:real = -x``] THEN
2707   UNDISCH_TAC ``!x y. (f:real->real) (x + y) = f x + f y`` THEN
2708   DISCH_THEN (MP_TAC o SYM o SPECL [``x:real``, ``-x'':real``]) THEN DISCH_TAC THEN
2709   ASM_REWRITE_TAC [GSYM real_sub]]
2710QED
2711
2712Theorem SPHERE_LINEAR_IMAGE:
2713   !f:real->real x r.
2714        linear f /\ (!y. ?x. f x = y) /\ (!x. abs(f x) = abs x)
2715        ==> (sphere(f x,r) = IMAGE f (sphere(x,r)))
2716Proof
2717  REWRITE_TAC[sphere] THEN
2718  SIMP_TAC std_ss [linear, IN_IMAGE, dist, EXTENSION, GSPECIFICATION] THEN
2719  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
2720  [UNDISCH_TAC ``!y. ?x. (f:real->real) x = y`` THEN DISCH_TAC THEN
2721   POP_ASSUM (MP_TAC o SPEC ``x':real``) THEN STRIP_TAC THEN
2722   EXISTS_TAC ``x'':real`` THEN GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN
2723   ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``!x. abs ((f:real->real) x) = abs x`` THEN
2724   DISCH_THEN (MP_TAC o SYM o SPEC ``x - x'':real``) THEN DISCH_TAC THEN
2725   ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``!x y. (f:real->real) (x + y) = f x + f y`` THEN
2726   DISCH_THEN (MP_TAC o SPECL [``x:real``, ``-x'':real``]) THEN
2727   REWRITE_TAC [GSYM real_sub] THEN DISCH_TAC THEN
2728   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ARITH ``-x = -1 * x:real``] THEN
2729   UNDISCH_TAC ``!c x. f (c * x) = c * (f:real->real) x`` THEN
2730   DISCH_THEN (MP_TAC o SPECL [``-1:real``,``x'':real``]) THEN ASM_REAL_ARITH_TAC,
2731   ASM_REWRITE_TAC [real_sub] THEN REWRITE_TAC [REAL_ARITH ``-(f:real->real) x = -1 * f x``] THEN
2732   UNDISCH_TAC ``!c x. f (c * x) = c * (f:real->real) x`` THEN
2733   DISCH_THEN (MP_TAC o SYM o SPECL [``-1:real``,``x'':real``]) THEN DISCH_TAC THEN
2734   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ARITH ``-1 * x:real = -x``] THEN
2735   UNDISCH_TAC ``!x y. (f:real->real) (x + y) = f x + f y`` THEN
2736   DISCH_THEN (MP_TAC o SYM o SPECL [``x:real``, ``-x'':real``]) THEN DISCH_TAC THEN
2737   ASM_REWRITE_TAC [GSYM real_sub]]
2738QED
2739
2740Theorem BALL_SCALING:
2741   !c. &0 < c ==> !x r. ball(c * x,c * r) = IMAGE (\x. c * x) (ball(x,r))
2742Proof
2743  REWRITE_TAC [IMAGE_DEF, IN_BALL] THEN BETA_TAC THEN
2744  SIMP_TAC std_ss [ball, EXTENSION, GSPECIFICATION, dist] THEN
2745  REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN
2746  EXISTS_TAC ``x' / c:real`` THEN
2747  FULL_SIMP_TAC std_ss [REAL_DIV_LMUL, REAL_POS_NZ] THEN
2748  KNOW_TAC `` abs (x - x' / c) < r <=> abs c * abs (x - x' / c) < c * r:real`` THENL
2749  [FULL_SIMP_TAC std_ss [abs, REAL_LT_IMP_LE, REAL_LT_LMUL], ALL_TAC] THEN
2750  DISC_RW_KILL THEN REWRITE_TAC [GSYM ABS_MUL] THEN
2751  FULL_SIMP_TAC std_ss [REAL_SUB_LDISTRIB, REAL_DIV_LMUL, REAL_POS_NZ],
2752  STRIP_TAC THEN FULL_SIMP_TAC std_ss [GSYM dist, DIST_MUL, abs,
2753                 REAL_LT_IMP_LE, REAL_LT_LMUL]]
2754QED
2755
2756Theorem CBALL_SCALING:
2757   !c. &0 < c ==> !x r. cball(c * x,c * r) = IMAGE (\x. c * x) (cball(x,r))
2758Proof
2759  REWRITE_TAC [IMAGE_DEF, IN_CBALL] THEN BETA_TAC THEN
2760  SIMP_TAC std_ss [cball, EXTENSION, GSPECIFICATION, dist] THEN
2761  REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN
2762  EXISTS_TAC ``x' / c:real`` THEN
2763  FULL_SIMP_TAC std_ss [REAL_DIV_LMUL, REAL_POS_NZ] THEN
2764  KNOW_TAC `` abs (x - x' / c) <= r <=> abs c * abs (x - x' / c) <= c * r:real`` THENL
2765  [FULL_SIMP_TAC std_ss [abs, REAL_LT_IMP_LE, REAL_LE_LMUL], ALL_TAC] THEN
2766  DISC_RW_KILL THEN REWRITE_TAC [GSYM ABS_MUL] THEN
2767  FULL_SIMP_TAC std_ss [REAL_SUB_LDISTRIB, REAL_DIV_LMUL, REAL_POS_NZ],
2768  STRIP_TAC THEN FULL_SIMP_TAC std_ss [GSYM dist, DIST_MUL, abs,
2769                 REAL_LT_IMP_LE, REAL_LE_LMUL]]
2770QED
2771
2772Theorem CBALL_DIFF_BALL:
2773   !a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)
2774Proof
2775  SIMP_TAC std_ss [ball, cball, sphere, EXTENSION, IN_DIFF, GSPECIFICATION] THEN
2776  REAL_ARITH_TAC
2777QED
2778
2779Theorem BALL_UNION_SPHERE:
2780   !a r. ball(a,r) UNION sphere(a,r) = cball(a,r)
2781Proof
2782  SIMP_TAC std_ss [ball, cball, sphere, EXTENSION, IN_UNION, GSPECIFICATION] THEN
2783  REAL_ARITH_TAC
2784QED
2785
2786Theorem SPHERE_UNION_BALL:
2787   !a r. sphere(a,r) UNION ball(a,r)  = cball(a,r)
2788Proof
2789  SIMP_TAC std_ss [ball, cball, sphere, EXTENSION, IN_UNION, GSPECIFICATION] THEN
2790  REAL_ARITH_TAC
2791QED
2792
2793Theorem CBALL_DIFF_SPHERE:
2794   !a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)
2795Proof
2796  REWRITE_TAC[EXTENSION, IN_DIFF, IN_SPHERE, IN_BALL, IN_CBALL] THEN
2797  REAL_ARITH_TAC
2798QED
2799
2800Theorem OPEN_BALL:
2801   !x e. open(ball(x,e))
2802Proof
2803  REPEAT GEN_TAC THEN REWRITE_TAC[open_def, ball] THEN
2804  FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
2805  MESON_TAC [REAL_SUB_LT, REAL_LT_SUB_LADD, REAL_ADD_SYM, REAL_LET_TRANS,
2806  DIST_TRIANGLE_ALT]
2807QED
2808
2809Theorem CENTRE_IN_BALL:
2810   !x e. x IN ball(x,e) <=> &0 < e
2811Proof
2812  MESON_TAC[IN_BALL, DIST_REFL]
2813QED
2814
2815Theorem OPEN_CONTAINS_BALL:
2816   !s. open s <=> !x. x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s
2817Proof
2818  REWRITE_TAC[open_def, SUBSET_DEF, IN_BALL] THEN SIMP_TAC std_ss [DIST_SYM]
2819QED
2820
2821Theorem OPEN_CONTAINS_BALL_EQ:
2822   !s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)
2823Proof
2824  MESON_TAC[OPEN_CONTAINS_BALL, SUBSET_DEF, CENTRE_IN_BALL]
2825QED
2826
2827Theorem BALL_EQ_EMPTY:
2828   !x e. (ball(x,e) = {}) <=> e <= &0
2829Proof
2830  REWRITE_TAC[EXTENSION, IN_BALL, NOT_IN_EMPTY, REAL_NOT_LT] THEN
2831  MESON_TAC[DIST_POS_LE, REAL_LE_TRANS, DIST_REFL]
2832QED
2833
2834Theorem BALL_EMPTY:
2835   !x e. e <= &0 ==> (ball(x,e) = {})
2836Proof
2837  REWRITE_TAC[BALL_EQ_EMPTY]
2838QED
2839
2840Theorem OPEN_CONTAINS_CBALL:
2841   !s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s
2842Proof
2843  GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL
2844   [ALL_TAC, ASM_MESON_TAC[SUBSET_TRANS, BALL_SUBSET_CBALL]] THEN
2845   KNOW_TAC ``!x. (x IN s ==> ?e. 0 < e /\ cball (x,e) SUBSET s) =
2846         (\x:real. x IN s ==> ?e. 0 < e /\ cball (x,e) SUBSET s) x`` THENL
2847   [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
2848   KNOW_TAC ``!x. (x IN s ==> ?e. 0 < e /\ ball (x,e) SUBSET s) =
2849         (\x:real. x IN s ==> ?e. 0 < e /\ ball (x,e) SUBSET s) x`` THENL
2850  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
2851  MATCH_MP_TAC MONO_ALL THEN GEN_TAC THEN BETA_TAC THEN
2852  MATCH_MP_TAC MONO_IMP THEN
2853  REWRITE_TAC[SUBSET_DEF, IN_BALL, IN_CBALL] THEN
2854  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
2855  EXISTS_TAC ``e / &2:real`` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
2856  SUBGOAL_THEN ``e / &2 < e:real`` (fn th => ASM_MESON_TAC[th, REAL_LET_TRANS]) THEN
2857  UNDISCH_TAC ``0 < e:real`` THEN SIMP_TAC arith_ss [REAL_LT_HALF2]
2858QED
2859
2860Theorem OPEN_CONTAINS_CBALL_EQ:
2861   !s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)
2862Proof
2863  MESON_TAC[OPEN_CONTAINS_CBALL, SUBSET_DEF, REAL_LT_IMP_LE, CENTRE_IN_CBALL]
2864QED
2865
2866Theorem SPHERE_EQ_EMPTY:
2867   !a:real r. (sphere(a,r) = {}) <=> r < &0
2868Proof
2869  SIMP_TAC std_ss [sphere, EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] THEN
2870  REPEAT GEN_TAC THEN EQ_TAC THENL [CCONTR_TAC THEN
2871  FULL_SIMP_TAC std_ss [REAL_NOT_LT] THEN
2872  UNDISCH_TAC ``!x. dist (a,x) <> r`` THEN
2873  FULL_SIMP_TAC std_ss [REAL_LE_LT, dist] THENL
2874  [EXISTS_TAC ``a - r:real`` THEN POP_ASSUM MP_TAC THEN
2875  REAL_ARITH_TAC, EXISTS_TAC ``a:real`` THEN
2876  METIS_TAC [REAL_SUB_REFL, EQ_SYM_EQ, ABS_0]], DISCH_TAC THEN
2877  ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN CCONTR_TAC THEN
2878  UNDISCH_TAC ``r < 0:real`` THEN FULL_SIMP_TAC std_ss [REAL_NOT_LT, DIST_POS_LE]]
2879QED
2880
2881Theorem SPHERE_EMPTY:
2882   !a:real r. r < &0 ==> (sphere(a,r) = {})
2883Proof
2884  REWRITE_TAC[SPHERE_EQ_EMPTY]
2885QED
2886
2887Theorem NEGATIONS_BALL:
2888   !r. IMAGE (\x:real. -x) (ball(0:real,r)) = ball(0,r)
2889Proof
2890  GEN_TAC THEN SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_BALL_0] THEN
2891  GEN_TAC THEN EQ_TAC THENL [METIS_TAC [ABS_NEG], DISCH_TAC THEN
2892  EXISTS_TAC ``-x:real`` THEN
2893  FULL_SIMP_TAC std_ss [ABS_NEG, REAL_NEG_NEG]]
2894QED
2895
2896Theorem NEGATIONS_CBALL:
2897   !r. IMAGE (\x. -x) (cball(0:real,r)) = cball(0,r)
2898Proof
2899  GEN_TAC THEN SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_CBALL_0] THEN
2900  GEN_TAC THEN EQ_TAC THENL [METIS_TAC [ABS_NEG], DISCH_TAC THEN
2901  EXISTS_TAC ``-x:real`` THEN
2902  FULL_SIMP_TAC std_ss [ABS_NEG, REAL_NEG_NEG]]
2903QED
2904
2905Theorem NEGATIONS_SPHERE:
2906   !r. IMAGE (\x. -x) (sphere(0:real,r)) = sphere(0,r)
2907Proof
2908  GEN_TAC THEN SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_SPHERE_0] THEN
2909  GEN_TAC THEN EQ_TAC THENL [METIS_TAC [ABS_NEG], DISCH_TAC THEN
2910  EXISTS_TAC ``-x:real`` THEN
2911  FULL_SIMP_TAC std_ss [ABS_NEG, REAL_NEG_NEG]]
2912QED
2913
2914(* ------------------------------------------------------------------------- *)
2915(* Basic "localization" results are handy for connectedness.                 *)
2916(* ------------------------------------------------------------------------- *)
2917
2918Theorem OPEN_IN_OPEN:
2919   !s:real->bool u.
2920        open_in (subtopology euclidean u) s <=> ?t. open t /\ (s = u INTER t)
2921Proof
2922  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [OPEN_IN_SUBTOPOLOGY, GSYM OPEN_IN] THEN
2923  SIMP_TAC std_ss [INTER_ACI]
2924QED
2925
2926Theorem OPEN_IN_INTER_OPEN:
2927   !s t u:real->bool.
2928        open_in (subtopology euclidean u) s /\ open t
2929        ==> open_in (subtopology euclidean u) (s INTER t)
2930Proof
2931  SIMP_TAC std_ss [OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
2932  ASM_MESON_TAC[INTER_ASSOC, OPEN_INTER]
2933QED
2934
2935Theorem OPEN_IN_OPEN_INTER:
2936   !u s. open s ==> open_in (subtopology euclidean u) (u INTER s)
2937Proof
2938  REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[]
2939QED
2940
2941Theorem OPEN_OPEN_IN_TRANS:
2942   !s t. open s /\ open t /\ t SUBSET s
2943         ==> open_in (subtopology euclidean s) t
2944Proof
2945  MESON_TAC[OPEN_IN_OPEN_INTER, SET_RULE ``(t:real->bool) SUBSET s ==> (t = s INTER t)``]
2946QED
2947
2948Theorem OPEN_SUBSET:
2949   !s t:real->bool.
2950        s SUBSET t /\ open s ==> open_in (subtopology euclidean t) s
2951Proof
2952  REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
2953  EXISTS_TAC ``s:real->bool`` THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
2954QED
2955
2956Theorem CLOSED_IN_CLOSED:
2957   !s:real->bool u.
2958    closed_in (subtopology euclidean u) s <=> ?t. closed t /\ (s = u INTER t)
2959Proof
2960  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [CLOSED_IN_SUBTOPOLOGY, GSYM CLOSED_IN] THEN
2961  SIMP_TAC std_ss [INTER_ACI]
2962QED
2963
2964Theorem CLOSED_SUBSET_EQ:
2965   !u s:real->bool.
2966        closed s ==> (closed_in (subtopology euclidean u) s <=> s SUBSET u)
2967Proof
2968  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
2969   [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN
2970    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY],
2971    REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC ``s:real->bool`` THEN
2972    REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]]
2973QED
2974
2975Theorem CLOSED_IN_INTER_CLOSED:
2976   !s t u:real->bool.
2977        closed_in (subtopology euclidean u) s /\ closed t
2978        ==> closed_in (subtopology euclidean u) (s INTER t)
2979Proof
2980  SIMP_TAC std_ss [CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
2981  ASM_MESON_TAC[INTER_ASSOC, CLOSED_INTER]
2982QED
2983
2984Theorem CLOSED_IN_CLOSED_INTER:
2985   !u s. closed s ==> closed_in (subtopology euclidean u) (u INTER s)
2986Proof
2987  REWRITE_TAC[CLOSED_IN_CLOSED] THEN MESON_TAC[]
2988QED
2989
2990Theorem CLOSED_SUBSET:
2991   !s t:real->bool.
2992        s SUBSET t /\ closed s ==> closed_in (subtopology euclidean t) s
2993Proof
2994  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN
2995  EXISTS_TAC ``s:real->bool`` THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
2996QED
2997
2998Theorem OPEN_IN_SUBSET_TRANS:
2999   !s t u:real->bool.
3000        open_in (subtopology euclidean u) s /\ s SUBSET t /\ t SUBSET u
3001        ==> open_in (subtopology euclidean t) s
3002Proof
3003  REPEAT GEN_TAC THEN SIMP_TAC std_ss [OPEN_IN_OPEN, LEFT_EXISTS_AND_THM] THEN
3004  SET_TAC[]
3005QED
3006
3007Theorem CLOSED_IN_SUBSET_TRANS:
3008   !s t u:real->bool.
3009        closed_in (subtopology euclidean u) s /\ s SUBSET t /\ t SUBSET u
3010        ==> closed_in (subtopology euclidean t) s
3011Proof
3012  REPEAT GEN_TAC THEN SIMP_TAC std_ss [CLOSED_IN_CLOSED] THEN
3013  REPEAT STRIP_TAC THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
3014QED
3015
3016Theorem open_in:
3017   !u s:real->bool.
3018        open_in (subtopology euclidean u) s <=>
3019          s SUBSET u /\
3020          !x. x IN s ==> ?e. &0 < e /\
3021                             !x'. x' IN u /\ dist(x',x) < e ==> x' IN s
3022Proof
3023  REPEAT GEN_TAC THEN
3024  SIMP_TAC std_ss [OPEN_IN_SUBTOPOLOGY, GSYM OPEN_IN] THEN EQ_TAC THENL
3025   [REWRITE_TAC[open_def] THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[INTER_SUBSET, IN_INTER],
3026    ALL_TAC] THEN
3027  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_TAC THEN
3028  FULL_SIMP_TAC std_ss [GSYM RIGHT_EXISTS_IMP_THM] THEN POP_ASSUM MP_TAC THEN
3029  SIMP_TAC std_ss [SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC ``d:real->real``) THEN
3030  EXISTS_TAC ``BIGUNION {b | ?x:real. (b = ball(x,d x)) /\ x IN s}`` THEN
3031  CONJ_TAC THENL
3032   [MATCH_MP_TAC OPEN_BIGUNION THEN
3033    ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN METIS_TAC [LEFT_EXISTS_IMP_THM, OPEN_BALL],
3034    GEN_REWR_TAC I [EXTENSION] THEN
3035    SIMP_TAC std_ss [IN_INTER, IN_BIGUNION, GSPECIFICATION] THEN
3036    ASM_MESON_TAC[SUBSET_DEF, DIST_REFL, DIST_SYM, IN_BALL]]
3037QED
3038
3039Theorem OPEN_IN_CONTAINS_BALL:
3040   !s t:real->bool.
3041        open_in (subtopology euclidean t) s <=>
3042        s SUBSET t /\
3043        !x. x IN s ==> ?e. &0 < e /\ ball(x,e) INTER t SUBSET s
3044Proof
3045  SIMP_TAC std_ss [open_in, INTER_DEF, SUBSET_DEF, GSPECIFICATION, IN_BALL] THEN
3046  MESON_TAC[DIST_SYM]
3047QED
3048
3049Theorem OPEN_IN_CONTAINS_CBALL:
3050   !s t:real->bool.
3051        open_in (subtopology euclidean t) s <=>
3052        s SUBSET t /\
3053        !x. x IN s ==> ?e. &0 < e /\ cball(x,e) INTER t SUBSET s
3054Proof
3055  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN
3056  AP_TERM_TAC THEN REWRITE_TAC[IN_BALL, IN_INTER, SUBSET_DEF, IN_CBALL] THEN
3057  MESON_TAC[METIS [REAL_LT_HALF1, REAL_LT_HALF2, REAL_LET_TRANS]
3058    ``&0 < e:real ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)``,
3059            REAL_LT_IMP_LE]
3060QED
3061
3062(* ------------------------------------------------------------------------- *)
3063(* These "transitivity" results are handy too.                               *)
3064(* ------------------------------------------------------------------------- *)
3065
3066Theorem OPEN_IN_TRANS:
3067   !s t u. open_in (subtopology euclidean t) s /\
3068           open_in (subtopology euclidean u) t
3069           ==> open_in (subtopology euclidean u) s
3070Proof
3071  ASM_MESON_TAC[OPEN_IN_OPEN, OPEN_IN, OPEN_INTER, INTER_ASSOC]
3072QED
3073
3074Theorem OPEN_IN_TRANS_EQ:
3075   !s t:real->bool.
3076        (!u. open_in (subtopology euclidean t) u
3077             ==> open_in (subtopology euclidean s) t)
3078        <=> open_in (subtopology euclidean s) t
3079Proof
3080  MESON_TAC[OPEN_IN_TRANS, OPEN_IN_REFL]
3081QED
3082
3083Theorem OPEN_IN_OPEN_TRANS:
3084   !s t. open_in (subtopology euclidean t) s /\ open t ==> open s
3085Proof
3086  REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] OPEN_IN] THEN
3087  REWRITE_TAC[OPEN_IN_TRANS]
3088QED
3089
3090Theorem CLOSED_IN_TRANS:
3091   !s t u. closed_in (subtopology euclidean t) s /\
3092           closed_in (subtopology euclidean u) t
3093           ==> closed_in (subtopology euclidean u) s
3094Proof
3095  ASM_MESON_TAC[CLOSED_IN_CLOSED, CLOSED_IN, CLOSED_INTER, INTER_ASSOC]
3096QED
3097
3098Theorem CLOSED_IN_TRANS_EQ:
3099   !s t:real->bool.
3100        (!u. closed_in (subtopology euclidean t) u
3101             ==> closed_in (subtopology euclidean s) t)
3102        <=> closed_in (subtopology euclidean s) t
3103Proof
3104  MESON_TAC[CLOSED_IN_TRANS, CLOSED_IN_REFL]
3105QED
3106
3107Theorem CLOSED_IN_CLOSED_TRANS:
3108   !s t. closed_in (subtopology euclidean t) s /\ closed t ==> closed s
3109Proof
3110  REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] CLOSED_IN] THEN
3111  REWRITE_TAC[CLOSED_IN_TRANS]
3112QED
3113
3114Theorem OPEN_IN_SUBTOPOLOGY_INTER_SUBSET:
3115   !s u v. open_in (subtopology euclidean u) (u INTER s) /\ v SUBSET u
3116           ==> open_in (subtopology euclidean v) (v INTER s)
3117Proof
3118  REPEAT GEN_TAC THEN SIMP_TAC std_ss [OPEN_IN_OPEN, GSYM LEFT_EXISTS_AND_THM] THEN
3119  STRIP_TAC THEN EXISTS_TAC ``t:real->bool`` THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
3120QED
3121
3122Theorem OPEN_IN_OPEN_EQ:
3123   !s t. open s
3124         ==> (open_in (subtopology euclidean s) t <=> open t /\ t SUBSET s)
3125Proof
3126  MESON_TAC[OPEN_OPEN_IN_TRANS, OPEN_IN_OPEN_TRANS, open_in]
3127QED
3128
3129Theorem CLOSED_IN_CLOSED_EQ:
3130   !s t. closed s
3131         ==> (closed_in (subtopology euclidean s) t <=>
3132              closed t /\ t SUBSET s)
3133Proof
3134  MESON_TAC[CLOSED_SUBSET, CLOSED_IN_CLOSED_TRANS, closed_in,
3135            TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]
3136QED
3137
3138(* ------------------------------------------------------------------------- *)
3139(* Line segments, with open/closed overloading of (a,b) and [a,b].           *)
3140(* ------------------------------------------------------------------------- *)
3141
3142Definition closed_segment[nocompute]:
3143  closed_segment (l:(real#real)list) =
3144   {((&1:real) - u) * FST(HD l) + u * SND(HD l) | &0 <= u /\ u <= &1}
3145End
3146
3147Definition open_segment[nocompute]:
3148 open_segment(a,b) = closed_segment[a,b] DIFF {a;b}
3149End
3150
3151Theorem OPEN_SEGMENT_ALT:
3152   !a b:real.
3153        ~(a = b)
3154        ==> (open_segment(a,b) = {(&1 - u) * a + u * b | &0 < u /\ u < &1:real})
3155Proof
3156  REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment, closed_segment, FST, SND, HD] THEN
3157  SIMP_TAC std_ss [EXTENSION, IN_DIFF, IN_INSERT, NOT_IN_EMPTY, GSPECIFICATION] THEN
3158  X_GEN_TAC ``x:real`` THEN SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN
3159  AP_TERM_TAC THEN SIMP_TAC std_ss [FUN_EQ_THM] THEN
3160  X_GEN_TAC ``u:real`` THEN ASM_CASES_TAC ``x:real = (&1 - u) * a + u * b`` THEN
3161  ASM_REWRITE_TAC[REAL_LE_LT,
3162    REAL_ARITH ``((&1 - u) * a + u * b = a) <=> (u * (b - a) = 0:real)``,
3163    REAL_ARITH ``((&1 - u) * a + u * b = b) <=> ((&1 - u) * (b - a) = 0:real)``,
3164    REAL_ENTIRE, REAL_SUB_0] THEN UNDISCH_TAC ``a <> b:real`` THEN DISCH_TAC THEN
3165        POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN DISCH_TAC THEN
3166        ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC
3167QED
3168
3169Overload segment = ``open_segment``
3170Overload segment = ``closed_segment``
3171
3172Theorem segment:
3173   (segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1:real}) /\
3174   (segment(a,b) = segment[a,b] DIFF {a;b:real})
3175Proof
3176  REWRITE_TAC[open_segment, closed_segment, HD]
3177QED
3178
3179Theorem SEGMENT_REFL:
3180   (!a. segment[a,a] = {a}) /\
3181   (!a. segment(a,a) = {})
3182Proof
3183  REWRITE_TAC[segment, REAL_ARITH ``(&1 - u) * a + u * a = a:real``] THEN
3184  CONJ_TAC THENL [ALL_TAC, SET_TAC[REAL_POS]] THEN
3185  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION] THEN REPEAT GEN_TAC THEN
3186  EQ_TAC THEN REWRITE_TAC [IN_SING] THENL [METIS_TAC [], ALL_TAC] THEN DISCH_TAC THEN
3187  ASM_REWRITE_TAC [] THEN EXISTS_TAC ``1:real`` THEN REAL_ARITH_TAC
3188QED
3189
3190Theorem IN_SEGMENT:
3191   !a b x:real.
3192        ((x IN segment[a,b] <=>
3193         ?u. &0 <= u /\ u <= &1 /\ (x = (&1 - u) * a + u * b:real))) /\
3194        ((x IN segment(a,b) <=>
3195         ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ (x = (&1 - u) * a + u * b:real)))
3196Proof
3197  REPEAT STRIP_TAC THENL
3198   [SIMP_TAC std_ss [segment, GSPECIFICATION, CONJ_ASSOC], ALL_TAC] THEN
3199  ASM_CASES_TAC ``a:real = b`` THEN
3200  ASM_REWRITE_TAC[SEGMENT_REFL, NOT_IN_EMPTY] THEN
3201  ASM_SIMP_TAC std_ss [OPEN_SEGMENT_ALT, GSPECIFICATION, CONJ_ASSOC] THEN METIS_TAC []
3202QED
3203
3204Theorem SEGMENT_SYM:
3205   (!a b:real. segment[a,b] = segment[b,a]) /\
3206   (!a b:real. segment(a,b) = segment(b,a))
3207Proof
3208  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
3209  SIMP_TAC std_ss [open_segment] THEN
3210  CONJ_TAC THENL [ALL_TAC, SIMP_TAC std_ss [INSERT_COMM, INSERT_INSERT]] THEN
3211  REWRITE_TAC[EXTENSION, IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN
3212  DISCH_THEN(X_CHOOSE_TAC ``u:real``) THEN EXISTS_TAC ``&1 - u:real`` THEN
3213  ASM_REWRITE_TAC[] THEN
3214  REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN ASM_REAL_ARITH_TAC
3215QED
3216
3217Theorem ENDS_IN_SEGMENT:
3218   !a b. a IN segment[a,b] /\ b IN segment[a,b]
3219Proof
3220  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [segment, GSPECIFICATION] THENL
3221   [EXISTS_TAC ``&0:real``, EXISTS_TAC ``&1:real``] THEN
3222  (CONJ_TAC THENL [REAL_ARITH_TAC, REAL_ARITH_TAC])
3223QED
3224
3225Theorem ENDS_NOT_IN_SEGMENT:
3226   !a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))
3227Proof
3228  REWRITE_TAC[open_segment] THEN SET_TAC[]
3229QED
3230
3231Theorem SEGMENT_CLOSED_OPEN:
3232   !a b. segment[a,b] = segment(a,b) UNION {a;b}
3233Proof
3234  REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE
3235   ``a IN s /\ b IN s ==> (s = (s DIFF {a;b}) UNION {a;b})``) THEN
3236  REWRITE_TAC[ENDS_IN_SEGMENT]
3237QED
3238
3239Theorem SEGMENT_OPEN_SUBSET_CLOSED:
3240   !a b. segment(a,b) SUBSET segment[a,b]
3241Proof
3242  REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]
3243QED
3244
3245Theorem MIDPOINT_IN_SEGMENT:
3246   (!a b:real. midpoint(a,b) IN segment[a,b]) /\
3247   (!a b:real. midpoint(a,b) IN segment(a,b) <=> ~(a = b))
3248Proof
3249  REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL
3250   [ALL_TAC, ASM_CASES_TAC ``a:real = b`` THEN ASM_REWRITE_TAC[]] THEN
3251  EXISTS_TAC ``&1 / &2:real`` THEN REWRITE_TAC[midpoint] THEN
3252  REWRITE_TAC [REAL_HALF_BETWEEN] THEN
3253  REWRITE_TAC [METIS [REAL_HALF_DOUBLE, REAL_EQ_SUB_RADD]
3254   ``1 - 1 / 2 = 1 / 2:real``] THEN REWRITE_TAC [GSYM REAL_LDISTRIB] THEN
3255   REWRITE_TAC [REAL_INV_1OVER]
3256QED
3257
3258Theorem BETWEEN_IN_SEGMENT:
3259   !x a b:real. between x (a,b) <=> x IN segment[a,b]
3260Proof
3261  REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN
3262  ASM_CASES_TAC ``a:real = b`` THEN
3263  ASM_REWRITE_TAC[SEGMENT_REFL, IN_SING] THENL
3264  [REWRITE_TAC [dist] THEN REAL_ARITH_TAC, ALL_TAC] THEN
3265  SIMP_TAC std_ss [segment, GSPECIFICATION] THEN EQ_TAC THENL
3266   [DISCH_THEN(ASSUME_TAC o SYM) THEN
3267    EXISTS_TAC ``dist(a:real,x) / dist(a,b)`` THEN
3268    ASM_SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ, DIST_POS_LT] THEN CONJ_TAC
3269    THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN
3270    ASM_REWRITE_TAC [dist] THEN REWRITE_TAC [REAL_SUB_RDISTRIB, REAL_MUL_LID] THEN
3271        ONCE_REWRITE_TAC [REAL_ARITH ``(x = a - y + z) = (y - z = a - x:real)``] THEN
3272        REWRITE_TAC [GSYM REAL_SUB_LDISTRIB] THEN KNOW_TAC ``(a - b:real) <> 0`` THENL
3273        [ASM_REAL_ARITH_TAC, DISCH_TAC] THEN ASM_SIMP_TAC std_ss [GSYM ABS_DIV] THEN
3274        Cases_on `0 < a - b:real` THENL
3275        [ASM_SIMP_TAC std_ss [GSYM REAL_EQ_RDIV_EQ] THEN REWRITE_TAC [ABS_REFL] THEN
3276         ASM_SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_MUL_LZERO] THEN
3277         FULL_SIMP_TAC std_ss [dist] THEN ASM_REAL_ARITH_TAC,
3278         FULL_SIMP_TAC std_ss [REAL_NOT_LT, REAL_LE_LT] THENL
3279         [ALL_TAC, ASM_REAL_ARITH_TAC] THEN
3280         POP_ASSUM MP_TAC THEN GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LT_NEG] THEN
3281         ONCE_REWRITE_TAC [REAL_ARITH ``(-0 = 0:real) /\ (-(a - b) = (b - a:real))``] THEN
3282         DISCH_TAC THEN ONCE_REWRITE_TAC [REAL_ARITH ``((a - b) = -(b - a:real))``] THEN
3283         ONCE_ASM_REWRITE_TAC [REAL_ARITH ``a * -b = -a * b:real``] THEN
3284         ASM_SIMP_TAC std_ss [GSYM REAL_EQ_RDIV_EQ] THEN REWRITE_TAC [real_div] THEN
3285         ONCE_REWRITE_TAC [REAL_ARITH ``(-a * b = -(a * b:real))``] THEN
3286         REWRITE_TAC [REAL_EQ_NEG] THEN KNOW_TAC ``(b - a:real) <> 0`` THENL
3287         [ASM_REAL_ARITH_TAC, DISCH_TAC] THEN ASM_SIMP_TAC std_ss [GSYM REAL_NEG_INV] THEN
3288         ONCE_REWRITE_TAC [REAL_ARITH ``(-(a * b) = (a * -b:real))``] THEN
3289         FULL_SIMP_TAC std_ss [REAL_NEG_NEG, dist] THEN
3290         REWRITE_TAC [ABS_REFL, GSYM real_div] THEN
3291         ASM_SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_MUL_LZERO] THEN
3292         ASM_REAL_ARITH_TAC], ALL_TAC] THEN FULL_SIMP_TAC std_ss [dist] THEN
3293         ASM_REAL_ARITH_TAC, ALL_TAC] THEN
3294    STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN
3295    SIMP_TAC std_ss [REAL_ARITH ``a - ((&1 - u) * a + u * b) = u * (a - b:real)``,
3296                REAL_ARITH ``((&1 - u) * a + u * b) - b = (&1 - u) * (a - b:real)``,
3297                ABS_MUL, GSYM REAL_ADD_RDISTRIB] THEN
3298        FULL_SIMP_TAC std_ss [REAL_ARITH ``u <= 1 <=> 0 <= 1 - u:real``, GSYM ABS_REFL] THEN
3299        REAL_ARITH_TAC
3300QED
3301
3302Theorem REAL_CONVEX_BOUND_LE:
3303   !x y a u v. x <= a /\ y <= a /\ &0 <= u /\ &0 <= v /\ (u + v = &1:real)
3304   ==> u * x + v * y <= a:real
3305Proof
3306  REPEAT STRIP_TAC THEN
3307  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``(u + v) * a:real`` THEN
3308  CONJ_TAC THENL [ALL_TAC, ASM_SIMP_TAC std_ss [REAL_LE_REFL, REAL_MUL_LID]] THEN
3309  ASM_SIMP_TAC std_ss [REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
3310  UNDISCH_TAC ``0 <= v:real`` THEN GEN_REWR_TAC LAND_CONV [REAL_LE_LT] THEN
3311  STRIP_TAC THEN UNDISCH_TAC ``0 <= u:real`` THEN
3312  GEN_REWR_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THEN
3313  ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
3314  POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN DISCH_TAC THEN
3315  DISCH_TAC THEN ASM_REWRITE_TAC [REAL_LE_LT, REAL_MUL_LZERO]
3316QED
3317
3318Theorem IN_SEGMENT_COMPONENT:
3319   !a b x:real i. x IN segment[a,b]
3320        ==> min (a) (b) <= x /\ x <= max (a) (b)
3321Proof
3322  REPEAT STRIP_TAC THEN
3323  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_SEGMENT]) THEN
3324  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
3325  FIRST_X_ASSUM(X_CHOOSE_THEN ``t:real`` STRIP_ASSUME_TAC) THEN
3326  ASM_REWRITE_TAC [] THEN
3327  SIMP_TAC std_ss [REAL_ARITH ``c <= u * a + t * b <=> u * -a + t * -b <= -c:real``] THEN
3328  MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN
3329  RW_TAC real_ss [] THEN
3330  ASM_REAL_ARITH_TAC
3331QED
3332
3333Theorem SEGMENT_TRANSLATION:
3334   (!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\
3335   (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))
3336Proof
3337  SIMP_TAC std_ss [EXTENSION, IN_SEGMENT, IN_IMAGE] THEN
3338  SIMP_TAC std_ss [REAL_ARITH ``(&1 - u) * (c + a) + u * (c + b) =
3339                            c + (&1 - u) * a + u * b:real``] THEN
3340  SIMP_TAC std_ss [REAL_ARITH ``(c + a:real = c + b) <=> (a = b)``] THEN
3341  CONJ_TAC THEN
3342  (REPEAT GEN_TAC THEN EQ_TAC THENL
3343   [REPEAT STRIP_TAC THEN EXISTS_TAC ``(1 - u) * a + u * b:real`` THEN
3344    ASM_SIMP_TAC std_ss [REAL_ADD_ASSOC] THEN EXISTS_TAC ``u:real`` THEN
3345        ASM_SIMP_TAC std_ss [],
3346        REPEAT STRIP_TAC THEN EXISTS_TAC ``u:real`` THEN
3347        ASM_SIMP_TAC std_ss [REAL_ADD_ASSOC]])
3348QED
3349
3350Theorem CLOSED_SEGMENT_LINEAR_IMAGE:
3351   !f a b. linear f
3352           ==> (segment[f a,f b] = IMAGE f (segment[a,b]))
3353Proof
3354  REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION, IN_IMAGE, IN_SEGMENT] THEN
3355  FIRST_ASSUM(fn th => REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
3356  FIRST_ASSUM(fn th => REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN
3357  MESON_TAC[]
3358QED
3359
3360Theorem OPEN_SEGMENT_LINEAR_IMAGE:
3361   !f:real->real a b.
3362        linear f /\ (!x y. (f x = f y) ==> (x = y))
3363        ==> (segment(f a,f b) = IMAGE f (segment(a,b)))
3364Proof
3365  REWRITE_TAC[open_segment, closed_segment, FST, SND, HD] THEN
3366  SIMP_TAC std_ss [linear, IN_IMAGE, dist, EXTENSION, GSPECIFICATION, IN_DIFF] THEN
3367  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
3368  [EXISTS_TAC ``(1 - u) * a + u * b:real`` THEN
3369   CONJ_TAC THENL [METIS_TAC [], ALL_TAC] THEN
3370   CONJ_TAC THENL [EXISTS_TAC ``u:real`` THEN ASM_REWRITE_TAC [], ALL_TAC] THEN
3371   ASM_SET_TAC [],
3372   CONJ_TAC THENL [EXISTS_TAC ``u:real`` THEN METIS_TAC [], ALL_TAC] THEN
3373   ASM_SET_TAC []]
3374QED
3375
3376Theorem IN_OPEN_SEGMENT:
3377   !a b x:real.
3378        x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)
3379Proof
3380  REPEAT GEN_TAC THEN REWRITE_TAC[open_segment, IN_DIFF] THEN SET_TAC[]
3381QED
3382
3383Theorem IN_OPEN_SEGMENT_ALT:
3384   !a b x:real.
3385        x IN segment(a,b) <=>
3386        x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)
3387Proof
3388  REPEAT GEN_TAC THEN ASM_CASES_TAC ``a:real = b`` THEN
3389  ASM_REWRITE_TAC[SEGMENT_REFL, IN_SING, NOT_IN_EMPTY] THEN
3390  ASM_MESON_TAC[IN_OPEN_SEGMENT]
3391QED
3392
3393Theorem COLLINEAR_DIST_IN_CLOSED_SEGMENT:
3394   !a b x. collinear {x;a;b} /\
3395           dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
3396           ==> x IN segment[a,b]
3397Proof
3398  REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT, COLLINEAR_DIST_BETWEEN]
3399QED
3400
3401Theorem COLLINEAR_DIST_IN_OPEN_SEGMENT:
3402   !a b x. collinear {x;a;b} /\
3403           dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b)
3404           ==> x IN segment(a,b)
3405Proof
3406  REWRITE_TAC[IN_OPEN_SEGMENT] THEN
3407  METIS_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT, REAL_LT_LE, DIST_SYM]
3408QED
3409
3410Theorem DIST_IN_OPEN_CLOSED_SEGMENT:
3411   (!a b x:real.
3412    x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\
3413   (!a b x:real.
3414    x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))
3415Proof
3416  SIMP_TAC std_ss [IN_SEGMENT, GSYM RIGHT_EXISTS_AND_THM, LEFT_IMP_EXISTS_THM, dist,
3417           REAL_ARITH
3418    ``(((&1 - u) * a + u * b) - a:real = u * (b - a)) /\
3419      (((&1 - u) * a + u * b) - b = -(&1 - u) * (b - a))``] THEN
3420  REWRITE_TAC[ABS_MUL, ABS_NEG] THEN ONCE_REWRITE_TAC [ABS_SUB] THEN CONJ_TAC THEN
3421  REPEAT GEN_TAC THEN STRIP_TAC THENL
3422   [ONCE_REWRITE_TAC [REAL_ARITH
3423     ``x * y <= abs (b - a) <=> x * y <= abs (a - b:real)``] THEN
3424    REWRITE_TAC[REAL_ARITH ``x * y <= y <=> x * y <= &1 * y:real``] THEN
3425    CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
3426    REWRITE_TAC[ABS_POS] THEN ASM_REAL_ARITH_TAC,
3427    ONCE_REWRITE_TAC [REAL_ARITH
3428     ``x * y < abs (b - a) <=> x * y < abs (a - b:real)``] THEN
3429    REWRITE_TAC[REAL_ARITH ``x * y < y <=> x * y < &1 * y:real``] THEN
3430    CONJ_TAC THEN MATCH_MP_TAC REAL_LT_RMUL_IMP THEN
3431    ASM_REAL_ARITH_TAC]
3432QED
3433
3434Theorem DIST_IN_CLOSED_SEGMENT:
3435    (!a b x:real.
3436    x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b))
3437Proof
3438  REWRITE_TAC [DIST_IN_OPEN_CLOSED_SEGMENT]
3439QED
3440
3441Theorem DIST_IN_OPEN_SEGMENT:
3442    (!a b x:real.
3443    x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))
3444Proof
3445  REWRITE_TAC [DIST_IN_OPEN_CLOSED_SEGMENT]
3446QED
3447
3448(* ------------------------------------------------------------------------- *)
3449(* Connectedness.                                                            *)
3450(* ------------------------------------------------------------------------- *)
3451
3452Definition connected[nocompute]:
3453  connected s <=>
3454      ~(?e1 e2. open e1 /\ open e2 /\ s SUBSET (e1 UNION e2) /\
3455                (e1 INTER e2 INTER s = {}) /\
3456                ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))
3457End
3458
3459Theorem CONNECTED_CLOSED:
3460   !s:real->bool.
3461        connected s <=>
3462        ~(?e1 e2. closed e1 /\ closed e2 /\ s SUBSET (e1 UNION e2) /\
3463                  (e1 INTER e2 INTER s = {}) /\
3464                  ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))
3465Proof
3466  GEN_TAC THEN REWRITE_TAC[connected] THEN AP_TERM_TAC THEN
3467  EQ_TAC THEN STRIP_TAC THEN
3468  MAP_EVERY EXISTS_TAC [``univ(:real) DIFF e1``, ``univ(:real) DIFF e2``] THEN
3469  ASM_REWRITE_TAC[GSYM closed_def, GSYM OPEN_CLOSED] THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
3470QED
3471
3472Theorem CONNECTED_OPEN_IN:
3473   !s. connected s <=>
3474           ~(?e1 e2.
3475                 open_in (subtopology euclidean s) e1 /\
3476                 open_in (subtopology euclidean s) e2 /\
3477                 s SUBSET e1 UNION e2 /\
3478                 (e1 INTER e2 = {}) /\
3479                 ~(e1 = {}) /\
3480                 ~(e2 = {}))
3481Proof
3482  GEN_TAC THEN REWRITE_TAC[connected, OPEN_IN_OPEN] THEN
3483  SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN
3484  REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]
3485QED
3486
3487Theorem CONNECTED_OPEN_IN_EQ:
3488   !s. connected s <=>
3489           ~(?e1 e2.
3490                 open_in (subtopology euclidean s) e1 /\
3491                 open_in (subtopology euclidean s) e2 /\
3492                 (e1 UNION e2 = s) /\ (e1 INTER e2 = {}) /\
3493                 ~(e1 = {}) /\ ~(e2 = {}))
3494Proof
3495  GEN_TAC THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN
3496  AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
3497  EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
3498  RULE_ASSUM_TAC(REWRITE_RULE[OPEN_IN_CLOSED_IN_EQ,
3499   TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THEN
3500  REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
3501QED
3502
3503Theorem CONNECTED_CLOSED_IN:
3504   !s. connected s <=>
3505           ~(?e1 e2.
3506                 closed_in (subtopology euclidean s) e1 /\
3507                 closed_in (subtopology euclidean s) e2 /\
3508                 s SUBSET e1 UNION e2 /\
3509                 (e1 INTER e2 = {}) /\
3510                 ~(e1 = {}) /\
3511                 ~(e2 = {}))
3512Proof
3513  GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOSED, CLOSED_IN_CLOSED] THEN
3514  SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN
3515  REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]
3516QED
3517
3518Theorem CONNECTED_CLOSED_IN_EQ:
3519   !s. connected s <=>
3520           ~(?e1 e2.
3521                 closed_in (subtopology euclidean s) e1 /\
3522                 closed_in (subtopology euclidean s) e2 /\
3523                 (e1 UNION e2 = s) /\ (e1 INTER e2 = {}) /\
3524                 ~(e1 = {}) /\ ~(e2 = {}))
3525Proof
3526  GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN] THEN
3527  AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
3528  EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
3529  RULE_ASSUM_TAC(REWRITE_RULE[closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THEN
3530  REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
3531QED
3532
3533Theorem EXISTS_DIFF:
3534   (?s:'a->bool. P(UNIV DIFF s)) <=> (?s. P s)
3535Proof
3536  MESON_TAC[prove(``UNIV DIFF (UNIV DIFF s) = s``,SET_TAC[])]
3537QED
3538
3539Theorem CONNECTED_CLOPEN:
3540   !s. connected s <=>
3541        !t. open_in (subtopology euclidean s) t /\
3542            closed_in (subtopology euclidean s) t ==> (t = {}) \/ (t = s)
3543Proof
3544  GEN_TAC THEN REWRITE_TAC[connected, OPEN_IN_OPEN, CLOSED_IN_CLOSED] THEN
3545  REWRITE_TAC [METIS [GSYM EXISTS_DIFF] ``!e1. (?e2. open e2) <=>
3546                              ?e2. open (univ(:real) DIFF e2)``] THEN
3547  KNOW_TAC ``(?e1 e2. open e1 /\ open e2 /\ s SUBSET e1 UNION e2 /\
3548        (e1 INTER e2 INTER s = {}) /\ e1 INTER s <> {} /\
3549        e2 INTER s <> {}) <=>
3550             (?e1 e2. open e1 /\ open (univ(:real) DIFF e2) /\
3551                    s SUBSET e1 UNION (univ(:real) DIFF e2) /\
3552        (e1 INTER (univ(:real) DIFF e2) INTER s = {}) /\ e1 INTER s <> {} /\
3553        (univ(:real) DIFF e2) INTER s <> {})`` THENL
3554  [EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC ``e1:real->bool`` THEN
3555   ASM_SIMP_TAC std_ss [EXISTS_DIFF] THEN METIS_TAC [],
3556   METIS_TAC [GSYM EXISTS_DIFF]], ALL_TAC] THEN DISC_RW_KILL THEN
3557  ONCE_REWRITE_TAC[TAUT `(~a <=> b) <=> (a <=> ~b)`] THEN
3558  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, GSYM CONJ_ASSOC, DE_MORGAN_THM] THEN
3559  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> b /\ a /\ c /\ d`] THEN
3560  KNOW_TAC ``(?t. (?t'. closed t' /\ (t = s INTER t')) /\
3561      (?t'. open t' /\ (t = s INTER t')) /\ t <> {} /\ t <> s) <=>
3562             (?t t'. (closed t' /\ (t = s INTER t')) /\
3563      (?t'. open t' /\ (t = s INTER t')) /\ t <> {} /\ t <> s)`` THENL
3564  [SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM], ALL_TAC] THEN DISC_RW_KILL THEN
3565  REWRITE_TAC [GSYM closed_def] THEN
3566  KNOW_TAC ``((?e1 e2. closed e2 /\ open e1 /\ s SUBSET e1 UNION (univ(:real) DIFF e2) /\
3567       (e1 INTER (univ(:real) DIFF e2) INTER s = {}) /\ e1 INTER s <> {} /\
3568       (univ(:real) DIFF e2) INTER s <> {}) <=> ?t t'. (closed t' /\ (t = s INTER t')) /\
3569      (?t'. open t' /\ (t = s INTER t')) /\ t <> {} /\ t <> s) <=>
3570            ((?e2 e1. closed e2 /\ open e1 /\ s SUBSET e1 UNION (univ(:real) DIFF e2) /\
3571       (e1 INTER (univ(:real) DIFF e2) INTER s = {}) /\ e1 INTER s <> {} /\
3572       (univ(:real) DIFF e2) INTER s <> {}) <=> ?t' t. (closed t' /\ (t = s INTER t')) /\
3573      (?t'. open t' /\ (t = s INTER t')) /\ t <> {} /\ t <> s)`` THENL
3574  [METIS_TAC [], ALL_TAC] THEN DISC_RW_KILL THEN AP_TERM_TAC THEN ABS_TAC THEN
3575  KNOW_TAC ``(?t. (closed e2 /\ (t = s INTER e2)) /\
3576      (?t'. open t' /\ (t = s INTER t')) /\ t <> {} /\ t <> s) <=>
3577             (?t' t.(closed e2 /\ (t = s INTER e2)) /\
3578      (open t' /\ (t = s INTER t')) /\ t <> {} /\ t <> s)`` THENL
3579  [METIS_TAC [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM], ALL_TAC] THEN
3580  DISC_RW_KILL THEN AP_TERM_TAC THEN ABS_TAC THEN
3581  REWRITE_TAC[TAUT `(a /\ b) /\ (c /\ d) /\ e <=> a /\ c /\ b /\ d /\ e`] THEN
3582  SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM, UNWIND_THM2] THEN
3583  AP_TERM_TAC THEN AP_TERM_TAC THEN SET_TAC[]
3584QED
3585
3586Theorem CONNECTED_CLOSED_SET:
3587   !s:real->bool.
3588        closed s
3589        ==> (connected s <=>
3590             ~(?e1 e2. closed e1 /\ closed e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\
3591                       (e1 UNION e2 = s) /\ (e1 INTER e2 = {})))
3592Proof
3593  REPEAT STRIP_TAC THEN EQ_TAC THENL
3594   [REWRITE_TAC [CONNECTED_CLOSED, GSYM MONO_NOT_EQ] THEN
3595    STRIP_TAC THEN EXISTS_TAC ``e1:real->bool`` THEN
3596    EXISTS_TAC ``e2:real->bool`` THEN REPEAT (POP_ASSUM MP_TAC) THEN
3597    REWRITE_TAC [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
3598    SIMP_TAC std_ss [] THEN SET_TAC[],
3599    REWRITE_TAC [CONNECTED_CLOSED_IN, GSYM MONO_NOT_EQ] THEN
3600    SIMP_TAC std_ss [PULL_EXISTS] THEN
3601    SIMP_TAC std_ss [CLOSED_IN_CLOSED, LEFT_IMP_EXISTS_THM, GSYM AND_IMP_INTRO] THEN
3602    SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
3603    REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
3604    MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
3605    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
3606     [``s INTER u:real->bool``, ``s INTER v:real->bool``] THEN
3607    ASM_SIMP_TAC std_ss [CLOSED_INTER] THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]]
3608QED
3609
3610Theorem CONNECTED_OPEN_SET:
3611   !s:real->bool.
3612        open s
3613        ==> (connected s <=>
3614             ~(?e1 e2. open e1 /\ open e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\
3615                       (e1 UNION e2 = s) /\ (e1 INTER e2 = {})))
3616Proof
3617  REPEAT STRIP_TAC THEN EQ_TAC THENL
3618   [REWRITE_TAC[connected, GSYM MONO_NOT_EQ] THEN
3619    STRIP_TAC THEN EXISTS_TAC ``e1:real->bool`` THEN
3620    EXISTS_TAC ``e2:real->bool`` THEN REPEAT (POP_ASSUM MP_TAC) THEN
3621    REWRITE_TAC [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
3622    SIMP_TAC std_ss [] THEN SET_TAC[],
3623    REWRITE_TAC [CONNECTED_OPEN_IN, GSYM MONO_NOT_EQ] THEN
3624    SIMP_TAC std_ss [PULL_EXISTS] THEN
3625    SIMP_TAC std_ss [OPEN_IN_OPEN, LEFT_IMP_EXISTS_THM, GSYM AND_IMP_INTRO] THEN
3626    SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
3627    REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
3628    MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
3629    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
3630     [``s INTER u:real->bool``, ``s INTER v:real->bool``] THEN
3631    ASM_SIMP_TAC std_ss [OPEN_INTER] THEN REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]]
3632QED
3633
3634Theorem CONNECTED_IFF_CONNECTABLE_POINTS :
3635   !(s:real->bool).
3636        connected s <=>
3637        !a b. a IN s /\ b IN s
3638              ==> ?t. connected t /\ t SUBSET s /\ a IN t /\ b IN t
3639Proof
3640  GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_REFL], DISCH_TAC] THEN
3641  SIMP_TAC std_ss' [connected, NOT_EXISTS_THM] THEN
3642  MAP_EVERY X_GEN_TAC [``e1:real->bool``, ``e2:real->bool``] THEN
3643  REWRITE_TAC [METIS [DE_MORGAN_THM]
3644                    ``~a \/ ~b \/ ~c \/ (d <> e) \/ (f = g) \/ (h = i) <=>
3645                      ~(a /\ b /\ c /\ (d = e) /\ (f <> g) /\ (h <> i))``] THEN
3646  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3647  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3648  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3649  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3650  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY, IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2
3651   (X_CHOOSE_TAC ``a:real``) (X_CHOOSE_TAC ``b:real``)) THEN
3652  FIRST_X_ASSUM(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
3653  ASM_REWRITE_TAC[connected] THEN
3654  DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
3655  REWRITE_TAC[] THEN
3656  MAP_EVERY EXISTS_TAC [``e1:real->bool``, ``e2:real->bool``] THEN
3657  ASM_SET_TAC[]
3658QED
3659
3660Theorem CONNECTED_EMPTY:
3661   connected {}
3662Proof
3663  REWRITE_TAC[connected, INTER_EMPTY]
3664QED
3665
3666Theorem CONNECTED_SING:
3667   !a. connected{a}
3668Proof
3669  REWRITE_TAC[connected] THEN SET_TAC[]
3670QED
3671
3672Theorem CONNECTED_REAL_LEMMA:
3673   !f:real->real a b e1 e2.
3674        a <= b /\ f(a) IN e1 /\ f(b) IN e2 /\
3675        (!e x. a <= x /\ x <= b /\ &0 < e
3676               ==> ?d. &0 < d /\
3677                       !y. abs(y - x) < d ==> dist(f(y),f(x)) < e) /\
3678        (!y. y IN e1 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e1) /\
3679        (!y. y IN e2 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e2) /\
3680        ~(?x. a <= x /\ x <= b /\ f(x) IN e1 /\ f(x) IN e2)
3681        ==> ?x. a <= x /\ x <= b /\ ~(f(x) IN e1) /\ ~(f(x) IN e2)
3682Proof
3683  REWRITE_TAC[EXTENSION, NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
3684  MP_TAC(SPEC ``\c. !x:real. a <= x /\ x <= c ==> (f(x):real) IN e1``
3685              REAL_COMPLETE) THEN
3686  SIMP_TAC std_ss [] THEN
3687  KNOW_TAC ``(?x:real. !x'. a <= x' /\ x' <= x ==> (f x'):real IN e1) /\
3688     (?M. !x. (!x'. a <= x' /\ x' <= x ==> f x' IN e1) ==> x <= M)`` THENL
3689  [METIS_TAC[REAL_LT_IMP_LE, REAL_LE_TOTAL, REAL_LE_ANTISYM],
3690   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
3691  DISCH_THEN (X_CHOOSE_TAC ``x:real``) THEN EXISTS_TAC ``x:real`` THEN
3692  POP_ASSUM MP_TAC THEN STRIP_TAC THEN
3693  SUBGOAL_THEN ``a <= x /\ x <= b:real`` STRIP_ASSUME_TAC THENL
3694  [METIS_TAC[REAL_LT_IMP_LE, REAL_LE_TOTAL, REAL_LE_ANTISYM], ALL_TAC] THEN
3695  ASM_REWRITE_TAC[] THEN
3696  SUBGOAL_THEN ``!z:real. a <= z /\ z < x ==> (f(z):real) IN e1`` ASSUME_TAC THENL
3697   [METIS_TAC[REAL_NOT_LT, REAL_LT_IMP_LE], ALL_TAC] THEN
3698  REPEAT STRIP_TAC THENL
3699   [SUBGOAL_THEN
3700     ``?d:real. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real) IN e1``
3701    STRIP_ASSUME_TAC THENL [METIS_TAC[], ALL_TAC] THEN
3702    METIS_TAC[REAL_ARITH ``z <= x + e /\ e < d ==> z < x \/ abs(z - x) < d:real``,
3703                  REAL_ARITH ``&0 < e ==> ~(x + e <= x:real)``, REAL_DOWN],
3704    SUBGOAL_THEN
3705     ``?d:real. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real) IN e2``
3706    STRIP_ASSUME_TAC THENL [METIS_TAC[], ALL_TAC] THEN
3707    MP_TAC(SPECL [``x - a:real``, ``d:real``] REAL_DOWN2) THEN
3708    KNOW_TAC ``0 < x - a:real /\ 0 < d:real`` THENL
3709     [METIS_TAC[REAL_LT_LE, REAL_SUB_LT], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
3710    METIS_TAC[REAL_ARITH ``e < x - a ==> a <= x - e:real``,
3711                  REAL_ARITH ``&0 < e /\ x <= b ==> x - e <= b:real``,
3712      REAL_ARITH ``&0 < e /\ e < d ==> x - e < x /\ abs((x - e) - x) < d:real``]]
3713QED
3714
3715Theorem CONNECTED_SEGMENT :
3716   (!a b:real. connected(segment[a,b])) /\
3717   (!a b:real. connected(segment(a,b)))
3718Proof
3719  CONJ_TAC THEN REPEAT GEN_TAC THENL
3720 [ (* goal 1 (of 2): connected(segment[a,b]) *)
3721  ASM_CASES_TAC ``b:real = a`` THEN
3722  ASM_SIMP_TAC std_ss [SEGMENT_REFL, CONNECTED_EMPTY, CONNECTED_SING] THEN
3723  ASM_SIMP_TAC std_ss' [connected, OPEN_SEGMENT_ALT, CONJUNCT1 segment,
3724               NOT_EXISTS_THM] THEN
3725  REWRITE_TAC [METIS [DE_MORGAN_THM]
3726   ``~a \/ ~b \/ ~c \/ (d <> e) \/ (f = g) \/ (h = i) <=>
3727     ~(a /\ b /\ c /\ (d = e) /\ (f <> g) /\ (h <> i))`` ] THEN
3728  MAP_EVERY X_GEN_TAC [``e1:real->bool``, ``e2:real->bool``] THEN
3729  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3730  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
3731  PURE_ONCE_REWRITE_TAC[INTER_COMM] THEN
3732  PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC [IN_INTER] THEN
3733  DISCH_TAC THEN DISCH_TAC THEN
3734  POP_ASSUM (MP_TAC o SIMP_RULE std_ss [EXISTS_IN_GSPEC]) THEN
3735  POP_ASSUM (MP_TAC o SIMP_RULE std_ss [EXISTS_IN_GSPEC]) THEN
3736  REWRITE_TAC [GSYM CONJ_ASSOC] THEN
3737  SIMP_TAC std_ss [NOT_EXISTS_THM, LEFT_IMP_EXISTS_THM] THEN
3738  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN
3739  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
3740  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
3741  MAP_EVERY (fn t => SPEC_TAC(t,t))
3742   [``e2:real->bool``, ``e1:real->bool``, ``v:real``, ``u:real``] THEN
3743  KNOW_TAC ``!(u :real) (v :real). (\u v. !(e1 :real -> bool) (e2 :real -> bool).
3744      (e1 INTER e2 INTER
3745       {((1 :real) - u) * (a :real) + u * (b :real) |
3746        (0 :real) <= u /\ u <= (1 :real)} =
3747       ({} :real -> bool)) /\
3748      {((1 :real) - u) * a + u * b |
3749       (0 :real) <= u /\ u <= (1 :real)} SUBSET e1 UNION e2 /\
3750      (open e2 :bool) /\ (open e1 :bool) /\ b <> a ==>
3751      (0 :real) <= u /\ u <= (1 :real) /\
3752      ((1 :real) - u) * a + u * b IN e1 ==>
3753      ~((0 :real) <= v) \/ ~(v <= (1 :real)) \/
3754      ((1 :real) - v) * a + v * b NOTIN e2) u v`` THENL
3755  [ALL_TAC, METIS_TAC []] THEN
3756  MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
3757   [MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN BETA_TAC THEN
3758    GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
3759        [UNION_COMM, INTER_COMM] THEN
3760   KNOW_TAC ``(!(e1 :real -> bool) (e2 :real -> bool).
3761       (e1 INTER e2 INTER
3762        {((1 :real) - u) * (a :real) + u * (b :real) |
3763         (0 :real) <= u /\ u <= (1 :real)} =
3764        ({} :real -> bool)) /\
3765       {((1 :real) - u) * a + u * b |
3766        (0 :real) <= u /\ u <= (1 :real)} SUBSET e1 UNION e2 /\
3767       (open e2 :bool) /\ (open e1 :bool) /\ b <> a ==>
3768       (0 :real) <= (u :real) /\ u <= (1 :real) /\
3769       ((1 :real) - u) * a + u * b IN e1 ==>
3770       ~((0 :real) <= (v :real)) \/ ~(v <= (1 :real)) \/
3771       ((1 :real) - v) * a + v * b NOTIN e2) <=>
3772    !(e2 :real -> bool) (e1 :real -> bool).
3773      ({((1 :real) - u) * a + u * b |
3774        (0 :real) <= u /\ u <= (1 :real)} INTER (e1 INTER e2) =
3775       ({} :real -> bool)) /\
3776      {((1 :real) - u) * a + u * b |
3777       (0 :real) <= u /\ u <= (1 :real)} SUBSET e2 UNION e1 /\
3778      (open e2 :bool) /\ (open e1 :bool) /\ b <> a ==>
3779      (0 :real) <= v /\ v <= (1 :real) /\
3780      ((1 :real) - v) * a + v * b IN e1 ==>
3781      ~((0 :real) <= u) \/ ~(u <= (1 :real)) \/
3782      ((1 :real) - u) * a + u * b NOTIN e2`` THENL
3783        [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
3784    REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
3785    SIMP_TAC std_ss [UNION_ACI, INTER_ACI] THEN METIS_TAC[],
3786    ALL_TAC] THEN
3787  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
3788  SIMP_TAC std_ss [] THEN
3789  REPEAT STRIP_TAC THEN CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
3790  MP_TAC(ISPECL
3791   [``\u. (&1 - u) * a + u * b:real``, ``u:real``, ``v:real``,
3792    ``e1:real->bool``, ``e2:real->bool``]
3793    CONNECTED_REAL_LEMMA) THEN BETA_TAC THEN
3794  ASM_REWRITE_TAC [GSYM open_def, REAL_POS, NOT_IMP] THEN
3795  REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
3796   [MAP_EVERY X_GEN_TAC [``e:real``, ``x:real``] THEN STRIP_TAC THEN
3797    EXISTS_TAC ``e / dist(a:real,b)`` THEN
3798    ASM_SIMP_TAC std_ss [REAL_LT_DIV, GSYM DIST_NZ] THEN
3799    GEN_TAC THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN
3800    ASM_SIMP_TAC std_ss [ABS_MUL, GSYM REAL_LT_RDIV_EQ, GSYM ABS_NZ, REAL_SUB_0,
3801                 ABS_NEG, REAL_ARITH
3802     ``((&1 - y') * a + y' * b) - ((&1 - x') * a + x' * b):real =
3803       -((y' - x') * (a - b))``],
3804    RULE_ASSUM_TAC(SIMP_RULE std_ss [EXTENSION, IN_INTER, GSPECIFICATION,
3805                                SUBSET_DEF, IN_UNION, NOT_IN_EMPTY]) THEN
3806    METIS_TAC[REAL_LE_TRANS, REAL_LET_TRANS, REAL_LTE_TRANS]],
3807
3808  (* goal 2 (of 2): connected(segment(a,b)) *)
3809  ASM_CASES_TAC ``b:real = a`` THEN
3810  ASM_SIMP_TAC std_ss [SEGMENT_REFL, CONNECTED_EMPTY, CONNECTED_SING] THEN
3811  ASM_SIMP_TAC std_ss' [connected, OPEN_SEGMENT_ALT, CONJUNCT1 segment,
3812               NOT_EXISTS_THM] THEN
3813  REWRITE_TAC [METIS [DE_MORGAN_THM]
3814   ``~a \/ ~b \/ ~c \/ (d <> e) \/ (f = g) \/ (h = i) <=>
3815     ~(a /\ b /\ c /\ (d = e) /\ (f <> g) /\ (h <> i))`` ] THEN
3816  MAP_EVERY X_GEN_TAC [``e1:real->bool``, ``e2:real->bool``] THEN
3817  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3818  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
3819  PURE_ONCE_REWRITE_TAC[INTER_COMM] THEN
3820  PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC [IN_INTER] THEN
3821  DISCH_TAC THEN DISCH_TAC THEN
3822  POP_ASSUM (MP_TAC o SIMP_RULE std_ss [EXISTS_IN_GSPEC]) THEN
3823  POP_ASSUM (MP_TAC o SIMP_RULE std_ss [EXISTS_IN_GSPEC]) THEN
3824  REWRITE_TAC [GSYM CONJ_ASSOC] THEN
3825  SIMP_TAC std_ss [NOT_EXISTS_THM, LEFT_IMP_EXISTS_THM] THEN
3826  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN
3827  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
3828  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
3829  MAP_EVERY (fn t => SPEC_TAC(t,t))
3830   [``e2:real->bool``, ``e1:real->bool``, ``v:real``, ``u:real``] THEN
3831  KNOW_TAC ``!(u :real) (v :real). (\u v. !(e1 :real -> bool) (e2 :real -> bool).
3832      (e1 INTER e2 INTER
3833       {((1 :real) - u) * (a :real) + u * (b :real) |
3834        (0 :real) < u /\ u < (1 :real)} =
3835       ({} :real -> bool)) /\
3836      {((1 :real) - u) * a + u * b | (0 :real) < u /\ u < (1 :real)} SUBSET
3837      e1 UNION e2 /\ (open e2 :bool) /\ (open e1 :bool) /\ b <> a ==>
3838      (0 :real) < u /\ u < (1 :real) /\
3839      ((1 :real) - u) * a + u * b IN e1 ==>
3840      ~((0 :real) < v) \/ ~(v < (1 :real)) \/
3841      ((1 :real) - v) * a + v * b NOTIN e2) u v`` THENL
3842  [ALL_TAC, METIS_TAC []] THEN
3843  MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
3844   [MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN BETA_TAC THEN
3845    GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
3846        [UNION_COMM, INTER_COMM] THEN
3847   KNOW_TAC `` (!(e1 :real -> bool) (e2 :real -> bool).
3848       (e1 INTER e2 INTER
3849        {((1 :real) - u) * (a :real) + u * (b :real) |
3850         (0 :real) < u /\ u < (1 :real)} =
3851        ({} :real -> bool)) /\
3852       {((1 :real) - u) * a + u * b | (0 :real) < u /\ u < (1 :real)} SUBSET
3853       e1 UNION e2 /\ (open e2 :bool) /\ (open e1 :bool) /\ b <> a ==>
3854       (0 :real) < (u :real) /\ u < (1 :real) /\
3855       ((1 :real) - u) * a + u * b IN e1 ==>
3856       ~((0 :real) < (v :real)) \/ ~(v < (1 :real)) \/
3857       ((1 :real) - v) * a + v * b NOTIN e2) <=>
3858    !(e2 :real -> bool) (e1 :real -> bool).
3859      ({((1 :real) - u) * a + u * b | (0 :real) < u /\ u < (1 :real)} INTER
3860       (e1 INTER e2) =
3861       ({} :real -> bool)) /\
3862      {((1 :real) - u) * a + u * b | (0 :real) < u /\ u < (1 :real)} SUBSET
3863      e2 UNION e1 /\ (open e2 :bool) /\ (open e1 :bool) /\ b <> a ==>
3864      (0 :real) < v /\ v < (1 :real) /\
3865      ((1 :real) - v) * a + v * b IN e1 ==>
3866      ~((0 :real) < u) \/ ~(u < (1 :real)) \/
3867      ((1 :real) - u) * a + u * b NOTIN e2`` THENL
3868        [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
3869    REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
3870    SIMP_TAC std_ss [UNION_ACI, INTER_ACI] THEN METIS_TAC[],
3871    ALL_TAC] THEN
3872  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
3873  SIMP_TAC std_ss [] THEN
3874  REPEAT STRIP_TAC THEN CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
3875  MP_TAC(ISPECL
3876   [``\u. (&1 - u) * a + u * b:real``, ``u:real``, ``v:real``,
3877    ``e1:real->bool``, ``e2:real->bool``]
3878    CONNECTED_REAL_LEMMA) THEN BETA_TAC THEN
3879  ASM_REWRITE_TAC [GSYM open_def, REAL_POS, NOT_IMP] THEN
3880  REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
3881   [MAP_EVERY X_GEN_TAC [``e:real``, ``x:real``] THEN STRIP_TAC THEN
3882    EXISTS_TAC ``e / dist(a:real,b)`` THEN
3883    ASM_SIMP_TAC std_ss [REAL_LT_DIV, GSYM DIST_NZ] THEN
3884    GEN_TAC THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN
3885    ASM_SIMP_TAC std_ss [ABS_MUL, GSYM REAL_LT_RDIV_EQ, GSYM ABS_NZ, REAL_SUB_0,
3886                 ABS_NEG, REAL_ARITH
3887     ``((&1 - y') * a + y' * b) - ((&1 - x') * a + x' * b):real =
3888       -((y' - x') * (a - b))``],
3889    RULE_ASSUM_TAC(SIMP_RULE std_ss [EXTENSION, IN_INTER, GSPECIFICATION,
3890                                SUBSET_DEF, IN_UNION, NOT_IN_EMPTY]) THEN
3891    METIS_TAC[REAL_LE_TRANS, REAL_LET_TRANS, REAL_LTE_TRANS]] ]
3892QED
3893
3894Theorem CONNECTED_UNIV:
3895   connected univ(:real)
3896Proof
3897  ONCE_REWRITE_TAC[CONNECTED_IFF_CONNECTABLE_POINTS] THEN
3898  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
3899  REWRITE_TAC[IN_UNIV, SUBSET_UNIV] THEN
3900  EXISTS_TAC ``segment[a:real,b]`` THEN
3901  ASM_SIMP_TAC std_ss [CONNECTED_SEGMENT, ENDS_IN_SEGMENT]
3902QED
3903
3904Theorem CLOPEN:
3905   !s. closed s /\ open s <=> (s = {}) \/ (s = univ(:real))
3906Proof
3907  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
3908  ASM_REWRITE_TAC[CLOSED_EMPTY, OPEN_EMPTY, CLOSED_UNIV, OPEN_UNIV] THEN
3909  MATCH_MP_TAC(REWRITE_RULE[CONNECTED_CLOPEN] CONNECTED_UNIV) THEN
3910  ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV, GSYM OPEN_IN, GSYM CLOSED_IN]
3911QED
3912
3913Theorem CONNECTED_BIGUNION:
3914   !P:(real->bool)->bool.
3915        (!s. s IN P ==> connected s) /\ ~(BIGINTER P = {})
3916        ==> connected(BIGUNION P)
3917Proof
3918  GEN_TAC THEN REWRITE_TAC[connected] THEN STRIP_TAC THEN
3919  CCONTR_TAC THEN POP_ASSUM (MP_TAC o REWRITE_RULE [REAL_NEG_NEG]) THEN
3920  STRIP_TAC THEN UNDISCH_TAC ``~(BIGINTER P :real->bool = {})`` THEN
3921  PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY, IN_BIGINTER] THEN
3922  DISCH_THEN(X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
3923  SUBGOAL_THEN ``(a:real) IN e1 \/ a IN e2`` STRIP_ASSUME_TAC THENL
3924   [ASM_SET_TAC[],
3925    UNDISCH_TAC ``~(e2 INTER BIGUNION P:real->bool = {})``,
3926    UNDISCH_TAC ``~(e1 INTER BIGUNION P:real->bool = {})``] THEN
3927  PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY, IN_INTER, IN_BIGUNION] THEN
3928  DISCH_THEN(X_CHOOSE_THEN ``b:real``
3929   (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3930  DISCH_THEN(X_CHOOSE_THEN ``s:real->bool`` STRIP_ASSUME_TAC) THEN
3931  UNDISCH_TAC ``!t:real->bool. t IN P ==> a IN t`` THEN
3932  DISCH_THEN(MP_TAC o SPEC ``s:real->bool``) THEN
3933  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3934  FIRST_X_ASSUM(MP_TAC o SPEC ``s:real->bool``) THEN
3935  ASM_REWRITE_TAC[] THEN CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
3936  POP_ASSUM (MP_TAC o SPECL [``e1:real->bool``, ``e2:real->bool``]) THEN
3937  ASM_SET_TAC[]
3938QED
3939
3940Theorem CONNECTED_UNION:
3941   !s t:real->bool.
3942        connected s /\ connected t /\ ~(s INTER t = {})
3943        ==> connected (s UNION t)
3944Proof
3945  REWRITE_TAC[GSYM BIGUNION_2, GSYM BIGINTER_2] THEN
3946  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_BIGUNION THEN
3947  ASM_SET_TAC[]
3948QED
3949
3950val CONJ_ACI = simpLib.AC CONJ_ASSOC CONJ_COMM
3951val INTER_ACI = simpLib.AC INTER_ASSOC INTER_COMM
3952val UNION_ACI = simpLib.AC UNION_ASSOC UNION_COMM
3953
3954Theorem CONNECTED_DIFF_OPEN_FROM_CLOSED:
3955   !s t u:real->bool.
3956        s SUBSET t /\ t SUBSET u /\
3957        open s /\ closed t /\ connected u /\ connected(t DIFF s)
3958        ==> connected(u DIFF s)
3959Proof
3960  REPEAT STRIP_TAC >> SIMP_TAC std_ss [connected, NOT_EXISTS_THM] >>
3961  MAP_EVERY X_GEN_TAC [“v:real->bool”, “w:real->bool”] >>
3962  CCONTR_TAC >> FULL_SIMP_TAC std_ss [] >>
3963  UNDISCH_TAC “connected(t DIFF s:real->bool)” >> SIMP_TAC std_ss [connected] >>
3964  MAP_EVERY EXISTS_TAC [“v:real->bool”, “w:real->bool”] >>
3965  ASM_REWRITE_TAC[] >> CONJ_TAC >- ASM_SET_TAC [] >>
3966  CONJ_TAC >- ASM_SET_TAC [] >>
3967  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) >>
3968  MAP_EVERY (fn t => SPEC_TAC(t,t)) [“v:real->bool”, “w:real->bool”] >>
3969  KNOW_TAC “(!v:real->bool w:real->bool.
3970      ~(w INTER (u DIFF s) = {}) /\ ~(v INTER (u DIFF s) = {}) /\
3971      (v INTER w INTER (u DIFF s) = {}) /\ u DIFF s SUBSET v UNION w /\
3972      open w /\ open v /\ connected u /\ closed t /\ open s /\
3973      t SUBSET u /\ s SUBSET t
3974      ==> ~(v INTER (u DIFF s) = {}) /\ ~(w INTER (u DIFF s) = {}) /\
3975          (w INTER v INTER (u DIFF s) = {}) /\ u DIFF s SUBSET w UNION v /\
3976          open v /\ open w /\ connected u /\ closed t /\ open s /\
3977          t SUBSET u /\ s SUBSET t) /\
3978 (!w v. (~(w INTER (u DIFF s) = {}) /\ ~(v INTER (u DIFF s) = {}) /\
3979       (v INTER w INTER (u DIFF s) = {}) /\ u DIFF s SUBSET v UNION w /\
3980       open w /\ open v /\ connected u /\ closed t /\ open s /\
3981       t SUBSET u /\ s SUBSET t) /\ (w INTER (t DIFF s) = {})
3982      ==> F)”
3983  THENL [
3984    CONJ_TAC >- SIMP_TAC std_ss [CONJ_ACI, INTER_ACI, UNION_ACI] >>
3985    REPEAT STRIP_TAC >> UNDISCH_TAC “connected u” >>
3986    GEN_REWR_TAC LAND_CONV [connected] >> SIMP_TAC std_ss [] >>
3987    MAP_EVERY EXISTS_TAC [“v UNION s:real->bool”, “w DIFF t:real->bool”] >>
3988    ASM_SIMP_TAC std_ss [OPEN_UNION, OPEN_DIFF] >> ASM_SET_TAC[],
3989    METIS_TAC []
3990  ]
3991QED
3992
3993Theorem CONNECTED_DISJOINT_BIGUNION_OPEN_UNIQUE:
3994   !f:(real->bool)->bool f'.
3995         pairwise DISJOINT f /\ pairwise DISJOINT f' /\
3996        (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
3997        (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
3998        (BIGUNION f = BIGUNION f')
3999        ==> (f = f')
4000Proof
4001  GEN_REWR_TAC (funpow 2 BINDER_CONV o RAND_CONV) [EXTENSION] THEN
4002  KNOW_TAC ``(!f f'.
4003      pairwise DISJOINT f /\ pairwise DISJOINT f' /\
4004      (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
4005      (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
4006      (BIGUNION f = BIGUNION f')
4007      ==> pairwise DISJOINT f' /\ pairwise DISJOINT f /\
4008          (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
4009          (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
4010          (BIGUNION f' = BIGUNION f)) /\
4011 (!f f' x. (pairwise DISJOINT f /\ pairwise DISJOINT f' /\
4012       (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
4013       (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
4014       (BIGUNION f = BIGUNION f')) /\ x IN f ==> x IN f')`` THENL
4015  [ALL_TAC, METIS_TAC []] THEN
4016  CONJ_TAC THENL [MESON_TAC[], ALL_TAC] THEN
4017  GEN_TAC THEN GEN_TAC THEN X_GEN_TAC ``s:real->bool`` THEN STRIP_TAC THEN
4018  SUBGOAL_THEN
4019   ``?t a:real. t IN f' /\ a IN s /\ a IN t`` STRIP_ASSUME_TAC
4020  THENL [ASM_SET_TAC[], ALL_TAC] THEN
4021  SUBGOAL_THEN ``s:real->bool = t`` (fn th => ASM_REWRITE_TAC[th]) THEN
4022  REWRITE_TAC[EXTENSION] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
4023  MAP_EVERY (fn t => SPEC_TAC(t,t))
4024   [``s:real->bool``, ``t:real->bool``,
4025    ``f:(real->bool)->bool``, ``f':(real->bool)->bool``] THEN
4026  KNOW_TAC ``(!f f' s t.
4027      a IN t /\ a IN s /\ t IN f' /\ s IN f /\
4028      (BIGUNION f = BIGUNION f') /\
4029      (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
4030      (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
4031      pairwise DISJOINT f' /\ pairwise DISJOINT f
4032      ==> a IN s /\ a IN t /\ s IN f /\ t IN f' /\
4033          (BIGUNION f' = BIGUNION f) /\
4034          (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
4035          (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
4036          pairwise DISJOINT f /\ pairwise DISJOINT f') /\
4037 (!f f' s t x.
4038      (a IN t /\ a IN s /\ t IN f' /\ s IN f /\
4039       (BIGUNION f = BIGUNION f') /\
4040       (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
4041       (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
4042       pairwise DISJOINT f' /\ pairwise DISJOINT f) /\
4043      x IN s ==> x IN t)`` THENL
4044  [ALL_TAC, METIS_TAC []] THEN
4045  CONJ_TAC THENL [MESON_TAC[], ALL_TAC] THEN
4046  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
4047  X_GEN_TAC ``b:real`` THEN STRIP_TAC THEN
4048  UNDISCH_TAC
4049   ``!s:real->bool. s IN f ==> open s /\ connected s /\ ~(s = {})`` THEN
4050  DISCH_THEN(MP_TAC o SPEC ``s:real->bool``) THEN ASM_REWRITE_TAC[] THEN
4051  STRIP_TAC THEN ASM_CASES_TAC ``(b:real) IN t`` THEN
4052  ASM_REWRITE_TAC[] THEN
4053  UNDISCH_TAC ``connected(s:real->bool)`` THEN
4054  REWRITE_TAC[connected] THEN
4055  MAP_EVERY EXISTS_TAC
4056   [``t:real->bool``, ``BIGUNION(f' DELETE (t:real->bool))``] THEN
4057  REPEAT STRIP_TAC THENL
4058   [ASM_SIMP_TAC std_ss [],
4059    MATCH_MP_TAC OPEN_BIGUNION THEN ASM_SIMP_TAC std_ss [IN_DELETE],
4060    REWRITE_TAC[GSYM BIGUNION_INSERT] THEN ASM_SET_TAC[],
4061    MATCH_MP_TAC(SET_RULE ``(t INTER u = {}) ==> (t INTER u INTER s = {})``) THEN
4062    SIMP_TAC std_ss [INTER_BIGUNION, EMPTY_BIGUNION, FORALL_IN_GSPEC] THEN
4063    REWRITE_TAC [IN_DELETE, GSYM DISJOINT_DEF] THEN ASM_MESON_TAC[pairwise],
4064    ASM_SET_TAC[], ASM_SET_TAC[]]
4065QED
4066
4067Theorem CONNECTED_FROM_CLOSED_UNION_AND_INTER:
4068   !s t:real->bool.
4069        closed s /\ closed t /\ connected(s UNION t) /\ connected(s INTER t)
4070        ==> connected s /\ connected t
4071Proof
4072  KNOW_TAC ``(!s t. closed s /\ closed t /\
4073       connected (s UNION t) /\ connected (s INTER t)
4074      ==> closed t /\ closed s /\ connected (t UNION s) /\
4075          connected (t INTER s)) /\
4076 (!s t. closed s /\ closed t /\ connected (s UNION t) /\
4077        connected (s INTER t) ==> connected s)`` THENL
4078  [ALL_TAC, MESON_TAC []] THEN
4079  CONJ_TAC THENL [SIMP_TAC std_ss [UNION_COMM, INTER_COMM], REPEAT STRIP_TAC] THEN
4080  ASM_SIMP_TAC std_ss [CONNECTED_CLOSED_SET] THEN
4081  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
4082  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
4083  ASM_CASES_TAC
4084   ``~(s INTER t SUBSET (u:real->bool)) /\ ~(s INTER t SUBSET v)``
4085  THENL
4086   [UNDISCH_TAC ``connected(s INTER t:real->bool)`` THEN
4087    ASM_SIMP_TAC std_ss [CONNECTED_CLOSED] THEN
4088    MAP_EVERY EXISTS_TAC [``u:real->bool``, ``v:real->bool``] THEN
4089    ASM_REWRITE_TAC[] THEN ASM_SET_TAC [],
4090    POP_ASSUM (MP_TAC o REWRITE_RULE [DE_MORGAN_THM]) THEN
4091    STRIP_TAC THEN UNDISCH_TAC ``connected(s UNION t:real->bool)`` THEN
4092    ASM_SIMP_TAC std_ss [CONNECTED_CLOSED] THENL
4093     [MAP_EVERY EXISTS_TAC [``t UNION u:real->bool``, ``v:real->bool``] THEN
4094      ASM_SIMP_TAC std_ss [CLOSED_UNION] THEN ASM_SET_TAC[],
4095      MAP_EVERY EXISTS_TAC [``t UNION v:real->bool``, ``u:real->bool``] THEN
4096      ASM_SIMP_TAC std_ss [CLOSED_UNION] THEN ASM_SET_TAC[]]]
4097QED
4098
4099Theorem CONNECTED_FROM_OPEN_UNION_AND_INTER:
4100   !s t:real->bool.
4101        open s /\ open t /\ connected(s UNION t) /\ connected(s INTER t)
4102        ==> connected s /\ connected t
4103Proof
4104
4105  KNOW_TAC ``(!s t.
4106      open s /\ open t /\ connected (s UNION t) /\ connected (s INTER t)
4107      ==> open t /\ open s /\ connected (t UNION s) /\ connected (t INTER s)) /\
4108 (!s t.
4109      open s /\ open t /\ connected (s UNION t) /\ connected (s INTER t)
4110      ==> connected s)`` THENL
4111  [ALL_TAC, MESON_TAC []] THEN
4112  CONJ_TAC THENL [SIMP_TAC std_ss [UNION_COMM, INTER_COMM], REPEAT STRIP_TAC] THEN
4113  ASM_SIMP_TAC std_ss [CONNECTED_OPEN_SET] THEN
4114  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
4115  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN ASM_CASES_TAC
4116   ``~(s INTER t SUBSET (u:real->bool)) /\ ~(s INTER t SUBSET v)``
4117  THENL
4118   [UNDISCH_TAC ``connected(s INTER t:real->bool)`` THEN
4119    ASM_SIMP_TAC std_ss [connected] THEN
4120    MAP_EVERY EXISTS_TAC [``u:real->bool``, ``v:real->bool``] THEN
4121    ASM_REWRITE_TAC[] THEN ASM_SET_TAC[],
4122    POP_ASSUM (MP_TAC o REWRITE_RULE [DE_MORGAN_THM]) THEN
4123    STRIP_TAC THEN UNDISCH_TAC ``connected(s UNION t:real->bool)`` THEN
4124    ASM_SIMP_TAC std_ss [connected] THENL
4125     [MAP_EVERY EXISTS_TAC [``t UNION u:real->bool``, ``v:real->bool``] THEN
4126      ASM_SIMP_TAC std_ss [OPEN_UNION] THEN ASM_SET_TAC[],
4127      MAP_EVERY EXISTS_TAC [``t UNION v:real->bool``, ``u:real->bool``] THEN
4128      ASM_SIMP_TAC std_ss [OPEN_UNION] THEN ASM_SET_TAC[]]]
4129QED
4130
4131(* ------------------------------------------------------------------------- *)
4132(* Sort of induction principle for connected sets.                           *)
4133(* ------------------------------------------------------------------------- *)
4134
4135Theorem CONNECTED_INDUCTION:
4136   !P Q s:real->bool. connected s /\
4137     (!t a. open_in (subtopology euclidean s) t /\ a IN t
4138     ==> ?z. z IN t /\ P z) /\ (!a. a IN s
4139       ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
4140       !x y. x IN t /\ y IN t /\ P x /\ P y /\ Q x ==> Q y)
4141          ==> !a b. a IN s /\ b IN s /\ P a /\ P b /\ Q a ==> Q b
4142Proof
4143  REPEAT STRIP_TAC THEN
4144  GEN_REWR_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN
4145  UNDISCH_TAC ``connected s`` THEN GEN_REWR_TAC LAND_CONV [CONNECTED_OPEN_IN] THEN
4146  REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
4147  [``{b:real | ?t. open_in (subtopology euclidean s) t /\
4148                   b IN t /\ !x. x IN t /\ P x ==> Q x}``,
4149   ``{b:real | ?t. open_in (subtopology euclidean s) t /\
4150                 b IN t /\ !x. x IN t /\ P x ==> ~(Q x)}``]   THEN
4151  REPEAT CONJ_TAC THENL
4152  [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
4153   X_GEN_TAC ``c:real`` THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
4154   ASM_SET_TAC[],
4155   ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
4156   X_GEN_TAC ``c:real`` THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
4157   ASM_SET_TAC[],
4158   SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNION] THEN
4159   X_GEN_TAC ``c:real`` THEN DISCH_TAC THEN
4160   FIRST_X_ASSUM(MP_TAC o SPEC ``c:real``) THEN ASM_SET_TAC[],
4161   KNOW_TAC ``!x. ~((?t. open_in (subtopology euclidean s) t /\
4162            x IN t /\ (!x. x IN t /\ P x ==> Q x)) /\
4163       (?t. open_in (subtopology euclidean s) t /\ x IN t /\
4164            (!x. x IN t /\ P x ==> ~Q x)))`` THENL
4165   [ALL_TAC, SIMP_TAC std_ss [EXTENSION, IN_INTER, NOT_IN_EMPTY, GSPECIFICATION]] THEN
4166   X_GEN_TAC ``c:real`` THEN DISCH_THEN(CONJUNCTS_THEN2
4167   (X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC)
4168   (X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC)) THEN
4169   FIRST_X_ASSUM(MP_TAC o SPECL [``t INTER u:real->bool``, ``c:real``]) THEN
4170   ASM_SIMP_TAC std_ss [OPEN_IN_INTER] THEN ASM_SET_TAC[],
4171   ASM_SET_TAC[], ASM_SET_TAC[]]
4172QED
4173
4174Theorem CONNECTED_EQUIVALENCE_RELATION_GEN:
4175   !P R s:real->bool. connected s /\ (!x y. R x y ==> R y x) /\
4176     (!x y z. R x y /\ R y z ==> R x z) /\
4177     (!t a. open_in (subtopology euclidean s) t /\ a IN t
4178    ==> ?z. z IN t /\ P z) /\ (!a. a IN s
4179      ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
4180      !x y. x IN t /\ y IN t /\ P x /\ P y ==> R x y)
4181        ==> !a b. a IN s /\ b IN s /\ P a /\ P b ==> R a b
4182Proof
4183  REPEAT GEN_TAC THEN STRIP_TAC THEN
4184  SUBGOAL_THEN
4185  ``!a:real. a IN s /\ P a
4186  ==> !b c. b IN s /\ c IN s /\ P b /\ P c /\ R a b ==> R a c``
4187  MP_TAC THENL [ALL_TAC, ASM_MESON_TAC[]] THEN
4188  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION THEN
4189  ASM_REWRITE_TAC [] THEN
4190  X_GEN_TAC ``b:real`` THEN POP_ASSUM MP_TAC THEN
4191  POP_ASSUM (MP_TAC o Q.SPEC `b:real`) THEN
4192  METIS_TAC[]
4193QED
4194
4195Theorem CONNECTED_INDUCTION_SIMPLE:
4196   !P s:real->bool. connected s /\
4197    (!a. a IN s
4198    ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
4199      !x y. x IN t /\ y IN t /\ P x ==> P y)
4200      ==> !a b. a IN s /\ b IN s /\ P a ==> P b
4201Proof
4202  MP_TAC(ISPEC ``\x:real. T`` CONNECTED_INDUCTION) THEN
4203  REWRITE_TAC[] THEN STRIP_TAC THEN
4204  MAP_EVERY X_GEN_TAC [``Q:real->bool``, ``s:real->bool``] THEN
4205  POP_ASSUM (MP_TAC o Q.SPECL [`Q:real->bool`, `s:real->bool`]) THEN
4206  METIS_TAC[]
4207QED
4208
4209Theorem CONNECTED_EQUIVALENCE_RELATION:
4210   !R s:real->bool. connected s /\
4211     (!x y. R x y ==> R y x) /\
4212     (!x y z. R x y /\ R y z ==> R x z) /\
4213     (!a. a IN s
4214     ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
4215      !x. x IN t ==> R a x)
4216      ==> !a b. a IN s /\ b IN s ==> R a b
4217Proof
4218  REPEAT GEN_TAC THEN STRIP_TAC THEN
4219  SUBGOAL_THEN
4220  ``!a:real. a IN s ==> !b c. b IN s /\ c IN s /\ R a b ==> R a c``
4221  MP_TAC THENL [ALL_TAC, ASM_MESON_TAC[]] THEN
4222  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION_SIMPLE THEN
4223  ASM_MESON_TAC[]
4224QED
4225
4226(* ------------------------------------------------------------------------- *)
4227(* Limit points.                                                             *)
4228(* ------------------------------------------------------------------------- *)
4229
4230val _ = set_fixity "limit_point_of" (Infix(NONASSOC, 450));
4231
4232(* ‘limpt’ is defined in topologyTheory *)
4233Definition limit_point_of_def :
4234    x limit_point_of s <=> limpt(euclidean) x s
4235End
4236
4237Theorem limit_point_of :
4238    !x s. x limit_point_of s <=>
4239          !t. x IN t /\ Open t ==> ?y. ~(y = x) /\ y IN s /\ y IN t
4240Proof
4241    rw [limit_point_of_def, limpt, neigh, TOPSPACE_EUCLIDEAN, GSYM OPEN_IN, IN_APP]
4242 >> EQ_TAC >> rw []
4243 >- (Q.PAT_X_ASSUM ‘!N. _ ==> ?y. x <> y /\ s y /\ N y’ (MP_TAC o (Q.SPEC ‘t’)) \\
4244     Know ‘?P. Open P /\ P SUBSET t /\ P x’
4245     >- (Q.EXISTS_TAC ‘t’ >> rw []) >> rw [] \\
4246     Q.EXISTS_TAC ‘y’ >> rw [])
4247 >> Q.PAT_X_ASSUM ‘!t. t x /\ Open t ==> _’ (MP_TAC o (Q.SPEC ‘P’))
4248 >> rw []
4249 >> Q.EXISTS_TAC ‘y’ >> fs [SUBSET_DEF, IN_APP]
4250QED
4251
4252Theorem LIMPT_SUBSET:
4253   !x s t. x limit_point_of s /\ s SUBSET t ==> x limit_point_of t
4254Proof
4255  REWRITE_TAC[limit_point_of, SUBSET_DEF] THEN MESON_TAC[]
4256QED
4257
4258Theorem LIMPT_APPROACHABLE:
4259   !x s. x limit_point_of s <=>
4260                !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e
4261Proof
4262  REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN
4263  MESON_TAC[open_def, DIST_SYM, OPEN_BALL, CENTRE_IN_BALL, IN_BALL]
4264QED
4265
4266Theorem lemma[local]:
4267   &0 < d:real ==> x <= d / &2 ==> x < d
4268Proof
4269 SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_LT] THEN REAL_ARITH_TAC
4270QED
4271
4272Theorem APPROACHABLE_LT_LE:
4273   !P f. (?d:real. &0 < d /\ !x. f(x) < d ==> P x) =
4274         (?d:real. &0 < d /\ !x. f(x) <= d ==> P x)
4275Proof
4276  MESON_TAC[REAL_LT_IMP_LE, lemma, REAL_LT_HALF1]
4277QED
4278
4279Theorem LIMPT_APPROACHABLE_LE:
4280   !x s. x limit_point_of s <=>
4281         !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e
4282Proof
4283  REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
4284  MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN
4285  KNOW_TAC ``!e. (0 < e ==> ?x'. x' IN s /\ x' <> x /\ dist (x',x) < e) <=>
4286            (\e. (0 < e ==> ?x'. x' IN s /\ x' <> x /\ dist (x',x) < e)) e`` THENL
4287  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4288  KNOW_TAC ``!e. (0 < e ==> ?x'. x' IN s /\ x' <> x /\ dist (x',x) <= e) <=>
4289            (\e. (0 < e ==> ?x'. x' IN s /\ x' <> x /\ dist (x',x) <= e)) e `` THENL
4290  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4291  REWRITE_TAC [NOT_FORALL_THM] THEN BETA_TAC THEN REWRITE_TAC [NOT_IMP] THEN
4292  KNOW_TAC ``!x'' x'. ( x'' IN s /\ x'' <> x /\ dist (x'',x) < x') <=>
4293            (\x''. x'' IN s /\ x'' <> x /\ dist (x'',x) < x') x''`` THENL
4294  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4295  KNOW_TAC ``!x'' x'. ( x'' IN s /\ x'' <> x /\ dist (x'',x) <= x') <=>
4296            (\x''. x'' IN s /\ x'' <> x /\ dist (x'',x) <= x') x''`` THENL
4297  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4298  REWRITE_TAC [NOT_EXISTS_THM] THEN BETA_TAC THEN
4299  SIMP_TAC std_ss [TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`, APPROACHABLE_LT_LE]
4300QED
4301
4302Theorem LIMPT_UNIV:
4303   !x:real. x limit_point_of UNIV
4304Proof
4305  GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE, IN_UNIV] THEN
4306  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
4307  SUBGOAL_THEN ``?c:real. abs(c) = e / &2`` CHOOSE_TAC THENL
4308   [ASM_SIMP_TAC std_ss [REAL_CHOOSE_SIZE, REAL_LT_HALF1, REAL_LT_IMP_LE],
4309    ALL_TAC] THEN
4310  EXISTS_TAC ``x + c:real`` THEN
4311  REWRITE_TAC[dist, REAL_ADD_RID_UNIQ] THEN ASM_REWRITE_TAC[REAL_ADD_SUB] THEN
4312  ASM_REWRITE_TAC [REAL_LT_HALF2] THEN KNOW_TAC ``0 < abs c:real`` THENL
4313  [ASM_SIMP_TAC std_ss [REAL_LT_HALF1], METIS_TAC [ABS_NZ]]
4314QED
4315
4316Theorem CLOSED_LIMPT:
4317   !s. closed s <=> !x. x limit_point_of s ==> x IN s
4318Proof
4319  REWRITE_TAC[closed_def] THEN ONCE_REWRITE_TAC[OPEN_SUB_OPEN] THEN
4320  REWRITE_TAC[limit_point_of, IN_DIFF, IN_UNIV, SUBSET_DEF] THEN MESON_TAC[]
4321QED
4322
4323Theorem LIMPT_EMPTY:
4324   !x. ~(x limit_point_of {})
4325Proof
4326  REWRITE_TAC[LIMPT_APPROACHABLE, NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]
4327QED
4328
4329Theorem NO_LIMIT_POINT_IMP_CLOSED:
4330   !s. ~(?x. x limit_point_of s) ==> closed s
4331Proof
4332  MESON_TAC[CLOSED_LIMPT]
4333QED
4334
4335Theorem CLOSED_POSITIVE_ORTHANT:
4336   closed {x:real | &0 <= x}
4337Proof
4338  REWRITE_TAC[CLOSED_LIMPT, LIMPT_APPROACHABLE] THEN
4339  SIMP_TAC std_ss [GSPECIFICATION] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
4340  REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
4341  FIRST_X_ASSUM(MP_TAC o SPEC ``-(x:real)``) THEN
4342  ASM_SIMP_TAC std_ss [REAL_LT_RNEG, REAL_ADD_LID, NOT_EXISTS_THM] THEN
4343  X_GEN_TAC ``y:real`` THEN ONCE_REWRITE_TAC [METIS []``(a = b) <=> ~(a <> b:real)``] THEN
4344  REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
4345  MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN
4346  MATCH_MP_TAC(REAL_ARITH ``!b. abs x <= b /\ b <= a ==> ~(a + x < &0:real)``) THEN
4347  EXISTS_TAC ``abs(y - x :real)`` THEN ASM_SIMP_TAC std_ss [dist, REAL_LE_REFL] THEN
4348  ASM_SIMP_TAC std_ss [REAL_ARITH ``x < &0 /\ &0 <= y:real ==> abs(x) <= abs(y - x)``]
4349QED
4350
4351Theorem FINITE_SET_AVOID:
4352   !a:real s. FINITE s
4353   ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)
4354Proof
4355  GEN_TAC THEN
4356  KNOW_TAC ``!s. (?d. 0 < d /\ !x:real. x IN s /\ x <> a ==> d <= dist (a,x)) <=>
4357             (\s. ?d. 0 < d /\ !x:real. x IN s /\ x <> a ==> d <= dist (a,x)) s `` THENL
4358  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4359  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
4360  REWRITE_TAC[NOT_IN_EMPTY] THEN
4361  CONJ_TAC THENL [MESON_TAC[REAL_LT_01], ALL_TAC] THEN
4362  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
4363  MAP_EVERY X_GEN_TAC [``s:real->bool``, ``x:real``] THEN
4364  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN DISCH_TAC THEN
4365  FIRST_X_ASSUM(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
4366  ASM_CASES_TAC ``x:real = a`` THEN REWRITE_TAC[IN_INSERT] THENL
4367  [ASM_MESON_TAC[], ALL_TAC] THEN
4368  EXISTS_TAC ``min d (dist(a:real,x))`` THEN
4369  ASM_REWRITE_TAC[REAL_LT_MIN, GSYM DIST_NZ, REAL_MIN_LE] THEN
4370  ASM_MESON_TAC[REAL_LE_REFL]
4371QED
4372
4373Theorem LIMIT_POINT_FINITE:
4374   !s a. FINITE s ==> ~(a limit_point_of s)
4375Proof
4376  REWRITE_TAC[LIMPT_APPROACHABLE, GSYM REAL_NOT_LE] THEN
4377  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, NOT_EXISTS_THM, REAL_NOT_LE,
4378   REAL_NOT_LT, TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN
4379  MESON_TAC[FINITE_SET_AVOID, DIST_SYM]
4380QED
4381
4382Theorem LIMPT_SING:
4383   !x y:real. ~(x limit_point_of {y})
4384Proof
4385  SIMP_TAC std_ss [LIMIT_POINT_FINITE, FINITE_SING]
4386QED
4387
4388Theorem LIMIT_POINT_UNION:
4389   !s t x:real. x limit_point_of (s UNION t) <=>
4390                x limit_point_of s \/ x limit_point_of t
4391Proof
4392  REPEAT GEN_TAC THEN EQ_TAC THENL
4393  [ALL_TAC, MESON_TAC[LIMPT_SUBSET, SUBSET_UNION]] THEN
4394  REWRITE_TAC[LIMPT_APPROACHABLE, IN_UNION] THEN DISCH_TAC THEN
4395  MATCH_MP_TAC(TAUT `(~a ==> b) ==> a \/ b`) THEN
4396  KNOW_TAC ``!e. &0 < e /\ ~(?x'. x' IN s /\ ~(x' = x) /\ dist (x',x) < e)
4397     ==> (!e. &0 < e ==> (?x'. x' IN t /\ ~(x' = x) /\ dist (x',x) < e))`` THENL
4398  [ALL_TAC, SIMP_TAC std_ss [NOT_FORALL_THM, LEFT_IMP_EXISTS_THM, NOT_IMP]] THEN
4399  X_GEN_TAC ``e:real`` THEN STRIP_TAC THEN X_GEN_TAC ``d:real`` THEN DISCH_TAC THEN
4400  FIRST_X_ASSUM(MP_TAC o SPEC ``min d e:real``) THEN ASM_MESON_TAC[REAL_LT_MIN]
4401QED
4402
4403Theorem LIMPT_INSERT:
4404   !s x y:real. x limit_point_of (y INSERT s) <=> x limit_point_of s
4405Proof
4406  ONCE_REWRITE_TAC[SET_RULE ``y:real INSERT s = {y} UNION s``] THEN
4407  REWRITE_TAC[LIMIT_POINT_UNION] THEN
4408  SIMP_TAC std_ss [FINITE_SING, LIMIT_POINT_FINITE]
4409QED
4410
4411Theorem LIMPT_OF_LIMPTS:
4412   !x:real s. x limit_point_of {y | y limit_point_of s}
4413          ==> x limit_point_of s
4414Proof
4415  SIMP_TAC std_ss [LIMPT_APPROACHABLE, GSPECIFICATION] THEN REPEAT GEN_TAC THEN
4416  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
4417  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
4418  DISCH_THEN (X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
4419  FIRST_X_ASSUM(MP_TAC o SPEC ``dist(y:real,x)``) THEN
4420  ASM_SIMP_TAC std_ss [DIST_POS_LT] THEN
4421  DISCH_THEN (X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
4422  EXISTS_TAC ``z:real`` THEN
4423  ASM_REWRITE_TAC[] THEN
4424  CONJ_TAC THENL
4425  [FIRST_ASSUM MP_TAC THEN GEN_REWR_TAC (LAND_CONV o LAND_CONV) [DIST_SYM] THEN
4426   REWRITE_TAC [dist] THEN REAL_ARITH_TAC, ALL_TAC] THEN
4427  FULL_SIMP_TAC std_ss [dist, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
4428  ASM_REAL_ARITH_TAC
4429QED
4430
4431Theorem CLOSED_LIMPTS:
4432   !s. closed {x:real | x limit_point_of s}
4433Proof
4434  SIMP_TAC std_ss [CLOSED_LIMPT, GSPECIFICATION, LIMPT_OF_LIMPTS]
4435QED
4436
4437Theorem DISCRETE_IMP_CLOSED:
4438   !s:real->bool e. &0 < e /\
4439    (!x y. x IN s /\ y IN s /\ abs(y - x) < e ==> (y = x))
4440    ==> closed s
4441Proof
4442  REPEAT STRIP_TAC THEN
4443  SUBGOAL_THEN ``!x:real. ~(x limit_point_of s)``
4444  (fn th => MESON_TAC[th, CLOSED_LIMPT]) THEN
4445  GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN
4446  FIRST_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
4447  REWRITE_TAC[REAL_LT_HALF1, ASSUME ``&0 < e:real``] THEN
4448  DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
4449  FIRST_X_ASSUM(MP_TAC o SPEC ``min (e / &2) (dist(x:real,y))``) THEN
4450  ASM_REWRITE_TAC [REAL_LT_MIN, REAL_LT_HALF1] THEN
4451  KNOW_TAC ``0 < dist(x,y:real)`` THENL
4452  [ASM_SIMP_TAC std_ss [DIST_POS_LT], ALL_TAC] THEN
4453  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
4454  DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
4455  FIRST_X_ASSUM(MP_TAC o SPECL [``y:real``, ``z:real``]) THEN
4456  ASM_SIMP_TAC arith_ss [GSYM dist] THEN CONJ_TAC THENL
4457  [MATCH_MP_TAC REAL_LET_TRANS THEN
4458   EXISTS_TAC ``dist(z,x) + dist(x,y:real)`` THEN
4459   METIS_TAC [DIST_TRIANGLE, GSYM REAL_HALF_DOUBLE, REAL_LT_ADD2, DIST_SYM],
4460   REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC [dist, DIST_NZ] THEN
4461   REAL_ARITH_TAC]
4462QED
4463
4464Theorem LIMPT_OF_UNIV:
4465   !x. x limit_point_of univ(:real)
4466Proof
4467  GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE, IN_UNIV] THEN
4468  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
4469  MP_TAC(ISPECL [``x:real``, ``e / &2:real``] REAL_CHOOSE_DIST) THEN
4470  KNOW_TAC ``0 <= e / 2:real`` THENL
4471  [METIS_TAC [REAL_LT_HALF1, REAL_LE_LT], ALL_TAC] THEN DISCH_TAC THEN
4472  ASM_REWRITE_TAC [] THEN STRIP_TAC THEN EXISTS_TAC ``y:real`` THEN
4473  CONJ_TAC THENL [ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
4474  ASM_REWRITE_TAC [DIST_NZ, REAL_LT_HALF1], MATCH_MP_TAC REAL_LET_TRANS THEN
4475  EXISTS_TAC ``e / 2:real`` THEN METIS_TAC [REAL_LT_HALF2, REAL_LE_LT, DIST_SYM]]
4476QED
4477
4478Theorem LIMPT_OF_OPEN_IN:
4479   !s t x:real. open_in (subtopology euclidean s) t /\
4480                x limit_point_of s /\ x IN t
4481                ==> x limit_point_of t
4482Proof
4483  REWRITE_TAC[open_in, SUBSET_DEF, LIMPT_APPROACHABLE] THEN
4484  REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
4485  UNDISCH_TAC ``!x. x IN t ==>
4486    ?e. 0 < e /\ !x'. x' IN s /\ dist (x',x) < e ==> x' IN t`` THEN DISCH_TAC THEN
4487  FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
4488  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
4489  UNDISCH_TAC ``!e. 0 < e ==> ?x'. x' IN s /\ x' <> x /\ dist (x',x) < e`` THEN
4490  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``min d e / &2:real``) THEN
4491  KNOW_TAC ``0 < min d e / 2:real`` THENL [REWRITE_TAC [min_def] THEN
4492  METIS_TAC [REAL_LT_HALF1], ALL_TAC] THEN DISCH_TAC THEN
4493  ASM_REWRITE_TAC [] THEN STRIP_TAC THEN EXISTS_TAC ``x':real`` THEN
4494  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN TRY (FIRST_X_ASSUM MATCH_MP_TAC) THEN
4495  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
4496  EXISTS_TAC ``min d e / 2:real`` THEN ASM_REWRITE_TAC [] THEN
4497  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``min d e:real`` THEN
4498  METIS_TAC [REAL_MIN_LE1, min_def, REAL_LT_HALF2]
4499QED
4500
4501Theorem LIMPT_OF_OPEN:
4502   !s x:real. open s /\ x IN s ==> x limit_point_of s
4503Proof
4504  REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
4505  MESON_TAC[LIMPT_OF_OPEN_IN, LIMPT_OF_UNIV]
4506QED
4507
4508Theorem OPEN_IN_SING:
4509   !s a. open_in (subtopology euclidean s) {a} <=>
4510   a IN s /\ ~(a limit_point_of s)
4511Proof
4512  REWRITE_TAC[open_in, LIMPT_APPROACHABLE, SING_SUBSET, IN_SING] THEN
4513  METIS_TAC[]
4514QED
4515
4516(* ------------------------------------------------------------------------- *)
4517(* Interior of a set.                                                        *)
4518(* ------------------------------------------------------------------------- *)
4519
4520Definition interior_def :
4521    interior s = euclidean interior_of s
4522End
4523
4524Theorem interior :
4525    !s. interior s = {x | ?t. open t /\ x IN t /\ t SUBSET s}
4526Proof
4527    rw [interior_def, interior_of, euclidean_open_def]
4528QED
4529
4530Theorem INTERIOR_EQ:
4531   !s. (interior s = s) <=> open s
4532Proof
4533  GEN_TAC THEN REWRITE_TAC[EXTENSION, interior] THEN
4534  SIMP_TAC std_ss [GSPECIFICATION] THEN GEN_REWR_TAC RAND_CONV [OPEN_SUB_OPEN]
4535  THEN MESON_TAC[SUBSET_DEF]
4536QED
4537
4538Theorem INTERIOR_OPEN:
4539   !s. open s ==> (interior s = s)
4540Proof
4541  MESON_TAC[INTERIOR_EQ]
4542QED
4543
4544Theorem INTERIOR_EMPTY:
4545   interior {} = {}
4546Proof
4547  SIMP_TAC std_ss [INTERIOR_OPEN, OPEN_EMPTY]
4548QED
4549
4550Theorem INTERIOR_UNIV:
4551   interior univ(:real) = univ(:real)
4552Proof
4553  SIMP_TAC std_ss [INTERIOR_OPEN, OPEN_UNIV]
4554QED
4555
4556Theorem OPEN_INTERIOR:
4557   !s. open(interior s)
4558Proof
4559  GEN_TAC THEN REWRITE_TAC[interior] THEN GEN_REWR_TAC I [OPEN_SUB_OPEN] THEN
4560  SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN MESON_TAC[]
4561QED
4562
4563Theorem INTERIOR_INTERIOR:
4564   !s. interior(interior s) = interior s
4565Proof
4566  MESON_TAC[INTERIOR_EQ, OPEN_INTERIOR]
4567QED
4568
4569Theorem INTERIOR_SUBSET:
4570   !s. (interior s) SUBSET s
4571Proof
4572  SIMP_TAC std_ss [SUBSET_DEF, interior, GSPECIFICATION] THEN MESON_TAC[]
4573QED
4574
4575Theorem SUBSET_INTERIOR_EQ:
4576   !s:real->bool. s SUBSET interior s <=> open s
4577Proof
4578  REWRITE_TAC[GSYM INTERIOR_EQ,
4579  SET_RULE ``!(s:real->bool) t. (s = t) <=> s SUBSET t /\ t SUBSET s``,
4580  INTERIOR_SUBSET]
4581QED
4582
4583Theorem SUBSET_INTERIOR:
4584   !s t. s SUBSET t ==> (interior s) SUBSET (interior t)
4585Proof
4586  SIMP_TAC std_ss [interior, SUBSET_DEF, GSPECIFICATION] THEN MESON_TAC[]
4587QED
4588
4589Theorem INTERIOR_MAXIMAL:
4590   !s t. t SUBSET s /\ open t ==> t SUBSET (interior s)
4591Proof
4592  SIMP_TAC std_ss[interior, SUBSET_DEF, GSPECIFICATION] THEN MESON_TAC[]
4593QED
4594
4595Theorem INTERIOR_MAXIMAL_EQ:
4596   !s t:real->bool. open s ==> (s SUBSET interior t <=> s SUBSET t)
4597Proof
4598  MESON_TAC[INTERIOR_MAXIMAL, SUBSET_TRANS, INTERIOR_SUBSET]
4599QED
4600
4601Theorem INTERIOR_UNIQUE:
4602   !s t. t SUBSET s /\ open t /\ (!t'. t' SUBSET s /\ open t' ==> t' SUBSET t)
4603         ==> (interior s = t)
4604Proof
4605  MESON_TAC[SUBSET_ANTISYM, INTERIOR_MAXIMAL, INTERIOR_SUBSET, OPEN_INTERIOR]
4606QED
4607
4608Theorem IN_INTERIOR:
4609   !x s. x IN interior s <=> ?e. &0 < e /\ ball(x,e) SUBSET s
4610Proof
4611  SIMP_TAC std_ss [interior, GSPECIFICATION] THEN
4612  MESON_TAC[OPEN_CONTAINS_BALL, SUBSET_TRANS, CENTRE_IN_BALL, OPEN_BALL]
4613QED
4614
4615Theorem OPEN_SUBSET_INTERIOR:
4616   !s t. open s ==> (s SUBSET interior t <=> s SUBSET t)
4617Proof
4618  MESON_TAC[INTERIOR_MAXIMAL, INTERIOR_SUBSET, SUBSET_TRANS]
4619QED
4620
4621Theorem INTERIOR_INTER:
4622   !s t:real->bool. interior(s INTER t) = interior s INTER interior t
4623Proof
4624  REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4625   [REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THEN
4626    MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[INTER_SUBSET],
4627    MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC std_ss [OPEN_INTER, OPEN_INTERIOR] THEN
4628    MATCH_MP_TAC(SET_RULE
4629      ``s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'``) THEN
4630    REWRITE_TAC[INTERIOR_SUBSET]]
4631QED
4632
4633Theorem INTERIOR_FINITE_BIGINTER:
4634   !s:(real->bool)->bool.
4635        FINITE s ==> (interior(BIGINTER s) = BIGINTER(IMAGE interior s))
4636Proof
4637  GEN_TAC THEN KNOW_TAC ``(interior (BIGINTER s) = BIGINTER (IMAGE interior s)) =
4638  (\s:(real->bool)->bool. (interior (BIGINTER s) = BIGINTER (IMAGE interior s))) s`` THENL
4639  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4640  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
4641  REWRITE_TAC[BIGINTER_EMPTY, BIGINTER_INSERT, INTERIOR_UNIV, IMAGE_EMPTY,
4642  IMAGE_INSERT] THEN SIMP_TAC std_ss [INTERIOR_INTER]
4643QED
4644
4645Theorem INTERIOR_BIGINTER_SUBSET:
4646   !f. interior(BIGINTER f) SUBSET BIGINTER (IMAGE interior f)
4647Proof
4648  REWRITE_TAC[SUBSET_DEF, IN_INTERIOR, IN_BIGINTER, FORALL_IN_IMAGE] THEN
4649  MESON_TAC[]
4650QED
4651
4652Theorem UNION_INTERIOR_SUBSET:
4653   !s t:real->bool.
4654        interior s UNION interior t SUBSET interior(s UNION t)
4655Proof
4656  SIMP_TAC std_ss [INTERIOR_MAXIMAL_EQ, OPEN_UNION, OPEN_INTERIOR] THEN
4657  REPEAT GEN_TAC THEN MATCH_MP_TAC(SET_RULE
4658   ``s SUBSET s' /\ t SUBSET t' ==> (s UNION t) SUBSET (s' UNION t')``) THEN
4659  REWRITE_TAC[INTERIOR_SUBSET]
4660QED
4661
4662Theorem INTERIOR_EQ_EMPTY:
4663   !s:real->bool. (interior s = {}) <=> !t. open t /\ t SUBSET s ==> (t = {})
4664Proof
4665  MESON_TAC[INTERIOR_MAXIMAL_EQ, SUBSET_EMPTY,
4666            OPEN_INTERIOR, INTERIOR_SUBSET]
4667QED
4668
4669Theorem INTERIOR_EQ_EMPTY_ALT:
4670   !s:real->bool. (interior s = {}) <=>
4671  !t. open t /\ ~(t = {}) ==> ~(t DIFF s = {})
4672Proof
4673  GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN SET_TAC[]
4674QED
4675
4676Theorem INTERIOR_LIMIT_POINT:
4677   !s x:real. x IN interior s ==> x limit_point_of s
4678Proof
4679  REPEAT GEN_TAC THEN
4680  SIMP_TAC std_ss [IN_INTERIOR, GSPECIFICATION, SUBSET_DEF, IN_BALL] THEN
4681  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
4682  REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC ``d:real`` THEN
4683  DISCH_TAC THEN
4684  MP_TAC(ISPECL [``x:real``, ``min d e / &2:real``] REAL_CHOOSE_DIST) THEN
4685  KNOW_TAC ``0 <= min d e / 2:real`` THENL
4686  [METIS_TAC [min_def, REAL_LE_LT, REAL_LT_HALF1], ALL_TAC] THEN
4687  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN
4688  EXISTS_TAC ``y:real`` THEN REPEAT CONJ_TAC THENL
4689  [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [] THEN
4690   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``min d e:real`` THEN
4691   METIS_TAC [REAL_MIN_LE1, min_def, REAL_LT_HALF2],
4692   CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[DIST_NZ] THEN
4693   ASM_REWRITE_TAC [] THEN METIS_TAC [min_def, REAL_LE_LT, REAL_LT_HALF1],
4694   ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC [] THEN
4695   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``min d e:real`` THEN
4696   METIS_TAC [REAL_MIN_LE1, min_def, REAL_LT_HALF2]]
4697QED
4698
4699Theorem INTERIOR_SING:
4700    !a:real. interior {a} = {}
4701Proof
4702  REWRITE_TAC[EXTENSION, NOT_IN_EMPTY] THEN
4703  MESON_TAC[INTERIOR_LIMIT_POINT, LIMPT_SING]
4704QED
4705
4706Theorem INTERIOR_CLOSED_UNION_EMPTY_INTERIOR:
4707   !s t:real->bool. closed(s) /\ (interior(t) = {})
4708                ==> (interior(s UNION t) = interior(s))
4709Proof
4710  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4711  SIMP_TAC std_ss [SUBSET_INTERIOR, SUBSET_UNION] THEN
4712  REWRITE_TAC[SUBSET_DEF, IN_INTERIOR, IN_INTER, IN_UNION] THEN
4713  X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN
4714  ASM_REWRITE_TAC[] THEN X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
4715  SUBGOAL_THEN ``(y:real) limit_point_of s``
4716   (fn th => ASM_MESON_TAC[CLOSED_LIMPT, th]) THEN
4717  REWRITE_TAC[IN_INTERIOR, NOT_IN_EMPTY, LIMPT_APPROACHABLE] THEN
4718  X_GEN_TAC ``d:real`` THEN DISCH_TAC THEN
4719  SUBGOAL_THEN
4720  ``?z:real. ~(z IN t) /\ ~(z = y) /\ dist(z,y) < d /\ dist(x,z) < e``
4721   (fn th => ASM_MESON_TAC[th, IN_BALL]) THEN
4722  UNDISCH_TAC ``y IN ball (x,e)`` THEN REWRITE_TAC [IN_BALL] THEN
4723  DISCH_TAC THEN UNDISCH_TAC ``interior t = {}`` THEN
4724  GEN_REWR_TAC LAND_CONV [EXTENSION] THEN
4725  KNOW_TAC ``(!x e. ~(&0 < e /\ ball (x,e) SUBSET t))
4726   ==> (?z. ~(z IN t) /\ ~(z = y) /\ dist (z,y) < d /\ dist (x,z) < e)`` THENL
4727  [ALL_TAC, SIMP_TAC std_ss [IN_INTERIOR, NOT_IN_EMPTY, NOT_EXISTS_THM]] THEN
4728  ABBREV_TAC ``k = min d (e - dist(x:real,y))`` THEN
4729  SUBGOAL_THEN ``&0 < k:real`` ASSUME_TAC THENL
4730  [METIS_TAC [min_def, REAL_SUB_LT], ALL_TAC] THEN
4731  SUBGOAL_THEN ``?w:real. dist(y,w) = k / &2`` CHOOSE_TAC THENL
4732  [ASM_SIMP_TAC std_ss [REAL_CHOOSE_DIST, REAL_HALF, REAL_LT_IMP_LE], ALL_TAC] THEN
4733  DISCH_THEN(MP_TAC o SPECL [``w:real``, ``k / &4:real``]) THEN
4734  ASM_SIMP_TAC arith_ss [SUBSET_DEF, NOT_FORALL_THM, REAL_LT_DIV, REAL_LT,
4735  NOT_IMP, IN_BALL] THEN DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN
4736  EXISTS_TAC ``z:real`` THEN POP_ASSUM MP_TAC THEN
4737  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN
4738  DISCH_TAC THEN REPEAT CONJ_TAC THENL
4739  [CCONTR_TAC THEN FULL_SIMP_TAC std_ss [DIST_SYM] THEN
4740   UNDISCH_TAC `` dist (w,y) < k / 4`` THEN ASM_REWRITE_TAC [REAL_NOT_LT, REAL_LE_LT] THEN
4741   DISJ1_TAC THEN KNOW_TAC ``k < k / 2 * 4:real`` THENL
4742   [ALL_TAC, SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``0 < 4:real``]] THEN
4743   REWRITE_TAC [REAL_ARITH ``4 = 2 * 2:real``, REAL_MUL_ASSOC] THEN
4744   SIMP_TAC arith_ss [REAL_DIV_RMUL, REAL_ARITH ``2 <> 0:real``] THEN
4745   ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM REAL_DOUBLE] THEN
4746   ONCE_REWRITE_TAC [REAL_ARITH``a = a + 0:real``] THEN
4747   GEN_REWR_TAC RAND_CONV [REAL_ADD_RID] THEN ASM_REWRITE_TAC [REAL_LT_LADD],
4748   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``dist (z, w) + dist (w, y:real)`` THEN
4749   REWRITE_TAC [DIST_TRIANGLE] THEN ONCE_REWRITE_TAC [DIST_SYM] THEN
4750   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``min d (e - dist (x,y))`` THEN
4751   ASM_REWRITE_TAC [REAL_MIN_LE1] THEN
4752   GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN REWRITE_TAC [REAL_LT_RADD] THEN
4753   MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC ``k / 4:real`` THEN
4754   ASM_REWRITE_TAC [] THEN KNOW_TAC ``k < k / 2 * 4:real`` THENL
4755   [ALL_TAC, SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``0 < 4:real``]] THEN
4756   REWRITE_TAC [REAL_ARITH ``4 = 2 * 2:real``, REAL_MUL_ASSOC] THEN
4757   SIMP_TAC arith_ss [REAL_DIV_RMUL, REAL_ARITH ``2 <> 0:real``] THEN
4758   ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM REAL_DOUBLE] THEN
4759   ONCE_REWRITE_TAC [REAL_ARITH``a = a + 0:real``] THEN
4760   GEN_REWR_TAC RAND_CONV [REAL_ADD_RID] THEN ASM_REWRITE_TAC [REAL_LT_LADD],
4761   Cases_on `d <= (e - dist (x,y))` THENL
4762   [ALL_TAC, FULL_SIMP_TAC std_ss [min_def] THEN
4763    FULL_SIMP_TAC std_ss [REAL_ARITH ``(a - b = c) = (a = c + b:real)``] THEN
4764    ONCE_REWRITE_TAC [REAL_ADD_SYM] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4765    EXISTS_TAC ``dist (x, y) + dist (y, z:real)`` THEN
4766    REWRITE_TAC [DIST_TRIANGLE, REAL_LT_LADD] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4767    EXISTS_TAC ``dist (y,w) + dist (w, z:real)`` THEN ASM_REWRITE_TAC [DIST_TRIANGLE] THEN
4768    GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN REWRITE_TAC [REAL_LT_LADD] THEN
4769    MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC ``k / 4:real`` THEN
4770    ASM_REWRITE_TAC [] THEN KNOW_TAC ``k < k / 2 * 4:real`` THENL
4771    [ALL_TAC, SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``0 < 4:real``]] THEN
4772    REWRITE_TAC [REAL_ARITH ``4 = 2 * 2:real``, REAL_MUL_ASSOC] THEN
4773    SIMP_TAC arith_ss [REAL_DIV_RMUL, REAL_ARITH ``2 <> 0:real``] THEN
4774    ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM REAL_DOUBLE] THEN
4775    ONCE_REWRITE_TAC [REAL_ARITH``a = a + 0:real``] THEN
4776    GEN_REWR_TAC RAND_CONV [REAL_ADD_RID] THEN ASM_REWRITE_TAC [REAL_LT_LADD]] THEN
4777   FULL_SIMP_TAC std_ss [min_def, REAL_LE_SUB_LADD] THEN
4778   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``d + dist (x,y)`` THEN
4779   ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC [REAL_ADD_SYM] THEN
4780   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``dist (x, y) + dist (y, z:real)`` THEN
4781   REWRITE_TAC [DIST_TRIANGLE, REAL_LT_LADD] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4782   EXISTS_TAC ``dist (y,w) + dist (w, z:real)`` THEN REWRITE_TAC [DIST_TRIANGLE] THEN
4783   ASM_REWRITE_TAC [] THEN GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
4784   ASM_REWRITE_TAC [REAL_LT_LADD] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
4785   EXISTS_TAC ``k / 4:real`` THEN ASM_REWRITE_TAC [] THEN
4786   KNOW_TAC ``k < k / 2 * 4:real`` THENL
4787   [ALL_TAC, SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``0 < 4:real``]] THEN
4788   REWRITE_TAC [REAL_ARITH ``4 = 2 * 2:real``, REAL_MUL_ASSOC] THEN
4789   SIMP_TAC arith_ss [REAL_DIV_RMUL, REAL_ARITH ``2 <> 0:real``] THEN
4790   ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM REAL_DOUBLE] THEN
4791   ONCE_REWRITE_TAC [REAL_ARITH``a = a + 0:real``] THEN
4792   GEN_REWR_TAC RAND_CONV [REAL_ADD_RID] THEN ASM_REWRITE_TAC [REAL_LT_LADD]]
4793QED
4794
4795Theorem INTERIOR_UNION_EQ_EMPTY:
4796   !s t:real->bool. closed s \/ closed t
4797        ==> ((interior(s UNION t) = {}) <=>
4798             (interior s = {}) /\ (interior t = {}))
4799Proof
4800REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
4801[ASM_MESON_TAC[SUBSET_UNION, SUBSET_INTERIOR, SUBSET_EMPTY],
4802 ASM_MESON_TAC[UNION_COMM, INTERIOR_CLOSED_UNION_EMPTY_INTERIOR]]
4803QED
4804
4805Theorem INTERIOR_UNIONS_OPEN_SUBSETS:
4806   !s:real->bool. BIGUNION {t | open t /\ t SUBSET s} = interior s
4807Proof
4808  GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN
4809  SIMP_TAC std_ss [OPEN_BIGUNION, GSPECIFICATION] THEN SET_TAC[]
4810QED
4811
4812Theorem REAL_ARCH_RDIV_EQ_0:
4813  !x c:real. &0 <= x /\ &0 <= c /\ (!m. 0 < m ==> &m * x <= c) ==> (x = &0)
4814Proof
4815  SIMP_TAC std_ss [GSYM REAL_LE_ANTISYM, GSYM REAL_NOT_LT] >> rpt STRIP_TAC >>
4816  POP_ASSUM (STRIP_ASSUME_TAC o SPEC “c:real” o MATCH_MP REAL_ARCH) >>
4817  ASM_CASES_TAC “n=0:num” >| [
4818    POP_ASSUM SUBST_ALL_TAC >>
4819    RULE_ASSUM_TAC (REWRITE_RULE [REAL_MUL_LZERO]) >>
4820    ASM_MESON_TAC [REAL_LET_ANTISYM],
4821    ASM_MESON_TAC [REAL_LET_ANTISYM, REAL_MUL_SYM, NOT_ZERO]
4822  ]
4823QED
4824
4825(* ------------------------------------------------------------------------- *)
4826(* Closure of a set.                                                         *)
4827(* ------------------------------------------------------------------------- *)
4828
4829Definition closure_def :
4830    closure s = euclidean closure_of s
4831End
4832
4833Theorem closure :
4834    !s. closure s = s UNION {x | x limit_point_of s}
4835Proof
4836    rw [closure_def, CLOSURE_OF, TOPSPACE_EUCLIDEAN, limit_point_of_def,
4837        derived_set_of_alt_limpt]
4838QED
4839
4840Theorem CLOSURE_APPROACHABLE:
4841   !x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e
4842Proof
4843  SIMP_TAC std_ss [closure, LIMPT_APPROACHABLE, IN_UNION, GSPECIFICATION] THEN
4844  MESON_TAC[DIST_REFL]
4845QED
4846
4847Theorem CLOSURE_NONEMPTY_OPEN_INTER:
4848   !s x:real. x IN closure s <=> !t. x IN t /\ open t ==> ~(s INTER t = {})
4849Proof
4850  REPEAT GEN_TAC THEN SIMP_TAC std_ss [closure, IN_UNION, GSPECIFICATION] THEN
4851  REWRITE_TAC[limit_point_of] THEN SET_TAC[]
4852QED
4853
4854Theorem CLOSURE_INTERIOR:
4855   !s:real->bool. closure s = UNIV DIFF (interior (UNIV DIFF s))
4856Proof
4857  SIMP_TAC std_ss [EXTENSION, closure, IN_UNION, IN_DIFF, IN_UNIV, interior,
4858              GSPECIFICATION, limit_point_of, SUBSET_DEF] THEN
4859  MESON_TAC[]
4860QED
4861
4862Theorem INTERIOR_CLOSURE:
4863   !s:real->bool. interior s = UNIV DIFF (closure (UNIV DIFF s))
4864Proof
4865  REWRITE_TAC[CLOSURE_INTERIOR, SET_RULE ``!s t. UNIV DIFF (UNIV DIFF t) = t``]
4866QED
4867
4868Theorem CLOSED_CLOSURE:
4869   !s. closed(closure s)
4870Proof
4871  REWRITE_TAC[closed_def, CLOSURE_INTERIOR, SET_RULE ``UNIV DIFF (UNIV DIFF s) = s``,
4872              OPEN_INTERIOR]
4873QED
4874
4875Theorem CLOSURE_HULL:
4876   !s. closure s = closed hull s
4877Proof
4878  GEN_TAC THEN MATCH_MP_TAC(GSYM HULL_UNIQUE) THEN
4879  REWRITE_TAC[CLOSED_CLOSURE, SUBSET_DEF] THEN
4880  SIMP_TAC std_ss [closure, IN_UNION, GSPECIFICATION, CLOSED_LIMPT] THEN
4881  MESON_TAC[limit_point_of]
4882QED
4883
4884Theorem CLOSURE_EQ:
4885   !s. (closure s = s) <=> closed s
4886Proof
4887  SIMP_TAC std_ss [CLOSURE_HULL, HULL_EQ, CLOSED_BIGINTER]
4888QED
4889
4890Theorem CLOSURE_CLOSED:
4891   !s. closed s ==> (closure s = s)
4892Proof
4893  MESON_TAC[CLOSURE_EQ]
4894QED
4895
4896Theorem CLOSURE_CLOSURE:
4897   !s. closure(closure s) = closure s
4898Proof
4899  REWRITE_TAC[CLOSURE_HULL, HULL_HULL]
4900QED
4901
4902Theorem CLOSURE_SUBSET:
4903   !s. s SUBSET (closure s)
4904Proof
4905  REWRITE_TAC[CLOSURE_HULL, HULL_SUBSET]
4906QED
4907
4908Theorem SUBSET_CLOSURE:
4909   !s t. s SUBSET t ==> (closure s) SUBSET (closure t)
4910Proof
4911  REWRITE_TAC[CLOSURE_HULL, HULL_MONO]
4912QED
4913
4914Theorem CLOSURE_UNION:
4915   !s t:real->bool. closure(s UNION t) = closure s UNION closure t
4916Proof
4917  REWRITE_TAC[LIMIT_POINT_UNION, closure] THEN SET_TAC[]
4918QED
4919
4920Theorem CLOSURE_INTER_SUBSET:
4921   !s t. closure(s INTER t) SUBSET closure(s) INTER closure(t)
4922Proof
4923  REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_INTER] THEN
4924  CONJ_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]
4925QED
4926
4927Theorem CLOSURE_BIGINTER_SUBSET:
4928   !f. closure(BIGINTER f) SUBSET BIGINTER (IMAGE closure f)
4929Proof
4930  REWRITE_TAC[SET_RULE ``s SUBSET BIGINTER f <=> !t. t IN f ==> s SUBSET t``] THEN
4931  REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
4932  MATCH_MP_TAC SUBSET_CLOSURE THEN ASM_SET_TAC[]
4933QED
4934
4935Theorem CLOSURE_MINIMAL:
4936   !s t. s SUBSET t /\ closed t ==> (closure s) SUBSET t
4937Proof
4938  REWRITE_TAC[HULL_MINIMAL, CLOSURE_HULL]
4939QED
4940
4941Theorem CLOSURE_MINIMAL_EQ:
4942   !s t:real->bool. closed t ==> (closure s SUBSET t <=> s SUBSET t)
4943Proof
4944  MESON_TAC[SUBSET_TRANS, CLOSURE_SUBSET, CLOSURE_MINIMAL]
4945QED
4946
4947Theorem CLOSURE_UNIQUE:
4948   !s t. s SUBSET t /\ closed t /\
4949  (!t'. s SUBSET t' /\ closed t' ==> t SUBSET t')
4950   ==> (closure s = t)
4951Proof
4952  REWRITE_TAC[CLOSURE_HULL, HULL_UNIQUE]
4953QED
4954
4955Theorem CLOSURE_EMPTY:
4956   closure {} = {}
4957Proof
4958  SIMP_TAC std_ss [CLOSURE_CLOSED, CLOSED_EMPTY]
4959QED
4960
4961Theorem CLOSURE_UNIV:
4962   closure univ(:real) = univ(:real)
4963Proof
4964  SIMP_TAC std_ss [CLOSURE_CLOSED, CLOSED_UNIV]
4965QED
4966
4967Theorem CLOSURE_BIGUNION:
4968   !f. FINITE f ==> (closure(BIGUNION f) = BIGUNION {closure s | s IN f})
4969Proof
4970  KNOW_TAC ``!f. (closure(BIGUNION f) = BIGUNION {closure s | s IN f}) =
4971             (\f. closure(BIGUNION f) = BIGUNION {closure s | s IN f}) f`` THENL
4972  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4973  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
4974  SIMP_TAC std_ss [BIGUNION_EMPTY, BIGUNION_INSERT, SET_RULE ``{f x | x IN {}} = {}``,
4975  SET_RULE ``{f x | x IN a INSERT s} = (f a) INSERT {f x | x IN s}``] THEN
4976  SIMP_TAC std_ss [CLOSURE_EMPTY, CLOSURE_UNION]
4977QED
4978
4979Theorem CLOSURE_EQ_EMPTY:
4980   !s. (closure s = {}) <=> (s = {})
4981Proof
4982  GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [CLOSURE_EMPTY] THEN
4983  MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> (t = {}) ==> (s = {})``) THEN
4984  REWRITE_TAC[CLOSURE_SUBSET]
4985QED
4986
4987Theorem CLOSURE_SUBSET_EQ:
4988   !s:real->bool. closure s SUBSET s <=> closed s
4989Proof
4990  GEN_TAC THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN
4991  MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN SET_TAC[]
4992QED
4993
4994Theorem OPEN_INTER_CLOSURE_EQ_EMPTY:
4995   !s t:real->bool.
4996        open s ==> ((s INTER (closure t) = {}) <=> (s INTER t = {}))
4997Proof
4998  REPEAT STRIP_TAC THEN EQ_TAC THENL
4999   [MP_TAC(ISPEC ``t:real->bool`` CLOSURE_SUBSET) THEN SET_TAC[], ALL_TAC] THEN
5000  DISCH_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN
5001  MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> (s INTER (UNIV DIFF t) = {})``) THEN
5002  ASM_SIMP_TAC std_ss [OPEN_SUBSET_INTERIOR] THEN
5003  REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]
5004QED
5005
5006Theorem CLOSURE_OPEN_IN_INTER_CLOSURE:
5007   !s t u:real->bool.
5008     open_in (subtopology euclidean u) s /\ t SUBSET u
5009     ==> (closure(s INTER closure t) = closure(s INTER t))
5010Proof
5011  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
5012  SIMP_TAC std_ss [CLOSURE_SUBSET, SUBSET_CLOSURE, SET_RULE
5013  ``t SUBSET u ==> s INTER t SUBSET s INTER u``] THEN
5014  REWRITE_TAC[SUBSET_DEF, CLOSURE_APPROACHABLE] THEN
5015  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
5016  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
5017  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
5018  ASM_REWRITE_TAC[REAL_LT_HALF1, IN_INTER, CLOSURE_APPROACHABLE] THEN
5019  DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
5020  UNDISCH_TAC ``open_in (subtopology euclidean u) s`` THEN
5021  REWRITE_TAC [open_in] THEN REWRITE_TAC[SUBSET_DEF] THEN
5022  DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC ``y:real``)) THEN
5023  ASM_REWRITE_TAC[] THEN
5024  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
5025  UNDISCH_TAC ``!e. 0 < e ==> ?y'. y' IN t /\ dist (y',y) < e`` THEN
5026  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``min d (e / &2:real)``) THEN
5027  ASM_REWRITE_TAC[REAL_LT_HALF1, REAL_LT_MIN] THEN
5028  DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN EXISTS_TAC ``z:real`` THEN
5029  POP_ASSUM MP_TAC THEN
5030  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET_DEF]) THEN ASM_SIMP_TAC std_ss [] THEN
5031  STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5032  EXISTS_TAC ``dist(z,y) + dist(y,x)`` THEN REWRITE_TAC [DIST_TRIANGLE] THEN
5033  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
5034  MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC []
5035QED
5036
5037Theorem CLOSURE_OPEN_INTER_CLOSURE:
5038   !s t:real->bool.
5039   open s ==> (closure(s INTER closure t) = closure(s INTER t))
5040Proof
5041  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_IN_INTER_CLOSURE THEN
5042  EXISTS_TAC ``univ(:real)`` THEN
5043  ASM_REWRITE_TAC[SUBSET_UNIV, GSYM OPEN_IN, SUBTOPOLOGY_UNIV]
5044QED
5045
5046Theorem OPEN_INTER_CLOSURE_SUBSET:
5047   !s t:real->bool.
5048        open s ==> (s INTER (closure t)) SUBSET closure(s INTER t)
5049Proof
5050  REPEAT STRIP_TAC THEN
5051  SIMP_TAC std_ss [SUBSET_DEF, IN_INTER, closure, IN_UNION, GSPECIFICATION] THEN
5052  X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5053  DISJ2_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
5054  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
5055  UNDISCH_TAC ``open s`` THEN REWRITE_TAC [open_def] THEN
5056  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
5057  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
5058  UNDISCH_TAC ``x limit_point_of t`` THEN REWRITE_TAC [LIMPT_APPROACHABLE] THEN
5059  DISCH_THEN(MP_TAC o SPEC ``min d e:real``) THEN
5060  ASM_REWRITE_TAC[REAL_LT_MIN, IN_INTER] THEN STRIP_TAC THEN
5061  EXISTS_TAC ``x':real`` THEN ASM_MESON_TAC[]
5062QED
5063
5064Theorem CLOSURE_OPEN_INTER_SUPERSET:
5065   !s t:real->bool.
5066        open s /\ s SUBSET closure t ==> (closure(s INTER t) = closure s)
5067Proof
5068  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
5069  SIMP_TAC std_ss [SUBSET_CLOSURE, INTER_SUBSET] THEN
5070  MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CLOSURE] THEN
5071  W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_SUBSET o rand o snd) THEN
5072  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] SUBSET_TRANS) THEN
5073  ASM_SET_TAC[]
5074QED
5075
5076Theorem CLOSURE_COMPLEMENT:
5077   !s:real->bool. closure(UNIV DIFF s) = UNIV DIFF interior(s)
5078Proof
5079  REWRITE_TAC[SET_RULE ``(s = UNIV DIFF t) <=> (UNIV DIFF s = t)``] THEN
5080  REWRITE_TAC[GSYM INTERIOR_CLOSURE]
5081QED
5082
5083Theorem INTERIOR_COMPLEMENT:
5084   !s:real->bool. interior(UNIV DIFF s) = UNIV DIFF closure(s)
5085Proof
5086  REWRITE_TAC[SET_RULE ``(s = UNIV DIFF t) <=> (UNIV DIFF s = t)``] THEN
5087  REWRITE_TAC[GSYM CLOSURE_INTERIOR]
5088QED
5089
5090Theorem CONNECTED_INTERMEDIATE_CLOSURE:
5091   !s t:real->bool.
5092   connected s /\ s SUBSET t /\ t SUBSET closure s ==> connected t
5093Proof
5094  REPEAT GEN_TAC THEN
5095  KNOW_TAC ``(!e1 e2.
5096      ~(open e1 /\ open e2 /\
5097        s SUBSET e1 UNION e2 /\ (e1 INTER e2 INTER s = {}) /\
5098        ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))) /\
5099        s SUBSET t /\ t SUBSET closure s
5100 ==> (!e1 e2.
5101          ~(open e1 /\ open e2 /\
5102            t SUBSET e1 UNION e2 /\ (e1 INTER e2 INTER t = {}) /\
5103            ~(e1 INTER t = {}) /\ ~(e2 INTER t = {})))`` THENL
5104  [ALL_TAC, SIMP_TAC std_ss [connected, NOT_EXISTS_THM]] THEN
5105  STRIP_TAC THEN MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
5106  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [``u:real->bool``, ``v:real->bool``]) THEN
5107  ASM_REWRITE_TAC[] THEN ASSUME_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN
5108  CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
5109  REWRITE_TAC[GSYM DE_MORGAN_THM] THEN STRIP_TAC THENL
5110  [SUBGOAL_THEN ``(closure s) SUBSET (univ(:real) DIFF u)`` MP_TAC THENL
5111  [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED], ALL_TAC],
5112  SUBGOAL_THEN ``(closure s) SUBSET (univ(:real) DIFF v)`` MP_TAC THENL
5113  [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED],
5114   ALL_TAC]] THEN ASM_SET_TAC[]
5115QED
5116
5117Theorem CONNECTED_CLOSURE:
5118   !s:real->bool. connected s ==> connected(closure s)
5119Proof
5120  MESON_TAC[CONNECTED_INTERMEDIATE_CLOSURE, CLOSURE_SUBSET, SUBSET_REFL]
5121QED
5122
5123Theorem CONNECTED_UNION_STRONG:
5124   !s t:real->bool.
5125    connected s /\ connected t /\ ~(closure s INTER t = {})
5126    ==> connected(s UNION t)
5127Proof
5128  REPEAT STRIP_TAC THEN
5129  POP_ASSUM (MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
5130  DISCH_THEN(X_CHOOSE_TAC ``p:real``) THEN
5131  SUBGOAL_THEN ``s UNION t = ((p:real) INSERT s) UNION t`` SUBST1_TAC THENL
5132  [ASM_SET_TAC[], ALL_TAC] THEN
5133  MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5134  [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
5135   EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
5136   MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[],
5137   ASM_SET_TAC[]]
5138QED
5139
5140Theorem INTERIOR_DIFF:
5141   !s t. interior(s DIFF t) = interior(s) DIFF closure(t)
5142Proof
5143  ONCE_REWRITE_TAC[SET_RULE ``s DIFF t = s INTER (UNIV DIFF t)``] THEN
5144  REWRITE_TAC[INTERIOR_INTER, CLOSURE_INTERIOR] THEN SET_TAC[]
5145QED
5146
5147Theorem LIMPT_OF_CLOSURE:
5148   !x:real s. x limit_point_of closure s <=> x limit_point_of s
5149Proof
5150  SIMP_TAC std_ss [closure, IN_UNION, GSPECIFICATION, LIMIT_POINT_UNION] THEN
5151  REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN
5152  REWRITE_TAC[LIMPT_OF_LIMPTS]
5153QED
5154
5155Theorem CLOSED_IN_LIMPT:
5156   !s t. closed_in (subtopology euclidean t) s <=>
5157    s SUBSET t /\ !x:real. x limit_point_of s /\ x IN t ==> x IN s
5158Proof
5159  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EQ_TAC THENL
5160  [DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
5161  ASM_SIMP_TAC std_ss [IN_INTER] THEN
5162  ASM_MESON_TAC[CLOSED_LIMPT, LIMPT_SUBSET, INTER_SUBSET],
5163  STRIP_TAC THEN EXISTS_TAC ``closure s :real->bool`` THEN
5164  REWRITE_TAC[CLOSED_CLOSURE] THEN REWRITE_TAC[closure] THEN
5165  ASM_SET_TAC[]]
5166QED
5167
5168Theorem CLOSED_IN_INTER_CLOSURE:
5169   !s t:real->bool.
5170    closed_in (subtopology euclidean s) t <=> (s INTER closure t = t)
5171Proof
5172  REWRITE_TAC[closure, CLOSED_IN_LIMPT] THEN SET_TAC[]
5173QED
5174
5175Theorem INTERIOR_CLOSURE_IDEMP:
5176   !s:real->bool.
5177    interior(closure(interior(closure s))) = interior(closure s)
5178Proof
5179  GEN_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN
5180  ASM_MESON_TAC[OPEN_INTERIOR, CLOSURE_SUBSET, CLOSURE_CLOSURE, SUBSET_TRANS,
5181                OPEN_SUBSET_INTERIOR, SUBSET_CLOSURE, INTERIOR_SUBSET]
5182QED
5183
5184Theorem CLOSURE_INTERIOR_IDEMP:
5185   !s:real->bool.
5186    closure(interior(closure(interior s))) = closure(interior s)
5187Proof
5188  GEN_TAC THEN
5189  ONCE_REWRITE_TAC[SET_RULE ``(s = t) <=> (UNIV DIFF s = UNIV DIFF t)``] THEN
5190  REWRITE_TAC[GSYM INTERIOR_COMPLEMENT, GSYM CLOSURE_COMPLEMENT] THEN
5191  REWRITE_TAC[INTERIOR_CLOSURE_IDEMP]
5192QED
5193
5194Theorem NOWHERE_DENSE_UNION:
5195   !s t:real->bool.
5196   (interior(closure(s UNION t)) = {}) <=>
5197   (interior(closure s) = {}) /\ (interior(closure t) = {})
5198Proof
5199  SIMP_TAC std_ss [CLOSURE_UNION, INTERIOR_UNION_EQ_EMPTY, CLOSED_CLOSURE]
5200QED
5201
5202Theorem NOWHERE_DENSE:
5203   !s:real->bool. (interior(closure s) = {}) <=>
5204              !t. open t /\ ~(t = {})
5205          ==> ?u. open u /\ ~(u = {}) /\ u SUBSET t /\ (u INTER s = {})
5206Proof
5207  GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY_ALT] THEN EQ_TAC THEN
5208  DISCH_TAC THEN X_GEN_TAC ``t:real->bool`` THEN STRIP_TAC THENL
5209  [EXISTS_TAC ``t DIFF closure s:real->bool`` THEN
5210  ASM_SIMP_TAC std_ss [OPEN_DIFF, CLOSED_CLOSURE] THEN
5211  MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN SET_TAC[],
5212  FIRST_X_ASSUM(MP_TAC o SPEC ``t:real->bool``) THEN ASM_REWRITE_TAC[] THEN
5213  DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
5214  MP_TAC(ISPECL [``u:real->bool``, ``s:real->bool``]
5215  OPEN_INTER_CLOSURE_EQ_EMPTY) THEN ASM_SET_TAC[]]
5216QED
5217
5218Theorem INTERIOR_CLOSURE_INTER_OPEN:
5219   !s t:real->bool. open s /\ open t
5220        ==> (interior(closure(s INTER t)) =
5221             interior(closure s) INTER interior(closure t))
5222Proof
5223  REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
5224  ``(u = s INTER t) <=> s INTER t SUBSET u /\ u SUBSET s /\ u SUBSET t``] THEN
5225  SIMP_TAC std_ss [SUBSET_INTERIOR, SUBSET_CLOSURE, INTER_SUBSET] THEN
5226  MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC std_ss [OPEN_INTER, OPEN_INTERIOR] THEN
5227  REWRITE_TAC[SET_RULE ``s SUBSET t <=> (s INTER (UNIV DIFF t) = {})``,
5228   GSYM INTERIOR_COMPLEMENT] THEN
5229  REWRITE_TAC[GSYM INTERIOR_INTER] THEN
5230  REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN
5231  X_GEN_TAC ``u:real->bool`` THEN STRIP_TAC THEN
5232  MP_TAC(ISPECL [``u INTER s:real->bool``, ``t:real->bool``]
5233   OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
5234  MP_TAC(ISPECL [``u:real->bool``, ``s:real->bool``]
5235   OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
5236  ASM_SIMP_TAC std_ss [OPEN_INTER] THEN ASM_SET_TAC[]
5237QED
5238
5239Theorem CLOSURE_INTERIOR_UNION_CLOSED:
5240   !s t:real->bool. closed s /\ closed t
5241        ==> (closure (interior (s UNION t)) =
5242             closure (interior s) UNION closure(interior t))
5243Proof
5244  REPEAT GEN_TAC THEN REWRITE_TAC[closed_def] THEN
5245  DISCH_THEN(MP_TAC o MATCH_MP INTERIOR_CLOSURE_INTER_OPEN) THEN
5246  REWRITE_TAC[CLOSURE_COMPLEMENT, INTERIOR_COMPLEMENT,
5247  SET_RULE ``(UNIV DIFF s) INTER (UNIV DIFF t) = UNIV DIFF (s UNION t)``] THEN
5248  SET_TAC[]
5249QED
5250
5251Theorem REGULAR_OPEN_INTER:
5252   !s t:real->bool.
5253    (interior(closure s) = s) /\ (interior(closure t) = t)
5254     ==> (interior(closure(s INTER t)) = s INTER t)
5255Proof
5256  MESON_TAC[INTERIOR_CLOSURE_INTER_OPEN, OPEN_INTERIOR]
5257QED
5258
5259Theorem REGULAR_CLOSED_UNION:
5260   !s t:real->bool.
5261  (closure(interior s) = s) /\ (closure(interior t) = t)
5262   ==> (closure(interior(s UNION t)) = s UNION t)
5263Proof
5264  MESON_TAC[CLOSURE_INTERIOR_UNION_CLOSED, CLOSED_CLOSURE]
5265QED
5266
5267Theorem REGULAR_CLOSED_BIGUNION:
5268   !f:(real->bool)->bool.
5269    FINITE f /\ (!t. t IN f ==> (closure(interior t) = t))
5270    ==> (closure(interior(BIGUNION f)) = BIGUNION f)
5271Proof
5272  REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
5273  KNOW_TAC ``!f. ((!t. t IN f ==> (closure(interior t) = t))
5274         ==> (closure(interior(BIGUNION f)) = BIGUNION f)) =
5275           (\f. (!t. t IN f ==> (closure(interior t) = t))
5276         ==> (closure(interior(BIGUNION f)) = BIGUNION f)) f`` THENL
5277  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
5278  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
5279  REWRITE_TAC[BIGUNION_INSERT, BIGUNION_EMPTY, INTERIOR_EMPTY, CLOSURE_EMPTY] THEN
5280  SIMP_TAC std_ss [FORALL_IN_INSERT, REGULAR_CLOSED_UNION]
5281QED
5282
5283Theorem DIFF_CLOSURE_SUBSET:
5284   !s t:real->bool. closure(s) DIFF closure t SUBSET closure(s DIFF t)
5285Proof
5286  REPEAT GEN_TAC THEN
5287  MP_TAC(ISPECL [``univ(:real) DIFF closure t``, ``s:real->bool``]
5288   OPEN_INTER_CLOSURE_SUBSET) THEN
5289  REWRITE_TAC[SET_RULE ``(UNIV DIFF t) INTER s = s DIFF t``] THEN
5290  REWRITE_TAC[GSYM closed_def, CLOSED_CLOSURE] THEN
5291  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
5292  MATCH_MP_TAC SUBSET_CLOSURE THEN
5293  MATCH_MP_TAC(SET_RULE ``t SUBSET u ==> s DIFF u SUBSET s DIFF t``) THEN
5294  REWRITE_TAC[CLOSURE_SUBSET]
5295QED
5296
5297Theorem DENSE_OPEN_INTER:
5298   !s t u:real->bool.
5299  (open_in (subtopology euclidean u) s /\ t SUBSET u \/
5300   open_in (subtopology euclidean u) t /\ s SUBSET u)
5301   ==> (u SUBSET closure (s INTER t) <=>
5302        u SUBSET closure s /\ u SUBSET closure t)
5303Proof
5304  KNOW_TAC ``((!s t u.
5305      (u SUBSET closure (s INTER t) <=>
5306       u SUBSET closure s /\ u SUBSET closure t)
5307      ==> (u SUBSET closure (t INTER s) <=>
5308           u SUBSET closure t /\ u SUBSET closure s)) /\
5309 (!s t u.
5310      open_in (subtopology euclidean u) s /\ t SUBSET u
5311      ==> (u SUBSET closure (s INTER t) <=>
5312           u SUBSET closure s /\ u SUBSET closure t)))`` THENL
5313  [ALL_TAC, METIS_TAC []] THEN CONJ_TAC THENL
5314  [SIMP_TAC std_ss [INTER_COMM, CONJ_ACI], ALL_TAC] THEN
5315  REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL
5316  [ASM_MESON_TAC[SUBSET_TRANS, SUBSET_CLOSURE, INTER_SUBSET], ALL_TAC] THEN
5317  REWRITE_TAC[SUBSET_DEF, CLOSURE_APPROACHABLE] THEN DISCH_TAC THEN
5318  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
5319  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
5320  FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC ``x:real``) ASSUME_TAC) THEN
5321  ASM_REWRITE_TAC[] THEN
5322  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
5323  DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
5324  FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN
5325  UNDISCH_TAC ``open_in (subtopology euclidean u) s`` THEN REWRITE_TAC [open_in] THEN
5326  REWRITE_TAC[SUBSET_DEF, IN_INTER] THEN
5327  DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC ``y:real``)) THEN
5328  ASM_REWRITE_TAC[] THEN
5329  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
5330  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC ``min d (e / &2):real``) THEN
5331  ASM_REWRITE_TAC[REAL_HALF, REAL_LT_MIN] THEN
5332  DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN EXISTS_TAC ``z:real`` THEN
5333  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET_DEF]) THEN ASM_SIMP_TAC std_ss [] THEN
5334  POP_ASSUM MP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5335  EXISTS_TAC ``dist(z,y) + dist(y,x)`` THEN REWRITE_TAC [DIST_TRIANGLE] THEN
5336  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
5337  MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC []
5338QED
5339
5340(* ------------------------------------------------------------------------- *)
5341(* Frontier (aka boundary).                                                  *)
5342(* ------------------------------------------------------------------------- *)
5343
5344Definition frontier_def :
5345    frontier s = euclidean frontier_of s
5346End
5347
5348Theorem frontier :
5349    !s. frontier s = (closure s) DIFF (interior s)
5350Proof
5351    rw [frontier_def, frontier_of, closure_def, interior_def]
5352QED
5353
5354Theorem FRONTIER_CLOSED:
5355   !s. closed(frontier s)
5356Proof
5357  SIMP_TAC std_ss [frontier, CLOSED_DIFF, CLOSED_CLOSURE, OPEN_INTERIOR]
5358QED
5359
5360Theorem FRONTIER_CLOSURES:
5361   !s:real->bool. frontier s = (closure s) INTER (closure(UNIV DIFF s))
5362Proof
5363  REWRITE_TAC[frontier, INTERIOR_CLOSURE,
5364   SET_RULE ``s DIFF (UNIV DIFF t) = s INTER t``]
5365QED
5366
5367Theorem FRONTIER_STRADDLE:
5368   !a:real s.
5369    a IN frontier s <=> !e. &0 < e ==> (?x. x IN s /\ dist(a,x) < e) /\
5370    (?x. ~(x IN s) /\ dist(a,x) < e)
5371Proof
5372  REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES, IN_INTER] THEN
5373  SIMP_TAC std_ss [closure, IN_UNION, GSPECIFICATION, limit_point_of,
5374  IN_UNIV, IN_DIFF] THEN
5375  ASM_MESON_TAC[IN_BALL, SUBSET_DEF, OPEN_CONTAINS_BALL,
5376  CENTRE_IN_BALL, OPEN_BALL, DIST_REFL]
5377QED
5378
5379Theorem FRONTIER_SUBSET_CLOSED:
5380   !s. closed s ==> (frontier s) SUBSET s
5381Proof
5382  METIS_TAC[frontier, CLOSURE_CLOSED, DIFF_SUBSET]
5383QED
5384
5385Theorem FRONTIER_EMPTY:
5386   frontier {} = {}
5387Proof
5388  REWRITE_TAC[frontier, CLOSURE_EMPTY, EMPTY_DIFF]
5389QED
5390
5391Theorem FRONTIER_UNIV:
5392   frontier univ(:real) = {}
5393Proof
5394  REWRITE_TAC[frontier, CLOSURE_UNIV, INTERIOR_UNIV] THEN SET_TAC[]
5395QED
5396
5397Theorem FRONTIER_SUBSET_EQ:
5398   !s:real->bool. (frontier s) SUBSET s <=> closed s
5399Proof
5400  GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [FRONTIER_SUBSET_CLOSED] THEN
5401  REWRITE_TAC[frontier] THEN
5402  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
5403  ``s DIFF t SUBSET u ==> t SUBSET u ==> s SUBSET u``)) THEN
5404  REWRITE_TAC[INTERIOR_SUBSET, CLOSURE_SUBSET_EQ]
5405QED
5406
5407Theorem FRONTIER_COMPLEMENT:
5408   !s:real->bool. frontier(UNIV DIFF s) = frontier s
5409Proof
5410  REWRITE_TAC[frontier, CLOSURE_COMPLEMENT, INTERIOR_COMPLEMENT] THEN
5411  SET_TAC[]
5412QED
5413
5414Theorem FRONTIER_DISJOINT_EQ:
5415   !s. ((frontier s) INTER s = {}) <=> open s
5416Proof
5417  ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT, OPEN_CLOSED] THEN
5418  REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN SET_TAC[]
5419QED
5420
5421Theorem FRONTIER_INTER_SUBSET:
5422   !s t. frontier(s INTER t) SUBSET frontier(s) UNION frontier(t)
5423Proof
5424  REPEAT GEN_TAC THEN REWRITE_TAC[frontier, INTERIOR_INTER] THEN
5425  MATCH_MP_TAC(SET_RULE ``cst SUBSET cs INTER ct
5426  ==> cst DIFF (s INTER t) SUBSET (cs DIFF s) UNION (ct DIFF t)``) THEN
5427  REWRITE_TAC[CLOSURE_INTER_SUBSET]
5428QED
5429
5430Theorem FRONTIER_UNION_SUBSET:
5431   !s t:real->bool. frontier(s UNION t) SUBSET frontier s UNION frontier t
5432Proof
5433  ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
5434  REWRITE_TAC[SET_RULE ``u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)``] THEN
5435  REWRITE_TAC[FRONTIER_INTER_SUBSET]
5436QED
5437
5438Theorem FRONTIER_INTERIORS:
5439   !s. frontier s = univ(:real) DIFF interior(s) DIFF interior(univ(:real) DIFF s)
5440Proof
5441  REWRITE_TAC[frontier, CLOSURE_INTERIOR] THEN SET_TAC[]
5442QED
5443
5444Theorem FRONTIER_FRONTIER_SUBSET:
5445   !s:real->bool. frontier(frontier s) SUBSET frontier s
5446Proof
5447  GEN_TAC THEN GEN_REWR_TAC LAND_CONV [frontier] THEN
5448  SIMP_TAC std_ss [CLOSURE_CLOSED, FRONTIER_CLOSED] THEN SET_TAC[]
5449QED
5450
5451Theorem INTERIOR_FRONTIER:
5452   !s:real->bool.
5453    interior(frontier s) = interior(closure s) DIFF closure(interior s)
5454Proof
5455  ONCE_REWRITE_TAC[SET_RULE ``s DIFF t = s INTER (UNIV DIFF t)``] THEN
5456  REWRITE_TAC[GSYM INTERIOR_COMPLEMENT, GSYM INTERIOR_INTER, frontier] THEN
5457  GEN_TAC THEN AP_TERM_TAC THEN SET_TAC[]
5458QED
5459
5460Theorem INTERIOR_FRONTIER_EMPTY:
5461   !s:real->bool. open s \/ closed s ==> (interior(frontier s) = {})
5462Proof
5463  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERIOR_FRONTIER] THEN
5464  ASM_SIMP_TAC std_ss [CLOSURE_CLOSED, INTERIOR_OPEN] THEN
5465  REWRITE_TAC[SET_RULE ``(s DIFF t = {}) <=> s SUBSET t``] THEN
5466  REWRITE_TAC[INTERIOR_SUBSET, CLOSURE_SUBSET]
5467QED
5468
5469Theorem FRONTIER_FRONTIER:
5470   !s:real->bool. open s \/ closed s ==> (frontier(frontier s) = frontier s)
5471Proof
5472  GEN_TAC THEN GEN_REWR_TAC (RAND_CONV o LAND_CONV) [frontier] THEN STRIP_TAC THEN
5473  ASM_SIMP_TAC std_ss [INTERIOR_FRONTIER_EMPTY, CLOSURE_CLOSED, FRONTIER_CLOSED] THEN
5474  REWRITE_TAC[DIFF_EMPTY]
5475QED
5476
5477Theorem FRONTIER_FRONTIER_FRONTIER:
5478   !s:real->bool. frontier(frontier(frontier s)) = frontier(frontier s)
5479Proof
5480  SIMP_TAC std_ss [FRONTIER_FRONTIER, FRONTIER_CLOSED]
5481QED
5482
5483Theorem lemma[local]:
5484   !s t x. x IN frontier s /\ x IN interior t ==> x IN frontier(s INTER t)
5485Proof
5486  REWRITE_TAC[FRONTIER_STRADDLE, IN_INTER, IN_INTERIOR, SUBSET_DEF, IN_BALL] THEN
5487  REPEAT GEN_TAC THEN
5488  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC ``d:real``)) THEN
5489  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
5490  FIRST_X_ASSUM(MP_TAC o SPEC ``min d e:real``) THEN
5491  ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]
5492QED
5493
5494Theorem UNION_FRONTIER:
5495   !s t:real->bool. frontier(s) UNION frontier(t) =
5496   frontier(s UNION t) UNION frontier(s INTER t) UNION
5497   frontier(s) INTER frontier(t)
5498Proof
5499  REWRITE_TAC[SET_EQ_SUBSET, UNION_SUBSET,
5500   FRONTIER_UNION_SUBSET, FRONTIER_INTER_SUBSET,
5501   SET_RULE ``s INTER t SUBSET s UNION t``] THEN
5502  REWRITE_TAC[GSYM UNION_SUBSET] THEN REWRITE_TAC[SUBSET_DEF, IN_UNION] THEN
5503  KNOW_TAC ``((!s t x. x IN frontier s
5504      ==> x IN frontier (s UNION t) \/
5505          x IN frontier (s INTER t) \/
5506          x IN frontier s INTER frontier t) /\
5507 (!s t x.
5508      x IN frontier (s UNION t) \/
5509      x IN frontier (s INTER t) \/
5510      x IN frontier s INTER frontier t <=>
5511      x IN frontier (t UNION s) \/
5512      x IN frontier (t INTER s) \/
5513      x IN frontier t INTER frontier s))`` THENL
5514  [ALL_TAC, METIS_TAC []] THEN CONJ_TAC THENL
5515  [REPEAT STRIP_TAC, SIMP_TAC std_ss [UNION_COMM, INTER_COMM]] THEN
5516  ASM_CASES_TAC ``(x:real) IN frontier t`` THEN ASM_REWRITE_TAC[IN_INTER] THEN
5517  POP_ASSUM MP_TAC THEN GEN_REWR_TAC (LAND_CONV o RAND_CONV o RAND_CONV)
5518   [FRONTIER_INTERIORS] THEN
5519  REWRITE_TAC[DE_MORGAN_THM, IN_DIFF, IN_UNIV] THEN
5520  GEN_REWR_TAC RAND_CONV [DISJ_SYM] THEN MATCH_MP_TAC MONO_OR THEN
5521  ASM_SIMP_TAC std_ss [lemma] THEN
5522  POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
5523  SIMP_TAC std_ss [lemma, SET_RULE
5524  ``UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)``]
5525QED
5526
5527Theorem CONNECTED_INTER_FRONTIER:
5528   !s t:real->bool.
5529    connected s /\ ~(s INTER t = {}) /\ ~(s DIFF t = {})
5530    ==> ~(s INTER frontier t = {})
5531Proof
5532  REWRITE_TAC[FRONTIER_INTERIORS] THEN REPEAT STRIP_TAC THEN
5533  UNDISCH_TAC ``connected s`` THEN REWRITE_TAC [CONNECTED_OPEN_IN] THEN
5534  MAP_EVERY EXISTS_TAC
5535   [``s INTER interior t:real->bool``,
5536    ``s INTER (interior(univ(:real) DIFF t))``] THEN
5537  SIMP_TAC std_ss [OPEN_IN_OPEN_INTER, OPEN_INTERIOR] THEN
5538  MAP_EVERY (MP_TAC o C ISPEC INTERIOR_SUBSET)
5539   [``t:real->bool``, ``univ(:real) DIFF t``] THEN
5540  ASM_SET_TAC[]
5541QED
5542
5543Theorem INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER:
5544   !s:real->bool. closed s /\ (interior s = {}) <=>
5545                ?t. open t /\ (s = frontier t)
5546Proof
5547  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5548  [EXISTS_TAC ``univ(:real) DIFF s`` THEN
5549  ASM_SIMP_TAC std_ss [OPEN_DIFF, OPEN_UNIV, FRONTIER_COMPLEMENT] THEN
5550  ASM_SIMP_TAC std_ss [frontier, CLOSURE_CLOSED, DIFF_EMPTY],
5551  ASM_SIMP_TAC std_ss [FRONTIER_CLOSED, INTERIOR_FRONTIER_EMPTY]]
5552QED
5553
5554Theorem FRONTIER_UNION:
5555   !s t:real->bool. (closure s INTER closure t = {})
5556    ==> (frontier(s UNION t) = frontier(s) UNION frontier(t))
5557Proof
5558  REPEAT STRIP_TAC THEN
5559  MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[FRONTIER_UNION_SUBSET] THEN
5560  GEN_REWR_TAC RAND_CONV [frontier] THEN
5561  REWRITE_TAC[CLOSURE_UNION] THEN MATCH_MP_TAC(SET_RULE
5562  ``(fs SUBSET cs /\ ft SUBSET ct) /\ (k INTER fs = {}) /\ (k INTER ft = {})
5563    ==> (fs UNION ft) SUBSET (cs UNION ct) DIFF k``) THEN
5564  CONJ_TAC THENL [REWRITE_TAC[frontier] THEN SET_TAC[], ALL_TAC] THEN
5565  CONJ_TAC THENL [ALL_TAC,
5566   ONCE_REWRITE_TAC[UNION_COMM] THEN
5567   RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTER_COMM])] THEN
5568   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5569   ``(s INTER t = {}) ==> s' SUBSET s /\ (s' INTER u INTER (UNIV DIFF t) = {})
5570     ==> (u INTER s' = {})``)) THEN
5571  REWRITE_TAC[frontier, DIFF_SUBSET, GSYM INTERIOR_COMPLEMENT] THENL
5572  [KNOW_TAC ``(closure s DIFF interior s) INTER
5573                     interior (s UNION t) INTER
5574            interior (univ(:real) DIFF t) =
5575              (closure s DIFF interior s) INTER
5576           interior ((s UNION t) INTER (univ(:real) DIFF t))`` THENL
5577   [METIS_TAC [INTERIOR_INTER, INTER_ASSOC], ALL_TAC] THEN DISC_RW_KILL,
5578   KNOW_TAC ``(closure t DIFF interior t) INTER
5579                    interior (t UNION s) INTER
5580           interior (univ(:real) DIFF s) =
5581             (closure t DIFF interior t) INTER
5582           interior ((t UNION s) INTER (univ(:real) DIFF s))`` THENL
5583   [METIS_TAC [INTERIOR_INTER, INTER_ASSOC], ALL_TAC] THEN DISC_RW_KILL] THEN
5584  REWRITE_TAC[SET_RULE ``(s UNION t) INTER (UNIV DIFF t) = s DIFF t``] THEN
5585  MATCH_MP_TAC(SET_RULE
5586  ``ti SUBSET si ==> ((c DIFF si) INTER ti = {})``) THEN
5587  SIMP_TAC std_ss [SUBSET_INTERIOR, DIFF_SUBSET]
5588QED
5589
5590Theorem CLOSURE_UNION_FRONTIER:
5591   !s:real->bool. closure s = s UNION frontier s
5592Proof
5593  GEN_TAC THEN REWRITE_TAC[frontier] THEN
5594  MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN
5595  MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN
5596  SET_TAC[]
5597QED
5598
5599Theorem FRONTIER_INTERIOR_SUBSET:
5600   !s:real->bool. frontier(interior s) SUBSET frontier s
5601Proof
5602  GEN_TAC THEN REWRITE_TAC[frontier, INTERIOR_INTERIOR] THEN
5603  MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> s DIFF u SUBSET t DIFF u``) THEN
5604  SIMP_TAC std_ss [SUBSET_CLOSURE, INTERIOR_SUBSET]
5605QED
5606
5607Theorem FRONTIER_CLOSURE_SUBSET:
5608   !s:real->bool. frontier(closure s) SUBSET frontier s
5609Proof
5610  GEN_TAC THEN REWRITE_TAC[frontier, CLOSURE_CLOSURE] THEN
5611  MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> u DIFF t SUBSET u DIFF s``) THEN
5612  SIMP_TAC std_ss [SUBSET_INTERIOR, CLOSURE_SUBSET]
5613QED
5614
5615Theorem SET_DIFF_FRONTIER:
5616   !s:real->bool. s DIFF frontier s = interior s
5617Proof
5618  GEN_TAC THEN REWRITE_TAC[frontier] THEN
5619  MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN
5620  MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN
5621  SET_TAC[]
5622QED
5623
5624Theorem FRONTIER_INTER_SUBSET_INTER:
5625   !s t:real->bool.
5626   frontier(s INTER t) SUBSET closure s INTER frontier t UNION
5627   frontier s INTER closure t
5628Proof
5629  REPEAT GEN_TAC THEN REWRITE_TAC[frontier, INTERIOR_INTER] THEN
5630  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``]
5631   CLOSURE_INTER_SUBSET) THEN SET_TAC[]
5632QED
5633
5634(* ------------------------------------------------------------------------- *)
5635(* Identify trivial limits, where we can't approach arbitrarily closely.     *)
5636(* ------------------------------------------------------------------------- *)
5637
5638(* |- !a s. net_condition (at a) s <=> a limit_point_of s *)
5639Theorem net_condition_at =
5640        NET_CONDITION_AT
5641     |> REWRITE_RULE [GSYM euclidean_def, GSYM limit_point_of_def]
5642
5643Theorem net_condition_open_in :
5644    !a s. open s /\ a IN s ==> net_condition (at a) s
5645Proof
5646    rw [net_condition_at, LIMPT_OF_OPEN]
5647QED
5648
5649Theorem limit_point_of_empty :
5650    !a. ~(a limit_point_of {})
5651Proof
5652    rw [limit_point_of_def, euclidean_def, MTOP_LIMPT', GSYM dist_def]
5653 >> Q.EXISTS_TAC ‘1’ >> simp []
5654QED
5655
5656Theorem net_condition_interior :
5657    !x s. x IN interior s ==> net_condition (at x) s
5658Proof
5659    RW_TAC std_ss [NET_CONDITION_AT]
5660 >> FULL_SIMP_TAC std_ss [IN_INTERIOR]
5661 >> MATCH_MP_TAC limpt_mono
5662 >> Q.EXISTS_TAC ‘ball (x,e)’ >> art []
5663 >> simp [GSYM euclidean_def, GSYM limit_point_of_def]
5664 >> MATCH_MP_TAC LIMPT_OF_OPEN
5665 >> simp [OPEN_BALL, CENTRE_IN_BALL]
5666QED
5667
5668Theorem TRIVIAL_LIMIT_WITHIN :
5669    !a:real. trivial_limit (at a within s) <=> ~(a limit_point_of s)
5670Proof
5671  REWRITE_TAC[trivial_limit, LIMPT_APPROACHABLE_LE, WITHIN, AT, DIST_NZ] THEN
5672  REPEAT GEN_TAC THEN EQ_TAC THENL
5673   [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
5674     [MESON_TAC[REAL_LT_01, REAL_LT_REFL, REAL_CHOOSE_DIST,
5675                DIST_REFL, REAL_LT_IMP_LE],
5676      DISCH_THEN(X_CHOOSE_THEN ``b:real`` (X_CHOOSE_THEN ``c:real``
5677        STRIP_ASSUME_TAC)) THEN
5678      SUBGOAL_THEN ``&0 < dist(a,b:real) \/ &0 < dist(a,c:real)`` MP_TAC THEN
5679      ASM_MESON_TAC[DIST_TRIANGLE, DIST_SYM, GSYM DIST_NZ, GSYM DIST_EQ_0,
5680                    REAL_ARITH ``x:real <= &0 + &0 ==> ~(&0 < x)``]],
5681    Know ‘!e. (0 < e ==> ?x'. x' IN s /\ 0 < dist (x',a) /\ dist (x',a) <= e) =
5682           (\e. 0 < e ==> ?x'. x' IN s /\ 0 < dist (x',a) /\ dist (x',a) <= e) e’
5683    >- FULL_SIMP_TAC std_ss [] \\
5684    DISC_RW_KILL THEN
5685    REWRITE_TAC[NOT_FORALL_THM] THEN BETA_TAC THEN REWRITE_TAC [NOT_IMP] THEN
5686    SIMP_TAC std_ss [GSYM LEFT_EXISTS_IMP_THM] THEN
5687    STRIP_TAC THEN DISJ2_TAC THEN
5688    EXISTS_TAC ``a:real`` THEN
5689    SUBGOAL_THEN ``?b:real. dist(a,b) = x`` MP_TAC THENL
5690     [ASM_SIMP_TAC std_ss [REAL_CHOOSE_DIST, REAL_LT_IMP_LE], ALL_TAC] THEN
5691    STRIP_TAC THEN EXISTS_TAC ``b:real`` THEN POP_ASSUM MP_TAC THEN
5692    DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
5693    ASM_MESON_TAC[REAL_NOT_LE, DIST_REFL, DIST_NZ, DIST_SYM]]
5694QED
5695
5696Theorem TRIVIAL_LIMIT_AT:
5697   !a. ~(trivial_limit (at a))
5698Proof
5699  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
5700  REWRITE_TAC[TRIVIAL_LIMIT_WITHIN, LIMPT_UNIV]
5701QED
5702
5703Theorem LIM_WITHIN_CLOSED_TRIVIAL:
5704   !a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)
5705Proof
5706  REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]
5707QED
5708
5709(* ------------------------------------------------------------------------- *)
5710(* Some property holds "sufficiently close" to the limit point.              *)
5711(* ------------------------------------------------------------------------- *)
5712
5713Theorem EVENTUALLY_WITHIN_LE:
5714   !s a:real p.
5715     eventually p (at a within s) <=>
5716        ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)
5717Proof
5718  REWRITE_TAC[eventually, AT, WITHIN, TRIVIAL_LIMIT_WITHIN] THEN
5719  REWRITE_TAC[LIMPT_APPROACHABLE_LE, DIST_NZ] THEN
5720  REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LTE_TRANS], ALL_TAC] THEN
5721  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
5722  MATCH_MP_TAC(TAUT `(a ==> b) ==> ~a \/ b`) THEN DISCH_TAC THEN
5723  SUBGOAL_THEN ``?b:real. dist(a,b) = d`` MP_TAC THENL
5724   [ASM_SIMP_TAC std_ss [REAL_CHOOSE_DIST, REAL_LT_IMP_LE], ALL_TAC] THEN
5725  STRIP_TAC THEN EXISTS_TAC ``b:real`` THEN POP_ASSUM MP_TAC THEN
5726  DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
5727  ASM_MESON_TAC[REAL_NOT_LE, DIST_REFL, DIST_NZ, DIST_SYM]
5728QED
5729
5730Theorem EVENTUALLY_WITHIN:
5731   !s a:real p.
5732     eventually p (at a within s) <=>
5733        ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)
5734Proof
5735  REWRITE_TAC[EVENTUALLY_WITHIN_LE] THEN
5736  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
5737  SIMP_TAC std_ss [APPROACHABLE_LT_LE]
5738QED
5739
5740Theorem EVENTUALLY_AT:
5741   !a p. eventually p (at a) <=>
5742         ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)
5743Proof
5744  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
5745  REWRITE_TAC[EVENTUALLY_WITHIN, IN_UNIV]
5746QED
5747
5748(* ------------------------------------------------------------------------- *)
5749(* Limits, defined as vacuously true when the limit is trivial.              *)
5750(* ------------------------------------------------------------------------- *)
5751
5752val _ = set_fixity "-->" (Infixr 750);
5753
5754(* LONG RIGHTWARDS ARROW *)
5755val _ = Unicode.unicode_version {u = UTF8.chr 0x27F6, tmnm = "-->"};
5756val _ = TeX_notation {hol = UTF8.chr 0x27F6, TeX = ("\\HOLTokenLongmap{}", 1)};
5757val _ = TeX_notation {hol = "-->",           TeX = ("\\HOLTokenLongmap{}", 1)};
5758
5759(* NOTE: This is for (f :'a -> real) (l :real) (net :'a net).
5760         Now the name "tendsto_real" follows HOL-Light's "realanalysis.ml".
5761 *)
5762Overload "-->" = “limit euclidean”
5763
5764(* NOTE: This is the original definition of “tendsto_real” *)
5765Theorem tendsto_real_def :
5766    !f l net. (f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net
5767Proof
5768    rw [limit, TOPSPACE_EUCLIDEAN, GSYM OPEN_IN]
5769 >> EQ_TAC >> rpt STRIP_TAC
5770 >| [ (* goal 1 (of 2) *)
5771      Q.PAT_X_ASSUM ‘!u. open u /\ l IN u ==> P’ (MP_TAC o Q.SPEC ‘ball (l,e)’) \\
5772      simp [OPEN_BALL, IN_BALL, Once DIST_SYM, DIST_REFL],
5773      (* goal 2 (of 2) *)
5774      fs [open_def] \\
5775      Q.PAT_X_ASSUM ‘!x. x IN u ==> P’ (MP_TAC o Q.SPEC ‘l’) >> rw [] \\
5776      Q.PAT_X_ASSUM ‘!e. 0 < e ==> P’  (MP_TAC o Q.SPEC ‘e’) >> rw [] \\
5777      MATCH_MP_TAC EVENTUALLY_MONO \\
5778      Q.EXISTS_TAC ‘\x. dist (f x,l) < e’ >> rw [] ]
5779QED
5780
5781(* |- !f l net.
5782        (f --> l) net <=>
5783        !e. 0 < e ==> eventually (\x. abs (f x - l) < e) net
5784
5785   NOTE: This theorem is compatible with HOL-Light (Multivariate/realanalysis.ml)
5786 *)
5787Theorem tendsto_real = REWRITE_RULE [dist] tendsto_real_def
5788
5789(* This theorem is only used locally for compatibility purposes *)
5790Theorem tendsto[local] = tendsto_real_def
5791
5792Theorem limit_at_alt_tends :
5793    !top f l a. l IN topspace top ==>
5794               (limit top f l (at a) <=> (f tends l) (top,tendsto (mr1,a)))
5795Proof
5796    rw [tendsto_mr1]
5797 >> MATCH_MP_TAC limit_alt_tends
5798 >> rw [TRIVIAL_LIMIT_AT, AT]
5799 >> MATCH_MP_TAC REAL_LTE_TRANS
5800 >> Q.EXISTS_TAC ‘dist (x,a)’ >> art []
5801QED
5802
5803Theorem tendsto_real_alt_tends :
5804    !f l a. (f --> l) (at a) <=> (f tends l) (mtop mr1,tendsto (mr1,a))
5805Proof
5806    rw [GSYM euclidean_def]
5807 >> MP_TAC (ISPEC “euclidean” limit_at_alt_tends)
5808 >> simp [TOPSPACE_EUCLIDEAN]
5809QED
5810
5811(* Now the name "reallim" follows HOL-Light's "realanalysis.ml" *)
5812Definition reallim :
5813    reallim net f = @l. (f --> l) net
5814End
5815Overload lim = “reallim”
5816
5817(* cf. limTheory.LIM *)
5818Theorem LIM_DEF : (* was: LIM *)
5819   !f l net. (f --> l) net <=>
5820        trivial_limit net \/
5821        !e. &0 < e ==> ?y. (?x. netord(net) x y) /\
5822                           !x. netord(net) x y ==> dist(f(x),l) < e
5823Proof
5824  REWRITE_TAC[tendsto, eventually] THEN MESON_TAC[]
5825QED
5826val LIM = LIM_DEF;
5827
5828(* ------------------------------------------------------------------------- *)
5829(* Show that they yield usual definitions in the various cases.              *)
5830(* ------------------------------------------------------------------------- *)
5831
5832Theorem LIM_WITHIN_LE:
5833   !f:real->real l a s.
5834        (f --> l)(at a within s) <=>
5835           !e. &0 < e ==> ?d. &0 < d /\
5836                              !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d
5837                                   ==> dist(f(x),l) < e
5838Proof
5839  SIMP_TAC std_ss [tendsto, EVENTUALLY_WITHIN_LE]
5840QED
5841
5842Theorem LIM_WITHIN:
5843   !f:real->real l a s.
5844      (f --> l) (at a within s) <=>
5845        !e. &0 < e
5846            ==> ?d. &0 < d /\
5847                    !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d
5848                    ==> dist(f(x),l) < e
5849Proof
5850  SIMP_TAC std_ss [tendsto, EVENTUALLY_WITHIN] THEN MESON_TAC[]
5851QED
5852
5853Theorem LIM_AT_LE:
5854   !f l a. (f --> l) (at a) <=>
5855           !e. &0 < e
5856               ==> ?d. &0 < d /\
5857                       !x. &0 < dist(x,a) /\ dist(x,a) <= d
5858                           ==> dist (f x,l) < e
5859Proof
5860  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
5861  REWRITE_TAC[LIM_WITHIN_LE, IN_UNIV]
5862QED
5863
5864Theorem LIM_AT:
5865   !f l:real a:real.
5866      (f --> l) (at a) <=>
5867              !e. &0 < e
5868                  ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d
5869                          ==> dist(f(x),l) < e
5870Proof
5871  REWRITE_TAC[tendsto, EVENTUALLY_AT] THEN MESON_TAC[]
5872QED
5873
5874Theorem LIM_AT_INFINITY:
5875   !f l. (f --> l) at_infinity <=>
5876               !e. &0 < e ==> ?b. !x. abs(x) >= b ==> dist(f(x),l) < e
5877Proof
5878  SIMP_TAC std_ss [tendsto, EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]
5879QED
5880
5881Theorem LIM_AT_INFINITY_POS:
5882   !f l. (f --> l) at_infinity <=>
5883         !e. &0 < e ==> ?b. &0 < b /\ !x. abs x >= b ==> dist(f x,l) < e
5884Proof
5885  REPEAT GEN_TAC THEN SIMP_TAC std_ss [LIM_AT_INFINITY] THEN
5886  METIS_TAC[REAL_ARITH ``&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)``]
5887QED
5888
5889Theorem LIM_AT_POSINFINITY:
5890   !f l. (f --> l) at_posinfinity <=>
5891               !e. &0 < e ==> ?b. !x. x >= b ==> dist(f(x),l) < e
5892Proof
5893  REWRITE_TAC[tendsto, EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]
5894QED
5895
5896Theorem LIM_AT_NEGINFINITY:
5897   !f l. (f --> l) at_neginfinity <=>
5898               !e. &0 < e ==> ?b. !x. x <= b ==> dist(f(x),l) < e
5899Proof
5900  REWRITE_TAC[tendsto, EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]
5901QED
5902
5903Theorem LIM_SEQUENTIALLY:
5904   !s l. (s --> l) sequentially <=>
5905          !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e
5906Proof
5907  REWRITE_TAC[tendsto, EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]
5908QED
5909
5910Theorem LIM_EVENTUALLY:
5911   !net f l. eventually (\x. f x = l) net ==> (f --> l) net
5912Proof
5913  REWRITE_TAC[eventually, LIM] THEN MESON_TAC[DIST_REFL]
5914QED
5915
5916Theorem LIM_POSINFINITY_SEQUENTIALLY:
5917   !f l. (f --> l) at_posinfinity ==> ((\n. f(&n)) --> l) sequentially
5918Proof
5919  REPEAT GEN_TAC THEN
5920  REWRITE_TAC[LIM_AT_POSINFINITY, LIM_SEQUENTIALLY] THEN
5921  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
5922  FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
5923  DISCH_THEN(X_CHOOSE_TAC ``B:real``) THEN
5924  MP_TAC(ISPEC ``B:real`` SIMP_REAL_ARCH) THEN
5925  DISCH_THEN(X_CHOOSE_THEN ``N:num`` STRIP_ASSUME_TAC) THEN
5926  EXISTS_TAC ``N:num`` THEN POP_ASSUM MP_TAC THEN
5927  REPEAT STRIP_TAC THEN BETA_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5928  RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN
5929  METIS_TAC [real_ge, REAL_LE_TRANS]
5930QED
5931
5932Theorem LIM_INFINITY_POSINFINITY:
5933   !f l:real. (f --> l) at_infinity ==> (f --> l) at_posinfinity
5934Proof
5935  SIMP_TAC std_ss [LIM_AT_INFINITY, LIM_AT_POSINFINITY, o_THM] THEN
5936  METIS_TAC[dist, REAL_ARITH ``x >= b ==> abs(x) >= b:real``]
5937QED
5938
5939(* ------------------------------------------------------------------------- *)
5940(* The expected monotonicity property.                                       *)
5941(* ------------------------------------------------------------------------- *)
5942
5943Theorem LIM_WITHIN_EMPTY:
5944   !f l x. (f --> l) (at x within {})
5945Proof
5946  REWRITE_TAC[LIM_WITHIN, NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]
5947QED
5948
5949(* NOTE: added missing quantifier “t” at the end *)
5950Theorem LIM_WITHIN_SUBSET:
5951   !f l a s t.
5952    (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)
5953Proof
5954  REWRITE_TAC[LIM_WITHIN, SUBSET_DEF] THEN MESON_TAC[]
5955QED
5956
5957Theorem LIM_UNION:
5958   !f x l s t.
5959        (f --> l) (at x within s) /\ (f --> l) (at x within t)
5960        ==> (f --> l) (at x within (s UNION t))
5961Proof
5962  REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN, IN_UNION] THEN
5963  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN STRIP_TAC THEN
5964  X_GEN_TAC ``e:real`` THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
5965  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_SIMP_TAC std_ss [] THEN
5966  DISCH_THEN(CONJUNCTS_THEN2
5967   (X_CHOOSE_TAC ``d1:real``) (X_CHOOSE_TAC ``d2:real``)) THEN
5968  EXISTS_TAC ``min d1 d2:real`` THEN ASM_MESON_TAC[REAL_LT_MIN]
5969QED
5970
5971Theorem LIM_UNION_UNIV:
5972   !f x l s t.
5973        (f --> l) (at x within s) /\ (f --> l) (at x within t) /\
5974        (s UNION t = univ(:real)) ==> (f --> l) (at x)
5975Proof
5976  MESON_TAC[LIM_UNION, WITHIN_UNIV]
5977QED
5978
5979(* ------------------------------------------------------------------------- *)
5980(* Composition of limits.                                                    *)
5981(* ------------------------------------------------------------------------- *)
5982
5983Theorem LIM_COMPOSE_WITHIN:
5984   !net f:'a->real g:real->real s y z.
5985    (f --> y) net /\
5986    eventually (\w. f w IN s /\ ((f w = y) ==> (g y = z))) net /\
5987    (g --> z) (at y within s)
5988    ==> ((g o f) --> z) net
5989Proof
5990  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto, CONJ_ASSOC] THEN
5991  KNOW_TAC ``(!e. (&0 < e ==> eventually (\x. dist ((f:'a->real) x,y) < e) net) /\
5992             eventually (\w. f w IN s /\ ((f w = y) ==> ((g:real->real) y = z))) net) /\
5993   (!e. &0 < e ==> eventually (\x. dist (g x,z) < e) (at y within s))
5994   ==> (!e. &0 < e ==> eventually (\x. dist ((g o f) x,z) < e) net)`` THENL
5995  [ALL_TAC, SIMP_TAC std_ss [LEFT_AND_FORALL_THM]] THEN
5996  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5997  STRIP_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
5998  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[] THEN
5999  REWRITE_TAC[EVENTUALLY_WITHIN, GSYM DIST_NZ, o_DEF] THEN
6000  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
6001  UNDISCH_TAC ``!e. (0 < e ==> eventually (\x. dist (f x,y) < e) net) /\
6002        eventually (\w. f w IN s /\ ((f:'a->real w = y) ==> (g:real->real y = z))) net`` THEN
6003  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``d:real``) THEN
6004  ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN BETA_TAC THEN
6005  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MONO) THEN
6006  ASM_MESON_TAC[DIST_REFL]
6007QED
6008
6009Theorem LIM_COMPOSE_AT:
6010   !net f:'a->real g:real->real y z.
6011    (f --> y) net /\
6012    eventually (\w. (f w = y) ==> (g y = z)) net /\
6013    (g --> z) (at y)
6014    ==> ((g o f) --> z) net
6015Proof
6016  REPEAT STRIP_TAC THEN
6017  MP_TAC(ISPECL [``net:('a)net``, ``f:'a->real``, ``g:real->real``,
6018                 ``univ(:real)``, ``y:real``, ``z:real``]
6019        LIM_COMPOSE_WITHIN) THEN
6020  ASM_REWRITE_TAC[IN_UNIV, WITHIN_UNIV]
6021QED
6022
6023(* ------------------------------------------------------------------------- *)
6024(* Interrelations between restricted and unrestricted limits.                *)
6025(* ------------------------------------------------------------------------- *)
6026
6027Theorem LIM_AT_WITHIN:
6028   !f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)
6029Proof
6030  REWRITE_TAC[LIM_AT, LIM_WITHIN] THEN MESON_TAC[]
6031QED
6032
6033Theorem LIM_WITHIN_OPEN:
6034   !f l a:real s.
6035     a IN s /\ open s ==> ((f --> l)(at a within s) <=> (f --> l)(at a))
6036Proof
6037  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [LIM_AT_WITHIN] THEN
6038  REWRITE_TAC[LIM_AT, LIM_WITHIN] THEN
6039  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
6040  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[] THEN
6041   DISCH_THEN(X_CHOOSE_THEN ``d1:real`` STRIP_ASSUME_TAC) THEN
6042  UNDISCH_TAC ``open s`` THEN GEN_REWR_TAC LAND_CONV [open_def] THEN
6043  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``a:real``) THEN
6044  ASM_REWRITE_TAC[] THEN
6045  DISCH_THEN(X_CHOOSE_THEN ``d2:real`` STRIP_ASSUME_TAC) THEN
6046  MP_TAC(SPECL [``d1:real``, ``d2:real``] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN
6047  ASM_MESON_TAC[REAL_LT_TRANS]
6048QED
6049
6050Theorem LIM_WITHIN_OPEN_CONG :
6051   !f (l :real) (a :real) s t.
6052       a IN s /\ open s /\ a IN t /\ open t ==>
6053      ((f --> l)(at a within s) <=> (f --> l)(at a within t))
6054Proof
6055    rw [LIM_WITHIN_OPEN]
6056QED
6057
6058(* ------------------------------------------------------------------------- *)
6059(* More limit point characterizations.                                       *)
6060(* ------------------------------------------------------------------------- *)
6061
6062Theorem LIMPT_SEQUENTIAL_INJ:
6063   !x:real s.
6064      x limit_point_of s <=>
6065             ?f. (!n. f(n) IN (s DELETE x)) /\
6066                 (!m n. (f m = f n) <=> (m = n)) /\
6067                 (f --> x) sequentially
6068Proof
6069  REPEAT GEN_TAC THEN
6070  REWRITE_TAC[LIMPT_APPROACHABLE, LIM_SEQUENTIALLY, IN_DELETE] THEN
6071  EQ_TAC THENL [ALL_TAC, MESON_TAC[GREATER_EQ, LESS_EQ_REFL]] THEN
6072  KNOW_TAC ``(!e. 0 < e ==> ?x'. x' IN s /\ x' <> x /\ dist (x',x) < e) =
6073             (!e. ?x'. &0 < e ==> x' IN s /\ ~(x' = x) /\ dist (x',x) < e)`` THENL
6074  [SIMP_TAC std_ss [GSYM RIGHT_EXISTS_IMP_THM], ALL_TAC] THEN DISC_RW_KILL THEN
6075  SIMP_TAC std_ss [SKOLEM_THM] THEN STRIP_TAC THEN
6076  KNOW_TAC ``?z. (z 0 = f (&1)) /\
6077    (!n. z (SUC n):real = f (min (inv(&2 pow (SUC n))) (dist(z n,x))))`` THENL
6078  [RW_TAC real_ss [num_Axiom], ALL_TAC] THEN STRIP_TAC THEN
6079  EXISTS_TAC ``z:num->real`` THEN
6080  SUBGOAL_THEN
6081   ``!n. z(n) IN s /\ ~(z n:real = x) /\ dist(z n,x) < inv(&2 pow n)``
6082  ASSUME_TAC THENL
6083   [INDUCT_TAC THEN ASM_REWRITE_TAC[] THENL [REWRITE_TAC [pow, REAL_INV1] THEN
6084    ASM_SIMP_TAC std_ss [REAL_LT_01], FIRST_X_ASSUM(MP_TAC o SPEC
6085     ``min (inv(&2 pow (SUC n))) (dist(z n:real,x))``) THEN
6086    ASM_SIMP_TAC std_ss [REAL_LT_MIN, REAL_LT_INV_EQ, REAL_POW_LT, DIST_POS_LT,
6087                         REAL_ARITH ``0:real < 2``]],
6088    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6089     [KNOW_TAC ``!m:num n. (((z:num->real) m = z n) <=> (m = n)) =
6090                    (\m n. ((z m = z n) <=> (m = n))) m n`` THENL
6091     [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
6092     MATCH_MP_TAC WLOG_LT THEN BETA_TAC THEN SIMP_TAC std_ss [EQ_SYM_EQ] THEN
6093      SUBGOAL_THEN ``!m n:num. m < n ==> dist(z n:real,x) < dist(z m,x)``
6094       (fn th => MESON_TAC[th, REAL_LT_REFL, LESS_REFL]) THEN
6095      KNOW_TAC ``!m n:num.  (dist (z n,x) < dist (z m,x)) =
6096                     (\m n.  dist (z n,x) < dist (z m,x)) m n`` THENL
6097      [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
6098      MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN BETA_TAC THEN
6099      CONJ_TAC THENL [REAL_ARITH_TAC, GEN_TAC THEN ASM_REWRITE_TAC[]] THEN
6100      FIRST_X_ASSUM(MP_TAC o SPEC
6101       ``min (inv(&2 pow (SUC n))) (dist(z n:real,x))``) THEN
6102      ASM_SIMP_TAC std_ss [REAL_LT_MIN, REAL_LT_INV_EQ, REAL_POW_LT,
6103      REAL_ARITH ``0:real < 2``, DIST_POS_LT],
6104      X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6105      MP_TAC(ISPECL [``inv(&2:real)``, ``e:real``] REAL_ARCH_POW_INV) THEN
6106      ASM_SIMP_TAC std_ss [REAL_INV_1OVER, REAL_HALF_BETWEEN] THEN
6107      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
6108      FULL_SIMP_TAC std_ss [GSYM REAL_INV_1OVER, REAL_POW_INV] THEN
6109      X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN
6110      EXISTS_TAC ``inv (2:real pow N)`` THEN ASM_REWRITE_TAC [] THEN
6111      MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``inv(&2:real pow n)`` THEN
6112      ASM_REWRITE_TAC [] THEN REWRITE_TAC [REAL_INV_1OVER] THEN
6113      SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_POW_LT, REAL_ARITH ``0 < 2:real``] THEN
6114      ONCE_REWRITE_TAC [REAL_MUL_COMM] THEN
6115      REWRITE_TAC [GSYM REAL_INV_1OVER, GSYM real_div] THEN SIMP_TAC std_ss [REAL_LE_RDIV_EQ,
6116      REAL_POW_LT, REAL_MUL_LID, REAL_ARITH ``0 < 2:real``] THEN
6117      FULL_SIMP_TAC std_ss [REAL_LE_LT, LESS_OR_EQ] THEN DISJ1_TAC THEN
6118      MATCH_MP_TAC REAL_POW_MONO_LT THEN ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC]]
6119QED
6120
6121Theorem LIMPT_SEQUENTIAL:
6122   !x:real s.
6123      x limit_point_of s <=>
6124             ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially
6125Proof
6126  REPEAT GEN_TAC THEN EQ_TAC THENL
6127   [REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN MESON_TAC[],
6128    REWRITE_TAC[LIMPT_APPROACHABLE, LIM_SEQUENTIALLY, IN_DELETE] THEN
6129    MESON_TAC[GREATER_EQ, LESS_EQ_REFL]]
6130QED
6131
6132Theorem INFINITE_SUPERSET:
6133   !s t. INFINITE s /\ s SUBSET t ==> INFINITE t
6134Proof
6135  REWRITE_TAC[] THEN MESON_TAC[SUBSET_FINITE_I]
6136QED
6137
6138Theorem LIMPT_INFINITE_OPEN_BALL_CBALL:
6139   (!s x:real.
6140        x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\
6141   (!s x:real.
6142        x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\
6143   (!s x:real.
6144        x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))
6145Proof
6146  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
6147   `(q ==> p) /\ (r ==> s) /\ (s ==> q) /\ (p ==> r)
6148    ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN
6149  REPEAT CONJ_TAC THENL
6150   [REWRITE_TAC[limit_point_of, SET_RULE
6151     ``(?y. ~(y = x) /\ y IN s /\ y IN t) <=> ~(s INTER t SUBSET {x})``] THEN
6152    MESON_TAC[SUBSET_FINITE_I, FINITE_SING],
6153    MESON_TAC[INFINITE_SUPERSET, BALL_SUBSET_CBALL,
6154              SET_RULE ``t SUBSET u ==> s INTER t SUBSET s INTER u``],
6155    MESON_TAC[INFINITE_SUPERSET, OPEN_CONTAINS_CBALL,
6156              SET_RULE ``t SUBSET u ==> s INTER t SUBSET s INTER u``],
6157    REWRITE_TAC[LIMPT_SEQUENTIAL_INJ, IN_DELETE, FORALL_AND_THM] THEN
6158    DISCH_THEN(X_CHOOSE_THEN ``f:num->real`` STRIP_ASSUME_TAC) THEN
6159    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6160    UNDISCH_TAC ``(f --> x) sequentially`` THEN
6161    GEN_REWR_TAC LAND_CONV [LIM_SEQUENTIALLY] THEN
6162    DISCH_THEN(MP_TAC o SPEC ``e:real``) THEN
6163    ASM_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN
6164    DISCH_THEN(X_CHOOSE_TAC ``N:num``) THEN
6165    MATCH_MP_TAC INFINITE_SUPERSET THEN
6166    EXISTS_TAC ``IMAGE (f:num->real) (from N)`` THEN
6167    ASM_SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE, IN_FROM, IN_INTER] THEN
6168    ASM_MESON_TAC[IMAGE_11_INFINITE, INFINITE_FROM]]
6169QED
6170
6171Theorem LIMPT_INFINITE_OPEN:
6172   (!s x:real.
6173        x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t))
6174Proof
6175  SIMP_TAC std_ss [LIMPT_INFINITE_OPEN_BALL_CBALL]
6176QED
6177
6178Theorem LIMPT_INFINITE_BALL:
6179   (!s x:real.
6180        x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e)))
6181Proof
6182  METIS_TAC [LIMPT_INFINITE_OPEN_BALL_CBALL]
6183QED
6184
6185Theorem LIMPT_INFINITE_CBALL:
6186   (!s x:real.
6187        x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))
6188Proof
6189  METIS_TAC [LIMPT_INFINITE_OPEN_BALL_CBALL]
6190QED
6191
6192Theorem INFINITE_OPEN_IN:
6193   !u s:real->bool.
6194      open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u)
6195      ==> INFINITE s
6196Proof
6197  REPEAT STRIP_TAC THEN
6198  UNDISCH_TAC ``open_in (subtopology euclidean u) s`` THEN
6199  REWRITE_TAC [OPEN_IN_OPEN] THEN
6200  DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
6201  UNDISCH_TAC ``x limit_point_of u`` THEN REWRITE_TAC [LIMPT_INFINITE_OPEN] THEN
6202  FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SET_TAC[]
6203QED
6204
6205(* ------------------------------------------------------------------------- *)
6206(* Condensation points.                                                      *)
6207(* ------------------------------------------------------------------------- *)
6208
6209val _ = set_fixity "condensation_point_of" (Infix(NONASSOC, 450));
6210
6211Definition condensation_point_of[nocompute]:
6212 x condensation_point_of s <=>
6213        !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)
6214End
6215
6216Theorem CONDENSATION_POINT_OF_SUBSET:
6217   !x:real s t.
6218        x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t
6219Proof
6220  REPEAT GEN_TAC THEN
6221  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6222  REWRITE_TAC[condensation_point_of] THEN
6223  DISCH_TAC THEN X_GEN_TAC ``t':real->bool`` THEN
6224  POP_ASSUM (MP_TAC o Q.SPEC `t':real->bool`) THEN
6225  MATCH_MP_TAC MONO_IMP THEN
6226  REWRITE_TAC[GSYM MONO_NOT_EQ] THEN
6227  MATCH_MP_TAC(REWRITE_RULE[CONJ_EQ_IMP] COUNTABLE_SUBSET) THEN
6228  ASM_SET_TAC[]
6229QED
6230
6231Theorem CONDENSATION_POINT_IMP_LIMPT:
6232   !x s. x condensation_point_of s ==> x limit_point_of s
6233Proof
6234  REWRITE_TAC[condensation_point_of, LIMPT_INFINITE_OPEN] THEN
6235  MESON_TAC[FINITE_IMP_COUNTABLE]
6236QED
6237
6238Theorem CONDENSATION_POINT_INFINITE_BALL_CBALL:
6239   (!s x:real.
6240        x condensation_point_of s <=>
6241        !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\
6242   (!s x:real.
6243        x condensation_point_of s <=>
6244        !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))
6245Proof
6246  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
6247   `(p ==> q) /\ (q ==> r) /\ (r ==> p)
6248    ==> (p <=> q) /\ (p <=> r)`) THEN
6249  REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL
6250   [MESON_TAC[OPEN_BALL, CENTRE_IN_BALL],
6251    MESON_TAC[BALL_SUBSET_CBALL, COUNTABLE_SUBSET,
6252              SET_RULE ``t SUBSET u ==> s INTER t SUBSET s INTER u``],
6253    MESON_TAC[COUNTABLE_SUBSET, OPEN_CONTAINS_CBALL,
6254              SET_RULE ``t SUBSET u ==> s INTER t SUBSET s INTER u``]]
6255QED
6256
6257Theorem CONDENSATION_POINT_INFINITE_BALL:
6258   (!s x:real.
6259        x condensation_point_of s <=>
6260        !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e)))
6261Proof
6262  METIS_TAC [CONDENSATION_POINT_INFINITE_BALL_CBALL]
6263QED
6264
6265Theorem CONDENSATION_POINT_INFINITE_CBALL:
6266   (!s x:real.
6267        x condensation_point_of s <=>
6268        !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))
6269Proof
6270  METIS_TAC [CONDENSATION_POINT_INFINITE_BALL_CBALL]
6271QED
6272
6273(* ------------------------------------------------------------------------- *)
6274(* Basic arithmetical combining theorems for limits.                         *)
6275(* ------------------------------------------------------------------------- *)
6276
6277Theorem LIM_LINEAR:
6278   !net:('a)net h f l.
6279        (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net
6280Proof
6281  REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
6282  ASM_CASES_TAC ``trivial_limit (net:('a)net)`` THEN ASM_REWRITE_TAC[] THEN
6283  STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC o
6284    MATCH_MP LINEAR_BOUNDED_POS) THEN
6285  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6286  UNDISCH_TAC ``!e. 0 < e ==> ?y. (?x. netord net x y) /\
6287          !x. netord net x y ==> dist (f x,l) < e`` THEN DISCH_TAC THEN
6288  FIRST_X_ASSUM(MP_TAC o SPEC ``e / B:real``) THEN
6289  ASM_SIMP_TAC std_ss [REAL_LT_DIV, dist, GSYM LINEAR_SUB, REAL_LT_RDIV_EQ] THEN
6290  ASM_MESON_TAC[REAL_LET_TRANS, REAL_MUL_SYM]
6291QED
6292
6293Theorem LIM_CONST:
6294   !net a:real. ((\x. a) --> a) net
6295Proof
6296  SIMP_TAC std_ss [LIM, DIST_REFL, trivial_limit] THEN MESON_TAC[]
6297QED
6298
6299Theorem LIM_CMUL:
6300   !f l c. (f --> l) net ==> ((\x. c * f x) --> (c * l)) net
6301Proof
6302  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN
6303  ASM_SIMP_TAC std_ss [REWRITE_RULE[ETA_AX]
6304    (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)] THEN
6305  REWRITE_TAC [linear] THEN REAL_ARITH_TAC
6306QED
6307
6308Theorem LIM_CMUL_EQ:
6309   !net f l c.
6310        ~(c = &0) ==> (((\x. c * f x) --> (c * l)) net <=> (f --> l) net)
6311Proof
6312  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [LIM_CMUL] THEN
6313  DISCH_THEN(MP_TAC o SPEC ``inv c:real`` o MATCH_MP LIM_CMUL) THEN
6314  ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_LID, ETA_AX]
6315QED
6316
6317Theorem LIM_NEG:
6318   !net f l:real. (f --> l) net ==> ((\x. -(f x)) --> -l) net
6319Proof
6320  REPEAT GEN_TAC THEN REWRITE_TAC[LIM, dist] THEN
6321  SIMP_TAC std_ss [REAL_ARITH ``-x - -y = -(x - y:real)``, ABS_NEG]
6322QED
6323
6324Theorem LIM_NEG_EQ:
6325   !net f l:real. ((\x. -(f x)) --> -l) net <=> (f --> l) net
6326Proof
6327  REPEAT GEN_TAC THEN EQ_TAC THEN
6328  DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN
6329  SIMP_TAC std_ss [REAL_NEG_NEG, ETA_AX]
6330QED
6331
6332Theorem LIM_ADD:
6333   !net:('a)net f g l m.
6334    (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> (l + m)) net
6335Proof
6336  REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
6337  ASM_CASES_TAC ``trivial_limit (net:('a)net)`` THEN
6338  ASM_SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
6339  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6340  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
6341  KNOW_TAC ``!x y. (dist(f x, l) < e / 2:real) =
6342              (\x. (dist(f x, l) < e / 2:real)) x`` THENL
6343  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
6344  KNOW_TAC ``!x y. (dist(g x, m) < e / 2:real) =
6345              (\x. (dist(g x, m) < e / 2:real)) x`` THENL
6346  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
6347  DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN BETA_TAC THEN
6348  STRIP_TAC THEN EXISTS_TAC ``c:'a`` THEN CONJ_TAC THENL [METIS_TAC [], ALL_TAC] THEN
6349  GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `x'`) THEN REPEAT STRIP_TAC THEN
6350  FULL_SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
6351  EXISTS_TAC ``dist (f x', l) + dist (g x', m)`` THEN
6352  METIS_TAC[REAL_LT_HALF1, REAL_LT_ADD2, DIST_TRIANGLE_ADD, GSYM REAL_HALF_DOUBLE]
6353QED
6354
6355Theorem lemma[local]:
6356   abs(x - y) <= abs(a - b) ==> dist(a,b) < e ==> dist(x,y) < e
6357Proof
6358  REWRITE_TAC [dist] THEN REAL_ARITH_TAC
6359QED
6360
6361Theorem LIM_ABS:
6362   !net:('a)net f:'a->real l.
6363     (f --> l) net
6364     ==> ((\x. abs(f(x))) --> (abs(l)):real) net
6365Proof
6366  REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
6367  ASM_CASES_TAC ``trivial_limit (net:('a)net)`` THEN ASM_REWRITE_TAC[] THEN
6368  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
6369  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
6370  STRIP_TAC THEN EXISTS_TAC ``y:'a`` THEN POP_ASSUM MP_TAC THEN
6371  POP_ASSUM MP_TAC THEN REWRITE_TAC [AND_IMP_INTRO] THEN
6372  MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
6373  STRIP_TAC THENL [DISCH_TAC THEN EXISTS_TAC ``x:'a`` THEN ASM_REWRITE_TAC [],
6374   ALL_TAC] THEN DISCH_TAC THEN GEN_TAC THEN
6375  POP_ASSUM (MP_TAC o Q.SPEC `x:'a`) THEN
6376  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
6377  MATCH_MP_TAC lemma THEN BETA_TAC THEN
6378  REAL_ARITH_TAC
6379QED
6380
6381Theorem LIM_SUB:
6382   !net:('a)net f g l m.
6383    (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> (l - m)) net
6384Proof
6385  REWRITE_TAC[real_sub] THEN ASM_SIMP_TAC std_ss [LIM_ADD, LIM_NEG]
6386QED
6387
6388(* NOTE: “max f g = 1 / 2 * abs (f - g) + (f + g)” *)
6389Theorem LIM_MAX :
6390   !net:('a)net f g (l :real) (m :real).
6391    (f --> l) net /\ (g --> m) net
6392    ==> ((\x. max (f(x)) (g(x))) --> (max (l) (m)):real) net
6393Proof
6394  REPEAT GEN_TAC THEN DISCH_TAC THEN
6395  FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN
6396  FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN
6397  DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN
6398  REWRITE_TAC[AND_IMP_INTRO] THEN
6399  DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
6400  DISCH_THEN(MP_TAC o SPEC ``inv(&2:real)`` o MATCH_MP LIM_CMUL) THEN
6401  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN BINOP_TAC THEN
6402  SIMP_TAC std_ss [FUN_EQ_THM, max_def, abs] THEN
6403  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN ONCE_REWRITE_TAC [GSYM real_div] THEN
6404  SIMP_TAC arith_ss [REAL_EQ_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
6405  ONCE_REWRITE_TAC [REAL_MUL_COMM] THEN
6406 (* 2 subgoals here, same tactics (each with 4 subgoals) *)
6407 (RW_TAC arith_ss [REAL_SUB_LE] THENL
6408  [(* goal 1 (of 4) *)
6409   REPEAT (POP_ASSUM MP_TAC) THEN
6410   RW_TAC std_ss [AND_IMP_INTRO, REAL_LE_ANTISYM, REAL_SUB_REFL,
6411                  REAL_ADD_LID] THEN  REWRITE_TAC [GSYM REAL_DOUBLE],
6412   (* goal 2 (of 4) *)
6413   REWRITE_TAC [REAL_ARITH ``a - b + (a + b) = a + a - b + b:real``,
6414                REAL_SUB_ADD, REAL_DOUBLE],
6415   (* goal 3 (of 4) *)
6416   REWRITE_TAC [REAL_ARITH ``-(a - b) + (a + b) = b + b - a + a:real``,
6417                REAL_SUB_ADD, REAL_DOUBLE],
6418   (* goal 4 (of 4) *)
6419   FULL_SIMP_TAC real_ss [REAL_NOT_LE] THEN METIS_TAC [REAL_LT_ANTISYM]])
6420QED
6421
6422Theorem LIM_MIN :
6423   !net:('a)net f g l:real m:real.
6424    (f --> l) net /\ (g --> m) net
6425    ==> ((\x. min (f(x)) (g(x))) --> (min (l) (m)):real) net
6426Proof
6427  REPEAT GEN_TAC THEN
6428  DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN
6429  REWRITE_TAC[AND_IMP_INTRO] THEN
6430  DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN
6431  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN
6432  reverse BINOP_TAC >- PROVE_TAC [GSYM REAL_MIN_MAX, REAL_MIN_ACI] THEN
6433  SIMP_TAC std_ss [FUN_EQ_THM] THEN
6434  GEN_TAC >> PROVE_TAC [GSYM REAL_MIN_MAX, REAL_MIN_ACI]
6435QED
6436
6437Theorem LIM_NULL:
6438   !net f l. (f --> l) net <=> ((\x. f(x) - l) --> 0) net
6439Proof
6440  SIMP_TAC arith_ss [LIM, dist, REAL_SUB_RZERO]
6441QED
6442
6443Theorem LIM_NULL_ABS:
6444   !net f. (f --> 0) net <=> ((\x. (abs(f x))) --> 0) net
6445Proof
6446  SIMP_TAC std_ss [LIM, dist, REAL_SUB_RZERO, ABS_ABS]
6447QED
6448
6449Theorem LIM_NULL_CMUL_EQ:
6450   !net f c.
6451        ~(c = &0) ==> (((\x. c * f x) --> 0) net <=> (f --> 0) net)
6452Proof
6453  METIS_TAC[LIM_CMUL_EQ, REAL_MUL_RZERO]
6454QED
6455
6456Theorem LIM_NULL_CMUL:
6457   !net f c. (f --> 0) net ==> ((\x. c * f x) --> 0) net
6458Proof
6459  REPEAT GEN_TAC THEN ASM_CASES_TAC ``c = &0:real`` THEN
6460  ASM_SIMP_TAC std_ss [LIM_NULL_CMUL_EQ, REAL_MUL_LZERO, LIM_CONST]
6461QED
6462
6463Theorem LIM_NULL_ADD:
6464   !net f g:'a->real.
6465        (f --> 0) net /\ (g --> 0) net
6466        ==> ((\x. f x + g x) --> 0) net
6467Proof
6468  REPEAT GEN_TAC THEN
6469  DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
6470  REWRITE_TAC[REAL_ADD_LID]
6471QED
6472
6473Theorem LIM_NULL_SUB:
6474   !net f g:'a->real.
6475        (f --> 0) net /\ (g --> 0) net
6476        ==> ((\x. f x - g x) --> 0) net
6477Proof
6478  REPEAT GEN_TAC THEN
6479  DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
6480  REWRITE_TAC[REAL_SUB_RZERO]
6481QED
6482
6483Theorem LIM_NULL_COMPARISON:
6484   !net f g. eventually (\x. abs(f x) <= g x) net /\
6485             ((\x. (g x)) --> 0) net
6486             ==> (f --> 0) net
6487Proof
6488  REPEAT GEN_TAC THEN SIMP_TAC std_ss [tendsto, RIGHT_AND_FORALL_THM] THEN
6489  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
6490  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_SIMP_TAC std_ss [GSYM EVENTUALLY_AND] THEN
6491  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MONO) THEN
6492  SIMP_TAC arith_ss [dist, REAL_SUB_RZERO] THEN REAL_ARITH_TAC
6493QED
6494
6495Theorem LIM_COMPONENT:
6496   !net f i l:real. (f --> l) net
6497       ==> ((\a. f(a)) --> l) net
6498Proof
6499  REWRITE_TAC[LIM, dist] THEN
6500  METIS_TAC[REAL_LET_TRANS]
6501QED
6502
6503Theorem LIM_TRANSFORM_BOUND:
6504   !net f g. eventually (\n. abs(f n) <= abs(g n)) net /\ (g --> 0) net
6505         ==> (f --> 0) net
6506Proof
6507  REPEAT GEN_TAC THEN
6508  SIMP_TAC std_ss [tendsto, RIGHT_AND_FORALL_THM] THEN
6509  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
6510  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_SIMP_TAC std_ss [GSYM EVENTUALLY_AND] THEN
6511  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MONO) THEN
6512  SIMP_TAC arith_ss [dist, REAL_SUB_RZERO] THEN REAL_ARITH_TAC
6513QED
6514
6515Theorem LIM_NULL_CMUL_BOUNDED:
6516   !net f g:'a->real B.
6517        eventually (\a. (g a = 0) \/ abs(f a) <= B) net /\
6518        (g --> 0) net
6519        ==> ((\n. f n * g n) --> 0) net
6520Proof
6521  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN
6522  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6523  FIRST_X_ASSUM(MP_TAC o SPEC ``e / (abs B + &1:real)``) THEN
6524  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_ARITH ``&0 < abs x + &1:real``] THEN
6525  UNDISCH_TAC ``eventually
6526        (\(a :'a). ((g :'a -> real) a = (0 :real)) \/
6527           abs ((f :'a -> real) a) <= (B :real)) (net :'a net)`` THEN
6528  REWRITE_TAC[AND_IMP_INTRO, GSYM EVENTUALLY_AND] THEN
6529  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MP) THEN
6530  SIMP_TAC std_ss [dist, REAL_SUB_RZERO, o_THM, ABS_MUL] THEN
6531  MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC ``x:'a`` THEN BETA_TAC THEN
6532  ASM_CASES_TAC ``(g:'a->real) x = 0`` THEN
6533  ASM_SIMP_TAC std_ss [ABS_0, REAL_MUL_RZERO] THEN
6534  STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
6535  EXISTS_TAC ``B * e / (abs B + &1:real)`` THEN CONJ_TAC THENL
6536  [ONCE_REWRITE_TAC [real_div] THEN ONCE_REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
6537  MATCH_MP_TAC REAL_LE_MUL2 THEN ONCE_REWRITE_TAC [GSYM real_div] THEN
6538  ASM_SIMP_TAC std_ss [REAL_ABS_POS, REAL_LT_IMP_LE], ALL_TAC] THEN
6539  SIMP_TAC std_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``&0 < abs x + &1:real``] THEN
6540  MATCH_MP_TAC(REAL_ARITH
6541   ``e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1:real)``) THEN
6542  ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN REAL_ARITH_TAC
6543QED
6544
6545Theorem LIM_SUM:
6546   !net f:'a->'b->real l s.
6547        FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net)
6548        ==> ((\x. sum s (\i. f i x)) --> sum s l) net
6549Proof
6550  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
6551  KNOW_TAC ``!s:'a->bool. ( (!(i :'a). i IN s ==>
6552     ((f :'a -> 'b -> real) i --> (l :'a -> real) i) (net :'b net)) ==>
6553  ((\(x :'b). sum s (\(i :'a). f i x)) --> sum s l) net) =
6554                       (\s. (!(i :'a). i IN s ==>
6555     ((f :'a -> 'b -> real) i --> (l :'a -> real) i) (net :'b net)) ==>
6556  ((\(x :'b). sum s (\(i :'a). f i x)) --> sum s l) net)  s`` THENL
6557  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
6558  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
6559  SIMP_TAC std_ss [SUM_CLAUSES, LIM_CONST, LIM_ADD, IN_INSERT, ETA_AX] THEN
6560  METIS_TAC [SUM_CLAUSES, LIM_CONST, LIM_ADD, IN_INSERT, ETA_AX]
6561QED
6562
6563Theorem LIM_NULL_SUM:
6564   !net f:'a->'b->real s.
6565  FINITE s /\ (!a. a IN s ==> ((\x. f x a) --> 0) net)
6566  ==> ((\x. sum s (f x)) --> 0) net
6567Proof
6568  REPEAT GEN_TAC THEN
6569  ONCE_REWRITE_TAC [METIS [] ``!a. (\x. f x a) = (\a. (\x. f x a)) a``] THEN
6570  ONCE_REWRITE_TAC [METIS [] ``0:real = (\a. 0) (a:'b)``] THEN
6571  DISCH_THEN(MP_TAC o MATCH_MP LIM_SUM) THEN BETA_TAC THEN
6572   ONCE_REWRITE_TAC [METIS [] ``!i. (\i. f x i) = (\i. f x) i``] THEN
6573  METIS_TAC [SUM_0', ETA_AX]
6574QED
6575
6576(* ------------------------------------------------------------------------- *)
6577(* Deducing things about the limit from the elements.                        *)
6578(* ------------------------------------------------------------------------- *)
6579
6580Theorem LIM_IN_CLOSED_SET:
6581   !net f:'a->real s l.
6582    closed s /\ eventually (\x. f(x) IN s) net /\
6583    ~(trivial_limit net) /\ (f --> l) net
6584    ==> l IN s
6585Proof
6586  REWRITE_TAC[closed_def] THEN REPEAT STRIP_TAC THEN
6587  MATCH_MP_TAC(SET_RULE ``~(x IN (UNIV DIFF s)) ==> x IN s``) THEN
6588  DISCH_TAC THEN UNDISCH_TAC ``open (univ(:real) DIFF s)`` THEN
6589  GEN_REWR_TAC LAND_CONV [OPEN_CONTAINS_BALL] THEN DISCH_TAC THEN
6590  POP_ASSUM (MP_TAC o Q.SPEC `l:real`) THEN
6591  KNOW_TAC ``~(?e. &0 < e /\ (!x. dist (l,x) < e ==>
6592                x IN univ(:real) /\ ~(x IN s)))`` THENL
6593  [ALL_TAC, ASM_SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, IN_DIFF, IN_UNION]] THEN
6594  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
6595  UNDISCH_TAC ``((f:'a->real) --> l) net`` THEN GEN_REWR_TAC LAND_CONV [tendsto] THEN
6596  DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
6597  UNDISCH_TAC ``eventually (\x. (f:'a->real) x IN s) net`` THEN
6598  ASM_REWRITE_TAC[GSYM EVENTUALLY_AND, TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
6599  MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]
6600QED
6601
6602(* ------------------------------------------------------------------------- *)
6603(* Need to prove closed(cball(x,e)) before deducing this as a corollary.     *)
6604(* ------------------------------------------------------------------------- *)
6605
6606Theorem LIM_ABS_UBOUND:
6607   !net:('a)net f (l:real) b.
6608   ~(trivial_limit net) /\ (f --> l) net /\
6609   eventually (\x. abs(f x) <= b) net
6610   ==> abs(l) <= b
6611Proof
6612  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6613  ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6614  ASM_REWRITE_TAC[eventually] THEN
6615  STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
6616  ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
6617  SUBGOAL_THEN
6618  ``?x:'a. dist(f(x):real,l) < abs(l:real) - b /\ abs(f x) <= b``
6619   (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET], ALL_TAC] THEN
6620  REWRITE_TAC[REAL_NOT_LT, REAL_LE_SUB_RADD, DE_MORGAN_THM, dist] THEN
6621  REAL_ARITH_TAC
6622QED
6623
6624Theorem LIM_ABS_LBOUND:
6625   !net:('a)net f (l:real) b.
6626   ~(trivial_limit net) /\ (f --> l) net /\
6627   eventually (\x. b <= abs(f x)) net
6628   ==> b <= abs(l)
6629Proof
6630  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6631  ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6632  ASM_REWRITE_TAC[eventually] THEN
6633  STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
6634  ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
6635  SUBGOAL_THEN
6636  ``?x:'a. dist(f(x):real,l) < b - abs(l:real) /\ b <= abs(f x)``
6637   (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET], ALL_TAC] THEN
6638  REWRITE_TAC[REAL_NOT_LT, REAL_LE_SUB_RADD, DE_MORGAN_THM, dist] THEN
6639  REAL_ARITH_TAC
6640QED
6641
6642(* ------------------------------------------------------------------------- *)
6643(* Uniqueness of the limit, when nontrivial. *)
6644(* ------------------------------------------------------------------------- *)
6645
6646Theorem LIM_UNIQUE:
6647   !net:('a)net f l:real l'.
6648  ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')
6649Proof
6650  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6651  DISCH_THEN(ASSUME_TAC o REWRITE_RULE[REAL_SUB_REFL] o MATCH_MP LIM_SUB) THEN
6652  SUBGOAL_THEN ``!e. &0 < e ==> abs(l:real - l') <= e`` MP_TAC THENL
6653  [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_ABS_UBOUND THEN
6654   MAP_EVERY EXISTS_TAC [``net:('a)net``, ``\x:'a. 0:real``] THEN
6655   ASM_SIMP_TAC std_ss [ABS_0, REAL_LT_IMP_LE, eventually] THEN
6656   ASM_MESON_TAC[trivial_limit],
6657  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN REWRITE_TAC[DIST_NZ, dist] THEN
6658  DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC ``abs(l - l':real) / &2``) THEN
6659  ASM_SIMP_TAC arith_ss [REAL_LT_RDIV_EQ, REAL_LE_RDIV_EQ, REAL_LT] THEN
6660  UNDISCH_TAC ``&0 < abs(l - l':real)`` THEN REAL_ARITH_TAC]
6661QED
6662
6663Theorem TENDSTO_LIM:
6664   !net f l. ~(trivial_limit net) /\ (f --> l) net ==> (lim net f = l)
6665Proof
6666  REWRITE_TAC[reallim] THEN METIS_TAC[LIM_UNIQUE]
6667QED
6668
6669Theorem LIM_CONST_EQ:
6670   !net:('a net) c d:real.
6671  ((\x. c) --> d) net <=> trivial_limit net \/ (c = d)
6672Proof
6673  REPEAT GEN_TAC THEN
6674  ASM_CASES_TAC ``trivial_limit (net:'a net)`` THEN ASM_REWRITE_TAC[] THENL
6675  [ASM_REWRITE_TAC[LIM], ALL_TAC] THEN
6676  EQ_TAC THEN SIMP_TAC std_ss [LIM_CONST] THEN DISCH_TAC THEN
6677  MATCH_MP_TAC(SPEC ``net:'a net`` LIM_UNIQUE) THEN
6678  EXISTS_TAC ``(\x. c):'a->real`` THEN ASM_REWRITE_TAC[LIM_CONST]
6679QED
6680
6681(* ------------------------------------------------------------------------- *)
6682(* Some unwieldy but occasionally useful theorems about uniform limits.      *)
6683(* ------------------------------------------------------------------------- *)
6684
6685Theorem UNIFORM_LIM_ADD:
6686   !net:('a)net P f g l m.
6687  (!e:real. &0 < e
6688   ==> eventually (\x. !n:'b. P n ==> abs(f n x - l n) < e) net) /\
6689  (!e:real. &0 < e
6690   ==> eventually (\x. !n. P n ==> abs(g n x - m n) < e) net)
6691    ==> !e. &0 < e ==> eventually (\x. !n. P n
6692     ==> abs((f n x + g n x) - (l n + m n)) < e) net
6693Proof
6694  REPEAT GEN_TAC THEN SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN DISCH_TAC THEN
6695  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6696  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
6697  ASM_REWRITE_TAC[REAL_LT_HALF1, GSYM EVENTUALLY_AND] THEN
6698  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MONO) THEN
6699  GEN_TAC THEN REWRITE_TAC[GSYM FORALL_AND_THM] THEN
6700  BETA_TAC THEN STRIP_TAC THEN X_GEN_TAC ``n:'b`` THEN
6701  POP_ASSUM (MP_TAC o Q.SPEC `n:'b`) THEN POP_ASSUM (MP_TAC o Q.SPEC `n:'b`) THEN
6702  ASM_CASES_TAC ``(P:'b->bool) n`` THEN ASM_REWRITE_TAC[] THEN
6703  REPEAT STRIP_TAC THEN GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
6704  REWRITE_TAC [REAL_ADD2_SUB2] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
6705  EXISTS_TAC ``abs ((f:'b->'a->real) n x - l n) + abs (-g n x - -m n):real`` THEN
6706  ASM_REAL_ARITH_TAC
6707QED
6708
6709Theorem UNIFORM_LIM_SUB:
6710   !net:('a)net P f g l m.
6711  (!e:real. &0 < e
6712   ==> eventually (\x. !n:'b. P n ==> abs(f n x - l n) < e) net) /\
6713  (!e:real. &0 < e
6714   ==> eventually (\x. !n. P n ==> abs(g n x - m n) < e) net)
6715    ==> !e. &0 < e ==> eventually (\x. !n. P n
6716     ==> abs((f n x - g n x) - (l n - m n)) < e) net
6717Proof
6718  REPEAT GEN_TAC THEN SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN DISCH_TAC THEN
6719  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6720  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
6721  ASM_REWRITE_TAC[REAL_LT_HALF1, GSYM EVENTUALLY_AND] THEN
6722  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MONO) THEN
6723  GEN_TAC THEN REWRITE_TAC[GSYM FORALL_AND_THM] THEN
6724  BETA_TAC THEN STRIP_TAC THEN X_GEN_TAC ``n:'b`` THEN
6725  POP_ASSUM (MP_TAC o Q.SPEC `n:'b`) THEN POP_ASSUM (MP_TAC o Q.SPEC `n:'b`) THEN
6726  ASM_CASES_TAC ``(P:'b->bool) n`` THEN ASM_REWRITE_TAC[] THEN
6727  REPEAT STRIP_TAC THEN GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
6728  REWRITE_TAC [REAL_ARITH ``abs (f n x - g n x - (l n - m n)):real =
6729                            abs (f n x + -g n x - (l n + -m n))``] THEN
6730  REWRITE_TAC [REAL_ADD2_SUB2] THEN
6731  MATCH_MP_TAC REAL_LET_TRANS THEN
6732  EXISTS_TAC ``abs ((f:'b->'a->real) n x - l n) + abs (-g n x - -m n):real`` THEN
6733  REWRITE_TAC [ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN
6734  ASM_REWRITE_TAC [REAL_ARITH ``-a - -b = - (a - b):real``, ABS_NEG]
6735QED
6736
6737(* ------------------------------------------------------------------------- *)
6738(* Limit under bilinear function, uniform version first.                     *)
6739(* ------------------------------------------------------------------------- *)
6740
6741Theorem UNIFORM_LIM_BILINEAR:
6742   !net:('a)net P (h:real->real->real) f g l m b1 b2.
6743        bilinear h /\
6744        eventually (\x. !n. P n ==> abs(l n) <= b1) net /\
6745        eventually (\x. !n. P n ==> abs(m n) <= b2) net /\
6746        (!e. &0 < e
6747             ==> eventually (\x. !n:'b. P n ==> abs(f n x - l n) < e) net) /\
6748        (!e. &0 < e
6749             ==> eventually (\x. !n. P n ==> abs(g n x - m n) < e) net)
6750        ==> !e. &0 < e
6751             ==> eventually (\x. !n. P n
6752                 ==> abs(h (f n x) (g n x) - h (l n) (m n)) < e) net
6753Proof
6754  REPEAT GEN_TAC THEN
6755  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6756  FIRST_ASSUM(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC o  MATCH_MP
6757   BILINEAR_BOUNDED_POS) THEN
6758  SIMP_TAC std_ss [GSYM FORALL_AND_THM, RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN
6759  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6760  FIRST_X_ASSUM(MP_TAC o SPEC
6761   ``min (abs b2 + &1:real) (e / &2 / (B * (abs b1 + abs b2 + &2)))``) THEN
6762  ASM_SIMP_TAC std_ss [REAL_LT_HALF1, REAL_LT_DIV, REAL_LT_MUL, REAL_LT_MIN,
6763               REAL_ARITH ``&0 < abs x + &1:real``,
6764               REAL_ARITH ``&0 < abs x + abs y + &2:real``] THEN
6765  REWRITE_TAC[GSYM EVENTUALLY_AND] THEN BETA_TAC THEN
6766  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] EVENTUALLY_MONO) THEN
6767  X_GEN_TAC ``x:'a`` THEN SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
6768  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `n:'b`) THEN
6769  ASM_CASES_TAC ``(P:'b->bool) n`` THEN ASM_REWRITE_TAC[] THEN
6770  STRIP_TAC THEN
6771  ONCE_REWRITE_TAC[REAL_ARITH
6772    ``h a b - h c d :real = (h a b - h a d) + (h a d - h c d)``] THEN
6773  ASM_SIMP_TAC std_ss [GSYM BILINEAR_LSUB, GSYM BILINEAR_RSUB] THEN
6774  MATCH_MP_TAC ABS_TRIANGLE_LT THEN
6775  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
6776   (MESON[REAL_LE_ADD2, REAL_LET_TRANS]
6777     ``(!x y. abs(h x y:real) <= B * abs x * abs y)
6778       ==> B * abs a * abs b + B * abs c * abs d < e
6779           ==> abs(h a b) + abs(h c d) < e``)) THEN
6780  REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
6781  MATCH_MP_TAC(METIS [REAL_LT_ADD2, REAL_HALF_DOUBLE, REAL_MUL_SYM]
6782   ``x * B < e / &2:real /\ y * B < e / &2:real ==> B * x + B * y < e``) THEN
6783  CONJ_TAC THEN ASM_SIMP_TAC std_ss [GSYM REAL_LT_RDIV_EQ] THENL
6784   [ONCE_REWRITE_TAC[REAL_MUL_SYM], ALL_TAC] THEN
6785  MATCH_MP_TAC REAL_LET_TRANS THEN
6786  EXISTS_TAC ``e / &2 / (B * (abs b1 + abs b2 + &2)) *
6787             (abs b1 + abs b2 + &1:real)`` THEN
6788  (CONJ_TAC THENL
6789    [MATCH_MP_TAC REAL_LE_MUL2 THEN
6790     ASM_SIMP_TAC std_ss [ABS_POS, REAL_LT_IMP_LE] THEN
6791     ASM_SIMP_TAC std_ss [REAL_ARITH ``a <= b2 ==> a <= abs b1 + abs b2 + &1:real``] THEN
6792     ASM_MESON_TAC[REAL_ARITH
6793       ``abs(f - l:real) < abs b2 + &1 /\ abs(l) <= b1
6794        ==> abs(f) <= abs b1 + abs b2 + &1``],
6795     ONCE_REWRITE_TAC[real_div] THEN
6796     KNOW_TAC ``(abs b1 + abs b2 + 2) <> 0:real`` THENL
6797     [ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
6798      MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``2:real`` THEN
6799      REWRITE_TAC [REAL_LE_ADDL] THEN CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
6800      ONCE_REWRITE_TAC [REAL_ARITH ``0 = 0 + 0:real``] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
6801      REWRITE_TAC [ABS_POS], ALL_TAC] THEN DISCH_TAC THEN
6802     ASM_SIMP_TAC arith_ss [REAL_LT_LMUL, REAL_LT_HALF1, GSYM REAL_MUL_ASSOC,
6803                  REAL_INV_MUL, REAL_LT_IMP_NE] THEN REWRITE_TAC [REAL_MUL_ASSOC] THEN
6804     REWRITE_TAC[METIS [real_div, REAL_MUL_RID, REAL_ARITH ``a * b * c = a * c * b:real``]
6805                 ``B * inv x * y < B <=> B * y / x < B * &1:real``] THEN
6806     ASM_SIMP_TAC arith_ss [REAL_LT_INV_EQ, REAL_LT_LMUL, REAL_LT_LDIV_EQ, REAL_MUL_RID,
6807                  REAL_ARITH ``&0 < abs x + abs y + &2:real``] THEN
6808     REAL_ARITH_TAC])
6809QED
6810
6811Theorem LIM_BILINEAR:
6812   !net:('a)net (h:real->real->real) f g l m.
6813        (f --> l) net /\ (g --> m) net /\ bilinear h
6814        ==> ((\x. h (f x) (g x)) --> (h l m)) net
6815Proof
6816  REPEAT STRIP_TAC THEN
6817  MP_TAC(ISPECL
6818   [``net:('a)net``, ``\x:one. T``, ``h:real->real->real``,
6819    ``\n:one. (f:'a->real)``, ``\n:one. (g:'a->real)``,
6820    ``\n:one. (l:real)``, ``\n:one. (m:real)``,
6821    ``abs(l:real)``, ``abs(m:real)``]
6822   UNIFORM_LIM_BILINEAR) THEN
6823  ASM_REWRITE_TAC[REAL_LE_REFL, EVENTUALLY_TRUE] THEN
6824  ASM_SIMP_TAC std_ss [GSYM dist, GSYM tendsto]
6825QED
6826
6827(* ------------------------------------------------------------------------- *)
6828(* These are special for limits out of the same vector space. *)
6829(* ------------------------------------------------------------------------- *)
6830
6831Theorem LIM_WITHIN_ID:
6832   !a s. ((\x. x) --> a) (at a within s)
6833Proof
6834  REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]
6835QED
6836
6837Theorem LIM_AT_ID:
6838   !a. ((\x. x) --> a) (at a)
6839Proof
6840  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]
6841QED
6842
6843Theorem LIM_AT_ZERO:
6844   !f:real->real l a.
6845    (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(0))
6846Proof
6847  REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT] THEN
6848  AP_TERM_TAC THEN ABS_TAC THEN
6849  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[] THEN
6850  AP_TERM_TAC THEN ABS_TAC THEN
6851  ASM_CASES_TAC ``&0 < d:real`` THEN ASM_REWRITE_TAC[] THEN
6852  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC ``x:real`` THENL
6853  [FIRST_X_ASSUM(MP_TAC o SPEC ``a + x:real``) THEN
6854   SIMP_TAC std_ss [dist, REAL_ADD_SUB, REAL_SUB_RZERO],
6855  FIRST_X_ASSUM(MP_TAC o SPEC ``x - a:real``) THEN
6856  SIMP_TAC std_ss [dist, REAL_SUB_RZERO, REAL_SUB_ADD2]]
6857QED
6858
6859(* ------------------------------------------------------------------------- *)
6860(* Transformation of limit. *)
6861(* ------------------------------------------------------------------------- *)
6862
6863Theorem LIM_TRANSFORM:
6864   !net f g l.
6865  ((\x. f x - g x) --> 0) net /\ (f --> l) net ==> (g --> l) net
6866Proof
6867  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
6868  DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMPLIES THEN
6869  AP_THM_TAC THEN BINOP_TAC THEN SIMP_TAC std_ss [FUN_EQ_THM] THEN
6870  REAL_ARITH_TAC
6871QED
6872
6873Theorem LIM_TRANSFORM_EVENTUALLY:
6874   !net f g l.
6875   eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net
6876Proof
6877  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN STRIP_TAC THEN
6878  KNOW_TAC ``((\ (x:'a). f x - g x) --> (0:real)) net`` THENL
6879  [METIS_TAC [LIM_EVENTUALLY], ALL_TAC] THEN
6880  METIS_TAC[LIM_TRANSFORM]
6881QED
6882
6883Theorem LIM_TRANSFORM_WITHIN:
6884    !f g x s d. &0 < d /\
6885  (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> (f(x') = g(x'))) /\
6886  (f --> l) (at x within s) ==> (g --> l) (at x within s)
6887Proof
6888  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
6889  DISCH_TAC THEN DISCH_TAC THEN
6890  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] LIM_TRANSFORM) THEN
6891  REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC ``d:real`` THEN
6892  ASM_SIMP_TAC std_ss [REAL_SUB_REFL, DIST_REFL]
6893QED
6894
6895Theorem LIM_TRANSFORM_AT:
6896   !f g x d. &0 < d /\
6897  (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> (f(x') = g(x'))) /\
6898  (f --> l) (at x) ==> (g --> l) (at x)
6899Proof
6900  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]
6901QED
6902
6903Theorem LIM_TRANSFORM_EQ:
6904   !net f:'a->real g l.
6905  ((\x. f x - g x) --> 0) net ==> ((f --> l) net <=> (g --> l) net)
6906Proof
6907  REPEAT STRIP_TAC THEN EQ_TAC THEN
6908  DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL
6909  [EXISTS_TAC ``f:'a->real`` THEN ASM_REWRITE_TAC[],
6910  EXISTS_TAC ``g:'a->real`` THEN ASM_REWRITE_TAC[] THEN
6911  ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN BETA_TAC THEN
6912  ASM_REWRITE_TAC[REAL_NEG_SUB, REAL_NEG_0]]
6913QED
6914
6915Theorem LIM_TRANSFORM_WITHIN_SET:
6916   !f a s t.
6917  eventually (\x. x IN s <=> x IN t) (at a)
6918  ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))
6919Proof
6920  REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT, LIM_WITHIN] THEN
6921  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
6922  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6923  FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
6924  DISCH_THEN(X_CHOOSE_THEN ``k:real`` STRIP_ASSUME_TAC) THEN
6925  EXISTS_TAC ``min d k:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6926  ASM_MESON_TAC[]
6927QED
6928
6929Theorem LIM_TRANSFORM_WITHIN_SET_IMP:
6930   !f l a s t.
6931  eventually (\x. x IN t ==> x IN s) (at a) /\ (f --> l) (at a within s)
6932  ==> (f --> l) (at a within t)
6933Proof
6934  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM AND_IMP_INTRO, EVENTUALLY_AT, LIM_WITHIN] THEN
6935  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
6936  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
6937  FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
6938  DISCH_THEN(X_CHOOSE_THEN ``k:real`` STRIP_ASSUME_TAC) THEN
6939  EXISTS_TAC ``min d k:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6940  ASM_MESON_TAC[]
6941QED
6942
6943(* ------------------------------------------------------------------------- *)
6944(* Common case assuming being away from some crucial point like 0.           *)
6945(* ------------------------------------------------------------------------- *)
6946
6947Theorem LIM_TRANSFORM_AWAY_WITHIN_lemma[local] :
6948   !f:real->real g a b s. ~(a = b) /\
6949  (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> (f(x) = g(x))) /\
6950  (f --> l) (at a within s) ==> (g --> l) (at a within s)
6951Proof
6952  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
6953  MAP_EVERY EXISTS_TAC [``f:real->real``, ``dist(a:real,b)``] THEN
6954  ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC ``y:real`` THEN
6955  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6956  ASM_MESON_TAC[DIST_SYM, REAL_LT_REFL]
6957QED
6958
6959(* NOTE: removed the unused quantifier ‘b’ *)
6960Theorem LIM_TRANSFORM_AWAY_WITHIN :
6961   !f:real->real g a s l.
6962      (!x. x IN s /\ ~(x = a) ==> (f(x) = g(x))) /\
6963      (f --> l) (at a within s) ==> (g --> l) (at a within s)
6964Proof
6965    rpt STRIP_TAC
6966 >> MATCH_MP_TAC LIM_TRANSFORM_AWAY_WITHIN_lemma
6967 >> qexistsl_tac [‘f’, ‘a + 1’] >> rw []
6968 >> REAL_ARITH_TAC
6969QED
6970
6971(* NOTE: removed the unused quantifier ‘b’ *)
6972Theorem LIM_TRANSFORM_AWAY_AT :
6973   !f:real->real g a l.
6974      (!x. ~(x = a) ==> (f(x) = g(x))) /\
6975      (f --> l) (at a) ==> (g --> l) (at a)
6976Proof
6977  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
6978  MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]
6979QED
6980
6981(* ------------------------------------------------------------------------- *)
6982(* Alternatively, within an open set. *)
6983(* ------------------------------------------------------------------------- *)
6984
6985Theorem LIM_TRANSFORM_WITHIN_OPEN:
6986   !f g:real->real s a l. open s /\ a IN s /\
6987  (!x. x IN s /\ ~(x = a) ==> (f x = g x)) /\
6988  (f --> l) (at a) ==> (g --> l) (at a)
6989Proof
6990  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN
6991  EXISTS_TAC ``f:real->real`` THEN ASM_REWRITE_TAC[] THEN
6992  UNDISCH_TAC ``open s`` THEN GEN_REWR_TAC LAND_CONV [OPEN_CONTAINS_BALL] THEN
6993  DISCH_THEN(MP_TAC o SPEC ``a:real``) THEN ASM_REWRITE_TAC[] THEN
6994  STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN POP_ASSUM MP_TAC THEN
6995  REWRITE_TAC[SUBSET_DEF, IN_BALL] THEN ASM_MESON_TAC[DIST_NZ, DIST_SYM]
6996QED
6997
6998Theorem LIM_TRANSFORM_WITHIN_OPEN_EQ :
6999    !f g:real->real s a l.
7000       open s /\ a IN s /\ (!x. x IN s /\ ~(x = a) ==> (f x = g x)) ==>
7001      ((f --> l) (at a) <=> (g --> l) (at a))
7002Proof
7003    rpt STRIP_TAC
7004 >> EQ_TAC >> DISCH_TAC
7005 >| [ (* goal 1 (of 2) *)
7006      MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN \\
7007      qexistsl_tac [‘f’, ‘s’] >> rw [],
7008      (* goal 2 (of 2) *)
7009      MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN \\
7010      qexistsl_tac [‘g’, ‘s’] >> rw [] ]
7011QED
7012
7013Theorem LIM_TRANSFORM_WITHIN_OPEN_IN:
7014   !f g:real->real s t a l.
7015  open_in (subtopology euclidean t) s /\ a IN s /\
7016  (!x. x IN s /\ ~(x = a) ==> (f x = g x)) /\
7017  (f --> l) (at a within t) ==> (g --> l) (at a within t)
7018Proof
7019  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
7020  EXISTS_TAC ``f:real->real`` THEN ASM_REWRITE_TAC[] THEN
7021  UNDISCH_TAC ``open_in (subtopology euclidean t) s`` THEN
7022  GEN_REWR_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN
7023  DISCH_THEN(MP_TAC o SPEC ``a:real`` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
7024  STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN POP_ASSUM MP_TAC THEN
7025  REWRITE_TAC[SUBSET_DEF, IN_INTER, IN_BALL] THEN ASM_MESON_TAC[DIST_NZ, DIST_SYM]
7026QED
7027
7028(* ------------------------------------------------------------------------- *)
7029(* Another quite common idiom of an explicit conditional in a sequence. *)
7030(* ------------------------------------------------------------------------- *)
7031
7032Theorem LIM_CASES_FINITE_SEQUENTIALLY:
7033   !f g l. FINITE {n | P n}
7034  ==> (((\n. if P n then f n else g n) --> l) sequentially <=>
7035  (g --> l) sequentially)
7036Proof
7037  REPEAT STRIP_TAC THEN EQ_TAC THEN
7038  MATCH_MP_TAC(REWRITE_RULE[GSYM AND_IMP_INTRO] LIM_TRANSFORM_EVENTUALLY) THEN
7039  FIRST_ASSUM(MP_TAC o SPEC ``\n:num. n`` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
7040  SIMP_TAC std_ss [GSPECIFICATION, LEFT_IMP_EXISTS_THM] THEN
7041  X_GEN_TAC ``N:num`` THEN DISCH_TAC THEN SIMP_TAC std_ss [EVENTUALLY_SEQUENTIALLY] THEN
7042  EXISTS_TAC ``N + 1:num`` THEN
7043  METIS_TAC[ARITH_PROVE ``~(x <= n:num /\ n + 1 <= x)``]
7044QED
7045
7046Theorem lemma[local]:
7047   (if p then x else y) = (if ~p then y else x)
7048Proof
7049 RW_TAC std_ss []
7050QED
7051
7052Theorem LIM_CASES_COFINITE_SEQUENTIALLY:
7053   !f g l. FINITE {n | ~P n}
7054  ==> (((\n. if P n then f n else g n) --> l) sequentially <=>
7055  (f --> l) sequentially)
7056Proof
7057  ONCE_REWRITE_TAC[lemma] THEN
7058  SIMP_TAC std_ss [LIM_CASES_FINITE_SEQUENTIALLY]
7059QED
7060
7061Theorem LIM_CASES_SEQUENTIALLY:
7062   !f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=>
7063  (f --> l) sequentially) /\
7064   (((\n. if m < n then f n else g n) --> l) sequentially <=>
7065  (f --> l) sequentially) /\
7066   (((\n. if n <= m then f n else g n) --> l) sequentially <=>
7067  (g --> l) sequentially) /\
7068   (((\n. if n < m then f n else g n) --> l) sequentially <=>
7069  (g --> l) sequentially)
7070Proof
7071  SIMP_TAC std_ss [LIM_CASES_FINITE_SEQUENTIALLY, LIM_CASES_COFINITE_SEQUENTIALLY,
7072  NOT_LESS, NOT_LESS_EQUAL, FINITE_NUMSEG_LT, FINITE_NUMSEG_LE]
7073QED
7074
7075(* ------------------------------------------------------------------------- *)
7076(* A congruence rule allowing us to transform limits assuming not at point.  *)
7077(* ------------------------------------------------------------------------- *)
7078
7079Theorem LIM_CONG_WITHIN:
7080   (!x. ~(x = a) ==> (f x = g x))
7081  ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))
7082Proof
7083 REWRITE_TAC[LIM_WITHIN, GSYM DIST_NZ] THEN SIMP_TAC std_ss []
7084QED
7085
7086(* NOTE: This theorem is not from HOL-Light. *)
7087Theorem LIM_WITHIN_CONG :
7088   !f g l r a s. (!x. ~(x = a) /\ x IN s ==> (f x - l = g x - r))
7089  ==> ((f --> l) (at a within s) <=> ((g --> r) (at a within s)))
7090Proof
7091    rw [LIM_WITHIN, dist]
7092QED
7093
7094Theorem LIM_WITHIN_ABS_CONG :
7095   !f g l r a s. (!x. ~(x = a) /\ x IN s ==> (abs (f x - l) = abs (g x - r)))
7096  ==> ((f --> l) (at a within s) <=> ((g --> r) (at a within s)))
7097Proof
7098    rw [LIM_WITHIN, dist]
7099QED
7100
7101Theorem LIM_CONG_AT:
7102   (!x. ~(x = a) ==> (f x = g x))
7103  ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))
7104Proof
7105 REWRITE_TAC[LIM_AT, GSYM DIST_NZ] THEN SIMP_TAC std_ss []
7106QED
7107
7108(* ------------------------------------------------------------------------- *)
7109(* Useful lemmas on closure and set of possible sequential limits.           *)
7110(* ------------------------------------------------------------------------- *)
7111
7112Theorem CLOSURE_SEQUENTIAL:
7113   !s l:real.
7114  l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially
7115Proof
7116  SIMP_TAC std_ss [closure, IN_UNION, LIMPT_SEQUENTIAL, GSPECIFICATION, IN_DELETE] THEN
7117  REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
7118   `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN
7119  CONJ_TAC THENL [MESON_TAC[], ALL_TAC] THEN DISCH_TAC THEN
7120  EXISTS_TAC ``\n:num. l:real`` THEN ASM_REWRITE_TAC[LIM_CONST]
7121QED
7122
7123Theorem CLOSED_CONTAINS_SEQUENTIAL_LIMIT:
7124   !s x l:real.
7125  closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s
7126Proof
7127  MESON_TAC[CLOSURE_SEQUENTIAL, CLOSURE_CLOSED]
7128QED
7129
7130Theorem CLOSED_SEQUENTIAL_LIMITS:
7131   !s. closed s <=>
7132   !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s
7133Proof
7134  MESON_TAC[CLOSURE_SEQUENTIAL, CLOSURE_CLOSED,
7135  CLOSED_LIMPT, LIMPT_SEQUENTIAL, IN_DELETE]
7136QED
7137
7138Theorem CLOSED_APPROACHABLE:
7139   !x s. closed s
7140  ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)
7141Proof
7142  MESON_TAC[CLOSURE_CLOSED, CLOSURE_APPROACHABLE]
7143QED
7144
7145Theorem IN_CLOSURE_DELETE:
7146   !s x:real. x IN closure(s DELETE x) <=> x limit_point_of s
7147Proof
7148  SIMP_TAC std_ss [CLOSURE_APPROACHABLE, LIMPT_APPROACHABLE, IN_DELETE, CONJ_ASSOC]
7149QED
7150
7151Theorem DENSE_IMP_PERFECT:
7152   !s. (closure s = univ(:real)) ==> !x. x IN s ==> x limit_point_of s
7153Proof
7154  REPEAT STRIP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
7155  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
7156  KNOW_TAC ``~(!x'. ~(x' = x) /\ dist (x',x) < e ==> ~(x' IN s))`` THENL
7157  [ALL_TAC, METIS_TAC []] THEN DISCH_TAC THEN
7158  MP_TAC(ISPECL [``x:real``, ``e / &2:real``] REAL_CHOOSE_DIST) THEN
7159  KNOW_TAC ``~(?y. dist (x,y) = e / &2)`` THENL
7160  [ALL_TAC, ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, REAL_LT_HALF1]] THEN
7161  DISCH_THEN(X_CHOOSE_TAC ``y:real``) THEN
7162  FIRST_ASSUM(MP_TAC o SPEC ``y:real`` o MATCH_MP (SET_RULE
7163   ``(s = UNIV) ==> !x. x IN s``)) THEN
7164  REWRITE_TAC[CLOSURE_APPROACHABLE] THEN
7165  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
7166  ASM_SIMP_TAC std_ss [REAL_HALF, NOT_EXISTS_THM] THEN
7167  X_GEN_TAC ``z:real`` THEN FIRST_X_ASSUM(MP_TAC o SPEC ``z:real``) THEN
7168  ASM_CASES_TAC ``(z:real) IN s`` THEN ASM_REWRITE_TAC[] THEN
7169  SIMP_TAC std_ss [] THEN STRIP_TAC THENL
7170  [METIS_TAC [REAL_LE_LT, REAL_NOT_LT], ALL_TAC] THEN
7171  DISCH_TAC THEN UNDISCH_TAC ``~(dist (z,x) < e)`` THEN REWRITE_TAC [] THEN
7172  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
7173  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``dist (z,y) + dist (y,x)`` THEN
7174  REWRITE_TAC [DIST_TRIANGLE] THEN ONCE_REWRITE_TAC [DIST_SYM] THEN
7175  ASM_REWRITE_TAC [] THEN METIS_TAC [REAL_LT_RADD, DIST_SYM]
7176QED
7177
7178Theorem DENSE_LIMIT_POINTS:
7179   !x. ({x | x limit_point_of s} = univ(:real)) <=> (closure s = univ(:real))
7180Proof
7181  GEN_TAC THEN EQ_TAC THENL [SIMP_TAC std_ss [closure] THEN SET_TAC[], DISCH_TAC] THEN
7182  FIRST_ASSUM(MP_TAC o MATCH_MP DENSE_IMP_PERFECT) THEN
7183  RULE_ASSUM_TAC(REWRITE_RULE[closure]) THEN ASM_SET_TAC[]
7184QED
7185
7186(* ------------------------------------------------------------------------- *)
7187(* Some other lemmas about sequences.                                        *)
7188(* ------------------------------------------------------------------------- *)
7189
7190Theorem SEQ_OFFSET:
7191   !f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially
7192Proof
7193  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
7194  MESON_TAC[ARITH_PROVE ``N <= n ==> N <= n + k:num``]
7195QED
7196
7197Theorem SEQ_OFFSET_NEG:
7198   !f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially
7199Proof
7200  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
7201  MESON_TAC[ARITH_PROVE ``N + k <= n ==> N <= n - k:num``]
7202QED
7203
7204Theorem SEQ_OFFSET_REV:
7205   !f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially
7206Proof
7207  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
7208  MESON_TAC[ARITH_PROVE ``N + k <= n ==> N <= n - k /\ ((n - k) + k = n:num)``]
7209QED
7210
7211Theorem SEQ_HARMONIC_OFFSET:
7212   !a. ((\n. inv(&n + a)) --> 0) sequentially
7213Proof
7214  GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
7215  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
7216  ASSUME_TAC REAL_ARCH_INV THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
7217  ASM_REWRITE_TAC [] THEN DISCH_THEN (X_CHOOSE_THEN ``N:num`` STRIP_ASSUME_TAC) THEN
7218  X_CHOOSE_THEN ``M:num`` STRIP_ASSUME_TAC
7219  (SPEC ``-a:real`` SIMP_REAL_ARCH) THEN
7220  EXISTS_TAC ``M + N:num`` THEN REWRITE_TAC[DIST_0] THEN
7221  X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
7222  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv (&N:real)`` THEN
7223  KNOW_TAC ``(&n + a:real) <> 0`` THENL
7224  [ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
7225   UNDISCH_TAC ``-a <= &M:real`` THEN
7226   GEN_REWR_TAC LAND_CONV [GSYM REAL_LE_NEG] THEN REWRITE_TAC [REAL_NEG_NEG] THEN
7227   DISCH_TAC THEN FULL_SIMP_TAC arith_ss [GSYM REAL_LE, GSYM REAL_ADD] THEN
7228   KNOW_TAC ``&M + &N + (-&M) <= &n + a:real`` THENL
7229   [FULL_SIMP_TAC arith_ss [REAL_LE_ADD2], ALL_TAC] THEN
7230   REWRITE_TAC [GSYM real_sub] THEN ONCE_REWRITE_TAC [REAL_ADD_COMM] THEN
7231   REWRITE_TAC [REAL_ADD_SUB_ALT] THEN DISCH_TAC THEN
7232   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
7233   FULL_SIMP_TAC std_ss [REAL_LT_INV_EQ], ALL_TAC] THEN DISCH_TAC THEN
7234  BETA_TAC THEN ASM_SIMP_TAC arith_ss [ABS_INV] THEN
7235  MATCH_MP_TAC REAL_LE_INV2 THEN FULL_SIMP_TAC std_ss [REAL_LT_INV_EQ] THEN
7236  RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE, GSYM REAL_OF_NUM_ADD]) THEN
7237  ASM_REAL_ARITH_TAC
7238QED
7239
7240Theorem SEQ_HARMONIC:
7241   ((\n. inv(&n)) --> 0) sequentially
7242Proof
7243  MP_TAC(SPEC ``&0:real`` SEQ_HARMONIC_OFFSET) THEN REWRITE_TAC[REAL_ADD_RID]
7244QED
7245
7246(* ------------------------------------------------------------------------- *)
7247(* More properties of closed balls.                                          *)
7248(* ------------------------------------------------------------------------- *)
7249
7250Theorem CLOSED_CBALL :
7251   !x:real e. closed(cball(x,e))
7252Proof
7253    rw [CLOSED_IN, cball_def, euclidean_def, CLOSED_IN_MCBALL]
7254QED
7255
7256Theorem IN_INTERIOR_CBALL:
7257   !x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s
7258Proof
7259  SIMP_TAC std_ss [interior, GSPECIFICATION] THEN
7260  MESON_TAC[OPEN_CONTAINS_CBALL, SUBSET_TRANS,
7261  BALL_SUBSET_CBALL, CENTRE_IN_BALL, OPEN_BALL]
7262QED
7263
7264Theorem LIMPT_BALL:
7265   !x:real y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)
7266Proof
7267  REPEAT GEN_TAC THEN ASM_CASES_TAC ``&0 < e:real`` THENL
7268  [ALL_TAC, ASM_MESON_TAC[LIMPT_EMPTY, REAL_NOT_LT, BALL_EQ_EMPTY]] THEN
7269  ASM_REWRITE_TAC[] THEN EQ_TAC THENL
7270  [MESON_TAC[CLOSED_CBALL, CLOSED_LIMPT, LIMPT_SUBSET, BALL_SUBSET_CBALL],
7271   REWRITE_TAC[IN_CBALL, LIMPT_APPROACHABLE, IN_BALL]] THEN
7272  DISCH_TAC THEN X_GEN_TAC ``d:real`` THEN DISCH_TAC THEN
7273  ASM_CASES_TAC ``y:real = x`` THEN ASM_REWRITE_TAC[DIST_NZ] THENL
7274  [MP_TAC(SPECL [``d:real``, ``e:real``] REAL_DOWN2) THEN
7275   ASM_REWRITE_TAC[] THEN
7276   GEN_MESON_TAC 0 40 1 [REAL_CHOOSE_DIST, DIST_SYM, REAL_LT_IMP_LE],
7277   ALL_TAC] THEN
7278  MP_TAC(SPECL [``abs(y:real - x)``, ``d:real``] REAL_DOWN2) THEN
7279  RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ, dist]) THEN ASM_REWRITE_TAC[] THEN
7280  DISCH_THEN(X_CHOOSE_THEN ``k:real`` STRIP_ASSUME_TAC) THEN
7281  EXISTS_TAC ``(y:real) - (k / dist(y,x)) * (y - x)`` THEN
7282  REWRITE_TAC[dist, REAL_ARITH ``(y - c * z) - y = -c * z:real``] THEN
7283  ASM_SIMP_TAC std_ss [ABS_MUL, ABS_DIV, ABS_ABS, ABS_NEG, REAL_POS_NZ] THEN
7284  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, REAL_POS_NZ] THEN
7285  REWRITE_TAC[REAL_ARITH ``x - (y - k * (y - x)) = (&1 - k) * (x - y:real)``] THEN
7286  ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < k ==> &0 < abs k:real``, ABS_MUL] THEN
7287  ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < k /\ k < d ==> abs k < d:real``] THEN
7288  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``abs(x:real - y)`` THEN
7289  ASM_REWRITE_TAC[] THEN GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
7290  KNOW_TAC ``0:real < abs (x - y)`` THENL [ASM_MESON_TAC[ABS_SUB], ALL_TAC] THEN
7291  DISCH_TAC THEN ASM_SIMP_TAC std_ss [REAL_LT_RMUL] THEN
7292  MATCH_MP_TAC(REAL_ARITH ``&0 < k /\ k < &1 ==> abs(&1 - k) < &1:real``) THEN
7293  ASM_SIMP_TAC std_ss [REAL_LT_LDIV_EQ, REAL_LT_RDIV_EQ, REAL_MUL_LZERO,
7294   REAL_MUL_LID]
7295QED
7296
7297Theorem CLOSURE_BALL:
7298   !x:real e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))
7299Proof
7300  SIMP_TAC std_ss [EXTENSION, closure, GSPECIFICATION, IN_UNION, LIMPT_BALL] THEN
7301  REWRITE_TAC[IN_BALL, IN_CBALL] THEN REAL_ARITH_TAC
7302QED
7303
7304Theorem INTERIOR_BALL:
7305   !a r. interior(ball(a,r)) = ball(a,r)
7306Proof
7307  SIMP_TAC std_ss [INTERIOR_OPEN, OPEN_BALL]
7308QED
7309
7310Theorem INTERIOR_CBALL:
7311   !x:real e. interior(cball(x,e)) = ball(x,e)
7312Proof
7313  REPEAT GEN_TAC THEN ASM_CASES_TAC ``&0 <= e:real`` THENL
7314  [ALL_TAC,
7315   SUBGOAL_THEN ``(cball(x:real,e) = {}) /\ (ball(x:real,e) = {})``
7316    (fn th => REWRITE_TAC[th, INTERIOR_EMPTY]) THEN
7317   REWRITE_TAC[IN_BALL, IN_CBALL, EXTENSION, NOT_IN_EMPTY] THEN
7318   CONJ_TAC THEN X_GEN_TAC ``y:real`` THEN
7319   MP_TAC(ISPECL [``x:real``, ``y:real``] DIST_POS_LE) THEN
7320   POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN
7321  MATCH_MP_TAC INTERIOR_UNIQUE THEN
7322  REWRITE_TAC[BALL_SUBSET_CBALL, OPEN_BALL] THEN
7323  X_GEN_TAC ``t:real->bool`` THEN
7324  SIMP_TAC std_ss [SUBSET_DEF, IN_CBALL, IN_BALL, REAL_LT_LE] THEN STRIP_TAC THEN
7325  X_GEN_TAC ``z:real`` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
7326  UNDISCH_TAC ``open t`` THEN REWRITE_TAC [open_def] THEN
7327  DISCH_THEN(MP_TAC o SPEC ``z:real``) THEN
7328  ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN ``d:real`` MP_TAC) THEN
7329  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7330  ASM_CASES_TAC ``z:real = x`` THENL
7331  [FIRST_X_ASSUM SUBST_ALL_TAC THEN
7332  FIRST_X_ASSUM(X_CHOOSE_TAC ``k:real`` o MATCH_MP REAL_DOWN) THEN
7333  SUBGOAL_THEN ``?w:real. dist(w,x) = k`` STRIP_ASSUME_TAC THENL
7334  [ASM_MESON_TAC[REAL_CHOOSE_DIST, DIST_SYM, REAL_LT_IMP_LE],
7335   ASM_MESON_TAC[REAL_NOT_LE, DIST_REFL, DIST_SYM]],
7336  RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN
7337  DISCH_THEN(MP_TAC o SPEC ``z + ((d / &2) / dist(z,x)) * (z - x:real)``) THEN
7338  FULL_SIMP_TAC arith_ss [dist, REAL_ADD_SUB, ABS_MUL, ABS_DIV,
7339  ABS_ABS, ABS_N, REAL_POS_NZ, REAL_ARITH ``0 < 2:real``] THEN
7340  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, GSYM dist, REAL_POS_NZ] THEN
7341  ASM_SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_LT] THEN
7342  ASM_REWRITE_TAC [REAL_ARITH ``abs d < d * &2 <=> &0 < d:real``] THEN
7343  DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN
7344  REWRITE_TAC[REAL_ARITH ``x - (z + k * (z - x)) = (&1 + k) * (x - z:real)``] THEN
7345  REWRITE_TAC[REAL_NOT_LE, ABS_MUL] THEN
7346  GEN_REWR_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
7347  ONCE_REWRITE_TAC[ABS_SUB] THEN
7348  ASM_SIMP_TAC std_ss [REAL_LT_RMUL, GSYM dist] THEN
7349  MATCH_MP_TAC(REAL_ARITH ``&0 < x ==> &1:real < abs(&1 + x)``) THEN
7350  ONCE_REWRITE_TAC[DIST_SYM] THEN
7351  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT, dist]]
7352QED
7353
7354Theorem FRONTIER_BALL:
7355   !a e. &0 < e ==> (frontier(ball(a,e)) = sphere(a,e))
7356Proof
7357  SIMP_TAC std_ss [frontier, sphere, CLOSURE_BALL, INTERIOR_OPEN, OPEN_BALL,
7358   REAL_LT_IMP_LE] THEN
7359  SIMP_TAC std_ss [EXTENSION, IN_DIFF, GSPECIFICATION, IN_BALL, IN_CBALL] THEN
7360  REAL_ARITH_TAC
7361QED
7362
7363Theorem FRONTIER_CBALL:
7364   !a e. (frontier(cball(a,e)) = sphere(a,e))
7365Proof
7366  SIMP_TAC std_ss [frontier, sphere, INTERIOR_CBALL, CLOSED_CBALL, CLOSURE_CLOSED,
7367   REAL_LT_IMP_LE] THEN
7368  SIMP_TAC std_ss [EXTENSION, IN_DIFF, SPECIFICATION, IN_BALL, IN_CBALL, dist] THEN
7369  GEN_REWR_TAC (QUANT_CONV o QUANT_CONV o QUANT_CONV o RAND_CONV) [GSYM SPECIFICATION] THEN
7370  SIMP_TAC std_ss [GSPECIFICATION] THEN REAL_ARITH_TAC
7371QED
7372
7373Theorem CBALL_EQ_EMPTY:
7374   !x e. (cball(x,e) = {}) <=> e < &0
7375Proof
7376  REWRITE_TAC[EXTENSION, IN_CBALL, NOT_IN_EMPTY, REAL_NOT_LE] THEN
7377  MESON_TAC[DIST_POS_LE, DIST_REFL, REAL_LTE_TRANS]
7378QED
7379
7380Theorem CBALL_EMPTY:
7381   !x e. e < &0 ==> (cball(x,e) = {})
7382Proof
7383 REWRITE_TAC[CBALL_EQ_EMPTY]
7384QED
7385
7386Theorem CBALL_EQ_SING:
7387   !x:real e. (cball(x,e) = {x}) <=> (e = &0)
7388Proof
7389  REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION, IN_CBALL, IN_SING] THEN
7390  EQ_TAC THENL [ALL_TAC, MESON_TAC[DIST_LE_0]] THEN
7391  DISCH_THEN(fn th => MP_TAC(SPEC ``x + (e / &2) * 1:real`` th) THEN
7392  MP_TAC(SPEC ``x:real`` th)) THEN
7393  REWRITE_TAC[dist, REAL_ARITH ``x - (x + e):real = -e``,
7394   REAL_ARITH ``(x + e = x) <=> (e:real = 0)``] THEN
7395  REWRITE_TAC[ABS_NEG, ABS_MUL, REAL_ENTIRE, ABS_0, REAL_SUB_REFL] THEN
7396  SIMP_TAC std_ss [ABS_1, REAL_ARITH ``~(1 = 0:real)``] THEN
7397  SIMP_TAC arith_ss [REAL_MUL_RID, REAL_EQ_LDIV_EQ,
7398   REAL_ARITH ``0 < 2:real``, REAL_MUL_LZERO] THEN
7399  GEN_REWR_TAC LAND_CONV [REAL_LE_LT] THEN RW_TAC arith_ss [] THEN
7400  RULE_ASSUM_TAC (ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN ASM_REWRITE_TAC [abs] THEN
7401  COND_CASES_TAC THENL
7402  [FULL_SIMP_TAC std_ss [REAL_LE_LT] THEN DISJ1_TAC THEN
7403   ASM_SIMP_TAC std_ss [REAL_LT_HALF2], ALL_TAC] THEN
7404  UNDISCH_TAC ``0 < e:real`` THEN GEN_REWR_TAC LAND_CONV [GSYM REAL_LT_HALF1] THEN
7405  DISCH_TAC THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN METIS_TAC [REAL_LT_ANTISYM]
7406QED
7407
7408Theorem CBALL_SING:
7409   !x e. (e = &0) ==> (cball(x,e) = {x})
7410Proof
7411 REWRITE_TAC[CBALL_EQ_SING]
7412QED
7413
7414Theorem SPHERE_SING:
7415   !x e. (e = &0) ==> (sphere(x,e) = {x})
7416Proof
7417  SIMP_TAC std_ss [sphere, DIST_EQ_0, GSPEC_EQ, GSPEC_EQ2]
7418QED
7419
7420Theorem SPHERE_EQ_SING:
7421   !a:real r x. (sphere(a,r) = {x}) <=> (x = a) /\ (r = &0)
7422Proof
7423  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [SPHERE_SING] THEN
7424  ASM_CASES_TAC ``r < &0:real`` THEN ASM_SIMP_TAC std_ss [SPHERE_EMPTY, NOT_INSERT_EMPTY] THEN
7425  ASM_CASES_TAC ``r = &0:real`` THEN ASM_SIMP_TAC std_ss [SPHERE_SING] THENL
7426  [ASM_SET_TAC[], ALL_TAC] THEN
7427  MATCH_MP_TAC(SET_RULE
7428   ``!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})``) THEN
7429  EXISTS_TAC ``a - (x - a):real`` THEN REWRITE_TAC[IN_SPHERE] THEN
7430  REWRITE_TAC [dist] THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC
7431QED
7432
7433(* ------------------------------------------------------------------------- *)
7434(* For points in the interior, localization of limits makes no difference.   *)
7435(* ------------------------------------------------------------------------- *)
7436
7437Theorem EVENTUALLY_WITHIN_INTERIOR:
7438   !p s x.
7439  x IN interior s
7440  ==> (eventually p (at x within s) <=> eventually p (at x))
7441Proof
7442  REWRITE_TAC[EVENTUALLY_WITHIN, EVENTUALLY_AT, IN_INTERIOR] THEN
7443  REPEAT GEN_TAC THEN SIMP_TAC std_ss [SUBSET_DEF, IN_BALL] THEN
7444  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
7445  EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
7446  EXISTS_TAC ``min (d:real) e`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
7447  ASM_MESON_TAC[DIST_SYM]
7448QED
7449
7450Theorem LIM_WITHIN_INTERIOR:
7451   !f l s x. x IN interior s
7452   ==> ((f --> l) (at x within s) <=> (f --> l) (at x))
7453Proof
7454  SIMP_TAC std_ss [tendsto, EVENTUALLY_WITHIN_INTERIOR]
7455QED
7456
7457Theorem NETLIMIT_WITHIN_INTERIOR:
7458   !s x:real. x IN interior s ==> (netlimit(at x within s) = x)
7459Proof
7460  REPEAT STRIP_TAC THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN
7461  REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN
7462  FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[OPEN_CONTAINS_BALL]
7463   (SPEC_ALL OPEN_INTERIOR))) THEN
7464  ASM_MESON_TAC[LIMPT_SUBSET, LIMPT_BALL, CENTRE_IN_CBALL, REAL_LT_IMP_LE,
7465   SUBSET_TRANS, INTERIOR_SUBSET]
7466QED
7467
7468(* ------------------------------------------------------------------------- *)
7469(* A non-singleton connected set is perfect (i.e. has no isolated points). *)
7470(* ------------------------------------------------------------------------- *)
7471
7472Theorem CONNECTED_IMP_PERFECT:
7473   !s x:real.
7474   connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s
7475Proof
7476  REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of] THEN
7477  X_GEN_TAC ``t:real->bool`` THEN STRIP_TAC THEN
7478  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7479  KNOW_TAC ``open t`` THENL [ASM_REWRITE_TAC [], ALL_TAC] THEN
7480  GEN_REWR_TAC LAND_CONV [OPEN_CONTAINS_CBALL] THEN
7481  DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `x:real`) THEN
7482  ASM_REWRITE_TAC[] THEN
7483  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
7484  UNDISCH_TAC ``connected s`` THEN GEN_REWR_TAC LAND_CONV [CONNECTED_CLOPEN] THEN
7485  DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `{x:real}`) THEN
7486  REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
7487  [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC ``t:real->bool`` THEN
7488   ASM_SET_TAC[],
7489   REWRITE_TAC[CLOSED_IN_CLOSED] THEN
7490   EXISTS_TAC ``cball(x:real,e)`` THEN REWRITE_TAC[CLOSED_CBALL] THEN
7491   REWRITE_TAC[EXTENSION, IN_INTER, IN_SING] THEN
7492   ASM_MESON_TAC[CENTRE_IN_CBALL, SUBSET_DEF, REAL_LT_IMP_LE],
7493  ASM_SET_TAC[]]
7494QED
7495
7496Theorem CONNECTED_IMP_PERFECT_CLOSED:
7497   !s x. connected s /\ closed s /\ ~(?a. s = {a})
7498   ==> (x limit_point_of s <=> x IN s)
7499Proof
7500  MESON_TAC[CONNECTED_IMP_PERFECT, CLOSED_LIMPT]
7501QED
7502
7503(* ------------------------------------------------------------------------- *)
7504(* Boundedness.                                                              *)
7505(* ------------------------------------------------------------------------- *)
7506
7507Definition bounded_def :
7508    Bounded s <=> ?a. !x:real. x IN s ==> abs(x) <= a
7509End
7510Overload bounded = “Bounded”
7511
7512(* NOTE: The alternative definition is usually better for providing “0 <= a” *)
7513Theorem bounded_alt :
7514    !(s :real set). bounded s <=> ?a. 0 <= a /\ !x. x IN s ==> abs x <= a
7515Proof
7516    rw [bounded_def]
7517 >> reverse EQ_TAC >- (STRIP_TAC >> Q.EXISTS_TAC ‘a’ >> art [])
7518 >> STRIP_TAC
7519 >> Cases_on ‘s = {}’ >> simp []
7520 >- (Q.EXISTS_TAC ‘0’ >> simp [])
7521 >> fs [GSYM MEMBER_NOT_EMPTY]
7522 >> Cases_on ‘0 <= a’ >- (Q.EXISTS_TAC ‘a’ >> art [])
7523 >> fs [REAL_NOT_LE]
7524 >> ‘abs x <= a’ by PROVE_TAC []
7525 >> ‘abs x < 0’ by PROVE_TAC [REAL_LET_TRANS]
7526 >> METIS_TAC [ABS_POS, REAL_LET_ANTISYM]
7527QED
7528
7529Theorem BOUNDED_EMPTY:
7530   bounded {}
7531Proof
7532  REWRITE_TAC[bounded_def, NOT_IN_EMPTY]
7533QED
7534
7535Theorem BOUNDED_SUBSET:
7536   !s t. bounded t /\ s SUBSET t ==> bounded s
7537Proof
7538  MESON_TAC[bounded_def, SUBSET_DEF]
7539QED
7540
7541Theorem BOUNDED_INTERIOR:
7542   !s:real->bool. bounded s ==> bounded(interior s)
7543Proof
7544  MESON_TAC[BOUNDED_SUBSET, INTERIOR_SUBSET]
7545QED
7546
7547Theorem BOUNDED_CLOSURE:
7548   !s:real->bool. bounded s ==> bounded(closure s)
7549Proof
7550  REWRITE_TAC[bounded_def, CLOSURE_SEQUENTIAL] THEN
7551  GEN_TAC THEN STRIP_TAC THEN EXISTS_TAC ``a:real`` THEN
7552  GEN_TAC THEN
7553  METIS_TAC[REWRITE_RULE[eventually] LIM_ABS_UBOUND,
7554   TRIVIAL_LIMIT_SEQUENTIALLY, trivial_limit]
7555QED
7556
7557Theorem BOUNDED_CLOSURE_EQ:
7558   !s:real->bool. bounded(closure s) <=> bounded s
7559Proof
7560  GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN
7561  MESON_TAC[BOUNDED_SUBSET, CLOSURE_SUBSET]
7562QED
7563
7564Theorem BOUNDED_CBALL:
7565   !x:real e. bounded(cball(x,e))
7566Proof
7567  REPEAT GEN_TAC THEN REWRITE_TAC[bounded_def] THEN
7568  EXISTS_TAC ``abs(x:real) + e`` THEN REWRITE_TAC[IN_CBALL, dist] THEN
7569  REAL_ARITH_TAC
7570QED
7571
7572Theorem BOUNDED_BALL:
7573   !x e. bounded(ball(x,e))
7574Proof
7575  MESON_TAC[BALL_SUBSET_CBALL, BOUNDED_CBALL, BOUNDED_SUBSET]
7576QED
7577
7578Theorem FINITE_IMP_BOUNDED:
7579   !s:real->bool. FINITE s ==> bounded s
7580Proof
7581  KNOW_TAC ``!s:real->bool. (bounded s) = (\s. bounded s) s`` THENL
7582  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
7583  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN REWRITE_TAC[BOUNDED_EMPTY] THEN
7584  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
7585  REWRITE_TAC[bounded_def, IN_INSERT] THEN GEN_TAC THEN X_GEN_TAC ``x:real`` THEN
7586  REWRITE_TAC [AND_IMP_INTRO] THEN STRIP_TAC THEN
7587  EXISTS_TAC ``abs(x:real) + abs a`` THEN REPEAT STRIP_TAC THEN
7588  ASM_MESON_TAC[ABS_POS, REAL_ARITH
7589   ``(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b:real``]
7590QED
7591
7592Theorem BOUNDED_UNION:
7593   !s t. bounded (s UNION t) <=> bounded s /\ bounded t
7594Proof
7595  REWRITE_TAC[bounded_def, IN_UNION] THEN MESON_TAC[REAL_LE_MAX]
7596QED
7597
7598Theorem BOUNDED_BIGUNION:
7599   !f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(BIGUNION f)
7600Proof
7601  REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
7602  KNOW_TAC ``!f. ((!s. s IN f ==> bounded s) ==> bounded(BIGUNION f)) =
7603             (\f. (!s. s IN f ==> bounded s) ==> bounded(BIGUNION f)) f`` THENL
7604  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
7605  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
7606  REWRITE_TAC[BIGUNION_EMPTY, BOUNDED_EMPTY, IN_INSERT, BIGUNION_INSERT] THEN
7607  MESON_TAC[BOUNDED_UNION]
7608QED
7609
7610Theorem BOUNDED_POS:
7611   !s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> abs(x) <= b
7612Proof
7613  REWRITE_TAC[bounded_def] THEN
7614  METIS_TAC[REAL_ARITH ``&0 < &1 + abs(y) /\ (x <= y ==> x:real <= &1 + abs(y))``]
7615QED
7616
7617Theorem BOUNDED_POS_LT:
7618   !s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> abs(x) < b
7619Proof
7620  REWRITE_TAC[bounded_def] THEN
7621  MESON_TAC[REAL_LT_IMP_LE,
7622   REAL_ARITH ``&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y:real))``]
7623QED
7624
7625Theorem BOUNDED_INTER:
7626   !s t. bounded s \/ bounded t ==> bounded (s INTER t)
7627Proof
7628  MESON_TAC[BOUNDED_SUBSET, INTER_SUBSET]
7629QED
7630
7631Theorem BOUNDED_DIFF:
7632   !s t. bounded s ==> bounded (s DIFF t)
7633Proof
7634  METIS_TAC[BOUNDED_SUBSET, DIFF_SUBSET]
7635QED
7636
7637Theorem BOUNDED_INSERT:
7638   !x s. bounded(x INSERT s) <=> bounded s
7639Proof
7640  ONCE_REWRITE_TAC[SET_RULE ``x INSERT s = {x} UNION s``] THEN
7641  SIMP_TAC std_ss [BOUNDED_UNION, FINITE_IMP_BOUNDED, FINITE_EMPTY, FINITE_INSERT]
7642QED
7643
7644Theorem BOUNDED_SING:
7645   !a. bounded {a}
7646Proof
7647  REWRITE_TAC[BOUNDED_INSERT, BOUNDED_EMPTY]
7648QED
7649
7650Theorem BOUNDED_BIGINTER:
7651   !f:(real->bool)->bool.
7652    (?s:real->bool. s IN f /\ bounded s) ==> bounded(BIGINTER f)
7653Proof
7654  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, CONJ_EQ_IMP] THEN REPEAT GEN_TAC THEN
7655  DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
7656  ASM_SET_TAC[]
7657QED
7658
7659Theorem NOT_BOUNDED_UNIV:
7660   ~(bounded univ(:real))
7661Proof
7662  SIMP_TAC std_ss [BOUNDED_POS, NOT_FORALL_THM, NOT_EXISTS_THM, IN_UNIV,
7663                   DE_MORGAN_THM, REAL_NOT_LE] THEN
7664  X_GEN_TAC ``B:real`` THEN ASM_CASES_TAC ``&0 < B:real`` THEN ASM_REWRITE_TAC[] THEN
7665  EXISTS_TAC ``(B + &1):real`` THEN REAL_ARITH_TAC
7666QED
7667
7668Theorem COBOUNDED_IMP_UNBOUNDED:
7669   !s. bounded(univ(:real) DIFF s) ==> ~bounded s
7670Proof
7671  GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
7672  REWRITE_TAC[GSYM BOUNDED_UNION, SET_RULE ``UNIV DIFF s UNION s = UNIV``] THEN
7673  REWRITE_TAC[NOT_BOUNDED_UNIV]
7674QED
7675
7676Theorem BOUNDED_LINEAR_IMAGE:
7677   !f:real->real s. bounded s /\ linear f ==> bounded(IMAGE f s)
7678Proof
7679  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
7680  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC ``B1:real``) MP_TAC) THEN
7681  DISCH_THEN(X_CHOOSE_TAC ``B2:real`` o MATCH_MP LINEAR_BOUNDED_POS) THEN
7682  EXISTS_TAC ``B2 * B1:real`` THEN ASM_SIMP_TAC std_ss [REAL_LT_MUL, FORALL_IN_IMAGE] THEN
7683  X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
7684  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``B2 * abs(x:real)`` THEN
7685  ASM_SIMP_TAC std_ss [REAL_LE_LMUL]
7686QED
7687
7688Theorem BOUNDED_SCALING:
7689   !c s. bounded s ==> bounded (IMAGE (\x. c * x) s)
7690Proof
7691  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
7692  ASM_SIMP_TAC std_ss [LINEAR_COMPOSE_CMUL, LINEAR_ID]
7693QED
7694
7695Theorem BOUNDED_NEGATIONS:
7696   !s. bounded s ==> bounded (IMAGE (\x. -x) s)
7697Proof
7698  GEN_TAC THEN
7699  DISCH_THEN(MP_TAC o SPEC ``-&1:real`` o MATCH_MP BOUNDED_SCALING) THEN
7700  REWRITE_TAC[bounded_def, IN_IMAGE, REAL_MUL_LNEG, REAL_MUL_LID]
7701QED
7702
7703Theorem BOUNDED_TRANSLATION:
7704   !a:real s. bounded s ==> bounded (IMAGE (\x. a + x) s)
7705Proof
7706  REPEAT GEN_TAC THEN SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE] THEN
7707  DISCH_THEN(X_CHOOSE_TAC ``B:real``) THEN
7708  EXISTS_TAC ``B + abs(a:real)`` THEN POP_ASSUM MP_TAC THEN
7709  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
7710  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `x:real`) THEN
7711  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC
7712QED
7713
7714Theorem BOUNDED_TRANSLATION_EQ:
7715   !a s. bounded (IMAGE (\x:real. a + x) s) <=> bounded s
7716Proof
7717  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN
7718  DISCH_THEN(MP_TAC o SPEC ``-a:real`` o MATCH_MP BOUNDED_TRANSLATION) THEN
7719  SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, IMAGE_ID,
7720   REAL_ARITH ``-a + (a + x:real) = x``]
7721QED
7722
7723Theorem BOUNDED_DIFFS:
7724   !s t:real->bool.
7725  bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}
7726Proof
7727  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
7728  DISCH_THEN(CONJUNCTS_THEN2
7729   (X_CHOOSE_TAC ``B:real``) (X_CHOOSE_TAC ``C:real``)) THEN
7730  EXISTS_TAC ``B + C:real`` THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
7731  CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_ADD THEN ASM_REWRITE_TAC [], REPEAT STRIP_TAC] THEN
7732  ASM_REWRITE_TAC[] THEN KNOW_TAC ``abs p_1 <= B:real /\ abs p_2 <= C:real`` THENL
7733  [ASM_SET_TAC [], ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
7734  EXISTS_TAC ``abs p_1 + abs p_2:real`` THEN REWRITE_TAC [real_sub, ABS_TRIANGLE] THEN
7735  CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
7736  MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC [ABS_NEG]
7737QED
7738
7739Theorem BOUNDED_SUMS:
7740   !s t:real->bool.
7741   bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}
7742Proof
7743  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
7744  DISCH_THEN(CONJUNCTS_THEN2
7745   (X_CHOOSE_TAC ``B:real``) (X_CHOOSE_TAC ``C:real``)) THEN
7746  EXISTS_TAC ``B + C:real`` THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
7747  CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_ADD THEN ASM_REWRITE_TAC [], REPEAT STRIP_TAC] THEN
7748  ASM_REWRITE_TAC[] THEN KNOW_TAC ``abs p_1 <= B:real /\ abs p_2 <= C:real`` THENL
7749  [ASM_SET_TAC [], ALL_TAC] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
7750  EXISTS_TAC ``abs p_1 + abs p_2:real`` THEN REWRITE_TAC [ABS_TRIANGLE] THEN
7751  MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC []
7752QED
7753
7754Theorem BOUNDED_SUMS_IMAGE:
7755   !f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t}
7756    ==> bounded {f x + g x | x IN t}
7757Proof
7758  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN
7759  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
7760  REWRITE_TAC [SUBSET_DEF] THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
7761  METIS_TAC []
7762QED
7763
7764Theorem BOUNDED_SUMS_IMAGES:
7765   !f:'a->'b->real t s. FINITE s /\
7766     (!a. a IN s ==> bounded {f x a | x IN t})
7767     ==> bounded { sum s (f x) | x IN t}
7768Proof
7769  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
7770  KNOW_TAC ``!s. ((!a. a IN s ==> bounded {(f:'a->'b->real) x a | x IN t}) ==>
7771                                  bounded {sum s (f x) | x IN t}) =
7772             (\s. (!a. a IN s ==> bounded {f x a | x IN t}) ==>
7773                                  bounded {sum s (f x) | x IN t}) s`` THENL
7774  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
7775  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
7776  SIMP_TAC std_ss [SUM_CLAUSES] THEN CONJ_TAC THENL
7777  [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
7778   EXISTS_TAC ``{0:real}`` THEN
7779   SIMP_TAC std_ss [FINITE_IMP_BOUNDED, FINITE_EMPTY, FINITE_INSERT] THEN SET_TAC[],
7780   ALL_TAC] THEN REPEAT STRIP_TAC THEN
7781  KNOW_TAC ``bounded {(f:'a->'b->real) x e | x IN t} /\
7782             bounded {sum s ((f:'a->'b->real) x) | x IN t}`` THENL
7783  [ALL_TAC, METIS_TAC [BOUNDED_SUMS_IMAGE]] THEN ASM_SIMP_TAC std_ss [IN_INSERT]
7784QED
7785
7786Theorem BOUNDED_SUBSET_BALL:
7787   !s x:real. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)
7788Proof
7789  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
7790  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
7791  EXISTS_TAC ``&2 * B + abs(x:real)`` THEN
7792  ASM_SIMP_TAC std_ss [ABS_POS, REAL_ARITH
7793   ``&0 < B /\ &0 <= x ==> &0 < &2 * B + x:real``] THEN
7794  REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
7795  FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN ASM_REWRITE_TAC[IN_BALL, dist] THEN
7796  UNDISCH_TAC ``&0 < B:real`` THEN REAL_ARITH_TAC
7797QED
7798
7799Theorem BOUNDED_SUBSET_CBALL:
7800   !s x:real. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)
7801Proof
7802  MESON_TAC[BOUNDED_SUBSET_BALL, SUBSET_TRANS, BALL_SUBSET_CBALL]
7803QED
7804
7805Theorem UNBOUNDED_INTER_COBOUNDED:
7806   !s t. ~bounded s /\ bounded(univ(:real) DIFF t) ==> ~(s INTER t = {})
7807Proof
7808  REWRITE_TAC[SET_RULE ``(s INTER t = {}) <=> s SUBSET univ(:real) DIFF t``] THEN
7809  MESON_TAC[BOUNDED_SUBSET]
7810QED
7811
7812Theorem COBOUNDED_INTER_UNBOUNDED:
7813   !s t. bounded(univ(:real) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})
7814Proof
7815  REWRITE_TAC[SET_RULE ``(s INTER t = {}) <=> t SUBSET univ(:real) DIFF s``] THEN
7816  MESON_TAC[BOUNDED_SUBSET]
7817QED
7818
7819Theorem SUBSPACE_BOUNDED_EQ_TRIVIAL:
7820   !s:real->bool. subspace s ==> (bounded s <=> (s = {0}))
7821Proof
7822  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [BOUNDED_SING] THEN
7823  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
7824  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
7825  ``~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)``)) THEN
7826  ASM_SIMP_TAC std_ss [SUBSPACE_0] THEN
7827  DISCH_THEN(X_CHOOSE_THEN ``v:real`` STRIP_ASSUME_TAC) THEN
7828  SIMP_TAC std_ss [bounded_def, NOT_EXISTS_THM] THEN X_GEN_TAC ``B:real`` THEN
7829  EXISTS_TAC ``(B + &1) / abs v * v:real`` THEN
7830  RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM ABS_ZERO]) THEN
7831  ASM_SIMP_TAC std_ss [SUBSPACE_MUL, ABS_MUL, ABS_DIV, ABS_ABS] THEN
7832  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, ABS_ZERO] THEN REAL_ARITH_TAC
7833QED
7834
7835Theorem BOUNDED_COMPONENTWISE:
7836   !s:real->bool.
7837   bounded s <=> bounded (IMAGE (\x. x) s)
7838Proof
7839 METIS_TAC [IMAGE_ID]
7840QED
7841
7842(* ------------------------------------------------------------------------- *)
7843(* Some theorems on sups and infs using the notion "bounded".                *)
7844(* ------------------------------------------------------------------------- *)
7845
7846Theorem BOUNDED_HAS_SUP:
7847   !s. bounded s /\ ~(s = {})
7848    ==> (!x. x IN s ==> x <= sup s) /\
7849    (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)
7850Proof
7851  REWRITE_TAC[bounded_def, IMAGE_EQ_EMPTY] THEN
7852  MESON_TAC[SUP, REAL_ARITH ``abs(x) <= a ==> x <= a:real``]
7853QED
7854
7855Theorem SUP_INSERT:
7856   !x s:real->bool. bounded s
7857   ==> (sup(x INSERT s) = if s = {} then x else (max x (sup s)))
7858Proof
7859  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN
7860  COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL
7861  [MESON_TAC[REAL_LE_REFL], ALL_TAC] THEN
7862   REWRITE_TAC[REAL_LE_MAX, REAL_LT_MAX, IN_INSERT] THEN
7863   MP_TAC(ISPEC ``s:real->bool`` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN
7864   REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL, REAL_NOT_LT]
7865QED
7866
7867Theorem BOUNDED_HAS_INF:
7868   !s. bounded s /\ ~(s = {})
7869   ==> (!x. x IN s ==> inf s <= x) /\
7870   (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)
7871Proof
7872  REWRITE_TAC[bounded_def, IMAGE_EQ_EMPTY] THEN
7873  MESON_TAC[INF, REAL_ARITH ``abs(x) <= a ==> -a <= x:real``]
7874QED
7875
7876Theorem INF_INSERT:
7877   !x s. bounded s
7878   ==> (inf(x INSERT s) = if s = {} then x else (min x (inf s)))
7879Proof
7880  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN
7881  COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL
7882  [MESON_TAC[REAL_LE_REFL], ALL_TAC] THEN
7883   REWRITE_TAC[REAL_MIN_LE, REAL_MIN_LT, IN_INSERT] THEN
7884   MP_TAC(ISPEC ``s:real->bool`` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN
7885   REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL, REAL_NOT_LT]
7886QED
7887
7888(* ------------------------------------------------------------------------- *)
7889(* Subset and overlapping relations on balls.                                *)
7890(* ------------------------------------------------------------------------- *)
7891
7892Theorem lemma[local]:
7893     (!a':real r r'.
7894       cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\
7895     (!a':real r r'.
7896       cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)
7897Proof
7898    CONJ_TAC THENL
7899    [KNOW_TAC ``(!a' r r'.
7900  cball (a,r) SUBSET cball (a',r') <=> dist (a,a') + r <= r' \/ r < 0) =
7901               (!r r' a.
7902  cball (a,r) SUBSET cball (0,r') <=> dist (a,0) + r <= r' \/ r < 0)`` THENL
7903  [EQ_TAC THENL
7904   [DISCH_TAC THEN REPEAT GEN_TAC THEN
7905    FULL_SIMP_TAC std_ss [cball, ball, SUBSET_DEF, GSPECIFICATION, dist,
7906     REAL_SUB_LZERO, REAL_SUB_RZERO, ABS_NEG] THEN
7907    POP_ASSUM (MP_TAC o Q.SPEC `a - a':real`) THEN DISCH_TAC THEN
7908    FULL_SIMP_TAC std_ss [REAL_ARITH ``a - (a - b) = b:real``] THEN
7909    POP_ASSUM (MP_TAC o Q.SPEC `r:real`) THEN DISCH_TAC THEN
7910    POP_ASSUM (MP_TAC o Q.SPEC `r':real`) THEN DISCH_TAC THEN
7911    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
7912    ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN EQ_TAC THENL
7913    [DISCH_TAC THEN GEN_TAC THEN
7914     POP_ASSUM (MP_TAC o Q.SPEC `-(a - a' - x:real)`) THEN
7915     REWRITE_TAC [ABS_NEG] THEN REAL_ARITH_TAC, ALL_TAC] THEN
7916    DISCH_TAC THEN GEN_TAC THEN
7917    POP_ASSUM (MP_TAC o Q.SPEC `-(-a + a' - x:real)`) THEN
7918    REAL_ARITH_TAC, ALL_TAC] THEN
7919  DISCH_TAC THEN REPEAT GEN_TAC THEN
7920  FULL_SIMP_TAC std_ss [cball, ball, SUBSET_DEF, GSPECIFICATION, dist,
7921   REAL_SUB_LZERO, REAL_SUB_RZERO, ABS_NEG] THEN
7922  POP_ASSUM (MP_TAC o Q.SPEC `r:real`) THEN DISCH_TAC THEN
7923  POP_ASSUM (MP_TAC o Q.SPEC `r':real`) THEN DISCH_TAC THEN
7924  POP_ASSUM (MP_TAC o Q.SPEC `a - a':real`) THEN DISCH_TAC THEN
7925  RULE_ASSUM_TAC (ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
7926  ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN EQ_TAC THENL
7927  [DISCH_TAC THEN GEN_TAC THEN
7928   POP_ASSUM (MP_TAC o Q.SPEC `-(-a' - x:real)`) THEN
7929   REAL_ARITH_TAC, ALL_TAC] THEN
7930  DISCH_TAC THEN GEN_TAC THEN
7931  POP_ASSUM (MP_TAC o Q.SPEC `-(a' - x:real)`) THEN
7932  REAL_ARITH_TAC,
7933  DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC],
7934    KNOW_TAC ``(!a' r r'.
7935  cball (a,r) SUBSET ball (a',r') <=> dist (a,a') + r < r' \/ r < 0) =
7936               (!r r' a.
7937  cball (a,r) SUBSET ball (0,r') <=> dist (a,0) + r < r' \/ r < 0)`` THENL
7938  [EQ_TAC THENL
7939   [DISCH_TAC THEN REPEAT GEN_TAC THEN
7940    FULL_SIMP_TAC std_ss [cball, ball, SUBSET_DEF, GSPECIFICATION, dist,
7941     REAL_SUB_LZERO, REAL_SUB_RZERO, ABS_NEG] THEN
7942    POP_ASSUM (MP_TAC o Q.SPEC `a - a':real`) THEN DISCH_TAC THEN
7943    FULL_SIMP_TAC std_ss [REAL_ARITH ``a - (a - b) = b:real``] THEN
7944    POP_ASSUM (MP_TAC o Q.SPEC `r:real`) THEN DISCH_TAC THEN
7945    POP_ASSUM (MP_TAC o Q.SPEC `r':real`) THEN DISCH_TAC THEN
7946    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
7947    ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN EQ_TAC THENL
7948    [DISCH_TAC THEN GEN_TAC THEN
7949     POP_ASSUM (MP_TAC o Q.SPEC `-(a - a' - x:real)`) THEN
7950     REWRITE_TAC [ABS_NEG] THEN REAL_ARITH_TAC, ALL_TAC] THEN
7951    DISCH_TAC THEN GEN_TAC THEN
7952    POP_ASSUM (MP_TAC o Q.SPEC `-(-a + a' - x:real)`) THEN
7953    REAL_ARITH_TAC, ALL_TAC] THEN
7954  DISCH_TAC THEN REPEAT GEN_TAC THEN
7955  FULL_SIMP_TAC std_ss [cball, ball, SUBSET_DEF, GSPECIFICATION, dist,
7956   REAL_SUB_LZERO, REAL_SUB_RZERO, ABS_NEG] THEN
7957  POP_ASSUM (MP_TAC o Q.SPEC `r:real`) THEN DISCH_TAC THEN
7958  POP_ASSUM (MP_TAC o Q.SPEC `r':real`) THEN DISCH_TAC THEN
7959  POP_ASSUM (MP_TAC o Q.SPEC `a - a':real`) THEN DISCH_TAC THEN
7960  RULE_ASSUM_TAC (ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
7961  ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN EQ_TAC THENL
7962  [DISCH_TAC THEN GEN_TAC THEN
7963   POP_ASSUM (MP_TAC o Q.SPEC `-(-a' - x:real)`) THEN
7964   REAL_ARITH_TAC, ALL_TAC] THEN
7965  DISCH_TAC THEN GEN_TAC THEN
7966  POP_ASSUM (MP_TAC o Q.SPEC `-(a' - x:real)`) THEN
7967  REAL_ARITH_TAC,
7968  DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC]] THEN
7969   (REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_DEF, IN_CBALL, IN_BALL] THEN
7970    EQ_TAC THENL
7971    [REWRITE_TAC[DIST_0],
7972     REWRITE_TAC [dist] THEN REAL_ARITH_TAC] THEN
7973    DISJ_CASES_TAC(REAL_ARITH ``r < &0 \/ &0 <= r:real``) THEN
7974    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN
7975    ASM_CASES_TAC ``a:real = 0`` THENL
7976     [FIRST_X_ASSUM(MP_TAC o SPEC ``r:real``) THEN
7977      ASM_SIMP_TAC std_ss [DIST_0, ABS_MUL, LESS_EQ_REFL] THEN
7978      ASM_REAL_ARITH_TAC,
7979      FIRST_X_ASSUM(MP_TAC o SPEC ``(&1 + r / abs(a)) * a:real``) THEN
7980      SIMP_TAC std_ss [dist, REAL_ARITH ``a - (&1 + x) * a:real = -(x * a)``] THEN
7981      ASM_SIMP_TAC std_ss [ABS_MUL, ABS_DIV, ABS_ABS, ABS_NEG, REAL_POS,
7982                   REAL_LE_DIV, ABS_POS, REAL_ADD_RDISTRIB, REAL_DIV_RMUL,
7983               ABS_ZERO, REAL_ARITH ``&0 <= x ==> (abs(&1 + x) = &1 + x:real)``] THEN
7984      ASM_REAL_ARITH_TAC])
7985QED
7986
7987val tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN
7988          ASM_SIMP_TAC std_ss [CLOSED_CBALL, CLOSURE_CLOSED, CLOSURE_BALL];
7989
7990Theorem SUBSET_BALLS:
7991   (!a a':real r r'.
7992      ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\
7993   (!a a':real r r'.
7994      ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\
7995   (!a a':real r r'.
7996      cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\
7997   (!a a':real r r'.
7998      cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)
7999Proof
8000  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
8001  KNOW_TAC ``(!a a':real r r'.
8002  (ball (a,r) SUBSET ball (a',r') <=>
8003   dist (a,a') + r <= r' \/ r <= 0) /\
8004  (ball (a,r) SUBSET cball (a',r') <=>
8005   dist (a,a') + r <= r' \/ r <= 0) /\
8006  (cball (a,r) SUBSET ball (a',r') <=>
8007     dist (a,a') + r < r' \/ r < 0) /\
8008  (cball (a,r) SUBSET cball (a',r') <=>
8009    dist (a,a') + r <= r' \/ r < 0)) =
8010   (!a:real r r'.
8011  (ball (a,r) SUBSET ball (0,r') <=>
8012   dist (a,0) + r <= r' \/ r <= 0) /\
8013  (ball (a,r) SUBSET cball (0,r') <=>
8014   dist (a,0) + r <= r' \/ r <= 0) /\
8015  (cball (a,r) SUBSET ball (0,r') <=>
8016     dist (a,0) + r < r' \/ r < 0) /\
8017  (cball (a,r) SUBSET cball (0,r') <=>
8018    dist (a,0) + r <= r' \/ r < 0))`` THENL
8019 [EQ_TAC THENL
8020  [DISCH_TAC THEN REPEAT GEN_TAC THEN METIS_TAC [], ALL_TAC] THEN
8021  DISCH_TAC THEN REPEAT GEN_TAC THEN FULL_SIMP_TAC std_ss [DIST_0] THEN
8022  FULL_SIMP_TAC std_ss [cball, ball, dist, SUBSET_DEF, GSPECIFICATION] THEN
8023  FULL_SIMP_TAC std_ss [REAL_SUB_LZERO, ABS_NEG] THEN
8024  POP_ASSUM (MP_TAC o Q.SPEC `a - a':real`) THEN DISCH_TAC THEN
8025  POP_ASSUM (MP_TAC o Q.SPEC `r:real`) THEN DISCH_TAC THEN
8026  POP_ASSUM (MP_TAC o Q.SPEC `r':real`) THEN
8027  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
8028  REPEAT STRIP_TAC THENL
8029  [UNDISCH_TAC ``abs (a - a') + r <= r' \/ r <= 0 <=>
8030        !x:real. abs (a - a' - x) < r ==> abs x < r'`` THEN
8031   REPEAT (POP_ASSUM K_TAC) THEN DISCH_TAC THEN
8032   ASM_REWRITE_TAC [] THEN EQ_TAC THENL
8033   [DISCH_TAC THEN GEN_TAC THEN
8034    POP_ASSUM (MP_TAC o Q.SPEC `-(-a' - x:real)`) THEN
8035    REAL_ARITH_TAC,
8036    DISCH_TAC THEN GEN_TAC THEN
8037    POP_ASSUM (MP_TAC o Q.SPEC `-(a' - x:real)`) THEN
8038    REAL_ARITH_TAC],
8039   UNDISCH_TAC ``abs (a - a') + r <= r' \/ r <= 0 <=>
8040        !x:real. abs (a - a' - x) < r ==> abs x <= r'`` THEN
8041   REPEAT (POP_ASSUM K_TAC) THEN DISCH_TAC THEN
8042   ASM_REWRITE_TAC [] THEN EQ_TAC THENL
8043   [DISCH_TAC THEN GEN_TAC THEN
8044    POP_ASSUM (MP_TAC o Q.SPEC `-(-a' - x:real)`) THEN
8045    REAL_ARITH_TAC,
8046    DISCH_TAC THEN GEN_TAC THEN
8047    POP_ASSUM (MP_TAC o Q.SPEC `-(a' - x:real)`) THEN
8048    REAL_ARITH_TAC],
8049   UNDISCH_TAC ``abs (a - a') + r < r' \/ r < 0 <=>
8050        !x:real. abs (a - a' - x) <= r ==> abs x < r'`` THEN
8051   REPEAT (POP_ASSUM K_TAC) THEN DISCH_TAC THEN
8052   ASM_REWRITE_TAC [] THEN EQ_TAC THENL
8053   [DISCH_TAC THEN GEN_TAC THEN
8054    POP_ASSUM (MP_TAC o Q.SPEC `-(-a' - x:real)`) THEN
8055    REAL_ARITH_TAC,
8056    DISCH_TAC THEN GEN_TAC THEN
8057    POP_ASSUM (MP_TAC o Q.SPEC `-(a' - x:real)`) THEN
8058    REAL_ARITH_TAC],
8059   UNDISCH_TAC ``abs (a - a') + r <= r' \/ r < 0 <=>
8060        !x:real. abs (a - a' - x) <= r ==> abs x <= r'`` THEN
8061   REPEAT (POP_ASSUM K_TAC) THEN DISCH_TAC THEN
8062   ASM_REWRITE_TAC [] THEN EQ_TAC THENL
8063   [DISCH_TAC THEN GEN_TAC THEN
8064    POP_ASSUM (MP_TAC o Q.SPEC `-(-a' - x:real)`) THEN
8065    REAL_ARITH_TAC,
8066    DISCH_TAC THEN GEN_TAC THEN
8067    POP_ASSUM (MP_TAC o Q.SPEC `-(a' - x:real)`) THEN
8068    REAL_ARITH_TAC]],
8069 DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
8070  REPEAT STRIP_TAC THEN
8071  (EQ_TAC THENL
8072    [ALL_TAC,
8073     REWRITE_TAC[SUBSET_DEF, IN_BALL, IN_CBALL, dist] THEN REAL_ARITH_TAC]) THEN
8074  MATCH_MP_TAC(SET_RULE
8075   ``((s = {}) <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p)
8076    ==> s SUBSET t ==> p \/ q``) THEN
8077  SIMP_TAC std_ss [BALL_EQ_EMPTY, CBALL_EQ_EMPTY, REAL_NOT_LE, REAL_NOT_LT] THEN
8078  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL
8079   [tac, tac, ALL_TAC, ALL_TAC] THEN REWRITE_TAC[lemma] THEN
8080  REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC
8081QED
8082
8083(* ------------------------------------------------------------------------- *)
8084(* A cute way of denoting open and closed intervals using overloading.       *)
8085(* ------------------------------------------------------------------------- *)
8086
8087Definition OPEN_interval :
8088    OPEN_interval ((a:real),(b:real)) = {x:real | a < x /\ x < b}
8089End
8090
8091Definition CLOSED_interval :
8092    CLOSED_interval (l :(real # real) list) =
8093      {x:real | FST (HD l) <= x /\ x <= SND (HD l)}
8094End
8095
8096Overload interval = ``OPEN_interval``
8097Overload interval = ``CLOSED_interval``
8098
8099Theorem interval:
8100   (interval (a,b) = {x:real | a < x /\ x < b}) /\
8101   (interval [a,b] = {x:real | a <= x /\ x <= b})
8102Proof
8103  REWRITE_TAC [OPEN_interval, CLOSED_interval, HD]
8104QED
8105
8106Theorem IN_INTERVAL:
8107   (x IN interval (a,b) <=> a < x /\ x < b) /\
8108   (x IN interval [a,b] <=> a <= x /\ x <= b)
8109Proof
8110  SIMP_TAC std_ss [interval, GSPECIFICATION]
8111QED
8112
8113Theorem BALL_INTERVAL:
8114   !x:real e. ball(x,e) = interval(x - e,x + e)
8115Proof
8116  REWRITE_TAC[EXTENSION, IN_BALL, IN_INTERVAL, dist] THEN
8117  REAL_ARITH_TAC
8118QED
8119
8120Theorem CBALL_INTERVAL:
8121   !x:real e. cball(x,e) = interval[x - e,x + e]
8122Proof
8123  REWRITE_TAC[EXTENSION, IN_CBALL, IN_INTERVAL, dist] THEN
8124  REAL_ARITH_TAC
8125QED
8126
8127Theorem DISJOINT_INTERVAL:
8128    !a b c d:real.
8129        ((interval[a,b] INTER interval[c,d] = {}) <=>
8130          b < a \/ d < c \/
8131          b < c \/ d < a) /\
8132        ((interval[a,b] INTER interval(c,d) = {}) <=>
8133          b < a \/ d <= c \/
8134          b <= c \/ d <= a) /\
8135        ((interval(a,b) INTER interval[c,d] = {}) <=>
8136          b <= a \/ d < c \/
8137          b <= c \/ d <= a) /\
8138        ((interval(a,b) INTER interval(c,d) = {}) <=>
8139          b <= a \/ d <= c \/
8140          b <= c \/ d <= a)
8141Proof
8142  REWRITE_TAC [EXTENSION, IN_INTER, IN_INTERVAL, NOT_IN_EMPTY] THEN
8143  SIMP_TAC std_ss [GSYM FORALL_AND_THM, NOT_FORALL_THM] THEN
8144  REWRITE_TAC [TAUT `~((p ==> q) /\ (p ==> r)) <=> p /\ (~q \/ ~r)`] THEN
8145  REWRITE_TAC [DE_MORGAN_THM] THEN
8146  REPEAT STRIP_TAC THEN (* 4 subgoals *)
8147  (EQ_TAC THENL
8148    [DISCH_THEN
8149      (MP_TAC o SPEC ``(@f. f = (max ((a:real)) ((c:real)) +
8150                                 min ((b:real)) ((d:real))) / &2):real``) THEN
8151     DISCH_TAC THEN
8152     FULL_SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ,
8153                           REAL_LT_RDIV_EQ, REAL_LT_LDIV_EQ,
8154                           REAL_ARITH ``0 < 2:real``] THEN (* 4 subgoals *)
8155     FULL_SIMP_TAC bool_ss [REAL_NOT_LE, min_def, max_def] THEN
8156     POP_ASSUM MP_TAC THEN
8157     REPEAT COND_CASES_TAC THEN ASM_REAL_ARITH_TAC,
8158
8159     DISCH_THEN (fn th => GEN_TAC THEN MP_TAC th) THEN
8160     SIMP_TAC std_ss [] THEN REAL_ARITH_TAC ])
8161QED
8162
8163(* NOTE: The original proof from HOL-Light is rather long and slow. The new
8164   shorter and faster proof is based on DISJOINT_INTERVAL.
8165 *)
8166Theorem INTER_BALLS_EQ_EMPTY :
8167   (!a b:real r s. (ball(a,r) INTER ball(b,s) = {}) <=>
8168                     r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\
8169   (!a b:real r s. (ball(a,r) INTER cball(b,s) = {}) <=>
8170                     r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\
8171   (!a b:real r s. (cball(a,r) INTER ball(b,s) = {}) <=>
8172                     r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\
8173   (!a b:real r s. (cball(a,r) INTER cball(b,s) = {}) <=>
8174                     r < &0 \/ s < &0 \/ r + s < dist(a,b))
8175Proof
8176    RW_TAC std_ss [BALL_INTERVAL, CBALL_INTERVAL, DISJOINT_INTERVAL, dist]
8177 >> REAL_ARITH_TAC
8178QED
8179
8180(* ------------------------------------------------------------------------- *)
8181(* Compactness (the definition is the one based on convegent subsequences).  *)
8182(* ------------------------------------------------------------------------- *)
8183
8184(* cf. [compact_def] connecting “compact” with “compact_in” (topologyTheory) *)
8185Definition compact[nocompute]:
8186 compact s <=> !f:num->real. (!n. f(n) IN s)
8187   ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\
8188       ((f o r) --> l) sequentially
8189End
8190
8191Theorem MONOTONE_BIGGER:
8192   !r. (!m n. m < n ==> r(m) < r(n)) ==> !n:num. n <= r(n)
8193Proof
8194  GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
8195  METIS_TAC[ZERO_LESS_EQ, ARITH_PROVE ``n <= m /\ m < p ==> SUC n <= p``, LT]
8196QED
8197
8198Theorem LIM_SUBSEQUENCE:
8199   !s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially
8200  ==> (s o r --> l) sequentially
8201Proof
8202  SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM] THEN
8203  MESON_TAC[MONOTONE_BIGGER, LESS_EQ_TRANS]
8204QED
8205
8206(* In this "weak" version, r(n) may increase weakly and slowly,
8207   but eventually r(n) should go to infinity. (added by Chun Tian for SLLN_IID)
8208
8209   This lemma is useful when ‘r = \n. flr (a pow n)’, where ‘1 < a’ (but close to 1)
8210 *)
8211Theorem LIM_SUBSEQUENCE_WEAK :
8212    !s r l. (!m n. m <= n ==> r(m) <= r(n)) /\ (!n. ?m. n <= r(m)) /\
8213            (s --> l) sequentially ==> (s o r --> l) sequentially
8214Proof
8215    RW_TAC std_ss [LIM_SEQUENTIALLY, dist, o_THM]
8216 >> Q.PAT_X_ASSUM ‘!e. 0 < e ==> P’ (MP_TAC o (Q.SPEC ‘e’))
8217 >> RW_TAC std_ss []
8218 >> Q.PAT_X_ASSUM ‘!n. ?m. n <= r m’ (MP_TAC o (Q.SPEC ‘N’))
8219 >> RW_TAC std_ss []
8220 >> Q.EXISTS_TAC ‘MAX N m’
8221 >> RW_TAC std_ss [MAX_LE]
8222 >> FIRST_X_ASSUM MATCH_MP_TAC
8223 >> MATCH_MP_TAC LESS_EQ_TRANS
8224 >> Q.EXISTS_TAC ‘r m’ >> art []
8225 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
8226QED
8227
8228Theorem MONOTONE_SUBSEQUENCE:
8229   !s:num->real. ?r:num->num.
8230   (!m n. m < n ==> r(m) < r(n)) /\
8231  ((!m n. m <= n ==> s(r(m)) <= s(r(n))) \/
8232   (!m n. m <= n ==> s(r(n)) <= s(r(m))))
8233Proof
8234  GEN_TAC THEN
8235  ASM_CASES_TAC ``!n:num. ?p. n < p /\ !m. p <= m ==> s(m):real <= s(p)`` THEN
8236  POP_ASSUM MP_TAC THEN
8237  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_EXISTS_THM, NOT_IMP, DE_MORGAN_THM] THEN
8238  SIMP_TAC std_ss [RIGHT_OR_EXISTS_THM, SKOLEM_THM, REAL_NOT_LE, REAL_NOT_LT] THENL
8239  [ABBREV_TAC ``N = 0:num``, DISCH_THEN(X_CHOOSE_THEN ``N:num`` MP_TAC)] THEN
8240  DISCH_THEN(X_CHOOSE_THEN ``next:num->num`` STRIP_ASSUME_TAC) THEN
8241  (KNOW_TAC ``(?r. (r 0 = (next:num->num) (SUC N)) /\
8242             (!n. r (SUC n) = (next:num->num) (r n)))`` THENL
8243  [RW_TAC std_ss [num_Axiom], ALL_TAC]) THEN
8244  STRIP_TAC THEN EXISTS_TAC ``r:num->num`` THENL
8245  [SUBGOAL_THEN ``!m:num n:num. r n <= m ==> s(m) <= s(r n):real``
8246   ASSUME_TAC THEN TRY CONJ_TAC THEN TRY DISJ2_TAC THEN
8247   GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC std_ss [LT, LE] THEN
8248   ASM_MESON_TAC[REAL_LE_TRANS, REAL_LE_REFL, LESS_IMP_LESS_OR_EQ, LESS_TRANS],
8249   SUBGOAL_THEN ``!n. N < (r:num->num) n`` ASSUME_TAC THEN
8250   TRY(CONJ_TAC THENL [GEN_TAC, DISJ1_TAC THEN GEN_TAC]) THEN
8251   INDUCT_TAC THEN ASM_SIMP_TAC std_ss [LT, LE] THEN
8252   TRY STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8253   ASM_MESON_TAC[REAL_LT_REFL, LT_LE, LESS_LESS_EQ_TRANS, REAL_LE_REFL,
8254    REAL_LT_LE, REAL_LE_TRANS, LT]]
8255QED
8256
8257Theorem CONVERGENT_BOUNDED_INCREASING:
8258   !s:num->real b. (!m n. m <= n ==> s m <= s n) /\ (!n. abs(s n) <= b)
8259   ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e
8260Proof
8261  REPEAT STRIP_TAC THEN
8262  MP_TAC(SPEC ``\x. ?n. (s:num->real) n = x`` REAL_COMPLETE) THEN BETA_TAC THEN
8263  KNOW_TAC ``(?x:real n:num. s n = x) /\ (?M. !x. (?n. s n = x) ==> x <= M)`` THENL
8264  [ASM_MESON_TAC[REAL_ARITH ``abs(x:real) <= b ==> x <= b``],
8265   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
8266  DISCH_THEN (X_CHOOSE_TAC ``l:real``) THEN EXISTS_TAC ``l:real`` THEN
8267  POP_ASSUM MP_TAC THEN STRIP_TAC THEN
8268  X_GEN_TAC ``e:real`` THEN STRIP_TAC THEN
8269  FIRST_X_ASSUM(MP_TAC o SPEC ``l - e:real``) THEN
8270  METIS_TAC[REAL_ARITH ``&0:real < e ==> ~(l <= l - e)``,
8271  REAL_ARITH ``x <= y /\ y <= l /\ ~(x <= l - e) ==> abs(y - l) < e:real``]
8272QED
8273
8274Theorem CONVERGENT_BOUNDED_MONOTONE:
8275   !s:num->real b. (!n. abs(s n) <= b) /\
8276   ((!m n. m <= n ==> s m <= s n) \/
8277    (!m n. m <= n ==> s n <= s m))
8278   ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e
8279Proof
8280  REPEAT STRIP_TAC THENL
8281  [ASM_MESON_TAC[CONVERGENT_BOUNDED_INCREASING], ALL_TAC] THEN
8282  MP_TAC(SPEC ``\n. -((s:num->real) n)`` CONVERGENT_BOUNDED_INCREASING) THEN
8283  ASM_SIMP_TAC std_ss [REAL_LE_NEG2, ABS_NEG] THEN
8284  ASM_MESON_TAC[REAL_ARITH ``abs(x - -l) = abs(-x - l:real)``]
8285QED
8286
8287Theorem COMPACT_REAL_LEMMA:
8288   !s b. (!n:num. abs(s n) <= b)
8289   ==> ?l r. (!m n:num. m < n ==> r(m) < r(n)) /\
8290   !e. &0:real < e ==> ?N. !n. N <= n ==> abs(s(r n) - l) < e
8291Proof
8292  REPEAT GEN_TAC THEN DISCH_TAC THEN
8293  KNOW_TAC ``?(r :num -> num) (l :real).
8294  (!(m :num) (n :num). m < n ==> r m < r n) /\
8295  !(e :real).
8296    (0 :real) < e ==>
8297    ?(N :num).
8298      !(n :num). N <= n ==> abs ((s :num -> real) (r n) - l) < e`` THENL
8299  [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
8300  MP_TAC(SPEC ``s:num->real`` MONOTONE_SUBSEQUENCE) THEN
8301  DISCH_THEN (X_CHOOSE_TAC ``r:num->num``) THEN EXISTS_TAC ``r:num->num`` THEN
8302  ASM_SIMP_TAC std_ss [] THEN POP_ASSUM MP_TAC THEN STRIP_TAC THENL
8303  [MP_TAC(SPEC ``\n. ((s:num->real) ((r:num->num) n))`` CONVERGENT_BOUNDED_INCREASING),
8304   MP_TAC(SPEC ``\n. -((s:num->real) ((r:num->num) n))`` CONVERGENT_BOUNDED_INCREASING)] THEN
8305  ASM_SIMP_TAC std_ss [REAL_LE_NEG2, ABS_NEG] THEN
8306  ASM_MESON_TAC[REAL_ARITH ``abs(x - -l) = abs(-x - l:real)``]
8307QED
8308
8309Theorem COMPACT_LEMMA:
8310  !s. bounded s /\ (!n. (x:num->real) n IN s)
8311      ==> ?l:real r. (!m n. m < n ==> r m < (r:num->num) n) /\
8312      !e. &0 < e ==> ?N. !n i. N <= n ==> abs(x(r n) - l) < e
8313Proof
8314  METIS_TAC [COMPACT_REAL_LEMMA, bounded_def]
8315QED
8316
8317Theorem BOUNDED_CLOSED_IMP_COMPACT:
8318   !s:real->bool. bounded s /\ closed s ==> compact s
8319Proof
8320  REPEAT STRIP_TAC THEN REWRITE_TAC[compact] THEN
8321  X_GEN_TAC ``x:num->real`` THEN DISCH_TAC THEN
8322  MP_TAC(ISPEC ``s:real->bool`` COMPACT_LEMMA) THEN
8323  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
8324  MAP_EVERY EXISTS_TAC [``l:real``, ``r:num->num``] THEN
8325  ASM_SIMP_TAC std_ss [] THEN
8326  MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN
8327  REPEAT STRIP_TAC THENL
8328  [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_SEQUENTIAL_LIMITS]) THEN
8329   EXISTS_TAC ``(x:num->real) o (r:num->num)`` THEN
8330   ASM_SIMP_TAC std_ss [o_THM], ALL_TAC] THEN
8331  REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
8332  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
8333  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_LT, REAL_HALF,
8334   ARITH_PROVE ``0:num < n <=> ~(n = 0)``] THEN
8335  STRIP_TAC THEN EXISTS_TAC ``N:num`` THEN
8336  POP_ASSUM MP_TAC THEN
8337  REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN
8338  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
8339  GEN_REWR_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN
8340  UNDISCH_TAC `` !n:num. N <= n ==> abs (x ((r:num->num) n) - l) < e / 2:real`` THEN
8341  DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `n:num`) THEN
8342  ASM_REWRITE_TAC [] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
8343  METIS_TAC [REAL_LT_HALF1]
8344QED
8345
8346(* ------------------------------------------------------------------------- *)
8347(* Completeness.                                                             *)
8348(* ------------------------------------------------------------------------- *)
8349
8350Definition cauchy_def :
8351    cauchy (s:num->real) <=>
8352     !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e
8353End
8354Theorem cauchy[local] = cauchy_def
8355
8356Definition complete[nocompute]:
8357  complete s <=>
8358     !f:num->real. (!n. f n IN s) /\ cauchy f
8359                      ==> ?l. l IN s /\ (f --> l) sequentially
8360End
8361
8362Theorem CAUCHY:
8363   !s:num->real.
8364      cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e
8365Proof
8366  REPEAT GEN_TAC THEN REWRITE_TAC[cauchy, GREATER_EQ] THEN EQ_TAC THENL
8367   [MESON_TAC[LESS_EQ_REFL], DISCH_TAC] THEN
8368  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
8369  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
8370  MESON_TAC[DIST_TRIANGLE_HALF_L]
8371QED
8372
8373Theorem CONVERGENT_IMP_CAUCHY:
8374   !s l. (s --> l) sequentially ==> cauchy s
8375Proof
8376  REWRITE_TAC[LIM_SEQUENTIALLY, cauchy] THEN
8377  REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
8378  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
8379  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
8380  ASM_MESON_TAC[GREATER_EQ, LESS_EQ_REFL, DIST_TRIANGLE_HALF_L]
8381QED
8382
8383Theorem GREATER_EQ_REFL:
8384    !m:num. m >= m
8385Proof
8386  REWRITE_TAC [GREATER_EQ, LESS_EQ_REFL]
8387QED
8388
8389Theorem CAUCHY_IMP_BOUNDED:
8390   !s:num->real. cauchy s ==> bounded {y | ?n. y = s n}
8391Proof
8392  REWRITE_TAC[cauchy, bounded_def, GSPECIFICATION] THEN GEN_TAC THEN
8393  DISCH_THEN(MP_TAC o SPEC ``&1:real``) THEN REWRITE_TAC[REAL_LT_01] THEN
8394  DISCH_THEN(X_CHOOSE_THEN ``N:num`` (MP_TAC o SPEC ``N:num``)) THEN
8395  REWRITE_TAC[GREATER_EQ_REFL] THEN DISCH_TAC THEN
8396  SUBGOAL_THEN ``!n:num. N <= n ==> abs(s n :real) <= abs(s N) + &1:real``
8397  ASSUME_TAC THENL
8398   [ASM_MESON_TAC[GREATER_EQ, dist, DIST_SYM, ABS_TRIANGLE_SUB,
8399                  REAL_ARITH ``a <= b + c /\ c < &1 ==> a <= b + &1:real``],
8400    MP_TAC(ISPECL [``\n:num. abs(s n :real)``, ``{0..N}``]
8401                  UPPER_BOUND_FINITE_SET_REAL) THEN
8402    SIMP_TAC std_ss [FINITE_NUMSEG, IN_NUMSEG, LESS_EQ_0, GSYM LEFT_EXISTS_IMP_THM] THEN
8403    ASM_MESON_TAC[LESS_EQ_CASES,
8404                  REAL_ARITH ``x <= a \/ x <= b ==> x <= abs a + abs b:real``]]
8405QED
8406
8407Theorem COMPACT_IMP_COMPLETE:
8408   !s:real->bool. compact s ==> complete s
8409Proof
8410  GEN_TAC THEN REWRITE_TAC[complete, compact] THEN
8411  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `f:num->real`) THEN
8412  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
8413  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC ``l:real`` THEN
8414  FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP] LIM_ADD)) THEN
8415  DISCH_THEN(MP_TAC o SPEC ``\n. (f:num->real)(n) - f(r n)``) THEN
8416  DISCH_THEN(MP_TAC o SPEC ``0:real``) THEN ASM_SIMP_TAC std_ss [o_THM] THEN
8417  SIMP_TAC std_ss [REAL_ADD_RID, REAL_SUB_ADD2, ETA_AX] THEN
8418  DISCH_THEN MATCH_MP_TAC THEN
8419  UNDISCH_TAC ``cauchy f`` THEN GEN_REWR_TAC LAND_CONV [cauchy] THEN
8420  SIMP_TAC std_ss [GE, LIM, SEQUENTIALLY, dist, REAL_SUB_RZERO] THEN
8421  SUBGOAL_THEN ``!n:num. n <= r(n)`` MP_TAC THENL [INDUCT_TAC, ALL_TAC] THEN
8422  ASM_MESON_TAC[LESS_EQ_TRANS, LESS_EQ_REFL, LT, LESS_EQ_LESS_TRANS,
8423                ZERO_LESS_EQ, NOT_LEQ, NOT_LE]
8424QED
8425
8426Theorem COMPLETE_UNIV:
8427   complete univ(:real)
8428Proof
8429  REWRITE_TAC[complete, IN_UNIV] THEN X_GEN_TAC ``x:num->real`` THEN
8430  DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN
8431  DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN
8432  MP_TAC(ISPEC ``closure {y:real | ?n:num. y = x n}``
8433   COMPACT_IMP_COMPLETE) THEN
8434  ASM_SIMP_TAC std_ss [BOUNDED_CLOSED_IMP_COMPACT, CLOSED_CLOSURE, complete] THEN
8435  DISCH_THEN(MP_TAC o SPEC ``x:num->real``) THEN
8436  KNOW_TAC ``(!n. x n IN closure {y | ?n. y = x n}) /\ cauchy x`` THENL
8437  [ALL_TAC, MESON_TAC[]] THEN
8438  ASM_SIMP_TAC std_ss [closure, GSPECIFICATION, IN_UNION] THEN MESON_TAC[]
8439QED
8440
8441Theorem COMPLETE_EQ_CLOSED:
8442   !s:real->bool. complete s <=> closed s
8443Proof
8444  GEN_TAC THEN EQ_TAC THENL
8445  [REWRITE_TAC[complete, CLOSED_LIMPT, LIMPT_SEQUENTIAL] THEN
8446   SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN
8447   SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN
8448   GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `f:num->real`) THEN
8449   MESON_TAC[CONVERGENT_IMP_CAUCHY, IN_DELETE, LIM_UNIQUE,
8450    TRIVIAL_LIMIT_SEQUENTIALLY],
8451   REWRITE_TAC[complete, CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN
8452   X_GEN_TAC ``f:num->real`` THEN STRIP_TAC THEN
8453   MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN
8454   DISCH_THEN(MP_TAC o SPEC ``f:num->real``) THEN
8455   ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]
8456QED
8457
8458Theorem CONVERGENT_EQ_CAUCHY:
8459   !s. (?l. (s --> l) sequentially) <=> cauchy s
8460Proof
8461  GEN_TAC THEN EQ_TAC THENL
8462  [METIS_TAC [LEFT_IMP_EXISTS_THM, CONVERGENT_IMP_CAUCHY],
8463   REWRITE_TAC[REWRITE_RULE[complete, IN_UNIV] COMPLETE_UNIV]]
8464QED
8465
8466Theorem CONVERGENT_IMP_BOUNDED:
8467   !s l. (s --> l) sequentially ==> bounded (IMAGE s univ(:num))
8468Proof
8469  SIMP_TAC std_ss [LEFT_FORALL_IMP_THM, CONVERGENT_EQ_CAUCHY] THEN
8470  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN
8471  REWRITE_TAC [bounded_def] THEN SET_TAC []
8472QED
8473
8474(* ------------------------------------------------------------------------- *)
8475(* Total boundedness.                                                        *)
8476(* ------------------------------------------------------------------------- *)
8477
8478Theorem COMPACT_IMP_TOTALLY_BOUNDED:
8479   !s:real->bool. compact s
8480   ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\
8481       s SUBSET (BIGUNION (IMAGE (\x. ball(x,e)) k))
8482Proof
8483  GEN_TAC THEN ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
8484  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, NOT_EXISTS_THM] THEN
8485  REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`, SUBSET_DEF] THEN
8486  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
8487  SUBGOAL_THEN
8488   ``?x:num->real. !n. x(n) IN s /\ !m. m < n ==> ~(dist(x(m),x(n)) < e)``
8489   MP_TAC THENL
8490  [SUBGOAL_THEN
8491   ``?x:num->real.
8492     !n. x(n) = @y. y IN s /\ !m. m < n ==> ~(dist(x(m),y) < e)``
8493     MP_TAC THENL
8494   [KNOW_TAC ``?(x :num -> real). !(n :num). x n =
8495    (\x n. @(y :real). y IN (s :real -> bool) /\
8496      !(m :num). m < n ==> ~((dist (x m,y) :real) < (e :real))) x n`` THENL
8497    [ALL_TAC, METIS_TAC []] THEN
8498    MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC std_ss [], ALL_TAC] THEN
8499    DISCH_THEN (X_CHOOSE_TAC ``x:num->real``) THEN EXISTS_TAC ``x:num->real`` THEN
8500    KNOW_TAC ``!(n :num). (\n. (x :num -> real) n IN (s :real -> bool) /\
8501     !(m :num). m < n ==> ~((dist (x m,x n) :real) < (e :real))) n`` THENL
8502    [ALL_TAC, METIS_TAC []] THEN
8503    MATCH_MP_TAC COMPLETE_INDUCTION THEN X_GEN_TAC ``n:num`` THEN
8504    BETA_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SPEC ``n:num``) THEN STRIP_TAC THEN
8505    CONV_TAC SELECT_CONV THEN
8506    FIRST_X_ASSUM(MP_TAC o SPEC ``IMAGE (x:num->real) {m | m < n}``) THEN
8507    SIMP_TAC std_ss [IMAGE_FINITE, FINITE_NUMSEG_LT, NOT_FORALL_THM, NOT_IMP] THEN
8508    SIMP_TAC std_ss [IN_BIGUNION, IN_IMAGE, GSPECIFICATION] THEN METIS_TAC[IN_BALL],
8509    ALL_TAC] THEN
8510   SIMP_TAC std_ss [compact, NOT_FORALL_THM] THEN
8511   DISCH_THEN (X_CHOOSE_TAC ``x:num->real``) THEN EXISTS_TAC ``x:num->real`` THEN
8512   POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [NOT_IMP, FORALL_AND_THM] THEN
8513   STRIP_TAC THEN ASM_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN
8514   CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
8515   FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN
8516   REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC ``e:real``) THEN
8517   ASM_SIMP_TAC std_ss [o_THM, NOT_EXISTS_THM, NOT_IMP, NOT_FORALL_THM, NOT_IMP] THEN
8518   X_GEN_TAC ``N:num`` THEN MAP_EVERY EXISTS_TAC [``N:num``, ``SUC N``] THEN
8519   CONJ_TAC THENL [ARITH_TAC, ASM_MESON_TAC[LT]]
8520QED
8521
8522(* ------------------------------------------------------------------------- *)
8523(* Heine-Borel theorem (following Burkill & Burkill vol. 2) *)
8524(* ------------------------------------------------------------------------- *)
8525
8526Theorem HEINE_BOREL_LEMMA:
8527   !s:real->bool. compact s
8528    ==> !t. s SUBSET (BIGUNION t) /\ (!b. b IN t ==> open b)
8529       ==> ?e. &0 < e /\
8530           !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b
8531Proof
8532  GEN_TAC THEN ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
8533  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, NOT_EXISTS_THM] THEN
8534  DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
8535  DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC ``&1 / (&n + &1:real)``) THEN
8536  SIMP_TAC std_ss [REAL_LT_DIV, REAL_LT_01, REAL_ARITH ``x <= y ==> x < y + &1:real``,
8537   FORALL_AND_THM, REAL_POS, NOT_FORALL_THM, NOT_IMP, SKOLEM_THM, compact] THEN
8538  DISCH_THEN (X_CHOOSE_TAC ``f:num->real``) THEN
8539  EXISTS_TAC ``f:num->real`` THEN POP_ASSUM MP_TAC THEN
8540  SIMP_TAC std_ss [NOT_EXISTS_THM] THEN
8541  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
8542  DISCH_TAC THEN MAP_EVERY X_GEN_TAC [``l:real``, ``r:num->num``] THEN
8543  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
8544  SUBGOAL_THEN ``?b:real->bool. l IN b /\ b IN t`` STRIP_ASSUME_TAC THENL
8545  [ASM_MESON_TAC[SUBSET_DEF, IN_BIGUNION], ALL_TAC] THEN
8546  SUBGOAL_THEN ``?e. &0 < e /\ !z:real. dist(z,l) < e ==> z IN b``
8547   STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_def], ALL_TAC] THEN
8548  UNDISCH_TAC ``(f o r:num->num --> l:real) sequentially`` THEN DISCH_TAC THEN
8549  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
8550  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
8551  SUBGOAL_THEN ``&0 < e / &2:real`` (fn th =>
8552   REWRITE_TAC [th, o_THM] THEN MP_TAC(ONCE_REWRITE_RULE [REAL_ARCH_INV] th))
8553   THENL [ASM_REWRITE_TAC[REAL_HALF], ALL_TAC] THEN
8554  DISCH_THEN(X_CHOOSE_THEN ``N1:num`` STRIP_ASSUME_TAC) THEN
8555  DISCH_THEN(X_CHOOSE_THEN ``N2:num`` STRIP_ASSUME_TAC) THEN
8556  FIRST_X_ASSUM(MP_TAC o SPECL
8557   [``(r:num->num)(N1 + N2)``, ``b:real->bool``]) THEN
8558  ASM_REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
8559  FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_R THEN
8560  EXISTS_TAC ``(f:num->real)(r(N1 + N2:num))`` THEN CONJ_TAC THENL
8561  [ALL_TAC, FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC] THEN
8562  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_BALL]) THEN
8563  MATCH_MP_TAC(REAL_ARITH ``a <= b ==> x < a ==> x < b:real``) THEN
8564  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``inv(&N1:real)`` THEN
8565  ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div, REAL_MUL_LID] THEN
8566  MATCH_MP_TAC REAL_LE_INV2 THEN
8567  REWRITE_TAC[REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT] THEN
8568  ASM_MESON_TAC[ARITH_PROVE ``(~(n = 0) ==> 0 < n:num)``, LESS_EQ_ADD, MONOTONE_BIGGER,
8569   LESS_IMP_LESS_OR_EQ, LESS_EQ_TRANS]
8570QED
8571
8572Theorem COMPACT_IMP_HEINE_BOREL:
8573   !s. compact (s:real->bool)
8574  ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (BIGUNION f)
8575  ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (BIGUNION f')
8576Proof
8577  REPEAT STRIP_TAC THEN
8578  FIRST_ASSUM(MP_TAC o SPEC ``f:(real->bool)->bool`` o
8579   MATCH_MP HEINE_BOREL_LEMMA) THEN ASM_REWRITE_TAC[] THEN
8580  DISCH_THEN(X_CHOOSE_THEN ``e:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
8581  DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
8582  SIMP_TAC std_ss [SKOLEM_THM, SUBSET_DEF, IN_BALL] THEN
8583  DISCH_THEN(X_CHOOSE_TAC ``B:real->real->bool``) THEN
8584  FIRST_ASSUM(MP_TAC o SPEC ``e:real`` o
8585   MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN
8586  ASM_SIMP_TAC std_ss [BIGUNION_IMAGE, SUBSET_DEF, GSPECIFICATION] THEN
8587  REWRITE_TAC[IN_BIGUNION, IN_BALL] THEN
8588  DISCH_THEN(X_CHOOSE_THEN ``k:real->bool`` STRIP_ASSUME_TAC) THEN
8589  EXISTS_TAC ``IMAGE (B:real->real->bool) k`` THEN
8590  ASM_SIMP_TAC std_ss [IMAGE_FINITE, SUBSET_DEF, IN_IMAGE, LEFT_IMP_EXISTS_THM] THEN
8591  ASM_MESON_TAC[IN_BALL]
8592QED
8593
8594(* ------------------------------------------------------------------------- *)
8595(* Bolzano-Weierstrass property.                                             *)
8596(* ------------------------------------------------------------------------- *)
8597
8598Theorem HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS:
8599   !s:real->bool.
8600  (!f. (!t. t IN f ==> open t) /\ s SUBSET (BIGUNION f)
8601   ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (BIGUNION f'))
8602   ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t
8603Proof
8604  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM, limit_point_of] THEN REPEAT GEN_TAC THEN
8605  ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> c ==> ~d ==> a ==> ~b`] THEN
8606  KNOW_TAC ``t SUBSET s
8607       ==> (!x. ?t'. ~(x IN s:real->bool /\
8608                 (x IN t' /\ open t' ==> (?y. ~(y = x) /\ y IN t /\ y IN t'))))
8609       ==> (!f. (!t. t IN f ==> open t) /\ s SUBSET BIGUNION f
8610              ==> (?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET BIGUNION f'))
8611        ==> ~INFINITE t`` THENL
8612  [ALL_TAC, SIMP_TAC std_ss [NOT_FORALL_THM, NOT_EXISTS_THM, RIGHT_AND_FORALL_THM] THEN
8613   METIS_TAC []] THEN
8614  DISCH_TAC THEN SIMP_TAC std_ss [SKOLEM_THM] THEN
8615  DISCH_THEN(X_CHOOSE_TAC ``f:real->real->bool``) THEN
8616  DISCH_THEN(MP_TAC o SPEC
8617   ``{t:real->bool | ?x:real. x IN s /\ (t = f x)}``) THEN
8618  SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_BIGUNION, NOT_IMP] THEN
8619  KNOW_TAC ``(!t. (?x. x IN s:real->bool /\ (t = f x)) ==> open t) /\
8620     (!x. x IN s ==> ?s'. x IN s' /\ ?x. x IN s /\ (s' = f x))`` THENL
8621  [METIS_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
8622  DISCH_THEN(X_CHOOSE_THEN ``g:(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
8623  MATCH_MP_TAC SUBSET_FINITE_I THEN
8624  EXISTS_TAC ``{x:real | x IN t /\ (f(x):real->bool) IN g}`` THEN
8625  CONJ_TAC THENL
8626  [MATCH_MP_TAC FINITE_IMAGE_INJ_GENERAL THEN ASM_MESON_TAC[SUBSET_DEF],
8627   SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN X_GEN_TAC ``u:real`` THEN
8628   DISCH_TAC THEN SUBGOAL_THEN ``(u:real) IN s`` ASSUME_TAC THEN
8629   ASM_MESON_TAC[SUBSET_DEF]]
8630QED
8631
8632(* ------------------------------------------------------------------------- *)
8633(* Complete the chain of compactness variants.                               *)
8634(* ------------------------------------------------------------------------- *)
8635
8636Theorem BOLZANO_WEIERSTRASS_IMP_BOUNDED:
8637   !s:real->bool.
8638   (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t)
8639   ==> bounded s
8640Proof
8641  GEN_TAC THEN ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
8642  SIMP_TAC std_ss [compact, bounded_def] THEN
8643  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_EXISTS_THM, SKOLEM_THM, NOT_IMP] THEN
8644  REWRITE_TAC[REAL_NOT_LE] THEN
8645  DISCH_THEN(X_CHOOSE_TAC ``beyond:real->real``) THEN
8646  KNOW_TAC ``?f. (f(0) = beyond(&0)) /\
8647   (!n. f(SUC n) = beyond(abs(f n) + &1):real)`` THENL
8648  [RW_TAC std_ss [num_Axiom], ALL_TAC] THEN
8649  DISCH_THEN(X_CHOOSE_THEN ``x:num->real`` STRIP_ASSUME_TAC) THEN
8650  EXISTS_TAC ``IMAGE (x:num->real) UNIV`` THEN
8651  SUBGOAL_THEN
8652  ``!m n. m < n ==> abs((x:num->real) m) + &1 < abs(x n)``
8653   ASSUME_TAC THENL
8654  [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN
8655   ASM_MESON_TAC[REAL_LT_TRANS, REAL_ARITH ``b < b + &1:real``],
8656   ALL_TAC] THEN
8657  SUBGOAL_THEN ``!m n. ~(m = n) ==> &1 < dist((x:num->real) m,x n)``
8658  ASSUME_TAC THENL
8659  [REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
8660   (SPECL [``m:num``, ``n:num``] LT_CASES) THEN
8661   ASM_MESON_TAC[dist, LT_CASES, ABS_TRIANGLE_SUB, ABS_SUB,
8662    REAL_ARITH ``x + &1 < y /\ y <= x + d ==> &1 < d:real``],
8663   ALL_TAC] THEN
8664  REPEAT CONJ_TAC THENL
8665  [ASM_MESON_TAC[IMAGE_11_INFINITE, num_INFINITE, DIST_REFL,
8666   REAL_ARITH ``~(&1 < &0:real)``],
8667  SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV, LEFT_IMP_EXISTS_THM] THEN
8668  INDUCT_TAC THEN METIS_TAC[], ALL_TAC] THEN
8669  X_GEN_TAC ``l:real`` THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
8670  SIMP_TAC std_ss [IN_IMAGE, IN_UNIV, GSYM LEFT_EXISTS_AND_THM] THEN
8671  KNOW_TAC ``~(!(e :real). (0 :real) < e ==>
8672      (?(x'' :num) (x' :real). (x' = (x :num -> real) x'') /\ (x' <> (l :real)) /\
8673        ((dist (x',l) :real) < e)))`` THENL
8674  [ALL_TAC, METIS_TAC []] THEN SIMP_TAC std_ss [UNWIND_THM2] THEN
8675  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
8676  FIRST_ASSUM(MP_TAC o SPEC ``&1 / &2:real``) THEN
8677  REWRITE_TAC [METIS [REAL_HALF_BETWEEN] ``0 < 1 / 2:real``] THEN
8678  DISCH_THEN(X_CHOOSE_THEN ``k:num`` STRIP_ASSUME_TAC) THEN
8679  FIRST_X_ASSUM(MP_TAC o SPEC ``dist((x:num->real) k,l)``) THEN
8680  ASM_SIMP_TAC std_ss [DIST_POS_LT] THEN
8681  X_GEN_TAC ``m:num`` THEN CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
8682  ASM_CASES_TAC ``m:num = k`` THEN
8683  ASM_MESON_TAC[DIST_TRIANGLE_HALF_L, REAL_LT_TRANS, REAL_LT_REFL]
8684QED
8685
8686Theorem SEQUENCE_INFINITE_LEMMA:
8687   !f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially
8688    ==> INFINITE {y:real | ?n. y = f n}
8689Proof
8690  REPEAT STRIP_TAC THEN MP_TAC(ISPEC
8691    ``IMAGE (\y:real. dist(y,l)) {y | ?n:num. y = f n}`` INF_FINITE) THEN
8692  ASM_SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, IN_IMAGE, IMAGE_FINITE, GSPECIFICATION] THEN
8693  ASM_MESON_TAC[LIM_SEQUENTIALLY, LESS_EQ_REFL, REAL_NOT_LE, DIST_POS_LT]
8694QED
8695
8696Theorem LE_1:
8697   (!n:num. ~(n = 0) ==> 0 < n) /\
8698   (!n:num. ~(n = 0) ==> 1 <= n) /\
8699   (!n:num. 0 < n ==> ~(n = 0)) /\
8700   (!n:num. 0 < n ==> 1 <= n) /\
8701   (!n:num. 1 <= n ==> 0 < n) /\
8702   (!n:num. 1 <= n ==> ~(n = 0))
8703Proof
8704  REWRITE_TAC[NOT_ZERO, GSYM NOT_LESS, ONE, LT]
8705QED
8706
8707Theorem LIMPT_OF_SEQUENCE_SUBSEQUENCE:
8708    !f:num->real l.
8709     l limit_point_of (IMAGE f univ(:num))
8710     ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially
8711Proof
8712  REPEAT STRIP_TAC THEN
8713  FIRST_ASSUM(MP_TAC o REWRITE_RULE [LIMPT_APPROACHABLE]) THEN
8714  DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC
8715   ``inf((inv(&n + &1:real)) INSERT IMAGE (\k. dist((f:num->real) k,l))
8716         {k | k IN {0..n} /\ ~(f k = l)})``) THEN
8717  SIMP_TAC std_ss [REAL_LT_INF_FINITE, FINITE_INSERT, NOT_INSERT_EMPTY,
8718   FINITE_RESTRICT, FINITE_NUMSEG, IMAGE_FINITE] THEN
8719  SIMP_TAC std_ss [FORALL_IN_INSERT, EXISTS_IN_IMAGE, FORALL_IN_IMAGE, IN_UNIV] THEN
8720  SIMP_TAC std_ss [REAL_LT_INV_EQ, METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]
8721                            ``&0 < &n + &1:real``] THEN
8722  SIMP_TAC std_ss [FORALL_AND_THM, FORALL_IN_GSPEC, GSYM DIST_NZ, SKOLEM_THM] THEN
8723  DISCH_THEN(X_CHOOSE_THEN ``nn:num->num`` STRIP_ASSUME_TAC) THEN
8724  KNOW_TAC ``?r:num->num. (r 0 = nn 0) /\ (!n. r (SUC n) = nn(r n))`` THENL
8725  [RW_TAC std_ss [num_Axiom], ALL_TAC] THEN
8726  STRIP_TAC THEN EXISTS_TAC ``r:num->num`` THEN
8727  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
8728  [ONCE_REWRITE_TAC [METIS []
8729    `` (r:num->num) m < r n <=> (\m n. r m < r n) m n``] THEN
8730  MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN CONJ_TAC THENL
8731  [METIS_TAC [LESS_TRANS], ALL_TAC] THEN
8732   X_GEN_TAC ``n:num`` THEN ASM_REWRITE_TAC[] THEN
8733   FIRST_X_ASSUM(MP_TAC o SPECL
8734    [``(r:num->num) n``, ``(nn:num->num)(r(n:num))``]) THEN
8735   ASM_SIMP_TAC arith_ss [IN_NUMSEG, ZERO_LESS_EQ, REAL_LT_REFL],
8736   DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN
8737  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
8738  X_GEN_TAC ``e:real`` THEN GEN_REWR_TAC LAND_CONV [REAL_ARCH_INV] THEN
8739  DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
8740  POP_ASSUM MP_TAC THEN STRIP_TAC THEN
8741  ONCE_REWRITE_TAC [METIS [] ``!n:num. (N <= n ==> dist ((f o r) n,l) < e) <=>
8742                          (\n. N <= n ==> dist ((f o r) n,l) < e) n``] THEN
8743  MATCH_MP_TAC INDUCTION THEN ASM_SIMP_TAC std_ss [CONJUNCT1 LE] THEN
8744  X_GEN_TAC ``n:num`` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN
8745  ASM_SIMP_TAC std_ss [o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
8746  EXISTS_TAC ``inv(&((r:num->num) n) + &1:real)`` THEN ASM_REWRITE_TAC[] THEN
8747  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv(&N:real)`` THEN
8748  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
8749  ASM_SIMP_TAC std_ss [REAL_OF_NUM_LE, REAL_LT, LE_1, REAL_OF_NUM_ADD] THEN
8750  MATCH_MP_TAC(ARITH_PROVE ``N <= SUC n /\ n <= r n ==> N <= r n + 1``) THEN
8751  ASM_REWRITE_TAC[]
8752QED
8753
8754Theorem SEQUENCE_UNIQUE_LIMPT:
8755   !f l l':real.
8756   (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n}
8757   ==> (l' = l)
8758Proof
8759  REWRITE_TAC[SET_RULE ``{y | ?n. y = f n} = IMAGE f univ(:num)``] THEN
8760  REPEAT STRIP_TAC THEN
8761  FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
8762  DISCH_THEN(X_CHOOSE_THEN ``r:num->num`` STRIP_ASSUME_TAC) THEN
8763  MATCH_MP_TAC(ISPEC ``sequentially`` LIM_UNIQUE) THEN
8764  EXISTS_TAC ``(f:num->real) o (r:num->num)`` THEN
8765  ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY, LIM_SUBSEQUENCE]
8766QED
8767
8768Theorem BOLZANO_WEIERSTRASS_IMP_CLOSED:
8769   !s:real->bool.
8770  (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t)
8771   ==> closed s
8772Proof
8773  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN
8774  MAP_EVERY X_GEN_TAC [``f:num->real``, ``l:real``] THEN
8775  DISCH_TAC THEN
8776  MAP_EVERY (MP_TAC o ISPECL [``f:num->real``, ``l:real``])
8777   [SEQUENCE_UNIQUE_LIMPT, SEQUENCE_INFINITE_LEMMA] THEN
8778  MATCH_MP_TAC(TAUT
8779   `(~d ==> a /\ ~(b /\ c)) ==> (a ==> b) ==> c ==> d`) THEN
8780  DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[], STRIP_TAC] THEN
8781  FIRST_X_ASSUM(MP_TAC o SPEC ``{y:real | ?n:num. y = f n}``) THEN
8782  ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
8783  [SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION],
8784   ABBREV_TAC ``t = {y:real | ?n:num. y = f n}``] THEN
8785  ASM_MESON_TAC[]
8786QED
8787
8788(* ------------------------------------------------------------------------- *)
8789(* Hence express everything as an equivalence.                               *)
8790(* ------------------------------------------------------------------------- *)
8791
8792Theorem COMPACT_EQ_HEINE_BOREL:
8793   !s:real->bool. compact s <=>
8794   !f. (!t. t IN f ==> open t) /\ s SUBSET (BIGUNION f)
8795   ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (BIGUNION f')
8796Proof
8797  GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [COMPACT_IMP_HEINE_BOREL] THEN
8798  DISCH_THEN(MP_TAC o MATCH_MP HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS) THEN
8799  DISCH_TAC THEN MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN
8800  ASM_MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED,
8801   BOLZANO_WEIERSTRASS_IMP_CLOSED]
8802QED
8803
8804Theorem compact_def :
8805    !s. compact s <=> compact_in euclidean s
8806Proof
8807    rw [COMPACT_EQ_HEINE_BOREL, compact_in, TOPSPACE_EUCLIDEAN, euclidean_open_def]
8808 >> METIS_TAC []
8809QED
8810
8811Theorem COMPACT_EQ_BOLZANO_WEIERSTRASS:
8812   !s:real->bool. compact s <=>
8813   !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t
8814Proof
8815  GEN_TAC THEN EQ_TAC THENL
8816  [SIMP_TAC std_ss [COMPACT_EQ_HEINE_BOREL, HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS],
8817   MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED, BOLZANO_WEIERSTRASS_IMP_CLOSED,
8818    BOUNDED_CLOSED_IMP_COMPACT]]
8819QED
8820
8821Theorem COMPACT_EQ_BOUNDED_CLOSED:
8822  !s:real->bool. compact s <=> bounded s /\ closed s
8823Proof
8824  GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSED_IMP_COMPACT] THEN
8825  MESON_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS, BOLZANO_WEIERSTRASS_IMP_BOUNDED,
8826  BOLZANO_WEIERSTRASS_IMP_CLOSED]
8827QED
8828
8829Theorem COMPACT_IMP_BOUNDED:
8830   !s. compact s ==> bounded s
8831Proof
8832  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED]
8833QED
8834
8835Theorem COMPACT_IMP_CLOSED:
8836   !s. compact s ==> closed s
8837Proof
8838  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED]
8839QED
8840
8841Theorem COMPACT_SEQUENCE_WITH_LIMIT:
8842   !f l:real.
8843  (f --> l) sequentially ==> compact (l INSERT IMAGE f univ(:num))
8844Proof
8845  REPEAT STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
8846  REWRITE_TAC[BOUNDED_INSERT] THEN CONJ_TAC THENL
8847  [ASM_MESON_TAC[CONVERGENT_IMP_BOUNDED],
8848   SIMP_TAC std_ss [CLOSED_LIMPT, LIMPT_INSERT, IN_INSERT] THEN
8849  SIMP_TAC std_ss [IMAGE_DEF, IN_UNIV, SET_RULE ``{f x | x IN s} =
8850    {y | ?x. x IN s /\ (y = f x)}``] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN
8851  MATCH_MP_TAC SEQUENCE_UNIQUE_LIMPT THEN METIS_TAC[]]
8852QED
8853
8854Theorem CLOSED_IN_COMPACT:
8855   !s t:real->bool.
8856  compact s /\ closed_in (subtopology euclidean s) t
8857   ==> compact t
8858Proof
8859  SIMP_TAC std_ss [CONJ_EQ_IMP, COMPACT_EQ_BOUNDED_CLOSED, CLOSED_IN_CLOSED_EQ] THEN
8860  MESON_TAC[BOUNDED_SUBSET]
8861QED
8862
8863Theorem CLOSED_IN_COMPACT_EQ:
8864   !s t. compact s
8865  ==> (closed_in (subtopology euclidean s) t <=>
8866   compact t /\ t SUBSET s)
8867Proof
8868  MESON_TAC[CLOSED_IN_CLOSED_EQ, COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_SUBSET]
8869QED
8870
8871(* ------------------------------------------------------------------------- *)
8872(* A version of Heine-Borel for subtopology.                                 *)
8873(* ------------------------------------------------------------------------- *)
8874
8875Theorem COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY:
8876   !s:real->bool. compact s <=>
8877   (!f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\
8878                        s SUBSET BIGUNION f
8879     ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET BIGUNION f')
8880Proof
8881  GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN EQ_TAC THEN
8882  DISCH_TAC THEN X_GEN_TAC ``f:(real->bool)->bool`` THENL
8883  [REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_TAC THEN
8884   POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
8885   SIMP_TAC std_ss [SKOLEM_THM] THEN
8886   DISCH_THEN(CONJUNCTS_THEN2
8887   (X_CHOOSE_TAC ``m:(real->bool)->(real->bool)``) ASSUME_TAC) THEN
8888   FIRST_X_ASSUM(MP_TAC o SPEC
8889   ``IMAGE (m:(real->bool)->(real->bool)) f``) THEN
8890   ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
8891   KNOW_TAC ``(s :real -> bool) SUBSET
8892     BIGUNION
8893       (IMAGE (m :(real -> bool) -> real -> bool)
8894          (f :(real -> bool) -> bool))`` THENL
8895   [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
8896  DISCH_THEN(X_CHOOSE_THEN ``f':(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
8897  EXISTS_TAC ``IMAGE (\t:real->bool. s INTER t) f'`` THEN
8898  ASM_SIMP_TAC std_ss [IMAGE_FINITE, BIGUNION_IMAGE, SUBSET_DEF, FORALL_IN_IMAGE] THEN
8899  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
8900  UNDISCH_TAC ``f' SUBSET IMAGE (m :(real -> bool) -> real -> bool) f`` THEN
8901  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [SUBSET_IMAGE]) THEN
8902  STRIP_TAC THEN ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET_DEF],
8903  DISCH_TAC THEN
8904  FIRST_X_ASSUM(MP_TAC o SPEC ``{s INTER t:real->bool | t IN f}``) THEN
8905  SIMP_TAC std_ss [GSYM IMAGE_DEF, FORALL_IN_IMAGE, OPEN_IN_OPEN, BIGUNION_IMAGE] THEN
8906  KNOW_TAC ``(!(t :real -> bool).
8907        t IN (f :(real -> bool) -> bool) ==>
8908        ?(t' :real -> bool).
8909          (open t' :bool) /\ ((s :real -> bool) INTER t = s INTER t')) /\
8910     s SUBSET {y | ?(t :real -> bool). t IN f /\ y IN s INTER t}`` THENL
8911  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
8912  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
8913  SIMP_TAC std_ss [EXISTS_FINITE_SUBSET_IMAGE, BIGUNION_IMAGE] THEN
8914  STRIP_TAC THEN EXISTS_TAC ``f' :(real -> bool) -> bool`` THEN
8915  ASM_SET_TAC []]
8916QED
8917
8918(* ------------------------------------------------------------------------- *)
8919(* More easy lemmas.                                                         *)
8920(* ------------------------------------------------------------------------- *)
8921
8922Theorem COMPACT_CLOSURE:
8923   !s. compact(closure s) <=> bounded s
8924Proof
8925  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED, CLOSED_CLOSURE, BOUNDED_CLOSURE_EQ]
8926QED
8927
8928Theorem BOLZANO_WEIERSTRASS_CONTRAPOS:
8929   !s t:real->bool.
8930  compact s /\ t SUBSET s /\
8931  (!x. x IN s ==> ~(x limit_point_of t))
8932  ==> FINITE t
8933Proof
8934  REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS] THEN MESON_TAC[]
8935QED
8936
8937Theorem DISCRETE_BOUNDED_IMP_FINITE:
8938   !s:real->bool e. &0 < e /\
8939  (!x y. x IN s /\ y IN s /\ abs(y - x) < e ==> (y = x)) /\
8940   bounded s ==> FINITE s
8941Proof
8942  REPEAT STRIP_TAC THEN
8943  SUBGOAL_THEN ``compact(s:real->bool)`` MP_TAC THENL
8944  [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
8945   ASM_MESON_TAC[DISCRETE_IMP_CLOSED],
8946  DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN
8947  DISCH_THEN(MP_TAC o SPEC ``IMAGE (\x:real. ball(x,e)) s``) THEN
8948  SIMP_TAC std_ss [FORALL_IN_IMAGE, OPEN_BALL, BIGUNION_IMAGE, GSPECIFICATION] THEN
8949  KNOW_TAC ``(s :real -> bool) SUBSET
8950     {y | ?(x :real). x IN s /\ y IN ball (x,(e :real))}`` THENL
8951  [SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN ASM_MESON_TAC[CENTRE_IN_BALL],
8952   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
8953   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN
8954  SIMP_TAC std_ss [EXISTS_FINITE_SUBSET_IMAGE] THEN
8955  DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
8956  SUBGOAL_THEN ``s:real->bool = t`` (fn th => ASM_REWRITE_TAC[th]) THEN
8957  MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
8958  REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
8959  UNDISCH_TAC ``s SUBSET BIGUNION (IMAGE (\x. ball (x,e)) t)`` THEN
8960  GEN_REWR_TAC (LAND_CONV o RAND_CONV) [BIGUNION_IMAGE] THEN
8961  DISCH_THEN(MP_TAC o SPEC ``x:real`` o REWRITE_RULE [SUBSET_DEF]) THEN
8962  ASM_SIMP_TAC std_ss [GSPECIFICATION, IN_BALL, dist] THEN ASM_MESON_TAC[SUBSET_DEF]
8963QED
8964
8965Theorem BOLZANO_WEIERSTRASS:
8966   !s:real->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s
8967Proof
8968  GEN_TAC THEN ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN DISCH_TAC THEN
8969  FIRST_ASSUM(ASSUME_TAC o MATCH_MP NO_LIMIT_POINT_IMP_CLOSED) THEN
8970  STRIP_TAC THEN
8971  MP_TAC(ISPEC ``s:real->bool`` COMPACT_EQ_BOLZANO_WEIERSTRASS) THEN
8972  ASM_SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED] THEN
8973  EXISTS_TAC ``s:real->bool`` THEN
8974  ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]
8975QED
8976
8977Theorem BOUNDED_EQ_BOLZANO_WEIERSTRASS:
8978   !s:real->bool.
8979  bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t
8980Proof
8981  MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED, BOLZANO_WEIERSTRASS,
8982   BOUNDED_SUBSET]
8983QED
8984
8985(* ------------------------------------------------------------------------- *)
8986(* In particular, some common special cases.                                 *)
8987(* ------------------------------------------------------------------------- *)
8988
8989Theorem COMPACT_EMPTY:
8990   compact {}
8991Proof
8992  REWRITE_TAC[compact, NOT_IN_EMPTY]
8993QED
8994
8995Theorem COMPACT_UNION:
8996   !s t. compact s /\ compact t ==> compact (s UNION t)
8997Proof
8998  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_UNION, CLOSED_UNION]
8999QED
9000
9001Theorem COMPACT_INTER:
9002   !s t. compact s /\ compact t ==> compact (s INTER t)
9003Proof
9004  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_INTER, CLOSED_INTER]
9005QED
9006
9007Theorem COMPACT_INTER_CLOSED:
9008   !s t. compact s /\ closed t ==> compact (s INTER t)
9009Proof
9010  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, CLOSED_INTER] THEN
9011  MESON_TAC[BOUNDED_SUBSET, INTER_SUBSET]
9012QED
9013
9014Theorem CLOSED_INTER_COMPACT:
9015   !s t. closed s /\ compact t ==> compact (s INTER t)
9016Proof
9017  MESON_TAC[COMPACT_INTER_CLOSED, INTER_COMM]
9018QED
9019
9020Theorem COMPACT_BIGINTER:
9021   !f:(real->bool)->bool.
9022  (!s. s IN f ==> compact s) /\ ~(f = {})
9023  ==> compact(BIGINTER f)
9024Proof
9025  SIMP_TAC std_ss[COMPACT_EQ_BOUNDED_CLOSED, CLOSED_BIGINTER] THEN
9026  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_BIGINTER THEN ASM_SET_TAC[]
9027QED
9028
9029Theorem FINITE_IMP_CLOSED:
9030   !s. FINITE s ==> closed s
9031Proof
9032  MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED, SUBSET_FINITE_I]
9033QED
9034
9035Theorem FINITE_IMP_CLOSED_IN:
9036   !s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s
9037Proof
9038  SIMP_TAC std_ss [CLOSED_SUBSET_EQ, FINITE_IMP_CLOSED]
9039QED
9040
9041Theorem FINITE_IMP_COMPACT:
9042   !s. FINITE s ==> compact s
9043Proof
9044  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, FINITE_IMP_CLOSED, FINITE_IMP_BOUNDED]
9045QED
9046
9047Theorem COMPACT_SING:
9048   !a. compact {a}
9049Proof
9050  SIMP_TAC std_ss [FINITE_IMP_COMPACT, FINITE_EMPTY, FINITE_INSERT]
9051QED
9052
9053Theorem COMPACT_INSERT:
9054   !a s. compact s ==> compact(a INSERT s)
9055Proof
9056  ONCE_REWRITE_TAC[SET_RULE ``a INSERT s = {a} UNION s``] THEN
9057  SIMP_TAC std_ss [COMPACT_UNION, COMPACT_SING]
9058QED
9059
9060Theorem CLOSED_SING:
9061   !a. closed {a}
9062Proof
9063 MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED, COMPACT_SING]
9064QED
9065
9066Theorem CLOSED_IN_SING:
9067   !u x:real. closed_in (subtopology euclidean u) {x} <=> x IN u
9068Proof
9069  SIMP_TAC std_ss [CLOSED_SUBSET_EQ, CLOSED_SING] THEN SET_TAC[]
9070QED
9071
9072Theorem CLOSURE_SING:
9073   !x:real. closure {x} = {x}
9074Proof
9075   SIMP_TAC std_ss [CLOSURE_CLOSED, CLOSED_SING]
9076QED
9077
9078Theorem CLOSED_INSERT:
9079   !a s. closed s ==> closed(a INSERT s)
9080Proof
9081  ONCE_REWRITE_TAC[SET_RULE ``a INSERT s = {a} UNION s``] THEN
9082  SIMP_TAC std_ss [CLOSED_UNION, CLOSED_SING]
9083QED
9084
9085Theorem COMPACT_CBALL:
9086   !x e. compact(cball(x,e))
9087Proof
9088  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_CBALL, CLOSED_CBALL]
9089QED
9090
9091Theorem COMPACT_FRONTIER_BOUNDED:
9092   !s. bounded s ==> compact(frontier s)
9093Proof
9094  SIMP_TAC std_ss [frontier, COMPACT_EQ_BOUNDED_CLOSED,
9095   CLOSED_DIFF, OPEN_INTERIOR, CLOSED_CLOSURE] THEN
9096  MESON_TAC[DIFF_SUBSET, BOUNDED_SUBSET, BOUNDED_CLOSURE]
9097QED
9098
9099Theorem COMPACT_FRONTIER:
9100   !s. compact s ==> compact (frontier s)
9101Proof
9102  MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED, COMPACT_FRONTIER_BOUNDED]
9103QED
9104
9105Theorem BOUNDED_FRONTIER:
9106   !s:real->bool. bounded s ==> bounded(frontier s)
9107Proof
9108  MESON_TAC[COMPACT_FRONTIER_BOUNDED, COMPACT_IMP_BOUNDED]
9109QED
9110
9111Theorem FRONTIER_SUBSET_COMPACT:
9112   !s. compact s ==> frontier s SUBSET s
9113Proof
9114  MESON_TAC[FRONTIER_SUBSET_CLOSED, COMPACT_EQ_BOUNDED_CLOSED]
9115QED
9116
9117Theorem OPEN_DELETE:
9118   !s x. open s ==> open(s DELETE x)
9119Proof
9120SIMP_TAC std_ss [SET_RULE ``s DELETE x = s DIFF {x}``,
9121                 OPEN_DIFF, CLOSED_SING]
9122QED
9123
9124Theorem OPEN_IN_DELETE:
9125   !u s a:real.
9126  open_in (subtopology euclidean u) s
9127  ==> open_in (subtopology euclidean u) (s DELETE a)
9128Proof
9129  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``(a:real) IN s`` THENL
9130  [ONCE_REWRITE_TAC[SET_RULE ``s DELETE a = s DIFF {a}``] THEN
9131   MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN
9132   FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_SET_TAC[],
9133   ASM_SIMP_TAC std_ss [SET_RULE ``~(a IN s) ==> (s DELETE a = s)``]]
9134QED
9135
9136Theorem CLOSED_BIGINTER_COMPACT:
9137   !s:real->bool.
9138  closed s <=> !e. compact(cball(0,e) INTER s)
9139Proof
9140  GEN_TAC THEN EQ_TAC THENL
9141  [SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, CLOSED_INTER, CLOSED_CBALL,
9142   BOUNDED_INTER, BOUNDED_CBALL], ALL_TAC] THEN
9143  STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN
9144  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
9145  FIRST_X_ASSUM(MP_TAC o SPEC ``abs(x:real) + &1:real``) THEN
9146  DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
9147  REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
9148  REWRITE_TAC[IN_INTER] THEN
9149  KNOW_TAC ``(x :real) limit_point_of
9150     cball ((0 :real),abs x + (1 :real)) INTER (s :real -> bool)`` THENL
9151  [ALL_TAC, MESON_TAC[]] THEN
9152  POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
9153  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
9154  FIRST_X_ASSUM(MP_TAC o SPEC ``min e (&1 / &2:real)``) THEN
9155  KNOW_TAC ``0 < min e (1 / 2:real)`` THENL
9156  [REWRITE_TAC [min_def] THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [REAL_HALF_BETWEEN],
9157   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
9158  DISCH_THEN (X_CHOOSE_TAC ``y:real``) THEN EXISTS_TAC ``y:real`` THEN
9159  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [IN_INTER, IN_CBALL] THEN
9160  REWRITE_TAC [REAL_LT_MIN, DIST_0, dist] THEN STRIP_TAC THEN
9161  FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
9162  ASM_REAL_ARITH_TAC
9163QED
9164
9165Theorem COMPACT_BIGUNION:
9166   !s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(BIGUNION s)
9167Proof
9168  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, CLOSED_BIGUNION, BOUNDED_BIGUNION]
9169QED
9170
9171Theorem COMPACT_DIFF:
9172   !s t. compact s /\ open t ==> compact(s DIFF t)
9173Proof
9174  ONCE_REWRITE_TAC[SET_RULE ``s DIFF t = s INTER (UNIV DIFF t)``] THEN
9175  SIMP_TAC std_ss [COMPACT_INTER_CLOSED, GSYM OPEN_CLOSED]
9176QED
9177
9178Theorem COMPACT_SPHERE:
9179   !a:real r. compact(sphere(a,r))
9180Proof
9181  REPEAT GEN_TAC THEN
9182 REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN
9183  REWRITE_TAC[COMPACT_CBALL]
9184QED
9185
9186Theorem BOUNDED_SPHERE:
9187   !a:real r. bounded(sphere(a,r))
9188Proof
9189  SIMP_TAC std_ss [COMPACT_SPHERE, COMPACT_IMP_BOUNDED]
9190QED
9191
9192Theorem CLOSED_SPHERE:
9193   !a r. closed(sphere(a,r))
9194Proof
9195  SIMP_TAC std_ss [COMPACT_SPHERE, COMPACT_IMP_CLOSED]
9196QED
9197
9198Theorem FRONTIER_SING:
9199   !a:real. frontier {a} = {a}
9200Proof
9201  REWRITE_TAC[frontier, CLOSURE_SING, INTERIOR_SING, DIFF_EMPTY]
9202QED
9203
9204(* ------------------------------------------------------------------------- *)
9205(* Finite intersection property. I could make it an equivalence in fact.     *)
9206(* ------------------------------------------------------------------------- *)
9207
9208Theorem lemma[local]:
9209   (s = UNIV DIFF t) <=> (UNIV DIFF s = t)
9210Proof
9211  SET_TAC[]
9212QED
9213
9214Theorem COMPACT_IMP_FIP:
9215   !s:real->bool f.
9216        compact s /\
9217        (!t. t IN f ==> closed t) /\
9218        (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (BIGINTER f') = {}))
9219        ==> ~(s INTER (BIGINTER f) = {})
9220Proof
9221  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9222  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [COMPACT_EQ_HEINE_BOREL]) THEN
9223  DISCH_THEN(MP_TAC o SPEC ``IMAGE (\t:real->bool. UNIV DIFF t) f``) THEN
9224  ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
9225  DISCH_THEN(fn th => REPEAT STRIP_TAC THEN MP_TAC th) THEN
9226  ASM_SIMP_TAC std_ss [OPEN_DIFF, CLOSED_DIFF, OPEN_UNIV, CLOSED_UNIV, NOT_IMP] THEN
9227  CONJ_TAC THENL
9228   [UNDISCH_TAC ``(s:real->bool) INTER BIGINTER f = {}`` THEN
9229    ONCE_REWRITE_TAC[SUBSET_DEF, EXTENSION] THEN
9230    REWRITE_TAC [IN_BIGUNION] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
9231        REWRITE_TAC [EXISTS_IN_IMAGE] THEN BETA_TAC THEN SET_TAC[],
9232    X_GEN_TAC ``g:(real->bool)->bool`` THEN
9233    FIRST_X_ASSUM(MP_TAC o SPEC ``IMAGE (\t:real->bool. UNIV DIFF t) g``) THEN
9234    ASM_CASES_TAC ``FINITE(g:(real->bool)->bool)`` THEN
9235    ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN ONCE_REWRITE_TAC[SUBSET_DEF, EXTENSION] THEN
9236    SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_INTER, IN_BIGINTER, IN_IMAGE, IN_DIFF,
9237                IN_UNIV, NOT_IN_EMPTY, lemma, UNWIND_THM1, IN_BIGUNION] THEN
9238    SET_TAC[]]
9239QED
9240
9241Theorem CLOSED_IMP_FIP:
9242   !s:real->bool f.
9243        closed s /\
9244        (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\
9245        (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (BIGINTER f') = {}))
9246        ==> ~(s INTER (BIGINTER f) = {})
9247Proof
9248  REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
9249   ``~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})``) THEN
9250  MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
9251   [ASM_MESON_TAC[CLOSED_INTER_COMPACT, COMPACT_EQ_BOUNDED_CLOSED],
9252    REWRITE_TAC [METIS [INTER_ASSOC, GSYM BIGINTER_INSERT]
9253          ``!f.  s INTER t INTER BIGINTER f = s INTER BIGINTER (t INSERT f)``] THEN
9254  GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9255  ASM_SIMP_TAC std_ss [FINITE_INSERT, INSERT_SUBSET]]
9256QED
9257
9258Theorem CLOSED_IMP_FIP_COMPACT:
9259   !s:real->bool f.
9260        closed s /\ (!t. t IN f ==> compact t) /\
9261        (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (BIGINTER f') = {}))
9262        ==> ~(s INTER (BIGINTER f) = {})
9263Proof
9264  REPEAT GEN_TAC THEN
9265  ASM_CASES_TAC ``f:(real->bool)->bool = {}`` THEN
9266  ASM_SIMP_TAC std_ss [SUBSET_EMPTY, BIGINTER_EMPTY, INTER_UNIV] THENL
9267   [MESON_TAC[FINITE_EMPTY], ALL_TAC] THEN
9268  STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN
9269  ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED, MEMBER_NOT_EMPTY]
9270QED
9271
9272Theorem CLOSED_FIP:
9273   !f. (!t:real->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\
9274       (!f'. FINITE f' /\ f' SUBSET f ==> ~(BIGINTER f' = {}))
9275       ==> ~(BIGINTER f = {})
9276Proof
9277  GEN_TAC THEN DISCH_TAC THEN
9278  ONCE_REWRITE_TAC[SET_RULE ``(s = {}) <=> (UNIV INTER s = {})``] THEN
9279  MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV, INTER_UNIV]
9280QED
9281
9282Theorem COMPACT_FIP:
9283   !f. (!t:real->bool. t IN f ==> compact t) /\
9284       (!f'. FINITE f' /\ f' SUBSET f ==> ~(BIGINTER f' = {}))
9285       ==> ~(BIGINTER f = {})
9286Proof
9287  GEN_TAC THEN DISCH_TAC THEN
9288  ONCE_REWRITE_TAC[SET_RULE ``(s = {}) <=> (UNIV INTER s = {})``] THEN
9289  MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN
9290  ASM_REWRITE_TAC[CLOSED_UNIV, INTER_UNIV]
9291QED
9292
9293(* ------------------------------------------------------------------------- *)
9294(* Bounded closed nest property (proof does not use Heine-Borel).            *)
9295(* ------------------------------------------------------------------------- *)
9296
9297Theorem BOUNDED_CLOSED_NEST:
9298   !s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
9299       (!m n. m <= n ==> s(n) SUBSET s(m)) /\
9300       bounded(s 0)
9301       ==> ?a:real. !n:num. a IN s(n)
9302Proof
9303  GEN_TAC THEN SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, SKOLEM_THM] THEN
9304  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9305  DISCH_THEN(CONJUNCTS_THEN2
9306     (X_CHOOSE_TAC ``a:num->real``) STRIP_ASSUME_TAC) THEN
9307  SUBGOAL_THEN ``compact(s  0n:real->bool)`` MP_TAC THENL
9308   [METIS_TAC[BOUNDED_CLOSED_IMP_COMPACT], ALL_TAC] THEN
9309  REWRITE_TAC[compact] THEN
9310  DISCH_THEN(MP_TAC o SPEC ``a:num->real``) THEN
9311  KNOW_TAC ``(!n:num. a n IN s  0n:real->bool)`` THENL
9312  [ASM_MESON_TAC[SUBSET_DEF, ZERO_LESS_EQ],
9313   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
9314  DISCH_THEN (X_CHOOSE_TAC ``l:real``) THEN
9315  EXISTS_TAC ``l:real`` THEN POP_ASSUM MP_TAC THEN
9316  SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM] THEN
9317  DISCH_THEN(X_CHOOSE_THEN ``r:num->num`` STRIP_ASSUME_TAC) THEN
9318  GEN_REWR_TAC I [TAUT `p <=> ~(~p)`] THEN
9319  REWRITE_TAC [NOT_FORALL_THM] THEN X_GEN_TAC ``N:num`` THEN
9320  MP_TAC(ISPECL [``l:real``, ``(s:num->real->bool) N``]
9321                CLOSED_APPROACHABLE) THEN
9322  ASM_MESON_TAC[SUBSET_DEF, LESS_EQ_REFL, LESS_EQ_TRANS, LE_CASES, MONOTONE_BIGGER]
9323QED
9324
9325(* ------------------------------------------------------------------------- *)
9326(* Decreasing case does not even need compactness, just completeness.        *)
9327(* ------------------------------------------------------------------------- *)
9328
9329Theorem DECREASING_CLOSED_NEST:
9330   !s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
9331       (!m n. m <= n ==> s(n) SUBSET s(m)) /\
9332       (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e)
9333       ==> ?a:real. !n:num. a IN s(n)
9334Proof
9335  GEN_TAC THEN SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, SKOLEM_THM] THEN
9336  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9337  DISCH_THEN(CONJUNCTS_THEN2
9338     (X_CHOOSE_TAC ``a:num->real``) STRIP_ASSUME_TAC) THEN
9339  SUBGOAL_THEN ``?l:real. (a --> l) sequentially`` MP_TAC THENL
9340   [ASM_MESON_TAC[cauchy, GE, SUBSET_DEF, LESS_EQ_TRANS, LESS_EQ_REFL,
9341                  complete, COMPLETE_UNIV, IN_UNIV],
9342    ASM_MESON_TAC[LIM_SEQUENTIALLY, CLOSED_APPROACHABLE,
9343                  SUBSET_DEF, LESS_EQ_REFL, LESS_EQ_TRANS, LE_CASES]]
9344QED
9345
9346(* ------------------------------------------------------------------------- *)
9347(* Strengthen it to the intersection actually being a singleton.             *)
9348(* ------------------------------------------------------------------------- *)
9349
9350Theorem DECREASING_CLOSED_NEST_SING:
9351   !s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
9352       (!m n. m <= n ==> s(n) SUBSET s(m)) /\
9353       (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e)
9354       ==> ?a:real. BIGINTER {t | ?n:num. t = s n} = {a}
9355Proof
9356  GEN_TAC THEN DISCH_TAC THEN
9357  FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN
9358  STRIP_TAC THEN EXISTS_TAC ``a:real`` THEN
9359  SIMP_TAC std_ss [EXTENSION, IN_BIGINTER, IN_SING, GSPECIFICATION] THEN
9360  METIS_TAC[DIST_POS_LT, REAL_LT_REFL, SUBSET_DEF, LE_CASES]
9361QED
9362
9363(* ------------------------------------------------------------------------- *)
9364(* A version for a more general chain, not indexed by N.                     *)
9365(* ------------------------------------------------------------------------- *)
9366
9367Theorem BOUNDED_CLOSED_CHAIN:
9368   !f b:real->bool.
9369        (!s. s IN f ==> closed s /\ ~(s = {})) /\
9370        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\
9371         b IN f /\ bounded b
9372         ==> ~(BIGINTER f = {})
9373Proof
9374  REPEAT GEN_TAC THEN STRIP_TAC THEN
9375  SUBGOAL_THEN ``~(b INTER (BIGINTER f):real->bool = {})`` MP_TAC THENL
9376   [ALL_TAC, SET_TAC[]] THEN
9377  MATCH_MP_TAC COMPACT_IMP_FIP THEN
9378  ASM_SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED] THEN
9379  X_GEN_TAC ``u:(real->bool)->bool`` THEN STRIP_TAC THEN
9380  SUBGOAL_THEN ``?s:real->bool. s IN f /\ !t. t IN u ==> s SUBSET t``
9381   MP_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
9382  UNDISCH_TAC ``(u:(real->bool)->bool) SUBSET f`` THEN
9383  UNDISCH_TAC ``FINITE(u:(real->bool)->bool)`` THEN
9384  SPEC_TAC(``u:(real->bool)->bool``,``u:(real->bool)->bool``) THEN
9385  ONCE_REWRITE_TAC [METIS [] ``!u. (u SUBSET f ==> ?s. s IN f /\ !t. t IN u ==> s SUBSET t) =
9386                          (\u. u SUBSET f ==> ?s. s IN f /\ !t. t IN u ==> s SUBSET t) u``] THEN
9387  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
9388  CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
9389  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN
9390  MAP_EVERY X_GEN_TAC [``u:(real->bool)->bool``, ``t:real->bool``] THEN
9391  REWRITE_TAC[INSERT_SUBSET] THEN
9392  ONCE_REWRITE_TAC [AND_IMP_INTRO] THEN
9393  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
9394  ASM_REWRITE_TAC[] THEN
9395  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
9396  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
9397  DISCH_THEN(X_CHOOSE_THEN ``s:real->bool`` STRIP_ASSUME_TAC) THEN
9398  FIRST_X_ASSUM(MP_TAC o SPECL [``s:real->bool``, ``t:real->bool``]) THEN
9399  ASM_SET_TAC[]
9400QED
9401
9402(* ------------------------------------------------------------------------- *)
9403(* Analogous things directly for compactness.                                *)
9404(* ------------------------------------------------------------------------- *)
9405
9406Theorem COMPACT_CHAIN:
9407   !f:(real->bool)->bool.
9408        (!s. s IN f ==> compact s /\ ~(s = {})) /\
9409        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
9410        ==> ~(BIGINTER f = {})
9411Proof
9412  GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN
9413  ASM_CASES_TAC ``f:(real->bool)->bool = {}`` THENL
9414   [ASM_REWRITE_TAC[BIGINTER_EMPTY] THEN SET_TAC[],
9415    MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM_SET_TAC[]]
9416QED
9417
9418Theorem COMPACT_NEST:
9419   !s. (!n. compact(s n) /\ ~(s n = {})) /\
9420       (!m n. m <= n ==> s n SUBSET s m)
9421       ==> ~(BIGINTER {s n | n IN univ(:num)} = {})
9422Proof
9423  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN
9424  ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
9425  ONCE_REWRITE_TAC [METIS [] ``!n n'. (s n SUBSET s n' \/ s n' SUBSET s n) =
9426                          (\n n'. s n SUBSET s n' \/ s n' SUBSET s n) n n'``] THEN
9427  MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]
9428QED
9429
9430(* ------------------------------------------------------------------------- *)
9431(* Cauchy-type criteria for *uniform* convergence.                           *)
9432(* ------------------------------------------------------------------------- *)
9433
9434Theorem UNIFORMLY_CONVERGENT_EQ_CAUCHY:
9435   !P s:num->'a->real.
9436         (?l. !e. &0 < e
9437                  ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=>
9438         (!e. &0 < e
9439              ==> ?N. !m n x. N <= m /\ N <= n /\ P x
9440                              ==> dist(s m x,s n x) < e)
9441Proof
9442  REPEAT GEN_TAC THEN EQ_TAC THENL
9443   [DISCH_THEN(X_CHOOSE_TAC ``l:'a->real``) THEN X_GEN_TAC ``e:real`` THEN
9444    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
9445    ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L],
9446    ALL_TAC] THEN
9447  DISCH_TAC THEN
9448  SUBGOAL_THEN ``!x:'a. P x ==> cauchy (\n. s n x :real)`` MP_TAC THENL
9449   [REWRITE_TAC[cauchy, GE] THEN ASM_MESON_TAC[], ALL_TAC] THEN
9450  REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY, LIM_SEQUENTIALLY] THEN
9451  DISCH_TAC THEN KNOW_TAC ``(!(x :'a). ?(l :real). (P :'a -> bool) x ==>
9452        (!(e :real). (0 :real) < e ==>
9453           (?(N :num). !(n :num). N <= n ==>
9454               (dist ((\(n :num). (s :num -> 'a -> real) n x) n,l) :real) < e)))`` THENL
9455  [METIS_TAC [], POP_ASSUM K_TAC] THEN SIMP_TAC std_ss [SKOLEM_THM] THEN
9456  DISCH_THEN (X_CHOOSE_TAC ``l:'a->real``) THEN
9457  EXISTS_TAC ``l:'a->real`` THEN POP_ASSUM MP_TAC THEN
9458  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN
9459  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
9460  ASM_REWRITE_TAC[REAL_HALF] THEN
9461  DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
9462  POP_ASSUM MP_TAC THEN STRIP_TAC THEN
9463  MAP_EVERY X_GEN_TAC [``n:num``, ``x:'a``] THEN STRIP_TAC THEN
9464  FIRST_X_ASSUM(MP_TAC o SPEC ``x:'a``) THEN ASM_REWRITE_TAC[] THEN
9465  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
9466  DISCH_THEN(X_CHOOSE_TAC ``M:num``) THEN
9467  UNDISCH_TAC ``!m n x. N:num <= m /\ N <= n /\ P x
9468                 ==> dist (s m x,s n x) < e / 2:real`` THEN DISCH_TAC THEN
9469  POP_ASSUM (MP_TAC o Q.SPECL [`n:num`, `N + M:num`, `x:'a`]) THEN
9470  ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
9471  FIRST_X_ASSUM(MP_TAC o SPEC ``M + N:num``) THEN REWRITE_TAC[LE_ADD] THEN
9472  ASM_MESON_TAC[DIST_TRIANGLE_HALF_L, DIST_SYM]
9473QED
9474
9475Theorem UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT:
9476   !P s:num->'a->real.
9477      (?l. !e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=>
9478      (!e. &0 < e ==>
9479           ?N. !m n x. N <= m /\ N <= n /\ m < n /\ P x ==>
9480                       dist(s m x,s n x) < e)
9481Proof
9482  REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
9483  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
9484  FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
9485  DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
9486  ASM_SIMP_TAC std_ss [] THEN
9487  HO_MATCH_MP_TAC WLOG_LT THEN
9488  ASM_SIMP_TAC std_ss [DIST_REFL] THEN MESON_TAC[DIST_SYM]
9489QED
9490
9491Theorem UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT:
9492   !P (s:num->'a->real) l.
9493    (!e. &0 < e
9494         ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\
9495    (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e)
9496    ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)
9497Proof
9498  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
9499  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC ``l':'a->real``) ASSUME_TAC) THEN
9500  SUBGOAL_THEN ``!x. P x ==> ((l:'a->real) x = l' x)`` MP_TAC THENL
9501   [ALL_TAC, METIS_TAC[]] THEN
9502  REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC ``sequentially`` LIM_UNIQUE) THEN
9503  EXISTS_TAC ``\n. (s:num->'a->real) n x`` THEN
9504  REWRITE_TAC[LIM_SEQUENTIALLY, TRIVIAL_LIMIT_SEQUENTIALLY] THEN
9505  ASM_MESON_TAC[]
9506QED
9507
9508(* ------------------------------------------------------------------------- *)
9509(* Define continuity over a net to take in restrictions of the set.          *)
9510(* ------------------------------------------------------------------------- *)
9511
9512val _ = set_fixity "continuous" (Infix(NONASSOC, 450));
9513
9514Definition continuous[nocompute]:
9515 f continuous net <=> (f --> f(netlimit net)) net
9516End
9517
9518Theorem CONTINUOUS_TRIVIAL_LIMIT:
9519   !f net. trivial_limit net ==> f continuous net
9520Proof
9521  SIMP_TAC std_ss [continuous, LIM]
9522QED
9523
9524Theorem CONTINUOUS_WITHIN:
9525   !f x:real. f continuous (at x within s) <=> (f --> f(x)) (at x within s)
9526Proof
9527  REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN
9528  ASM_CASES_TAC ``trivial_limit(at (x:real) within s)`` THENL
9529  [ASM_REWRITE_TAC[LIM], ASM_SIMP_TAC std_ss [NETLIMIT_WITHIN]]
9530QED
9531
9532Theorem CONTINUOUS_AT:
9533   !f (x:real). f continuous (at x) <=> (f --> f(x)) (at x)
9534Proof
9535  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
9536  REWRITE_TAC[CONTINUOUS_WITHIN, IN_UNIV]
9537QED
9538
9539Theorem CONTINUOUS_AT_WITHIN:
9540   !f:real->real x s.
9541  f continuous (at x) ==> f continuous (at x within s)
9542Proof
9543  SIMP_TAC std_ss [LIM_AT_WITHIN, CONTINUOUS_AT, CONTINUOUS_WITHIN]
9544QED
9545
9546Theorem CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL:
9547   !a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)
9548Proof
9549  ASM_SIMP_TAC std_ss [continuous, LIM, LIM_WITHIN_CLOSED_TRIVIAL]
9550QED
9551
9552Theorem CONTINUOUS_TRANSFORM_WITHIN:
9553   !f g:real->real s x d. &0 < d /\ x IN s /\
9554   (!x'. x' IN s /\ dist(x',x) < d ==> (f(x') = g(x'))) /\
9555    f continuous (at x within s) ==> g continuous (at x within s)
9556Proof
9557  SIMP_TAC std_ss [CONTINUOUS_WITHIN] THEN
9558  METIS_TAC[LIM_TRANSFORM_WITHIN, DIST_REFL]
9559QED
9560
9561Theorem CONTINUOUS_TRANSFORM_AT:
9562   !f g:real->real x d.
9563   &0 < d /\ (!x'. dist(x',x) < d ==> (f(x') = g(x'))) /\
9564   f continuous (at x) ==> g continuous (at x)
9565Proof
9566  REWRITE_TAC[CONTINUOUS_AT] THEN
9567  METIS_TAC[LIM_TRANSFORM_AT, DIST_REFL]
9568QED
9569
9570Theorem CONTINUOUS_TRANSFORM_WITHIN_OPEN:
9571   !f g:real->real s a. open s /\ a IN s /\
9572   (!x. x IN s ==> (f x = g x)) /\
9573    f continuous at a ==> g continuous at a
9574Proof
9575  METIS_TAC[CONTINUOUS_AT, LIM_TRANSFORM_WITHIN_OPEN]
9576QED
9577
9578Theorem CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN:
9579   !f g:real->real s t a.
9580   open_in (subtopology euclidean t) s /\ a IN s /\
9581   (!x. x IN s ==> (f x = g x)) /\
9582    f continuous (at a within t) ==> g continuous (at a within t)
9583Proof
9584  METIS_TAC[CONTINUOUS_WITHIN, LIM_TRANSFORM_WITHIN_OPEN_IN]
9585QED
9586
9587Theorem CONTINUOUS_TRANSFORM_WITHIN_SET_IMP:
9588   !f a s t. eventually (\x. x IN t ==> x IN s) (at a) /\
9589   f continuous (at a within s) ==> f continuous (at a within t)
9590Proof
9591  REWRITE_TAC[CONTINUOUS_WITHIN, LIM_TRANSFORM_WITHIN_SET_IMP]
9592QED
9593
9594(* ------------------------------------------------------------------------- *)
9595(* Derive the epsilon-delta forms, which we often use as "definitions" *)
9596(* ------------------------------------------------------------------------- *)
9597
9598Theorem continuous_within:
9599   f continuous (at x within s) <=> !e. &0 < e
9600   ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x',x) < d
9601     ==> dist(f(x'),f(x)) < e
9602Proof
9603  SIMP_TAC std_ss [CONTINUOUS_WITHIN, LIM_WITHIN] THEN
9604  SIMP_TAC std_ss [GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]
9605QED
9606
9607Theorem continuous_at:
9608   f continuous (at x) <=>
9609  !e. &0 < e ==> ?d. &0 < d /\
9610  !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e
9611Proof
9612  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
9613  SIMP_TAC std_ss [continuous_within, IN_UNIV]
9614QED
9615
9616(* ------------------------------------------------------------------------- *)
9617(* Versions in terms of open balls.                                          *)
9618(* ------------------------------------------------------------------------- *)
9619
9620Theorem CONTINUOUS_WITHIN_BALL:
9621   !f s x. f continuous (at x within s) <=>
9622   !e. &0 < e ==> ?d. &0 < d /\
9623   IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)
9624Proof
9625  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE, IN_BALL, continuous_within, IN_INTER] THEN
9626  MESON_TAC[DIST_SYM]
9627QED
9628
9629Theorem CONTINUOUS_AT_BALL:
9630   !f x. f continuous (at x) <=>
9631   !e. &0 < e ==> ?d. &0 < d /\
9632   IMAGE f (ball(x,d)) SUBSET ball(f x,e)
9633Proof
9634  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE, IN_BALL, continuous_at] THEN
9635  MESON_TAC[DIST_SYM]
9636QED
9637
9638(* ------------------------------------------------------------------------- *)
9639(*                                                                           *)
9640(* ------------------------------------------------------------------------- *)
9641
9642Theorem CONTINUOUS_WITHIN_COMPARISON:
9643   !f:real->real g:real->real s a.
9644        g continuous (at a within s) /\
9645        (!x. x IN s ==> dist(f a,f x) <= dist(g a,g x))
9646        ==> f continuous (at a within s)
9647Proof
9648  ONCE_REWRITE_TAC[DIST_SYM] THEN
9649  REWRITE_TAC[continuous_within] THEN MESON_TAC[REAL_LET_TRANS]
9650QED
9651
9652(* ------------------------------------------------------------------------- *)
9653(* For setwise continuity, just start from the epsilon-delta definitions.    *)
9654(* ------------------------------------------------------------------------- *)
9655
9656val _ = set_fixity "continuous_on" (Infix(NONASSOC, 450));
9657val _ = set_fixity "uniformly_continuous_on" (Infix(NONASSOC, 450));
9658
9659Definition continuous_on_def :
9660    f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)
9661End
9662Theorem CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = continuous_on_def
9663
9664Theorem continuous_on :
9665    !f s. f continuous_on s <=>
9666          !x. x IN s ==> !e. &0 < e
9667                     ==> ?d. &0 < d /\ !x'. x' IN s /\ dist(x',x) < d
9668                                             ==> dist(f(x'),f(x)) < e
9669Proof
9670    rw [continuous_on_def, continuous_within]
9671QED
9672
9673Definition uniformly_continuous_on :
9674   f uniformly_continuous_on s <=>
9675   !e. &0 < e
9676   ==> ?d. &0 < d /\ !x x'. x IN s /\ x' IN s /\ dist(x',x) < d
9677     ==> dist(f(x'),f(x)) < e
9678End
9679
9680(* ------------------------------------------------------------------------- *)
9681(* Some simple consequential lemmas.                                         *)
9682(* ------------------------------------------------------------------------- *)
9683
9684Theorem UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS:
9685   !f s. f uniformly_continuous_on s ==> f continuous_on s
9686Proof
9687  REWRITE_TAC[uniformly_continuous_on, continuous_on] THEN MESON_TAC[]
9688QED
9689
9690Theorem CONTINUOUS_AT_IMP_CONTINUOUS_ON:
9691   !f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s
9692Proof
9693  REWRITE_TAC[continuous_at, continuous_on] THEN MESON_TAC[]
9694QED
9695
9696Theorem CONTINUOUS_ON:
9697   !f (s:real->bool).
9698  f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)
9699Proof
9700  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_WITHIN]
9701QED
9702
9703Theorem CONTINUOUS_ON_EQ_CONTINUOUS_AT:
9704   !f:real->real s.
9705  open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))
9706Proof
9707  SIMP_TAC std_ss [CONTINUOUS_ON, CONTINUOUS_AT, LIM_WITHIN_OPEN]
9708QED
9709
9710Theorem CONTINUOUS_WITHIN_SUBSET:
9711   !f s t x. f continuous (at x within s) /\ t SUBSET s
9712  ==> f continuous (at x within t)
9713Proof
9714 REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]
9715QED
9716
9717Theorem CONTINUOUS_ON_SUBSET:
9718   !f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t
9719Proof
9720  REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET_DEF, LIM_WITHIN_SUBSET]
9721QED
9722
9723Theorem UNIFORMLY_CONTINUOUS_ON_SUBSET:
9724   !f s t. f uniformly_continuous_on s /\ t SUBSET s
9725  ==> f uniformly_continuous_on t
9726Proof
9727  REWRITE_TAC[uniformly_continuous_on] THEN
9728  MESON_TAC[SUBSET_DEF, LIM_WITHIN_SUBSET]
9729QED
9730
9731Theorem CONTINUOUS_ON_INTERIOR:
9732   !f:real->real s x.
9733  f continuous_on s /\ x IN interior(s) ==> f continuous at x
9734Proof
9735  SIMP_TAC std_ss [interior, GSPECIFICATION] THEN
9736  MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT, CONTINUOUS_ON_SUBSET]
9737QED
9738
9739Theorem CONTINUOUS_ON_EQ:
9740   !f g s. (!x. x IN s ==> (f(x) = g(x))) /\ f continuous_on s
9741  ==> g continuous_on s
9742Proof
9743  SIMP_TAC std_ss [continuous_on, CONJ_EQ_IMP]
9744QED
9745
9746Theorem UNIFORMLY_CONTINUOUS_ON_EQ:
9747   !f g s. (!x. x IN s ==> (f x = g x)) /\ f uniformly_continuous_on s
9748   ==> g uniformly_continuous_on s
9749Proof
9750  SIMP_TAC std_ss [uniformly_continuous_on, CONJ_EQ_IMP]
9751QED
9752
9753Theorem CONTINUOUS_ON_SING:
9754   !f:real->real a. f continuous_on {a}
9755Proof
9756  SIMP_TAC std_ss [continuous_on, IN_SING, DIST_REFL] THEN
9757  METIS_TAC[]
9758QED
9759
9760Theorem CONTINUOUS_ON_EMPTY:
9761   !f:real->real. f continuous_on {}
9762Proof
9763  MESON_TAC[CONTINUOUS_ON_SING, EMPTY_SUBSET, CONTINUOUS_ON_SUBSET]
9764QED
9765
9766Theorem CONTINUOUS_ON_NO_LIMPT:
9767   !f:real->real s.
9768  ~(?x. x limit_point_of s) ==> f continuous_on s
9769Proof
9770  REWRITE_TAC[continuous_on, LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]
9771QED
9772
9773Theorem CONTINUOUS_ON_FINITE:
9774   !f:real->real s. FINITE s ==> f continuous_on s
9775Proof
9776  MESON_TAC[CONTINUOUS_ON_NO_LIMPT, LIMIT_POINT_FINITE]
9777QED
9778
9779Theorem CONTRACTION_IMP_CONTINUOUS_ON:
9780   !f:real->real.
9781   (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y))
9782   ==> f continuous_on s
9783Proof
9784  SIMP_TAC std_ss [continuous_on] THEN MESON_TAC[REAL_LET_TRANS]
9785QED
9786
9787Theorem ISOMETRY_ON_IMP_CONTINUOUS_ON:
9788   !f:real->real.
9789   (!x y. x IN s /\ y IN s ==> (dist(f x,f y) = dist(x,y)))
9790   ==> f continuous_on s
9791Proof
9792  SIMP_TAC std_ss [CONTRACTION_IMP_CONTINUOUS_ON, REAL_LE_REFL]
9793QED
9794
9795(* ------------------------------------------------------------------------- *)
9796(* Characterization of various kinds of continuity in terms of sequences.    *)
9797(* ------------------------------------------------------------------------- *)
9798
9799Theorem CONTINUOUS_WITHIN_SEQUENTIALLY:
9800   !f s a:real.
9801    f continuous (at a within s) <=>
9802    !x. (!n. x(n) IN s) /\ (x --> a) sequentially
9803    ==> ((f o x) --> f(a)) sequentially
9804Proof
9805  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL
9806  [SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM] THEN MESON_TAC[], ALL_TAC] THEN
9807  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
9808  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, NOT_EXISTS_THM] THEN
9809  DISCH_THEN(X_CHOOSE_THEN ``e:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9810  DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC ``&1 / (&n + &1:real)``) THEN
9811  SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT, REAL_OF_NUM_LE, REAL_POS,
9812   REAL_ARITH ``&0 <= n ==> &0 < n + &1:real``, NOT_FORALL_THM, SKOLEM_THM] THEN
9813  DISCH_THEN (X_CHOOSE_TAC ``y:num->real``) THEN EXISTS_TAC ``y:num->real`` THEN
9814  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [NOT_IMP, FORALL_AND_THM] THEN
9815  SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM] THEN
9816  STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[LESS_EQ_REFL]] THEN
9817  KNOW_TAC ``!e. (?N:num. !n. N <= n ==> dist (y n,a) < e) =
9818             (\e. ?N:num. !n. N <= n ==> dist (y n,a) < e) e`` THENL
9819  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
9820  MATCH_MP_TAC FORALL_POS_MONO_1 THEN BETA_TAC THEN
9821  CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS], ALL_TAC] THEN
9822  X_GEN_TAC ``n:num`` THEN EXISTS_TAC ``n:num`` THEN X_GEN_TAC ``m:num`` THEN
9823  DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
9824  EXISTS_TAC ``&1 / (&m + &1:real)`` THEN ASM_REWRITE_TAC[] THEN
9825  ASM_SIMP_TAC std_ss
9826  [REAL_LE_INV2, real_div, REAL_ARITH ``&0 <= x ==> &0 < x + &1:real``,
9827   REAL_POS, REAL_MUL_LID, REAL_LE_RADD, REAL_OF_NUM_LE]
9828QED
9829
9830Theorem CONTINUOUS_AT_SEQUENTIALLY:
9831   !f a:real. f continuous (at a) <=>
9832   !x. (x --> a) sequentially ==> ((f o x) --> f(a)) sequentially
9833Proof
9834  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
9835  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY, IN_UNIV]
9836QED
9837
9838Theorem CONTINUOUS_ON_SEQUENTIALLY:
9839   !f s:real->bool. f continuous_on s <=>
9840   !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially
9841   ==> ((f o x) --> f(a)) sequentially
9842Proof
9843  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN,
9844  CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]
9845QED
9846
9847Theorem UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY:
9848   !f s:real->bool. f uniformly_continuous_on s <=>
9849   !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\
9850   ((\n. x(n) - y(n)) --> 0) sequentially
9851   ==> ((\n. f(x(n)) - f(y(n))) --> 0) sequentially
9852Proof
9853  REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN
9854  REWRITE_TAC[LIM_SEQUENTIALLY, dist, REAL_SUB_RZERO] THEN
9855  EQ_TAC THENL [MESON_TAC[], ALL_TAC] THEN
9856  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
9857  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, NOT_EXISTS_THM] THEN
9858  DISCH_THEN(X_CHOOSE_THEN ``e:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9859  DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC ``&1 / (&n + &1:real)``) THEN
9860  SIMP_TAC std_ss [REAL_LT_DIV, REAL_LT, REAL_OF_NUM_LE, REAL_POS,
9861   REAL_ARITH ``&0 <= n ==> &0 < n + &1:real``, NOT_FORALL_THM, SKOLEM_THM] THEN
9862  DISCH_THEN (X_CHOOSE_TAC ``x:num->real``) THEN POP_ASSUM MP_TAC THEN
9863  DISCH_THEN (X_CHOOSE_TAC ``y:num->real``) THEN
9864  EXISTS_TAC ``x:num->real`` THEN EXISTS_TAC ``y:num->real`` THEN
9865  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [NOT_IMP, FORALL_AND_THM] THEN STRIP_TAC THEN
9866  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN CONJ_TAC THENL
9867  [KNOW_TAC ``!e:real. (?N:num. !n. N <= n ==> abs (y n - x n) < e) =
9868                   (\e. ?N:num. !n. N <= n ==> abs (y n - x n) < e) e`` THENL
9869   [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
9870   MATCH_MP_TAC FORALL_POS_MONO_1 THEN BETA_TAC THEN
9871   CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS], ALL_TAC] THEN
9872   X_GEN_TAC ``n:num`` THEN EXISTS_TAC ``n:num`` THEN X_GEN_TAC ``m:num`` THEN
9873   DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
9874   EXISTS_TAC ``&1 / (&m + &1:real)`` THEN ASM_REWRITE_TAC[] THEN
9875   ASM_SIMP_TAC std_ss [REAL_LE_INV2, real_div,
9876                        REAL_ARITH ``&0 <= x ==> &0 < x + &1:real``,
9877    REAL_POS, REAL_MUL_LID, REAL_LE_RADD, REAL_OF_NUM_LE],
9878  EXISTS_TAC ``e:real`` THEN ASM_REWRITE_TAC[] THEN
9879  EXISTS_TAC ``\x:num. x`` THEN ASM_SIMP_TAC std_ss [LESS_EQ_REFL]]
9880QED
9881
9882Theorem LIM_CONTINUOUS_FUNCTION:
9883   !f net g l.
9884  f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net
9885Proof
9886  REWRITE_TAC[tendsto, continuous_at, eventually] THEN MESON_TAC[]
9887QED
9888
9889(* NOTE: This proof is learnt from CONTINUOUS_WITHIN_SEQUENTIALLY, where the
9890   key device is FORALL_POS_MONO_1. The original proof from HOL-Light is a
9891   specialisation of LIMIT_ATPOINTOF_SEQUENTIALLY_WITHIN (combined proof is
9892   based on EVENTUALLY_ATPOINTOF_WITHIN_SEQUENTIALLY, etc.)
9893 *)
9894Theorem LIM_WITHIN_SEQUENTIALLY_combined[local] :
9895   (!f:real->real s a l.
9896        (f --> l) (at a within s) <=>
9897        !x. (!n. x(n) IN s DELETE a) /\
9898            (x --> a) sequentially
9899            ==> ((f o x) --> l) sequentially) /\
9900   (!f:real->real s a l.
9901        (f --> l) (at a within s) <=>
9902        !x. (!n. x(n) IN s DELETE a) /\
9903            (!m n. x m = x n <=> m = n) /\
9904            (x --> a) sequentially
9905            ==> ((f o x) --> l) sequentially) /\
9906   (!f:real->real s a l.
9907        (f --> l) (at a within s) <=>
9908        !x. (!n. x(n) IN s DELETE a) /\
9909            (!m n. m < n ==> dist(x n,a) < dist(x m,a)) /\
9910            (x --> a) sequentially
9911            ==> ((f o x) --> l) sequentially)
9912Proof
9913  SIMP_TAC bool_ss [AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
9914  MATCH_MP_TAC(TAUT
9915   `(r ==> s) /\ (q ==> r) /\ (p ==> q) /\ (s ==> p)
9916    ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN
9917  REPEAT CONJ_TAC THENL (* 4 subgoals *)
9918  [ (* goal 1 (of 4): r ==> s *)
9919    HO_MATCH_MP_TAC MONO_FORALL THEN Q.X_GEN_TAC `x` THEN
9920    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
9921    DISCH_THEN MATCH_MP_TAC THEN
9922    HO_MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN
9923    ASM_MESON_TAC[REAL_LT_REFL],
9924    (* goal 2 (of 4): q ==> r *)
9925    HO_MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[],
9926    (* goal 3 (of 4): p ==> q *)
9927    REWRITE_TAC[LIM_WITHIN] THEN
9928    SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM, IN_DELETE, GSYM DIST_NZ] THEN
9929    MESON_TAC[],
9930    (* goal 4 (of 4): p ==> s *)
9931    ALL_TAC ] THEN
9932 (* remaining goal (p ==> s) *)
9933  REWRITE_TAC[LIM_WITHIN] THEN
9934  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
9935  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, NOT_EXISTS_THM] THEN
9936  DISCH_THEN(X_CHOOSE_THEN ``e:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9937  DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC ``&1 / (&n + &1:real)``) THEN
9938  SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT, REAL_OF_NUM_LE, REAL_POS,
9939   REAL_ARITH ``&0 <= n ==> &0 < n + &1:real``, NOT_FORALL_THM, SKOLEM_THM,
9940   GSYM DIST_NZ] THEN
9941  DISCH_THEN (X_CHOOSE_TAC ``y:num->real``) THEN
9942 (* applying DEPENDENT_CHOICE *)
9943  SUBGOAL_THEN
9944    ``?x. (!n. x n IN s /\ ~(x n = a) /\
9945               dist (x n,a) < 1 / (&n + &1) /\
9946               ~(dist (f (x n),l) < e)) /\
9947          (!n. dist (x(SUC n),a) < dist (x n,a))``
9948    STRIP_ASSUME_TAC >-
9949     (HO_MATCH_MP_TAC DEPENDENT_CHOICE THEN SIMP_TAC real_ss [] THEN
9950      CONJ_TAC
9951      >- (Q.EXISTS_TAC ‘y 0’ \\
9952          POP_ASSUM (MP_TAC o Q.SPEC ‘0’) >> simp []) \\
9953      MAP_EVERY Q.X_GEN_TAC [`n`, `x`] THEN STRIP_TAC THEN
9954      SIMP_TAC bool_ss[TAUT `(p /\ q /\ r /\ s) /\ u <=>
9955                             p /\ q /\ (r /\ u) /\ s`] THEN
9956      REWRITE_TAC[GSYM REAL_LT_MIN] THEN
9957      qabbrev_tac ‘d = min (1 / &(SUC n + 1)) (dist (x,a))’ \\
9958      Know ‘0 < d’
9959      >- (ASM_SIMP_TAC std_ss [Abbr ‘d’, REAL_LT_MIN, GSYM DIST_NZ] \\
9960          simp []) >> DISCH_TAC \\
9961     ‘?N. inv (&SUC N) < d’ by METIS_TAC [REAL_ARCH_INV_SUC] \\
9962      Q.EXISTS_TAC ‘y N’ \\
9963      Q.PAT_X_ASSUM ‘!n. P’ (MP_TAC o Q.SPEC ‘N’) >> RW_TAC std_ss [] \\
9964      Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘1 / (&N + 1)’ >> art [] \\
9965      Q.PAT_X_ASSUM ‘inv (&SUC N) < d’ MP_TAC >> simp [ADD1]) \\
9966 (* stage work *)
9967  EXISTS_TAC ``x:num->real`` THEN
9968  ASM_SIMP_TAC std_ss [IN_DELETE, GSYM CONJ_ASSOC] THEN
9969  CONJ_ASM1_TAC (* !m n. m < n ==> dist (x n,a) < dist (x m,a) *)
9970  >- (MATCH_MP_TAC
9971        (SRULE [real_gt]
9972               (ISPECL [“real_gt”, “\i:num. dist (x i,a)”]
9973                       transitive_monotone)) >> art [] \\
9974      simp [relationTheory.transitive_def, real_gt, Once CONJ_SYM] \\
9975      METIS_TAC [REAL_LT_TRANS]) \\
9976  CONJ_ASM1_TAC
9977  >- (simp [LIM_SEQUENTIALLY] \\
9978      Q.X_GEN_TAC ‘d’ >> DISCH_TAC \\
9979     ‘?N. inv (&SUC N) < d’ by METIS_TAC [REAL_ARCH_INV_SUC] \\
9980      Q.EXISTS_TAC ‘N’ >> rpt STRIP_TAC \\
9981      Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘1 / (&N + 1)’ >> art [] \\
9982      reverse CONJ_TAC
9983      >- (Q.PAT_X_ASSUM ‘inv (&SUC N) < d’ MP_TAC >> simp [ADD1]) \\
9984     ‘n = N \/ N < n’ by simp [] >- art [] \\
9985      Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘dist (x N,a)’ >> art [] \\
9986      FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
9987 (* final goal *)
9988  SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM, IN_DELETE, GSYM DIST_NZ] \\
9989  Q.EXISTS_TAC ‘e’ >> rw [] \\
9990  Q.EXISTS_TAC ‘N’ >> simp []
9991QED
9992
9993(* |- !f s a l.
9994        (f --> l) (at a within s) <=>
9995        !x. (!n. x n IN s DELETE a) /\ (x --> a) sequentially ==>
9996            (f o x --> l) sequentially
9997 *)
9998Theorem LIM_WITHIN_SEQUENTIALLY =
9999        LIM_WITHIN_SEQUENTIALLY_combined |> cj 1
10000
10001(* |- !f s a l.
10002        (f --> l) (at a within s) <=>
10003        !x. (!n. x n IN s DELETE a) /\ (!m n. x m = x n <=> m = n) /\
10004            (x --> a) sequentially ==>
10005            (f o x --> l) sequentially
10006 *)
10007Theorem LIM_WITHIN_SEQUENTIALLY_INJ =
10008        LIM_WITHIN_SEQUENTIALLY_combined |> cj 2
10009
10010(* |- !f s a l.
10011        (f --> l) (at a within s) <=>
10012        !x. (!n. x n IN s DELETE a) /\
10013            (!m n. m < n ==> dist (x n,a) < dist (x m,a)) /\
10014            (x --> a) sequentially ==>
10015            (f o x --> l) sequentially
10016 *)
10017Theorem LIM_WITHIN_SEQUENTIALLY_DECREASING =
10018        LIM_WITHIN_SEQUENTIALLY_combined |> cj 3
10019
10020(* ------------------------------------------------------------------------- *)
10021(* Combination results for pointwise continuity.                             *)
10022(* ------------------------------------------------------------------------- *)
10023
10024Theorem CONTINUOUS_CONST:
10025   !net c. (\x. c) continuous net
10026Proof
10027  REWRITE_TAC[continuous, LIM_CONST]
10028QED
10029
10030Theorem CONTINUOUS_CMUL:
10031   !f c net. f continuous net ==> (\x. c * f(x)) continuous net
10032Proof
10033  SIMP_TAC std_ss [continuous, LIM_CMUL]
10034QED
10035
10036Theorem CONTINUOUS_NEG:
10037   !f net. f continuous net ==> (\x. -(f x)) continuous net
10038Proof
10039  SIMP_TAC std_ss [continuous, LIM_NEG]
10040QED
10041
10042Theorem CONTINUOUS_ADD:
10043   !f g net. f continuous net /\ g continuous net
10044  ==> (\x. f(x) + g(x)) continuous net
10045Proof
10046  SIMP_TAC std_ss [continuous, LIM_ADD]
10047QED
10048
10049Theorem CONTINUOUS_SUB:
10050   !f g net. f continuous net /\ g continuous net
10051  ==> (\x. f(x) - g(x)) continuous net
10052Proof
10053  SIMP_TAC std_ss [continuous, LIM_SUB]
10054QED
10055
10056Theorem CONTINUOUS_ABS:
10057   !(f:'a->real) net. f continuous net
10058  ==> (\x. abs(f(x)):real) continuous net
10059Proof
10060  SIMP_TAC std_ss [continuous, LIM_ABS]
10061QED
10062
10063Theorem CONTINUOUS_MAX:
10064   !(f:'a->real) (g:'a->real) net.
10065   f continuous net /\ g continuous net
10066   ==> (\x. (max (f(x)) (g(x))):real) continuous net
10067Proof
10068  SIMP_TAC std_ss [continuous, LIM_MAX]
10069QED
10070
10071Theorem CONTINUOUS_MIN:
10072   !(f:'a->real) (g:'a->real) net.
10073   f continuous net /\ g continuous net
10074   ==> (\x. (min (f(x)) (g(x))):real) continuous net
10075Proof
10076  SIMP_TAC std_ss [continuous, LIM_MIN]
10077QED
10078
10079Theorem CONTINUOUS_SUM:
10080   !net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net)
10081  ==> (\x. sum s (\a. f a x)) continuous net
10082Proof
10083  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJ_EQ_IMP] THEN
10084  KNOW_TAC ``!s. ((!a:'b. a IN s ==> f a continuous net) ==>
10085              (\x:'a. sum s (\a. f a x)) continuous net) =
10086             (\s. (!a. a IN s ==> f a continuous net) ==>
10087              (\x. sum s (\a. f a x)) continuous net) s`` THENL
10088  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
10089  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
10090  SIMP_TAC std_ss [FORALL_IN_INSERT, NOT_IN_EMPTY, SUM_CLAUSES,
10091   CONTINUOUS_CONST, CONTINUOUS_ADD, ETA_AX] THEN
10092  METIS_TAC [FORALL_IN_INSERT, NOT_IN_EMPTY, SUM_CLAUSES,
10093   CONTINUOUS_CONST, CONTINUOUS_ADD, ETA_AX]
10094QED
10095
10096(* ------------------------------------------------------------------------- *)
10097(* Same thing for setwise continuity.                                        *)
10098(* ------------------------------------------------------------------------- *)
10099
10100Theorem CONTINUOUS_ON_CONST:
10101   !s c. (\x. c) continuous_on s
10102Proof
10103  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_CONST]
10104QED
10105
10106Theorem CONTINUOUS_ON_CMUL:
10107   !f c s. f continuous_on s ==> (\x. c * f(x)) continuous_on s
10108Proof
10109  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_CMUL]
10110QED
10111
10112Theorem CONTINUOUS_ON_NEG:
10113   !f s. f continuous_on s
10114  ==> (\x. -(f x)) continuous_on s
10115Proof
10116  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_NEG]
10117QED
10118
10119Theorem CONTINUOUS_ON_ADD:
10120   !f g s. f continuous_on s /\ g continuous_on s
10121  ==> (\x. f(x) + g(x)) continuous_on s
10122Proof
10123  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_ADD]
10124QED
10125
10126Theorem CONTINUOUS_ON_SUB:
10127   !f g s. f continuous_on s /\ g continuous_on s
10128  ==> (\x. f(x) - g(x)) continuous_on s
10129Proof
10130  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_SUB]
10131QED
10132
10133Theorem CONTINUOUS_ON_ABS:
10134   !f:real->real s. f continuous_on s
10135  ==> (\x. (abs(f(x))):real) continuous_on s
10136Proof
10137  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_ABS]
10138QED
10139
10140Theorem CONTINUOUS_ON_MAX:
10141   !f:real->real g:real->real s.
10142  f continuous_on s /\ g continuous_on s
10143  ==> (\x. (max (f(x)) (g(x))):real)
10144   continuous_on s
10145Proof
10146  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_MAX]
10147QED
10148
10149Theorem CONTINUOUS_ON_MIN:
10150   !f:real->real g:real->real s.
10151  f continuous_on s /\ g continuous_on s
10152  ==> (\x. (min (f(x)) (g(x))):real)
10153   continuous_on s
10154Proof
10155  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_MIN]
10156QED
10157
10158Theorem CONTINUOUS_ON_SUM:
10159   !t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t)
10160  ==> (\x. sum s (\a. f a x)) continuous_on t
10161Proof
10162  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_SUM]
10163QED
10164
10165(* ------------------------------------------------------------------------- *)
10166(* Same thing for uniform continuity, using sequential formulations.         *)
10167(* ------------------------------------------------------------------------- *)
10168
10169Theorem UNIFORMLY_CONTINUOUS_ON_CONST:
10170   !s c. (\x. c) uniformly_continuous_on s
10171Proof
10172  SIMP_TAC std_ss [UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY, o_DEF,
10173   REAL_SUB_REFL, LIM_CONST]
10174QED
10175
10176Theorem LINEAR_UNIFORMLY_CONTINUOUS_ON:
10177   !f:real->real s. linear f ==> f uniformly_continuous_on s
10178Proof
10179  REPEAT STRIP_TAC THEN
10180  ASM_SIMP_TAC std_ss [uniformly_continuous_on, dist, GSYM LINEAR_SUB] THEN
10181  FIRST_ASSUM(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC o
10182   MATCH_MP LINEAR_BOUNDED_POS) THEN
10183  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN EXISTS_TAC ``e / B:real`` THEN
10184  ASM_SIMP_TAC std_ss [REAL_LT_DIV] THEN
10185  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
10186  MATCH_MP_TAC REAL_LET_TRANS THEN
10187  EXISTS_TAC ``B * abs(y - x:real)`` THEN ASM_REWRITE_TAC[] THEN
10188  ASM_MESON_TAC[REAL_LT_RDIV_EQ, REAL_MUL_SYM]
10189QED
10190
10191Theorem lemma[local]:
10192   (!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=>
10193   (!x. P x /\ Q (f x) ==> R (f x))
10194Proof
10195  MESON_TAC[]
10196QED
10197
10198Theorem UNIFORMLY_CONTINUOUS_ON_COMPOSE:
10199   !f g s. f uniformly_continuous_on s /\
10200           g uniformly_continuous_on (IMAGE f s)
10201 ==> (g o f) uniformly_continuous_on s
10202Proof
10203  REPEAT GEN_TAC THEN
10204  SIMP_TAC std_ss [uniformly_continuous_on, o_THM, IN_IMAGE] THEN
10205  KNOW_TAC ``((!e:real. 0 < e ==> ?d. 0 < d /\
10206     !x x'. x IN s /\ x' IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10207              (!e:real. 0 < e ==> ?d. 0 < d /\
10208     !x x'. (?x'. (x = f x') /\ x' IN s) /\ (?x. (x' = f x) /\ x IN s) /\
10209       dist (x',x) < d ==> dist (g x',g x) < e) ==>
10210               !e:real. 0 < e ==> ?d. 0 < d /\
10211    !x x'. x IN s /\ x' IN s /\ dist (x',x) < d ==>
10212      dist (g (f x'),g (f x)) < e) =
10213             ((!e:real. 0 < e ==> ?d. 0 < d /\
10214     !x' x. x IN s /\ x' IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10215              (!e:real. 0 < e ==> ?d. 0 < d /\
10216     !x' x. (?x'. (x = f x') /\ x' IN s) /\ (?x. (x' = f x) /\ x IN s) /\
10217       dist (x',x) < d ==> dist (g x',g x) < e) ==>
10218               !e:real. 0 < e ==> ?d. 0 < d /\
10219    !x' x. x IN s /\ x' IN s /\ dist (x',x) < d ==>
10220      dist (g (f x'),g (f x)) < e)`` THENL
10221  [METIS_TAC [SWAP_FORALL_THM], ALL_TAC] THEN DISC_RW_KILL THEN
10222  KNOW_TAC `` ((!e:real. 0 < e ==> ?d. 0 < d /\
10223     !x' x. x IN s /\ x' IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10224              (!e:real. 0 < e ==> ?d. 0 < d /\
10225     !x' x. (?x'. (x = f x') /\ x' IN s) /\ (?x. (x' = f x) /\ x IN s) /\
10226       dist (x',x) < d ==> dist (g x',g x) < e) ==>
10227               !e:real. 0 < e ==> ?d. 0 < d /\
10228     !x' x. x IN s /\ x' IN s /\ dist (x',x) < d ==>
10229      dist (g (f x'),g (f x)) < e) =
10230              ((!e:real. 0 < e ==> ?d. 0 < d /\
10231     !x' x. x IN s /\ x' IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10232              (!e:real. 0 < e ==> ?d. 0 < d /\
10233     !x' x. x IN s /\ (?x. (x' = f x) /\ x IN s) /\ dist (x',f x) < d
10234                    ==> dist (g x',g (f x)) < e) ==>
10235               !e:real. 0 < e ==> ?d. 0 < d /\
10236     !x' x. x IN s /\ x' IN s /\ dist (x',x) < d ==>
10237      dist (g (f x'),g (f x)) < e)`` THENL
10238  [METIS_TAC [], ALL_TAC] THEN DISC_RW_KILL THEN
10239  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
10240  KNOW_TAC ``((!e. 0 < e ==> ?d. 0 < d /\
10241     !x' x. x' IN s /\ x IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10242              (!e. 0 < e ==> ?d. 0 < d /\
10243     !x' x. (?x. (x' = f x) /\ x IN s) /\ x IN s /\ dist (x',f x) < d ==>
10244       dist (g x',g (f x)) < e) ==>
10245               !e. 0 < e ==> ?d. 0 < d /\
10246    !x' x. x' IN s /\ x IN s /\ dist (x',x) < d ==>
10247      dist (g (f x'),g (f x)) < e) =
10248              ((!e. 0 < e ==> ?d. 0 < d /\
10249     !x x'. x' IN s /\ x IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10250              (!e. 0 < e ==> ?d. 0 < d /\
10251     !x x'. (?x. (x' = f x) /\ x IN s) /\ x IN s /\ dist (x',f x) < d ==>
10252       dist (g x',g (f x)) < e) ==>
10253               !e. 0 < e ==> ?d. 0 < d /\
10254    !x x'. x' IN s /\ x IN s /\ dist (x',x) < d ==>
10255      dist (g (f x'),g (f x)) < e)`` THENL
10256  [METIS_TAC [SWAP_FORALL_THM], ALL_TAC] THEN DISC_RW_KILL THEN
10257  KNOW_TAC ``((!e. 0 < e ==> ?d. 0 < d /\
10258     !x x'. x' IN s /\ x IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10259              (!e. 0 < e ==> ?d. 0 < d /\
10260     !x x'. (?x. (x' = f x) /\ x IN s) /\ x IN s /\ dist (x',f x) < d ==>
10261       dist (g x',g (f x)) < e) ==>
10262               !e. 0 < e ==> ?d. 0 < d /\
10263    !x x'. x' IN s /\ x IN s /\ dist (x',x) < d ==>
10264      dist (g (f x'),g (f x)) < e) =
10265            ((!e. 0 < e ==> ?d. 0 < d /\
10266     !x x'. x' IN s /\ x IN s /\ dist (x',x) < d ==> dist (f x',f x) < e) /\
10267              (!e. 0 < e ==> ?d. 0 < d /\
10268     !x x'. x' IN s /\ x IN s /\ dist (f x',f x) < d ==>
10269       dist (g (f x'),g (f x)) < e) ==>
10270               !e. 0 < e ==> ?d. 0 < d /\
10271    !x x'. x' IN s /\ x IN s /\ dist (x',x) < d ==>
10272      dist (g (f x'),g (f x)) < e)`` THENL
10273  [METIS_TAC [], ALL_TAC] THEN DISC_RW_KILL THEN
10274  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10275  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN
10276  POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
10277  ASM_CASES_TAC ``&0 < e`` THEN ASM_REWRITE_TAC[] THEN
10278  ASM_MESON_TAC[]
10279QED
10280
10281Theorem BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE:
10282   !f:real->real g (h:real->real->real) s.
10283    f uniformly_continuous_on s /\ g uniformly_continuous_on s /\
10284    bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s)
10285    ==> (\x. h (f x) (g x)) uniformly_continuous_on s
10286Proof
10287  REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on, dist] THEN
10288  BETA_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
10289  SUBGOAL_THEN
10290   ``!a b c d. (h:real->real->real) a b - h c d =
10291     h (a - c) b + h c (b - d)`` (fn th => ONCE_REWRITE_TAC[th]) THENL
10292  [FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN
10293   FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN
10294   REAL_ARITH_TAC, ALL_TAC] THEN
10295  FIRST_X_ASSUM(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC o
10296   MATCH_MP BILINEAR_BOUNDED_POS) THEN
10297  UNDISCH_TAC ``bounded(IMAGE (g:real->real) s)`` THEN
10298  UNDISCH_TAC ``bounded(IMAGE (f:real->real) s)`` THEN
10299  SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE] THEN
10300  DISCH_THEN(X_CHOOSE_THEN ``B1:real`` STRIP_ASSUME_TAC) THEN
10301  DISCH_THEN(X_CHOOSE_THEN ``B2:real`` STRIP_ASSUME_TAC) THEN
10302  UNDISCH_TAC ``(g:real->real) uniformly_continuous_on s`` THEN
10303  UNDISCH_TAC ``(f:real->real) uniformly_continuous_on s`` THEN
10304  REWRITE_TAC[uniformly_continuous_on] THEN
10305  DISCH_THEN(MP_TAC o SPEC ``e:real / &2 / &2 / B / B2``) THEN
10306  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_HALF, dist] THEN
10307  DISCH_THEN(X_CHOOSE_THEN ``d1:real`` STRIP_ASSUME_TAC) THEN
10308  DISCH_THEN(MP_TAC o SPEC ``e:real / &2 / &2 / B / B1``) THEN
10309  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_HALF, dist] THEN
10310  DISCH_THEN(X_CHOOSE_THEN ``d2:real`` STRIP_ASSUME_TAC) THEN
10311  EXISTS_TAC ``min d1 d2:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
10312  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
10313  FIRST_X_ASSUM(MP_TAC o SPECL [``x:real``, ``y:real``]) THEN
10314  FIRST_X_ASSUM(MP_TAC o SPECL [``x:real``, ``y:real``]) THEN
10315  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
10316  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
10317   ``B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1:real`` THEN
10318  CONJ_TAC THENL
10319  [MATCH_MP_TAC(REAL_ARITH
10320   ``abs(x) <= a /\ abs(y) <= b ==> abs(x + y:real) <= a + b``) THEN
10321  CONJ_TAC THEN
10322  FIRST_X_ASSUM(fn th => W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN
10323  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
10324  REWRITE_TAC [real_div] THEN REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
10325  MATCH_MP_TAC REAL_LE_LMUL1 THEN ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE] THENL
10326  [REWRITE_TAC [GSYM real_div, REAL_MUL_ASSOC],ALL_TAC] THEN
10327  MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC [GSYM real_div, REAL_MUL_ASSOC] THEN
10328  ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, ABS_POS],
10329  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, REAL_POS_NZ] THEN
10330  REWRITE_TAC [real_div, GSYM REAL_MUL_ASSOC] THEN
10331  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
10332  REWRITE_TAC [GSYM real_div, REAL_MUL_ASSOC] THEN
10333  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, REAL_POS_NZ] THEN
10334  REWRITE_TAC [real_div] THEN
10335  REWRITE_TAC [REAL_ARITH `` B1 * e * inv 2 * inv 2 * inv B * inv B1 * B =
10336                             e * inv 2 * inv 2 * inv B * inv B1 * B1 * B:real``] THEN
10337  REWRITE_TAC [GSYM real_div] THEN
10338  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, REAL_POS_NZ] THEN
10339  REWRITE_TAC [REAL_HALF_DOUBLE] THEN ASM_SIMP_TAC std_ss [REAL_LT_HALF2]]
10340QED
10341
10342Theorem UNIFORMLY_CONTINUOUS_ON_MUL:
10343   !f g:real->real s.
10344    f uniformly_continuous_on s /\ g uniformly_continuous_on s /\
10345    bounded(IMAGE f s) /\ bounded(IMAGE g s)
10346    ==> (\x. f x * g x) uniformly_continuous_on s
10347Proof
10348  REPEAT STRIP_TAC THEN
10349  MP_TAC(ISPECL [``(f:real->real)``, ``g:real->real``,
10350   ``\c (v:real). c * v``, ``s:real->bool``]
10351  BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN
10352  ASM_SIMP_TAC std_ss [o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
10353  REWRITE_TAC[bilinear, linear] THEN BETA_TAC THEN REAL_ARITH_TAC
10354QED
10355
10356Theorem UNIFORMLY_CONTINUOUS_ON_CMUL:
10357   !f c s. f uniformly_continuous_on s
10358   ==> (\x. c * f(x)) uniformly_continuous_on s
10359Proof
10360  REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN
10361  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
10362  POP_ASSUM (MP_TAC o Q.SPECL [`x:num->real`, `y:num->real`]) THEN
10363  DISCH_THEN(fn th => DISCH_TAC THEN MP_TAC th) THEN
10364  ASM_REWRITE_TAC[] THEN
10365  DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN
10366  ASM_SIMP_TAC std_ss [REAL_SUB_LDISTRIB, REAL_MUL_RZERO]
10367QED
10368
10369Theorem UNIFORMLY_CONTINUOUS_ON_VMUL:
10370   !s:real->bool c v:real.
10371    c uniformly_continuous_on s
10372    ==> (\x. c x * v) uniformly_continuous_on s
10373Proof
10374  REPEAT GEN_TAC THEN
10375  DISCH_THEN(MP_TAC o ISPEC ``\x. (x * v:real)`` o MATCH_MP
10376   (REWRITE_RULE[CONJ_EQ_IMP] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN
10377  SIMP_TAC std_ss [o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
10378  MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN
10379  REWRITE_TAC [linear] THEN BETA_TAC THEN REAL_ARITH_TAC
10380QED
10381
10382Theorem UNIFORMLY_CONTINUOUS_ON_NEG:
10383   !f s. f uniformly_continuous_on s
10384   ==> (\x. -(f x)) uniformly_continuous_on s
10385Proof
10386  ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN
10387  REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]
10388QED
10389
10390Theorem UNIFORMLY_CONTINUOUS_ON_ADD:
10391   !f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s
10392  ==> (\x. f(x) + g(x)) uniformly_continuous_on s
10393Proof
10394  REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN
10395  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
10396  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
10397  POP_ASSUM (MP_TAC o Q.SPECL [`x:num->real`, `y:num->real`]) THEN
10398  DISCH_THEN(fn th => DISCH_TAC THEN MP_TAC th) THEN
10399  ASM_SIMP_TAC std_ss [o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
10400  MATCH_MP_TAC EQ_IMPLIES THEN BETA_TAC THEN
10401  REWRITE_TAC[REAL_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN
10402  REWRITE_TAC[FUN_EQ_THM] THEN BETA_TAC THEN REAL_ARITH_TAC
10403QED
10404
10405Theorem UNIFORMLY_CONTINUOUS_ON_SUB:
10406   !f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s
10407   ==> (\x. f(x) - g(x)) uniformly_continuous_on s
10408Proof
10409  REWRITE_TAC[real_sub] THEN
10410  SIMP_TAC std_ss [UNIFORMLY_CONTINUOUS_ON_NEG, UNIFORMLY_CONTINUOUS_ON_ADD]
10411QED
10412
10413Theorem UNIFORMLY_CONTINUOUS_ON_SUM:
10414   !t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t)
10415    ==> (\x. sum s (\a. f a x)) uniformly_continuous_on t
10416Proof
10417  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJ_EQ_IMP] THEN
10418  KNOW_TAC ``!s. ((!a. a IN s ==> f a uniformly_continuous_on t) ==>
10419              (\x. sum s (\a. f a x)) uniformly_continuous_on t) =
10420             (\s. (!a. a IN s ==> f a uniformly_continuous_on t) ==>
10421              (\x. sum s (\a. f a x)) uniformly_continuous_on t) s`` THENL
10422  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
10423  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
10424  SIMP_TAC std_ss [FORALL_IN_INSERT, NOT_IN_EMPTY, SUM_CLAUSES,
10425   UNIFORMLY_CONTINUOUS_ON_CONST, ETA_AX] THEN REPEAT STRIP_TAC THEN
10426  METIS_TAC [UNIFORMLY_CONTINUOUS_ON_ADD]
10427QED
10428
10429(* ------------------------------------------------------------------------- *)
10430(* Identity function is continuous in every sense.                           *)
10431(* ------------------------------------------------------------------------- *)
10432
10433Theorem CONTINUOUS_WITHIN_ID:
10434   !a s. (\x. x) continuous (at a within s)
10435Proof
10436  REWRITE_TAC[continuous_within] THEN MESON_TAC[]
10437QED
10438
10439Theorem CONTINUOUS_AT_ID:
10440   !a. (\x. x) continuous (at a)
10441Proof
10442  REWRITE_TAC[continuous_at] THEN MESON_TAC[]
10443QED
10444
10445Theorem CONTINUOUS_ON_ID:
10446   !s. (\x. x) continuous_on s
10447Proof
10448  REWRITE_TAC[continuous_on] THEN MESON_TAC[]
10449QED
10450
10451Theorem UNIFORMLY_CONTINUOUS_ON_ID:
10452   !s. (\x. x) uniformly_continuous_on s
10453Proof
10454  REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]
10455QED
10456
10457(* ------------------------------------------------------------------------- *)
10458(* Continuity of all kinds is preserved under composition. *)
10459(* ------------------------------------------------------------------------- *)
10460
10461Theorem CONTINUOUS_WITHIN_COMPOSE:
10462   !f g x s. f continuous (at x within s) /\
10463      g continuous (at (f x) within IMAGE f s)
10464    ==> (g o f) continuous (at x within s)
10465Proof
10466  REPEAT GEN_TAC THEN SIMP_TAC std_ss [continuous_within, o_THM, IN_IMAGE] THEN
10467  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10468  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
10469  ASM_MESON_TAC[]
10470QED
10471
10472Theorem CONTINUOUS_AT_COMPOSE:
10473   !f g x. f continuous (at x) /\ g continuous (at (f x))
10474   ==> (g o f) continuous (at x)
10475Proof
10476  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
10477  MESON_TAC[CONTINUOUS_WITHIN_COMPOSE, IN_IMAGE, CONTINUOUS_WITHIN_SUBSET,
10478   SUBSET_UNIV, IN_UNIV]
10479QED
10480
10481Theorem CONTINUOUS_ON_COMPOSE:
10482   !f g s. f continuous_on s /\ g continuous_on (IMAGE f s)
10483  ==> (g o f) continuous_on s
10484Proof
10485  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10486  MESON_TAC[IN_IMAGE, CONTINUOUS_WITHIN_COMPOSE]
10487QED
10488
10489(* ------------------------------------------------------------------------- *)
10490(* Continuity in terms of open preimages. *)
10491(* ------------------------------------------------------------------------- *)
10492
10493Theorem CONTINUOUS_WITHIN_OPEN:
10494   !f:real->real x u.
10495    f continuous (at x within u) <=>
10496   !t. open t /\ f(x) IN t
10497   ==> ?s. open s /\ x IN s /\
10498    !x'. x' IN s /\ x' IN u ==> f(x') IN t
10499Proof
10500  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL
10501  [DISCH_TAC THEN X_GEN_TAC ``t:real->bool`` THEN
10502   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10503   GEN_REWR_TAC LAND_CONV [open_def] THEN
10504   DISCH_THEN(MP_TAC o SPEC ``(f:real->real) x``) THEN
10505   ASM_MESON_TAC[IN_BALL, DIST_SYM, OPEN_BALL, CENTRE_IN_BALL, DIST_SYM],
10506   DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
10507   FIRST_X_ASSUM(MP_TAC o SPEC ``ball((f:real->real) x,e)``) THEN
10508   ASM_SIMP_TAC std_ss [OPEN_BALL, CENTRE_IN_BALL] THEN
10509   MESON_TAC[open_def, IN_BALL, REAL_LT_TRANS, DIST_SYM]]
10510QED
10511
10512Theorem CONTINUOUS_AT_OPEN:
10513   !f:real->real x.
10514   f continuous (at x) <=>
10515   !t. open t /\ f(x) IN t
10516   ==> ?s. open s /\ x IN s /\
10517    !x'. x' IN s ==> f(x') IN t
10518Proof
10519  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL
10520  [DISCH_TAC THEN X_GEN_TAC ``t:real->bool`` THEN
10521   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10522   GEN_REWR_TAC LAND_CONV [open_def] THEN
10523   DISCH_THEN(MP_TAC o SPEC ``(f:real->real) x``) THEN
10524   ASM_MESON_TAC[IN_BALL, DIST_SYM, OPEN_BALL, CENTRE_IN_BALL],
10525   DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
10526   FIRST_X_ASSUM(MP_TAC o SPEC ``ball((f:real->real) x,e)``) THEN
10527   ASM_SIMP_TAC std_ss [OPEN_BALL, CENTRE_IN_BALL] THEN
10528   MESON_TAC[open_def, IN_BALL, REAL_LT_TRANS, DIST_SYM]]
10529QED
10530
10531Theorem CONTINUOUS_ON_OPEN_GEN:
10532   !f:real->real s t.
10533   IMAGE f s SUBSET t
10534   ==> (f continuous_on s <=>
10535    !u. open_in (subtopology euclidean t) u
10536    ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})
10537Proof
10538  REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL
10539  [SIMP_TAC std_ss [open_in, SUBSET_DEF, GSPECIFICATION] THEN
10540   DISCH_TAC THEN X_GEN_TAC ``u:real->bool`` THEN STRIP_TAC THEN
10541   X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
10542   FIRST_X_ASSUM(MP_TAC o SPEC ``(f:real->real) x``) THEN ASM_SET_TAC[],
10543  DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN
10544  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
10545  FIRST_X_ASSUM(MP_TAC o
10546   SPEC ``ball((f:real->real) x,e) INTER t``) THEN
10547  KNOW_TAC ``open_in (subtopology euclidean t) (ball ((f:real->real) x,e) INTER t)`` THENL
10548  [ASM_MESON_TAC[OPEN_IN_OPEN, INTER_COMM, OPEN_BALL], ALL_TAC] THEN
10549  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
10550  SIMP_TAC std_ss [open_in, SUBSET_DEF, IN_INTER, GSPECIFICATION, IN_BALL, IN_IMAGE] THEN
10551  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
10552  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET_DEF, FORALL_IN_IMAGE]) THEN
10553  FULL_SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
10554  ASM_MESON_TAC[DIST_REFL, DIST_SYM]]
10555QED
10556
10557Theorem CONTINUOUS_ON_OPEN:
10558   !f:real->real s.
10559   f continuous_on s <=>
10560   !t. open_in (subtopology euclidean (IMAGE f s)) t
10561    ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}
10562Proof
10563  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN
10564  REWRITE_TAC[SUBSET_REFL]
10565QED
10566
10567Theorem CONTINUOUS_OPEN_IN_PREIMAGE_GEN:
10568   !f:real->real s t u.
10569    f continuous_on s /\ IMAGE f s SUBSET t /\
10570    open_in (subtopology euclidean t) u
10571    ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}
10572Proof
10573  METIS_TAC[CONTINUOUS_ON_OPEN_GEN]
10574QED
10575
10576Theorem CONTINUOUS_ON_IMP_OPEN_IN:
10577   !f:real->real s t. f continuous_on s /\
10578   open_in (subtopology euclidean (IMAGE f s)) t
10579   ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}
10580Proof
10581 METIS_TAC[CONTINUOUS_ON_OPEN]
10582QED
10583
10584(* NOTE: It's a bit strange that “open_in euclidean (IMAGE f s)” is required,
10585   by [OPEN_IN_SUBTOPOLOGY]. cf. HOL-Light's CONTINUOUS_MAP_EUCLIDEAN.
10586 *)
10587Theorem continuous_on_alt_continuous_map :
10588   !(f :real -> real) s. open_in euclidean (IMAGE f s) ==>
10589     (f continuous_on s <=>
10590      continuous_map (subtopology euclidean s,euclidean) f)
10591Proof
10592    rpt STRIP_TAC
10593 >> reverse EQ_TAC
10594 >- (rw [CONTINUOUS_MAP, CONTINUOUS_ON_OPEN, TOPSPACE_EUCLIDEAN] \\
10595     FIRST_X_ASSUM MATCH_MP_TAC \\
10596     fs [OPEN_IN_SUBTOPOLOGY] \\
10597     MATCH_MP_TAC OPEN_IN_INTER >> art [])
10598 (* stage work *)
10599 >> rw [CONTINUOUS_MAP, TOPSPACE_EUCLIDEAN]
10600 >> MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN
10601 >> Q.EXISTS_TAC ‘UNIV’ >> rw []
10602QED
10603
10604Theorem continuous_on_univ_alt_continuous_map :
10605   !(f :real -> real).
10606     f continuous_on UNIV <=> continuous_map (euclidean,euclidean) f
10607Proof
10608    Q.X_GEN_TAC ‘f’
10609 >> EQ_TAC
10610 >- (rw [CONTINUOUS_MAP, TOPSPACE_EUCLIDEAN] \\
10611     MP_TAC (Q.SPECL [‘f’, ‘UNIV’, ‘UNIV’, ‘u’] CONTINUOUS_OPEN_IN_PREIMAGE_GEN) \\
10612     rw [SUBTOPOLOGY_UNIV])
10613 >> rw [CONTINUOUS_MAP, TOPSPACE_EUCLIDEAN, continuous_on, GSYM euclidean_open_def]
10614 >> Q.PAT_X_ASSUM ‘!u. open u ==> _’ (MP_TAC o Q.SPEC ‘ball (f (x :real),e)’)
10615 >> simp [OPEN_BALL, IN_BALL]
10616 >> rw [open_def]
10617 >> POP_ASSUM (MP_TAC o Q.SPEC ‘x’) >> simp [DIST_REFL]
10618 >> DISCH_THEN (Q.X_CHOOSE_THEN ‘r’ STRIP_ASSUME_TAC)
10619 >> Q.EXISTS_TAC ‘r’ >> art []
10620 >> Q.X_GEN_TAC ‘y’
10621 >> DISCH_TAC
10622 >> ONCE_REWRITE_TAC [DIST_SYM]
10623 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
10624QED
10625
10626(* ------------------------------------------------------------------------- *)
10627(* Similarly in terms of closed sets. *)
10628(* ------------------------------------------------------------------------- *)
10629
10630Theorem CONTINUOUS_ON_CLOSED_GEN:
10631   !f:real->real s t.
10632   IMAGE f s SUBSET t
10633   ==> (f continuous_on s <=>
10634    !u. closed_in (subtopology euclidean t) u
10635    ==> closed_in (subtopology euclidean s)
10636    {x | x IN s /\ f x IN u})
10637Proof
10638  REPEAT STRIP_TAC THEN FIRST_ASSUM(fn th =>
10639  ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
10640  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC ``u:real->bool`` THEN
10641  FIRST_X_ASSUM(MP_TAC o SPEC ``t DIFF u:real->bool``) THENL
10642  [REWRITE_TAC[closed_in], REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN
10643  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
10644  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
10645  ASM_SIMP_TAC std_ss [SUBSET_RESTRICT] THEN
10646  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]
10647QED
10648
10649Theorem CONTINUOUS_ON_CLOSED:
10650   !f:real->real s.
10651    f continuous_on s <=>
10652   !t. closed_in (subtopology euclidean (IMAGE f s)) t
10653    ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}
10654Proof
10655  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN
10656  REWRITE_TAC[SUBSET_REFL]
10657QED
10658
10659Theorem CONTINUOUS_CLOSED_IN_PREIMAGE_GEN:
10660   !f:real->real s t u.
10661   f continuous_on s /\ IMAGE f s SUBSET t /\
10662   closed_in (subtopology euclidean t) u
10663   ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}
10664Proof
10665  METIS_TAC[CONTINUOUS_ON_CLOSED_GEN]
10666QED
10667
10668Theorem CONTINUOUS_ON_IMP_CLOSED_IN:
10669   !f:real->real s t. f continuous_on s /\
10670    closed_in (subtopology euclidean (IMAGE f s)) t
10671    ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}
10672Proof
10673  METIS_TAC[CONTINUOUS_ON_CLOSED]
10674QED
10675
10676(* ------------------------------------------------------------------------- *)
10677(* Half-global and completely global cases. *)
10678(* ------------------------------------------------------------------------- *)
10679
10680Theorem CONTINUOUS_OPEN_IN_PREIMAGE:
10681   !f s t.
10682  f continuous_on s /\ open t
10683  ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}
10684Proof
10685  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
10686  ``x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)``] THEN
10687  FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN
10688  ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
10689  ASM_REWRITE_TAC[]
10690QED
10691
10692Theorem CONTINUOUS_CLOSED_IN_PREIMAGE:
10693   !f s t.
10694   f continuous_on s /\ closed t
10695   ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}
10696Proof
10697  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
10698   ``x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)``] THEN
10699  FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN
10700  ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN
10701  ASM_REWRITE_TAC[]
10702QED
10703
10704Theorem CONTINUOUS_OPEN_PREIMAGE:
10705   !f:real->real s t.
10706   f continuous_on s /\ open s /\ open t
10707   ==> open {x | x IN s /\ f(x) IN t}
10708Proof
10709  REPEAT STRIP_TAC THEN
10710  UNDISCH_TAC ``f continuous_on s`` THEN GEN_REWR_TAC LAND_CONV [CONTINUOUS_ON_OPEN] THEN
10711  REWRITE_TAC [OPEN_IN_OPEN] THEN
10712  DISCH_THEN(MP_TAC o SPEC ``IMAGE (f:real->real) s INTER t``) THEN
10713  KNOW_TAC ``(?t'. open t' /\ (IMAGE (f:real->real) s INTER t = IMAGE f s INTER t'))`` THENL
10714  [EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC [],
10715  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN
10716  SUBGOAL_THEN ``{x | x IN s /\ (f:real->real) x IN t} =
10717                                            s INTER t'`` SUBST1_TAC THENL
10718  [ASM_SET_TAC [], ASM_MESON_TAC [OPEN_INTER]]]
10719QED
10720
10721Theorem CONTINUOUS_CLOSED_PREIMAGE:
10722   !f:real->real s t.
10723    f continuous_on s /\ closed s /\ closed t
10724    ==> closed {x | x IN s /\ f(x) IN t}
10725Proof
10726  REPEAT STRIP_TAC THEN UNDISCH_TAC ``f continuous_on s`` THEN
10727  GEN_REWR_TAC LAND_CONV [CONTINUOUS_ON_CLOSED] THEN
10728  REWRITE_TAC [CLOSED_IN_CLOSED] THEN
10729  DISCH_THEN(MP_TAC o SPEC ``IMAGE (f:real->real) s INTER t``) THEN
10730  KNOW_TAC ``(?t'. closed t' /\ (IMAGE (f:real->real) s INTER t = IMAGE f s INTER t'))`` THENL
10731  [EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC [],
10732  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN
10733  SUBGOAL_THEN ``{x | x IN s /\ (f:real->real) x IN t} =
10734                                            s INTER t'`` SUBST1_TAC THENL
10735  [ASM_SET_TAC [], ASM_MESON_TAC [CLOSED_INTER]]]
10736QED
10737
10738Theorem CONTINUOUS_OPEN_PREIMAGE_UNIV:
10739   !f:real->real s.
10740  (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}
10741Proof
10742  REPEAT STRIP_TAC THEN
10743  MP_TAC(SPECL [``f:real->real``, ``univ(:real)``, ``s:real->bool``]
10744   CONTINUOUS_OPEN_PREIMAGE) THEN
10745  ASM_SIMP_TAC std_ss [OPEN_UNIV, IN_UNIV, CONTINUOUS_AT_IMP_CONTINUOUS_ON]
10746QED
10747
10748Theorem CONTINUOUS_CLOSED_PREIMAGE_UNIV:
10749   !f:real->real s.
10750  (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}
10751Proof
10752  REPEAT STRIP_TAC THEN
10753  MP_TAC(SPECL [``f:real->real``, ``univ(:real)``, ``s:real->bool``]
10754   CONTINUOUS_CLOSED_PREIMAGE) THEN
10755  ASM_SIMP_TAC std_ss [CLOSED_UNIV, IN_UNIV, CONTINUOUS_AT_IMP_CONTINUOUS_ON]
10756QED
10757
10758Theorem CONTINUOUS_OPEN_IN_PREIMAGE_EQ:
10759   !f:real->real s. f continuous_on s <=>
10760   !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}
10761Proof
10762  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [CONTINUOUS_OPEN_IN_PREIMAGE] THEN
10763  REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN
10764  X_GEN_TAC ``t:real->bool`` THEN GEN_REWR_TAC LAND_CONV [OPEN_IN_OPEN] THEN
10765  DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
10766  FIRST_X_ASSUM(MP_TAC o SPEC ``u:real->bool``) THEN
10767  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN SET_TAC[]
10768QED
10769
10770Theorem CONTINUOUS_CLOSED_IN_PREIMAGE_EQ:
10771   !f:real->real s. f continuous_on s <=> !t. closed t
10772     ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}
10773Proof
10774  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [CONTINUOUS_CLOSED_IN_PREIMAGE] THEN
10775  REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN
10776  X_GEN_TAC ``t:real->bool`` THEN
10777  GEN_REWR_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN
10778  DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
10779  FIRST_X_ASSUM(MP_TAC o SPEC ``u:real->bool``) THEN
10780  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN SET_TAC[]
10781QED
10782
10783(* ------------------------------------------------------------------------- *)
10784(* Linear functions are (uniformly) continuous on any set. *)
10785(* ------------------------------------------------------------------------- *)
10786
10787Theorem LINEAR_LIM_0:
10788   !f. linear f ==> (f --> 0) (at (0))
10789Proof
10790  REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN
10791  FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN
10792  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
10793  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN EXISTS_TAC ``e / B:real`` THEN
10794  ASM_SIMP_TAC std_ss [REAL_LT_DIV] THEN REWRITE_TAC[dist, REAL_SUB_RZERO] THEN
10795  ASM_MESON_TAC[REAL_MUL_SYM, REAL_LET_TRANS, REAL_LT_RDIV_EQ]
10796QED
10797
10798Theorem LINEAR_CONTINUOUS_AT:
10799   !f:real->real a. linear f ==> f continuous (at a)
10800Proof
10801  REPEAT STRIP_TAC THEN
10802  MP_TAC(ISPEC ``\x. (f:real->real) (a + x) - f(a)`` LINEAR_LIM_0) THEN
10803  KNOW_TAC ``linear (\x. f (a + x) - f a)`` THENL
10804  [POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [linear] THEN
10805   REPEAT STRIP_TAC THEN REAL_ARITH_TAC, ALL_TAC] THEN
10806  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
10807  SIMP_TAC std_ss [GSYM LIM_NULL, CONTINUOUS_AT] THEN
10808  GEN_REWR_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC std_ss []
10809QED
10810
10811Theorem LINEAR_CONTINUOUS_WITHIN:
10812   !f:real->real s x. linear f ==> f continuous (at x within s)
10813Proof
10814  SIMP_TAC std_ss [CONTINUOUS_AT_WITHIN, LINEAR_CONTINUOUS_AT]
10815QED
10816
10817Theorem LINEAR_CONTINUOUS_ON:
10818   !f:real->real s. linear f ==> f continuous_on s
10819Proof
10820  MESON_TAC[LINEAR_CONTINUOUS_AT, CONTINUOUS_AT_IMP_CONTINUOUS_ON]
10821QED
10822
10823Theorem LINEAR_CONTINUOUS_COMPOSE:
10824   !net f:'a->real g:real->real.
10825   f continuous net /\ linear g ==> (\x. g(f x)) continuous net
10826Proof
10827  SIMP_TAC std_ss [continuous, LIM_LINEAR]
10828QED
10829
10830Theorem LINEAR_CONTINUOUS_ON_COMPOSE:
10831   !f:real->real g:real->real s.
10832    f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s
10833Proof
10834  SIMP_TAC std_ss[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN,
10835   LINEAR_CONTINUOUS_COMPOSE]
10836QED
10837
10838Theorem CONTINUOUS_COMPONENT_COMPOSE:
10839   !net f:'a->real i. f continuous net ==> (\x. f x) continuous net
10840Proof
10841  REPEAT GEN_TAC THEN
10842  SUBGOAL_THEN ``linear(\x:real. x)`` MP_TAC THENL
10843  [REWRITE_TAC[LINEAR_ID], REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
10844  METIS_TAC [LINEAR_CONTINUOUS_COMPOSE]
10845QED
10846
10847Theorem CONTINUOUS_ON_COMPONENT_COMPOSE:
10848   !f:real->real s. f continuous_on s
10849    ==> (\x. f x) continuous_on s
10850Proof
10851  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN,
10852                   CONTINUOUS_COMPONENT_COMPOSE]
10853QED
10854
10855(* ------------------------------------------------------------------------- *)
10856(* Also bilinear functions, in composition form. *)
10857(* ------------------------------------------------------------------------- *)
10858
10859Theorem BILINEAR_CONTINUOUS_COMPOSE:
10860   !net f:'a->real g:'a->real h:real->real->real.
10861   f continuous net /\ g continuous net /\ bilinear h
10862   ==> (\x. h (f x) (g x)) continuous net
10863Proof
10864  SIMP_TAC std_ss [continuous, LIM_BILINEAR]
10865QED
10866
10867Theorem BILINEAR_CONTINUOUS_ON_COMPOSE:
10868   !f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h
10869   ==> (\x. h (f x) (g x)) continuous_on s
10870Proof
10871  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN,
10872                   BILINEAR_CONTINUOUS_COMPOSE]
10873QED
10874
10875Theorem BILINEAR_DOT:
10876   bilinear (\x y:real. (x * y))
10877Proof
10878SIMP_TAC std_ss [bilinear, linear] THEN REAL_ARITH_TAC
10879QED
10880
10881Theorem CONTINUOUS_DOT2:
10882   !net f g:'a->real.
10883   f continuous net /\ g continuous net
10884   ==> (\x. f x * g x) continuous net
10885Proof
10886  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
10887   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
10888  BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN BETA_TAC THEN REWRITE_TAC[]
10889QED
10890
10891Theorem CONTINUOUS_ON_DOT2:
10892   !f:real->real g s.
10893    f continuous_on s /\ g continuous_on s
10894    ==> (\x. f x * g x) continuous_on s
10895Proof
10896  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
10897  [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
10898  BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN BETA_TAC THEN REWRITE_TAC[]
10899QED
10900
10901(* ------------------------------------------------------------------------- *)
10902(* Preservation of compactness and connectedness under continuous function. *)
10903(* ------------------------------------------------------------------------- *)
10904
10905Theorem COMPACT_CONTINUOUS_IMAGE:
10906   !f:real->real s.
10907    f continuous_on s /\ compact s ==> compact(IMAGE f s)
10908Proof
10909  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on, compact] THEN
10910  STRIP_TAC THEN X_GEN_TAC ``y:num->real`` THEN
10911  SIMP_TAC std_ss [IN_IMAGE, SKOLEM_THM, FORALL_AND_THM] THEN
10912  DISCH_THEN(X_CHOOSE_THEN ``x:num->real`` STRIP_ASSUME_TAC) THEN
10913  FIRST_X_ASSUM(MP_TAC o SPEC ``x:num->real``) THEN ASM_REWRITE_TAC[] THEN
10914  KNOW_TAC ``((?(l :real) (r :num -> num).
10915              l IN s /\ (!(m :num) (n :num). m < n ==> r m < r n) /\
10916                         ((x :num -> real) o r --> l) sequentially) ==>
10917               ?(l :real) (r :num -> num).
10918              (?(x :real). (l = f x) /\ x IN s) /\
10919                        (!(m :num) (n :num). m < n ==> r m < r n) /\
10920                         ((y :num -> real) o r --> l) sequentially) =
10921             ((?(r :num -> num) (l :real).
10922              l IN s /\ (!(m :num) (n :num). m < n ==> r m < r n) /\
10923                         ((x :num -> real) o r --> l) sequentially) ==>
10924               ?(r :num -> num) (l :real).
10925              (?(x :real). (l = f x) /\ x IN s) /\
10926                        (!(m :num) (n :num). m < n ==> r m < r n) /\
10927                         ((y :num -> real) o r --> l) sequentially)`` THENL
10928  [METIS_TAC [SWAP_EXISTS_THM], DISC_RW_KILL] THEN
10929  STRIP_TAC THEN EXISTS_TAC ``r:num->num`` THEN
10930  EXISTS_TAC ``(f:real->real) l`` THEN ASM_REWRITE_TAC[] THEN
10931  CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
10932  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
10933  FIRST_X_ASSUM(MP_TAC o SPEC ``l:real``) THEN
10934  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN
10935  POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
10936  DISCH_THEN(fn th => DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
10937  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
10938  UNDISCH_TAC `` ((x :num -> real) o (r :num -> num) --> l) sequentially`` THEN
10939  GEN_REWR_TAC LAND_CONV [LIM_SEQUENTIALLY] THEN
10940  DISCH_THEN(MP_TAC o SPEC ``d:real``) THEN ASM_SIMP_TAC std_ss [o_THM] THEN
10941  ASM_MESON_TAC[]
10942QED
10943
10944Theorem COMPACT_TRANSLATION:
10945   !s a:real. compact s ==> compact (IMAGE (\x. a + x) s)
10946Proof
10947  SIMP_TAC std_ss [COMPACT_CONTINUOUS_IMAGE, CONTINUOUS_ON_ADD,
10948   CONTINUOUS_ON_CONST, CONTINUOUS_ON_ID]
10949QED
10950
10951Theorem COMPACT_TRANSLATION_EQ:
10952   !a s. compact (IMAGE (\x:real. a + x) s) <=> compact s
10953Proof
10954  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN
10955  DISCH_THEN(MP_TAC o ISPEC ``-a:real`` o MATCH_MP COMPACT_TRANSLATION) THEN
10956  SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, IMAGE_ID,
10957   REAL_ARITH ``-a + (a + x:real) = x``]
10958QED
10959
10960Theorem COMPACT_LINEAR_IMAGE:
10961   !f:real->real s. compact s /\ linear f ==> compact(IMAGE f s)
10962Proof
10963  SIMP_TAC std_ss [LINEAR_CONTINUOUS_ON, COMPACT_CONTINUOUS_IMAGE]
10964QED
10965
10966Theorem CONNECTED_CONTINUOUS_IMAGE:
10967   !f:real->real s.
10968   f continuous_on s /\ connected s ==> connected(IMAGE f s)
10969Proof
10970  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN
10971  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10972  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
10973  SIMP_TAC std_ss [CONNECTED_CLOPEN, NOT_FORALL_THM, NOT_IMP, DE_MORGAN_THM] THEN
10974  SIMP_TAC std_ss [closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
10975  DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
10976  FIRST_X_ASSUM(fn th => MP_TAC(SPEC ``t:real->bool`` th) THEN
10977   MP_TAC(SPEC ``IMAGE (f:real->real) s DIFF t`` th)) THEN
10978  ASM_REWRITE_TAC[] THEN
10979  SUBGOAL_THEN ``{x | x IN s /\ (f:real->real) x IN IMAGE f s DIFF t} =
10980   s DIFF {x | x IN s /\ f x IN t}`` SUBST1_TAC THENL
10981  [UNDISCH_TAC ``t SUBSET IMAGE (f:real->real) s`` THEN
10982   SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_DIFF, GSPECIFICATION, SUBSET_DEF] THEN
10983   MESON_TAC[],
10984   REPEAT STRIP_TAC THEN
10985   EXISTS_TAC ``{x | x IN s /\ (f:real->real) x IN t}`` THEN
10986   ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
10987   SIMP_TAC std_ss [IN_IMAGE, SUBSET_DEF, GSPECIFICATION, NOT_IN_EMPTY, EXTENSION] THEN
10988   MESON_TAC[]]
10989QED
10990
10991Theorem CONNECTED_TRANSLATION:
10992   !a s. connected s ==> connected (IMAGE (\x:real. a + x) s)
10993Proof
10994  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
10995  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_ADD, CONTINUOUS_ON_ID, CONTINUOUS_ON_CONST]
10996QED
10997
10998Theorem CONNECTED_TRANSLATION_EQ:
10999   !a s. connected (IMAGE (\x:real. a + x) s) <=> connected s
11000Proof
11001  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN
11002  DISCH_THEN(MP_TAC o ISPEC ``-a:real`` o MATCH_MP CONNECTED_TRANSLATION) THEN
11003  SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, IMAGE_ID,
11004   REAL_ARITH ``-a + (a + x:real) = x``]
11005QED
11006
11007Theorem CONNECTED_LINEAR_IMAGE:
11008   !f:real->real s. connected s /\ linear f ==> connected(IMAGE f s)
11009Proof
11010  SIMP_TAC std_ss [LINEAR_CONTINUOUS_ON, CONNECTED_CONTINUOUS_IMAGE]
11011QED
11012
11013(* ------------------------------------------------------------------------- *)
11014(* Quotient maps are occasionally useful.                                    *)
11015(* ------------------------------------------------------------------------- *)
11016
11017Theorem QUASICOMPACT_OPEN_CLOSED:
11018   !f:real->real s t.
11019   IMAGE f s SUBSET t
11020   ==> ((!u. u SUBSET t
11021    ==> (open_in (subtopology euclidean s)
11022        {x | x IN s /\ f x IN u}
11023      ==> open_in (subtopology euclidean t) u)) <=>
11024          (!u. u SUBSET t
11025        ==> (closed_in (subtopology euclidean s)
11026            {x | x IN s /\ f x IN u}
11027           ==> closed_in (subtopology euclidean t) u)))
11028Proof
11029  SIMP_TAC std_ss [closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
11030  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
11031  X_GEN_TAC ``u:real->bool`` THEN
11032  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``t DIFF u:real->bool``) THEN
11033  ASM_SIMP_TAC std_ss [SET_RULE ``u SUBSET t ==> (t DIFF (t DIFF u) = u)``] THEN
11034  REWRITE_TAC [DIFF_SUBSET] THEN REPEAT STRIP_TAC THEN
11035  FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC std_ss [SUBSET_RESTRICT] THEN
11036  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
11037   ``open_in top x ==> (x = y) ==> open_in top y``)) THEN
11038  ASM_SET_TAC[]
11039QED
11040
11041Theorem QUOTIENT_MAP_IMP_CONTINUOUS_OPEN:
11042   !f:real->real s t.
11043    IMAGE f s SUBSET t /\
11044    (!u. u SUBSET t
11045    ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11046     open_in (subtopology euclidean t) u))
11047     ==> f continuous_on s
11048Proof
11049  METIS_TAC[OPEN_IN_IMP_SUBSET, CONTINUOUS_ON_OPEN_GEN]
11050QED
11051
11052Theorem QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED:
11053   !f:real->real s t.
11054   IMAGE f s SUBSET t /\
11055   (!u. u SUBSET t
11056   ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11057     closed_in (subtopology euclidean t) u))
11058     ==> f continuous_on s
11059Proof
11060  METIS_TAC[CLOSED_IN_IMP_SUBSET, CONTINUOUS_ON_CLOSED_GEN]
11061QED
11062
11063Theorem OPEN_MAP_IMP_QUOTIENT_MAP:
11064   !f:real->real s. f continuous_on s /\
11065  (!t. open_in (subtopology euclidean s) t
11066  ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t))
11067    ==> !t. t SUBSET IMAGE f s
11068      ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
11069           open_in (subtopology euclidean (IMAGE f s)) t)
11070Proof
11071  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
11072  [SUBGOAL_THEN
11073   ``(t = IMAGE f {x | x IN s /\ (f:real->real) x IN t})``
11074    SUBST1_TAC THENL [ASM_SET_TAC[], ASM_SIMP_TAC std_ss []],
11075  UNDISCH_TAC ``f continuous_on s`` THEN GEN_REWR_TAC LAND_CONV [CONTINUOUS_ON_OPEN] THEN
11076  ASM_SIMP_TAC std_ss []]
11077QED
11078
11079Theorem CLOSED_MAP_IMP_QUOTIENT_MAP:
11080   !f:real->real s. f continuous_on s /\
11081  (!t. closed_in (subtopology euclidean s) t
11082  ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t))
11083   ==> !t. t SUBSET IMAGE f s
11084     ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
11085          open_in (subtopology euclidean (IMAGE f s)) t)
11086Proof
11087  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
11088  [FIRST_X_ASSUM(MP_TAC o SPEC
11089    ``s DIFF {x | x IN s /\ (f:real->real) x IN t}``) THEN
11090   KNOW_TAC ``closed_in (subtopology euclidean (s :real -> bool))
11091   (s DIFF {x | x IN s /\ (f :real -> real) x IN (t :real -> bool)})`` THENL
11092  [MATCH_MP_TAC CLOSED_IN_DIFF THEN
11093   ASM_SIMP_TAC std_ss [CLOSED_IN_SUBTOPOLOGY_REFL,
11094    TOPSPACE_EUCLIDEAN, SUBSET_UNIV],
11095   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
11096   SIMP_TAC std_ss [closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
11097   DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMPLIES THEN
11098   AP_TERM_TAC THEN ASM_SET_TAC[]],
11099  UNDISCH_TAC ``f continuous_on s`` THEN GEN_REWR_TAC LAND_CONV [CONTINUOUS_ON_OPEN] THEN
11100  ASM_SIMP_TAC std_ss []]
11101QED
11102
11103Theorem CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP:
11104   !f:real->real g s t.
11105    f continuous_on s /\ IMAGE f s SUBSET t /\
11106    g continuous_on t /\ IMAGE g t SUBSET s /\
11107  (!y. y IN t ==> (f(g y) = y))
11108   ==> (!u. u SUBSET t
11109    ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11110         open_in (subtopology euclidean t) u))
11111Proof
11112  REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL
11113  [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC ``(IMAGE (g:real->real) t) INTER
11114                              {x | x IN s /\ (f:real->real) x IN u}``) THEN
11115   SUBGOAL_THEN ``open_in (subtopology euclidean (IMAGE (g:real->real) t))
11116               (IMAGE g t INTER {x | x IN s /\ (f:real->real) x IN u})``
11117               (fn th => REWRITE_TAC[th]) THENL
11118   [POP_ASSUM(MP_TAC o REWRITE_RULE [OPEN_IN_OPEN]) THEN
11119    SIMP_TAC std_ss [OPEN_IN_OPEN] THEN ASM_SET_TAC[],
11120    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]],
11121   DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11122   SUBGOAL_THEN ``IMAGE (f:real->real) s = t``
11123    (fn th => ASM_REWRITE_TAC[th]) THEN
11124   ASM_SET_TAC[]]
11125QED
11126
11127Theorem CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP:
11128   !f:real->real g s.
11129    f continuous_on s /\ g continuous_on (IMAGE f s) /\
11130    (!x. x IN s ==> (g(f x) = x))
11131    ==> (!u. u SUBSET (IMAGE f s)
11132      ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11133           open_in (subtopology euclidean (IMAGE f s)) u))
11134Proof
11135  REPEAT GEN_TAC THEN STRIP_TAC THEN
11136  MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
11137  EXISTS_TAC ``g:real->real`` THEN
11138  ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]
11139QED
11140
11141Theorem QUOTIENT_MAP_OPEN_CLOSED:
11142   !f:real->real s t.
11143    IMAGE f s SUBSET t
11144    ==> ((!u. u SUBSET t
11145      ==> (open_in (subtopology euclidean s)
11146          {x | x IN s /\ f x IN u} <=>
11147          open_in (subtopology euclidean t) u)) <=>
11148          (!u. u SUBSET t
11149          ==> (closed_in (subtopology euclidean s)
11150              {x | x IN s /\ f x IN u} <=>
11151              closed_in (subtopology euclidean t) u)))
11152Proof
11153  SIMP_TAC std_ss [closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
11154  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
11155  X_GEN_TAC ``u:real->bool`` THEN
11156  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``t DIFF u:real->bool``) THEN
11157  ASM_SIMP_TAC std_ss [SET_RULE ``u SUBSET t ==> (t DIFF (t DIFF u) = u)``] THEN
11158  REWRITE_TAC [DIFF_SUBSET] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
11159  SIMP_TAC std_ss [SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM_SET_TAC[]
11160QED
11161
11162Theorem CONTINUOUS_ON_COMPOSE_QUOTIENT:
11163   !f:real->real g:real->real s t u.
11164   IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
11165   (!v. v SUBSET t
11166   ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
11167        open_in (subtopology euclidean t) v)) /\
11168       (g o f) continuous_on s
11169         ==> g continuous_on t
11170Proof
11171  REPEAT GEN_TAC THEN
11172  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11173  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11174  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11175  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
11176  SUBGOAL_THEN
11177   ``IMAGE ((g:real->real) o (f:real->real)) s SUBSET u``
11178   (fn th => REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THENL
11179  [REWRITE_TAC[IMAGE_COMPOSE] THEN ASM_SET_TAC[], DISCH_TAC] THEN
11180  X_GEN_TAC ``v:real->bool`` THEN DISCH_TAC THEN
11181  FIRST_X_ASSUM(MP_TAC o SPEC ``v:real->bool``) THEN
11182  ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN
11183  FIRST_X_ASSUM(MP_TAC o SPEC ``{x | x IN t /\ (g:real->real) x IN v}``) THEN
11184  ASM_SIMP_TAC std_ss [SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
11185  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
11186   ``open_in top s ==> (s = t) ==> open_in top t``)) THEN
11187  ASM_SET_TAC[]
11188QED
11189
11190Theorem FUNCTION_FACTORS_LEFT_GEN:
11191   !P f g. (!x y. P x /\ P y /\ (g x = g y) ==> (f x = f y)) <=>
11192           (?h. !x. P x ==> (f(x) = h(g x)))
11193Proof
11194  ONCE_REWRITE_TAC[MESON[]
11195   ``(!x. P x ==> (f(x) = g(k x))) <=> (!y x. P x /\ (y = k x) ==> (f x = g y))``] THEN
11196  SIMP_TAC std_ss [GSYM SKOLEM_THM] THEN MESON_TAC[]
11197QED
11198
11199Theorem LIFT_TO_QUOTIENT_SPACE:
11200   !f:real->real h:real->real s t u.
11201  (IMAGE f s = t) /\ (!v. v SUBSET t
11202  ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
11203       open_in (subtopology euclidean t) v)) /\
11204       h continuous_on s /\ (IMAGE h s = u) /\
11205      (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (h x = h y))
11206     ==> ?g. g continuous_on t /\ (IMAGE g t = u) /\
11207         !x. x IN s ==> (h(x) = g(f x))
11208Proof
11209  REPEAT GEN_TAC THEN
11210  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11211  SIMP_TAC std_ss [FUNCTION_FACTORS_LEFT_GEN] THEN
11212  DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN
11213  EXISTS_TAC ``g:real->real`` THEN
11214  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
11215  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC
11216   [``f:real->real``, ``s:real->bool``, ``u:real->bool``] THEN
11217  ASM_SIMP_TAC std_ss [SUBSET_REFL] THEN CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
11218  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
11219   CONTINUOUS_ON_EQ)) THEN ASM_SIMP_TAC std_ss [o_THM]
11220QED
11221
11222Theorem QUOTIENT_MAP_COMPOSE:
11223   !f:real->real g:real->real s t u.
11224  IMAGE f s SUBSET t /\
11225  (!v. v SUBSET t
11226  ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
11227      open_in (subtopology euclidean t) v)) /\
11228      (!v. v SUBSET u
11229      ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=>
11230           open_in (subtopology euclidean u) v))
11231          ==> !v. v SUBSET u
11232            ==> (open_in (subtopology euclidean s)
11233                {x | x IN s /\ (g o f) x IN v} <=>
11234                 open_in (subtopology euclidean u) v)
11235Proof
11236  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [o_THM] THEN
11237  SUBGOAL_THEN
11238   ``{x | x IN s /\ (g:real->real) ((f:real->real) x) IN v} =
11239     {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}``
11240   SUBST1_TAC THENL [ASM_SET_TAC[], ASM_SIMP_TAC std_ss [SUBSET_RESTRICT]]
11241QED
11242
11243Theorem QUOTIENT_MAP_FROM_COMPOSITION:
11244   !f:real->real g:real->real s t u.
11245    f continuous_on s /\ IMAGE f s SUBSET t /\
11246    g continuous_on t /\ IMAGE g t SUBSET u /\
11247    (!v. v SUBSET u
11248    ==> (open_in (subtopology euclidean s)
11249         {x | x IN s /\ (g o f) x IN v} <=>
11250         open_in (subtopology euclidean u) v))
11251         ==> !v. v SUBSET u
11252           ==> (open_in (subtopology euclidean t)
11253                {x | x IN t /\ g x IN v} <=>
11254                open_in (subtopology euclidean u) v)
11255Proof
11256  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
11257  [FIRST_X_ASSUM(MP_TAC o SPEC ``v:real->bool``) THEN
11258   ASM_SIMP_TAC std_ss [o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
11259   SUBGOAL_THEN
11260    ``{x | x IN s /\ (g:real->real) ((f:real->real) x) IN v} =
11261      {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}``
11262     SUBST1_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
11263   MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
11264   EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[],
11265   MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
11266   EXISTS_TAC ``u:real->bool`` THEN ASM_REWRITE_TAC[]]
11267QED
11268
11269Theorem QUOTIENT_MAP_FROM_SUBSET:
11270   !f:real->real s t u.
11271    f continuous_on t /\ IMAGE f t SUBSET u /\
11272    s SUBSET t /\ (IMAGE f s = u) /\
11273    (!v. v SUBSET u
11274    ==> (open_in (subtopology euclidean s)
11275         {x | x IN s /\ f x IN v} <=>
11276         open_in (subtopology euclidean u) v))
11277         ==> !v. v SUBSET u
11278           ==> (open_in (subtopology euclidean t)
11279               {x | x IN t /\ f x IN v} <=>
11280                open_in (subtopology euclidean u) v)
11281Proof
11282  REPEAT GEN_TAC THEN STRIP_TAC THEN
11283  MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION THEN
11284  MAP_EVERY EXISTS_TAC [``\x:real. x``, ``s:real->bool``] THEN
11285  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_ID, IMAGE_ID, o_THM]
11286QED
11287
11288Theorem QUOTIENT_MAP_RESTRICT:
11289   !f:real->real s t c.
11290    IMAGE f s SUBSET t /\
11291   (!u. u SUBSET t
11292   ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11293        open_in (subtopology euclidean t) u)) /\
11294       (open_in (subtopology euclidean t) c \/
11295      closed_in (subtopology euclidean t) c)
11296      ==> !u. u SUBSET c
11297        ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c})
11298             {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=>
11299             open_in (subtopology euclidean c) u)
11300Proof
11301  REPEAT GEN_TAC THEN
11302  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11303  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
11304  DISCH_THEN(fn th => MP_TAC th THEN MP_TAC (MATCH_MP
11305   (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN
11306  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
11307  SUBGOAL_THEN ``IMAGE (f:real->real) {x | x IN s /\ f x IN c} SUBSET c``
11308   ASSUME_TAC THENL [SET_TAC[], ALL_TAC] THEN
11309  FIRST_X_ASSUM DISJ_CASES_TAC THENL
11310  [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET),
11311   ASM_SIMP_TAC std_ss [QUOTIENT_MAP_OPEN_CLOSED] THEN
11312   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN
11313  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `u:real->bool`) THEN
11314  DISCH_THEN(fn th => DISCH_TAC THEN MP_TAC th) THEN
11315  (KNOW_TAC ``(u:real->bool) SUBSET t`` THENL
11316   [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []]) THEN
11317  (MATCH_MP_TAC EQ_IMPLIES THEN BINOP_TAC THENL
11318  [MATCH_MP_TAC(MESON[] ``(t = s) /\ (P s <=> Q s) ==> (P s <=> Q t)``) THEN
11319   CONJ_TAC THENL [ASM_SET_TAC[], SIMP_TAC std_ss [GSPECIFICATION]], ALL_TAC]) THEN
11320  (EQ_TAC THENL
11321  [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE
11322   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS),
11323   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE
11324   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN
11325  (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE
11326   MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC std_ss []) THEN
11327  ASM_SET_TAC[]
11328QED
11329
11330Theorem CONNECTED_MONOTONE_QUOTIENT_PREIMAGE :
11331   !f:real->real s t.
11332    f continuous_on s /\ (IMAGE f s = t) /\
11333   (!u. u SUBSET t
11334   ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11335        open_in (subtopology euclidean t) u)) /\
11336       (!y. y IN t ==> connected {x | x IN s /\ (f x = y)}) /\
11337        connected t ==> connected s
11338Proof
11339  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [connected, NOT_EXISTS_THM] THEN
11340  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN CCONTR_TAC THEN
11341  FULL_SIMP_TAC std_ss [] THEN UNDISCH_TAC ``connected(t:real->bool)`` THEN
11342  SIMP_TAC std_ss' [CONNECTED_OPEN_IN] THEN
11343  MAP_EVERY EXISTS_TAC
11344  [``IMAGE (f:real->real) (s INTER u)``,
11345   ``IMAGE (f:real->real) (s INTER v)``] THEN
11346  ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN
11347  SUBGOAL_THEN
11348   ``IMAGE (f:real->real) (s INTER u) INTER IMAGE f (s INTER v) = {}``
11349   ASSUME_TAC THENL
11350  [REWRITE_TAC[EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN
11351   X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
11352   FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN
11353   KNOW_TAC ``y IN t:real->bool`` THENL
11354   [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC[connected]] THEN
11355  MAP_EVERY EXISTS_TAC [``u:real->bool``, ``v:real->bool``] THEN
11356  ASM_SET_TAC[], ALL_TAC] THEN
11357  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
11358  CONJ_TAC THENL [CONJ_TAC, ASM_SET_TAC[]] THEN
11359  FIRST_X_ASSUM(fn th =>
11360   W(MP_TAC o PART_MATCH (rand o rand) th o snd)) THENL
11361  [KNOW_TAC ``IMAGE (f:real->real) (s INTER u) SUBSET t:real->bool`` THENL
11362   [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_THEN(SUBST1_TAC o SYM)],
11363   KNOW_TAC ``IMAGE (f:real->real) (s INTER v) SUBSET t:real->bool`` THENL
11364   [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_THEN(SUBST1_TAC o SYM)]] THEN
11365  MATCH_MP_TAC(MESON[]
11366   ``({x | x IN s /\ f x IN IMAGE f u} = u) /\ open_in top u
11367       ==> open_in top {x | x IN s /\ f x IN IMAGE f u}``) THEN
11368  ASM_SIMP_TAC std_ss [OPEN_IN_OPEN_INTER] THEN ASM_SET_TAC[]
11369QED
11370
11371Theorem CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN:
11372   !f:real->real s t c.
11373   (IMAGE f s = t) /\ (!u. u SUBSET t
11374   ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11375        open_in (subtopology euclidean t) u)) /\
11376       (!y. y IN t ==> connected {x | x IN s /\ (f x = y)}) /\
11377       (open_in (subtopology euclidean t) c \/
11378      closed_in (subtopology euclidean t) c) /\
11379      connected c ==> connected {x | x IN s /\ f x IN c}
11380Proof
11381  REPEAT GEN_TAC THEN
11382  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11383  MATCH_MP_TAC(ONCE_REWRITE_RULE[CONJ_EQ_IMP]
11384   (REWRITE_RULE[CONJ_ASSOC] CONNECTED_MONOTONE_QUOTIENT_PREIMAGE)) THEN
11385  SUBGOAL_THEN ``(c:real->bool) SUBSET t`` ASSUME_TAC THENL
11386  [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET, CLOSED_IN_IMP_SUBSET], ALL_TAC] THEN
11387  EXISTS_TAC ``f:real->real`` THEN REPEAT CONJ_TAC THENL
11388  [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
11389    QUOTIENT_MAP_IMP_CONTINUOUS_OPEN)) THEN
11390   ASM_REWRITE_TAC[SUBSET_REFL] THEN
11391  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN
11392  SIMP_TAC std_ss [SUBSET_RESTRICT],
11393  ASM_SET_TAC[],
11394  MATCH_MP_TAC QUOTIENT_MAP_RESTRICT THEN
11395  METIS_TAC[SUBSET_REFL],
11396  X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
11397  FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN
11398  KNOW_TAC ``y IN t:real->bool`` THENL
11399  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN MATCH_MP_TAC EQ_IMPLIES] THEN
11400  AP_TERM_TAC THEN ASM_SET_TAC[]]
11401QED
11402
11403(* ------------------------------------------------------------------------- *)
11404(* More properties of open and closed maps.                                  *)
11405(* ------------------------------------------------------------------------- *)
11406
11407Theorem CLOSED_MAP_CLOSURES:
11408   !f:real->real.
11409  (!s. closed s ==> closed(IMAGE f s)) <=>
11410  (!s. closure(IMAGE f s) SUBSET IMAGE f (closure s))
11411Proof
11412  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
11413  [MATCH_MP_TAC CLOSURE_MINIMAL THEN
11414   ASM_SIMP_TAC std_ss [CLOSED_CLOSURE, CLOSURE_SUBSET, IMAGE_SUBSET],
11415   REWRITE_TAC[GSYM CLOSURE_SUBSET_EQ] THEN ASM_MESON_TAC[CLOSURE_CLOSED]]
11416QED
11417
11418Theorem OPEN_MAP_INTERIORS:
11419   !f:real->real.
11420  (!s. open s ==> open(IMAGE f s)) <=>
11421  (!s. IMAGE f (interior s) SUBSET interior(IMAGE f s))
11422Proof
11423  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
11424  [MATCH_MP_TAC INTERIOR_MAXIMAL THEN
11425  ASM_SIMP_TAC std_ss [OPEN_INTERIOR, INTERIOR_SUBSET, IMAGE_SUBSET],
11426  REWRITE_TAC[GSYM SUBSET_INTERIOR_EQ] THEN ASM_MESON_TAC[INTERIOR_OPEN]]
11427QED
11428
11429Theorem OPEN_MAP_RESTRICT:
11430   !f:real->real s t t'.
11431  (!u. open_in (subtopology euclidean s) u
11432  ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
11433      t' SUBSET t
11434     ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u
11435         ==> open_in (subtopology euclidean t') (IMAGE f u)
11436Proof
11437  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
11438  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, CONJ_EQ_IMP] THEN
11439  REPEAT DISCH_TAC THEN X_GEN_TAC ``c:real->bool`` THEN
11440  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``c:real->bool``) THEN
11441ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]
11442QED
11443
11444Theorem CLOSED_MAP_RESTRICT:
11445   !f:real->real s t t'.
11446  (!u. closed_in (subtopology euclidean s) u
11447  ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\
11448      t' SUBSET t
11449     ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u
11450     ==> closed_in (subtopology euclidean t') (IMAGE f u)
11451Proof
11452  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN
11453  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, CONJ_EQ_IMP] THEN
11454  REPEAT DISCH_TAC THEN X_GEN_TAC ``c:real->bool`` THEN
11455  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``c:real->bool``) THEN
11456  ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]
11457QED
11458
11459Theorem QUOTIENT_MAP_OPEN_MAP_EQ:
11460   !f:real->real s t.
11461  IMAGE f s SUBSET t /\
11462  (!u. u SUBSET t
11463  ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11464       open_in (subtopology euclidean t) u))
11465      ==> ((!k. open_in (subtopology euclidean s) k
11466            ==> open_in (subtopology euclidean t) (IMAGE f k)) <=>
11467               (!k. open_in (subtopology euclidean s) k
11468                ==> open_in (subtopology euclidean s)
11469                    {x | x IN s /\ f x IN IMAGE f k}))
11470Proof
11471  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
11472  X_GEN_TAC ``k:real->bool`` THEN STRIP_TAC THEN
11473  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
11474  UNDISCH_TAC ``!u. u SUBSET t ==>
11475        (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11476         open_in (subtopology euclidean t) u)`` THEN
11477  DISCH_TAC THEN
11478  FIRST_X_ASSUM(MP_TAC o SPEC ``IMAGE (f:real->real) k``) THEN
11479  ASM_SIMP_TAC std_ss [IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SET_TAC[]
11480QED
11481
11482Theorem QUOTIENT_MAP_CLOSED_MAP_EQ:
11483   !f:real->real s t.
11484   IMAGE f s SUBSET t /\
11485   (!u. u SUBSET t
11486   ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11487        open_in (subtopology euclidean t) u))
11488       ==> ((!k. closed_in (subtopology euclidean s) k
11489         ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
11490            (!k. closed_in (subtopology euclidean s) k
11491           ==> closed_in (subtopology euclidean s)
11492               {x | x IN s /\ f x IN IMAGE f k}))
11493Proof
11494  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11495  ASM_SIMP_TAC std_ss [QUOTIENT_MAP_OPEN_CLOSED] THEN
11496  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
11497  X_GEN_TAC ``k:real->bool`` THEN STRIP_TAC THEN
11498  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
11499  UNDISCH_TAC ``!u. u SUBSET t ==>
11500        (closed_in (subtopology euclidean s)
11501           {x | x IN s /\ f x IN u} <=>
11502         closed_in (subtopology euclidean t) u)`` THEN
11503  DISCH_TAC THEN
11504  FIRST_X_ASSUM(MP_TAC o SPEC ``IMAGE (f:real->real) k``) THEN
11505  ASM_SIMP_TAC std_ss [IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_SET_TAC[]
11506QED
11507
11508Theorem CLOSED_MAP_IMP_OPEN_MAP:
11509   !f:real->real s t.
11510  (IMAGE f s = t) /\
11511  (!u. closed_in (subtopology euclidean s) u
11512  ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\
11513      (!u. open_in (subtopology euclidean s) u
11514      ==> open_in (subtopology euclidean s)
11515          {x | x IN s /\ f x IN IMAGE f u})
11516          ==> (!u. open_in (subtopology euclidean s) u
11517            ==> open_in (subtopology euclidean t) (IMAGE f u))
11518Proof
11519  REPEAT STRIP_TAC THEN
11520  SUBGOAL_THEN
11521   ``IMAGE (f:real->real) u =
11522   t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})``
11523   SUBST1_TAC THENL
11524  [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM_SET_TAC[],
11525  MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
11526  FIRST_X_ASSUM MATCH_MP_TAC THEN
11527  MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
11528  ASM_SIMP_TAC std_ss [CLOSED_IN_REFL]]
11529QED
11530
11531Theorem OPEN_MAP_IMP_CLOSED_MAP:
11532   !f:real->real s t.
11533   (IMAGE f s = t) /\
11534   (!u. open_in (subtopology euclidean s) u
11535   ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
11536      (!u. closed_in (subtopology euclidean s) u
11537      ==> closed_in (subtopology euclidean s)
11538          {x | x IN s /\ f x IN IMAGE f u})
11539          ==> (!u. closed_in (subtopology euclidean s) u
11540            ==> closed_in (subtopology euclidean t) (IMAGE f u))
11541Proof
11542  REPEAT STRIP_TAC THEN
11543  SUBGOAL_THEN
11544  ``IMAGE (f:real->real) u =
11545    t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})``
11546   SUBST1_TAC THENL
11547  [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SET_TAC[],
11548  MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
11549  FIRST_X_ASSUM MATCH_MP_TAC THEN
11550  MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
11551  ASM_SIMP_TAC std_ss [OPEN_IN_REFL]]
11552QED
11553
11554Theorem OPEN_MAP_FROM_COMPOSITION_SURJECTIVE:
11555   !f:real->real g:real->real s t u.
11556   f continuous_on s /\ (IMAGE f s = t) /\ IMAGE g t SUBSET u /\
11557  (!k. open_in (subtopology euclidean s) k
11558  ==> open_in (subtopology euclidean u) (IMAGE (g o f) k))
11559    ==> (!k. open_in (subtopology euclidean t) k
11560      ==> open_in (subtopology euclidean u) (IMAGE g k))
11561Proof
11562  REPEAT STRIP_TAC THEN SUBGOAL_THEN
11563   ``IMAGE g k = IMAGE ((g:real->real) o (f:real->real))
11564     {x | x IN s /\ f(x) IN k}`` SUBST1_TAC THENL
11565  [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
11566   REWRITE_TAC[IMAGE_COMPOSE] THEN ASM_SET_TAC[],
11567  FIRST_X_ASSUM MATCH_MP_TAC THEN
11568  MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
11569  EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[SUBSET_REFL]]
11570QED
11571
11572Theorem CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE:
11573   !f:real->real g:real->real s t u.
11574    f continuous_on s /\ (IMAGE f s = t) /\ IMAGE g t SUBSET u /\
11575  (!k. closed_in (subtopology euclidean s) k
11576   ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k))
11577     ==> (!k. closed_in (subtopology euclidean t) k
11578       ==> closed_in (subtopology euclidean u) (IMAGE g k))
11579Proof
11580  REPEAT STRIP_TAC THEN SUBGOAL_THEN
11581   ``IMAGE g k = IMAGE ((g:real->real) o (f:real->real))
11582    {x | x IN s /\ f(x) IN k}`` SUBST1_TAC THENL
11583  [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
11584  REWRITE_TAC[IMAGE_COMPOSE] THEN ASM_SET_TAC[],
11585  FIRST_X_ASSUM MATCH_MP_TAC THEN
11586  MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
11587  EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[SUBSET_REFL]]
11588QED
11589
11590Theorem OPEN_MAP_FROM_COMPOSITION_INJECTIVE:
11591   !f:real->real g:real->real s t u.
11592  IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
11593  g continuous_on t /\ (!x y. x IN t /\ y IN t /\ (g x = g y) ==> (x = y)) /\
11594  (!k. open_in (subtopology euclidean s) k
11595   ==> open_in (subtopology euclidean u) (IMAGE (g o f) k))
11596     ==> (!k. open_in (subtopology euclidean s) k
11597       ==> open_in (subtopology euclidean t) (IMAGE f k))
11598Proof
11599  REPEAT STRIP_TAC THEN SUBGOAL_THEN
11600  ``IMAGE f k = {x | x IN t /\
11601     g(x) IN IMAGE ((g:real->real) o (f:real->real)) k}``
11602   SUBST1_TAC THENL
11603  [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
11604  REWRITE_TAC[IMAGE_COMPOSE] THEN ASM_SET_TAC[],
11605  MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
11606  EXISTS_TAC ``u:real->bool`` THEN ASM_SIMP_TAC std_ss []]
11607QED
11608
11609Theorem CLOSED_MAP_FROM_COMPOSITION_INJECTIVE:
11610   !f:real->real g:real->real s t u.
11611  IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
11612  g continuous_on t /\ (!x y. x IN t /\ y IN t /\ (g x = g y) ==> (x = y)) /\
11613  (!k. closed_in (subtopology euclidean s) k
11614  ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k))
11615    ==> (!k. closed_in (subtopology euclidean s) k
11616      ==> closed_in (subtopology euclidean t) (IMAGE f k))
11617Proof
11618  REPEAT STRIP_TAC THEN SUBGOAL_THEN
11619   ``IMAGE f k = {x | x IN t /\
11620     g(x) IN IMAGE ((g:real->real) o (f:real->real)) k}``
11621   SUBST1_TAC THENL
11622  [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
11623  REWRITE_TAC[IMAGE_COMPOSE] THEN ASM_SET_TAC[],
11624  MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
11625  EXISTS_TAC ``u:real->bool`` THEN ASM_SIMP_TAC std_ss []]
11626QED
11627
11628Theorem OPEN_MAP_CLOSED_SUPERSET_PREIMAGE:
11629   !f:real->real s t u w.
11630  (!k. open_in (subtopology euclidean s) k
11631   ==> open_in (subtopology euclidean t) (IMAGE f k)) /\
11632     closed_in (subtopology euclidean s) u /\
11633     w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
11634     ==> ?v. closed_in (subtopology euclidean t) v /\
11635          w SUBSET v /\
11636         {x | x IN s /\ f(x) IN v} SUBSET u
11637Proof
11638  REPEAT STRIP_TAC THEN
11639  EXISTS_TAC ``t DIFF IMAGE (f:real->real) (s DIFF u)`` THEN
11640  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
11641  MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
11642  FIRST_X_ASSUM MATCH_MP_TAC THEN
11643  ASM_SIMP_TAC std_ss [OPEN_IN_DIFF, OPEN_IN_REFL]
11644QED
11645
11646Theorem OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ:
11647   !f:real->real s t.
11648  IMAGE f s SUBSET t
11649    ==> ((!k. open_in (subtopology euclidean s) k
11650      ==> open_in (subtopology euclidean t) (IMAGE f k)) <=>
11651        (!u w. closed_in (subtopology euclidean s) u /\
11652        w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
11653        ==> ?v. closed_in (subtopology euclidean t) v /\
11654            w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))
11655Proof
11656  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
11657  ASM_SIMP_TAC std_ss [OPEN_MAP_CLOSED_SUPERSET_PREIMAGE] THEN
11658  FIRST_X_ASSUM(MP_TAC o SPECL
11659  [``s DIFF k:real->bool``, ``t DIFF IMAGE (f:real->real) k``]) THEN
11660  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
11661  ASM_SIMP_TAC std_ss [CLOSED_IN_DIFF, CLOSED_IN_REFL] THEN
11662  KNOW_TAC ``t DIFF IMAGE (f:real->real) k SUBSET t /\
11663     {x | x IN s /\ f x IN t DIFF IMAGE (f:real->real) k} SUBSET s DIFF k`` THENL
11664  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
11665  DISCH_THEN(X_CHOOSE_THEN ``v:real->bool`` STRIP_ASSUME_TAC) THEN
11666  SUBGOAL_THEN ``IMAGE (f:real->real) k = t DIFF v`` SUBST1_TAC THENL
11667  [ASM_SET_TAC[], ASM_SIMP_TAC std_ss [OPEN_IN_DIFF, OPEN_IN_REFL]]
11668QED
11669
11670Theorem CLOSED_MAP_OPEN_SUPERSET_PREIMAGE:
11671   !f:real->real s t u w.
11672  (!k. closed_in (subtopology euclidean s) k
11673   ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
11674         open_in (subtopology euclidean s) u /\
11675        w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
11676       ==> ?v. open_in (subtopology euclidean t) v /\
11677          w SUBSET v /\
11678         {x | x IN s /\ f(x) IN v} SUBSET u
11679Proof
11680  REPEAT STRIP_TAC THEN
11681  EXISTS_TAC ``t DIFF IMAGE (f:real->real) (s DIFF u)`` THEN
11682  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
11683  MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
11684  FIRST_X_ASSUM MATCH_MP_TAC THEN
11685  ASM_SIMP_TAC std_ss [CLOSED_IN_DIFF, CLOSED_IN_REFL]
11686QED
11687
11688Theorem CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ:
11689   !f:real->real s t.
11690  IMAGE f s SUBSET t
11691  ==> ((!k. closed_in (subtopology euclidean s) k
11692    ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
11693       (!u w. open_in (subtopology euclidean s) u /\
11694       w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
11695       ==> ?v. open_in (subtopology euclidean t) v /\
11696           w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))
11697Proof
11698  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
11699  ASM_SIMP_TAC std_ss [CLOSED_MAP_OPEN_SUPERSET_PREIMAGE] THEN
11700  FIRST_X_ASSUM(MP_TAC o SPECL
11701  [``s DIFF k:real->bool``, ``t DIFF IMAGE (f:real->real) k``]) THEN
11702  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
11703  ASM_SIMP_TAC std_ss [OPEN_IN_DIFF, OPEN_IN_REFL] THEN
11704  KNOW_TAC ``t DIFF IMAGE (f:real->real) k SUBSET t /\
11705     {x | x IN s /\ f x IN t DIFF IMAGE (f:real->real) k} SUBSET s DIFF k`` THENL
11706  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
11707  DISCH_THEN(X_CHOOSE_THEN ``v:real->bool`` STRIP_ASSUME_TAC) THEN
11708  SUBGOAL_THEN ``IMAGE (f:real->real) k = t DIFF v`` SUBST1_TAC THENL
11709  [ASM_SET_TAC[], ASM_SIMP_TAC std_ss [CLOSED_IN_DIFF, CLOSED_IN_REFL]]
11710QED
11711
11712Theorem CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT:
11713   !f:real->real s t.
11714  IMAGE f s SUBSET t
11715  ==> ((!k. closed_in (subtopology euclidean s) k
11716    ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
11717   (!u y. open_in (subtopology euclidean s) u /\
11718     y IN t /\ {x | x IN s /\ (f(x) = y)} SUBSET u
11719  ==> ?v. open_in (subtopology euclidean t) v /\
11720     y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))
11721Proof
11722  REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ] THEN
11723  EQ_TAC THEN DISCH_TAC THENL
11724  [MAP_EVERY X_GEN_TAC [``u:real->bool``, ``y:real``] THEN
11725  STRIP_TAC THEN
11726  FIRST_X_ASSUM(MP_TAC o SPECL [``u:real->bool``, ``{y:real}``]) THEN
11727  ASM_REWRITE_TAC[SING_SUBSET, IN_SING],
11728  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``w:real->bool``] THEN
11729  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``u:real->bool``) THEN
11730  KNOW_TAC ``(!y. ?v. open_in (subtopology euclidean s) u /\
11731          y IN t /\ {x | x IN s /\ (f x = y)} SUBSET u
11732          ==> open_in (subtopology euclidean t) v /\
11733              y IN v /\ {x | x IN s /\ f x IN v} SUBSET u)
11734     ==> (?v. open_in (subtopology euclidean t) v /\
11735          w SUBSET v /\ {x | x IN s /\ f x IN v} SUBSET u)`` THENL
11736  [ALL_TAC, METIS_TAC [GSYM RIGHT_EXISTS_IMP_THM]] THEN
11737  SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
11738  X_GEN_TAC ``vv:real->real->bool`` THEN DISCH_TAC THEN
11739  EXISTS_TAC ``BIGUNION {(vv:real->real->bool) y | y IN w}`` THEN
11740  CONJ_TAC THENL
11741  [MATCH_MP_TAC OPEN_IN_BIGUNION THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
11742   ASM_SET_TAC[],
11743   SIMP_TAC std_ss [BIGUNION_GSPEC] THEN
11744   CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
11745   SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, GSYM RIGHT_EXISTS_AND_THM,
11746    LEFT_IMP_EXISTS_THM] THEN
11747   MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
11748   FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN ASM_SET_TAC[]]]
11749QED
11750
11751Theorem CONNECTED_OPEN_MONOTONE_PREIMAGE:
11752   !f:real->real s t.
11753    f continuous_on s /\ (IMAGE f s = t) /\
11754  (!c. open_in (subtopology euclidean s) c
11755   ==> open_in (subtopology euclidean t) (IMAGE f c)) /\
11756      (!y. y IN t ==> connected {x | x IN s /\ (f x = y)})
11757       ==> !c. connected c /\ c SUBSET t
11758         ==> connected {x | x IN s /\ f x IN c}
11759Proof
11760  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC ``c:real->bool`` o MATCH_MP
11761   (ONCE_REWRITE_RULE[CONJ_EQ_IMP] OPEN_MAP_RESTRICT)) THEN
11762  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL
11763   [``f:real->real``, ``{x | x IN s /\ (f:real->real) x IN c}``]
11764   OPEN_MAP_IMP_QUOTIENT_MAP) THEN
11765  SUBGOAL_THEN ``IMAGE f {x | x IN s /\ (f:real->real) x IN c} = c``
11766   ASSUME_TAC THENL [ASM_SET_TAC[], ASM_REWRITE_TAC[]] THEN
11767  KNOW_TAC ``(f:real->real) continuous_on {x | x IN s /\ f x IN c}`` THENL
11768  [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
11769   CONTINUOUS_ON_SUBSET)) THEN SET_TAC[],
11770   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_TAC] THEN
11771  MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN
11772  MAP_EVERY EXISTS_TAC [``f:real->real``, ``c:real->bool``] THEN
11773  ASM_REWRITE_TAC[] THEN
11774  SIMP_TAC std_ss [SET_RULE
11775   ``y IN c ==> ({x | x IN {x | x IN s /\ f x IN c} /\ (f x = y)} =
11776                 {x | x IN s /\ (f x = y)})``] THEN
11777  ASM_SET_TAC[]
11778QED
11779
11780Theorem CONNECTED_CLOSED_MONOTONE_PREIMAGE:
11781   !f:real->real s t.
11782    f continuous_on s /\ (IMAGE f s = t) /\
11783   (!c. closed_in (subtopology euclidean s) c
11784   ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
11785      (!y. y IN t ==> connected {x | x IN s /\ (f x = y)})
11786      ==> !c. connected c /\ c SUBSET t
11787        ==> connected {x | x IN s /\ f x IN c}
11788Proof
11789  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC ``c:real->bool`` o MATCH_MP
11790   (ONCE_REWRITE_RULE[CONJ_EQ_IMP] CLOSED_MAP_RESTRICT)) THEN
11791  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL
11792   [``f:real->real``, ``{x | x IN s /\ (f:real->real) x IN c}``]
11793    CLOSED_MAP_IMP_QUOTIENT_MAP) THEN
11794  SUBGOAL_THEN ``IMAGE f {x | x IN s /\ (f:real->real) x IN c} = c``
11795   ASSUME_TAC THENL [ASM_SET_TAC[], ASM_REWRITE_TAC[]] THEN
11796  KNOW_TAC ``(f:real->real) continuous_on {x | x IN s /\ f x IN c}`` THENL
11797  [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
11798   CONTINUOUS_ON_SUBSET)) THEN SET_TAC[],
11799   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_TAC] THEN
11800  MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN
11801  MAP_EVERY EXISTS_TAC [``f:real->real``, ``c:real->bool``] THEN
11802  ASM_REWRITE_TAC[] THEN
11803  SIMP_TAC std_ss [SET_RULE
11804   ``y IN c ==> ({x | x IN {x | x IN s /\ f x IN c} /\ (f x = y)} =
11805                 {x | x IN s /\ (f x = y)})``] THEN
11806  ASM_SET_TAC[]
11807QED
11808
11809(* ------------------------------------------------------------------------- *)
11810(* Proper maps, including projections out of compact sets.                   *)
11811(* ------------------------------------------------------------------------- *)
11812
11813Theorem PROPER_MAP:
11814   !f:real->real s t.
11815  IMAGE f s SUBSET t
11816  ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=>
11817       (!k. closed_in (subtopology euclidean s) k
11818        ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
11819            (!a. a IN t ==> compact {x | x IN s /\ (f x = a)}))
11820Proof
11821  REPEAT STRIP_TAC THEN EQ_TAC THENL
11822  [REPEAT STRIP_TAC THENL
11823   [ALL_TAC,
11824    ONCE_REWRITE_TAC[SET_RULE ``(x = a) <=> x IN {a}``] THEN
11825    FIRST_X_ASSUM MATCH_MP_TAC THEN
11826    ASM_REWRITE_TAC[SING_SUBSET, COMPACT_SING]] THEN
11827   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
11828   REWRITE_TAC[CLOSED_IN_LIMPT] THEN
11829   CONJ_TAC THENL [ASM_SET_TAC[], X_GEN_TAC ``y:real``] THEN
11830   REWRITE_TAC[LIMPT_SEQUENTIAL_INJ, IN_DELETE] THEN
11831   SIMP_TAC std_ss [IN_IMAGE, GSYM LEFT_EXISTS_AND_THM, SKOLEM_THM] THEN
11832   KNOW_TAC ``(?(x :num -> real) (f' :num -> real).
11833   ((!(n :num).
11834       ((f' n = (f :real -> real) (x n)) /\
11835        x n IN (k :real -> bool)) /\ f' n <> (y :real)) /\
11836    (!(m :num) (n :num). (f' m = f' n) <=> (m = n)) /\
11837    ((f' --> y) sequentially :bool)) /\ y IN (t :real -> bool)) ==>
11838     ?(x :real). (y = f x) /\ x IN k`` THENL
11839   [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
11840   SIMP_TAC std_ss [GSYM CONJ_ASSOC, FORALL_AND_THM] THEN
11841   SIMP_TAC std_ss [GSYM FUN_EQ_THM] THEN
11842   SIMP_TAC std_ss [UNWIND_THM2, FUN_EQ_THM] THEN
11843   DISCH_THEN(X_CHOOSE_THEN ``x:num->real`` STRIP_ASSUME_TAC) THEN
11844   SUBGOAL_THEN
11845   ``~(BIGINTER {{a | a IN k /\ (f:real->real) a IN
11846      (y INSERT IMAGE (\i. f(x(n + i))) univ(:num))} | n IN univ(:num)} = {})``
11847   MP_TAC THENL
11848   [MATCH_MP_TAC COMPACT_FIP THEN CONJ_TAC THENL
11849    [SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV] THEN X_GEN_TAC ``n:num`` THEN
11850     UNDISCH_TAC ``closed_in (subtopology euclidean s) k`` THEN DISCH_TAC THEN
11851     FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [CLOSED_IN_CLOSED]) THEN
11852     DISCH_THEN(X_CHOOSE_THEN ``c:real->bool`` STRIP_ASSUME_TAC) THEN
11853     ONCE_REWRITE_TAC [METIS [] ``f a IN s <=> (\a. f a IN s) a``] THEN
11854     ASM_REWRITE_TAC[SET_RULE
11855     ``{x | x IN s INTER k /\ P x} = k INTER {x | x IN s /\ P x}``] THEN
11856     MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
11857     BETA_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11858     CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
11859     MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN
11860     UNDISCH_TAC ``((\n. f ((x:num->real) n)) --> y) sequentially`` THEN DISCH_TAC THEN
11861     FIRST_ASSUM(MP_TAC o SPEC ``n:num`` o MATCH_MP SEQ_OFFSET) THEN
11862     BETA_TAC THEN GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN
11863     SIMP_TAC std_ss [],
11864     SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_FINITE_SUBSET_IMAGE] THEN
11865     X_GEN_TAC ``i:num->bool`` THEN STRIP_TAC THEN
11866     UNDISCH_TAC ``FINITE (i:num->bool)`` THEN DISCH_TAC THEN
11867     FIRST_ASSUM(MP_TAC o ISPEC ``\n:num. n`` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
11868     SIMP_TAC std_ss [] THEN DISCH_THEN(X_CHOOSE_TAC ``m:num``) THEN
11869     SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, BIGINTER_IMAGE, GSPECIFICATION] THEN
11870     EXISTS_TAC ``(x:num->real) m`` THEN
11871     X_GEN_TAC ``p:num`` THEN DISCH_TAC THEN
11872     CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
11873     REWRITE_TAC[IN_INSERT, IN_IMAGE, IN_UNIV] THEN DISJ2_TAC THEN
11874     EXISTS_TAC ``m - p:num`` THEN BETA_TAC THEN
11875     UNDISCH_TAC ``!x:num. x IN i ==> x <= m`` THEN DISCH_THEN (MP_TAC o SPEC ``p:num``) THEN
11876     ASM_REWRITE_TAC [] THEN ARITH_TAC],
11877     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
11878     DISCH_THEN (X_CHOOSE_TAC ``x:real``) THEN EXISTS_TAC ``x:real`` THEN
11879     POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [BIGINTER_GSPEC, GSPECIFICATION, IN_UNIV] THEN
11880     DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC ``0:num``) THEN
11881     SIMP_TAC std_ss [ADD_CLAUSES, IN_INSERT, IN_IMAGE, IN_UNIV] THEN
11882     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN MP_TAC)) THEN
11883     ASM_SIMP_TAC std_ss [] THEN DISCH_THEN(X_CHOOSE_TAC ``i:num``) THEN
11884     FIRST_X_ASSUM (MP_TAC o SPEC ``i + 1:num``) THEN
11885     ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN DISCH_TAC THEN
11886     ASM_SIMP_TAC std_ss [IN_INSERT, IN_IMAGE, IN_UNIV] THEN ARITH_TAC],
11887   STRIP_TAC THEN X_GEN_TAC ``k:real->bool`` THEN STRIP_TAC THEN
11888   REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN
11889   X_GEN_TAC ``c:(real->bool)->bool`` THEN STRIP_TAC THEN
11890   SUBGOAL_THEN
11891   ``!a. a IN k
11892   ==> ?g. g SUBSET c /\ FINITE g /\
11893    {x | x IN s /\ ((f:real->real) x = a)} SUBSET BIGUNION g``
11894   MP_TAC THENL
11895   [X_GEN_TAC ``a:real`` THEN DISCH_TAC THEN UNDISCH_THEN
11896    ``!a. a IN t ==> compact {x | x IN s /\ ((f:real->real) x = a)}``
11897    (MP_TAC o SPEC ``a:real``) THEN
11898    KNOW_TAC ``(a :real) IN (t :real -> bool)`` THENL
11899    [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
11900     POP_ASSUM K_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL]] THEN
11901     DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SET_TAC[],
11902   DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
11903   SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
11904   X_GEN_TAC ``uu:real->(real->bool)->bool`` THEN DISCH_TAC] THEN
11905  SUBGOAL_THEN
11906  ``!a. a IN k ==> ?v. open v /\ a IN v /\
11907   {x | x IN s /\ (f:real->real) x IN v} SUBSET BIGUNION(uu a)``
11908   MP_TAC THENL
11909  [REPEAT STRIP_TAC THEN
11910   UNDISCH_THEN
11911   ``!k. closed_in (subtopology euclidean s) k
11912     ==> closed_in (subtopology euclidean t) (IMAGE (f:real->real) k)``
11913    (MP_TAC o SPEC ``(s:real->bool) DIFF BIGUNION(uu(a:real))``) THEN
11914   SIMP_TAC std_ss [closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
11915   KNOW_TAC ``(s :real -> bool) DIFF
11916    BIGUNION ((uu :real -> (real -> bool) -> bool) (a :real)) SUBSET s /\
11917     open_in (subtopology euclidean s) (s DIFF (s DIFF BIGUNION (uu a)))`` THENL
11918   [CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
11919    REWRITE_TAC[SET_RULE ``s DIFF (s DIFF t) = s INTER t``] THEN
11920    MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
11921    MATCH_MP_TAC OPEN_BIGUNION THEN ASM_SET_TAC[],
11922    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
11923    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11924    REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN (X_CHOOSE_TAC ``v:real->bool``) THEN
11925    EXISTS_TAC ``v:real->bool`` THEN POP_ASSUM MP_TAC THEN
11926    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11927    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC ``a:real``)) THEN
11928    ASM_REWRITE_TAC[] THEN
11929    KNOW_TAC ``a IN t:real->bool`` THENL [ASM_SET_TAC[],
11930     DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN DISCH_TAC] THEN
11931    STRIP_TAC THEN ASM_SET_TAC[]],
11932   DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
11933   SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
11934   X_GEN_TAC ``vv:real->(real->bool)`` THEN DISCH_TAC] THEN
11935  UNDISCH_TAC ``compact k`` THEN DISCH_TAC THEN
11936  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [COMPACT_EQ_HEINE_BOREL]) THEN
11937  DISCH_THEN(MP_TAC o SPEC ``IMAGE (vv:real->(real->bool)) k``) THEN
11938  KNOW_TAC ``(!(t :real -> bool).
11939    t IN IMAGE (vv :real -> real -> bool) (k :real -> bool) ==>
11940    (open t :bool)) /\ k SUBSET BIGUNION (IMAGE vv k)`` THENL
11941  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
11942   POP_ASSUM K_TAC THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM]] THEN
11943  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN
11944  SIMP_TAC real_ss [FORALL_FINITE_SUBSET_IMAGE] THEN
11945  X_GEN_TAC ``j:real->bool`` THEN REPEAT STRIP_TAC THEN
11946  EXISTS_TAC ``BIGUNION (IMAGE (uu:real->(real->bool)->bool) j)`` THEN
11947  REPEAT CONJ_TAC THENL
11948  [ASM_SET_TAC[],
11949   ASM_SIMP_TAC std_ss [FINITE_BIGUNION_EQ, FORALL_IN_IMAGE, IMAGE_FINITE] THEN
11950   ASM_SET_TAC[],
11951   SIMP_TAC std_ss [BIGUNION_IMAGE, SUBSET_DEF, IN_BIGUNION, GSPECIFICATION] THEN
11952   ASM_SET_TAC[]]]
11953QED
11954
11955Theorem COMPACT_CONTINUOUS_IMAGE_EQ:
11956   !f:real->real s.
11957   (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
11958   ==> (f continuous_on s <=>
11959   !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))
11960Proof
11961  REPEAT STRIP_TAC THEN EQ_TAC THENL
11962  [MESON_TAC[COMPACT_CONTINUOUS_IMAGE, CONTINUOUS_ON_SUBSET], DISCH_TAC] THEN
11963   FIRST_X_ASSUM(X_CHOOSE_TAC ``g:real->real`` o
11964   SIMP_RULE std_ss [INJECTIVE_ON_LEFT_INVERSE]) THEN
11965   REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN
11966   X_GEN_TAC ``u:real->bool`` THEN DISCH_TAC THEN
11967   MP_TAC(ISPECL [``g:real->real``, ``IMAGE (f:real->real) s``,
11968    ``s:real->bool``] PROPER_MAP) THEN
11969  KNOW_TAC ``IMAGE (g :real -> real)
11970   (IMAGE (f :real -> real) (s :real -> bool)) SUBSET s`` THENL
11971  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
11972   POP_ASSUM K_TAC] THEN
11973  MATCH_MP_TAC(TAUT `(q ==> s) /\ p ==> (p <=> q /\ r) ==> s`) THEN
11974  REPEAT STRIP_TAC THENL
11975  [SUBGOAL_THEN
11976   ``{x | x IN s /\ (f:real->real) x IN u} = IMAGE g u``
11977   (fn th => ASM_MESON_TAC[th]),
11978   SUBGOAL_THEN
11979   ``{x | x IN IMAGE f s /\ (g:real->real) x IN k} = IMAGE f k``
11980   (fn th => ASM_SIMP_TAC std_ss [th])] THEN
11981  UNDISCH_TAC `` closed_in
11982        (subtopology euclidean
11983           (IMAGE (f :real -> real) (s :real -> bool)))
11984        (u :real -> bool)`` THEN DISCH_TAC THEN
11985  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM_SET_TAC[]
11986QED
11987
11988Theorem PROPER_MAP_FROM_COMPACT:
11989   !f:real->real s k.
11990   f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\
11991   closed_in (subtopology euclidean t) k
11992   ==> compact {x | x IN s /\ f x IN k}
11993Proof
11994   REPEAT STRIP_TAC THEN
11995   MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC ``s:real->bool`` THEN
11996   METIS_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]
11997QED
11998
11999Theorem PROPER_MAP_COMPOSE:
12000   !f:real->real g:real->real s t u.
12001   IMAGE f s SUBSET t /\
12002   (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
12003   (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k})
12004   ==> !k. k SUBSET u /\ compact k
12005   ==> compact {x | x IN s /\ (g o f) x IN k}
12006Proof
12007  REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
12008  FIRST_X_ASSUM(MP_TAC o SPEC ``k:real->bool``) THEN
12009  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
12010  FIRST_X_ASSUM(MP_TAC o SPEC ``{x | x IN t /\ (g:real->real) x IN k}``) THEN
12011  KNOW_TAC ``{x | x IN (t :real -> bool) /\
12012   (g :real -> real) x IN (k :real -> bool)} SUBSET t /\
12013    compact {x | x IN t /\ g x IN k}`` THENL
12014  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12015   POP_ASSUM K_TAC THEN MATCH_MP_TAC EQ_IMPLIES] THEN
12016  AP_TERM_TAC THEN ASM_SET_TAC[]
12017QED
12018
12019Theorem PROPER_MAP_FROM_COMPOSITION_LEFT:
12020   !f:real->real g:real->real s t u.
12021    f continuous_on s /\ (IMAGE f s = t) /\
12022    g continuous_on t /\ IMAGE g t SUBSET u /\
12023    (!k. k SUBSET u /\ compact k
12024   ==> compact {x | x IN s /\ (g o f) x IN k})
12025   ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}
12026Proof
12027  REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN
12028  FIRST_X_ASSUM(MP_TAC o SPEC ``k:real->bool``) THEN ASM_REWRITE_TAC[] THEN
12029  DISCH_THEN(MP_TAC o ISPEC ``f:real->real`` o MATCH_MP
12030  (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN
12031  KNOW_TAC ``(f :real -> real) continuous_on
12032   {x | x IN (s :real -> bool) /\
12033   (g :real -> real) (f x) IN (k :real -> bool)} `` THENL
12034  [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
12035  CONTINUOUS_ON_SUBSET)) THEN SET_TAC[],
12036  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
12037  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]]
12038QED
12039
12040Theorem lemma[local]:
12041   !s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t
12042Proof
12043  MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_SUBSET, CLOSED_IN_CLOSED_EQ]
12044QED
12045
12046Theorem PROPER_MAP_FROM_COMPOSITION_RIGHT:
12047   !f:real->real g:real->real s t u.
12048    f continuous_on s /\ IMAGE f s SUBSET t /\
12049    g continuous_on t /\ IMAGE g t SUBSET u /\
12050   (!k. k SUBSET u /\ compact k
12051   ==> compact {x | x IN s /\ (g o f) x IN k})
12052   ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}
12053Proof
12054  REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN
12055  FIRST_X_ASSUM(MP_TAC o SPEC ``IMAGE (g:real->real) k``) THEN
12056  KNOW_TAC ``IMAGE (g :real -> real) (k :real -> bool) SUBSET (u :real -> bool) /\
12057   compact (IMAGE g k)`` THENL
12058  [CONJ_TAC THENL [ASM_SET_TAC[], MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN
12059   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET],
12060   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
12061   MATCH_MP_TAC lemma THEN
12062   MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
12063   EXISTS_TAC ``s:real->bool`` THEN
12064   CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
12065  MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
12066  EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[] THEN
12067  MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED]]
12068QED
12069
12070(* ------------------------------------------------------------------------- *)
12071(* Pasting functions together on open sets.                                  *)
12072(* ------------------------------------------------------------------------- *)
12073
12074Theorem PASTING_LEMMA:
12075   !f:'a->real->real g t s k.
12076        (!i. i IN k
12077             ==> open_in (subtopology euclidean s) (t i) /\
12078                 (f i) continuous_on (t i)) /\
12079        (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
12080                 ==> (f i x = f j x)) /\
12081        (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ (g x = f j x))
12082        ==> g continuous_on s
12083Proof
12084  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
12085  STRIP_TAC THEN X_GEN_TAC ``u:real->bool`` THEN DISCH_TAC THEN
12086  SUBGOAL_THEN
12087   ``{x | x IN s /\ g x IN u} =
12088     BIGUNION {{x | x IN (t i) /\ ((f:'a->real->real) i x) IN u} |
12089            i IN k}``
12090  SUBST1_TAC THENL
12091   [SUBGOAL_THEN ``!i. i IN k ==> ((t:'a->real->bool) i) SUBSET s``
12092    ASSUME_TAC THENL
12093     [ASM_MESON_TAC[OPEN_IN_SUBSET, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY],
12094      SIMP_TAC std_ss [BIGUNION_GSPEC] THEN ASM_SET_TAC[]],
12095    MATCH_MP_TAC OPEN_IN_BIGUNION THEN SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
12096    METIS_TAC[OPEN_IN_TRANS]]
12097QED
12098
12099Theorem PASTING_LEMMA_EXISTS:
12100   !f:'a->real->real t s k.
12101        s SUBSET BIGUNION {t i | i IN k} /\
12102        (!i. i IN k
12103             ==> open_in (subtopology euclidean s) (t i) /\
12104                 (f i) continuous_on (t i)) /\
12105        (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
12106                 ==> (f i x = f j x))
12107        ==> ?g. g continuous_on s /\
12108                (!x i. i IN k /\ x IN s INTER t i ==> (g x = f i x))
12109Proof
12110  REPEAT STRIP_TAC THEN
12111  EXISTS_TAC ``\x. (f:'a->real->real)(@i. i IN k /\ x IN t i) x`` THEN
12112  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA THEN
12113  MAP_EVERY EXISTS_TAC
12114   [``f:'a->real->real``, ``t:'a->real->bool``, ``k:'a->bool``] THEN
12115  ASM_SET_TAC[]
12116QED
12117
12118Theorem CONTINUOUS_ON_UNION_LOCAL_OPEN:
12119   !f:real->real s.
12120        open_in (subtopology euclidean (s UNION t)) s /\
12121        open_in (subtopology euclidean (s UNION t)) t /\
12122        f continuous_on s /\ f continuous_on t
12123        ==> f continuous_on (s UNION t)
12124Proof
12125  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
12126   [``(\i:(real->bool). (f:real->real))``, ``f:real->real``,
12127    ``(\i:(real->bool). i)``, ``s UNION (t:real->bool)``, ``{s:real->bool;t}``]
12128   PASTING_LEMMA) THEN DISCH_THEN MATCH_MP_TAC THEN
12129  ASM_SIMP_TAC std_ss [FORALL_IN_INSERT, EXISTS_IN_INSERT, NOT_IN_EMPTY] THEN
12130  REWRITE_TAC[IN_UNION]
12131QED
12132
12133Theorem CONTINUOUS_ON_UNION_OPEN:
12134   !f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t
12135           ==> f continuous_on (s UNION t)
12136Proof
12137  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN
12138  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN
12139  ASM_SIMP_TAC std_ss [OPEN_UNION] THEN SET_TAC[]
12140QED
12141
12142Theorem CONTINUOUS_ON_CASES_LOCAL_OPEN:
12143   !P f g:real->real s t.
12144        open_in (subtopology euclidean (s UNION t)) s /\
12145        open_in (subtopology euclidean (s UNION t)) t /\
12146        f continuous_on s /\ g continuous_on t /\
12147        (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> (f x = g x))
12148        ==> (\x. if P x then f x else g x) continuous_on (s UNION t)
12149Proof
12150  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN
12151  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
12152   [EXISTS_TAC ``f:real->real``, EXISTS_TAC ``g:real->real``] THEN
12153  ASM_SIMP_TAC std_ss [] THEN METIS_TAC[]
12154QED
12155
12156Theorem CONTINUOUS_ON_CASES_OPEN:
12157   !P f g s t.
12158           open s /\
12159           open t /\
12160           f continuous_on s /\
12161           g continuous_on t /\
12162           (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> (f x = g x))
12163           ==> (\x. if P x then f x else g x) continuous_on s UNION t
12164Proof
12165  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
12166  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN
12167  ASM_SIMP_TAC std_ss [OPEN_UNION] THEN SET_TAC[]
12168QED
12169
12170(* ------------------------------------------------------------------------- *)
12171(* Likewise on closed sets, with a finiteness assumption.                    *)
12172(* ------------------------------------------------------------------------- *)
12173
12174Theorem PASTING_LEMMA_CLOSED:
12175   !f:'a->real->real g t s k.
12176        FINITE k /\
12177        (!i. i IN k
12178             ==> closed_in (subtopology euclidean s) (t i) /\
12179                 (f i) continuous_on (t i)) /\
12180        (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
12181                 ==> (f i x = f j x)) /\
12182        (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ (g x = f j x))
12183        ==> g continuous_on s
12184Proof
12185  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
12186  STRIP_TAC THEN X_GEN_TAC ``u:real->bool`` THEN DISCH_TAC THEN
12187  SUBGOAL_THEN
12188   ``{x | x IN s /\ g x IN u} =
12189     BIGUNION {{x | x IN (t i) /\ ((f:'a->real->real) i x) IN u} |
12190            i IN k}``
12191  SUBST1_TAC THENL
12192   [SUBGOAL_THEN ``!i. i IN k ==> ((t:'a->real->bool) i) SUBSET s``
12193    ASSUME_TAC THENL
12194     [ASM_MESON_TAC[CLOSED_IN_SUBSET, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY],
12195      SIMP_TAC std_ss [BIGUNION_GSPEC] THEN ASM_SET_TAC[]],
12196    MATCH_MP_TAC CLOSED_IN_BIGUNION THEN
12197    ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, IMAGE_FINITE, FORALL_IN_IMAGE] THEN
12198    METIS_TAC[CLOSED_IN_TRANS]]
12199QED
12200
12201Theorem PASTING_LEMMA_EXISTS_CLOSED:
12202   !f:'a->real->real t s k.
12203        FINITE k /\
12204        s SUBSET BIGUNION {t i | i IN k} /\
12205        (!i. i IN k
12206             ==> closed_in (subtopology euclidean s) (t i) /\
12207                 (f i) continuous_on (t i)) /\
12208        (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
12209                 ==> (f i x = f j x))
12210        ==> ?g. g continuous_on s /\
12211                (!x i. i IN k /\ x IN s INTER t i ==> (g x = f i x))
12212Proof
12213  REPEAT STRIP_TAC THEN
12214  EXISTS_TAC ``\x. (f:'a->real->real)(@i. i IN k /\ x IN t i) x`` THEN
12215  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
12216  MATCH_MP_TAC PASTING_LEMMA_CLOSED THEN
12217  MAP_EVERY EXISTS_TAC
12218   [``f:'a->real->real``, ``t:'a->real->bool``, ``k:'a->bool``] THEN
12219  ASM_SET_TAC[]
12220QED
12221
12222(* ------------------------------------------------------------------------- *)
12223(* Closure of halflines, halfspaces and hyperplanes.                         *)
12224(* ------------------------------------------------------------------------- *)
12225
12226Theorem LIM_LIFT_DOT:
12227   !f:real->real a.
12228        (f --> l) net ==> ((\y. a * f(y)) --> (a * l)) net
12229Proof
12230  METIS_TAC [LIM_CMUL]
12231QED
12232
12233Theorem CONTINUOUS_AT_LIFT_DOT:
12234   !a:real x. (\y. a * y) continuous at x
12235Proof
12236  REPEAT GEN_TAC THEN SIMP_TAC std_ss [CONTINUOUS_AT, o_THM] THEN
12237  KNOW_TAC ``((\y. a * (\y. y) y:real) --> (a * x)) (at x)`` THENL
12238  [ALL_TAC, SIMP_TAC std_ss []] THEN
12239  MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN METIS_TAC[]
12240QED
12241
12242Theorem CONTINUOUS_ON_LIFT_DOT:
12243   !s. (\y. a * y) continuous_on s
12244Proof
12245  SIMP_TAC std_ss [CONTINUOUS_AT_IMP_CONTINUOUS_ON, CONTINUOUS_AT_LIFT_DOT]
12246QED
12247
12248Theorem CLOSED_INTERVAL_LEFT:
12249   !b:real.
12250     closed {x:real | x <= b}
12251Proof
12252  SIMP_TAC std_ss [CLOSED_LIMPT, LIMPT_APPROACHABLE, GSPECIFICATION] THEN
12253  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
12254  FIRST_X_ASSUM(MP_TAC o SPEC ``(x:real) - (b:real)``) THEN
12255  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
12256  DISCH_THEN(X_CHOOSE_THEN ``z:real`` MP_TAC) THEN
12257  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12258  REWRITE_TAC[dist] THEN ASM_REAL_ARITH_TAC
12259QED
12260
12261Theorem CLOSED_INTERVAL_RIGHT:
12262   !a:real.
12263     closed {x:real | a <= x}
12264Proof
12265  SIMP_TAC std_ss [CLOSED_LIMPT, LIMPT_APPROACHABLE, GSPECIFICATION] THEN
12266  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
12267  FIRST_X_ASSUM(MP_TAC o SPEC ``(a:real) - (x:real)``) THEN
12268  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
12269  DISCH_THEN(X_CHOOSE_THEN ``z:real`` MP_TAC) THEN
12270  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12271  REWRITE_TAC[dist] THEN ASM_REAL_ARITH_TAC
12272QED
12273
12274Theorem CLOSED_HALFSPACE_LE:
12275   !a:real b. closed {x | a * x <= b}
12276Proof
12277  REPEAT GEN_TAC THEN
12278  MP_TAC(ISPEC ``univ(:real)`` CONTINUOUS_ON_LIFT_DOT) THEN
12279  SIMP_TAC std_ss [CONTINUOUS_ON_CLOSED, GSYM CLOSED_IN, SUBTOPOLOGY_UNIV] THEN
12280  DISCH_THEN(MP_TAC o SPEC
12281   ``IMAGE (\x. x) {r | ?x:real. (a * x = r) /\ r <= b}``) THEN
12282   KNOW_TAC ``closed_in (subtopology euclidean (IMAGE (\y. a * y) univ(:real)))
12283             (IMAGE (\x. x) {r | ?x. (a * x = r) /\ r <= b})`` THENL
12284   [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12285    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN
12286    SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE, IN_UNIV] THEN
12287    METIS_TAC []] THEN
12288  REWRITE_TAC[CLOSED_IN_CLOSED] THEN
12289  EXISTS_TAC ``{x | (x:real) <= (b)}`` THEN
12290  SIMP_TAC std_ss [CLOSED_INTERVAL_LEFT] THEN
12291  SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_UNIV, GSPECIFICATION, IN_INTER] THEN
12292  METIS_TAC []
12293QED
12294
12295Theorem CLOSED_HALFSPACE_GE:
12296   !a:real b. closed {x | a * x >= b}
12297Proof
12298  REWRITE_TAC[REAL_ARITH ``a >= b <=> -a <= -b:real``] THEN
12299  REWRITE_TAC[GSYM REAL_MUL_LNEG, CLOSED_HALFSPACE_LE]
12300QED
12301
12302Theorem CLOSED_HYPERPLANE:
12303   !a b. closed {x | a * x = b}
12304Proof
12305  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
12306  REWRITE_TAC[REAL_ARITH ``b <= a * x <=> a * x >= b:real``] THEN
12307  REWRITE_TAC[SET_RULE `` {x | a * x <= b /\ a * x >= b} =
12308                          {x | a * x <= b} INTER  {x | a * x >= b}``] THEN
12309  SIMP_TAC std_ss [CLOSED_INTER, CLOSED_HALFSPACE_LE, CLOSED_HALFSPACE_GE]
12310QED
12311
12312Theorem CLOSURE_HYPERPLANE:
12313   !a b. closure {x | a * x = b} = {x | a * x = b}
12314Proof
12315  SIMP_TAC std_ss [CLOSURE_CLOSED, CLOSED_HYPERPLANE]
12316QED
12317
12318Theorem CLOSED_STANDARD_HYPERPLANE:
12319   !a. closed {x:real | x = a}
12320Proof
12321  REPEAT GEN_TAC THEN
12322  MP_TAC(ISPECL [``1:real``, ``a:real``] CLOSED_HYPERPLANE) THEN
12323  rw []
12324QED
12325
12326Theorem CLOSED_HALFSPACE_COMPONENT_LE:
12327   !a. closed {x:real | x <= a}
12328Proof
12329  REPEAT GEN_TAC THEN
12330  MP_TAC(ISPECL [``1:real``, ``a:real``] CLOSED_HALFSPACE_LE) THEN
12331  rw []
12332QED
12333
12334Theorem CLOSED_HALFSPACE_COMPONENT_GE:
12335   !a. closed {x:real | x >= a}
12336Proof
12337  REPEAT GEN_TAC THEN
12338  MP_TAC(ISPECL [``1:real``, ``a:real``] CLOSED_HALFSPACE_GE) THEN
12339  rw []
12340QED
12341
12342(* ------------------------------------------------------------------------- *)
12343(* Openness of halfspaces.                                                   *)
12344(* ------------------------------------------------------------------------- *)
12345
12346Theorem OPEN_HALFSPACE_LT:
12347   !a b. open {x | a * x < b}
12348Proof
12349  REWRITE_TAC[GSYM REAL_NOT_LE] THEN
12350  SIMP_TAC std_ss [SET_RULE ``{x | ~p x} = UNIV DIFF {x | p x}``] THEN
12351  REWRITE_TAC[GSYM closed_def, GSYM real_ge, CLOSED_HALFSPACE_GE]
12352QED
12353
12354Theorem OPEN_HALFSPACE_COMPONENT_LT:
12355   !a. open {x:real | x < a}
12356Proof
12357  REPEAT GEN_TAC THEN
12358  MP_TAC(ISPECL [``1:real``, ``a:real``] OPEN_HALFSPACE_LT) THEN
12359  ASM_SIMP_TAC std_ss [REAL_MUL_LID]
12360QED
12361
12362Theorem OPEN_HALFSPACE_GT:
12363   !a b. open {x | a * x > b}
12364Proof
12365  REWRITE_TAC[REAL_ARITH ``x > y <=> ~(x <= y:real)``] THEN
12366  SIMP_TAC std_ss [SET_RULE ``{x | ~p x} = UNIV DIFF {x | p x}``] THEN
12367  REWRITE_TAC[GSYM closed_def, CLOSED_HALFSPACE_LE]
12368QED
12369
12370Theorem OPEN_HALFSPACE_COMPONENT_GT:
12371   !a. open {x:real | x > a}
12372Proof
12373  REPEAT GEN_TAC THEN
12374  MP_TAC(ISPECL [``1:real``, ``a:real``] OPEN_HALFSPACE_GT) THEN
12375  ASM_SIMP_TAC std_ss [REAL_MUL_LID]
12376QED
12377
12378Theorem OPEN_POSITIVE_MULTIPLES:
12379   !s:real->bool. open s ==> open {c * x | &0 < c /\ x IN s}
12380Proof
12381  SIMP_TAC std_ss [open_def, FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN
12382  MAP_EVERY X_GEN_TAC [``c:real``, ``x:real``] THEN STRIP_TAC THEN
12383  FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_SIMP_TAC std_ss [] THEN
12384  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
12385  EXISTS_TAC ``c * e:real`` THEN ASM_SIMP_TAC std_ss [REAL_LT_MUL] THEN
12386  X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
12387  FIRST_X_ASSUM(MP_TAC o SPEC ``inv(c) * y:real``) THEN
12388  KNOW_TAC ``(dist (inv (c :real) * (y :real),(x :real)) :real) < (e :real)`` THENL
12389   [SUBGOAL_THEN ``x:real = inv c * c * x`` SUBST1_TAC THENL
12390     [ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_LID,
12391                   REAL_LT_IMP_NE],
12392          ONCE_REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
12393      ASM_SIMP_TAC std_ss [DIST_MUL, abs, REAL_LT_INV_EQ, REAL_LT_IMP_LE] THEN
12394      ONCE_REWRITE_TAC[METIS [REAL_MUL_SYM, GSYM real_div] ``inv c * x:real = x / c:real``] THEN
12395      METIS_TAC[REAL_LT_LDIV_EQ, REAL_MUL_SYM]],
12396        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12397    DISCH_TAC THEN SRW_TAC [][] THEN
12398    EXISTS_TAC ``c:real`` THEN EXISTS_TAC ``inv(c) * y:real`` THEN
12399    ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_RINV, REAL_LT_IMP_NE] THEN
12400    REAL_ARITH_TAC]
12401QED
12402
12403Theorem OPEN_INTERVAL_LEFT:
12404   !b:real. open {x:real | x < b}
12405Proof
12406    REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]
12407QED
12408
12409Theorem OPEN_INTERVAL_RIGHT:
12410   !a:real. open {x:real | a < x}
12411Proof
12412    REWRITE_TAC[GSYM real_gt, OPEN_HALFSPACE_COMPONENT_GT]
12413QED
12414
12415Theorem OPEN_POSITIVE_ORTHANT:
12416   open {x:real | &0 < x}
12417Proof
12418  MP_TAC(ISPEC ``0:real`` OPEN_INTERVAL_RIGHT) THEN
12419  REWRITE_TAC[]
12420QED
12421
12422(* ------------------------------------------------------------------------- *)
12423(* Closures and interiors of halfspaces.                                     *)
12424(* ------------------------------------------------------------------------- *)
12425
12426Theorem INTERIOR_HALFSPACE_LE:
12427   !a:real b.
12428        ~(a = 0) ==> (interior {x | a * x <= b} = {x | a * x < b})
12429Proof
12430  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN
12431  SIMP_TAC std_ss [OPEN_HALFSPACE_LT, SUBSET_DEF, GSPECIFICATION, REAL_LT_IMP_LE] THEN
12432  X_GEN_TAC ``s:real->bool`` THEN STRIP_TAC THEN
12433  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN ASM_SIMP_TAC std_ss [REAL_LT_LE] THEN
12434  DISCH_TAC THEN UNDISCH_TAC ``open s`` THEN DISCH_TAC THEN
12435  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_CONTAINS_CBALL]) THEN
12436  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
12437  DISCH_THEN(X_CHOOSE_THEN ``e:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12438  REWRITE_TAC[SUBSET_DEF, IN_CBALL] THEN
12439  DISCH_THEN(MP_TAC o SPEC ``x + e / abs(a) * a:real``) THEN
12440  REWRITE_TAC[METIS [dist, REAL_ADD_SUB2, ABS_NEG] ``dist(x:real,x + y) = abs y``] THEN
12441  ASM_SIMP_TAC std_ss [ABS_MUL, ABS_DIV, ABS_ABS, REAL_DIV_RMUL,
12442               ABS_ZERO, REAL_ARITH ``&0 < x ==> abs x <= x:real``] THEN
12443  DISCH_TAC THEN
12444  FIRST_X_ASSUM(MP_TAC o SPEC ``x + e / abs(a) * a:real``) THEN
12445  ASM_REWRITE_TAC [REAL_LDISTRIB] THEN
12446  REWRITE_TAC [REAL_ARITH ``a * (b * a) = b * (a * a:real)``] THEN
12447  MATCH_MP_TAC(REAL_ARITH ``&0 < e ==> ~(b + e <= b:real)``) THEN
12448  ASM_SIMP_TAC std_ss [REAL_LT_MUL, REAL_LT_DIV, GSYM ABS_NZ, REAL_POSSQ]
12449QED
12450
12451Theorem INTERIOR_HALFSPACE_GE:
12452   !a:real b.
12453        ~(a = 0) ==> (interior {x | a * x >= b} = {x | a * x > b})
12454Proof
12455  REPEAT STRIP_TAC THEN
12456  ONCE_REWRITE_TAC[REAL_ARITH ``a >= b <=> -a <= -b:real``,
12457                   REAL_ARITH ``a > b <=> -a < -b:real``] THEN
12458  ASM_SIMP_TAC std_ss [REAL_NEG_LMUL, INTERIOR_HALFSPACE_LE, REAL_NEG_EQ0]
12459QED
12460
12461Theorem INTERIOR_HALFSPACE_COMPONENT_LE:
12462   !a. interior {x:real | x <= a} = {x | x < a}
12463Proof
12464  REPEAT GEN_TAC THEN
12465  MP_TAC(ISPECL [``1:real``, ``a:real``] INTERIOR_HALFSPACE_LE) THEN
12466  ONCE_REWRITE_TAC [REAL_ARITH ``1 <> 0:real``] THEN SIMP_TAC std_ss [REAL_MUL_LID]
12467QED
12468
12469Theorem INTERIOR_HALFSPACE_COMPONENT_GE:
12470   !a. interior {x:real | x >= a} = {x | x > a}
12471Proof
12472  REPEAT GEN_TAC THEN
12473  MP_TAC(ISPECL [``1:real``, ``a:real``] INTERIOR_HALFSPACE_GE) THEN
12474  ONCE_REWRITE_TAC [REAL_ARITH ``1 <> 0:real``] THEN SIMP_TAC std_ss [REAL_MUL_LID]
12475QED
12476
12477Theorem CLOSURE_HALFSPACE_LT:
12478   !a:real b.
12479        ~(a = 0) ==> (closure {x | a * x < b} = {x | a * x <= b})
12480Proof
12481  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN
12482  SIMP_TAC std_ss [SET_RULE ``UNIV DIFF {x | P x} = {x | ~P x}``] THEN
12483  ASM_SIMP_TAC std_ss [REAL_ARITH ``~(x < b) <=> x >= b:real``, INTERIOR_HALFSPACE_GE] THEN
12484  SIMP_TAC std_ss [EXTENSION, IN_DIFF, IN_UNIV, GSPECIFICATION] THEN REAL_ARITH_TAC
12485QED
12486
12487Theorem CLOSURE_HALFSPACE_GT:
12488   !a:real b.
12489        ~(a = 0) ==> (closure {x | a * x > b} = {x | a * x >= b})
12490Proof
12491  REPEAT STRIP_TAC THEN
12492  ONCE_REWRITE_TAC[REAL_ARITH ``a >= b <=> -a <= -b:real``,
12493                   REAL_ARITH ``a > b <=> -a < -b:real``] THEN
12494  ASM_SIMP_TAC std_ss [REAL_NEG_LMUL, CLOSURE_HALFSPACE_LT, REAL_NEG_EQ0]
12495QED
12496
12497Theorem CLOSURE_HALFSPACE_COMPONENT_LT:
12498   !a. closure {x:real | x < a} = {x | x <= a}
12499Proof
12500  REPEAT GEN_TAC THEN
12501  MP_TAC(ISPECL [``1:real``, ``a:real``] CLOSURE_HALFSPACE_LT) THEN
12502  ONCE_REWRITE_TAC [REAL_ARITH ``1 <> 0:real``] THEN SIMP_TAC std_ss [REAL_MUL_LID]
12503QED
12504
12505Theorem CLOSURE_HALFSPACE_COMPONENT_GT:
12506   !a. closure {x:real | x > a} = {x | x >= a}
12507Proof
12508  REPEAT GEN_TAC THEN
12509  MP_TAC(ISPECL [``1:real``, ``a:real``] CLOSURE_HALFSPACE_GT) THEN
12510  ONCE_REWRITE_TAC [REAL_ARITH ``1 <> 0:real``] THEN SIMP_TAC std_ss [REAL_MUL_LID]
12511QED
12512
12513Theorem INTERIOR_HYPERPLANE:
12514   !a b. ~(a = 0) ==> (interior {x | a * x = b} = {})
12515Proof
12516  REWRITE_TAC[REAL_ARITH ``(x = y) <=> x <= y /\ x >= y:real``] THEN
12517  SIMP_TAC std_ss [SET_RULE ``{x | p x /\ q x} = {x | p x} INTER {x | q x}``] THEN
12518  REWRITE_TAC[INTERIOR_INTER] THEN
12519  REWRITE_TAC [GSYM DE_MORGAN_THM, REAL_ARITH ``x <= y /\ x >= y:real <=> (x = y)``] THEN
12520  ASM_SIMP_TAC std_ss [INTERIOR_HALFSPACE_LE, INTERIOR_HALFSPACE_GE] THEN
12521  SIMP_TAC std_ss [EXTENSION, IN_INTER, GSPECIFICATION, NOT_IN_EMPTY] THEN
12522  REAL_ARITH_TAC
12523QED
12524
12525Theorem FRONTIER_HALFSPACE_LE:
12526   !a:real b. ~((a = 0) /\ (b = &0))
12527                ==> (frontier {x | a * x <= b} = {x | a * x = b})
12528Proof
12529  REPEAT GEN_TAC THEN ASM_CASES_TAC ``a:real = 0`` THEN
12530  ASM_SIMP_TAC std_ss [REAL_MUL_LZERO] THENL
12531   [ASM_CASES_TAC ``&0 <= b:real`` THEN
12532    ASM_SIMP_TAC std_ss [GSPEC_T, FRONTIER_UNIV, GSPEC_F, FRONTIER_EMPTY],
12533    ASM_SIMP_TAC std_ss [frontier, INTERIOR_HALFSPACE_LE, CLOSURE_CLOSED,
12534                 CLOSED_HALFSPACE_LE] THEN
12535    SIMP_TAC std_ss [EXTENSION, IN_DIFF, GSPECIFICATION] THEN REAL_ARITH_TAC]
12536QED
12537
12538Theorem FRONTIER_HALFSPACE_GE:
12539   !a:real b. ~((a = 0) /\ (b = &0))
12540                ==> (frontier {x | a * x >= b} = {x | a * x = b})
12541Proof
12542  REPEAT STRIP_TAC THEN
12543  MP_TAC(ISPECL [``-a:real``, ``-b:real``] FRONTIER_HALFSPACE_LE) THEN
12544  ASM_REWRITE_TAC [REAL_NEG_EQ0, REAL_NEG_LMUL] THEN
12545  REWRITE_TAC [GSYM REAL_NEG_LMUL] THEN REWRITE_TAC [REAL_EQ_NEG] THEN
12546  SIMP_TAC std_ss [REAL_LE_NEG2, real_ge]
12547QED
12548
12549Theorem FRONTIER_HALFSPACE_LT:
12550   !a:real b. ~((a = 0) /\ (b = &0))
12551                ==> (frontier {x | a * x < b} = {x | a * x = b})
12552Proof
12553  REPEAT GEN_TAC THEN ASM_CASES_TAC ``a:real = 0`` THEN
12554  ASM_SIMP_TAC std_ss [REAL_NEG_LMUL] THENL
12555   [ASM_CASES_TAC ``&0 < b:real`` THEN REWRITE_TAC [REAL_MUL_LZERO] THEN
12556    ASM_SIMP_TAC std_ss [GSPEC_T, FRONTIER_UNIV, GSPEC_F, FRONTIER_EMPTY],
12557    ASM_SIMP_TAC std_ss [frontier, CLOSURE_HALFSPACE_LT, INTERIOR_OPEN,
12558                 OPEN_HALFSPACE_LT] THEN
12559    SIMP_TAC std_ss [EXTENSION, IN_DIFF, GSPECIFICATION] THEN REAL_ARITH_TAC]
12560QED
12561
12562Theorem FRONTIER_HALFSPACE_GT:
12563   !a:real b. ~((a = 0) /\ (b = &0))
12564                ==> (frontier {x | a * x > b} = {x | a * x = b})
12565Proof
12566  REPEAT STRIP_TAC THEN
12567  MP_TAC(ISPECL [``-a:real``, ``-b:real``] FRONTIER_HALFSPACE_LT) THEN
12568  ASM_REWRITE_TAC[REAL_NEG_EQ0, REAL_MUL_LNEG] THEN
12569  SIMP_TAC std_ss [REAL_LT_NEG, REAL_EQ_NEG, real_gt]
12570QED
12571
12572Theorem INTERIOR_STANDARD_HYPERPLANE:
12573   !a. interior {x:real | x = a} = {}
12574Proof
12575  REPEAT GEN_TAC THEN
12576  MP_TAC(ISPECL [``1:real``, ``a:real``] INTERIOR_HYPERPLANE) THEN
12577  ONCE_REWRITE_TAC [REAL_ARITH ``1 <> 0:real``] THEN SIMP_TAC std_ss [REAL_MUL_LID]
12578QED
12579
12580(* ------------------------------------------------------------------------- *)
12581(* Unboundedness of halfspaces.                                              *)
12582(* ------------------------------------------------------------------------- *)
12583
12584Theorem UNBOUNDED_HALFSPACE_COMPONENT_LE:
12585    !a. ~bounded {x:real | x <= a}
12586Proof
12587    REPEAT GEN_TAC
12588 >> ASM_SIMP_TAC std_ss [bounded_def, FORALL_IN_GSPEC]
12589 >> X_GEN_TAC ``B:real``
12590 >> EXISTS_TAC ``-((&1:real) + max (abs B) (abs a))``
12591 >> REAL_ARITH_TAC
12592QED
12593
12594Theorem UNBOUNDED_HALFSPACE_COMPONENT_GE:
12595   !a. ~bounded {x:real | x >= a}
12596Proof
12597  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN
12598  MP_TAC(SPECL [``-a:real``] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN
12599  REWRITE_TAC[GSYM MONO_NOT_EQ] THEN MATCH_MP_TAC EQ_IMPLIES THEN
12600  AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL
12601   [MESON_TAC[REAL_NEG_NEG],
12602    SIMP_TAC std_ss [GSPECIFICATION] THEN REAL_ARITH_TAC]
12603QED
12604
12605Theorem UNBOUNDED_HALFSPACE_COMPONENT_LT:
12606   !a. ~bounded {x:real | x < a}
12607Proof
12608  ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
12609  REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT,
12610              UNBOUNDED_HALFSPACE_COMPONENT_LE]
12611QED
12612
12613Theorem UNBOUNDED_HALFSPACE_COMPONENT_GT:
12614   !a. ~bounded {x:real | x > a}
12615Proof
12616  ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
12617  REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT,
12618              UNBOUNDED_HALFSPACE_COMPONENT_GE]
12619QED
12620
12621(* ------------------------------------------------------------------------- *)
12622(* Equality of continuous functions on closure and related results.          *)
12623(* ------------------------------------------------------------------------- *)
12624
12625Theorem FORALL_IN_CLOSURE:
12626   !f:real->real s t.
12627        closed t /\ f continuous_on (closure s) /\
12628        (!x. x IN s ==> f x IN t)
12629        ==> (!x. x IN closure s ==> f x IN t)
12630Proof
12631  REWRITE_TAC[SET_RULE ``(!x. x IN s ==> f x IN t) <=>
12632                        s SUBSET {x | x IN s /\ f x IN t}``] THEN
12633  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
12634  ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN CONJ_TAC THENL
12635   [MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[],
12636    MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
12637    ASM_REWRITE_TAC[CLOSED_CLOSURE]]
12638QED
12639
12640Theorem FORALL_IN_CLOSURE_EQ:
12641   !f s t.
12642         closed t /\ f continuous_on closure s
12643         ==> ((!x. x IN closure s ==> f x IN t) <=>
12644              (!x. x IN s ==> f x IN t))
12645Proof
12646  METIS_TAC[FORALL_IN_CLOSURE, CLOSURE_SUBSET, SUBSET_DEF]
12647QED
12648
12649Theorem CONTINUOUS_LE_ON_CLOSURE:
12650   !f:real->real s a.
12651        f continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a)
12652        ==> !x. x IN closure(s) ==> f(x) <= a
12653Proof
12654  REPEAT GEN_TAC THEN STRIP_TAC THEN
12655  KNOW_TAC `` !(x :real). x IN closure (s :real -> bool)
12656           ==> (f :real -> real) x IN {y | y <= (a :real)}`` THENL
12657  [ALL_TAC, SET_TAC []] THEN
12658  MATCH_MP_TAC FORALL_IN_CLOSURE THEN
12659  ASM_SIMP_TAC std_ss [ETA_AX, CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM_SET_TAC []
12660QED
12661
12662Theorem CONTINUOUS_GE_ON_CLOSURE:
12663   !f:real->real s a.
12664        f continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x))
12665        ==> !x. x IN closure(s) ==> a <= f(x)
12666Proof
12667  REPEAT GEN_TAC THEN STRIP_TAC THEN
12668  KNOW_TAC `` !(x :real). x IN closure (s :real -> bool)
12669           ==> (f :real -> real) x IN {y | y >= (a :real)}`` THENL
12670  [ALL_TAC, SET_TAC [real_ge]] THEN
12671  MATCH_MP_TAC FORALL_IN_CLOSURE THEN
12672  ASM_SIMP_TAC std_ss [ETA_AX, CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_SET_TAC [real_ge]
12673QED
12674
12675Theorem CONTINUOUS_CONSTANT_ON_CLOSURE:
12676   !f:real->real s a.
12677        f continuous_on closure(s) /\ (!x. x IN s ==> (f(x) = a))
12678        ==> !x. x IN closure(s) ==> (f(x) = a)
12679Proof
12680  REWRITE_TAC[SET_RULE
12681   ``x IN s ==> (f x = a) <=> x IN s ==> f x IN {a}``] THEN
12682  REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN
12683  ASM_REWRITE_TAC[CLOSED_SING]
12684QED
12685
12686Theorem CONTINUOUS_AGREE_ON_CLOSURE:
12687   !g h:real->real.
12688        g continuous_on closure s /\ h continuous_on closure s /\
12689        (!x. x IN s ==> (g x = h x))
12690        ==> !x. x IN closure s ==> (g x = h x)
12691Proof
12692  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN STRIP_TAC THEN
12693  ONCE_REWRITE_TAC [METIS [] ``(g x - h x = 0) = ((\x. g x - h x) x = 0:real)``] THEN
12694  MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_CLOSURE THEN
12695  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_SUB]
12696QED
12697
12698Theorem CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT:
12699   !f:real->real s a.
12700        f continuous_on s
12701        ==> closed_in (subtopology euclidean s) {x | x IN s /\ (f x = a)}
12702Proof
12703  REPEAT STRIP_TAC THEN
12704  ONCE_REWRITE_TAC[SET_RULE
12705   ``{x | x IN s /\ (f(x) = a)} = {x | x IN s /\ f(x) IN {a}}``] THEN
12706  MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
12707  ASM_REWRITE_TAC[CLOSED_SING]
12708QED
12709
12710Theorem CONTINUOUS_CLOSED_PREIMAGE_CONSTANT:
12711   !f:real->real s.
12712      f continuous_on s /\ closed s ==> closed {x | x IN s /\ (f(x) = a)}
12713Proof
12714  REPEAT STRIP_TAC THEN
12715  ASM_CASES_TAC ``{x | x IN s /\ ((f:real->real)(x) = a)} = {}`` THEN
12716  ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE
12717   ``{x | x IN s /\ (f(x) = a)} = {x | x IN s /\ f(x) IN {a}}``] THEN
12718  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
12719  ASM_REWRITE_TAC[CLOSED_SING] THEN ASM_SET_TAC[]
12720QED
12721
12722(* ------------------------------------------------------------------------- *)
12723(* Theorems relating continuity and uniform continuity to closures.          *)
12724(* ------------------------------------------------------------------------- *)
12725
12726Theorem CONTINUOUS_ON_CLOSURE:
12727   !f:real->real s.
12728        f continuous_on closure s <=>
12729        !x e. x IN closure s /\ &0 < e
12730              ==> ?d. &0 < d /\
12731                      !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e
12732Proof
12733  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on] THEN
12734  EQ_TAC THENL [METIS_TAC[REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET], ALL_TAC] THEN
12735  DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
12736  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
12737  FIRST_ASSUM(MP_TAC o SPECL [``x:real``, ``e / &2:real``]) THEN
12738  KNOW_TAC ``x IN closure s:real->bool /\ 0 < e / 2:real`` THENL
12739  [ASM_REWRITE_TAC[REAL_HALF], DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [])] THEN
12740  DISCH_TAC THEN FIRST_ASSUM (fn th => REWRITE_TAC [th]) THEN
12741  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
12742  EXISTS_TAC ``d / &2:real`` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
12743  X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
12744  FIRST_X_ASSUM(MP_TAC o SPECL [``y:real``, ``e / &2:real``]) THEN
12745  ASM_REWRITE_TAC[REAL_HALF] THEN
12746  DISCH_THEN(X_CHOOSE_THEN ``k:real`` STRIP_ASSUME_TAC) THEN
12747  MP_TAC(ISPECL [``y:real``, ``s:real->bool``] CLOSURE_APPROACHABLE) THEN
12748  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC ``min k (d / &2:real)``) THEN
12749  ASM_REWRITE_TAC[REAL_HALF, REAL_LT_MIN] THEN
12750  KNOW_TAC ``!a b c e. abs(a - b) < e / &2 /\ abs(b - c) < e / &2:real ==>
12751                                    abs(a - c) < e / 2 + e / 2:real`` THENL
12752  [REAL_ARITH_TAC, DISCH_TAC] THEN STRIP_TAC THEN
12753  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN REWRITE_TAC [dist] THEN
12754  FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC ``(f:real->real) y'`` THEN CONJ_TAC THENL
12755  [REWRITE_TAC [GSYM dist] THEN ONCE_REWRITE_TAC [DIST_SYM] THEN
12756   FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [],
12757   REWRITE_TAC [GSYM dist] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [] THEN
12758   MATCH_MP_TAC DIST_TRIANGLE_LT THEN EXISTS_TAC ``y:real`` THEN
12759   GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN
12760   METIS_TAC [DIST_SYM]]
12761QED
12762
12763Theorem CONTINUOUS_ON_CLOSURE_SEQUENTIALLY:
12764   !f:real->real s.
12765        f continuous_on closure s <=>
12766        !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially
12767              ==> ((f o x) --> f a) sequentially
12768Proof
12769  REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN
12770  SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
12771  REWRITE_TAC[AND_IMP_INTRO, GSYM continuous_within] THEN
12772  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]
12773QED
12774
12775Theorem UNIFORMLY_CONTINUOUS_ON_CLOSURE:
12776   !f:real->real s.
12777        f uniformly_continuous_on s /\ f continuous_on closure s
12778        ==> f uniformly_continuous_on closure s
12779Proof
12780  REPEAT GEN_TAC THEN
12781  REWRITE_TAC[uniformly_continuous_on] THEN STRIP_TAC THEN
12782  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
12783  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &3:real``) THEN
12784  KNOW_TAC ``0 < e / 3:real`` THENL
12785  [FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
12786   ASM_REAL_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
12787  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
12788  EXISTS_TAC ``d / &3:real`` THEN CONJ_TAC THENL
12789  [FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
12790   REWRITE_TAC [REAL_MUL_LZERO] THEN ASM_REWRITE_TAC [], ALL_TAC] THEN
12791  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
12792  UNDISCH_TAC ``f continuous_on closure s`` THEN DISCH_TAC THEN
12793  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [continuous_on]) THEN
12794  DISCH_THEN(fn th =>
12795    MP_TAC(SPEC ``y:real`` th) THEN MP_TAC(SPEC ``x:real`` th)) THEN
12796  ASM_REWRITE_TAC[] THEN
12797  DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN ASM_REWRITE_TAC [] THEN
12798  DISCH_THEN(X_CHOOSE_THEN ``d1:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12799  MP_TAC(ISPECL [``x:real``, ``s:real->bool``] CLOSURE_APPROACHABLE) THEN
12800  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC ``min d1 (d / &3:real)``) THEN
12801  KNOW_TAC ``0 < min d1 (d / 3:real)`` THENL
12802  [REWRITE_TAC [min_def] THEN COND_CASES_TAC THEN
12803   FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
12804   REWRITE_TAC [REAL_MUL_LZERO] THEN ASM_REWRITE_TAC [],
12805   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
12806  REWRITE_TAC[REAL_LT_MIN] THEN
12807  DISCH_THEN(X_CHOOSE_THEN ``x':real`` STRIP_ASSUME_TAC) THEN
12808  DISCH_THEN(MP_TAC o SPEC ``x':real``) THEN
12809  ASM_SIMP_TAC std_ss [REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET] THEN DISCH_TAC THEN
12810  DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN ASM_REWRITE_TAC [] THEN
12811  DISCH_THEN(X_CHOOSE_THEN ``d2:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12812  MP_TAC(ISPECL [``y:real``, ``s:real->bool``] CLOSURE_APPROACHABLE) THEN
12813  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC ``min d2 (d / &3:real)``) THEN
12814  KNOW_TAC ``0 < min d2 (d / 3:real)`` THENL
12815  [REWRITE_TAC [min_def] THEN COND_CASES_TAC THEN
12816   FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
12817   REWRITE_TAC [REAL_MUL_LZERO] THEN ASM_REWRITE_TAC [],
12818   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
12819  REWRITE_TAC[REAL_LT_MIN] THEN
12820  DISCH_THEN(X_CHOOSE_THEN ``y':real`` STRIP_ASSUME_TAC) THEN
12821  DISCH_THEN(MP_TAC o SPEC ``y':real``) THEN
12822  ASM_SIMP_TAC std_ss [REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET] THEN DISCH_TAC THEN
12823  FIRST_X_ASSUM(MP_TAC o SPECL [``x':real``, ``y':real``]) THEN
12824  FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
12825  METIS_TAC[dist, ABS_SUB, REAL_ARITH
12826   ``abs(y - x) * 3 < d /\ abs(x' - x) * 3 < d /\ abs(y' - y) * 3 < d
12827    ==> abs(y' - x') < d:real``]
12828QED
12829
12830(* ------------------------------------------------------------------------- *)
12831(* Cauchy continuity, and the extension of functions to closures.            *)
12832(* ------------------------------------------------------------------------- *)
12833
12834Theorem UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS:
12835   !f:real->real s.
12836        f uniformly_continuous_on s
12837        ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
12838Proof
12839  REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on, cauchy, o_DEF] THEN
12840  MESON_TAC[]
12841QED
12842
12843Theorem CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS:
12844   !f:real->real s.
12845        f continuous_on s /\ closed s
12846        ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
12847Proof
12848  REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED, CONTINUOUS_ON_SEQUENTIALLY] THEN
12849  REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]
12850QED
12851
12852Theorem CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA:
12853   !f:real->real s.
12854        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
12855        ==> !a x. (!n. (x n) IN s) /\ (x --> a) sequentially
12856                  ==> ?l. ((f o x) --> l) sequentially /\
12857                          !y. (!n. (y n) IN s) /\ (y --> a) sequentially
12858                              ==> ((f o y) --> l) sequentially
12859Proof
12860  REPEAT STRIP_TAC THEN
12861  FIRST_ASSUM(MP_TAC o SPEC ``x:num->real``) THEN
12862  KNOW_TAC ``cauchy x /\ (!n. x n IN s)`` THENL
12863  [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY],
12864    DISCH_THEN (fn th => REWRITE_TAC [th])] THEN
12865  REWRITE_TAC [GSYM CONVERGENT_EQ_CAUCHY] THEN
12866  DISCH_THEN (X_CHOOSE_TAC ``l:real``) THEN EXISTS_TAC ``l:real`` THEN
12867  ASM_REWRITE_TAC [] THEN
12868  X_GEN_TAC ``y:num->real`` THEN STRIP_TAC THEN
12869  FIRST_ASSUM(MP_TAC o SPEC ``y:num->real``) THEN
12870  KNOW_TAC ``cauchy y /\ (!n. y n IN s)`` THENL
12871  [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY],
12872    DISCH_THEN (fn th => REWRITE_TAC [th])] THEN
12873  REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
12874  DISCH_THEN(X_CHOOSE_THEN ``l':real`` STRIP_ASSUME_TAC) THEN
12875  SUBGOAL_THEN ``l:real = l'`` (fn th => ASM_REWRITE_TAC[th]) THEN
12876  ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
12877  MATCH_MP_TAC(ISPEC ``sequentially`` LIM_UNIQUE) THEN
12878  EXISTS_TAC ``\n:num. (f:real->real)(x n) - f(y n)`` THEN
12879  RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
12880  ASM_SIMP_TAC std_ss [LIM_SUB, TRIVIAL_LIMIT_SEQUENTIALLY] THEN
12881  FIRST_X_ASSUM(MP_TAC o SPEC
12882   ``\n. if EVEN n then x(n DIV 2):real else y(n DIV 2)``) THEN
12883  REWRITE_TAC[cauchy, o_THM, LIM_SEQUENTIALLY] THEN
12884  KNOW_TAC ``(!(e :real).
12885    (0 :real) < e ==>
12886    ?(N :num).
12887      !(m :num) (n :num).
12888        m >= N /\ n >= N ==>
12889        (dist
12890           ((\(n :num).
12891               if EVEN n then (x :num -> real) (n DIV  2n)
12892               else (y :num -> real) (n DIV  2n)) m,
12893            (\(n :num).
12894               if EVEN n then x (n DIV  2n)
12895               else y (n DIV  2n)) n) :real) < e) /\
12896      (!(n :num). (\(n :num).
12897       if EVEN n then x (n DIV  2n) else y (n DIV  2n)) n IN
12898    (s :real -> bool))`` THENL
12899  [ (* goal 1 (of 2) *)
12900    CONJ_TAC THENL [ALL_TAC, METIS_TAC[]] THEN
12901    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC
12902     [``((y:num->real) --> a) sequentially``,
12903      ``((x:num->real) --> a) sequentially``] THEN
12904    REWRITE_TAC[LIM_SEQUENTIALLY] THEN
12905    DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
12906    DISCH_THEN(X_CHOOSE_TAC ``N1:num``) THEN
12907    DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
12908    DISCH_THEN(X_CHOOSE_TAC ``N2:num``) THEN
12909    EXISTS_TAC ``2 * (N1 + N2:num)`` THEN
12910    MAP_EVERY X_GEN_TAC [``m:num``, ``n:num``] THEN STRIP_TAC THEN
12911    UNDISCH_TAC ``!n. (y:num->real) n IN s`` THEN DISCH_TAC THEN
12912    UNDISCH_TAC ``!n. (x:num->real) n IN s`` THEN DISCH_TAC THEN
12913    POP_ASSUM K_TAC THEN POP_ASSUM K_TAC THEN
12914    REPEAT(FIRST_X_ASSUM(fn th =>
12915      MP_TAC(SPEC ``m DIV 2`` th) THEN MP_TAC(SPEC ``n DIV 2`` th))) THEN
12916    KNOW_TAC ``N1 <= n DIV 2`` THENL
12917    [SIMP_TAC std_ss [X_LE_DIV, ARITH_PROVE ``0 < 2:num``] THEN
12918     ASM_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12919     POP_ASSUM K_TAC THEN DISCH_TAC] THEN
12920    KNOW_TAC ``N1 <= m DIV 2`` THENL
12921    [SIMP_TAC std_ss [X_LE_DIV, ARITH_PROVE ``0 < 2:num``] THEN
12922     ASM_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12923     POP_ASSUM K_TAC THEN DISCH_TAC] THEN
12924    KNOW_TAC ``N2 <= n DIV 2`` THENL
12925    [SIMP_TAC std_ss [X_LE_DIV, ARITH_PROVE ``0 < 2:num``] THEN
12926     ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12927     POP_ASSUM K_TAC THEN DISCH_TAC] THEN
12928    KNOW_TAC ``N2 <= m DIV 2`` THENL
12929    [SIMP_TAC std_ss [X_LE_DIV, ARITH_PROVE ``0 < 2:num``] THEN
12930     ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12931     POP_ASSUM K_TAC THEN DISCH_TAC] THEN
12932    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
12933    FULL_SIMP_TAC std_ss [dist, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
12934    Cases_on `EVEN m` >> Cases_on `EVEN n` >> fs [] >| (* 4 subgoals *)
12935    [ MP_TAC (Q.SPECL [`x (m DIV 2) - a`, `x (n DIV 2) - a`] ABS_TRIANGLE_NEG),
12936      MP_TAC (Q.SPECL [`x (m DIV 2) - a`, `y (n DIV 2) - a`] ABS_TRIANGLE_NEG),
12937      MP_TAC (Q.SPECL [`y (m DIV 2) - a`, `x (n DIV 2) - a`] ABS_TRIANGLE_NEG),
12938      MP_TAC (Q.SPECL [`y (m DIV 2) - a`, `y (n DIV 2) - a`] ABS_TRIANGLE_NEG) ]
12939    >> ASM_REAL_ARITH_TAC,
12940    (* goal 2 (of 2) *)
12941    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
12942    DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN
12943    ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[] THEN
12944    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
12945    X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
12946    FIRST_X_ASSUM(MP_TAC o SPECL [``2 * n:num``, ``2 * n + 1:num``]) THEN
12947    KNOW_TAC ``2 * n >= N /\ 2 * n + 1 >= N:num`` THENL
12948    [ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
12949    SIMP_TAC arith_ss [EVEN_ADD, EVEN_MULT] THEN
12950    KNOW_TAC ``((2 * n) DIV 2 = n) /\ ((2 * n + 1) DIV 2 = n)`` THENL
12951    [SIMP_TAC arith_ss [DIV_EQ_X, ARITH_PROVE ``0 < 2:num``], ALL_TAC] THEN
12952    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
12953    REWRITE_TAC[dist, REAL_SUB_RZERO] ]
12954QED
12955
12956Theorem CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE:
12957   !f:real->real s.
12958        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
12959        ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> (g x = f x))
12960Proof
12961  REPEAT STRIP_TAC THEN
12962  SUBGOAL_THEN
12963   ``!a:real. ?x.
12964       a IN closure s ==> (!n. x n IN s) /\ (x --> a) sequentially``
12965  MP_TAC THENL [MESON_TAC[CLOSURE_SEQUENTIAL], ALL_TAC] THEN
12966  SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
12967  X_GEN_TAC ``X:real->num->real`` THEN DISCH_TAC THEN
12968  FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA) THEN
12969  DISCH_THEN(MP_TAC o GEN ``a:real`` o
12970   SPECL [``a:real``, ``(X:real->num->real) a``]) THEN
12971  KNOW_TAC ``(!(a :real). a IN closure (s :real -> bool) ==>
12972   ?(l :real).
12973     (((f :real -> real) o X a --> l) sequentially :bool) /\
12974     !(y :num -> real).
12975       (!(n :num). y n IN s) /\ ((y --> a) sequentially :bool) ==>
12976       ((f o y --> l) sequentially :bool)) ==>
12977  ?(g :real -> real).
12978  g continuous_on closure s /\ !(x :real). x IN s ==> (g x = f x)`` THENL
12979  [ALL_TAC, METIS_TAC []] THEN DISCH_TAC THEN
12980  POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
12981  SIMP_TAC std_ss [SKOLEM_THM] THEN
12982  DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN EXISTS_TAC ``g:real->real`` THEN
12983  POP_ASSUM MP_TAC THEN STRIP_TAC THEN
12984  MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
12985   [X_GEN_TAC ``a:real`` THEN DISCH_TAC THEN
12986    FIRST_X_ASSUM(MP_TAC o SPEC ``a:real``) THEN
12987    ASM_SIMP_TAC std_ss [REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET] THEN
12988    DISCH_THEN(MP_TAC o SPEC ``(\n. a):num->real`` o CONJUNCT2) THEN
12989    ASM_SIMP_TAC std_ss [LIM_CONST_EQ, o_DEF, TRIVIAL_LIMIT_SEQUENTIALLY],
12990    STRIP_TAC] THEN
12991  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_CLOSURE_SEQUENTIALLY] THEN
12992  MAP_EVERY X_GEN_TAC [``x:num->real``, ``a:real``] THEN STRIP_TAC THEN
12993  MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
12994  EXISTS_TAC ``(f:real->real) o (x:num->real)`` THEN ASM_SIMP_TAC std_ss [] THEN
12995  MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC std_ss [o_THM]
12996QED
12997
12998Theorem UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE:
12999   !f:real->real s.
13000   f uniformly_continuous_on s
13001   ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> (g x = f x)) /\
13002           !h. h continuous_on closure s /\ (!x. x IN s ==> (h x = f x))
13003               ==> !x. x IN closure s ==> (h x = g x)
13004Proof
13005  REPEAT STRIP_TAC THEN
13006  FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o
13007   MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN
13008  STRIP_TAC THEN EXISTS_TAC ``g:real->real`` THEN
13009  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
13010   [METIS_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE, UNIFORMLY_CONTINUOUS_ON_EQ],
13011    METIS_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]
13012QED
13013
13014Theorem CAUCHY_CONTINUOUS_IMP_CONTINUOUS:
13015   !f:real->real s.
13016        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
13017        ==> f continuous_on s
13018Proof
13019  REPEAT STRIP_TAC THEN
13020  FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
13021  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET, CLOSURE_SUBSET, CONTINUOUS_ON_EQ]
13022QED
13023
13024Theorem BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE:
13025   !f:real->real s.
13026        f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)
13027Proof
13028  REPEAT STRIP_TAC THEN FIRST_ASSUM
13029   (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
13030  DISCH_THEN(X_CHOOSE_THEN ``g:real->real`` STRIP_ASSUME_TAC) THEN
13031  MATCH_MP_TAC BOUNDED_SUBSET THEN
13032  EXISTS_TAC ``IMAGE (g:real->real) (closure s)`` THEN CONJ_TAC THENL
13033   [ASM_MESON_TAC[COMPACT_CLOSURE, UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS,
13034                  COMPACT_IMP_BOUNDED, COMPACT_CONTINUOUS_IMAGE],
13035    MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[]]
13036QED
13037
13038(* ------------------------------------------------------------------------- *)
13039(* Occasionally useful invariance properties.                                *)
13040(* ------------------------------------------------------------------------- *)
13041
13042Theorem CONTINUOUS_AT_COMPOSE_EQ:
13043   !f:real->real g:real->real h:real->real.
13044        g continuous at x /\ h continuous at (g x) /\
13045        (!y. g(h y) = y) /\ (h(g x) = x)
13046        ==> ((f continuous at (g x) <=> (\x. f(g x)) continuous at x))
13047Proof
13048  REPEAT STRIP_TAC THEN EQ_TAC THEN
13049  ASM_SIMP_TAC std_ss [REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN
13050  DISCH_TAC THEN
13051  SUBGOAL_THEN
13052   ``((f:real->real) o (g:real->real) o (h:real->real))
13053     continuous at (g(x:real))``
13054  MP_TAC THENL
13055   [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
13056    ASM_REWRITE_TAC[o_DEF],
13057    ASM_SIMP_TAC std_ss [o_DEF, ETA_AX]]
13058QED
13059
13060Theorem CONTINUOUS_AT_TRANSLATION:
13061   !a z f:real->real.
13062      f continuous at (a + z) <=> (\x. f(a + x)) continuous at z
13063Proof
13064  REPEAT GEN_TAC THEN
13065  ONCE_REWRITE_TAC [METIS [] ``a + z = (\z. a + z) z:real``] THEN
13066  MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN
13067  EXISTS_TAC ``\x:real. x - a`` THEN
13068  SIMP_TAC std_ss [CONTINUOUS_ADD, CONTINUOUS_SUB,
13069           CONTINUOUS_AT_ID, CONTINUOUS_CONST] THEN
13070  REAL_ARITH_TAC
13071QED
13072
13073(* ------------------------------------------------------------------------- *)
13074(* Interior of an injective image.                                           *)
13075(* ------------------------------------------------------------------------- *)
13076
13077Theorem INTERIOR_IMAGE_SUBSET:
13078   !f:real->real s.
13079       (!x. f continuous at x) /\ (!x y. (f x = f y) ==> (x = y))
13080       ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)
13081Proof
13082  REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET_DEF] THEN
13083  SIMP_TAC std_ss [interior, GSPECIFICATION] THEN
13084  X_GEN_TAC ``y:real`` THEN
13085  DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
13086  SIMP_TAC std_ss [IN_IMAGE, GSPECIFICATION] THEN
13087  SUBGOAL_THEN ``y IN IMAGE (f:real->real) s`` MP_TAC THENL
13088   [ASM_SET_TAC[], ALL_TAC] THEN
13089  REWRITE_TAC[IN_IMAGE] THEN
13090  STRIP_TAC THEN EXISTS_TAC ``x:real`` THEN
13091  ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
13092  EXISTS_TAC ``{x | (f:real->real)(x) IN t}`` THEN
13093  SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN CONJ_TAC THENL
13094   [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[],
13095    ASM_SET_TAC[]]
13096QED
13097
13098(* ------------------------------------------------------------------------- *)
13099(* Making a continuous function avoid some value in a neighbourhood.         *)
13100(* ------------------------------------------------------------------------- *)
13101
13102Theorem CONTINUOUS_WITHIN_AVOID:
13103   !f:real->real x s a.
13104        f continuous (at x within s) /\ x IN s /\  ~(f x = a)
13105        ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)
13106Proof
13107  REPEAT STRIP_TAC THEN
13108  UNDISCH_TAC ``f continuous (at x within s)`` THEN DISCH_TAC THEN
13109  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [continuous_within]) THEN
13110  DISCH_THEN(MP_TAC o SPEC ``abs((f:real->real) x - a)``) THEN
13111  ASM_REWRITE_TAC[GSYM ABS_NZ, REAL_SUB_0] THEN
13112  DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN EXISTS_TAC ``d:real`` THEN
13113  POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN
13114  REWRITE_TAC[] THEN DISCH_TAC THEN X_GEN_TAC ``y:real`` THEN
13115  POP_ASSUM (MP_TAC o SPEC ``y:real``) THEN
13116  MATCH_MP_TAC MONO_IMP THEN SIMP_TAC std_ss [dist] THEN REAL_ARITH_TAC
13117QED
13118
13119Theorem CONTINUOUS_AT_AVOID:
13120   !f:real->real x a.
13121        f continuous (at x) /\ ~(f x = a)
13122        ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)
13123Proof
13124  MP_TAC CONTINUOUS_WITHIN_AVOID THEN
13125  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
13126  POP_ASSUM (MP_TAC o SPECL [``f:real->real``,``x:real``]) THEN
13127  DISCH_THEN(MP_TAC o SPEC ``univ(:real)``) THEN
13128  DISCH_TAC THEN X_GEN_TAC ``a:real`` THEN POP_ASSUM (MP_TAC o SPEC ``a:real``) THEN
13129  REWRITE_TAC[WITHIN_UNIV, IN_UNIV]
13130QED
13131
13132Theorem CONTINUOUS_ON_AVOID:
13133   !f:real->real x s a.
13134        f continuous_on s /\ x IN s /\ ~(f x = a)
13135        ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)
13136Proof
13137  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
13138  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN
13139  ASM_SIMP_TAC std_ss []
13140QED
13141
13142Theorem CONTINUOUS_ON_OPEN_AVOID:
13143   !f:real->real x s a.
13144        f continuous_on s /\ open s /\ x IN s /\ ~(f x = a)
13145        ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)
13146Proof
13147  REPEAT GEN_TAC THEN ASM_CASES_TAC ``open(s:real->bool)`` THEN
13148  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN
13149  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN
13150  ASM_SIMP_TAC std_ss []
13151QED
13152
13153(* ------------------------------------------------------------------------- *)
13154(* Proving a function is constant by proving open-ness of level set.         *)
13155(* ------------------------------------------------------------------------- *)
13156
13157Theorem CONTINUOUS_LEVELSET_OPEN_IN_CASES:
13158   !f:real->real s a.
13159        connected s /\
13160        f continuous_on s /\
13161        open_in (subtopology euclidean s) {x | x IN s /\ (f x = a)}
13162        ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> (f x = a))
13163Proof
13164  REWRITE_TAC[SET_RULE ``(!x. x IN s ==> ~(f x = a)) <=>
13165                        ({x | x IN s /\ (f x = a)} = {})``,
13166              SET_RULE ``(!x. x IN s ==> (f x = a)) <=>
13167                        ({x | x IN s /\ (f x = a)} = s)``] THEN
13168  REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN
13169  FIRST_X_ASSUM MATCH_MP_TAC THEN
13170  ASM_SIMP_TAC std_ss [CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]
13171QED
13172
13173Theorem CONTINUOUS_LEVELSET_OPEN_IN:
13174   !f:real->real s a.
13175        connected s /\
13176        f continuous_on s /\
13177        open_in (subtopology euclidean s) {x | x IN s /\ (f x = a)} /\
13178        (?x. x IN s /\ (f x = a))
13179        ==> (!x. x IN s ==> (f x = a))
13180Proof
13181  METIS_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]
13182QED
13183
13184Theorem CONTINUOUS_LEVELSET_OPEN:
13185   !f:real->real s a.
13186        connected s /\
13187        f continuous_on s /\
13188        open {x | x IN s /\ (f x = a)} /\
13189        (?x. x IN s /\ (f x = a))
13190        ==> (!x. x IN s ==> (f x = a))
13191Proof
13192  REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
13193  MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN
13194  ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
13195  EXISTS_TAC ``{x | x IN s /\ ((f:real->real) x = a)}`` THEN
13196  ASM_REWRITE_TAC[] THEN SET_TAC[]
13197QED
13198
13199(* ------------------------------------------------------------------------- *)
13200(* Some arithmetical combinations (more to prove).                           *)
13201(* ------------------------------------------------------------------------- *)
13202
13203Theorem OPEN_SCALING:
13204   !s:real->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c * x) s)
13205Proof
13206  REPEAT GEN_TAC THEN SIMP_TAC std_ss [open_def, FORALL_IN_IMAGE] THEN
13207  STRIP_TAC THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
13208  FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
13209  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
13210  EXISTS_TAC ``e * abs(c:real)`` THEN ASM_SIMP_TAC std_ss [REAL_LT_MUL, GSYM ABS_NZ] THEN
13211  X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
13212  EXISTS_TAC ``inv(c) * y:real`` THEN
13213  ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_RINV, REAL_MUL_LID] THEN
13214  FIRST_X_ASSUM MATCH_MP_TAC THEN
13215  SUBGOAL_THEN ``x = inv(c) * c * x:real`` SUBST1_TAC THENL
13216   [ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_LID],
13217    REWRITE_TAC[dist, GSYM REAL_MUL_ASSOC, GSYM REAL_SUB_LDISTRIB, ABS_MUL] THEN
13218    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC std_ss [ABS_INV] THEN
13219    ASM_SIMP_TAC std_ss [GSYM real_div, REAL_LT_LDIV_EQ, GSYM ABS_NZ] THEN
13220    ASM_REWRITE_TAC[GSYM dist]]
13221QED
13222
13223Theorem OPEN_NEGATIONS:
13224   !s:real->bool. open s ==> open (IMAGE (\x. -x) s)
13225Proof
13226  SUBGOAL_THEN ``(\x. -x) = \x:real. -(&1) * x``
13227   (fn th => SIMP_TAC std_ss [th, OPEN_SCALING, REAL_ARITH ``~(-(&1) = &0:real)``]) THEN
13228  REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC
13229QED
13230
13231Theorem OPEN_TRANSLATION:
13232   !s a:real. open s ==> open(IMAGE (\x. a + x) s)
13233Proof
13234  REPEAT STRIP_TAC THEN
13235  MP_TAC(ISPECL [``\x:real. x - a``, ``s:real->bool``]
13236         CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN
13237  ASM_SIMP_TAC std_ss [CONTINUOUS_SUB, CONTINUOUS_AT_ID, CONTINUOUS_CONST] THEN
13238  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN
13239  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE, IN_UNIV] THEN
13240  ASM_MESON_TAC[REAL_ARITH ``(a + x) - a = x:real``,
13241                REAL_ARITH ``a + (x - a) = x:real``]
13242QED
13243
13244Theorem OPEN_TRANSLATION_EQ:
13245   !a s. open (IMAGE (\x:real. a + x) s) <=> open s
13246Proof
13247  REPEAT GEN_TAC THEN EQ_TAC THENL
13248  [ALL_TAC, REWRITE_TAC [OPEN_TRANSLATION]] THEN
13249  REWRITE_TAC [open_def] THEN DISCH_TAC THEN GEN_TAC THEN
13250  DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC ``a + x:real``) THEN
13251  KNOW_TAC ``a + x IN IMAGE (\x:real. a + x) s`` THENL
13252  [SIMP_TAC std_ss [IN_IMAGE, REAL_EQ_LADD] THEN METIS_TAC [],
13253   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
13254  STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN ASM_REWRITE_TAC [] THEN
13255  GEN_TAC THEN DISCH_TAC THEN FULL_SIMP_TAC std_ss [dist, IN_IMAGE] THEN
13256  FIRST_X_ASSUM (MP_TAC o SPEC ``a + x':real``) THEN
13257  ASM_SIMP_TAC real_ss [REAL_ARITH ``a + b - (a + c) = b - c:real``] THEN
13258  REWRITE_TAC [REAL_EQ_LADD] THEN METIS_TAC []
13259QED
13260
13261Theorem OPEN_AFFINITY:
13262   !s a:real c.
13263        open s /\ ~(c = &0) ==> open (IMAGE (\x. a + c * x) s)
13264Proof
13265  REPEAT STRIP_TAC THEN
13266  SUBGOAL_THEN ``(\x:real. a + c * x) = (\x. a + x) o (\x. c * x)``
13267  SUBST1_TAC THENL [REWRITE_TAC[o_DEF], ALL_TAC] THEN
13268  ASM_SIMP_TAC std_ss [IMAGE_COMPOSE, OPEN_TRANSLATION, OPEN_SCALING]
13269QED
13270
13271Theorem INTERIOR_TRANSLATION:
13272   !a:real s.
13273    interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)
13274Proof
13275  REPEAT STRIP_TAC THEN
13276  KNOW_TAC ``(!t. ?s. IMAGE ((\x. a + x):real->real) s = t)`` THENL
13277  [REWRITE_TAC [SURJECTIVE_IMAGE] THEN GEN_TAC THEN EXISTS_TAC ``-a + y:real`` THEN
13278   SIMP_TAC std_ss [] THEN REAL_ARITH_TAC, DISCH_TAC] THEN
13279  REWRITE_TAC [interior] THEN
13280  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE] THEN
13281  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
13282  [FIRST_ASSUM (MP_TAC o REWRITE_RULE [SUBSET_DEF]) THEN
13283   DISCH_THEN (MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC [IN_IMAGE] THEN
13284   SIMP_TAC std_ss [] THEN STRIP_TAC THEN EXISTS_TAC ``x':real`` THEN
13285   ASM_REWRITE_TAC [] THEN
13286   FIRST_ASSUM (MP_TAC o SPEC ``t:real->bool``) THEN STRIP_TAC THEN
13287   EXISTS_TAC ``s':real->bool`` THEN REPEAT CONJ_TAC THENL
13288   [METIS_TAC [OPEN_TRANSLATION_EQ],
13289    UNDISCH_TAC ``IMAGE ((\x. a + x):real->real) s' = t`` THEN REWRITE_TAC [EXTENSION] THEN
13290    DISCH_THEN (MP_TAC o SPEC ``x:real``) THEN ASM_SIMP_TAC std_ss [IN_IMAGE] THEN
13291    REWRITE_TAC [REAL_EQ_LADD] THEN METIS_TAC [],
13292    REWRITE_TAC [SUBSET_DEF] THEN X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
13293    UNDISCH_TAC ``IMAGE ((\x. a + x):real->real) s' = t`` THEN REWRITE_TAC [EXTENSION] THEN
13294    DISCH_THEN (MP_TAC o SPEC ``a + y:real``) THEN SIMP_TAC std_ss [IN_IMAGE] THEN
13295    KNOW_TAC ``(?x:real. (a + y = a + x) /\ x IN s')`` THENL
13296    [METIS_TAC [], ALL_TAC] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
13297    DISCH_TAC THEN UNDISCH_TAC ``t SUBSET IMAGE ((\x. a + x):real->real) s`` THEN
13298    REWRITE_TAC [SUBSET_DEF] THEN DISCH_THEN (MP_TAC o SPEC ``a + y:real``) THEN
13299    ASM_REWRITE_TAC [] THEN SIMP_TAC std_ss [IN_IMAGE, REAL_EQ_LADD]], ALL_TAC] THEN
13300  FIRST_ASSUM (MP_TAC o SPEC ``t:real->bool``) THEN
13301  STRIP_TAC THEN EXISTS_TAC ``IMAGE (\x:real. a + x) t`` THEN
13302  REPEAT CONJ_TAC THENL
13303  [METIS_TAC [OPEN_TRANSLATION_EQ],
13304   SIMP_TAC std_ss [IN_IMAGE] THEN EXISTS_TAC ``x':real`` THEN
13305   ASM_REWRITE_TAC [],
13306   MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC []]
13307QED
13308
13309Theorem OPEN_SUMS:
13310   !s t:real->bool.
13311        open s \/ open t ==> open {x + y | x IN s /\ y IN t}
13312Proof
13313  REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN
13314  SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
13315  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THENL
13316   [FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``),
13317    FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``)] THEN
13318  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
13319  EXISTS_TAC ``e:real`` THEN ASM_REWRITE_TAC[] THEN
13320  X_GEN_TAC ``z:real`` THEN DISCH_TAC THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
13321  METIS_TAC[REAL_ADD_SYM, REAL_ARITH ``(z - y) + y:real = z``, dist,
13322                REAL_ARITH ``abs(z:real - (x + y)) < e ==> abs(z - y - x) < e``]
13323QED
13324
13325(* ------------------------------------------------------------------------- *)
13326(* Upper and lower hemicontinuous functions, relation in the case of         *)
13327(* preimage map to open and closed maps, and fact that upper and lower       *)
13328(* hemicontinuity together imply continuity in the sense of the Hausdorff    *)
13329(* metric (at points where the function gives a bounded and nonempty set).   *)
13330(* ------------------------------------------------------------------------- *)
13331
13332Theorem UPPER_HEMICONTINUOUS:
13333   !f:real->real->bool t s.
13334        (!x. x IN s ==> f(x) SUBSET t)
13335        ==> ((!u. open_in (subtopology euclidean t) u
13336                  ==> open_in (subtopology euclidean s)
13337                              {x | x IN s /\ f(x) SUBSET u}) <=>
13338             (!u. closed_in (subtopology euclidean t) u
13339                  ==> closed_in (subtopology euclidean s)
13340                                {x | x IN s /\ ~(f(x) INTER u = {})}))
13341Proof
13342  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN
13343  FIRST_X_ASSUM(MP_TAC o SPEC ``t DIFF u:real->bool``) THEN
13344  MATCH_MP_TAC MONO_IMP THEN
13345  SIMP_TAC std_ss [OPEN_IN_DIFF, CLOSED_IN_DIFF, OPEN_IN_REFL, CLOSED_IN_REFL] THENL
13346   [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ], REWRITE_TAC[closed_in]] THEN
13347  SIMP_TAC std_ss [TOPSPACE_EUCLIDEAN_SUBTOPOLOGY, SUBSET_RESTRICT] THEN
13348  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]
13349QED
13350
13351Theorem LOWER_HEMICONTINUOUS:
13352   !f:real->real->bool t s.
13353        (!x. x IN s ==> f(x) SUBSET t)
13354        ==> ((!u. closed_in (subtopology euclidean t) u
13355                  ==> closed_in (subtopology euclidean s)
13356                                {x | x IN s /\ f(x) SUBSET u}) <=>
13357             (!u. open_in (subtopology euclidean t) u
13358                  ==> open_in (subtopology euclidean s)
13359                              {x | x IN s /\ ~(f(x) INTER u = {})}))
13360Proof
13361  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN
13362  FIRST_X_ASSUM(MP_TAC o SPEC ``t DIFF u:real->bool``) THEN
13363  MATCH_MP_TAC MONO_IMP THEN
13364  SIMP_TAC std_ss [OPEN_IN_DIFF, CLOSED_IN_DIFF, OPEN_IN_REFL, CLOSED_IN_REFL] THENL
13365   [REWRITE_TAC[closed_in], REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN
13366  SIMP_TAC std_ss [TOPSPACE_EUCLIDEAN_SUBTOPOLOGY, SUBSET_RESTRICT] THEN
13367  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]
13368QED
13369
13370Theorem OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE:
13371   !f:real->real s t.
13372        IMAGE f s SUBSET t
13373        ==> ((!u. open_in (subtopology euclidean s) u
13374                  ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
13375             (!u. closed_in (subtopology euclidean s) u
13376                      ==> closed_in (subtopology euclidean t)
13377                                    {y | y IN t /\
13378                                         {x | x IN s /\ (f x = y)} SUBSET u}))
13379Proof
13380  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
13381   [X_GEN_TAC ``v:real->bool`` THEN DISCH_TAC THEN
13382    FIRST_X_ASSUM(MP_TAC o SPEC ``s DIFF v:real->bool``) THEN
13383    ASM_SIMP_TAC std_ss [OPEN_IN_DIFF, OPEN_IN_REFL] THEN
13384    SIMP_TAC std_ss [OPEN_IN_CLOSED_IN_EQ, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
13385    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13386    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
13387    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[],
13388    X_GEN_TAC ``v:real->bool`` THEN DISCH_TAC THEN
13389    FIRST_X_ASSUM(MP_TAC o SPEC ``s DIFF v:real->bool``) THEN
13390    ASM_SIMP_TAC std_ss [CLOSED_IN_DIFF, CLOSED_IN_REFL] THEN
13391    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
13392    REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
13393    DISCH_THEN(fn th => CONJ_TAC THENL [ASM_SET_TAC[], MP_TAC th]) THEN
13394    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]]
13395QED
13396
13397Theorem CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE:
13398   !f:real->real s t.
13399        IMAGE f s SUBSET t
13400        ==> ((!u. closed_in (subtopology euclidean s) u
13401                  ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=>
13402             (!u. open_in (subtopology euclidean s) u
13403                  ==> open_in (subtopology euclidean t)
13404                              {y | y IN t /\
13405                                   {x | x IN s /\ (f x = y)} SUBSET u}))
13406Proof
13407  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
13408   [X_GEN_TAC ``v:real->bool`` THEN DISCH_TAC THEN
13409    FIRST_X_ASSUM(MP_TAC o SPEC ``s DIFF v:real->bool``) THEN
13410    ASM_SIMP_TAC std_ss [CLOSED_IN_DIFF, CLOSED_IN_REFL] THEN
13411    SIMP_TAC std_ss [closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
13412    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13413    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
13414    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[],
13415    X_GEN_TAC ``v:real->bool`` THEN DISCH_TAC THEN
13416    FIRST_X_ASSUM(MP_TAC o SPEC ``s DIFF v:real->bool``) THEN
13417    ASM_SIMP_TAC std_ss [OPEN_IN_DIFF, OPEN_IN_REFL] THEN
13418    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
13419    REWRITE_TAC[closed_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
13420    DISCH_THEN(fn th => CONJ_TAC THENL [ASM_SET_TAC[], MP_TAC th]) THEN
13421    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN ASM_SET_TAC[]]
13422QED
13423
13424Theorem UPPER_LOWER_HEMICONTINUOUS_EXPLICIT:
13425   !f:real->real->bool t s.
13426      (!x. x IN s ==> f(x) SUBSET t) /\
13427      (!u. open_in (subtopology euclidean t) u
13428           ==> open_in (subtopology euclidean s)
13429                       {x | x IN s /\ f(x) SUBSET u}) /\
13430      (!u. closed_in (subtopology euclidean t) u
13431           ==> closed_in (subtopology euclidean s)
13432                         {x | x IN s /\ f(x) SUBSET u})
13433      ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {})
13434                ==> ?d. &0 < d /\
13435                        !x'. x' IN s /\ dist(x,x') < d
13436                             ==> (!y. y IN f x
13437                                      ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\
13438                                 (!y'. y' IN f x'
13439                                       ==> ?y. y IN f x /\ dist(y',y) < e)
13440Proof
13441  REPEAT STRIP_TAC THEN
13442  UNDISCH_TAC
13443   ``!u. open_in (subtopology euclidean t) u
13444        ==> open_in (subtopology euclidean s)
13445                    {x | x IN s /\ (f:real->real->bool)(x) SUBSET u}`` THEN
13446  DISCH_THEN(MP_TAC o SPEC
13447   ``t INTER
13448    {a + b | a IN (f:real->real->bool) x /\ b IN ball(0,e)}``) THEN
13449  SIMP_TAC std_ss [OPEN_SUMS, OPEN_BALL, OPEN_IN_OPEN_INTER] THEN
13450  SIMP_TAC std_ss [open_in, SUBSET_RESTRICT] THEN
13451  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
13452  ASM_SIMP_TAC std_ss [GSPECIFICATION, SUBSET_INTER] THEN
13453  KNOW_TAC ``(f :real -> real -> bool) (x :real) SUBSET
13454    {a + b | a IN f x /\ b IN ball ((0 :real),(e :real))}`` THENL
13455   [SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
13456    METIS_TAC[CENTRE_IN_BALL, REAL_ADD_RID],
13457    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
13458    DISCH_THEN(X_CHOOSE_THEN ``d1:real``
13459     (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))] THEN
13460  UNDISCH_TAC
13461   ``!u. closed_in (subtopology euclidean t) u
13462        ==> closed_in (subtopology euclidean s)
13463                    {x | x IN s /\ (f:real->real->bool)(x) SUBSET u}`` THEN
13464  ASM_SIMP_TAC std_ss [LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o
13465    GEN ``a:real`` o SPEC ``t INTER ball(a:real,e / &2)``) THEN
13466  SIMP_TAC std_ss [OPEN_BALL, OPEN_IN_OPEN_INTER] THEN
13467  MP_TAC(SPEC ``closure((f:real->real->bool) x)``
13468    COMPACT_EQ_HEINE_BOREL) THEN
13469  ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC
13470   ``{ball(a:real,e / &2) | a IN (f:real->real->bool) x}``) THEN
13471  SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_IN_IMAGE, OPEN_BALL] THEN
13472  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
13473  SIMP_TAC std_ss [EXISTS_FINITE_SUBSET_IMAGE] THEN
13474  KNOW_TAC ``closure ((f :real -> real -> bool) (x :real)) SUBSET
13475   BIGUNION (IMAGE (\(a :real). ball (a,(e :real) / (2 :real))) (f x))`` THENL
13476   [SIMP_TAC std_ss [CLOSURE_APPROACHABLE, SUBSET_DEF, BIGUNION_IMAGE, GSPECIFICATION] THEN
13477    REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC std_ss [REAL_HALF],
13478    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
13479  DISCH_THEN(X_CHOOSE_THEN ``c:real->bool`` STRIP_ASSUME_TAC) THEN
13480  DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP
13481   (METIS[CLOSURE_SUBSET, SUBSET_TRANS]
13482        ``closure s SUBSET t ==> s SUBSET t``)) THEN
13483  SUBGOAL_THEN
13484   ``open_in (subtopology euclidean s)
13485      (BIGINTER {{x | x IN s /\
13486          ~((f:real->real->bool) x INTER t INTER ball(a,e / &2) = {})} |
13487     a IN c})``
13488  MP_TAC THENL
13489   [MATCH_MP_TAC OPEN_IN_BIGINTER THEN
13490    ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_IN_IMAGE, IMAGE_FINITE,
13491     GSYM INTER_ASSOC] THEN ASM_SIMP_TAC std_ss [IMAGE_EQ_EMPTY] THEN
13492    ASM_SET_TAC[], ALL_TAC] THEN
13493  REWRITE_TAC[open_in] THEN
13494  DISCH_THEN(MP_TAC o SPEC ``x:real`` o CONJUNCT2) THEN
13495  KNOW_TAC ``(x :real) IN
13496   BIGINTER {{x |
13497     x IN (s :real -> bool) /\
13498     (f :real -> real -> bool) x INTER (t :real -> bool) INTER
13499     ball (a,(e :real) / (2 :real)) <> ({} :real -> bool)} |
13500    a IN (c :real -> bool)}`` THENL
13501   [SIMP_TAC std_ss [BIGINTER_GSPEC, GSPECIFICATION] THEN
13502    X_GEN_TAC ``a:real`` THEN DISCH_TAC THEN
13503    ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
13504    EXISTS_TAC ``a:real`` THEN
13505    ASM_REWRITE_TAC[IN_INTER, CENTRE_IN_BALL, REAL_HALF] THEN
13506    ASM_SET_TAC[],
13507    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
13508    DISCH_THEN(X_CHOOSE_THEN ``d2:real``
13509     (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))] THEN
13510  EXISTS_TAC ``min d1 d2:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
13511  X_GEN_TAC ``x':real`` THEN STRIP_TAC THEN CONJ_TAC THENL
13512   [ALL_TAC,
13513    UNDISCH_TAC ``!x'':real.
13514        x'' IN s /\ dist (x'',x) < d1 ==>
13515        f x'' SUBSET {a + b | a IN f x /\ b IN ball (0,e)}`` THEN
13516    DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC ``x':real``) THEN
13517    ASM_REWRITE_TAC[] THEN
13518    KNOW_TAC ``dist (x',x) < d1:real`` THENL
13519    [ASM_MESON_TAC[DIST_SYM], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
13520    SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, EXISTS_PROD, IN_BALL] THEN
13521    SIMP_TAC std_ss [REAL_ARITH ``(x:real = a + b) <=> (x - a = b)``,
13522                DIST_0, ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
13523    REWRITE_TAC[dist]] THEN
13524  UNDISCH_TAC ``!x':real.
13525         x' IN s /\ dist (x',x) < d2 ==>
13526         x' IN
13527         BIGINTER
13528           {{x | x IN s /\ f x INTER t INTER ball (a,e / 2) <> {}} |
13529            a IN c}`` THEN DISCH_TAC THEN
13530  FIRST_X_ASSUM (MP_TAC o SPEC ``x':real``) THEN
13531  ASM_SIMP_TAC std_ss [BIGINTER_GSPEC, GSPECIFICATION] THEN
13532  KNOW_TAC ``dist (x',x) < d2:real`` THENL
13533  [ASM_MESON_TAC[DIST_SYM], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
13534  DISCH_TAC THEN
13535  X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
13536  UNDISCH_TAC ``(f:real->real->bool) x SUBSET
13537               BIGUNION (IMAGE (\a. ball (a,e / &2)) c)`` THEN
13538  REWRITE_TAC[SUBSET_DEF] THEN DISCH_THEN(MP_TAC o SPEC ``y:real``) THEN
13539  ASM_SIMP_TAC std_ss [BIGUNION_IMAGE, GSPECIFICATION, IN_BALL] THEN
13540  DISCH_THEN(X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
13541  UNDISCH_TAC ``!(a' :real).
13542         a' IN (c :real -> bool) ==>
13543         (f :real -> real -> bool) (x' :real) INTER
13544         (t :real -> bool) INTER ball (a',(e :real) / (2 :real)) <>
13545         ({} :real -> bool)`` THEN DISCH_TAC THEN
13546  FIRST_X_ASSUM (MP_TAC o SPEC ``a:real``) THEN
13547  ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY, IN_INTER, IN_BALL] THEN
13548  DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN EXISTS_TAC ``z:real`` THEN
13549  POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13550  METIS_TAC[DIST_TRIANGLE_HALF_L, DIST_SYM]
13551QED
13552
13553(* ------------------------------------------------------------------------- *)
13554(* Connected components, considered as a "connectedness" relation or a set.  *)
13555(* ------------------------------------------------------------------------- *)
13556
13557Definition connected_component[nocompute]:
13558 connected_component s x y <=>
13559        ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t
13560End
13561
13562Theorem CONNECTED_COMPONENT_IN:
13563   !s x y. connected_component s x y ==> x IN s /\ y IN s
13564Proof
13565  REWRITE_TAC[connected_component] THEN SET_TAC[]
13566QED
13567
13568Theorem CONNECTED_COMPONENT_REFL:
13569   !s x:real. x IN s ==> connected_component s x x
13570Proof
13571  REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN
13572  EXISTS_TAC ``{x:real}`` THEN REWRITE_TAC[CONNECTED_SING] THEN
13573  ASM_SET_TAC[]
13574QED
13575
13576Theorem CONNECTED_COMPONENT_REFL_EQ:
13577   !s x:real. connected_component s x x <=> x IN s
13578Proof
13579  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN
13580  REWRITE_TAC[connected_component] THEN SET_TAC[]
13581QED
13582
13583Theorem CONNECTED_COMPONENT_SYM:
13584   !s x y:real. connected_component s x y ==> connected_component s y x
13585Proof
13586  REWRITE_TAC[connected_component] THEN MESON_TAC[]
13587QED
13588
13589Theorem CONNECTED_COMPONENT_TRANS:
13590   !s x y:real.
13591    connected_component s x y /\ connected_component s y z
13592    ==> connected_component s x z
13593Proof
13594  REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN
13595  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC ``t:real->bool``)
13596                             (X_CHOOSE_TAC ``u:real->bool``)) THEN
13597  EXISTS_TAC ``t UNION u:real->bool`` THEN
13598  ASM_REWRITE_TAC[IN_UNION, UNION_SUBSET] THEN
13599  MATCH_MP_TAC CONNECTED_UNION THEN ASM_SET_TAC[]
13600QED
13601
13602Theorem CONNECTED_COMPONENT_OF_SUBSET:
13603   !s t x. s SUBSET t /\ connected_component s x y
13604           ==> connected_component t x y
13605Proof
13606  REWRITE_TAC[connected_component] THEN SET_TAC[]
13607QED
13608
13609Theorem CONNECTED_COMPONENT_SET:
13610   !s x. connected_component s x =
13611            { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}
13612Proof
13613  SIMP_TAC std_ss [GSPECIFICATION, EXTENSION] THEN
13614  SIMP_TAC std_ss [IN_DEF, connected_component]
13615QED
13616
13617Theorem CONNECTED_COMPONENT_BIGUNION:
13618   !s x. connected_component s x =
13619                BIGUNION {t | connected t /\ x IN t /\ t SUBSET s}
13620Proof
13621  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]
13622QED
13623
13624Theorem CONNECTED_COMPONENT_SUBSET:
13625   !s x. (connected_component s x) SUBSET s
13626Proof
13627  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]
13628QED
13629
13630Theorem CONNECTED_CONNECTED_COMPONENT_SET:
13631   !s. connected s <=> !x:real. x IN s ==> (connected_component s x = s)
13632Proof
13633  GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_BIGUNION] THEN EQ_TAC THENL
13634   [SET_TAC[], ALL_TAC] THEN
13635  ASM_CASES_TAC ``s:real->bool = {}`` THEN
13636  ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN
13637  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
13638  DISCH_THEN(X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
13639  DISCH_THEN(MP_TAC o SPEC ``a:real``) THEN ASM_REWRITE_TAC[] THEN
13640  DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_BIGUNION THEN
13641  ASM_SET_TAC[]
13642QED
13643
13644Theorem CONNECTED_COMPONENT_UNIV:
13645   !x. connected_component univ(:real) x = univ(:real)
13646Proof
13647  MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET, CONNECTED_UNIV, IN_UNIV]
13648QED
13649
13650Theorem CONNECTED_COMPONENT_EQ_UNIV:
13651   !s x. (connected_component s x = univ(:real)) <=> (s = univ(:real))
13652Proof
13653  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC std_ss [CONNECTED_COMPONENT_UNIV] THEN
13654  MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> (s = UNIV) ==> (t = UNIV)``) THEN
13655  REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]
13656QED
13657
13658Theorem CONNECTED_COMPONENT_EQ_SELF:
13659   !s x. connected s /\ x IN s ==> (connected_component s x = s)
13660Proof
13661  MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]
13662QED
13663
13664Theorem CONNECTED_IFF_CONNECTED_COMPONENT:
13665   !s. connected s <=>
13666          !x y. x IN s /\ y IN s ==> connected_component s x y
13667Proof
13668  REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN
13669  REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN_DEF, CONNECTED_COMPONENT_IN]
13670QED
13671
13672Theorem CONNECTED_COMPONENT_MAXIMAL:
13673   !s t x:real.
13674        x IN t /\ connected t /\ t SUBSET s
13675        ==> t SUBSET (connected_component s x)
13676Proof
13677  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]
13678QED
13679
13680Theorem CONNECTED_COMPONENT_MONO:
13681   !s t x. s SUBSET t
13682           ==> (connected_component s x) SUBSET (connected_component t x)
13683Proof
13684  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]
13685QED
13686
13687Theorem CONNECTED_CONNECTED_COMPONENT:
13688   !s x. connected(connected_component s x)
13689Proof
13690  REWRITE_TAC[CONNECTED_COMPONENT_BIGUNION] THEN
13691  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_BIGUNION THEN SET_TAC[]
13692QED
13693
13694Theorem CONNECTED_COMPONENT_EQ_EMPTY:
13695   !s x:real. (connected_component s x = {}) <=> ~(x IN s)
13696Proof
13697  REPEAT GEN_TAC THEN EQ_TAC THENL
13698   [REWRITE_TAC[EXTENSION, NOT_IN_EMPTY] THEN
13699    DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
13700    SIMP_TAC std_ss [IN_DEF, CONNECTED_COMPONENT_REFL_EQ],
13701    REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]
13702QED
13703
13704Theorem CONNECTED_COMPONENT_EMPTY:
13705   !x. connected_component {} x = {}
13706Proof
13707  REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY, NOT_IN_EMPTY]
13708QED
13709
13710Theorem CONNECTED_COMPONENT_EQ:
13711   !s x y. y IN connected_component s x
13712           ==> ((connected_component s y = connected_component s x))
13713Proof
13714  REWRITE_TAC[EXTENSION, IN_DEF] THEN
13715  MESON_TAC[CONNECTED_COMPONENT_SYM, CONNECTED_COMPONENT_TRANS]
13716QED
13717
13718Theorem CLOSED_CONNECTED_COMPONENT:
13719   !s x:real. closed s ==> closed(connected_component s x)
13720Proof
13721  REPEAT STRIP_TAC THEN
13722  ASM_CASES_TAC ``(x:real) IN s`` THENL
13723   [ALL_TAC, ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY, CLOSED_EMPTY]] THEN
13724  REWRITE_TAC[GSYM CLOSURE_EQ] THEN
13725  MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
13726  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
13727  SIMP_TAC std_ss [CONNECTED_CLOSURE, CONNECTED_CONNECTED_COMPONENT] THEN
13728  CONJ_TAC THENL
13729   [MATCH_MP_TAC(REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET) THEN
13730    ASM_SIMP_TAC std_ss [IN_DEF, CONNECTED_COMPONENT_REFL_EQ],
13731    MATCH_MP_TAC CLOSURE_MINIMAL THEN
13732    ASM_SIMP_TAC std_ss [CONNECTED_COMPONENT_SUBSET]]
13733QED
13734
13735Theorem CONNECTED_COMPONENT_DISJOINT:
13736   !s a b. DISJOINT (connected_component s a) (connected_component s b) <=>
13737             ~(a IN connected_component s b)
13738Proof
13739  REWRITE_TAC[DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN
13740  REWRITE_TAC[IN_DEF] THEN
13741  MESON_TAC[CONNECTED_COMPONENT_SYM, CONNECTED_COMPONENT_TRANS]
13742QED
13743
13744Theorem CONNECTED_COMPONENT_NONOVERLAP:
13745   !s a b:real.
13746        ((connected_component s a) INTER (connected_component s b) = {}) <=>
13747        ~(a IN s) \/ ~(b IN s) \/
13748        ~(connected_component s a = connected_component s b)
13749Proof
13750  REPEAT GEN_TAC THEN
13751  ASM_CASES_TAC ``(a:real) IN s`` THEN ASM_REWRITE_TAC[] THEN
13752  RULE_ASSUM_TAC(SIMP_RULE std_ss [GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
13753  ASM_SIMP_TAC std_ss [INTER_EMPTY] THEN
13754  ASM_CASES_TAC ``(b:real) IN s`` THEN ASM_REWRITE_TAC[] THEN
13755  RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
13756  ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC
13757   ``connected_component s (a:real) = connected_component s b`` THEN
13758  ASM_REWRITE_TAC[INTER_IDEMPOT, CONNECTED_COMPONENT_EQ_EMPTY] THEN
13759  POP_ASSUM MP_TAC THEN
13760  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN DISCH_TAC THEN
13761  REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
13762  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM DISJOINT_DEF]) THEN
13763  REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]
13764QED
13765
13766Theorem CONNECTED_COMPONENT_OVERLAP:
13767   !s a b:real.
13768        ~((connected_component s a) INTER (connected_component s b) = {}) <=>
13769        a IN s /\ b IN s /\
13770        (connected_component s a = connected_component s b)
13771Proof
13772  REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP, DE_MORGAN_THM]
13773QED
13774
13775Theorem CONNECTED_COMPONENT_SYM_EQ:
13776   !s x y. connected_component s x y <=> connected_component s y x
13777Proof
13778  MESON_TAC[CONNECTED_COMPONENT_SYM]
13779QED
13780
13781Theorem CONNECTED_COMPONENT_EQ_EQ:
13782   !s x y:real.
13783        (connected_component s x = connected_component s y) <=>
13784           ~(x IN s) /\ ~(y IN s) \/
13785           x IN s /\ y IN s /\ connected_component s x y
13786Proof
13787  REPEAT GEN_TAC THEN ASM_CASES_TAC ``(y:real) IN s`` THENL
13788   [ASM_CASES_TAC ``(x:real) IN s`` THEN ASM_REWRITE_TAC[] THENL
13789     [REWRITE_TAC[FUN_EQ_THM] THEN
13790      ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS, CONNECTED_COMPONENT_REFL,
13791                    CONNECTED_COMPONENT_SYM],
13792      ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]],
13793    RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
13794    ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
13795    ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
13796    ASM_REWRITE_TAC[EMPTY_DEF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]
13797QED
13798
13799Theorem CONNECTED_EQ_CONNECTED_COMPONENT_EQ:
13800   !s. connected s <=>
13801       !x y. x IN s /\ y IN s
13802             ==> (connected_component s x = connected_component s y)
13803Proof
13804  SIMP_TAC std_ss [CONNECTED_COMPONENT_EQ_EQ] THEN
13805  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]
13806QED
13807
13808Theorem CONNECTED_COMPONENT_IDEMP:
13809   !s x:real. connected_component (connected_component s x) x =
13810                connected_component s x
13811Proof
13812  REWRITE_TAC[FUN_EQ_THM, connected_component] THEN
13813  REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN
13814  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13815  ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL, SUBSET_TRANS,
13816                CONNECTED_COMPONENT_SUBSET]
13817QED
13818
13819Theorem CONNECTED_COMPONENT_UNIQUE:
13820   !s c x:real.
13821        x IN c /\ c SUBSET s /\ connected c /\
13822        (!c'. x IN c' /\ c' SUBSET s /\ connected c'
13823              ==> c' SUBSET c)
13824        ==> (connected_component s x = c)
13825Proof
13826  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
13827   [FIRST_X_ASSUM MATCH_MP_TAC THEN
13828    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET, CONNECTED_CONNECTED_COMPONENT] THEN
13829    REWRITE_TAC[IN_DEF] THEN ASM_SIMP_TAC std_ss [CONNECTED_COMPONENT_REFL_EQ] THEN
13830    ASM_SET_TAC[],
13831    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]
13832QED
13833
13834Theorem JOINABLE_CONNECTED_COMPONENT_EQ:
13835   !s t x y:real.
13836        connected t /\ t SUBSET s /\
13837        ~(connected_component s x INTER t = {}) /\
13838        ~(connected_component s y INTER t = {})
13839        ==> (connected_component s x = connected_component s y)
13840Proof
13841  REPEAT GEN_TAC THEN
13842  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13843  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13844  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY, IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2
13845   (X_CHOOSE_THEN ``w:real`` STRIP_ASSUME_TAC)
13846   (X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC)) THEN
13847  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
13848  SIMP_TAC std_ss [IN_DEF] THEN
13849  MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
13850  EXISTS_TAC ``z:real`` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_DEF], ALL_TAC] THEN
13851  MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
13852  EXISTS_TAC ``w:real`` THEN CONJ_TAC THENL
13853   [REWRITE_TAC[connected_component] THEN
13854    EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[],
13855    ASM_MESON_TAC[IN_DEF, CONNECTED_COMPONENT_SYM]]
13856QED
13857
13858Theorem BIGUNION_CONNECTED_COMPONENT:
13859   !s:real->bool. BIGUNION {connected_component s x |x| x IN s} = s
13860Proof
13861  GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
13862  SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_GSPEC, CONNECTED_COMPONENT_SUBSET] THEN
13863  SIMP_TAC std_ss [SUBSET_DEF, BIGUNION_GSPEC, GSPECIFICATION] THEN
13864  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN EXISTS_TAC ``x:real`` THEN
13865  ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_DEF] THEN
13866  ASM_SIMP_TAC std_ss [CONNECTED_COMPONENT_REFL_EQ]
13867QED
13868
13869Theorem COMPLEMENT_CONNECTED_COMPONENT_BIGUNION:
13870   !s x:real.
13871     s DIFF connected_component s x =
13872     BIGUNION({connected_component s y | y | y IN s} DELETE
13873            (connected_component s x))
13874Proof
13875  REPEAT GEN_TAC THEN
13876  GEN_REWR_TAC (LAND_CONV o LAND_CONV)
13877    [GSYM BIGUNION_CONNECTED_COMPONENT] THEN
13878  MATCH_MP_TAC(SET_RULE
13879   ``(!x. x IN s DELETE a ==> DISJOINT a x)
13880     ==> (BIGUNION s DIFF a = BIGUNION (s DELETE a))``) THEN
13881  SIMP_TAC std_ss [CONJ_EQ_IMP, FORALL_IN_GSPEC, IN_DELETE] THEN
13882  SIMP_TAC std_ss [CONNECTED_COMPONENT_DISJOINT, CONNECTED_COMPONENT_EQ_EQ] THEN
13883  MESON_TAC[IN_DEF, SUBSET_DEF, CONNECTED_COMPONENT_SUBSET]
13884QED
13885
13886Theorem CLOSED_IN_CONNECTED_COMPONENT:
13887   !s x:real. closed_in (subtopology euclidean s) (connected_component s x)
13888Proof
13889  REPEAT GEN_TAC THEN
13890  ASM_CASES_TAC ``connected_component s (x:real) = {}`` THEN
13891  ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN
13892  RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN
13893  REWRITE_TAC[CLOSED_IN_CLOSED] THEN
13894  EXISTS_TAC ``closure(connected_component s x):real->bool`` THEN
13895  REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
13896  REWRITE_TAC[SUBSET_INTER, CONNECTED_COMPONENT_SUBSET, CLOSURE_SUBSET] THEN
13897  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN
13898  CONJ_TAC THENL
13899   [ASM_REWRITE_TAC[IN_INTER] THEN
13900    MATCH_MP_TAC(REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET) THEN
13901    ASM_SIMP_TAC std_ss [IN_DEF, CONNECTED_COMPONENT_REFL_EQ],
13902    MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
13903    EXISTS_TAC ``connected_component s (x:real)`` THEN
13904    SIMP_TAC std_ss [INTER_SUBSET, CONNECTED_CONNECTED_COMPONENT,
13905                SUBSET_INTER, CONNECTED_COMPONENT_SUBSET, CLOSURE_SUBSET]]
13906QED
13907
13908Theorem BIGUNION_DIFF:
13909   !s t. BIGUNION s DIFF t = BIGUNION {x DIFF t | x IN s}
13910Proof
13911  SIMP_TAC std_ss [BIGUNION_GSPEC] THEN SET_TAC[]
13912QED
13913
13914Theorem OPEN_IN_CONNECTED_COMPONENT:
13915   !s x:real.
13916        FINITE {connected_component s x |x| x IN s}
13917        ==> open_in (subtopology euclidean s) (connected_component s x)
13918Proof
13919  REPEAT STRIP_TAC THEN
13920  SUBGOAL_THEN
13921   ``connected_component s (x:real) =
13922        s DIFF (BIGUNION {connected_component s y |y| y IN s} DIFF
13923                connected_component s x)``
13924  SUBST1_TAC THENL
13925   [REWRITE_TAC[BIGUNION_CONNECTED_COMPONENT] THEN
13926    MATCH_MP_TAC(SET_RULE ``t SUBSET s ==> (t = s DIFF (s DIFF t))``) THEN
13927    SIMP_TAC std_ss [CONNECTED_COMPONENT_SUBSET],
13928    MATCH_MP_TAC OPEN_IN_DIFF THEN
13929    SIMP_TAC std_ss [OPEN_IN_SUBTOPOLOGY_REFL, TOPSPACE_EUCLIDEAN, SUBSET_UNIV] THEN
13930    SIMP_TAC std_ss [BIGUNION_DIFF] THEN
13931    MATCH_MP_TAC CLOSED_IN_BIGUNION THEN SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
13932        CONJ_TAC THENL [METIS_TAC [GSYM IMAGE_DEF, IMAGE_FINITE], ALL_TAC] THEN
13933    X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
13934    SUBGOAL_THEN
13935    ``(connected_component s y DIFF connected_component s x =
13936       connected_component s y) \/
13937      (connected_component s (y:real) DIFF connected_component s x = {})``
13938     (DISJ_CASES_THEN SUBST1_TAC)
13939    THENL
13940     [MATCH_MP_TAC(SET_RULE
13941       ``(~(s INTER t = {}) ==> (s = t)) ==> (s DIFF t = s) \/ (s DIFF t = {})``) THEN
13942      SIMP_TAC std_ss [CONNECTED_COMPONENT_OVERLAP],
13943      REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT],
13944      REWRITE_TAC[CLOSED_IN_EMPTY]]]
13945QED
13946
13947Theorem CONNECTED_COMPONENT_EQUIVALENCE_RELATION:
13948   !R s:real->bool.
13949        (!x y. R x y ==> R y x) /\
13950        (!x y z. R x y /\ R y z ==> R x z) /\
13951        (!a. a IN s
13952             ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
13953                     !x. x IN t ==> R a x)
13954        ==> !a b. connected_component s a b ==> R a b
13955Proof
13956  REPEAT STRIP_TAC THEN
13957  MP_TAC(ISPECL [``R:real->real->bool``, ``connected_component s (a:real)``]
13958    CONNECTED_EQUIVALENCE_RELATION) THEN
13959  ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
13960  KNOW_TAC ``(!(a' :real).
13961        a' IN connected_component (s :real -> bool) (a :real) ==>
13962        ?(t :real -> bool).
13963          open_in (subtopology euclidean (connected_component s a)) t /\
13964          a' IN t /\
13965          !(x :real). x IN t ==> (R :real -> real -> bool) a' x)`` THENL
13966   [X_GEN_TAC ``c:real`` THEN DISCH_TAC THEN
13967    FIRST_X_ASSUM(MP_TAC o SPEC ``c:real``) THEN
13968    KNOW_TAC ``(c :real) IN (s :real -> bool)`` THENL
13969     [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET, SUBSET_DEF],
13970          DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
13971    DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
13972    EXISTS_TAC ``t INTER connected_component s (a:real)`` THEN
13973    ASM_SIMP_TAC std_ss [IN_INTER, OPEN_IN_OPEN] THEN
13974        UNDISCH_TAC ``open_in (subtopology euclidean s) t`` THEN DISCH_TAC THEN
13975    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_IN_OPEN]) THEN
13976    SIMP_TAC std_ss [] THEN
13977    MP_TAC(ISPECL [``s:real->bool``, ``a:real``]
13978        CONNECTED_COMPONENT_SUBSET) THEN
13979    SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
13980    DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [IN_DEF] THEN
13981    REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
13982    ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]
13983QED
13984
13985Theorem CONNECTED_COMPONENT_INTERMEDIATE_SUBSET:
13986   !t u a:real.
13987        connected_component u a SUBSET t /\ t SUBSET u
13988        ==> (connected_component t a = connected_component u a)
13989Proof
13990  REPEAT GEN_TAC THEN ASM_CASES_TAC ``(a:real) IN u`` THENL
13991   [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
13992    ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
13993    CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL, IN_DEF], ALL_TAC] THEN
13994    REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
13995    ASM_SET_TAC[],
13996    ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY, SUBSET_DEF]]
13997QED
13998
13999(* ------------------------------------------------------------------------- *)
14000(* The set of connected components of a set.                                 *)
14001(* ------------------------------------------------------------------------- *)
14002
14003Definition components[nocompute]:
14004  components s = {connected_component s x | x | x:real IN s}
14005End
14006
14007Theorem IN_COMPONENTS:
14008   !u:real->bool s. s IN components u
14009    <=> ?x. x IN u /\ (s = connected_component u x)
14010Proof
14011  REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC
14012  THENL [SET_TAC[], STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
14013  UNDISCH_TAC ``x:real IN u`` THEN SET_TAC[]]
14014QED
14015
14016Theorem BIGUNION_COMPONENTS:
14017    !u:real->bool. u = BIGUNION (components u)
14018Proof
14019    REWRITE_TAC [EXTENSION]
14020 >> REPEAT GEN_TAC >> EQ_TAC
14021 >| [ (* goal 1 (of 2) *)
14022      DISCH_TAC >> REWRITE_TAC [IN_BIGUNION] \\
14023      EXISTS_TAC ``connected_component (u:real->bool) x`` \\
14024      CONJ_TAC >|
14025      [ REWRITE_TAC [CONNECTED_COMPONENT_SET] \\
14026        SUBGOAL_THEN ``?s:real->bool. connected s /\ s SUBSET u /\ x IN s`` MP_TAC >|
14027        [ EXISTS_TAC ``{x:real}`` \\
14028          ASM_REWRITE_TAC [CONNECTED_SING] \\
14029          POP_ASSUM MP_TAC >> SET_TAC [],
14030          SET_TAC [] ],
14031        REWRITE_TAC [components] >> ASM_SET_TAC [] ],
14032      (* goal 2 of 2 *)
14033      REWRITE_TAC [IN_BIGUNION] \\
14034      STRIP_TAC \\
14035      MATCH_MP_TAC (SET_RULE ``!x:real s u. x IN s /\ s SUBSET u ==> x IN u``) \\
14036      EXISTS_TAC ``s :real -> bool`` >> ASM_REWRITE_TAC [] \\
14037      `?(y :real). ((s :real -> bool) = connected_component u y)`
14038                by METIS_TAC [IN_COMPONENTS] \\
14039      ASM_REWRITE_TAC [CONNECTED_COMPONENT_SUBSET] ]
14040QED
14041
14042Theorem PAIRWISE_DISJOINT_COMPONENTS:
14043   !u:real->bool. pairwise DISJOINT (components u)
14044Proof
14045  GEN_TAC THEN REWRITE_TAC[pairwise, DISJOINT_DEF] THEN
14046  MAP_EVERY X_GEN_TAC [``s:real->bool``, ``t:real->bool``] THEN STRIP_TAC THEN
14047  ASSERT_TAC ``(?a. s:real->bool = connected_component u a) /\
14048                ?b. t:real->bool = connected_component u b``
14049  THENL [ASM_MESON_TAC[IN_COMPONENTS],
14050  ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]
14051QED
14052
14053Theorem IN_COMPONENTS_NONEMPTY:
14054   !s c. c IN components s ==> ~(c = {})
14055Proof
14056  REPEAT GEN_TAC THEN SIMP_TAC std_ss [components, GSPECIFICATION] THEN
14057  STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]
14058QED
14059
14060Theorem IN_COMPONENTS_SUBSET:
14061   !s c. c IN components s ==> c SUBSET s
14062Proof
14063  REPEAT GEN_TAC THEN SIMP_TAC std_ss [components, GSPECIFICATION] THEN
14064  STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]
14065QED
14066
14067Theorem IN_COMPONENTS_CONNECTED:
14068   !s c. c IN components s ==> connected c
14069Proof
14070  REPEAT GEN_TAC THEN SIMP_TAC std_ss [components, GSPECIFICATION] THEN
14071  STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]
14072QED
14073
14074Theorem IN_COMPONENTS_MAXIMAL:
14075   !s c:real->bool.
14076        c IN components s <=>
14077        ~(c = {}) /\ c SUBSET s /\ connected c /\
14078        !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c'
14079             ==> (c' = c)
14080Proof
14081  REPEAT GEN_TAC THEN SIMP_TAC std_ss [components, GSPECIFICATION] THEN EQ_TAC THENL
14082   [DISCH_THEN(X_CHOOSE_THEN ``x:real`` STRIP_ASSUME_TAC) THEN
14083    ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY, CONNECTED_COMPONENT_SUBSET,
14084                    CONNECTED_CONNECTED_COMPONENT] THEN
14085    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
14086    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
14087    ASM_MESON_TAC[CONNECTED_COMPONENT_REFL, IN_DEF, SUBSET_DEF],
14088    STRIP_TAC THEN
14089        UNDISCH_TAC ``(c:real->bool) <> {}`` THEN DISCH_TAC THEN
14090    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
14091        STRIP_TAC THEN EXISTS_TAC ``x:real`` THEN CONJ_TAC THENL
14092        [ALL_TAC, ASM_SET_TAC[]] THEN
14093    MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN
14094    ASM_REWRITE_TAC[] THEN X_GEN_TAC ``c':real->bool`` THEN STRIP_TAC THEN
14095    REWRITE_TAC[SET_RULE ``c' SUBSET c <=> (c' UNION c = c)``] THEN
14096    FIRST_X_ASSUM MATCH_MP_TAC THEN
14097    REPEAT(CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC]) THEN
14098    MATCH_MP_TAC CONNECTED_UNION THEN ASM_SET_TAC[]]
14099QED
14100
14101Theorem JOINABLE_COMPONENTS_EQ:
14102   !s t c1 c2.
14103        connected t /\ t SUBSET s /\
14104        c1 IN components s /\ c2 IN components s /\
14105        ~(c1 INTER t = {}) /\ ~(c2 INTER t = {})
14106        ==> (c1 = c2)
14107Proof
14108  SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM, components, FORALL_IN_GSPEC] THEN
14109  MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]
14110QED
14111
14112Theorem CLOSED_IN_COMPONENT:
14113   !s c:real->bool.
14114        c IN components s ==> closed_in (subtopology euclidean s) c
14115Proof
14116  SIMP_TAC std_ss [components, FORALL_IN_GSPEC, CLOSED_IN_CONNECTED_COMPONENT]
14117QED
14118
14119Theorem CLOSED_COMPONENTS:
14120   !s c. closed s /\ c IN components s ==> closed c
14121Proof
14122  SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM, components, FORALL_IN_GSPEC] THEN
14123  SIMP_TAC std_ss [CLOSED_CONNECTED_COMPONENT]
14124QED
14125
14126Theorem COMPACT_COMPONENTS:
14127   !s c:real->bool. compact s /\ c IN components s ==> compact c
14128Proof
14129  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
14130  MESON_TAC[CLOSED_COMPONENTS, IN_COMPONENTS_SUBSET, BOUNDED_SUBSET]
14131QED
14132
14133Theorem CONTINUOUS_ON_COMPONENTS_GEN:
14134   !f:real->real s.
14135        (!c. c IN components s
14136             ==> open_in (subtopology euclidean s) c /\ f continuous_on c)
14137        ==> f continuous_on s
14138Proof
14139  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
14140  DISCH_TAC THEN X_GEN_TAC ``t:real->bool`` THEN DISCH_TAC THEN
14141  SUBGOAL_THEN
14142   ``{x | x IN s /\ (f:real->real) x IN t} =
14143     BIGUNION {{x | x IN c /\ f x IN t} | c IN components s}``
14144  SUBST1_TAC THENL
14145   [GEN_REWR_TAC LAND_CONV [METIS [BIGUNION_COMPONENTS] ``{x | x IN s /\ f x IN t} =
14146          {x | x IN BIGUNION (components s) /\ f x IN t}``] THEN
14147    SIMP_TAC std_ss [BIGUNION_GSPEC, IN_BIGUNION] THEN SET_TAC[],
14148    MATCH_MP_TAC OPEN_IN_BIGUNION THEN SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
14149    METIS_TAC[OPEN_IN_TRANS]]
14150QED
14151
14152Theorem CONTINUOUS_ON_COMPONENTS_FINITE:
14153   !f:real->real s.
14154        FINITE(components s) /\
14155        (!c. c IN components s ==> f continuous_on c)
14156        ==> f continuous_on s
14157Proof
14158  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
14159  DISCH_TAC THEN X_GEN_TAC ``t:real->bool`` THEN DISCH_TAC THEN
14160  SUBGOAL_THEN
14161   ``{x | x IN s /\ (f:real->real) x IN t} =
14162    BIGUNION {{x | x IN c /\ f x IN t} | c IN components s}``
14163  SUBST1_TAC THENL
14164   [GEN_REWR_TAC LAND_CONV [METIS [BIGUNION_COMPONENTS] ``{x | x IN s /\ f x IN t} =
14165          {x | x IN BIGUNION (components s) /\ f x IN t}``] THEN
14166    SIMP_TAC std_ss [BIGUNION_GSPEC, IN_BIGUNION] THEN SET_TAC[],
14167    MATCH_MP_TAC CLOSED_IN_BIGUNION THEN
14168    ASM_SIMP_TAC std_ss [GSYM IMAGE_DEF, IMAGE_FINITE, FORALL_IN_IMAGE] THEN
14169    METIS_TAC[CLOSED_IN_TRANS, CLOSED_IN_COMPONENT]]
14170QED
14171
14172Theorem COMPONENTS_NONOVERLAP:
14173   !s c c'. c IN components s /\ c' IN components s
14174            ==> ((c INTER c' = {}) <=> ~(c = c'))
14175Proof
14176  SIMP_TAC std_ss [components, GSPECIFICATION] THEN REPEAT STRIP_TAC THEN
14177  ASM_SIMP_TAC std_ss [CONNECTED_COMPONENT_NONOVERLAP]
14178QED
14179
14180Theorem COMPONENTS_EQ:
14181   !s c c'. c IN components s /\ c' IN components s
14182            ==> ((c = c') <=> ~(c INTER c' = {}))
14183Proof
14184  MESON_TAC[COMPONENTS_NONOVERLAP]
14185QED
14186
14187Theorem COMPONENTS_EQ_EMPTY:
14188   !s. (components s = {}) <=> (s = {})
14189Proof
14190  GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN
14191  SIMP_TAC std_ss [components, connected_component, GSPECIFICATION] THEN
14192  SET_TAC[]
14193QED
14194
14195Theorem COMPONENTS_EMPTY:
14196   components {} = {}
14197Proof
14198  REWRITE_TAC[COMPONENTS_EQ_EMPTY]
14199QED
14200
14201Theorem CONNECTED_EQ_CONNECTED_COMPONENTS_EQ:
14202   !s. connected s <=>
14203       !c c'. c IN components s /\ c' IN components s ==> (c = c')
14204Proof
14205  SIMP_TAC std_ss [components, GSPECIFICATION] THEN
14206  MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]
14207QED
14208
14209Theorem COMPONENTS_EQ_SING_N_EXISTS:
14210   (!s:real->bool. (components s = {s}) <=> connected s /\ ~(s = {})) /\
14211   (!s:real->bool. (?a. (components s = {a})) <=> connected s /\ ~(s = {}))
14212Proof
14213  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``s:real->bool`` THEN
14214  MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p)
14215                     ==> (p <=> r) /\ (q <=> r)`) THEN
14216  REPEAT CONJ_TAC THENL
14217   [MESON_TAC[],
14218    STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN
14219    ASM_MESON_TAC[IN_SING, COMPONENTS_EQ_EMPTY, NOT_INSERT_EMPTY],
14220    STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN
14221    REWRITE_TAC[IN_SING] THEN
14222    SIMP_TAC std_ss [components, GSPECIFICATION] THEN
14223    ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET, MEMBER_NOT_EMPTY]]
14224QED
14225
14226Theorem COMPONENTS_EQ_SING:
14227   (!s:real->bool. (components s = {s}) <=> connected s /\ ~(s = {}))
14228Proof
14229   REWRITE_TAC [COMPONENTS_EQ_SING_N_EXISTS]
14230QED
14231
14232Theorem COMPONENTS_EQ_SING_EXISTS:
14233    (!s:real->bool. (?a. (components s = {a})) <=> connected s /\ ~(s = {}))
14234Proof
14235   REWRITE_TAC [COMPONENTS_EQ_SING_N_EXISTS]
14236QED
14237
14238Theorem COMPONENTS_UNIV:
14239   components univ(:real) = {univ(:real)}
14240Proof
14241  REWRITE_TAC[COMPONENTS_EQ_SING, CONNECTED_UNIV, UNIV_NOT_EMPTY]
14242QED
14243
14244Theorem CONNECTED_EQ_COMPONENTS_SUBSET_SING:
14245   !s:real->bool. connected s <=> components s SUBSET {s}
14246Proof
14247  GEN_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
14248  ASM_REWRITE_TAC[COMPONENTS_EMPTY, CONNECTED_EMPTY, EMPTY_SUBSET] THEN
14249  REWRITE_TAC[SET_RULE ``s SUBSET {a} <=> (s = {}) \/ (s = {a})``] THEN
14250  ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY, COMPONENTS_EQ_SING]
14251QED
14252
14253Theorem CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS:
14254   !s:real->bool. connected s <=> ?a. components s SUBSET {a}
14255Proof
14256  GEN_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
14257  ASM_REWRITE_TAC[COMPONENTS_EMPTY, CONNECTED_EMPTY, EMPTY_SUBSET] THEN
14258  REWRITE_TAC[SET_RULE ``s SUBSET {a} <=> (s = {}) \/ (s = {a})``] THEN
14259  ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY, COMPONENTS_EQ_SING_EXISTS]
14260QED
14261
14262Theorem IN_COMPONENTS_SELF:
14263   !s:real->bool. s IN components s <=> connected s /\ ~(s = {})
14264Proof
14265  GEN_TAC THEN EQ_TAC THENL
14266   [MESON_TAC[IN_COMPONENTS_NONEMPTY, IN_COMPONENTS_CONNECTED],
14267    SIMP_TAC std_ss [GSYM COMPONENTS_EQ_SING, IN_SING]]
14268QED
14269
14270Theorem COMPONENTS_MAXIMAL:
14271   !s t c:real->bool.
14272     c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {})
14273     ==> t SUBSET c
14274Proof
14275  SIMP_TAC std_ss [CONJ_EQ_IMP, components, FORALL_IN_GSPEC] THEN
14276  REPEAT STRIP_TAC THEN
14277  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
14278  SIMP_TAC std_ss [IN_INTER, LEFT_IMP_EXISTS_THM] THEN
14279  X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
14280  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
14281  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]
14282QED
14283
14284Theorem COMPONENTS_UNIQUE:
14285   !s:real->bool k.
14286        (BIGUNION k = s) /\
14287        (!c. c IN k
14288             ==> connected c /\ ~(c = {}) /\
14289                 !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> (c' = c))
14290        ==> (components s = k)
14291Proof
14292  REPEAT STRIP_TAC THEN GEN_REWR_TAC I [EXTENSION] THEN
14293  X_GEN_TAC ``c:real->bool`` THEN REWRITE_TAC[IN_COMPONENTS] THEN
14294  EQ_TAC THENL
14295   [DISCH_THEN(X_CHOOSE_THEN ``x:real``
14296     (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
14297        UNDISCH_TAC `` !c. c IN k ==>
14298            connected c /\ c <> {} /\
14299            !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> (c' = c)`` THEN DISCH_TAC THEN
14300    FIRST_ASSUM(MP_TAC o SPEC ``x:real`` o REWRITE_RULE [EXTENSION]) THEN
14301    REWRITE_TAC[IN_BIGUNION] THEN ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
14302    X_GEN_TAC ``c:real->bool`` THEN STRIP_TAC THEN
14303    SUBGOAL_THEN ``connected_component s (x:real) = c``
14304     (fn th => ASM_REWRITE_TAC[th]) THEN
14305    MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
14306    FIRST_X_ASSUM(MP_TAC o SPEC ``c:real->bool``) THEN
14307    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14308    CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
14309    X_GEN_TAC ``c':real->bool`` THEN STRIP_TAC THEN
14310    REWRITE_TAC[SET_RULE ``c' SUBSET c <=> (c' UNION c = c)``] THEN
14311    FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL
14312     [MATCH_MP_TAC CONNECTED_UNION, ASM_SET_TAC[]] THEN
14313    ASM_SET_TAC[],
14314    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``c:real->bool``) THEN
14315    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
14316        UNDISCH_TAC ``c <> {}:real->bool`` THEN DISCH_TAC THEN
14317    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
14318        STRIP_TAC THEN EXISTS_TAC ``x:real`` THEN
14319    CONJ_TAC THENL [ASM_SET_TAC[], CONV_TAC SYM_CONV] THEN
14320    FIRST_X_ASSUM MATCH_MP_TAC THEN
14321    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT, CONNECTED_COMPONENT_SUBSET] THEN
14322    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
14323    ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]]
14324QED
14325
14326Theorem COMPONENTS_UNIQUE_EQ:
14327   !s:real->bool k.
14328        (components s = k) <=>
14329        (BIGUNION k = s) /\
14330        (!c. c IN k
14331             ==> connected c /\ ~(c = {}) /\
14332                 !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> (c' = c))
14333Proof
14334  REPEAT GEN_TAC THEN EQ_TAC THENL
14335   [DISCH_THEN(SUBST1_TAC o SYM), REWRITE_TAC[COMPONENTS_UNIQUE]] THEN
14336  REWRITE_TAC[GSYM BIGUNION_COMPONENTS] THEN
14337  X_GEN_TAC ``c:real->bool`` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
14338   [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED],
14339    ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY],
14340    RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN
14341    ASM_MESON_TAC[SUBSET_EMPTY]]
14342QED
14343
14344Theorem EXISTS_COMPONENT_SUPERSET:
14345   !s t:real->bool.
14346        t SUBSET s /\ ~(s = {}) /\ connected t
14347        ==> ?c. c IN components s /\ t SUBSET c
14348Proof
14349  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``t:real->bool = {}`` THENL
14350   [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN
14351    ASM_MESON_TAC[COMPONENTS_EQ_EMPTY, MEMBER_NOT_EMPTY],
14352    FIRST_X_ASSUM(X_CHOOSE_TAC ``a:real`` o
14353      REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
14354    EXISTS_TAC ``connected_component s (a:real)`` THEN
14355    REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL
14356     [ASM_SET_TAC[], ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]
14357QED
14358
14359Theorem COMPONENTS_INTERMEDIATE_SUBSET:
14360   !s t u:real->bool.
14361        s IN components u /\ s SUBSET t /\ t SUBSET u
14362        ==> s IN components t
14363Proof
14364  REPEAT GEN_TAC THEN SIMP_TAC std_ss [IN_COMPONENTS, GSYM LEFT_EXISTS_AND_THM] THEN
14365  MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET, SUBSET_DEF,
14366            CONNECTED_COMPONENT_REFL, IN_DEF, CONNECTED_COMPONENT_SUBSET]
14367QED
14368
14369Theorem IN_COMPONENTS_BIGUNION_COMPLEMENT:
14370   !s c:real->bool.
14371        c IN components s
14372        ==> (s DIFF c = BIGUNION(components s DELETE c))
14373Proof
14374  SIMP_TAC std_ss [components, FORALL_IN_GSPEC,
14375              COMPLEMENT_CONNECTED_COMPONENT_BIGUNION]
14376QED
14377
14378Theorem CONNECTED_SUBSET_CLOPEN:
14379   !u s c:real->bool.
14380        closed_in (subtopology euclidean u) s /\
14381        open_in (subtopology euclidean u) s /\
14382        connected c /\ c SUBSET u /\ ~(c INTER s = {})
14383        ==> c SUBSET s
14384Proof
14385  REPEAT STRIP_TAC THEN
14386  UNDISCH_TAC ``connected c`` THEN DISCH_TAC THEN
14387  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [CONNECTED_CLOSED_IN]) THEN
14388  SIMP_TAC std_ss [NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o
14389    SPECL [``c INTER s:real->bool``, ``c DIFF s:real->bool``]) THEN
14390  KNOW_TAC ``~((((closed_in (subtopology euclidean (c :real -> bool))
14391               (c INTER (s :real -> bool)) /\
14392               closed_in (subtopology euclidean c) (c DIFF s)) /\
14393               (c SUBSET c INTER s UNION (c DIFF s))) /\
14394               (c INTER s INTER (c DIFF s) = ({} :real -> bool))) /\
14395     ~(c SUBSET s)) ==> c SUBSET s`` THENL
14396         [ALL_TAC, METIS_TAC [CONJ_ASSOC, SET_RULE ``(c DIFF s = {}) <=> c SUBSET s``]] THEN
14397  MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN
14398  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
14399  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
14400  CONJ_TAC THENL
14401   [UNDISCH_TAC ``closed_in (subtopology euclidean u) s`` THEN DISCH_TAC THEN
14402    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [CLOSED_IN_CLOSED]),
14403        UNDISCH_TAC ``open_in (subtopology euclidean u) s`` THEN DISCH_TAC THEN
14404    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_IN_OPEN])] THEN
14405  DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
14406  REWRITE_TAC[OPEN_IN_OPEN, CLOSED_IN_CLOSED] THENL
14407   [EXISTS_TAC ``t:real->bool``, EXISTS_TAC ``univ(:real) DIFF t``] THEN
14408  ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM_SET_TAC[]
14409QED
14410
14411Theorem CLOPEN_BIGUNION_COMPONENTS:
14412   !u s:real->bool.
14413        closed_in (subtopology euclidean u) s /\
14414        open_in (subtopology euclidean u) s
14415        ==> ?k. k SUBSET components u /\ (s = BIGUNION k)
14416Proof
14417  REPEAT STRIP_TAC THEN
14418  EXISTS_TAC ``{c:real->bool | c IN components u /\ ~(c INTER s = {})}`` THEN
14419  SIMP_TAC std_ss [SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
14420  CONJ_TAC THENL
14421   [MP_TAC(ISPEC ``u:real->bool`` BIGUNION_COMPONENTS) THEN
14422    FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[],
14423    SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_GSPEC] THEN
14424    REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN
14425    EXISTS_TAC ``u:real->bool`` THEN
14426    ASM_MESON_TAC[IN_COMPONENTS_CONNECTED, IN_COMPONENTS_SUBSET]]
14427QED
14428
14429Theorem CLOPEN_IN_COMPONENTS:
14430   !u s:real->bool.
14431        closed_in (subtopology euclidean u) s /\
14432        open_in (subtopology euclidean u) s /\
14433        connected s /\ ~(s = {})
14434        ==> s IN components u
14435Proof
14436  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
14437  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14438  FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_BIGUNION_COMPONENTS) THEN
14439  DISCH_THEN(X_CHOOSE_THEN ``k:(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
14440  ASM_CASES_TAC ``k:(real->bool)->bool = {}`` THEN
14441  ASM_REWRITE_TAC[BIGUNION_EMPTY] THEN
14442  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
14443  DISCH_THEN(X_CHOOSE_TAC ``c:real->bool``) THEN
14444  ASM_CASES_TAC ``k = {c:real->bool}`` THENL
14445   [METIS_TAC[BIGUNION_SING, GSYM SING_SUBSET], ALL_TAC] THEN
14446  MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN
14447  SUBGOAL_THEN ``?c':real->bool. c' IN k /\ ~(c = c')`` STRIP_ASSUME_TAC THENL
14448   [ASM_MESON_TAC[SET_RULE
14449     ``a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)``],
14450    REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN
14451    DISCH_THEN(MP_TAC o SPECL [``c:real->bool``, ``c':real->bool``]) THEN
14452    ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN
14453    MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN
14454    EXISTS_TAC ``u:real->bool`` THEN
14455    MP_TAC(ISPEC ``u:real->bool`` BIGUNION_COMPONENTS) THEN ASM_SET_TAC[]]
14456QED
14457
14458(* ------------------------------------------------------------------------- *)
14459(* Continuity implies uniform continuity on a compact domain.                *)
14460(* ------------------------------------------------------------------------- *)
14461
14462Theorem COMPACT_UNIFORMLY_EQUICONTINUOUS:
14463   !(fs:(real->real)->bool) s.
14464     (!x e. x IN s /\ &0 < e
14465            ==> ?d. &0 < d /\
14466                    (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d
14467                            ==> dist (f x',f x) < e)) /\
14468     compact s
14469     ==> !e. &0 < e
14470             ==> ?d. &0 < d /\
14471                     !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d
14472                              ==> dist(f x',f x) < e
14473Proof
14474  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
14475  DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
14476  SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
14477  X_GEN_TAC ``d:real->real->real`` THEN DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN
14478  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN
14479  DISCH_THEN(MP_TAC o SPEC
14480    ``{ ball(x:real,d x (e / &2:real)) | x IN s}``) THEN
14481  SIMP_TAC std_ss [FORALL_IN_GSPEC, OPEN_BALL, BIGUNION_GSPEC, SUBSET_DEF, GSPECIFICATION] THEN
14482  KNOW_TAC ``(!(x :real).
14483        x IN (s :real -> bool) ==>
14484        ?(x' :real).
14485          x' IN s /\
14486          x IN
14487          ball
14488            (x',
14489             (d :real -> real -> real) x'
14490               ((e :real) / (2 :real))))`` THENL
14491  [ASM_MESON_TAC[CENTRE_IN_BALL, REAL_HALF], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
14492  DISCH_THEN (X_CHOOSE_TAC ``k:real``) THEN EXISTS_TAC ``k:real`` THEN
14493  POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14494  MAP_EVERY X_GEN_TAC [``f:real->real``, ``u:real``, ``v:real``] THEN
14495  STRIP_TAC THEN FIRST_X_ASSUM(fn th => MP_TAC(SPEC ``v:real`` th) THEN
14496    ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN
14497  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14498  DISCH_THEN(fn th =>
14499    MP_TAC(SPEC ``u:real`` th) THEN MP_TAC(SPEC ``v:real`` th)) THEN
14500  ASM_SIMP_TAC std_ss [DIST_REFL] THEN POP_ASSUM MP_TAC THEN
14501  DISCH_THEN (X_CHOOSE_TAC ``w:real``) THEN ASM_REWRITE_TAC [] THEN
14502  ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN
14503  ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN
14504  FIRST_X_ASSUM(MP_TAC o SPECL [``w:real``, ``e / &2:real``]) THEN
14505  ASM_REWRITE_TAC[REAL_HALF] THEN
14506  DISCH_THEN(MP_TAC o SPEC ``f:real->real`` o CONJUNCT2) THEN
14507  DISCH_THEN(fn th => MP_TAC(SPEC ``u:real`` th) THEN
14508                        MP_TAC(SPEC ``v:real`` th)) THEN
14509  ASM_REWRITE_TAC[] THEN GEN_REWR_TAC (LAND_CONV o LAND_CONV) [DIST_SYM] THEN
14510  REWRITE_TAC [dist] THEN GEN_REWR_TAC (RAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
14511  REAL_ARITH_TAC
14512QED
14513
14514Theorem COMPACT_UNIFORMLY_CONTINUOUS:
14515   !f:real->real s.
14516        f continuous_on s /\ compact s ==> f uniformly_continuous_on s
14517Proof
14518  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on, uniformly_continuous_on] THEN
14519  STRIP_TAC THEN
14520  MP_TAC(ISPECL [``{f:real->real}``, ``s:real->bool``]
14521        COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN
14522  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, CONJ_EQ_IMP, IN_SING, UNWIND_FORALL_THM2] THEN
14523  ASM_MESON_TAC[]
14524QED
14525
14526(* ------------------------------------------------------------------------- *)
14527(* A uniformly convergent limit of continuous functions is continuous.       *)
14528(* ------------------------------------------------------------------------- *)
14529
14530Theorem ABS_TRIANGLE_LE:
14531   !x y. abs(x) + abs(y) <= e ==> abs(x + y) <= e:real
14532Proof
14533  METIS_TAC[REAL_LE_TRANS, ABS_TRIANGLE]
14534QED
14535
14536Theorem CONTINUOUS_UNIFORM_LIMIT:
14537   !net f:'a->real->real g s.
14538        ~(trivial_limit net) /\
14539        eventually (\n. (f n) continuous_on s) net /\
14540        (!e. &0 < e
14541             ==> eventually (\n. !x. x IN s ==> abs(f n x - g x) < e) net)
14542        ==> g continuous_on s
14543Proof
14544  REWRITE_TAC[continuous_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
14545  X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
14546  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
14547  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &3:real``) THEN
14548  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
14549  UNDISCH_TAC ``eventually
14550        (\n. !x. x IN s ==>
14551             !e. 0 < e ==>
14552               ?d. 0 < d /\
14553                 !x'. x' IN s /\ dist (x',x) < d ==>
14554                   dist (f n x',f n x) < e) net`` THEN DISCH_TAC THEN
14555  FIRST_X_ASSUM(fn th => MP_TAC th THEN REWRITE_TAC[AND_IMP_INTRO] THEN
14556        GEN_REWR_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN
14557  DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
14558  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC ``a:'a`` THEN
14559  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC ``x:real``) ASSUME_TAC) THEN
14560  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN
14561  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
14562  DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN EXISTS_TAC ``d:real`` THEN
14563  POP_ASSUM MP_TAC THEN
14564  MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
14565  DISCH_TAC THEN X_GEN_TAC ``y:real`` THEN POP_ASSUM (MP_TAC o Q.SPEC `y:real`) THEN
14566  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
14567  FIRST_X_ASSUM(fn th =>
14568   MP_TAC(SPEC ``x:real`` th) THEN MP_TAC(SPEC ``y:real`` th)) THEN
14569  ASM_REWRITE_TAC[] THEN SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
14570  MATCH_MP_TAC(REAL_ARITH ``w <= x + y + z
14571    ==> x * &3 < e ==> y * &3 < e ==> z * &3 < e ==> w < e:real``) THEN
14572  REWRITE_TAC[dist] THEN
14573  SUBST1_TAC(REAL_ARITH
14574   ``(g:real->real) y - g x =
14575    -(f (a:'a) y - g y) + (f a x - g x) + (f a y - f a x)``) THEN
14576  MATCH_MP_TAC ABS_TRIANGLE_LE THEN SIMP_TAC std_ss [ABS_NEG, REAL_LE_LADD] THEN
14577  MATCH_MP_TAC REAL_LE_ADD2 THEN SIMP_TAC std_ss [REAL_LE_REFL] THEN
14578  MATCH_MP_TAC ABS_TRIANGLE_LE THEN REWRITE_TAC[ABS_NEG, REAL_LE_REFL]
14579QED
14580
14581(* ------------------------------------------------------------------------- *)
14582(* Topological stuff lifted from and dropped to R                            *)
14583(* ------------------------------------------------------------------------- *)
14584
14585Theorem OPEN:
14586   !s. open s <=>
14587        !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s
14588Proof
14589  REWRITE_TAC[open_def, dist]
14590QED
14591
14592Theorem CLOSED:
14593   !s. closed s <=>
14594        !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e)
14595            ==> x IN s
14596Proof
14597   SIMP_TAC std_ss [open_def, closed_def, dist, IN_DIFF, IN_UNIV] THEN
14598   SET_TAC []
14599QED
14600
14601Theorem CONTINUOUS_AT_RANGE:
14602   !f x. f continuous (at x) <=>
14603                !e. &0 < e
14604                    ==> ?d. &0 < d /\
14605                            (!x'. abs(x' - x) < d
14606                                  ==> abs(f x' - f x) < e)
14607Proof
14608  REWRITE_TAC[continuous_at, o_THM, dist] THEN REWRITE_TAC[dist]
14609QED
14610
14611Theorem CONTINUOUS_ON_RANGE:
14612   !f s. f continuous_on s <=>
14613         !x. x IN s
14614             ==> !e. &0 < e
14615                     ==> ?d. &0 < d /\
14616                             (!x'. x' IN s /\ abs(x' - x) < d
14617                                   ==> abs(f x' - f x) < e)
14618Proof
14619  REWRITE_TAC[continuous_on, o_THM, dist] THEN REWRITE_TAC[dist]
14620QED
14621
14622Theorem CONTINUOUS_ABS_COMPOSE:
14623   !net f:'a->real.
14624        f continuous net
14625        ==> (\x. abs(f x)) continuous net
14626Proof
14627  REPEAT GEN_TAC THEN REWRITE_TAC[continuous, tendsto] THEN
14628  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
14629  MATCH_MP_TAC MONO_IMP THEN
14630  REWRITE_TAC[] THEN
14631  MATCH_MP_TAC(REWRITE_RULE[CONJ_EQ_IMP] EVENTUALLY_MONO) THEN
14632  SIMP_TAC std_ss [dist] THEN REAL_ARITH_TAC
14633QED
14634
14635Theorem CONTINUOUS_ON_ABS_COMPOSE:
14636   !f:real->real s.
14637        f continuous_on s
14638        ==> (\x. abs(f x)) continuous_on s
14639Proof
14640  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_ABS_COMPOSE]
14641QED
14642
14643Theorem CONTINUOUS_AT_ABS:
14644   !x. abs continuous (at x)
14645Proof
14646  REWRITE_TAC[CONTINUOUS_AT_RANGE] THEN
14647  METIS_TAC [ABS_SUB_ABS, REAL_LET_TRANS]
14648QED
14649
14650Theorem CONTINUOUS_AT_DIST:
14651   !a:real x. (\x. dist(a,x)) continuous (at x)
14652Proof
14653  REWRITE_TAC[CONTINUOUS_AT_RANGE, dist] THEN
14654  METIS_TAC[REAL_ARITH ``abs(abs(a:real - x) - abs(a - y)) <= abs(x - y)``,
14655            REAL_LET_TRANS]
14656QED
14657
14658Theorem CONTINUOUS_ON_DIST:
14659   !a s. (\x. dist(a,x)) continuous_on s
14660Proof
14661  REWRITE_TAC[CONTINUOUS_ON_RANGE, dist] THEN
14662  METIS_TAC [REAL_ARITH ``abs(abs(a:real - x) - abs(a - y)) <= abs(x - y)``,
14663            REAL_LET_TRANS]
14664QED
14665
14666(* ------------------------------------------------------------------------- *)
14667(* Hence some handy theorems on distance, diameter etc. of/from a set.       *)
14668(* ------------------------------------------------------------------------- *)
14669
14670Theorem COMPACT_ATTAINS_SUP:
14671   !s. compact s /\ ~(s = {})
14672       ==> ?x. x IN s /\ !y. y IN s ==> y <= x
14673Proof
14674  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN
14675  MP_TAC(SPEC ``s:real->bool`` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN
14676  STRIP_TAC THEN EXISTS_TAC ``sup (s:real->bool)`` THEN ASM_SIMP_TAC std_ss [] THEN
14677  METIS_TAC [CLOSED, REAL_ARITH ``s <= s - e <=> ~(&0 < e:real)``,
14678             REAL_ARITH ``x <= s /\ ~(x <= s - e) ==> abs(x - s) < e:real``]
14679QED
14680
14681Theorem COMPACT_ATTAINS_INF:
14682   !s. compact s /\ ~(s = {})
14683       ==> ?x. x IN s /\ !y. y IN s ==> x <= y
14684Proof
14685  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN
14686  MP_TAC(SPEC ``s:real->bool`` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN
14687  STRIP_TAC THEN EXISTS_TAC ``inf (s:real->bool)`` THEN ASM_REWRITE_TAC[] THEN
14688  METIS_TAC[ CLOSED, REAL_ARITH ``s + e <= s <=> ~(&0 < e:real)``,
14689                REAL_ARITH ``s <= x /\ ~(s + e <= x) ==> abs(x - s) < e:real``]
14690QED
14691
14692Theorem CONTINUOUS_ATTAINS_SUP:
14693   !f:real->real s.
14694        compact s /\ ~(s = {}) /\ (f) continuous_on s
14695        ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)
14696Proof
14697  REPEAT STRIP_TAC THEN
14698  MP_TAC(SPEC ``IMAGE (f:real->real) s`` COMPACT_ATTAINS_SUP) THEN
14699  ASM_SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, COMPACT_CONTINUOUS_IMAGE, IMAGE_EQ_EMPTY] THEN
14700  MESON_TAC[IN_IMAGE]
14701QED
14702
14703Theorem CONTINUOUS_ATTAINS_INF:
14704   !f:real->real s.
14705        compact s /\ ~(s = {}) /\ (f) continuous_on s
14706        ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)
14707Proof
14708  REPEAT STRIP_TAC THEN
14709  MP_TAC(SPEC ``IMAGE (f:real->real) s`` COMPACT_ATTAINS_INF) THEN
14710  ASM_SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, COMPACT_CONTINUOUS_IMAGE, IMAGE_EQ_EMPTY] THEN
14711  MESON_TAC[IN_IMAGE]
14712QED
14713
14714Theorem DISTANCE_ATTAINS_SUP:
14715   !s a. compact s /\ ~(s = {})
14716         ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)
14717Proof
14718  REPEAT STRIP_TAC THEN
14719  ONCE_REWRITE_TAC [METIS [] ``dist (a,x) = (\x. dist (a,x)) x:real``] THEN
14720  MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN
14721  ASM_REWRITE_TAC[CONTINUOUS_ON_RANGE] THEN REWRITE_TAC[dist] THEN
14722  ASM_MESON_TAC[REAL_LET_TRANS, ABS_SUB_ABS, ABS_NEG,
14723                REAL_ARITH ``(a - x) - (a - y) = -(x - y):real``]
14724QED
14725
14726(* ------------------------------------------------------------------------- *)
14727(* For *minimal* distance, we only need closure, not compactness.            *)
14728(* ------------------------------------------------------------------------- *)
14729
14730Theorem DISTANCE_ATTAINS_INF:
14731   !s a:real.
14732        closed s /\ ~(s = {})
14733        ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)
14734Proof
14735  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14736  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
14737  DISCH_THEN(X_CHOOSE_TAC ``b:real``) THEN
14738  MP_TAC(ISPECL [``\x:real. dist(a,x)``, ``cball(a:real,dist(b,a)) INTER s``]
14739                CONTINUOUS_ATTAINS_INF) THEN
14740  KNOW_TAC ``compact
14741   (cball ((a :real),(dist ((b :real),a) :real)) INTER
14742    (s :real -> bool)) /\
14743    cball (a,(dist (b,a) :real)) INTER s <> ({} :real -> bool) /\
14744    (\(x :real). (dist (a,x) :real)) continuous_on
14745    cball (a,(dist (b,a) :real)) INTER s`` THENL
14746   [ASM_SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, CLOSED_INTER, BOUNDED_INTER,
14747                 BOUNDED_CBALL, CLOSED_CBALL, GSYM MEMBER_NOT_EMPTY] THEN
14748    SIMP_TAC std_ss [dist, CONTINUOUS_ON_RANGE, IN_INTER, IN_CBALL] THEN
14749    METIS_TAC[REAL_LET_TRANS, ABS_SUB_ABS, ABS_NEG, REAL_LE_REFL,
14750            ABS_SUB, REAL_ARITH ``(a - x) - (a - y) = -(x - y:real):real``],
14751    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
14752    DISCH_THEN (X_CHOOSE_TAC ``x:real``) THEN EXISTS_TAC ``x:real`` THEN
14753    POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [IN_INTER, IN_CBALL] THEN
14754    METIS_TAC[DIST_SYM, REAL_LE_TOTAL, REAL_LE_TRANS]]
14755QED
14756
14757(* ------------------------------------------------------------------------- *)
14758(* We can now extend limit compositions to consider the scalar multiplier.   *)
14759(* ------------------------------------------------------------------------- *)
14760
14761Theorem LIM_MUL:
14762   !net:('a)net f l:real c d.
14763        (c --> d) net /\ (f --> l) net
14764        ==> ((\x. c(x) * f(x)) --> (d * l)) net
14765Proof
14766  REPEAT STRIP_TAC THEN
14767  MP_TAC(ISPECL [``net:('a)net``, ``\x y:real. x * y``, ``c:'a->real``,
14768  ``f:'a->real``, ``d:real``, ``l:real``] LIM_BILINEAR) THEN
14769  BETA_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_THEN MATCH_MP_TAC THEN
14770  REWRITE_TAC[bilinear, linear] THEN BETA_TAC THEN
14771  REPEAT STRIP_TAC THEN REAL_ARITH_TAC
14772QED
14773
14774Theorem LIM_VMUL:
14775   !net:('a)net c d v:real.
14776  (c --> d) net ==> ((\x. c(x) * v) --> (d * v)) net
14777Proof
14778  REPEAT STRIP_TAC THEN
14779  KNOW_TAC ``(((\(x :'a). (c :'a -> real) x * (v :real)) -->
14780                             ((d :real) * v)) (net :'a net)) =
14781             (((\(x :'a). (c :'a -> real) x * (\x. v :real) x) -->
14782                             ((d :real) * v)) (net :'a net))`` THENL
14783 [SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
14784 MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]
14785QED
14786
14787Theorem CONTINUOUS_VMUL:
14788   !net c v. c continuous net ==> (\x. c(x) * v) continuous net
14789Proof
14790  SIMP_TAC std_ss [continuous, LIM_VMUL, o_THM]
14791QED
14792
14793Theorem CONTINUOUS_MUL:
14794   !net f c. c continuous net /\ f continuous net
14795             ==> (\x. c(x) * f(x)) continuous net
14796Proof
14797  SIMP_TAC std_ss [continuous, LIM_MUL, o_THM]
14798QED
14799
14800Theorem CONTINUOUS_ON_VMUL:
14801   !s c v. c continuous_on s ==> (\x. c(x) * v) continuous_on s
14802Proof
14803  REWRITE_TAC [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
14804  SIMP_TAC std_ss [CONTINUOUS_VMUL]
14805QED
14806
14807Theorem CONTINUOUS_ON_MUL:
14808   !s c f. c continuous_on s /\ f continuous_on s
14809           ==> (\x. c(x) * f(x)) continuous_on s
14810Proof
14811  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
14812  SIMP_TAC std_ss [CONTINUOUS_MUL]
14813QED
14814
14815Theorem CONTINUOUS_POW:
14816   !net f:'a->real n.
14817        (\x. f x) continuous net
14818        ==> (\x. f x pow n) continuous net
14819Proof
14820  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
14821  INDUCT_TAC THEN ASM_SIMP_TAC std_ss [pow, CONTINUOUS_CONST] THEN
14822  KNOW_TAC ``((\x:'a. f x * f x pow n) continuous net) =
14823             ((\x:'a. f x * (\x. f x pow n) x)  continuous net)`` THENL
14824  [SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
14825  MATCH_MP_TAC CONTINUOUS_MUL THEN METIS_TAC [o_DEF, ETA_AX]
14826QED
14827
14828Theorem CONTINUOUS_ON_POW:
14829   !f:real->real s n.
14830        (\x. f x) continuous_on s
14831        ==> (\x. f x pow n) continuous_on s
14832Proof
14833  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN
14834  DISCH_TAC THEN INDUCT_TAC THEN
14835  ASM_SIMP_TAC std_ss[pow, CONTINUOUS_ON_CONST] THEN
14836  KNOW_TAC ``((\x. (f:real->real) x * f x pow n) continuous_on s:real->bool) =
14837             ((\x. f x * (\x. f x pow n) x)  continuous_on s)`` THENL
14838  [SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
14839  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN METIS_TAC [o_DEF, ETA_AX]
14840QED
14841
14842Theorem CONTINUOUS_PRODUCT:
14843   !net:('a)net f (t:'b->bool).
14844        FINITE t /\
14845        (!i. i IN t ==> (\x. (f x i)) continuous net)
14846        ==> (\x. (product t (f x))) continuous net
14847Proof
14848  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJ_EQ_IMP] THEN
14849  ONCE_REWRITE_TAC [METIS []
14850    ``!t. ((!i. i IN t ==> (\x. f x i) continuous net) ==>
14851  (\x. product t (f x)) continuous net) =
14852     (\t. (!i. i IN t ==> (\x. f x i) continuous net) ==>
14853  (\x. product t (f x)) continuous net) t``] THEN
14854  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN SIMP_TAC std_ss [PRODUCT_CLAUSES] THEN
14855  SIMP_TAC std_ss [CONTINUOUS_CONST, FORALL_IN_INSERT] THEN
14856  REPEAT STRIP_TAC THEN
14857  ONCE_REWRITE_TAC [METIS [] ``(\x. f x e * product s (f x)) =
14858                  (\x. (\x. f x e) x * (\x. product s (f x)) x)``] THEN
14859  MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_SIMP_TAC std_ss [o_DEF]
14860QED
14861
14862Theorem CONTINUOUS_ON_PRODUCT:
14863   !f:real->'a->real s t.
14864        FINITE t /\
14865        (!i. i IN t ==> (\x. (f x i)) continuous_on s)
14866        ==> (\x. (product t (f x))) continuous_on s
14867Proof
14868  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_PRODUCT]
14869QED
14870
14871(* ------------------------------------------------------------------------- *)
14872(* And so we have continuity of inverse.                                     *)
14873(* ------------------------------------------------------------------------- *)
14874
14875Theorem LIM_INV:
14876   !net:('a)net f l.
14877        (f --> l) net /\ ~(l = &0)
14878        ==> ((inv o f) --> (inv l)) net
14879Proof
14880  REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
14881  ASM_CASES_TAC ``trivial_limit(net:('a)net)`` THEN ASM_REWRITE_TAC[] THEN
14882  REWRITE_TAC[o_THM, dist] THEN STRIP_TAC THEN
14883  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
14884  FIRST_X_ASSUM(MP_TAC o SPEC ``min (abs(l) / &2) ((l pow 2 * e) / &2:real)``) THEN
14885  REWRITE_TAC[REAL_LT_MIN] THEN
14886  KNOW_TAC ``0 < abs l / 2 /\ 0 < l pow 2 * e / 2:real`` THENL
14887   [ASM_SIMP_TAC arith_ss [GSYM ABS_NZ, REAL_LT_DIV, REAL_LT] THEN
14888    MATCH_MP_TAC REAL_LT_DIV THEN SIMP_TAC arith_ss [REAL_LT] THEN
14889    ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
14890    ASM_SIMP_TAC std_ss [REAL_LT_MUL, GSYM ABS_NZ, REAL_POW_LT],
14891    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
14892  DISCH_THEN (X_CHOOSE_TAC ``a:'a``) THEN EXISTS_TAC ``a:'a`` THEN
14893  POP_ASSUM MP_TAC THEN
14894  MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
14895  DISCH_TAC THEN X_GEN_TAC ``b:'a`` THEN POP_ASSUM (MP_TAC o Q.SPEC `b:'a`) THEN
14896  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
14897  SIMP_TAC arith_ss [REAL_LT_RDIV_EQ, REAL_LT] THEN STRIP_TAC THEN
14898  FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH
14899   ``abs(x - l) * &2 < abs l ==> ~(x = &0:real)``)) THEN
14900  ASM_SIMP_TAC std_ss [REAL_SUB_INV2, ABS_DIV, REAL_LT_LDIV_EQ,
14901               GSYM ABS_NZ, REAL_ENTIRE] THEN
14902  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
14903   ``abs(x - y) * &2 < b * c ==> c * b <= d * &2 ==> abs(y - x) < d:real``)) THEN
14904  ASM_SIMP_TAC std_ss [GSYM REAL_MUL_ASSOC, REAL_LE_LMUL] THEN
14905  ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
14906  ASM_SIMP_TAC std_ss [ABS_MUL, POW_2, REAL_MUL_ASSOC, GSYM ABS_NZ,
14907               REAL_LE_RMUL] THEN
14908  ASM_SIMP_TAC std_ss [REAL_ARITH ``abs(x - y) * &2 < abs y ==> abs y <= &2 * abs x:real``]
14909QED
14910
14911Theorem CONTINUOUS_INV:
14912   !net f. f continuous net /\ ~(f(netlimit net) = &0)
14913           ==> (inv o f) continuous net
14914Proof
14915  SIMP_TAC std_ss [continuous, LIM_INV, o_THM]
14916QED
14917
14918Theorem CONTINUOUS_AT_WITHIN_INV:
14919   !f s a:real.
14920        f continuous (at a within s) /\ ~(f a = &0)
14921        ==> (inv o f) continuous (at a within s)
14922Proof
14923  REPEAT GEN_TAC THEN
14924  ASM_CASES_TAC ``trivial_limit (at (a:real) within s)`` THENL
14925   [ASM_REWRITE_TAC[continuous, LIM],
14926    ASM_SIMP_TAC std_ss [NETLIMIT_WITHIN, CONTINUOUS_INV]]
14927QED
14928
14929Theorem CONTINUOUS_AT_INV:
14930   !f a. f continuous at a /\ ~(f a = &0)
14931         ==> (inv o f) continuous at a
14932Proof
14933  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
14934  REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]
14935QED
14936
14937Theorem CONTINUOUS_ON_INV:
14938   !f s. f continuous_on s /\ (!x. x IN s ==> ~(f x = &0))
14939         ==> (inv o f) continuous_on s
14940Proof
14941  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, CONTINUOUS_AT_WITHIN_INV]
14942QED
14943
14944(* ------------------------------------------------------------------------- *)
14945(* Hence some useful properties follow quite easily.                         *)
14946(* ------------------------------------------------------------------------- *)
14947
14948Theorem CONNECTED_SCALING:
14949   !s:real->bool c. connected s ==> connected (IMAGE (\x. c * x) s)
14950Proof
14951  REPEAT STRIP_TAC THEN
14952  MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
14953  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
14954  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
14955  REWRITE_TAC[linear] THEN CONJ_TAC THEN SIMP_TAC std_ss [] THEN REAL_ARITH_TAC
14956QED
14957
14958Theorem CONNECTED_NEGATIONS:
14959   !s:real->bool. connected s ==> connected (IMAGE (\x. -x) s)
14960Proof
14961  REPEAT STRIP_TAC THEN
14962  MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
14963  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
14964  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
14965  REWRITE_TAC[linear] THEN CONJ_TAC THEN SIMP_TAC std_ss [] THEN REAL_ARITH_TAC
14966QED
14967
14968Theorem COMPACT_SCALING:
14969   !s:real->bool c. compact s ==> compact (IMAGE (\x. c * x) s)
14970Proof
14971  REPEAT STRIP_TAC THEN
14972  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
14973  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
14974  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
14975  REWRITE_TAC[linear] THEN CONJ_TAC THEN SIMP_TAC std_ss [] THEN REAL_ARITH_TAC
14976QED
14977
14978Theorem COMPACT_NEGATIONS:
14979   !s:real->bool. compact s ==> compact (IMAGE (\x. -x) s)
14980Proof
14981  REPEAT STRIP_TAC THEN
14982  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
14983  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
14984  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
14985  REWRITE_TAC[linear] THEN CONJ_TAC THEN SIMP_TAC std_ss [] THEN REAL_ARITH_TAC
14986QED
14987
14988Theorem COMPACT_AFFINITY:
14989   !s a:real c.
14990        compact s ==> compact (IMAGE (\x. a + c * x) s)
14991Proof
14992  REPEAT STRIP_TAC THEN
14993  SUBGOAL_THEN ``(\x:real. a + c * x) = (\x. a + x) o (\x. c * x)``
14994  SUBST1_TAC THENL [REWRITE_TAC[o_DEF], ALL_TAC] THEN
14995  ASM_SIMP_TAC std_ss [IMAGE_COMPOSE, COMPACT_TRANSLATION, COMPACT_SCALING]
14996QED
14997
14998(* ------------------------------------------------------------------------- *)
14999(* We can state this in terms of diameter of a set.                          *)
15000(* ------------------------------------------------------------------------- *)
15001
15002(* This is a generalized ‘diameter’ with a metric parameter d *)
15003Definition set_diameter_def :
15004    set_diameter (d :'a metric) (s :'a set) =
15005      if s = {} then (0 :real)
15006      else sup {dist d (x,y) | x IN s /\ y IN s}
15007End
15008
15009(* New definition of ‘diameter’ *)
15010Overload diameter = “set_diameter mr1”
15011
15012(* Old definition of ‘diameter’ (now becomes a theorem) *)
15013Theorem diameter :
15014    !s. diameter s =
15015        if s = {} then (&0:real)
15016        else sup {abs(x - y) | x IN s /\ y IN s}
15017Proof
15018    RW_TAC std_ss [GSYM dist_def, dist, set_diameter_def]
15019QED
15020
15021Theorem DIAMETER_BOUNDED:
15022   !s. bounded s
15023       ==> (!x:real y. x IN s /\ y IN s ==> abs(x - y) <= diameter s) /\
15024           (!d. &0 <= d /\ d < diameter s
15025                ==> ?x y. x IN s /\ y IN s /\ abs(x - y) > d)
15026Proof
15027  GEN_TAC THEN DISCH_TAC THEN
15028  ASM_CASES_TAC ``s:real->bool = {}`` THEN
15029  ASM_REWRITE_TAC[diameter, NOT_IN_EMPTY, REAL_LET_ANTISYM] THENL
15030  [SIMP_TAC std_ss [REAL_NOT_LE, REAL_NOT_LT, REAL_LTE_TOTAL], ALL_TAC] THEN
15031  MP_TAC(SPEC ``{abs(x - y:real) | x IN s /\ y IN s}`` SUP) THEN
15032  ABBREV_TAC ``b = sup {abs(x - y:real) | x IN s /\ y IN s}`` THEN
15033  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN
15034  REWRITE_TAC[NOT_IN_EMPTY, real_gt] THEN
15035  KNOW_TAC ``(?(x :real) (p_1 :real) (p_2 :real).
15036    (x = abs (p_1 - p_2)) /\ p_1 IN (s :real -> bool) /\ p_2 IN s) /\
15037 (?(b :real).
15038    !(x :real).
15039      (?(p_1 :real) (p_2 :real).
15040         (x = abs (p_1 - p_2)) /\ p_1 IN s /\ p_2 IN s) ==>
15041      x <= b)`` THENL
15042   [CONJ_TAC THENL [METIS_TAC[MEMBER_NOT_EMPTY], ALL_TAC],
15043    METIS_TAC[REAL_NOT_LE]] THEN
15044  SIMP_TAC std_ss [REAL_SUB, LEFT_IMP_EXISTS_THM] THEN
15045  UNDISCH_TAC ``bounded s`` THEN DISCH_TAC THEN
15046  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [bounded_def]) THEN
15047  REWRITE_TAC [real_sub] THEN
15048  METIS_TAC [REAL_ARITH ``x <= y + z /\ y <= b /\ z <= b ==> x <= b + b:real``,
15049            ABS_TRIANGLE, ABS_NEG]
15050QED
15051
15052Theorem DIAMETER_BOUNDED_BOUND:
15053   !s x y. bounded s /\ x IN s /\ y IN s ==> abs(x - y) <= diameter s
15054Proof
15055  MESON_TAC[DIAMETER_BOUNDED]
15056QED
15057
15058Theorem DIAMETER_LINEAR_IMAGE:
15059   !f:real->real s.
15060        linear f /\ (!x. abs(f x) = abs x)
15061        ==> (diameter(IMAGE f s) = diameter s)
15062Proof
15063  REWRITE_TAC[diameter] THEN
15064  REPEAT STRIP_TAC THEN REWRITE_TAC[diameter, IMAGE_EQ_EMPTY] THEN
15065  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN
15066  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN
15067  ONCE_REWRITE_TAC [CONJ_SYM] THEN
15068  SIMP_TAC std_ss [GSYM CONJ_ASSOC, RIGHT_EXISTS_AND_THM, EXISTS_IN_IMAGE] THEN
15069  METIS_TAC[LINEAR_SUB]
15070QED
15071
15072Theorem DIAMETER_EMPTY:
15073   diameter {} = &0
15074Proof
15075  REWRITE_TAC[diameter]
15076QED
15077
15078Theorem DIAMETER_SING:
15079   !a. diameter {a} = &0
15080Proof
15081  REWRITE_TAC[diameter, NOT_INSERT_EMPTY, IN_SING] THEN
15082  ONCE_REWRITE_TAC [METIS [] ``abs (x - y:real) = (\x y. abs (x - y:real)) x y``] THEN
15083  KNOW_TAC ``!a:real f x:real y:real. {f x y | (x = a) /\ (y = a)} = {(f a a):real }`` THENL
15084  [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD, IN_SING],
15085   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
15086  SIMP_TAC std_ss [REAL_SUB_REFL, ABS_0] THEN
15087  MATCH_MP_TAC REAL_SUP_UNIQUE THEN
15088  REWRITE_TAC [METIS [SPECIFICATION] ``{0:real} x <=> x IN {0}``] THEN
15089  SET_TAC [REAL_LE_LT]
15090QED
15091
15092Theorem DIAMETER_POS_LE:
15093   !s:real->bool. bounded s ==> &0 <= diameter s
15094Proof
15095  REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN
15096  COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
15097  MP_TAC(SPEC ``{abs(x - y:real) | x IN s /\ y IN s}`` SUP) THEN
15098  SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
15099  KNOW_TAC ``{abs (x - y) | x IN (s :real -> bool) /\ y IN s} <>
15100      ({} :real -> bool) /\ (?(b :real).
15101    !(x :real) (y :real). x IN s /\ y IN s ==> abs (x - y) <= b)`` THENL
15102   [CONJ_TAC THENL [FULL_SIMP_TAC std_ss [EXTENSION, GSPECIFICATION,
15103     EXISTS_PROD, NOT_IN_EMPTY] THEN METIS_TAC [MEMBER_NOT_EMPTY], ALL_TAC] THEN
15104    UNDISCH_TAC ``bounded s`` THEN DISCH_TAC THEN
15105    FIRST_X_ASSUM(X_CHOOSE_TAC ``B:real`` o REWRITE_RULE [BOUNDED_POS]) THEN
15106    EXISTS_TAC ``&2 * B:real`` THEN
15107    ASM_SIMP_TAC std_ss [REAL_ARITH
15108      ``abs x <= B /\ abs y <= B ==> abs(x - y) <= &2 * B:real``],
15109    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
15110    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
15111    DISCH_THEN(X_CHOOSE_TAC ``a:real``) THEN
15112    DISCH_THEN(MP_TAC o SPECL [``a:real``, ``a:real``] o CONJUNCT1) THEN
15113    ASM_REWRITE_TAC[REAL_SUB_REFL, ABS_0]]
15114QED
15115
15116Theorem DIAMETER_SUBSET:
15117   !s t:real->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t
15118Proof
15119  REPEAT STRIP_TAC THEN
15120  ASM_CASES_TAC ``s:real->bool = {}`` THEN
15121  ASM_SIMP_TAC std_ss [DIAMETER_EMPTY, DIAMETER_POS_LE] THEN
15122  ASM_REWRITE_TAC[diameter] THEN
15123  COND_CASES_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
15124  MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN
15125  REPEAT(CONJ_TAC THENL
15126  [FULL_SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, SUBSET_DEF,
15127     EXISTS_PROD, NOT_IN_EMPTY] THEN METIS_TAC [MEMBER_NOT_EMPTY], ALL_TAC]) THEN
15128  SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
15129  UNDISCH_TAC ``bounded t`` THEN DISCH_TAC THEN
15130  FIRST_X_ASSUM(X_CHOOSE_TAC ``B:real`` o REWRITE_RULE [BOUNDED_POS]) THEN
15131  EXISTS_TAC ``&2 * B:real`` THEN
15132  ASM_SIMP_TAC std_ss [REAL_ARITH
15133    ``abs x <= B /\ abs y <= B ==> abs(x - y) <= &2 * B:real``]
15134QED
15135
15136Theorem DIAMETER_CLOSURE:
15137   !s:real->bool. bounded s ==> (diameter(closure s) = diameter s)
15138Proof
15139  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN
15140  ASM_SIMP_TAC std_ss [DIAMETER_SUBSET, BOUNDED_CLOSURE, CLOSURE_SUBSET] THEN
15141  REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
15142  DISCH_TAC THEN MP_TAC(ISPEC ``closure s:real->bool`` DIAMETER_BOUNDED) THEN
15143  ABBREV_TAC ``d = diameter(closure s) - diameter(s:real->bool)`` THEN
15144  ASM_SIMP_TAC std_ss [BOUNDED_CLOSURE] THEN
15145  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
15146  POP_ASSUM (MP_TAC o
15147    SPEC ``diameter(closure(s:real->bool)) - d / &2:real``) THEN
15148  SIMP_TAC std_ss [NOT_IMP, GSYM CONJ_ASSOC, NOT_EXISTS_THM] THEN
15149  ONCE_REWRITE_TAC [SET_RULE ``(x:real) NOTIN y <=> ~(x IN y)``, GSYM DE_MORGAN_THM] THEN
15150  ONCE_REWRITE_TAC [SET_RULE ``(x:real) NOTIN y <=> ~(x IN y)``, GSYM DE_MORGAN_THM] THEN
15151  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN
15152  CONJ_TAC THENL
15153  [SIMP_TAC std_ss [REAL_SUB_LE, REAL_LE_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
15154   EXPAND_TAC "d" THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
15155   SIMP_TAC std_ss [GSYM REAL_DOUBLE, real_sub] THEN
15156   MATCH_MP_TAC REAL_LE_ADD2 THEN SIMP_TAC std_ss [REAL_LE_REFL] THEN
15157   FULL_SIMP_TAC std_ss [REAL_ARITH ``(a - b = c) <=> (a = c + b:real)``] THEN
15158   ONCE_REWRITE_TAC [GSYM REAL_SUB_LE] THEN
15159   REWRITE_TAC [REAL_ARITH ``0 < a + b - -c <=> 0 + 0 < a + (b + c):real``, REAL_LE_LT] THEN
15160   DISJ1_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC [] THEN
15161   ONCE_REWRITE_TAC [REAL_ARITH ``0 = 0 + 0:real``] THEN
15162   MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC [], ALL_TAC] THEN
15163  CONJ_TAC THENL
15164  [ONCE_REWRITE_TAC [REAL_ARITH ``a - b < c <=> a - c < b:real``] THEN
15165   SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
15166   ASM_REWRITE_TAC [REAL_SUB_REFL, REAL_MUL_LZERO], ALL_TAC] THEN
15167  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN
15168  SIMP_TAC std_ss [CLOSURE_APPROACHABLE, CONJ_ASSOC, GSYM FORALL_AND_THM] THEN
15169  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
15170  UNDISCH_TAC ``!e. ~(0 < e) \/ ?y'. y' IN s /\ dist (y',y) < e:real`` THEN DISCH_TAC THEN
15171  POP_ASSUM (MP_TAC o Q.SPEC `d / 4:real`) THEN
15172  UNDISCH_TAC ``!e. ~(0 < e) \/ ?y. y IN s /\ dist (y,x) < e:real`` THEN DISCH_TAC THEN
15173  POP_ASSUM (MP_TAC o Q.SPEC `d / 4:real`) THEN REWRITE_TAC [AND_IMP_INTRO] THEN
15174  ASM_REWRITE_TAC[METIS [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 4:real``, REAL_MUL_LZERO]
15175                         ``&0 < d / &4 <=> &0 < d:real``] THEN
15176  DISCH_THEN(CONJUNCTS_THEN2
15177   (X_CHOOSE_THEN ``u:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
15178   (X_CHOOSE_THEN ``v:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN
15179  FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN
15180  DISCH_THEN(MP_TAC o SPECL [``u:real``, ``v:real``] o CONJUNCT1) THEN
15181  ASM_REWRITE_TAC[dist] THEN
15182  RULE_ASSUM_TAC (REWRITE_RULE [real_gt]) THEN
15183  RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_ARITH ``a - b < c <=> a - c < b:real``]) THEN
15184  RULE_ASSUM_TAC (SIMP_RULE std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``]) THEN
15185  UNDISCH_TAC `` (diameter (closure s) - abs (x - y)) * 2 < d:real`` THEN
15186  EXPAND_TAC "d" THEN SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 4:real``] THEN
15187  REAL_ARITH_TAC
15188QED
15189
15190Theorem DIAMETER_SUBSET_CBALL_NONEMPTY:
15191   !s:real->bool.
15192       bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)
15193Proof
15194   REPEAT STRIP_TAC THEN
15195   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
15196   DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
15197   ASM_REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``b:real`` THEN
15198   DISCH_TAC THEN REWRITE_TAC[IN_CBALL, dist] THEN
15199   ASM_MESON_TAC[DIAMETER_BOUNDED]
15200QED
15201
15202Theorem DIAMETER_SUBSET_CBALL:
15203   !s:real->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)
15204Proof
15205  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
15206  ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY, EMPTY_SUBSET]
15207QED
15208
15209Theorem DIAMETER_EQ_0:
15210   !s:real->bool.
15211        bounded s ==> ((diameter s = &0) <=> (s = {}) \/ ?a. (s = {a}))
15212Proof
15213  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
15214  ASM_REWRITE_TAC[DIAMETER_EMPTY, DIAMETER_SING] THEN
15215  REWRITE_TAC[SET_RULE
15216   ``(s = {}) \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> (a = b)``] THEN
15217  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
15218  MP_TAC(ISPECL [``s:real->bool``, ``a:real``, ``b:real``]
15219        DIAMETER_BOUNDED_BOUND) THEN
15220  ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC
15221QED
15222
15223Theorem DIAMETER_LE:
15224   !s:real->bool d.
15225        (~(s = {}) \/ &0 <= d) /\
15226        (!x y. x IN s /\ y IN s ==> abs(x - y) <= d) ==> diameter s <= d
15227Proof
15228  NTAC 2 GEN_TAC THEN REWRITE_TAC[diameter] THEN
15229  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN
15230  STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE' THEN
15231  CONJ_TAC THENL [
15232   SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN ASM_SET_TAC[],
15233   SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN ASM_SET_TAC []]
15234QED
15235
15236Theorem DIAMETER_CBALL:
15237   !a:real r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r
15238Proof
15239  REPEAT GEN_TAC THEN COND_CASES_TAC THENL
15240   [ASM_MESON_TAC[CBALL_EQ_EMPTY, DIAMETER_EMPTY], ALL_TAC] THEN
15241  RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
15242  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
15243   [MATCH_MP_TAC DIAMETER_LE THEN
15244    ASM_SIMP_TAC std_ss [CBALL_EQ_EMPTY, REAL_LE_MUL, REAL_POS, REAL_NOT_LT] THEN
15245    REWRITE_TAC[IN_CBALL, dist] THEN REAL_ARITH_TAC,
15246    MATCH_MP_TAC REAL_LE_TRANS THEN
15247    EXISTS_TAC ``abs((a + r) - (a - r):real)`` THEN
15248    CONJ_TAC THENL
15249     [REWRITE_TAC[REAL_ARITH ``(a + r) - (a - r) = (&2 * r:real)``] THEN
15250      ASM_REAL_ARITH_TAC,
15251      MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
15252      REWRITE_TAC[BOUNDED_CBALL, IN_CBALL, dist] THEN
15253      REWRITE_TAC[REAL_ARITH
15254       ``(abs(a - (a + b)) = abs b) /\ (abs(a - (a - b)) = abs b:real)``] THEN
15255      ASM_REAL_ARITH_TAC]]
15256QED
15257
15258Theorem DIAMETER_BALL:
15259   !a:real r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r
15260Proof
15261  REPEAT GEN_TAC THEN COND_CASES_TAC THENL
15262   [ASM_SIMP_TAC std_ss [BALL_EMPTY, REAL_LT_IMP_LE, DIAMETER_EMPTY], ALL_TAC] THEN
15263  ASM_CASES_TAC ``r = &0:real`` THEN
15264  ASM_SIMP_TAC std_ss [BALL_EMPTY, REAL_LE_REFL, DIAMETER_EMPTY, REAL_MUL_RZERO] THEN
15265  MATCH_MP_TAC EQ_TRANS THEN
15266  EXISTS_TAC ``diameter(cball(a:real,r))`` THEN CONJ_TAC THENL
15267   [SUBGOAL_THEN ``&0 < r:real`` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC, ALL_TAC] THEN
15268    ASM_SIMP_TAC std_ss [GSYM CLOSURE_BALL, DIAMETER_CLOSURE, BOUNDED_BALL],
15269    ASM_SIMP_TAC std_ss [DIAMETER_CBALL]]
15270QED
15271
15272Theorem DIAMETER_SUMS:
15273   !s t:real->bool.
15274        bounded s /\ bounded t
15275        ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t
15276Proof
15277  REPEAT STRIP_TAC THEN
15278  KNOW_TAC ``!x y:real. {x + y| F} = {}:real->bool`` THENL
15279  [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN SET_TAC [], DISCH_TAC] THEN
15280  ASM_CASES_TAC ``s:real->bool = {}`` THEN
15281  ASM_SIMP_TAC std_ss [NOT_IN_EMPTY, DIAMETER_EMPTY, REAL_ADD_LID, DIAMETER_POS_LE] THEN
15282  ASM_CASES_TAC ``t:real->bool = {}`` THEN
15283  ASM_SIMP_TAC std_ss [NOT_IN_EMPTY, DIAMETER_EMPTY, REAL_ADD_RID, DIAMETER_POS_LE] THEN
15284  MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL
15285  [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD, NOT_IN_EMPTY] THEN
15286   ASM_SET_TAC [], ALL_TAC] THEN
15287  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, CONJ_EQ_IMP, FORALL_IN_GSPEC] THEN
15288  REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
15289   ``abs(x - x') <= s /\ abs(y - y') <= t
15290    ==> abs((x + y) - (x' + y'):real) <= s + t``) THEN
15291  ASM_SIMP_TAC std_ss [DIAMETER_BOUNDED_BOUND]
15292QED
15293
15294Theorem LEBESGUE_COVERING_LEMMA:
15295   !s:real->bool c.
15296        compact s /\ ~(c = {}) /\ s SUBSET BIGUNION c /\ (!b. b IN c ==> open b)
15297        ==> ?d. &0 < d /\
15298                !t. t SUBSET s /\ diameter t <= d
15299                    ==> ?b. b IN c /\ t SUBSET b
15300Proof
15301  REPEAT STRIP_TAC THEN
15302  FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN
15303  DISCH_THEN(MP_TAC o SPEC ``c:(real->bool)->bool``) THEN ASM_SIMP_TAC std_ss [] THEN
15304  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC ``e:real`` THEN
15305  STRIP_TAC THEN EXISTS_TAC ``e / &2:real`` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
15306  X_GEN_TAC ``t:real->bool`` THEN STRIP_TAC THEN
15307  ASM_CASES_TAC ``t:real->bool = {}`` THENL [ASM_SET_TAC[], ALL_TAC] THEN
15308  MP_TAC(ISPEC ``t:real->bool`` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN
15309  KNOW_TAC ``(bounded (t :real -> bool) :bool) /\ t <> ({} :real -> bool)`` THENL
15310   [ASM_MESON_TAC[BOUNDED_SUBSET, COMPACT_IMP_BOUNDED],
15311    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
15312  DISCH_THEN(X_CHOOSE_THEN ``x:real`` STRIP_ASSUME_TAC) THEN
15313  FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
15314  KNOW_TAC ``(x :real) IN (s :real -> bool)`` THENL
15315  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
15316  DISCH_THEN (X_CHOOSE_TAC ``b:real->bool``) THEN EXISTS_TAC ``b:real->bool`` THEN
15317  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN
15318  EXISTS_TAC ``cball(x:real,diameter(t:real->bool))`` THEN
15319  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN
15320  EXISTS_TAC ``ball(x:real,e)`` THEN ASM_REWRITE_TAC[] THEN
15321  REWRITE_TAC[SUBSET_DEF, IN_CBALL, IN_BALL] THEN
15322  MAP_EVERY UNDISCH_TAC [``&0 < e:real``, ``diameter(t:real->bool) <= e / &2:real``] THEN
15323  SIMP_TAC std_ss [dist, REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN REAL_ARITH_TAC
15324QED
15325
15326(* ------------------------------------------------------------------------- *)
15327(* Related results with closure as the conclusion.                           *)
15328(* ------------------------------------------------------------------------- *)
15329
15330Theorem CLOSED_SCALING:
15331   !s:real->bool c. closed s ==> closed (IMAGE (\x. c * x) s)
15332Proof
15333  REPEAT GEN_TAC THEN
15334  ASM_CASES_TAC ``s :real->bool = {}`` THEN
15335  ASM_REWRITE_TAC[CLOSED_EMPTY, IMAGE_EMPTY, IMAGE_INSERT] THEN
15336  ASM_CASES_TAC ``c = &0:real`` THENL
15337   [SUBGOAL_THEN ``IMAGE (\x:real. c * x) s = {(0)}``
15338     (fn th => REWRITE_TAC[th, CLOSED_SING]) THEN
15339    ASM_REWRITE_TAC[EXTENSION, IN_IMAGE, IN_SING, REAL_MUL_LZERO] THEN
15340    ASM_MESON_TAC[MEMBER_NOT_EMPTY],
15341    ALL_TAC] THEN
15342  SIMP_TAC std_ss [CLOSED_SEQUENTIAL_LIMITS, IN_IMAGE, SKOLEM_THM] THEN
15343  STRIP_TAC THEN X_GEN_TAC ``x:num->real`` THEN X_GEN_TAC ``l:real`` THEN
15344  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
15345  DISCH_THEN(X_CHOOSE_THEN ``y:num->real`` MP_TAC) THEN
15346  SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC THEN
15347  EXISTS_TAC ``inv(c) * l :real`` THEN
15348  ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_RINV, REAL_MUL_LID] THEN
15349  FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC ``\n:num. inv(c) * x n:real`` THEN
15350  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
15351   [ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_LID],
15352    ONCE_REWRITE_TAC [METIS [] ``(\n:num. inv c * (c * (y:num->real) n)) =
15353                                 (\n. inv c:real * (\n. (c * y n)) n)``] THEN
15354    MATCH_MP_TAC LIM_CMUL THEN
15355    FIRST_ASSUM(fn th => REWRITE_TAC[SYM(SPEC_ALL th)]) THEN
15356    ASM_SIMP_TAC std_ss [ETA_AX]]
15357QED
15358
15359Theorem CLOSED_NEGATIONS:
15360   !s:real->bool. closed s ==> closed (IMAGE (\x. -x) s)
15361Proof
15362  REPEAT GEN_TAC THEN
15363  SUBGOAL_THEN ``IMAGE (\x. -x) s = IMAGE (\x:real. -(&1) * x) s``
15364  SUBST1_TAC THEN SIMP_TAC std_ss [CLOSED_SCALING] THEN
15365  REWRITE_TAC[REAL_ARITH ``-(&1) * x = -x:real``] THEN SIMP_TAC std_ss [ETA_AX]
15366QED
15367
15368Theorem COMPACT_CLOSED_SUMS:
15369   !s:real->bool t.
15370        compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}
15371Proof
15372  REPEAT GEN_TAC THEN
15373  SIMP_TAC std_ss [compact, GSPECIFICATION, CLOSED_SEQUENTIAL_LIMITS, EXISTS_PROD] THEN
15374  STRIP_TAC THEN X_GEN_TAC ``f:num->real`` THEN X_GEN_TAC ``l:real`` THEN
15375  SIMP_TAC std_ss [SKOLEM_THM, FORALL_AND_THM] THEN
15376  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
15377  DISCH_THEN(X_CHOOSE_THEN ``a:num->real`` MP_TAC) THEN
15378  DISCH_THEN(X_CHOOSE_THEN ``b:num->real`` STRIP_ASSUME_TAC) THEN
15379  UNDISCH_TAC `` !f:num->real.
15380        (!n. f n IN s) ==>
15381        ?l r.
15382          l IN s /\ (!m n. m < n ==> r m < r n) /\
15383          (f o r --> l) sequentially`` THEN DISCH_TAC THEN
15384  FIRST_X_ASSUM(MP_TAC o SPEC ``a:num->real``) THEN
15385  ASM_REWRITE_TAC[] THEN
15386  DISCH_THEN(X_CHOOSE_THEN ``la:real`` (X_CHOOSE_THEN ``sub:num->num``
15387        STRIP_ASSUME_TAC)) THEN
15388  MAP_EVERY EXISTS_TAC [``la:real``, ``l - la:real``] THEN
15389  ASM_REWRITE_TAC[REAL_ARITH ``a + (b - a) = b:real``] THEN
15390  FIRST_X_ASSUM MATCH_MP_TAC THEN
15391  EXISTS_TAC ``\n. (f o (sub:num->num)) n - (a o sub) n:real`` THEN
15392  CONJ_TAC THENL [ASM_SIMP_TAC std_ss [REAL_ADD_SUB, o_THM], ALL_TAC] THEN
15393  MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC std_ss [LIM_SUBSEQUENCE, ETA_AX]
15394QED
15395
15396Theorem CLOSED_COMPACT_SUMS:
15397   !s:real->bool t.
15398        closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}
15399Proof
15400  REPEAT GEN_TAC THEN
15401  SUBGOAL_THEN ``{x + y:real | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}``
15402  SUBST1_TAC THEN  SIMP_TAC std_ss [COMPACT_CLOSED_SUMS] THEN
15403  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN METIS_TAC [REAL_ADD_SYM]
15404QED
15405
15406Theorem CLOSURE_SUMS:
15407   !s t:real->bool.
15408        bounded s \/ bounded t
15409        ==> (closure {x + y | x IN s /\ y IN t} =
15410             {x + y | x IN closure s /\ y IN closure t})
15411Proof
15412  REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
15413  SIMP_TAC std_ss [FORALL_AND_THM] THEN
15414  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN
15415  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN
15416  SIMP_TAC std_ss [] THEN
15417  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [EXTENSION, CLOSURE_SEQUENTIAL] THEN
15418  X_GEN_TAC ``z:real`` THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN EQ_TAC THENL
15419   [GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJ_SYM] THEN
15420    SIMP_TAC std_ss [GSPECIFICATION, IN_DELETE, SKOLEM_THM, GSYM LEFT_EXISTS_AND_THM] THEN
15421    SIMP_TAC std_ss [FORALL_AND_THM] THEN
15422    ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
15423    KNOW_TAC ``(?(x' :num -> real) (f :num -> real) (f' :num -> real).
15424   (\x' f f'. ((!(n :num). f n IN (s :real -> bool)) /\
15425    !(n :num). f' n IN (t :real -> bool)) /\
15426   (!(n :num). x' n = f n + f' n) /\
15427   ((x' --> (z :real)) sequentially :bool)) x' f f') ==>
15428?(p_1 :real) (p_2 :real) (x' :num -> real).
15429  (\p_1 p_2 x'. (?(x :num -> real).
15430     (!(n :num). x n IN t) /\ ((x --> p_2) sequentially :bool)) /\
15431  ((!(n :num). x' n IN s) /\ ((x' --> p_1) sequentially :bool)) /\
15432  (z = p_1 + p_2)) p_1 p_2 x'`` THENL
15433    [ALL_TAC, METIS_TAC []] THEN
15434    ONCE_REWRITE_TAC[MESON[] ``(?f x y. P f x y) <=> (?x y f. P f x y)``] THEN
15435    SIMP_TAC std_ss [GSYM FUN_EQ_THM] THEN
15436    SIMP_TAC std_ss [ETA_AX, UNWIND_THM2] THEN
15437    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
15438    MAP_EVERY X_GEN_TAC [``a:num->real``, ``b:num->real``] THEN
15439    STRIP_TAC THEN
15440    MP_TAC(ISPEC ``closure s:real->bool`` compact) THEN
15441    ASM_SIMP_TAC std_ss [COMPACT_CLOSURE] THEN
15442    DISCH_THEN(MP_TAC o SPEC ``a:num->real``) THEN
15443    ASM_SIMP_TAC std_ss [SIMP_RULE std_ss [SUBSET_DEF] CLOSURE_SUBSET, LEFT_IMP_EXISTS_THM] THEN
15444    MAP_EVERY X_GEN_TAC [``u:real``, ``r:num->num``] THEN STRIP_TAC THEN
15445    EXISTS_TAC ``z - u:real`` THEN
15446    EXISTS_TAC ``(a:num->real) o (r:num->num)`` THEN EXISTS_TAC ``u:real`` THEN
15447    ASM_SIMP_TAC std_ss [o_THM] THEN
15448    CONJ_TAC THENL [ALL_TAC, REAL_ARITH_TAC] THEN
15449    EXISTS_TAC ``(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n)
15450                :num->real`` THEN
15451    CONJ_TAC THENL
15452     [ASM_SIMP_TAC real_ss [o_DEF, REAL_ARITH ``(a + b) - a:real = b``],
15453      MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC std_ss [ETA_AX] THEN
15454      MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]],
15455    SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN
15456    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, GSYM LEFT_EXISTS_AND_THM,
15457                GSYM RIGHT_EXISTS_AND_THM] THEN
15458    MAP_EVERY X_GEN_TAC
15459     [``x:real``, ``y:real``, ``a:num->real``, ``b:num->real``] THEN
15460    STRIP_TAC THEN EXISTS_TAC ``(\n. a n + b n):num->real`` THEN
15461    ASM_SIMP_TAC std_ss [LIM_ADD] THEN ASM_MESON_TAC[]]
15462QED
15463
15464Theorem COMPACT_CLOSED_DIFFERENCES:
15465   !s:real->bool t.
15466        compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}
15467Proof
15468  REPEAT STRIP_TAC THEN
15469  SUBGOAL_THEN ``{x - y | x:real IN s /\ y IN t} =
15470                 {x + y | x IN s /\ y IN (IMAGE (\x. -x) t)}``
15471    (fn th => ASM_SIMP_TAC std_ss [th, COMPACT_CLOSED_SUMS, CLOSED_NEGATIONS]) THEN
15472  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD, IN_IMAGE] THEN
15473  ONCE_REWRITE_TAC[REAL_ARITH ``(x:real = -y) <=> (y = -x:real)``] THEN
15474  SIMP_TAC std_ss [real_sub, GSYM CONJ_ASSOC, UNWIND_THM2] THEN
15475  METIS_TAC[REAL_NEG_NEG]
15476QED
15477
15478Theorem CLOSED_COMPACT_DIFFERENCES:
15479   !s:real->bool t.
15480        closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}
15481Proof
15482  REPEAT STRIP_TAC THEN
15483  SUBGOAL_THEN ``{x - y | x:real IN s /\ y IN t} =
15484                 {x + y | x IN s /\ y IN (IMAGE (\x. -x) t)}``
15485    (fn th => ASM_SIMP_TAC std_ss [th, CLOSED_COMPACT_SUMS, COMPACT_NEGATIONS]) THEN
15486  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD, IN_IMAGE] THEN
15487  ONCE_REWRITE_TAC[REAL_ARITH ``(x:real = -y) <=> (y = -x)``] THEN
15488  SIMP_TAC std_ss [real_sub, GSYM CONJ_ASSOC, UNWIND_THM2] THEN
15489  METIS_TAC[REAL_NEG_NEG]
15490QED
15491
15492Theorem TRANSLATION_DIFF:
15493   !s t:real->bool.
15494        IMAGE (\x. a + x) (s DIFF t) =
15495        (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)
15496Proof
15497  SIMP_TAC std_ss [EXTENSION, IN_DIFF, IN_IMAGE] THEN
15498  ONCE_REWRITE_TAC[REAL_ARITH ``(x:real = a + y) <=> (y = x - a)``] THEN
15499  SIMP_TAC std_ss [UNWIND_THM2]
15500QED
15501
15502(* ------------------------------------------------------------------------- *)
15503(* Separation between points and sets.                                       *)
15504(* ------------------------------------------------------------------------- *)
15505
15506Theorem SEPARATE_POINT_CLOSED:
15507   !s a:real.
15508        closed s /\ ~(a IN s)
15509        ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)
15510Proof
15511  REPEAT STRIP_TAC THEN
15512  ASM_CASES_TAC ``s:real->bool = {}`` THENL
15513   [EXISTS_TAC ``&1:real`` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY, REAL_LT_01],
15514    ALL_TAC] THEN
15515  MP_TAC(ISPECL [``s:real->bool``, ``a:real``] DISTANCE_ATTAINS_INF) THEN
15516  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC ``b:real`` THEN
15517  STRIP_TAC THEN EXISTS_TAC ``dist(a:real,b)`` THEN
15518  METIS_TAC[DIST_POS_LT]
15519QED
15520
15521Theorem SEPARATE_COMPACT_CLOSED :
15522   !s t:real->bool.
15523        compact s /\ closed t /\ (s INTER t = {})
15524        ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)
15525Proof
15526  REPEAT STRIP_TAC THEN
15527  MP_TAC(ISPECL [``{x - y:real | x IN s /\ y IN t}``, ``0:real``]
15528                SEPARATE_POINT_CLOSED) THEN
15529  ASM_SIMP_TAC std_ss' [COMPACT_CLOSED_DIFFERENCES, GSPECIFICATION, EXISTS_PROD] THEN
15530  REWRITE_TAC[REAL_ARITH ``(0 = x - y) <=> (x = y:real)``] THEN
15531  KNOW_TAC ``(!(p_1 :real) (p_2 :real).
15532    p_1 <> p_2 \/ p_1 NOTIN (s :real -> bool) \/
15533    p_2 NOTIN (t :real -> bool))`` THENL
15534  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
15535  DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN EXISTS_TAC ``d:real`` THEN
15536  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
15537  REWRITE_TAC [dist] THEN
15538  METIS_TAC[REAL_ARITH ``abs(0 - (x - y)) = abs(x - y:real)``]
15539QED
15540
15541Theorem SEPARATE_CLOSED_COMPACT:
15542   !s t:real->bool.
15543        closed s /\ compact t /\ (s INTER t = {})
15544        ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)
15545Proof
15546  ONCE_REWRITE_TAC[DIST_SYM, INTER_COMM] THEN
15547  MESON_TAC[SEPARATE_COMPACT_CLOSED]
15548QED
15549
15550(* ------------------------------------------------------------------------- *)
15551(* Representing sets as the union of a chain of compact sets.                *)
15552(* ------------------------------------------------------------------------- *)
15553
15554Theorem CLOSED_UNION_COMPACT_SUBSETS:
15555   !s. closed s
15556       ==> ?f:num->real->bool.
15557                (!n. compact(f n)) /\
15558                (!n. (f n) SUBSET s) /\
15559                (!n. (f n) SUBSET f(n + 1)) /\
15560                (BIGUNION {f n | n IN univ(:num)} = s) /\
15561                (!k. compact k /\ k SUBSET s
15562                     ==> ?N. !n. n >= N ==> k SUBSET (f n))
15563Proof
15564  REPEAT STRIP_TAC THEN
15565  EXISTS_TAC ``\n. s INTER cball(0:real,&n)`` THEN
15566  ASM_SIMP_TAC std_ss [INTER_SUBSET, COMPACT_CBALL, CLOSED_INTER_COMPACT] THEN
15567  REPEAT CONJ_TAC THENL
15568   [GEN_TAC THEN MATCH_MP_TAC(SET_RULE
15569     ``t SUBSET u ==> s INTER t SUBSET s INTER u``) THEN
15570    REWRITE_TAC[SUBSET_BALLS, DIST_REFL, GSYM REAL_OF_NUM_ADD] THEN
15571    REAL_ARITH_TAC,
15572    SIMP_TAC std_ss [EXTENSION, BIGUNION_GSPEC, GSPECIFICATION, IN_UNIV, IN_INTER] THEN
15573    X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_CBALL_0] THEN
15574    MESON_TAC[SIMP_REAL_ARCH],
15575    X_GEN_TAC ``k:real->bool`` THEN SIMP_TAC std_ss [SUBSET_INTER] THEN
15576    REPEAT STRIP_TAC THEN
15577    FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN
15578     (MP_TAC o SPEC ``0:real`` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN
15579    DISCH_THEN(X_CHOOSE_THEN ``r:real`` STRIP_ASSUME_TAC) THEN
15580    MP_TAC(ISPEC ``r:real`` SIMP_REAL_ARCH) THEN
15581    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
15582    POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN
15583    REPEAT STRIP_TAC THEN
15584    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
15585        SUBSET_TRANS)) THEN
15586    REWRITE_TAC[SUBSET_BALLS, DIST_REFL] THEN ASM_REAL_ARITH_TAC]
15587QED
15588
15589Theorem OPEN_UNION_COMPACT_SUBSETS:
15590   !s. open s
15591       ==> ?f:num->real->bool.
15592                (!n. compact(f n)) /\
15593                (!n. (f n) SUBSET s) /\
15594                (!n. (f n) SUBSET interior(f(n + 1))) /\
15595                (BIGUNION {f n | n IN univ(:num)} = s) /\
15596                (!k. compact k /\ k SUBSET s
15597                     ==> ?N. !n. n >= N ==> k SUBSET (f n))
15598Proof
15599  GEN_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THENL
15600   [DISCH_TAC THEN EXISTS_TAC ``(\n. {}):num->real->bool`` THEN
15601    ASM_SIMP_TAC std_ss [EMPTY_SUBSET, SUBSET_EMPTY, COMPACT_EMPTY] THEN
15602    SIMP_TAC std_ss [EXTENSION, BIGUNION_GSPEC, GSPECIFICATION, NOT_IN_EMPTY],
15603    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
15604    DISCH_THEN(X_CHOOSE_TAC ``a:real``) THEN STRIP_TAC] THEN
15605  KNOW_TAC ``?(f :num -> real -> bool).
15606           (\f. !(n :num). compact (f n)) f /\
15607           (\f. !(n :num). f n SUBSET (s :real -> bool)) f /\
15608           (\f. !(n :num). f n SUBSET interior (f (n +  1n))) f /\
15609           (\f. BIGUNION {f n | n IN univ((:num) :num itself)} = s) f /\
15610  (\f. !(k :real -> bool).
15611    compact k /\ k SUBSET s ==>
15612    ?(N :num). !(n :num). n >= N ==> k SUBSET f n) f`` THENL
15613  [ALL_TAC, METIS_TAC []] THEN
15614  MATCH_MP_TAC(METIS[]
15615  ``(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\
15616    (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f))
15617    ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f``) THEN
15618  CONJ_TAC THENL
15619   [BETA_TAC THEN X_GEN_TAC ``f:num->real->bool`` THEN STRIP_TAC THEN
15620    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
15621    X_GEN_TAC ``k:real->bool`` THEN STRIP_TAC THEN
15622    UNDISCH_TAC ``compact k`` THEN DISCH_TAC THEN
15623    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [COMPACT_EQ_HEINE_BOREL]) THEN
15624    DISCH_THEN(MP_TAC o SPEC ``{interior(f n):real->bool | n IN univ(:num)}``) THEN
15625    SIMP_TAC std_ss [FORALL_IN_GSPEC, OPEN_INTERIOR] THEN
15626    KNOW_TAC ``(k :real -> bool) SUBSET
15627        BIGUNION {interior ((f :num -> real -> bool) n) |
15628                               n IN univ((:num) :num itself)}`` THENL
15629     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
15630        SUBSET_TRANS)) THEN
15631      SIMP_TAC std_ss [SUBSET_DEF, BIGUNION_GSPEC, GSPECIFICATION] THEN ASM_SET_TAC[],
15632      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
15633      ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
15634      ONCE_REWRITE_TAC [METIS [] ``interior (f n) = (\n. interior (f n)) (n:num)``] THEN
15635      SIMP_TAC std_ss [GSYM IMAGE_DEF, EXISTS_FINITE_SUBSET_IMAGE] THEN
15636      REWRITE_TAC[SUBSET_UNIV] THEN
15637      DISCH_THEN(X_CHOOSE_THEN ``i:num->bool`` STRIP_ASSUME_TAC) THEN
15638      FIRST_ASSUM(MP_TAC o SPEC ``\n:num. n`` o
15639        MATCH_MP UPPER_BOUND_FINITE_SET) THEN
15640      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
15641      POP_ASSUM MP_TAC THEN
15642      REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
15643      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
15644        SUBSET_TRANS)) THEN
15645      SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_IMAGE] THEN
15646      X_GEN_TAC ``m:num`` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
15647      EXISTS_TAC ``(f:num->real->bool) m`` THEN
15648      REWRITE_TAC[INTERIOR_SUBSET] THEN
15649      SUBGOAL_THEN ``!m n. m <= n ==> (f:num->real->bool) m SUBSET f n``
15650       (fn th => METIS_TAC[th, LESS_EQ_TRANS]) THEN
15651      ONCE_REWRITE_TAC [METIS [] ``f m SUBSET f n <=> (\m n. f m SUBSET f n) m n``] THEN
15652      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
15653      METIS_TAC[SUBSET_DEF, ADD1, INTERIOR_SUBSET]],
15654    BETA_TAC THEN EXISTS_TAC ``\n. cball(a,&n) DIFF
15655         {x + e | x IN univ(:real) DIFF s /\ e IN ball(0,inv(&n + &1))}`` THEN
15656    SIMP_TAC std_ss [] THEN REPEAT CONJ_TAC THENL
15657     [X_GEN_TAC ``n:num`` THEN MATCH_MP_TAC COMPACT_DIFF THEN
15658      SIMP_TAC std_ss [COMPACT_CBALL, OPEN_SUMS, OPEN_BALL],
15659      GEN_TAC THEN MATCH_MP_TAC(SET_RULE
15660       ``(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s``) THEN
15661      SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
15662      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
15663      MAP_EVERY EXISTS_TAC [``x:real``, ``0:real``] THEN
15664      ASM_SIMP_TAC std_ss [REAL_ADD_RID, CENTRE_IN_BALL, REAL_LT_INV_EQ] THEN
15665      SIMP_TAC std_ss [REAL_LT, REAL_OF_NUM_ADD] THEN ARITH_TAC,
15666      GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE
15667       ``s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')``) THEN
15668      CONJ_TAC THENL
15669       [REWRITE_TAC[INTERIOR_CBALL, SUBSET_DEF, IN_BALL, IN_CBALL] THEN
15670        SIMP_TAC std_ss [GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC,
15671        MATCH_MP_TAC SUBSET_TRANS THEN
15672        EXISTS_TAC ``{x + e | x IN univ(:real) DIFF s /\
15673                             e IN cball(0,inv(&n + &2))}`` THEN
15674        CONJ_TAC THENL
15675         [MATCH_MP_TAC CLOSURE_MINIMAL THEN
15676          ASM_SIMP_TAC std_ss [CLOSED_COMPACT_SUMS, COMPACT_CBALL,
15677                       GSYM OPEN_CLOSED] THEN
15678          KNOW_TAC ``ball (0,inv (&n + 1)) SUBSET ball (0,inv (&n + 1))`` THENL
15679          [SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
15680           SIMP_TAC std_ss [ball, cball, dist, GSYM REAL_OF_NUM_ADD,
15681                            REAL_ARITH ``n + 1 + 1:real = n + 2``,
15682                            GSPECIFICATION] THEN
15683           METIS_TAC [REAL_LE_LT], ALL_TAC] THEN
15684          SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, IN_CBALL, GSYM REAL_OF_NUM_ADD] THEN
15685          SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD, dist,
15686                           REAL_ARITH ``n + 1 + 1:real = n + 2``] THEN
15687          METIS_TAC [REAL_LE_LT],
15688          KNOW_TAC ``cball (0,inv (&n + &2)) SUBSET ball (0,inv (&n + &1))`` THENL
15689          [ALL_TAC,
15690           SIMP_TAC std_ss [cball, ball, dist, SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
15691           METIS_TAC [REAL_LE_LT]] THEN
15692          REWRITE_TAC[SUBSET_DEF, IN_BALL, IN_CBALL, GSYM REAL_OF_NUM_ADD] THEN
15693          GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
15694           ``a < b ==> x <= a ==> x < b:real``) THEN
15695          MATCH_MP_TAC REAL_LT_INV2 THEN
15696          SIMP_TAC arith_ss [REAL_LT, REAL_OF_NUM_ADD]]],
15697      DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
15698      ASM_SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_GSPEC] THEN
15699      SIMP_TAC std_ss [SUBSET_DEF, BIGUNION_GSPEC, IN_UNIV, GSPECIFICATION] THEN
15700      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN
15701      SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV, IN_BALL_0, EXISTS_PROD] THEN
15702      REWRITE_TAC[REAL_ARITH ``(x:real = y + e) <=> (e = x - y)``] THEN
15703      SIMP_TAC std_ss [TAUT `(p /\ q) /\ r <=> r /\ p /\ q`, UNWIND_THM2] THEN
15704      ONCE_REWRITE_TAC [METIS [DE_MORGAN_THM]
15705           ``(!p_1:real. p_1 IN s \/ ~(abs (x - p_1) < inv (&n + 1))) <=>
15706             ~(?p_1:real. (~(\p_1. (p_1 IN s)) p_1 /\
15707                            (\p_1. abs (x - p_1) < inv (&n + 1)) p_1))``] THEN
15708      REWRITE_TAC[METIS [] ``~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x``] THEN
15709      UNDISCH_TAC ``open s`` THEN DISCH_TAC THEN BETA_TAC THEN
15710      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_CONTAINS_BALL]) THEN
15711      DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
15712      ASM_REWRITE_TAC[SUBSET_DEF, IN_BALL, dist] THEN
15713      DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
15714      UNDISCH_TAC ``0 < e:real`` THEN DISCH_TAC THEN
15715      FIRST_ASSUM(MP_TAC o ONCE_REWRITE_RULE [REAL_ARCH_INV]) THEN
15716      DISCH_THEN(X_CHOOSE_THEN ``N1:num`` STRIP_ASSUME_TAC) THEN
15717      MP_TAC(ISPEC ``abs(x - a:real)`` SIMP_REAL_ARCH) THEN
15718      DISCH_THEN(X_CHOOSE_TAC ``N2:num``) THEN EXISTS_TAC ``N1 + N2:num`` THEN
15719      CONJ_TAC THENL
15720       [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM, dist] THEN
15721        UNDISCH_TAC ``abs(x - a:real) <= &N2`` THEN
15722        REWRITE_TAC[dist, GSYM REAL_OF_NUM_ADD] THEN
15723        FULL_SIMP_TAC std_ss [REAL_LT_INV_EQ] THEN
15724        DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
15725        EXISTS_TAC ``&N2:real`` THEN ASM_REWRITE_TAC [] THEN
15726        SIMP_TAC arith_ss [REAL_OF_NUM_LE, REAL_OF_NUM_ADD],
15727        REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
15728        SUBGOAL_THEN ``inv(&(N1 + N2) + &1) <= inv(&N1:real)`` MP_TAC THENL
15729         [MATCH_MP_TAC REAL_LE_INV2 THEN
15730          ASM_SIMP_TAC arith_ss [REAL_LT, LE_1] THEN
15731          REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN
15732          SIMP_TAC arith_ss [REAL_OF_NUM_LE, REAL_OF_NUM_ADD],
15733          METIS_TAC [REAL_LTE_TRANS, REAL_LET_TRANS, REAL_LE_TRANS, REAL_LT_TRANS]]]]]
15734QED
15735
15736Theorem IN_INTERVAL_REFLECT:
15737   (!a b x. (-x) IN interval[-b,-a] <=> x IN interval[a,b]) /\
15738   (!a b x. (-x) IN interval(-b,-a) <=> x IN interval(a,b))
15739Proof
15740  SIMP_TAC std_ss [IN_INTERVAL, REAL_LT_NEG, REAL_LE_NEG] THEN
15741  METIS_TAC[]
15742QED
15743
15744Theorem REFLECT_INTERVAL:
15745   (!a b:real. IMAGE (\x. -x) (interval[a,b]) = interval[-b,-a]) /\
15746   (!a b:real. IMAGE (\x. -x) (interval(a,b)) = interval(-b,-a))
15747Proof
15748  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_INTERVAL,
15749   IN_IMAGE] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN
15750  METIS_TAC [REAL_LE_NEG, REAL_LT_NEG, REAL_NEG_NEG]
15751QED
15752
15753Theorem INTERVAL_EQ_EMPTY:
15754   !a b. (b < a <=> (interval [a,b] = {})) /\
15755         (b <= a <=> (interval (a,b) = {}))
15756Proof
15757  REPEAT GEN_TAC THEN CONJ_TAC THENL
15758  [EQ_TAC THENL [RW_TAC std_ss [EXTENSION, IN_INTERVAL] THEN EQ_TAC THENL
15759  [SIMP_TAC std_ss [NOT_IN_EMPTY] THEN CCONTR_TAC THEN
15760   FULL_SIMP_TAC std_ss [REAL_NEG_NEG] THEN UNDISCH_TAC (Term `b < a:real`) THEN
15761   FULL_SIMP_TAC std_ss [REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
15762   EXISTS_TAC ``x:real`` THEN ASM_REWRITE_TAC [], SIMP_TAC std_ss [NOT_IN_EMPTY]],
15763   RW_TAC std_ss [EXTENSION, IN_INTERVAL] THEN
15764   CCONTR_TAC THEN UNDISCH_TAC (Term `!x:real. a <= x /\ x <= b <=> x IN {}`) THEN
15765   FULL_SIMP_TAC std_ss [NOT_IN_EMPTY, REAL_NOT_LT] THEN EXISTS_TAC ``a:real``
15766   THEN FULL_SIMP_TAC std_ss [REAL_LE_LT]],
15767   EQ_TAC THENL [RW_TAC std_ss [EXTENSION, IN_INTERVAL] THEN EQ_TAC THENL
15768    [SIMP_TAC std_ss [NOT_IN_EMPTY] THEN CCONTR_TAC THEN
15769     FULL_SIMP_TAC std_ss [REAL_NEG_NEG] THEN UNDISCH_TAC (Term `b <= a:real`) THEN
15770     FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
15771     EXISTS_TAC ``x:real`` THEN ASM_REWRITE_TAC [], SIMP_TAC std_ss [NOT_IN_EMPTY]],
15772     RW_TAC std_ss [EXTENSION, IN_INTERVAL] THEN
15773     CCONTR_TAC THEN UNDISCH_TAC (Term `!x:real. a < x /\ x < b <=> x IN {}`) THEN
15774     FULL_SIMP_TAC std_ss [NOT_IN_EMPTY, REAL_NOT_LE, REAL_MEAN]]]
15775QED
15776
15777Theorem INTERVAL_NE_EMPTY:
15778   (~(interval [a:real,b] = {}) <=> a <= b) /\
15779   (~(interval (a:real,b) = {}) <=> a < b)
15780Proof
15781  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY, IN_INTERVAL] THEN
15782  CONJ_TAC THEN EQ_TAC THENL [SIMP_TAC std_ss [REAL_LE_TRANS],
15783  DISCH_TAC THEN EXISTS_TAC ``a:real`` THEN ASM_SIMP_TAC std_ss [REAL_LE_LT],
15784  SIMP_TAC std_ss [REAL_LT_TRANS], FULL_SIMP_TAC std_ss [REAL_MEAN]]
15785QED
15786
15787Theorem SUBSET_INTERVAL_IMP:
15788   ((a <= c /\ d <= b) ==> interval[c,d] SUBSET interval[a:real,b]) /\
15789   ((a < c  /\ d < b)  ==> interval[c,d] SUBSET interval(a:real,b)) /\
15790   ((a <= c /\ d <= b) ==> interval(c,d) SUBSET interval[a:real,b]) /\
15791   ((a <= c /\ d <= b) ==> interval(c,d) SUBSET interval(a:real,b))
15792Proof
15793  REWRITE_TAC[SUBSET_DEF, IN_INTERVAL] THEN REPEAT CONJ_TAC THEN
15794  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN
15795  METIS_TAC [REAL_LE_TRANS, REAL_LET_TRANS, REAL_LTE_TRANS, REAL_LT_IMP_LE]
15796QED
15797
15798Theorem INTERVAL_SING:
15799   (interval[a,a] = {a}) /\ (interval(a,a) = {})
15800Proof
15801  REWRITE_TAC[EXTENSION, IN_SING, NOT_IN_EMPTY, IN_INTERVAL] THEN
15802  REWRITE_TAC[REAL_LE_ANTISYM, REAL_LT_ANTISYM] THEN
15803  MESON_TAC[EQ_SYM_EQ]
15804QED
15805
15806Theorem SUBSET_INTERVAL:
15807   (interval[c,d] SUBSET interval[a:real,b] <=>
15808        (c <= d) ==> (a <= c /\ d <= b)) /\
15809   (interval[c,d] SUBSET interval(a:real,b) <=>
15810        (c <= d) ==> (a < c /\ d < b)) /\
15811   (interval(c,d) SUBSET interval[a:real,b] <=>
15812        (c < d) ==> (a <= c /\ d <= b)) /\
15813   (interval(c,d) SUBSET interval(a:real,b) <=>
15814        (c < d) ==> (a <= c /\ d <= b))
15815Proof
15816  REPEAT STRIP_TAC THEN
15817  (MATCH_MP_TAC(TAUT
15818    `(~q ==> p) /\ (q ==> (p <=> r)) ==> (p <=> q ==> r)`) THEN
15819   CONJ_TAC THENL
15820    [DISCH_TAC THEN MATCH_MP_TAC(SET_RULE ``(s = {}) ==> s SUBSET t``) THEN
15821     ASM_MESON_TAC[INTERVAL_EQ_EMPTY, REAL_NOT_LE], ALL_TAC] THEN
15822   DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_IMP] THEN
15823   REWRITE_TAC[SUBSET_DEF, IN_INTERVAL]) THENL
15824   [KNOW_TAC ``((?y. c <= y /\ y <= d)
15825           ==> (!y. c <= y /\ y <= d
15826                ==> a <= y /\ y <= b))
15827          ==> (a <= c:real /\ d <= b:real)`` THENL
15828    [ALL_TAC, METIS_TAC []] THEN
15829    KNOW_TAC ``(?y:real. c <= y /\ y <= d)`` THENL
15830    [ASM_MESON_TAC[REAL_MEAN, REAL_LE_BETWEEN], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
15831    STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS, REAL_LE_REFL],
15832    KNOW_TAC ``((?y. c <= y /\ y <= d)
15833           ==> (!y. c <= y /\ y <= d
15834                 ==> a < y /\ y < b))
15835           ==> (a < c:real /\ d < b:real)`` THENL
15836    [ALL_TAC, METIS_TAC []] THEN
15837    KNOW_TAC ``(?y:real. c <= y /\ y <= d)`` THENL
15838    [ASM_MESON_TAC[REAL_MEAN, REAL_LE_BETWEEN], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
15839    STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS, REAL_LE_REFL],
15840    KNOW_TAC ``((?y. c < y /\ y < d)
15841           ==> (!y. c < y /\ y < d
15842               ==> a <= y /\ y <= b))
15843         ==> (a <= c:real /\ d <= b:real)`` THENL
15844    [ALL_TAC, METIS_TAC []] THEN
15845    KNOW_TAC ``(?y:real. c < y /\ y < d)`` THENL
15846    [ASM_MESON_TAC[REAL_MEAN, REAL_LE_BETWEEN], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
15847    REPEAT STRIP_TAC THENL
15848    [CCONTR_TAC THEN UNDISCH_TAC ``!y:real. c < y /\ y < d ==> a <= y /\ y <= b`` THEN
15849    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN
15850    EXISTS_TAC ``((c:real) + min ((a:real)) ((d:real))) / &2:real`` THEN
15851    METIS_TAC [min_def, max_def, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``, REAL_LT_LDIV_EQ,
15852               GSYM REAL_DOUBLE, REAL_LT_LADD, REAL_ADD_SYM, REAL_MUL_SYM, REAL_LT_ADD2,
15853               REAL_LTE_ADD2, REAL_NOT_LE],
15854    CCONTR_TAC THEN UNDISCH_TAC ``!y:real. c < y /\ y < d ==> a <= y /\ y <= b`` THEN
15855    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN
15856    EXISTS_TAC ``(max ((b:real)) ((c:real)) + (d:real)) / &2:real`` THEN
15857    METIS_TAC [min_def, max_def, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``, REAL_LT_LDIV_EQ,
15858               GSYM REAL_DOUBLE, REAL_LT_LADD, REAL_ADD_SYM, REAL_MUL_SYM, REAL_LT_ADD2,
15859               REAL_LTE_ADD2, REAL_NOT_LE]],
15860    KNOW_TAC ``((?y. c < y /\ y < d)
15861           ==> (!y. c < y /\ y < d
15862                ==> a < y /\ y < b))
15863         ==> (a <= c:real /\ d <= b:real)`` THENL
15864    [ALL_TAC, METIS_TAC []] THEN
15865    KNOW_TAC ``(?y:real. c < y /\ y < d)`` THENL
15866    [ASM_MESON_TAC[REAL_MEAN, REAL_LE_BETWEEN], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
15867    REPEAT STRIP_TAC THENL
15868    [CCONTR_TAC THEN UNDISCH_TAC ``!y:real. c < y /\ y < d ==> a < y /\ y < b`` THEN
15869    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN
15870    EXISTS_TAC ``((c:real) + min ((a:real)) ((d:real))) / &2:real`` THEN
15871    METIS_TAC [min_def, max_def, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``, REAL_LT_LDIV_EQ,
15872               GSYM REAL_DOUBLE, REAL_LT_LADD, REAL_ADD_SYM, REAL_MUL_SYM, REAL_LT_ADD2,
15873               REAL_LTE_ADD2, REAL_NOT_LE, REAL_NOT_LT, REAL_LT_RDIV_EQ, REAL_LT_LDIV_EQ,
15874               REAL_LE_LADD, REAL_LE_ADD2, REAL_LE_RADD, REAL_LE_LT],
15875    CCONTR_TAC THEN UNDISCH_TAC ``!y:real. c < y /\ y < d ==> a < y /\ y < b`` THEN
15876    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN
15877    EXISTS_TAC ``(max ((b:real)) ((c:real)) + (d:real)) / &2:real`` THEN
15878    METIS_TAC [min_def, max_def, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``, REAL_LT_LDIV_EQ,
15879               GSYM REAL_DOUBLE, REAL_LT_LADD, REAL_ADD_SYM, REAL_MUL_SYM, REAL_LT_ADD2,
15880               REAL_LTE_ADD2, REAL_NOT_LE, REAL_NOT_LT, REAL_LT_RDIV_EQ, REAL_LT_LDIV_EQ,
15881               REAL_LE_LADD, REAL_LE_ADD2, REAL_LE_RADD, REAL_LE_LT]]]
15882QED
15883
15884Theorem ENDS_IN_INTERVAL:
15885   (!a b. a IN interval[a,b] <=> ~(interval[a,b] = {})) /\
15886   (!a b. b IN interval[a,b] <=> ~(interval[a,b] = {})) /\
15887   (!a b. ~(a IN interval(a,b))) /\
15888   (!a b. ~(b IN interval(a,b)))
15889Proof
15890  REWRITE_TAC[IN_INTERVAL, INTERVAL_NE_EMPTY] THEN
15891  REWRITE_TAC[REAL_LE_REFL, REAL_LT_REFL] THEN
15892  MESON_TAC[REAL_LE_REFL]
15893QED
15894
15895Theorem ENDS_IN_UNIT_INTERVAL:
15896   0 IN interval[0,1] /\ 1 IN interval[0,1] /\
15897   ~(0 IN interval(0,1)) /\ ~(1 IN interval(0,1))
15898Proof
15899  REWRITE_TAC[ENDS_IN_INTERVAL, INTERVAL_NE_EMPTY] THEN
15900  REWRITE_TAC[REAL_POS]
15901QED
15902
15903Theorem INTER_INTERVAL:
15904   interval[a,b] INTER interval[c,d] =
15905        interval[(max (a) (c)),(min (b) (d))]
15906Proof
15907  REWRITE_TAC[EXTENSION, IN_INTER, IN_INTERVAL] THEN
15908  SIMP_TAC std_ss [REAL_MAX_LE, REAL_LE_MIN] THEN MESON_TAC[]
15909QED
15910
15911Theorem INTERVAL_OPEN_SUBSET_CLOSED:
15912   !a b. interval(a,b) SUBSET interval[a,b]
15913Proof
15914  REWRITE_TAC[SUBSET_DEF, IN_INTERVAL] THEN MESON_TAC[REAL_LT_IMP_LE]
15915QED
15916
15917Theorem OPEN_INTERVAL_LEMMA:
15918   !a b x. a < x /\ x < b
15919           ==> ?d. (0:real) < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b
15920Proof
15921  REPEAT STRIP_TAC THEN
15922  EXISTS_TAC ``min (x - a) (b - x:real)`` THEN REWRITE_TAC[REAL_LT_MIN] THEN
15923  REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC
15924QED
15925
15926Theorem OPEN_INTERVAL:
15927   !a:real b. open(interval (a,b))
15928Proof
15929  REPEAT GEN_TAC THEN
15930  SIMP_TAC std_ss [open_def, interval, GSPECIFICATION, dist, OPEN_INTERVAL_LEMMA]
15931QED
15932
15933Theorem CLOSED_INTERVAL:
15934   !a:real b. closed(interval [a,b])
15935Proof
15936  REWRITE_TAC[CLOSED_LIMPT, LIMPT_APPROACHABLE, IN_INTERVAL] THEN
15937  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL
15938   [FIRST_X_ASSUM(MP_TAC o SPEC ``(a:real) - (x:real)``),
15939    FIRST_X_ASSUM(MP_TAC o SPEC ``(x:real) - (b:real)``)] THEN
15940  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
15941  DISCH_THEN(X_CHOOSE_THEN ``z:real`` MP_TAC) THEN
15942  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15943  REWRITE_TAC[dist, REAL_NOT_LT] THEN
15944  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs((z - x :real))`` THEN
15945  ASM_SIMP_TAC std_ss [REAL_ARITH ``x < a /\ a <= z ==> a - x:real <= abs(z - x)``,
15946                       REAL_ARITH ``z <= b /\ b < x ==> x - b:real <= abs(z - x)``,
15947                       REAL_LE_REFL]
15948QED
15949
15950Theorem INTERIOR_CLOSED_INTERVAL:
15951   !a:real b. interior(interval [a,b]) = interval (a,b)
15952Proof
15953  REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
15954   [ALL_TAC,
15955    MATCH_MP_TAC INTERIOR_MAXIMAL THEN
15956    REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED, OPEN_INTERVAL]] THEN
15957  SIMP_TAC std_ss [interior, SUBSET_DEF, IN_INTERVAL, GSPECIFICATION] THEN
15958  X_GEN_TAC ``x:real`` THEN
15959  DISCH_THEN(X_CHOOSE_THEN ``s:real->bool`` STRIP_ASSUME_TAC) THEN
15960  ASM_SIMP_TAC std_ss [REAL_LT_LE] THEN REPEAT STRIP_TAC THEN
15961  UNDISCH_TAC ``open s`` THEN REWRITE_TAC [open_def] THEN
15962  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
15963  DISCH_THEN(X_CHOOSE_THEN ``e:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
15964  [DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `x - (e / 2:real)`),
15965   DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `x + (e / 2:real)`)] THEN
15966   ASM_SIMP_TAC std_ss [dist, REAL_ADD_SUB, REAL_ARITH ``x - y - x = -y:real``,
15967                                   REAL_ARITH ``x + y - x = y:real``] THEN
15968   ASM_SIMP_TAC std_ss [ABS_MUL, ABS_NEG, REAL_MUL_RID] THENL [CONJ_TAC THENL
15969   [METIS_TAC [ABS_REFL, REAL_LT_HALF1, REAL_LT_HALF2, REAL_LE_LT], ALL_TAC],
15970    CONJ_TAC THENL [METIS_TAC [ABS_REFL, REAL_LT_HALF1, REAL_LT_HALF2, REAL_LE_LT],
15971   ALL_TAC]] THEN CCONTR_TAC THEN
15972   UNDISCH_TAC ``!x. x IN s ==> a <= x /\ x <= b:real`` THEN DISCH_TAC THENL
15973   [POP_ASSUM (MP_TAC o Q.SPEC `x - e / 2:real`),
15974    POP_ASSUM (MP_TAC o Q.SPEC `x + e / 2:real`)] THEN FULL_SIMP_TAC std_ss [] THENL
15975   [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH ``a <= a - b <=> ~(&0 < b:real)``],
15976    DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH ``a + b <= a <=> ~(&0 < b:real)``]] THEN
15977   FULL_SIMP_TAC std_ss [REAL_LT_HALF1]
15978QED
15979
15980Theorem INTERIOR_INTERVAL:
15981   (!a b. interior(interval[a,b]) = interval(a,b)) /\
15982   (!a b. interior(interval(a,b)) = interval(a,b))
15983Proof
15984  SIMP_TAC std_ss [INTERIOR_CLOSED_INTERVAL, INTERIOR_OPEN, OPEN_INTERVAL]
15985QED
15986
15987Theorem BOUNDED_CLOSED_INTERVAL:
15988   !a b:real. bounded (interval [a,b])
15989Proof
15990  REPEAT STRIP_TAC THEN REWRITE_TAC[bounded_def, interval] THEN
15991  SIMP_TAC std_ss [GSPECIFICATION] THEN
15992  EXISTS_TAC ``abs(a) + abs(b:real)`` THEN REAL_ARITH_TAC
15993QED
15994
15995Theorem BOUNDED_INTERVAL:
15996   (!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))
15997Proof
15998  MESON_TAC[BOUNDED_CLOSED_INTERVAL, BOUNDED_SUBSET,
15999            INTERVAL_OPEN_SUBSET_CLOSED]
16000QED
16001
16002Theorem NOT_INTERVAL_UNIV:
16003   (!a b. ~(interval[a,b] = UNIV)) /\
16004   (!a b. ~(interval(a,b) = UNIV))
16005Proof
16006  MESON_TAC[BOUNDED_INTERVAL, NOT_BOUNDED_UNIV]
16007QED
16008
16009Theorem COMPACT_INTERVAL:
16010   !a b. compact (interval [a,b])
16011Proof
16012  SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_INTERVAL, CLOSED_INTERVAL]
16013QED
16014
16015Theorem OPEN_INTERVAL_MIDPOINT:
16016   !a b:real.
16017        ~(interval(a,b) = {}) ==> (inv(&2) * (a + b)) IN interval(a,b)
16018Proof
16019  REWRITE_TAC[INTERVAL_NE_EMPTY, IN_INTERVAL] THEN
16020  ONCE_REWRITE_TAC [REAL_MUL_COMM] THEN ONCE_REWRITE_TAC [GSYM real_div] THEN
16021  KNOW_TAC ``0 < 2:real`` THENL [REAL_ARITH_TAC, ALL_TAC] THEN
16022  REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_LT_LDIV_EQ] THEN
16023  REWRITE_TAC [REAL_MUL_COMM, GSYM REAL_DOUBLE] THEN
16024  FULL_SIMP_TAC std_ss [REAL_LT_LADD, REAL_LT_RADD]
16025QED
16026
16027Theorem OPEN_CLOSED_INTERVAL_CONVEX:
16028   !a b x y:real e.
16029        x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1
16030        ==> (e * x + (&1 - e) * y) IN interval(a,b)
16031Proof
16032  REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
16033   `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN
16034  STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN
16035  SUBST1_TAC(REAL_ARITH ``(a:real) = e * a + (&1 - e) * a``) THEN
16036  SUBST1_TAC(REAL_ARITH ``(b:real) = e * b + (&1 - e) * b``) THEN
16037  KNOW_TAC ``0:real <= 1 - e`` THENL
16038 [FULL_SIMP_TAC std_ss [REAL_SUB_LE], ALL_TAC] THEN
16039  REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL
16040  [CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN
16041  ASM_SIMP_TAC std_ss [REAL_LT_LMUL, REAL_LE_LMUL, REAL_SUB_LE],
16042  POP_ASSUM MP_TAC THEN GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN
16043  DISCH_TAC THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN
16044  ASM_SIMP_TAC std_ss [REAL_LT_LMUL, REAL_LE_LMUL, REAL_SUB_LE, REAL_MUL_LZERO, REAL_LE_REFL]]
16045QED
16046
16047Theorem CLOSURE_OPEN_INTERVAL:
16048   !a b:real.
16049     ~(interval(a,b) = {}) ==> (closure(interval(a,b)) = interval[a,b])
16050Proof
16051  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
16052   [MATCH_MP_TAC CLOSURE_MINIMAL THEN
16053    REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED, CLOSED_INTERVAL],
16054    ALL_TAC] THEN
16055  REWRITE_TAC[SUBSET_DEF, closure, IN_UNION] THEN X_GEN_TAC ``x:real`` THEN
16056  DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN
16057  SIMP_TAC std_ss [GSPECIFICATION, LIMPT_SEQUENTIAL] THEN
16058  ABBREV_TAC ``(c:real) = inv(&2:real) * (a + b)`` THEN
16059  EXISTS_TAC ``\n. (x:real) + inv(&n + &1:real) * (c - x)`` THEN CONJ_TAC THENL
16060   [X_GEN_TAC ``n:num`` THEN REWRITE_TAC[IN_DELETE] THEN BETA_TAC THEN
16061    REWRITE_TAC[REAL_ARITH ``(x + a = x) <=> (a = 0:real)``] THEN
16062    REWRITE_TAC[REAL_ENTIRE, REAL_INV_EQ_0] THEN
16063    SIMP_TAC std_ss [REAL_SUB_0, REAL_OF_NUM_SUC, SUC_NOT, REAL_OF_NUM_EQ, EQ_SYM_EQ] THEN
16064    CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN
16065    REWRITE_TAC[REAL_ARITH ``x + a * (y - x) = a * y + (&1 - a) * x:real``] THEN
16066    MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN
16067    CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT], ALL_TAC] THEN
16068    KNOW_TAC ``&0:real < &n + &1`` THENL [SIMP_TAC std_ss [REAL_OF_NUM_SUC] THEN
16069    ASM_REWRITE_TAC[REAL_LT_INV_EQ, REAL_OF_NUM_SUC, REAL_LT, LESS_0], ALL_TAC] THEN
16070    DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ, REAL_OF_NUM_SUC, REAL_LT, LESS_0] THEN
16071    MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC [REAL_LE, ONE, LESS_EQ_MONO,
16072    ZERO_LESS_EQ], ALL_TAC] THEN
16073  GEN_REWR_TAC LAND_CONV [REAL_ARITH ``x:real = x + &0 * (c - x)``] THEN
16074  KNOW_TAC ``!n:num x:real. (\n. x + inv (&n + 1) * (c - x)) =
16075                     (\n. (\n. x) n + (\n. inv (&n + 1) * (c - x)) n)`` THENL
16076  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
16077  MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN
16078  KNOW_TAC ``!n:num. (\n. inv (&n + 1) * (c - x:real)) =
16079                     (\n. (\n. inv (&n + 1)) n * (\n. (c - x)) n)`` THENL
16080  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
16081  MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[LIM_CONST] THEN
16082  REWRITE_TAC[LIM_SEQUENTIALLY, o_THM, REAL_SUB_RZERO] THEN BETA_TAC THEN
16083  X_GEN_TAC ``e:real`` THEN GEN_REWR_TAC LAND_CONV [REAL_ARCH_INV] THEN
16084  DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
16085  X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
16086  KNOW_TAC ``&n + 1 <> 0:real`` THENL
16087  [ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
16088   SIMP_TAC arith_ss [REAL_OF_NUM_SUC, REAL_LT, ADD1], ALL_TAC] THEN DISCH_TAC THEN
16089  ASM_SIMP_TAC std_ss [DIST_0, ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
16090  EXISTS_TAC ``inv(&N:real)`` THEN ASM_REWRITE_TAC[] THEN
16091  MATCH_MP_TAC REAL_LE_INV2 THEN FULL_SIMP_TAC std_ss [] THEN
16092  UNDISCH_TAC ``N:num <= n`` THEN UNDISCH_TAC ``N <> 0:num`` THEN
16093  REWRITE_TAC[NOT_ZERO_LT_ZERO, GSYM REAL_OF_NUM_LE, GSYM REAL_LT] THEN
16094  REAL_ARITH_TAC
16095QED
16096
16097Theorem CLOSURE_INTERVAL:
16098   (!a b. closure(interval[a,b]) = interval[a,b]) /\
16099   (!a b. closure(interval(a,b)) =
16100          if interval(a,b) = {} then {} else interval[a,b])
16101Proof
16102  SIMP_TAC std_ss [CLOSURE_CLOSED, CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN
16103  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [CLOSURE_OPEN_INTERVAL, CLOSURE_EMPTY]
16104QED
16105
16106Theorem BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC:
16107   !s:real->bool. bounded s ==> ?a. s SUBSET interval(-a,a)
16108Proof
16109  SIMP_TAC std_ss [BOUNDED_POS, LEFT_IMP_EXISTS_THM] THEN
16110  MAP_EVERY X_GEN_TAC [``s:real->bool``, ``B:real``] THEN STRIP_TAC THEN
16111  EXISTS_TAC ``(B + &1):real`` THEN
16112  REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
16113  SIMP_TAC std_ss [IN_INTERVAL, REAL_BOUNDS_LT] THEN
16114  METIS_TAC[REAL_LE_REFL, REAL_ARITH ``x <= y ==> a <= x ==> a < y + &1:real``]
16115QED
16116
16117Theorem BOUNDED_SUBSET_OPEN_INTERVAL:
16118   !s:real->bool. bounded s ==> ?a b. s SUBSET interval(a,b)
16119Proof
16120  MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]
16121QED
16122
16123Theorem BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC:
16124   !s:real->bool. bounded s ==> ?a. s SUBSET interval[-a,a]
16125Proof
16126  GEN_TAC THEN
16127  DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN
16128  STRIP_TAC THEN EXISTS_TAC ``a:real`` THEN POP_ASSUM MP_TAC THEN
16129  SIMP_TAC std_ss [IN_BALL, IN_INTERVAL, SUBSET_DEF, REAL_LT_IMP_LE]
16130QED
16131
16132Theorem BOUNDED_SUBSET_CLOSED_INTERVAL:
16133   !s:real->bool. bounded s ==> ?a b. s SUBSET interval[a,b]
16134Proof
16135  MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]
16136QED
16137
16138Theorem FRONTIER_CLOSED_INTERVAL:
16139   !a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)
16140Proof
16141  SIMP_TAC std_ss [frontier, INTERIOR_CLOSED_INTERVAL, CLOSURE_CLOSED,
16142           CLOSED_INTERVAL]
16143QED
16144
16145Theorem FRONTIER_OPEN_INTERVAL:
16146   !a b. frontier(interval(a,b)) =
16147                if interval(a,b) = {} then {}
16148                else interval[a,b] DIFF interval(a,b)
16149Proof
16150  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN
16151  ASM_SIMP_TAC std_ss [frontier, CLOSURE_OPEN_INTERVAL, INTERIOR_OPEN,
16152               OPEN_INTERVAL]
16153QED
16154
16155Theorem INTER_INTERVAL_MIXED_EQ_EMPTY:
16156   !a b c d:real.
16157        ~(interval(c,d) = {})
16158        ==> ((interval(a,b) INTER interval[c,d] = {}) <=>
16159             (interval(a,b) INTER interval(c,d) = {}))
16160Proof
16161  SIMP_TAC std_ss [GSYM CLOSURE_OPEN_INTERVAL, OPEN_INTER_CLOSURE_EQ_EMPTY,
16162           OPEN_INTERVAL]
16163QED
16164
16165Theorem INTERVAL_TRANSLATION:
16166   (!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\
16167   (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))
16168Proof
16169  REWRITE_TAC[interval] THEN CONJ_TAC THEN
16170  (SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE] THEN
16171   REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
16172   TRY (EXISTS_TAC ``-c + x:real``) THEN ASM_REAL_ARITH_TAC)
16173QED
16174
16175Theorem EMPTY_AS_INTERVAL:
16176   {} = interval[1,0]
16177Proof
16178  SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, IN_INTERVAL] THEN
16179  REAL_ARITH_TAC
16180QED
16181
16182Theorem UNIT_INTERVAL_NONEMPTY:
16183   ~(interval[0:real,1] = {}) /\
16184   ~(interval(0:real,1) = {})
16185Proof
16186  SIMP_TAC std_ss [INTERVAL_NE_EMPTY, REAL_LT_01, REAL_POS]
16187QED
16188
16189Theorem IMAGE_STRETCH_INTERVAL:
16190   !a b:real m.
16191    IMAGE (\x. @f. f = m 1n * x) (interval[a,b]) =
16192        if interval[a,b] = {} then {}
16193        else interval[(@f. f = min (m 1n * a) (m 1n * b)):real,
16194                      (@f. f = max (m 1n * a) (m 1n * b))]
16195Proof
16196  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [IMAGE_EMPTY, IMAGE_INSERT] THEN
16197  ASM_SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_INTERVAL, GSYM FORALL_AND_THM,
16198               TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN
16199  X_GEN_TAC ``x:real`` THEN
16200  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
16201  ASM_CASES_TAC ``(m:num->real)  1n = &0`` THENL
16202   [ASM_SIMP_TAC std_ss [REAL_MUL_LZERO, REAL_MAX_ACI, REAL_MIN_ACI] THEN
16203    METIS_TAC[REAL_LE_ANTISYM, REAL_LE_REFL],
16204    ALL_TAC] THEN
16205  KNOW_TAC ``!m x y:real. ~(m = 0:real) ==> ((x = m * y) <=> (y = x / m))`` THENL
16206  [REPEAT GEN_TAC THEN DISCH_TAC THEN ASSUME_TAC REAL_LE_TOTAL THEN
16207   GEN_REWR_TAC RAND_CONV [EQ_SYM_EQ] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
16208   POP_ASSUM (MP_TAC o Q.SPECL [`m':real`,`0:real`]) THEN
16209   ASM_SIMP_TAC std_ss [REAL_LE_LT] THEN STRIP_TAC THENL
16210   [ALL_TAC, METIS_TAC [REAL_EQ_LDIV_EQ]] THEN
16211   ONCE_REWRITE_TAC [GSYM REAL_EQ_NEG] THEN REWRITE_TAC [real_div] THEN
16212   REWRITE_TAC [REAL_ARITH ``-(a * b) = a * -b:real``] THEN
16213   ASM_SIMP_TAC std_ss [REAL_NEG_INV, GSYM real_div] THEN POP_ASSUM MP_TAC THEN
16214   GEN_REWR_TAC LAND_CONV [GSYM REAL_LT_NEG] THEN REWRITE_TAC [REAL_NEG_0] THEN
16215   DISCH_TAC THEN REWRITE_TAC [REAL_ARITH ``(-x = y * -m) <=> (x = -y * -m:real)``] THEN
16216   METIS_TAC [REAL_EQ_LDIV_EQ], DISCH_TAC THEN ASM_SIMP_TAC std_ss []] THEN
16217  SIMP_TAC std_ss [UNWIND_THM2] THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP
16218   (REAL_ARITH ``~(z = &0) ==> &0 < z \/ &0 < -z:real``))
16219  >- ( ASM_SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ] \\
16220       DISCH_TAC \\
16221       `(m 1) * a <= (m 1) * b` by PROVE_TAC [REAL_LE_LMUL] \\
16222       ASM_SIMP_TAC std_ss [min_def, max_def] \\
16223       METIS_TAC [REAL_MUL_SYM] )
16224  >> ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2]
16225  >> ONCE_REWRITE_TAC[REAL_MUL_SYM]
16226  >> KNOW_TAC ``!a b. -(max a b) = min (-a) (-b:real)``
16227  >- PROVE_TAC [REAL_MAX_MIN, REAL_NEG_NEG] >> DISCH_TAC
16228  >> KNOW_TAC ``!a b. -(min a b) = max (-a) (-b:real)``
16229  >- PROVE_TAC [REAL_MIN_MAX, REAL_NEG_NEG] >> DISCH_TAC
16230  >> ASM_SIMP_TAC std_ss [real_div, GSYM REAL_MUL_RNEG, REAL_NEG_INV]
16231  >> REWRITE_TAC [GSYM real_div]
16232  >> ASM_SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ]
16233  >> ONCE_REWRITE_TAC [REAL_LE_NEG2]
16234  >> DISCH_TAC
16235  >> `a * -(m 1) <= b * -(m 1)` by PROVE_TAC [REAL_LE_RMUL]
16236  >> ASM_SIMP_TAC std_ss [min_def, max_def]
16237  >> REAL_ARITH_TAC
16238QED
16239
16240Theorem INTERVAL_IMAGE_STRETCH_INTERVAL:
16241   !a b:real m. ?u v:real.
16242     IMAGE (\x. @f. f = m  1n * x) (interval[a,b]) = interval[u,v]
16243Proof
16244  SIMP_TAC std_ss [IMAGE_STRETCH_INTERVAL] THEN METIS_TAC[EMPTY_AS_INTERVAL]
16245QED
16246
16247Theorem CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL:
16248   !a b:real.
16249        ~(interval[a,b] = {})
16250        ==> (interval[a,b] = IMAGE (\x:real. a + x)
16251                                  (IMAGE (\x. (@f. f = (b - a) * x))
16252                                         (interval[0:real,1])))
16253Proof
16254  REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
16255  ONCE_REWRITE_TAC [METIS [] ``(\x. @f. f = (b - a) * x) =
16256                               (\x. @f. f = (\x. (b - a))  1n * x:real)``] THEN
16257  REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN
16258  SIMP_TAC std_ss [REAL_MUL_RZERO, REAL_MUL_RID, UNIT_INTERVAL_NONEMPTY] THEN
16259  REWRITE_TAC[EXTENSION, IN_INTERVAL] THEN
16260  GEN_TAC THEN SIMP_TAC std_ss [IN_IMAGE, IN_INTERVAL, min_def, max_def] THEN
16261  ASM_SIMP_TAC std_ss [REAL_SUB_LE] THEN EQ_TAC THENL
16262  [DISCH_TAC THEN EXISTS_TAC ``x - a:real`` THEN ASM_REAL_ARITH_TAC, ASM_REAL_ARITH_TAC]
16263QED
16264
16265Theorem SUMS_INTERVALS:
16266   (!a b c d:real.
16267        ~(interval[a,b] = {}) /\ ~(interval[c,d] = {})
16268        ==> ({x + y | x IN interval[a,b] /\ y IN interval[c,d]} =
16269             interval[a+c,b+d])) /\
16270   (!a b c d:real.
16271        ~(interval(a,b) = {}) /\ ~(interval(c,d) = {})
16272        ==> ({x + y | x IN interval(a,b) /\ y IN interval(c,d)} =
16273             interval(a+c,b+d)))
16274Proof
16275  CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
16276  STRIP_TAC THEN SIMP_TAC std_ss [EXTENSION, IN_INTERVAL, GSPECIFICATION, EXISTS_PROD] THEN
16277  ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN
16278  REWRITE_TAC[REAL_ARITH ``(x:real = y + z) <=> (z = x - y)``] THEN
16279  SIMP_TAC std_ss [UNWIND_THM2] THEN (* 2 subgoals *)
16280  ( X_GEN_TAC ``x:real`` THEN EQ_TAC
16281 >- ( DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) >> ASM_REAL_ARITH_TAC )
16282 >> STRIP_TAC
16283 >> ONCE_REWRITE_TAC [CONJ_SYM]
16284 >> KNOW_TAC
16285    ``(!y. (a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=>
16286       ((if a <= x - d then x - d else a) <= y /\
16287    y <= if b <= x - c then b else x - c:real)) /\
16288      (!y. (a < y /\ y < b) /\ c < x - y /\ x - y < d <=>
16289       ((if a <= x - d then x - d else a) < y /\
16290    y < if b <= x - c then b else x - c:real))``
16291 >- ( CONJ_TAC >> GEN_TAC >> rpt COND_CASES_TAC >> ASM_REAL_ARITH_TAC )
16292 >> STRIP_TAC >> ASM_REWRITE_TAC []
16293 >> REWRITE_TAC [GSYM min_def, GSYM max_def, GSYM REAL_LE_BETWEEN, GSYM REAL_LT_BETWEEN]
16294 >> ASM_REWRITE_TAC [min_def, max_def]
16295 >> rpt COND_CASES_TAC (* 4 subgoals *)
16296 >> METIS_TAC [REAL_LE_SUB_LADD, REAL_LE_SUB_RADD, REAL_LE_LADD, REAL_LE_NEG, real_sub,
16297               REAL_LT_SUB_LADD, REAL_LT_SUB_RADD, REAL_LT_LADD, REAL_LT_NEG] )
16298QED
16299
16300Theorem OPEN_CONTAINS_INTERVAL_OPEN_INTERVAL:
16301   (!s:real->bool.
16302        open s <=>
16303        !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\
16304   (!s:real->bool.
16305        open s <=>
16306        !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)
16307Proof
16308  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN GEN_TAC THEN
16309  MATCH_MP_TAC(TAUT
16310   `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
16311  REPEAT CONJ_TAC THENL
16312   [MESON_TAC[SUBSET_TRANS, INTERVAL_OPEN_SUBSET_CLOSED],
16313    DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
16314    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
16315    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
16316    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
16317    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
16318    MP_TAC(ISPEC ``interval(a:real,b)`` OPEN_CONTAINS_BALL) THEN
16319    REWRITE_TAC[OPEN_INTERVAL] THEN
16320    DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
16321        REPEAT STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN ASM_REWRITE_TAC[] THEN
16322    ASM_MESON_TAC[SUBSET_TRANS, INTERVAL_OPEN_SUBSET_CLOSED],
16323    DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
16324    FIRST_ASSUM(MP_TAC o SPEC ``x:real`` o
16325      REWRITE_RULE [OPEN_CONTAINS_CBALL]) THEN
16326    ASM_REWRITE_TAC[] THEN
16327    DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
16328    EXISTS_TAC ``x - e:real`` THEN
16329    EXISTS_TAC ``x + e:real`` THEN
16330    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
16331     ``b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s``)) THEN
16332    SIMP_TAC std_ss [IN_INTERVAL, IN_CBALL, SUBSET_DEF, REAL_MUL_RID] THEN
16333    REWRITE_TAC[REAL_ARITH ``x - e < x /\ x < x + e <=> &0 < e:real``,
16334                REAL_ARITH ``x - e <= y /\ y <= x + e <=> abs(x - y) <= e:real``] THEN
16335    ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_LT, LE_1] THEN
16336    X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN ASM_REWRITE_TAC[dist]]
16337QED
16338
16339Theorem OPEN_CONTAINS_INTERVAL:
16340   (!s:real->bool.
16341        open s <=>
16342        !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s)
16343Proof
16344   REWRITE_TAC [OPEN_CONTAINS_INTERVAL_OPEN_INTERVAL]
16345QED
16346
16347Theorem OPEN_CONTAINS_OPEN_INTERVAL:
16348   (!s:real->bool.
16349        open s <=>
16350        !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)
16351Proof
16352   METIS_TAC [OPEN_CONTAINS_INTERVAL_OPEN_INTERVAL]
16353QED
16354
16355Theorem DIAMETER_INTERVAL:
16356   (!a b:real.
16357        diameter(interval[a,b]) =
16358        if interval[a,b] = {} then &0 else abs(b - a)) /\
16359   (!a b:real.
16360        diameter(interval(a,b)) =
16361        if interval(a,b) = {} then &0 else abs(b - a))
16362Proof
16363  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN REPEAT GEN_TAC THEN
16364  ASM_CASES_TAC ``interval[a:real,b] = {}`` THENL
16365   [METIS_TAC[INTERVAL_OPEN_SUBSET_CLOSED, SUBSET_EMPTY, DIAMETER_EMPTY],
16366    ASM_REWRITE_TAC[]] THEN
16367  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
16368   [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
16369    ASM_SIMP_TAC std_ss [DIAMETER_BOUNDED_BOUND,
16370                 ENDS_IN_INTERVAL, BOUNDED_INTERVAL] THEN
16371    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
16372     ``diameter(cball(inv(&2) * (a + b):real,abs(b - a) / &2))`` THEN
16373    CONJ_TAC THENL
16374     [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN
16375      REWRITE_TAC[SUBSET_DEF, IN_INTERVAL, IN_CBALL] THEN
16376      GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN
16377      KNOW_TAC ``x = x * (2 / 2:real)`` THENL
16378      [METIS_TAC [REAL_DIV_REFL, REAL_MUL_RID, REAL_ARITH ``2 <> 0:real``],
16379       DISCH_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
16380       REWRITE_TAC [real_div]] THEN
16381      REWRITE_TAC [REAL_ARITH ``a * (b * inv b) = inv b * (a * b:real)``] THEN
16382      REWRITE_TAC [GSYM REAL_SUB_LDISTRIB, ABS_MUL] THEN
16383      SIMP_TAC std_ss [ABS_INV, REAL_ARITH ``2 <> 0:real``, ABS_N] THEN
16384      GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
16385      SIMP_TAC std_ss [ABS_POS, REAL_LE_REFL, REAL_INV_1OVER, REAL_HALF_BETWEEN] THEN
16386      ASM_REAL_ARITH_TAC,
16387      REWRITE_TAC[DIAMETER_CBALL] THEN COND_CASES_TAC THEN
16388      REWRITE_TAC [ABS_POS, real_div] THEN
16389      ONCE_REWRITE_TAC [REAL_ARITH ``a * (b * c) = (a * c) * b:real``] THEN
16390      SIMP_TAC std_ss [REAL_MUL_RINV, REAL_ARITH ``2 <> 0:real``] THEN
16391      REAL_ARITH_TAC],
16392    DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN
16393    SUBGOAL_THEN ``interval[a:real,b] = closure(interval(a,b))``
16394    SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN
16395    ASM_MESON_TAC[DIAMETER_CLOSURE, BOUNDED_INTERVAL]]
16396QED
16397
16398Theorem IMAGE_TWIZZLE_INTERVAL:
16399   !p a b. IMAGE ((\x. x):real->real) (interval[a,b]) =
16400               interval[a,b]
16401Proof
16402  SET_TAC [interval]
16403QED
16404
16405Theorem EQ_INTERVAL:
16406   (!a b c d:real.
16407        (interval[a,b] = interval[c,d]) <=>
16408        ((interval[a,b] = {}) /\ (interval[c,d] = {})) \/ ((a = c) /\ (b = d))) /\
16409   (!a b c d:real.
16410        (interval[a,b] = interval(c,d)) <=>
16411        (interval[a,b] = {}) /\ (interval(c,d) = {})) /\
16412   (!a b c d:real.
16413        (interval(a,b) = interval[c,d]) <=>
16414        (interval(a,b) = {}) /\ (interval[c,d] = {})) /\
16415   (!a b c d:real.
16416        (interval(a,b) = interval(c,d)) <=>
16417        ((interval(a,b) = {}) /\ (interval(c,d) = {})) \/ ((a = c) /\ (b = d)))
16418Proof
16419  REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN
16420  (EQ_TAC THENL [ALL_TAC, STRIP_TAC THEN ASM_REWRITE_TAC[]]) THEN
16421  MATCH_MP_TAC(MESON[]
16422   ``((p = {}) /\ (q = {}) ==> r) /\ (~(p = {}) /\ ~(q = {}) ==> (p = q) ==> r)
16423    ==> (p = q) ==> r``) THEN
16424  SIMP_TAC std_ss [] THENL
16425   [REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
16426    REWRITE_TAC[GSYM SUBSET_ANTISYM] THEN
16427    METIS_TAC [SUBSET_INTERVAL, GSYM REAL_LE_ANTISYM],
16428    STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN]
16429     ``closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(s = t)``) THEN
16430    ASM_REWRITE_TAC[CLOSED_INTERVAL, OPEN_INTERVAL, NOT_INTERVAL_UNIV],
16431    STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN]
16432     ``closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(t = s)``) THEN
16433    ASM_REWRITE_TAC[CLOSED_INTERVAL, OPEN_INTERVAL, NOT_INTERVAL_UNIV],
16434    REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
16435    REWRITE_TAC[GSYM SUBSET_ANTISYM] THEN
16436    METIS_TAC [SUBSET_INTERVAL, GSYM REAL_LE_ANTISYM]]
16437QED
16438
16439Theorem CLOSED_INTERVAL_EQ:
16440   (!a b:real. closed(interval[a,b])) /\
16441   (!a b:real. closed(interval(a,b)) <=> (interval(a,b) = {}))
16442Proof
16443  REWRITE_TAC[CLOSED_INTERVAL] THEN
16444  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
16445  ASM_REWRITE_TAC[CLOSED_EMPTY] THEN
16446  MP_TAC(ISPEC ``interval(a:real,b)`` CLOPEN) THEN
16447  ASM_REWRITE_TAC[OPEN_INTERVAL] THEN
16448  METIS_TAC[BOUNDED_INTERVAL, NOT_BOUNDED_UNIV]
16449QED
16450
16451Theorem OPEN_INTERVAL_EQ:
16452   (!a b:real. open(interval[a,b]) <=> (interval[a,b] = {})) /\
16453   (!a b:real. open(interval(a,b)))
16454Proof
16455  REWRITE_TAC[OPEN_INTERVAL] THEN
16456  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
16457  ASM_REWRITE_TAC[CLOSED_EMPTY] THEN
16458  MP_TAC(ISPEC ``interval[a:real,b]`` CLOPEN) THEN
16459  ASM_REWRITE_TAC[CLOSED_INTERVAL] THEN
16460  METIS_TAC[BOUNDED_INTERVAL, NOT_BOUNDED_UNIV]
16461QED
16462
16463Theorem COMPACT_INTERVAL_EQ:
16464   (!a b:real. compact(interval[a,b])) /\
16465   (!a b:real. compact(interval(a,b)) <=> (interval(a,b) = {}))
16466Proof
16467  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_INTERVAL] THEN
16468  REWRITE_TAC[CLOSED_INTERVAL_EQ]
16469QED
16470
16471Theorem EQ_BALLS:
16472   (!a a':real r r'.
16473      (ball(a,r) = ball(a',r')) <=> (a = a') /\ (r = r') \/ r <= &0 /\ r' <= &0) /\
16474   (!a a':real r r'.
16475      (ball(a,r) = cball(a',r')) <=> r <= &0 /\ r' < &0) /\
16476   (!a a':real r r'.
16477      (cball(a,r) = ball(a',r')) <=> r < &0 /\ r' <= &0) /\
16478   (!a a':real r r'.
16479      (cball(a,r) = cball(a',r')) <=> (a = a') /\ (r = r') \/ r < &0 /\ r' < &0)
16480Proof
16481  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN
16482  (EQ_TAC THENL
16483    [ALL_TAC, REWRITE_TAC[EXTENSION, IN_BALL, IN_CBALL, dist] THEN REAL_ARITH_TAC])
16484  THENL
16485   [SIMP_TAC std_ss [SET_EQ_SUBSET, SUBSET_BALLS, dist] THEN REAL_ARITH_TAC,
16486    ONCE_REWRITE_TAC[EQ_SYM_EQ],
16487    ALL_TAC,
16488    REWRITE_TAC[SET_EQ_SUBSET, SUBSET_BALLS, dist] THEN REAL_ARITH_TAC] THEN
16489  DISCH_THEN(MP_TAC o MATCH_MP (METIS [CLOPEN, BOUNDED_BALL, NOT_BOUNDED_UNIV]
16490    ``(s = t) ==> closed s /\ open t /\ bounded t ==> (s = {}) /\ (t = {})``)) THEN
16491  REWRITE_TAC[OPEN_BALL, CLOSED_CBALL, BOUNDED_BALL,
16492              BALL_EQ_EMPTY, CBALL_EQ_EMPTY] THEN
16493  REAL_ARITH_TAC
16494QED
16495
16496(* ------------------------------------------------------------------------- *)
16497(* Some special cases for intervals in R^1.                                  *)
16498(* ------------------------------------------------------------------------- *)
16499
16500Theorem INTERVAL_CASES:
16501   !x:real. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)
16502Proof
16503  REWRITE_TAC[IN_INTERVAL] THEN REAL_ARITH_TAC
16504QED
16505
16506Theorem OPEN_CLOSED_INTERVAL:
16507   !a b:real. interval(a,b) = interval[a,b] DIFF {a;b}
16508Proof
16509  REWRITE_TAC[EXTENSION, IN_INTERVAL, IN_DIFF, IN_INSERT, NOT_IN_EMPTY] THEN
16510  SIMP_TAC std_ss [] THEN REAL_ARITH_TAC
16511QED
16512
16513Theorem CLOSED_OPEN_INTERVAL:
16514   !a b:real. a <= b ==> (interval[a,b] = interval(a,b) UNION {a;b})
16515Proof
16516  REWRITE_TAC[EXTENSION, IN_INTERVAL, IN_UNION, IN_INSERT, NOT_IN_EMPTY] THEN
16517  SIMP_TAC std_ss [] THEN REAL_ARITH_TAC
16518QED
16519
16520Theorem BALL:
16521   !x:real r. (cball(x,r) = interval[x - r,x + r]) /\
16522               (ball(x,r) = interval(x - r,x + r))
16523Proof
16524  REWRITE_TAC[EXTENSION, IN_BALL, IN_CBALL, IN_INTERVAL] THEN
16525  REWRITE_TAC[dist] THEN REAL_ARITH_TAC
16526QED
16527
16528Theorem SPHERE:
16529   !a:real r. sphere(a,r) = if r < (&0:real) then {} else {a - r;a + r}
16530Proof
16531  REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN
16532  SIMP_TAC std_ss [EXTENSION, IN_INSERT, NOT_IN_EMPTY, GSPECIFICATION, dist] THEN
16533  ASM_REAL_ARITH_TAC
16534QED
16535
16536Theorem FINITE_SPHERE:
16537   !a:real r. FINITE(sphere(a,r))
16538Proof
16539  REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE] THEN
16540  METIS_TAC[FINITE_INSERT, FINITE_EMPTY]
16541QED
16542
16543Theorem FINITE_INTERVAL:
16544   (!a b. FINITE(interval[a,b]) <=> b <= a) /\
16545   (!a b. FINITE(interval(a,b)) <=> b <= a)
16546Proof
16547  REWRITE_TAC[OPEN_CLOSED_INTERVAL] THEN
16548  REWRITE_TAC[SET_RULE ``s DIFF {a;b} = s DELETE a DELETE b``] THEN
16549  REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN
16550  SIMP_TAC std_ss [interval, FINITE_IMAGE_INJ_EQ, FINITE_REAL_INTERVAL]
16551QED
16552
16553Theorem BALL_INTERVAL_0:
16554   !e. ball(0:real,e) = interval(-e,e)
16555Proof
16556  GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN
16557  BINOP_TAC THEN REAL_ARITH_TAC
16558QED
16559
16560Theorem CBALL_INTERVAL_0:
16561   !e. cball(0:real,e) = interval[-e,e]
16562Proof
16563  GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN
16564  AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN REAL_ARITH_TAC
16565QED
16566
16567Theorem CLOSED_DIFF_OPEN_INTERVAL:
16568   !a b:real.
16569        interval[a,b] DIFF interval(a,b) =
16570        if interval[a,b] = {} then {} else {a;b}
16571Proof
16572  REWRITE_TAC[EXTENSION, IN_DIFF, GSYM INTERVAL_EQ_EMPTY, IN_INTERVAL] THEN
16573  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
16574  ASM_REWRITE_TAC[NOT_IN_EMPTY, IN_INSERT, NOT_IN_EMPTY] THEN
16575  FULL_SIMP_TAC std_ss [NOT_IN_EMPTY] THEN
16576  ASM_REAL_ARITH_TAC
16577QED
16578
16579Theorem INTERVAL:
16580   (!a b:real. interval[a,b] =
16581                 if a <= b then cball(midpoint(a,b),dist(a,b) / &2)
16582                 else {}) /\
16583   (!a b:real. interval(a,b) =
16584                 if a < b then ball(midpoint(a,b),dist(a,b) / &2)
16585                 else {})
16586Proof
16587  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
16588  RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE, REAL_NOT_LT]) THEN
16589  ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN
16590  REWRITE_TAC[BALL, dist] THEN
16591  ASM_SIMP_TAC std_ss [REAL_SUB_LE, REAL_LT_IMP_LE,
16592                       REAL_ARITH ``a <= b ==> (abs(a - b) = b - a:real)``] THEN
16593  REWRITE_TAC[METIS [real_div, REAL_MUL_SYM] ``x / &2 = inv(&2:real) * x``] THEN
16594  REWRITE_TAC[midpoint] THEN
16595  TRY AP_TERM_TAC THEN ASM_SIMP_TAC std_ss [PAIR_EQ, CONS_11, GSYM INTERVAL_EQ_EMPTY] THEN
16596  REWRITE_TAC [GSYM REAL_SUB_LDISTRIB, GSYM REAL_ADD_LDISTRIB] THEN
16597  REWRITE_TAC [REAL_ARITH ``a + b - (b - a) = 2 * a:real``] THEN
16598  REWRITE_TAC [REAL_ARITH ``a + b + (b - a) = 2 * b:real``] THEN
16599  SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_ARITH ``2 <> 0:real``, REAL_MUL_LINV] THEN REAL_ARITH_TAC
16600QED
16601
16602Theorem SEGMENT:
16603   (!a b. segment[a,b] =
16604          if a <= b then interval[a,b] else interval[b,a]) /\
16605   (!a b. segment(a,b) =
16606          if a <= b then interval(a,b) else interval(b,a))
16607Proof
16608  CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN
16609  COND_CASES_TAC THEN
16610  REWRITE_TAC[IN_DIFF, IN_INSERT, NOT_IN_EMPTY,
16611              EXTENSION, GSYM BETWEEN_IN_SEGMENT, between, IN_INTERVAL] THEN
16612  REWRITE_TAC[dist] THEN ASM_REAL_ARITH_TAC
16613QED
16614
16615Theorem OPEN_SEGMENT:
16616   !a b:real. open(segment(a,b))
16617Proof
16618  REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT] THEN
16619  COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]
16620QED
16621
16622Theorem SEGMENT_SCALAR_MULTIPLE:
16623   (!a b v:real. segment[a * v,b * v] =
16624            {x * v:real | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\
16625   (!a b v:real. ~(v = 0)
16626            ==> (segment(a * v,b * v) =
16627                 {x * v:real | a < x /\ x < b \/ b < x /\ x < a}))
16628Proof
16629  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL
16630   [REPEAT GEN_TAC THEN
16631    MP_TAC(SPECL [``a * 1:real``, ``b * 1:real``]
16632     (CONJUNCT1 SEGMENT)) THEN
16633    REWRITE_TAC[segment, REAL_MUL_ASSOC, GSYM REAL_ADD_RDISTRIB] THEN
16634        ONCE_REWRITE_TAC [METIS [] ``((1 - u) * a + u * b:real) =
16635                                (\u. ((1 - u) * a + u * b)) u``] THEN
16636        ONCE_REWRITE_TAC [METIS [] ``(0 <= u /\ u <= 1:real) =
16637                                (\u.  0 <= u /\ u <= 1) u``] THEN
16638        ONCE_REWRITE_TAC [METIS []
16639        ``{x:real * v | a <= x /\ x <= b \/ b <= x /\ x <= a} =
16640          {(\x. x) x * v | (\x. a <= x /\ x <= b \/ b <= x /\ x <= a) x}``] THEN
16641    REWRITE_TAC [SET_RULE ``{f x * b:real | p (x:real)} =
16642                                IMAGE (\a. a * b) {f x | p x}``] THEN
16643    BETA_TAC THEN DISCH_TAC THEN AP_TERM_TAC THEN
16644    FIRST_X_ASSUM(MP_TAC o SIMP_RULE std_ss [REAL_MUL_RID, IMAGE_ID]) THEN
16645    DISCH_THEN SUBST1_TAC THEN COND_CASES_TAC THEN
16646        SIMP_TAC std_ss [EXTENSION, IN_INTERVAL, GSPECIFICATION] THEN ASM_REAL_ARITH_TAC,
16647    ASM_REWRITE_TAC[open_segment] THEN
16648        ONCE_REWRITE_TAC [METIS [] ``{x * v | a <= x /\ x <= b \/ b <= x /\ x <= a:real} =
16649                        {(\x. x) x * v | (\x. a <= x /\ x <= b \/ b <= x /\ x <= a) x}``] THEN
16650    ASM_SIMP_TAC std_ss [REAL_EQ_RMUL, SET_RULE
16651     ``(!x y:real. (x * v = y * v) <=> (x = y))
16652      ==> ({x * v | P x} DIFF {a * v;b * v} =
16653           {x * v | P x /\ ~(x = a) /\ ~(x = b)})``] THEN
16654        ONCE_REWRITE_TAC [SET_RULE
16655        ``{x * v | (a <= x /\ x <= b \/ b <= x /\ x <= a) /\ x <> a /\ x <> b:real} =
16656     {(\x. x * v) x | x IN (\x. (a <= x /\ x <= b \/ b <= x /\ x <= a) /\ x <> a /\ x <> b)}``] THEN
16657        ONCE_REWRITE_TAC [SET_RULE
16658              ``{x * v | a < x /\ x < b \/ b < x /\ x < a:real} =
16659       {(\x. x * v) x | x IN (\x. (a < x /\ x < b \/ b < x /\ x < a))}``] THEN
16660    ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN AP_TERM_TAC THEN
16661    ABS_TAC THEN REAL_ARITH_TAC]
16662QED
16663
16664(* ------------------------------------------------------------------------- *)
16665(* Intervals in general, including infinite and mixtures of open and closed. *)
16666(* ------------------------------------------------------------------------- *)
16667
16668Definition is_interval[nocompute]:
16669  is_interval(s:real->bool) <=>
16670        !a b x. a IN s /\ b IN s
16671                     ==> (a <= x /\ x <= b) \/
16672                         (b <= x /\ x <= a)
16673                ==> x IN s
16674End
16675
16676Theorem IS_INTERVAL_INTERVAL:
16677   !a:real b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])
16678Proof
16679  REWRITE_TAC[is_interval, IN_INTERVAL] THEN
16680  METIS_TAC[REAL_LT_TRANS, REAL_LE_TRANS, REAL_LET_TRANS, REAL_LTE_TRANS]
16681QED
16682
16683Theorem IS_INTERVAL_EMPTY:
16684   is_interval {}
16685Proof
16686  REWRITE_TAC[is_interval, NOT_IN_EMPTY]
16687QED
16688
16689Theorem IS_INTERVAL_UNIV:
16690   is_interval(UNIV:real->bool)
16691Proof
16692  REWRITE_TAC[is_interval, IN_UNIV]
16693QED
16694
16695Theorem IS_INTERVAL_POINTWISE:
16696   !s:real->bool x.
16697        is_interval s ==> (?a. a IN s /\ (a = x))
16698        ==> x IN s
16699Proof
16700  METIS_TAC [is_interval]
16701QED
16702
16703Theorem IS_INTERVAL_COMPACT :
16704    !s:real->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]
16705Proof
16706  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
16707  ASM_SIMP_TAC std_ss [IS_INTERVAL_INTERVAL, COMPACT_INTERVAL] THEN
16708  ASM_CASES_TAC ``s:real->bool = {}``
16709  >- ASM_MESON_TAC[EMPTY_AS_INTERVAL] THEN (* one goal left *)
16710  EXISTS_TAC ``(@f. f = inf { (x:real) | x IN s}):real`` THEN
16711  EXISTS_TAC ``(@f. f = sup { (x:real) | x IN s}):real`` THEN
16712  SIMP_TAC std_ss [EXTENSION, IN_INTERVAL] THEN X_GEN_TAC ``x:real`` THEN
16713  EQ_TAC THENL (* 2 subgoals *)
16714  [ (* goal 1 (of 2) *)
16715    DISCH_TAC THEN
16716    MP_TAC(ISPEC ``{ (x:real) | x IN s}`` INF) THEN
16717    MP_TAC(ISPEC ``{ (x:real) | x IN s}`` SUP) THEN
16718    SIMP_TAC std_ss [METIS [] ``x = (\x. x) x``, GSYM IMAGE_DEF] THEN
16719    ASM_SIMP_TAC std_ss [IMAGE_EQ_EMPTY, FORALL_IN_IMAGE] THEN
16720    FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
16721    REWRITE_TAC[bounded_def] THEN
16722    ASM_MESON_TAC[REAL_LE_TRANS, MEMBER_NOT_EMPTY,
16723                  REAL_ARITH ``abs(x) <= B ==> -B <= x /\ x <= B:real``],
16724    (* goal 2 (of 2) *)
16725    DISCH_TAC THEN
16726    SUFF_TAC ``?a:real. a IN s /\ (a = x)``
16727    >- (MATCH_MP_TAC IS_INTERVAL_POINTWISE >> ASM_REWRITE_TAC []) THEN
16728    SUBGOAL_THEN
16729     ``?a b:real. a IN s /\ b IN s /\ a <= (x:real) /\ x <= b``
16730    STRIP_ASSUME_TAC THENL (* 2 subgoals *)
16731    [ (* goal 2.1 (of 2) *)
16732      MP_TAC (ISPECL [``\x:real. x``, ``s:real->bool``]
16733                     CONTINUOUS_ATTAINS_INF) THEN
16734      ASM_SIMP_TAC std_ss [CONTINUOUS_ON_ID, o_DEF] THEN
16735      DISCH_THEN (X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
16736      EXISTS_TAC ``a:real`` THEN
16737      MP_TAC (ISPECL [``\x:real. x``, ``s:real->bool``]
16738                     CONTINUOUS_ATTAINS_SUP) THEN
16739      ASM_SIMP_TAC std_ss [CONTINUOUS_ON_ID, o_DEF] THEN
16740      DISCH_THEN (X_CHOOSE_THEN ``b:real`` STRIP_ASSUME_TAC) THEN
16741      EXISTS_TAC ``b:real`` THEN ASM_REWRITE_TAC [] THEN
16742      CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL (* 2 subgoals *)
16743      [ (* goal 2.1.1 (of 2) *)
16744        EXISTS_TAC ``inf {(x:real) | x IN s}`` THEN ASM_SIMP_TAC std_ss [] THEN
16745        MATCH_MP_TAC REAL_LE_INF THEN
16746        ONCE_REWRITE_TAC [METIS [SPECIFICATION] ``{x | x IN s} x <=> x IN {x | x IN s}``] THEN
16747        ASM_SET_TAC [],
16748        (* goal 2.1.2 (of 2) *)
16749        EXISTS_TAC ``sup {(x:real) | x IN s}`` THEN ASM_SIMP_TAC std_ss [] THEN
16750        MATCH_MP_TAC REAL_SUP_LE' THEN
16751        ONCE_REWRITE_TAC [METIS [SPECIFICATION] ``{x | x IN s} x <=> x IN {x | x IN s}``] THEN
16752        ASM_SET_TAC [] ],
16753      (* goal 2.2 (of 2) *)
16754      EXISTS_TAC ``x:real`` THEN ASM_SIMP_TAC std_ss [] THEN
16755      UNDISCH_TAC ``is_interval s`` THEN DISCH_TAC THEN
16756      FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval, AND_IMP_INTRO]) THEN
16757      MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN
16758      ASM_SIMP_TAC std_ss [] ] ]
16759QED
16760
16761Theorem IS_INTERVAL:
16762   !s:real->bool.
16763        is_interval s <=>
16764          !a b x. a IN s /\ b IN s /\ a <= x /\ x <= b
16765                  ==> x IN s
16766Proof
16767  REWRITE_TAC[is_interval] THEN MESON_TAC[]
16768QED
16769
16770Theorem IS_INTERVAL_CASES:
16771   !s:real->bool.
16772        is_interval s <=>
16773        (s = {}) \/
16774        (s = univ(:real)) \/
16775        (?a. s = {x | a < x}) \/
16776        (?a. s = {x | a <= x}) \/
16777        (?b. s = {x | x <= b}) \/
16778        (?b. s = {x | x < b}) \/
16779        (?a b. s = {x | a < x /\ x < b}) \/
16780        (?a b. s = {x | a < x /\ x <= b}) \/
16781        (?a b. s = {x | a <= x /\ x < b}) \/
16782        (?a b. s = {x | a <= x /\ x <= b})
16783Proof
16784  GEN_TAC THEN REWRITE_TAC[IS_INTERVAL] THEN EQ_TAC THENL
16785   [DISCH_TAC,
16786    STRIP_TAC THEN ASM_SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV, NOT_IN_EMPTY] THEN
16787    REAL_ARITH_TAC] THEN
16788  ASM_CASES_TAC ``s:real->bool = {}`` THEN ASM_REWRITE_TAC[] THEN
16789  MP_TAC(ISPEC ``s:real->bool`` SUP) THEN
16790  MP_TAC(ISPEC ``s:real->bool`` INF) THEN
16791  ASM_SIMP_TAC std_ss [IMAGE_EQ_EMPTY, FORALL_IN_IMAGE] THEN
16792  ASM_CASES_TAC ``?a. !x:real. x IN s ==> a <= x`` THEN
16793  ASM_CASES_TAC ``?b. !x:real. x IN s ==> x <= b`` THEN
16794  ASM_REWRITE_TAC[] THENL
16795   [STRIP_TAC THEN STRIP_TAC THEN
16796    MAP_EVERY ASM_CASES_TAC
16797     [``inf(s) IN s:real->bool``, ``sup(s) IN s:real->bool``]
16798    THENL
16799     [DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN
16800          DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC,
16801      DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN
16802      DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC,
16803      DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN
16804          DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC,
16805      DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN
16806      DISJ2_TAC THEN DISJ1_TAC] THEN
16807    MAP_EVERY EXISTS_TAC [``inf(s:real->bool)``, ``sup(s:real->bool)``],
16808    STRIP_TAC THEN ASM_CASES_TAC ``inf(s:real->bool) IN s`` THENL
16809     [DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC,
16810      DISJ2_TAC THEN DISJ1_TAC] THEN
16811    EXISTS_TAC ``inf(s:real->bool)``,
16812    STRIP_TAC THEN ASM_CASES_TAC ``sup(s:real->bool) IN s`` THENL
16813     [DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC,
16814      DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN
16815          DISJ1_TAC] THEN
16816    EXISTS_TAC ``sup(s:real->bool)``,
16817    DISJ1_TAC] THEN
16818  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_UNIV] THEN
16819  RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN
16820  REWRITE_TAC[GSYM REAL_NOT_LE] THEN
16821  ASM_MESON_TAC [REAL_LE_TRANS, REAL_LE_TOTAL, REAL_LE_ANTISYM]
16822QED
16823
16824Theorem IS_INTERVAL_POSSIBILITIES:
16825    (is_interval ∅) ∧
16826    (is_interval 𝕌(:real)) ∧
16827    (∀a. is_interval {x | a ≤ x}) ∧
16828    (∀a. is_interval {x | a < x}) ∧
16829    (∀b. is_interval {x | x ≤ b}) ∧
16830    (∀b. is_interval {x | x < b}) ∧
16831    (∀a b. is_interval {x | a ≤ x ∧ x ≤ b}) ∧
16832    (∀a b. is_interval {x | a ≤ x ∧ x < b}) ∧
16833    (∀a b. is_interval {x | a < x ∧ x ≤ b}) ∧
16834    (∀a b. is_interval {x | a < x ∧ x < b})
16835Proof
16836    metis_tac[IS_INTERVAL_CASES]
16837QED
16838
16839Theorem IS_INTERVAL_INTER:
16840   !s t:real->bool.
16841        is_interval s /\ is_interval t ==> is_interval(s INTER t)
16842Proof
16843  REWRITE_TAC[is_interval, IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
16844  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``x:real``] THEN
16845  REPEAT STRIP_TAC THENL
16846  [UNDISCH_TAC ``!a b x.
16847            a IN s /\ b IN s ==>
16848            a <= x /\ x <= b \/ b <= x /\ x <= a ==>
16849            x IN s:real->bool`` THEN DISCH_TAC THEN
16850   FIRST_X_ASSUM (MATCH_MP_TAC o REWRITE_RULE [AND_IMP_INTRO]),
16851   UNDISCH_TAC ``!a b x.
16852            a IN t /\ b IN t ==>
16853            a <= x /\ x <= b \/ b <= x /\ x <= a ==>
16854            x IN t:real->bool`` THEN DISCH_TAC THEN
16855   FIRST_X_ASSUM (MATCH_MP_TAC o REWRITE_RULE [AND_IMP_INTRO]),
16856   UNDISCH_TAC ``!a b x.
16857            a IN s /\ b IN s ==>
16858            a <= x /\ x <= b \/ b <= x /\ x <= a ==>
16859            x IN s:real->bool`` THEN DISCH_TAC THEN
16860   FIRST_X_ASSUM (MATCH_MP_TAC o REWRITE_RULE [AND_IMP_INTRO]),
16861   UNDISCH_TAC ``!a b x.
16862            a IN t /\ b IN t ==>
16863            a <= x /\ x <= b \/ b <= x /\ x <= a ==>
16864            x IN t:real->bool`` THEN DISCH_TAC THEN
16865   FIRST_X_ASSUM (MATCH_MP_TAC o REWRITE_RULE [AND_IMP_INTRO])] THEN
16866  MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN ASM_REWRITE_TAC[]
16867QED
16868
16869Theorem INTERVAL_SUBSET_IS_INTERVAL:
16870   !s a b:real.
16871     is_interval s
16872     ==> (interval[a,b] SUBSET s <=> (interval[a,b] = {}) \/ a IN s /\ b IN s)
16873Proof
16874  REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN
16875  ASM_CASES_TAC ``interval[a:real,b] = {}`` THEN
16876  ASM_REWRITE_TAC[EMPTY_SUBSET] THEN
16877  EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF], ALL_TAC] THEN
16878  REWRITE_TAC[SUBSET_DEF, IN_INTERVAL] THEN ASM_MESON_TAC[]
16879QED
16880
16881Theorem INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD:
16882   !s x:real.
16883        is_interval s /\ x IN s
16884        ==> ?a b d. &0 < d /\ x IN interval[a,b] /\
16885                    interval[a,b] SUBSET s /\
16886                    ball(x,d) INTER s SUBSET interval[a,b]
16887Proof
16888  REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [INTERVAL_SUBSET_IS_INTERVAL] THEN
16889  SUBGOAL_THEN ``?a. (?y. y IN s /\ (y = a)) /\
16890                    (a < x \/ (a = (x:real)) /\
16891                        !y:real. y IN s ==> a <= y)``
16892  MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT], SIMP_TAC std_ss []] THEN
16893  DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
16894  SUBGOAL_THEN
16895   ``?b. (?y. y IN s /\ (y = b)) /\
16896                (x < b \/ (b = (x:real)) /\
16897                            !y:real. y IN s ==> y <= b)``
16898  MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT], SIMP_TAC std_ss []] THEN
16899  DISCH_THEN (X_CHOOSE_TAC ``b:real``) THEN EXISTS_TAC ``b:real`` THEN
16900  EXISTS_TAC ``min (if a < x then (x:real) - a else &1)
16901                   (if x < b then (b:real) - x else &1)`` THEN
16902  REWRITE_TAC[REAL_LT_MIN, SUBSET_DEF, IN_BALL, IN_INTER] THEN
16903  SIMP_TAC std_ss [REAL_LT_INF_FINITE, IMAGE_EQ_EMPTY, IMAGE_FINITE,
16904                   FINITE_NUMSEG, NUMSEG_EMPTY, GSYM NOT_LESS_EQUAL] THEN
16905  SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_INTERVAL] THEN REPEAT CONJ_TAC THENL
16906   [METIS_TAC[REAL_SUB_LT, REAL_LT_01],
16907    METIS_TAC[REAL_SUB_LT, REAL_LT_01],
16908    ASM_MESON_TAC[REAL_LE_LT],
16909    ASM_MESON_TAC[REAL_LE_LT],
16910        METIS_TAC [], ALL_TAC] THEN
16911    X_GEN_TAC ``y:real`` THEN
16912    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
16913    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
16914    (COND_CASES_TAC THENL [REWRITE_TAC[dist], ASM_MESON_TAC[]]) THEN
16915        REWRITE_TAC [abs] THEN COND_CASES_TAC THEN DISCH_TAC THENL
16916        [FULL_SIMP_TAC std_ss [REAL_ARITH ``x - y < x - a <=> a < y:real``, REAL_LE_LT],
16917     FULL_SIMP_TAC std_ss [REAL_NOT_LE, REAL_ARITH ``x - y < 0 <=> x < y:real``] THEN
16918         METIS_TAC [REAL_LE_TRANS, REAL_LE_LT],
16919         FULL_SIMP_TAC std_ss [REAL_SUB_LE] THEN METIS_TAC [REAL_LE_TRANS, REAL_LE_LT],
16920         FULL_SIMP_TAC std_ss [REAL_NEG_SUB,
16921          REAL_ARITH ``y - x < b - x <=> y < b:real``, REAL_LE_LT]]
16922QED
16923
16924Theorem IS_INTERVAL_SUMS :
16925    !s t:real->bool.
16926        is_interval s /\ is_interval t
16927        ==> is_interval {x + y | x IN s /\ y IN t}
16928Proof
16929  REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN
16930  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
16931  SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
16932  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN
16933  REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
16934  MAP_EVERY X_GEN_TAC
16935   [``a:real``, ``a':real``, ``b:real``, ``b':real``, ``y:real``] THEN
16936  DISCH_THEN(CONJUNCTS_THEN2
16937   (MP_TAC o SPECL [``a:real``, ``b:real``]) MP_TAC) THEN
16938  DISCH_THEN(CONJUNCTS_THEN2
16939   (MP_TAC o SPECL [``a':real``, ``b':real``]) ASSUME_TAC) THEN
16940  ASM_SIMP_TAC std_ss [AND_IMP_INTRO, GSPECIFICATION, EXISTS_PROD] THEN
16941  ONCE_REWRITE_TAC[REAL_ARITH ``(z:real = x + y) <=> (y = z - x)``] THEN
16942  SIMP_TAC std_ss [UNWIND_THM2] THEN
16943  ONCE_REWRITE_TAC [METIS []
16944   ``!a b s. (!x. a <= x /\ x <= b \/ b <= x /\ x <= a ==> x IN s:real->bool) =
16945             (!x. (\x. a <= x /\ x <= b \/ b <= x /\ x <= a) x ==> x IN s)``] THEN
16946  ONCE_REWRITE_TAC [METIS [] ``(y - p_1) = (\x. y - x) (p_1:real)``] THEN
16947  MATCH_MP_TAC(METIS []
16948   ``(?x. P x /\ Q(f x))
16949    ==> (!x. Q x ==> x IN t) /\ (!x. P x ==> x IN s)
16950        ==> ?x. x IN s /\ f x IN t``) THEN
16951  POP_ASSUM MP_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
16952  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
16953  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
16954  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
16955  SIMP_TAC std_ss [REAL_ARITH
16956   ``c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c:real``] THEN
16957  Know `!a b x. a <= x /\ x <= b \/ b <= x /\ x <= a:real <=>
16958                min a b <= x /\ x <= max a b`
16959  >- (KILL_TAC >> RW_TAC std_ss [max_def, min_def] \\
16960      REAL_ASM_ARITH_TAC) >> Rewr \\
16961  ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN
16962  REWRITE_TAC[GSYM REAL_LE_MIN, GSYM REAL_MAX_LE] THEN
16963  REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN
16964  SIMP_TAC std_ss [min_def, max_def] THEN REPEAT COND_CASES_TAC THEN
16965  FULL_SIMP_TAC std_ss [] THEN ASM_REAL_ARITH_TAC
16966QED
16967
16968Theorem IS_INTERVAL_SING:
16969   !a:real. is_interval {a}
16970Proof
16971  SIMP_TAC std_ss [is_interval, IN_SING, CONJ_EQ_IMP, REAL_LE_ANTISYM]
16972QED
16973
16974Theorem IS_INTERVAL_SCALING:
16975   !s:real->bool c. is_interval s ==> is_interval(IMAGE (\x. c * x) s)
16976Proof
16977  REPEAT GEN_TAC THEN ASM_CASES_TAC ``c = &0:real`` THENL
16978   [ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
16979    SUBGOAL_THEN ``(IMAGE ((\x. 0):real->real) (s:real->bool) = {}) \/
16980                   (IMAGE ((\x. 0):real->real) s = {0})``
16981    STRIP_ASSUME_TAC THENL
16982     [SET_TAC[],
16983      ASM_REWRITE_TAC[IS_INTERVAL_EMPTY],
16984      ASM_REWRITE_TAC[IS_INTERVAL_SING]],
16985    SIMP_TAC std_ss [is_interval, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
16986    SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN DISCH_TAC THEN
16987        SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN
16988        POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM]) THEN
16989    REWRITE_TAC[AND_IMP_INTRO] THEN
16990        DISCH_TAC THEN MAP_EVERY X_GEN_TAC [``a:real``,``b:real``] THEN
16991        POP_ASSUM (MP_TAC o Q.SPECL [`a:real`,`b:real`]) THEN
16992    DISCH_THEN(fn th => X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
16993                         MP_TAC(SPEC ``inv(c) * x:real`` th)) THEN
16994    ASM_SIMP_TAC std_ss [IN_IMAGE] THEN
16995    KNOW_TAC ``a <= inv c * x /\ inv c * x <= b \/
16996               b <= inv c * x /\ inv c * x <= a:real`` THENL
16997     [FIRST_X_ASSUM(MP_TAC) THEN
16998          DISCH_THEN (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
16999          ASM_REWRITE_TAC[] THEN
17000      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
17001          UNDISCH_TAC ``c <> 0:real`` THEN DISCH_TAC THEN
17002      FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
17003       ``~(c = &0:real) ==> &0 < c \/ &0 < -c``)) THEN
17004      ASM_SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THEN
17005      GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN
17006      ASM_SIMP_TAC std_ss [GSYM REAL_MUL_RNEG, GSYM REAL_LE_RDIV_EQ, GSYM
17007                   REAL_LE_LDIV_EQ] THEN
17008      ASM_SIMP_TAC std_ss [real_div, GSYM REAL_NEG_INV] THEN REAL_ARITH_TAC,
17009          DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
17010      DISCH_TAC THEN EXISTS_TAC ``inv c * x:real`` THEN
17011      ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_RINV, REAL_MUL_LID]]]
17012QED
17013
17014Theorem IS_INTERVAL_SCALING_EQ:
17015   !s:real->bool c.
17016        is_interval(IMAGE (\x. c * x) s) <=> (c = &0) \/ is_interval s
17017Proof
17018  REPEAT GEN_TAC THEN ASM_CASES_TAC ``c = &0:real`` THENL
17019   [ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
17020    SUBGOAL_THEN ``(IMAGE ((\x. 0):real->real) s = {}) \/
17021                   (IMAGE ((\x. 0):real->real) s = {0})``
17022    STRIP_ASSUME_TAC THENL
17023     [SET_TAC[],
17024      ASM_REWRITE_TAC[IS_INTERVAL_EMPTY],
17025      ASM_REWRITE_TAC[IS_INTERVAL_SING]],
17026    ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN
17027    DISCH_THEN(MP_TAC o SPEC ``inv c:real`` o MATCH_MP IS_INTERVAL_SCALING) THEN
17028    ASM_SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, REAL_MUL_ASSOC, o_DEF, REAL_MUL_LINV,
17029                 REAL_MUL_LID, IMAGE_ID]]
17030QED
17031
17032Theorem lemma0[local]:  (* unused *)
17033    !c. &0 < c
17034       ==> !s:real->bool. is_interval(IMAGE (\x. c * x) s) <=>
17035                            is_interval s
17036Proof
17037  SIMP_TAC std_ss [IS_INTERVAL_SCALING_EQ, REAL_LT_IMP_NE]
17038QED
17039
17040Theorem lemma[local]:
17041    ~(?a b c:real. a < b /\ b < c /\
17042               a IN s /\ b IN s /\ c IN s)
17043     ==> FINITE s /\ CARD(s) <= 2
17044Proof
17045    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
17046    REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN
17047    REWRITE_TAC[ARITH_PROVE ``~(n <= 2) <=> 3 <= n:num``] THEN
17048    DISCH_THEN(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN
17049    REWRITE_TAC [ARITH_PROVE ``3 = SUC 2``, TWO, ONE,  HAS_SIZE_CLAUSES] THEN
17050    DISCH_TAC THEN KNOW_TAC ``(?a b c:real.
17051      ((~(b = c) /\ ~(a = c)) /\ ~(a = b)) /\ {a; b; c} SUBSET s)`` THENL
17052    [POP_ASSUM MP_TAC THEN
17053     REWRITE_TAC [ARITH_PROVE ``3 = SUC 2``, TWO, ONE,  HAS_SIZE_CLAUSES] THEN
17054     SET_TAC [], POP_ASSUM K_TAC] THEN
17055    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, GSYM CONJ_ASSOC] THEN
17056    REWRITE_TAC[INSERT_SUBSET, EMPTY_SUBSET] THEN
17057    ONCE_REWRITE_TAC [METIS []
17058     ``(b <> c /\ a <> c /\ a <> b /\ a IN s /\ b IN s /\ c IN s ==>
17059     ?a b c:real. a < b /\ b < c /\ a IN s /\ b IN s /\ c IN s) =
17060    (\a b c. b <> c /\ a <> c /\ a <> b /\ a IN s /\ b IN s /\ c IN s ==>
17061     ?a b c:real. a < b /\ b < c /\ a IN s /\ b IN s /\ c IN s) a b c``] THEN
17062    MATCH_MP_TAC(METIS [REAL_LE_TOTAL]
17063     ``(!m n p:real. P m n p ==> P n p m /\ P n m p) /\
17064       (!m n p. m <= n /\ n <= p ==> P m n p)
17065       ==> !m n p. P m n p``) THEN
17066    CONJ_TAC THENL [METIS_TAC[], ALL_TAC] THEN
17067    SIMP_TAC std_ss [REAL_LT_LE] THEN METIS_TAC[]
17068QED
17069
17070Theorem CARD_FRONTIER_INTERVAL:
17071   !s:real->bool.
17072        is_interval s ==> FINITE(frontier s) /\ CARD(frontier s) <= 2
17073Proof
17074  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN
17075  SIMP_TAC std_ss [NOT_EXISTS_THM, FRONTIER_CLOSURES, IN_INTER] THEN
17076  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``] THEN
17077  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
17078  MAP_EVERY UNDISCH_TAC
17079   [``b IN closure (univ(:real) DIFF s)``,
17080    ``(a:real) IN closure s``, ``(c:real) IN closure s``] THEN
17081  SIMP_TAC std_ss [CLOSURE_APPROACHABLE, IN_DIFF, IN_UNIV, dist] THEN
17082  DISCH_THEN(MP_TAC o SPEC ``(c - b) / &2:real``) THEN
17083  ASM_REWRITE_TAC[REAL_HALF, REAL_SUB_LT] THEN
17084  DISCH_THEN(X_CHOOSE_THEN ``v:real`` STRIP_ASSUME_TAC) THEN
17085  DISCH_THEN(MP_TAC o SPEC ``(b - a) / &2:real``) THEN
17086  ASM_REWRITE_TAC[REAL_HALF, REAL_SUB_LT] THEN
17087  DISCH_THEN(X_CHOOSE_THEN ``u:real`` STRIP_ASSUME_TAC) THEN
17088  EXISTS_TAC ``min ((b - a) / &2:real) ((c - b) / &2:real)`` THEN
17089  ASM_REWRITE_TAC[REAL_HALF, REAL_SUB_LT, REAL_LT_MIN] THEN
17090  X_GEN_TAC ``w:real`` THEN CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
17091  UNDISCH_TAC ``is_interval s`` THEN DISCH_TAC THEN
17092  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IS_INTERVAL]) THEN
17093  DISCH_THEN(MP_TAC o SPECL [``u:real``, ``v:real``, ``w:real``]) THEN
17094  ASM_REWRITE_TAC[] THEN FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
17095  ASM_REAL_ARITH_TAC
17096QED
17097
17098Theorem INTERIOR_INTERVAL_CASES:
17099    (interior ∅ = ∅) ∧
17100    (interior 𝕌(:real) = 𝕌(:real)) ∧
17101    (∀a. interior {x | a ≤ x} = {x | a < x}) ∧
17102    (∀a. interior {x | a < x} = {x | a < x}) ∧
17103    (∀b. interior {x | x ≤ b} = {x | x < b}) ∧
17104    (∀b. interior {x | x < b} = {x | x < b}) ∧
17105    (∀a b. interior {x | a ≤ x ∧ x ≤ b} = {x | a < x ∧ x < b}) ∧
17106    (∀a b. interior {x | a ≤ x ∧ x < b} = {x | a < x ∧ x < b}) ∧
17107    (∀a b. interior {x | a < x ∧ x ≤ b} = {x | a < x ∧ x < b}) ∧
17108    (∀a b. interior {x | a < x ∧ x < b} = {x | a < x ∧ x < b})
17109Proof
17110    simp[SRULE [CLOSED_interval,OPEN_interval] INTERIOR_INTERVAL] >>
17111    ‘∀a b. {x | a ≤ x ∧ x < b} = {x | a ≤ x} ∩ {x | x < b}’ by simp[EXTENSION] >>
17112    ‘∀a b. {x | a < x ∧ x ≤ b} = {x | a < x} ∩ {x | x ≤ b}’ by simp[EXTENSION] >>
17113    ‘∀a b. {x | a < x ∧ x < b} = {x | a < x} ∩ {x | x < b}’ by simp[EXTENSION] >>
17114    csimp[INTERIOR_INTER] >>
17115    simp[INTERIOR_EMPTY,INTERIOR_UNIV,INTERIOR_HALFSPACE_COMPONENT_LE,
17116        SRULE [real_ge,real_gt] INTERIOR_HALFSPACE_COMPONENT_GE] >>
17117    simp[INTERIOR_EQ,OPEN_INTERVAL_RIGHT,OPEN_INTERVAL_LEFT]
17118QED
17119
17120(* ------------------------------------------------------------------------- *)
17121(* Limit component bounds.                                                   *)
17122(* ------------------------------------------------------------------------- *)
17123
17124Theorem LIM_COMPONENT_UBOUND:
17125   !net:('a)net f (l:real) b k.
17126        ~(trivial_limit net) /\ (f --> l) net /\
17127        eventually (\x. f x <= b) net
17128        ==> l <= b
17129Proof
17130  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
17131   [``net:('a)net``, ``f:'a->real``, ``{y:real | y <= b}``, ``l:real``]
17132   LIM_IN_CLOSED_SET) THEN
17133  ASM_SIMP_TAC std_ss [CLOSED_HALFSPACE_COMPONENT_LE, GSPECIFICATION]
17134QED
17135
17136Theorem LIM_COMPONENT_LBOUND:
17137   !net:('a)net f (l:real) b.
17138        ~(trivial_limit net) /\ (f --> l) net /\
17139        eventually (\x. b <= (f x)) net
17140        ==> b <= l
17141Proof
17142  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
17143   [``net:('a)net``, ``f:'a->real``, ``{y:real | b <= y}``, ``l:real``]
17144   LIM_IN_CLOSED_SET) THEN
17145  ASM_SIMP_TAC std_ss [REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE,
17146    GSPECIFICATION]
17147QED
17148
17149Theorem LIM_COMPONENT_EQ:
17150   !net f:'a->real i l b.
17151        (f --> l) net /\
17152        ~(trivial_limit net) /\ eventually (\x. f(x) = b) net
17153        ==> (l = b)
17154Proof
17155  SIMP_TAC std_ss [GSYM REAL_LE_ANTISYM, EVENTUALLY_AND] THEN
17156  METIS_TAC [LIM_COMPONENT_UBOUND, LIM_COMPONENT_LBOUND]
17157QED
17158
17159Theorem LIM_COMPONENT_LE:
17160   !net:('a)net f:'a->real g:'a->real l m.
17161         ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\
17162        eventually (\x. (f x) <= (g x)) net
17163        ==> (l <= m)
17164Proof
17165  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
17166  SIMP_TAC std_ss [LIM_COMPONENT_LBOUND] THEN
17167  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
17168  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN
17169  DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REPEAT STRIP_TAC THEN
17170  MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN EXISTS_TAC ``net:'a net`` THEN
17171  EXISTS_TAC ``(\(x :'a). (g :'a -> real) x - (f :'a -> real) x)`` THEN
17172  METIS_TAC []
17173QED
17174
17175Theorem LIM_DROP_LE:
17176   !net:('a)net f g l m.
17177         ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\
17178        eventually (\x. f x <= g x) net
17179        ==> l <= m
17180Proof
17181  REPEAT STRIP_TAC THEN
17182  MATCH_MP_TAC(ISPEC ``net:('a)net`` LIM_COMPONENT_LE) THEN
17183  MAP_EVERY EXISTS_TAC [``f:'a->real``, ``g:'a->real``] THEN
17184  ASM_REWRITE_TAC[LESS_EQ_REFL]
17185QED
17186
17187Theorem LIM_DROP_UBOUND:
17188   !net f:'a->real l b.
17189        (f --> l) net /\
17190        ~(trivial_limit net) /\ eventually (\x. f x <= b) net
17191        ==> l <= b
17192Proof
17193  REPEAT STRIP_TAC THEN
17194  MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN
17195  REWRITE_TAC[LESS_EQ_REFL] THEN METIS_TAC[]
17196QED
17197
17198Theorem LIM_DROP_LBOUND:
17199   !net f:'a->real l b.
17200        (f --> l) net /\
17201        ~(trivial_limit net) /\ eventually (\x. b <= f x) net
17202        ==> b <= l
17203Proof
17204  REPEAT STRIP_TAC THEN
17205  MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN
17206  REWRITE_TAC[LESS_EQ_REFL] THEN METIS_TAC[]
17207QED
17208
17209(* ------------------------------------------------------------------------- *)
17210(* Also extending closed bounds to closures.                                 *)
17211(* ------------------------------------------------------------------------- *)
17212
17213Theorem IMAGE_CLOSURE_SUBSET:
17214   !f (s:real->bool) (t:real->bool).
17215      f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t
17216      ==> IMAGE f (closure s) SUBSET t
17217Proof
17218  REPEAT STRIP_TAC THEN
17219  SUBGOAL_THEN ``closure s SUBSET {x | (f:real->real) x IN t}`` MP_TAC
17220  THENL [MATCH_MP_TAC SUBSET_TRANS, SET_TAC []]  THEN
17221  EXISTS_TAC ``{x | x IN closure s /\ (f:real->real) x IN t}`` THEN
17222  CONJ_TAC THENL
17223  [MATCH_MP_TAC CLOSURE_MINIMAL, SET_TAC[]] THEN
17224  ASM_SIMP_TAC std_ss [CONTINUOUS_CLOSED_PREIMAGE, CLOSED_CLOSURE] THEN
17225  MP_TAC (ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[]
17226QED
17227
17228Theorem CLOSURE_IMAGE_CLOSURE:
17229   !f:real->real s.
17230        f continuous_on closure s
17231        ==> (closure(IMAGE f (closure s)) = closure(IMAGE f s))
17232Proof
17233  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
17234  SIMP_TAC std_ss [SUBSET_CLOSURE, IMAGE_SUBSET, CLOSURE_SUBSET] THEN
17235  SIMP_TAC std_ss [CLOSURE_MINIMAL_EQ, CLOSED_CLOSURE] THEN
17236  MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN
17237  ASM_REWRITE_TAC[CLOSED_CLOSURE, CLOSURE_SUBSET]
17238QED
17239
17240Theorem CLOSURE_IMAGE_BOUNDED:
17241   !f:real->real s.
17242        f continuous_on closure s /\ bounded s
17243        ==> (closure(IMAGE f s) = IMAGE f (closure s))
17244Proof
17245  REPEAT STRIP_TAC THEN
17246  MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC ``closure(IMAGE (f:real->real) (closure s))`` THEN
17247  CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE], ALL_TAC] THEN
17248  MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
17249  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
17250  ASM_REWRITE_TAC[COMPACT_CLOSURE]
17251QED
17252
17253Theorem CONTINUOUS_ON_CLOSURE_ABS_LE:
17254   !f:real->real s x b.
17255      f continuous_on (closure s) /\
17256      (!y. y IN s ==> abs(f y) <= b) /\
17257      x IN (closure s)
17258      ==> abs(f x) <= b
17259Proof
17260  REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
17261  SUBGOAL_THEN ``IMAGE (f:real->real) (closure s) SUBSET cball(0,b)``
17262    MP_TAC THENL
17263  [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET, ASM_SET_TAC []] THEN
17264  ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM_SET_TAC []
17265QED
17266
17267Theorem CONTINUOUS_ON_CLOSURE_COMPONENT_LE:
17268   !f:real->real s x b.
17269      f continuous_on (closure s) /\
17270      (!y. y IN s ==> (f y) <= b) /\
17271      x IN (closure s)
17272      ==> (f x) <= b
17273Proof
17274  REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
17275  SUBGOAL_THEN ``IMAGE (f:real->real) (closure s) SUBSET {x | x <= b}``
17276  MP_TAC THENL
17277   [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET, ASM_SET_TAC []] THEN
17278  ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM_SET_TAC[]
17279QED
17280
17281Theorem CONTINUOUS_ON_CLOSURE_COMPONENT_GE:
17282   !f:real->real s x b.
17283      f continuous_on (closure s) /\
17284      (!y. y IN s ==> b <= (f y)) /\
17285      x IN (closure s)
17286      ==> b <= (f x)
17287Proof
17288  REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
17289  SUBGOAL_THEN ``IMAGE (f:real->real) (closure s) SUBSET {x | x >= b}``
17290  MP_TAC THENL
17291   [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET, ASM_SET_TAC [real_ge]] THEN
17292  ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM_SET_TAC[real_ge]
17293QED
17294
17295Theorem CONTINUOUS_MAP_CLOSURES:
17296   !f:real->real.
17297        f continuous_on UNIV <=>
17298        !s. IMAGE f (closure s) SUBSET closure(IMAGE f s)
17299Proof
17300  GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
17301   [GEN_TAC THEN MATCH_MP_TAC(MESON[SUBSET_DEF, CLOSURE_SUBSET]
17302     ``(closure s = t) ==> s SUBSET t``) THEN
17303    MATCH_MP_TAC CLOSURE_IMAGE_CLOSURE THEN
17304    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET, SUBSET_UNIV],
17305    REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
17306    REWRITE_TAC[GSYM CLOSED_IN, SUBTOPOLOGY_UNIV, IN_UNIV] THEN
17307    X_GEN_TAC ``t:real->bool`` THEN DISCH_TAC THEN
17308    FIRST_X_ASSUM(MP_TAC o SPEC ``{x | (f:real->real) x IN t}``) THEN
17309    REWRITE_TAC[GSYM CLOSURE_SUBSET_EQ] THEN
17310    SUBGOAL_THEN
17311     ``closure(IMAGE (f:real->real) {x | f x IN t}) SUBSET t``
17312    MP_TAC THENL
17313     [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SET_TAC[], SET_TAC[]]]
17314QED
17315
17316(* ------------------------------------------------------------------------- *)
17317(* Limits relative to a union.                                               *)
17318(* ------------------------------------------------------------------------- *)
17319
17320Theorem LIM_WITHIN_UNION:
17321   (f --> l) (at x within (s UNION t)) <=>
17322   (f --> l) (at x within s) /\ (f --> l) (at x within t)
17323Proof
17324  SIMP_TAC std_ss [LIM_WITHIN, IN_UNION, GSYM FORALL_AND_THM] THEN
17325  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC ``e:real`` THEN
17326  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_SIMP_TAC std_ss [] THEN
17327  EQ_TAC THENL [MESON_TAC[], ALL_TAC] THEN DISCH_THEN
17328   (CONJUNCTS_THEN2 (X_CHOOSE_TAC ``d:real``) (X_CHOOSE_TAC ``k:real``)) THEN
17329  EXISTS_TAC ``min d k:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
17330  ASM_MESON_TAC[]
17331QED
17332
17333Theorem CONTINUOUS_ON_UNION:
17334   !f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t
17335           ==> f continuous_on (s UNION t)
17336Proof
17337  REWRITE_TAC[CONTINUOUS_ON, CLOSED_LIMPT, IN_UNION, LIM_WITHIN_UNION] THEN
17338  MESON_TAC[LIM, TRIVIAL_LIMIT_WITHIN]
17339QED
17340
17341Theorem CONTINUOUS_ON_CASES:
17342   !P f g:real->real s t.
17343        closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\
17344        (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> (f x = g x))
17345        ==> (\x. if P x then f x else g x) continuous_on (s UNION t)
17346Proof
17347  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN
17348  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
17349   [EXISTS_TAC ``f:real->real``, EXISTS_TAC ``g:real->real``] THEN
17350  METIS_TAC[]
17351QED
17352
17353Theorem CONTINUOUS_ON_UNION_LOCAL:
17354   !f:real->real s.
17355        closed_in (subtopology euclidean (s UNION t)) s /\
17356        closed_in (subtopology euclidean (s UNION t)) t /\
17357        f continuous_on s /\ f continuous_on t
17358        ==> f continuous_on (s UNION t)
17359Proof
17360  REWRITE_TAC[CONTINUOUS_ON, CLOSED_IN_LIMPT, IN_UNION, LIM_WITHIN_UNION] THEN
17361  MESON_TAC[LIM, TRIVIAL_LIMIT_WITHIN]
17362QED
17363
17364Theorem CONTINUOUS_ON_CASES_LOCAL:
17365   !P f g:real->real s t.
17366        closed_in (subtopology euclidean (s UNION t)) s /\
17367        closed_in (subtopology euclidean (s UNION t)) t /\
17368        f continuous_on s /\ g continuous_on t /\
17369        (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> (f x = g x))
17370        ==> (\x. if P x then f x else g x) continuous_on (s UNION t)
17371Proof
17372  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN
17373  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
17374   [EXISTS_TAC ``f:real->real``, EXISTS_TAC ``g:real->real``] THEN
17375  METIS_TAC[]
17376QED
17377
17378Theorem CONTINUOUS_ON_CASES_LE:
17379   !f g:real->real h s a.
17380        f continuous_on {t | t IN s /\ h t <= a} /\
17381        g continuous_on {t | t IN s /\ a <= h t} /\
17382        (h) continuous_on s /\
17383        (!t. t IN s /\ (h t = a) ==> (f t = g t))
17384        ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s
17385Proof
17386  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC
17387   ``{t | t IN s /\ (h:real->real) t <= a} UNION
17388     {t | t IN s /\ a <= h t}`` THEN
17389  CONJ_TAC THENL
17390   [ALL_TAC, SIMP_TAC std_ss [SUBSET_DEF, IN_UNION, GSPECIFICATION, REAL_LE_TOTAL]] THEN
17391  ONCE_REWRITE_TAC [METIS [] ``h t <= a <=> (\t:real. h t <= a:real) t``] THEN
17392  MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_SIMP_TAC std_ss [] THEN
17393  SIMP_TAC std_ss [GSPECIFICATION, GSYM CONJ_ASSOC, REAL_LE_ANTISYM] THEN
17394  REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
17395   [ALL_TAC, METIS_TAC[]] THEN
17396  CONJ_TAC THENL
17397   [SUBGOAL_THEN
17398     ``{t | t IN s /\ (h:real->real) t <= a} =
17399       {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\
17400           (h) t IN {x | x <= a}}``
17401     (fn th => GEN_REWR_TAC RAND_CONV [th])
17402    THENL
17403     [SIMP_TAC std_ss [o_THM, GSPECIFICATION, EXTENSION, IN_UNION] THEN
17404      GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC std_ss [],
17405      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
17406      ASM_SIMP_TAC std_ss [CLOSED_HALFSPACE_COMPONENT_LE, ETA_AX] THEN
17407      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
17408        CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]],
17409    SUBGOAL_THEN
17410     ``{t | t IN s /\ a <= (h:real->real) t} =
17411       {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\
17412           (h) t IN {x | x >= a}}``
17413     (fn th => GEN_REWR_TAC RAND_CONV [th])
17414    THENL
17415     [SIMP_TAC std_ss [o_THM, GSPECIFICATION, EXTENSION, IN_UNION] THEN
17416      GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC std_ss [real_ge] THEN
17417      ASM_REAL_ARITH_TAC,
17418      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
17419      ASM_SIMP_TAC std_ss [CLOSED_HALFSPACE_COMPONENT_GE, ETA_AX] THEN
17420      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
17421        CONTINUOUS_ON_SUBSET)) THEN
17422      SET_TAC[]]]
17423QED
17424
17425Theorem CONTINUOUS_ON_CASES_1:
17426   !f g:real->real s a.
17427        f continuous_on {t | t IN s /\ t <= a} /\
17428        g continuous_on {t | t IN s /\ a <= t} /\
17429        (a IN s ==> (f(a) = g(a)))
17430        ==> (\t. if t <= a then f(t) else g(t)) continuous_on s
17431Proof
17432  REPEAT STRIP_TAC THEN
17433  ONCE_REWRITE_TAC [METIS [] ``t <= a <=> (\t. t) t <= a:real``] THEN
17434  MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
17435  ASM_SIMP_TAC std_ss [o_DEF, CONTINUOUS_ON_ID] THEN
17436  METIS_TAC[]
17437QED
17438
17439Theorem EXTENSION_FROM_CLOPEN:
17440   !f:real->real s t u.
17441        open_in (subtopology euclidean s) t /\
17442        closed_in (subtopology euclidean s) t /\
17443        f continuous_on t /\ IMAGE f t SUBSET u /\ ((u = {}) ==> (s = {}))
17444        ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\
17445                !x. x IN t ==> (g x = f x)
17446Proof
17447  REPEAT GEN_TAC THEN ASM_CASES_TAC ``u:real->bool = {}`` THEN
17448  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_EMPTY, IMAGE_EMPTY, IMAGE_INSERT, SUBSET_EMPTY,
17449               IMAGE_EQ_EMPTY, NOT_IN_EMPTY] THEN
17450  STRIP_TAC THEN UNDISCH_TAC ``u <> {}:real->bool`` THEN DISCH_TAC THEN
17451  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
17452  DISCH_THEN(X_CHOOSE_TAC ``a:real``) THEN
17453  EXISTS_TAC ``\x. if x IN t then (f:real->real) x else a`` THEN
17454  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE] THEN
17455  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
17456  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
17457  SUBGOAL_THEN ``s:real->bool = t UNION (s DIFF t)`` SUBST1_TAC THENL
17458   [ASM_SET_TAC[],
17459    ONCE_REWRITE_TAC [METIS [] ``(\x. if x IN t then f x else a) =
17460                                 (\x. if (\x. x IN t) x then f x else (\x. a) x)``] THEN
17461    MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN
17462  ASM_SIMP_TAC std_ss [SET_RULE ``t SUBSET s ==> (t UNION (s DIFF t) = s)``] THEN
17463  REWRITE_TAC[CONTINUOUS_ON_CONST, IN_DIFF] THEN
17464  CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF, MESON_TAC[]] THEN
17465  ASM_REWRITE_TAC[CLOSED_IN_REFL]
17466QED
17467
17468(* ------------------------------------------------------------------------- *)
17469(* Some more convenient intermediate-value theorem formulations.             *)
17470(* ------------------------------------------------------------------------- *)
17471
17472Theorem CONNECTED_IVT_HYPERPLANE:
17473   !s x y:real a b.
17474        connected s /\
17475        x IN s /\ y IN s /\ a * x <= b /\ b <= a * y
17476        ==> ?z. z IN s /\ (a * z = b)
17477Proof
17478  REPEAT STRIP_TAC THEN
17479  UNDISCH_TAC ``connected s`` THEN DISCH_TAC THEN
17480  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [connected]) THEN
17481  SIMP_TAC std_ss [NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL
17482   [``{x:real | a * x < b}``, ``{x:real | a * x > b}``]) THEN
17483  SIMP_TAC std_ss [OPEN_HALFSPACE_LT, OPEN_HALFSPACE_GT] THEN
17484  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN SIMP_TAC std_ss [] THEN STRIP_TAC THEN
17485  SIMP_TAC real_ss [EXTENSION, GSPECIFICATION, IN_INTER, NOT_IN_EMPTY, SUBSET_DEF,
17486              IN_UNION, REAL_LT_LE, real_gt] THEN
17487  METIS_TAC[REAL_LE_TOTAL, REAL_LE_ANTISYM]
17488QED
17489
17490Theorem CONNECTED_IVT_COMPONENT:
17491   !s x y:real a.
17492        connected s /\ x IN s /\ y IN s /\ x <= a /\ a <= y
17493        ==> ?z. z IN s /\ (z = a)
17494Proof
17495  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
17496   [``s:real->bool``, ``x:real``, ``y:real``, ``1:real``,
17497    ``a:real``] CONNECTED_IVT_HYPERPLANE) THEN
17498  ASM_SIMP_TAC std_ss [REAL_MUL_LID]
17499QED
17500
17501Theorem CONNECTED_IVT :
17502    !s x y a. connected s /\ x IN s /\ y IN s /\ x <= a /\ a <= y ==> a IN s
17503Proof
17504    rpt STRIP_TAC
17505 >> ‘?z. z IN s /\ z = a’ by METIS_TAC [CONNECTED_IVT_COMPONENT]
17506 >> POP_ASSUM (simp o wrap o SYM)
17507QED
17508
17509(* This theorem is inspired by limTheory.IVT *)
17510Theorem CONTINUOUS_ON_IVT :
17511    !f a b y. a <= b /\ f(a) <= y /\ y <= f(b) /\
17512              f continuous_on (interval [a,b])
17513          ==> ?x. x IN interval [a,b] /\ (f(x) = y)
17514Proof
17515    rpt STRIP_TAC
17516 >> ‘connected (interval [a,b])’ by METIS_TAC [CONNECTED_SEGMENT, SEGMENT]
17517 >> ‘connected (IMAGE f (interval [a,b]))’
17518      by PROVE_TAC [CONNECTED_CONTINUOUS_IMAGE]
17519 >> MP_TAC (Q.SPECL [‘IMAGE f (interval [a,b])’,
17520                     ‘(f :real->real) a’, ‘(f :real->real) b’, ‘y’]
17521                    CONNECTED_IVT_COMPONENT)
17522 >> Know ‘f a IN IMAGE f (interval [a,b]) /\
17523          f b IN IMAGE f (interval [a,b])’
17524 >- (rw [IN_IMAGE, IN_INTERVAL] >| (* 2 subgoals *)
17525     [ Q.EXISTS_TAC ‘a’ >> rw [],
17526       Q.EXISTS_TAC ‘b’ >> rw [] ])
17527 >> RW_TAC std_ss []
17528 >> POP_ASSUM MP_TAC
17529 >> rw [IN_IMAGE]
17530 >> Q.EXISTS_TAC ‘x’ >> art []
17531QED
17532
17533(* ------------------------------------------------------------------------- *)
17534(* Rather trivial observation that we can map any connected set on segment.  *)
17535(* ------------------------------------------------------------------------- *)
17536
17537Theorem MAPPING_CONNECTED_ONTO_SEGMENT:
17538   !s:real->bool a b:real.
17539        connected s /\ ~(?a. s SUBSET {a})
17540        ==> ?f. f continuous_on s /\ (IMAGE f s = segment[a,b])
17541Proof
17542  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
17543   ``~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)``)) THEN
17544  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
17545  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN STRIP_TAC THEN EXISTS_TAC
17546   ``\x:real. a + dist(u,x) / (dist(u,x) + dist(v,x)) * (b - a:real)`` THEN
17547  CONJ_TAC THEN SIMP_TAC std_ss [] THENL
17548   [ONCE_REWRITE_TAC [METIS []
17549     ``(\x. a + dist (u,x) / (dist (u,x) + dist (v,x)) * (b - a)) =
17550       (\x. (\x. a) x + (\x. dist (u,x) / (dist (u,x) + dist (v,x)) * (b - a)) x)``] THEN
17551    MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
17552    ONCE_REWRITE_TAC [METIS []
17553    ``(\x. dist (u,x) / (dist (u,x) + dist (v,x)) * (b - a)) =
17554      (\x. (\x. dist (u,x) / (dist (u,x) + dist (v,x))) x * (\x. (b - a)) x)``] THEN
17555    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC std_ss [o_DEF, CONTINUOUS_ON_CONST],
17556
17557    REWRITE_TAC[segment, REAL_ARITH
17558     ``(&1 - u) * a + u * b:real = a + u * (b - a)``] THEN
17559    ONCE_REWRITE_TAC [METIS []
17560    ``(\x. a + dist (u,x) / (dist (u,x) + dist (v,x)) * (b - a)) =
17561      (\x. a + (\x. dist (u,x) / (dist (u,x) + dist (v,x))) x * (b - a))``] THEN
17562    ONCE_REWRITE_TAC [METIS [] ``(0 <= u /\ u <= 1:real) <=> (\u. 0 <= u /\ u <= 1) u``] THEN
17563    MATCH_MP_TAC(SET_RULE
17564     ``(IMAGE f s = {x | P x})
17565      ==> (IMAGE (\x. a + f x * b) s = {a + u * b:real | P u})``) THEN
17566    SIMP_TAC std_ss [GSYM SUBSET_ANTISYM_EQ, SUBSET_DEF, FORALL_IN_IMAGE] THEN
17567    ASM_SIMP_TAC real_ss [dist, GSPECIFICATION, REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ,
17568      REAL_ARITH ``~(u:real = v) ==> &0 < abs(u - x) + abs(v - x)``] THEN
17569    CONJ_TAC THENL [REAL_ARITH_TAC, REWRITE_TAC[IN_IMAGE]] THEN
17570    X_GEN_TAC ``t:real`` THEN STRIP_TAC THEN
17571    MP_TAC(ISPECL
17572     [``IMAGE (\x:real. dist(u,x) / (dist(u,x) + dist(v,x))) s``,
17573      ``0:real``, ``1:real``, ``t:real``]
17574        CONNECTED_IVT_COMPONENT) THEN
17575    ASM_SIMP_TAC arith_ss [] THEN
17576    SIMP_TAC std_ss [EXISTS_IN_IMAGE] THEN
17577    KNOW_TAC ``connected
17578   (IMAGE
17579      (\(x :real).
17580         (dist ((u :real),x) :real) /
17581         ((dist (u,x) :real) + (dist ((v :real),x) :real)))
17582      (s :real -> bool)) /\
17583 (0 :real) IN
17584 IMAGE
17585   (\(x :real).
17586      (dist (u,x) :real) / ((dist (u,x) :real) + (dist (v,x) :real)))
17587   s /\
17588 (1 :real) IN
17589 IMAGE
17590   (\(x :real).
17591      (dist (u,x) :real) / ((dist (u,x) :real) + (dist (v,x) :real)))
17592   s`` THENL
17593   [REWRITE_TAC[IN_IMAGE], DISCH_TAC THEN ASM_REWRITE_TAC [IN_IMAGE] THEN
17594    BETA_TAC THEN MESON_TAC[dist]] THEN
17595    REPEAT CONJ_TAC THENL
17596     [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[],
17597      EXISTS_TAC ``u:real`` THEN ASM_REWRITE_TAC[DIST_REFL, real_div, dist] THEN
17598      BETA_TAC THEN REAL_ARITH_TAC,
17599      EXISTS_TAC ``v:real`` THEN ASM_REWRITE_TAC[DIST_REFL] THEN
17600      ASM_SIMP_TAC std_ss [REAL_DIV_REFL, DIST_EQ_0, REAL_ADD_RID] THEN
17601      RULE_ASSUM_TAC (ONCE_REWRITE_RULE
17602       [REAL_ARITH ``(u <> v) = (abs (u - v) <> 0:real)``]) THEN
17603      ASM_SIMP_TAC real_ss [REAL_DIV_REFL]]] THEN
17604  REWRITE_TAC[real_div] THENL
17605  [ONCE_REWRITE_TAC [METIS [] ``(\x. dist (u,x) * inv (dist (u,x) + dist (v,x))) =
17606                  (\x. (\x. dist (u,x)) x * (\x. inv (dist (u,x) + dist (v,x))) x)``] THEN
17607  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
17608  REWRITE_TAC[CONTINUOUS_ON_DIST] THEN
17609  ONCE_REWRITE_TAC [METIS [] ``(\x. inv (dist (u,x) + dist (v,x))) =
17610                          (\x. inv ((\x. (dist (u,x) + dist (v,x))) x))``] THEN
17611  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
17612  ASM_SIMP_TAC std_ss [dist, REAL_ARITH
17613   ``~(u:real = v) ==> ~(abs(u - x) + abs(v - x) = &0)``] THEN
17614  ONCE_REWRITE_TAC [METIS [] ``(\x:real. abs (u - x) + abs (v - x)) =
17615                       (\x. (\x. abs (u - x)) x + (\x. abs (v - x)) x)``] THEN
17616  MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
17617  SIMP_TAC std_ss [GSYM dist, REWRITE_RULE[o_DEF] CONTINUOUS_ON_DIST],
17618   ONCE_REWRITE_TAC [METIS [] ``(\x. dist (u,x) * inv (dist (u,x) + dist (v,x))) =
17619                  (\x. (\x. dist (u,x)) x * (\x. inv (dist (u,x) + dist (v,x))) x)``] THEN
17620  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
17621  REWRITE_TAC[CONTINUOUS_ON_DIST] THEN
17622  ONCE_REWRITE_TAC [METIS [] ``(\x. inv (dist (u,x) + dist (v,x))) =
17623                          (\x. inv ((\x. (dist (u,x) + dist (v,x))) x))``] THEN
17624  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
17625  ASM_SIMP_TAC std_ss [dist, REAL_ARITH
17626   ``~(u:real = v) ==> ~(abs(u - x) + abs(v - x) = &0)``] THEN
17627  ONCE_REWRITE_TAC [METIS [] ``(\x:real. abs (u - x) + abs (v - x)) =
17628                       (\x. (\x. abs (u - x)) x + (\x. abs (v - x)) x)``] THEN
17629  MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
17630  SIMP_TAC std_ss [GSYM dist, REWRITE_RULE[o_DEF] CONTINUOUS_ON_DIST],
17631  ALL_TAC] THEN
17632  FULL_SIMP_TAC std_ss [GSYM dist, DIST_REFL, REAL_ADD_RID] THEN
17633  REWRITE_TAC [GSYM real_div] THEN METIS_TAC [REAL_DIV_REFL]
17634QED
17635
17636(* ------------------------------------------------------------------------- *)
17637(* Also more convenient formulations of monotone convergence.                *)
17638(* ------------------------------------------------------------------------- *)
17639
17640Theorem BOUNDED_INCREASING_CONVERGENT:
17641   !s:num->real.
17642        bounded {s n | n IN univ(:num)} /\ (!n. (s n) <= (s(SUC n)))
17643        ==> ?l. (s --> l) sequentially
17644Proof
17645  GEN_TAC THEN
17646  SIMP_TAC std_ss [bounded_def, GSPECIFICATION, LIM_SEQUENTIALLY, dist,
17647              IN_UNIV] THEN
17648  DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN
17649  SIMP_TAC std_ss [LEFT_EXISTS_AND_THM] THEN
17650  CONJ_TAC THENL [METIS_TAC[], ALL_TAC] THEN DISJ1_TAC THEN
17651  ONCE_REWRITE_TAC [METIS [] ``!m n. ((s:num->real) m <= s n) = (\m n. s m <= s n) m n``] THEN
17652  MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
17653  METIS_TAC [REAL_LE_TRANS, REAL_LE_REFL]
17654QED
17655
17656Theorem BOUNDED_DECREASING_CONVERGENT:
17657   !s:num->real.
17658        bounded {s n | n IN univ(:num)} /\ (!n. (s(SUC n)) <= (s(n)))
17659        ==> ?l. (s --> l) sequentially
17660Proof
17661  GEN_TAC THEN SIMP_TAC std_ss [bounded_def, FORALL_IN_GSPEC] THEN
17662  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
17663  MP_TAC(ISPEC ``\n. -((s:num->real) n)`` BOUNDED_INCREASING_CONVERGENT) THEN
17664  ASM_SIMP_TAC std_ss [bounded_def, FORALL_IN_GSPEC, ABS_NEG, REAL_LE_NEG2] THEN
17665  GEN_REWR_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN
17666  SIMP_TAC std_ss [REAL_NEG_NEG, ETA_AX] THEN METIS_TAC[]
17667QED
17668
17669(* ------------------------------------------------------------------------- *)
17670(* Basic homeomorphism definitions.                                          *)
17671(* ------------------------------------------------------------------------- *)
17672
17673Definition homeomorphism[nocompute]:
17674  homeomorphism (s,t) (f,g) <=>
17675     (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\
17676     (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t
17677End
17678
17679val _ = set_fixity "homeomorphic" (Infix(NONASSOC, 450));
17680
17681Definition homeomorphic[nocompute]:
17682  s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)
17683End
17684
17685Theorem HOMEOMORPHISM:
17686   !s:real->bool t:real->bool f g.
17687        homeomorphism (s,t) (f,g) <=>
17688         f continuous_on s /\ IMAGE f s SUBSET t /\
17689         g continuous_on t /\ IMAGE g t SUBSET s /\
17690         (!x. x IN s ==> (g (f x) = x)) /\
17691         (!y. y IN t ==> (f (g y) = y))
17692Proof
17693  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
17694  EQ_TAC THEN SIMP_TAC std_ss [] THEN SET_TAC[]
17695QED
17696
17697Theorem HOMEOMORPHISM_OF_SUBSETS:
17698   !f g s t s' t'.
17699    homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ (IMAGE f s' = t')
17700    ==> homeomorphism (s',t') (f,g)
17701Proof
17702  REWRITE_TAC[homeomorphism] THEN
17703  REPEAT STRIP_TAC THEN
17704  TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM_SET_TAC[]
17705QED
17706
17707Theorem HOMEOMORPHISM_ID:
17708   !s:real->bool. homeomorphism (s,s) ((\x. x),(\x. x))
17709Proof
17710  SIMP_TAC std_ss [homeomorphism, IMAGE_ID, CONTINUOUS_ON_ID]
17711QED
17712
17713Theorem HOMEOMORPHIC_REFL:
17714   !s:real->bool. s homeomorphic s
17715Proof
17716  REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_ID]
17717QED
17718
17719Theorem HOMEOMORPHISM_SYM:
17720   !f:real->real g s t.
17721        homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)
17722Proof
17723  REWRITE_TAC[homeomorphism] THEN MESON_TAC[]
17724QED
17725
17726Theorem HOMEOMORPHIC_SYM:
17727   !s t. s homeomorphic t <=> t homeomorphic s
17728Proof
17729  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic, homeomorphism] THEN
17730  ONCE_REWRITE_TAC [METIS []
17731       ``((!x. x IN t ==> (g (f x) = x)) /\ (IMAGE f t = s) /\
17732     f continuous_on t /\ (!y. y IN s ==> (f (g y) = y)) /\
17733     (IMAGE g s = t) /\ g continuous_on s) =
17734   (\f g. (!x. x IN t ==> (g (f x) = x)) /\ (IMAGE f t = s) /\
17735     f continuous_on t /\ (!y. y IN s ==> (f (g y) = y)) /\
17736     (IMAGE g s = t) /\ g continuous_on s) f g``] THEN
17737  GEN_REWR_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
17738  REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SIMP_TAC std_ss [] THEN
17739  TAUT_TAC
17740QED
17741
17742Theorem HOMEOMORPHISM_COMPOSE:
17743   !f:real->real g h:real->real k s t u.
17744        homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k)
17745        ==> homeomorphism (s,u) (h o f,g o k)
17746Proof
17747  SIMP_TAC std_ss [homeomorphism, CONTINUOUS_ON_COMPOSE, IMAGE_COMPOSE, o_THM] THEN
17748  SET_TAC[]
17749QED
17750
17751Theorem HOMEOMORPHIC_TRANS:
17752   !s:real->bool t:real->bool u:real->bool.
17753        s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u
17754Proof
17755  REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]
17756QED
17757
17758Theorem HOMEOMORPHIC_IMP_CARD_EQ:
17759   !s:real->bool t:real->bool. s homeomorphic t ==> s =_c t
17760Proof
17761  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic, homeomorphism, eq_c] THEN
17762  STRIP_TAC THEN EXISTS_TAC ``f:real->real`` THEN ASM_SET_TAC []
17763QED
17764
17765Theorem HOMEOMORPHIC_FINITENESS:
17766   !s:real->bool t:real->bool.
17767        s homeomorphic t ==> (FINITE s <=> FINITE t)
17768Proof
17769  REPEAT GEN_TAC THEN
17770  DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
17771  DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_FINITE_CONG)
17772QED
17773
17774Theorem HOMEOMORPHIC_EMPTY:
17775   (!s. (s:real->bool) homeomorphic ({}:real->bool) <=> (s = {})) /\
17776   (!s. ({}:real->bool) homeomorphic (s:real->bool) <=> (s = {}))
17777Proof
17778  REWRITE_TAC[homeomorphic, homeomorphism, IMAGE_EMPTY, IMAGE_INSERT, IMAGE_EQ_EMPTY] THEN
17779  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
17780  ASM_SIMP_TAC std_ss [continuous_on, NOT_IN_EMPTY]
17781QED
17782
17783Theorem HOMEOMORPHIC_MINIMAL:
17784   !s t. s homeomorphic t <=>
17785            ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\
17786                  (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\
17787                  f continuous_on s /\ g continuous_on t
17788Proof
17789  REWRITE_TAC[homeomorphic, homeomorphism, EXTENSION, IN_IMAGE] THEN
17790  REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]
17791QED
17792
17793Theorem HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF:
17794   !f:real->real s.
17795        linear f /\ (!x y. (f x = f y) ==> (x = y))
17796        ==> (IMAGE f s) homeomorphic s
17797Proof
17798  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
17799  FIRST_ASSUM(MP_TAC o REWRITE_RULE [INJECTIVE_LEFT_INVERSE]) THEN
17800  STRIP_TAC THEN EXISTS_TAC ``g:real->real`` THEN
17801  EXISTS_TAC ``f:real->real`` THEN
17802  ASM_SIMP_TAC std_ss [LINEAR_CONTINUOUS_ON, FORALL_IN_IMAGE, FUN_IN_IMAGE] THEN
17803  ASM_SIMP_TAC std_ss [continuous_on, CONJ_EQ_IMP, FORALL_IN_IMAGE] THEN
17804  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
17805  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
17806  MP_TAC(ISPEC ``f:real->real`` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN
17807  ASM_REWRITE_TAC[] THEN
17808  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
17809  EXISTS_TAC ``e * B:real`` THEN ASM_SIMP_TAC real_ss [REAL_LT_MUL] THEN
17810  X_GEN_TAC ``y:real`` THEN ASM_SIMP_TAC std_ss [dist, GSYM LINEAR_SUB] THEN
17811  DISCH_TAC THEN ASM_SIMP_TAC real_ss [GSYM REAL_LT_LDIV_EQ] THEN
17812  MATCH_MP_TAC(REAL_ARITH ``a <= b ==> b < x ==> a < x:real``) THEN
17813  ASM_SIMP_TAC real_ss [REAL_LE_RDIV_EQ]
17814QED
17815
17816Theorem HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ:
17817   !f:real->real s t.
17818        linear f /\ (!x y. (f x = f y) ==> (x = y))
17819        ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)
17820Proof
17821  REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC ``s:real->bool`` o
17822    MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN
17823  EQ_TAC THENL
17824   [FIRST_X_ASSUM(MP_TAC o ONCE_REWRITE_RULE [HOMEOMORPHIC_SYM]),
17825    POP_ASSUM MP_TAC] THEN
17826  METIS_TAC[AND_IMP_INTRO, HOMEOMORPHIC_TRANS]
17827QED
17828
17829Theorem HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ:
17830   !f:real->real s t.
17831        linear f /\ (!x y. (f x = f y) ==> (x = y))
17832        ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)
17833Proof
17834  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
17835  REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]
17836QED
17837
17838Theorem HOMEOMORPHIC_TRANSLATION_SELF:
17839   !a:real s. (IMAGE (\x. a + x) s) homeomorphic s
17840Proof
17841  REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
17842  EXISTS_TAC ``\x:real. x - a`` THEN
17843  EXISTS_TAC ``\x:real. a + x`` THEN
17844  SIMP_TAC std_ss [FORALL_IN_IMAGE, CONTINUOUS_ON_SUB, CONTINUOUS_ON_ID,
17845           CONTINUOUS_ON_CONST, CONTINUOUS_ON_ADD, REAL_ADD_SUB] THEN
17846  REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]
17847QED
17848
17849Theorem HOMEOMORPHIC_TRANSLATION_LEFT_EQ:
17850   !a:real s t.
17851      (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t
17852Proof
17853  METIS_TAC[HOMEOMORPHIC_TRANSLATION_SELF,
17854            HOMEOMORPHIC_SYM, HOMEOMORPHIC_TRANS]
17855QED
17856
17857Theorem HOMEOMORPHIC_TRANSLATION_RIGHT_EQ:
17858   !a:real s t.
17859      s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t
17860Proof
17861  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
17862  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]
17863QED
17864
17865Theorem HOMEOMORPHISM_IMP_QUOTIENT_MAP:
17866   !f:real->real g s t.
17867    homeomorphism (s,t) (f,g)
17868    ==> !u. u SUBSET t
17869            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
17870                 open_in (subtopology euclidean t) u)
17871Proof
17872  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
17873  STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
17874  EXISTS_TAC ``g:real->real`` THEN ASM_REWRITE_TAC[SUBSET_REFL]
17875QED
17876
17877Theorem HOMEOMORPHIC_SCALING_LEFT:
17878   !c. &0 < c
17879       ==> (!s t. (IMAGE (\x. c * x) s) homeomorphic t <=> s homeomorphic t)
17880Proof
17881  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
17882  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN
17883  ASM_SIMP_TAC std_ss [REAL_EQ_LMUL, REAL_LT_IMP_NE, LINEAR_SCALING]
17884QED
17885
17886Theorem HOMEOMORPHIC_SCALING_RIGHT:
17887   !c. &0 < c
17888       ==> (!s t. s homeomorphic (IMAGE (\x. c * x) t) <=> s homeomorphic t)
17889Proof
17890  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
17891  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN
17892  ASM_SIMP_TAC std_ss [REAL_EQ_LMUL, REAL_LT_IMP_NE, LINEAR_SCALING]
17893QED
17894
17895Theorem HOMEOMORPHIC_FINITE:
17896   !s:real->bool t:real->bool.
17897        FINITE s /\ FINITE t ==> (s homeomorphic t <=> (CARD s = CARD t))
17898Proof
17899  REPEAT STRIP_TAC THEN EQ_TAC THENL
17900   [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
17901    ASM_SIMP_TAC std_ss [CARD_EQ_CARD],
17902    STRIP_TAC THEN REWRITE_TAC[homeomorphic, HOMEOMORPHISM] THEN
17903    MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``]
17904        CARD_EQ_BIJECTIONS) THEN
17905    ASM_REWRITE_TAC[] THEN
17906    DISCH_THEN (X_CHOOSE_TAC ``f:real->real``) THEN POP_ASSUM MP_TAC THEN
17907    DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN
17908    MAP_EVERY EXISTS_TAC [``f:real->real``,``g:real->real``] THEN
17909    POP_ASSUM MP_TAC THEN
17910    ASM_SIMP_TAC std_ss [CONTINUOUS_ON_FINITE] THEN ASM_SET_TAC[]]
17911QED
17912
17913Theorem HOMEOMORPHIC_FINITE_STRONG:
17914   !s:real->bool t:real->bool.
17915        FINITE s \/ FINITE t
17916        ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ (CARD s = CARD t))
17917Proof
17918  REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN
17919  SIMP_TAC std_ss [HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN
17920  FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP
17921    HOMEOMORPHIC_IMP_CARD_EQ) THEN
17922  FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
17923  ASM_MESON_TAC[HOMEOMORPHIC_FINITE]
17924QED
17925
17926Theorem HOMEOMORPHIC_SING:
17927   !a:real b:real. {a} homeomorphic {b}
17928Proof
17929  SIMP_TAC std_ss [HOMEOMORPHIC_FINITE, FINITE_SING, CARD_SING]
17930QED
17931
17932Theorem LIFT_TO_QUOTIENT_SPACE_UNIQUE:
17933   !f:real->real g:real->real s t u.
17934        (IMAGE f s = t) /\
17935        (IMAGE g s = u) /\
17936        (!v. v SUBSET t
17937             ==> (open_in (subtopology euclidean s)
17938                  {x | x IN s /\ f x IN v} <=>
17939                  open_in (subtopology euclidean t) v)) /\
17940         (!v. v SUBSET u
17941             ==> (open_in (subtopology euclidean s)
17942                  {x | x IN s /\ g x IN v} <=>
17943                  open_in (subtopology euclidean u) v)) /\
17944        (!x y. x IN s /\ y IN s ==> ((f x = f y) <=> (g x = g y)))
17945        ==> t homeomorphic u
17946Proof
17947  REPEAT STRIP_TAC THEN
17948  MP_TAC(ISPECL
17949   [``f:real->real``, ``g:real->real``, ``s:real->bool``,
17950    ``t:real->bool``, ``u:real->bool``] LIFT_TO_QUOTIENT_SPACE) THEN
17951  MP_TAC(ISPECL
17952   [``g:real->real``, ``f:real->real``, ``s:real->bool``,
17953    ``u:real->bool``, ``t:real->bool``] LIFT_TO_QUOTIENT_SPACE) THEN
17954  ASM_REWRITE_TAC[] THEN
17955  MP_TAC(ISPECL [``f:real->real``, ``s:real->bool``, ``t:real->bool``]
17956        CONTINUOUS_ON_OPEN_GEN) THEN
17957  ASM_SIMP_TAC std_ss [SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN
17958  KNOW_TAC ``(!(u :real -> bool).
17959    open_in (subtopology euclidean (t :real -> bool)) u ==>
17960    open_in (subtopology euclidean (s :real -> bool))
17961      {x | x IN s /\ (f :real -> real) x IN u})`` THENL
17962   [METIS_TAC[OPEN_IN_IMP_SUBSET],
17963    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
17964    DISCH_THEN(X_CHOOSE_THEN ``h:real->real`` STRIP_ASSUME_TAC)] THEN
17965  MP_TAC(ISPECL [``g:real->real``, ``s:real->bool``, ``u:real->bool``]
17966        CONTINUOUS_ON_OPEN_GEN) THEN
17967  ASM_SIMP_TAC std_ss [SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN
17968  KNOW_TAC ``(!(u' :real -> bool).
17969    open_in (subtopology euclidean (u :real -> bool)) u' ==>
17970    open_in (subtopology euclidean (s :real -> bool))
17971      {x | x IN s /\ (g :real -> real) x IN u'}) /\
17972 (!(x :real) (y :real).
17973    x IN s /\ y IN s /\ ((f :real -> real) x = f y) ==> (g x = g y))`` THENL
17974   [METIS_TAC[OPEN_IN_IMP_SUBSET],
17975    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
17976    DISCH_THEN(X_CHOOSE_THEN ``k:real->real`` STRIP_ASSUME_TAC)] THEN
17977  REWRITE_TAC[homeomorphic, homeomorphism] THEN
17978  MAP_EVERY EXISTS_TAC
17979   [``k:real->real``, ``h:real->real``] THEN
17980  ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]
17981QED
17982
17983(* ------------------------------------------------------------------------- *)
17984(* Inverse function property for open/closed maps.                           *)
17985(* ------------------------------------------------------------------------- *)
17986
17987Theorem CONTINUOUS_ON_INVERSE_OPEN_MAP:
17988   !f:real->real g s t.
17989        f continuous_on s /\ (IMAGE f s = t) /\ (!x. x IN s ==> (g(f x) = x)) /\
17990        (!u. open_in (subtopology euclidean s) u
17991             ==> open_in (subtopology euclidean t) (IMAGE f u))
17992        ==> g continuous_on t
17993Proof
17994  REPEAT STRIP_TAC THEN
17995  MP_TAC(ISPECL [``g:real->real``, ``t:real->bool``, ``s:real->bool``]
17996        CONTINUOUS_ON_OPEN_GEN) THEN
17997  KNOW_TAC ``IMAGE (g :real -> real) (t :real -> bool) SUBSET (s :real -> bool)`` THENL
17998  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
17999   DISCH_THEN SUBST1_TAC] THEN
18000  X_GEN_TAC ``u:real->bool`` THEN DISCH_TAC THEN
18001  FIRST_X_ASSUM(MP_TAC o SPEC ``u:real->bool``) THEN ASM_REWRITE_TAC[] THEN
18002  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN
18003  FIRST_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE [open_in]) THEN
18004  ASM_SET_TAC[]
18005QED
18006
18007Theorem CONTINUOUS_ON_INVERSE_CLOSED_MAP:
18008   !f:real->real g s t.
18009        f continuous_on s /\ (IMAGE f s = t) /\ (!x. x IN s ==> (g(f x) = x)) /\
18010        (!u. closed_in (subtopology euclidean s) u
18011             ==> closed_in (subtopology euclidean t) (IMAGE f u))
18012        ==> g continuous_on t
18013Proof
18014  REPEAT STRIP_TAC THEN
18015  MP_TAC(ISPECL [``g:real->real``, ``t:real->bool``, ``s:real->bool``]
18016        CONTINUOUS_ON_CLOSED_GEN) THEN
18017  KNOW_TAC ``IMAGE (g :real -> real) (t :real -> bool) SUBSET (s :real -> bool)`` THENL
18018  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
18019   DISCH_THEN SUBST1_TAC] THEN
18020  X_GEN_TAC ``u:real->bool`` THEN DISCH_TAC THEN
18021  FIRST_X_ASSUM(MP_TAC o SPEC ``u:real->bool``) THEN ASM_REWRITE_TAC[] THEN
18022  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN
18023  FIRST_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE [closed_in]) THEN
18024  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_SET_TAC[]
18025QED
18026
18027Theorem HOMEOMORPHISM_INJECTIVE_OPEN_MAP:
18028   !f:real->real s t.
18029        f continuous_on s /\ (IMAGE f s = t) /\
18030        (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\
18031        (!u. open_in (subtopology euclidean s) u
18032             ==> open_in (subtopology euclidean t) (IMAGE f u))
18033        ==> ?g. homeomorphism (s,t) (f,g)
18034Proof
18035  REPEAT STRIP_TAC THEN
18036  UNDISCH_TAC ``!(x :real) (y :real).
18037        x IN (s :real -> bool) /\ y IN s /\
18038        ((f :real -> real) x = f y) ==>
18039        (x = y)`` THEN DISCH_TAC THEN
18040  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [INJECTIVE_ON_LEFT_INVERSE]) THEN
18041  DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN EXISTS_TAC ``g:real->real`` THEN
18042  ASM_SIMP_TAC std_ss [homeomorphism] THEN
18043  REPEAT(CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC]) THEN
18044  MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]
18045QED
18046
18047Theorem HOMEOMORPHISM_INJECTIVE_CLOSED_MAP:
18048   !f:real->real s t.
18049        f continuous_on s /\ (IMAGE f s = t) /\
18050        (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\
18051        (!u. closed_in (subtopology euclidean s) u
18052             ==> closed_in (subtopology euclidean t) (IMAGE f u))
18053        ==> ?g. homeomorphism (s,t) (f,g)
18054Proof
18055  REPEAT STRIP_TAC THEN
18056  UNDISCH_TAC ``!(x :real) (y :real).
18057        x IN (s :real -> bool) /\ y IN s /\
18058        ((f :real -> real) x = f y) ==>
18059        (x = y)`` THEN DISCH_TAC THEN
18060  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [INJECTIVE_ON_LEFT_INVERSE]) THEN
18061  DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN EXISTS_TAC ``g:real->real`` THEN
18062  ASM_SIMP_TAC std_ss [homeomorphism] THEN
18063  REPEAT(CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC]) THEN
18064  MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]
18065QED
18066
18067Theorem HOMEOMORPHISM_IMP_OPEN_MAP:
18068   !f:real->real g s t u.
18069        homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u
18070        ==> open_in (subtopology euclidean t) (IMAGE f u)
18071Proof
18072  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
18073  SUBGOAL_THEN ``IMAGE (f:real->real) u =
18074                 {y | y IN t /\ g(y) IN u}``
18075  SUBST1_TAC THENL
18076   [FIRST_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE [open_in]) THEN
18077    ASM_SET_TAC[],
18078    MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]
18079QED
18080
18081Theorem HOMEOMORPHISM_IMP_CLOSED_MAP:
18082   !f:real->real g s t u.
18083        homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u
18084        ==> closed_in (subtopology euclidean t) (IMAGE f u)
18085Proof
18086  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
18087  SUBGOAL_THEN ``IMAGE (f:real->real) u =
18088                  {y | y IN t /\ g(y) IN u}``
18089  SUBST1_TAC THENL
18090   [FIRST_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE [closed_in]) THEN
18091    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_SET_TAC[],
18092    MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]
18093QED
18094
18095Theorem HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ:
18096   !f:real->real s t.
18097        f continuous_on s /\ (IMAGE f s = t) /\
18098        (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
18099        ==> ((?g. homeomorphism (s,t) (f,g)) <=>
18100             !u. open_in (subtopology euclidean s) u
18101                 ==> open_in (subtopology euclidean t) (IMAGE f u))
18102Proof
18103  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
18104   [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[],
18105    MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
18106    ASM_REWRITE_TAC[]]
18107QED
18108
18109Theorem HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ:
18110   !f:real->real s t.
18111        f continuous_on s /\ (IMAGE f s = t) /\
18112        (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
18113        ==> ((?g. homeomorphism (s,t) (f,g)) <=>
18114             !u. closed_in (subtopology euclidean s) u
18115                 ==> closed_in (subtopology euclidean t) (IMAGE f u))
18116Proof
18117  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
18118   [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[],
18119    MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN
18120    ASM_REWRITE_TAC[]]
18121QED
18122
18123Theorem INJECTIVE_MAP_OPEN_IFF_CLOSED:
18124   !f:real->real s t.
18125        f continuous_on s /\ (IMAGE f s = t) /\
18126        (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
18127        ==> ((!u. open_in (subtopology euclidean s) u
18128                  ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
18129             (!u. closed_in (subtopology euclidean s) u
18130                  ==> closed_in (subtopology euclidean t) (IMAGE f u)))
18131Proof
18132  REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
18133  EXISTS_TAC ``?g:real->real. homeomorphism (s,t) (f,g)`` THEN
18134  CONJ_TAC THENL
18135   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ,
18136    MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN
18137  ASM_REWRITE_TAC[]
18138QED
18139
18140(* ------------------------------------------------------------------------- *)
18141(* Relatively weak hypotheses if the domain of the function is compact.      *)
18142(* ------------------------------------------------------------------------- *)
18143
18144Theorem CONTINUOUS_IMP_CLOSED_MAP:
18145   !f:real->real s t.
18146        f continuous_on s /\ (IMAGE f s = t) /\ compact s
18147        ==> !u. closed_in (subtopology euclidean s) u
18148                ==> closed_in (subtopology euclidean t) (IMAGE f u)
18149Proof
18150  SIMP_TAC std_ss [CLOSED_IN_CLOSED_EQ, COMPACT_IMP_CLOSED] THEN
18151  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN
18152  ASM_SIMP_TAC std_ss [IMAGE_SUBSET] THEN
18153  MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
18154  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
18155  ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED, CLOSED_IN_CLOSED_TRANS,
18156                BOUNDED_SUBSET, CONTINUOUS_ON_SUBSET]
18157QED
18158
18159Theorem CONTINUOUS_IMP_QUOTIENT_MAP:
18160   !f:real->real s t.
18161        f continuous_on s /\ (IMAGE f s = t) /\ compact s
18162        ==> !u. u SUBSET t
18163                ==> (open_in (subtopology euclidean s)
18164                             {x | x IN s /\ f x IN u} <=>
18165                     open_in (subtopology euclidean t) u)
18166Proof
18167  REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
18168  MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
18169  ASM_REWRITE_TAC[] THEN
18170  MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP THEN
18171  ASM_REWRITE_TAC[]
18172QED
18173
18174Theorem CONTINUOUS_ON_INVERSE:
18175   !f:real->real g s.
18176        f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x))
18177        ==> g continuous_on (IMAGE f s)
18178Proof
18179  REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN
18180  SUBGOAL_THEN ``IMAGE g (IMAGE (f:real->real) s) = s`` SUBST1_TAC THENL
18181   [REWRITE_TAC[EXTENSION, IN_IMAGE] THEN ASM_MESON_TAC[], ALL_TAC] THEN
18182  X_GEN_TAC ``t:real->bool`` THEN DISCH_TAC THEN
18183  REWRITE_TAC[CLOSED_IN_CLOSED] THEN
18184  EXISTS_TAC ``IMAGE (f:real->real) t`` THEN CONJ_TAC THENL
18185   [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
18186    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
18187    FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN
18188    REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
18189    ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED, CLOSED_IN_CLOSED_TRANS,
18190                  BOUNDED_SUBSET, CONTINUOUS_ON_SUBSET],
18191    SIMP_TAC std_ss [EXTENSION, IN_INTER, GSPECIFICATION, IN_IMAGE] THEN
18192    ASM_MESON_TAC[CLOSED_IN_SUBSET, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY, SUBSET_DEF]]
18193QED
18194
18195Theorem HOMEOMORPHISM_COMPACT:
18196   !s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\
18197           (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
18198           ==> ?g. homeomorphism(s,t) (f,g)
18199Proof
18200  REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN
18201  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
18202  DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN EXISTS_TAC ``g:real->real`` THEN
18203  ASM_SIMP_TAC std_ss [EXTENSION, homeomorphism] THEN
18204  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
18205  ASM_MESON_TAC[CONTINUOUS_ON_INVERSE, IN_IMAGE]
18206QED
18207
18208Theorem HOMEOMORPHIC_COMPACT:
18209   !s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\
18210           (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
18211           ==> s homeomorphic t
18212Proof
18213  REWRITE_TAC[homeomorphic] THEN METIS_TAC[HOMEOMORPHISM_COMPACT]
18214QED
18215
18216(* ------------------------------------------------------------------------- *)
18217(* Lemmas about composition of homeomorphisms.                               *)
18218(* ------------------------------------------------------------------------- *)
18219
18220Theorem HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE:
18221   !f:real->real g:real->real s t u.
18222        f continuous_on s /\ (IMAGE f s = t) /\
18223        g continuous_on t /\ IMAGE g t SUBSET u /\
18224        (?h. homeomorphism (s,u) (g o f,h))
18225        ==> (?f'. homeomorphism (s,t) (f,f')) /\
18226            (?g'. homeomorphism (t,u) (g,g'))
18227Proof
18228  REPEAT GEN_TAC THEN STRIP_TAC THEN
18229  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism, o_THM]) THEN
18230  MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
18231   [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
18232    REPEAT(CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC]) THEN
18233    MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN
18234    MAP_EVERY EXISTS_TAC [``f:real->real``, ``s:real->bool``] THEN
18235    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
18236    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
18237    MAP_EVERY EXISTS_TAC [``h:real->real``, ``s:real->bool``] THEN
18238    ASM_SIMP_TAC std_ss [homeomorphism, o_THM],
18239    REWRITE_TAC[homeomorphism, o_THM] THEN
18240    DISCH_THEN(X_CHOOSE_THEN ``g':real->real`` STRIP_ASSUME_TAC) THEN
18241    EXISTS_TAC ``((h:real->real) o (g:real->real))`` THEN
18242    ASM_SIMP_TAC std_ss [o_THM, IMAGE_COMPOSE] THEN
18243    CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
18244    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18245    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]
18246QED
18247
18248Theorem HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE:
18249   !f:real->real g:real->real s t u.
18250        f continuous_on s /\ IMAGE f s SUBSET t /\
18251        g continuous_on t /\ IMAGE g t SUBSET u /\
18252        (!x y. x IN t /\ y IN t /\ (g x = g y) ==> (x = y)) /\
18253        (?h. homeomorphism (s,u) (g o f,h))
18254        ==> (?f'. homeomorphism (s,t) (f,f')) /\
18255            (?g'. homeomorphism (t,u) (g,g'))
18256Proof
18257  REPEAT GEN_TAC THEN STRIP_TAC THEN
18258  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism, o_THM]) THEN
18259  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
18260   [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
18261    REPEAT(CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC]) THEN
18262    MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN
18263    MAP_EVERY EXISTS_TAC [``g:real->real``, ``u:real->bool``] THEN
18264    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
18265    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
18266    MAP_EVERY EXISTS_TAC [``h:real->real``, ``s:real->bool``] THEN
18267    ASM_REWRITE_TAC[homeomorphism, o_THM],
18268    REWRITE_TAC[homeomorphism, o_THM] THEN
18269    DISCH_THEN(X_CHOOSE_THEN ``f':real->real`` STRIP_ASSUME_TAC) THEN
18270    EXISTS_TAC ``(f:real->real) o (h:real->real)`` THEN
18271    ASM_SIMP_TAC std_ss [o_THM, IMAGE_COMPOSE] THEN
18272    REPEAT(CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC]) THEN
18273    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18274    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]
18275QED
18276
18277(* ------------------------------------------------------------------------- *)
18278(* Preservation of topological properties.                                   *)
18279(* ------------------------------------------------------------------------- *)
18280
18281Theorem HOMEOMORPHIC_COMPACTNESS:
18282   !s t. s homeomorphic t ==> (compact s <=> compact t)
18283Proof
18284  REWRITE_TAC[homeomorphic, homeomorphism] THEN
18285  MESON_TAC[COMPACT_CONTINUOUS_IMAGE]
18286QED
18287
18288Theorem HOMEOMORPHIC_CONNECTEDNESS:
18289   !s t. s homeomorphic t ==> (connected s <=> connected t)
18290Proof
18291  REWRITE_TAC[homeomorphic, homeomorphism] THEN
18292  MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]
18293QED
18294
18295(* ------------------------------------------------------------------------- *)
18296(* Results on translation, scaling etc.                                      *)
18297(* ------------------------------------------------------------------------- *)
18298
18299Theorem HOMEOMORPHIC_SCALING:
18300   !s:real->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c * x) s)
18301Proof
18302  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
18303  MAP_EVERY EXISTS_TAC [``\x:real. c * x``, ``\x:real. inv(c) * x``] THEN
18304  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_CMUL, CONTINUOUS_ON_ID, FORALL_IN_IMAGE] THEN
18305  ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_RINV] THEN
18306  SIMP_TAC std_ss [REAL_MUL_LID, IN_IMAGE, REAL_MUL_LID] THEN MESON_TAC[]
18307QED
18308
18309Theorem HOMEOMORPHIC_TRANSLATION:
18310   !s a:real. s homeomorphic (IMAGE (\x. a + x) s)
18311Proof
18312  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
18313  MAP_EVERY EXISTS_TAC [``\x:real. a +  x``, ``\x:real. -a + x``] THEN
18314  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_ADD, CONTINUOUS_ON_CONST, CONTINUOUS_ON_ID] THEN
18315  SIMP_TAC std_ss [REAL_ADD_ASSOC, REAL_ADD_LINV, REAL_ADD_RINV,
18316           FORALL_IN_IMAGE, REAL_ADD_LID] THEN
18317  REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]
18318QED
18319
18320Theorem HOMEOMORPHIC_AFFINITY:
18321   !s a:real c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. a + c * x) s)
18322Proof
18323  REPEAT STRIP_TAC THEN
18324  MATCH_MP_TAC HOMEOMORPHIC_TRANS THEN
18325  EXISTS_TAC ``IMAGE (\x:real. c * x) s`` THEN
18326  ASM_SIMP_TAC std_ss [HOMEOMORPHIC_SCALING] THEN
18327  SUBGOAL_THEN ``(\x:real. a + c * x) = (\x. a + x) o (\x. c * x)``
18328  SUBST1_TAC THENL [REWRITE_TAC[o_DEF], ALL_TAC] THEN
18329  SIMP_TAC std_ss [IMAGE_COMPOSE, HOMEOMORPHIC_TRANSLATION]
18330QED
18331
18332Theorem HOMEOMORPHIC_BALLS_CBALL_SPHERE:
18333   (!a:real b:real d e.
18334      &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\
18335   (!a:real b:real d e.
18336      &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\
18337   (!a:real b:real d e.
18338      &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))
18339Proof
18340  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
18341  EXISTS_TAC ``\x:real. b + (e / d) * (x - a)`` THEN
18342  EXISTS_TAC ``\x:real. a + (d / e) * (x - b)`` THEN
18343  ASM_SIMP_TAC std_ss [CONTINUOUS_ON_ADD, CONTINUOUS_ON_SUB, CONTINUOUS_ON_CMUL,
18344    CONTINUOUS_ON_CONST, CONTINUOUS_ON_ID, IN_BALL, IN_CBALL, IN_SPHERE] THEN
18345  REWRITE_TAC[dist, REAL_ARITH ``a - (a + b) = -b:real``, ABS_NEG] THEN
18346  REWRITE_TAC[real_div, REAL_ARITH
18347   ``a + d * ((b + e * (x - a)) - b) = (&1 - d * e) * a + (d * e) * x:real``] THEN
18348  ONCE_REWRITE_TAC[REAL_ARITH
18349    ``(e * d') * (d * e') = (d * d') * (e * e':real)``] THEN
18350  ASM_SIMP_TAC std_ss [REAL_MUL_RINV, REAL_LT_IMP_NE, REAL_MUL_LID, REAL_SUB_REFL] THEN
18351  REWRITE_TAC[ABS_MUL, REAL_MUL_LZERO, REAL_MUL_LID, REAL_ADD_LID] THEN
18352  ASM_SIMP_TAC std_ss [ABS_MUL, ABS_INV, REAL_ARITH
18353   ``&0 < x ==> (abs x = x:real)``, REAL_LT_IMP_NE] THEN
18354  GEN_REWR_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV)
18355        [GSYM REAL_MUL_RID] THEN
18356  ONCE_REWRITE_TAC[REAL_ARITH ``(a * b) * c = (a * c) * b:real``] THEN
18357  ASM_SIMP_TAC std_ss [REAL_LE_LMUL, GSYM real_div, REAL_LE_LDIV_EQ, REAL_MUL_LID,
18358    GSYM REAL_MUL_ASSOC, REAL_LT_LMUL, REAL_LT_LDIV_EQ, ABS_SUB] THEN
18359  ASM_SIMP_TAC std_ss [REAL_DIV_REFL, REAL_LT_IMP_NE, REAL_MUL_RID]
18360QED
18361
18362Theorem HOMEOMORPHIC_BALLS:
18363   (!a:real b:real d e.
18364      &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e))
18365Proof
18366 REWRITE_TAC [HOMEOMORPHIC_BALLS_CBALL_SPHERE]
18367QED
18368
18369Theorem HOMEOMORPHIC_CBALL:
18370   (!a:real b:real d e.
18371      &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e))
18372Proof
18373 REWRITE_TAC [HOMEOMORPHIC_BALLS_CBALL_SPHERE]
18374QED
18375
18376Theorem HOMEOMORPHIC_SPHERE:
18377   (!a:real b:real d e.
18378      &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))
18379Proof
18380 REWRITE_TAC [HOMEOMORPHIC_BALLS_CBALL_SPHERE]
18381QED
18382
18383(* ------------------------------------------------------------------------- *)
18384(* Homeomorphism of one-point compactifications.                             *)
18385(* ------------------------------------------------------------------------- *)
18386
18387Theorem HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS:
18388   !s:real->bool t:real->bool a b.
18389        compact s /\ compact t /\ a IN s /\ b IN t /\
18390        (s DELETE a) homeomorphic (t DELETE b)
18391        ==> s homeomorphic t
18392Proof
18393  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
18394  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [homeomorphic]) THEN
18395  SIMP_TAC std_ss [HOMEOMORPHISM, LEFT_IMP_EXISTS_THM] THEN
18396  MAP_EVERY X_GEN_TAC [``f:real->real``, ``g:real->real``] THEN
18397  STRIP_TAC THEN
18398  EXISTS_TAC ``\x. if x = a then b else (f:real->real) x`` THEN
18399  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
18400  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
18401  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
18402  ASM_CASES_TAC ``x:real = a`` THEN ASM_REWRITE_TAC[] THENL
18403   [REWRITE_TAC[continuous_within] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
18404    MP_TAC(ISPECL [``b:real``, ``e:real``] CENTRE_IN_BALL) THEN
18405    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
18406    SUBGOAL_THEN
18407      ``closed_in (subtopology euclidean s)
18408                 { x | x IN (s DELETE a) /\
18409                       (f:real->real)(x) IN t DIFF ball(b,e)}``
18410    MP_TAC THENL
18411     [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
18412      MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN
18413       ``{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} =
18414        IMAGE (g:real->real) (t DIFF ball (b,e))``
18415      SUBST1_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
18416      MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
18417      ASM_SIMP_TAC std_ss [COMPACT_DIFF, OPEN_BALL] THEN
18418      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
18419        CONTINUOUS_ON_SUBSET)) THEN ASM_SET_TAC[],
18420      REWRITE_TAC[closed_in, open_in, TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
18421      DISCH_THEN(MP_TAC o SPEC ``a:real`` o last o CONJUNCTS) THEN
18422      ASM_SIMP_TAC std_ss [GSPECIFICATION, IN_DIFF, IN_DELETE] THEN
18423      SIMP_TAC std_ss [CONJ_EQ_IMP, DE_MORGAN_THM] THEN
18424      STRIP_TAC THEN EXISTS_TAC ``e':real`` THEN
18425      ASM_REWRITE_TAC[] THEN GEN_TAC THEN COND_CASES_TAC THEN
18426      ASM_REWRITE_TAC[DIST_REFL] THEN
18427      GEN_REWR_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [DIST_SYM] THEN
18428      RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM_SET_TAC[]],
18429    UNDISCH_TAC ``(f:real->real) continuous_on (s DELETE a)`` THEN
18430    SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
18431    DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[IN_DELETE] THEN
18432    REWRITE_TAC[continuous_within] THEN
18433    DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN
18434    ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
18435    DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
18436    EXISTS_TAC ``min d (dist(a:real,x))`` THEN
18437    ASM_SIMP_TAC std_ss [REAL_LT_MIN, GSYM DIST_NZ] THEN
18438    METIS_TAC[REAL_LT_REFL]]
18439QED
18440
18441(* ------------------------------------------------------------------------- *)
18442(* Homeomorphisms between open intervals in real and then in real.       *)
18443(* Could prove similar things for closed intervals, but they drop out of     *)
18444(* later stuff in "convex.ml" even more easily.                              *)
18445(* ------------------------------------------------------------------------- *)
18446
18447Theorem HOMEOMORPHIC_OPEN_INTERVALS:
18448   !a b c d.
18449        a < b /\ c < d
18450        ==> interval(a,b) homeomorphic interval(c,d)
18451Proof
18452  SUBGOAL_THEN
18453   ``!a b. a < b
18454          ==> interval(0:real,1) homeomorphic interval(a,b)``
18455  ASSUME_TAC THENL
18456   [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
18457    EXISTS_TAC ``(\x. a + x * (b - a)):real->real`` THEN
18458    EXISTS_TAC ``(\x. inv(b - a) * (x - a)):real->real`` THEN
18459    ASM_SIMP_TAC std_ss [IN_INTERVAL] THEN
18460    REWRITE_TAC[METIS [REAL_MUL_SYM, GSYM real_div] ``inv b * a:real = a / b``] THEN
18461    ASM_SIMP_TAC std_ss [REAL_LT_LDIV_EQ, REAL_LT_RDIV_EQ, REAL_SUB_LT,
18462       REAL_LT_ADDR, REAL_EQ_LDIV_EQ, REAL_DIV_RMUL, REAL_LT_IMP_NE,
18463       REAL_LT_MUL, REAL_MUL_LZERO, REAL_ADD_SUB, REAL_LT_RMUL,
18464       REAL_ARITH ``a + x < b <=> x < &1 * (b - a:real)``] THEN
18465    REPEAT CONJ_TAC THENL
18466     [REAL_ARITH_TAC,
18467      ONCE_REWRITE_TAC [METIS [] ``(\x. a + x * (b - a)) =
18468                      (\x. (\x. a) x + (\x. x * (b - a)) x:real)``] THEN
18469      MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
18470      ONCE_REWRITE_TAC [METIS [] ``(\x. x * (b - a)) =
18471                      (\x. (\x. x) x * (\x. (b - a)) x:real)``] THEN
18472      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
18473      REWRITE_TAC[o_DEF, CONTINUOUS_ON_ID, CONTINUOUS_ON_CONST],
18474      ONCE_REWRITE_TAC [METIS [real_div, REAL_MUL_SYM] ``(\x. (x - a) / (b - a))  =
18475                                       (\x. inv(b - a) * (\x. (x - a)) x:real)``] THEN
18476      MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
18477      ASM_SIMP_TAC std_ss [CONTINUOUS_ON_SUB, CONTINUOUS_ON_CONST, CONTINUOUS_ON_ID]],
18478    REPEAT STRIP_TAC THEN
18479    FIRST_ASSUM(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
18480    FIRST_X_ASSUM(MP_TAC o SPECL [``c:real``, ``d:real``]) THEN
18481    ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
18482    GEN_REWR_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN
18483    REWRITE_TAC[HOMEOMORPHIC_TRANS]]
18484QED
18485
18486Theorem HOMEOMORPHIC_OPEN_INTERVAL_UNIV:
18487   !a b. a < b ==> interval(a,b) homeomorphic univ(:real)
18488Proof
18489  REPEAT STRIP_TAC THEN
18490  MP_TAC(SPECL [``a:real``, ``b:real``, ``-1:real``, ``1:real``]
18491        HOMEOMORPHIC_OPEN_INTERVALS) THEN
18492  ASM_REWRITE_TAC[] THEN REWRITE_TAC [REAL_ARITH ``-1 < 1:real``] THEN
18493  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN
18494  POP_ASSUM_LIST(K ALL_TAC) THEN
18495  REWRITE_TAC[HOMEOMORPHIC_MINIMAL, IN_UNIV] THEN
18496  EXISTS_TAC ``\x:real. inv(&1 - abs x) * x`` THEN
18497  EXISTS_TAC ``\y:real. if &0 <= y then inv(&1 + y) * y
18498                  else inv(&1 - y) * y`` THEN
18499  SIMP_TAC std_ss [] THEN REPEAT CONJ_TAC THENL
18500   [X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_INTERVAL] THEN
18501    SIMP_TAC std_ss [REAL_LE_MUL, REAL_LT_INV_EQ, REAL_LE_MUL, REAL_ARITH
18502     ``-a < x /\ x < a ==> &0 < a - abs x:real``] THEN
18503    SIMP_TAC std_ss [abs, REAL_MUL_ASSOC] THEN
18504    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
18505    GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
18506    AP_THM_TAC THEN AP_TERM_TAC THEN COND_CASES_TAC THEN
18507    (Cases_on `x = 0:real` THENL
18508     [ASM_REWRITE_TAC [REAL_INV1, REAL_NEG_0, REAL_SUB_RZERO,
18509      REAL_ADD_RID, REAL_MUL_RZERO] THEN REAL_ARITH_TAC, ALL_TAC]) THEN
18510     (KNOW_TAC ``!y. y <> 0:real ==> ((1 + inv y * x) = (y + x) / y:real) /\
18511                                     ((1 - inv y * x) = (y - x) / y:real)`` THENL
18512     [ASM_SIMP_TAC real_ss [real_div, REAL_ADD_RDISTRIB, REAL_MUL_RINV, REAL_SUB_RDISTRIB] THEN
18513      REAL_ARITH_TAC, STRIP_TAC] THEN
18514     KNOW_TAC ``(1 - x) <> 0 /\ (1 - -x) <> 0:real`` THENL
18515     [METIS_TAC [REAL_ARITH ``x < 1 ==> 1 - x <> 0:real``,
18516                 REAL_ARITH ``-1 < x ==> 1 - -x <> 0:real``],
18517      STRIP_TAC] THEN ASM_SIMP_TAC real_ss []) THENL
18518     [METIS_TAC [REAL_INV_1OVER, REAL_MUL_RINV, REAL_INV_INV],
18519      FULL_SIMP_TAC real_ss [REAL_LT_IMP_LE] THEN
18520      RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_MUL_SYM]) THEN
18521      FULL_SIMP_TAC real_ss [GSYM real_div, REAL_LE_RDIV_EQ,
18522       REAL_ARITH ``(-1 < x) = (0 < 1 + x:real)``],
18523      FULL_SIMP_TAC real_ss [REAL_LT_IMP_LE, REAL_NOT_LE] THEN
18524      RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_MUL_SYM]) THEN
18525      FULL_SIMP_TAC real_ss [GSYM real_div, REAL_LT_LDIV_EQ,
18526       REAL_ARITH ``(x < 1) = (0 < 1 - x:real)``] THEN
18527      METIS_TAC [REAL_ARITH ``~(x < 0 /\ 0 <= x:real)``],
18528      FULL_SIMP_TAC real_ss [] THEN
18529      METIS_TAC [REAL_INV_1OVER, REAL_MUL_RINV, REAL_INV_INV]],
18530    X_GEN_TAC ``y:real`` THEN COND_CASES_TAC THEN
18531    ASM_SIMP_TAC real_ss [IN_INTERVAL, REAL_BOUNDS_LT] THEN
18532    ASM_SIMP_TAC real_ss [ABS_MUL, ABS_INV, REAL_ARITH
18533     ``(0 <= y ==> 1 + y <> 0:real) /\ (~(0 <= y) ==> 1 - y <> 0:real)``] THEN
18534    REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN
18535    ASM_SIMP_TAC real_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``&0 <= x ==> &0 < abs(&1 + x:real)``,
18536                 REAL_ARITH ``~(&0 <= x) ==> &0 < abs(&1 - x:real)``] THEN
18537    (CONJ_TAC THENL [ASM_REAL_ARITH_TAC, ALL_TAC]) THEN
18538    REWRITE_TAC [real_div] THEN
18539    ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c = c * b * a:real``] THEN
18540    REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[ABS_MUL] THEN
18541    ASM_REWRITE_TAC[abs,  REAL_LE_INV_EQ] THEN
18542    ASM_SIMP_TAC real_ss [REAL_ARITH ``&0 <= x ==> &0 <= &1 + x:real``,
18543                 REAL_ARITH ``~(&0 <= x) ==> &0 <= &1 - x:real``] THEN
18544    GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
18545    AP_THM_TAC THEN AP_TERM_TAC THEN
18546    (KNOW_TAC ``!x. x <> 0:real ==> ((1 + y * inv x) = (x + y) / x:real) /\
18547                                   ((1 - y * inv x) = (x - y) / x:real)`` THENL
18548     [ASM_SIMP_TAC real_ss [real_div, REAL_ADD_RDISTRIB, REAL_MUL_RINV, REAL_SUB_RDISTRIB],
18549      STRIP_TAC]) THENL
18550     [KNOW_TAC ``(1 + y) <> 0:real`` THENL
18551      [METIS_TAC [REAL_ARITH ``(0 <= x) ==> 1 + x <> 0:real``],
18552       STRIP_TAC] THEN ASM_SIMP_TAC real_ss [],
18553      KNOW_TAC ``(1 - y) <> 0:real`` THENL
18554      [METIS_TAC [REAL_ARITH ``~(0 <= x) ==> 1 - x <> 0:real``],
18555       STRIP_TAC] THEN ASM_SIMP_TAC real_ss []] THEN
18556     METIS_TAC [REAL_INV_1OVER, REAL_MUL_RINV, REAL_INV_INV],
18557    MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
18558    X_GEN_TAC ``x:real`` THEN
18559    REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN
18560    ONCE_REWRITE_TAC [METIS [] ``(\x. inv (1 - abs x) * x) =
18561                    (\x. (\x. inv (1 - abs x)) x * (\x. x) x:real)``] THEN
18562    MATCH_MP_TAC CONTINUOUS_MUL THEN
18563    REWRITE_TAC[CONTINUOUS_AT_ID] THEN
18564    ONCE_REWRITE_TAC [METIS [] ``(\x. inv (1 - abs x)) =
18565                             (\x. inv ((\x. 1 - abs x) x:real))``] THEN
18566    ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
18567    SIMP_TAC real_ss [NETLIMIT_AT, o_DEF] THEN
18568    CONJ_TAC THENL
18569     [ONCE_REWRITE_TAC [METIS []
18570      ``(\x. 1 - abs x) = (\x. (\x. 1) x - (\x. abs x) x:real)``] THEN
18571      MATCH_MP_TAC CONTINUOUS_SUB THEN
18572      SIMP_TAC std_ss [CONTINUOUS_CONST] THEN
18573      ONCE_REWRITE_TAC [METIS [] ``(\x. abs x) = (\x. abs ((\x. x) x:real))``] THEN
18574      METIS_TAC [REWRITE_RULE[o_DEF] CONTINUOUS_AT_ABS], ASM_REAL_ARITH_TAC],
18575    SUBGOAL_THEN ``univ(:real) = {x | x >= &0} UNION {x | x <= &0}``
18576    SUBST1_TAC THENL
18577     [SIMP_TAC std_ss [EXTENSION, IN_UNION, IN_UNION, GSPECIFICATION, IN_UNIV] THEN
18578      REAL_ARITH_TAC,
18579      ONCE_REWRITE_TAC [METIS []
18580      ``(\y. if 0 <= y then inv (1 + y) * y else inv (1 - y) * y) =
18581        (\y. if (\y. 0 <= y) y then (\y. inv (1 + y) * y) y
18582                               else (\y. inv (1 - y) * y) y:real)``] THEN
18583      MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
18584      SIMP_TAC std_ss [CLOSED_HALFSPACE_COMPONENT_LE, CLOSED_HALFSPACE_COMPONENT_GE,
18585                  GSPECIFICATION] THEN
18586      REWRITE_TAC[REAL_NOT_LE, real_ge, REAL_LET_ANTISYM] THEN
18587      SIMP_TAC std_ss [REAL_LE_ANTISYM, REAL_SUB_RZERO, REAL_ADD_RID] THEN
18588      CONJ_TAC THENL
18589      [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
18590       X_GEN_TAC ``y:real`` THEN SIMP_TAC std_ss [GSPECIFICATION, real_ge] THEN
18591       DISCH_TAC THEN ONCE_REWRITE_TAC [METIS [] ``(\y. inv (1 + y) * y) =
18592                                      (\y. (\y. inv (1 + y)) y * (\y. y) y:real)``] THEN
18593      MATCH_MP_TAC CONTINUOUS_MUL THEN
18594      REWRITE_TAC[CONTINUOUS_AT_ID] THEN
18595      ONCE_REWRITE_TAC [METIS [] ``(\y. inv (1 + y)) = (\y. inv ((\y. (1 + y)) y:real))``] THEN
18596      ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
18597      SIMP_TAC std_ss [NETLIMIT_AT, o_DEF] THEN
18598      ASM_SIMP_TAC std_ss [CONTINUOUS_ADD, CONTINUOUS_AT_ID, CONTINUOUS_SUB,
18599                   CONTINUOUS_CONST] THEN
18600      ASM_REAL_ARITH_TAC, ALL_TAC] THEN CONJ_TAC THENL
18601      [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
18602       X_GEN_TAC ``y:real`` THEN SIMP_TAC std_ss [GSPECIFICATION, real_ge] THEN
18603       DISCH_TAC THEN ONCE_REWRITE_TAC [METIS [] ``(\y. inv (1 - y) * y) =
18604                                      (\y. (\y. inv (1 - y)) y * (\y. y) y:real)``] THEN
18605       MATCH_MP_TAC CONTINUOUS_MUL THEN
18606       REWRITE_TAC[CONTINUOUS_AT_ID] THEN
18607       ONCE_REWRITE_TAC [METIS [] ``(\y. inv (1 - y)) = (\y. inv ((\y. (1 - y)) y:real))``] THEN
18608       ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
18609       SIMP_TAC std_ss [NETLIMIT_AT, o_DEF] THEN
18610       ASM_SIMP_TAC std_ss [CONTINUOUS_ADD, CONTINUOUS_AT_ID, CONTINUOUS_SUB,
18611                   CONTINUOUS_CONST] THEN
18612       ASM_REAL_ARITH_TAC,
18613       REPEAT STRIP_TAC THENL [METIS_TAC [REAL_ARITH ``~(0 <= x /\ x < 0:real)``],
18614        ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC]]]]
18615QED
18616
18617(* ------------------------------------------------------------------------- *)
18618(* Cardinality of the reals. This is done in a rather laborious way to avoid *)
18619(* any dependence on the theories of analysis.                               *)
18620(* ------------------------------------------------------------------------- *)
18621
18622Theorem lemma[local]:
18623  !s m n. sum (s INTER {m..n}) (\i. inv(&3 pow i)) < &3 / &2 / &3 pow m
18624Proof
18625    REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
18626    EXISTS_TAC ``sum {m..n} (\i. inv(&3 pow i))`` THEN CONJ_TAC THENL
18627    [ (* goal 1 (of 2) *)
18628      MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
18629      SIMP_TAC std_ss [FINITE_NUMSEG, INTER_SUBSET, REAL_LE_INV_EQ,
18630               POW_POS, REAL_POS],
18631      (* goal 2 (of 2) *)
18632      completeInduct_on `n - m:num` THEN GEN_TAC THEN GEN_TAC THEN
18633      DISCH_TAC THEN FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
18634      KNOW_TAC ``(!m'. m' < n - m ==>
18635        !n m''. (m' = n - m'') ==>
18636          sum {m'' .. n} (\i. inv (3 pow i)) < 3 / 2 / 3 pow m'') ==>
18637       (!n' m''. (n' - m'' < n - m) ==>
18638          sum {m'' .. n'} (\i. inv (3 pow i)) < 3 / 2 / 3 pow m'')`` THENL
18639      [ METIS_TAC [], ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN DISCH_TAC ] THEN
18640      ASM_CASES_TAC ``m:num <= n`` THENL
18641      [ (* goal 2.1 (of 2) *)
18642        ASM_SIMP_TAC std_ss [SUM_CLAUSES_LEFT] THEN ASM_CASES_TAC ``m + 1 <= n:num`` THENL
18643        [ (* goal 2.1.1 (of 2) *)
18644          FIRST_X_ASSUM (MP_TAC o SPECL [``n:num``, ``SUC m``]) THEN
18645          KNOW_TAC ``n - SUC m < n - m`` THENL
18646          [ASM_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
18647           ASM_SIMP_TAC arith_ss [ADD1, REAL_POW_ADD]] THEN
18648          MATCH_MP_TAC (REAL_ARITH
18649                        ``a + j:real <= k ==> x < j ==> a + x < k:real``) THEN
18650          KNOW_TAC ``3 pow m <> 0:real`` THENL
18651          [MATCH_MP_TAC POW_NZ THEN REAL_ARITH_TAC, DISCH_TAC] THEN
18652          ASM_SIMP_TAC real_ss [real_div, REAL_INV_MUL, POW_1] THEN
18653          ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
18654          GEN_REWR_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_MUL_RID] THEN
18655          REWRITE_TAC [GSYM REAL_ADD_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN
18656          MATCH_MP_TAC REAL_LE_LMUL_IMP THEN CONJ_TAC THENL
18657          [REWRITE_TAC [REAL_LE_INV_EQ] THEN MATCH_MP_TAC POW_POS THEN
18658           REAL_ARITH_TAC, ALL_TAC] THEN REWRITE_TAC [GSYM real_div] THEN
18659           SIMP_TAC real_ss [REAL_LE_RDIV_EQ, REAL_ADD_RDISTRIB, real_div] THEN
18660           REWRITE_TAC [REAL_MUL_ASSOC] THEN SIMP_TAC real_ss [REAL_MUL_LINV],
18661          ALL_TAC], ALL_TAC] THEN
18662      RULE_ASSUM_TAC (REWRITE_RULE[NOT_LESS_EQUAL, GSYM NUMSEG_EMPTY]) THEN
18663      ASM_REWRITE_TAC [SUM_CLAUSES, REAL_ADD_RID] THEN
18664      (KNOW_TAC ``0:real < 3 pow m`` THENL
18665          [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC, DISCH_TAC] THEN
18666       ASM_SIMP_TAC real_ss [REAL_LT_RDIV_EQ, REAL_MUL_LINV, REAL_LT_IMP_NE])]
18667QED
18668
18669Theorem CARD_EQ_REAL:   univ(:real) ≈ univ(:num->bool)
18670Proof
18671  REWRITE_TAC [GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
18672  [ (* goal 1 (of 2) *)
18673    ‘univ(:real) ≼ (univ(:num) *_c univ(:num->bool)) ∧
18674     (univ(:num) *_c univ(:num->bool)) <=_c univ(:num -> bool)’
18675    suffices_by METIS_TAC [CARD_LE_TRANS] >>
18676    reverse CONJ_TAC
18677    >- (MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN REWRITE_TAC[INFINITE_Unum] THEN
18678        SIMP_TAC std_ss [CANTOR_THM_UNIV, CARD_LT_IMP_LE, CARD_LE_REFL]) >>
18679    ‘univ(:real) <=_c (univ(:num) *_c {x:real | &0 <= x}) /\
18680     univ(:num) *_c {x:real | &0 <= x} <=_c univ(:num) *_c univ(:num -> bool)’
18681       suffices_by METIS_TAC[CARD_LE_TRANS] THEN
18682    CONJ_TAC
18683    >- (SIMP_TAC std_ss [LE_C, mul_c, EXISTS_PROD, IN_ELIM_PAIR_THM, IN_UNIV] >>
18684        EXISTS_TAC “λ(n,x:real). -(&1) pow n * x” >> X_GEN_TAC “x:real” >>
18685        ‘∃p_2. (p_2 ∈ {x | 0r <= x} ∧ ((λ(n,x). -1 pow n * x) (0,p_2) = x)) ∨
18686               (p_2 ∈ {x | 0r <= x} ∧ ((λ(n,x). -1 pow n * x) (1,p_2) = x))’
18687          suffices_by METIS_TAC[] THEN EXISTS_TAC “abs x:real” THEN
18688        SIMP_TAC std_ss [GSPECIFICATION, pow, POW_1] THEN REAL_ARITH_TAC) >>
18689    MATCH_MP_TAC CARD_LE_MUL THEN SIMP_TAC std_ss [CARD_LE_REFL] THEN
18690    MP_TAC(ISPECL [“univ(:num)”, “univ(:num)”] CARD_MUL_ABSORB_LE) THEN
18691    SIMP_TAC std_ss [CARD_LE_REFL, num_INFINITE] THEN
18692    SIMP_TAC std_ss [le_c, mul_c, IN_UNIV, FORALL_PROD, IN_ELIM_PAIR_THM] THEN
18693    REWRITE_TAC [GSYM PAIR_EQ] THEN
18694    SIMP_TAC std_ss [GSYM FORALL_PROD, INJECTIVE_LEFT_INVERSE] THEN
18695    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM]
18696
18697    THEN
18698    MAP_EVERY X_GEN_TAC [“Pair:num#num->num”, “Unpair:num->num#num”] THEN
18699    DISCH_TAC THEN
18700    EXISTS_TAC “\x:real n:num. &(FST(Unpair n)) * x <= &(SND(Unpair n))” THEN
18701    SIMP_TAC std_ss [] THEN
18702    HO_MATCH_MP_TAC REAL_WLOG_LT THEN
18703    SIMP_TAC std_ss [GSPECIFICATION, FUN_EQ_THM] THEN
18704    CONJ_TAC THENL [SIMP_TAC std_ss [EQ_SYM_EQ, CONJ_ACI], ALL_TAC] THEN
18705    MAP_EVERY X_GEN_TAC [“x:real”, “y:real”] THEN REPEAT STRIP_TAC THEN
18706    FIRST_X_ASSUM(MP_TAC o GENL [“p:num”, “q:num”] o
18707      SPEC “(Pair:num#num->num) (p,q)”) THEN
18708    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT ‘~p ==> p ==> q’) THEN
18709    MP_TAC(SPEC “y - x:real” REAL_ARCH) THEN
18710    ASM_SIMP_TAC std_ss [REAL_SUB_LT, NOT_FORALL_THM] THEN
18711    DISCH_THEN(MP_TAC o SPEC “&2:real”) THEN
18712    DISCH_THEN (X_CHOOSE_TAC “p:num”) THEN EXISTS_TAC “p:num” THEN
18713    MP_TAC(ISPEC “&p * x:real” REAL_BIGNUM) THEN
18714    ONCE_REWRITE_TAC [METIS [] “(?n. &p * x < &n:real) = (?n. (\n. &p * x < &n) n)”] THEN
18715    DISCH_THEN (MP_TAC o MATCH_MP WOP) THEN SIMP_TAC std_ss [] THEN
18716    DISCH_THEN (X_CHOOSE_TAC “n:num”) THEN EXISTS_TAC “n:num” THEN
18717    POP_ASSUM MP_TAC THEN SPEC_TAC (“n:num”,“n:num”) >>
18718    Cases >>
18719    ASM_SIMP_TAC std_ss [REAL_LE_MUL, REAL_POS,
18720                         REAL_ARITH “x:real < &0 <=> ~(&0 <= x)”] >>
18721    rename [‘SUC q’] >>
18722    REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN
18723    STRIP_TAC THEN
18724    FIRST_X_ASSUM(MP_TAC o SPEC “q:num”) THEN
18725    SIMP_TAC arith_ss [LT] THEN POP_ASSUM MP_TAC THEN
18726    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
18727    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
18728
18729    (* goal 2 (of 2) *)
18730    REWRITE_TAC[le_c, IN_UNIV] THEN
18731    EXISTS_TAC “\s:num->bool. sup { sum (s INTER { 0n..n}) (\i. inv(&3 pow i)) |
18732                                    n IN univ(:num) }” THEN
18733    MAP_EVERY X_GEN_TAC [“x:num->bool”, “y:num->bool”] THEN
18734    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
18735    SIMP_TAC std_ss [EXTENSION, NOT_FORALL_THM] THEN
18736    ONCE_REWRITE_TAC [METIS [] “(?x':num. x' IN x <=/=> x' IN y) =
18737                           (?x'. (\x'. x' IN x <=/=> x' IN y) x')”] THEN
18738    DISCH_THEN (MP_TAC o MATCH_MP WOP) THEN SIMP_TAC std_ss [] THEN
18739    MAP_EVERY (fn w => SPEC_TAC(w,w)) [“y:num->bool”, “x:num->bool”] THEN
18740    KNOW_TAC “!x y.
18741     (?n. ~(n IN x <=> n IN y) /\ (\x y n. !m. m < n ==> (m IN x <=> m IN y)) x y n) ==>
18742     (\x y. sup {sum (x INTER {0 .. n}) (\i. inv (3 pow i)) | n IN univ(:num)} <>
18743            sup {sum (y INTER {0 .. n}) (\i. inv (3 pow i)) | n IN univ(:num)}) x y” THENL
18744    [ALL_TAC, METIS_TAC []] THEN
18745    MATCH_MP_TAC(MESON[]
18746     “((!P Q n. R P Q n <=> R Q P n) /\ (!P Q. SS P Q <=> SS Q P)) /\
18747       (!P Q. (?n. n IN P /\ ~(n IN Q) /\ R P Q n) ==> SS P Q)
18748       ==> !P Q. (?n:num. ~(n IN P <=> n IN Q) /\ R P Q n) ==> SS P Q”) THEN
18749    SIMP_TAC std_ss [] THEN CONJ_TAC THENL
18750    [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN METIS_TAC [], SIMP_TAC std_ss []] THEN
18751    MAP_EVERY X_GEN_TAC [“x:num->bool”, “y:num->bool”] THEN
18752    DISCH_THEN(X_CHOOSE_THEN “n:num” STRIP_ASSUME_TAC) THEN
18753    MATCH_MP_TAC(REAL_ARITH “!z:real. y < z /\ z <= x ==> ~(x = y)”) THEN
18754
18755    EXISTS_TAC “sum (x INTER { 0n..n}) (\i. inv(&3 pow i))” THEN CONJ_TAC THENL
18756    [ (* goal 2.1 (of 2) *)
18757      MATCH_MP_TAC REAL_LET_TRANS THEN
18758      EXISTS_TAC
18759       “sum (y INTER { 0n..n}) (\i. inv(&3 pow i)) +
18760         &3 / &2 / &3 pow (SUC n)” THEN
18761
18762      CONJ_TAC THENL
18763       [MATCH_MP_TAC REAL_SUP_LE' THEN
18764        CONJ_TAC THENL [SET_TAC[], SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV]] THEN
18765        X_GEN_TAC “p:num” THEN ASM_CASES_TAC “n:num <= p” THENL
18766         [MATCH_MP_TAC(REAL_ARITH
18767           “!d. (s:real = t + d) /\ d <= e ==> s <= t + e”) THEN
18768          EXISTS_TAC “sum(y INTER {n+ 1n..p}) (\i. inv (&3 pow i))” THEN
18769          CONJ_TAC THENL
18770           [ONCE_REWRITE_TAC[INTER_COMM] THEN
18771            SIMP_TAC std_ss [INTER_DEF, SUM_RESTRICT_SET] THEN
18772            ASM_SIMP_TAC std_ss [SUM_COMBINE_R, ZERO_LESS_EQ],
18773            SIMP_TAC std_ss [ADD1, lemma, REAL_LT_IMP_LE]],
18774          MATCH_MP_TAC(REAL_ARITH “y:real <= x /\ &0 <= d ==> y <= x + d”) THEN
18775          SIMP_TAC real_ss [REAL_LE_DIV, REAL_POS, POW_POS] THEN
18776          MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
18777          SIMP_TAC real_ss [REAL_LE_INV_EQ, POW_POS, REAL_POS] THEN
18778          SIMP_TAC std_ss [FINITE_INTER, FINITE_NUMSEG] THEN MATCH_MP_TAC
18779           (SET_RULE “s SUBSET t ==> u INTER s SUBSET u INTER t”) THEN
18780          REWRITE_TAC[SUBSET_NUMSEG] THEN ASM_SIMP_TAC arith_ss []],
18781        ONCE_REWRITE_TAC[INTER_COMM] THEN
18782        SIMP_TAC std_ss [INTER_DEF, SUM_RESTRICT_SET] THEN ASM_CASES_TAC “n = 0:num” THENL
18783         [FIRST_X_ASSUM SUBST_ALL_TAC THEN
18784          FULL_SIMP_TAC real_ss [SUM_SING, NUMSEG_SING, pow] THEN
18785          SIMP_TAC real_ss [REAL_LT_LDIV_EQ, REAL_INV1] THEN REAL_ARITH_TAC,
18786          ASM_SIMP_TAC std_ss [SUM_CLAUSES_RIGHT, LE_1, ZERO_LESS_EQ, REAL_ADD_RID] THEN
18787          MATCH_MP_TAC(REAL_ARITH “(s:real = t) /\ d < e ==> s + d < t + e”) THEN
18788          CONJ_TAC THENL
18789           [MATCH_MP_TAC SUM_EQ_NUMSEG THEN
18790            ASM_SIMP_TAC std_ss [ARITH_PROVE “~(n = 0:num) /\ m <= n - 1 ==> m < n”],
18791            SIMP_TAC real_ss [pow, real_div, REAL_INV_MUL, REAL_MUL_ASSOC] THEN
18792            KNOW_TAC “3 pow n <> 0:real” THENL
18793            [MATCH_MP_TAC POW_NZ THEN REAL_ARITH_TAC, DISCH_TAC] THEN
18794            KNOW_TAC “0:real < 3 pow n” THENL
18795            [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC, DISCH_TAC] THEN
18796            ASM_SIMP_TAC real_ss [REAL_INV_MUL, REAL_MUL_ASSOC] THEN
18797            GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
18798            MATCH_MP_TAC REAL_LT_RMUL_IMP THEN ASM_SIMP_TAC real_ss [REAL_LT_INV_EQ] THEN
18799            ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
18800            SIMP_TAC real_ss [REAL_MUL_ASSOC, REAL_MUL_LINV] THEN
18801            SIMP_TAC real_ss [REAL_INV_1OVER, REAL_LT_LDIV_EQ]]]],
18802      MP_TAC(ISPEC “{ sum (x INTER { 0n..n}) (\i. inv(&3 pow i)) | n IN univ(:num) }”
18803          SUP) THEN SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV] THEN
18804      KNOW_TAC “{sum (x INTER {0 .. n}) (\i. inv (3 pow i)) | n | T} <> {} /\
18805         (?b. !n. sum (x INTER {0 .. n}) (\i. inv (3 pow i)) <= b)” THENL
18806      [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
18807       SIMP_TAC std_ss []] THEN
18808      CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
18809      EXISTS_TAC “&3 / &2 / (&3:real) pow 0” THEN
18810      SIMP_TAC std_ss [lemma, REAL_LT_IMP_LE]]
18811  ]
18812QED
18813
18814Theorem UNCOUNTABLE_REAL:
18815   ~COUNTABLE univ(:real)
18816Proof
18817  REWRITE_TAC[COUNTABLE, ge_c] THEN
18818  KNOW_TAC ``univ(:num) <_c univ(:num->bool) /\
18819             univ(:num->bool) <=_c univ(:real)`` THENL
18820  [ALL_TAC, METIS_TAC [CARD_LTE_TRANS]] THEN
18821  REWRITE_TAC[CANTOR_THM_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
18822  ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL]
18823QED
18824
18825Theorem CARD_EQ_REAL_IMP_UNCOUNTABLE :
18826    !s:real->bool. s =_c univ(:real) ==> ~COUNTABLE s
18827Proof
18828  GEN_TAC THEN STRIP_TAC THEN
18829  DISCH_THEN (MP_TAC o ISPEC ``univ(:real)`` o MATCH_MP
18830    (SIMP_RULE std_ss [CONJ_EQ_IMP] CARD_EQ_COUNTABLE)) THEN
18831  REWRITE_TAC[UNCOUNTABLE_REAL] THEN ASM_MESON_TAC[CARD_EQ_SYM]
18832QED
18833
18834(* ------------------------------------------------------------------------- *)
18835(* Cardinalities of various useful sets.                                     *)
18836(* ------------------------------------------------------------------------- *)
18837
18838(* original HOL Light theorem is univ(:real[n]) =_c univ(:real), which is
18839   not so vacuous *)
18840Theorem CARD_EQ_EUCLIDEAN:
18841   univ(:real) =_c univ(:real)
18842Proof
18843  simp[]
18844QED
18845
18846Theorem UNCOUNTABLE_EUCLIDEAN:
18847   ~COUNTABLE univ(:real)
18848Proof
18849  MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
18850  REWRITE_TAC[CARD_EQ_EUCLIDEAN]
18851QED
18852
18853Theorem CARD_EQ_INTERVAL:
18854   (!a b:real. ~(interval(a,b) = {}) ==> (interval[a,b] =_c univ(:real))) /\
18855   (!a b:real. ~(interval(a,b) = {}) ==> (interval(a,b) =_c univ(:real)))
18856Proof
18857  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN REPEAT GEN_TAC THEN
18858  ASM_CASES_TAC ``interval(a:real,b) = {}`` THEN ASM_REWRITE_TAC[] THEN
18859  CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
18860   [REWRITE_TAC[CARD_LE_UNIV],
18861    KNOW_TAC ``univ(:real) <=_c interval(a:real,b) /\
18862               interval(a:real,b) <=_c interval [(a,b)]`` THENL
18863    [ALL_TAC, METIS_TAC [CARD_LE_TRANS]] THEN
18864    SIMP_TAC std_ss [CARD_LE_SUBSET, INTERVAL_OPEN_SUBSET_CLOSED],
18865    REWRITE_TAC[CARD_LE_UNIV],
18866    ALL_TAC] THEN
18867  RULE_ASSUM_TAC (REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
18868  FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN
18869  DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
18870  MESON_TAC[CARD_EQ_IMP_LE, CARD_EQ_SYM]
18871QED
18872
18873Theorem UNCOUNTABLE_INTERVAL:
18874   (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\
18875   (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))
18876Proof
18877  SIMP_TAC std_ss [CARD_EQ_REAL_IMP_UNCOUNTABLE, CARD_EQ_INTERVAL]
18878QED
18879
18880Theorem COUNTABLE_OPEN_INTERVAL:
18881   !a b. COUNTABLE(interval(a,b)) <=> (interval(a,b) = {})
18882Proof
18883  MESON_TAC[COUNTABLE_EMPTY, UNCOUNTABLE_INTERVAL]
18884QED
18885
18886Theorem CARD_EQ_OPEN:
18887   !s:real->bool. open s /\ ~(s = {}) ==> s =_c univ(:real)
18888Proof
18889  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
18890   [REWRITE_TAC[CARD_LE_UNIV],
18891    UNDISCH_TAC ``open s`` THEN DISCH_TAC THEN
18892    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_CONTAINS_INTERVAL]) THEN
18893    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
18894    DISCH_THEN(X_CHOOSE_TAC ``c:real``) THEN
18895    DISCH_THEN(MP_TAC o SPEC ``c:real``) THEN
18896    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
18897    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
18898    ASM_CASES_TAC ``interval(a:real,b) = {}`` THEN
18899    ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
18900    KNOW_TAC ``univ(:real) <=_c interval[a:real,b] /\
18901               interval[a:real,b] <=_c s:real->bool`` THENL
18902    [ALL_TAC, METIS_TAC [CARD_LE_TRANS]] THEN
18903    ASM_SIMP_TAC std_ss [CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
18904    ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC std_ss [CARD_EQ_INTERVAL]]
18905QED
18906
18907Theorem UNCOUNTABLE_OPEN:
18908   !s:real->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)
18909Proof
18910  SIMP_TAC std_ss [CARD_EQ_OPEN, CARD_EQ_REAL_IMP_UNCOUNTABLE]
18911QED
18912
18913Theorem CARD_EQ_BALL:
18914   !a:real r. &0 < r ==> ball(a,r) =_c  univ(:real)
18915Proof
18916  SIMP_TAC std_ss [CARD_EQ_OPEN, OPEN_BALL, BALL_EQ_EMPTY, GSYM REAL_NOT_LT]
18917QED
18918
18919Theorem CARD_EQ_CBALL:
18920   !a:real r. &0 < r ==> cball(a,r) =_c univ(:real)
18921Proof
18922  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
18923   [REWRITE_TAC[CARD_LE_UNIV],
18924    KNOW_TAC ``univ(:real) <=_c ball(a:real,r) /\
18925               ball(a:real,r) <=_c cball (a,r:real)`` THENL
18926    [ALL_TAC, METIS_TAC [CARD_LE_TRANS]] THEN
18927    SIMP_TAC std_ss [CARD_LE_SUBSET, BALL_SUBSET_CBALL] THEN
18928    MATCH_MP_TAC CARD_EQ_IMP_LE THEN
18929    ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC std_ss [CARD_EQ_BALL]]
18930QED
18931
18932Theorem FINITE_IMP_NOT_OPEN:
18933   !s:real->bool. FINITE s /\ ~(s = {}) ==> ~(open s)
18934Proof
18935  MESON_TAC[UNCOUNTABLE_OPEN, FINITE_IMP_COUNTABLE]
18936QED
18937
18938Theorem OPEN_IMP_INFINITE:
18939   !s. open s ==> (s = {}) \/ INFINITE s
18940Proof
18941  MESON_TAC[FINITE_IMP_NOT_OPEN]
18942QED
18943
18944Theorem EMPTY_INTERIOR_FINITE:
18945   !s:real->bool. FINITE s ==> (interior s = {})
18946Proof
18947  REPEAT STRIP_TAC THEN MP_TAC(ISPEC ``s:real->bool`` OPEN_INTERIOR) THEN
18948  ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
18949  MATCH_MP_TAC(REWRITE_RULE[CONJ_EQ_IMP] FINITE_IMP_NOT_OPEN) THEN
18950  MATCH_MP_TAC SUBSET_FINITE_I THEN EXISTS_TAC ``s:real->bool`` THEN
18951  ASM_REWRITE_TAC[INTERIOR_SUBSET]
18952QED
18953
18954Theorem FINITE_CBALL:
18955   !a:real r. FINITE(cball(a,r)) <=> r <= &0
18956Proof
18957  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``r < &0:real`` THEN
18958  ASM_SIMP_TAC std_ss [CBALL_EMPTY, REAL_LT_IMP_LE, FINITE_EMPTY] THEN
18959  ASM_CASES_TAC ``r = &0:real`` THEN
18960  ASM_REWRITE_TAC[CBALL_TRIVIAL, FINITE_SING, REAL_LE_REFL] THEN
18961  EQ_TAC THENL [ALL_TAC, ASM_REAL_ARITH_TAC] THEN
18962  DISCH_THEN(MP_TAC o MATCH_MP EMPTY_INTERIOR_FINITE) THEN
18963  REWRITE_TAC[INTERIOR_CBALL, BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC
18964QED
18965
18966Theorem FINITE_BALL:
18967   !a:real r. FINITE(ball(a,r)) <=> r <= &0
18968Proof
18969  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``r <= &0:real`` THEN
18970  ASM_SIMP_TAC std_ss [BALL_EMPTY, REAL_LT_IMP_LE, FINITE_EMPTY] THEN
18971  DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[CONJ_EQ_IMP]
18972        FINITE_IMP_NOT_OPEN)) THEN
18973  REWRITE_TAC[OPEN_BALL, BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC
18974QED
18975
18976(* ------------------------------------------------------------------------- *)
18977(* "Iff" forms of constancy of function from connected set into a set that   *)
18978(* is smaller than R, or countable, or finite, or disconnected, or discrete. *)
18979(* ------------------------------------------------------------------------- *)
18980
18981Theorem CONTINUOUS_DISCONNECTED_DISCRETE_FINITE_RANGE_CONSTANT_EQ:
18982    (!s. connected s <=>
18983         !f:real->real t.
18984            f continuous_on s /\ IMAGE f s SUBSET t /\
18985            (!y. y IN t ==> (connected_component t y = {y}))
18986            ==> ?a. !x. x IN s ==> (f x = a)) /\
18987    (!s. connected s <=>
18988         !f:real->real.
18989            f continuous_on s /\
18990            (!x. x IN s
18991                 ==> ?e. &0 < e /\
18992                         !y. y IN s /\ ~(f y = f x) ==> e <= abs(f y - f x))
18993            ==> ?a. !x. x IN s ==> (f x = a)) /\
18994    (!s. connected s <=>
18995         !f:real->real.
18996            f continuous_on s /\ FINITE(IMAGE f s)
18997            ==> ?a. !x. x IN s ==> (f x = a))
18998Proof
18999  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``s:real->bool`` THEN
19000  MATCH_MP_TAC(TAUT
19001    `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s)
19002     ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN
19003  REPEAT CONJ_TAC THENL
19004   [REPEAT STRIP_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
19005    ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
19006    FIRST_X_ASSUM(X_CHOOSE_TAC ``x:real`` o
19007        REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
19008    EXISTS_TAC ``(f:real->real) x`` THEN
19009    MATCH_MP_TAC(SET_RULE
19010     ``IMAGE f s SUBSET {a} ==> !y. y IN s ==> (f y = a)``) THEN
19011    FIRST_X_ASSUM(MP_TAC o SPEC ``(f:real->real) x``) THEN
19012    KNOW_TAC ``(f:real->real) x IN t`` THENL
19013    [ASM_SET_TAC [], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
19014     DISCH_THEN(SUBST1_TAC o SYM)] THEN
19015    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
19016    ASM_SIMP_TAC std_ss [CONNECTED_CONTINUOUS_IMAGE] THEN ASM_SET_TAC [],
19017    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
19018    EXISTS_TAC ``IMAGE (f:real->real) s`` THEN
19019    ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, SUBSET_REFL] THEN
19020    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
19021    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
19022    DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
19023    MATCH_MP_TAC(SET_RULE
19024     ``(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> (f y = a)) /\
19025       connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\
19026       connected_component (IMAGE f s) a a
19027       ==> (connected_component (IMAGE f s) a = {a})``) THEN
19028    SIMP_TAC std_ss [CONNECTED_COMPONENT_SUBSET, CONNECTED_COMPONENT_REFL_EQ] THEN
19029    ASM_SIMP_TAC std_ss [FUN_IN_IMAGE] THEN X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
19030    MP_TAC(ISPEC ``connected_component (IMAGE (f:real->real) s) (f x)``
19031        CONNECTED_CLOSED) THEN
19032    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
19033    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN DISCH_TAC THEN
19034    ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
19035     [``cball((f:real->real) x,e / &2)``,
19036      ``univ(:real) DIFF ball((f:real->real) x,e)``] THEN
19037    SIMP_TAC std_ss [GSYM OPEN_CLOSED, OPEN_BALL, CLOSED_CBALL] THEN
19038    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL
19039     [REWRITE_TAC[SUBSET_DEF, IN_CBALL, IN_UNION, IN_DIFF, IN_BALL, IN_UNIV] THEN
19040      ONCE_REWRITE_TAC [METIS []
19041       ``(dist (f x,x') <= e / 2 \/ ~(dist (f x,x') < e)) =
19042         (\x'. dist (f x,x') <= e / 2 \/ ~(dist (f x,x') < e)) x'``] THEN
19043      MATCH_MP_TAC(MESON[SUBSET_DEF, CONNECTED_COMPONENT_SUBSET]
19044       ``(!x. x IN s ==> P x)
19045        ==> (!x. x IN connected_component s y ==> P x)``) THEN
19046      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN X_GEN_TAC ``z:real`` THEN
19047      DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``z:real``) THEN
19048      ASM_SIMP_TAC real_ss [dist, REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC,
19049      MATCH_MP_TAC(SET_RULE
19050       ``(!x. x IN s /\ x IN t ==> F) ==> (s INTER t INTER u = {})``) THEN
19051      REWRITE_TAC[IN_BALL, IN_CBALL, IN_DIFF, IN_UNIV] THEN
19052      UNDISCH_TAC ``&0 < e:real`` THEN
19053      ASM_SIMP_TAC real_ss [dist, REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC,
19054      EXISTS_TAC ``(f:real->real) x`` THEN
19055      ASM_SIMP_TAC std_ss [CENTRE_IN_CBALL, REAL_HALF, REAL_LT_IMP_LE, IN_INTER] THEN
19056      SIMP_TAC std_ss [SPECIFICATION] THEN
19057      ASM_SIMP_TAC std_ss [CONNECTED_COMPONENT_REFL_EQ, FUN_IN_IMAGE],
19058      EXISTS_TAC ``(f:real->real) y`` THEN
19059      ASM_REWRITE_TAC[IN_INTER, IN_DIFF, IN_UNIV, IN_BALL, REAL_NOT_LT] THEN
19060      ASM_SIMP_TAC std_ss [ONCE_REWRITE_RULE[DIST_SYM] dist]],
19061    DISCH_TAC THEN X_GEN_TAC ``f:real->real`` THEN
19062    POP_ASSUM (MP_TAC o SPEC ``f:real->real``) THEN
19063    DISCH_THEN(fn th => STRIP_TAC THEN MATCH_MP_TAC th) THEN
19064    ASM_REWRITE_TAC[] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
19065    ASM_CASES_TAC ``IMAGE (f:real->real) s DELETE (f x) = {}`` THENL
19066     [EXISTS_TAC ``&1:real`` THEN REWRITE_TAC[REAL_LT_01] THEN ASM_SET_TAC [],
19067      ALL_TAC] THEN
19068    EXISTS_TAC
19069     ``inf{abs(z - f x) |z| z IN IMAGE (f:real->real) s DELETE (f x)}`` THEN
19070    SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
19071    ASM_SIMP_TAC std_ss [REAL_LT_INF_FINITE, REAL_INF_LE_FINITE, FINITE_DELETE,
19072                 IMAGE_FINITE, IMAGE_EQ_EMPTY] THEN
19073    SIMP_TAC std_ss [FORALL_IN_IMAGE, EXISTS_IN_IMAGE] THEN
19074    SIMP_TAC real_ss [IN_DELETE, GSYM ABS_NZ, REAL_SUB_0, IN_IMAGE] THEN
19075    MESON_TAC[REAL_LE_REFL],
19076    REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN
19077    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
19078    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
19079    MAP_EVERY X_GEN_TAC [``t:real->bool``, ``u:real->bool``] THEN
19080    STRIP_TAC THEN EXISTS_TAC
19081     ``(\x. if x IN t then 0 else 1:real):real->real`` THEN
19082    SIMP_TAC std_ss [NOT_IMP] THEN REPEAT CONJ_TAC THENL
19083     [EXPAND_TAC "s" THEN
19084      ONCE_REWRITE_TAC [METIS [] ``(\x:real. if x IN t then 0 else 1:real) =
19085                   (\x. if (\x. x IN t) x then (\x. 0) x else (\x. 1) x)``] THEN
19086      MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
19087      ASM_SIMP_TAC std_ss [CONTINUOUS_ON_CONST] THEN ASM_SET_TAC [],
19088      MATCH_MP_TAC SUBSET_FINITE_I THEN EXISTS_TAC ``{0:real;1:real}`` THEN
19089      REWRITE_TAC[FINITE_INSERT, FINITE_EMPTY] THEN SET_TAC[],
19090      SUBGOAL_THEN ``?a b:real. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)``
19091      STRIP_ASSUME_TAC THENL
19092       [ASM_SET_TAC [], GEN_TAC] THEN CCONTR_TAC THEN
19093      POP_ASSUM (MP_TAC o SIMP_RULE std_ss []) THEN
19094      DISCH_THEN(fn th => MP_TAC(SPEC ``a:real`` th) THEN
19095                           MP_TAC(SPEC ``b:real`` th)) THEN
19096      ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]
19097QED
19098
19099Theorem CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ:
19100   (!s. connected s <=>
19101         !f:real->real t.
19102            f continuous_on s /\ IMAGE f s SUBSET t /\
19103            (!y. y IN t ==> (connected_component t y = {y}))
19104            ==> ?a. !x. x IN s ==> (f x = a))
19105Proof
19106  REWRITE_TAC [CONTINUOUS_DISCONNECTED_DISCRETE_FINITE_RANGE_CONSTANT_EQ]
19107QED
19108
19109Theorem CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ:
19110   (!s. connected s <=>
19111         !f:real->real.
19112            f continuous_on s /\
19113            (!x. x IN s
19114                 ==> ?e. &0 < e /\
19115                         !y. y IN s /\ ~(f y = f x) ==> e <= abs(f y - f x))
19116            ==> ?a. !x. x IN s ==> (f x = a))
19117Proof
19118  METIS_TAC [CONTINUOUS_DISCONNECTED_DISCRETE_FINITE_RANGE_CONSTANT_EQ]
19119QED
19120
19121Theorem CONTINUOUS_FINITE_RANGE_CONSTANT_EQ:
19122   (!s. connected s <=>
19123         !f:real->real.
19124            f continuous_on s /\ FINITE(IMAGE f s)
19125            ==> ?a. !x. x IN s ==> (f x = a))
19126Proof
19127  METIS_TAC [CONTINUOUS_DISCONNECTED_DISCRETE_FINITE_RANGE_CONSTANT_EQ]
19128QED
19129
19130Theorem CONTINUOUS_DISCONNECTED_RANGE_CONSTANT:
19131   !f:real->real s.
19132        connected s /\
19133        f continuous_on s /\ IMAGE f s SUBSET t /\
19134        (!y. y IN t ==> (connected_component t y = {y}))
19135        ==> ?a. !x. x IN s ==> (f x = a)
19136Proof
19137  MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]
19138QED
19139
19140Theorem CONTINUOUS_DISCRETE_RANGE_CONSTANT:
19141   !f:real->real s.
19142        connected s /\
19143        f continuous_on s /\
19144        (!x. x IN s
19145             ==> ?e. &0 < e /\
19146                     !y. y IN s /\ ~(f y = f x) ==> e <= abs(f y - f x))
19147        ==> ?a. !x. x IN s ==> (f x = a)
19148Proof
19149  KNOW_TAC ``!s f:real->real.
19150        connected s /\
19151        f continuous_on s /\
19152        (!x. x IN s
19153             ==> ?e. &0 < e /\
19154                     !y. y IN s /\ ~(f y = f x) ==> e <= abs(f y - f x))
19155        ==> ?a. !x. x IN s ==> (f x = a)`` THENL
19156  [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
19157  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, CONJ_EQ_IMP] THEN
19158  SIMP_TAC std_ss [AND_IMP_INTRO, GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]
19159QED
19160
19161Theorem CONTINUOUS_FINITE_RANGE_CONSTANT:
19162   !f:real->real s.
19163        connected s /\
19164        f continuous_on s /\
19165        FINITE(IMAGE f s)
19166        ==> ?a. !x. x IN s ==> (f x = a)
19167Proof
19168  MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]
19169QED
19170
19171(* ------------------------------------------------------------------------- *)
19172(* Homeomorphism of hyperplanes.                                             *)
19173(* ------------------------------------------------------------------------- *)
19174
19175Theorem lemma[local]:
19176     ~(a = 0)
19177     ==> {x:real | a * x = b} homeomorphic {x:real | x = &0}
19178Proof
19179    REPEAT STRIP_TAC THEN SUBGOAL_THEN ``?c:real. a * c = b``
19180    STRIP_ASSUME_TAC THENL
19181     [EXISTS_TAC ``inv a * b:real`` THEN
19182      ASM_SIMP_TAC real_ss [REAL_MUL_RINV, REAL_MUL_ASSOC], ALL_TAC] THEN
19183     REWRITE_TAC [homeomorphic, homeomorphism] THEN
19184     EXISTS_TAC ``(\x. 0):real->real`` THEN
19185     EXISTS_TAC ``(\x:real. inv a * b:real)`` THEN
19186     SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE] THEN
19187     SIMP_TAC std_ss [CONTINUOUS_ON_CONST] THEN
19188     REPEAT STRIP_TAC THENL
19189     [ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
19190      ASM_CASES_TAC ``0 < a:real`` THENL
19191      [ASM_SIMP_TAC real_ss [REAL_EQ_LDIV_EQ] THEN ASM_REAL_ARITH_TAC, ALL_TAC] THEN
19192      FULL_SIMP_TAC real_ss [REAL_NOT_LT, REAL_LE_LT] THENL [ALL_TAC, METIS_TAC []] THEN
19193      KNOW_TAC ``a < 0 ==> 0 < -a:real`` THENL [REAL_ARITH_TAC, ASM_REWRITE_TAC []] THEN
19194      DISCH_TAC THEN ONCE_REWRITE_TAC [GSYM REAL_EQ_NEG] THEN
19195      REWRITE_TAC [real_div, REAL_ARITH ``-(a * b) = a * -b:real``] THEN
19196      ASM_SIMP_TAC std_ss [REAL_NEG_INV, GSYM real_div] THEN
19197      ASM_SIMP_TAC real_ss [REAL_EQ_LDIV_EQ] THEN ASM_REAL_ARITH_TAC,
19198      METIS_TAC [],
19199      ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
19200      ASM_CASES_TAC ``0 < a:real`` THENL
19201      [ASM_SIMP_TAC real_ss [REAL_EQ_RDIV_EQ] THEN ASM_REAL_ARITH_TAC, ALL_TAC] THEN
19202      FULL_SIMP_TAC real_ss [REAL_NOT_LT, REAL_LE_LT] THENL [ALL_TAC, METIS_TAC []] THEN
19203      KNOW_TAC ``a < 0 ==> 0 < -a:real`` THENL [REAL_ARITH_TAC, ASM_REWRITE_TAC []] THEN
19204      DISCH_TAC THEN ONCE_REWRITE_TAC [GSYM REAL_EQ_NEG] THEN
19205      REWRITE_TAC [real_div, REAL_ARITH ``-(a * b) = a * -b:real``] THEN
19206      ASM_SIMP_TAC std_ss [REAL_NEG_INV, GSYM real_div] THEN
19207      ASM_SIMP_TAC real_ss [REAL_EQ_RDIV_EQ] THEN ASM_REAL_ARITH_TAC]
19208QED
19209
19210Theorem HOMEOMORPHIC_HYPERPLANES:
19211   !a:real b c:real d.
19212        ~(a = 0) /\ ~(c = 0)
19213        ==> {x | a * x = b} homeomorphic {x | c * x = d}
19214Proof
19215  REPEAT STRIP_TAC THEN
19216  MATCH_MP_TAC HOMEOMORPHIC_TRANS THEN EXISTS_TAC ``{x:real | x = &0}`` THEN
19217  ASM_SIMP_TAC std_ss [lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
19218  ASM_SIMP_TAC std_ss [lemma]
19219QED
19220
19221Theorem HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE:
19222   !a:real b c.
19223        ~(a = 0)
19224        ==> {x | a * x = b} homeomorphic {x:real | x = c}
19225Proof
19226  REPEAT STRIP_TAC THEN
19227  SUBGOAL_THEN ``{x:real | x = c} = {x | 1 * x = c}`` SUBST1_TAC
19228  THENL [ASM_SIMP_TAC real_ss [], MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN
19229  ASM_SIMP_TAC real_ss []
19230QED
19231
19232Theorem HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE:
19233   !a:real b c.
19234        ~(a = 0)
19235        ==> {x:real | x = c} homeomorphic {x | a * x = b}
19236Proof
19237  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
19238  SIMP_TAC std_ss [HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]
19239QED
19240
19241(* ------------------------------------------------------------------------- *)
19242(* "Isometry" (up to constant bounds) of injective linear map etc.           *)
19243(* ------------------------------------------------------------------------- *)
19244
19245Theorem CAUCHY_ISOMETRIC:
19246   !f s e x.
19247        &0 < e /\ subspace s /\
19248        linear f /\ (!x. x IN s ==> abs(f x) >= e * abs(x)) /\
19249        (!n. x(n) IN s) /\ cauchy(f o x)
19250        ==> cauchy x
19251Proof
19252  REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN
19253  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
19254  SIMP_TAC std_ss [CAUCHY, dist, o_THM] THEN
19255  FIRST_ASSUM(fn th => REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN
19256  DISCH_THEN(fn th => X_GEN_TAC ``d:real`` THEN DISCH_TAC THEN MP_TAC th) THEN
19257  DISCH_THEN(MP_TAC o SPEC ``d * e:real``) THEN ASM_SIMP_TAC std_ss [REAL_LT_MUL] THEN
19258  METIS_TAC[REAL_LE_RDIV_EQ, REAL_MUL_SYM, REAL_LET_TRANS, SUBSPACE_SUB,
19259            REAL_LT_LDIV_EQ]
19260QED
19261
19262Theorem COMPLETE_ISOMETRIC_IMAGE:
19263   !f:real->real s e.
19264        &0 < e /\ subspace s /\
19265        linear f /\ (!x. x IN s ==> abs(f x) >= e * abs(x)) /\
19266        complete s
19267        ==> complete(IMAGE f s)
19268Proof
19269  REPEAT GEN_TAC THEN SIMP_TAC std_ss [complete, EXISTS_IN_IMAGE] THEN
19270  STRIP_TAC THEN X_GEN_TAC ``g:num->real`` THEN
19271  SIMP_TAC std_ss [IN_IMAGE, SKOLEM_THM, FORALL_AND_THM] THEN
19272  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
19273  DISCH_THEN(X_CHOOSE_THEN ``x:num->real`` MP_TAC) THEN
19274  ONCE_REWRITE_TAC [METIS [] ``(!n. g n = f (x n)) = (!n. g n = (\n. f (x n)) n)``] THEN
19275  GEN_REWR_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN
19276  REWRITE_TAC[GSYM o_DEF] THEN
19277  DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
19278  FIRST_X_ASSUM(MP_TAC o SPEC ``x:num->real``) THEN
19279  ASM_MESON_TAC[CAUCHY_ISOMETRIC, LINEAR_CONTINUOUS_AT,
19280                CONTINUOUS_AT_SEQUENTIALLY]
19281QED
19282
19283Theorem INJECTIVE_IMP_ISOMETRIC:
19284   !f:real->real s.
19285        closed s /\ subspace s /\
19286        linear f /\ (!x. x IN s /\ (f x = 0) ==> (x = 0))
19287        ==> ?e. &0 < e /\ !x. x IN s ==> abs(f x) >= e * abs(x)
19288Proof
19289  REPEAT STRIP_TAC THEN
19290  ASM_CASES_TAC ``s SUBSET {0 :real}`` THENL
19291   [EXISTS_TAC ``&1:real`` THEN REWRITE_TAC[REAL_LT_01, REAL_MUL_LID, real_ge] THEN
19292    ASM_MESON_TAC[SUBSET_DEF, IN_SING, ABS_0, LINEAR_0, REAL_LE_REFL],
19293    ALL_TAC] THEN
19294  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [SUBSET_DEF]) THEN
19295  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, IN_SING] THEN
19296  DISCH_THEN(X_CHOOSE_THEN ``a:real`` STRIP_ASSUME_TAC) THEN
19297  MP_TAC(ISPECL
19298   [``{(f:real->real) x | x IN s /\ (abs(x) = abs(a:real))}``,
19299    ``0:real``] DISTANCE_ATTAINS_INF) THEN
19300  KNOW_TAC ``closed {(f:real->real) x | x IN s /\ (abs x = abs a)} /\
19301   {f x | x IN s /\ (abs x = abs a)} <> {}`` THENL
19302   [SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, GSPECIFICATION] THEN
19303    CONJ_TAC THENL [ALL_TAC, METIS_TAC[]] THEN
19304    MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
19305    SUBST1_TAC(SET_RULE
19306     ``{f x | x IN s /\ (abs(x) = abs(a:real))} =
19307       IMAGE (f:real->real) (s INTER {x | abs x = abs a})``) THEN
19308    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
19309    ASM_SIMP_TAC std_ss [LINEAR_CONTINUOUS_ON] THEN
19310    MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
19311    SUBGOAL_THEN
19312     ``{x:real | abs x = abs(a:real)} = frontier(cball(0,abs a))``
19313    SUBST1_TAC THENL
19314     [ASM_SIMP_TAC real_ss [FRONTIER_CBALL, GSYM ABS_NZ, dist, REAL_SUB_LZERO,
19315                   ABS_NEG, sphere],
19316      ASM_SIMP_TAC std_ss [COMPACT_FRONTIER, COMPACT_CBALL]],
19317    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
19318  ONCE_REWRITE_TAC [METIS [] ``{(f:real->real) x | x IN s /\ (abs x = abs a)} =
19319                          {f x | (\x. x IN s /\ (abs x = abs a)) x}``] THEN
19320  ONCE_REWRITE_TAC[SET_RULE ``{f x | P x} = IMAGE f {x | P x}``] THEN
19321  SIMP_TAC std_ss [FORALL_IN_IMAGE, EXISTS_IN_IMAGE] THEN
19322  DISCH_THEN(X_CHOOSE_THEN ``b:real`` MP_TAC) THEN
19323  SIMP_TAC std_ss [GSPECIFICATION, dist, REAL_SUB_LZERO, ABS_NEG] THEN
19324  STRIP_TAC THEN SIMP_TAC std_ss [CLOSED_LIMPT, LIMPT_APPROACHABLE] THEN
19325  EXISTS_TAC ``abs((f:real->real) b) / abs(b)`` THEN CONJ_TAC THENL
19326   [ASM_MESON_TAC[REAL_LT_DIV, GSYM ABS_NZ, ABS_ZERO], ALL_TAC] THEN
19327  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
19328  ASM_CASES_TAC ``x:real = 0`` THENL
19329   [FIRST_ASSUM(fn th => ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN
19330    REWRITE_TAC[ABS_0, REAL_MUL_RZERO, real_ge, REAL_LE_REFL],
19331    ALL_TAC] THEN
19332  FIRST_X_ASSUM(MP_TAC o SPEC ``(abs(a:real) / abs(x)) * x:real``) THEN
19333  KNOW_TAC ``abs a / abs x * x IN s /\ (abs (abs a / abs x * x) = abs a:real)`` THENL
19334   [KNOW_TAC ``(abs x <> 0:real) /\ (abs a <> 0:real)`` THENL
19335    [UNDISCH_TAC ``a <> 0:real`` THEN POP_ASSUM MP_TAC THEN
19336     REAL_ARITH_TAC, STRIP_TAC] THEN
19337    ASM_SIMP_TAC real_ss [ABS_MUL, ABS_DIV, ABS_ABS] THEN
19338    FULL_SIMP_TAC std_ss [subspace] THEN
19339    ASM_SIMP_TAC real_ss [REAL_DIV_RMUL, ABS_ZERO],
19340    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
19341  UNDISCH_TAC ``linear f`` THEN DISCH_TAC THEN
19342  FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP LINEAR_CMUL th]) THEN
19343  KNOW_TAC ``(abs x <> 0:real) /\ (abs a <> 0:real)`` THENL
19344    [UNDISCH_TAC ``a <> 0:real`` THEN UNDISCH_TAC ``x <> 0:real`` THEN
19345     REAL_ARITH_TAC, STRIP_TAC] THEN
19346  ASM_SIMP_TAC real_ss [ABS_MUL, ABS_DIV, ABS_ABS, real_ge] THEN
19347  ASM_SIMP_TAC real_ss [GSYM REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ, GSYM ABS_NZ] THEN
19348  SIMP_TAC std_ss [real_div, REAL_MUL_ASSOC] THEN REAL_ARITH_TAC
19349QED
19350
19351Theorem CLOSED_INJECTIVE_IMAGE_SUBSPACE:
19352   !f s. subspace s /\
19353         linear f /\
19354         (!x. x IN s /\ (f(x) = 0) ==> (x = 0)) /\
19355         closed s
19356         ==> closed(IMAGE f s)
19357Proof
19358  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN
19359  MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN
19360  ASM_SIMP_TAC std_ss [COMPLETE_EQ_CLOSED] THEN
19361  MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN
19362  ASM_REWRITE_TAC[]
19363QED
19364
19365(* ------------------------------------------------------------------------- *)
19366(* Relating linear images to open/closed/interior/closure.                   *)
19367(* ------------------------------------------------------------------------- *)
19368
19369Theorem OPEN_SURJECTIVE_LINEAR_IMAGE:
19370   !f:real->real.
19371        linear f /\ (!y. ?x. f x = y)
19372        ==> !s. open s ==> open(IMAGE f s)
19373Proof
19374  GEN_TAC THEN STRIP_TAC THEN
19375  SIMP_TAC std_ss [open_def, FORALL_IN_IMAGE] THEN
19376  FIRST_ASSUM(MP_TAC o GEN ``k:num`` o SPEC ``if (1 = k:num) then &1 else &0:real``) THEN
19377  SIMP_TAC std_ss [SKOLEM_THM] THEN
19378  DISCH_THEN(X_CHOOSE_THEN ``b:num->real`` STRIP_ASSUME_TAC) THEN
19379  SUBGOAL_THEN ``bounded(IMAGE (b:num->real) { 1n.. 1n})`` MP_TAC THENL
19380   [SIMP_TAC std_ss [FINITE_IMP_BOUNDED, IMAGE_FINITE, FINITE_NUMSEG], ALL_TAC] THEN
19381  SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE, IN_NUMSEG] THEN
19382  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
19383  X_GEN_TAC ``s:real->bool`` THEN DISCH_TAC THEN
19384  X_GEN_TAC ``x:real`` THEN POP_ASSUM (MP_TAC o SPEC ``x:real``) THEN
19385  ASM_CASES_TAC ``(x:real) IN s`` THEN
19386  ASM_REWRITE_TAC[] THEN
19387  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
19388  EXISTS_TAC ``e / B / &(1):real`` THEN
19389  ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_LT, LE_1] THEN
19390  X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
19391  ABBREV_TAC ``u = y - (f:real->real) x`` THEN
19392  EXISTS_TAC ``x + sum{1 .. 1} (\i. (u:real) * b i):real`` THEN
19393  ASM_SIMP_TAC std_ss [LINEAR_ADD, LINEAR_SUM, FINITE_NUMSEG, o_DEF,
19394               LINEAR_CMUL] THEN
19395  CONJ_TAC THENL [EXPAND_TAC "u" THEN SIMP_TAC std_ss [NUMSEG_SING, SUM_SING] THEN
19396                  REAL_ARITH_TAC, ALL_TAC] THEN
19397  FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [dist] THEN
19398  REWRITE_TAC[REAL_ARITH ``abs(x + y - x) = abs y:real``] THEN
19399  MATCH_MP_TAC REAL_LET_TRANS THEN
19400  EXISTS_TAC ``(dist(y,(f:real->real) x) * &(1)) * B:real`` THEN
19401  ASM_SIMP_TAC real_ss [GSYM REAL_LT_RDIV_EQ, REAL_LT, LE_1] THEN
19402  MATCH_MP_TAC SUM_ABS_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
19403  EXPAND_TAC "u" THEN SIMP_TAC std_ss [NUMSEG_SING, SUM_SING] THEN
19404  REWRITE_TAC [ABS_MUL] THEN
19405  UNDISCH_TAC ``!x. 1 <= x /\ x <= 1 ==> abs ((b:num->real) x) <= B`` THEN
19406  DISCH_THEN (MP_TAC o SPEC ``1:num``) THEN ASM_SIMP_TAC real_ss [dist] THEN
19407  DISCH_TAC THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN
19408  ASM_SIMP_TAC std_ss [ABS_POS]
19409QED
19410
19411Theorem OPEN_BIJECTIVE_LINEAR_IMAGE_EQ:
19412   !f:real->real s.
19413        linear f /\ (!x y. (f x = f y) ==> (x = y)) /\ (!y. ?x. f x = y)
19414        ==> (open(IMAGE f s) <=> open s)
19415Proof
19416  REPEAT STRIP_TAC THEN EQ_TAC THENL
19417   [DISCH_TAC, ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN
19418  SUBGOAL_THEN ``s = {x | (f:real->real) x IN IMAGE f s}``
19419  SUBST1_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
19420  MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN
19421  ASM_SIMP_TAC std_ss [LINEAR_CONTINUOUS_AT]
19422QED
19423
19424Theorem CLOSED_INJECTIVE_LINEAR_IMAGE:
19425   !f:real->real.
19426        linear f /\ (!x y. (f x = f y) ==> (x = y))
19427        ==> !s. closed s ==> closed(IMAGE f s)
19428Proof
19429  REPEAT STRIP_TAC THEN
19430  MP_TAC(ISPEC ``f:real->real`` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
19431  ASM_REWRITE_TAC[] THEN
19432  DISCH_THEN(X_CHOOSE_THEN ``g:real->real`` STRIP_ASSUME_TAC) THEN
19433  MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
19434  EXISTS_TAC ``IMAGE (f:real->real) univ(:real)`` THEN
19435  CONJ_TAC THENL
19436   [MP_TAC(ISPECL [``g:real->real``, ``IMAGE (f:real->real) univ(:real)``,
19437                   ``IMAGE (g:real->real) (IMAGE (f:real->real) s)``]
19438        CONTINUOUS_CLOSED_IN_PREIMAGE) THEN
19439    ASM_SIMP_TAC std_ss [LINEAR_CONTINUOUS_ON] THEN
19440    KNOW_TAC ``closed (IMAGE (g:real->real) (IMAGE (f:real->real) s))`` THENL
19441     [ASM_REWRITE_TAC[GSYM IMAGE_COMPOSE, IMAGE_ID],
19442      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
19443    MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN
19444    FIRST_X_ASSUM(MP_TAC o SIMP_RULE std_ss [FUN_EQ_THM]) THEN
19445    SIMP_TAC std_ss [EXTENSION, o_THM, I_THM] THEN SET_TAC[],
19446    MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN
19447    ASM_REWRITE_TAC[IN_UNIV, SUBSPACE_UNIV, CLOSED_UNIV] THEN
19448    X_GEN_TAC ``x:real`` THEN
19449    DISCH_THEN(MP_TAC o AP_TERM ``g:real->real``) THEN
19450    RULE_ASSUM_TAC(SIMP_RULE std_ss [FUN_EQ_THM, I_THM, o_THM]) THEN
19451    ASM_MESON_TAC[LINEAR_0]]
19452QED
19453
19454Theorem CLOSED_INJECTIVE_LINEAR_IMAGE_EQ:
19455   !f:real->real s.
19456        linear f /\ (!x y. (f x = f y) ==> (x = y))
19457        ==> (closed(IMAGE f s) <=> closed s)
19458Proof
19459  REPEAT STRIP_TAC THEN EQ_TAC THENL
19460   [DISCH_TAC, ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN
19461  SUBGOAL_THEN ``s = {x | (f:real->real) x IN IMAGE f s}``
19462  SUBST1_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
19463  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
19464  ASM_SIMP_TAC std_ss [LINEAR_CONTINUOUS_AT]
19465QED
19466
19467Theorem CLOSURE_LINEAR_IMAGE_SUBSET:
19468   !f:real->real s.
19469        linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)
19470Proof
19471  REPEAT STRIP_TAC THEN
19472  MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN
19473  ASM_SIMP_TAC std_ss [CLOSED_CLOSURE, CLOSURE_SUBSET, LINEAR_CONTINUOUS_ON]
19474QED
19475
19476Theorem CLOSURE_INJECTIVE_LINEAR_IMAGE:
19477   !f:real->real s.
19478        linear f /\ (!x y. (f x = f y) ==> (x = y))
19479        ==> (closure(IMAGE f s) = IMAGE f (closure s))
19480Proof
19481  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
19482  ASM_SIMP_TAC std_ss [CLOSURE_LINEAR_IMAGE_SUBSET] THEN
19483  MATCH_MP_TAC CLOSURE_MINIMAL THEN
19484  SIMP_TAC std_ss [CLOSURE_SUBSET, IMAGE_SUBSET] THEN
19485  ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE, CLOSED_CLOSURE]
19486QED
19487
19488Theorem CLOSURE_BOUNDED_LINEAR_IMAGE:
19489   !f:real->real s.
19490        linear f /\ bounded s
19491        ==> (closure(IMAGE f s) = IMAGE f (closure s))
19492Proof
19493  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
19494  ASM_SIMP_TAC std_ss [CLOSURE_LINEAR_IMAGE_SUBSET] THEN
19495  MATCH_MP_TAC CLOSURE_MINIMAL THEN
19496  SIMP_TAC std_ss [CLOSURE_SUBSET, IMAGE_SUBSET] THEN
19497  MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
19498  MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN
19499  ASM_REWRITE_TAC[COMPACT_CLOSURE]
19500QED
19501
19502Theorem LINEAR_INTERIOR_IMAGE_SUBSET:
19503   !f:real->real s.
19504        linear f /\ (!x y. (f x = f y) ==> (x = y))
19505       ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)
19506Proof
19507  MESON_TAC[INTERIOR_IMAGE_SUBSET, LINEAR_CONTINUOUS_AT]
19508QED
19509
19510Theorem LINEAR_IMAGE_SUBSET_INTERIOR:
19511   !f:real->real s.
19512        linear f /\ (!y. ?x. f x = y)
19513        ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)
19514Proof
19515  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN
19516  ASM_SIMP_TAC std_ss [OPEN_SURJECTIVE_LINEAR_IMAGE, OPEN_INTERIOR,
19517               IMAGE_SUBSET, INTERIOR_SUBSET]
19518QED
19519
19520Theorem INTERIOR_BIJECTIVE_LINEAR_IMAGE:
19521   !f:real->real s.
19522        linear f /\ (!x y. (f x = f y) ==> (x = y)) /\ (!y. ?x. f x = y)
19523        ==> (interior(IMAGE f s) = IMAGE f (interior s))
19524Proof
19525  ONCE_REWRITE_TAC [GSYM SURJECTIVE_IMAGE] THEN REPEAT STRIP_TAC THEN
19526  REWRITE_TAC [interior] THEN
19527  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE] THEN
19528  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
19529  [FIRST_ASSUM (MP_TAC o SPEC ``t:real->bool``) THEN
19530   STRIP_TAC THEN UNDISCH_TAC ``(t:real->bool) SUBSET IMAGE (f:real->real) s`` THEN
19531   DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SIMP_RULE std_ss [SUBSET_DEF, IN_IMAGE]) THEN
19532   DISCH_THEN (MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN
19533   EXISTS_TAC ``x':real`` THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC ``s':real->bool`` THEN
19534   REPEAT CONJ_TAC THENL
19535   [UNDISCH_TAC ``open t`` THEN MATCH_MP_TAC EQ_IMPLIES THEN
19536    EXPAND_TAC "t" THEN MATCH_MP_TAC OPEN_BIJECTIVE_LINEAR_IMAGE_EQ THEN
19537    METIS_TAC [SURJECTIVE_IMAGE],
19538    UNDISCH_TAC ``IMAGE (f:real->real) s' = t`` THEN REWRITE_TAC [EXTENSION] THEN
19539    DISCH_THEN (MP_TAC o SPEC ``(f:real->real) x'``) THEN SIMP_TAC std_ss [IN_IMAGE] THEN
19540    METIS_TAC [],
19541    REWRITE_TAC [SUBSET_DEF] THEN X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
19542    UNDISCH_TAC ``IMAGE (f:real->real) s' = t`` THEN REWRITE_TAC [EXTENSION] THEN
19543    DISCH_THEN (MP_TAC o SPEC ``(f:real->real) y``) THEN REWRITE_TAC [IN_IMAGE] THEN
19544    KNOW_TAC ``(?x. (f y = (f:real->real) x) /\ x IN s')`` THENL
19545    [METIS_TAC [], ALL_TAC] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
19546    DISCH_TAC THEN UNDISCH_TAC ``t SUBSET IMAGE (f:real->real) s`` THEN
19547    REWRITE_TAC [SUBSET_DEF] THEN DISCH_THEN (MP_TAC o SPEC ``(f:real->real) y``) THEN
19548    ASM_REWRITE_TAC [] THEN REWRITE_TAC [IN_IMAGE] THEN STRIP_TAC THEN
19549    METIS_TAC []], ALL_TAC] THEN
19550  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
19551  STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC ``t:real->bool``) THEN
19552  STRIP_TAC THEN EXISTS_TAC ``IMAGE (f:real->real) t`` THEN
19553  REPEAT CONJ_TAC THENL
19554  [UNDISCH_TAC ``open t`` THEN MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN
19555   METIS_TAC [SURJECTIVE_IMAGE],
19556   REWRITE_TAC [IN_IMAGE] THEN EXISTS_TAC ``x':real`` THEN
19557   ASM_REWRITE_TAC [],
19558   MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC []]
19559QED
19560
19561(* ------------------------------------------------------------------------- *)
19562(* Corollaries, reformulations and special cases for M = N.                  *)
19563(* ------------------------------------------------------------------------- *)
19564
19565Theorem IN_INTERIOR_LINEAR_IMAGE:
19566   !f:real->real g s x.
19567        linear f /\ linear g /\ (f o g = I) /\ x IN interior s
19568        ==> (f x) IN interior (IMAGE f s)
19569Proof
19570  SIMP_TAC std_ss [FUN_EQ_THM, o_THM, I_THM] THEN REPEAT STRIP_TAC THEN
19571  MP_TAC(ISPECL [``f:real->real``, ``s:real->bool``]
19572    LINEAR_IMAGE_SUBSET_INTERIOR) THEN
19573  ASM_SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE] THEN
19574  ASM_MESON_TAC[]
19575QED
19576
19577Theorem LINEAR_OPEN_MAPPING:
19578   !f:real->real g.
19579        linear f /\ linear g /\ (f o g = I)
19580        ==> !s. open s ==> open(IMAGE f s)
19581Proof
19582  REPEAT GEN_TAC THEN SIMP_TAC std_ss [FUN_EQ_THM, o_THM, I_THM] THEN DISCH_TAC THEN
19583  MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN
19584  ASM_MESON_TAC[]
19585QED
19586
19587Theorem INTERIOR_INJECTIVE_LINEAR_IMAGE:
19588   !f:real->real s.
19589        linear f /\ (!x y. (f x = f y) ==> (x = y))
19590        ==> (interior(IMAGE f s) = IMAGE f (interior s))
19591Proof
19592  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN
19593  METIS_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]
19594QED
19595
19596Theorem COMPLETE_INJECTIVE_LINEAR_IMAGE:
19597   !f:real->real.
19598        linear f /\ (!x y. (f x = f y) ==> (x = y))
19599        ==> !s. complete s ==> complete(IMAGE f s)
19600Proof
19601  REWRITE_TAC[COMPLETE_EQ_CLOSED, CLOSED_INJECTIVE_LINEAR_IMAGE]
19602QED
19603
19604Theorem COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ:
19605   !f:real->real s.
19606        linear f /\ (!x y. (f x = f y) ==> (x = y))
19607        ==> (complete(IMAGE f s) <=> complete s)
19608Proof
19609  REWRITE_TAC[COMPLETE_EQ_CLOSED, CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]
19610QED
19611
19612Theorem LIMPT_INJECTIVE_LINEAR_IMAGE_EQ:
19613   !f:real->real s.
19614        linear f /\ (!x y. (f x = f y) ==> (x = y))
19615        ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)
19616Proof
19617  SIMP_TAC std_ss [LIMPT_APPROACHABLE, EXISTS_IN_IMAGE] THEN
19618  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN
19619  DISCH_TAC THENL
19620   [MP_TAC(ISPEC ``f:real->real`` LINEAR_INJECTIVE_BOUNDED_BELOW_POS),
19621    MP_TAC(ISPEC ``f:real->real`` LINEAR_BOUNDED_POS)] THEN
19622  ASM_REWRITE_TAC [] THEN
19623  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THENL
19624   [UNDISCH_TAC ``!(e :real).
19625        (0 :real) < e ==>
19626        ?(x' :real).
19627          x' IN (s :real -> bool) /\
19628          (f :real -> real) x' <> f (x :real) /\
19629          (dist (f x',f x) :real) < e`` THEN
19630    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``e * B:real``),
19631    UNDISCH_TAC ``!(e :real).
19632        (0 :real) < e ==>
19633        ?(x' :real).
19634          x' IN (s :real -> bool) /\ x' <> (x :real) /\
19635          (dist (x',x) :real) < e`` THEN DISCH_TAC THEN
19636    FIRST_X_ASSUM(MP_TAC o SPEC ``e / B:real``)] THEN
19637  ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_LT_MUL, dist, GSYM LINEAR_SUB] THEN
19638  DISCH_THEN (X_CHOOSE_TAC ``y:real``) THEN EXISTS_TAC ``y:real`` THEN
19639  POP_ASSUM MP_TAC THEN
19640  REPEAT(MATCH_MP_TAC MONO_AND THEN
19641         CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC]) THEN
19642  ASM_SIMP_TAC real_ss [GSYM REAL_LT_LDIV_EQ, REAL_LT_RDIV_EQ] THEN
19643  MATCH_MP_TAC(REAL_ARITH ``a <= b ==> b < x ==> a < x:real``) THEN
19644  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC real_ss [REAL_LE_RDIV_EQ]
19645QED
19646
19647(* ------------------------------------------------------------------------- *)
19648(* Even more special cases.                                                  *)
19649(* ------------------------------------------------------------------------- *)
19650
19651Theorem INTERIOR_NEGATIONS:
19652   !s. interior(IMAGE (\x. -x) s) = IMAGE (\x. -x) (interior s)
19653Proof
19654  GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN
19655  SIMP_TAC std_ss [linear] THEN REPEAT CONJ_TAC THEN REAL_ARITH_TAC
19656QED
19657
19658Theorem SYMMETRIC_INTERIOR:
19659   !s:real->bool.
19660        (!x. x IN s ==> -x IN s)
19661        ==> !x. x IN interior s ==> (-x) IN interior s
19662Proof
19663  REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
19664  DISCH_THEN(MP_TAC o MATCH_MP(ISPEC ``(\x. -x):real->real`` FUN_IN_IMAGE)) THEN
19665  SIMP_TAC std_ss [GSYM INTERIOR_NEGATIONS] THEN
19666  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
19667  SIMP_TAC std_ss [EXTENSION, IN_IMAGE] THEN METIS_TAC[REAL_NEG_NEG]
19668QED
19669
19670Theorem CLOSURE_NEGATIONS:
19671   !s. closure(IMAGE (\x. -x) s) = IMAGE (\x. -x) (closure s)
19672Proof
19673  GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
19674  SIMP_TAC std_ss [linear] THEN REPEAT CONJ_TAC THEN REAL_ARITH_TAC
19675QED
19676
19677Theorem SYMMETRIC_CLOSURE:
19678   !s:real->bool.
19679        (!x. x IN s ==> -x IN s)
19680        ==> !x. x IN closure s ==> (-x) IN closure s
19681Proof
19682  REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
19683  DISCH_THEN(MP_TAC o MATCH_MP(ISPEC ``(\x. -x):real->real`` FUN_IN_IMAGE)) THEN
19684  SIMP_TAC std_ss [GSYM CLOSURE_NEGATIONS] THEN
19685  MATCH_MP_TAC EQ_IMPLIES THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
19686  SIMP_TAC std_ss [EXTENSION, IN_IMAGE] THEN ASM_MESON_TAC[REAL_NEG_NEG]
19687QED
19688
19689(* ------------------------------------------------------------------------- *)
19690(* Some properties of a canonical subspace.                                  *)
19691(* ------------------------------------------------------------------------- *)
19692
19693Theorem SUBSPACE_SUBSTANDARD:
19694   subspace {x:real | (x = &0)}
19695Proof
19696  SIMP_TAC std_ss [subspace, GSPECIFICATION, REAL_MUL_RZERO, REAL_ADD_LID]
19697QED
19698
19699Theorem CLOSED_SUBSTANDARD:
19700   closed {x:real | x = &0}
19701Proof
19702  REWRITE_TAC [GSPEC_EQ, CLOSED_SING]
19703QED
19704
19705Theorem DIM_SUBSTANDARD :
19706    dim {x:real | x = &0} = 0
19707Proof
19708  REWRITE_TAC [dim, GSPEC_EQ] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
19709  RW_TAC std_ss [] THEN EQ_TAC THENL
19710  [ONCE_REWRITE_TAC [MONO_NOT_EQ] THEN RW_TAC std_ss [] THEN
19711   ASM_CASES_TAC ``~(b SUBSET {0:real})`` THEN
19712   ASM_REWRITE_TAC [] THEN FULL_SIMP_TAC std_ss [SET_RULE
19713    ``b SUBSET {0:real} <=> (b = {}) \/ (b = {0})``] THENL
19714   [DISJ2_TAC THEN DISJ2_TAC THEN SIMP_TAC std_ss' [HAS_SIZE] THEN
19715    DISJ2_TAC THEN REWRITE_TAC [CARD_EMPTY] THEN METIS_TAC [],
19716    REWRITE_TAC [INDEPENDENT_SING]], ALL_TAC] THEN
19717  DISCH_TAC THEN EXISTS_TAC ``{}:real->bool`` THEN
19718  ASM_SIMP_TAC std_ss [SPAN_EMPTY, SUBSET_REFL, EMPTY_SUBSET, INDEPENDENT_EMPTY] THEN
19719  ASM_REWRITE_TAC [HAS_SIZE_0]
19720QED
19721
19722(* ------------------------------------------------------------------------- *)
19723(* Affine transformations of intervals.                                      *)
19724(* ------------------------------------------------------------------------- *)
19725
19726Theorem AFFINITY_INVERSES:
19727   !m c. ~(m = &0:real)
19728         ==> ((\x. m * x + c) o (\x. inv(m) * x + (-(inv(m) * c))) = (\x. x)) /\
19729             ((\x. inv(m) * x + (-(inv(m) * c))) o (\x. m * x + c) = (\x. x))
19730Proof
19731  SIMP_TAC std_ss [FUN_EQ_THM, o_THM] THEN
19732  SIMP_TAC std_ss [REAL_ADD_LDISTRIB, REAL_MUL_RNEG] THEN
19733  SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_RINV] THEN
19734  REPEAT STRIP_TAC THEN REAL_ARITH_TAC
19735QED
19736
19737Theorem REAL_AFFINITY_LE:
19738   !m c x y. &0:real < m ==> ((m * x + c <= y) <=> (x <= inv(m) * y + -(c / m)))
19739Proof
19740  REWRITE_TAC[REAL_ARITH ``(m * x + c <= y:real) <=> (x * m <= y - c)``] THEN
19741  SIMP_TAC std_ss [GSYM REAL_LE_RDIV_EQ] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
19742  REWRITE_TAC [real_div, GSYM real_sub, REAL_SUB_RDISTRIB]
19743QED
19744
19745Theorem REAL_LE_AFFINITY:
19746   !m c x y. &0:real < m ==> ((y <= m * x + c) <=> (inv(m) * y + -(c / m) <= x))
19747Proof
19748  REWRITE_TAC[REAL_ARITH ``(y <= m * x + c:real) <=> (y - c <= x * m)``] THEN
19749  SIMP_TAC std_ss [GSYM REAL_LE_LDIV_EQ] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
19750  REWRITE_TAC [real_div, GSYM real_sub, REAL_SUB_RDISTRIB]
19751QED
19752
19753Theorem REAL_AFFINITY_LT:
19754   !m c x y. &0:real < m ==> (m * x + c < y <=> x < inv(m) * y + -(c / m))
19755Proof
19756  SIMP_TAC std_ss [REAL_LE_AFFINITY, GSYM REAL_NOT_LE]
19757QED
19758
19759Theorem REAL_LT_AFFINITY:
19760   !m c x y. &0:real < m ==> (y < m * x + c <=> inv(m) * y + -(c / m) < x)
19761Proof
19762  SIMP_TAC std_ss [REAL_AFFINITY_LE, GSYM REAL_NOT_LE]
19763QED
19764
19765Theorem REAL_AFFINITY_EQ:
19766   !m c x y. ~(m = &0:real) ==> ((m * x + c = y) <=> (x = inv(m) * y + -(c / m)))
19767Proof
19768  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
19769  REWRITE_TAC [real_div, GSYM real_sub, GSYM REAL_SUB_RDISTRIB] THEN
19770  REWRITE_TAC [GSYM REAL_EQ_SUB_LADD, GSYM real_div] THEN
19771  REPEAT STRIP_TAC THEN EQ_TAC THENL
19772  [GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISCH_TAC THEN
19773   ASM_SIMP_TAC arith_ss [real_div, GSYM REAL_MUL_ASSOC, REAL_MUL_RINV,
19774   REAL_MUL_RID], DISCH_TAC THEN METIS_TAC [REAL_DIV_RMUL]]
19775QED
19776
19777Theorem REAL_EQ_AFFINITY:
19778   !m c x y. ~(m = &0:real) ==> ((y = m * x + c)  <=> (inv(m) * y + -(c / m) = x))
19779Proof
19780  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
19781  REWRITE_TAC [real_div, GSYM real_sub, GSYM REAL_SUB_RDISTRIB] THEN
19782  REPEAT STRIP_TAC THEN GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN
19783  REWRITE_TAC [GSYM REAL_EQ_SUB_LADD, GSYM real_div] THEN EQ_TAC THENL
19784  [GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISCH_TAC THEN
19785   ASM_SIMP_TAC arith_ss [real_div, GSYM REAL_MUL_ASSOC, REAL_MUL_RINV,
19786   REAL_MUL_RID], DISCH_TAC THEN METIS_TAC [REAL_DIV_RMUL]]
19787QED
19788
19789Theorem IMAGE_AFFINITY_INTERVAL:
19790   !a b:real m c.
19791        IMAGE (\x. m * x + c) (interval[a,b]) =
19792            if interval[a,b] = {} then {}
19793            else if &0 <= m then interval[m * a + c,m * b + c]
19794            else interval[m * b + c,m * a + c]
19795Proof
19796  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_EMPTY, IMAGE_INSERT] THEN
19797  ASM_CASES_TAC ``m = &0:real`` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL
19798   [ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, COND_ID] THEN
19799    REWRITE_TAC[INTERVAL_SING] THEN ASM_SET_TAC[],
19800    ALL_TAC] THEN
19801  FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
19802   ``~(x = &0:real) ==> &0 < x \/ &0 < -x``)) THEN
19803  ASM_SIMP_TAC std_ss [EXTENSION, IN_IMAGE, REAL_ARITH ``&0 < -x ==> ~(&0 < x:real)``] THENL
19804   [ALL_TAC,
19805    ONCE_REWRITE_TAC[REAL_ARITH ``(x = m * y + c:real) <=> (c = (-m) * y + x)``]] THEN
19806  (ASM_SIMP_TAC std_ss [REAL_EQ_AFFINITY, REAL_LT_IMP_NE, UNWIND_THM1] THEN
19807  SIMP_TAC std_ss [IN_INTERVAL] THEN
19808  POP_ASSUM(MP_TAC o ONCE_REWRITE_RULE [GSYM REAL_LT_INV_EQ]) THEN
19809  SIMP_TAC std_ss [REAL_AFFINITY_LE, REAL_LE_AFFINITY, real_div] THEN
19810  DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN
19811  REWRITE_TAC[REAL_MUL_LNEG, REAL_NEGNEG] THEN
19812  KNOW_TAC ``-m <> 0:real`` THENL [ASM_REAL_ARITH_TAC, DISCH_TAC] THEN
19813  ASM_SIMP_TAC std_ss [METIS [REAL_MUL_RID, GSYM REAL_MUL_ASSOC, REAL_MUL_RINV,
19814   REAL_ARITH ``b * inv a * a = b * a * inv a:real``]
19815   ``m <> 0:real ==> (x * inv m * m = x)``] THEN
19816  GEN_TAC THEN ONCE_REWRITE_TAC [REAL_ADD_SYM] THEN REWRITE_TAC [GSYM real_sub] THEN
19817  REAL_ARITH_TAC)
19818QED
19819
19820(* ------------------------------------------------------------------------- *)
19821(* Infinite sums of vectors. Allow general starting point (and more).        *)
19822(* ------------------------------------------------------------------------- *)
19823
19824val _ = hide "sums";
19825val _ = hide "summable";
19826
19827val _ = set_fixity "sums" (Infix(NONASSOC, 450));
19828
19829Definition sums_def : (* cf. seqTheory.sums *)
19830   (f sums l) s = ((\n. sum (s INTER { 0n..n}) f) --> l) sequentially
19831End
19832val sums = sums_def;
19833
19834Definition suminf_def : (* cf. seqTheory.suminf *)
19835    infsum s f = @l. (f sums l) s
19836End
19837Overload suminf = ``infsum``
19838val infsum = suminf_def;
19839
19840Definition summable_def : (* cf. seqTheory.summable *)
19841    summable s f = ?l. (f sums l) s
19842End
19843val summable = summable_def;
19844
19845Theorem SUMS_SUMMABLE:
19846   !f l s. (f sums l) s ==> summable s f
19847Proof
19848  REWRITE_TAC[summable] THEN MESON_TAC[]
19849QED
19850
19851Theorem SUMS_INFSUM:
19852   !f s. (f sums (infsum s f)) s <=> summable s f
19853Proof
19854  REWRITE_TAC[infsum, summable] THEN METIS_TAC[]
19855QED
19856
19857Theorem SUMS_LIM:
19858   !f:num->real s.
19859      (f sums lim sequentially (\n. sum (s INTER { 0n..n}) f)) s
19860      <=> summable s f
19861Proof
19862  GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable],
19863  REWRITE_TAC[summable, sums] THEN STRIP_TAC THEN REWRITE_TAC[reallim] THEN
19864  METIS_TAC[]]
19865QED
19866
19867Theorem FINITE_INTER_NUMSEG:
19868   !s m n. FINITE(s INTER {m..n})
19869Proof
19870  MESON_TAC[SUBSET_FINITE_I, FINITE_NUMSEG, INTER_SUBSET]
19871QED
19872
19873Theorem SERIES_FROM:
19874   !f l k. (f sums l) (from k) = ((\n. sum{k..n} f) --> l) sequentially
19875Proof
19876  REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN
19877  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
19878  AP_THM_TAC THEN AP_TERM_TAC THEN
19879  SIMP_TAC std_ss [EXTENSION, numseg, from_def, GSPECIFICATION, IN_INTER] THEN ARITH_TAC
19880QED
19881
19882Theorem SERIES_UNIQUE:
19883   !f:num->real l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')
19884Proof
19885  REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY, LIM_UNIQUE]
19886QED
19887
19888Theorem INFSUM_UNIQUE:
19889   !f:num->real l s. (f sums l) s ==> (infsum s f = l)
19890Proof
19891  MESON_TAC[SERIES_UNIQUE, SUMS_INFSUM, summable]
19892QED
19893
19894Theorem SERIES_TERMS_TOZERO:
19895   !f l n. (f sums l) (from n) ==> (f --> 0) sequentially
19896Proof
19897  REPEAT GEN_TAC THEN SIMP_TAC std_ss [sums, LIM_SEQUENTIALLY, FROM_INTER_NUMSEG] THEN
19898  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
19899  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
19900  ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC ``N:num``) THEN
19901  EXISTS_TAC ``N + n + 1:num`` THEN X_GEN_TAC ``m:num`` THEN DISCH_TAC THEN
19902  FIRST_X_ASSUM(fn th =>
19903    MP_TAC(SPEC ``m - 1:num`` th) THEN MP_TAC(SPEC ``m:num`` th)) THEN
19904  SUBGOAL_THEN ``0 < m:num /\ n <= m`` (fn th => SIMP_TAC std_ss [SUM_CLAUSES_RIGHT, th])
19905  THENL [CONJ_TAC THENL
19906   [MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN EXISTS_TAC ``N + n + 1:num`` THEN
19907    ASM_REWRITE_TAC [] THEN ARITH_TAC,
19908    MATCH_MP_TAC LESS_EQ_TRANS THEN EXISTS_TAC ``N + n + 1:num`` THEN
19909    ASM_REWRITE_TAC [] THEN ARITH_TAC], ALL_TAC] THEN
19910  KNOW_TAC ``N <= m:num`` THENL [MATCH_MP_TAC LESS_EQ_TRANS THEN
19911   EXISTS_TAC ``N + n + 1:num`` THEN ASM_REWRITE_TAC [] THEN ARITH_TAC,
19912  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_TAC] THEN
19913  KNOW_TAC ``N <= m:num - 1`` THENL [MATCH_MP_TAC LESS_EQ_TRANS THEN
19914   EXISTS_TAC ``N + n:num`` THEN CONJ_TAC THENL [ARITH_TAC, ALL_TAC] THEN
19915   ONCE_REWRITE_TAC [ARITH_PROVE ``(a <= b) = (a + 1 <= b + 1:num)``] THEN
19916   MATCH_MP_TAC LESS_EQ_TRANS THEN EXISTS_TAC ``m:num`` THEN
19917   ASM_REWRITE_TAC [] THEN ARITH_TAC,
19918  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN DISCH_TAC] THEN
19919  REWRITE_TAC [DIST_0] THEN GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
19920  FULL_SIMP_TAC std_ss [dist] THEN ASM_REAL_ARITH_TAC
19921QED
19922
19923Theorem SERIES_FINITE:
19924   !f s. FINITE s ==> (f sums (sum s f)) s
19925Proof
19926  REPEAT GEN_TAC THEN SIMP_TAC std_ss [num_FINITE, LEFT_IMP_EXISTS_THM] THEN
19927  X_GEN_TAC ``n:num`` THEN SIMP_TAC std_ss [sums, LIM_SEQUENTIALLY] THEN
19928  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN EXISTS_TAC ``n:num`` THEN
19929  X_GEN_TAC ``m:num`` THEN DISCH_TAC THEN
19930  SUBGOAL_THEN ``s INTER { 0n..m} = s``
19931   (fn th => ASM_REWRITE_TAC[th, DIST_REFL]) THEN
19932  SIMP_TAC std_ss [EXTENSION, IN_INTER, IN_NUMSEG, ZERO_LESS_EQ] THEN
19933  METIS_TAC[LESS_EQ_TRANS]
19934QED
19935
19936Theorem SERIES_LINEAR:
19937   !f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s
19938Proof
19939  SIMP_TAC std_ss [sums, LIM_LINEAR, FINITE_INTER, FINITE_NUMSEG,
19940           GSYM(REWRITE_RULE[o_DEF] LINEAR_SUM)]
19941QED
19942
19943Theorem SERIES_0:
19944   !s. ((\n. 0) sums (0)) s
19945Proof
19946  REWRITE_TAC[sums, SUM_0', LIM_CONST]
19947QED
19948
19949Theorem SERIES_ADD:
19950   !x x0 y y0 s.
19951     (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s
19952Proof
19953  SIMP_TAC std_ss [sums, FINITE_INTER_NUMSEG, SUM_ADD', LIM_ADD]
19954QED
19955
19956Theorem SERIES_SUB:
19957   !x x0 y y0 s.
19958     (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s
19959Proof
19960  SIMP_TAC std_ss [sums, FINITE_INTER_NUMSEG, SUM_SUB', LIM_SUB]
19961QED
19962
19963Theorem SERIES_CMUL:
19964   !x x0 c s. (x sums x0) s ==> ((\n. c * x n) sums (c * x0)) s
19965Proof
19966  SIMP_TAC std_ss [sums, FINITE_INTER_NUMSEG, SUM_LMUL, LIM_CMUL]
19967QED
19968
19969Theorem SERIES_NEG:
19970   !x x0 s. (x sums x0) s ==> ((\n. -(x n)) sums (-x0)) s
19971Proof
19972  SIMP_TAC std_ss [sums, FINITE_INTER_NUMSEG, SUM_NEG', LIM_NEG]
19973QED
19974
19975Theorem SUMS_IFF:
19976   !f g k. (!x. x IN k ==> (f x = g x)) ==> ((f sums l) k <=> (g sums l) k)
19977Proof
19978  REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN
19979  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
19980  MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC std_ss [IN_INTER]
19981QED
19982
19983Theorem SUMS_EQ:
19984   !f g k. (!x. x IN k ==> (f x = g x)) /\ (f sums l) k ==> (g sums l) k
19985Proof
19986  MESON_TAC[SUMS_IFF]
19987QED
19988
19989Theorem SUMS_0:
19990   !f:num->real s. (!n. n IN s ==> (f n = 0)) ==> (f sums 0) s
19991Proof
19992  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN
19993  EXISTS_TAC ``\n:num. 0:real`` THEN ASM_SIMP_TAC std_ss [SERIES_0]
19994QED
19995
19996Theorem SERIES_FINITE_SUPPORT:
19997   !f:num->real s k.
19998     FINITE (s INTER k) /\ (!x. x IN k /\ ~(x IN s) ==> (f x = 0))
19999     ==> (f sums sum (s INTER k) f) k
20000Proof
20001  REWRITE_TAC[sums, LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN
20002  FIRST_ASSUM(MP_TAC o ISPEC ``\x:num. x`` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
20003  REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN
20004  EXISTS_TAC ``N:num`` THEN POP_ASSUM MP_TAC THEN
20005  STRIP_TAC THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
20006  SIMP_TAC std_ss [] THEN
20007  SUBGOAL_THEN ``sum (k INTER { 0n..n}) (f:num->real) = sum(s INTER k) f``
20008   (fn th => ASM_SIMP_TAC std_ss [DIST_REFL, th]) THEN
20009  MATCH_MP_TAC SUM_SUPERSET THEN
20010  ASM_SIMP_TAC std_ss [SUBSET_DEF, IN_INTER, IN_NUMSEG, ZERO_LESS_EQ] THEN
20011  METIS_TAC[IN_INTER, LESS_EQ_TRANS]
20012QED
20013
20014Theorem SERIES_COMPONENT:
20015   !f s l:real. (f sums l) s
20016          ==> ((\i. f(i)) sums l) s
20017Proof
20018  METIS_TAC []
20019QED
20020
20021Theorem SERIES_DIFFS:
20022   !f:num->real k. (f --> 0) sequentially
20023        ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)
20024Proof
20025  REWRITE_TAC[sums, FROM_INTER_NUMSEG, SUM_DIFFS'] THEN
20026  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
20027  EXISTS_TAC ``\n. (f:num->real) k - f(n + 1)`` THEN CONJ_TAC THENL
20028   [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC ``k:num`` THEN
20029    SIMP_TAC std_ss [],
20030    GEN_REWR_TAC LAND_CONV [GSYM REAL_SUB_RZERO] THEN
20031    KNOW_TAC ``((\n. (\n. f k) n - (\n. f (n + 1)) n)
20032                   --> ((f:num->real) k - 0)) sequentially`` THENL
20033    [ALL_TAC, SIMP_TAC std_ss []] THEN
20034    MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN
20035    MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]
20036QED
20037
20038Theorem SERIES_TRIVIAL:
20039   !f. (f sums 0) {}
20040Proof
20041  SIMP_TAC std_ss [sums, INTER_EMPTY, SUM_CLAUSES, LIM_CONST]
20042QED
20043
20044Theorem SERIES_RESTRICT:
20045   !f k l:real.
20046        ((\n. if n IN k then f(n) else 0) sums l) univ(:num) <=>
20047        (f sums l) k
20048Proof
20049  REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN
20050  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
20051  REWRITE_TAC[FUN_EQ_THM, INTER_UNIV] THEN GEN_TAC THEN
20052  SIMP_TAC std_ss [] THEN
20053  MATCH_MP_TAC(METIS [] ``(sum s f = sum t f) /\ (sum t f = sum t g)
20054                        ==> (sum s f = sum t g)``) THEN
20055  CONJ_TAC THENL
20056   [MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[],
20057    MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [IN_INTER]]
20058QED
20059
20060Theorem SERIES_SUM:
20061   !f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> (f x = 0)) /\
20062             (sum s f = l) ==> (f sums l) k
20063Proof
20064  REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN
20065  SUBGOAL_THEN ``s INTER k = s:num->bool`` ASSUME_TAC THENL
20066   [ASM_SET_TAC [], ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]
20067QED
20068
20069Theorem SUMS_REINDEX:
20070   !k a l:real n.
20071   ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))
20072Proof
20073  REPEAT GEN_TAC THEN REWRITE_TAC[sums, FROM_INTER_NUMSEG] THEN
20074  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_OFFSET'] THEN
20075  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
20076  ASM_MESON_TAC[ARITH_PROVE ``N + k:num <= n ==> (n = (n - k) + k) /\ N <= n - k``,
20077                ARITH_PROVE ``N + k:num <= n ==> N <= n + k``]
20078QED
20079
20080Theorem SUMS_REINDEX_GEN:
20081   !k a l:real s.
20082     ((\x. a(x + k)) sums l) s <=> (a sums l) (IMAGE (\i. i + k) s)
20083Proof
20084  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
20085  MP_TAC(ISPECL
20086   [``k:num``,
20087    ``\i. if i IN IMAGE (\i. i + k) s then (a:num->real) i else 0``,
20088    ``l:real``, ``0:num``] SUMS_REINDEX) THEN
20089  REWRITE_TAC[FROM_0] THEN
20090  SIMP_TAC std_ss [EQ_ADD_RCANCEL, SET_RULE
20091   ``(!x y:num. (x + k = y + k) <=> (x = y))
20092         ==> ((x + k) IN IMAGE (\i. i + k) s <=> x IN s)``] THEN
20093  DISCH_THEN SUBST1_TAC THEN
20094  GEN_REWR_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN
20095  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
20096  REWRITE_TAC[FUN_EQ_THM, IN_FROM, ADD_CLAUSES] THEN
20097  SUBGOAL_THEN ``!x:num. x IN IMAGE (\i. i + k) s ==> k <= x`` MP_TAC THENL
20098   [SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN ARITH_TAC, SET_TAC[]]
20099QED
20100
20101(* ------------------------------------------------------------------------- *)
20102(* Similar combining theorems just for summability.                          *)
20103(* ------------------------------------------------------------------------- *)
20104
20105Theorem SUMMABLE_LINEAR:
20106   !f h s. summable s f /\ linear h ==> summable s (\n. h(f n))
20107Proof
20108  REWRITE_TAC[summable] THEN METIS_TAC[SERIES_LINEAR]
20109QED
20110
20111Theorem SUMMABLE_0:
20112   !s. summable s (\n. 0)
20113Proof
20114  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]
20115QED
20116
20117Theorem SUMMABLE_ADD:
20118   !x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)
20119Proof
20120  REWRITE_TAC[summable] THEN METIS_TAC[SERIES_ADD]
20121QED
20122
20123Theorem SUMMABLE_SUB:
20124   !x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)
20125Proof
20126  REWRITE_TAC[summable] THEN METIS_TAC[SERIES_SUB]
20127QED
20128
20129Theorem SUMMABLE_CMUL:
20130   !s x c. summable s x ==> summable s (\n. c * x n)
20131Proof
20132  REWRITE_TAC[summable] THEN METIS_TAC[SERIES_CMUL]
20133QED
20134
20135Theorem SUMMABLE_NEG:
20136   !x s. summable s x ==> summable s (\n. -(x n))
20137Proof
20138  REWRITE_TAC[summable] THEN METIS_TAC[SERIES_NEG]
20139QED
20140
20141Theorem SUMMABLE_IFF:
20142   !f g k. (!x. x IN k ==> (f x = g x)) ==> (summable k f <=> summable k g)
20143Proof
20144  REWRITE_TAC[summable] THEN METIS_TAC[SUMS_IFF]
20145QED
20146
20147Theorem SUMMABLE_EQ:
20148   !f g k. (!x. x IN k ==> (f x = g x)) /\ summable k f ==> summable k g
20149Proof
20150  REWRITE_TAC[summable] THEN METIS_TAC[SUMS_EQ]
20151QED
20152
20153Theorem SUMMABLE_COMPONENT:
20154   !f:num->real s.
20155        summable s f ==> summable s (\i. f(i))
20156Proof
20157  METIS_TAC []
20158QED
20159
20160Theorem SERIES_SUBSET:
20161   !x s t l.
20162        s SUBSET t /\
20163        ((\i. if i IN s then x i else 0) sums l) t
20164        ==> (x sums l) s
20165Proof
20166  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
20167  REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMPLIES THEN
20168  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
20169  ASM_SIMP_TAC std_ss [GSYM SUM_RESTRICT_SET, FINITE_INTER_NUMSEG] THEN
20170  AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]
20171QED
20172
20173Theorem SUMMABLE_SUBSET:
20174   !x s t.
20175        s SUBSET t /\
20176        summable t (\i. if i IN s then x i else 0)
20177        ==> summable s x
20178Proof
20179  REWRITE_TAC[summable] THEN METIS_TAC[SERIES_SUBSET]
20180QED
20181
20182Theorem SUMMABLE_TRIVIAL:
20183   !f:num->real. summable {} f
20184Proof
20185  GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC ``0:real`` THEN
20186  REWRITE_TAC[SERIES_TRIVIAL]
20187QED
20188
20189Theorem SUMMABLE_RESTRICT:
20190   !f:num->real k.
20191        summable univ(:num) (\n. if n IN k then f(n) else 0) <=>
20192        summable k f
20193Proof
20194  SIMP_TAC std_ss [summable, SERIES_RESTRICT]
20195QED
20196
20197Theorem SUMS_FINITE_DIFF:
20198   !f:num->real t s l.
20199        t SUBSET s /\ FINITE t /\ (f sums l) s
20200        ==> (f sums (l - sum t f)) (s DIFF t)
20201Proof
20202  REPEAT GEN_TAC THEN
20203  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
20204  FIRST_ASSUM(MP_TAC o ISPEC ``f:num->real`` o MATCH_MP SERIES_FINITE) THEN
20205  ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
20206  REWRITE_TAC[AND_IMP_INTRO] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
20207  DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN
20208  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
20209  REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC ``x:num`` THEN REWRITE_TAC[IN_DIFF] THEN
20210  UNDISCH_TAC ``t SUBSET s:num->bool`` THEN DISCH_TAC THEN
20211  FIRST_ASSUM(MP_TAC o SPEC ``x:num`` o REWRITE_RULE [SUBSET_DEF]) THEN
20212  MAP_EVERY ASM_CASES_TAC [``(x:num) IN s``, ``(x:num) IN t``] THEN
20213  ASM_SIMP_TAC arith_ss [] THEN REAL_ARITH_TAC
20214QED
20215
20216Theorem SUMS_FINITE_UNION:
20217   !f:num->real s t l.
20218        FINITE t /\ (f sums l) s
20219        ==> (f sums (l + sum (t DIFF s) f)) (s UNION t)
20220Proof
20221  REPEAT GEN_TAC THEN
20222  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
20223  FIRST_ASSUM(MP_TAC o SPEC ``s:num->bool`` o MATCH_MP FINITE_DIFF) THEN
20224  DISCH_THEN(MP_TAC o ISPEC ``f:num->real`` o MATCH_MP SERIES_FINITE) THEN
20225  ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
20226  REWRITE_TAC[AND_IMP_INTRO] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
20227  DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN
20228  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
20229  REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC ``x:num`` THEN
20230  REWRITE_TAC[IN_DIFF, IN_UNION] THEN
20231  MAP_EVERY ASM_CASES_TAC [``(x:num) IN s``, ``(x:num) IN t``] THEN
20232  ASM_SIMP_TAC arith_ss [] THEN REAL_ARITH_TAC
20233QED
20234
20235Theorem SUMS_OFFSET:
20236   !f l:real m n.
20237           (f sums l) (from m) /\ 0 < n /\ m <= n
20238           ==> (f sums l - sum {m..n - 1} f) (from n)
20239Proof
20240  REPEAT STRIP_TAC THEN
20241  SUBGOAL_THEN ``from n = from m DIFF {m..n-1}`` SUBST1_TAC THENL
20242   [SIMP_TAC std_ss [EXTENSION, IN_FROM, IN_DIFF, IN_NUMSEG] THEN
20243    GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN CONJ_TAC THENL
20244     [MATCH_MP_TAC LESS_EQ_TRANS THEN EXISTS_TAC ``n:num`` THEN ASM_REWRITE_TAC [],
20245      REWRITE_TAC [NOT_LESS_EQUAL] THEN DISJ2_TAC THEN
20246      MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN EXISTS_TAC ``n:num`` THEN ASM_REWRITE_TAC [] THEN
20247      MATCH_MP_TAC SUB_LESS THEN CONJ_TAC THENL [ARITH_TAC , ALL_TAC] THEN
20248      REWRITE_TAC [ONE] THEN ASM_REWRITE_TAC [GSYM LESS_EQ]], ARITH_TAC],
20249    MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
20250    SIMP_TAC std_ss [SUBSET_DEF, IN_FROM, IN_NUMSEG]]
20251QED
20252
20253Theorem SUMS_OFFSET_REV:
20254   !f:num->real l m n.
20255        (f sums l) (from m) /\ 0 < m /\ n <= m
20256        ==> (f sums (l + sum{n..m-1} f)) (from n)
20257Proof
20258  REPEAT STRIP_TAC THEN
20259  MP_TAC(ISPECL [``f:num->real``, ``from m``, ``{n..m-1}``, ``l:real``]
20260                SUMS_FINITE_UNION) THEN
20261  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMPLIES THEN
20262  BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC, ALL_TAC] THEN
20263  REWRITE_TAC[EXTENSION, IN_DIFF, IN_UNION, IN_FROM, IN_NUMSEG] THEN
20264  ASM_SIMP_TAC arith_ss []
20265QED
20266
20267Theorem SUMMABLE_REINDEX:
20268   !k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a
20269Proof
20270  REWRITE_TAC[summable, GSYM SUMS_REINDEX]
20271QED
20272
20273Theorem SERIES_DROP_LE:
20274   !f g s a b.
20275        (f sums a) s /\ (g sums b) s /\
20276        (!x. x IN s ==> (f x <= g x))
20277        ==> a <= b
20278Proof
20279  REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN
20280  MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LE) THEN
20281  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY, TRIVIAL_LIMIT_SEQUENTIALLY] THEN
20282  EXISTS_TAC ``\n. sum (s INTER { 0n..n}) (f:num->real)`` THEN
20283  EXISTS_TAC ``\n. sum (s INTER { 0n..n}) (g:num->real)`` THEN
20284  ASM_REWRITE_TAC[] THEN EXISTS_TAC ``0:num`` THEN REPEAT STRIP_TAC THEN
20285  SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_LE THEN
20286  ASM_SIMP_TAC std_ss [FINITE_INTER, FINITE_NUMSEG, IN_INTER, IN_NUMSEG]
20287QED
20288
20289Theorem SERIES_DROP_POS:
20290   !f s a.
20291        (f sums a) s /\ (!x. x IN s ==> &0 <= f x)
20292        ==> &0 <= a
20293Proof
20294  REPEAT STRIP_TAC THEN
20295  MP_TAC(ISPECL [``(\n. 0):num->real``, ``f:num->real``, ``s:num->bool``,
20296                 ``0:real``, ``a:real``] SERIES_DROP_LE) THEN
20297  ASM_SIMP_TAC std_ss [SUMS_0]
20298QED
20299
20300Theorem SERIES_BOUND:
20301   !f:num->real g s a b.
20302        (f sums a) s /\ (g sums b) s /\
20303        (!i. i IN s ==> abs(f i) <= g i)
20304        ==> abs (a) <= b
20305Proof
20306  REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN
20307  MATCH_MP_TAC(ISPEC ``sequentially`` LIM_ABS_UBOUND) THEN
20308  EXISTS_TAC ``\n. sum (s INTER { 0n..n}) (f:num->real)`` THEN
20309  ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
20310  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC ``0:num`` THEN
20311  X_GEN_TAC ``m:num`` THEN DISCH_TAC THEN
20312  SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
20313  EXISTS_TAC ``sum (s INTER { 0n..m}) g`` THEN CONJ_TAC THEN
20314  ASM_SIMP_TAC std_ss [SUM_ABS_LE, IN_INTER, FINITE_NUMSEG, FINITE_INTER] THEN
20315  RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN
20316  UNDISCH_TAC ``(g sums b) s`` THEN
20317  GEN_REWR_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN
20318  REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC ``m + 1:num`` o MATCH_MP
20319   (ONCE_REWRITE_RULE[CONJ_EQ_IMP] SUMS_OFFSET)) THEN
20320  KNOW_TAC ``0 < m + 1 /\ 0 <= m + 1:num`` THENL
20321  [ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
20322  REWRITE_TAC[ARITH_PROVE ``0 < m + 1:num``, o_DEF, ADD_SUB] THEN
20323  SIMP_TAC std_ss [GSYM SUM_RESTRICT_SET] THEN
20324  SIMP_TAC std_ss [ETA_AX] THEN
20325  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP] SERIES_DROP_POS)) THEN
20326  REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER_DEF),
20327              REAL_SUB_LE] THEN
20328  DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN
20329  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
20330  ASM_MESON_TAC[REAL_ARITH ``abs(x:real) <= y ==> &0 <= y``]
20331QED
20332
20333(* ------------------------------------------------------------------------- *)
20334(* Similar combining theorems for infsum.                                    *)
20335(* ------------------------------------------------------------------------- *)
20336
20337Theorem INFSUM_LINEAR:
20338   !f h s. summable s f /\ linear h
20339           ==> (infsum s (\n. h(f n)) = h(infsum s f))
20340Proof
20341  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
20342  MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]
20343QED
20344
20345Theorem INFSUM_0:
20346   infsum s (\i. 0) = 0
20347Proof
20348  MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]
20349QED
20350
20351Theorem INFSUM_ADD:
20352   !x y s. summable s x /\ summable s y
20353           ==> (infsum s (\i. x i + y i) = infsum s x + infsum s y)
20354Proof
20355  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
20356  MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]
20357QED
20358
20359Theorem INFSUM_SUB:
20360   !x y s. summable s x /\ summable s y
20361           ==> (infsum s (\i. x i - y i) = infsum s x - infsum s y)
20362Proof
20363  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
20364  MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]
20365QED
20366
20367Theorem INFSUM_CMUL:
20368   !s x c. summable s x ==> (infsum s (\n. c * x n) = c * infsum s x)
20369Proof
20370  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
20371  MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]
20372QED
20373
20374Theorem INFSUM_NEG:
20375   !s x. summable s x ==> (infsum s (\n. -(x n)) = -(infsum s x))
20376Proof
20377  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
20378  MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]
20379QED
20380
20381Theorem INFSUM_EQ:
20382   !f g k. summable k f /\ summable k g /\ (!x. x IN k ==> (f x = g x))
20383           ==> (infsum k f = infsum k g)
20384Proof
20385  REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN
20386  AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ, SUMS_INFSUM]
20387QED
20388
20389Theorem INFSUM_RESTRICT:
20390   !k a:num->real.
20391        infsum univ(:num) (\n. if n IN k then a n else 0) = infsum k a
20392Proof
20393  REPEAT GEN_TAC THEN
20394  MP_TAC(ISPECL [``a:num->real``, ``k:num->bool``] SUMMABLE_RESTRICT) THEN
20395  ASM_CASES_TAC ``summable k (a:num->real)`` THEN ASM_REWRITE_TAC[] THEN
20396  STRIP_TAC THENL
20397   [MATCH_MP_TAC INFSUM_UNIQUE THEN
20398    ASM_REWRITE_TAC[SERIES_RESTRICT, SUMS_INFSUM],
20399    FULL_SIMP_TAC std_ss [summable, NOT_EXISTS_THM] THEN
20400    ASM_REWRITE_TAC[infsum]]
20401QED
20402
20403Theorem PARTIAL_SUMS_COMPONENT_LE_INFSUM:
20404   !f:num->real s n.
20405        (!i. i IN s ==> &0 <= f i) /\ summable s f
20406        ==> (sum (s INTER { 0n..n}) f) <= (infsum s f)
20407Proof
20408  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN
20409  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
20410  REWRITE_TAC[sums, LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
20411  REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
20412  FIRST_X_ASSUM(MP_TAC o SPEC
20413   ``sum (s INTER { 0n..n}) (f:num->real) - (infsum s f)``) THEN
20414  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
20415  DISCH_THEN(X_CHOOSE_THEN ``N:num`` (MP_TAC o SPEC ``N + n:num``)) THEN
20416  REWRITE_TAC[LE_ADD, REAL_NOT_LT, dist] THEN
20417  MATCH_MP_TAC REAL_LE_TRANS THEN
20418  EXISTS_TAC ``abs((sum (s INTER { 0n..N + n}) f - infsum s f:real))`` THEN
20419  ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
20420  MATCH_MP_TAC(REAL_ARITH ``s < a /\ a <= b ==> a - s <= abs(b - s:real)``) THEN
20421  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
20422  KNOW_TAC ``sum (s INTER { 0n..n}) f <=
20423              sum (s INTER { 0n..n} UNION s INTER {n +  1n..n + N}) f`` THENL
20424  [ALL_TAC, SIMP_TAC std_ss [GSYM NUMSEG_ADD_SPLIT, ZERO_LESS_EQ, GSYM UNION_OVER_INTER]] THEN
20425  KNOW_TAC ``(sum (s INTER { 0n..n} UNION s INTER {n +  1n..n + N}) f =
20426              sum (s INTER { 0n..n}) f + sum (s INTER {n +  1n..n + N}) f)`` THENL
20427  [MATCH_MP_TAC SUM_UNION THEN
20428   SIMP_TAC std_ss [FINITE_INTER, FINITE_NUMSEG, DISJOINT_DEF, EXTENSION] THEN
20429   SIMP_TAC arith_ss [IN_INTER, NOT_IN_EMPTY, IN_NUMSEG] THEN CCONTR_TAC THEN
20430   FULL_SIMP_TAC arith_ss [], ALL_TAC] THEN
20431  DISCH_THEN SUBST1_TAC THEN
20432  REWRITE_TAC[REAL_LE_ADDR] THEN
20433  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_POS_LE THEN
20434  ASM_SIMP_TAC std_ss [FINITE_INTER, IN_INTER, FINITE_NUMSEG]
20435QED
20436
20437Theorem PARTIAL_SUMS_DROP_LE_INFSUM:
20438   !f s n.
20439        (!i. i IN s ==> &0 <= f i) /\
20440        summable s f
20441        ==> sum (s INTER { 0n..n}) f <= (infsum s f)
20442Proof
20443  REPEAT STRIP_TAC THEN
20444  MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN
20445  ASM_REWRITE_TAC[LESS_EQ_REFL]
20446QED
20447
20448(* ------------------------------------------------------------------------- *)
20449(* Cauchy criterion for series.                                              *)
20450(* ------------------------------------------------------------------------- *)
20451
20452Theorem SEQUENCE_CAUCHY_WLOG:
20453   !P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=>
20454         (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)
20455Proof
20456  MESON_TAC[DIST_SYM, LE_CASES]
20457QED
20458
20459Theorem SUM_DIFF_LEMMA:
20460   !f:num->real k m n.
20461        m <= n
20462        ==> (sum (k INTER {0 .. n}) f - sum (k INTER { 0n..m}) f =
20463             sum (k INTER {m+1 .. n}) f)
20464Proof
20465  REPEAT STRIP_TAC THEN
20466  MP_TAC(ISPECL [``f:num->real``, ``k INTER { 0n..n}``, ``k INTER { 0n..m}``]
20467    SUM_DIFF') THEN
20468  KNOW_TAC ``FINITE (k INTER { 0n .. n}) /\
20469             k INTER { 0n .. m} SUBSET k INTER { 0n .. n}`` THENL
20470   [SIMP_TAC std_ss [FINITE_INTER, FINITE_NUMSEG] THEN MATCH_MP_TAC
20471     (SET_RULE ``s SUBSET t ==> (u INTER s SUBSET u INTER t)``) THEN
20472    REWRITE_TAC[SUBSET_DEF, IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC,
20473    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
20474    DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN
20475    REWRITE_TAC[SET_RULE
20476     ``(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)``] THEN
20477    AP_TERM_TAC THEN REWRITE_TAC[EXTENSION, IN_DIFF, IN_NUMSEG] THEN
20478    POP_ASSUM MP_TAC THEN ARITH_TAC]
20479QED
20480
20481Theorem ABS_SUM_TRIVIAL_LEMMA:
20482   !e:real. &0 < e ==> (P ==> abs(sum(s INTER {m..n}) f) < e <=>
20483                        P ==> n < m \/ abs(sum(s INTER {m..n}) f) < e)
20484Proof
20485  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``n:num < m`` THEN ASM_REWRITE_TAC[] THEN
20486  FIRST_X_ASSUM(SUBST1_TAC o REWRITE_RULE [GSYM NUMSEG_EMPTY]) THEN
20487  ASM_REWRITE_TAC[SUM_CLAUSES, ABS_0, INTER_EMPTY]
20488QED
20489
20490Theorem SERIES_CAUCHY:
20491   !f s. (?l. (f sums l) s) =
20492         !e. &0 < e
20493             ==> ?N. !m n. m >= N
20494                           ==> abs(sum(s INTER {m..n}) f) < e
20495Proof
20496  REPEAT GEN_TAC THEN REWRITE_TAC[sums, CONVERGENT_EQ_CAUCHY, cauchy] THEN
20497  SIMP_TAC std_ss [SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
20498  SIMP_TAC std_ss [dist, SUM_DIFF_LEMMA, ABS_SUM_TRIVIAL_LEMMA] THEN
20499  REWRITE_TAC[GE, TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
20500  REWRITE_TAC[NOT_LESS, ARITH_PROVE
20501   ``(N:num <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=>
20502    N + 1 <= m + 1 /\ m + 1 <= n``] THEN
20503  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC ``e:real`` THEN
20504  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_SIMP_TAC std_ss [] THEN
20505  EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC ``N:num``) THENL
20506   [EXISTS_TAC ``N + 1:num``, EXISTS_TAC ``N:num``] THEN
20507  REPEAT STRIP_TAC THEN
20508  ASM_SIMP_TAC std_ss [ARITH_PROVE ``N + 1 <= m + 1 ==> N <= m + 1:num``] THEN
20509  FIRST_X_ASSUM(MP_TAC o SPECL [``m - 1:num``, ``n:num``]) THEN
20510  SUBGOAL_THEN ``m - 1 + 1 = m:num`` SUBST_ALL_TAC THENL
20511   [ALL_TAC,
20512    KNOW_TAC ``N <= m - 1 /\ m <= n:num`` THENL
20513    [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC []]] THEN
20514  ASM_ARITH_TAC
20515QED
20516
20517Theorem SUMMABLE_CAUCHY:
20518   !f s. summable s f <=>
20519         !e. &0 < e
20520             ==> ?N. !m n. m >= N ==> abs(sum(s INTER {m..n}) f) < e
20521Proof
20522  REWRITE_TAC[summable, GSYM SERIES_CAUCHY]
20523QED
20524
20525Theorem SUMMABLE_IFF_EVENTUALLY:
20526   !f g k. (?N. !n. N <= n /\ n IN k ==> (f n = g n))
20527           ==> (summable k f <=> summable k g)
20528Proof
20529  REWRITE_TAC[summable, SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN
20530  DISCH_THEN(X_CHOOSE_THEN ``N0:num`` STRIP_ASSUME_TAC) THEN
20531  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC ``e:real`` THEN
20532  BETA_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN
20533  DISCH_THEN(X_CHOOSE_THEN ``N1:num``
20534   (fn th => EXISTS_TAC ``N0 + N1:num`` THEN MP_TAC th)) THEN
20535  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
20536  POP_ASSUM (MP_TAC o Q.SPECL [`m:num`,`n:num`]) THEN
20537  DISCH_THEN(fn th => DISCH_TAC THEN MP_TAC th) THEN
20538  (KNOW_TAC ``m >= N1:num`` THENL [POP_ASSUM MP_TAC THEN ARITH_TAC,
20539   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC]) THEN
20540  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
20541  MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC std_ss [IN_INTER, IN_NUMSEG] THEN
20542  REPEAT STRIP_TAC THENL [ALL_TAC, CONV_TAC SYM_CONV] THEN
20543  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
20544  ASM_ARITH_TAC
20545QED
20546
20547Theorem SUMMABLE_EQ_EVENTUALLY:
20548   !f g k. (?N. !n. N <= n /\ n IN k ==> (f n = g n)) /\ summable k f
20549           ==> summable k g
20550Proof
20551  MESON_TAC[SUMMABLE_IFF_EVENTUALLY]
20552QED
20553
20554Theorem SUMMABLE_IFF_COFINITE:
20555   !f s t. FINITE((s DIFF t) UNION (t DIFF s))
20556           ==> (summable s f <=> summable t f)
20557Proof
20558  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN
20559  MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN
20560  FIRST_ASSUM(MP_TAC o ISPEC ``\x:num.x`` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
20561  DISCH_THEN(X_CHOOSE_THEN ``N:num`` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN
20562  DISCH_TAC THEN EXISTS_TAC ``N + 1:num`` THEN
20563  REWRITE_TAC[ARITH_PROVE ``N + 1 <= n <=> ~(n <= N:num)``] THEN ASM_SET_TAC[]
20564QED
20565
20566Theorem SUMMABLE_EQ_COFINITE:
20567   !f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f
20568           ==> summable t f
20569Proof
20570  MESON_TAC[SUMMABLE_IFF_COFINITE]
20571QED
20572
20573Theorem SUMMABLE_FROM_ELSEWHERE:
20574   !f m n. summable (from m) f ==> summable (from n) f
20575Proof
20576  REPEAT GEN_TAC THEN
20577  MATCH_MP_TAC(REWRITE_RULE[CONJ_EQ_IMP] SUMMABLE_EQ_COFINITE) THEN
20578  MATCH_MP_TAC SUBSET_FINITE_I THEN EXISTS_TAC ``{0n..m+n}`` THEN
20579  SIMP_TAC std_ss [FINITE_NUMSEG, SUBSET_DEF, IN_NUMSEG, IN_UNION, IN_DIFF, IN_FROM] THEN
20580  ARITH_TAC
20581QED
20582
20583(* ------------------------------------------------------------------------- *)
20584(* Uniform vesion of Cauchy criterion.                                       *)
20585(* ------------------------------------------------------------------------- *)
20586
20587Theorem SERIES_CAUCHY_UNIFORM:
20588   !P f:'a->num->real k.
20589        (?l. !e. &0 < e
20590                 ==> ?N. !n x. N <= n /\ P x
20591                               ==> dist(sum(k INTER { 0n..n}) (f x),
20592                                        l x) < e) <=>
20593        (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x
20594                                    ==> abs(sum(k INTER {m..n}) (f x)) < e)
20595Proof
20596  REPEAT GEN_TAC THEN
20597  SIMP_TAC std_ss [sums, UNIFORMLY_CONVERGENT_EQ_CAUCHY, cauchy] THEN
20598  ONCE_REWRITE_TAC [METIS [] ``(dist (sum (k INTER {0 .. n}) (f x),
20599                                      sum (k INTER {0 .. n'}) (f x)) < e) =
20600                      (\n n' x. dist (sum (k INTER {0 .. n}) (f x),
20601                                      sum (k INTER {0 .. n'}) (f x)) < e) n n' x``] THEN
20602  ONCE_REWRITE_TAC[MESON[]
20603   ``(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=>
20604     (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)``] THEN
20605  SIMP_TAC std_ss [SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
20606  SIMP_TAC std_ss [dist, SUM_DIFF_LEMMA, ABS_SUM_TRIVIAL_LEMMA] THEN
20607  REWRITE_TAC[GE, TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
20608  REWRITE_TAC[NOT_LESS, ARITH_PROVE
20609   ``(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=>
20610      N + 1 <= m + 1 /\ m + 1 <= n:num``] THEN
20611  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC ``e:real`` THEN
20612  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_SIMP_TAC std_ss [] THEN
20613  EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC ``N:num``) THENL
20614   [EXISTS_TAC ``N + 1:num``, EXISTS_TAC ``N:num``] THEN
20615  REPEAT STRIP_TAC THEN
20616  ASM_SIMP_TAC std_ss [ARITH_PROVE ``N + 1 <= m + 1 ==> N <= m + 1:num``] THEN
20617  FIRST_X_ASSUM(MP_TAC o SPEC ``x:'a``) THEN ASM_REWRITE_TAC[] THEN
20618  DISCH_THEN(MP_TAC o SPECL [``m - 1:num``, ``n:num``]) THEN
20619  SUBGOAL_THEN ``m - 1 + 1 = m:num`` SUBST_ALL_TAC THENL
20620   [ASM_ARITH_TAC, ALL_TAC] THEN
20621  KNOW_TAC ``N <= m - 1 /\ m <= n:num`` THENL
20622  [ASM_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC []]
20623QED
20624
20625(* ------------------------------------------------------------------------- *)
20626(* So trivially, terms of a convergent series go to zero.                    *)
20627(* ------------------------------------------------------------------------- *)
20628
20629Theorem SERIES_GOESTOZERO:
20630   !s x. summable s x
20631         ==> !e. &0 < e
20632                 ==> eventually (\n. n IN s ==> abs(x n) < e) sequentially
20633Proof
20634  REPEAT GEN_TAC THEN REWRITE_TAC[summable, SERIES_CAUCHY] THEN
20635  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN
20636  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
20637  DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
20638  X_GEN_TAC ``n:num`` THEN BETA_TAC THEN REPEAT STRIP_TAC THEN
20639  FIRST_X_ASSUM(MP_TAC o SPECL [``n:num``, ``n:num``]) THEN
20640  ASM_SIMP_TAC std_ss [NUMSEG_SING, GE, SET_RULE ``n IN s ==> (s INTER {n} = {n})``] THEN
20641  REWRITE_TAC[SUM_SING]
20642QED
20643
20644Theorem SUMMABLE_IMP_TOZERO:
20645   !f:num->real k.
20646       summable k f
20647       ==> ((\n. if n IN k then f(n) else 0) --> 0) sequentially
20648Proof
20649  REPEAT GEN_TAC THEN GEN_REWR_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN
20650  REWRITE_TAC[summable, LIM_SEQUENTIALLY, INTER_UNIV, sums] THEN
20651  DISCH_THEN(X_CHOOSE_TAC ``l:real``) THEN X_GEN_TAC ``e:real`` THEN
20652  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
20653  ASM_SIMP_TAC std_ss [REAL_HALF, LEFT_IMP_EXISTS_THM] THEN
20654  X_GEN_TAC ``N:num`` THEN DISCH_TAC THEN EXISTS_TAC ``N + 1:num`` THEN
20655  X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
20656  UNDISCH_TAC ``!n:num. N <= n ==>
20657        dist (sum { 0n .. n} (\n. if n IN k then f n else 0),l) < e / 2:real`` THEN
20658  DISCH_TAC THEN
20659  FIRST_X_ASSUM(fn th =>
20660    MP_TAC(SPEC ``n - 1:num`` th) THEN MP_TAC(SPEC ``n:num`` th)) THEN
20661  ASM_SIMP_TAC std_ss [ARITH_PROVE ``N + 1 <= n ==> N <= n /\ N <= n - 1:num``] THEN
20662  ABBREV_TAC ``m = n - 1:num`` THEN
20663  SUBGOAL_THEN ``n = SUC m`` SUBST1_TAC THENL
20664   [ASM_ARITH_TAC, ALL_TAC] THEN
20665  SIMP_TAC std_ss [SUM_CLAUSES_NUMSEG, ZERO_LESS_EQ, dist] THEN
20666  SIMP_TAC std_ss [REAL_ARITH ``abs(x - 0) = abs x:real``] THEN
20667  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [ABS_0] THEN
20668  SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
20669  REAL_ARITH_TAC
20670QED
20671
20672Theorem SUMMABLE_IMP_BOUNDED:
20673   !f:num->real k. summable k f ==> bounded (IMAGE f k)
20674Proof
20675  REPEAT GEN_TAC THEN
20676  DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN
20677  DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
20678  SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE, IN_UNIV] THEN
20679  METIS_TAC[REAL_LT_IMP_LE, ABS_0]
20680QED
20681
20682Theorem SUMMABLE_IMP_SUMS_BOUNDED:
20683   !f:num->real k.
20684       summable (from k) f ==> bounded { sum{k..n} f | n IN univ(:num) }
20685Proof
20686  SIMP_TAC std_ss [summable, sums, LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN
20687  DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
20688  SIMP_TAC std_ss [FROM_INTER_NUMSEG, GSYM IMAGE_DEF]
20689QED
20690
20691(* ------------------------------------------------------------------------- *)
20692(* Comparison test.                                                          *)
20693(* ------------------------------------------------------------------------- *)
20694
20695Theorem SERIES_COMPARISON:
20696   !f g s. (?l. (g sums l) s) /\
20697           (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n)
20698           ==> ?l:real. (f sums l) s
20699Proof
20700  REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN
20701  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC ``N1:num``)) THEN
20702  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN
20703  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
20704  DISCH_THEN(X_CHOOSE_TAC ``N2:num``) THEN
20705  EXISTS_TAC ``N1 + N2:num`` THEN
20706  MAP_EVERY X_GEN_TAC [``m:num``, ``n:num``] THEN DISCH_TAC THEN
20707  MATCH_MP_TAC REAL_LET_TRANS THEN
20708  EXISTS_TAC ``abs (sum (s INTER {m .. n}) g)`` THEN CONJ_TAC THENL
20709   [SIMP_TAC std_ss [FINITE_INTER_NUMSEG] THEN
20710    MATCH_MP_TAC(REAL_ARITH ``x <= a ==> x <= abs(a:real)``) THEN
20711    MATCH_MP_TAC SUM_ABS_LE THEN
20712    REWRITE_TAC[FINITE_INTER_NUMSEG, IN_INTER, IN_NUMSEG] THEN
20713    ASM_MESON_TAC[ARITH_PROVE ``m >= N1 + N2:num /\ m <= x ==> x >= N1``],
20714    ASM_MESON_TAC[ARITH_PROVE ``m >= N1 + N2:num ==> m >= N2``]]
20715QED
20716
20717Theorem SUMMABLE_COMPARISON:
20718   !f g s. summable s g /\
20719           (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n)
20720           ==> summable s f
20721Proof
20722  REWRITE_TAC[summable, SERIES_COMPARISON]
20723QED
20724
20725Theorem SERIES_ABSCONV_IMP_CONV:
20726   !x:num->real k. summable k (\n. (abs(x n))) ==> summable k x
20727Proof
20728  REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN
20729  MATCH_MP_TAC SERIES_COMPARISON THEN
20730  EXISTS_TAC ``\n:num. abs(x n:real)`` THEN
20731  ASM_SIMP_TAC std_ss [o_DEF, REAL_LE_REFL] THEN ASM_MESON_TAC[]
20732QED
20733
20734Theorem SUMMABLE_SUBSET_ABSCONV:
20735   !x:num->real s t.
20736        summable s (\n. abs(x n)) /\ t SUBSET s
20737        ==> summable t (\n. abs(x n))
20738Proof
20739  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN
20740  EXISTS_TAC ``s:num->bool`` THEN ASM_REWRITE_TAC[] THEN
20741  REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN
20742  EXISTS_TAC ``\n:num. abs(x n:real)`` THEN
20743  ASM_SIMP_TAC std_ss [o_DEF, GSYM summable] THEN
20744  EXISTS_TAC ``0:num`` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
20745  SIMP_TAC std_ss [REAL_LE_REFL, ABS_ABS, ABS_0, ABS_POS]
20746QED
20747
20748Theorem SERIES_COMPARISON_BOUND:
20749   !f:num->real g s a.
20750        (g sums a) s /\ (!i. i IN s ==> abs(f i) <= (g i))
20751        ==> ?l. (f sums l) s /\ abs(l) <= a
20752Proof
20753  REPEAT STRIP_TAC THEN
20754  MP_TAC(ISPECL [``f:num->real``, ``g:num->real``, ``s:num->bool``]
20755        SUMMABLE_COMPARISON) THEN
20756  SIMP_TAC std_ss [o_DEF, GE, ETA_AX, summable] THEN
20757  KNOW_TAC ``(?l. ((g:num->real) sums l) s) /\
20758             (?N:num. !n. N <= n /\ n IN s ==> abs (f n) <= g n)`` THENL
20759  [ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
20760  STRIP_TAC THEN EXISTS_TAC ``l:real`` THEN ASM_REWRITE_TAC[] THEN
20761  RULE_ASSUM_TAC(REWRITE_RULE[FROM_0, INTER_UNIV, sums]) THEN
20762  MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC
20763   [``f:num->real``, ``g:num->real``, ``s:num->bool``] THEN
20764  ASM_SIMP_TAC std_ss [sums, o_DEF, ETA_AX]
20765QED
20766
20767(* ------------------------------------------------------------------------- *)
20768(* Uniform version of comparison test.                                       *)
20769(* ------------------------------------------------------------------------- *)
20770
20771Theorem SERIES_COMPARISON_UNIFORM:
20772   !f g P s. (?l. (g sums l) s) /\
20773             (?N. !n x. N <= n /\ n IN s /\ P x ==> abs(f x n) <= g n)
20774             ==> ?l:'a->real.
20775                    !e. &0 < e
20776                        ==> ?N. !n x. N <= n /\ P x
20777                                      ==> dist(sum(s INTER { 0n..n}) (f x),
20778                                               l x) < e
20779Proof
20780  REPEAT GEN_TAC THEN SIMP_TAC std_ss [GE, SERIES_CAUCHY, SERIES_CAUCHY_UNIFORM] THEN
20781  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC ``N1:num``)) THEN
20782  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN
20783  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
20784  DISCH_THEN(X_CHOOSE_TAC ``N2:num``) THEN
20785  EXISTS_TAC ``N1 + N2:num`` THEN
20786  MAP_EVERY X_GEN_TAC [``m:num``, ``n:num``, ``x:'a``] THEN DISCH_TAC THEN
20787  MATCH_MP_TAC REAL_LET_TRANS THEN
20788  EXISTS_TAC ``abs (sum (s INTER {m .. n}) g)`` THEN CONJ_TAC THENL
20789   [SIMP_TAC std_ss [FINITE_INTER_NUMSEG] THEN
20790    MATCH_MP_TAC(REAL_ARITH ``x <= a ==> x <= abs(a:real)``) THEN
20791    MATCH_MP_TAC SUM_ABS_LE THEN
20792    REWRITE_TAC[FINITE_INTER_NUMSEG, IN_INTER, IN_NUMSEG] THEN
20793    ASM_MESON_TAC[ARITH_PROVE ``N1 + N2:num <= m /\ m <= x ==> N1 <= x``],
20794    ASM_MESON_TAC[ARITH_PROVE ``N1 + N2:num <= m ==> N2 <= m``]]
20795QED
20796
20797(* ------------------------------------------------------------------------- *)
20798(* Ratio test.                                                               *)
20799(* ------------------------------------------------------------------------- *)
20800
20801Theorem SERIES_RATIO:
20802   !c a s N.
20803      c < &1 /\
20804      (!n. n >= N ==> abs(a(SUC n)) <= c * abs(a(n)))
20805      ==> ?l:real. (a sums l) s
20806Proof
20807  REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
20808  MATCH_MP_TAC SERIES_COMPARISON THEN
20809  DISJ_CASES_TAC(REAL_ARITH ``c <= &0 \/ &0 < c:real``) THENL
20810   [EXISTS_TAC ``\n:num. &0:real`` THEN REWRITE_TAC[o_DEF] THEN
20811    CONJ_TAC THENL [MESON_TAC[SERIES_0], ALL_TAC] THEN
20812    EXISTS_TAC ``N + 1:num`` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
20813    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``c * abs(a(n - 1:num):real)`` THEN
20814    CONJ_TAC THENL
20815     [ASM_MESON_TAC[ARITH_PROVE ``N + 1 <= n ==> (SUC(n - 1) = n) /\ N <= n - 1``],
20816      ALL_TAC] THEN
20817    MATCH_MP_TAC(REAL_ARITH ``&0 <= -c * x ==> c * x <= &0:real``) THEN
20818    MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[ABS_POS] THEN
20819    UNDISCH_TAC ``c <= &0:real`` THEN REAL_ARITH_TAC,
20820    ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME ``&0 < c:real``))] THEN
20821  EXISTS_TAC ``\n:num. abs(a(N):real) * c pow (n - N)`` THEN
20822  REWRITE_TAC[] THEN CONJ_TAC THENL
20823   [ALL_TAC,
20824    EXISTS_TAC ``N:num`` THEN
20825    SIMP_TAC std_ss [GE, LESS_EQ_EXISTS, CONJ_EQ_IMP, ADD_SUB2, LEFT_IMP_EXISTS_THM] THEN
20826    SUBGOAL_THEN ``!d:num. abs(a(N + d):real) <= abs(a N) * c pow d``
20827     (fn th => MESON_TAC[th]) THEN INDUCT_TAC THEN
20828    REWRITE_TAC[ADD_CLAUSES, pow, REAL_MUL_RID, REAL_LE_REFL] THEN
20829    MATCH_MP_TAC REAL_LE_TRANS THEN
20830    EXISTS_TAC ``c * abs((a:num->real) (N + d:num))`` THEN
20831    ASM_SIMP_TAC std_ss [LE_ADD] THEN
20832    ASM_MESON_TAC[REAL_LE_LMUL, REAL_MUL_ASSOC, REAL_MUL_COMM]] THEN
20833  GEN_REWR_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC ``e:real`` THEN
20834  SIMP_TAC std_ss [FINITE_INTER, FINITE_NUMSEG] THEN
20835  DISCH_TAC THEN SIMP_TAC std_ss [SUM_LMUL, FINITE_INTER, FINITE_NUMSEG] THEN
20836  ASM_CASES_TAC ``(a:num->real) N = 0:real`` THENL
20837   [ASM_REWRITE_TAC[ABS_0, REAL_MUL_LZERO, ABS_N], ALL_TAC] THEN
20838  MP_TAC(SPECL [``c:real``, ``((&1 - c) * e) / abs((a:num->real) N)``]
20839               REAL_ARCH_POW_INV) THEN
20840  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_LT_MUL, REAL_SUB_LT, GSYM ABS_NZ, GE] THEN
20841  DISCH_THEN(X_CHOOSE_TAC ``M:num``) THEN EXISTS_TAC ``N + M:num`` THEN
20842  MAP_EVERY X_GEN_TAC [``m:num``, ``n:num``] THEN DISCH_TAC THEN
20843  MATCH_MP_TAC REAL_LET_TRANS THEN
20844  EXISTS_TAC ``abs(abs((a:num->real) N) *
20845                  sum{m..n} (\i. c pow (i - N)))`` THEN
20846  CONJ_TAC THENL
20847   [REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN
20848    REWRITE_TAC[ABS_POS] THEN
20849    MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ x <= y ==> abs x <= abs y:real``) THEN
20850    ASM_SIMP_TAC std_ss [SUM_POS_LE, FINITE_INTER_NUMSEG, POW_POS] THEN
20851    MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC std_ss [POW_POS] THEN
20852    REWRITE_TAC[FINITE_INTER_NUMSEG, FINITE_NUMSEG] THEN
20853    REWRITE_TAC[IN_INTER, IN_DIFF] THEN MESON_TAC[],
20854    ALL_TAC] THEN
20855  REWRITE_TAC[ABS_MUL, ABS_ABS] THEN
20856  DISJ_CASES_TAC(ARITH_PROVE ``n:num < m \/ m <= n``) THENL
20857   [ASM_SIMP_TAC std_ss [SUM_TRIV_NUMSEG, ABS_N, REAL_MUL_RZERO], ALL_TAC] THEN
20858  SUBGOAL_THEN ``(m = 0 + m) /\ (n = (n - m) + m:num)`` (CONJUNCTS_THEN SUBST1_TAC) THENL
20859   [UNDISCH_TAC ``m:num <= n`` THEN ARITH_TAC, ALL_TAC] THEN
20860  REWRITE_TAC[SUM_OFFSET'] THEN UNDISCH_TAC ``N + M:num <= m`` THEN
20861  SIMP_TAC std_ss [LESS_EQ_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN ``d:num`` SUBST_ALL_TAC) THEN
20862  REWRITE_TAC[ARITH_PROVE ``(i + (N + M + d) - N:num) = (M + d) + i``] THEN
20863  ONCE_REWRITE_TAC[POW_ADD] THEN SIMP_TAC arith_ss [SUM_LMUL, SUM_GP] THEN
20864  ASM_SIMP_TAC std_ss [LT, REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
20865  FULL_SIMP_TAC std_ss [GSYM REAL_LT_RDIV_EQ, ABS_NZ, ABS_MUL] THEN
20866  REWRITE_TAC[GSYM POW_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
20867  KNOW_TAC ``1 - c:real <> 0`` THENL
20868  [UNDISCH_TAC ``c < 1:real`` THEN REAL_ARITH_TAC, DISCH_TAC] THEN
20869  ASM_SIMP_TAC std_ss [GSYM REAL_LT_RDIV_EQ, ABS_DIV, REAL_POW_LT, ABS_NZ, REAL_ARITH
20870   ``&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c:real)``, REAL_LT_LDIV_EQ] THEN
20871  ONCE_REWRITE_TAC [METIS [pow] ``x pow 0 = 1:real``] THEN
20872  MATCH_MP_TAC(REAL_ARITH
20873   ``&0 < x /\ x <= &1 /\ &1 <= e ==> abs(1 - x) < e:real``) THEN
20874  ASM_SIMP_TAC std_ss [REAL_POW_LT, REAL_POW_1_LE, REAL_LT_IMP_LE] THEN
20875  ASM_SIMP_TAC std_ss [REAL_ARITH ``c < &1 ==> (x * abs(&1 - c) = (&1 - c) * x:real)``] THEN
20876  KNOW_TAC ``(abs (c pow M) <> 0:real) /\ (abs (c pow d) <> 0:real)`` THENL
20877  [CONJ_TAC THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
20878   REWRITE_TAC [GSYM ABS_NZ] THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
20879   MATCH_MP_TAC REAL_LT_IMP_NE THEN METIS_TAC [REAL_POW_LT], STRIP_TAC] THEN
20880  FULL_SIMP_TAC real_ss [real_div, REAL_INV_MUL, ABS_NZ, REAL_POW_LT, REAL_POW_ADD,
20881                        REAL_MUL_ASSOC, REAL_LT_IMP_NE, POW_ABS, ABS_MUL] THEN
20882  REWRITE_TAC[REAL_ARITH
20883   ``(a * b * c * d * e) = (e * ((a * b) * c)) * d:real``] THEN
20884  ASM_SIMP_TAC real_ss [GSYM real_div, REAL_LE_RDIV_EQ, REAL_POW_LT, REAL_MUL_LID,
20885               REAL_ARITH ``&0 < c ==> (abs c = c:real)``] THEN
20886  REWRITE_TAC [real_div] THEN
20887  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
20888   ``xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e:real``)) THEN
20889  MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
20890   [REWRITE_TAC[REAL_SUB_LE, GSYM REAL_POW_INV] THEN
20891    MATCH_MP_TAC REAL_POW_LE_1 THEN
20892    MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE],
20893    MATCH_MP_TAC REAL_LT_IMP_LE THEN
20894    ASM_SIMP_TAC std_ss [REAL_SUB_LT, REAL_LT_MUL, REAL_LT_DIV, ABS_NZ, GSYM real_div]]
20895QED
20896
20897(* ------------------------------------------------------------------------- *)
20898(* Ostensibly weaker versions of the boundedness of partial sums.            *)
20899(* ------------------------------------------------------------------------- *)
20900
20901Theorem BOUNDED_PARTIAL_SUMS:
20902   !f:num->real k.
20903        bounded { sum{k..n} f | n IN univ(:num) }
20904        ==> bounded { sum{m..n} f | m IN univ(:num) /\ n IN univ(:num) }
20905Proof
20906  REPEAT STRIP_TAC THEN
20907  SUBGOAL_THEN ``bounded { sum{ 0n..n} f:real | n IN univ(:num) }`` MP_TAC THENL
20908   [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [BOUNDED_POS]) THEN
20909    REWRITE_TAC[bounded_def] THEN
20910    SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_IN_IMAGE, IN_UNIV] THEN
20911    DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
20912    EXISTS_TAC ``sum { i:num | i < k} (\i. abs(f i:real)) + B`` THEN
20913    X_GEN_TAC ``i:num`` THEN ASM_CASES_TAC ``i:num < k`` THENL
20914     [MATCH_MP_TAC(REAL_ARITH
20915       ``!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b:real``) THEN
20916      EXISTS_TAC ``sum { 0n..i} (\i. abs(f i:real))`` THEN
20917      ASM_SIMP_TAC std_ss [SUM_ABS, FINITE_NUMSEG] THEN
20918      MATCH_MP_TAC SUM_SUBSET THEN
20919      REWRITE_TAC[FINITE_NUMSEG, FINITE_NUMSEG_LT, ABS_POS] THEN
20920      SIMP_TAC std_ss [IN_DIFF, IN_NUMSEG, GSPECIFICATION] THEN
20921      ASM_SIMP_TAC arith_ss [] THEN REAL_ARITH_TAC,
20922      ALL_TAC] THEN
20923    ASM_CASES_TAC ``k = 0:num`` THENL
20924     [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH
20925       ``x <= B /\ &0 <= b ==> x <= b + B:real``) THEN
20926      ASM_SIMP_TAC std_ss [SUM_POS_LE, FINITE_NUMSEG_LT, ABS_POS],
20927      ALL_TAC] THEN
20928    MP_TAC(ISPECL [``f:num->real``, ``0:num``, ``k:num``, ``i:num``]
20929      SUM_COMBINE_L) THEN
20930    KNOW_TAC ``0 < k /\ 0 <= k /\ k <= i + 1:num`` THENL
20931    [ASM_SIMP_TAC arith_ss [],
20932     DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
20933    DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN
20934    MATCH_MP_TAC(REAL_ARITH
20935     ``abs(x) <= a /\ abs(y) <= b ==> abs(x + y) <= a + b:real``) THEN
20936    ASM_SIMP_TAC std_ss [SUM_ABS, FINITE_NUMSEG],
20937    ALL_TAC] THEN
20938  DISCH_THEN(fn th =>
20939    MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN
20940  REWRITE_TAC[AND_IMP_INTRO, GSYM BOUNDED_UNION] THEN
20941  MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`]
20942        BOUNDED_SUBSET) THEN
20943  KNOW_TAC ``!x:real m n:num.
20944     (x = sum {m..n} f)
20945     ==> (?n. x = sum { 0n..n} f) \/
20946         (?x' y.
20947              ((?n. x' = sum { 0n..n} f) /\ (?n. y = sum { 0n..n} f)) /\
20948              (x = x' - y))`` THENL
20949  [ALL_TAC, SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNION, LEFT_IMP_EXISTS_THM,
20950                             IN_UNIV, EXISTS_PROD] THEN METIS_TAC []] THEN
20951  MAP_EVERY X_GEN_TAC [``x:real``, ``m:num``, ``n:num``] THEN
20952  DISCH_THEN SUBST1_TAC THEN
20953  ASM_CASES_TAC ``m = 0:num`` THENL [ASM_MESON_TAC[], ALL_TAC] THEN
20954  ASM_CASES_TAC ``n:num < m`` THENL
20955   [DISJ2_TAC THEN REPEAT(EXISTS_TAC ``sum{ 0n.. 0n} (f:num->real)``) THEN
20956    ASM_SIMP_TAC std_ss [SUM_TRIV_NUMSEG, REAL_SUB_REFL] THEN MESON_TAC[],
20957    ALL_TAC] THEN
20958  DISJ2_TAC THEN MAP_EVERY EXISTS_TAC
20959   [``sum{0..n} (f:num->real)``, ``sum{0..m-1} (f:num->real)``] THEN
20960  CONJ_TAC THENL [MESON_TAC[], ALL_TAC] THEN
20961  MP_TAC(ISPECL [``f:num->real``, ``0:num``, ``m:num``, ``n:num``]
20962      SUM_COMBINE_L) THEN ASM_SIMP_TAC arith_ss [] THEN
20963  REAL_ARITH_TAC
20964QED
20965
20966(* ------------------------------------------------------------------------- *)
20967(* General Dirichlet convergence test (could make this uniform on a set).    *)
20968(* ------------------------------------------------------------------------- *)
20969
20970Theorem SUMMABLE_BILINEAR_PARTIAL_PRE:
20971   !f g h:real->real->real l k.
20972        bilinear h /\
20973        ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\
20974        summable (from k) (\n. h (f(n + 1) - f(n)) (g(n)))
20975        ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))
20976Proof
20977  REPEAT GEN_TAC THEN
20978  SIMP_TAC std_ss [summable, sums, FROM_INTER_NUMSEG] THEN
20979  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
20980  FIRST_ASSUM(fn th =>
20981   REWRITE_TAC[MATCH_MP BILINEAR_SUM_PARTIAL_PRE th]) THEN
20982  DISCH_THEN(X_CHOOSE_TAC ``l':real``) THEN
20983  EXISTS_TAC ``l - (h:real->real->real) ((f:num->real) k) (g(k - 1)) - l'`` THEN
20984  SIMP_TAC std_ss [LIM_CASES_SEQUENTIALLY] THEN
20985  KNOW_TAC  ``(((\(n :num).
20986     (\n. (h :real -> real -> real) ((f :num -> real) (n +  1n))
20987       ((g :num -> real) n) - h (f (k :num)) (g (k -  1n))) n -
20988     (\n. sum {k .. n} (\(k :num). h (f (k +  1n) - f k) (g k))) n) -->
20989  ((l :real) - h (f k) (g (k -  1n)) - (l' :real))) sequentially :
20990   bool)`` THENL
20991  [ALL_TAC, METIS_TAC []] THEN
20992  MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC std_ss [LIM_CONST] THEN
20993  KNOW_TAC ``(((\(n :num).
20994     (\n. (h :real -> real -> real) ((f :num -> real) (n +  1n))
20995       ((g :num -> real) n)) n - (\n. h (f (k :num)) (g (k -  1n))) n) -->
20996  ((l :real) - h (f k) (g (k -  1n)))) sequentially :bool)`` THENL
20997  [ALL_TAC, METIS_TAC []] THEN MATCH_MP_TAC LIM_SUB THEN
20998  ASM_SIMP_TAC std_ss [LIM_CONST]
20999QED
21000
21001Theorem SERIES_DIRICHLET_BILINEAR:
21002   !f g h:real->real->real k m p l.
21003        bilinear h /\
21004        bounded {sum {m..n} f | n IN univ(:num)} /\
21005        summable (from p) (\n. abs(g(n + 1) - g(n))) /\
21006        ((\n. h (g(n + 1)) (sum{ 1n..n} f)) --> l) sequentially
21007        ==> summable (from k) (\n. h (g n) (f n))
21008Proof
21009  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN
21010  EXISTS_TAC ``1:num`` THEN
21011  FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN
21012  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [BOUNDED_POS]) THEN
21013  SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV, LEFT_IMP_EXISTS_THM, EXISTS_PROD] THEN
21014  X_GEN_TAC ``B:real`` THEN STRIP_TAC THEN
21015  FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN
21016  DISCH_THEN(X_CHOOSE_THEN ``C:real`` STRIP_ASSUME_TAC) THEN
21017  MATCH_MP_TAC SUMMABLE_EQ THEN
21018  EXISTS_TAC ``\n. (h:real->real->real)
21019                   (g n) (sum { 1n..n} f - sum { 1n..n-1:num} f)`` THEN
21020  SIMP_TAC std_ss [IN_FROM, GSYM NUMSEG_RREC] THEN
21021  SIMP_TAC std_ss [SUM_CLAUSES, FINITE_NUMSEG, IN_NUMSEG,
21022           ARITH_PROVE ``1 <= n ==> ~(n <= n - 1:num)``] THEN
21023  CONJ_TAC THENL
21024   [REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [BILINEAR_RADD, BILINEAR_RSUB] THEN
21025    REAL_ARITH_TAC,
21026    ALL_TAC] THEN
21027  MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC ``p:num`` THEN
21028  MP_TAC(ISPECL [``g:num->real``, ``\n. sum{ 1n..n} f:real``,
21029                 ``h:real->real->real``, ``l:real``, ``p:num``]
21030         SUMMABLE_BILINEAR_PARTIAL_PRE) THEN
21031  SIMP_TAC std_ss [] THEN DISCH_THEN MATCH_MP_TAC THEN
21032  ASM_REWRITE_TAC[] THEN
21033  SUBGOAL_THEN
21034    ``summable (from p) ((\n. C * B * abs(g(n + 1) - g(n):real)))``
21035  MP_TAC THENL [ASM_SIMP_TAC std_ss [o_DEF, SUMMABLE_CMUL], ALL_TAC] THEN
21036  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN
21037  EXISTS_TAC ``0:num`` THEN REWRITE_TAC[IN_FROM, GE, ZERO_LESS_EQ] THEN
21038  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
21039   ``C * abs(g(n + 1:num) - g(n):real) * abs(sum { 1n..n} f:real)`` THEN
21040  ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN
21041  REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
21042  ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN
21043  GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN
21044  ASM_SIMP_TAC std_ss [REAL_LE_LMUL_IMP, ABS_POS]
21045QED
21046
21047Theorem SERIES_DIRICHLET:
21048   !f:num->real g N k m.
21049        bounded {sum {m..n} f | n IN univ(:num)} /\
21050        (!n. N <= n ==> g(n + 1) <= g(n)) /\
21051        (g --> 0) sequentially
21052        ==> summable (from k) (\n. g(n) * f(n))
21053Proof
21054  REPEAT STRIP_TAC THEN
21055  MP_TAC(ISPECL [``f:num->real``, ``g:num->real``,
21056                 ``\x y:real. x * y``] SERIES_DIRICHLET_BILINEAR) THEN
21057  SIMP_TAC std_ss [o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
21058  MAP_EVERY EXISTS_TAC [``m:num``, ``N:num``, ``0:real``] THEN CONJ_TAC THENL
21059   [SIMP_TAC std_ss [bilinear, linear] THEN
21060    REPEAT STRIP_TAC THEN REAL_ARITH_TAC,
21061    ALL_TAC] THEN
21062  ASM_REWRITE_TAC [] THEN
21063  FIRST_ASSUM(MP_TAC o SPEC ``1:num`` o MATCH_MP SEQ_OFFSET) THEN
21064  SIMP_TAC std_ss [o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
21065   [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN
21066    EXISTS_TAC ``(\n. (g:num->real)(n) - g(n + 1))`` THEN SIMP_TAC std_ss [] THEN
21067    CONJ_TAC THENL
21068     [EXISTS_TAC ``N:num`` THEN REPEAT STRIP_TAC THEN
21069      UNDISCH_TAC ``!n. N <= n ==> g (n + 1) <= (g:num->real) n`` THEN
21070      DISCH_THEN (MP_TAC o SPEC ``n:num``) THEN
21071      ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC,
21072      SIMP_TAC std_ss [summable, sums, FROM_INTER_NUMSEG, SUM_DIFFS'] THEN
21073      SIMP_TAC std_ss [LIM_CASES_SEQUENTIALLY] THEN
21074      EXISTS_TAC ``(g(N:num)) - 0:real`` THEN
21075      ONCE_REWRITE_TAC [METIS [] ``((\n:num. g N - g (n + 1)) --> (g N - 0:real)) =
21076                       ((\n. (\n. g N) n - (\n. g (n + 1)) n) --> (g N - 0))``] THEN
21077      MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]],
21078    ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
21079    ONCE_REWRITE_TAC [METIS []
21080        ``((\n. sum {1 .. n} f * (g:num->real) (n + 1)) --> 0) =
21081      ((\n. (\n. sum {1 .. n} f) n * (\n. g (n + 1)) n) --> 0)``] THEN
21082    MATCH_MP_TAC LIM_NULL_CMUL_BOUNDED THEN ASM_SIMP_TAC std_ss [o_DEF] THEN
21083    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
21084    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN
21085    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [BOUNDED_POS]) THEN
21086    SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV, EXISTS_PROD] THEN METIS_TAC[]]
21087QED
21088
21089(* ------------------------------------------------------------------------- *)
21090(* Rearranging absolutely convergent series.                                 *)
21091(* ------------------------------------------------------------------------- *)
21092
21093Theorem lemma[local]:
21094     !f:'a->real s t.
21095          FINITE s /\ FINITE t
21096          ==> (sum s f - sum t f = sum (s DIFF t) f - sum (t DIFF s) f)
21097Proof
21098    REPEAT STRIP_TAC THEN
21099    ONCE_REWRITE_TAC[SET_RULE ``s DIFF t = s DIFF (s INTER t)``] THEN
21100    ASM_SIMP_TAC std_ss [SUM_DIFF', INTER_SUBSET] THEN
21101    GEN_REWR_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM] THEN
21102    REAL_ARITH_TAC
21103QED
21104
21105Theorem SERIES_INJECTIVE_IMAGE_STRONG:
21106   !x:num->real s f.
21107        summable (IMAGE f s) (\n. abs(x n)) /\
21108        (!m n. m IN s /\ n IN s /\ (f m = f n) ==> (m = n))
21109        ==> ((\n. sum (IMAGE f s INTER { 0n..n}) x -
21110                  sum (s INTER { 0n..n}) (x o f)) --> 0)
21111            sequentially
21112Proof
21113  REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
21114  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
21115  UNDISCH_TAC ``(summable (IMAGE (f :num -> num) (s :num -> bool))
21116         (\(n :num). abs ((x :num -> real) n)) :bool)`` THEN DISCH_TAC THEN
21117  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [SUMMABLE_CAUCHY]) THEN
21118  SIMP_TAC std_ss [FINITE_INTER, FINITE_NUMSEG] THEN
21119  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN
21120  SIMP_TAC std_ss [SUM_POS_LE, ABS_POS, FINITE_INTER, FINITE_NUMSEG] THEN
21121  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
21122  ASM_REWRITE_TAC[dist, GE, REAL_SUB_RZERO, REAL_HALF] THEN
21123  DISCH_THEN(X_CHOOSE_THEN ``N:num`` STRIP_ASSUME_TAC) THEN
21124  UNDISCH_TAC ``!(m :num) (n :num).
21125        m IN (s :num -> bool) /\ n IN s /\ ((f :num -> num) m = f n) ==>
21126        (m = n)`` THEN DISCH_TAC THEN
21127  FIRST_ASSUM(MP_TAC o REWRITE_RULE [INJECTIVE_ON_LEFT_INVERSE]) THEN
21128  DISCH_THEN(X_CHOOSE_TAC ``g:num->num``) THEN
21129  MP_TAC(ISPECL [``g:num->num``, ``{ 0n..N}``] UPPER_BOUND_FINITE_SET) THEN
21130  REWRITE_TAC[FINITE_NUMSEG, IN_NUMSEG, ZERO_LESS_EQ] THEN
21131  DISCH_THEN(X_CHOOSE_TAC ``P:num``) THEN
21132  EXISTS_TAC ``MAX N P:num`` THEN X_GEN_TAC ``n:num`` THEN
21133  REWRITE_TAC [MAX_DEF] THEN
21134  SIMP_TAC std_ss [ARITH_PROVE ``(if a < b then b else a) <= c <=> a <= c /\ b <= c:num``] THEN
21135  DISCH_TAC THEN
21136  W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE o rand o
21137    rand o lhand o snd) THEN
21138  KNOW_TAC ``(!(x :num) (y :num).
21139    x IN (s :num -> bool) INTER {0 .. n} /\
21140    y IN s INTER { 0 .. n} /\ ((f :num -> num) x = f y) ==>
21141    (x = y))`` THENL
21142   [ASM_MESON_TAC[FINITE_INTER, FINITE_NUMSEG, IN_INTER],
21143    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
21144    DISCH_THEN(SUBST1_TAC o SYM)] THEN
21145  W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN
21146  SIMP_TAC std_ss [FINITE_INTER, IMAGE_FINITE, FINITE_NUMSEG] THEN
21147  DISCH_THEN SUBST1_TAC THEN GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
21148   MATCH_MP_TAC(REAL_ARITH
21149   ``abs a < x /\ abs b < y ==> abs(a - b:real) < x + y:real``) THEN
21150  CONJ_TAC THEN
21151  W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
21152  SIMP_TAC std_ss [FINITE_DIFF, IMAGE_FINITE, FINITE_INTER, FINITE_NUMSEG] THEN
21153  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
21154  MATCH_MP_TAC REAL_LET_TRANS THENL
21155   [EXISTS_TAC
21156     ``sum((IMAGE (f:num->num) s) INTER {N..n}) (\i. abs(x i :real))`` THEN
21157    CONJ_TAC THENL [ALL_TAC,
21158     MATCH_MP_TAC (REAL_ARITH ``abs x < y ==> x < y:real``) THEN
21159     ASM_SIMP_TAC real_ss []] THEN
21160    MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
21161    SIMP_TAC std_ss [ABS_POS, FINITE_INTER, FINITE_NUMSEG] THEN
21162    MATCH_MP_TAC(SET_RULE
21163     ``(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t)
21164      ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET
21165          IMAGE f s INTER t``) THEN
21166    ASM_SIMP_TAC std_ss [IN_NUMSEG, ZERO_LESS_EQ, NOT_LESS_EQUAL] THEN
21167    X_GEN_TAC ``i:num`` THEN STRIP_TAC THEN
21168    MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN ONCE_REWRITE_TAC[GSYM NOT_LESS_EQUAL] THEN
21169    UNDISCH_TAC ``!(x :num). x <= (N :num) ==> (g :num -> num) x <= (P :num)`` THEN
21170    DISCH_TAC THEN POP_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE [MONO_NOT_EQ]) THEN
21171    ASM_SIMP_TAC arith_ss [],
21172    MP_TAC(ISPECL [``f:num->num``, ``{ 0n..n}``] UPPER_BOUND_FINITE_SET) THEN
21173    REWRITE_TAC[FINITE_NUMSEG, IN_NUMSEG, ZERO_LESS_EQ] THEN
21174    DISCH_THEN(X_CHOOSE_TAC ``p:num``) THEN
21175    EXISTS_TAC
21176     ``sum(IMAGE (f:num->num) s INTER {N..p}) (\i. abs(x i :real))`` THEN
21177    CONJ_TAC THENL [ALL_TAC,
21178     MATCH_MP_TAC (REAL_ARITH ``abs x < y ==> x < y:real``) THEN
21179     ASM_SIMP_TAC real_ss []] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
21180    SIMP_TAC std_ss [ABS_POS, FINITE_INTER, FINITE_NUMSEG] THEN
21181    MATCH_MP_TAC(SET_RULE
21182     ``(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t)
21183      ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET
21184          (IMAGE f s INTER t)``) THEN
21185    ASM_SIMP_TAC arith_ss [IN_NUMSEG, ZERO_LESS_EQ]]
21186QED
21187
21188Theorem SERIES_INJECTIVE_IMAGE:
21189   !x:num->real s f l.
21190        summable (IMAGE f s) (\n. abs(x n)) /\
21191        (!m n. m IN s /\ n IN s /\ (f m = f n) ==> (m = n))
21192        ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))
21193Proof
21194  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN
21195  MATCH_MP_TAC LIM_TRANSFORM_EQ THEN SIMP_TAC std_ss [] THEN
21196  MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN
21197  ASM_REWRITE_TAC[]
21198QED
21199
21200Theorem SERIES_REARRANGE_EQ:
21201   !x:num->real s p l.
21202        (summable s (\n. abs(x n))) /\ (p permutes s)
21203        ==> (((x o p) sums l) s <=> (x sums l) s)
21204Proof
21205  REPEAT STRIP_TAC THEN
21206  MP_TAC(ISPECL [``x:num->real``, ``s:num->bool``, ``p:num->num``, ``l:real``]
21207        SERIES_INJECTIVE_IMAGE) THEN
21208  ASM_SIMP_TAC std_ss [PERMUTES_IMAGE] THEN
21209  ASM_MESON_TAC[PERMUTES_INJECTIVE]
21210QED
21211
21212Theorem SERIES_REARRANGE:
21213   !x:num->real s p l.
21214        summable s (\n. abs(x n)) /\ p permutes s /\ (x sums l) s
21215        ==> ((x o p) sums l) s
21216Proof
21217  METIS_TAC[SERIES_REARRANGE_EQ]
21218QED
21219
21220Theorem SUMMABLE_REARRANGE:
21221   !x s p.
21222        summable s (\n. abs(x n)) /\ p permutes s
21223        ==> summable s (x o p)
21224Proof
21225  METIS_TAC[SERIES_ABSCONV_IMP_CONV, summable, SERIES_REARRANGE]
21226QED
21227
21228(* ------------------------------------------------------------------------- *)
21229(* Banach fixed point theorem (not really topological...)                    *)
21230(* ------------------------------------------------------------------------- *)
21231
21232Theorem BANACH_FIX:
21233   !f s c. complete s /\ ~(s = {}) /\
21234           &0 <= c /\ c < &1 /\
21235           (IMAGE f s) SUBSET s /\
21236           (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y))
21237           ==> ?!x:real. x IN s /\ (f x = x)
21238Proof
21239  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL
21240   [ALL_TAC,
21241    MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
21242    SUBGOAL_THEN ``dist((f:real->real) x,f y) <= c * dist(x,y)`` MP_TAC THENL
21243     [ASM_MESON_TAC[], ALL_TAC] THEN
21244    ASM_REWRITE_TAC[REAL_ARITH ``a <= c * a <=> &0 <= -a * (&1 - c:real)``] THEN
21245    ASM_SIMP_TAC std_ss [GSYM REAL_LE_LDIV_EQ, REAL_SUB_LT, real_div] THEN
21246    REWRITE_TAC[REAL_MUL_LZERO, REAL_ARITH ``&0:real <= -x <=> ~(&0 < x)``] THEN
21247    MESON_TAC[DIST_POS_LT]] THEN
21248  KNOW_TAC ``?z. (z 0 = @x:real. x IN s) /\ (!n. z(SUC n) = f(z n))`` THENL
21249  [RW_TAC std_ss [num_Axiom], STRIP_TAC] THEN
21250  SUBGOAL_THEN ``!n. (z:num->real) n IN s`` ASSUME_TAC THENL
21251   [INDUCT_TAC THEN ASM_SIMP_TAC std_ss [] THEN
21252    METIS_TAC[MEMBER_NOT_EMPTY, SUBSET_DEF, IN_IMAGE],
21253    ALL_TAC] THEN
21254  UNDISCH_THEN ``z  0n = @x:real. x IN s`` (K ALL_TAC) THEN
21255  SUBGOAL_THEN ``?x:real. x IN s /\ (z --> x) sequentially`` MP_TAC THENL
21256   [ALL_TAC,
21257    DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
21258    POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
21259    ABBREV_TAC ``e = dist(f(a:real),a)`` THEN
21260    SUBGOAL_THEN ``~(&0 < e:real)`` (fn th => METIS_TAC[th, DIST_POS_LT]) THEN
21261    DISCH_TAC THEN UNDISCH_TAC ``(z --> a) sequentially`` THEN DISCH_TAC THEN
21262    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
21263    DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
21264    ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC ``N:num``) THEN
21265    SUBGOAL_THEN
21266     ``dist(f(z N),a:real) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2``
21267     (fn th => ASM_MESON_TAC[th, DIST_TRIANGLE_HALF_R, REAL_LT_REFL]) THEN
21268    CONJ_TAC THENL [ASM_MESON_TAC[ARITH_PROVE ``N <= SUC N``], ALL_TAC] THEN
21269    MATCH_MP_TAC REAL_LET_TRANS THEN
21270    EXISTS_TAC ``c * dist((z:num->real) N,a)`` THEN ASM_SIMP_TAC std_ss [] THEN
21271    MATCH_MP_TAC(REAL_ARITH ``x < y /\ c * x <= &1 * x ==> c * x < y:real``) THEN
21272    ASM_SIMP_TAC std_ss [LESS_EQ_REFL, REAL_LE_RMUL_IMP, DIST_POS_LE, REAL_LT_IMP_LE]] THEN
21273  UNDISCH_TAC ``complete s`` THEN DISCH_TAC THEN
21274  FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE [complete]) THEN
21275  ASM_REWRITE_TAC[CAUCHY] THEN
21276  SUBGOAL_THEN ``!n. dist(z(n):real,z(SUC n)) <= c pow n * dist(z(0),z(1))``
21277  ASSUME_TAC THENL
21278   [INDUCT_TAC THEN
21279    SIMP_TAC arith_ss [pow, REAL_MUL_LID, REAL_LE_REFL] THEN
21280    MATCH_MP_TAC REAL_LE_TRANS THEN
21281    EXISTS_TAC ``c * dist(z(n):real,z(SUC n))`` THEN
21282    CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
21283    REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC std_ss [REAL_LE_LMUL_IMP],
21284    ALL_TAC] THEN
21285  SUBGOAL_THEN
21286   ``!m n:num. (&1 - c) * dist(z(m):real,z(m+n))
21287                <= c pow m * dist(z(0),z 1n) * (&1 - c pow n)``
21288  ASSUME_TAC THENL
21289   [GEN_TAC THEN INDUCT_TAC THENL
21290     [REWRITE_TAC[ADD_CLAUSES, DIST_REFL, REAL_MUL_RZERO, GSYM REAL_MUL_ASSOC] THEN
21291      MATCH_MP_TAC REAL_LE_MUL THEN
21292      ASM_SIMP_TAC std_ss [REAL_LE_MUL, POW_POS, DIST_POS_LE, REAL_SUB_LE,
21293                   REAL_POW_1_LE, REAL_LT_IMP_LE],
21294      ALL_TAC] THEN
21295    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
21296    ``(&1 - c) * (dist(z m:real,z(m + n)) + dist(z(m + n),z(m + SUC n)))`` THEN
21297    ASM_SIMP_TAC std_ss [REAL_LE_LMUL_IMP, REAL_SUB_LE, REAL_LT_IMP_LE, DIST_TRIANGLE] THEN
21298    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
21299      ``c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y':real``)) THEN
21300    REWRITE_TAC[REAL_ARITH
21301     ``q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y:real)``] THEN
21302    REWRITE_TAC[ADD_CLAUSES, pow] THEN
21303    REWRITE_TAC[REAL_ARITH ``a * b * (d - c * d) = (&1 - c) * a * d * b:real``] THEN
21304    REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN
21305    ASM_SIMP_TAC std_ss [REAL_SUB_LE, REAL_LT_IMP_LE] THEN
21306    REWRITE_TAC[GSYM REAL_POW_ADD, REAL_MUL_ASSOC] THEN ASM_MESON_TAC[],
21307    ALL_TAC] THEN
21308  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
21309  ASM_CASES_TAC ``(z:num->real) 0 = z 1`` THENL
21310   [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC ``0:num`` THEN
21311    REWRITE_TAC[GE, ZERO_LESS_EQ] THEN X_GEN_TAC ``n:num`` THEN
21312    FIRST_X_ASSUM(MP_TAC o SPECL [``0:num``, ``n:num``]) THEN
21313    REWRITE_TAC[ADD_CLAUSES, DIST_REFL, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
21314    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
21315    ASM_CASES_TAC ``(z:num->real) 0 = z n`` THEN
21316    ASM_REWRITE_TAC[DIST_REFL, REAL_NOT_LE] THEN
21317    ASM_SIMP_TAC std_ss [REAL_LT_MUL, DIST_POS_LT, REAL_SUB_LT],
21318    ALL_TAC] THEN
21319  MP_TAC(SPECL [``c:real``, ``e * (&1 - c) / dist((z:num->real) 0,z 1)``]
21320   REAL_ARCH_POW_INV) THEN
21321  ASM_SIMP_TAC std_ss [REAL_LT_MUL, REAL_LT_DIV, REAL_SUB_LT, DIST_POS_LT] THEN
21322  DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
21323  POP_ASSUM MP_TAC THEN REWRITE_TAC[real_div, GE, REAL_MUL_ASSOC] THEN
21324  ASM_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, GSYM real_div, DIST_POS_LT] THEN
21325  ASM_SIMP_TAC std_ss [GSYM REAL_LT_LDIV_EQ, REAL_SUB_LT] THEN DISCH_TAC THEN
21326  SIMP_TAC std_ss [LESS_EQ_EXISTS, LEFT_IMP_EXISTS_THM] THEN
21327  X_GEN_TAC ``d:num`` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
21328  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH
21329    ``d < e ==> x <= d ==> x < e:real``)) THEN
21330  ASM_SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_SUB_LT] THEN
21331  FIRST_X_ASSUM(MP_TAC o SPECL [``N:num``, ``d:num``]) THEN
21332  MATCH_MP_TAC(REAL_ARITH
21333  ``(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d:real``) THEN
21334  MATCH_MP_TAC REAL_LE_LMUL_IMP THEN
21335  ASM_SIMP_TAC std_ss [REAL_LE_MUL, POW_POS, DIST_POS_LE, REAL_ARITH
21336   ``&0 <= x ==> &1 - x <= &1:real``]
21337QED
21338
21339(* ------------------------------------------------------------------------- *)
21340(* Dini's theorem.                                                           *)
21341(* ------------------------------------------------------------------------- *)
21342
21343Theorem DINI:
21344   !f:num->real->real g s.
21345        compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\
21346        (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\
21347        (!n x. x IN s ==> (f n x) <= (f (n + 1) x))
21348        ==> !e. &0 < e
21349                ==> eventually (\n. !x. x IN s ==> abs(f n x - g x) < e)
21350                               sequentially
21351Proof
21352  REPEAT STRIP_TAC THEN
21353  SUBGOAL_THEN
21354   ``!x:real m n:num. x IN s /\ m <= n ==> (f m x):real <= (f n x)``
21355  ASSUME_TAC THENL
21356   [GEN_TAC THEN ASM_CASES_TAC ``(x:real) IN s`` THEN ASM_REWRITE_TAC[] THEN
21357    ONCE_REWRITE_TAC [METIS [] ``!m n. (f:num->real->real) m x <= f n x <=>
21358                                       (\m n. f m x <= f n x) m n``] THEN
21359    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC std_ss [ADD1] THEN
21360    REAL_ARITH_TAC, ALL_TAC] THEN
21361  SUBGOAL_THEN ``!n:num x:real. x IN s ==> (f n x):real <= (g x)``
21362  ASSUME_TAC THENL
21363   [REPEAT STRIP_TAC THEN
21364    MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LE) THEN
21365    EXISTS_TAC ``\m:num. (f:num->real->real) n x`` THEN
21366    EXISTS_TAC ``\m:num. (f:num->real->real) m x`` THEN
21367    ASM_SIMP_TAC std_ss [LIM_CONST, TRIVIAL_LIMIT_SEQUENTIALLY] THEN
21368    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[],
21369    ALL_TAC] THEN
21370  RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY, dist]) THEN
21371  UNDISCH_TAC ``compact s`` THEN DISCH_TAC THEN
21372  FIRST_ASSUM(MP_TAC o REWRITE_RULE
21373   [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
21374  DISCH_THEN(MP_TAC o SPEC
21375   ``IMAGE (\n. { x | x IN s /\ abs((f:num->real->real) n x - g x) < e})
21376          univ(:num)``) THEN
21377  SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_UNIV] THEN
21378  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
21379  SIMP_TAC std_ss [EXISTS_FINITE_SUBSET_IMAGE, SUBSET_UNION, BIGUNION_IMAGE] THEN
21380  SIMP_TAC std_ss [IN_UNIV, GSPECIFICATION, EVENTUALLY_SEQUENTIALLY] THEN
21381  SIMP_TAC std_ss [SUBSET_DEF, IN_UNIV, GSPECIFICATION] THEN
21382  KNOW_TAC ``(!(n :num).
21383    open_in (subtopology euclidean (s :real -> bool))
21384      {x |
21385       x IN s /\
21386       abs ((f :num -> real -> real) n x - (g :real -> real) x) <
21387       (e :real)}) /\
21388 (!(x :real). x IN s ==> ?(n :num). abs (f n x - g x) < e)`` THENL
21389   [CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[LESS_EQ_REFL]] THEN
21390    X_GEN_TAC ``n:num`` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN
21391    ONCE_REWRITE_TAC [METIS [] ``f n x - g x =
21392          (\x. (f:num->real->real) n x - g x) x``] THEN
21393    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
21394    METIS_TAC [OPEN_BALL, CONTINUOUS_ON_SUB, ETA_AX],
21395    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
21396    DISCH_THEN(X_CHOOSE_THEN ``k:num->bool`` (CONJUNCTS_THEN2
21397     (MP_TAC o SPEC ``\n:num. n`` o MATCH_MP UPPER_BOUND_FINITE_SET)
21398     ASSUME_TAC)) THEN
21399    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
21400    POP_ASSUM MP_TAC THEN
21401    SIMP_TAC std_ss [] THEN STRIP_TAC THEN X_GEN_TAC ``n:num`` THEN
21402    DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
21403    UNDISCH_TAC ``!x. x IN s ==> ?n. n IN k /\
21404                  abs ((f:num->real->real) n x - g x) < e`` THEN
21405    DISCH_TAC THEN
21406    FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
21407    DISCH_THEN(X_CHOOSE_THEN ``m:num`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
21408    MATCH_MP_TAC(REAL_ARITH
21409     ``m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e:real``) THEN
21410    METIS_TAC[LESS_EQ_TRANS]]
21411QED
21412
21413(* ------------------------------------------------------------------------- *)
21414(* Closest point of a (closed) set to a point.                               *)
21415(* ------------------------------------------------------------------------- *)
21416
21417Definition closest_point[nocompute]:
21418 closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)
21419End
21420
21421Theorem CLOSEST_POINT_EXISTS:
21422   !s a. closed s /\ ~(s = {})
21423         ==> (closest_point s a) IN s /\
21424             !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)
21425Proof
21426  REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN
21427  REWRITE_TAC[DISTANCE_ATTAINS_INF]
21428QED
21429
21430Theorem CLOSEST_POINT_IN_SET:
21431   !s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s
21432Proof
21433  MESON_TAC[CLOSEST_POINT_EXISTS]
21434QED
21435
21436Theorem CLOSEST_POINT_LE:
21437   !s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)
21438Proof
21439  MESON_TAC[CLOSEST_POINT_EXISTS, MEMBER_NOT_EMPTY]
21440QED
21441
21442Theorem CLOSEST_POINT_SELF:
21443   !s x:real. x IN s ==> (closest_point s x = x)
21444Proof
21445  REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN
21446  MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL
21447   [BETA_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
21448    ASM_SIMP_TAC std_ss [DIST_LE_0, DIST_REFL],
21449    BETA_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL, DIST_POS_LE]]
21450QED
21451
21452Theorem CLOSEST_POINT_REFL:
21453   !s x:real. closed s /\ ~(s = {}) ==> ((closest_point s x = x) <=> x IN s)
21454Proof
21455  MESON_TAC[CLOSEST_POINT_IN_SET, CLOSEST_POINT_SELF]
21456QED
21457
21458Theorem DIST_CLOSEST_POINT_LIPSCHITZ:
21459   !s x y:real.
21460        closed s /\ ~(s = {})
21461        ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y))
21462            <= dist(x,y)
21463Proof
21464  REPEAT GEN_TAC THEN DISCH_TAC THEN
21465  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN
21466  DISCH_THEN(fn th =>
21467    CONJUNCTS_THEN2 ASSUME_TAC
21468     (MP_TAC o SPEC ``closest_point s (y:real)``) (SPEC ``x:real`` th) THEN
21469    CONJUNCTS_THEN2 ASSUME_TAC
21470     (MP_TAC o SPEC ``closest_point s (x:real)``) (SPEC ``y:real`` th)) THEN
21471  ASM_SIMP_TAC std_ss [dist] THEN REAL_ARITH_TAC
21472QED
21473
21474Theorem CONTINUOUS_AT_DIST_CLOSEST_POINT:
21475   !s x:real.
21476        closed s /\ ~(s = {})
21477        ==> (\x. (dist(x,closest_point s x))) continuous (at x)
21478Proof
21479  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [continuous_at] THEN REWRITE_TAC [dist] THEN
21480  METIS_TAC[REWRITE_RULE [dist] DIST_CLOSEST_POINT_LIPSCHITZ, REAL_LET_TRANS]
21481QED
21482
21483Theorem CONTINUOUS_ON_DIST_CLOSEST_POINT:
21484   !s t. closed s /\ ~(s = {})
21485         ==> (\x. (dist(x,closest_point s x))) continuous_on t
21486Proof
21487  METIS_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON,
21488            CONTINUOUS_AT_DIST_CLOSEST_POINT]
21489QED
21490
21491Theorem UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT:
21492   !s t:real->bool.
21493        closed s /\ ~(s = {})
21494        ==> (\x. (dist(x,closest_point s x))) uniformly_continuous_on t
21495Proof
21496  REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN
21497  REWRITE_TAC [dist] THEN
21498  METIS_TAC[REWRITE_RULE [dist] DIST_CLOSEST_POINT_LIPSCHITZ, REAL_LET_TRANS]
21499QED
21500
21501Theorem SEGMENT_TO_CLOSEST_POINT:
21502   !s a:real.
21503        closed s /\ ~(s = {})
21504        ==> (segment(a,closest_point s a) INTER s = {})
21505Proof
21506  REPEAT STRIP_TAC THEN
21507  REWRITE_TAC[SET_RULE ``(s INTER t = {}) <=> !x. x IN s ==> ~(x IN t)``] THEN
21508  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN
21509  MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN
21510  METIS_TAC [CLOSEST_POINT_EXISTS, REAL_NOT_LT, DIST_SYM]
21511QED
21512
21513Theorem SEGMENT_TO_POINT_EXISTS:
21514   !s a:real.
21515        closed s /\ ~(s = {}) ==> ?b. b IN s /\ (segment(a,b) INTER s = {})
21516Proof
21517  MESON_TAC[SEGMENT_TO_CLOSEST_POINT, CLOSEST_POINT_EXISTS]
21518QED
21519
21520Theorem CLOSEST_POINT_IN_INTERIOR:
21521   !s x:real.
21522        closed s /\ ~(s = {})
21523        ==> ((closest_point s x) IN interior s <=> x IN interior s)
21524Proof
21525  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``(x:real) IN s`` THEN
21526  ASM_SIMP_TAC std_ss [CLOSEST_POINT_SELF] THEN
21527  MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN
21528  CONJ_TAC THENL [METIS_TAC[INTERIOR_SUBSET, SUBSET_DEF], STRIP_TAC] THEN
21529  FIRST_ASSUM(MP_TAC o REWRITE_RULE [IN_INTERIOR_CBALL]) THEN
21530  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
21531  SUBGOAL_THEN ``closest_point s (x:real) IN s`` ASSUME_TAC THENL
21532   [METIS_TAC[INTERIOR_SUBSET, SUBSET_DEF], ALL_TAC] THEN
21533  SUBGOAL_THEN ``~(closest_point s (x:real) = x)`` ASSUME_TAC THENL
21534   [ASM_MESON_TAC[], ALL_TAC] THEN
21535  MP_TAC(ISPECL [``s:real->bool``, ``x:real``,
21536  ``closest_point s x -
21537    (min (&1) (e / abs(closest_point s x - x))) *
21538    (closest_point s x - x):real``]
21539    CLOSEST_POINT_LE) THEN
21540  ASM_REWRITE_TAC[dist, NOT_IMP, REAL_ARITH
21541   ``x - (y - e * (y - x)):real = (&1 - e) * (x - y:real)``] THEN
21542  CONJ_TAC THENL
21543  [ (* goal 1 (of 2) *)
21544    UNDISCH_TAC ``cball (closest_point s x,e) SUBSET s`` THEN DISCH_TAC THEN
21545    FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE [SUBSET_DEF]) THEN
21546    REWRITE_TAC[dist, IN_CBALL, REAL_ARITH ``abs(a:real - a - x) = abs x``] THEN
21547    SIMP_TAC real_ss [ABS_MUL, ABS_DIV, ABS_ABS] THEN
21548    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM REAL_SUB_0]) THEN
21549    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [ABS_NZ]) THEN
21550
21551    ASM_SIMP_TAC std_ss [GSYM REAL_LE_RDIV_EQ, min_def] THEN
21552    KNOW_TAC ``!a:real. &0 <= a ==> abs (if 1 <= a then 1 else a) <= a``
21553    >- ( RW_TAC real_ss [] >> PROVE_TAC [abs, REAL_LE_REFL] ) THEN
21554    DISCH_THEN MATCH_MP_TAC THEN
21555    ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, REAL_LE_DIV, ABS_POS],
21556    (* goal 2 (of 2) *)
21557    REWRITE_TAC[ABS_MUL, REAL_ARITH
21558     ``~(n <= a * n) <=> &0 < (&1 - a) * n:real``] THEN
21559    MATCH_MP_TAC REAL_LT_MUL THEN
21560    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_ARITH ``(a <> b) <=> (b - a <> 0:real)``]) THEN
21561    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [ABS_NZ]) THEN ASM_SIMP_TAC std_ss [] THEN
21562    KNOW_TAC ``!e:real. &0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)``
21563    >- ( RW_TAC real_ss [] \\
21564         `0 <= 1 - e'` by ASM_REAL_ARITH_TAC \\
21565         ASM_SIMP_TAC real_ss [abs] ) THEN
21566    DISCH_THEN MATCH_MP_TAC THEN
21567    REWRITE_TAC[REAL_MIN_LE, REAL_LT_MIN, REAL_LT_01, REAL_LE_REFL] THEN
21568    METIS_TAC [REAL_LT_DIV, ABS_SUB] ]
21569QED
21570
21571Theorem CLOSEST_POINT_IN_FRONTIER:
21572   !s x:real.
21573        closed s /\ ~(s = {}) /\ ~(x IN interior s)
21574        ==> (closest_point s x) IN frontier s
21575Proof
21576  SIMP_TAC std_ss [frontier, IN_DIFF, CLOSEST_POINT_IN_INTERIOR] THEN
21577  SIMP_TAC std_ss [CLOSEST_POINT_IN_SET, CLOSURE_CLOSED]
21578QED
21579
21580(* ------------------------------------------------------------------------- *)
21581(* More general infimum of distance between two sets.                        *)
21582(* ------------------------------------------------------------------------- *)
21583
21584(* New definition of ‘setdist’ *)
21585Overload setdist = “set_dist mr1”
21586
21587(* Old definition of ‘diameter’ (now becomes a theorem) *)
21588Theorem setdist :
21589    !s t. setdist(s,t) =
21590          if (s = {}) \/ (t = {}) then (&0 :real)
21591          else inf {dist(x,y) | x IN s /\ y IN t}
21592Proof
21593    RW_TAC std_ss [GSYM dist_def, dist, set_dist_def]
21594QED
21595
21596(* NOTE: This function translates “set_dist” theorems to “setdist” theorems. *)
21597fun mr1_xfer th = th |> INST_TYPE [alpha |-> “:real”]
21598                     |> INST [“m :real metric” |-> “mr1”]
21599                     |> REWRITE_RULE [GSYM dist_def] (* dist mr1 -> dist *)
21600
21601Theorem SETDIST_EMPTY          = mr1_xfer SET_DIST_EMPTY
21602Theorem SETDIST_POS_LE         = mr1_xfer SET_DIST_POS_LE
21603Theorem SETDIST_SUBSETS_EQ     = mr1_xfer SET_DIST_SUBSETS_EQ
21604Theorem REAL_LE_SETDIST        = mr1_xfer REAL_LE_SET_DIST
21605Theorem SETDIST_LE_DIST        = mr1_xfer SET_DIST_LE_DIST
21606Theorem REAL_LE_SETDIST_EQ     = mr1_xfer REAL_LE_SET_DIST_EQ
21607Theorem REAL_SETDIST_LT_EXISTS = mr1_xfer REAL_SET_DIST_LT_EXISTS
21608Theorem SETDIST_REFL           = mr1_xfer SET_DIST_REFL
21609Theorem SETDIST_SYM            = mr1_xfer SET_DIST_SYM
21610Theorem SETDIST_TRIANGLE       = mr1_xfer SET_DIST_TRIANGLE
21611Theorem SETDIST_SINGS          = mr1_xfer SET_DIST_SINGS
21612Theorem SETDIST_LIPSCHITZ      = mr1_xfer SET_DIST_LIPSCHITZ
21613
21614Theorem CONTINUOUS_AT_SETDIST:
21615   !s x:real. (\y. setdist({y},s)) continuous (at x)
21616Proof
21617  REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at] THEN
21618  SIMP_TAC std_ss [dist] THEN
21619  METIS_TAC[REWRITE_RULE [dist] SETDIST_LIPSCHITZ, REAL_LET_TRANS]
21620QED
21621
21622Theorem CONTINUOUS_ON_SETDIST:
21623   !s t:real->bool. (\y. setdist({y},s)) continuous_on t
21624Proof
21625  METIS_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON,
21626            CONTINUOUS_AT_SETDIST]
21627QED
21628
21629Theorem UNIFORMLY_CONTINUOUS_ON_SETDIST:
21630   !s t:real->bool.
21631         (\y. setdist({y},s)) uniformly_continuous_on t
21632Proof
21633  REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN
21634  BETA_TAC THEN METIS_TAC[dist, SETDIST_LIPSCHITZ, REAL_LET_TRANS]
21635QED
21636
21637Theorem SETDIST_DIFFERENCES:
21638   !s t. setdist(s,t) = setdist({0},{x - y:real | x IN s /\ y IN t})
21639Proof
21640  REPEAT GEN_TAC THEN
21641  KNOW_TAC ``!f:real->real->real x y s t.
21642   ({f x y | x IN s /\ y IN t} = {}) <=> (s = {}) \/ (t = {})`` THENL
21643  [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN SET_TAC [],
21644   DISCH_TAC] THEN
21645  ONCE_REWRITE_TAC [METIS [] ``x - y = (\x y. x - y) x y:real``] THEN
21646  ASM_REWRITE_TAC[setdist, NOT_INSERT_EMPTY] THEN
21647  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN AP_TERM_TAC THEN
21648  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_SING, EXISTS_PROD] THEN
21649  SIMP_TAC std_ss [GSYM CONJ_ASSOC, RIGHT_EXISTS_AND_THM, UNWIND_THM2, DIST_0] THEN
21650  REWRITE_TAC[dist] THEN MESON_TAC[]
21651QED
21652
21653Theorem SETDIST_SUBSET_RIGHT = mr1_xfer SET_DIST_SUBSET_RIGHT
21654Theorem SETDIST_SUBSET_LEFT  = mr1_xfer SET_DIST_SUBSET_LEFT
21655
21656Theorem SETDIST_CLOSURE:
21657   (!s t:real->bool. setdist(closure s,t) = setdist(s,t)) /\
21658   (!s t:real->bool. setdist(s,closure t) = setdist(s,t))
21659Proof
21660  REWRITE_TAC [METIS [SWAP_FORALL_THM]
21661   ``(!s t. setdist (s,closure t) = setdist (s,t)) =
21662     (!t s. setdist (s,closure t) = setdist (s,t))``] THEN
21663  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN
21664  SIMP_TAC std_ss [] THEN
21665  REWRITE_TAC[MESON[REAL_LE_ANTISYM]
21666   ``(x:real = y) <=> !d. d <= x <=> d <= y``] THEN
21667  REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
21668  MAP_EVERY ASM_CASES_TAC [``s:real->bool = {}``, ``t:real->bool = {}``] THEN
21669  ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY, CLOSURE_EMPTY, NOT_IN_EMPTY] THEN
21670  ONCE_REWRITE_TAC [METIS [] ``d <= dist (x,y) <=> (\x y. d <= dist (x,y)) x y``] THEN
21671  ONCE_REWRITE_TAC [METIS [] ``x IN s /\ y IN t <=> x IN s /\ (\y. y IN t) y``] THEN
21672  MATCH_MP_TAC(SET_RULE
21673   ``s SUBSET c /\
21674    (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y))
21675   ==> ((!x y. x IN c /\ Q y ==> P x y) <=>
21676        (!x y. x IN s /\ Q y ==> P x y))``) THEN
21677  SIMP_TAC std_ss [CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN
21678  ONCE_REWRITE_TAC [METIS [] ``dist (x,y) = (\x. dist (x, y)) x``] THEN
21679  MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN ASM_SIMP_TAC std_ss [] THEN
21680  ASM_SIMP_TAC std_ss [o_DEF, dist] THEN
21681  ONCE_REWRITE_TAC [METIS [] ``abs (x - y) = abs ((\x. x - y) x:real)``] THEN
21682  MATCH_MP_TAC CONTINUOUS_ON_ABS_COMPOSE THEN
21683  SIMP_TAC std_ss [CONTINUOUS_ON_SUB, CONTINUOUS_ON_CONST, CONTINUOUS_ON_ID]
21684QED
21685
21686Theorem SETDIST_FRONTIER:
21687   (!s t:real->bool.
21688        DISJOINT s t ==> (setdist(frontier s,t) = setdist(s,t))) /\
21689   (!s t:real->bool.
21690        DISJOINT s t ==> (setdist(s,frontier t) = setdist(s,t)))
21691Proof
21692  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN
21693  CONJ_TAC THENL [MESON_TAC[SETDIST_SYM, DISJOINT_SYM], ALL_TAC] THEN
21694  REPEAT STRIP_TAC THEN
21695  GEN_REWR_TAC RAND_CONV [GSYM(CONJUNCT1 SETDIST_CLOSURE)] THEN
21696  MATCH_MP_TAC SETDIST_SUBSETS_EQ THEN
21697  SIMP_TAC std_ss [frontier, IN_DIFF, DIFF_SUBSET, SUBSET_REFL] THEN
21698  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
21699  ASM_CASES_TAC  ``(x:real) IN interior s`` THENL
21700   [ALL_TAC, ASM_MESON_TAC[REAL_LE_REFL]] THEN
21701  KNOW_TAC ``?y' x'. (x' IN closure s /\ x' NOTIN interior s) /\
21702                      y' IN t /\ dist (x',y') <= dist (x,y)`` THENL
21703  [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
21704  EXISTS_TAC ``y:real`` THEN ASM_REWRITE_TAC[] THEN
21705  MP_TAC(ISPECL [``segment[x:real,y]``, ``s:real->bool``]
21706        CONNECTED_INTER_FRONTIER) THEN
21707  REWRITE_TAC[CONNECTED_SEGMENT, GSYM MEMBER_NOT_EMPTY] THEN
21708  KNOW_TAC ``(?x'. x' IN segment [(x,y)] INTER s) /\
21709             (?x'. x' IN segment [(x,y)] DIFF s)`` THENL
21710   [CONJ_TAC THENL [EXISTS_TAC ``x:real``, EXISTS_TAC ``y:real``] THEN
21711    ASM_SIMP_TAC std_ss [IN_INTER, IN_DIFF, ENDS_IN_SEGMENT] THEN
21712    MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN ASM_SET_TAC[],
21713    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
21714    DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN EXISTS_TAC ``z:real`` THEN
21715    POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [IN_INTER, frontier, IN_DIFF] THEN
21716    MESON_TAC[DIST_IN_CLOSED_SEGMENT]]
21717QED
21718
21719Theorem SETDIST_COMPACT_CLOSED:
21720   !s t:real->bool.
21721        compact s /\ closed t /\ ~(s = {}) /\ ~(t = {})
21722        ==> ?x y. x IN s /\ y IN t /\ (dist(x,y) = setdist(s,t))
21723Proof
21724  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
21725  KNOW_TAC ``?x y. (\x. x IN s) x /\ (\y. y IN t) y /\
21726                   (\x y. dist (x,y) <= setdist (s,t)) x y /\
21727                   (\x y. setdist (s,t) <= dist (x,y)) x y`` THENL
21728  [ALL_TAC, METIS_TAC []] THEN
21729  MATCH_MP_TAC(METIS []
21730   ``(!x y. P x /\ Q y ==> R' x y) /\ (?x y. (P x /\ Q y /\ R x y))
21731    ==> (?x y. P x /\ Q y /\ R x y /\ R' x y)``) THEN
21732  SIMP_TAC std_ss [SETDIST_LE_DIST] THEN
21733  ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
21734  MP_TAC(ISPECL [``{x - y:real | x IN s /\ y IN t}``, ``0:real``]
21735        DISTANCE_ATTAINS_INF) THEN
21736  ASM_SIMP_TAC std_ss [COMPACT_CLOSED_DIFFERENCES, EXISTS_IN_GSPEC, FORALL_IN_GSPEC,
21737               DIST_0, GSYM CONJ_ASSOC, GSPECIFICATION, EXISTS_PROD] THEN
21738  REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
21739  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN ASM_SET_TAC[]
21740QED
21741
21742Theorem SETDIST_CLOSED_COMPACT:
21743   !s t:real->bool.
21744        closed s /\ compact t /\ ~(s = {}) /\ ~(t = {})
21745        ==> ?x y. x IN s /\ y IN t /\ (dist(x,y) = setdist(s,t))
21746Proof
21747  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
21748   KNOW_TAC ``?x y. (\x. x IN s) x /\ (\y. y IN t) y /\
21749                   (\x y. dist (x,y) <= setdist (s,t)) x y /\
21750                   (\x y. setdist (s,t) <= dist (x,y)) x y`` THENL
21751  [ALL_TAC, METIS_TAC []] THEN
21752  MATCH_MP_TAC(METIS[]
21753   ``(!x y. P x /\ Q y ==> R' x y) /\ (?x y. P x /\ Q y /\ R x y)
21754    ==> ?x y. P x /\ Q y /\ R x y /\ R' x y``) THEN
21755  SIMP_TAC std_ss [SETDIST_LE_DIST] THEN
21756  ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
21757  MP_TAC(ISPECL [``{x - y:real | x IN s /\ y IN t}``, ``0:real``]
21758        DISTANCE_ATTAINS_INF) THEN
21759  ASM_SIMP_TAC std_ss [CLOSED_COMPACT_DIFFERENCES, EXISTS_IN_GSPEC, FORALL_IN_GSPEC,
21760               DIST_0, GSYM CONJ_ASSOC, GSPECIFICATION, EXISTS_PROD] THEN
21761  REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
21762  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN ASM_SET_TAC[]
21763QED
21764
21765Theorem SETDIST_EQ_0_COMPACT_CLOSED:
21766   !s t:real->bool.
21767        compact s /\ closed t
21768        ==> ((setdist(s,t) = &0) <=> (s = {}) \/ (t = {}) \/ ~(s INTER t = {}))
21769Proof
21770  REPEAT STRIP_TAC THEN
21771  MAP_EVERY ASM_CASES_TAC [``s:real->bool = {}``, ``t:real->bool = {}``] THEN
21772  ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL
21773   [MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``]
21774      SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN
21775    REWRITE_TAC[EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0],
21776    REWRITE_TAC[GSYM REAL_LE_ANTISYM, SETDIST_POS_LE] THEN
21777    REWRITE_TAC[EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN
21778    MESON_TAC[SETDIST_LE_DIST, DIST_EQ_0]]
21779QED
21780
21781Theorem SETDIST_EQ_0_CLOSED_COMPACT:
21782   !s t:real->bool.
21783        closed s /\ compact t
21784        ==> ((setdist(s,t) = &0) <=> (s = {}) \/ (t = {}) \/ ~(s INTER t = {}))
21785Proof
21786  ONCE_REWRITE_TAC[SETDIST_SYM] THEN
21787  SIMP_TAC std_ss [SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]
21788QED
21789
21790Theorem SETDIST_EQ_0_BOUNDED:
21791   !s t:real->bool.
21792        (bounded s \/ bounded t)
21793        ==> ((setdist(s,t) = &0) <=>
21794             (s = {}) \/ (t = {}) \/ ~(closure(s) INTER closure(t) = {}))
21795Proof
21796  REPEAT GEN_TAC THEN
21797  MAP_EVERY ASM_CASES_TAC [``s:real->bool = {}``, ``t:real->bool = {}``] THEN
21798  ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN
21799  ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE]
21800   ``setdist(s,t) = setdist(closure s,closure t)``] THEN
21801  ASM_SIMP_TAC std_ss [SETDIST_EQ_0_COMPACT_CLOSED, SETDIST_EQ_0_CLOSED_COMPACT,
21802               COMPACT_CLOSURE, CLOSED_CLOSURE, CLOSURE_EQ_EMPTY]
21803QED
21804
21805Theorem SETDIST_TRANSLATION:
21806   !a:real s t.
21807        setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)
21808Proof
21809  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN
21810  AP_TERM_TAC THEN AP_TERM_TAC THEN
21811  KNOW_TAC ``!f:real->real->real x:real y:real g:real->real s:real->bool t:real->bool.
21812   {f x y | x IN IMAGE g s /\ y IN IMAGE g t} = {f (g x) (g y) | x IN s /\ y IN t}`` THENL
21813  [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN
21814   ASM_SET_TAC[], DISCH_TAC] THEN
21815  ONCE_REWRITE_TAC [METIS [] ``x - y = (\x y. x - y) x y:real``] THEN
21816  ASM_REWRITE_TAC [] THEN
21817  SIMP_TAC std_ss [REAL_ARITH ``(a + x) - (a + y):real = x - y``]
21818QED
21819
21820Theorem SETDIST_LINEAR_IMAGE:
21821   !f:real->real s t.
21822        linear f /\ (!x. abs(f x) = abs x)
21823        ==> (setdist(IMAGE f s,IMAGE f t) = setdist(s,t))
21824Proof
21825  REPEAT STRIP_TAC THEN REWRITE_TAC[setdist, IMAGE_EQ_EMPTY] THEN
21826  COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN
21827  ONCE_REWRITE_TAC [METIS [] ``abs (x - y) = (\x y. abs (x - y)) x y:real``] THEN
21828  KNOW_TAC ``!f:real->real->real x:real y:real g:real->real s:real->bool t:real->bool.
21829   {f x y | x IN IMAGE g s /\ y IN IMAGE g t} = {f (g x) (g y) | x IN s /\ y IN t}`` THENL
21830  [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, EXISTS_PROD] THEN
21831   ASM_SET_TAC[], DISCH_TAC] THEN ASM_REWRITE_TAC [] THEN BETA_TAC THEN
21832  FIRST_X_ASSUM(fn th => REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN
21833  ASM_SIMP_TAC std_ss []
21834QED
21835
21836Theorem SETDIST_UNIQUE = mr1_xfer SET_DIST_UNIQUE
21837Theorem SETDIST_UNIV   = mr1_xfer SET_DIST_UNIV
21838Theorem SETDIST_ZERO   = mr1_xfer SET_DIST_ZERO
21839
21840Theorem SETDIST_ZERO_STRONG:
21841   !s t:real->bool.
21842      ~(DISJOINT (closure s) (closure t)) ==> (setdist(s,t) = &0)
21843Proof
21844  MESON_TAC[SETDIST_CLOSURE, SETDIST_ZERO]
21845QED
21846
21847Theorem SETDIST_FRONTIERS:
21848   !s t:real->bool.
21849        setdist(s,t) =
21850        if DISJOINT s t then setdist(frontier s,frontier t) else &0
21851Proof
21852  REPEAT STRIP_TAC THEN
21853  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [SETDIST_ZERO] THEN
21854  ASSUME_TAC SETDIST_FRONTIER THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
21855  DISCH_THEN (CONJUNCTS_THEN2 K_TAC ASSUME_TAC) THEN ASM_SIMP_TAC std_ss [] THEN
21856  POP_ASSUM K_TAC THEN
21857  ASM_CASES_TAC ``DISJOINT s (frontier t:real->bool)`` THENL
21858   [ASM_MESON_TAC[SETDIST_FRONTIER], ALL_TAC] THEN
21859  GEN_REWR_TAC LAND_CONV [GSYM(CONJUNCT1 SETDIST_CLOSURE)] THEN
21860  CONV_TAC SYM_CONV THEN MATCH_MP_TAC SETDIST_SUBSETS_EQ THEN
21861  SIMP_TAC std_ss [frontier, DIFF_SUBSET, SUBSET_REFL, IN_DIFF] THEN
21862  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
21863  KNOW_TAC ``?y' x'.
21864  (x' IN closure s /\ x' NOTIN interior s) /\
21865  (y' IN closure t /\ y' NOTIN interior t) /\ dist (x',y') <= dist (x,y)`` THENL
21866  [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN EXISTS_TAC ``y:real`` THEN
21867  ASM_REWRITE_TAC[] THEN
21868  ASM_CASES_TAC ``(x:real) IN interior s`` THENL
21869   [ALL_TAC, ASM_MESON_TAC[REAL_LE_REFL]] THEN
21870  MP_TAC(ISPECL [``segment[x:real,y]``, ``interior s:real->bool``]
21871        CONNECTED_INTER_FRONTIER) THEN
21872  REWRITE_TAC[CONNECTED_SEGMENT, GSYM MEMBER_NOT_EMPTY] THEN
21873  KNOW_TAC ``(?x'. x' IN segment [(x,y)] INTER interior s) /\
21874             (?x'. x' IN segment [(x,y)] DIFF interior s)`` THENL
21875   [CONJ_TAC THENL [EXISTS_TAC ``x:real``, EXISTS_TAC ``y:real``] THEN
21876    ASM_SIMP_TAC std_ss [IN_INTER, IN_DIFF, ENDS_IN_SEGMENT] THEN
21877    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
21878     ``y IN u ==> (u INTER v = {}) ==> ~(y IN v)``)) THEN
21879    REWRITE_TAC[INTERIOR_CLOSURE, SET_RULE
21880     ``(s INTER (UNIV DIFF t) = {}) <=> s SUBSET t``] THEN
21881    MATCH_MP_TAC SUBSET_CLOSURE THEN ASM_SET_TAC[],
21882    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
21883    DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN EXISTS_TAC ``z:real`` THEN
21884    POP_ASSUM MP_TAC THEN
21885    SIMP_TAC std_ss [IN_INTER, GSYM frontier, GSYM IN_DIFF] THEN
21886    MESON_TAC[FRONTIER_INTERIOR_SUBSET, SUBSET_DEF, DIST_IN_CLOSED_SEGMENT]]
21887QED
21888
21889Theorem SETDIST_SING_FRONTIER:
21890   !s x:real. ~(x IN s) ==> (setdist({x},frontier s) = setdist({x},s))
21891Proof
21892  MESON_TAC[SET_RULE ``DISJOINT {x} s <=> ~(x IN s)``, SETDIST_FRONTIER]
21893QED
21894
21895Theorem SETDIST_CLOSEST_POINT:
21896   !a:real s.
21897      closed s /\ ~(s = {}) ==> (setdist({a},s) = dist(a,closest_point s a))
21898Proof
21899  REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN
21900  SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM, IN_SING, UNWIND_THM2] THEN
21901  EXISTS_TAC ``closest_point s (a:real)`` THEN
21902  ASM_MESON_TAC[CLOSEST_POINT_EXISTS, DIST_SYM]
21903QED
21904
21905Theorem SETDIST_EQ_0_SING:
21906   (!s x:real. (setdist({x},s) = &0) <=> (s = {}) \/ x IN closure s) /\
21907   (!s x:real. (setdist(s,{x}) = &0) <=> (s = {}) \/ x IN closure s)
21908Proof
21909  SIMP_TAC std_ss [SETDIST_EQ_0_BOUNDED, BOUNDED_SING, CLOSURE_SING] THEN SET_TAC[]
21910QED
21911
21912Theorem SETDIST_EQ_0_CLOSED:
21913   !s x. closed s ==> ((setdist({x},s) = &0) <=> (s = {}) \/ x IN s)
21914Proof
21915  SIMP_TAC std_ss [SETDIST_EQ_0_COMPACT_CLOSED, COMPACT_SING] THEN SET_TAC[]
21916QED
21917
21918Theorem SETDIST_EQ_0_CLOSED_IN:
21919   !u s x. closed_in (subtopology euclidean u) s /\ x IN u
21920           ==> ((setdist({x},s) = &0) <=> (s = {}) \/ x IN s)
21921Proof
21922  REWRITE_TAC[SETDIST_EQ_0_SING, CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]
21923QED
21924
21925Theorem SETDIST_SING_IN_SET = mr1_xfer SET_DIST_SING_IN_SET
21926
21927Theorem SETDIST_SING_FRONTIER_CASES:
21928   !s x:real.
21929        setdist({x},s) = if x IN s then &0 else setdist({x},frontier s)
21930Proof
21931  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
21932  ASM_SIMP_TAC std_ss [SETDIST_SING_IN_SET, SETDIST_SING_FRONTIER]
21933QED
21934
21935Theorem SETDIST_SING_TRIANGLE:
21936   !s x y:real. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)
21937Proof
21938  REPEAT GEN_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
21939  ASM_REWRITE_TAC[SETDIST_EMPTY, REAL_SUB_REFL, ABS_N, DIST_POS_LE] THEN
21940  REWRITE_TAC[ABS_BOUNDS, REAL_NEG_SUB] THEN REPEAT STRIP_TAC THEN
21941  ONCE_REWRITE_TAC[REAL_ARITH ``a - b <= c <=> a - c <= b:real``,
21942                   REAL_ARITH ``-a <= b - c <=> c - a <= b:real``] THEN
21943  MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN
21944  SIMP_TAC std_ss [IN_SING, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM, UNWIND_FORALL_THM2] THEN
21945  X_GEN_TAC ``z:real`` THEN DISCH_TAC THEN REWRITE_TAC [dist] THENL
21946   [MATCH_MP_TAC(REAL_ARITH
21947     ``a <= abs(y:real - z) ==> a - abs(x - y) <= abs(x - z:real)``),
21948    MATCH_MP_TAC(REAL_ARITH
21949     ``a <= abs(x:real - z) ==> a - abs(x - y) <= abs(y - z)``)] THEN
21950  REWRITE_TAC [GSYM dist] THEN
21951  MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]
21952QED
21953
21954Theorem SETDIST_LE_SING = mr1_xfer SET_DIST_LE_SING
21955
21956Theorem SETDIST_BALLS:
21957   (!a b:real r s.
21958        setdist(ball(a,r),ball(b,s)) =
21959        if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
21960   (!a b:real r s.
21961        setdist(ball(a,r),cball(b,s)) =
21962        if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
21963   (!a b:real r s.
21964        setdist(cball(a,r),ball(b,s)) =
21965        if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
21966   (!a b:real r s.
21967        setdist(cball(a,r),cball(b,s)) =
21968        if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))
21969Proof
21970  REWRITE_TAC[METIS[]
21971   ``(x = if p then y else z) <=> (p ==> (x = y)) /\ (~p ==> (x = z))``] THEN
21972  SIMP_TAC std_ss [TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
21973  SIMP_TAC std_ss [BALL_EMPTY, CBALL_EMPTY, SETDIST_EMPTY, DE_MORGAN_THM] THEN
21974  ONCE_REWRITE_TAC[METIS[SETDIST_CLOSURE]
21975   ``setdist(s,t) = setdist(closure s,closure t)``] THEN
21976  SIMP_TAC std_ss [REAL_NOT_LE, REAL_NOT_LT, CLOSURE_BALL] THEN
21977  REWRITE_TAC[SETDIST_CLOSURE] THEN
21978  MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN
21979  CONJ_TAC THENL [METIS_TAC[REAL_LT_IMP_LE], REPEAT GEN_TAC] THEN
21980  REWRITE_TAC[max_def, REAL_SUB_LE] THEN COND_CASES_TAC THEN
21981  SIMP_TAC std_ss [SETDIST_EQ_0_BOUNDED, BOUNDED_CBALL, CLOSED_CBALL, CLOSURE_CLOSED,
21982           CBALL_EQ_EMPTY, INTER_BALLS_EQ_EMPTY]
21983  THENL [ALL_TAC, ASM_REAL_ARITH_TAC] THEN
21984  ASM_CASES_TAC ``b:real = a`` THENL
21985   [FIRST_X_ASSUM SUBST_ALL_TAC THEN
21986    RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN
21987    ASM_CASES_TAC ``(r = &0:real) /\ (s = &0:real)`` THENL
21988     [ALL_TAC, ASM_REAL_ARITH_TAC] THEN
21989    ASM_SIMP_TAC std_ss [CBALL_SING, SETDIST_SINGS, dist] THEN REAL_ARITH_TAC,
21990    STRIP_TAC] THEN
21991  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
21992   [ALL_TAC,
21993    MATCH_MP_TAC REAL_LE_SETDIST THEN
21994    ASM_REWRITE_TAC[CBALL_EQ_EMPTY, REAL_NOT_LT, IN_CBALL, dist] THEN
21995    REAL_ARITH_TAC] THEN
21996  MATCH_MP_TAC REAL_LE_TRANS THEN
21997  EXISTS_TAC ``dist(a + r / dist(a,b) * (b - a):real,
21998                   b - s / dist(a,b) * (b - a))`` THEN
21999  CONJ_TAC THENL
22000   [MATCH_MP_TAC SETDIST_LE_DIST THEN
22001    REWRITE_TAC[dist, IN_CBALL, REAL_ARITH ``abs(a - (a + x)) = abs x:real``,
22002                                REAL_ARITH ``abs(a - (a - x)) = abs x:real``] THEN
22003    REWRITE_TAC [GSYM dist] THEN ONCE_REWRITE_TAC [DIST_SYM] THEN
22004    FULL_SIMP_TAC real_ss [dist, ABS_MUL, ABS_DIV, ABS_ABS, ABS_NZ,
22005      REAL_LT_IMP_NE, REAL_ARITH ``(b <> a) = (b - a <> 0:real)``] THEN
22006    KNOW_TAC ``abs (b - a:real) <> 0`` THENL
22007     [METIS_TAC [REAL_LT_IMP_NE], DISCH_TAC] THEN
22008    ASM_SIMP_TAC std_ss [REAL_DIV_RMUL, REAL_SUB_0, ABS_ZERO] THEN
22009    ASM_REAL_ARITH_TAC,
22010    REWRITE_TAC[dist, REAL_ARITH
22011     ``(a + d * (b - a)) - (b - e * (b - a)):real =
22012       (&1 - d - e) * (a - b:real)``] THEN
22013    REWRITE_TAC[ABS_MUL, real_div, REAL_ARITH
22014      ``&1 - r * y - s * y = &1 - (r + s) * y:real``] THEN
22015    REWRITE_TAC [GSYM real_div] THEN
22016    REWRITE_TAC [METIS [GSYM ABS_ABS]
22017                       ``d * abs (a - b) = d * abs(abs (a - b:real))``] THEN
22018    REWRITE_TAC[GSYM ABS_MUL] THEN
22019    KNOW_TAC ``!n x:real. ~(n = &0) ==> ((&1 - x / n) * n = n - x)`` THENL
22020    [REPEAT GEN_TAC THEN DISCH_TAC THEN
22021     ASM_SIMP_TAC std_ss [REAL_SUB_RDISTRIB, REAL_DIV_RMUL] THEN
22022     REAL_ARITH_TAC, DISCH_TAC] THEN
22023    RULE_ASSUM_TAC
22024     (ONCE_REWRITE_RULE [REAL_ARITH ``(b <> a) = (abs (a - b) <> 0:real)``]) THEN
22025    ASM_SIMP_TAC real_ss [REAL_SUB_0, ABS_ZERO] THEN
22026    FULL_SIMP_TAC std_ss [dist] THEN SIMP_TAC std_ss [REAL_LE_LT] THEN
22027    DISJ2_TAC THEN REWRITE_TAC [ABS_REFL, REAL_SUB_LE] THEN ASM_REWRITE_TAC []]
22028QED
22029
22030(* ------------------------------------------------------------------------- *)
22031(* Use set distance for an easy proof of separation properties etc.          *)
22032(* ------------------------------------------------------------------------- *)
22033
22034Theorem SEPARATION_CLOSURES:
22035   !s t:real->bool.
22036        (s INTER closure(t) = {}) /\ (t INTER closure(s) = {})
22037        ==> ?u v. DISJOINT u v /\ open u /\ open v /\
22038                  s SUBSET u /\ t SUBSET v
22039Proof
22040  REPEAT STRIP_TAC THEN
22041  ASM_CASES_TAC ``s:real->bool = {}`` THENL
22042   [MAP_EVERY EXISTS_TAC [``{}:real->bool``, ``univ(:real)``] THEN
22043    ASM_REWRITE_TAC[OPEN_EMPTY, OPEN_UNIV] THEN ASM_SET_TAC[],
22044    ALL_TAC] THEN
22045  ASM_CASES_TAC ``t:real->bool = {}`` THENL
22046   [MAP_EVERY EXISTS_TAC [``univ(:real)``, ``{}:real->bool``] THEN
22047    ASM_REWRITE_TAC[OPEN_EMPTY, OPEN_UNIV] THEN ASM_SET_TAC[],
22048    ALL_TAC] THEN
22049  EXISTS_TAC ``{x | x IN univ(:real) /\
22050                   (setdist({x},t) - setdist({x},s)) IN
22051                   {x | &0 < x}}`` THEN
22052  EXISTS_TAC ``{x | x IN univ(:real) /\
22053                   (setdist({x},t) - setdist({x},s)) IN
22054                   {x | x < &0}}`` THEN
22055  REPEAT CONJ_TAC THENL
22056   [REWRITE_TAC[SET_RULE ``DISJOINT s t <=> !x. x IN s /\ x IN t ==> F``] THEN
22057    SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV] THEN REAL_ARITH_TAC,
22058    ONCE_REWRITE_TAC [METIS [] ``(setdist ({x},t) - setdist ({x},s)) =
22059                             (\x. setdist ({x},t) - setdist ({x},s)) x``] THEN
22060    MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN
22061    SIMP_TAC std_ss [REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT, OPEN_UNIV] THEN
22062    SIMP_TAC std_ss [CONTINUOUS_ON_SUB, CONTINUOUS_ON_SETDIST],
22063    ONCE_REWRITE_TAC [METIS [] ``(setdist ({x},t) - setdist ({x},s)) =
22064                             (\x. setdist ({x},t) - setdist ({x},s)) x``] THEN
22065    MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN
22066    SIMP_TAC std_ss [OPEN_HALFSPACE_COMPONENT_LT, OPEN_UNIV] THEN
22067    SIMP_TAC std_ss [CONTINUOUS_ON_SUB, CONTINUOUS_ON_SETDIST],
22068    SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNIV] THEN
22069    GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
22070     ``&0 <= x /\ (y = &0) /\ ~(x = &0) ==> &0 < x - y:real``),
22071    SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNIV] THEN
22072    GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
22073     ``&0 <= y /\ (x = &0) /\ ~(y = &0) ==> x - y < &0:real``)] THEN
22074  ASM_SIMP_TAC std_ss [SETDIST_POS_LE, SETDIST_EQ_0_BOUNDED, BOUNDED_SING] THEN
22075  ASM_SIMP_TAC std_ss [CLOSED_SING, CLOSURE_CLOSED, NOT_INSERT_EMPTY,
22076               REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET,
22077               SET_RULE ``({a} INTER s = {}) <=> ~(a IN s)``] THEN
22078  ASM_SET_TAC[]
22079QED
22080
22081Theorem SEPARATION_NORMAL:
22082   !s t:real->bool.
22083        closed s /\ closed t /\ (s INTER t = {})
22084        ==> ?u v. open u /\ open v /\
22085                  s SUBSET u /\ t SUBSET v /\ (u INTER v = {})
22086Proof
22087  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT_DEF] THEN
22088  ONCE_REWRITE_TAC[TAUT
22089    `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN
22090  MATCH_MP_TAC SEPARATION_CLOSURES THEN
22091  ASM_SIMP_TAC std_ss [CLOSURE_CLOSED] THEN ASM_SET_TAC[]
22092QED
22093
22094Theorem SEPARATION_NORMAL_LOCAL:
22095   !s t u:real->bool.
22096        closed_in (subtopology euclidean u) s /\
22097        closed_in (subtopology euclidean u) t /\
22098        (s INTER t = {})
22099        ==> ?s' t'. open_in (subtopology euclidean u) s' /\
22100                    open_in (subtopology euclidean u) t' /\
22101                    s SUBSET s' /\ t SUBSET t' /\ (s' INTER t' = {})
22102Proof
22103  REPEAT STRIP_TAC THEN
22104  ASM_CASES_TAC ``s:real->bool = {}`` THENL
22105   [MAP_EVERY EXISTS_TAC [``{}:real->bool``, ``u:real->bool``] THEN
22106    ASM_SIMP_TAC std_ss [OPEN_IN_REFL, OPEN_IN_EMPTY, INTER_EMPTY, EMPTY_SUBSET] THEN
22107    ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET],
22108    ALL_TAC] THEN
22109  ASM_CASES_TAC ``t:real->bool = {}`` THENL
22110   [MAP_EVERY EXISTS_TAC [``u:real->bool``, ``{}:real->bool``] THEN
22111    ASM_SIMP_TAC std_ss [OPEN_IN_REFL, OPEN_IN_EMPTY, INTER_EMPTY, EMPTY_SUBSET] THEN
22112    ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET],
22113    ALL_TAC] THEN
22114  EXISTS_TAC ``{x:real | x IN u /\ setdist({x},s) < setdist({x},t)}`` THEN
22115  EXISTS_TAC ``{x:real | x IN u /\ setdist({x},t) < setdist({x},s)}`` THEN
22116  SIMP_TAC std_ss [EXTENSION, SUBSET_DEF, GSPECIFICATION, SETDIST_SING_IN_SET, IN_INTER,
22117           NOT_IN_EMPTY, SETDIST_POS_LE, CONJ_ASSOC,
22118           REAL_ARITH ``&0 < x <=> &0 <= x /\ ~(x = &0:real)``] THEN
22119  CONJ_TAC THENL [ALL_TAC, METIS_TAC[REAL_LT_ANTISYM]] THEN
22120  ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
22121   [ALL_TAC,
22122    ASM_MESON_TAC[SETDIST_EQ_0_CLOSED_IN, CLOSED_IN_IMP_SUBSET, SUBSET_DEF,
22123                  MEMBER_NOT_EMPTY, IN_INTER]] THEN
22124  ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
22125  ONCE_REWRITE_TAC [METIS [] ``(setdist ({x},t) - setdist ({x},s)) =
22126                           (\x. setdist ({x},t) - setdist ({x},s)) x``] THEN
22127  REWRITE_TAC[SET_RULE
22128   ``{x:real | x IN u /\ &0 < (f:real->real) x} =
22129     {x:real | x IN u /\ f x IN {x | &0 < x}}``] THEN
22130  CONJ_TAC THEN
22131  MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
22132  REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT,
22133           REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT, OPEN_UNIV] THEN
22134  SIMP_TAC std_ss [CONTINUOUS_ON_SUB, CONTINUOUS_ON_SETDIST]
22135QED
22136
22137Theorem SEPARATION_NORMAL_COMPACT:
22138   !s t:real->bool.
22139        compact s /\ closed t /\ (s INTER t = {})
22140        ==> ?u v. open u /\ compact(closure u) /\ open v /\
22141                  s SUBSET u /\ t SUBSET v /\ (u INTER v = {})
22142Proof
22143  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED, CLOSED_CLOSURE] THEN
22144  REPEAT STRIP_TAC THEN FIRST_ASSUM
22145   (MP_TAC o SPEC ``0:real`` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
22146  DISCH_THEN(X_CHOOSE_THEN ``r:real`` STRIP_ASSUME_TAC) THEN
22147  MP_TAC(ISPECL [``s:real->bool``, ``t UNION (univ(:real) DIFF ball(0,r))``]
22148        SEPARATION_NORMAL) THEN
22149  ASM_SIMP_TAC std_ss [CLOSED_UNION, GSYM OPEN_CLOSED, OPEN_BALL] THEN
22150  KNOW_TAC ``((s :real -> bool) INTER
22151  ((t :real -> bool) UNION
22152   (univ(:real) DIFF ball ((0 :real),(r :real)))) =
22153  ({} :real -> bool))`` THENL [ASM_SET_TAC[], DISCH_TAC THEN
22154    ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
22155  STRIP_TAC THEN EXISTS_TAC ``u:real->bool`` THEN
22156  EXISTS_TAC ``v:real->bool`` THEN ASM_REWRITE_TAC[] THEN
22157  CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE, ASM_SET_TAC[]] THEN
22158  MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC ``ball(0:real,r)`` THEN
22159  REWRITE_TAC[BOUNDED_BALL] THEN ASM_SET_TAC[]
22160QED
22161
22162Theorem SEPARATION_HAUSDORFF:
22163   !x:real y.
22164      ~(x = y)
22165      ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})
22166Proof
22167  REPEAT STRIP_TAC THEN
22168  MP_TAC(SPECL [``{x:real}``, ``{y:real}``] SEPARATION_NORMAL) THEN
22169  REWRITE_TAC[SING_SUBSET, CLOSED_SING] THEN
22170  DISCH_THEN MATCH_MP_TAC THEN ASM_SET_TAC[]
22171QED
22172
22173Theorem SEPARATION_T2:
22174   !x:real y.
22175        ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\
22176                           (u INTER v = {})
22177Proof
22178  REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC std_ss [SEPARATION_HAUSDORFF] THEN
22179  REWRITE_TAC[EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN MESON_TAC[]
22180QED
22181
22182Theorem SEPARATION_T1:
22183   !x:real y.
22184        ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\
22185                           ~(x IN v) /\ y IN v
22186Proof
22187  REPEAT STRIP_TAC THEN EQ_TAC THENL
22188   [ASM_SIMP_TAC std_ss [SEPARATION_T2, EXTENSION, NOT_IN_EMPTY, IN_INTER],
22189    ALL_TAC] THEN MESON_TAC[]
22190QED
22191
22192Theorem SEPARATION_T0:
22193   !x:real y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)
22194Proof
22195  MESON_TAC[SEPARATION_T1]
22196QED
22197
22198(* ------------------------------------------------------------------------- *)
22199(* Connectedness of the intersection of a chain.                             *)
22200(* ------------------------------------------------------------------------- *)
22201
22202Theorem CONNECTED_CHAIN:
22203   !f:(real->bool)->bool.
22204        (!s. s IN f ==> compact s /\ connected s) /\
22205        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
22206        ==> connected(BIGINTER f)
22207Proof
22208  REPEAT STRIP_TAC THEN
22209  ASM_CASES_TAC ``f:(real->bool)->bool = {}`` THEN
22210  ASM_REWRITE_TAC[BIGINTER_EMPTY, CONNECTED_UNIV] THEN
22211  ABBREV_TAC ``c:real->bool = BIGINTER f`` THEN
22212  SUBGOAL_THEN ``compact(c:real->bool)`` ASSUME_TAC THENL
22213   [EXPAND_TAC "c" THEN MATCH_MP_TAC COMPACT_BIGINTER THEN ASM_SET_TAC[],
22214    ALL_TAC] THEN
22215  ASM_SIMP_TAC std_ss [CONNECTED_CLOSED_SET, COMPACT_IMP_CLOSED, NOT_EXISTS_THM] THEN
22216  MAP_EVERY X_GEN_TAC [``a:real->bool``, ``b:real->bool``] THEN CCONTR_TAC THEN
22217  FULL_SIMP_TAC std_ss [] THEN
22218  MP_TAC(ISPECL [``a:real->bool``, ``b:real->bool``] SEPARATION_NORMAL) THEN
22219  ASM_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN
22220  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
22221  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
22222  SUBGOAL_THEN ``?k:real->bool. k IN f`` STRIP_ASSUME_TAC THENL
22223   [ASM_SET_TAC[], ALL_TAC] THEN
22224  SUBGOAL_THEN ``?n:real->bool. open n /\ k SUBSET n`` MP_TAC THENL
22225   [ASM_MESON_TAC[BOUNDED_SUBSET_BALL, COMPACT_IMP_BOUNDED, OPEN_BALL],
22226    REWRITE_TAC[BIGUNION_SUBSET] THEN STRIP_TAC] THEN
22227  MP_TAC(ISPEC ``k:real->bool`` COMPACT_IMP_HEINE_BOREL) THEN
22228  ASM_SIMP_TAC std_ss [] THEN
22229  KNOW_TAC ``~(!(f' :(real -> bool) -> bool).
22230  ((!(t :real -> bool). t IN f' ==> (open t :bool)) /\
22231   (k :real -> bool) SUBSET BIGUNION f') ==>
22232  ?(f'' :(real -> bool) -> bool).
22233    (f'' SUBSET f') /\ FINITE f'' /\ (k SUBSET BIGUNION f''))`` THENL
22234  [ALL_TAC, METIS_TAC []] THEN DISCH_THEN (MP_TAC o SPEC
22235   ``(u UNION v:real->bool) INSERT {n DIFF s | s IN f}``) THEN
22236  SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_IN_INSERT, FORALL_IN_IMAGE] THEN
22237  ASM_SIMP_TAC std_ss [OPEN_UNION, OPEN_DIFF, COMPACT_IMP_CLOSED, NOT_IMP] THEN
22238  CONJ_TAC THENL
22239   [REWRITE_TAC[BIGUNION_INSERT] THEN REWRITE_TAC[SUBSET_DEF] THEN
22240    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[IN_UNION] THEN
22241    ASM_CASES_TAC ``(x:real) IN c`` THENL [ASM_SET_TAC[], DISJ2_TAC] THEN
22242    SIMP_TAC std_ss [BIGUNION_IMAGE, GSPECIFICATION] THEN
22243    UNDISCH_TAC ``~((x:real) IN c)`` THEN
22244    SUBST1_TAC(SYM(ASSUME ``BIGINTER f:real->bool = c``)) THEN
22245    SIMP_TAC std_ss [IN_BIGINTER, NOT_FORALL_THM] THEN
22246    STRIP_TAC THEN EXISTS_TAC ``P:real->bool`` THEN ASM_SET_TAC[],
22247    ALL_TAC] THEN
22248  X_GEN_TAC ``g:(real->bool)->bool`` THEN
22249  REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
22250  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
22251  REWRITE_TAC[SUBSET_INSERT_DELETE] THEN
22252  SUBGOAL_THEN ``FINITE(g DELETE (u UNION v:real->bool))`` MP_TAC THENL
22253   [ASM_REWRITE_TAC[FINITE_DELETE],
22254    REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN
22255  REWRITE_TAC[FINITE_SUBSET_IMAGE] THEN
22256  DISCH_THEN(X_CHOOSE_THEN ``f':(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
22257  SUBGOAL_THEN
22258   ``?j:real->bool. j IN f /\
22259                   BIGUNION(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)``
22260  STRIP_ASSUME_TAC THENL
22261   [ASM_CASES_TAC ``f':(real->bool)->bool = {}`` THEN
22262    ASM_REWRITE_TAC[IMAGE_EMPTY, IMAGE_INSERT, BIGUNION_EMPTY, EMPTY_SUBSET] THENL
22263     [ASM_SET_TAC[], ALL_TAC] THEN
22264    SUBGOAL_THEN
22265     ``?j:real->bool. j IN f' /\
22266                       BIGUNION(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)``
22267    MP_TAC THENL [ALL_TAC, ASM_MESON_TAC[SUBSET_DEF]] THEN
22268    SUBGOAL_THEN
22269     ``!s t:real->bool. s IN f' /\ t IN f' ==> s SUBSET t \/ t SUBSET s``
22270    MP_TAC THENL [ASM_MESON_TAC[SUBSET_DEF], ALL_TAC] THEN
22271    UNDISCH_TAC ``~(f':(real->bool)->bool = {})`` THEN
22272    UNDISCH_TAC ``FINITE(f':(real->bool)->bool)`` THEN
22273    SPEC_TAC(``f':(real->bool)->bool``,``f':(real->bool)->bool``) THEN
22274    KNOW_TAC ``!(f' :(real -> bool) -> bool). (f' <> {} ==>
22275  (!s t. s IN f' /\ t IN f' ==> s SUBSET t \/ t SUBSET s) ==>
22276  ?j. j IN f' /\ BIGUNION (IMAGE (\s. n DIFF s) f') SUBSET n DIFF j) =
22277        (\f'. f' <> {} ==>
22278  (!s t. s IN f' /\ t IN f' ==> s SUBSET t \/ t SUBSET s) ==>
22279  ?j. j IN f' /\ BIGUNION (IMAGE (\s. n DIFF s) f') SUBSET n DIFF j) f'``
22280    THENL [METIS_TAC [], DISC_RW_KILL] THEN
22281    MATCH_MP_TAC FINITE_INDUCT THEN SIMP_TAC std_ss [] THEN
22282    SIMP_TAC std_ss [EXISTS_IN_INSERT, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
22283    SIMP_TAC std_ss [FORALL_IN_INSERT] THEN POP_ASSUM_LIST(K ALL_TAC) THEN
22284    SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
22285    MAP_EVERY X_GEN_TAC [``f:(real->bool)->bool``, ``i:real->bool``] THEN
22286    ASM_CASES_TAC ``f:(real->bool)->bool = {}`` THEN
22287    ASM_SIMP_TAC std_ss [IMAGE_EMPTY, IMAGE_INSERT, BIGUNION_INSERT, NOT_IN_EMPTY,
22288                    BIGUNION_EMPTY, UNION_EMPTY, SUBSET_REFL] THEN
22289    REWRITE_TAC [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
22290    REWRITE_TAC [GSYM CONJ_ASSOC] THEN REWRITE_TAC [GSYM AND_IMP_INTRO] THEN
22291    DISCH_THEN(fn th => REPEAT DISCH_TAC THEN MP_TAC th) THEN
22292    KNOW_TAC ``(!(s' :real -> bool) (t :real -> bool).
22293               s' IN (f :(real -> bool) -> bool) ==> t IN f ==>
22294               s' SUBSET t \/ t SUBSET s')`` THENL
22295    [ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
22296    DISCH_THEN(X_CHOOSE_THEN ``j:real->bool`` STRIP_ASSUME_TAC) THEN
22297    SUBGOAL_THEN ``(n DIFF j) SUBSET (n DIFF i) \/
22298                  (n DIFF i:real->bool) SUBSET (n DIFF j)``
22299    STRIP_ASSUME_TAC THENL
22300     [ASM_SET_TAC[],
22301      DISJ1_TAC THEN ASM_SET_TAC[],
22302      DISJ2_TAC THEN EXISTS_TAC ``j:real->bool`` THEN ASM_SET_TAC[]],
22303    ALL_TAC] THEN
22304  SUBGOAL_THEN ``(j INTER k:real->bool) SUBSET (u UNION v)`` ASSUME_TAC THENL
22305   [MATCH_MP_TAC(SET_RULE
22306     ``k SUBSET (u UNION v) UNION (n DIFF j)
22307      ==> (j INTER k) SUBSET (u UNION v)``) THEN
22308    MATCH_MP_TAC SUBSET_TRANS THEN
22309    EXISTS_TAC ``BIGUNION g :real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
22310    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
22311     ``BIGUNION((u UNION v:real->bool) INSERT (g DELETE (u UNION v)))`` THEN
22312    CONJ_TAC THENL [MATCH_MP_TAC SUBSET_BIGUNION THEN SET_TAC[], ALL_TAC] THEN
22313    ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[BIGUNION_INSERT] THEN
22314    ASM_SET_TAC[],
22315    ALL_TAC] THEN
22316  SUBGOAL_THEN ``connected(j INTER k:real->bool)`` MP_TAC THENL
22317   [ASM_MESON_TAC[SET_RULE ``s SUBSET t ==> (s INTER t = s)``, INTER_COMM],
22318    REWRITE_TAC[connected] THEN
22319    MAP_EVERY EXISTS_TAC [``u:real->bool``, ``v:real->bool``] THEN
22320    ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]]
22321QED
22322
22323Theorem CONNECTED_CHAIN_GEN:
22324   !f:(real->bool)->bool.
22325       (!s. s IN f ==> closed s /\ connected s) /\
22326       (?s. s IN f /\ compact s) /\
22327       (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
22328       ==> connected(BIGINTER f)
22329Proof
22330  GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
22331  FIRST_X_ASSUM(X_CHOOSE_THEN ``s:real->bool`` STRIP_ASSUME_TAC) THEN
22332  SUBGOAL_THEN
22333   ``BIGINTER f = BIGINTER(IMAGE (\t:real->bool. s INTER t) f)``
22334  SUBST1_TAC THENL
22335   [SIMP_TAC std_ss [EXTENSION, BIGINTER_IMAGE] THEN ASM_SET_TAC[],
22336    MATCH_MP_TAC CONNECTED_CHAIN THEN
22337    SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM, FORALL_IN_IMAGE] THEN
22338    ASM_SIMP_TAC std_ss [COMPACT_INTER_CLOSED] THEN
22339    CONJ_TAC THENL [X_GEN_TAC ``t:real->bool``, ASM_SET_TAC[]] THEN
22340    DISCH_TAC THEN
22341    SUBGOAL_THEN ``(s INTER t:real->bool = s) \/ (s INTER t = t)``
22342     (DISJ_CASES_THEN SUBST1_TAC) THEN
22343    ASM_SET_TAC[]]
22344QED
22345
22346Theorem CONNECTED_NEST:
22347   !s. (!n. compact(s n) /\ connected(s n)) /\
22348       (!m n. m <= n ==> s n SUBSET s m)
22349       ==> connected(BIGINTER {s n | n IN univ(:num)})
22350Proof
22351  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CHAIN THEN
22352  ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM] THEN
22353  ONCE_REWRITE_TAC [METIS [] ``(s n SUBSET s n' \/ s n' SUBSET s n) =
22354                        (\n n'. s n SUBSET s n' \/ s n' SUBSET s n) n n'``] THEN
22355  MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]
22356QED
22357
22358Theorem CONNECTED_NEST_GEN:
22359   !s. (!n. closed(s n) /\ connected(s n)) /\ (?n. compact(s n)) /\
22360       (!m n. m <= n ==> s n SUBSET s m)
22361       ==> connected(BIGINTER {s n | n IN univ(:num)})
22362Proof
22363  GEN_TAC THEN
22364  DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN
22365  MATCH_MP_TAC CONNECTED_CHAIN_GEN THEN
22366  ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV, CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM,
22367               EXISTS_IN_GSPEC] THEN
22368  ONCE_REWRITE_TAC [METIS [] ``(s n SUBSET s n' \/ s n' SUBSET s n) =
22369                        (\n n'. s n SUBSET s n' \/ s n' SUBSET s n) n n'``] THEN
22370  MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]
22371QED
22372
22373(* ------------------------------------------------------------------------- *)
22374(* Hausdorff distance between sets.                                          *)
22375(* ------------------------------------------------------------------------- *)
22376
22377Definition hausdist[nocompute]:
22378 hausdist(s:real->bool,t:real->bool) =
22379        if (({setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} <> {}) /\
22380            (?b. !d. d IN {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} ==> d <= b))
22381        then sup ({setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t}) else &0
22382End
22383
22384Theorem HAUSDIST_POS_LE:
22385   !s t:real->bool. &0 <= hausdist(s,t)
22386Proof
22387  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
22388  SIMP_TAC std_ss [FORALL_IN_GSPEC, FORALL_IN_UNION] THEN
22389  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
22390  MATCH_MP_TAC REAL_LE_SUP2 THEN
22391  ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, FORALL_IN_UNION, SETDIST_POS_LE] THEN
22392  KNOW_TAC ``?(y :real) (b :real).
22393  y IN {setdist ({x},(t :real -> bool)) | x IN (s :real -> bool)} UNION
22394  {setdist ({y},s) | y IN t} /\ (0 :real) <= y /\
22395  (!(x :real). x IN s ==> setdist ({x},t) <= b) /\
22396  !(y :real). y IN t ==> setdist ({y},s) <= b`` THENL
22397  [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
22398  ASM_SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM] THEN
22399  ONCE_REWRITE_TAC [METIS [] ``(0 <= y:real) = (\y. 0 <= y) y``] THEN
22400  MATCH_MP_TAC(SET_RULE
22401   ``~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y``) THEN
22402  ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, FORALL_IN_UNION, SETDIST_POS_LE]
22403QED
22404
22405Theorem HAUSDIST_REFL:
22406   !s:real->bool. hausdist(s,s) = &0
22407Proof
22408  GEN_TAC THEN SIMP_TAC std_ss [GSYM REAL_LE_ANTISYM, HAUSDIST_POS_LE] THEN
22409  REWRITE_TAC[hausdist] THEN
22410  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
22411  MATCH_MP_TAC REAL_SUP_LE' THEN
22412  SIMP_TAC std_ss [FORALL_IN_GSPEC, FORALL_IN_UNION] THEN
22413  ASM_SIMP_TAC std_ss [SETDIST_SING_IN_SET, REAL_LE_REFL]
22414QED
22415
22416Theorem HAUSDIST_SYM:
22417   !s t:real->bool. hausdist(s,t) = hausdist(t,s)
22418Proof
22419  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
22420  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN
22421  REWRITE_TAC[]
22422QED
22423
22424Theorem HAUSDIST_EMPTY:
22425   (!t:real->bool. hausdist ({},t) = &0) /\
22426   (!s:real->bool. hausdist (s,{}) = &0)
22427Proof
22428  REWRITE_TAC[hausdist, SETDIST_EMPTY] THEN
22429  REWRITE_TAC[SET_RULE ``{setdist ({x},t) | x IN {}} = {}``, UNION_EMPTY] THEN
22430  REWRITE_TAC[SET_RULE ``({c |x| x IN s} = {}) <=> (s = {})``] THEN
22431  X_GEN_TAC ``s:real->bool`` THEN
22432  ASM_CASES_TAC ``s:real->bool = {}`` THEN ASM_REWRITE_TAC[] THEN
22433  ASM_SIMP_TAC std_ss [SET_RULE ``~(s = {}) ==> ({c |x| x IN s} = {c})``] THEN
22434  REWRITE_TAC[SUP_SING, COND_ID]
22435QED
22436
22437Theorem HAUSDIST_SINGS:
22438   !x y:real. hausdist({x},{y}) = dist(x,y)
22439Proof
22440  REWRITE_TAC[hausdist, SETDIST_SINGS] THEN
22441  REWRITE_TAC[SET_RULE ``{dist (x,y) | x IN {a}} = {dist (a,y)}``] THEN
22442  ONCE_REWRITE_TAC [METIS [DIST_SYM] ``{dist (x,y)} UNION {dist (y,x)} =
22443                               {dist (x,y)} UNION {dist (x,y)}``] THEN
22444  SIMP_TAC std_ss [UNION_IDEMPOT, SUP_SING, NOT_INSERT_EMPTY] THEN
22445  SIMP_TAC std_ss [IN_SING, UNWIND_FORALL_THM2] THEN
22446  METIS_TAC[REAL_LE_REFL]
22447QED
22448
22449Theorem HAUSDIST_EQ :
22450   !s t:real->bool s' t':real->bool.
22451        (!b. (!x. x IN s ==> setdist({x},t) <= b) /\
22452             (!y. y IN t ==> setdist({y},s) <= b) <=>
22453             (!x. x IN s' ==> setdist({x},t') <= b) /\
22454             (!y. y IN t' ==> setdist({y},s') <= b))
22455        ==> (hausdist(s,t) = hausdist(s',t'))
22456Proof
22457  REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist] THEN
22458  MATCH_MP_TAC(METIS[]
22459   ``(p <=> p') /\ (s = s')
22460    ==> ((if p then s else &0:real) = (if p' then s' else &0:real))``) THEN
22461  CONJ_TAC THENL
22462   [BINOP_TAC THENL
22463     [PURE_REWRITE_TAC[SET_RULE ``(s = {}) <=> !x. x IN s ==> F``],
22464      AP_TERM_TAC THEN ABS_TAC],
22465    MATCH_MP_TAC SUP_EQ] THEN
22466  SIMP_TAC std_ss [FORALL_IN_UNION, FORALL_IN_GSPEC] THEN
22467  ASM_REWRITE_TAC[] THEN
22468  ONCE_REWRITE_TAC [METIS [] ``(a = b) = (~a = ~b:bool)``] THEN
22469  REWRITE_TAC [DE_MORGAN_THM] THEN
22470  SIMP_TAC std_ss' [NOT_FORALL_THM, MEMBER_NOT_EMPTY] THEN
22471  REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN
22472  DISCH_THEN(fn th => POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN
22473  ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
22474  DISCH_THEN(MP_TAC o SPEC ``-(&1):real``) THEN
22475  SIMP_TAC std_ss [SETDIST_POS_LE, REAL_ARITH ``&0 <= x ==> ~(x <= -(&1:real))``] THEN
22476  SET_TAC[]
22477QED
22478
22479Theorem HAUSDIST_TRANSLATION:
22480   !a s t:real->bool.
22481        hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)
22482Proof
22483  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
22484  SIMP_TAC real_ss [SET_RULE ``{f x | x IN IMAGE g s} = {f(g x) | x IN s}``] THEN
22485  SIMP_TAC real_ss [SET_RULE ``{a + x:real} = IMAGE (\x. a + x) {x}``] THEN
22486  REWRITE_TAC[SETDIST_TRANSLATION]
22487QED
22488
22489Theorem HAUSDIST_LINEAR_IMAGE:
22490   !f:real->real s t.
22491           linear f /\ (!x. abs(f x) = abs x)
22492           ==> (hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t))
22493Proof
22494  REPEAT STRIP_TAC THEN
22495  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
22496  SIMP_TAC real_ss [SET_RULE ``{f x | x IN IMAGE g s} = {f(g x) | x IN s}``] THEN
22497  ONCE_REWRITE_TAC[SET_RULE ``{(f:real->real) x} = IMAGE f {x}``] THEN
22498  ASM_SIMP_TAC std_ss [SETDIST_LINEAR_IMAGE]
22499QED
22500
22501Theorem HAUSDIST_CLOSURE:
22502   (!s t:real->bool. hausdist(closure s,t) = hausdist(s,t)) /\
22503   (!s t:real->bool. hausdist(s,closure t) = hausdist(s,t))
22504Proof
22505  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN
22506  GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN
22507  ONCE_REWRITE_TAC [METIS [] ``setdist ({x},t) <= b <=> (\x. setdist ({x},t) <= b) x``] THEN
22508  PURE_ONCE_REWRITE_TAC[SET_RULE
22509   ``(!x. x IN P ==> Q x) <=> (!x. x IN P ==> (\x. x) x IN {x | Q x})``] THEN
22510  MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
22511  SIMP_TAC std_ss [GSPEC_F, CONTINUOUS_ON_ID, CLOSED_EMPTY] THEN
22512  ONCE_REWRITE_TAC [METIS [] ``setdist ({x},t) = (\x. setdist ({x},t)) x``] THEN
22513  REWRITE_TAC[SET_RULE
22514    ``{x | (f x) <= b:real} =
22515      {x | x IN UNIV /\ (f x) IN {x | x <= b}}``] THEN
22516  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
22517  SIMP_TAC std_ss [CLOSED_UNIV, CONTINUOUS_ON_SETDIST] THEN
22518  REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE]
22519QED
22520
22521Theorem REAL_HAUSDIST_LE:
22522   !s t:real->bool b.
22523        ~(s = {}) /\ ~(t = {}) /\
22524        (!x. x IN s ==> setdist({x},t) <= b) /\
22525        (!y. y IN t ==> setdist({y},s) <= b)
22526        ==> hausdist(s,t) <= b
22527Proof
22528  REPEAT STRIP_TAC THEN
22529  REWRITE_TAC[hausdist, SETDIST_SINGS] THEN
22530  ASM_SIMP_TAC real_ss [EMPTY_UNION, SET_RULE ``({f x | x IN s} = {}) <=> (s = {})``] THEN
22531  SIMP_TAC std_ss [FORALL_IN_UNION, FORALL_IN_GSPEC] THEN
22532  COND_CASES_TAC THENL [ALL_TAC, METIS_TAC[]] THEN
22533  MATCH_MP_TAC REAL_SUP_LE' THEN
22534  ASM_SIMP_TAC real_ss [EMPTY_UNION, SET_RULE ``({f x | x IN s} = {}) <=> (s = {})``] THEN
22535  ASM_SIMP_TAC real_ss [FORALL_IN_UNION, FORALL_IN_GSPEC]
22536QED
22537
22538Theorem REAL_HAUSDIST_LE_SUMS:
22539   !s t:real->bool b.
22540        ~(s = {}) /\ ~(t = {}) /\
22541        s SUBSET {y + z | y IN t /\ z IN cball(0,b)} /\
22542        t SUBSET {y + z | y IN s /\ z IN cball(0,b)}
22543        ==> hausdist(s,t) <= b
22544Proof
22545  SIMP_TAC real_ss [SUBSET_DEF, GSPECIFICATION, EXISTS_PROD, IN_CBALL_0] THEN
22546  SIMP_TAC real_ss [REAL_ARITH ``(a:real = b + x) <=> (a - b = x)``,
22547              ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
22548  REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN
22549  MATCH_MP_TAC REAL_HAUSDIST_LE THEN
22550  METIS_TAC[SETDIST_LE_DIST, REAL_LE_TRANS, IN_SING]
22551QED
22552
22553Theorem REAL_LE_HAUSDIST:
22554   !s t:real->bool a b c z.
22555        ~(s = {}) /\ ~(t = {}) /\
22556        (!x. x IN s ==> setdist({x},t) <= b) /\
22557        (!y. y IN t ==> setdist({y},s) <= c) /\
22558        (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s))
22559        ==> a <= hausdist(s,t)
22560Proof
22561  REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
22562  REWRITE_TAC[hausdist, SETDIST_SINGS] THEN
22563  ASM_SIMP_TAC real_ss [EMPTY_UNION, SET_RULE ``({f x | x IN s} = {}) <=> (s = {})``] THEN
22564  SIMP_TAC real_ss [FORALL_IN_UNION, FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL
22565   [MATCH_MP_TAC REAL_LE_SUP2 THEN
22566    ASM_SIMP_TAC real_ss [EMPTY_UNION, SET_RULE ``({f x | x IN s} = {}) <=> (s = {})``] THEN
22567    SIMP_TAC real_ss [FORALL_IN_UNION, FORALL_IN_GSPEC],
22568    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [NOT_EXISTS_THM]) THEN
22569    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN DISCH_TAC THEN
22570    SIMP_TAC real_ss [NOT_FORALL_THM]] THEN
22571  EXISTS_TAC ``max b c:real`` THEN
22572  ASM_SIMP_TAC real_ss [REAL_LE_MAX] THEN ASM_SET_TAC[]
22573QED
22574
22575Theorem SETDIST_LE_HAUSDIST:
22576   !s t:real->bool.
22577        bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)
22578Proof
22579  REPEAT STRIP_TAC THEN
22580  ASM_CASES_TAC ``s:real->bool = {}`` THEN
22581  ASM_SIMP_TAC real_ss [SETDIST_EMPTY, HAUSDIST_EMPTY, REAL_LE_REFL] THEN
22582  ASM_CASES_TAC ``t:real->bool = {}`` THEN
22583  ASM_SIMP_TAC real_ss [SETDIST_EMPTY, HAUSDIST_EMPTY, REAL_LE_REFL] THEN
22584  MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN
22585  ASM_SIMP_TAC real_ss [RIGHT_EXISTS_AND_THM, LEFT_EXISTS_AND_THM] THEN
22586  CONJ_TAC THENL
22587   [ALL_TAC, METIS_TAC[SETDIST_LE_SING, MEMBER_NOT_EMPTY]] THEN
22588  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``] BOUNDED_DIFFS) THEN
22589  ASM_REWRITE_TAC[] THEN SIMP_TAC real_ss [bounded_def, FORALL_IN_GSPEC, GSYM dist] THEN
22590  DISCH_THEN(X_CHOOSE_TAC ``b:real``) THEN
22591  CONJ_TAC THEN EXISTS_TAC ``b:real`` THEN REPEAT STRIP_TAC THEN
22592  METIS_TAC[REAL_LE_TRANS, SETDIST_LE_DIST, MEMBER_NOT_EMPTY, IN_SING, DIST_SYM]
22593QED
22594
22595Theorem SETDIST_SING_LE_HAUSDIST:
22596   !s t x:real.
22597        bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)
22598Proof
22599  REPEAT GEN_TAC THEN
22600  ASM_CASES_TAC ``s:real->bool = {}`` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
22601  ASM_CASES_TAC ``t:real->bool = {}`` THEN
22602  ASM_REWRITE_TAC[SETDIST_EMPTY, HAUSDIST_EMPTY, REAL_LE_REFL] THEN
22603  STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN
22604  ASM_SIMP_TAC real_ss [RIGHT_EXISTS_AND_THM] THEN
22605  SIMP_TAC real_ss [LEFT_EXISTS_AND_THM, EXISTS_OR_THM, CONJ_ASSOC] THEN
22606  CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN
22607  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``] BOUNDED_DIFFS) THEN
22608  ASM_REWRITE_TAC[] THEN SIMP_TAC real_ss [bounded_def, FORALL_IN_GSPEC] THEN
22609  DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
22610  POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM dist] THENL
22611   [ALL_TAC,
22612    KNOW_TAC ``(!y x:real. x IN s /\ y IN t ==> dist (x,y) <= a) ==>
22613                !y. y IN t ==> setdist ({y},s) <= a`` THENL
22614    [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]]] THEN
22615  DISCH_TAC THEN X_GEN_TAC ``y:real`` THEN POP_ASSUM (MP_TAC o SPEC ``y:real``) THEN
22616  REPEAT STRIP_TAC THENL
22617   [UNDISCH_TAC ``~(t:real->bool = {})``,
22618    UNDISCH_TAC ``~(s:real->bool = {})``] THEN
22619  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
22620  DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
22621  FIRST_X_ASSUM(MP_TAC o SPEC ``z:real``) THEN ASM_REWRITE_TAC[] THEN
22622  MATCH_MP_TAC(REWRITE_RULE[CONJ_EQ_IMP] REAL_LE_TRANS) THENL
22623   [ALL_TAC, ONCE_REWRITE_TAC[DIST_SYM]] THEN
22624  MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]
22625QED
22626
22627Theorem SETDIST_HAUSDIST_TRIANGLE:
22628   !s t u:real->bool.
22629        ~(t = {}) /\ bounded t /\ bounded u
22630        ==> setdist(s,u) <= setdist(s,t) + hausdist(t,u)
22631Proof
22632  REPEAT STRIP_TAC THEN
22633  MAP_EVERY ASM_CASES_TAC [``s:real->bool = {}``, ``u:real->bool = {}``] THEN
22634  ASM_SIMP_TAC real_ss [SETDIST_EMPTY, REAL_LE_ADD, REAL_ADD_LID,
22635                        SETDIST_POS_LE, HAUSDIST_POS_LE] THEN
22636  ONCE_REWRITE_TAC[REAL_ARITH ``a <= b + c <=> a - c <= b:real``] THEN
22637  ASM_SIMP_TAC real_ss [REAL_LE_SETDIST_EQ, NOT_INSERT_EMPTY, IN_SING] THEN
22638  MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
22639  REWRITE_TAC[REAL_LE_SUB_RADD] THEN
22640  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``setdist({x:real},u)`` THEN
22641  ASM_SIMP_TAC real_ss [SETDIST_LE_SING] THEN
22642  MP_TAC(ISPECL [``u:real->bool``, ``x:real``, ``y:real``]
22643        SETDIST_SING_TRIANGLE) THEN
22644  MATCH_MP_TAC(REAL_ARITH
22645   ``yu <= z ==> abs(xu - yu) <= d ==> xu <= d + z:real``) THEN
22646  MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]
22647QED
22648
22649Theorem HAUSDIST_SETDIST_TRIANGLE:
22650   !s t u:real->bool.
22651        ~(t = {}) /\ bounded s /\ bounded t
22652        ==> setdist(s,u) <= hausdist(s,t) + setdist(t,u)
22653Proof
22654  ONCE_REWRITE_TAC[SETDIST_SYM, HAUSDIST_SYM] THEN
22655  ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
22656  SIMP_TAC real_ss [SETDIST_HAUSDIST_TRIANGLE]
22657QED
22658
22659Theorem REAL_LT_HAUSDIST_POINT_EXISTS:
22660   !s t x:real d.
22661        bounded s /\ bounded t /\ ~(t = {}) /\ hausdist(s,t) < d /\ x IN s
22662        ==> ?y. y IN t /\ dist(x,y) < d
22663Proof
22664  REPEAT STRIP_TAC THEN
22665  MP_TAC(ISPECL [``{x:real}``, ``t:real->bool``, ``d:real``]
22666        REAL_SETDIST_LT_EXISTS) THEN
22667  SIMP_TAC real_ss [IN_SING, RIGHT_EXISTS_AND_THM, UNWIND_THM2] THEN
22668  DISCH_THEN MATCH_MP_TAC THEN
22669  ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN
22670  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``hausdist(s:real->bool,t)`` THEN
22671  ASM_SIMP_TAC real_ss [] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN
22672  ASM_REWRITE_TAC[]
22673QED
22674
22675Theorem UPPER_LOWER_HEMICONTINUOUS:
22676   !f:real->real->bool t s.
22677      (!x. x IN s ==> f(x) SUBSET t) /\
22678      (!u. open_in (subtopology euclidean t) u
22679           ==> open_in (subtopology euclidean s)
22680                       {x | x IN s /\ f(x) SUBSET u}) /\
22681      (!u. closed_in (subtopology euclidean t) u
22682           ==> closed_in (subtopology euclidean s)
22683                         {x | x IN s /\ f(x) SUBSET u})
22684      ==> !x e. x IN s /\ &0 < e /\ bounded(f x)
22685                ==> ?d. &0 < d /\
22686                        !x'. x' IN s /\ dist(x,x') < d
22687                             ==> hausdist(f x,f x') < e
22688Proof
22689  REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN
22690  ASM_CASES_TAC ``(f:real->real->bool) x = {}`` THENL
22691   [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN METIS_TAC[REAL_LT_01], ALL_TAC] THEN
22692  FIRST_ASSUM(MP_TAC o SPECL [``x:real``, ``e / &2:real``] o MATCH_MP
22693        UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN
22694  ASM_REWRITE_TAC[REAL_HALF] THEN
22695  DISCH_THEN(X_CHOOSE_THEN ``d1:real`` STRIP_ASSUME_TAC) THEN
22696  FIRST_ASSUM(MP_TAC o SPEC ``0:real`` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
22697  DISCH_THEN(X_CHOOSE_THEN ``r:real`` STRIP_ASSUME_TAC) THEN
22698  FIRST_ASSUM(MP_TAC o SPEC ``t INTER ball(0:real,r)`` o
22699        CONJUNCT1 o CONJUNCT2) THEN
22700  SIMP_TAC std_ss [OPEN_IN_OPEN_INTER, OPEN_BALL] THEN REWRITE_TAC[open_in] THEN
22701  DISCH_THEN(MP_TAC o SPEC ``x:real`` o CONJUNCT2) THEN
22702  ASM_SIMP_TAC std_ss [SUBSET_INTER, GSPECIFICATION] THEN
22703  DISCH_THEN(X_CHOOSE_THEN ``d2:real`` STRIP_ASSUME_TAC) THEN
22704  EXISTS_TAC ``min d1 d2:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
22705  X_GEN_TAC ``x':real`` THEN STRIP_TAC THEN
22706  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC ``x':real``)) THEN
22707  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_SIMP_TAC std_ss [] THEN
22708  STRIP_TAC THEN STRIP_TAC THEN
22709  ASM_CASES_TAC ``(f:real->real->bool) x' = {}`` THEN
22710  ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
22711  KNOW_TAC ``0 < e / 2:real`` THENL [ASM_REWRITE_TAC [REAL_HALF], DISCH_TAC] THEN
22712  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
22713  MATCH_MP_TAC(REAL_ARITH ``&0 < e / 2 /\ x <= e / &2 ==> x < e / 2 + e / 2:real``) THEN
22714  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN
22715  METIS_TAC [SETDIST_LE_DIST, DIST_SYM, REAL_LE_TRANS, IN_SING, REAL_LT_IMP_LE]
22716QED
22717
22718Theorem HAUSDIST_NONTRIVIAL:
22719   !s t:real->bool.
22720        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
22721        ==> (hausdist(s,t) =
22722             sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t}))
22723Proof
22724  REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist] THEN
22725  COND_CASES_TAC THEN ASM_SIMP_TAC real_ss [] THEN
22726  FIRST_X_ASSUM(MP_TAC o SIMP_RULE real_ss [DE_MORGAN_THM]) THEN
22727  ASM_SIMP_TAC real_ss [EMPTY_UNION, GSYM IMAGE_DEF, IMAGE_EQ_EMPTY] THEN
22728  REWRITE_TAC [METIS [] ``(!b. ?d. d IN P /\ ~(d <= b)) =
22729                              ~(?b. !d. d IN P ==> d <= b:real)``] THEN
22730  MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
22731  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``] BOUNDED_DIFFS) THEN
22732  ASM_SIMP_TAC real_ss [bounded_def, FORALL_IN_UNION, FORALL_IN_IMAGE, GSYM dist] THEN
22733  DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN POP_ASSUM MP_TAC THEN
22734  SIMP_TAC real_ss [FORALL_IN_GSPEC] THEN
22735  METIS_TAC[SETDIST_LE_DIST, dist, DIST_SYM, REAL_LE_TRANS,
22736                MEMBER_NOT_EMPTY, IN_SING]
22737QED
22738
22739Theorem HAUSDIST_NONTRIVIAL_ALT:
22740   !s t:real->bool.
22741        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
22742        ==> (hausdist(s,t) = max (sup {setdist ({x},t) | x IN s})
22743                                (sup {setdist ({y},s) | y IN t}))
22744Proof
22745  REPEAT STRIP_TAC THEN ASM_SIMP_TAC real_ss [HAUSDIST_NONTRIVIAL] THEN
22746  MATCH_MP_TAC SUP_UNION THEN
22747  ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
22748  CONJ_TAC THEN
22749  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``] BOUNDED_DIFFS) THEN
22750  ASM_SIMP_TAC real_ss [bounded_def, FORALL_IN_UNION, FORALL_IN_IMAGE, GSYM dist] THEN
22751  DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
22752  POP_ASSUM MP_TAC THEN SIMP_TAC real_ss [FORALL_IN_GSPEC, GSYM dist] THEN
22753  METIS_TAC [SETDIST_LE_DIST, dist, DIST_SYM, REAL_LE_TRANS,
22754                MEMBER_NOT_EMPTY, IN_SING]
22755QED
22756
22757Theorem REAL_HAUSDIST_LE_EQ:
22758   !s t:real->bool b.
22759        ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t
22760        ==> (hausdist(s,t) <= b <=>
22761             (!x. x IN s ==> setdist({x},t) <= b) /\
22762             (!y. y IN t ==> setdist({y},s) <= b))
22763Proof
22764  REPEAT STRIP_TAC THEN
22765  ASM_SIMP_TAC real_ss [HAUSDIST_NONTRIVIAL_ALT, REAL_MAX_LE] THEN
22766  BINOP_TAC THEN
22767  ONCE_REWRITE_TAC [METIS [] ``setdist ({x},t) = (\x. setdist ({x},t)) x:real``] THEN
22768  ONCE_REWRITE_TAC [SET_RULE ``(!x. x IN s ==> f x <= b) <=>
22769                               (!y. y IN {f x | x IN s} ==> y <= b:real)``] THEN
22770  MATCH_MP_TAC REAL_SUP_LE_EQ THEN
22771  ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, IMAGE_EQ_EMPTY, FORALL_IN_IMAGE] THEN
22772  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``] BOUNDED_DIFFS) THEN
22773  ASM_SIMP_TAC real_ss [bounded_def, FORALL_IN_UNION, FORALL_IN_IMAGE, GSYM dist] THEN
22774  DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
22775  POP_ASSUM MP_TAC THEN SIMP_TAC real_ss [FORALL_IN_GSPEC, GSYM dist] THEN
22776  METIS_TAC[SETDIST_LE_DIST, dist, DIST_SYM, REAL_LE_TRANS,
22777            MEMBER_NOT_EMPTY, IN_SING]
22778QED
22779
22780Theorem HAUSDIST_UNION_LE:
22781   !s t u:real->bool.
22782        bounded s /\ bounded t /\ bounded u /\ ~(t = {}) /\ ~(u = {})
22783        ==> hausdist(s UNION t,s UNION u) <= hausdist(t,u)
22784Proof
22785  REPEAT STRIP_TAC THEN
22786  ASM_SIMP_TAC real_ss [REAL_HAUSDIST_LE_EQ, BOUNDED_UNION, EMPTY_UNION] THEN
22787  SIMP_TAC real_ss [FORALL_IN_UNION] THEN
22788  SIMP_TAC real_ss [SETDIST_SING_IN_SET, IN_UNION, HAUSDIST_POS_LE] THEN
22789  ASM_SIMP_TAC real_ss [GSYM REAL_HAUSDIST_LE_EQ, BOUNDED_UNION, EMPTY_UNION] THEN
22790  CONJ_TAC THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THENL
22791   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``setdist({x:real},u)``,
22792    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``setdist({x:real},t)``] THEN
22793  ASM_SIMP_TAC real_ss [SETDIST_SUBSET_RIGHT, SUBSET_UNION] THENL
22794   [ALL_TAC, ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN
22795  MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]
22796QED
22797
22798Theorem HAUSDIST_INSERT_LE:
22799   !s t a:real.
22800        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
22801        ==> hausdist(a INSERT s,a INSERT t) <= hausdist(s,t)
22802Proof
22803  ONCE_REWRITE_TAC[SET_RULE ``a INSERT s = {a} UNION s``] THEN
22804  ASM_SIMP_TAC real_ss [HAUSDIST_UNION_LE, NOT_INSERT_EMPTY, BOUNDED_SING]
22805QED
22806
22807Theorem HAUSDIST_COMPACT_EXISTS:
22808   !s t:real->bool.
22809        bounded s /\ compact t /\ ~(t = {})
22810        ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)
22811Proof
22812  REPEAT STRIP_TAC THEN
22813  ASM_CASES_TAC ``s:real->bool = {}`` THENL [ASM_SET_TAC[], ALL_TAC] THEN
22814  MP_TAC(ISPECL [``{x:real}``, ``t:real->bool``]
22815        SETDIST_COMPACT_CLOSED) THEN
22816  ASM_SIMP_TAC real_ss [COMPACT_SING, COMPACT_IMP_CLOSED, NOT_INSERT_EMPTY] THEN
22817  SIMP_TAC real_ss [IN_SING, UNWIND_THM2, RIGHT_EXISTS_AND_THM, UNWIND_THM1] THEN
22818  DISCH_THEN (X_CHOOSE_TAC ``y:real``) THEN EXISTS_TAC ``y:real`` THEN POP_ASSUM MP_TAC THEN
22819  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
22820  MATCH_MP_TAC REAL_LE_HAUSDIST THEN
22821  ASM_SIMP_TAC real_ss [LEFT_EXISTS_AND_THM, RIGHT_EXISTS_AND_THM] THEN
22822  REWRITE_TAC[CONJ_ASSOC] THEN
22823  CONJ_TAC THENL [CONJ_TAC, METIS_TAC[REAL_LE_REFL]] THEN
22824  MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``] BOUNDED_DIFFS) THEN
22825  ASM_SIMP_TAC real_ss [COMPACT_IMP_BOUNDED] THEN
22826  SIMP_TAC real_ss [bounded_def, FORALL_IN_GSPEC, GSYM dist] THEN
22827  DISCH_THEN (X_CHOOSE_TAC ``a:real``) THEN EXISTS_TAC ``a:real`` THEN
22828  METIS_TAC[SETDIST_LE_DIST, dist, DIST_SYM, REAL_LE_TRANS,
22829                MEMBER_NOT_EMPTY, IN_SING]
22830QED
22831
22832Theorem HAUSDIST_TRIANGLE:
22833   !s t u:real->bool.
22834        bounded s /\ bounded t /\ bounded u /\ ~(t = {})
22835        ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)
22836Proof
22837  ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN
22838  ONCE_REWRITE_TAC[GSYM(CONJUNCT2 HAUSDIST_CLOSURE)] THEN
22839  ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE, GSYM CLOSURE_EQ_EMPTY] THEN
22840  REPEAT GEN_TAC THEN MAP_EVERY
22841   (fn t => SPEC_TAC(mk_comb(``closure:(real->bool)->real->bool``,t),t))
22842   [``u:real->bool``, ``t:real->bool``, ``s:real->bool``] THEN
22843  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
22844  ASM_REWRITE_TAC[HAUSDIST_EMPTY, HAUSDIST_POS_LE, REAL_ADD_LID] THEN
22845  ASM_CASES_TAC ``u:real->bool = {}`` THEN
22846  ASM_REWRITE_TAC[HAUSDIST_EMPTY, HAUSDIST_POS_LE, REAL_ADD_RID] THEN
22847  ASM_SIMP_TAC real_ss [REAL_HAUSDIST_LE_EQ, COMPACT_IMP_BOUNDED] THEN
22848  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [HAUSDIST_SYM] THEN
22849  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN
22850  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
22851   MAP_EVERY (fn t => SPEC_TAC(t,t))
22852   [``u:real->bool``, ``t:real->bool``, ``s:real->bool``] THEN
22853  ONCE_REWRITE_TAC [METIS [] ``(~(u = {}) /\ ~(s = {}) /\ ~(t = {}) /\
22854                                compact u /\ compact t /\ compact s) =
22855                       (\s t u. ~(u = {}) /\ ~(s = {}) /\ ~(t = {}) /\
22856                                compact u /\ compact t /\ compact s) s t u``] THEN
22857  ONCE_REWRITE_TAC [METIS [] ``(!x. x IN s ==> setdist ({x},u) <=
22858                                hausdist (s,t) + hausdist (t,u)) =
22859                       (\s t u. !x. x IN s ==> setdist ({x},u) <=
22860                                hausdist (s,t) + hausdist (t,u)) s t u ``] THEN
22861  MATCH_MP_TAC(METIS[]
22862   ``(!s t u. P s t u ==> P u t s) /\
22863     (!s t u. P s t u ==> Q s t u)
22864     ==> (!s t u. P s t u ==> Q s t u /\ Q u t s)``) THEN BETA_TAC THEN
22865  CONJ_TAC THENL [METIS_TAC[CONJ_ACI], REPEAT GEN_TAC THEN STRIP_TAC] THEN
22866  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
22867  SUBGOAL_THEN ``?y:real. y IN t /\ dist(x,y) <= hausdist(s,t)``
22868  STRIP_ASSUME_TAC THENL
22869   [METIS_TAC[HAUSDIST_COMPACT_EXISTS, COMPACT_IMP_BOUNDED], ALL_TAC] THEN
22870  SUBGOAL_THEN ``?z:real. z IN u /\ dist(y,z) <= hausdist(t,u)``
22871  STRIP_ASSUME_TAC THENL
22872   [METIS_TAC[HAUSDIST_COMPACT_EXISTS, COMPACT_IMP_BOUNDED], ALL_TAC] THEN
22873  RULE_ASSUM_TAC (REWRITE_RULE [dist]) THEN
22874  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
22875   ``abs(y - z) <= b ==> abs(x - y) <= a /\ s <= abs(x - z) ==> s <= a + b:real``)) THEN
22876  ASM_REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
22877  ASM_REWRITE_TAC[IN_SING]
22878QED
22879
22880Theorem HAUSDIST_COMPACT_SUMS:
22881   !s t:real->bool.
22882        bounded s /\ compact t /\ ~(t = {})
22883        ==> s SUBSET {y + z | y IN t /\ z IN cball(0,hausdist(s,t))}
22884Proof
22885  SIMP_TAC real_ss [SUBSET_DEF, GSPECIFICATION, IN_CBALL_0, EXISTS_PROD] THEN
22886  SIMP_TAC real_ss [REAL_ARITH ``(a:real = b + x) <=> (a - b = x)``,
22887              ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
22888  SIMP_TAC real_ss [GSYM dist, HAUSDIST_COMPACT_EXISTS]
22889QED
22890
22891Theorem lemma[local]:
22892   !s t u:real->bool.
22893          bounded s /\ bounded t /\ bounded u /\
22894          ~(s = {}) /\ ~(t = {}) /\ ~(u = {})
22895          ==> !x. x IN s ==> setdist({x},u) <= hausdist(s,t) + hausdist(t,u)
22896Proof
22897    REPEAT STRIP_TAC THEN
22898    MP_TAC(ISPECL [``closure s:real->bool``, ``closure t:real->bool``]
22899        HAUSDIST_COMPACT_EXISTS) THEN
22900    ASM_SIMP_TAC real_ss [COMPACT_CLOSURE, BOUNDED_CLOSURE, CLOSURE_EQ_EMPTY] THEN
22901    DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
22902    ASM_SIMP_TAC real_ss [REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET, HAUSDIST_CLOSURE] THEN
22903    DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
22904    MP_TAC(ISPECL [``closure t:real->bool``, ``closure u:real->bool``]
22905      HAUSDIST_COMPACT_EXISTS) THEN
22906    ASM_SIMP_TAC real_ss [COMPACT_CLOSURE, BOUNDED_CLOSURE, CLOSURE_EQ_EMPTY] THEN
22907    DISCH_THEN(MP_TAC o SPEC ``y:real``) THEN
22908    ASM_SIMP_TAC real_ss [REWRITE_RULE[SUBSET_DEF] CLOSURE_SUBSET, HAUSDIST_CLOSURE] THEN
22909    DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
22910    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``dist(x:real,z)`` THEN CONJ_TAC THENL
22911     [METIS_TAC[SETDIST_CLOSURE, SETDIST_LE_DIST, IN_SING], ALL_TAC] THEN
22912    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``dist(x:real,y) + dist(y,z)`` THEN
22913    REWRITE_TAC[DIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC
22914QED
22915
22916Theorem HAUSDIST_TRANS:
22917   !s t u:real->bool.
22918        bounded s /\ bounded t /\ bounded u /\ ~(t = {})
22919        ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)
22920Proof
22921  REPEAT STRIP_TAC THEN
22922  ASM_CASES_TAC ``s:real->bool = {}`` THEN
22923  ASM_REWRITE_TAC[HAUSDIST_EMPTY, REAL_ADD_LID, HAUSDIST_POS_LE] THEN
22924  ASM_CASES_TAC ``u:real->bool = {}`` THEN
22925  ASM_REWRITE_TAC[HAUSDIST_EMPTY, REAL_ADD_RID, HAUSDIST_POS_LE] THEN
22926  ASM_SIMP_TAC real_ss [REAL_HAUSDIST_LE_EQ] THEN
22927  ASM_MESON_TAC[lemma, HAUSDIST_SYM, SETDIST_SYM, REAL_ADD_SYM]
22928QED
22929
22930Theorem HAUSDIST_EQ_0:
22931   !s t:real->bool.
22932      bounded s /\ bounded t
22933      ==> ((hausdist(s,t) = &0) <=> (s = {}) \/ (t = {}) \/ (closure s = closure t))
22934Proof
22935  REPEAT STRIP_TAC THEN
22936  MAP_EVERY ASM_CASES_TAC [``s:real->bool = {}``, ``t:real->bool = {}``] THEN
22937  ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
22938  ASM_SIMP_TAC real_ss [GSYM REAL_LE_ANTISYM, HAUSDIST_POS_LE, REAL_HAUSDIST_LE_EQ] THEN
22939  SIMP_TAC real_ss [SETDIST_POS_LE, REAL_ARITH ``&0 <= x ==> (x <= &0 <=> (x = &0:real))``] THEN
22940  ASM_SIMP_TAC real_ss [SETDIST_EQ_0_SING, GSYM SUBSET_ANTISYM_EQ, SUBSET_DEF] THEN
22941  SIMP_TAC std_ss [FORALL_IN_CLOSURE_EQ, CLOSED_CLOSURE, CONTINUOUS_ON_ID]
22942QED
22943
22944Theorem HAUSDIST_COMPACT_NONTRIVIAL:
22945   !s t:real->bool.
22946        compact s /\ compact t /\ ~(s = {}) /\ ~(t = {})
22947        ==> (hausdist(s,t) =
22948            inf {e | &0 <= e /\
22949                   s SUBSET {x + y | x IN t /\ abs y <= e} /\
22950                   t SUBSET {x + y | x IN s /\ abs y <= e}})
22951Proof
22952  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
22953  MATCH_MP_TAC REAL_INF_UNIQUE THEN
22954  SIMP_TAC real_ss [FORALL_IN_GSPEC, EXISTS_IN_GSPEC] THEN
22955  SIMP_TAC real_ss [SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
22956  SIMP_TAC real_ss [REAL_ARITH ``(a:real = b + x) <=> (a - b = x)``,
22957              ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
22958  REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL
22959   [REPEAT STRIP_TAC THEN
22960    MATCH_MP_TAC REAL_HAUSDIST_LE THEN
22961    METIS_TAC[SETDIST_LE_DIST, DIST_SYM, REAL_LE_TRANS,
22962              IN_SING, REAL_LT_IMP_LE],
22963    REPEAT STRIP_TAC THEN EXISTS_TAC ``hausdist(s:real->bool,t)`` THEN
22964    ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN
22965    METIS_TAC[DIST_SYM, HAUSDIST_SYM,
22966                  HAUSDIST_COMPACT_EXISTS, COMPACT_IMP_BOUNDED]]
22967QED
22968
22969Theorem HAUSDIST_BALLS :
22970   (!a b:real r s.
22971        hausdist(ball(a,r),ball(b,s)) =
22972        if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\
22973   (!a b:real r s.
22974        hausdist(ball(a,r),cball(b,s)) =
22975        if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\
22976   (!a b:real r s.
22977        hausdist(cball(a,r),ball(b,s)) =
22978        if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\
22979   (!a b:real r s.
22980        hausdist(cball(a,r),cball(b,s)) =
22981        if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))
22982Proof
22983  REWRITE_TAC[METIS[]
22984   ``(x = if p then y else z) <=> (p ==> (x = y)) /\ (~p ==> (x = z))``] THEN
22985  SIMP_TAC real_ss [TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
22986  SIMP_TAC real_ss [BALL_EMPTY, CBALL_EMPTY, HAUSDIST_EMPTY, DE_MORGAN_THM] THEN
22987  ONCE_REWRITE_TAC[METIS[HAUSDIST_CLOSURE]
22988   ``hausdist(s,t) = hausdist(closure s,closure t)``] THEN
22989  SIMP_TAC real_ss [REAL_NOT_LE, REAL_NOT_LT, CLOSURE_BALL] THEN
22990  REWRITE_TAC[HAUSDIST_CLOSURE] THEN
22991  MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN
22992  CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE], REPEAT STRIP_TAC] THEN
22993  ASM_SIMP_TAC real_ss [HAUSDIST_NONTRIVIAL, BOUNDED_CBALL, CBALL_EQ_EMPTY,
22994               REAL_NOT_LT] THEN
22995  MATCH_MP_TAC SUP_UNIQUE THEN
22996  SIMP_TAC real_ss [FORALL_IN_GSPEC, FORALL_IN_UNION] THEN
22997  REWRITE_TAC[MESON[CBALL_SING] ``{a} = cball(a:real,&0)``] THEN
22998  ASM_REWRITE_TAC[SETDIST_BALLS, REAL_LT_REFL] THEN
22999  X_GEN_TAC ``c:real`` THEN REWRITE_TAC[IN_CBALL] THEN
23000  reverse EQ_TAC
23001  >- (RW_TAC real_ss [dist] >> REAL_ASM_ARITH_TAC) THEN
23002  ASM_CASES_TAC ``b:real = a`` THENL
23003  [ (* goal 1 (of 2) *)
23004    ONCE_ASM_REWRITE_TAC [DIST_SYM] THEN ASM_REWRITE_TAC[DIST_REFL, REAL_MAX_LE] THEN
23005    DISCH_THEN(CONJUNCTS_THEN2
23006     (MP_TAC o SPEC ``a + r * 1:real``)
23007     (MP_TAC o SPEC ``a + s * 1:real``)) THEN
23008    REWRITE_TAC[dist, REAL_ARITH ``abs(a:real - (a + x)) = abs x``] THEN
23009    SIMP_TAC real_ss [ABS_MUL, LESS_EQ_REFL] \\
23010    REAL_ASM_ARITH_TAC,
23011    (* goal 2 (of 2) *)
23012    DISCH_THEN(CONJUNCTS_THEN2
23013     (MP_TAC o SPEC ``a - r / dist(a,b) * (b - a):real``)
23014     (MP_TAC o SPEC ``b - s / dist(a,b) * (a - b):real``)) THEN
23015    REWRITE_TAC[dist, REAL_ARITH ``abs(a:real - (a - x)) = abs x``] THEN
23016    REWRITE_TAC[dist, ABS_MUL, REAL_ARITH
23017     ``b - e * (a - b) - a:real = (&1 + e) * (b - a)``] THEN
23018    ONCE_REWRITE_TAC [METIS [ABS_ABS] ``abs x * abs (a - b) =
23019                                        abs x * abs (abs (a - b:real))``] THEN
23020    REWRITE_TAC[GSYM ABS_MUL] THEN REWRITE_TAC[ABS_ABS] THEN
23021    ONCE_REWRITE_TAC [METIS [ABS_SUB] ``r / abs (a - b) * abs (b - a) =
23022                                   r / abs (a - b) * abs (a - b:real)``] THEN
23023    REWRITE_TAC[REAL_ADD_RDISTRIB, REAL_MUL_LID] THEN
23024    RULE_ASSUM_TAC (ONCE_REWRITE_RULE [REAL_ARITH ``(b <> a) = (abs (a - b) <> 0:real)``]) THEN
23025    ONCE_REWRITE_TAC [METIS [ABS_SUB] ``r / abs (a - b) * abs (b - a) =
23026                                   r / abs (a - b) * abs (a - b:real)``] THEN
23027    ASM_SIMP_TAC real_ss [REAL_DIV_RMUL, ABS_ZERO, REAL_SUB_0] THEN
23028    REAL_ASM_ARITH_TAC ]
23029QED
23030
23031Theorem HAUSDIST_ALT:
23032   !s t:real->bool.
23033        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
23034        ==> (hausdist(s,t) =
23035             sup {abs(setdist({x},s) - setdist({x},t)) | x IN univ(:real)})
23036Proof
23037  REPEAT GEN_TAC THEN
23038  ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE, GSYM(CONJUNCT2 SETDIST_CLOSURE),
23039    GSYM CLOSURE_EQ_EMPTY, METIS[HAUSDIST_CLOSURE]
23040    ``hausdist(s:real->bool,t) = hausdist(closure s,closure t)``] THEN
23041  SPEC_TAC(``closure t:real->bool``,``t:real->bool``) THEN
23042  SPEC_TAC(``closure s:real->bool``,``s:real->bool``) THEN
23043  REPEAT STRIP_TAC THEN
23044  ASM_SIMP_TAC real_ss [HAUSDIST_NONTRIVIAL, COMPACT_IMP_BOUNDED] THEN
23045  MATCH_MP_TAC SUP_EQ THEN
23046  SIMP_TAC real_ss [FORALL_IN_UNION, FORALL_IN_GSPEC, IN_UNIV] THEN
23047  REWRITE_TAC[REAL_ARITH ``abs(y - x) <= b <=> x <= y + b /\ y <= x + b:real``] THEN
23048  GEN_TAC THEN SIMP_TAC real_ss [FORALL_AND_THM] THEN BINOP_TAC THEN
23049  (EQ_TAC THENL [ALL_TAC, METIS_TAC[SETDIST_SING_IN_SET, REAL_ADD_LID]]) THEN
23050  DISCH_TAC THEN X_GEN_TAC ``z:real`` THENL
23051   [MP_TAC(ISPECL[``{z:real}``, ``s:real->bool``] SETDIST_CLOSED_COMPACT),
23052    MP_TAC(ISPECL[``{z:real}``, ``t:real->bool``] SETDIST_CLOSED_COMPACT)] THEN
23053  ASM_REWRITE_TAC[CLOSED_SING, NOT_INSERT_EMPTY] THEN
23054  SIMP_TAC real_ss [IN_SING, RIGHT_EXISTS_AND_THM, UNWIND_THM2] THEN
23055  DISCH_THEN(X_CHOOSE_THEN ``y:real`` (STRIP_ASSUME_TAC o GSYM)) THEN
23056  FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN ASM_REWRITE_TAC[] THENL
23057   [MP_TAC(ISPECL[``{y:real}``, ``t:real->bool``] SETDIST_CLOSED_COMPACT),
23058    MP_TAC(ISPECL[``{y:real}``, ``s:real->bool``] SETDIST_CLOSED_COMPACT)] THEN
23059  ASM_REWRITE_TAC[CLOSED_SING, NOT_INSERT_EMPTY] THEN
23060  SIMP_TAC real_ss [IN_SING, RIGHT_EXISTS_AND_THM, UNWIND_THM2] THEN
23061  DISCH_THEN(X_CHOOSE_THEN ``x:real`` (STRIP_ASSUME_TAC o GSYM)) THEN
23062  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
23063  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``dist(z:real,x)`` THEN
23064  ASM_SIMP_TAC real_ss [SETDIST_LE_DIST, IN_SING] THEN
23065  UNDISCH_TAC ``dist(y:real,x) <= b`` THEN REWRITE_TAC [dist] THEN REAL_ARITH_TAC
23066QED
23067
23068Theorem CONTINUOUS_DIAMETER:
23069   !s:real->bool e.
23070        bounded s /\ ~(s = {}) /\ &0 < e
23071        ==> ?d. &0 < d /\
23072                !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d
23073                    ==> abs(diameter s - diameter t) < e
23074Proof
23075  REPEAT STRIP_TAC THEN EXISTS_TAC ``e / &2:real`` THEN
23076  ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN
23077  SUBGOAL_THEN ``diameter(s:real->bool) - diameter(t:real->bool) =
23078                 diameter(closure s) - diameter(closure t)``
23079  SUBST1_TAC THENL [ASM_MESON_TAC[DIAMETER_CLOSURE], ALL_TAC] THEN
23080  MATCH_MP_TAC REAL_LET_TRANS THEN
23081  EXISTS_TAC ``&2 * hausdist(s:real->bool,t)`` THEN
23082  CONJ_TAC THENL [ALL_TAC,
23083   FULL_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
23084   ASM_REAL_ARITH_TAC] THEN
23085  MP_TAC(ISPECL [``0:real``, ``hausdist(s:real->bool,t)``]
23086    DIAMETER_CBALL) THEN
23087  ASM_SIMP_TAC real_ss [HAUSDIST_POS_LE, GSYM REAL_NOT_LE] THEN
23088  DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH
23089   ``x <= y + e /\ y <= x + e ==> abs(x - y) <= e:real``) THEN
23090  CONJ_TAC THEN
23091  W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN
23092  ASM_SIMP_TAC real_ss [BOUNDED_CBALL, BOUNDED_CLOSURE] THEN
23093  MATCH_MP_TAC(REWRITE_RULE[CONJ_EQ_IMP] REAL_LE_TRANS) THEN
23094  MATCH_MP_TAC DIAMETER_SUBSET THEN
23095  ASM_SIMP_TAC real_ss [BOUNDED_SUMS, BOUNDED_CBALL, BOUNDED_CLOSURE] THEN
23096  ONCE_REWRITE_TAC[METIS[HAUSDIST_CLOSURE]
23097   ``hausdist(s:real->bool,t) = hausdist(closure s,closure t)``]
23098  THENL [ALL_TAC, ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN
23099  MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN
23100  ASM_SIMP_TAC real_ss [COMPACT_CLOSURE, BOUNDED_CLOSURE, CLOSURE_EQ_EMPTY]
23101QED
23102
23103(* ------------------------------------------------------------------------- *)
23104(* Isometries are embeddings, and even surjective in the compact case.       *)
23105(* ------------------------------------------------------------------------- *)
23106
23107Theorem ISOMETRY_IMP_OPEN_MAP:
23108   !f:real->real s t u.
23109        (IMAGE f s = t) /\
23110        (!x y. x IN s /\ y IN s ==> (dist(f x,f y) = dist(x,y))) /\
23111        open_in (subtopology euclidean s) u
23112        ==> open_in (subtopology euclidean t) (IMAGE f u)
23113Proof
23114  SIMP_TAC std_ss [open_in, FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
23115  CONJ_TAC THENL [ASM_SET_TAC[], X_GEN_TAC ``x:real`` THEN DISCH_TAC] THEN
23116  FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
23117  STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN ASM_REWRITE_TAC[CONJ_EQ_IMP] THEN
23118  SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
23119  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET_DEF]) THEN
23120  ASM_SIMP_TAC std_ss [IN_IMAGE] THEN ASM_MESON_TAC[]
23121QED
23122
23123Theorem ISOMETRY_IMP_EMBEDDING:
23124   !f:real->real s t.
23125        (IMAGE f s = t) /\ (!x y. x IN s /\ y IN s ==> (dist(f x,f y) = dist(x,y)))
23126        ==> ?g. homeomorphism (s,t) (f,g)
23127Proof
23128  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
23129  ASM_SIMP_TAC std_ss [ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN
23130  CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0], REPEAT STRIP_TAC] THEN
23131  MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]
23132QED
23133
23134Theorem ISOMETRY_IMP_HOMEOMORPHISM_COMPACT:
23135   !f s:real->bool.
23136        compact s /\ IMAGE f s SUBSET s /\
23137        (!x y. x IN s /\ y IN s ==> (dist(f x,f y) = dist(x,y)))
23138        ==> ?g. homeomorphism (s,s) (f,g)
23139Proof
23140  REPEAT STRIP_TAC THEN
23141  SUBGOAL_THEN ``IMAGE (f:real->real) s = s``
23142   (fn th => ASM_MESON_TAC[th, ISOMETRY_IMP_EMBEDDING]) THEN
23143  FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN
23144  ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET_DEF] THEN
23145  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
23146  SUBGOAL_THEN ``setdist({x},IMAGE (f:real->real) s) = &0`` MP_TAC THENL
23147   [MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ ~(&0 < x) ==> (x = &0:real)``) THEN
23148    REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN
23149    KNOW_TAC ``?z. (z 0 = (x:real)) /\ !n. z(SUC n) = f(z n)`` THENL
23150    [RW_TAC std_ss [num_Axiom], STRIP_TAC] THEN
23151    SUBGOAL_THEN ``!n. (z:num->real) n IN s`` ASSUME_TAC THENL
23152     [INDUCT_TAC THEN ASM_SET_TAC[], ALL_TAC] THEN
23153    UNDISCH_TAC ``compact s`` THEN DISCH_TAC THEN
23154    FIRST_ASSUM(MP_TAC o REWRITE_RULE [compact]) THEN
23155    DISCH_THEN(MP_TAC o SPEC ``z:num->real``) THEN
23156    ASM_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN
23157    MAP_EVERY X_GEN_TAC [``l:real``, ``r:num->num``] THEN CCONTR_TAC THEN
23158    FULL_SIMP_TAC std_ss [] THEN
23159    FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN
23160    REWRITE_TAC[cauchy] THEN
23161    DISCH_THEN(MP_TAC o SPEC ``setdist({x},IMAGE (f:real->real) s)``) THEN
23162    ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN ``N:num``
23163     (MP_TAC o SPECL [``N:num``, ``N + 1:num``])) THEN
23164    KNOW_TAC ``N >= N /\ N + 1 >= N:num`` THENL
23165    [ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
23166     POP_ASSUM K_TAC THEN REWRITE_TAC[REAL_NOT_LT, o_THM]] THEN
23167    SUBGOAL_THEN ``(r:num->num) N < r (N + 1)`` MP_TAC THENL
23168     [RULE_ASSUM_TAC (REWRITE_RULE [METIS [] ``(~a \/ b) = (a ==> b)``]) THEN
23169      FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC,
23170      SIMP_TAC std_ss [LT_EXISTS, LEFT_IMP_EXISTS_THM]] THEN
23171    X_GEN_TAC ``d:num`` THEN DISCH_THEN SUBST1_TAC THEN
23172    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``dist(x:real,z(SUC d))`` THEN CONJ_TAC THENL
23173     [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SET_TAC[], ALL_TAC] THEN
23174    MATCH_MP_TAC REAL_EQ_IMP_LE THEN
23175    SPEC_TAC(``(r:num->num) N``,``m:num``) THEN
23176    INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES],
23177    REWRITE_TAC[SETDIST_EQ_0_SING, IMAGE_EQ_EMPTY] THEN
23178    ASM_MESON_TAC[COMPACT_IMP_CLOSED, NOT_IN_EMPTY,
23179                  COMPACT_CONTINUOUS_IMAGE, CLOSURE_CLOSED]]
23180QED
23181
23182(* ------------------------------------------------------------------------- *)
23183(* Urysohn's lemma (for real, where the proof is easy using distances).      *)
23184(* ------------------------------------------------------------------------- *)
23185
23186Theorem lemma[local]:
23187     !s t u a b.
23188          closed_in (subtopology euclidean u) s /\
23189          closed_in (subtopology euclidean u) t /\
23190          (s INTER t = {}) /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b)
23191          ==> ?f:real->real.
23192                 f continuous_on u /\
23193                 (!x. x IN u ==> f(x) IN segment[a,b]) /\
23194                 (!x. x IN u ==> ((f x = a) <=> x IN s)) /\
23195                 (!x. x IN u ==> ((f x = b) <=> x IN t))
23196Proof
23197    REPEAT STRIP_TAC THEN EXISTS_TAC
23198      ``\x:real. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) *
23199                      (b - a:real)`` THEN SIMP_TAC std_ss [] THEN
23200    SUBGOAL_THEN
23201     ``(!x:real. x IN u ==> ((setdist({x},s) = &0) <=> x IN s)) /\
23202       (!x:real. x IN u ==> ((setdist({x},t) = &0) <=> x IN t))``
23203    STRIP_ASSUME_TAC THENL
23204     [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL
23205       [MP_TAC(ISPEC ``s:real->bool`` CLOSED_IN_CLOSED),
23206        MP_TAC(ISPEC ``t:real->bool`` CLOSED_IN_CLOSED)] THEN
23207      DISCH_THEN(MP_TAC o SPEC ``u:real->bool``) THEN
23208      ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN ``v:real->bool``
23209       (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
23210      ASM_MESON_TAC[CLOSURE_CLOSED, INTER_SUBSET, SUBSET_CLOSURE, SUBSET_DEF,
23211                    IN_INTER, CLOSURE_SUBSET],
23212      ALL_TAC] THEN
23213    SUBGOAL_THEN ``!x:real. x IN u ==> &0 < setdist({x},s) + setdist({x},t)``
23214    ASSUME_TAC THENL
23215     [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
23216        ``&0 <= x /\ &0 <= y /\ ~((x = &0) /\ (y = &0)) ==> &0 < x + y:real``) THEN
23217      REWRITE_TAC[SETDIST_POS_LE] THEN ASM_SET_TAC[],
23218      ALL_TAC] THEN
23219    REPEAT CONJ_TAC THENL
23220     [ONCE_REWRITE_TAC [METIS [] ``(\x. a +
23221       setdist ({x},s) / (setdist ({x},s) + setdist ({x},t)) * (b - a)) =
23222                                   (\x. (\x. a) x +
23223       (\x. setdist ({x},s) / (setdist ({x},s) + setdist ({x},t)) * (b - a)) x)``] THEN
23224      MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
23225      REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
23226      ONCE_REWRITE_TAC [METIS [] ``(\x. setdist ({x},s) *
23227       (inv (setdist ({x},s) + setdist ({x},t)) * (b - a))) =
23228                                   (\x. (\x. setdist ({x},s)) x *
23229       (\x. (inv (setdist ({x},s) + setdist ({x},t)) * (b - a))) x)``] THEN
23230      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC THENL
23231      [REWRITE_TAC[CONTINUOUS_ON_SETDIST], ALL_TAC] THEN
23232      ONCE_REWRITE_TAC [METIS [] ``(\x. inv (setdist ({x},s) + setdist ({x},t)) * (b - a)) =
23233            (\x. (\x. inv (setdist ({x},s) + setdist ({x},t))) x * (\x. (b - a)) x)``] THEN
23234      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST, o_DEF] THEN
23235      REWRITE_TAC[CONTINUOUS_ON_SETDIST] THEN
23236      ONCE_REWRITE_TAC [METIS [] ``(\x. inv (setdist ({x},s) + setdist ({x},t))) =
23237                              (\x. inv ((\x. setdist ({x},s) + setdist ({x},t)) x))``] THEN
23238      MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
23239      ASM_SIMP_TAC std_ss [REAL_LT_IMP_NE] THEN
23240      ONCE_REWRITE_TAC [METIS [] ``(\x. setdist ({x},s) + setdist ({x},t)) =
23241                      (\x. (\x. setdist ({x},s)) x + (\x. setdist ({x},t)) x)``] THEN
23242      MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
23243      REWRITE_TAC[CONTINUOUS_ON_SETDIST],
23244      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
23245      SIMP_TAC std_ss[segment, GSPECIFICATION] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
23246      SIMP_TAC real_ss [REAL_ENTIRE, LEFT_AND_OVER_OR, REAL_ARITH
23247       ``(a + x * (b - a):real = (&1 - u) * a + u * b) <=>
23248        ((x - u) * (b - a) = 0)``, EXISTS_OR_THM] THEN
23249      DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
23250      REWRITE_TAC[REAL_SUB_0, UNWIND_THM1] THEN
23251      ASM_SIMP_TAC std_ss [REAL_LE_DIV, REAL_LE_ADD, SETDIST_POS_LE, REAL_LE_LDIV_EQ,
23252                   REAL_ARITH ``a <= &1 * (a + b) <=> &0 <= b:real``],
23253      SIMP_TAC real_ss [REAL_ARITH ``(a + x:real = a) <=> (x = 0)``],
23254      REWRITE_TAC[REAL_ARITH ``(a + x * (b - a):real = b) <=>
23255                               ((x - &1) * (b - a) = 0)``]] THEN
23256    ASM_REWRITE_TAC[REAL_ENTIRE, REAL_SUB_0] THEN
23257    ASM_SIMP_TAC std_ss [REAL_SUB_0, REAL_EQ_LDIV_EQ,
23258                 REAL_MUL_LZERO, REAL_MUL_LID] THEN
23259    REWRITE_TAC[REAL_ARITH ``(x:real = x + y) <=> (y = &0)``] THEN
23260    ASM_REWRITE_TAC[]
23261QED
23262
23263Theorem URYSOHN_LOCAL_STRONG:
23264   !s t u a b.
23265        closed_in (subtopology euclidean u) s /\
23266        closed_in (subtopology euclidean u) t /\
23267        (s INTER t = {}) /\ ~(a = b)
23268        ==> ?f:real->real.
23269               f continuous_on u /\
23270               (!x. x IN u ==> f(x) IN segment[a,b]) /\
23271               (!x. x IN u ==> ((f x = a) <=> x IN s)) /\
23272               (!x. x IN u ==> ((f x = b) <=> x IN t))
23273Proof
23274  KNOW_TAC ``!(s :real -> bool) (t :real -> bool).
23275   (\s t. !(u :real -> bool) (a :real) (b :real).
23276  closed_in (subtopology euclidean u) s /\
23277  closed_in (subtopology euclidean u) t /\
23278  (s INTER t = ({} :real -> bool)) /\ a <> b ==>
23279  ?(f :real -> real).
23280    f continuous_on u /\
23281    (!(x :real). x IN u ==> f x IN segment [(a,b)]) /\
23282    (!(x :real). x IN u ==> ((f x = a) <=> x IN s)) /\
23283    !(x :real). x IN u ==> ((f x = b) <=> x IN t)) s t`` THENL
23284  [ALL_TAC, SIMP_TAC std_ss []] THEN
23285  MATCH_MP_TAC(MESON[]
23286   ``(!s t. P s t <=> P t s) /\
23287    (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\
23288    P {} {} /\ (!t. ~(t = {}) ==> P {} t)
23289    ==> !s t. P s t``) THEN
23290  SIMP_TAC std_ss [] THEN REPEAT CONJ_TAC THENL
23291
23292   [REPEAT GEN_TAC THEN
23293    KNOW_TAC ``(!(u :real -> bool) (a :real) (b :real).
23294   closed_in (subtopology euclidean u) (s :real -> bool) /\
23295   closed_in (subtopology euclidean u) (t :real -> bool) /\
23296   (s INTER t = ({} :real -> bool)) /\ a <> b ==>
23297   ?(f :real -> real).
23298     f continuous_on u /\
23299     (!(x :real). x IN u ==> f x IN segment [(a,b)]) /\
23300     (!(x :real). x IN u ==> ((f x = a) <=> x IN s)) /\
23301     !(x :real). x IN u ==> ((f x = b) <=> x IN t)) <=>
23302   !(u :real -> bool) (b :real) (a :real).
23303   closed_in (subtopology euclidean u) t /\
23304   closed_in (subtopology euclidean u) s /\
23305   (t INTER s = ({} :real -> bool)) /\ a <> b ==>
23306   ?(f :real -> real).
23307    f continuous_on u /\
23308    (!(x :real). x IN u ==> f x IN segment [(a,b)]) /\
23309    (!(x :real). x IN u ==> ((f x = a) <=> x IN t)) /\
23310    !(x :real). x IN u ==> ((f x = b) <=> x IN s)`` THENL
23311    [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
23312     EQ_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THENL
23313     [POP_ASSUM (MP_TAC o SPECL [``u:real->bool``,``b:real``,``a:real``]),
23314      POP_ASSUM (MP_TAC o SPECL [``u:real->bool``,``a:real``,``b:real``])] THEN
23315     SIMP_TAC std_ss []] THEN
23316    REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
23317    METIS_TAC[SEGMENT_SYM, INTER_COMM, CONJ_ACI, EQ_SYM_EQ],
23318    SIMP_TAC real_ss [lemma],
23319    REPEAT STRIP_TAC THEN EXISTS_TAC ``(\x. midpoint(a,b)):real->real`` THEN
23320    ASM_SIMP_TAC std_ss [NOT_IN_EMPTY, CONTINUOUS_ON_CONST, MIDPOINT_IN_SEGMENT] THEN
23321    REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
23322    UNDISCH_TAC ``~(a:real = b)`` THEN REWRITE_TAC[GSYM MONO_NOT_EQ] THEN
23323    ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
23324    SIMP_TAC std_ss [REAL_EQ_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
23325    REAL_ARITH_TAC,
23326    REPEAT STRIP_TAC THEN ASM_CASES_TAC ``t:real->bool = u`` THENL
23327     [EXISTS_TAC ``(\x. b):real->real`` THEN
23328      ASM_SIMP_TAC std_ss [NOT_IN_EMPTY, ENDS_IN_SEGMENT, IN_UNIV,
23329                      CONTINUOUS_ON_CONST],
23330      SUBGOAL_THEN ``?c:real. c IN u /\ ~(c IN t)`` STRIP_ASSUME_TAC THENL
23331       [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN
23332        REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM_SET_TAC[],
23333        ALL_TAC] THEN
23334      MP_TAC(ISPECL [``{c:real}``, ``t:real->bool``, ``u:real->bool``,
23335                     ``midpoint(a,b):real``, ``b:real``] lemma) THEN
23336      ASM_REWRITE_TAC[CLOSED_IN_SING, MIDPOINT_EQ_ENDPOINT] THEN
23337      KNOW_TAC ``({(c :real)} INTER (t :real -> bool) = ({} :real -> bool)) /\
23338                   {c} <> ({} :real -> bool)`` THENL
23339      [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
23340      DISCH_THEN (X_CHOOSE_TAC ``f:real->real``) THEN EXISTS_TAC ``f:real->real`` THEN
23341      POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [NOT_IN_EMPTY] THEN
23342      STRIP_TAC THEN CONJ_TAC THENL
23343       [SUBGOAL_THEN
23344         ``segment[midpoint(a,b):real,b] SUBSET segment[a,b]`` MP_TAC
23345        THENL
23346         [REWRITE_TAC[SUBSET_DEF, IN_SEGMENT, midpoint] THEN GEN_TAC THEN
23347          DISCH_THEN(X_CHOOSE_THEN ``u:real`` STRIP_ASSUME_TAC) THEN
23348          EXISTS_TAC ``(&1 + u) / &2:real`` THEN ASM_REWRITE_TAC[] THEN
23349          SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
23350          CONJ_TAC THENL [UNDISCH_TAC ``0 <= u:real`` THEN REAL_ARITH_TAC, ALL_TAC] THEN
23351          CONJ_TAC THENL [UNDISCH_TAC ``u <= 1:real`` THEN REAL_ARITH_TAC, ALL_TAC] THEN
23352          ONCE_REWRITE_TAC [REAL_ARITH ``a * (b * c) = (a * c) * b:real``] THEN
23353          GEN_REWR_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN
23354          ONCE_REWRITE_TAC [METIS [REAL_DIV_REFL, REAL_ARITH ``2 <> 0:real``]
23355           ``u * b * 1 = u * b * (2 / 2:real)``] THEN REWRITE_TAC [real_div] THEN
23356          ONCE_REWRITE_TAC [REAL_ARITH ``u * b * (2 * inv 2) = (u * b * 2) * inv 2:real``] THEN
23357          REWRITE_TAC [GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC [GSYM real_div] THEN
23358          SIMP_TAC real_ss [REAL_EQ_LDIV_EQ] THEN REWRITE_TAC [REAL_ADD_RDISTRIB] THEN
23359          REWRITE_TAC [real_div, REAL_SUB_RDISTRIB] THEN
23360          REWRITE_TAC [REAL_ARITH
23361          ``(1 + u) * inv 2 * a * 2 = (1 + u) * a * (inv 2 * 2:real)``] THEN
23362          SIMP_TAC real_ss [REAL_MUL_LINV] THEN REAL_ARITH_TAC,
23363          ASM_SET_TAC[]],
23364        SUBGOAL_THEN ``~(a IN segment[midpoint(a,b):real,b])`` MP_TAC THENL
23365         [ALL_TAC, ASM_MESON_TAC[]] THEN
23366        DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN
23367        REWRITE_TAC[DIST_MIDPOINT] THEN
23368        UNDISCH_TAC ``~(a:real = b)`` THEN REWRITE_TAC [dist] THEN
23369        SIMP_TAC real_ss [REAL_LE_RDIV_EQ] THEN REWRITE_TAC [REAL_NOT_LE] THEN
23370        REWRITE_TAC [abs] THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]]]
23371QED
23372
23373Theorem URYSOHN_LOCAL:
23374   !s t u a b.
23375        closed_in (subtopology euclidean u) s /\
23376        closed_in (subtopology euclidean u) t /\
23377        (s INTER t = {})
23378        ==> ?f:real->real.
23379               f continuous_on u /\
23380               (!x. x IN u ==> f(x) IN segment[a,b]) /\
23381               (!x. x IN s ==> (f x = a)) /\
23382               (!x. x IN t ==> (f x = b))
23383Proof
23384  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``a:real = b`` THENL
23385   [EXISTS_TAC ``(\x. b):real->real`` THEN
23386    ASM_REWRITE_TAC[ENDS_IN_SEGMENT, CONTINUOUS_ON_CONST],
23387    MP_TAC(ISPECL [``s:real->bool``, ``t:real->bool``, ``u:real->bool``,
23388                   ``a:real``, ``b:real``] URYSOHN_LOCAL_STRONG) THEN
23389    ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_TAC ``f:real->real``) THEN
23390    EXISTS_TAC ``f:real->real`` THEN POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [] THEN
23391    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN
23392    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]
23393QED
23394
23395Theorem URYSOHN_STRONG:
23396   !s t a b.
23397        closed s /\ closed t /\ (s INTER t = {}) /\ ~(a = b)
23398        ==> ?f:real->real.
23399               f continuous_on univ(:real) /\ (!x. f(x) IN segment[a,b]) /\
23400               (!x. (f x = a) <=> x IN s) /\ (!x. (f x = b) <=> x IN t)
23401Proof
23402  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN
23403  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
23404  DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN
23405  REWRITE_TAC[IN_UNIV]
23406QED
23407
23408Theorem URYSOHN:
23409   !s t a b.
23410        closed s /\ closed t /\ (s INTER t = {})
23411        ==> ?f:real->real.
23412               f continuous_on univ(:real) /\ (!x. f(x) IN segment[a,b]) /\
23413               (!x. x IN s ==> (f x = a)) /\ (!x. x IN t ==> (f x = b))
23414Proof
23415  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN
23416  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN
23417   (MP_TAC o ISPECL [``a:real``, ``b:real``] o MATCH_MP URYSOHN_LOCAL) THEN
23418  REWRITE_TAC[IN_UNIV]
23419QED
23420
23421(* ------------------------------------------------------------------------- *)
23422(* Basics about "local" properties in general.                               *)
23423(* ------------------------------------------------------------------------- *)
23424
23425Definition locally[nocompute]:
23426 locally P (s:real->bool) <=>
23427        !w x. open_in (subtopology euclidean s) w /\ x IN w
23428              ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\
23429                        x IN u /\ u SUBSET v /\ v SUBSET w
23430End
23431
23432Theorem LOCALLY_MONO:
23433   !P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s
23434Proof
23435  REWRITE_TAC[locally] THEN MESON_TAC[]
23436QED
23437
23438Theorem LOCALLY_OPEN_SUBSET:
23439   !P s t:real->bool.
23440        locally P s /\ open_in (subtopology euclidean s) t
23441        ==> locally P t
23442Proof
23443  REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN
23444  MAP_EVERY X_GEN_TAC [``w:real->bool``, ``x:real``] THEN STRIP_TAC THEN
23445  FIRST_X_ASSUM(MP_TAC o SPECL [``w:real->bool``, ``x:real``]) THEN
23446  KNOW_TAC ``open_in (subtopology euclidean s) w /\ x IN w`` THENL
23447  [ASM_MESON_TAC[OPEN_IN_TRANS],
23448   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
23449  STRIP_TAC THEN EXISTS_TAC ``u:real->bool`` THEN EXISTS_TAC ``v:real->bool`` THEN
23450  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
23451  EXISTS_TAC ``s:real->bool`` THEN ASM_MESON_TAC[open_in, SUBSET_DEF]
23452QED
23453
23454Theorem LOCALLY_DIFF_CLOSED:
23455   !P s t:real->bool.
23456        locally P s /\ closed_in (subtopology euclidean s) t
23457        ==> locally P (s DIFF t)
23458Proof
23459  REPEAT STRIP_TAC THEN
23460  MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
23461  EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
23462  MATCH_MP_TAC OPEN_IN_DIFF THEN
23463  ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL, SUBSET_UNIV, TOPSPACE_EUCLIDEAN]
23464QED
23465
23466Theorem LOCALLY_EMPTY:
23467   !P. locally P {}
23468Proof
23469  REWRITE_TAC[locally] THEN MESON_TAC[open_in, SUBSET_DEF, NOT_IN_EMPTY]
23470QED
23471
23472Theorem LOCALLY_SING:
23473   !P a. locally P {a} <=> P {a}
23474Proof
23475  REWRITE_TAC[locally, open_in] THEN
23476  REWRITE_TAC[SET_RULE
23477   ``(w SUBSET {a} /\ P) /\ x IN w <=> (w = {a}) /\ (x = a) /\ P``] THEN
23478  SIMP_TAC std_ss [CONJ_EQ_IMP, RIGHT_FORALL_IMP_THM, UNWIND_FORALL_THM2, IN_SING] THEN
23479  REWRITE_TAC[SET_RULE
23480   ``(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=>
23481    (u = {a}) /\ (v = {a}) /\ P /\ Q``] THEN
23482  SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM, UNWIND_THM2, IN_SING] THEN
23483  REWRITE_TAC[UNWIND_FORALL_THM2, MESON[REAL_LT_01] ``?x:real. &0 < x``]
23484QED
23485
23486Theorem LOCALLY_INTER:
23487   !P:(real->bool)->bool.
23488        (!s t. P s /\ P t ==> P(s INTER t))
23489        ==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)
23490Proof
23491  GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
23492  REWRITE_TAC[locally, OPEN_IN_OPEN] THEN
23493  SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN
23494  REWRITE_TAC [GSYM CONJ_ASSOC] THEN
23495  ONCE_REWRITE_TAC [METIS [] ``( ?v t.
23496     open t /\ P v /\ x IN s INTER t /\ s INTER t SUBSET v /\
23497           v SUBSET w) = (\w x.  ?v t.
23498     open t /\ P v /\ x IN s INTER t /\ s INTER t SUBSET v /\
23499           v SUBSET w) w x``] THEN
23500  ONCE_REWRITE_TAC [METIS [] ``s INTER t = (\t. s INTER t:real->bool) t``] THEN
23501  ONCE_REWRITE_TAC [METIS [] ``x IN w <=> (\w x.  x IN w) w x``] THEN
23502  ONCE_REWRITE_TAC [METIS[]
23503   ``(!w x. (?t. P t /\ (w = f t) /\ Q w x) ==> R w x) <=>
23504     (!t x. P t /\ Q (f t) x ==> R (f t) x)``] THEN
23505  SIMP_TAC std_ss [] THEN
23506  SIMP_TAC std_ss [GSYM FORALL_AND_THM, UNWIND_THM2, IN_INTER] THEN
23507  DISCH_TAC THEN X_GEN_TAC ``w:real->bool`` THEN X_GEN_TAC ``x:real`` THEN
23508  POP_ASSUM (MP_TAC o SPECL [``w:real->bool``,``x:real``]) THEN
23509  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
23510  ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2
23511   (X_CHOOSE_THEN ``u1:real->bool`` (X_CHOOSE_THEN ``v1:real->bool``
23512        STRIP_ASSUME_TAC))
23513   (X_CHOOSE_THEN ``u2:real->bool`` (X_CHOOSE_THEN ``v2:real->bool``
23514        STRIP_ASSUME_TAC))) THEN
23515  EXISTS_TAC ``u1 INTER u2:real->bool`` THEN
23516  EXISTS_TAC ``v1 INTER v2:real->bool`` THEN
23517  ASM_SIMP_TAC std_ss [OPEN_INTER] THEN ASM_SET_TAC[]
23518QED
23519
23520Theorem lemma[local]:
23521    !P Q f g. (!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t)
23522        ==> (!s:real->bool t:real->bool.
23523                locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)
23524Proof
23525    REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
23526    REWRITE_TAC[locally] THEN STRIP_TAC THEN
23527    FIRST_X_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE [homeomorphism]) THEN
23528    MAP_EVERY X_GEN_TAC [``w:real->bool``, ``y:real``] THEN STRIP_TAC THEN
23529    FIRST_X_ASSUM(MP_TAC o SPECL
23530     [``IMAGE (g:real->real) w``, ``(g:real->real) y``]) THEN
23531    KNOW_TAC ``open_in (subtopology euclidean (s :real -> bool))
23532                     (IMAGE (g :real -> real) (w :real -> bool)) /\
23533                             g (y :real) IN IMAGE g w`` THENL
23534     [CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
23535      SUBGOAL_THEN ``IMAGE (g:real->real) w =
23536                     {x | x IN s /\ f(x) IN w}``
23537      SUBST1_TAC THENL
23538       [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM_SET_TAC[],
23539        MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]],
23540      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM]] THEN
23541    MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
23542    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
23543     [``IMAGE (f:real->real) u``, ``IMAGE (f:real->real) v``] THEN
23544    CONJ_TAC THENL
23545     [SUBGOAL_THEN ``IMAGE (f:real->real) u =
23546                     {x | x IN t /\ g(x) IN u}``
23547      SUBST1_TAC THENL
23548       [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM_SET_TAC[],
23549        MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]],
23550      ALL_TAC] THEN
23551    CONJ_TAC THENL
23552     [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC ``v:real->bool`` THEN
23553      ASM_REWRITE_TAC[homeomorphism] THEN
23554      REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN
23555      TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[CONJ_EQ_IMP]
23556          CONTINUOUS_ON_SUBSET))),
23557      ALL_TAC] THEN
23558    RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM_SET_TAC[]
23559QED
23560
23561Theorem HOMEOMORPHISM_LOCALLY:
23562   !P Q f:real->real g.
23563        (!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t))
23564        ==> (!s t. homeomorphism (s,t) (f,g)
23565                   ==> (locally P s <=> locally Q t))
23566Proof
23567  REPEAT STRIP_TAC THEN EQ_TAC THEN
23568  MATCH_MP_TAC(SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM,
23569        TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN
23570  ASM_MESON_TAC[HOMEOMORPHISM_SYM]
23571QED
23572
23573Theorem HOMEOMORPHIC_LOCALLY:
23574   !P Q. (!s:real->bool t:real->bool. s homeomorphic t ==> (P s <=> Q t))
23575         ==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))
23576Proof
23577  REPEAT GEN_TAC THEN STRIP_TAC THEN
23578  SIMP_TAC std_ss [homeomorphic, LEFT_IMP_EXISTS_THM] THEN
23579  ONCE_REWRITE_TAC [METIS [] ``(homeomorphism (s,t) (f,g) ==>
23580                               (locally P s <=> locally Q t)) =
23581                     (\s t f g. homeomorphism (s,t) (f,g) ==>
23582                               (locally P s <=> locally Q t)) s t f g``] THEN
23583  ONCE_REWRITE_TAC[METIS[]
23584   ``(!a b c d. P a b c d) <=> (!c d a b. P a b c d)``] THEN
23585  GEN_TAC THEN GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_LOCALLY THEN
23586  ASM_MESON_TAC[homeomorphic]
23587QED
23588
23589Theorem LOCALLY_TRANSLATION:
23590   !P:(real->bool)->bool.
23591        (!a s. P (IMAGE (\x. a + x) s) <=> P s)
23592        ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)
23593Proof
23594  GEN_TAC THEN
23595  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``a:real``) THEN
23596  MP_TAC(ISPECL
23597   [``P:(real->bool)->bool``, ``P:(real->bool)->bool``,
23598    ``\x:real. a + x``, ``\x:real. -a + x``]
23599     HOMEOMORPHISM_LOCALLY) THEN
23600  SIMP_TAC real_ss [homeomorphism] THEN
23601  SIMP_TAC real_ss [CONTINUOUS_ON_ADD, CONTINUOUS_ON_CONST, CONTINUOUS_ON_ID] THEN
23602  SIMP_TAC real_ss [UNWIND_FORALL_THM1, CONJ_EQ_IMP, GSYM IMAGE_COMPOSE, o_DEF] THEN
23603  REWRITE_TAC [REAL_ARITH ``(-a + (a + x:real) = x) /\ (a + (-a + x) = x:real)``] THEN
23604  REWRITE_TAC [IMAGE_ID] THEN METIS_TAC[]
23605QED
23606
23607Theorem LOCALLY_INJECTIVE_LINEAR_IMAGE:
23608   !P:(real->bool)->bool Q:(real->bool)->bool.
23609        (!f s. linear f /\ (!x y. (f x = f y) ==> (x = y))
23610               ==> (P (IMAGE f s) <=> Q s))
23611        ==>  (!f s. linear f /\ (!x y. (f x = f y) ==> (x = y))
23612                    ==> (locally P (IMAGE f s) <=> locally Q s))
23613Proof
23614  GEN_TAC THEN GEN_TAC THEN
23615  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``f:real->real``) THEN
23616  ASM_CASES_TAC ``linear(f:real->real) /\ (!x y. (f x = f y) ==> (x = y))`` THEN
23617  ASM_REWRITE_TAC[] THEN
23618  FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
23619  REWRITE_TAC[FUN_EQ_THM, o_THM, I_THM] THEN
23620  DISCH_THEN(X_CHOOSE_THEN ``g:real->real`` STRIP_ASSUME_TAC) THEN
23621  MP_TAC(ISPECL
23622   [``Q:(real->bool)->bool``, ``P:(real->bool)->bool``,
23623    ``f:real->real``, ``g:real->real``]
23624     HOMEOMORPHISM_LOCALLY) THEN
23625  ASM_SIMP_TAC std_ss [homeomorphism, LINEAR_CONTINUOUS_ON] THEN
23626  ASM_SIMP_TAC std_ss [UNWIND_FORALL_THM1, CONJ_EQ_IMP, FORALL_IN_IMAGE] THEN
23627  ASM_SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, IMAGE_ID] THEN MESON_TAC[]
23628QED
23629
23630Theorem LOCALLY_OPEN_MAP_IMAGE:
23631   !P Q f:real->real s.
23632        f continuous_on s /\
23633        (!t. open_in (subtopology euclidean s) t
23634              ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\
23635        (!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\
23636        locally P s
23637        ==> locally Q (IMAGE f s)
23638Proof
23639  REPEAT GEN_TAC THEN
23640  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
23641  REWRITE_TAC[locally] THEN DISCH_TAC THEN
23642  MAP_EVERY X_GEN_TAC [``w:real->bool``, ``y:real``] THEN
23643  STRIP_TAC THEN
23644  FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE [open_in]) THEN
23645  UNDISCH_TAC ``f continuous_on s`` THEN DISCH_TAC THEN
23646  FIRST_ASSUM(MP_TAC o  SPEC ``w:real->bool`` o
23647    REWRITE_RULE [CONTINUOUS_ON_OPEN]) THEN
23648  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
23649  SUBGOAL_THEN ``?x. x IN s /\ ((f:real->real) x = y)`` STRIP_ASSUME_TAC THENL
23650   [ASM_SET_TAC[], ALL_TAC] THEN
23651  FIRST_X_ASSUM(MP_TAC o SPECL
23652   [``{x | x IN s /\ (f:real->real) x IN w}``, ``x:real``]) THEN
23653  ASM_SIMP_TAC real_ss [GSPECIFICATION, LEFT_IMP_EXISTS_THM] THEN
23654  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
23655  STRIP_TAC THEN MAP_EVERY EXISTS_TAC
23656   [``IMAGE (f:real->real) u``, ``IMAGE (f:real->real) v``] THEN
23657  ASM_SIMP_TAC real_ss [] THEN CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
23658  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SET_TAC[]
23659QED
23660
23661(* ------------------------------------------------------------------------- *)
23662(* F_sigma and G_delta sets.                                                 *)
23663(* ------------------------------------------------------------------------- *)
23664
23665Overload gdelta = “gdelta_in euclidean”
23666Overload fsigma = “fsigma_in euclidean”
23667
23668Theorem gdelta :
23669    !s. gdelta (s:real->bool) <=>
23670        ?g. COUNTABLE g /\ (!u. u IN g ==> open u) /\ (BIGINTER g = s)
23671Proof
23672    rw [gdelta_in, INTERSECTION_OF, euclidean_open_def, SUBSET_DEF, IN_APP,
23673        TOPSPACE_EUCLIDEAN, RELATIVE_TO_UNIV]
23674QED
23675
23676Theorem fsigma :
23677    !s. fsigma (s:real->bool) <=>
23678        ?g. COUNTABLE g /\ (!c. c IN g ==> closed c) /\ (BIGUNION g = s)
23679Proof
23680    rw [fsigma_in, UNION_OF, euclidean_closed_def, SUBSET_DEF, IN_APP]
23681QED
23682
23683Theorem GDELTA_COMPLEMENT :
23684   !s. gdelta(univ(:real) DIFF s) <=> fsigma s
23685Proof
23686   rw [GDELTA_IN_FSIGMA_IN, TOPSPACE_EUCLIDEAN, COMPL_COMPL_applied]
23687QED
23688
23689Theorem METRIZABLE_SPACE_EUCLIDEAN :
23690   metrizable_space euclidean
23691Proof
23692   REWRITE_TAC[euclidean_def, METRIZABLE_SPACE_MTOPOLOGY]
23693QED
23694
23695Theorem CLOSED_AS_GDELTA :
23696   !s:real->bool. closed s ==> gdelta s
23697Proof
23698    RW_TAC std_ss [euclidean_closed_def]
23699 >> MATCH_MP_TAC CLOSED_IMP_GDELTA_IN
23700 >> ASM_REWRITE_TAC [METRIZABLE_SPACE_EUCLIDEAN]
23701QED
23702
23703(* ------------------------------------------------------------------------- *)
23704(* Local compactness.                                                        *)
23705(* ------------------------------------------------------------------------- *)
23706
23707Theorem LOCALLY_COMPACT:
23708   !s:real->bool.
23709        locally compact s <=>
23710        !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
23711                             open_in (subtopology euclidean s) u /\
23712                             compact v
23713Proof
23714  GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
23715   [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN FIRST_X_ASSUM
23716     (MP_TAC o SPECL [``s INTER ball(x:real,&1)``, ``x:real``]) THEN
23717    ASM_SIMP_TAC real_ss [OPEN_IN_OPEN_INTER, OPEN_BALL] THEN
23718    ASM_REWRITE_TAC[IN_INTER, CENTRE_IN_BALL, REAL_LT_01] THEN
23719    MESON_TAC[SUBSET_INTER],
23720    MAP_EVERY X_GEN_TAC [``w:real->bool``, ``x:real``] THEN
23721    REWRITE_TAC[CONJ_EQ_IMP] THEN GEN_REWR_TAC LAND_CONV [OPEN_IN_OPEN] THEN
23722    DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
23723    ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
23724    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
23725    ASM_SIMP_TAC real_ss [LEFT_IMP_EXISTS_THM] THEN
23726    MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
23727    STRIP_TAC THEN
23728    UNDISCH_TAC ``open t`` THEN DISCH_TAC THEN
23729    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_CONTAINS_CBALL]) THEN
23730    DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
23731    DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
23732    EXISTS_TAC ``(s INTER ball(x:real,e)) INTER u`` THEN
23733    EXISTS_TAC ``cball(x:real,e) INTER v`` THEN
23734    ASM_SIMP_TAC real_ss [OPEN_IN_INTER, OPEN_IN_OPEN_INTER, OPEN_BALL, CENTRE_IN_BALL,
23735                 COMPACT_INTER, COMPACT_CBALL, IN_INTER] THEN
23736    MP_TAC(ISPECL [``x:real``, ``e:real``] BALL_SUBSET_CBALL) THEN
23737    ASM_SET_TAC[]]
23738QED
23739
23740Theorem LOCALLY_COMPACT_ALT:
23741   !s:real->bool.
23742        locally compact s <=>
23743        !x. x IN s
23744            ==> ?u. x IN u /\
23745                    open_in (subtopology euclidean s) u /\
23746                    compact(closure u) /\ closure u SUBSET s
23747Proof
23748  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN EQ_TAC THEN
23749  DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
23750  FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
23751  DISCH_THEN (X_CHOOSE_TAC ``u:real->bool``) THEN EXISTS_TAC ``u:real->bool`` THEN
23752  POP_ASSUM MP_TAC THEN
23753  METIS_TAC[CLOSURE_SUBSET, SUBSET_TRANS, CLOSURE_MINIMAL,
23754            COMPACT_CLOSURE, BOUNDED_SUBSET, COMPACT_EQ_BOUNDED_CLOSED]
23755QED
23756
23757Theorem LOCALLY_COMPACT_INTER_CBALL:
23758   !s:real->bool.
23759        locally compact s <=>
23760        !x. x IN s ==> ?e. &0 < e /\ closed(cball(x,e) INTER s)
23761Proof
23762  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT, OPEN_IN_CONTAINS_CBALL] THEN
23763  EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``x:real``) THEN
23764  ASM_CASES_TAC ``(x:real) IN s`` THEN ASM_SIMP_TAC real_ss [LEFT_IMP_EXISTS_THM] THENL
23765  [ MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
23766    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
23767    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN
23768    ASM_REWRITE_TAC[] THEN
23769    SUBGOAL_THEN ``cball(x:real,e) INTER s = cball (x,e) INTER v``
23770    SUBST1_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
23771    ASM_SIMP_TAC real_ss [COMPACT_CBALL, COMPACT_INTER, COMPACT_IMP_CLOSED],
23772
23773    X_GEN_TAC ``e:real`` THEN STRIP_TAC THEN
23774    EXISTS_TAC ``ball(x:real,e) INTER s`` THEN
23775    EXISTS_TAC ``cball(x:real,e) INTER s`` THEN
23776    REWRITE_TAC[GSYM OPEN_IN_CONTAINS_CBALL] THEN
23777    ASM_SIMP_TAC real_ss [IN_INTER, CENTRE_IN_BALL, INTER_SUBSET] THEN
23778    ASM_SIMP_TAC real_ss [COMPACT_EQ_BOUNDED_CLOSED, BOUNDED_INTER, BOUNDED_CBALL] THEN
23779    ONCE_REWRITE_TAC[INTER_COMM] THEN
23780    SIMP_TAC real_ss [OPEN_IN_OPEN_INTER, OPEN_BALL] THEN
23781    REWRITE_TAC [SUBSET_DEF, IN_INTER] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
23782    METIS_TAC[SUBSET_DEF, BALL_SUBSET_CBALL]]
23783QED
23784
23785Theorem LOCALLY_COMPACT_INTER_CBALLS:
23786   !s:real->bool.
23787      locally compact s <=>
23788      !x. x IN s ==> ?e. &0 < e /\ !d. d <= e ==> closed(cball(x,d) INTER s)
23789Proof
23790  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL] THEN
23791  EQ_TAC THENL [ALL_TAC, METIS_TAC[REAL_LE_REFL]] THEN
23792  DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN POP_ASSUM (MP_TAC o SPEC ``x:real``) THEN
23793  ASM_CASES_TAC ``(x:real) IN s`` THEN ASM_REWRITE_TAC[] THEN
23794  STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN ASM_REWRITE_TAC[] THEN
23795  GEN_TAC THEN DISCH_TAC THEN
23796  SUBGOAL_THEN
23797   ``cball(x:real,d) INTER s = cball(x,d) INTER cball(x,e) INTER s``
23798  SUBST1_TAC THENL
23799  [ REWRITE_TAC[INTER_ASSOC, GSYM CBALL_MIN_INTER] THEN
23800    AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
23801    BINOP_TAC THEN REWRITE_TAC[min_def] THEN PROVE_TAC [],
23802    ASM_SIMP_TAC real_ss [GSYM INTER_ASSOC, CLOSED_INTER, CLOSED_CBALL] ]
23803QED
23804
23805Theorem LOCALLY_COMPACT_COMPACT:
23806   !s:real->bool.
23807        locally compact s <=>
23808        !k. k SUBSET s /\ compact k
23809            ==> ?u v. k SUBSET u /\
23810                      u SUBSET v /\
23811                      v SUBSET s /\
23812                      open_in (subtopology euclidean s) u /\
23813                      compact v
23814Proof
23815  GEN_TAC THEN GEN_REWR_TAC LAND_CONV [LOCALLY_COMPACT] THEN EQ_TAC THEN
23816  REPEAT STRIP_TAC THENL
23817   [ALL_TAC, METIS_TAC[SING_SUBSET, COMPACT_SING]] THEN
23818  UNDISCH_TAC ``!x. x IN s ==>
23819        ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
23820          open_in (subtopology euclidean s) u /\ compact v`` THEN DISCH_TAC THEN
23821  FIRST_X_ASSUM(MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
23822  SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
23823  MAP_EVERY X_GEN_TAC [``u:real->real->bool``, ``v:real->real->bool``] THEN
23824  DISCH_TAC THEN UNDISCH_TAC ``compact k`` THEN DISCH_TAC THEN
23825  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE
23826   [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
23827  DISCH_THEN(MP_TAC o SPEC ``IMAGE (\x:real. k INTER u x) k``) THEN
23828  ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, BIGUNION_IMAGE] THEN
23829  KNOW_TAC ``(!(x :real).
23830    x IN (k :real -> bool) ==>
23831    open_in (subtopology euclidean k)
23832      (k INTER (u :real -> real -> bool) x)) /\
23833    k SUBSET {y | ?(x :real). x IN k /\ y IN k INTER u x}`` THENL
23834   [CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
23835    REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
23836    EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
23837    MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN
23838    ASM_SET_TAC[],
23839    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
23840    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
23841    SIMP_TAC std_ss [EXISTS_FINITE_SUBSET_IMAGE, BIGUNION_IMAGE] THEN
23842    DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
23843    EXISTS_TAC ``BIGUNION(IMAGE (u:real->real->bool) t)`` THEN
23844    EXISTS_TAC ``BIGUNION(IMAGE (v:real->real->bool) t)`` THEN
23845    REPEAT CONJ_TAC THENL
23846     [ALL_TAC, ALL_TAC, ALL_TAC, MATCH_MP_TAC OPEN_IN_BIGUNION,
23847      MATCH_MP_TAC COMPACT_BIGUNION THEN ASM_SIMP_TAC std_ss [IMAGE_FINITE]] THEN
23848    ASM_SET_TAC[]]
23849QED
23850
23851Theorem LOCALLY_COMPACT_COMPACT_ALT:
23852   !s:real->bool.
23853        locally compact s <=>
23854        !k. k SUBSET s /\ compact k
23855            ==> ?u. k SUBSET u /\
23856                    open_in (subtopology euclidean s) u /\
23857                    compact(closure u) /\ closure u SUBSET s
23858Proof
23859  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN
23860  DISCH_TAC THEN X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
23861  FIRST_X_ASSUM(MP_TAC o SPEC ``k:real->bool``) THEN ASM_REWRITE_TAC[] THEN
23862  DISCH_THEN (X_CHOOSE_TAC ``u:real->bool``) THEN EXISTS_TAC ``u:real->bool`` THEN
23863  POP_ASSUM MP_TAC THEN
23864  METIS_TAC[CLOSURE_SUBSET, SUBSET_TRANS, CLOSURE_MINIMAL,
23865            COMPACT_CLOSURE, BOUNDED_SUBSET, COMPACT_EQ_BOUNDED_CLOSED]
23866QED
23867
23868Theorem LOCALLY_COMPACT_COMPACT_SUBOPEN:
23869   !s:real->bool.
23870        locally compact s <=>
23871        !k t. k SUBSET s /\ compact k /\ open t /\ k SUBSET t
23872              ==> ?u v. k SUBSET u /\ u SUBSET v /\ u SUBSET t /\ v SUBSET s /\
23873                        open_in (subtopology euclidean s) u /\
23874                        compact v
23875Proof
23876  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN
23877  EQ_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THENL
23878   [FIRST_X_ASSUM(MP_TAC o SPEC ``k:real->bool``) THEN
23879    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
23880    MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
23881    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
23882     [``u INTER t:real->bool``, ``closure(u INTER t:real->bool)``] THEN
23883    REWRITE_TAC[CLOSURE_SUBSET, INTER_SUBSET] THEN REPEAT CONJ_TAC THENL
23884     [ASM_SET_TAC[],
23885      MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC ``closure(u:real->bool)`` THEN
23886      SIMP_TAC std_ss [SUBSET_CLOSURE, INTER_SUBSET] THEN
23887      MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC ``v:real->bool`` THEN ASM_REWRITE_TAC[] THEN
23888      MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED],
23889      ASM_SIMP_TAC std_ss [OPEN_IN_INTER_OPEN],
23890      REWRITE_TAC[COMPACT_CLOSURE] THEN
23891      ASM_MESON_TAC[BOUNDED_SUBSET, INTER_SUBSET, SUBSET_TRANS,
23892                    COMPACT_IMP_BOUNDED]],
23893    FIRST_X_ASSUM(MP_TAC o SPECL [``k:real->bool``, ``univ(:real)``]) THEN
23894    ASM_REWRITE_TAC[OPEN_UNIV, SUBSET_UNIV]]
23895QED
23896
23897Theorem OPEN_IMP_LOCALLY_COMPACT:
23898   !s:real->bool. open s ==> locally compact s
23899Proof
23900  REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
23901  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
23902  UNDISCH_TAC ``open s`` THEN DISCH_TAC THEN FIRST_ASSUM
23903   (MP_TAC o REWRITE_RULE [OPEN_CONTAINS_CBALL]) THEN
23904  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
23905  DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
23906  MAP_EVERY EXISTS_TAC [``ball(x:real,e)``, ``cball(x:real,e)``] THEN
23907  ASM_REWRITE_TAC[BALL_SUBSET_CBALL, CENTRE_IN_BALL, COMPACT_CBALL] THEN
23908  MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN
23909  MATCH_MP_TAC SUBSET_TRANS THEN METIS_TAC [BALL_SUBSET_CBALL]
23910QED
23911
23912Theorem CLOSED_IMP_LOCALLY_COMPACT:
23913   !s:real->bool. closed s ==> locally compact s
23914Proof
23915  REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
23916  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
23917   [``s INTER ball(x:real,&1)``, ``s INTER cball(x:real,&1)``] THEN
23918  ASM_REWRITE_TAC[IN_INTER, CENTRE_IN_BALL, INTER_SUBSET, REAL_LT_01] THEN
23919  ASM_SIMP_TAC std_ss [OPEN_IN_OPEN_INTER, OPEN_BALL] THEN
23920  ASM_SIMP_TAC std_ss [CLOSED_INTER_COMPACT, COMPACT_CBALL] THEN
23921  MP_TAC(ISPECL [``x:real``, ``&1:real``] BALL_SUBSET_CBALL) THEN ASM_SET_TAC[]
23922QED
23923
23924Theorem IS_INTERVAL_IMP_LOCALLY_COMPACT:
23925   !s:real->bool. is_interval s ==> locally compact s
23926Proof
23927  REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
23928  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
23929  MP_TAC(ISPECL [``s:real->bool``, ``x:real``]
23930   INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
23931  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
23932  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``d:real``] THEN STRIP_TAC THEN
23933  MAP_EVERY EXISTS_TAC
23934   [``s INTER ball(x:real,d)``, ``interval[a:real,b]``] THEN
23935  ASM_SIMP_TAC std_ss [COMPACT_INTERVAL, OPEN_IN_OPEN_INTER, OPEN_BALL] THEN
23936  ASM_REWRITE_TAC[CENTRE_IN_BALL, IN_INTER] THEN ASM_SET_TAC[]
23937QED
23938
23939Theorem LOCALLY_COMPACT_UNIV:
23940   locally compact univ(:real)
23941Proof
23942  SIMP_TAC std_ss [OPEN_IMP_LOCALLY_COMPACT, OPEN_UNIV]
23943QED
23944
23945Theorem LOCALLY_COMPACT_INTER:
23946   !s t:real->bool.
23947        locally compact s /\ locally compact t
23948        ==> locally compact (s INTER t)
23949Proof
23950  MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]
23951QED
23952
23953Theorem LOCALLY_COMPACT_OPEN_IN:
23954   !s t:real->bool.
23955        open_in (subtopology euclidean s) t /\ locally compact s
23956        ==> locally compact t
23957Proof
23958  REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
23959  ASM_SIMP_TAC std_ss [LOCALLY_COMPACT_INTER, OPEN_IMP_LOCALLY_COMPACT]
23960QED
23961
23962Theorem LOCALLY_COMPACT_CLOSED_IN:
23963   !s t:real->bool.
23964        closed_in (subtopology euclidean s) t /\ locally compact s
23965        ==> locally compact t
23966Proof
23967  REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
23968  ASM_SIMP_TAC std_ss [LOCALLY_COMPACT_INTER, CLOSED_IMP_LOCALLY_COMPACT]
23969QED
23970
23971Theorem LOCALLY_COMPACT_DELETE:
23972   !s a:real. locally compact s ==> locally compact (s DELETE a)
23973Proof
23974  REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_COMPACT_OPEN_IN THEN
23975  EXISTS_TAC ``s:real->bool`` THEN
23976  ASM_SIMP_TAC std_ss [OPEN_IN_DELETE, OPEN_IN_REFL]
23977QED
23978
23979Theorem HOMEOMORPHIC_LOCAL_COMPACTNESS:
23980   !s t:real->bool.
23981        s homeomorphic t ==> (locally compact s <=> locally compact t)
23982Proof
23983  MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
23984  REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]
23985QED
23986
23987Theorem LOCALLY_COMPACT_TRANSLATION_EQ:
23988   !a:real s. locally compact (IMAGE (\x. a + x) s) <=>
23989                locally compact s
23990Proof
23991  MATCH_MP_TAC LOCALLY_TRANSLATION THEN
23992  REWRITE_TAC[COMPACT_TRANSLATION_EQ]
23993QED
23994
23995Theorem LOCALLY_CLOSED:
23996   !s:real->bool. locally closed s <=> locally compact s
23997Proof
23998  GEN_TAC THEN EQ_TAC THENL
23999   [ALL_TAC, MESON_TAC[LOCALLY_MONO, COMPACT_IMP_CLOSED]] THEN
24000  REWRITE_TAC[locally] THEN DISCH_TAC THEN
24001  MAP_EVERY X_GEN_TAC [``w:real->bool``, ``x:real``] THEN STRIP_TAC THEN
24002  FIRST_X_ASSUM(MP_TAC o SPECL [``w:real->bool``, ``x:real``]) THEN
24003  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
24004  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
24005  STRIP_TAC THEN
24006  EXISTS_TAC ``u INTER ball(x:real,&1)`` THEN
24007  EXISTS_TAC ``v INTER cball(x:real,&1)`` THEN
24008  ASM_SIMP_TAC std_ss [OPEN_IN_INTER_OPEN, OPEN_BALL] THEN
24009  ASM_SIMP_TAC std_ss [CLOSED_INTER_COMPACT, COMPACT_CBALL] THEN
24010  ASM_REWRITE_TAC[IN_INTER, CENTRE_IN_BALL, REAL_LT_01] THEN
24011  MP_TAC(ISPEC ``x:real`` BALL_SUBSET_CBALL) THEN ASM_SET_TAC[]
24012QED
24013
24014Theorem LOCALLY_COMPACT_OPEN_UNION:
24015   !s t:real->bool.
24016        locally compact s /\ locally compact t /\
24017        open_in (subtopology euclidean (s UNION t)) s /\
24018        open_in (subtopology euclidean (s UNION t)) t
24019        ==> locally compact (s UNION t)
24020Proof
24021  REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL, IN_UNION] THEN
24022  STRIP_TAC THEN X_GEN_TAC ``x:real`` THEN STRIP_TAC THENL
24023   [UNDISCH_TAC ``!x. x IN s ==> ?e. 0 < e /\ closed (cball (x,e) INTER s)`` THEN
24024    DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC ``x:real``) THEN
24025    UNDISCH_TAC ``open_in (subtopology euclidean (s UNION t)) s`` THEN DISCH_TAC THEN
24026    FIRST_ASSUM (MP_TAC o REWRITE_RULE [OPEN_IN_CONTAINS_CBALL]),
24027    UNDISCH_TAC ``!x. x IN t ==> ?e. 0 < e /\ closed (cball (x,e) INTER t)`` THEN
24028    DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC ``x:real``) THEN
24029    UNDISCH_TAC ``open_in (subtopology euclidean (s UNION t)) t`` THEN DISCH_TAC THEN
24030    FIRST_ASSUM (MP_TAC o REWRITE_RULE [OPEN_IN_CONTAINS_CBALL])] THEN
24031  DISCH_THEN(MP_TAC o SPEC ``x:real`` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
24032  UNDISCH_TAC ``!x. x IN s ==> ?e. 0 < e /\ closed (cball (x,e) INTER s)`` THEN
24033  DISCH_THEN (MP_TAC o SPEC ``x:real``) THEN
24034  UNDISCH_TAC `` !x. x IN t ==> ?e. 0 < e /\ closed (cball (x,e) INTER t)`` THEN
24035  DISCH_THEN (MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC [] THENL
24036  [DISCH_TAC THEN DISCH_THEN (X_CHOOSE_TAC ``e:real``),
24037   DISCH_THEN (X_CHOOSE_TAC ``e:real``) THEN DISCH_TAC] THEN
24038  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
24039  EXISTS_TAC ``min d e:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
24040  REWRITE_TAC[CBALL_MIN_INTER, INTER_ASSOC] THEN
24041  FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
24042   ``u INTER st SUBSET s ==> s SUBSET st ==> (u INTER st = u INTER s)``)) THEN
24043  REWRITE_TAC[SUBSET_UNION] THEN
24044  ONCE_REWRITE_TAC [SET_RULE ``a INTER b INTER c = b INTER (a INTER c)``] THEN
24045  DISCH_THEN SUBST1_TAC THEN
24046  ONCE_REWRITE_TAC [SET_RULE ``a INTER (b INTER c) = b INTER (a INTER c)``] THEN
24047  METIS_TAC[CLOSED_INTER, CLOSED_CBALL, INTER_ACI]
24048QED
24049
24050Theorem LOCALLY_COMPACT_CLOSED_UNION:
24051   !s t:real->bool.
24052        locally compact s /\ locally compact t /\
24053        closed_in (subtopology euclidean (s UNION t)) s /\
24054        closed_in (subtopology euclidean (s UNION t)) t
24055        ==> locally compact (s UNION t)
24056Proof
24057  REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL, IN_UNION] THEN
24058  STRIP_TAC THEN X_GEN_TAC ``x:real`` THEN
24059  DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (TAUT
24060   `p \/ q ==> p /\ q \/ p /\ ~q \/ q /\ ~p`))
24061  THENL
24062   [FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN
24063    FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN
24064    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
24065    X_GEN_TAC ``d:real`` THEN STRIP_TAC THEN
24066    X_GEN_TAC ``e:real`` THEN STRIP_TAC THEN
24067    EXISTS_TAC ``min d e:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
24068    SIMP_TAC std_ss [SET_RULE ``u INTER (s UNION t) = u INTER s UNION u INTER t``] THEN
24069    MATCH_MP_TAC CLOSED_UNION THEN REWRITE_TAC[CBALL_MIN_INTER] THEN CONJ_TAC THENL
24070    [ONCE_REWRITE_TAC [SET_RULE ``a INTER b INTER c = b INTER (a INTER c)``],
24071     REWRITE_TAC [GSYM INTER_ASSOC]] THEN
24072    METIS_TAC[CLOSED_CBALL, CLOSED_INTER, INTER_ACI],
24073    UNDISCH_TAC ``!x. x IN s ==> ?e. 0 < e /\ closed (cball (x,e) INTER s)`` THEN
24074    DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
24075    DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
24076    UNDISCH_TAC ``closed_in (subtopology euclidean (s UNION t)) t`` THEN DISCH_TAC THEN
24077    FIRST_X_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE [closed_in]),
24078    FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
24079    DISCH_THEN(X_CHOOSE_THEN ``e:real`` STRIP_ASSUME_TAC) THEN
24080    UNDISCH_TAC ``closed_in (subtopology euclidean (s UNION t)) s`` THEN DISCH_TAC THEN
24081    FIRST_X_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE [closed_in])] THEN
24082  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_IN_CONTAINS_CBALL]) THEN
24083  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY, IN_DIFF, IN_UNION] THEN
24084  DISCH_THEN(MP_TAC o SPEC ``x:real`` o CONJUNCT2) THEN ASM_SIMP_TAC std_ss [] THEN
24085  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
24086  EXISTS_TAC ``min d e:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THENL
24087   [SUBGOAL_THEN ``cball (x:real,min d e) INTER (s UNION t) =
24088                  cball(x,d) INTER cball (x,e) INTER s`` SUBST1_TAC
24089    THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM_SET_TAC[], ALL_TAC],
24090    SUBGOAL_THEN ``cball (x:real,min d e) INTER (s UNION t) =
24091                  cball(x,d) INTER cball (x,e) INTER t`` SUBST1_TAC
24092    THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM_SET_TAC[], ALL_TAC]] THEN
24093  ASM_MESON_TAC[GSYM INTER_ASSOC, CLOSED_INTER, CLOSED_CBALL]
24094QED
24095
24096Theorem OPEN_IN_LOCALLY_COMPACT:
24097   !s t:real->bool.
24098        locally compact s
24099        ==> (open_in (subtopology euclidean s) t <=>
24100             t SUBSET s /\
24101             !k. compact k /\ k SUBSET s
24102                 ==> open_in (subtopology euclidean k) (k INTER t))
24103Proof
24104  REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
24105   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET],
24106    UNDISCH_TAC ``open_in (subtopology euclidean s) t`` THEN DISCH_TAC THEN
24107    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [OPEN_IN_OPEN]) THEN
24108    REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN (X_CHOOSE_TAC ``t':real->bool``) THEN
24109    EXISTS_TAC ``t':real->bool`` THEN ASM_SET_TAC[],
24110    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
24111    X_GEN_TAC ``a:real`` THEN DISCH_TAC THEN
24112    UNDISCH_TAC ``locally compact s`` THEN DISCH_TAC THEN
24113    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LOCALLY_COMPACT]) THEN
24114    DISCH_THEN(MP_TAC o SPEC ``a:real``) THEN
24115    KNOW_TAC ``a IN s:real->bool`` THENL
24116    [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
24117     SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM]] THEN
24118    MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
24119    STRIP_TAC THEN EXISTS_TAC ``t INTER u:real->bool`` THEN
24120    ASM_REWRITE_TAC[IN_INTER, INTER_SUBSET] THEN
24121    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC ``u:real->bool`` THEN
24122    ASM_REWRITE_TAC[] THEN
24123    FIRST_X_ASSUM(MP_TAC o SPEC ``closure u:real->bool``) THEN
24124    KNOW_TAC ``compact (closure u) /\ closure u SUBSET s`` THENL
24125     [SUBGOAL_THEN ``(closure u:real->bool) SUBSET v`` MP_TAC THENL
24126       [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED],
24127        REWRITE_TAC[COMPACT_CLOSURE] THEN
24128        ASM_MESON_TAC[SUBSET_TRANS, BOUNDED_SUBSET, COMPACT_IMP_BOUNDED]],
24129      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
24130      REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN (X_CHOOSE_TAC ``t':real->bool``) THEN
24131      EXISTS_TAC ``t':real->bool`` THEN ASM_REWRITE_TAC [] THEN
24132      MP_TAC(ISPEC ``u:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[]]]
24133QED
24134
24135Theorem LOCALLY_COMPACT_PROPER_IMAGE_EQ:
24136   !f:real->real s.
24137        f continuous_on s /\
24138        (!k. k SUBSET (IMAGE f s) /\ compact k
24139             ==> compact {x | x IN s /\ f x IN k})
24140        ==> (locally compact s <=> locally compact (IMAGE f s))
24141Proof
24142  REPEAT STRIP_TAC THEN
24143  MP_TAC(ISPECL [``f:real->real``, ``s:real->bool``,
24144                 ``IMAGE (f:real->real) s``] PROPER_MAP) THEN
24145  ASM_REWRITE_TAC[SUBSET_REFL] THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
24146   [REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC ``y:real`` THEN
24147    DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC ``y:real``) THEN
24148    ASM_REWRITE_TAC[] THEN UNDISCH_TAC ``locally compact s`` THEN DISCH_TAC THEN
24149    FIRST_ASSUM(MP_TAC o REWRITE_RULE [LOCALLY_COMPACT_COMPACT_ALT]) THEN
24150    DISCH_THEN(MP_TAC o SPEC ``{x | x IN s /\ ((f:real->real) x = y)}``) THEN
24151    ONCE_REWRITE_TAC [METIS [] ``(f x = y) = (\x. (f x = y)) x``] THEN
24152    ASM_SIMP_TAC std_ss [SUBSET_RESTRICT] THEN
24153    DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
24154    SUBGOAL_THEN
24155     ``?v. open_in (subtopology euclidean (IMAGE f s)) v /\
24156          y IN v /\
24157          {x | x IN s /\ (f:real->real) x IN v} SUBSET u``
24158    MP_TAC THENL
24159     [GEN_REWR_TAC (BINDER_CONV o RAND_CONV o LAND_CONV)
24160       [GSYM SING_SUBSET] THEN
24161      MATCH_MP_TAC CLOSED_MAP_OPEN_SUPERSET_PREIMAGE THEN
24162      ASM_REWRITE_TAC[SING_SUBSET, IN_SING],
24163      DISCH_THEN (X_CHOOSE_TAC ``v:real->bool``) THEN EXISTS_TAC ``v:real->bool`` THEN
24164      POP_ASSUM MP_TAC THEN
24165      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
24166      SUBGOAL_THEN ``closure v SUBSET IMAGE (f:real->real) (closure u)``
24167      ASSUME_TAC THENL
24168       [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC ``closure(IMAGE (f:real->real) u)`` THEN
24169        CONJ_TAC THENL
24170         [MATCH_MP_TAC SUBSET_CLOSURE THEN
24171          REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
24172          ASM_SET_TAC[],
24173          MATCH_MP_TAC CLOSURE_MINIMAL THEN
24174          SIMP_TAC std_ss [CLOSURE_SUBSET, IMAGE_SUBSET] THEN
24175          MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
24176          MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
24177          ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]],
24178        CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
24179        REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED, CLOSED_CLOSURE] THEN
24180        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
24181          BOUNDED_SUBSET)) THEN
24182        MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
24183        MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
24184        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]],
24185    REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN
24186    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24187    UNDISCH_TAC ``locally compact (IMAGE (f :real -> real) (s :real -> bool))`` THEN
24188    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LOCALLY_COMPACT_ALT]) THEN
24189    DISCH_THEN(MP_TAC o SPEC ``(f:real->real) x``) THEN
24190    ASM_SIMP_TAC std_ss [FUN_IN_IMAGE] THEN
24191    DISCH_THEN(X_CHOOSE_THEN ``v:real->bool`` STRIP_ASSUME_TAC) THEN
24192    FIRST_X_ASSUM(MP_TAC o SPEC ``closure v:real->bool``) THEN
24193    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
24194    EXISTS_TAC ``{x | x IN s /\ (f:real->real) x IN v}`` THEN
24195    ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN CONJ_TAC THENL
24196     [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
24197      ASM_MESON_TAC[SUBSET_REFL],
24198      ALL_TAC] THEN
24199    SUBGOAL_THEN
24200     ``closure {x | x IN s /\ f x IN v} SUBSET
24201       {x | x IN s /\ (f:real->real) x IN closure v}``
24202    ASSUME_TAC THENL
24203     [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED] THEN
24204      MP_TAC(ISPEC ``v:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[],
24205      CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
24206      SIMP_TAC std_ss [COMPACT_EQ_BOUNDED_CLOSED, CLOSED_CLOSURE] THEN
24207      METIS_TAC[COMPACT_IMP_BOUNDED, BOUNDED_SUBSET]]]
24208QED
24209
24210Theorem LOCALLY_COMPACT_PROPER_IMAGE:
24211   !f:real->real s.
24212        f continuous_on s /\
24213        (!k. k SUBSET (IMAGE f s) /\ compact k
24214             ==> compact {x | x IN s /\ f x IN k}) /\
24215        locally compact s
24216        ==> locally compact (IMAGE f s)
24217Proof
24218  METIS_TAC[LOCALLY_COMPACT_PROPER_IMAGE_EQ]
24219QED
24220
24221Theorem MUMFORD_LEMMA:
24222   !f:real->real s t y.
24223        f continuous_on s /\ IMAGE f s SUBSET t /\ locally compact s /\
24224        y IN t /\ compact {x | x IN s /\ (f x = y)}
24225        ==> ?u v. open_in (subtopology euclidean s) u /\
24226                  open_in (subtopology euclidean t) v /\
24227                  {x | x IN s /\ (f x = y)} SUBSET u /\ y IN v /\
24228                  IMAGE f u SUBSET v /\
24229                  (!k. k SUBSET v /\ compact k
24230                       ==> compact {x | x IN u /\ f x IN k})
24231Proof
24232  REPEAT STRIP_TAC THEN
24233  FIRST_ASSUM(MP_TAC o SPEC ``{x | x IN s /\ ((f:real->real) x = y)}`` o
24234   REWRITE_RULE [LOCALLY_COMPACT_COMPACT]) THEN
24235  ASM_SIMP_TAC std_ss [SUBSET_RESTRICT, LEFT_IMP_EXISTS_THM] THEN
24236  MAP_EVERY X_GEN_TAC [``u:real->bool``, ``v:real->bool``] THEN
24237  STRIP_TAC THEN
24238  SUBGOAL_THEN ``(closure u:real->bool) SUBSET v`` ASSUME_TAC THENL
24239   [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED],
24240    ALL_TAC] THEN
24241  SUBGOAL_THEN ``compact(closure u:real->bool)`` ASSUME_TAC THENL
24242   [ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
24243    ASM_MESON_TAC[BOUNDED_SUBSET, COMPACT_IMP_BOUNDED],
24244    ALL_TAC] THEN
24245  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
24246  SUBGOAL_THEN
24247   ``!b. open_in (subtopology euclidean t) b /\ y IN b
24248        ==> u INTER {x | x IN s /\ (f:real->real) x IN b} PSUBSET
24249            closure u INTER {x | x IN s /\ (f:real->real) x IN b}``
24250  MP_TAC THENL
24251   [REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET_DEF] THEN
24252    SIMP_TAC std_ss [CLOSURE_SUBSET,
24253             SET_RULE ``s SUBSET t ==> s INTER u SUBSET t INTER u``] THEN
24254    MATCH_MP_TAC(MESON[] ``!P. ~P s /\ P t ==> ~(s = t)``) THEN
24255    EXISTS_TAC
24256     ``\a. !k. k SUBSET b /\ compact k
24257              ==> compact {x | x IN a /\ (f:real->real) x IN k}`` THEN
24258    SIMP_TAC std_ss [] THEN CONJ_TAC THENL
24259     [KNOW_TAC ``(open_in (subtopology euclidean s) (u INTER {x | x IN s /\ f x IN b})
24260                  ==> {x | x IN s /\ (f x = y)} SUBSET u INTER {x | x IN s /\ f x IN b}
24261                  ==> IMAGE f (u INTER {x | x IN s /\ f x IN b}) SUBSET b
24262                  ==> ~(!k. k SUBSET b /\ compact k
24263                  ==> compact
24264                    {x | x IN u INTER {x | x IN s /\ f x IN b} /\ f x IN k}))
24265                  ==> ~(!k. k SUBSET b /\ compact k
24266                     ==> compact
24267                     {x | x IN u INTER {x | x IN s /\ f x IN b} /\ f x IN k})`` THENL
24268       [ALL_TAC, METIS_TAC []] THEN
24269       KNOW_TAC ``open_in (subtopology euclidean s)
24270                  (u INTER {x | x IN s /\ (f:real->real) x IN b})`` THENL
24271       [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_SIMP_TAC std_ss [] THEN
24272        MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_SET_TAC[],
24273        ASM_SET_TAC[]],
24274      X_GEN_TAC ``k:real->bool`` THEN STRIP_TAC THEN
24275      SUBGOAL_THEN
24276       ``{x | x IN closure u INTER {x | x IN s /\ f x IN b} /\ f x IN k} =
24277        v INTER {x | x IN closure u /\ (f:real->real) x IN k}``
24278      SUBST1_TAC THENL [ASM_SET_TAC[], MATCH_MP_TAC COMPACT_INTER_CLOSED] THEN
24279      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
24280      ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED, CLOSED_CLOSURE] THEN
24281      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET, SUBSET_TRANS]],
24282    DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC
24283     ``t INTER ball(y:real,inv(&n + &1))``) THEN
24284    SIMP_TAC std_ss [OPEN_IN_OPEN_INTER, OPEN_BALL, IN_INTER, CENTRE_IN_BALL] THEN
24285    ASM_REWRITE_TAC[REAL_LT_INV_EQ,
24286     METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
24287    KNOW_TAC ``~(!n. ?x. x IN closure u /\
24288           ~(x IN u) /\
24289           x IN {x | x IN s /\ f x IN t /\ f x IN ball (y,inv (&n + &1))})`` THENL
24290    [ALL_TAC,
24291     METIS_TAC [CLOSURE_SUBSET, REAL_OF_NUM_ADD, SET_RULE
24292     ``u SUBSET u'
24293      ==> (u INTER t PSUBSET u' INTER t <=>
24294           ?x. x IN u' /\ ~(x IN u) /\ x IN t)``]] THEN
24295    KNOW_TAC ``~(?x. (!n. x n IN closure u) /\
24296       (!n. ~(x n IN u)) /\
24297       (!n. x n IN s) /\
24298       (!n. f (x n) IN t) /\
24299       (!n. dist (y,f (x n)) < inv (&n + &1)))`` THENL
24300    [ALL_TAC,
24301     SIMP_TAC std_ss [SKOLEM_THM, GSPECIFICATION, IN_BALL, FORALL_AND_THM] THEN
24302     METIS_TAC [SKOLEM_THM]] THEN
24303    DISCH_THEN(X_CHOOSE_THEN ``x:num->real`` STRIP_ASSUME_TAC) THEN
24304    MP_TAC(ISPEC ``closure u:real->bool`` compact) THEN
24305    ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC ``x:num->real``) THEN
24306    ASM_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN
24307    MAP_EVERY X_GEN_TAC [``l:real``, ``r:num->num``] THEN
24308    CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
24309    SUBGOAL_THEN ``(f:real->real) l = y`` ASSUME_TAC THENL
24310     [MATCH_MP_TAC(ISPEC ``sequentially`` LIM_UNIQUE) THEN
24311      EXISTS_TAC ``(f:real->real) o x o (r:num->num)`` THEN
24312      ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
24313       [SUBGOAL_THEN ``(f:real->real) continuous_on closure u`` MP_TAC THENL
24314         [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET, SUBSET_TRANS], ALL_TAC] THEN
24315        REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN
24316        DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [o_THM],
24317        REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
24318        ASM_SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_THM] THEN
24319        CONJ_TAC THENL [METIS_TAC [], ALL_TAC] THEN
24320        X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
24321        MP_TAC(SPEC ``e:real`` REAL_ARCH_INV) THEN
24322        ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN
24323        EXISTS_TAC ``N:num`` THEN X_GEN_TAC ``n:num`` THEN
24324        DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
24325        MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC ``inv(&n + &1:real)`` THEN
24326        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
24327        EXISTS_TAC ``inv(&N:real)`` THEN ASM_REWRITE_TAC[] THEN
24328        MATCH_MP_TAC REAL_LT_INV2 THEN
24329        ASM_SIMP_TAC arith_ss [REAL_OF_NUM_ADD, REAL_LT]],
24330      UNDISCH_TAC ``open_in (subtopology euclidean s) u`` THEN DISCH_TAC THEN
24331      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [open_in]) THEN
24332      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``l:real``)) THEN
24333      SIMP_TAC std_ss [NOT_IMP, NOT_EXISTS_THM] THEN
24334      CONJ_TAC THENL [ASM_SET_TAC[], X_GEN_TAC ``e:real`` THEN
24335      CCONTR_TAC THEN FULL_SIMP_TAC std_ss []] THEN
24336      UNDISCH_TAC ``(((x :num -> real) o (r :num -> num) --> (l :real))
24337          sequentially :bool)`` THEN DISCH_TAC THEN
24338      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
24339      DISCH_THEN(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
24340      DISCH_THEN(X_CHOOSE_THEN ``n:num`` (MP_TAC o SPEC ``n:num``)) THEN
24341      ASM_SIMP_TAC std_ss [LESS_EQ_REFL, o_THM] THEN ASM_SET_TAC[]]]
24342QED
24343
24344(* ------------------------------------------------------------------------- *)
24345(* Locally compact sets are closed in an open set and are homeomorphic       *)
24346(* to an absolutely closed set if we have one more dimension to play with.   *)
24347(* ------------------------------------------------------------------------- *)
24348
24349Theorem LOCALLY_COMPACT_OPEN_INTER_CLOSURE:
24350   !s:real->bool. locally compact s ==> ?t. open t /\ (s = t INTER closure s)
24351Proof
24352  GEN_TAC THEN SIMP_TAC std_ss [LOCALLY_COMPACT, OPEN_IN_OPEN, CLOSED_IN_CLOSED] THEN
24353  SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN
24354  ONCE_REWRITE_TAC [METIS [] ``(x IN s INTER t /\ s INTER t SUBSET v /\
24355                                v SUBSET s /\ open t /\ compact v) =
24356                         (\v t. x IN s INTER t /\ s INTER t SUBSET v /\
24357                                v SUBSET s /\ open t /\ compact v) v t``] THEN
24358  REWRITE_TAC[GSYM CONJ_ASSOC, TAUT `p /\ (x = y) /\ q <=> (x = y) /\ p /\ q`] THEN
24359  ONCE_REWRITE_TAC[MESON[] ``(?v t. P v t) <=> (?t v. P v t)``] THEN
24360  DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
24361  SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
24362  MAP_EVERY X_GEN_TAC [``u:real->real->bool``, ``v:real->real->bool``] THEN
24363  DISCH_TAC THEN EXISTS_TAC ``BIGUNION (IMAGE (u:real->real->bool) s)`` THEN
24364  ASM_SIMP_TAC std_ss [CLOSED_CLOSURE, OPEN_BIGUNION, FORALL_IN_IMAGE] THEN
24365  REWRITE_TAC[INTER_BIGUNION] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
24366   ``BIGUNION {v INTER s | v | v IN IMAGE (u:real->real->bool) s}`` THEN
24367  CONJ_TAC THENL
24368   [SIMP_TAC std_ss [BIGUNION_GSPEC, EXISTS_IN_IMAGE] THEN ASM_SET_TAC[], ALL_TAC] THEN
24369  AP_TERM_TAC THEN
24370  ONCE_REWRITE_TAC [METIS [] ``v INTER s = (\v. v INTER s:real->bool) v``] THEN
24371  MATCH_MP_TAC(SET_RULE ``(!x. x IN s ==> (f(g x) = f'(g x)))
24372    ==> ({f x | x IN IMAGE g s} = {f' x | x IN IMAGE g s})``) THEN
24373  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24374  SIMP_TAC std_ss [GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL
24375   [MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN ASM_SET_TAC[],
24376  REWRITE_TAC[SUBSET_INTER, INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
24377  EXISTS_TAC ``closure((u:real->real->bool) x INTER s)`` THEN
24378  ASM_SIMP_TAC std_ss [OPEN_INTER_CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
24379  EXISTS_TAC ``(v:real->real->bool) x`` THEN
24380  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
24381  ASM_SIMP_TAC std_ss [COMPACT_IMP_CLOSED] THEN ASM_SET_TAC[]]
24382QED
24383
24384Theorem LOCALLY_COMPACT_CLOSED_IN_OPEN:
24385   !s:real->bool.
24386    locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s
24387Proof
24388  GEN_TAC THEN
24389  DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
24390  STRIP_TAC THEN EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
24391  FIRST_X_ASSUM SUBST1_TAC THEN
24392  SIMP_TAC std_ss [CLOSED_IN_CLOSED_INTER, CLOSED_CLOSURE]
24393QED
24394
24395Theorem LOCALLY_COMPACT_CLOSED_INTER_OPEN:
24396   !s:real->bool.
24397        locally compact s <=> ?t u. closed t /\ open u /\ (s = t INTER u)
24398Proof
24399  MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT, OPEN_IMP_LOCALLY_COMPACT,
24400            LOCALLY_COMPACT_INTER, INTER_COMM, CLOSED_CLOSURE,
24401            LOCALLY_COMPACT_OPEN_INTER_CLOSURE]
24402QED
24403
24404(* ------------------------------------------------------------------------- *)
24405(* Forms of the Baire propery of dense sets.                                 *)
24406(* ------------------------------------------------------------------------- *)
24407
24408Theorem BAIRE:
24409   !g s:real->bool.
24410        locally compact s /\ COUNTABLE g /\
24411        (!t. t IN g
24412             ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t)
24413        ==> s SUBSET closure(BIGINTER g)
24414Proof
24415  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``g:(real->bool)->bool = {}`` THEN
24416  ASM_REWRITE_TAC[BIGINTER_EMPTY, CLOSURE_UNIV, SUBSET_UNIV] THEN
24417  MP_TAC(ISPEC ``g:(real->bool)->bool`` COUNTABLE_AS_IMAGE) THEN
24418  ASM_REWRITE_TAC[] THEN
24419  MAP_EVERY (C UNDISCH_THEN (K ALL_TAC))
24420   [``COUNTABLE(g:(real->bool)->bool)``,
24421    ``~(g:(real->bool)->bool = {})``] THEN
24422  DISCH_THEN(X_CHOOSE_THEN ``g:num->real->bool`` SUBST_ALL_TAC) THEN
24423  RULE_ASSUM_TAC(SIMP_RULE std_ss [FORALL_IN_IMAGE, IN_UNIV]) THEN
24424  REWRITE_TAC[SUBSET_DEF, CLOSURE_NONEMPTY_OPEN_INTER] THEN
24425  X_GEN_TAC ``a:real`` THEN DISCH_TAC THEN
24426  X_GEN_TAC ``v:real->bool`` THEN STRIP_TAC THEN
24427  MP_TAC(ISPECL
24428   [``\n:num u:real->bool.
24429        open_in (subtopology euclidean s) u /\ ~(u = {}) /\ u SUBSET v``,
24430    ``\n:num u v:real->bool.
24431       ?c. compact c /\ v SUBSET c /\ c SUBSET u /\ c SUBSET (g n)``]
24432   DEPENDENT_CHOICE) THEN
24433  SIMP_TAC std_ss [] THEN
24434  KNOW_TAC ``(?(a :real -> bool).
24435    open_in (subtopology euclidean (s :real -> bool)) a /\
24436    a <> ({} :real -> bool) /\ a SUBSET (v :real -> bool)) /\
24437 (!(n :num) (x :real -> bool).
24438    open_in (subtopology euclidean s) x /\ x <> ({} :real -> bool) /\
24439    x SUBSET v ==>
24440    ?(y :real -> bool).
24441      (open_in (subtopology euclidean s) y /\ y <> ({} :real -> bool) /\
24442       y SUBSET v) /\
24443      ?(c :real -> bool).
24444        compact c /\ y SUBSET c /\ c SUBSET x /\
24445        c SUBSET (g :num -> real -> bool) n)`` THENL
24446   [CONJ_TAC THENL
24447     [EXISTS_TAC ``s INTER v:real->bool`` THEN
24448      ASM_SIMP_TAC std_ss [OPEN_IN_OPEN_INTER] THEN ASM_SET_TAC[],
24449      ALL_TAC] THEN
24450    MAP_EVERY X_GEN_TAC [``n:num``, ``w:real->bool``] THEN STRIP_TAC THEN
24451    FIRST_X_ASSUM(STRIP_ASSUME_TAC o SPEC ``n:num``) THEN
24452    SUBGOAL_THEN ``?b:real. b IN w /\ b IN g(n:num)``
24453    STRIP_ASSUME_TAC THENL
24454     [UNDISCH_TAC ``open_in (subtopology euclidean s) (w:real->bool)`` THEN
24455      SIMP_TAC std_ss [OPEN_IN_OPEN, LEFT_IMP_EXISTS_THM] THEN
24456      X_GEN_TAC ``t:real->bool`` THEN
24457      STRIP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN
24458      UNDISCH_TAC ``s SUBSET closure((g:num->real->bool) n)`` THEN
24459      REWRITE_TAC[SUBSET_DEF, CLOSURE_NONEMPTY_OPEN_INTER] THEN
24460      FIRST_X_ASSUM(X_CHOOSE_TAC ``x:real`` o
24461        REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
24462      DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
24463      KNOW_TAC ``x:real IN s`` THENL [ASM_SET_TAC[], DISCH_TAC THEN
24464       ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
24465      DISCH_THEN(MP_TAC o SPEC ``t:real->bool``) THEN
24466      KNOW_TAC ``x:real IN t /\ open t`` THENL
24467      [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
24468      FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[],
24469      UNDISCH_TAC ``locally compact s`` THEN DISCH_TAC THEN
24470      FIRST_ASSUM(MP_TAC o REWRITE_RULE [locally]) THEN
24471      DISCH_THEN(MP_TAC o SPECL
24472       [``w INTER (g:num->real->bool) n``, ``b:real``]) THEN
24473      ASM_SIMP_TAC std_ss [OPEN_IN_INTER, OPEN_IN_REFL, IN_INTER] THEN
24474      SIMP_TAC std_ss [GSYM RIGHT_EXISTS_AND_THM] THEN
24475      STRIP_TAC THEN MAP_EVERY EXISTS_TAC [``u:real->bool``,``v':real->bool``] THEN
24476      ASM_SET_TAC[]],
24477    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
24478    SIMP_TAC std_ss [SKOLEM_THM, GSYM RIGHT_EXISTS_AND_THM, LEFT_IMP_EXISTS_THM] THEN
24479    MAP_EVERY X_GEN_TAC [``u:num->real->bool``, ``c:num->real->bool``] THEN
24480    SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC THEN
24481    MATCH_MP_TAC(SET_RULE ``!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})``) THEN
24482    EXISTS_TAC ``BIGINTER {c n:real->bool | n IN univ(:num)}`` THEN
24483    CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
24484    MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN
24485    CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
24486    ONCE_REWRITE_TAC [METIS [] ``(c n SUBSET c m) = (\m n. c n SUBSET c m) m n``] THEN
24487    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SET_TAC[]]
24488QED
24489
24490Theorem BAIRE_ALT:
24491   !g s:real->bool.
24492        locally compact s /\ ~(s = {}) /\ COUNTABLE g /\ (BIGUNION g = s)
24493        ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\
24494                  u SUBSET (closure t)
24495Proof
24496  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
24497  [``IMAGE (\t:real->bool. s DIFF closure t) g``, ``s:real->bool``] BAIRE) THEN
24498  ASM_SIMP_TAC std_ss [COUNTABLE_IMAGE, FORALL_IN_IMAGE] THEN
24499  MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN
24500  CONJ_TAC THENL
24501   [MATCH_MP_TAC(SET_RULE
24502     ``~(s = {}) /\ ((t = {}) ==> (closure t = {})) /\ (t = {})
24503      ==> ~(s SUBSET closure t)``) THEN
24504    ASM_SIMP_TAC std_ss [CLOSURE_EMPTY] THEN
24505    MATCH_MP_TAC(SET_RULE ``i SUBSET s /\ (s DIFF i = s) ==> (i = {})``) THEN
24506    CONJ_TAC THENL [SIMP_TAC std_ss [BIGINTER_IMAGE] THEN ASM_SET_TAC[], ALL_TAC] THEN
24507    REWRITE_TAC[DIFF_BIGINTER2] THEN
24508    REWRITE_TAC[SET_RULE ``{f x | x IN IMAGE g s} = {f(g x) | x IN s}``] THEN
24509    SIMP_TAC std_ss [SET_RULE ``s DIFF (s DIFF t) = s INTER t``] THEN
24510    REWRITE_TAC[SET_RULE ``{s INTER closure t | t IN g} =
24511                          {s INTER t | t IN IMAGE closure g}``] THEN
24512    SIMP_TAC std_ss [GSYM INTER_BIGUNION, SET_RULE ``(s INTER t = s) <=> s SUBSET t``] THEN
24513    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
24514    GEN_REWR_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN
24515    MATCH_MP_TAC BIGUNION_MONO_IMAGE THEN SIMP_TAC std_ss [CLOSURE_SUBSET],
24516    SIMP_TAC std_ss [NOT_EXISTS_THM] THEN STRIP_TAC THEN
24517    X_GEN_TAC ``t:real->bool`` THEN REPEAT STRIP_TAC THENL
24518     [ONCE_REWRITE_TAC[SET_RULE ``s DIFF t = s DIFF (s INTER t)``] THEN
24519      MATCH_MP_TAC OPEN_IN_DIFF THEN
24520      ASM_SIMP_TAC std_ss [CLOSED_IN_CLOSED_INTER, CLOSED_CLOSURE, OPEN_IN_REFL],
24521      REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24522      REWRITE_TAC[CLOSURE_APPROACHABLE] THEN
24523      X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
24524       [``t:real->bool``, ``s INTER ball(x:real,e)``]) THEN
24525      ASM_SIMP_TAC std_ss [OPEN_IN_OPEN_INTER, OPEN_BALL, SUBSET_DEF, IN_INTER, IN_BALL,
24526                   IN_DIFF] THEN
24527      METIS_TAC[DIST_SYM]]]
24528QED
24529
24530Theorem NOWHERE_DENSE_COUNTABLE_BIGUNION_CLOSED:
24531   !g:(real->bool)->bool.
24532        COUNTABLE g /\ (!s. s IN g ==> closed s /\ (interior s = {}))
24533        ==> (interior(BIGUNION g) = {})
24534Proof
24535  REPEAT STRIP_TAC THEN
24536  MP_TAC(ISPECL [``{univ(:real) DIFF s | s IN g}``, ``univ(:real)``]
24537        BAIRE) THEN
24538  SIMP_TAC std_ss [LOCALLY_COMPACT_UNIV, GSYM OPEN_IN, SUBTOPOLOGY_UNIV] THEN
24539  ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, COUNTABLE_IMAGE, FORALL_IN_IMAGE] THEN
24540  ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, COUNTABLE_IMAGE, FORALL_IN_IMAGE] THEN
24541  ASM_SIMP_TAC std_ss [GSYM closed_def, SET_RULE
24542   ``UNIV SUBSET s <=> (UNIV DIFF s = {})``] THEN
24543  SIMP_TAC std_ss[GSYM INTERIOR_COMPLEMENT] THEN
24544  SIMP_TAC std_ss [IMAGE_DEF, GSYM BIGUNION_BIGINTER] THEN
24545  ASM_SIMP_TAC std_ss [SET_RULE ``UNIV DIFF (UNIV DIFF s) = s``]
24546QED
24547
24548Theorem NOWHERE_DENSE_COUNTABLE_BIGUNION:
24549   !g:(real->bool)->bool.
24550        COUNTABLE g /\ (!s. s IN g ==> (interior(closure s) = {}))
24551        ==> (interior(BIGUNION g) = {})
24552Proof
24553  REPEAT STRIP_TAC THEN
24554  MP_TAC(ISPEC ``IMAGE closure (g:(real->bool)->bool)``
24555        NOWHERE_DENSE_COUNTABLE_BIGUNION_CLOSED) THEN
24556  ASM_SIMP_TAC std_ss [COUNTABLE_IMAGE, FORALL_IN_IMAGE, CLOSED_CLOSURE] THEN
24557  MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> (t = {}) ==> (s = {})``) THEN
24558  MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC BIGUNION_MONO THEN
24559  SIMP_TAC std_ss [EXISTS_IN_IMAGE] THEN MESON_TAC[CLOSURE_SUBSET]
24560QED
24561
24562(* ------------------------------------------------------------------------- *)
24563(* Partitions of unity subordinate to locally finite open coverings.         *)
24564(* ------------------------------------------------------------------------- *)
24565
24566Theorem SUBORDINATE_PARTITION_OF_UNITY:
24567   !c s. s SUBSET BIGUNION c /\ (!u. u IN c ==> open u) /\
24568         (!x. x IN s
24569              ==> ?v. open v /\ x IN v /\
24570                      FINITE {u | u IN c /\ ~(u INTER v = {})})
24571         ==> ?f:(real->bool)->real->real.
24572                      (!u. u IN c
24573                           ==> f u continuous_on s /\
24574                               !x. x IN s ==> &0 <= f u x) /\
24575                      (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> (f u x = &0)) /\
24576                      (!x. x IN s ==> (sum c (\u. f u x) = &1)) /\
24577                      (!x. x IN s
24578                           ==> ?n. open n /\ x IN n /\
24579                                   FINITE {u | u IN c /\
24580                                           ~(!x. x IN n ==> (f u x = &0))})
24581Proof
24582  REPEAT STRIP_TAC THEN
24583  ASM_CASES_TAC ``?u:real->bool. u IN c /\ s SUBSET u`` THENL
24584   [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN
24585    EXISTS_TAC ``\v:real->bool x:real. if v = u then &1 else &0:real`` THEN
24586    SIMP_TAC arith_ss [COND_RAND, COND_RATOR, o_DEF, REAL_POS, REAL_OF_NUM_EQ,
24587                METIS [] ``(if p then q else T) <=> p ==> q``] THEN
24588    ASM_SIMP_TAC std_ss [CONTINUOUS_ON_CONST, COND_ID, SUM_DELTA] THEN
24589    CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
24590    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24591    EXISTS_TAC ``ball(x:real,&1)`` THEN
24592    REWRITE_TAC[OPEN_BALL, CENTRE_IN_BALL, REAL_LT_01] THEN
24593    MATCH_MP_TAC SUBSET_FINITE_I THEN EXISTS_TAC ``{u:real->bool}`` THEN
24594    SIMP_TAC std_ss [FINITE_SING, SUBSET_DEF, GSPECIFICATION, IN_SING] THEN
24595    X_GEN_TAC ``v:real->bool`` THEN
24596    ASM_CASES_TAC ``v:real->bool = u`` THEN ASM_REWRITE_TAC[],
24597    ALL_TAC] THEN
24598  EXISTS_TAC ``\u:real->bool x:real.
24599        if x IN s
24600        then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v))
24601        else &0`` THEN
24602  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE] THEN
24603  SIMP_TAC std_ss [SUM_POS_LE, SETDIST_POS_LE, REAL_LE_DIV] THEN
24604  SIMP_TAC std_ss [SETDIST_SING_IN_SET, IN_DIFF, real_div, REAL_MUL_LZERO] THEN
24605  SIMP_TAC std_ss [SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN
24606  MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL
24607   [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24608    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
24609    DISCH_THEN (X_CHOOSE_TAC ``n:real->bool``) THEN EXISTS_TAC ``n:real->bool`` THEN
24610    POP_ASSUM MP_TAC THEN
24611    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
24612    ASM_REWRITE_TAC[] THEN
24613    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_FINITE_I) THEN
24614    SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN X_GEN_TAC ``u:real->bool`` THEN
24615    ASM_CASES_TAC ``(u:real->bool) IN c`` THENL [ALL_TAC, METIS_TAC []] THEN
24616    ASM_REWRITE_TAC [] THEN ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN DISCH_TAC THEN
24617    FULL_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN X_GEN_TAC ``y:real`` THEN CCONTR_TAC THEN
24618    FULL_SIMP_TAC std_ss [] THEN POP_ASSUM MP_TAC THEN
24619    REWRITE_TAC[real_div, REAL_ENTIRE] THEN
24620    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
24621    ASM_CASES_TAC ``(y:real) IN u`` THEN
24622    ASM_SIMP_TAC std_ss [SETDIST_SING_IN_SET, IN_DIFF, REAL_MUL_LZERO] THEN
24623    ASM_SET_TAC[], ALL_TAC] THEN
24624  SUBGOAL_THEN
24625   ``!v x:real. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)``
24626  ASSUME_TAC THENL
24627   [REPEAT STRIP_TAC THEN
24628    SIMP_TAC std_ss [SETDIST_POS_LE, REAL_ARITH ``&0 < x <=> &0 <= x /\ ~(x = &0:real)``] THEN
24629    MP_TAC(ISPECL [``s:real->bool``, ``s DIFF v:real->bool``, ``x:real``]
24630        SETDIST_EQ_0_CLOSED_IN) THEN
24631    ONCE_REWRITE_TAC[SET_RULE ``s DIFF t = s INTER (UNIV DIFF t)``] THEN
24632    ASM_SIMP_TAC std_ss [CLOSED_IN_CLOSED_INTER, GSYM OPEN_CLOSED] THEN
24633    DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN
24634    ASM_REWRITE_TAC[IN_INTER, IN_DIFF, IN_UNION] THEN ASM_SET_TAC[],
24635    ALL_TAC] THEN
24636  SUBGOAL_THEN
24637   ``!x:real. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))``
24638  ASSUME_TAC THENL
24639   [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24640    ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN
24641    REWRITE_TAC[support, NEUTRAL_REAL_ADD] THEN
24642    MATCH_MP_TAC SUM_POS_LT THEN SIMP_TAC std_ss [SETDIST_POS_LE] THEN
24643    CONJ_TAC THENL
24644     [FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
24645      DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
24646      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
24647      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_FINITE_I) THEN
24648      SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN X_GEN_TAC ``u:real->bool`` THEN
24649      ASM_CASES_TAC ``(x:real) IN u`` THEN
24650      ASM_SIMP_TAC std_ss [SETDIST_SING_IN_SET, IN_DIFF] THEN ASM_SET_TAC[],
24651      UNDISCH_TAC `` s SUBSET BIGUNION c:real->bool`` THEN DISCH_TAC THEN
24652      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [SUBSET_DEF]) THEN
24653      DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN REWRITE_TAC[IN_BIGUNION] THEN
24654      ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN DISCH_THEN (X_CHOOSE_TAC ``t:real->bool``) THEN
24655      EXISTS_TAC ``t:real->bool`` THEN METIS_TAC[REAL_LT_IMP_NE]],
24656    ALL_TAC] THEN
24657  ASM_SIMP_TAC std_ss [REAL_LT_IMP_NE, REAL_DIV_REFL, o_DEF] THEN
24658  X_GEN_TAC ``u:real->bool`` THEN DISCH_TAC THEN
24659  MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
24660  EXISTS_TAC ``\x:real.
24661        setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v))`` THEN
24662  SIMP_TAC std_ss [] THEN REWRITE_TAC[real_div] THEN
24663  ONCE_REWRITE_TAC [METIS []
24664   ``(\x. setdist ({x},s DIFF u) *
24665   inv (sum c (\v. setdist ({x},s DIFF v)))) =
24666     (\x. (\x. setdist ({x},s DIFF u)) x *
24667   (\x. inv (sum c (\v. setdist ({x},s DIFF v)))) x)``] THEN
24668  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
24669  SIMP_TAC std_ss [CONTINUOUS_ON_SETDIST, o_DEF] THEN
24670  ONCE_REWRITE_TAC [METIS []
24671   ``(\x. inv (sum c (\v. setdist ({x},s DIFF v)))) =
24672     (\x. inv ((\x. sum c (\v. setdist ({x},s DIFF v))) x))``] THEN
24673  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
24674  ASM_SIMP_TAC std_ss [REAL_LT_IMP_NE, CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
24675  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
24676  FIRST_X_ASSUM(fn th =>
24677    MP_TAC(SPEC ``x:real`` th) THEN ASM_REWRITE_TAC[] THEN
24678    DISCH_THEN(X_CHOOSE_THEN ``n:real->bool`` STRIP_ASSUME_TAC)) THEN
24679  MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN
24680  MAP_EVERY EXISTS_TAC
24681   [``\x:real. sum {v | v IN c /\ ~(v INTER n = {})}
24682                         (\v. setdist({x},s DIFF v))``,
24683    ``s INTER n:real->bool``] THEN
24684  ASM_SIMP_TAC std_ss [IN_INTER, OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL
24685   [X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
24686    CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN
24687    ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN STRIP_TAC THENL
24688    [ASM_SET_TAC [], ALL_TAC] THEN X_GEN_TAC ``v:real->bool`` THEN
24689    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
24690    ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN DISCH_TAC THEN
24691    MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM_SET_TAC[],
24692    ONCE_REWRITE_TAC [METIS []
24693     ``(\x. sum {v | v IN c /\ v INTER n <> {}}
24694       (\v. setdist ({x},s DIFF v))) =
24695       (\x. sum {v | v IN c /\ v INTER n <> {}}
24696       (\v. (\v x. setdist ({x},s DIFF v)) v x))``] THEN
24697    MATCH_MP_TAC CONTINUOUS_SUM THEN
24698    ASM_SIMP_TAC std_ss [CONTINUOUS_AT_SETDIST, CONTINUOUS_AT_WITHIN]]
24699QED
24700
24701(* ------------------------------------------------------------------------- *)
24702(* Bounds on intervals where they exist (moved from integrationTheory)       *)
24703(* ------------------------------------------------------------------------- *)
24704
24705(* NOTE: HOL Light's original definitions:
24706
24707   `sup {a | ?x. x IN s /\ (x = a)}` = `sup s`
24708   `inf {a | ?x. x IN s /\ (x = a)}` = `inf s`
24709
24710   are not specified on {} but `sup {} = inf {}` can be proven due to the
24711   definition of `inf` in HOL Light. However in HOL4 this is not derivable.
24712   Now we explicitly define that the upper and lower bounds of {} are both 0.
24713   This change shouldn't cause anything wrong. -- Chun Tian, Oct 24, 2019.
24714 *)
24715Definition interval_upperbound :
24716    (interval_upperbound:(real->bool)->real) s =
24717       if s = {} then 0:real else sup s
24718End
24719
24720Definition interval_lowerbound :
24721    (interval_lowerbound:(real->bool)->real) s =
24722       if s = {} then 0:real else inf s
24723End
24724
24725Theorem INTERVAL_UPPERBOUND :
24726    !a b:real. a <= b ==> (interval_upperbound(interval[a,b]) = b)
24727Proof
24728    RW_TAC std_ss [interval_upperbound]
24729 >- (fs [EXTENSION, GSPECIFICATION, IN_INTERVAL] \\
24730     METIS_TAC [REAL_LE_REFL])
24731 >> MATCH_MP_TAC REAL_SUP_UNIQUE
24732 >> SIMP_TAC std_ss [GSPECIFICATION, IN_INTERVAL]
24733 >> ASM_MESON_TAC[REAL_LE_REFL]
24734QED
24735
24736Theorem OPEN_INTERVAL_UPPERBOUND :
24737    !a b:real. a < b ==> interval_upperbound(interval(a,b)) = b
24738Proof
24739    RW_TAC std_ss [interval_upperbound]
24740 >- METIS_TAC [INTERVAL_EQ_EMPTY, GSYM real_lte]
24741 >> MATCH_MP_TAC REAL_SUP_UNIQUE
24742 >> rw [GSPECIFICATION, IN_INTERVAL]
24743 >- (MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
24744 >> MP_TAC (Q.SPECL [‘max a b'’, ‘b’] REAL_MEAN)
24745 >> rw [REAL_MAX_LT]
24746 >> Q.EXISTS_TAC ‘z’ >> art []
24747QED
24748
24749Theorem INTERVAL_LOWERBOUND :
24750    !a b:real. a <= b ==> (interval_lowerbound(interval[a,b]) = a)
24751Proof
24752    RW_TAC std_ss [interval_lowerbound]
24753 >- (fs [EXTENSION, GSPECIFICATION, IN_INTERVAL] \\
24754     METIS_TAC [REAL_LE_REFL])
24755 >> MATCH_MP_TAC REAL_INF_UNIQUE
24756 >> SIMP_TAC std_ss [GSPECIFICATION, IN_INTERVAL]
24757 >> ASM_MESON_TAC [REAL_LE_REFL]
24758QED
24759
24760Theorem OPEN_INTERVAL_LOWERBOUND :
24761    !a b:real. a < b ==> interval_lowerbound(interval(a,b)) = a
24762Proof
24763    RW_TAC std_ss [interval_lowerbound]
24764 >- METIS_TAC [INTERVAL_EQ_EMPTY, GSYM real_lte]
24765 >> MATCH_MP_TAC REAL_INF_UNIQUE
24766 >> rw [GSPECIFICATION, IN_INTERVAL]
24767 >- (MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
24768 >> MP_TAC (Q.SPECL [‘a’, ‘min b b'’] REAL_MEAN)
24769 >> rw [REAL_LT_MIN]
24770 >> Q.EXISTS_TAC ‘z’ >> art []
24771QED
24772
24773Theorem INTERVAL_LOWERBOUND_NONEMPTY :
24774    !a b:real. ~(interval[a,b] = {}) ==>
24775               (interval_lowerbound(interval[a,b]) = a)
24776Proof
24777    SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_NE_EMPTY]
24778QED
24779
24780Theorem INTERVAL_UPPERBOUND_NONEMPTY :
24781    !a b:real. ~(interval[a,b] = {}) ==>
24782               (interval_upperbound(interval[a,b]) = b)
24783Proof
24784    SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_NE_EMPTY]
24785QED
24786
24787Theorem INTERVAL_BOUNDS_EMPTY[simp] :
24788    (interval_upperbound {} = 0) /\
24789    (interval_lowerbound {} = 0)
24790Proof
24791    rw [interval_upperbound, interval_lowerbound]
24792QED
24793
24794(* ------------------------------------------------------------------------- *)
24795(* Content (length) of an interval (moved from integrationTheory)            *)
24796(* ------------------------------------------------------------------------- *)
24797
24798Definition content[nocompute]:
24799  content(s:real->bool) =
24800    if s = {} then 0:real
24801              else (interval_upperbound s - interval_lowerbound s)
24802End
24803
24804Theorem CONTENT_CLOSED_INTERVAL:
24805   !a b:real. a <= b ==> (content(interval[a,b]) = b - a)
24806Proof
24807 REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC std_ss [interval] THEN
24808 KNOW_TAC ``{x | (a :real) <= x /\ x <= (b :real)} <> {}`` THENL
24809 [ONCE_REWRITE_TAC [GSYM MEMBER_NOT_EMPTY] THEN
24810  FULL_SIMP_TAC std_ss [GSPECIFICATION, REAL_LE_LT] THENL
24811  [KNOW_TAC ``(?(x :real). a < x /\ x < b)`` THENL
24812  [FULL_SIMP_TAC std_ss [REAL_MEAN], ALL_TAC] THEN STRIP_TAC THEN
24813  EXISTS_TAC ``x:real`` THEN ASM_REWRITE_TAC [],
24814  EXISTS_TAC ``a:real`` THEN ASM_REWRITE_TAC []],
24815  FULL_SIMP_TAC std_ss [content, INTERVAL_UPPERBOUND,
24816                                 INTERVAL_LOWERBOUND, GSYM interval]]
24817QED
24818
24819Theorem CONTENT_UNIT:
24820   content(interval[0,1]) = 1:real
24821Proof
24822  SIMP_TAC arith_ss [CONTENT_CLOSED_INTERVAL, REAL_LE_01, REAL_SUB_RZERO]
24823QED
24824
24825Theorem CONTENT_POS_LE:
24826   !a b:real. &0 <= content(interval[a,b])
24827Proof
24828  REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN
24829  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
24830  FULL_SIMP_TAC std_ss [INTERVAL_NE_EMPTY] THEN
24831  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND, REAL_SUB_LE]
24832QED
24833
24834Theorem CONTENT_POS_LT:
24835   !a b:real. a < b ==> &0 < content(interval[a,b])
24836Proof
24837  REPEAT STRIP_TAC THEN
24838  ASM_SIMP_TAC std_ss [CONTENT_CLOSED_INTERVAL, REAL_LT_IMP_LE] THEN
24839  ASM_SIMP_TAC std_ss [REAL_SUB_LT]
24840QED
24841
24842Theorem CONTENT_EQ_0_GEN:
24843   !s:real->bool. bounded s
24844     ==> ((content s = &0) <=> ?a. !x. x IN s ==> (x = a))
24845Proof
24846  REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN
24847  COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
24848  REWRITE_TAC [bounded_def] THEN DISCH_TAC THEN
24849  ASM_SIMP_TAC std_ss [interval_upperbound, interval_lowerbound,
24850  GSPEC_ID, REAL_SUB_0, REAL_SUP_EQ_INF] THEN EQ_TAC THENL
24851  [METIS_TAC [GSYM UNIQUE_MEMBER_SING],
24852   REWRITE_TAC [GSYM UNIQUE_MEMBER_SING] THEN KNOW_TAC ``?a:real. a IN s`` THENL
24853   [EXISTS_TAC ``CHOICE (s:real->bool)`` THEN
24854    METIS_TAC [CHOICE_DEF, GSYM SPECIFICATION], METIS_TAC []]]
24855QED
24856
24857Theorem CONTENT_EQ_0:
24858   !a b:real. (content(interval[a,b]) = &0) <=> b <= a
24859Proof
24860  REPEAT GEN_TAC THEN REWRITE_TAC[content, INTERVAL_EQ_EMPTY] THEN
24861  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
24862  [FULL_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_LT_IMP_LE],
24863   FULL_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT,
24864   INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND, REAL_SUB_0] THEN
24865   METIS_TAC [REAL_LE_LT, REAL_LE_ANTISYM]]
24866QED
24867
24868Theorem CONTENT_0_SUBSET_GEN:
24869   !s t:real->bool.
24870      s SUBSET t /\ bounded t /\ (content t = &0) ==> (content s = &0)
24871Proof
24872  REPEAT GEN_TAC THEN
24873  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
24874  SUBGOAL_THEN ``bounded(s:real->bool)`` ASSUME_TAC THENL
24875   [ASM_MESON_TAC[BOUNDED_SUBSET], ALL_TAC] THEN
24876  ASM_SIMP_TAC std_ss [CONTENT_EQ_0_GEN] THEN
24877  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SET_TAC[]
24878QED
24879
24880Theorem CONTENT_0_SUBSET:
24881   !s a b:real. s SUBSET interval[a,b] /\
24882        (content(interval[a,b]) = &0) ==> (content s = &0)
24883Proof
24884  MESON_TAC[CONTENT_0_SUBSET_GEN, BOUNDED_INTERVAL]
24885QED
24886
24887Theorem CONTENT_CLOSED_INTERVAL_CASES:
24888   !a b:real. content(interval[a,b]) =
24889              if a <= b then b - a else &0
24890Proof
24891  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
24892  ASM_SIMP_TAC std_ss [CONTENT_EQ_0, CONTENT_CLOSED_INTERVAL] THEN
24893  ASM_MESON_TAC[REAL_LE_TOTAL]
24894QED
24895
24896Theorem CONTENT_EQ_0_INTERIOR:
24897   !a b:real.
24898        (content(interval[a,b]) = &0) <=> (interior(interval[a,b]) = {})
24899Proof
24900  REWRITE_TAC[CONTENT_EQ_0, INTERIOR_CLOSED_INTERVAL, INTERVAL_EQ_EMPTY]
24901QED
24902
24903Theorem CONTENT_EQ_0_1:
24904   !a b:real.
24905        (content(interval[a,b]) = &0) <=> b <= a
24906Proof
24907  REWRITE_TAC [CONTENT_EQ_0]
24908QED
24909
24910Theorem CONTENT_POS_LT_EQ:
24911   !a b:real. &0 < content(interval[a,b]) <=> a < b
24912Proof
24913  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONTENT_POS_LT] THEN
24914  REWRITE_TAC[REAL_ARITH ``&0 < x:real <=> &0 <= x:real /\ ~(x = &0:real)``] THEN
24915  REWRITE_TAC[CONTENT_POS_LE, CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]
24916QED
24917
24918Theorem CONTENT_EMPTY:
24919   content {} = &0
24920Proof
24921  REWRITE_TAC[content]
24922QED
24923
24924Theorem CONTENT_SUBSET:
24925   !a b c d:real.
24926        interval[a,b] SUBSET interval[c,d]
24927        ==> content(interval[a,b]) <= content(interval[c,d])
24928Proof
24929  REPEAT STRIP_TAC THEN GEN_REWR_TAC LAND_CONV [content] THEN
24930  COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_POS_LE] THEN
24931  UNDISCH_TAC ``interval [(a,b)] SUBSET interval [(c,d)]`` THEN
24932  REWRITE_TAC [SUBSET_DEF] THEN
24933  RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
24934  REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(fn th =>
24935    MP_TAC(SPEC ``a:real`` th) THEN MP_TAC(SPEC ``b:real`` th)) THEN
24936  ASM_SIMP_TAC std_ss [REAL_LE_REFL, content] THEN REPEAT STRIP_TAC THEN
24937  ONCE_REWRITE_TAC[METIS [] ``(if b then c else d) = (if ~b then d else c)``] THEN
24938  REWRITE_TAC[INTERVAL_NE_EMPTY] THEN COND_CASES_TAC THENL
24939  [ALL_TAC, ASM_MESON_TAC[REAL_LE_TRANS]] THEN
24940  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
24941  METIS_TAC [real_sub, REAL_LE_ADD2, REAL_LE_NEG]
24942QED
24943
24944Theorem CONTENT_LT_NZ:
24945   !a b. &0 < content(interval[a,b]) <=> ~(content(interval[a,b]) = &0)
24946Proof
24947  REWRITE_TAC[CONTENT_POS_LT_EQ, CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]
24948QED
24949
24950Theorem INTERVAL_BOUNDS_NULL :
24951    !a b:real. (content(interval[a,b]) = &0)
24952        ==> (interval_upperbound(interval[a,b]) =
24953             interval_lowerbound(interval[a,b]))
24954Proof
24955    rpt GEN_TAC >> ASM_CASES_TAC ``interval[a:real,b] = {}``
24956 >| [ (* goal 1 (of 2) *)
24957      RW_TAC std_ss [interval_upperbound, interval_lowerbound,
24958                     GSYM INTERVAL_EQ_EMPTY, NOT_IN_EMPTY] \\
24959      fs [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY, IN_INTERVAL] \\
24960      METIS_TAC [real_lte, REAL_LE_REFL],
24961      (* goal 2 (of 2) *)
24962      RULE_ASSUM_TAC (SIMP_RULE std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT]) \\
24963      ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] \\
24964      REWRITE_TAC [CONTENT_EQ_0] >> ASM_REAL_ARITH_TAC ]
24965QED
24966
24967Theorem CONNECTED_INTERVAL :
24968    !a b. connected (interval (a,b)) /\
24969          connected (interval [a,b])
24970Proof
24971    rpt STRIP_TAC
24972 >| [ (* goal 1 (of 2) *)
24973      Cases_on ‘b < a’
24974      >- simp [iffLR (cj 2 INTERVAL_EQ_EMPTY), CONNECTED_EMPTY, REAL_LT_IMP_LE] \\
24975      fs [REAL_NOT_LT] \\
24976     ‘segment (a,b) = interval (a,b)’ by simp [SEGMENT] \\
24977      POP_ASSUM (REWRITE_TAC o wrap o SYM) \\
24978      simp [CONNECTED_SEGMENT],
24979      (* goal 2 (of 2) *)
24980      Cases_on ‘b < a’
24981      >- simp [iffLR (cj 1 INTERVAL_EQ_EMPTY), CONNECTED_EMPTY] \\
24982      fs [REAL_NOT_LT] \\
24983     ‘segment [a,b] = interval [a,b]’ by simp [SEGMENT] \\
24984      POP_ASSUM (REWRITE_TAC o wrap o SYM) \\
24985      simp [CONNECTED_SEGMENT] ]
24986QED
24987
24988(* END *)
24989
24990(* References:
24991
24992  [1] Bartle, R.G.: A Modern Theory of Integration. American Math. Soc. (2001).
24993 *)