1 (* ========================================================================= *)
2 (* Paths, connectedness, homotopy, simple connectedness & contractibility. *)
4 (* (c) Copyright, John Harrison 1998-2008 *)
5 (* (c) Copyright, Valentina Bruno 2010 *)
6 (* ========================================================================= *)
8 needs "Multivariate/convex.ml";;
10 (* ------------------------------------------------------------------------- *)
12 (* ------------------------------------------------------------------------- *)
14 let path = new_definition
15 `!g:real^1->real^N. path g <=> g continuous_on interval[vec 0,vec 1]`;;
17 let pathstart = new_definition
18 `pathstart (g:real^1->real^N) = g(vec 0)`;;
20 let pathfinish = new_definition
21 `pathfinish (g:real^1->real^N) = g(vec 1)`;;
23 let path_image = new_definition
24 `path_image (g:real^1->real^N) = IMAGE g (interval[vec 0,vec 1])`;;
26 let reversepath = new_definition
27 `reversepath (g:real^1->real^N) = \x. g(vec 1 - x)`;;
29 let joinpaths = new_definition
30 `(g1 ++ g2) = \x. if drop x <= &1 / &2 then g1(&2 % x)
31 else g2(&2 % x - vec 1)`;;
33 let simple_path = new_definition
34 `simple_path (g:real^1->real^N) <=>
36 !x y. x IN interval[vec 0,vec 1] /\
37 y IN interval[vec 0,vec 1] /\
39 ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0`;;
41 let arc = new_definition
42 `arc (g:real^1->real^N) <=>
44 !x y. x IN interval [vec 0,vec 1] /\
45 y IN interval [vec 0,vec 1] /\
49 (* ------------------------------------------------------------------------- *)
50 (* Invariance theorems. *)
51 (* ------------------------------------------------------------------------- *)
54 (`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ path p
56 REWRITE_TAC[path; CONTINUOUS_ON_EQ]);;
58 let PATH_CONTINUOUS_IMAGE = prove
59 (`!f:real^M->real^N g.
60 path g /\ f continuous_on path_image g ==> path(f o g)`,
61 REWRITE_TAC[path; path_image; CONTINUOUS_ON_COMPOSE]);;
63 let PATH_TRANSLATION_EQ = prove
64 (`!a g:real^1->real^N. path((\x. a + x) o g) <=> path g`,
65 REPEAT GEN_TAC THEN REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
66 [SUBGOAL_THEN `(g:real^1->real^N) = (\x. --a + x) o (\x. a + x) o g`
68 [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC];
70 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
71 ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;
73 add_translation_invariants [PATH_TRANSLATION_EQ];;
75 let PATH_LINEAR_IMAGE_EQ = prove
76 (`!f:real^M->real^N g.
77 linear f /\ (!x y. f x = f y ==> x = y)
78 ==> (path(f o g) <=> path g)`,
79 REPEAT GEN_TAC THEN DISCH_TAC THEN
80 FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o
81 MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
82 REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
83 [SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g`
84 SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC];
86 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
87 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]);;
89 add_linear_invariants [PATH_LINEAR_IMAGE_EQ];;
91 let PATHSTART_TRANSLATION = prove
92 (`!a g. pathstart((\x. a + x) o g) = a + pathstart g`,
93 REWRITE_TAC[pathstart; o_THM]);;
95 add_translation_invariants [PATHSTART_TRANSLATION];;
97 let PATHSTART_LINEAR_IMAGE_EQ = prove
98 (`!f g. linear f ==> pathstart(f o g) = f(pathstart g)`,
99 REWRITE_TAC[pathstart; o_THM]);;
101 add_linear_invariants [PATHSTART_LINEAR_IMAGE_EQ];;
103 let PATHFINISH_TRANSLATION = prove
104 (`!a g. pathfinish((\x. a + x) o g) = a + pathfinish g`,
105 REWRITE_TAC[pathfinish; o_THM]);;
107 add_translation_invariants [PATHFINISH_TRANSLATION];;
109 let PATHFINISH_LINEAR_IMAGE = prove
110 (`!f g. linear f ==> pathfinish(f o g) = f(pathfinish g)`,
111 REWRITE_TAC[pathfinish; o_THM]);;
113 add_linear_invariants [PATHFINISH_LINEAR_IMAGE];;
115 let PATH_IMAGE_TRANSLATION = prove
116 (`!a g. path_image((\x. a + x) o g) = IMAGE (\x. a + x) (path_image g)`,
117 REWRITE_TAC[path_image; IMAGE_o]);;
119 add_translation_invariants [PATH_IMAGE_TRANSLATION];;
121 let PATH_IMAGE_LINEAR_IMAGE = prove
122 (`!f g. linear f ==> path_image(f o g) = IMAGE f (path_image g)`,
123 REWRITE_TAC[path_image; IMAGE_o]);;
125 add_linear_invariants [PATH_IMAGE_LINEAR_IMAGE];;
127 let REVERSEPATH_TRANSLATION = prove
128 (`!a g. reversepath((\x. a + x) o g) = (\x. a + x) o reversepath g`,
129 REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);;
131 add_translation_invariants [REVERSEPATH_TRANSLATION];;
133 let REVERSEPATH_LINEAR_IMAGE = prove
134 (`!f g. linear f ==> reversepath(f o g) = f o reversepath g`,
135 REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);;
137 add_linear_invariants [REVERSEPATH_LINEAR_IMAGE];;
139 let JOINPATHS_TRANSLATION = prove
140 (`!a:real^N g1 g2. ((\x. a + x) o g1) ++ ((\x. a + x) o g2) =
141 (\x. a + x) o (g1 ++ g2)`,
142 REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
143 COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);;
145 add_translation_invariants [JOINPATHS_TRANSLATION];;
147 let JOINPATHS_LINEAR_IMAGE = prove
148 (`!f g1 g2. linear f ==> (f o g1) ++ (f o g2) = f o (g1 ++ g2)`,
149 REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN
150 COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);;
152 add_linear_invariants [JOINPATHS_LINEAR_IMAGE];;
154 let SIMPLE_PATH_TRANSLATION_EQ = prove
155 (`!a g:real^1->real^N. simple_path((\x. a + x) o g) <=> simple_path g`,
156 REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN
157 REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);;
159 add_translation_invariants [SIMPLE_PATH_TRANSLATION_EQ];;
161 let SIMPLE_PATH_LINEAR_IMAGE_EQ = prove
162 (`!f:real^M->real^N g.
163 linear f /\ (!x y. f x = f y ==> x = y)
164 ==> (simple_path(f o g) <=> simple_path g)`,
165 REPEAT STRIP_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN
166 BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
167 REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;
169 add_linear_invariants [SIMPLE_PATH_LINEAR_IMAGE_EQ];;
171 let ARC_TRANSLATION_EQ = prove
172 (`!a g:real^1->real^N. arc((\x. a + x) o g) <=> arc g`,
173 REPEAT GEN_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN
174 REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);;
176 add_translation_invariants [ARC_TRANSLATION_EQ];;
178 let ARC_LINEAR_IMAGE_EQ = prove
179 (`!f:real^M->real^N g.
180 linear f /\ (!x y. f x = f y ==> x = y)
181 ==> (arc(f o g) <=> arc g)`,
182 REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN
183 BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
184 REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;
186 add_linear_invariants [ARC_LINEAR_IMAGE_EQ];;
188 (* ------------------------------------------------------------------------- *)
189 (* Basic lemmas about paths. *)
190 (* ------------------------------------------------------------------------- *)
192 let ARC_IMP_SIMPLE_PATH = prove
193 (`!g. arc g ==> simple_path g`,
194 REWRITE_TAC[arc; simple_path] THEN MESON_TAC[]);;
196 let ARC_IMP_PATH = prove
197 (`!g. arc g ==> path g`,
198 REWRITE_TAC[arc] THEN MESON_TAC[]);;
200 let SIMPLE_PATH_IMP_PATH = prove
201 (`!g. simple_path g ==> path g`,
202 REWRITE_TAC[simple_path] THEN MESON_TAC[]);;
204 let SIMPLE_PATH_CASES = prove
205 (`!g:real^1->real^N. simple_path g ==> arc g \/ pathfinish g = pathstart g`,
206 REWRITE_TAC[simple_path; arc; pathfinish; pathstart] THEN
207 REPEAT STRIP_TAC THEN
208 ASM_CASES_TAC `(g:real^1->real^N) (vec 0) = g(vec 1)` THEN
209 ASM_REWRITE_TAC[] THEN
210 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN
211 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`]) THEN
214 let SIMPLE_PATH_IMP_ARC = prove
216 simple_path g /\ ~(pathfinish g = pathstart g) ==> arc g`,
217 MESON_TAC[SIMPLE_PATH_CASES]);;
219 let ARC_DISTINCT_ENDS = prove
220 (`!g:real^1->real^N. arc g ==> ~(pathfinish g = pathstart g)`,
221 GEN_TAC THEN REWRITE_TAC[arc; pathfinish; pathstart] THEN
222 ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b /\ ~d ==> ~c`] THEN
223 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN
224 REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC] THEN
225 CONV_TAC REAL_RAT_REDUCE_CONV);;
227 let ARC_SIMPLE_PATH = prove
229 arc g <=> simple_path g /\ ~(pathfinish g = pathstart g)`,
230 MESON_TAC[SIMPLE_PATH_CASES; ARC_IMP_SIMPLE_PATH; ARC_DISTINCT_ENDS]);;
232 let SIMPLE_PATH_EQ_ARC = prove
233 (`!g. ~(pathstart g = pathfinish g) ==> (simple_path g <=> arc g)`,
234 SIMP_TAC[ARC_SIMPLE_PATH]);;
236 let PATH_IMAGE_NONEMPTY = prove
237 (`!g. ~(path_image g = {})`,
238 REWRITE_TAC[path_image; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY] THEN
239 SIMP_TAC[DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM; UNWIND_THM1; VEC_COMPONENT;
240 ARITH; REAL_OF_NUM_LT]);;
242 let PATHSTART_IN_PATH_IMAGE = prove
243 (`!g. (pathstart g) IN path_image g`,
244 GEN_TAC THEN REWRITE_TAC[pathstart; path_image] THEN
245 MATCH_MP_TAC FUN_IN_IMAGE THEN
246 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]);;
248 let PATHFINISH_IN_PATH_IMAGE = prove
249 (`!g. (pathfinish g) IN path_image g`,
250 GEN_TAC THEN REWRITE_TAC[pathfinish; path_image] THEN
251 MATCH_MP_TAC FUN_IN_IMAGE THEN
252 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC);;
254 let CONNECTED_PATH_IMAGE = prove
255 (`!g. path g ==> connected(path_image g)`,
256 REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
257 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
258 ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);;
260 let COMPACT_PATH_IMAGE = prove
261 (`!g. path g ==> compact(path_image g)`,
262 REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
263 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
264 ASM_REWRITE_TAC[COMPACT_INTERVAL]);;
266 let BOUNDED_PATH_IMAGE = prove
267 (`!g. path g ==> bounded(path_image g)`,
268 MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_BOUNDED]);;
270 let CLOSED_PATH_IMAGE = prove
271 (`!g. path g ==> closed(path_image g)`,
272 MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED]);;
274 let CONNECTED_SIMPLE_PATH_IMAGE = prove
275 (`!g. simple_path g ==> connected(path_image g)`,
276 MESON_TAC[CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
278 let COMPACT_SIMPLE_PATH_IMAGE = prove
279 (`!g. simple_path g ==> compact(path_image g)`,
280 MESON_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
282 let BOUNDED_SIMPLE_PATH_IMAGE = prove
283 (`!g. simple_path g ==> bounded(path_image g)`,
284 MESON_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
286 let CLOSED_SIMPLE_PATH_IMAGE = prove
287 (`!g. simple_path g ==> closed(path_image g)`,
288 MESON_TAC[CLOSED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
290 let CONNECTED_ARC_IMAGE = prove
291 (`!g. arc g ==> connected(path_image g)`,
292 MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH]);;
294 let COMPACT_ARC_IMAGE = prove
295 (`!g. arc g ==> compact(path_image g)`,
296 MESON_TAC[COMPACT_PATH_IMAGE; ARC_IMP_PATH]);;
298 let BOUNDED_ARC_IMAGE = prove
299 (`!g. arc g ==> bounded(path_image g)`,
300 MESON_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH]);;
302 let CLOSED_ARC_IMAGE = prove
303 (`!g. arc g ==> closed(path_image g)`,
304 MESON_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH]);;
306 let PATHSTART_COMPOSE = prove
307 (`!f p. pathstart(f o p) = f(pathstart p)`,
308 REWRITE_TAC[pathstart; o_THM]);;
310 let PATHFINISH_COMPOSE = prove
311 (`!f p. pathfinish(f o p) = f(pathfinish p)`,
312 REWRITE_TAC[pathfinish; o_THM]);;
314 let PATH_IMAGE_COMPOSE = prove
315 (`!f p. path_image (f o p) = IMAGE f (path_image p)`,
316 REWRITE_TAC[path_image; IMAGE_o]);;
318 let PATH_COMPOSE_JOIN = prove
319 (`!f p q. f o (p ++ q) = (f o p) ++ (f o q)`,
320 REWRITE_TAC[joinpaths; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);;
322 let PATH_COMPOSE_REVERSEPATH = prove
323 (`!f p. f o reversepath p = reversepath(f o p)`,
324 REWRITE_TAC[reversepath; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);;
326 let JOIN_PATHS_EQ = prove
327 (`!p q:real^1->real^N.
328 (!t. t IN interval[vec 0,vec 1] ==> p t = p' t) /\
329 (!t. t IN interval[vec 0,vec 1] ==> q t = q' t)
330 ==> !t. t IN interval[vec 0,vec 1] ==> (p ++ q) t = (p' ++ q') t`,
331 REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
332 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
333 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
334 ASM_REAL_ARITH_TAC);;
336 let CARD_EQ_SIMPLE_PATH_IMAGE = prove
337 (`!g. simple_path g ==> path_image g =_c (:real)`,
338 SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SIMPLE_PATH_IMAGE] THEN
339 GEN_TAC THEN REWRITE_TAC[simple_path; path_image] THEN MATCH_MP_TAC(SET_RULE
340 `(?u v. u IN s /\ v IN s /\ ~(u = a) /\ ~(v = a) /\ ~(u = v))
341 ==> P /\ (!x y. x IN s /\ y IN s /\ f x = f y
342 ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a)
343 ==> ~(?c. IMAGE f s SUBSET {c})`) THEN
344 MAP_EVERY EXISTS_TAC [`lift(&1 / &3)`; `lift(&1 / &2)`] THEN
345 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN
346 CONV_TAC REAL_RAT_REDUCE_CONV);;
348 let INFINITE_SIMPLE_PATH_IMAGE = prove
349 (`!g. simple_path g ==> INFINITE(path_image g)`,
350 MESON_TAC[CARD_EQ_SIMPLE_PATH_IMAGE; INFINITE; FINITE_IMP_COUNTABLE;
351 UNCOUNTABLE_REAL; CARD_COUNTABLE_CONG]);;
353 let CARD_EQ_ARC_IMAGE = prove
354 (`!g. arc g ==> path_image g =_c (:real)`,
355 MESON_TAC[ARC_IMP_SIMPLE_PATH; CARD_EQ_SIMPLE_PATH_IMAGE]);;
357 let INFINITE_ARC_IMAGE = prove
358 (`!g. arc g ==> INFINITE(path_image g)`,
359 MESON_TAC[ARC_IMP_SIMPLE_PATH; INFINITE_SIMPLE_PATH_IMAGE]);;
361 (* ------------------------------------------------------------------------- *)
362 (* Simple paths with the endpoints removed. *)
363 (* ------------------------------------------------------------------------- *)
365 let SIMPLE_PATH_ENDLESS = prove
368 ==> path_image c DIFF {pathstart c,pathfinish c} =
369 IMAGE c (interval(vec 0,vec 1))`,
370 REWRITE_TAC[simple_path; path_image; pathstart; pathfinish] THEN
371 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path] THEN
372 REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
373 `(!x y. x IN s /\ y IN s /\ c x = c y
374 ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) /\
376 ==> IMAGE c s DIFF {c a,c b} = IMAGE c (s DIFF {a,b})`) THEN
377 ASM_REWRITE_TAC[] THEN
378 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;
380 let CONNECTED_SIMPLE_PATH_ENDLESS = prove
383 ==> connected(path_image c DIFF {pathstart c,pathfinish c})`,
384 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_ENDLESS] THEN
385 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
386 SIMP_TAC[CONVEX_INTERVAL; CONVEX_CONNECTED] THEN
387 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
388 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
389 RULE_ASSUM_TAC(REWRITE_RULE[simple_path; path]) THEN
390 ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);;
392 let NONEMPTY_SIMPLE_PATH_ENDLESS = prove
394 simple_path c ==> ~(path_image c DIFF {pathstart c,pathfinish c} = {})`,
395 SIMP_TAC[SIMPLE_PATH_ENDLESS; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY_1] THEN
396 REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);;
398 (* ------------------------------------------------------------------------- *)
399 (* The operations on paths. *)
400 (* ------------------------------------------------------------------------- *)
402 let JOINPATHS = prove
403 (`!g1 g2. pathfinish g1 = pathstart g2
404 ==> g1 ++ g2 = \x. if drop x < &1 / &2 then g1(&2 % x)
405 else g2 (&2 % x - vec 1)`,
406 REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN
407 REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN
408 X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `drop x = &1 / &2` THENL
409 [FIRST_X_ASSUM(MP_TAC o AP_TERM `lift`) THEN
410 REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN SUBST1_TAC THEN
411 REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_CMUL; REAL_LT_REFL] THEN
412 CONV_TAC REAL_RAT_REDUCE_CONV THEN
413 ASM_REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL];
414 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]);;
416 let REVERSEPATH_REVERSEPATH = prove
417 (`!g:real^1->real^N. reversepath(reversepath g) = g`,
418 REWRITE_TAC[reversepath; ETA_AX;
419 VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);;
421 let PATHSTART_REVERSEPATH = prove
422 (`pathstart(reversepath g) = pathfinish g`,
423 REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_RZERO]);;
425 let PATHFINISH_REVERSEPATH = prove
426 (`pathfinish(reversepath g) = pathstart g`,
427 REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_REFL]);;
429 let PATHSTART_JOIN = prove
430 (`!g1 g2. pathstart(g1 ++ g2) = pathstart g1`,
431 REWRITE_TAC[joinpaths; pathstart; pathstart; DROP_VEC; VECTOR_MUL_RZERO] THEN
432 CONV_TAC REAL_RAT_REDUCE_CONV);;
434 let PATHFINISH_JOIN = prove
435 (`!g1 g2. pathfinish(g1 ++ g2) = pathfinish g2`,
436 REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; pathfinish; DROP_VEC] THEN
437 CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);;
439 let PATH_IMAGE_REVERSEPATH = prove
440 (`!g:real^1->real^N. path_image(reversepath g) = path_image g`,
441 SUBGOAL_THEN `!g:real^1->real^N.
442 path_image(reversepath g) SUBSET path_image g`
443 (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH; SUBSET_ANTISYM]) THEN
444 REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE] THEN
445 MAP_EVERY X_GEN_TAC [`g:real^1->real^N`; `x:real^1`] THEN
446 DISCH_TAC THEN REWRITE_TAC[reversepath; IN_IMAGE] THEN
447 EXISTS_TAC `vec 1 - x:real^1` THEN POP_ASSUM MP_TAC THEN
448 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);;
450 let PATH_REVERSEPATH = prove
451 (`!g:real^1->real^N. path(reversepath g) <=> path g`,
452 SUBGOAL_THEN `!g:real^1->real^N. path g ==> path(reversepath g)`
453 (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN
454 GEN_TAC THEN REWRITE_TAC[path; reversepath] THEN STRIP_TAC THEN
455 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
456 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
457 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
458 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
459 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
460 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
461 REWRITE_TAC[DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC);;
463 let PATH_JOIN = prove
464 (`!g1 g2:real^1->real^N.
465 pathfinish g1 = pathstart g2
466 ==> (path(g1 ++ g2) <=> path g1 /\ path g2)`,
467 REWRITE_TAC[path; pathfinish; pathstart] THEN
468 REPEAT STRIP_TAC THEN EQ_TAC THENL
469 [STRIP_TAC THEN CONJ_TAC THENL
471 `(g1:real^1->real^N) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)`
473 [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
476 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
477 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
478 MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
479 EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL
480 [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN
481 SIMP_TAC[DROP_VEC; REAL_ARITH `&1 / &2 * x <= &1 / &2 <=> x <= &1`];
483 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
484 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN
485 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN
486 REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC;
488 `(g2:real^1->real^N) =
489 (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))`
491 [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
494 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
495 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
496 CONTINUOUS_ON_ADD] THEN
497 MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
498 EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL
499 [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN
500 REWRITE_TAC[DROP_VEC; DROP_ADD; REAL_ARITH
501 `&1 / &2 * (x + &1) <= &1 / &2 <=> x <= &0`] THEN
502 SIMP_TAC[REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`; LIFT_NUM;
503 VECTOR_MUL_ASSOC; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
504 CONV_TAC REAL_RAT_REDUCE_CONV THEN
505 ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LID] THEN
506 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
507 REWRITE_TAC[VECTOR_ARITH `(x + vec 1) - vec 1 = x`];
509 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
510 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN
511 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN
512 REWRITE_TAC[DROP_VEC; DROP_ADD] THEN REAL_ARITH_TAC];
514 SUBGOAL_THEN `interval[vec 0,vec 1] =
515 interval[vec 0,lift(&1 / &2)] UNION
516 interval[lift(&1 / &2),vec 1]`
518 [SIMP_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
521 MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
522 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
523 [EXISTS_TAC `\x. (g1:real^1->real^N) (&2 % x)`;
524 EXISTS_TAC `\x. (g2:real^1->real^N) (&2 % x - vec 1)`] THEN
525 REWRITE_TAC[joinpaths] THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP] THENL
526 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
527 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
528 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
529 ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % (x:real^1) = &2 % x + vec 0`] THEN
530 REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
531 REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN
532 REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN
533 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM];
536 [SIMP_TAC[REAL_ARITH `&1 / &2 <= x ==> (x <= &1 / &2 <=> x = &1 / &2)`;
537 GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
538 CONV_TAC REAL_RAT_REDUCE_CONV THEN
539 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
540 ASM_REWRITE_TAC[LIFT_NUM] THEN
541 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
542 REWRITE_TAC[GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
543 REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL];
545 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
546 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
547 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
548 CONTINUOUS_ON_ID] THEN
549 ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x - vec 1 = &2 % x + --vec 1`] THEN
550 REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
551 REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN
552 REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN
553 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM] THEN
554 ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x + --x = x /\ x + --x = vec 0`]]);;
556 let PATH_JOIN_IMP = prove
557 (`!g1 g2:real^1->real^N.
558 path g1 /\ path g2 /\ pathfinish g1 = pathstart g2
560 MESON_TAC[PATH_JOIN]);;
562 let PATH_IMAGE_JOIN_SUBSET = prove
563 (`!g1 g2:real^1->real^N.
564 path_image(g1 ++ g2) SUBSET (path_image g1 UNION path_image g2)`,
565 REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN
566 GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `x:real^1` THEN
567 REWRITE_TAC[IN_INTERVAL_1; IN_UNION; IN_IMAGE; DROP_VEC; joinpaths] THEN
568 STRIP_TAC THEN ASM_CASES_TAC `drop x <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
569 [DISJ1_TAC THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[DROP_CMUL];
570 DISJ2_TAC THEN EXISTS_TAC `&2 % x - vec 1:real^1` THEN
571 REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC]] THEN
572 ASM_REAL_ARITH_TAC);;
574 let SUBSET_PATH_IMAGE_JOIN = prove
575 (`!g1 g2:real^1->real^N s.
576 path_image g1 SUBSET s /\ path_image g2 SUBSET s
577 ==> path_image(g1 ++ g2) SUBSET s`,
578 MP_TAC PATH_IMAGE_JOIN_SUBSET THEN
579 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
582 let PATH_IMAGE_JOIN = prove
583 (`!g1 g2. pathfinish g1 = pathstart g2
584 ==> path_image(g1 ++ g2) = path_image g1 UNION path_image g2`,
585 REWRITE_TAC[pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
586 MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN
587 REWRITE_TAC[path_image; SUBSET; FORALL_AND_THM; IN_UNION; TAUT
588 `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
589 REWRITE_TAC[FORALL_IN_IMAGE; joinpaths] THEN
590 REWRITE_TAC[IN_INTERVAL_1; IN_IMAGE; DROP_VEC] THEN
591 CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THENL
592 [EXISTS_TAC `(&1 / &2) % x:real^1` THEN
593 ASM_REWRITE_TAC[DROP_CMUL; REAL_ARITH
594 `&1 / &2 * x <= &1 / &2 <=> x <= &1`] THEN
595 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
596 ASM_REWRITE_TAC[VECTOR_MUL_LID];
597 EXISTS_TAC `(&1 / &2) % (x + vec 1):real^1` THEN
598 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_VEC] THEN
599 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
600 REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(x + vec 1) - vec 1 = x`] THEN
601 ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&1 / &2 * (x + &1) <= &1 / &2 <=>
603 REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN
604 COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; DROP_VEC]] THEN
605 ASM_REAL_ARITH_TAC);;
607 let NOT_IN_PATH_IMAGE_JOIN = prove
608 (`!g1 g2 x. ~(x IN path_image g1) /\ ~(x IN path_image g2)
609 ==> ~(x IN path_image(g1 ++ g2))`,
610 MESON_TAC[PATH_IMAGE_JOIN_SUBSET; SUBSET; IN_UNION]);;
612 let ARC_REVERSEPATH = prove
613 (`!g. arc g ==> arc(reversepath g)`,
614 GEN_TAC THEN SIMP_TAC[arc; PATH_REVERSEPATH] THEN
615 REWRITE_TAC[arc; reversepath] THEN STRIP_TAC THEN
616 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
617 FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
618 ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
619 REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN
622 let SIMPLE_PATH_REVERSEPATH = prove
623 (`!g. simple_path g ==> simple_path (reversepath g)`,
624 GEN_TAC THEN SIMP_TAC[simple_path; PATH_REVERSEPATH] THEN
625 REWRITE_TAC[simple_path; reversepath] THEN STRIP_TAC THEN
626 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
627 FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
628 ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
629 REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN
632 let SIMPLE_PATH_JOIN_LOOP = prove
633 (`!g1 g2:real^1->real^N.
635 pathfinish g1 = pathstart g2 /\
636 pathfinish g2 = pathstart g1 /\
637 (path_image g1 INTER path_image g2) SUBSET
638 {pathstart g1,pathstart g2}
639 ==> simple_path(g1 ++ g2)`,
640 REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN
642 `(a /\ b /\ c /\ d ==> f) /\
643 (a' /\ b' /\ c /\ d /\ e ==> g)
644 ==> (a /\ a') /\ (b /\ b') /\ c /\ d /\ e ==> f /\ g`) THEN
645 CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN
646 REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart;
647 pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN
648 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
649 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
650 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
651 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
652 MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
653 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
654 MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
655 ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
656 [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
657 ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
658 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
659 DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC;
662 REMOVE_THEN "G2" (MP_TAC o SPECL
663 [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
664 ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
665 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
666 DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC] THEN
667 REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
670 [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
671 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
673 ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN
674 EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
675 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
679 [DISJ2_TAC THEN DISJ1_TAC;
680 DISJ1_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
681 EXISTS_TAC `&1 / &2 % vec 1:real^1`] THEN
682 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
683 [SUBGOAL_THEN `&2 % x:real^1 = vec 0` MP_TAC THENL
684 [ALL_TAC; VECTOR_ARITH_TAC] THEN
685 REMOVE_THEN "G1" MATCH_MP_TAC;
686 DISCH_THEN SUBST_ALL_TAC THEN
687 RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_RZERO]) THEN
688 UNDISCH_TAC `T` THEN REWRITE_TAC[] THEN
689 SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 1` MP_TAC THENL
690 [ALL_TAC; VECTOR_ARITH_TAC] THEN
691 REMOVE_THEN "G2" MATCH_MP_TAC;
692 SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
693 [ALL_TAC; VECTOR_ARITH_TAC] THEN
694 REMOVE_THEN "G1" MATCH_MP_TAC;
695 DISCH_THEN SUBST_ALL_TAC THEN
696 SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
697 [ALL_TAC; VECTOR_ARITH_TAC] THEN
698 REMOVE_THEN "G2" MATCH_MP_TAC] THEN
699 (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
700 [ALL_TAC; ASM_MESON_TAC[]] THEN
701 ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN
702 ASM_REAL_ARITH_TAC));;
705 (`!g1 g2:real^1->real^N.
707 pathfinish g1 = pathstart g2 /\
708 (path_image g1 INTER path_image g2) SUBSET {pathstart g2}
710 REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN
712 `(a /\ b /\ c /\ d ==> f) /\
713 (a' /\ b' /\ c /\ d ==> g)
714 ==> (a /\ a') /\ (b /\ b') /\ c /\ d ==> f /\ g`) THEN
715 CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN
716 REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart;
717 pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN
718 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
719 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
720 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
721 MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
722 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
723 MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
724 ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
725 [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
726 ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
727 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
731 REMOVE_THEN "G2" (MP_TAC o SPECL
732 [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
733 ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
734 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
735 VECTOR_ARITH_TAC] THEN
736 REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
739 [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
740 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
742 ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN
743 EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
744 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
748 SUBGOAL_THEN `x:real^1 = &1 / &2 % vec 1` SUBST_ALL_TAC THENL
749 [SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
750 [ALL_TAC; VECTOR_ARITH_TAC] THEN
751 REMOVE_THEN "G1" MATCH_MP_TAC;
752 SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
753 [ALL_TAC; VECTOR_ARITH_TAC] THEN
754 REMOVE_THEN "G2" MATCH_MP_TAC] THEN
755 (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
756 [ALL_TAC; ASM_MESON_TAC[]] THEN
757 ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN
758 ASM_REAL_ARITH_TAC));;
760 let REVERSEPATH_JOINPATHS = prove
761 (`!g1 g2. pathfinish g1 = pathstart g2
762 ==> reversepath(g1 ++ g2) = reversepath g2 ++ reversepath g1`,
764 REWRITE_TAC[reversepath; joinpaths; pathfinish; pathstart; FUN_EQ_THM] THEN
765 DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN
766 REWRITE_TAC[DROP_VEC; DROP_SUB; REAL_ARITH
767 `&1 - x <= &1 / &2 <=> &1 / &2 <= x`] THEN
768 ASM_CASES_TAC `t = lift(&1 / &2)` THENL
769 [ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_NUM; GSYM LIFT_SUB;
771 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM];
772 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN
773 REWRITE_TAC[LIFT_DROP] THEN DISCH_TAC THEN
774 ASM_SIMP_TAC[REAL_ARITH
775 `~(x = &1 / &2) ==> (&1 / &2 <= x <=> ~(x <= &1 / &2))`] THEN
776 ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THEN
777 AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC]);;
779 (* ------------------------------------------------------------------------- *)
780 (* Some reversed and "if and only if" versions of joining theorems. *)
781 (* ------------------------------------------------------------------------- *)
783 let PATH_JOIN_PATH_ENDS = prove
784 (`!g1 g2:real^1->real^N.
785 path g2 /\ path(g1 ++ g2) ==> pathfinish g1 = pathstart g2`,
786 REPEAT GEN_TAC THEN DISJ_CASES_TAC(NORM_ARITH
787 `pathfinish g1:real^N = pathstart g2 \/
788 &0 < dist(pathfinish g1,pathstart g2)`) THEN
789 ASM_REWRITE_TAC[path; continuous_on; joinpaths] THEN
790 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
791 REWRITE_TAC[pathstart; pathfinish] THEN
792 ABBREV_TAC `e = dist((g1:real^1->real^N)(vec 1),g2(vec 0:real^1))` THEN
793 DISCH_THEN(CONJUNCTS_THEN2
794 (MP_TAC o SPEC `vec 0:real^1`) (MP_TAC o SPEC `lift(&1 / &2)`)) THEN
795 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; LIFT_DROP; REAL_LE_REFL] THEN
796 REWRITE_TAC[GSYM LIFT_CMUL; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
797 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
798 DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
799 DISCH_THEN(X_CHOOSE_THEN `d1:real`
800 (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
801 DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
802 DISCH_THEN(X_CHOOSE_THEN `d2:real`
803 (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
804 REMOVE_THEN "2" (MP_TAC o SPEC `lift(min (&1 / &2) (min d1 d2) / &2)`) THEN
805 REWRITE_TAC[LIFT_DROP; DIST_LIFT; DIST_0; NORM_REAL; GSYM drop] THEN
806 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
807 REMOVE_THEN "1" (MP_TAC o SPEC
808 `lift(&1 / &2 + min (&1 / &2) (min d1 d2) / &4)`) THEN
809 REWRITE_TAC[LIFT_DROP; DIST_LIFT] THEN
810 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
811 COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
812 REWRITE_TAC[GSYM LIFT_CMUL; LIFT_ADD; REAL_ADD_LDISTRIB] THEN
813 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
814 REWRITE_TAC[VECTOR_ADD_SUB; REAL_ARITH `&2 * x / &4 = x / &2`] THEN
815 REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
817 let PATH_JOIN_EQ = prove
818 (`!g1 g2:real^1->real^N.
820 ==> (path(g1 ++ g2) <=> pathfinish g1 = pathstart g2)`,
821 MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_JOIN_IMP]);;
823 let SIMPLE_PATH_JOIN_IMP = prove
824 (`!g1 g2:real^1->real^N.
825 simple_path(g1 ++ g2) /\ pathfinish g1 = pathstart g2
826 ==> arc g1 /\ arc g2 /\
827 path_image g1 INTER path_image g2 SUBSET
828 {pathstart g1, pathstart g2}`,
830 ASM_CASES_TAC `path(g1:real^1->real^N) /\ path(g2:real^1->real^N)` THENL
831 [ALL_TAC; ASM_MESON_TAC[PATH_JOIN; SIMPLE_PATH_IMP_PATH]] THEN
832 REWRITE_TAC[simple_path; pathstart; pathfinish; arc] THEN
833 STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[] THENL
834 [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
835 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
836 FIRST_X_ASSUM(MP_TAC o SPECL
837 [`&1 / &2 % x:real^1`; `&1 / &2 % y:real^1`]) THEN
838 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; joinpaths; DROP_CMUL] THEN
839 REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
840 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
841 ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC] THEN
843 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
844 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
845 FIRST_X_ASSUM(MP_TAC o SPECL
846 [`&1 / &2 % (x + vec 1):real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN
847 ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN
848 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_CMUL] THEN
849 REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
850 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
851 ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(a + b) - b:real^N = a`] THEN
852 ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC;
856 `s INTER t SUBSET u <=> !x. x IN s ==> x IN t ==> x IN u`] THEN
857 REWRITE_TAC[path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN
858 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
859 REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^1` THEN
860 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
861 SUBST1_TAC(SYM(ASSUME
862 `(g1:real^1->real^N)(vec 1) = g2(vec 0:real^1)`)) THEN
863 MATCH_MP_TAC(SET_RULE `x = a \/ x = b ==> f x IN {f a,f b}`) THEN
864 FIRST_X_ASSUM(MP_TAC o SPECL
865 [`&1 / &2 % x:real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN
867 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
868 REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
869 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [joinpaths] THEN
870 ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN
871 REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN
872 REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
873 REWRITE_TAC[VECTOR_ARITH `&2 % &1 / &2 % x:real^N = x`] THEN
874 ASM_REWRITE_TAC[VECTOR_ARITH `(a + b) - b:real^N = a`];
875 REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_VEC] THEN
876 ASM_REAL_ARITH_TAC]]);;
878 let SIMPLE_PATH_JOIN_LOOP_EQ = prove
879 (`!g1 g2:real^1->real^N.
880 pathfinish g2 = pathstart g1 /\
881 pathfinish g1 = pathstart g2
882 ==> (simple_path(g1 ++ g2) <=>
884 path_image g1 INTER path_image g2 SUBSET
885 {pathstart g1, pathstart g2})`,
886 MESON_TAC[SIMPLE_PATH_JOIN_IMP; SIMPLE_PATH_JOIN_LOOP]);;
888 let ARC_JOIN_EQ = prove
889 (`!g1 g2:real^1->real^N.
890 pathfinish g1 = pathstart g2
891 ==> (arc(g1 ++ g2) <=>
893 path_image g1 INTER path_image g2 SUBSET {pathstart g2})`,
894 REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ARC_JOIN] THEN
895 GEN_REWRITE_TAC LAND_CONV [ARC_SIMPLE_PATH] THEN
896 REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN] THEN STRIP_TAC THEN
897 MP_TAC(ISPECL [`g1:real^1->real^N`; `g2:real^1->real^N`]
898 SIMPLE_PATH_JOIN_IMP) THEN
899 ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
900 SUBGOAL_THEN `~((pathstart g1:real^N) IN path_image g2)`
901 (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN
902 REWRITE_TAC[path_image; IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
903 DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
904 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN
905 DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `lift(&1 / &2) + inv(&2) % u`] o
907 REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_ADD; DROP_VEC;
908 DROP_CMUL; LIFT_DROP; joinpaths] THEN
909 CONV_TAC REAL_RAT_REDUCE_CONV THEN
910 ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_IMP_NZ;
911 REAL_ARITH `&0 <= x ==> &0 < &1 / &2 + &1 / &2 * x`] THEN
912 REWRITE_TAC[REAL_ARITH `&1 / &2 + &1 / &2 * u = &1 <=> u = &1`] THEN
913 ASM_SIMP_TAC[REAL_ARITH
914 `&0 <= u ==> (&1 / &2 + &1 / &2 * u <= &1 / &2 <=> u = &0)`] THEN
915 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
916 ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
917 ASM_SIMP_TAC[REAL_ARITH `u <= &1 ==> &1 / &2 + &1 / &2 * u <= &1`] THEN
918 REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN COND_CASES_TAC THENL
919 [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_CMUL] THEN
920 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
921 ASM_REWRITE_TAC[VEC_EQ] THEN ARITH_TAC;
922 REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM LIFT_CMUL] THEN
923 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
924 CONV_TAC REAL_RAT_REDUCE_CONV THEN
925 REWRITE_TAC[LIFT_NUM; VECTOR_MUL_LID; VECTOR_ADD_SUB] THEN
928 let ARC_JOIN_EQ_ALT = prove
929 (`!g1 g2:real^1->real^N.
930 pathfinish g1 = pathstart g2
931 ==> (arc(g1 ++ g2) <=>
933 path_image g1 INTER path_image g2 = {pathstart g2})`,
934 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARC_JOIN_EQ] THEN
935 MP_TAC(ISPEC `g1:real^1->real^N` PATHFINISH_IN_PATH_IMAGE) THEN
936 MP_TAC(ISPEC `g2:real^1->real^N` PATHSTART_IN_PATH_IMAGE) THEN
939 (* ------------------------------------------------------------------------- *)
940 (* Reassociating a joined path doesn't matter for various properties. *)
941 (* ------------------------------------------------------------------------- *)
943 let PATH_ASSOC = prove
944 (`!p q r:real^1->real^N.
945 pathfinish p = pathstart q /\ pathfinish q = pathstart r
946 ==> (path(p ++ (q ++ r)) <=> path((p ++ q) ++ r))`,
947 SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONV_TAC TAUT);;
949 let SIMPLE_PATH_ASSOC = prove
950 (`!p q r:real^1->real^N.
951 pathfinish p = pathstart q /\ pathfinish q = pathstart r
952 ==> (simple_path(p ++ (q ++ r)) <=> simple_path((p ++ q) ++ r))`,
953 REPEAT STRIP_TAC THEN
954 ASM_CASES_TAC `pathstart(p:real^1->real^N) = pathfinish r` THENL
956 ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHFINISH_JOIN]] THEN
957 ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_JOIN; PATHFINISH_JOIN;
958 ARC_JOIN_EQ; PATH_IMAGE_JOIN] THEN
959 MAP_EVERY ASM_CASES_TAC
960 [`arc(p:real^1->real^N)`; `arc(q:real^1->real^N)`;
961 `arc(r:real^1->real^N)`] THEN
962 ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET;
963 ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN
964 REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS)) THEN
965 MAP_EVERY (fun t -> MP_TAC(ISPEC t PATHSTART_IN_PATH_IMAGE) THEN
966 MP_TAC(ISPEC t PATHFINISH_IN_PATH_IMAGE))
967 [`p:real^1->real^N`; `q:real^1->real^N`; `r:real^1->real^N`] THEN
970 let ARC_ASSOC = prove
971 (`!p q r:real^1->real^N.
972 pathfinish p = pathstart q /\ pathfinish q = pathstart r
973 ==> (arc(p ++ (q ++ r)) <=> arc((p ++ q) ++ r))`,
974 SIMP_TAC[ARC_SIMPLE_PATH; SIMPLE_PATH_ASSOC] THEN
975 SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN]);;
977 (* ------------------------------------------------------------------------- *)
978 (* In the case of a loop, neither does symmetry. *)
979 (* ------------------------------------------------------------------------- *)
982 (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
983 ==> (path(p ++ q) <=> path(q ++ p))`,
984 SIMP_TAC[PATH_JOIN; CONJ_ACI]);;
986 let SIMPLE_PATH_SYM = prove
987 (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
988 ==> (simple_path(p ++ q) <=> simple_path(q ++ p))`,
989 SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; INTER_ACI; CONJ_ACI; INSERT_AC]);;
991 let PATH_IMAGE_SYM = prove
992 (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
993 ==> path_image(p ++ q) = path_image(q ++ p)`,
994 SIMP_TAC[PATH_IMAGE_JOIN; UNION_ACI]);;
996 (* ------------------------------------------------------------------------- *)
997 (* Reparametrizing a closed curve to start at some chosen point. *)
998 (* ------------------------------------------------------------------------- *)
1000 let shiftpath = new_definition
1001 `shiftpath a (f:real^1->real^N) =
1002 \x. if drop(a + x) <= &1 then f(a + x)
1003 else f(a + x - vec 1)`;;
1005 let SHIFTPATH_TRANSLATION = prove
1006 (`!a t g. shiftpath t ((\x. a + x) o g) = (\x. a + x) o shiftpath t g`,
1007 REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);;
1009 add_translation_invariants [SHIFTPATH_TRANSLATION];;
1011 let SHIFTPATH_LINEAR_IMAGE = prove
1012 (`!f t g. linear f ==> shiftpath t (f o g) = f o shiftpath t g`,
1013 REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);;
1015 add_linear_invariants [SHIFTPATH_LINEAR_IMAGE];;
1017 let PATHSTART_SHIFTPATH = prove
1018 (`!a g. drop a <= &1 ==> pathstart(shiftpath a g) = g(a)`,
1019 SIMP_TAC[pathstart; shiftpath; VECTOR_ADD_RID]);;
1021 let PATHFINISH_SHIFTPATH = prove
1022 (`!a g. &0 <= drop a /\ pathfinish g = pathstart g
1023 ==> pathfinish(shiftpath a g) = g(a)`,
1024 SIMP_TAC[pathfinish; shiftpath; pathstart; DROP_ADD; DROP_VEC] THEN
1025 REWRITE_TAC[VECTOR_ARITH `a + vec 1 - vec 1 = a`] THEN
1026 ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x + &1 <= &1 <=> x = &0)`] THEN
1027 SIMP_TAC[DROP_EQ_0; VECTOR_ADD_LID] THEN MESON_TAC[]);;
1029 let ENDPOINTS_SHIFTPATH = prove
1030 (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
1031 ==> pathfinish(shiftpath a g) = g a /\
1032 pathstart(shiftpath a g) = g a`,
1033 SIMP_TAC[IN_INTERVAL_1; DROP_VEC;
1034 PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]);;
1036 let CLOSED_SHIFTPATH = prove
1037 (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
1038 ==> pathfinish(shiftpath a g) = pathstart(shiftpath a g)`,
1039 SIMP_TAC[IN_INTERVAL_1; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH;
1042 let PATH_SHIFTPATH = prove
1043 (`!g a. path g /\ pathfinish g:real^N = pathstart g /\
1044 a IN interval[vec 0,vec 1]
1045 ==> path(shiftpath a g)`,
1046 REWRITE_TAC[shiftpath; path] THEN REPEAT STRIP_TAC THEN
1048 `interval[vec 0,vec 1] = interval[vec 0,vec 1 - a:real^1] UNION
1049 interval[vec 1 - a,vec 1]`
1051 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
1052 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
1053 REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC;
1055 MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
1056 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
1057 [EXISTS_TAC `(\x. g(a + x)):real^1->real^N` THEN
1058 REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN
1059 SIMP_TAC[REAL_ARITH `a + x <= &1 <=> x <= &1 - a`];
1060 EXISTS_TAC `(\x. g(a + x - vec 1)):real^1->real^N` THEN
1061 REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN
1062 SIMP_TAC[REAL_ARITH `&1 - a <= x ==> (a + x <= &1 <=> a + x = &1)`] THEN
1063 ONCE_REWRITE_TAC[COND_RAND] THEN
1064 REWRITE_TAC[VECTOR_ARITH `a + x - vec 1 = (a + x) - vec 1`] THEN
1065 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
1066 ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_NUM; LIFT_DROP] THEN
1067 REWRITE_TAC[VECTOR_SUB_REFL; COND_ID]] THEN
1068 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
1069 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
1070 CONTINUOUS_ON_SUB] THEN
1071 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
1072 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
1073 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
1074 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
1075 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_ADD] THEN
1078 let SHIFTPATH_SHIFTPATH = prove
1079 (`!g a x. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g /\
1080 x IN interval[vec 0,vec 1]
1081 ==> shiftpath (vec 1 - a) (shiftpath a g) x = g x`,
1082 REWRITE_TAC[shiftpath; pathfinish; pathstart] THEN
1083 REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN
1084 REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
1085 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1086 REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THENL
1088 AP_TERM_TAC THEN VECTOR_ARITH_TAC;
1089 AP_TERM_TAC THEN VECTOR_ARITH_TAC;
1090 ASM_REAL_ARITH_TAC] THEN
1091 SUBGOAL_THEN `x:real^1 = vec 0` SUBST1_TAC THENL
1092 [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
1094 ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a + vec 0:real^1 = vec 1`]]);;
1096 let PATH_IMAGE_SHIFTPATH = prove
1097 (`!a g:real^1->real^N.
1098 a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g
1099 ==> path_image(shiftpath a g) = path_image g`,
1100 REWRITE_TAC[IN_INTERVAL_1; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
1101 MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
1102 REWRITE_TAC[path_image; shiftpath; FORALL_IN_IMAGE; SUBSET] THEN
1103 REWRITE_TAC[IN_IMAGE] THEN REPEAT STRIP_TAC THEN
1104 REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_IMAGE] THENL
1105 [EXISTS_TAC `a + x:real^1`;
1106 EXISTS_TAC `a + x - vec 1:real^1`;
1108 REPEAT(POP_ASSUM MP_TAC) THEN
1109 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN
1110 TRY REAL_ARITH_TAC THEN REPEAT STRIP_TAC THEN
1111 ASM_CASES_TAC `drop a <= drop x` THENL
1112 [EXISTS_TAC `x - a:real^1` THEN
1113 REWRITE_TAC[VECTOR_ARITH `a + x - a:real^1 = x`; DROP_SUB] THEN
1114 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1116 EXISTS_TAC `vec 1 + x - a:real^1` THEN
1117 REWRITE_TAC[VECTOR_ARITH `a + (v + x - a) - v:real^1 = x`] THEN
1118 REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN
1119 ASM_CASES_TAC `x:real^1 = vec 0` THEN
1120 ASM_REWRITE_TAC[VECTOR_ARITH `a + v + x - a:real^1 = v + x`] THEN
1121 ASM_REWRITE_TAC[VECTOR_ADD_RID; DROP_VEC; COND_ID] THEN
1122 ASM_REWRITE_TAC[REAL_ARITH `a + &1 + x - a <= &1 <=> x <= &0`] THEN
1123 REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
1124 TRY(COND_CASES_TAC THEN POP_ASSUM MP_TAC) THEN REWRITE_TAC[] THEN
1127 let SIMPLE_PATH_SHIFTPATH = prove
1128 (`!g a. simple_path g /\ pathfinish g = pathstart g /\
1129 a IN interval[vec 0,vec 1]
1130 ==> simple_path(shiftpath a g)`,
1131 REPEAT GEN_TAC THEN REWRITE_TAC[simple_path] THEN
1133 `(a /\ c /\ d ==> e) /\ (b /\ c /\ d ==> f)
1134 ==> (a /\ b) /\ c /\ d ==> e /\ f`) THEN
1135 CONJ_TAC THENL [MESON_TAC[PATH_SHIFTPATH]; ALL_TAC] THEN
1136 REWRITE_TAC[simple_path; shiftpath; IN_INTERVAL_1; DROP_VEC;
1137 DROP_ADD; DROP_SUB] THEN
1138 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1139 ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
1140 STRIP_TAC THEN REPEAT GEN_TAC THEN
1141 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
1142 DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN
1143 REPEAT(POP_ASSUM MP_TAC) THEN
1144 REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; GSYM DROP_EQ] THEN
1147 (* ------------------------------------------------------------------------- *)
1148 (* Choosing a sub-path of an existing path. *)
1149 (* ------------------------------------------------------------------------- *)
1151 let subpath = new_definition
1152 `subpath u v g = \x. g(u + drop(v - u) % x)`;;
1154 let SUBPATH_SCALING_LEMMA = prove
1156 IMAGE (\x. u + drop(v - u) % x) (interval[vec 0,vec 1]) = segment[u,v]`,
1157 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
1158 REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; SEGMENT_1] THEN
1159 REWRITE_TAC[DROP_SUB; REAL_SUB_LE; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN
1160 CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN
1161 ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1162 BINOP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN
1163 REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN VECTOR_ARITH_TAC);;
1165 let PATH_IMAGE_SUBPATH_GEN = prove
1166 (`!u v g:real^1->real^N. path_image(subpath u v g) = IMAGE g (segment[u,v])`,
1167 REPEAT GEN_TAC THEN REWRITE_TAC[path_image; subpath] THEN
1168 ONCE_REWRITE_TAC[GSYM o_DEF] THEN
1169 REWRITE_TAC[IMAGE_o; SUBPATH_SCALING_LEMMA]);;
1171 let PATH_IMAGE_SUBPATH = prove
1172 (`!u v g:real^1->real^N.
1174 ==> path_image(subpath u v g) = IMAGE g (interval[u,v])`,
1175 SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1]);;
1177 let PATH_SUBPATH = prove
1178 (`!u v g:real^1->real^N.
1179 path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
1180 ==> path(subpath u v g)`,
1181 REWRITE_TAC[path; subpath] THEN REPEAT STRIP_TAC THEN
1182 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
1183 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
1184 CONTINUOUS_ON_CONST] THEN
1185 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1186 CONTINUOUS_ON_SUBSET)) THEN
1187 REWRITE_TAC[SUBPATH_SCALING_LEMMA; SEGMENT_1] THEN
1188 COND_CASES_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN
1189 REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1192 let PATHSTART_SUBPATH = prove
1193 (`!u v g:real^1->real^N. pathstart(subpath u v g) = g(u)`,
1194 REWRITE_TAC[pathstart; subpath; VECTOR_MUL_RZERO; VECTOR_ADD_RID]);;
1196 let PATHFINISH_SUBPATH = prove
1197 (`!u v g:real^1->real^N. pathfinish(subpath u v g) = g(v)`,
1198 REWRITE_TAC[pathfinish; subpath; GSYM LIFT_EQ_CMUL] THEN
1199 REWRITE_TAC[LIFT_DROP; VECTOR_ARITH `u + v - u:real^N = v`]);;
1201 let SUBPATH_TRIVIAL = prove
1202 (`!g. subpath (vec 0) (vec 1) g = g`,
1203 REWRITE_TAC[subpath; VECTOR_SUB_RZERO; DROP_VEC; VECTOR_MUL_LID;
1204 VECTOR_ADD_LID; ETA_AX]);;
1206 let SUBPATH_REVERSEPATH = prove
1207 (`!g. subpath (vec 1) (vec 0) g = reversepath g`,
1208 REWRITE_TAC[subpath; reversepath; VECTOR_SUB_LZERO; DROP_NEG; DROP_VEC] THEN
1209 REWRITE_TAC[VECTOR_ARITH `a + -- &1 % b:real^N = a - b`]);;
1211 let REVERSEPATH_SUBPATH = prove
1212 (`!g u v. reversepath(subpath u v g) = subpath v u g`,
1213 REWRITE_TAC[reversepath; subpath; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
1214 AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_SUB_LDISTRIB] THEN
1215 REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_SUB; LIFT_DROP] THEN
1218 let SUBPATH_TRANSLATION = prove
1219 (`!a g u v. subpath u v ((\x. a + x) o g) = (\x. a + x) o subpath u v g`,
1220 REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);;
1222 add_translation_invariants [SUBPATH_TRANSLATION];;
1224 let SUBPATH_LINEAR_IMAGE = prove
1225 (`!f g u v. linear f ==> subpath u v (f o g) = f o subpath u v g`,
1226 REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);;
1228 add_linear_invariants [SUBPATH_LINEAR_IMAGE];;
1230 let SIMPLE_PATH_SUBPATH_EQ = prove
1231 (`!g u v. simple_path(subpath u v g) <=>
1232 path(subpath u v g) /\ ~(u = v) /\
1233 (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
1234 ==> x = y \/ x = u /\ y = v \/ x = v /\ y = u)`,
1235 REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; subpath] THEN AP_TERM_TAC THEN
1236 REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN
1237 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
1238 REWRITE_TAC[VECTOR_ARITH `u + a % x = u <=> a % x = vec 0`;
1239 VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
1240 REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_LCANCEL] THEN
1241 REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB;
1242 REAL_RING `u + (v - u) * y = v <=> v = u \/ y = &1`] THEN
1243 REWRITE_TAC[REAL_SUB_0; DROP_EQ; GSYM DROP_VEC] THEN
1244 ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN
1245 REWRITE_TAC[REAL_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
1246 REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
1247 DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN
1248 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN
1249 CONV_TAC REAL_RAT_REDUCE_CONV);;
1251 let ARC_SUBPATH_EQ = prove
1252 (`!g u v. arc(subpath u v g) <=>
1253 path(subpath u v g) /\ ~(u = v) /\
1254 (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
1256 REPEAT GEN_TAC THEN REWRITE_TAC[arc; subpath] THEN AP_TERM_TAC THEN
1257 REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN
1258 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
1259 REWRITE_TAC[VECTOR_ARITH `u + a % x = u + a % y <=> a % (x - y) = vec 0`;
1260 VECTOR_MUL_EQ_0; DROP_EQ_0; VECTOR_SUB_EQ] THEN
1261 ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN
1262 REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
1263 REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
1264 DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN
1265 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN
1266 CONV_TAC REAL_RAT_REDUCE_CONV);;
1268 let SIMPLE_PATH_SUBPATH = prove
1269 (`!g u v. simple_path g /\
1270 u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
1272 ==> simple_path(subpath u v g)`,
1273 SIMP_TAC[SIMPLE_PATH_SUBPATH_EQ; PATH_SUBPATH; SIMPLE_PATH_IMP_PATH] THEN
1274 REWRITE_TAC[simple_path] THEN GEN_TAC THEN
1275 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
1276 REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
1277 CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
1278 SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN
1279 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
1280 STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
1281 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
1283 `!x:real^1. x IN interval[u,v] ==> x IN interval[vec 0,vec 1]`
1285 [REWRITE_TAC[GSYM SUBSET; SUBSET_INTERVAL_1] THEN
1286 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_TRANS];
1287 ASM_SIMP_TAC[]] THEN
1288 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1289 REWRITE_TAC[DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);;
1291 let ARC_SIMPLE_PATH_SUBPATH = prove
1292 (`!g u v. simple_path g /\
1293 u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
1295 ==> arc(subpath u v g)`,
1296 REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN
1297 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1298 ASM_MESON_TAC[SIMPLE_PATH_SUBPATH]);;
1300 let ARC_SUBPATH_ARC = prove
1302 u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\
1304 ==> arc(subpath u v g)`,
1305 REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
1306 ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH; arc]);;
1308 let ARC_SIMPLE_PATH_SUBPATH_INTERIOR = prove
1309 (`!g u v. simple_path g /\
1310 u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
1311 ~(u = v) /\ abs(drop u - drop v) < &1
1312 ==> arc(subpath u v g)`,
1313 REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
1314 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1315 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN
1316 DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o CONJUNCT2) THEN
1317 ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
1318 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
1319 STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);;
1321 let PATH_IMAGE_SUBPATH_SUBSET = prove
1322 (`!u v g:real^1->real^N.
1323 path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
1324 ==> path_image(subpath u v g) SUBSET path_image g`,
1325 SIMP_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REPEAT STRIP_TAC THEN
1326 REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
1327 SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1328 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;
1330 let JOIN_SUBPATHS_MIDDLE = prove
1331 (`!p:real^1->real^N.
1332 subpath (vec 0) (lift(&1 / &2)) p ++ subpath (lift(&1 / &2)) (vec 1) p = p`,
1333 REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
1334 REWRITE_TAC[joinpaths; subpath] THEN COND_CASES_TAC THEN AP_TERM_TAC THEN
1335 REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_CMUL; LIFT_DROP;
1339 (* ------------------------------------------------------------------------- *)
1340 (* Some additional lemmas about choosing sub-paths. *)
1341 (* ------------------------------------------------------------------------- *)
1343 let EXISTS_SUBPATH_OF_PATH = prove
1345 path g /\ a IN path_image g /\ b IN path_image g
1346 ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\
1347 path_image h SUBSET path_image g`,
1348 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
1349 GEN_TAC THEN DISCH_TAC THEN
1350 X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
1351 X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN
1352 EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
1353 ASM_REWRITE_TAC[GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
1354 ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1355 REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
1356 SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1357 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;
1359 let EXISTS_SUBPATH_OF_ARC_NOENDS = prove
1361 arc g /\ a IN path_image g /\ b IN path_image g /\
1362 {a,b} INTER {pathstart g,pathfinish g} = {}
1363 ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\
1365 (path_image g) DIFF {pathstart g,pathfinish g}`,
1366 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
1367 GEN_TAC THEN DISCH_TAC THEN
1368 X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
1369 X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN DISCH_TAC THEN
1370 EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
1371 ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
1372 ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
1373 REWRITE_TAC[path_image; pathstart; pathfinish] THEN
1374 REWRITE_TAC[SET_RULE
1375 `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN
1376 REWRITE_TAC[IN_IMAGE] THEN
1377 SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])`
1378 STRIP_ASSUME_TAC THENL
1379 [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1380 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
1381 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1382 SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN
1383 REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN
1384 RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1387 SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL
1388 [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1389 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET];
1391 RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1392 SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\
1393 (vec 1:real^1) IN interval[vec 0,vec 1]`
1395 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
1398 let EXISTS_SUBARC_OF_ARC_NOENDS = prove
1400 arc g /\ a IN path_image g /\ b IN path_image g /\ ~(a = b) /\
1401 {a,b} INTER {pathstart g,pathfinish g} = {}
1402 ==> ?h. arc h /\ pathstart h = a /\ pathfinish h = b /\
1404 (path_image g) DIFF {pathstart g,pathfinish g}`,
1405 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
1406 GEN_TAC THEN DISCH_TAC THEN
1407 X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
1408 X_GEN_TAC `v:real^1` THEN REPEAT DISCH_TAC THEN
1409 EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
1410 ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
1411 ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
1413 [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
1414 ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH];
1416 REWRITE_TAC[path_image; pathstart; pathfinish] THEN
1417 REWRITE_TAC[SET_RULE
1418 `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN
1419 REWRITE_TAC[IN_IMAGE] THEN
1420 SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])`
1421 STRIP_ASSUME_TAC THENL
1422 [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1423 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
1424 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1425 SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN
1426 REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN
1427 RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1430 SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL
1431 [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1432 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET];
1434 RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1435 SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\
1436 (vec 1:real^1) IN interval[vec 0,vec 1]`
1438 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
1441 let EXISTS_ARC_PSUBSET_SIMPLE_PATH = prove
1442 (`!g:real^1->real^N.
1443 simple_path g /\ closed s /\ s PSUBSET path_image g
1445 s SUBSET path_image h /\
1446 path_image h SUBSET path_image g`,
1447 REPEAT STRIP_TAC THEN
1448 FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL
1449 [EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
1451 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
1452 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1453 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN
1454 REWRITE_TAC[EXISTS_IN_IMAGE] THEN
1455 DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
1456 ABBREV_TAC `(h:real^1->real^N) = shiftpath u g` THEN
1458 `simple_path(h:real^1->real^N) /\
1459 pathstart h = (g:real^1->real^N) u /\
1460 pathfinish h = (g:real^1->real^N) u /\
1461 path_image h = path_image g`
1463 [EXPAND_TAC "h" THEN
1464 ASM_MESON_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH;
1465 PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH;
1466 IN_INTERVAL_1; DROP_VEC];
1467 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1468 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1469 UNDISCH_THEN `pathstart(h:real^1->real^N) = (g:real^1->real^N) u`
1470 (SUBST_ALL_TAC o SYM)] THEN
1472 `open_in (subtopology euclidean (interval[vec 0,vec 1]))
1473 {x:real^1 | x IN interval[vec 0,vec 1] /\
1474 (h x) IN ((:real^N) DIFF s)}`
1476 [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
1477 ASM_SIMP_TAC[GSYM path; GSYM closed; SIMPLE_PATH_IMP_PATH];
1478 REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o CONJUNCT2)] THEN
1479 REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
1480 DISCH_THEN(fun th ->
1481 MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN
1482 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
1483 REWRITE_TAC[DIST_REAL; VEC_COMPONENT; REAL_SUB_RZERO] THEN
1484 SIMP_TAC[GSYM drop] THEN
1485 ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
1486 DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
1487 ANTS_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
1488 DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
1490 `subpath (lift(min d1 (&1 / &4))) (lift(&1 - min d2 (&1 / &4)))
1491 (h:real^1->real^N)` THEN
1492 REPEAT CONJ_TAC THENL
1493 [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN
1494 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP; LIFT_EQ] THEN
1496 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1497 `s SUBSET t ==> t INTER s SUBSET u ==> s SUBSET u`)) THEN
1498 REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ] THEN
1499 SIMP_TAC[PATH_IMAGE_SUBPATH; LIFT_DROP;
1500 REAL_ARITH `min d1 (&1 / &4) <= &1 - min d2 (&1 / &4)`] THEN
1501 REWRITE_TAC[FORALL_IN_IMAGE; path_image; IN_INTERVAL_1; DROP_VEC] THEN
1502 X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN
1503 REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^1` THEN
1504 ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN
1505 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
1506 ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
1507 MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
1508 ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
1509 ASM_REAL_ARITH_TAC]);;
1511 let EXISTS_DOUBLE_ARC = prove
1512 (`!g:real^1->real^N a b.
1513 simple_path g /\ pathfinish g = pathstart g /\
1514 a IN path_image g /\ b IN path_image g /\ ~(a = b)
1515 ==> ?u d. arc u /\ arc d /\
1516 pathstart u = a /\ pathfinish u = b /\
1517 pathstart d = b /\ pathfinish d = a /\
1518 (path_image u) INTER (path_image d) = {a,b} /\
1519 (path_image u) UNION (path_image d) = path_image g`,
1520 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image] THEN
1521 ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN
1522 X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM path_image] THEN
1523 X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN DISCH_TAC THEN
1524 ABBREV_TAC `h = shiftpath u (g:real^1->real^N)` THEN
1526 `simple_path(h:real^1->real^N) /\
1527 pathstart h = g u /\
1528 pathfinish h = g u /\
1529 path_image h = path_image g`
1530 STRIP_ASSUME_TAC THENL
1531 [EXPAND_TAC "h" THEN
1532 ASM_SIMP_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN
1533 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
1535 ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH];
1536 UNDISCH_THEN `path_image h :real^N->bool = path_image g`
1537 (SUBST_ALL_TAC o SYM)] THEN
1538 UNDISCH_TAC `(b:real^N) IN path_image h` THEN
1539 REWRITE_TAC[IN_IMAGE; path_image; LEFT_IMP_EXISTS_THM] THEN
1540 X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN
1541 MAP_EVERY EXISTS_TAC
1542 [`subpath (vec 0) v (h:real^1->real^N)`;
1543 `subpath v (vec 1) (h:real^1->real^N)`] THEN
1544 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
1545 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1546 UNDISCH_THEN `b = (h:real^1->real^N) v` SUBST_ALL_TAC THEN
1547 STRIP_ASSUME_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]
1548 (ASSUME `(v:real^1) IN interval[vec 0,vec 1]`)) THEN
1549 ASM_SIMP_TAC[ARC_SIMPLE_PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC;
1550 REAL_LE_REFL; REAL_POS; PATH_IMAGE_SUBPATH] THEN
1551 REWRITE_TAC[GSYM IMAGE_UNION; path_image] THEN
1552 UNDISCH_THEN `(h:real^1->real^N)(vec 0) = (g:real^1->real^N) u`
1553 (SUBST_ALL_TAC o SYM) THEN
1555 `interval[vec 0,v] UNION interval[v,vec 1] = interval[vec 0:real^1,vec 1]`
1558 ASM_SIMP_TAC[IMAGE_SUBSET] THEN
1559 MATCH_MP_TAC(SET_RULE
1560 `(!x y. x IN (s UNION t) /\ y IN (s UNION t) /\ f x = f y
1561 ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0) /\
1562 (f(vec 0) = f(vec 1)) /\ (vec 0) IN s /\ (vec 1) IN t /\
1564 ==> IMAGE f s INTER IMAGE f t = {f (vec 0), f c}`) THEN
1565 RULE_ASSUM_TAC(REWRITE_RULE[simple_path]) THEN ASM_REWRITE_TAC[]] THEN
1566 REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_INTER; IN_UNION] THEN
1567 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1568 REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN ASM_REAL_ARITH_TAC);;
1570 let SUBPATH_TO_FRONTIER_EXPLICIT = prove
1571 (`!g:real^1->real^N s.
1572 path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1573 ==> ?u. u IN interval[vec 0,vec 1] /\
1574 (!x. &0 <= drop x /\ drop x < drop u ==> g x IN interior s) /\
1575 ~(g u IN interior s) /\
1576 (u = vec 0 \/ g u IN closure s)`,
1577 REPEAT STRIP_TAC THEN
1578 MP_TAC(ISPEC `{u | lift u IN interval[vec 0,vec 1] /\
1579 g(lift u) IN closure((:real^N) DIFF s)}`
1580 COMPACT_ATTAINS_INF) THEN
1581 SIMP_TAC[LIFT_DROP; SET_RULE
1582 `(!x. lift(drop x) = x) ==> IMAGE lift {x | P(lift x)} = {x | P x}`] THEN
1584 [RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish; SUBSET;
1585 path_image; FORALL_IN_IMAGE]) THEN
1587 [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
1588 [MATCH_MP_TAC BOUNDED_SUBSET THEN
1589 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
1590 REWRITE_TAC[BOUNDED_INTERVAL] THEN SET_TAC[];
1591 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
1592 ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSED_INTERVAL]];
1593 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
1594 EXISTS_TAC `&1` THEN REWRITE_TAC[LIFT_NUM] THEN
1595 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
1596 MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
1597 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]];
1599 REWRITE_TAC[EXISTS_DROP; FORALL_DROP; IN_ELIM_THM; LIFT_DROP] THEN
1600 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
1601 REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
1602 ASM_REWRITE_TAC[subpath; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
1603 ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN
1604 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
1605 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
1606 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1607 [REPEAT STRIP_TAC THEN
1608 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV
1609 [TAUT `a /\ ~b ==> c <=> a /\ ~c ==> b`]) THEN
1611 FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^1`) THEN DISCH_TAC] THEN
1612 ASM_CASES_TAC `drop u = &0` THEN
1613 ASM_REWRITE_TAC[frontier; IN_DIFF; CLOSURE_APPROACHABLE] THEN
1614 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1615 RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish]) THEN
1616 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
1617 DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN
1618 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1619 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1620 DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1621 DISCH_THEN(MP_TAC o SPEC `lift(max (&0) (drop u - d / &2))`) THEN
1622 REWRITE_TAC[LIFT_DROP; DIST_REAL; GSYM drop] THEN
1623 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC
1624 (MESON[] `P a ==> dist(a,y) < e ==> ?x. P x /\ dist(x,y) < e`) THEN
1625 MATCH_MP_TAC(REWRITE_RULE[SUBSET] INTERIOR_SUBSET) THEN
1626 FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN ASM_ARITH_TAC);;
1628 let SUBPATH_TO_FRONTIER_STRONG = prove
1629 (`!g:real^1->real^N s.
1630 path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1631 ==> ?u. u IN interval[vec 0,vec 1] /\
1632 ~(pathfinish(subpath (vec 0) u g) IN interior s) /\
1634 (!x. x IN interval[vec 0,vec 1] /\ ~(x = vec 1)
1635 ==> (subpath (vec 0) u g x) IN interior s) /\
1636 pathfinish(subpath (vec 0) u g) IN closure s)`,
1637 REPEAT GEN_TAC THEN DISCH_TAC THEN
1638 FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_EXPLICIT) THEN
1639 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
1640 REWRITE_TAC[subpath; pathfinish; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
1641 ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN
1642 STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO] THEN
1643 ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN
1644 X_GEN_TAC `x:real^1` THEN
1645 REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN STRIP_TAC THEN
1646 FIRST_X_ASSUM MATCH_MP_TAC THEN
1647 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
1648 ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL] THEN
1649 REWRITE_TAC[REAL_ARITH `u * x < u <=> &0 < u * (&1 - x)`] THEN
1650 MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_SUB_LT] THEN
1651 ASM_REWRITE_TAC[REAL_LT_LE] THEN
1652 ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]);;
1654 let SUBPATH_TO_FRONTIER = prove
1655 (`!g:real^1->real^N s.
1656 path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1657 ==> ?u. u IN interval[vec 0,vec 1] /\
1658 pathfinish(subpath (vec 0) u g) IN frontier s /\
1659 (path_image(subpath (vec 0) u g) DELETE
1660 pathfinish(subpath (vec 0) u g))
1662 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[frontier; IN_DIFF] THEN
1663 FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_STRONG) THEN
1664 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
1665 ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THENL
1666 [REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1667 RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN STRIP_TAC THEN
1668 ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
1669 REWRITE_TAC[subpath; path_image; VECTOR_SUB_REFL; DROP_VEC;
1670 VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
1672 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1673 REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_DELETE; IMP_CONJ] THEN
1674 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; pathfinish] THEN
1675 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1676 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_MESON_TAC[]]);;
1678 let EXISTS_PATH_SUBPATH_TO_FRONTIER = prove
1679 (`!g:real^1->real^N s.
1680 path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1681 ==> ?h. path h /\ pathstart h = pathstart g /\
1682 (path_image h) SUBSET (path_image g) /\
1683 (path_image h DELETE (pathfinish h)) SUBSET interior s /\
1684 pathfinish h IN frontier s`,
1685 REPEAT GEN_TAC THEN DISCH_TAC THEN
1686 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP SUBPATH_TO_FRONTIER) THEN
1687 EXISTS_TAC `subpath (vec 0) u (g:real^1->real^N)` THEN
1688 ASM_SIMP_TAC[PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL;
1689 PATHSTART_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
1690 REWRITE_TAC[pathstart]);;
1692 let EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED = prove
1693 (`!g:real^1->real^N s.
1694 closed s /\ path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1695 ==> ?h. path h /\ pathstart h = pathstart g /\
1696 (path_image h) SUBSET (path_image g) INTER s /\
1697 pathfinish h IN frontier s`,
1698 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
1699 FIRST_ASSUM(MP_TAC o MATCH_MP EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
1700 MATCH_MP_TAC MONO_EXISTS THEN
1701 REWRITE_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1702 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
1703 `(pathfinish h:real^N) INSERT (path_image h DELETE pathfinish h)` THEN
1704 CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN CONJ_TAC THENL
1705 [ASM_MESON_TAC[frontier; CLOSURE_EQ; IN_DIFF];
1706 ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]]);;
1708 (* ------------------------------------------------------------------------- *)
1709 (* Special case of straight-line paths. *)
1710 (* ------------------------------------------------------------------------- *)
1712 let linepath = new_definition
1713 `linepath(a,b) = \x. (&1 - drop x) % a + drop x % b`;;
1715 let LINEPATH_TRANSLATION = prove
1716 (`!a b c. linepath(a + b,a + c) = (\x. a + x) o linepath(b,c)`,
1717 REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;
1719 add_translation_invariants [LINEPATH_TRANSLATION];;
1721 let LINEPATH_LINEAR_IMAGE = prove
1722 (`!f. linear f ==> !b c. linepath(f b,f c) = f o linepath(b,c)`,
1723 REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN
1724 FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_ADD) THEN
1725 FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL) THEN
1726 ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
1728 add_linear_invariants [LINEPATH_LINEAR_IMAGE];;
1730 let PATHSTART_LINEPATH = prove
1731 (`!a b. pathstart(linepath(a,b)) = a`,
1732 REWRITE_TAC[linepath; pathstart; DROP_VEC] THEN VECTOR_ARITH_TAC);;
1734 let PATHFINISH_LINEPATH = prove
1735 (`!a b. pathfinish(linepath(a,b)) = b`,
1736 REWRITE_TAC[linepath; pathfinish; DROP_VEC] THEN VECTOR_ARITH_TAC);;
1738 let CONTINUOUS_LINEPATH_AT = prove
1739 (`!a b x. linepath(a,b) continuous (at x)`,
1740 REPEAT GEN_TAC THEN REWRITE_TAC[linepath] THEN
1741 REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + y = x + u % --x + y`] THEN
1742 MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
1743 MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN
1744 MATCH_MP_TAC CONTINUOUS_VMUL THEN
1745 REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;
1747 let CONTINUOUS_ON_LINEPATH = prove
1748 (`!a b s. linepath(a,b) continuous_on s`,
1749 MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_LINEPATH_AT]);;
1751 let PATH_LINEPATH = prove
1752 (`!a b. path(linepath(a,b))`,
1753 REWRITE_TAC[path; CONTINUOUS_ON_LINEPATH]);;
1755 let PATH_IMAGE_LINEPATH = prove
1756 (`!a b. path_image(linepath (a,b)) = segment[a,b]`,
1757 REWRITE_TAC[segment; path_image; linepath] THEN
1758 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN
1759 SIMP_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT; ARITH] THEN
1760 REWRITE_TAC[EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]);;
1762 let REVERSEPATH_LINEPATH = prove
1763 (`!a b. reversepath(linepath(a,b)) = linepath(b,a)`,
1764 REWRITE_TAC[reversepath; linepath; DROP_SUB; DROP_VEC; FUN_EQ_THM] THEN
1767 let ARC_LINEPATH = prove
1768 (`!a b. ~(a = b) ==> arc(linepath(a,b))`,
1769 REWRITE_TAC[arc; PATH_LINEPATH] THEN REWRITE_TAC[linepath] THEN
1770 REWRITE_TAC[VECTOR_ARITH
1771 `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
1772 (x - y) % (a - b) = vec 0`] THEN
1773 SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; DROP_EQ; REAL_SUB_0]);;
1775 let SIMPLE_PATH_LINEPATH = prove
1776 (`!a b. ~(a = b) ==> simple_path(linepath(a,b))`,
1777 MESON_TAC[ARC_IMP_SIMPLE_PATH; ARC_LINEPATH]);;
1779 let SIMPLE_PATH_LINEPATH_EQ = prove
1780 (`!a b:real^N. simple_path(linepath(a,b)) <=> ~(a = b)`,
1781 REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIMPLE_PATH_LINEPATH] THEN
1782 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[simple_path] THEN
1783 DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
1784 REWRITE_TAC[linepath; GSYM VECTOR_ADD_RDISTRIB] THEN
1785 DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]) THEN
1786 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN
1787 CONV_TAC REAL_RAT_REDUCE_CONV);;
1789 let ARC_LINEPATH_EQ = prove
1790 (`!a b. arc(linepath(a,b)) <=> ~(a = b)`,
1791 REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ARC_LINEPATH] THEN
1792 MESON_TAC[SIMPLE_PATH_LINEPATH_EQ; ARC_IMP_SIMPLE_PATH]);;
1794 let LINEPATH_REFL = prove
1795 (`!a. linepath(a,a) = \x. a`,
1796 REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`]);;
1798 let SHIFTPATH_TRIVIAL = prove
1799 (`!t a. shiftpath t (linepath(a,a)) = linepath(a,a)`,
1800 REWRITE_TAC[shiftpath; LINEPATH_REFL; COND_ID]);;
1802 let SUBPATH_REFL = prove
1803 (`!g a. subpath a a g = linepath(g a,g a)`,
1804 REWRITE_TAC[subpath; linepath; VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO;
1805 FUN_EQ_THM; VECTOR_ADD_RID] THEN
1808 (* ------------------------------------------------------------------------- *)
1809 (* Bounding a point away from a path. *)
1810 (* ------------------------------------------------------------------------- *)
1812 let NOT_ON_PATH_BALL = prove
1814 path g /\ ~(z IN path_image g)
1815 ==> ?e. &0 < e /\ ball(z,e) INTER (path_image g) = {}`,
1816 REPEAT STRIP_TAC THEN
1817 MP_TAC(ISPECL [`path_image g:real^N->bool`; `z:real^N`]
1818 DISTANCE_ATTAINS_INF) THEN
1819 REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN
1820 ASM_SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED] THEN
1821 DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
1822 EXISTS_TAC `dist(z:real^N,a)` THEN
1823 CONJ_TAC THENL [ASM_MESON_TAC[DIST_POS_LT]; ALL_TAC] THEN
1824 REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_BALL; IN_INTER] THEN
1825 ASM_MESON_TAC[REAL_NOT_LE]);;
1827 let NOT_ON_PATH_CBALL = prove
1829 path g /\ ~(z IN path_image g)
1830 ==> ?e. &0 < e /\ cball(z,e) INTER (path_image g) = {}`,
1831 REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NOT_ON_PATH_BALL) THEN
1832 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1833 EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
1834 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1835 `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
1836 REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN
1837 UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);;
1839 (* ------------------------------------------------------------------------- *)
1840 (* Homeomorphisms of arc images. *)
1841 (* ------------------------------------------------------------------------- *)
1843 let HOMEOMORPHISM_ARC = prove
1844 (`!g:real^1->real^N.
1845 arc g ==> ?h. homeomorphism (interval[vec 0,vec 1],path_image g) (g,h)`,
1846 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
1847 ASM_REWRITE_TAC[path_image; COMPACT_INTERVAL; GSYM path; GSYM arc]);;
1849 let HOMEOMORPHIC_ARC_IMAGE_INTERVAL = prove
1850 (`!g:real^1->real^N a b:real^1.
1851 arc g /\ drop a < drop b ==> (path_image g) homeomorphic interval[a,b]`,
1852 REPEAT STRIP_TAC THEN
1853 TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN
1855 [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
1856 EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[HOMEOMORPHISM_ARC];
1857 MATCH_MP_TAC HOMEOMORPHIC_CLOSED_INTERVALS THEN
1858 ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; REAL_LT_01]]);;
1860 let HOMEOMORPHIC_ARC_IMAGES = prove
1861 (`!g:real^1->real^M h:real^1->real^N.
1862 arc g /\ arc h ==> (path_image g) homeomorphic (path_image h)`,
1863 REPEAT STRIP_TAC THEN
1864 TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN
1865 CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
1866 MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGE_INTERVAL THEN
1867 ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01]);;
1869 let HOMEOMORPHIC_ARC_IMAGE_SEGMENT = prove
1870 (`!g:real^1->real^N a b:real^M.
1871 arc g /\ ~(a = b) ==> (path_image g) homeomorphic segment[a,b]`,
1872 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN
1873 MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGES THEN
1874 ASM_REWRITE_TAC[ARC_LINEPATH_EQ]);;
1876 (* ------------------------------------------------------------------------- *)
1877 (* Path component, considered as a "joinability" relation (from Tom Hales). *)
1878 (* ------------------------------------------------------------------------- *)
1880 let path_component = new_definition
1881 `path_component s x y <=>
1882 ?g. path g /\ path_image g SUBSET s /\
1883 pathstart g = x /\ pathfinish g = y`;;
1885 let PATH_COMPONENT_IN = prove
1886 (`!s x y. path_component s x y ==> x IN s /\ y IN s`,
1887 REWRITE_TAC[path_component; path_image; pathstart; pathfinish] THEN
1888 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
1889 REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN
1890 FIRST_X_ASSUM MATCH_MP_TAC THEN
1891 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_REFL; REAL_POS]);;
1893 let PATH_COMPONENT_REFL = prove
1894 (`!s x:real^N. x IN s ==> path_component s x x`,
1895 REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN
1896 EXISTS_TAC `(\u. x):real^1->real^N` THEN
1897 REWRITE_TAC[pathstart; pathfinish; path_image; path;
1898 CONTINUOUS_ON_CONST; IMAGE; FORALL_IN_IMAGE] THEN
1899 REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]);;
1901 let PATH_COMPONENT_REFL_EQ = prove
1902 (`!s x:real^N. path_component s x x <=> x IN s`,
1903 MESON_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_REFL]);;
1905 let PATH_COMPONENT_SYM = prove
1906 (`!s x y:real^N. path_component s x y ==> path_component s y x`,
1907 REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN
1908 MESON_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
1909 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);;
1911 let PATH_COMPONENT_SYM_EQ = prove
1912 (`!s x y. path_component s x y <=> path_component s y x`,
1913 MESON_TAC[PATH_COMPONENT_SYM]);;
1915 let PATH_COMPONENT_TRANS = prove
1917 path_component s x y /\ path_component s y z ==> path_component s x z`,
1918 REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN
1919 DISCH_THEN(CONJUNCTS_THEN2
1920 (X_CHOOSE_TAC `g1:real^1->real^N`) (X_CHOOSE_TAC `g2:real^1->real^N`)) THEN
1921 EXISTS_TAC `g1 ++ g2 :real^1->real^N` THEN
1922 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET;
1923 PATHSTART_JOIN; PATHFINISH_JOIN]);;
1925 let PATH_COMPONENT_OF_SUBSET = prove
1926 (`!s t x. s SUBSET t /\ path_component s x y ==> path_component t x y`,
1927 REWRITE_TAC[path_component] THEN SET_TAC[]);;
1929 (* ------------------------------------------------------------------------- *)
1930 (* Can also consider it as a set, as the name suggests. *)
1931 (* ------------------------------------------------------------------------- *)
1933 let PATH_COMPONENT_SET = prove
1934 (`!s x. path_component s x =
1935 { y | ?g. path g /\ path_image g SUBSET s /\
1936 pathstart g = x /\ pathfinish g = y }`,
1937 REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN; path_component]);;
1939 let PATH_COMPONENT_SUBSET = prove
1940 (`!s x. (path_component s x) SUBSET s`,
1941 REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[PATH_COMPONENT_IN; IN]);;
1943 let PATH_COMPONENT_EQ_EMPTY = prove
1944 (`!s x. path_component s x = {} <=> ~(x IN s)`,
1945 REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
1946 MESON_TAC[IN; PATH_COMPONENT_REFL; PATH_COMPONENT_IN]);;
1948 let PATH_COMPONENT_EMPTY = prove
1949 (`!x. path_component {} x = {}`,
1950 REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);;
1952 let UNIONS_PATH_COMPONENT = prove
1953 (`!s:real^N->bool. UNIONS {path_component s x |x| x IN s} = s`,
1954 GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
1955 REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; PATH_COMPONENT_SUBSET] THEN
1956 REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN
1957 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
1958 ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
1959 ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ]);;
1961 let PATH_COMPONENT_TRANSLATION = prove
1962 (`!a s x. path_component (IMAGE (\x. a + x) s) (a + x) =
1963 IMAGE (\x. a + x) (path_component s x)`,
1964 REWRITE_TAC[PATH_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);;
1966 add_translation_invariants [PATH_COMPONENT_TRANSLATION];;
1968 let PATH_COMPONENT_LINEAR_IMAGE = prove
1969 (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
1970 ==> path_component (IMAGE f s) (f x) =
1971 IMAGE f (path_component s x)`,
1972 REWRITE_TAC[PATH_COMPONENT_SET] THEN
1973 GEOM_TRANSFORM_TAC[]);;
1975 add_linear_invariants [PATH_COMPONENT_LINEAR_IMAGE];;
1977 (* ------------------------------------------------------------------------- *)
1978 (* Path connectedness of a space. *)
1979 (* ------------------------------------------------------------------------- *)
1981 let path_connected = new_definition
1982 `path_connected s <=>
1983 !x y. x IN s /\ y IN s
1984 ==> ?g. path g /\ (path_image g) SUBSET s /\
1985 pathstart g = x /\ pathfinish g = y`;;
1987 let PATH_CONNECTED_IFF_PATH_COMPONENT = prove
1988 (`!s. path_connected s <=> !x y. x IN s /\ y IN s ==> path_component s x y`,
1989 REWRITE_TAC[path_connected; path_component]);;
1991 let PATH_CONNECTED_COMPONENT_SET = prove
1992 (`!s. path_connected s <=> !x. x IN s ==> path_component s x = s`,
1993 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; GSYM SUBSET_ANTISYM_EQ] THEN
1994 REWRITE_TAC[PATH_COMPONENT_SUBSET] THEN SET_TAC[]);;
1996 let PATH_COMPONENT_MONO = prove
1997 (`!s t x. s SUBSET t ==> (path_component s x) SUBSET (path_component t x)`,
1998 REWRITE_TAC[PATH_COMPONENT_SET] THEN SET_TAC[]);;
2000 let PATH_COMPONENT_MAXIMAL = prove
2001 (`!s t x. x IN t /\ path_connected t /\ t SUBSET s
2002 ==> t SUBSET (path_component s x)`,
2003 REWRITE_TAC[path_connected; PATH_COMPONENT_SET; SUBSET; IN_ELIM_THM] THEN
2006 let PATH_COMPONENT_EQ = prove
2007 (`!s x y. y IN path_component s x
2008 ==> path_component s y = path_component s x`,
2009 REWRITE_TAC[EXTENSION; IN] THEN
2010 MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);;
2012 let PATH_COMPONENT_PATH_IMAGE_PATHSTART = prove
2014 path p /\ x IN path_image p
2015 ==> path_component (path_image p) (pathstart p) x`,
2016 REWRITE_TAC[path_image; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2017 REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^1 = vec 0` THENL
2018 [ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC PATH_COMPONENT_REFL THEN
2019 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
2020 REWRITE_TAC[DROP_VEC; REAL_POS];
2022 REWRITE_TAC[path_component] THEN
2023 EXISTS_TAC `\y. (p:real^1->real^N)(drop x % y)` THEN
2024 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
2025 REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
2026 [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
2027 ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
2028 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN
2029 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET);
2030 ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN
2031 MATCH_MP_TAC IMAGE_SUBSET;
2032 AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN
2033 REWRITE_TAC[REAL_MUL_RID]] THEN
2034 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
2035 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
2036 SIMP_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_LE_MUL] THEN
2037 REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2038 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);;
2040 let PATH_CONNECTED_PATH_IMAGE = prove
2041 (`!p:real^1->real^N. path p ==> path_connected(path_image p)`,
2042 REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
2043 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
2044 MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
2045 EXISTS_TAC `pathstart p :real^N` THEN
2046 ASM_MESON_TAC[PATH_COMPONENT_PATH_IMAGE_PATHSTART; PATH_COMPONENT_SYM]);;
2048 let PATH_CONNECTED_PATH_COMPONENT = prove
2049 (`!s x:real^N. path_connected(path_component s x)`,
2050 REPEAT GEN_TAC THEN REWRITE_TAC[path_connected; IN] THEN
2051 MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN
2052 SUBGOAL_THEN `path_component s y (z:real^N)` MP_TAC THENL
2053 [ASM_MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]; ALL_TAC] THEN
2054 REWRITE_TAC[path_component] THEN
2055 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->real^N` THEN
2056 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN
2057 X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN
2058 SUBGOAL_THEN `path_component s (x:real^N) = path_component s y`
2059 SUBST1_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_EQ; IN]; ALL_TAC] THEN
2060 MP_TAC(ISPECL [`p:real^1->real^N`; `w:real^N`]
2061 PATH_COMPONENT_PATH_IMAGE_PATHSTART) THEN
2062 ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
2063 FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_MONO) THEN
2064 REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]);;
2066 let PATH_COMPONENT = prove
2068 path_component s x y <=>
2069 ?t. path_connected t /\ t SUBSET s /\ x IN t /\ y IN t`,
2070 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
2071 [EXISTS_TAC `path_component s (x:real^N)` THEN
2072 REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT; PATH_COMPONENT_SUBSET] THEN
2073 FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_IN) THEN
2074 ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL_EQ];
2075 REWRITE_TAC[path_component] THEN ASM_MESON_TAC[path_connected; SUBSET]]);;
2077 let PATH_COMPONENT_PATH_COMPONENT = prove
2079 path_component (path_component s x) x = path_component s x`,
2081 ASM_CASES_TAC `(x:real^N) IN s` THENL
2082 [MATCH_MP_TAC SUBSET_ANTISYM THEN
2083 SIMP_TAC[PATH_COMPONENT_MONO; PATH_COMPONENT_SUBSET] THEN
2084 MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
2085 REWRITE_TAC[SUBSET_REFL; PATH_CONNECTED_PATH_COMPONENT] THEN
2086 ASM_REWRITE_TAC[IN; PATH_COMPONENT_REFL_EQ];
2087 MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN
2088 ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
2089 ASM_MESON_TAC[SUBSET; PATH_COMPONENT_SUBSET]]);;
2091 let PATH_CONNECTED_LINEPATH = prove
2092 (`!s a b:real^N. segment[a,b] SUBSET s ==> path_component s a b`,
2093 REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN
2094 EXISTS_TAC `linepath(a:real^N,b)` THEN
2095 ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
2096 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]);;
2098 let PATH_COMPONENT_DISJOINT = prove
2099 (`!s a b. DISJOINT (path_component s a) (path_component s b) <=>
2100 ~(a IN path_component s b)`,
2101 REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
2102 REWRITE_TAC[IN] THEN MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);;
2104 let PATH_COMPONENT_EQ_EQ = prove
2106 path_component s x = path_component s y <=>
2107 ~(x IN s) /\ ~(y IN s) \/
2108 x IN s /\ y IN s /\ path_component s x y`,
2109 REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL
2110 [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL
2111 [REWRITE_TAC[FUN_EQ_THM] THEN
2112 ASM_MESON_TAC[PATH_COMPONENT_TRANS; PATH_COMPONENT_REFL;
2113 PATH_COMPONENT_SYM];
2114 ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]];
2115 RULE_ASSUM_TAC(REWRITE_RULE[GSYM PATH_COMPONENT_EQ_EMPTY]) THEN
2116 ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
2117 ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN
2118 ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]);;
2120 let PATH_COMPONENT_UNIQUE = prove
2122 x IN c /\ c SUBSET s /\ path_connected c /\
2123 (!c'. x IN c' /\ c' SUBSET s /\ path_connected c'
2125 ==> path_component s x = c`,
2126 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
2127 [FIRST_X_ASSUM MATCH_MP_TAC THEN
2128 REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
2129 REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
2131 MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);;
2133 let PATH_COMPONENT_INTERMEDIATE_SUBSET = prove
2135 path_component u a SUBSET t /\ t SUBSET u
2136 ==> path_component t a = path_component u a`,
2137 REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL
2138 [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN
2139 ASM_REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
2140 CONJ_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_REFL; IN]; ALL_TAC] THEN
2141 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
2143 ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET]]);;
2145 let COMPLEMENT_PATH_COMPONENT_UNIONS = prove
2147 s DIFF path_component s x =
2148 UNIONS({path_component s y | y | y IN s} DELETE (path_component s x))`,
2150 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_PATH_COMPONENT] THEN
2151 MATCH_MP_TAC(SET_RULE
2152 `(!x. x IN s DELETE a ==> DISJOINT a x)
2153 ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN
2154 REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
2155 SIMP_TAC[PATH_COMPONENT_DISJOINT; PATH_COMPONENT_EQ_EQ] THEN
2156 MESON_TAC[IN; SUBSET; PATH_COMPONENT_SUBSET]);;
2158 (* ------------------------------------------------------------------------- *)
2159 (* General "locally connected implies connected" type results. *)
2160 (* ------------------------------------------------------------------------- *)
2162 let OPEN_GENERAL_COMPONENT = prove
2163 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2164 (!s x y. c s x y ==> c s y x) /\
2165 (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2166 (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2167 (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2168 ==> c (ball(x,e)) x y)
2169 ==> !s x:real^N. open s ==> open(c s x)`,
2170 GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
2171 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
2172 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
2173 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
2174 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
2175 DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
2176 REWRITE_TAC[SUBSET; IN] THEN STRIP_TAC THEN
2177 SUBGOAL_THEN `(x:real^N) IN s /\ y IN s` STRIP_ASSUME_TAC THENL
2178 [ASM_MESON_TAC[]; ALL_TAC] THEN
2179 FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
2180 MATCH_MP_TAC MONO_EXISTS THEN
2181 X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2182 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
2183 REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN
2184 ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
2185 EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
2186 REMOVE_THEN "BALL" MATCH_MP_TAC THEN
2187 REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;
2189 let OPEN_NON_GENERAL_COMPONENT = prove
2190 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2191 (!s x y. c s x y ==> c s y x) /\
2192 (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2193 (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2194 (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2195 ==> c (ball(x,e)) x y)
2196 ==> !s x:real^N. open s ==> open(s DIFF c s x)`,
2197 GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
2198 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
2199 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
2200 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
2201 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
2202 DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN
2203 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[IN])) THEN
2204 FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
2205 MATCH_MP_TAC MONO_EXISTS THEN
2206 X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2207 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
2208 REWRITE_TAC[IN] THEN DISCH_TAC THEN
2209 FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN
2210 REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN
2211 ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
2212 EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
2213 REMOVE_THEN "SYM" MATCH_MP_TAC THEN
2214 REMOVE_THEN "BALL" MATCH_MP_TAC THEN
2215 REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;
2217 let GENERAL_CONNECTED_OPEN = prove
2218 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2219 (!s x y. c s x y ==> c s y x) /\
2220 (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2221 (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2222 (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2223 ==> c (ball(x,e)) x y)
2224 ==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s
2226 REPEAT STRIP_TAC THEN
2227 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
2228 REWRITE_TAC[IN] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN
2229 MAP_EVERY EXISTS_TAC
2230 [`c (s:real^N->bool) (x:real^N):real^N->bool`;
2231 `s DIFF (c (s:real^N->bool) (x:real^N))`] THEN
2232 MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g)
2233 ==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN
2234 REPEAT CONJ_TAC THENL
2235 [MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
2236 OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
2237 MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
2238 OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
2243 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
2244 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
2245 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2246 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
2247 ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN
2248 FIRST_ASSUM(MATCH_MP_TAC o
2249 SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN
2250 ASM_MESON_TAC[CENTRE_IN_BALL]);;
2252 (* ------------------------------------------------------------------------- *)
2253 (* Some useful lemmas about path-connectedness. *)
2254 (* ------------------------------------------------------------------------- *)
2256 let CONVEX_IMP_PATH_CONNECTED = prove
2257 (`!s:real^N->bool. convex s ==> path_connected s`,
2258 REWRITE_TAC[CONVEX_ALT; path_connected] THEN REPEAT GEN_TAC THEN
2259 DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
2260 STRIP_TAC THEN EXISTS_TAC `\u. (&1 - drop u) % x + drop u % y:real^N` THEN
2261 ASM_SIMP_TAC[pathstart; pathfinish; DROP_VEC; path; path_image;
2262 SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN
2263 CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN VECTOR_ARITH_TAC] THEN
2264 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
2265 MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
2266 REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
2267 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;
2269 let PATH_CONNECTED_UNIV = prove
2270 (`path_connected(:real^N)`,
2271 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV]);;
2273 let IS_INTERVAL_PATH_CONNECTED = prove
2274 (`!s. is_interval s ==> path_connected s`,
2275 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; IS_INTERVAL_CONVEX]);;
2277 let PATH_CONNECTED_INTERVAL = prove
2278 (`(!a b:real^N. path_connected(interval[a,b])) /\
2279 (!a b:real^N. path_connected(interval(a,b)))`,
2280 SIMP_TAC[IS_INTERVAL_PATH_CONNECTED; IS_INTERVAL_INTERVAL]);;
2282 let PATH_COMPONENT_UNIV = prove
2283 (`!x. path_component(:real^N) x = (:real^N)`,
2284 MESON_TAC[PATH_CONNECTED_COMPONENT_SET; PATH_CONNECTED_UNIV; IN_UNIV]);;
2286 let PATH_CONNECTED_IMP_CONNECTED = prove
2287 (`!s:real^N->bool. path_connected s ==> connected s`,
2289 REWRITE_TAC[path_connected; CONNECTED_IFF_CONNECTED_COMPONENT] THEN
2290 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
2291 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN
2292 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
2293 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
2294 REWRITE_TAC[connected_component] THEN
2295 EXISTS_TAC `path_image(g:real^1->real^N)` THEN
2296 ASM_MESON_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE;
2297 PATHFINISH_IN_PATH_IMAGE]);;
2299 let OPEN_PATH_COMPONENT = prove
2300 (`!s x:real^N. open s ==> open(path_component s x)`,
2301 MATCH_MP_TAC OPEN_GENERAL_COMPONENT THEN
2302 REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
2303 PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
2304 MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
2305 (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
2306 ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;
2308 let OPEN_NON_PATH_COMPONENT = prove
2309 (`!s x:real^N. open s ==> open(s DIFF path_component s x)`,
2310 MATCH_MP_TAC OPEN_NON_GENERAL_COMPONENT THEN
2311 REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
2312 PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
2313 MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
2314 (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
2315 ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;
2317 let PATH_CONNECTED_CONTINUOUS_IMAGE = prove
2318 (`!f:real^M->real^N s.
2319 f continuous_on s /\ path_connected s ==> path_connected (IMAGE f s)`,
2320 REPEAT GEN_TAC THEN REWRITE_TAC[path_connected] THEN STRIP_TAC THEN
2321 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2322 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
2323 X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
2324 FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
2325 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
2326 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
2327 EXISTS_TAC `(f:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL
2328 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2329 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
2330 ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;
2332 let HOMEOMORPHIC_PATH_CONNECTEDNESS = prove
2333 (`!s t. s homeomorphic t ==> (path_connected s <=> path_connected t)`,
2334 REWRITE_TAC[homeomorphic; homeomorphism] THEN
2335 MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2337 let PATH_CONNECTED_LINEAR_IMAGE = prove
2338 (`!f:real^M->real^N s.
2339 path_connected s /\ linear f ==> path_connected(IMAGE f s)`,
2340 SIMP_TAC[LINEAR_CONTINUOUS_ON; PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2342 let PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
2343 (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
2344 ==> (path_connected (IMAGE f s) <=> path_connected s)`,
2345 MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE PATH_CONNECTED_LINEAR_IMAGE));;
2347 add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];;
2349 let PATH_CONNECTED_EMPTY = prove
2350 (`path_connected {}`,
2351 REWRITE_TAC[path_connected; NOT_IN_EMPTY]);;
2353 let PATH_CONNECTED_SING = prove
2354 (`!a:real^N. path_connected {a}`,
2355 GEN_TAC THEN REWRITE_TAC[path_connected; IN_SING] THEN
2356 REPEAT STRIP_TAC THEN EXISTS_TAC `linepath(a:real^N,a)` THEN
2357 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
2358 REWRITE_TAC[SEGMENT_REFL; PATH_IMAGE_LINEPATH; SUBSET_REFL]);;
2360 let PATH_CONNECTED_UNION = prove
2361 (`!s t. path_connected s /\ path_connected t /\ ~(s INTER t = {})
2362 ==> path_connected (s UNION t)`,
2363 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
2364 REWRITE_TAC[IN_INTER; IN_UNION] THEN
2365 MESON_TAC[PATH_COMPONENT_OF_SUBSET; SUBSET_UNION; PATH_COMPONENT_TRANS]);;
2367 let PATH_CONNECTED_TRANSLATION = prove
2368 (`!a s. path_connected s ==> path_connected (IMAGE (\x:real^N. a + x) s)`,
2369 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
2370 ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;
2372 let PATH_CONNECTED_TRANSLATION_EQ = prove
2373 (`!a s. path_connected (IMAGE (\x:real^N. a + x) s) <=> path_connected s`,
2374 REWRITE_TAC[path_connected] THEN GEOM_TRANSLATE_TAC[]);;
2376 add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];;
2378 let PATH_CONNECTED_PCROSS = prove
2379 (`!s:real^M->bool t:real^N->bool.
2380 path_connected s /\ path_connected t
2381 ==> path_connected (s PCROSS t)`,
2382 REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; path_connected] THEN DISCH_TAC THEN
2383 REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
2384 MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN
2385 STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2
2386 (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`])
2387 (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN
2388 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2389 X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
2390 X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN
2391 EXISTS_TAC `(\t. pastecart (x1:real^M) ((h:real^1->real^N) t)) ++
2392 (\t. pastecart ((g:real^1->real^M) t) (y2:real^N))` THEN
2393 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path]) THEN
2394 RULE_ASSUM_TAC(REWRITE_RULE[path_image; FORALL_IN_IMAGE; SUBSET]) THEN
2395 REPEAT CONJ_TAC THENL
2396 [MATCH_MP_TAC PATH_JOIN_IMP THEN REPEAT CONJ_TAC THENL
2397 [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2398 ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
2399 REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2400 ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
2401 ASM_REWRITE_TAC[pathstart; pathfinish]];
2402 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
2403 ASM_SIMP_TAC[path_image; FORALL_IN_IMAGE; SUBSET; IN_ELIM_PASTECART_THM];
2404 REWRITE_TAC[PATHSTART_JOIN] THEN ASM_REWRITE_TAC[pathstart];
2405 REWRITE_TAC[PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[pathfinish]]);;
2407 let PATH_CONNECTED_PCROSS_EQ = prove
2408 (`!s:real^M->bool t:real^N->bool.
2409 path_connected(s PCROSS t) <=>
2410 s = {} \/ t = {} \/ path_connected s /\ path_connected t`,
2412 ASM_CASES_TAC `s:real^M->bool = {}` THEN
2413 ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
2414 ASM_CASES_TAC `t:real^N->bool = {}` THEN
2415 ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
2416 EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
2417 [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
2418 `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2419 PATH_CONNECTED_LINEAR_IMAGE) THEN
2420 ASM_REWRITE_TAC[LINEAR_FSTCART];
2421 MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
2422 `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2423 PATH_CONNECTED_LINEAR_IMAGE) THEN
2424 ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
2425 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2426 REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
2427 FSTCART_PASTECART; SNDCART_PASTECART] THEN
2430 let PATH_CONNECTED_SCALING = prove
2431 (`!s:real^N->bool c.
2432 path_connected s ==> path_connected (IMAGE (\x. c % x) s)`,
2433 REPEAT STRIP_TAC THEN
2434 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2435 MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
2436 REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
2437 REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2439 let PATH_CONNECTED_NEGATIONS = prove
2441 path_connected s ==> path_connected (IMAGE (--) s)`,
2442 REPEAT STRIP_TAC THEN
2443 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2444 MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
2445 REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
2446 REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2448 let PATH_CONNECTED_SUMS = prove
2449 (`!s t:real^N->bool.
2450 path_connected s /\ path_connected t
2451 ==> path_connected {x + y | x IN s /\ y IN t}`,
2453 DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_PCROSS) THEN
2454 DISCH_THEN(MP_TAC o ISPEC
2455 `\z. (fstcart z + sndcart z:real^N)` o
2456 MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2457 PATH_CONNECTED_CONTINUOUS_IMAGE)) THEN
2458 SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
2459 LINEAR_SNDCART; PCROSS] THEN
2460 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2461 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN
2462 REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
2465 let IS_INTERVAL_PATH_CONNECTED_1 = prove
2466 (`!s:real^1->bool. is_interval s <=> path_connected s`,
2467 MESON_TAC[CONVEX_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED;
2468 IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1]);;
2470 (* ------------------------------------------------------------------------- *)
2471 (* Bounds on components of a continuous image. *)
2472 (* ------------------------------------------------------------------------- *)
2474 let CARD_LE_PATH_COMPONENTS = prove
2475 (`!f:real^M->real^N s.
2477 ==> {path_component (IMAGE f s) y | y | y IN IMAGE f s}
2478 <=_c {path_component s x | x | x IN s}`,
2479 REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN
2480 SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC
2481 `\c. path_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN
2482 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN
2483 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_EQ THEN
2484 REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[PATH_COMPONENT] THEN
2485 EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s x)` THEN
2486 REPEAT CONJ_TAC THENL
2487 [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
2488 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_COMPONENT_SUBSET;
2489 PATH_CONNECTED_PATH_COMPONENT];
2490 MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[PATH_COMPONENT_SUBSET];
2491 ALL_TAC; ALL_TAC] THEN
2492 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
2493 ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ]);;
2495 let CARD_LE_CONNECTED_COMPONENTS = prove
2496 (`!f:real^M->real^N s.
2498 ==> {connected_component (IMAGE f s) y | y | y IN IMAGE f s}
2499 <=_c {connected_component s x | x | x IN s}`,
2500 REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN
2501 SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC
2502 `\c. connected_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN
2503 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN
2504 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
2505 REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[connected_component] THEN
2506 EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s x)` THEN
2507 REPEAT CONJ_TAC THENL
2508 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
2509 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_COMPONENT_SUBSET;
2510 CONNECTED_CONNECTED_COMPONENT];
2511 MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
2512 ALL_TAC; ALL_TAC] THEN
2513 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
2514 ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ]);;
2516 let CARD_LE_COMPONENTS = prove
2517 (`!f:real^M->real^N s.
2518 f continuous_on s ==> components(IMAGE f s) <=_c components s`,
2519 REWRITE_TAC[components; CARD_LE_CONNECTED_COMPONENTS]);;
2521 (* ------------------------------------------------------------------------- *)
2522 (* More stuff about segments. *)
2523 (* ------------------------------------------------------------------------- *)
2525 let SEGMENT_OPEN_SUBSET_CLOSED = prove
2526 (`!a b. segment(a,b) SUBSET segment[a,b]`,
2527 REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]);;
2529 let BOUNDED_SEGMENT = prove
2530 (`(!a b:real^N. bounded(segment[a,b])) /\
2531 (!a b:real^N. bounded(segment(a,b)))`,
2532 REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2533 MATCH_MP_TAC(MESON[BOUNDED_SUBSET]
2534 `bounded s /\ t SUBSET s ==> bounded s /\ bounded t`) THEN
2535 REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN
2536 MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2537 MATCH_MP_TAC COMPACT_CONVEX_HULL THEN
2538 SIMP_TAC[COMPACT_INSERT; COMPACT_EMPTY]);;
2540 let SEGMENT_IMAGE_INTERVAL = prove
2541 (`(!a b. segment[a,b] =
2542 IMAGE (\u. (&1 - drop u) % a + drop u % b)
2543 (interval[vec 0,vec 1])) /\
2546 IMAGE (\u. (&1 - drop u) % a + drop u % b)
2547 (interval(vec 0,vec 1)))`,
2548 REPEAT STRIP_TAC THEN
2549 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_SEGMENT] THEN
2550 ASM_REWRITE_TAC[GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]);;
2552 let CLOSURE_SEGMENT = prove
2553 (`(!a b:real^N. closure(segment[a,b]) = segment[a,b]) /\
2554 (!a b:real^N. closure(segment(a,b)) = if a = b then {} else segment[a,b])`,
2555 REPEAT STRIP_TAC THENL
2556 [ASM_MESON_TAC[CLOSURE_EQ; COMPACT_IMP_CLOSED; SEGMENT_CONVEX_HULL;
2557 COMPACT_CONVEX_HULL; COMPACT_INSERT; COMPACT_EMPTY];
2559 REPEAT GEN_TAC THEN COND_CASES_TAC THEN
2560 ASM_REWRITE_TAC[SEGMENT_REFL; CLOSURE_EMPTY] THEN
2561 ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THEN
2562 ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL CLOSURE_OPEN_INTERVAL);
2563 INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_ARITH `~(&1 <= &0)`] THEN
2565 `(\u. (&1 - drop u) % a + drop u % (b:real^N)) =
2566 (\x. a + x) o (\u. drop u % (b - a))`
2568 [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
2569 REWRITE_TAC[IMAGE_o; CLOSURE_TRANSLATION] THEN AP_TERM_TAC THEN
2570 MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
2571 ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_SUB_EQ; DROP_EQ] THEN
2572 REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;
2574 let CLOSED_SEGMENT = prove
2575 (`(!a b:real^N. closed(segment[a,b])) /\
2576 (!a b:real^N. closed(segment(a,b)) <=> a = b)`,
2577 REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN
2578 REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL] THEN
2579 MESON_TAC[ENDS_NOT_IN_SEGMENT; ENDS_IN_SEGMENT]);;
2581 let COMPACT_SEGMENT = prove
2582 (`(!a b:real^N. compact(segment[a,b])) /\
2583 (!a b:real^N. compact(segment(a,b)) <=> a = b)`,
2584 REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_SEGMENT; BOUNDED_SEGMENT]);;
2586 let AFFINE_HULL_SEGMENT = prove
2587 (`(!a b:real^N. affine hull (segment [a,b]) = affine hull {a,b}) /\
2588 (!a b:real^N. affine hull (segment(a,b)) =
2589 if a = b then {} else affine hull {a,b})`,
2590 REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL] THEN
2591 REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN
2592 REWRITE_TAC[CLOSURE_SEGMENT] THEN
2593 COND_CASES_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN
2594 REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL]);;
2596 let SEGMENT_AS_BALL = prove
2597 (`(!a b. segment[a:real^N,b] =
2598 affine hull {a,b} INTER cball(inv(&2) % (a + b),norm(b - a) / &2)) /\
2599 (!a b. segment(a:real^N,b) =
2600 affine hull {a,b} INTER ball(inv(&2) % (a + b),norm(b - a) / &2))`,
2601 REPEAT STRIP_TAC THEN
2602 (ASM_CASES_TAC `b:real^N = a` THEN
2603 ASM_REWRITE_TAC[SEGMENT_REFL; VECTOR_SUB_REFL; NORM_0] THEN
2604 CONV_TAC REAL_RAT_REDUCE_CONV THEN
2605 REWRITE_TAC[BALL_TRIVIAL; CBALL_TRIVIAL] THENL
2606 [REWRITE_TAC[INTER_EMPTY; INSERT_AC] THEN
2607 REWRITE_TAC[VECTOR_ARITH `&1 / &2 % (a + a) = a`] THEN
2608 REWRITE_TAC[SET_RULE `a = b INTER a <=> a SUBSET b`; HULL_SUBSET];
2609 ASM_REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_INTER; AFFINE_HULL_2] THEN
2610 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
2611 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2612 REWRITE_TAC[REAL_ARITH `u + v:real = &1 <=> u = &1 - v`] THEN
2613 REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
2614 AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
2615 X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN
2616 ASM_CASES_TAC `y:real^N = (&1 - u) % a + u % b` THEN
2617 ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_BALL; IN_CBALL; dist; VECTOR_ARITH
2618 `&1 / &2 % (a + b) - ((&1 - u) % a + u % b):real^N =
2619 (&1 / &2 - u) % (b - a)`] THEN
2620 ASM_SIMP_TAC[NORM_MUL; REAL_LT_MUL_EQ; REAL_LE_MUL_EQ; NORM_POS_LT;
2621 VECTOR_SUB_EQ; REAL_ARITH `a * n < n / &2 <=> &0 < n * (inv(&2) - a)`;
2622 REAL_ARITH `a * n <= n / &2 <=> &0 <= n * (inv(&2) - a)`] THEN
2625 let CONVEX_SEGMENT = prove
2626 (`(!a b. convex(segment[a,b])) /\ (!a b. convex(segment(a,b)))`,
2627 REWRITE_TAC[SEGMENT_AS_BALL] THEN
2628 SIMP_TAC[CONVEX_INTER; CONVEX_BALL; CONVEX_CBALL;
2629 AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);;
2631 let RELATIVE_INTERIOR_SEGMENT = prove
2633 relative_interior(segment[a,b]) = if a = b then {a} else segment(a,b)) /\
2634 (!a b:real^N. relative_interior(segment(a,b)) = segment(a,b))`,
2635 MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
2636 [REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
2637 ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_EMPTY] THEN
2638 REWRITE_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_OPEN] THEN
2639 ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN
2640 EXISTS_TAC `ball(inv(&2) % (a + b):real^N,norm(b - a) / &2)` THEN
2641 REWRITE_TAC[OPEN_BALL; SEGMENT_AS_BALL];
2642 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
2643 ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_SING] THEN
2644 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 CLOSURE_SEGMENT)) THEN
2645 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2646 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
2647 MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN
2648 REWRITE_TAC[CONVEX_SEGMENT]]);;
2650 let PATH_CONNECTED_SEGMENT = prove
2651 (`(!a b. path_connected(segment[a,b])) /\
2652 (!a b. path_connected(segment(a,b)))`,
2653 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEGMENT]);;
2655 let CONNECTED_SEGMENT = prove
2656 (`(!a b. connected(segment[a,b])) /\ (!a b. connected(segment(a,b)))`,
2657 SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEGMENT]);;
2659 let CONVEX_SEMIOPEN_SEGMENT = prove
2660 (`(!a b:real^N. convex(segment[a,b] DELETE a)) /\
2661 (!a b:real^N. convex(segment[a,b] DELETE b))`,
2662 MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN
2663 CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
2664 REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN
2665 ASM_SIMP_TAC[SEGMENT_REFL; SET_RULE `{a} DELETE a = {}`; CONVEX_EMPTY] THEN
2666 REWRITE_TAC[CONVEX_ALT; IN_DELETE] THEN
2667 SIMP_TAC[REWRITE_RULE[CONVEX_ALT] CONVEX_SEGMENT] THEN
2668 REWRITE_TAC[IN_SEGMENT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
2669 ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
2670 GSYM VECTOR_ADD_ASSOC] THEN
2671 ASM_REWRITE_TAC[VECTOR_ARITH
2672 `x % a + y % b + z % a + w % b:real^N = a <=>
2673 (&1 - x - z) % a = (w + y) % b`] THEN
2674 ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_ARITH
2675 `&1 - (&1 - u) * (&1 - v) - u * (&1 - w) =
2676 u * w + (&1 - u) * v`] THEN
2677 ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
2678 `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN
2679 REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN
2680 DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2681 `(u = &0 \/ w = &0) /\ (u = &1 \/ v = &0)
2682 ==> u = &0 /\ v = &0 \/ u = &1 /\ w = &0 \/ v = &0 /\ w = &0`)) THEN
2683 DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
2684 ASM_MESON_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
2686 let PATH_CONNECTED_SEMIOPEN_SEGMENT = prove
2687 (`(!a b:real^N. path_connected(segment[a,b] DELETE a)) /\
2688 (!a b:real^N. path_connected(segment[a,b] DELETE b))`,
2689 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;
2691 let CONNECTED_SEMIOPEN_SEGMENT = prove
2692 (`(!a b:real^N. connected(segment[a,b] DELETE a)) /\
2693 (!a b:real^N. connected(segment[a,b] DELETE b))`,
2694 SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;
2696 let SEGMENT_EQ_EMPTY = prove
2697 (`(!a b:real^N. ~(segment[a,b] = {})) /\
2698 (!a b:real^N. segment(a,b) = {} <=> a = b)`,
2699 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN
2700 REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
2701 ASM_REWRITE_TAC[SEGMENT_REFL] THEN
2702 ASM_MESON_TAC[NOT_IN_EMPTY; MIDPOINT_IN_SEGMENT]);;
2704 let FINITE_SEGMENT = prove
2705 (`(!a b:real^N. FINITE(segment[a,b]) <=> a = b) /\
2706 (!a b:real^N. FINITE(segment(a,b)) <=> a = b)`,
2707 REWRITE_TAC[open_segment; SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN
2708 REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN
2709 ASM_CASES_TAC `a:real^N = b` THEN
2710 ASM_REWRITE_TAC[SEGMENT_REFL; FINITE_SING] THEN
2711 REWRITE_TAC[SEGMENT_IMAGE_INTERVAL] THEN
2712 W(MP_TAC o PART_MATCH (lhs o rand) FINITE_IMAGE_INJ_EQ o rand o snd) THEN
2714 [REWRITE_TAC[VECTOR_ARITH
2715 `(&1 - u) % a + u % b:real^N = (&1 - v) % a + v % b <=>
2716 (u - v) % (b - a) = vec 0`] THEN
2717 ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ];
2718 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_INTERVAL_1] THEN
2719 REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC]);;
2721 let SEGMENT_EQ_SING = prove
2722 (`(!a b c:real^N. segment[a,b] = {c} <=> a = c /\ b = c) /\
2723 (!a b c:real^N. ~(segment(a,b) = {c}))`,
2724 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_SING] THEN
2725 CONJ_TAC THENL [SET_TAC[]; REPEAT GEN_TAC] THEN
2726 ASM_CASES_TAC `a:real^N = b` THEN
2727 ASM_REWRITE_TAC[SEGMENT_REFL; NOT_INSERT_EMPTY] THEN
2729 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 FINITE_SEGMENT)) THEN
2730 ASM_REWRITE_TAC[FINITE_SING]);;
2732 let SUBSET_SEGMENT_OPEN_CLOSED = prove
2734 segment(a,b) SUBSET segment(c,d) <=>
2735 a = b \/ segment[a,b] SUBSET segment[c,d]`,
2736 REPEAT GEN_TAC THEN EQ_TAC THENL
2737 [ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[] THEN
2738 DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN
2739 ASM_REWRITE_TAC[CLOSURE_SEGMENT] THEN
2740 COND_CASES_TAC THEN REWRITE_TAC[SUBSET_EMPTY; SEGMENT_EQ_EMPTY];
2742 DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN
2743 REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET] THEN
2744 ABBREV_TAC `m:real^N = d - c` THEN POP_ASSUM MP_TAC THEN
2745 GEOM_NORMALIZE_TAC `m:real^N` THEN
2746 SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; SEGMENT_EQ_SING; SEGMENT_EQ_EMPTY;
2747 SET_RULE `s SUBSET {a} <=> s = {a} \/ s = {}`; SUBSET_REFL] THEN
2748 X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
2749 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN
2750 GEOM_ORIGIN_TAC `c:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `d:real^N` THEN
2751 X_GEN_TAC `d:real` THEN DISCH_TAC THEN
2752 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
2753 SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
2754 ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN
2755 POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
2756 SUBGOAL_THEN `collinear{vec 0:real^N,&1 % basis 1,x} /\
2757 collinear{vec 0:real^N,&1 % basis 1,y}`
2759 [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
2760 CONJ_TAC THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN
2761 REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN
2762 ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT];
2764 SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
2765 VECTOR_ARITH `&1 % x:real^N = vec 0 <=> x = vec 0`] THEN
2766 REWRITE_TAC[IMP_CONJ; VECTOR_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN
2767 X_GEN_TAC `a:real` THEN REWRITE_TAC[REAL_MUL_RID] THEN
2768 DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `b:real` THEN
2769 DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN
2770 SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN
2771 ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; VECTOR_MUL_RCANCEL; BASIS_NONZERO;
2772 DIMINDEX_GE_1; LE_REFL; SET_RULE
2773 `(!x y. x % v = y % v <=> x = y)
2774 ==> ({x % v | P x} SUBSET {x % v | Q x} <=>
2775 {x | P x} SUBSET {x | Q x})`] THEN
2776 REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=>
2777 min a b <= x /\ x <= max a b`;
2778 REAL_ARITH `a < x /\ x < b \/ b < x /\ x < a <=>
2779 min a b < x /\ x < max a b`] THEN
2780 CONV_TAC REAL_RAT_REDUCE_CONV THEN
2781 REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN
2782 X_GEN_TAC `x:real` THEN
2783 FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th)
2784 [`min (a:real) b`; `max (a:real) b`]) THEN
2787 let SUBSET_SEGMENT = prove
2789 segment[a,b] SUBSET segment[c,d] <=>
2790 a IN segment[c,d] /\ b IN segment[c,d]) /\
2792 segment[a,b] SUBSET segment(c,d) <=>
2793 a IN segment(c,d) /\ b IN segment(c,d)) /\
2795 segment(a,b) SUBSET segment[c,d] <=>
2796 a = b \/ a IN segment[c,d] /\ b IN segment[c,d]) /\
2798 segment(a,b) SUBSET segment(c,d) <=>
2799 a = b \/ a IN segment[c,d] /\ b IN segment[c,d])`,
2800 MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
2802 [REPEAT STRIP_TAC THEN
2803 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_CONVEX_HULL] THEN
2804 SIMP_TAC[SUBSET_HULL; CONVEX_SEGMENT] THEN SET_TAC[];
2805 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_SEGMENT_OPEN_CLOSED] THEN
2806 REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2807 EXISTS_TAC `closure(segment(a:real^N,b)) SUBSET segment[c,d]` THEN
2808 CONJ_TAC THENL [SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_SEGMENT]; ALL_TAC] THEN
2809 REWRITE_TAC[CLOSURE_SEGMENT] THEN
2810 COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_SUBSET]]);;
2812 let INTERIOR_SEGMENT = prove
2813 (`(!a b:real^N. interior(segment[a,b]) =
2814 if 2 <= dimindex(:N) then {} else segment(a,b)) /\
2815 (!a b:real^N. interior(segment(a,b)) =
2816 if 2 <= dimindex(:N) then {} else segment(a,b))`,
2817 REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2818 ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL
2819 [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ s = {} ==> s = {} /\ t = {}`) THEN
2820 SIMP_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SUBSET_INTERIOR] THEN
2821 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2822 MATCH_MP_TAC EMPTY_INTERIOR_CONVEX_HULL THEN
2823 REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN FIRST_ASSUM
2824 (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS)) THEN
2825 SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC;
2826 ASM_CASES_TAC `a:real^N = b` THEN
2827 ASM_SIMP_TAC[SEGMENT_REFL; INTERIOR_EMPTY; EMPTY_INTERIOR_FINITE;
2830 `affine hull (segment[a,b]) = (:real^N) /\
2831 affine hull (segment(a,b)) = (:real^N)`
2832 (fun th -> ASM_SIMP_TAC[th; GSYM RELATIVE_INTERIOR_INTERIOR;
2833 RELATIVE_INTERIOR_SEGMENT]) THEN
2834 ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN
2835 MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN
2836 REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
2837 ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
2840 let SEGMENT_EQ = prove
2842 segment[a,b] = segment[c,d] <=> {a,b} = {c,d}) /\
2844 ~(segment[a,b] = segment(c,d))) /\
2846 ~(segment(a,b) = segment[c,d])) /\
2848 segment(a,b) = segment(c,d) <=> a = b /\ c = d \/ {a,b} = {c,d})`,
2849 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2850 [REPEAT GEN_TAC THEN EQ_TAC THENL
2851 [DISCH_THEN(fun th -> MP_TAC th THEN
2852 MP_TAC(AP_TERM `\s:real^N->bool. s DIFF relative_interior s` th)) THEN
2853 REWRITE_TAC[RELATIVE_INTERIOR_SEGMENT] THEN
2854 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL]) THEN
2855 SIMP_TAC[ENDS_IN_SEGMENT; open_segment; SET_RULE
2856 `a IN s /\ b IN s ==> s DIFF (s DIFF {a,b}) = {a,b}`] THEN
2857 ASM SET_TAC[SEGMENT_EQ_SING];
2858 SIMP_TAC[SEGMENT_CONVEX_HULL]];
2860 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2861 [REPEAT STRIP_TAC THEN
2862 FIRST_ASSUM(MP_TAC o AP_TERM `closed:(real^N->bool)->bool`) THEN
2863 REWRITE_TAC[CONJUNCT1 CLOSED_SEGMENT] THEN
2864 REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN
2865 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
2866 [ASM SET_TAC[SEGMENT_EQ_EMPTY];
2867 REWRITE_TAC[open_segment; ENDS_IN_SEGMENT; SET_RULE
2868 `s = s DIFF {a,b} <=> ~(a IN s) /\ ~(b IN s)`]];
2869 DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
2870 REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = d` THEN
2871 ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL
2872 [ASM SET_TAC[]; ALL_TAC] THEN
2873 CONV_TAC(BINOP_CONV SYM_CONV)THEN
2874 ASM_CASES_TAC `a:real^N = b` THEN
2875 ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL
2876 [ASM SET_TAC[]; ALL_TAC] THEN
2877 ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_SEGMENT_OPEN_CLOSED] THEN
2878 ASM_REWRITE_TAC[SUBSET_ANTISYM_EQ]]);;
2880 let COLLINEAR_SEGMENT = prove
2881 (`(!a b:real^N. collinear(segment[a,b])) /\
2882 (!a b:real^N. collinear(segment(a,b)))`,
2883 REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2884 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2885 [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
2886 MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
2887 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
2888 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN
2889 REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]]);;
2891 let INTER_SEGMENT = prove
2893 b IN segment[a,c] \/ ~collinear{a,b,c}
2894 ==> segment[a,b] INTER segment[b,c] = {b}`,
2895 REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL
2896 [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; INTER_IDEMPOT; INSERT_AC; COLLINEAR_2];
2898 DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
2899 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN DISCH_TAC THEN
2900 MP_TAC(ISPECL [`{a:real^N,c}`; `b:real^N`; `{a:real^N}`; `{c:real^N}`]
2901 CONVEX_HULL_EXCHANGE_INTER) THEN
2902 ASM_REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
2903 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INSERT_AC]] THEN
2904 DISCH_THEN SUBST1_TAC THEN
2905 ASM_SIMP_TAC[SET_RULE `~(a = c) ==> {a} INTER {c} = {}`] THEN
2906 REWRITE_TAC[CONVEX_HULL_SING];
2907 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
2908 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
2910 ==> b IN s /\ b IN t
2911 ==> ?a. ~(a = b) /\ a IN s /\ b IN s /\ a IN t /\ b IN t`)) THEN
2912 ANTS_TAC THENL [REWRITE_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
2913 REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN
2914 X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN
2915 REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN
2916 MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `d:real^N` THEN
2917 REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);;
2919 let SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 = prove
2920 (`!f:real^N->real^1 a b.
2921 f continuous_on segment[a,b]
2922 ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b])`,
2923 REPEAT STRIP_TAC THEN
2924 FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2925 CONNECTED_CONTINUOUS_IMAGE)) THEN
2926 REWRITE_TAC[CONNECTED_SEGMENT] THEN
2927 REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1] THEN
2928 REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN
2929 MESON_TAC[IN_IMAGE; ENDS_IN_SEGMENT]);;
2931 let CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1 = prove
2932 (`!f:real^N->real^1 a b.
2933 f continuous_on segment[a,b] /\
2934 (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
2935 ==> IMAGE f (segment[a,b]) = segment[f a,f b]`,
2938 ~(a = b) /\ ~(a IN segment(c,b)) /\ ~(b IN segment(a,c))
2939 ==> c IN segment[a,b]`,
2940 REWRITE_TAC[FORALL_LIFT; SEGMENT_1; LIFT_DROP] THEN
2941 REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_EQ] THEN
2942 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]) THEN
2943 ASM_REAL_ARITH_TAC) in
2944 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2945 REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; LEFT_IMP_EXISTS_THM] THEN
2946 X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN
2947 MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^1->real^N`;
2948 `segment[a:real^N,b]`]
2949 CONTINUOUS_ON_INVERSE) THEN
2950 ASM_REWRITE_TAC[COMPACT_SEGMENT] THEN DISCH_TAC THEN
2951 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
2952 MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
2953 [ASM_SIMP_TAC[SUBSET_CONTINUOUS_IMAGE_SEGMENT_1]; DISCH_TAC] THEN
2954 ASM_CASES_TAC `a:real^N = b` THEN
2955 ASM_REWRITE_TAC[SEGMENT_REFL] THENL [SET_TAC[]; ALL_TAC] THEN
2956 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N` THEN
2957 DISCH_TAC THEN MATCH_MP_TAC lemma THEN
2958 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2959 [ASM_MESON_TAC[ENDS_IN_SEGMENT]; DISCH_TAC] THEN
2960 ONCE_REWRITE_TAC[segment] THEN
2961 ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
2962 REPEAT STRIP_TAC THENL
2963 [MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `b:real^N`]
2964 SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
2965 SUBGOAL_THEN `segment[c:real^N,b] SUBSET segment[a,b]` ASSUME_TAC THENL
2966 [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2967 REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2968 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
2969 DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) a`) THEN
2970 ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
2971 X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = a` THENL
2972 [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT];
2973 ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]];
2974 MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `c:real^N`]
2975 SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
2976 SUBGOAL_THEN `segment[a:real^N,c] SUBSET segment[a,b]` ASSUME_TAC THENL
2977 [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2978 REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2979 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
2980 DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN
2981 ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
2982 X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = b` THENL
2983 [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT; BETWEEN_SYM];
2984 ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]]);;
2986 let CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1 = prove
2987 (`!f:real^N->real^1 a b.
2988 f continuous_on segment[a,b] /\
2989 (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
2990 ==> IMAGE f (segment(a,b)) = segment(f a,f b)`,
2991 REPEAT GEN_TAC THEN DISCH_TAC THEN
2992 ONCE_REWRITE_TAC[segment] THEN
2993 FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
2994 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN
2995 MP_TAC(ISPECL [`(f:real^N->real^1) a`; `(f:real^1->real^1) b`]
2996 ENDS_IN_SEGMENT) THEN
2999 let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove
3000 (`!f:real^N->real^1 a b.
3001 f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b)
3002 ==> ?z. z IN segment(a,b) /\
3003 ((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/
3004 (!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`,
3005 REPEAT STRIP_TAC THEN
3006 MAP_EVERY (MP_TAC o ISPECL
3007 [`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`])
3008 [CONTINUOUS_ATTAINS_SUP; CONTINUOUS_ATTAINS_INF] THEN
3009 ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
3010 REWRITE_TAC[COMPACT_SEGMENT; SEGMENT_EQ_EMPTY] THEN
3011 DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN
3012 ASM_CASES_TAC `(d:real^N) IN segment(a,b)` THENL
3013 [ASM_MESON_TAC[]; ALL_TAC] THEN
3014 DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
3015 ASM_CASES_TAC `(c:real^N) IN segment(a,b)` THENL
3016 [ASM_MESON_TAC[]; ALL_TAC] THEN
3017 EXISTS_TAC `midpoint(a:real^N,b)` THEN
3018 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
3019 [ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN
3020 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN
3021 REPEAT(FIRST_X_ASSUM(MP_TAC o
3022 GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN
3023 ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
3024 REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN
3025 FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]);;
3027 let FRONTIER_UNIONS_SUBSET_CLOSURE = prove
3028 (`!f:(real^N->bool)->bool.
3029 frontier(UNIONS f) SUBSET closure(UNIONS {frontier t | t IN f})`,
3030 GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN
3031 REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN
3032 X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
3033 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3034 FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
3035 ASM_REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN
3036 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
3037 ASM_CASES_TAC `(t:real^N->bool) IN f` THEN ASM_REWRITE_TAC[] THEN
3038 ASM_CASES_TAC `(x:real^N) IN t` THENL
3039 [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `x:real^N` THEN
3040 ASM_REWRITE_TAC[frontier; DIST_REFL; IN_DIFF] THEN
3041 ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
3042 FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
3043 SPEC_TAC(`x:real^N`,`z:real^N`) THEN
3044 REWRITE_TAC[CONTRAPOS_THM; GSYM SUBSET] THEN
3045 MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[];
3046 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
3047 MP_TAC(ISPECL [`segment[x:real^N,y]`; `t:real^N->bool`]
3048 CONNECTED_INTER_FRONTIER) THEN
3049 SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
3050 ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
3051 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
3052 ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM; REAL_LET_TRANS]]);;
3054 let FRONTIER_UNIONS_SUBSET = prove
3055 (`!f:(real^N->bool)->bool.
3056 FINITE f ==> frontier(UNIONS f) SUBSET UNIONS {frontier t | t IN f}`,
3057 REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[]
3058 `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN
3059 REWRITE_TAC[FRONTIER_UNIONS_SUBSET_CLOSURE; CLOSURE_EQ] THEN
3060 MATCH_MP_TAC CLOSED_UNIONS THEN
3061 ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FRONTIER_CLOSED]);;
3063 let CLOSURE_CONVEX_INTER_AFFINE = prove
3064 (`!s t:real^N->bool.
3065 convex s /\ affine t /\ ~(relative_interior s INTER t = {})
3066 ==> closure(s INTER t) = closure(s) INTER t`,
3067 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
3068 REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL
3069 [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[];
3070 TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN
3071 SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
3072 ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE; SUBSET_REFL];
3074 FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` MP_TAC o
3075 GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
3076 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
3077 GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN
3078 REWRITE_TAC[IN_INTER] THEN
3079 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
3080 ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN
3081 FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET]
3082 RELATIVE_INTERIOR_SUBSET)) THEN
3083 REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
3084 STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL
3085 [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
3086 ASM_REWRITE_TAC[IN_INTER];
3088 SUBGOAL_THEN `x IN closure(segment(vec 0:real^N,x))` MP_TAC THENL
3089 [ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
3090 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
3091 MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET_INTER] THEN
3093 [TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN
3094 REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN
3095 MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN
3097 ASM_SIMP_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
3098 SUBSPACE_MUL; LEFT_IMP_EXISTS_THM]]);;
3100 let RELATIVE_FRONTIER_CONVEX_INTER_AFFINE = prove
3101 (`!s t:real^N->bool.
3102 convex s /\ affine t /\ ~(interior s INTER t = {})
3103 ==> relative_frontier(s INTER t) = frontier s INTER t`,
3104 SIMP_TAC[relative_frontier; RELATIVE_INTERIOR_CONVEX_INTER_AFFINE;
3106 REPEAT STRIP_TAC THEN
3107 SUBGOAL_THEN `~(relative_interior s INTER t:real^N->bool = {})`
3109 [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN
3111 ASM_SIMP_TAC[CLOSURE_CONVEX_INTER_AFFINE] THEN SET_TAC[]]);;
3113 let CONNECTED_COMPONENT_1_GEN = prove
3116 ==> (connected_component s a b <=> segment[a,b] SUBSET s)`,
3117 SIMP_TAC[connected_component; GSYM CONNECTED_CONVEX_1_GEN] THEN
3118 MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET; CONVEX_SEGMENT;
3121 let CONNECTED_COMPONENT_1 = prove
3122 (`!s a b:real^1. connected_component s a b <=> segment[a,b] SUBSET s`,
3123 SIMP_TAC[CONNECTED_COMPONENT_1_GEN; DIMINDEX_1]);;
3125 (* ------------------------------------------------------------------------- *)
3126 (* An injective function into R is a homeomorphism and so an open map. *)
3127 (* ------------------------------------------------------------------------- *)
3129 let INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM = prove
3130 (`!f:real^N->real^1 s.
3131 f continuous_on s /\ path_connected s
3132 ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3133 ?g. homeomorphism (s,IMAGE f s) (f,g))`,
3134 REPEAT STRIP_TAC THEN EQ_TAC THENL
3135 [REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE];
3136 REWRITE_TAC[homeomorphism] THEN MESON_TAC[]] THEN
3137 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN
3138 STRIP_TAC THEN ASM_SIMP_TAC[homeomorphism; FORALL_IN_IMAGE] THEN
3139 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3140 SUBGOAL_THEN `is_interval (IMAGE (f:real^N->real^1) s)` ASSUME_TAC THENL
3141 [REWRITE_TAC[IS_INTERVAL_PATH_CONNECTED_1] THEN
3142 ASM_MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE];
3144 REWRITE_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN
3145 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3146 ABBREV_TAC `y = (f:real^N->real^1) x` THEN
3147 ABBREV_TAC `t = IMAGE (f:real^N->real^1) s` THEN
3148 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3150 `?a b d. a IN s /\ b IN s /\ &0 < d /\
3151 ball(y,d) INTER t SUBSET segment[(f:real^N->real^1) a,f b]`
3152 STRIP_ASSUME_TAC THENL
3153 [MP_TAC(ISPECL [`t:real^1->bool`; `y:real^1`]
3154 INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
3155 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3156 ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN
3157 REWRITE_TAC[SET_RULE
3158 `P /\ y IN s /\ (s = {} \/ a IN t /\ b IN t) /\ R <=>
3159 a IN t /\ b IN t /\ P /\ y IN s /\ R`] THEN
3160 REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
3161 EXPAND_TAC "t" THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
3162 REWRITE_TAC[SEGMENT_1; IN_INTERVAL_1] THEN
3163 MESON_TAC[REAL_LE_TRANS];
3164 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
3165 DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3166 ASM_REWRITE_TAC[] THEN
3167 DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
3169 `(g:real^1->real^N) continuous_on segment[(f:real^N->real^1) a,f b]`
3171 [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
3172 EXISTS_TAC `IMAGE (f:real^N->real^1) (path_image p)` THEN CONJ_TAC THENL
3173 [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN
3174 ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN CONJ_TAC THENL
3175 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
3176 SUBGOAL_THEN `convex(IMAGE (f:real^N->real^1) (path_image p))`
3178 [REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; IS_INTERVAL_CONNECTED_1] THEN
3179 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
3180 ASM_SIMP_TAC[CONNECTED_PATH_IMAGE] THEN
3181 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
3182 REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN
3183 CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
3184 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]];
3185 REWRITE_TAC[continuous_on] THEN
3186 DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL
3187 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3188 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM SET_TAC[];
3190 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
3191 DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
3192 EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
3193 X_GEN_TAC `x':real^N` THEN REPEAT STRIP_TAC THEN
3194 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3195 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3196 ASM_REWRITE_TAC[IN_INTER; IN_BALL] THEN
3197 ONCE_REWRITE_TAC[DIST_SYM] THEN ASM SET_TAC[]]]);;
3199 let INJECTIVE_INTO_1D_IMP_OPEN_MAP = prove
3200 (`!f:real^N->real^1 s t.
3201 f continuous_on s /\ path_connected s /\
3202 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3203 open_in (subtopology euclidean s) t
3204 ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)`,
3205 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
3206 ASM_MESON_TAC[INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM]);;
3208 (* ------------------------------------------------------------------------- *)
3209 (* Injective function on an interval is strictly increasing or decreasing. *)
3210 (* ------------------------------------------------------------------------- *)
3212 let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove
3213 (`!f:real^1->real^1 s.
3214 f continuous_on s /\ is_interval s
3215 ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3216 (!x y. x IN s /\ y IN s /\ drop x < drop y
3217 ==> drop(f x) < drop(f y)) \/
3218 (!x y. x IN s /\ y IN s /\ drop x < drop y
3219 ==> drop(f y) < drop(f x)))`,
3221 (`!s f:real^1->real^1.
3222 f continuous_on s /\ is_interval s /\
3223 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3224 ==> !u v w. u IN s /\ v IN s /\ w IN s /\
3225 drop u < drop v /\ drop v < drop w /\
3226 drop(f u) <= drop(f v) /\ drop(f w) <= drop(f v) ==> F`,
3227 REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT] THEN
3228 REPEAT STRIP_TAC THEN
3229 MP_TAC(ISPECL [`f:real^1->real^1`; `u:real^1`; `w:real^1`]
3230 CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
3231 ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN
3232 REWRITE_TAC[EXTENSION] THEN
3233 DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) v`) THEN
3234 MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
3235 [MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[SEGMENT_1] THEN
3236 COND_CASES_TAC THENL
3237 [ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC];
3238 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
3239 ASM_REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THENL
3240 [SUBGOAL_THEN `drop(f(w:real^1)) = drop(f v)` ASSUME_TAC THENL
3241 [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]];
3242 SUBGOAL_THEN `drop(f(u:real^1)) = drop(f v)` ASSUME_TAC THENL
3243 [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]]])
3245 let [l1;l2] = map (map (fun x -> mk_var(x,`:real^1`)) o explode) [s1;s2] in
3246 REPEAT(FIRST_X_ASSUM(fun th ->
3247 MP_TAC(ISPECL l1 th) THEN MP_TAC(ISPECL l2 th))) THEN
3248 ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC in
3249 REPEAT STRIP_TAC THEN EQ_TAC THENL
3251 REWRITE_TAC[GSYM DROP_EQ] THEN
3252 MESON_TAC[REAL_LT_TOTAL; REAL_LT_REFL]] THEN
3253 DISCH_TAC THEN MATCH_MP_TAC(MESON[]
3254 `(!a b c d. ~(~P a b /\ ~Q c d)) ==> (!x y. P x y) \/ (!x y. Q x y)`) THEN
3255 MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN
3256 REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN STRIP_TAC THEN
3258 (FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN
3259 REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL
3260 [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]]) THEN
3261 MP_TAC(ISPEC `s:real^1->bool` lemma) THEN ASM_REWRITE_TAC[] THEN
3262 DISCH_THEN(fun th ->
3263 MP_TAC(SPEC `(--) o (f:real^1->real^1)` th) THEN
3264 MP_TAC(SPEC `f:real^1->real^1` th)) THEN
3265 ASM_REWRITE_TAC[o_THM; VECTOR_ARITH `--x:real^N = --y <=> x = y`] THEN
3266 DISCH_TAC THEN REWRITE_TAC[NOT_IMP; DROP_NEG; REAL_LE_NEG2] THEN
3268 [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE;LINEAR_CONTINUOUS_ON; LINEAR_NEGATION];
3270 ASM_CASES_TAC `drop d <= drop a` THENL [tac "cab" "cdb"; ALL_TAC] THEN
3271 ASM_CASES_TAC `drop b <= drop c` THENL [tac "abd" "acd"; ALL_TAC] THEN
3272 ASM_CASES_TAC `c:real^1 = a /\ d:real^1 = b` THENL
3273 [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN
3274 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
3276 ==> (c = a ==> d = b) /\ (d = b ==> c = a) /\
3277 (~(c = a) /\ ~(d = b) ==> F) ==> F`)) THEN
3278 REPEAT CONJ_TAC THENL
3279 [DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "adb" "abd";
3280 DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "acb" "cab";
3281 REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC] THEN
3282 ASM_CASES_TAC `drop a <= drop c` THENL [tac "acb" "acd"; tac "cab" "cad"]);;
3284 (* ------------------------------------------------------------------------- *)
3285 (* Some uncountability results for relevant sets. *)
3286 (* ------------------------------------------------------------------------- *)
3288 let CARD_EQ_SEGMENT = prove
3289 (`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\
3290 (!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`,
3291 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL
3292 [TRANS_TAC CARD_EQ_TRANS `interval[vec 0:real^1,vec 1]`;
3293 TRANS_TAC CARD_EQ_TRANS `interval(vec 0:real^1,vec 1)`] THEN
3294 SIMP_TAC[CARD_EQ_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
3295 MATCH_MP_TAC CARD_EQ_IMAGE THEN
3296 ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH
3297 `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
3298 (x - y) % (a - b) = vec 0`] THEN
3299 SIMP_TAC[REAL_SUB_0; DROP_EQ]);;
3301 let UNCOUNTABLE_SEGMENT = prove
3302 (`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\
3303 (!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`,
3304 SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_SEGMENT]);;
3306 let CARD_EQ_PATH_CONNECTED = prove
3308 path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
3309 MESON_TAC[CARD_EQ_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;
3311 let UNCOUNTABLE_PATH_CONNECTED = prove
3313 path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
3314 REPEAT GEN_TAC THEN STRIP_TAC THEN
3315 MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
3316 MATCH_MP_TAC CARD_EQ_PATH_CONNECTED THEN
3319 let CARD_EQ_CONVEX = prove
3321 convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
3322 MESON_TAC[CARD_EQ_PATH_CONNECTED; CONVEX_IMP_PATH_CONNECTED]);;
3324 let UNCOUNTABLE_CONVEX = prove
3326 convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
3327 REPEAT GEN_TAC THEN STRIP_TAC THEN
3328 MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
3329 MATCH_MP_TAC CARD_EQ_CONVEX THEN
3332 let CARD_EQ_NONEMPTY_INTERIOR = prove
3333 (`!s:real^N->bool. ~(interior s = {}) ==> s =_c (:real)`,
3334 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
3335 [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
3336 SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN];
3337 TRANS_TAC CARD_LE_TRANS `interior(s:real^N->bool)` THEN
3338 SIMP_TAC[CARD_LE_SUBSET; INTERIOR_SUBSET] THEN
3339 MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
3340 MATCH_MP_TAC CARD_EQ_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]]);;
3342 let UNCOUNTABLE_NONEMPTY_INTERIOR = prove
3343 (`!s:real^N->bool. ~(interior s = {}) ==> ~(COUNTABLE s)`,
3344 SIMP_TAC[CARD_EQ_NONEMPTY_INTERIOR; CARD_EQ_REAL_IMP_UNCOUNTABLE]);;
3346 let COUNTABLE_EMPTY_INTERIOR = prove
3347 (`!s:real^N->bool. COUNTABLE s ==> interior s = {}`,
3348 MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]);;
3350 let FINITE_EMPTY_INTERIOR = prove
3351 (`!s:real^N->bool. FINITE s ==> interior s = {}`,
3352 SIMP_TAC[COUNTABLE_EMPTY_INTERIOR; FINITE_IMP_COUNTABLE]);;
3354 let [CONNECTED_FINITE_IFF_SING;
3355 CONNECTED_FINITE_IFF_COUNTABLE;
3356 CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove)
3357 (`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\
3358 (!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\
3359 (!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`,
3360 REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
3361 ASM_CASES_TAC `connected(s:real^N->bool)` THEN
3362 ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT
3363 `(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r)
3364 ==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN
3365 REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN
3366 REPEAT CONJ_TAC THEN STRIP_TAC THEN
3367 ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN
3368 MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);;
3370 let CLOSED_AS_FRONTIER_OF_SUBSET = prove
3371 (`!s:real^N->bool. closed s <=> ?t. t SUBSET s /\ s = frontier t`,
3372 GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRONTIER_CLOSED]] THEN
3373 DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEPARABLE) THEN
3374 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
3375 SIMP_TAC[frontier] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3376 `s SUBSET c /\ c SUBSET s /\ i = {} ==> s = c DIFF i`) THEN
3377 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3378 [ASM_MESON_TAC[SUBSET_CLOSURE; CLOSURE_CLOSED];
3379 ASM_MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]]);;
3381 let CLOSED_AS_FRONTIER = prove
3382 (`!s:real^N->bool. closed s <=> ?t. s = frontier t`,
3383 GEN_TAC THEN EQ_TAC THENL
3384 [MESON_TAC[CLOSED_AS_FRONTIER_OF_SUBSET]; MESON_TAC[FRONTIER_CLOSED]]);;
3386 let CARD_EQ_CLOSED = prove
3387 (`!s:real^N->bool. closed s ==> s <=_c (:num) \/ s =_c (:real)`,
3391 ==> ?x y. ~(x = y) /\ x IN s /\ y IN s /\
3392 x condensation_point_of s /\
3393 y condensation_point_of s`,
3394 REPEAT STRIP_TAC THEN
3395 FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
3396 DISCH_THEN(MP_TAC o MATCH_MP CARD_INFINITE_CONG) THEN
3397 REWRITE_TAC[INFINITE] THEN
3398 MATCH_MP_TAC(TAUT `q /\ (p ==> s) ==> (p <=> q) ==> s`) THEN
3399 CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMP_COUNTABLE]; ALL_TAC] THEN
3401 MP_TAC(ISPECL [`2`; `{x:real^N | x IN s /\ x condensation_point_of s}`]
3402 CHOOSE_SUBSET_STRONG) THEN
3403 ASM_REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`; RIGHT_AND_EXISTS_THM] THEN
3404 DISCH_THEN(CHOOSE_THEN MP_TAC) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
3405 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
3406 STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
3407 RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; NOT_IN_EMPTY]) THEN
3408 ASM_REWRITE_TAC[]) in
3409 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM COUNTABLE_ALT] THEN
3410 ASM_CASES_TAC `COUNTABLE(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
3413 closed t /\ ~COUNTABLE t
3414 ==> ?l r. (compact l /\ ~COUNTABLE l) /\ (compact r /\ ~COUNTABLE r) /\
3415 l INTER r = {} /\ l SUBSET t /\ r SUBSET t /\
3416 diameter l <= inv(&2 pow n) /\
3417 diameter r <= inv(&2 pow n)`
3419 [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
3420 (MP_TAC o MATCH_MP slemma)) THEN
3421 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3422 MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
3423 MAP_EVERY EXISTS_TAC
3424 [`t INTER cball(a:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`;
3425 `t INTER cball(b:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`] THEN
3426 ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
3427 REPEAT CONJ_TAC THENL
3428 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
3429 [CONDENSATION_POINT_INFINITE_CBALL]) THEN
3430 REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
3431 UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3432 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
3433 [CONDENSATION_POINT_INFINITE_CBALL]) THEN
3434 REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
3435 UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3436 MATCH_MP_TAC(SET_RULE
3437 `(!x. ~(x IN t /\ x IN u)) ==> (s INTER t) INTER (s INTER u) = {}`) THEN
3438 REWRITE_TAC[IN_CBALL; REAL_LE_MIN] THEN
3439 UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3442 MATCH_MP_TAC DIAMETER_LE THEN
3443 SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
3444 REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN
3445 CONV_TAC NORM_ARITH;
3446 MATCH_MP_TAC DIAMETER_LE THEN
3447 SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
3448 REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN
3449 CONV_TAC NORM_ARITH];
3450 REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3452 [`l:num->(real^N->bool)->(real^N->bool)`;
3453 `r:num->(real^N->bool)->(real^N->bool)`] THEN
3456 `!b. ?x:num->real^N->bool.
3457 (x 0 = s) /\ (!n. x(SUC n) = if b(n) then r n (x n) else l n (x n))`
3460 W(ACCEPT_TAC o prove_recursive_functions_exist num_RECURSION o
3461 snd o dest_exists o snd);
3462 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN
3463 X_GEN_TAC `x:(num->bool)->num->real^N->bool` THEN STRIP_TAC THEN
3464 REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
3465 [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
3466 SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE];
3467 TRANS_TAC CARD_LE_TRANS `(:num->bool)` THEN
3468 SIMP_TAC[CARD_EQ_REAL; CARD_EQ_IMP_LE]] THEN
3469 REWRITE_TAC[le_c; IN_UNIV] THEN
3471 `!b n. closed((x:(num->bool)->num->real^N->bool) b n) /\
3474 [GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[] THEN
3475 COND_CASES_TAC THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
3476 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
3477 MP_TAC(GEN `b:num->bool` (ISPEC `(x:(num->bool)->num->real^N->bool) b`
3478 DECREASING_CLOSED_NEST_SING)) THEN
3479 DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
3480 [ASM_SIMP_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL
3481 [ASM_MESON_TAC[COUNTABLE_EMPTY];
3482 GEN_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
3483 REWRITE_TAC[SUBSET_REFL] THEN ASM SET_TAC[];
3484 MAP_EVERY X_GEN_TAC [`b:num->bool`; `e:real`] THEN DISCH_TAC THEN
3485 MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
3486 ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3487 DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN
3488 EXISTS_TAC `SUC m` THEN ASM_SIMP_TAC[] THEN
3489 REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
3490 DISCH_THEN(MP_TAC o MATCH_MP
3491 (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q /\ r ==> p ==> s`]
3492 DIAMETER_BOUNDED_BOUND)) THEN
3493 ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
3494 UNDISCH_TAC `inv(&2 pow m) < e` THEN MATCH_MP_TAC(NORM_ARITH
3495 `d <= i ==> i < e ==> norm(x - y) <= d ==> dist(x:real^N,y) < e`) THEN
3498 REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3499 X_GEN_TAC `f:(num->bool)->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL
3500 [X_GEN_TAC `b:num->bool` THEN
3501 REWRITE_TAC[SET_RULE `x IN s <=> {x} SUBSET s`] THEN
3502 FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
3503 REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
3504 ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
3505 SIMP_TAC[FORALL_UNWIND_THM2] THEN GEN_TAC THEN ASM SET_TAC[];
3506 MAP_EVERY X_GEN_TAC [`b:num->bool`; `c:num->bool`] THEN
3507 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3508 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [FUN_EQ_THM] THEN
3509 REWRITE_TAC[NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN
3510 SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
3511 MATCH_MP_TAC(SET_RULE
3512 `!f g. INTERS f = {a} /\ INTERS g = {b} /\
3513 (?s t. s IN f /\ t IN g /\ s INTER t = {})
3515 EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) b n}` THEN
3516 EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) c n}` THEN
3517 ASM_REWRITE_TAC[IN_ELIM_THM] THEN
3518 EXISTS_TAC `(x:(num->bool)->num->real^N->bool) b (SUC k)` THEN
3519 EXISTS_TAC `(x:(num->bool)->num->real^N->bool) c (SUC k)` THEN
3520 REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[] THEN
3522 `!i. i <= k ==> (x:(num->bool)->num->real^N->bool) b i = x c i`
3524 [INDUCT_TAC THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE];
3525 DISCH_THEN(MP_TAC o SPEC `k:num`)] THEN
3526 REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN
3527 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
3528 [TAUT `~(p <=> q) <=> (q <=> ~p)`]) THEN
3529 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
3530 ASM_MESON_TAC[INTER_COMM]]]);;
3532 let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS =
3535 {x | x condensation_point_of s} = {} <=> COUNTABLE s) /\
3537 {x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`,
3538 REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
3539 `(r ==> p) /\ (~r ==> q) /\ (p ==> ~q)
3540 ==> (p <=> r) /\ (q <=> ~r)`) THEN
3541 REPEAT CONJ_TAC THENL
3542 [DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
3543 REWRITE_TAC[condensation_point_of] THEN
3544 ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV];
3545 DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE
3546 [TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN
3547 REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN
3548 FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
3549 DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN
3550 ASM_REWRITE_TAC[CONTRAPOS_THM] THEN
3551 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[];
3552 DISCH_THEN SUBST1_TAC THEN
3553 DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN
3554 REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);;
3556 let UNCOUNTABLE_HAS_CONDENSATION_POINT = prove
3557 (`!s:real^N->bool. ~COUNTABLE s ==> ?x. x condensation_point_of s`,
3558 REWRITE_TAC[GSYM CONDENSATION_POINTS_EQ_EMPTY] THEN SET_TAC[]);;
3560 let CARD_EQ_PERFECT_SET = prove
3562 closed s /\ (!x. x IN s ==> x limit_point_of s) /\ ~(s = {})
3564 REPEAT STRIP_TAC THEN
3565 FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP CARD_EQ_CLOSED) THEN
3566 ASM_REWRITE_TAC[] THEN
3567 RULE_ASSUM_TAC(REWRITE_RULE[GSYM COUNTABLE; GSYM ge_c]) THEN
3568 MP_TAC(ISPECL [`IMAGE (\x:real^N. s DELETE x) s`; `s:real^N->bool`]
3569 BAIRE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
3570 SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN
3571 MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL
3572 [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3573 GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
3574 ASM_CASES_TAC `x:real^N = y` THEN
3575 ASM_SIMP_TAC[IN_CLOSURE_DELETE] THEN
3576 MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
3577 ASM_REWRITE_TAC[IN_DELETE];
3578 REWRITE_TAC[INTERS_IMAGE; IN_DELETE] THEN
3579 SUBGOAL_THEN `{y:real^N | !x. x IN s ==> y IN s /\ ~(y = x)} = {}`
3581 [ASM SET_TAC[]; ASM_REWRITE_TAC[CLOSURE_EMPTY; SUBSET_EMPTY]]]);;
3583 (* ------------------------------------------------------------------------- *)
3584 (* Density of sets with small complement, including irrationals. *)
3585 (* ------------------------------------------------------------------------- *)
3587 let COSMALL_APPROXIMATION = prove
3588 (`!s. ((:real) DIFF s) <_c (:real)
3589 ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
3591 (`!s. ((:real^1) DIFF s) <_c (:real)
3592 ==> !x e. &0 < e ==> ?y. y IN s /\ norm(y - x) < e`,
3593 REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3594 `~({x | P x} SUBSET UNIV DIFF s) ==> ?x. x IN s /\ P x`) THEN
3595 MP_TAC(ISPEC `ball(x:real^1,e)` CARD_EQ_OPEN) THEN
3596 ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE] THEN DISCH_TAC THEN
3597 DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
3598 REWRITE_TAC[CARD_NOT_LE] THEN
3599 REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM ball] THEN
3600 TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
3601 ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE]) in
3602 REWRITE_TAC[FORALL_DROP_IMAGE; FORALL_DROP; EXISTS_DROP] THEN
3603 REWRITE_TAC[GSYM IMAGE_DROP_UNIV; GSYM DROP_SUB; GSYM ABS_DROP] THEN
3604 REWRITE_TAC[DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN
3605 SIMP_TAC[GSYM IMAGE_DIFF_INJ; DROP_EQ] THEN GEN_TAC THEN
3606 DISCH_TAC THEN MATCH_MP_TAC lemma THEN POP_ASSUM MP_TAC THEN
3607 MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_LT_CONG THEN
3608 REWRITE_TAC[IMAGE_DROP_UNIV; CARD_EQ_REFL] THEN
3609 MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[DROP_EQ]);;
3611 let COCOUNTABLE_APPROXIMATION = prove
3612 (`!s. COUNTABLE((:real) DIFF s)
3613 ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
3614 GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_TAC THEN
3615 MATCH_MP_TAC COSMALL_APPROXIMATION THEN
3616 TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_REWRITE_TAC[] THEN
3617 TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3618 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3619 REWRITE_TAC[CARD_EQ_REAL]);;
3621 let IRRATIONAL_APPROXIMATION = prove
3622 (`!x e. &0 < e ==> ?y. ~(rational y) /\ abs(y - x) < e`,
3623 REWRITE_TAC[SET_RULE `~rational y <=> y IN UNIV DIFF rational`] THEN
3624 MATCH_MP_TAC COCOUNTABLE_APPROXIMATION THEN
3625 REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COUNTABLE_RATIONAL]);;
3627 let OPEN_SET_COSMALL_COORDINATES = prove
3628 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3629 ==> (:real) DIFF {x | P i x} <_c (:real))
3630 ==> !s:real^N->bool.
3632 ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
3633 REPEAT STRIP_TAC THEN
3634 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
3635 DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
3636 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
3637 DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
3638 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
3640 `!i. 1 <= i /\ i <= dimindex(:N)
3641 ==> ?y:real. P i y /\ abs(y - (a:real^N)$i) < d / &(dimindex(:N))`
3643 [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
3644 FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
3645 DISCH_THEN(MP_TAC o MATCH_MP COSMALL_APPROXIMATION) THEN
3646 REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
3647 ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1];
3648 REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3649 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
3650 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3651 REWRITE_TAC[IN_CBALL; dist] THEN
3652 W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
3653 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
3654 MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
3655 REWRITE_TAC[VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN
3656 ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
3657 ASM_SIMP_TAC[REAL_LT_IMP_LE; CARD_NUMSEG_1]]);;
3659 let OPEN_SET_COCOUNTABLE_COORDINATES = prove
3660 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3661 ==> COUNTABLE((:real) DIFF {x | P i x}))
3662 ==> !s:real^N->bool.
3664 ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
3665 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SET_COSMALL_COORDINATES THEN
3666 REPEAT STRIP_TAC THEN
3667 TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
3668 TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3669 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3670 REWRITE_TAC[CARD_EQ_REAL]);;
3672 let OPEN_SET_IRRATIONAL_COORDINATES = prove
3675 ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> ~rational(x$i)`,
3676 MATCH_MP_TAC OPEN_SET_COCOUNTABLE_COORDINATES THEN
3677 REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;
3679 let CLOSURE_COSMALL_COORDINATES = prove
3680 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3681 ==> (:real) DIFF {x | P i x} <_c (:real))
3682 ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
3684 GEN_TAC THEN DISCH_TAC THEN
3685 REWRITE_TAC[CLOSURE_APPROACHABLE; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
3686 MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN
3687 FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_SET_COSMALL_COORDINATES) THEN
3688 DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e)`) THEN
3689 ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; IN_BALL] THEN
3690 MESON_TAC[DIST_SYM]);;
3692 let CLOSURE_COCOUNTABLE_COORDINATES = prove
3693 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3694 ==> COUNTABLE((:real) DIFF {x | P i x}))
3695 ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
3697 REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_COSMALL_COORDINATES THEN
3698 REPEAT STRIP_TAC THEN
3699 TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
3700 TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3701 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3702 REWRITE_TAC[CARD_EQ_REAL]);;
3704 let CLOSURE_IRRATIONAL_COORDINATES = prove
3705 (`closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> ~rational(x$i)} =
3707 MATCH_MP_TAC CLOSURE_COCOUNTABLE_COORDINATES THEN
3708 REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;
3710 (* ------------------------------------------------------------------------- *)
3711 (* Every path between distinct points contains an arc, and hence *)
3712 (* that path connection is equivalent to arcwise connection, for distinct *)
3713 (* points. The proof is based on Whyburn's "Topological Analysis". *)
3714 (* ------------------------------------------------------------------------- *)
3716 let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove
3717 (`!f:real^1->real^N.
3718 f continuous_on interval[vec 0,vec 1] /\
3719 (!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\
3720 ~(f(vec 1) = f(vec 0))
3721 ==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic
3722 (interval[vec 0:real^1,vec 1])`,
3723 let closure_dyadic_rationals_in_convex_set_pos_1 = prove
3724 (`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x)
3725 ==> closure(s INTER { lift(&m / &2 pow n) |
3726 m IN (:num) /\ n IN (:num)}) =
3728 REPEAT STRIP_TAC THEN
3729 MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN
3730 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
3731 MATCH_MP_TAC(SET_RULE
3732 `(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t)
3733 ==> s INTER t = s INTER u`) THEN
3734 REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN
3735 REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN
3736 REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN
3737 CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN
3738 MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN
3739 FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN
3740 ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN
3741 ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in
3742 let function_on_dyadic_rationals = prove
3744 (!m n. f (2 * m) (n + 1) = f m n)
3745 ==> ?g. !m n. g(&m / &2 pow n) = f m n`,
3746 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL
3747 [`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`]
3748 FUNCTION_FACTORS_LEFT) THEN
3749 REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN
3750 DISCH_THEN (SUBST1_TAC o SYM) THEN
3751 ONCE_REWRITE_TAC[MESON[]
3752 `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN
3753 MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
3754 SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0)
3755 ==> (x / y = x' / y' <=> y' / y * x = x')`;
3756 REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN
3757 SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
3758 SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN
3760 `(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=>
3761 (!d m n. P m (g d m) n d)`] THEN
3762 INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN
3763 REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in
3764 let recursion_on_dyadic_rationals = prove
3766 ?f. (!m. f(&m) = b m) /\
3767 (!m n. f(&(4 * m + 1) / &2 pow (n + 1)) =
3768 l(f(&(2 * m + 1) / &2 pow n))) /\
3769 (!m n. f(&(4 * m + 3) / &2 pow (n + 1)) =
3770 r(f(&(2 * m + 1) / &2 pow n)))`,
3774 (!m n. f (2 * m) (n + 1) = f m n) /\
3775 (!m. f m 0 = b m) /\
3776 (!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\
3777 (!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))`
3779 [MP_TAC(prove_recursive_functions_exist num_RECURSION
3780 `(!m. f m 0 = (b:num->A) m) /\
3781 (!m n. f m (SUC n) =
3782 if EVEN m then f (m DIV 2) n
3783 else if EVEN(m DIV 2)
3784 then l(f ((m + 1) DIV 2) n)
3785 else r(f (m DIV 2) n))`) THEN
3786 MATCH_MP_TAC MONO_EXISTS THEN
3787 X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN
3788 RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN
3789 REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN
3790 REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`;
3791 ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`;
3792 ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`;
3793 ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN
3794 REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND];
3795 DISCH_THEN(X_CHOOSE_THEN `f:num->num->A`
3796 (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
3797 DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN
3798 MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
3799 DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN
3800 RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN
3801 ASM_REWRITE_TAC[]]) in
3802 let recursion_on_dyadic_rationals_1 = prove
3804 ?f. (!m. f(&m / &2) = b) /\
3805 (!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) =
3806 l(f(&(2 * m + 1) / &2 pow n))) /\
3807 (!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) =
3808 r(f(&(2 * m + 1) / &2 pow n)))`,
3810 MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`]
3811 recursion_on_dyadic_rationals) THEN
3813 DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN
3814 EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN
3815 ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN
3816 CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
3817 ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ;
3818 ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in
3819 let exists_function_unpair = prove
3820 (`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`,
3821 EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN
3822 EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN
3823 EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN
3824 ASM_REWRITE_TAC[PAIR; ETA_AX]) in
3825 let dyadics_in_open_unit_interval = prove
3826 (`interval(vec 0,vec 1) INTER
3827 {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} =
3828 {lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`,
3829 MATCH_MP_TAC(SET_RULE
3830 `(!m n. (f m n) IN s <=> P m n)
3831 ==> s INTER {f m n | m IN UNIV /\ n IN UNIV} =
3832 {f m n | P m n}`) THEN
3833 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
3834 SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
3835 SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in
3836 REPEAT STRIP_TAC THEN
3838 `!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1]
3839 ==> ?c d. drop a <= drop c /\ drop c <= drop m /\
3840 drop m <= drop d /\ drop d <= drop b /\
3841 (!x. x IN interval[c,d] ==> f x = f m) /\
3842 (!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\
3843 (!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\
3844 (!x y. x IN interval[a,c] DELETE c /\
3845 y IN interval[d,b] DELETE d
3846 ==> ~((f:real^1->real^N) x = f y))`
3848 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN
3849 REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3851 `?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
3855 `{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
3857 {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}`
3859 [REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM;
3861 GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
3864 `?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} =
3867 [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN
3868 ONCE_REWRITE_TAC[SET_RULE
3869 `{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN
3870 MATCH_MP_TAC COMPACT_INTER_CLOSED THEN
3871 REWRITE_TAC[COMPACT_INTERVAL] THEN
3872 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
3873 ASM_REWRITE_TAC[CLOSED_INTERVAL];
3874 STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]];
3876 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN
3877 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN
3878 SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL
3879 [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
3880 REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
3882 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN
3883 SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL
3884 [ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN
3886 FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
3888 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN
3889 STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
3891 [GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN
3892 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
3893 [GSYM th]) THEN SIMP_TAC[IN_ELIM_THM];
3895 GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
3896 [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
3897 `{x | x IN s /\ f x = a} = t
3898 ==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t))
3899 ==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN
3900 REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC;
3902 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
3903 REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN
3904 SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL
3905 [REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`;
3908 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
3909 (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
3910 REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN
3911 REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN
3912 ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL
3913 [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3914 ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL
3915 [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3916 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3917 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o
3918 SPEC `(f:real^1->real^N) y`) THEN
3919 ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL
3920 [`x:real^1`; `y:real^1`; `m:real^1`]) THEN
3921 ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
3923 REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3925 [`leftcut:real^1->real^1->real^1->real^1`;
3926 `rightcut:real^1->real^1->real^1->real^1`] THEN
3928 FIRST_ASSUM(MP_TAC o SPECL
3929 [`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN
3930 REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC
3931 `u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN
3932 REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN
3933 REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
3934 DISCH_THEN(SUBST1_TAC o SYM) THEN
3935 REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
3937 FIRST_ASSUM(MP_TAC o SPECL
3938 [`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN
3939 REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
3940 ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC
3941 `v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN
3942 ONCE_REWRITE_TAC[TAUT
3943 `a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN
3944 REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN
3945 ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3946 REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
3949 `!x. x IN interval[vec 0,v] DELETE v
3950 ==> ~((f:real^1->real^N) x = f(vec 1))`
3952 [X_GEN_TAC `t:real^1` THEN
3953 REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN
3954 ASM_CASES_TAC `drop t < drop u` THENL
3955 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
3956 `~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`));
3958 FIRST_X_ASSUM MATCH_MP_TAC THEN
3959 ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
3962 `!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))`
3965 [`(u:real^1,v:real^1)`;
3966 `\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`;
3967 `\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`]
3968 recursion_on_dyadic_rationals_1) THEN
3969 REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN
3970 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3971 MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN
3972 ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN
3973 REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
3974 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
3976 `!m n. drop u <= drop(a(&m / &2 pow n)) /\
3977 drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\
3978 drop(b(&m / &2 pow n)) <= drop v`
3980 [GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN
3982 [REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
3983 ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL];
3984 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN
3985 X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL
3986 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
3987 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3988 REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN
3989 ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD
3990 `&0 < y ==> (&2 * x) / (&2 * y) = x / y`];
3992 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
3993 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3994 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
3995 [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL];
3996 REWRITE_TAC[ADD1]] THEN
3997 DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL
3998 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
3999 DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
4000 ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`];
4001 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4002 DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
4003 ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN
4004 (FIRST_X_ASSUM(MP_TAC o SPECL
4005 [`a(&(2 * r + 1) / &2 pow n):real^1`;
4006 `b(&(2 * r + 1) / &2 pow n):real^1`;
4007 `c(&(2 * r + 1) / &2 pow n):real^1`]) THEN
4009 [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4011 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4012 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4013 UNDISCH_TAC `drop(vec 0) <= drop u` THEN
4014 UNDISCH_TAC `drop v <= drop (vec 1)`;
4016 REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC);
4017 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
4018 SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL
4019 [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4020 SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL
4021 [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4023 `!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\
4024 drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))`
4026 [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
4027 (fun th -> REWRITE_TAC[GSYM th]) THEN
4028 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4029 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4030 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
4031 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
4034 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
4035 ==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\
4036 drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))`
4038 [REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN
4039 DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL
4040 [GEN_TAC THEN STRIP_TAC THEN
4041 MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)`
4042 REAL_ABS_INTEGER_LEMMA) THEN
4044 `i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN
4045 REPEAT CONJ_TAC THENL
4046 [REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN
4047 REWRITE_TAC[REAL_ARITH
4048 `n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN
4049 ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
4050 MESON_TAC[INTEGER_CLOSED];
4051 SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN
4052 REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN
4053 SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4054 ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`];
4055 ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ;
4056 REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]];
4058 X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN
4059 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4060 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4061 [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
4062 ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS];
4064 UNDISCH_THEN `n:num < m`
4065 (fun th -> let th' = MATCH_MP
4066 (ARITH_RULE `n < m ==> m - SUC n < m - n`) th in
4067 FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN
4068 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
4069 `&i / &2 pow m = &(2 * j + 1) / &2 pow n \/
4070 &i / &2 pow m < &(2 * j + 1) / &2 pow n \/
4071 &(2 * j + 1) / &2 pow n < &i / &2 pow m`)
4073 [ASM_REWRITE_TAC[ADD1];
4074 DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN
4075 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
4076 MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
4077 [MATCH_MP_TAC(REAL_ARITH
4078 `x < i /\ &2 * n1 = n /\ j + n1 = i
4079 ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
4080 ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN
4081 REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4082 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4084 MATCH_MP_TAC(REAL_ARITH
4085 `b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN
4086 FIRST_X_ASSUM(MP_TAC o SPECL
4087 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4088 `b(&(2 * j + 1) / &2 pow n):real^1`;
4089 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4090 ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4091 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4093 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4094 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4095 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4096 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]];
4097 DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN
4098 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
4099 MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
4100 [MATCH_MP_TAC(REAL_ARITH
4101 `i < x /\ &2 * n1 = n /\ j - n1 = i
4102 ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
4103 ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN
4104 REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4105 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4107 MATCH_MP_TAC(REAL_ARITH
4108 `a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN
4109 FIRST_X_ASSUM(MP_TAC o SPECL
4110 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4111 `b(&(2 * j + 1) / &2 pow n):real^1`;
4112 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4113 ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4114 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4116 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4117 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4118 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4119 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]];
4122 `!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n)))
4125 [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL
4126 [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
4127 ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN
4128 RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
4130 X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN
4131 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4132 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4133 [ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
4134 RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
4136 DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
4137 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4138 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4139 REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN
4140 ASM_SIMP_TAC[ADD1] THEN
4141 MATCH_MP_TAC(REAL_ARITH
4142 `drop c = (drop a + drop b) / &2 /\
4143 abs(drop a - drop b) <= &2 * k /\
4144 drop a <= drop(leftcut a b c) /\
4145 drop(leftcut a b c) <= drop c
4146 ==> abs(drop a - drop(leftcut a b c)) <= k`);
4147 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4148 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4149 REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN
4150 ASM_SIMP_TAC[ADD1] THEN
4151 MATCH_MP_TAC(REAL_ARITH
4152 `drop c = (drop a + drop b) / &2 /\
4153 abs(drop a - drop b) <= &2 * k /\
4154 drop c <= drop(rightcut a b c) /\
4155 drop(rightcut a b c) <= drop b
4156 ==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN
4158 [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
4159 (fun th -> REWRITE_TAC[GSYM th]) THEN
4160 REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC;
4163 [REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4164 REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN
4165 ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH];
4167 FIRST_X_ASSUM(MP_TAC o SPECL
4168 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4169 `b(&(2 * j + 1) / &2 pow n):real^1`;
4170 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4171 ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4172 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4174 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4175 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4176 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4177 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]);
4180 `!n j. 0 < 2 * j /\ 2 * j < 2 EXP n
4181 ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) =
4182 f(a(&(2 * j + 1) / &2 pow n))`
4184 [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
4185 [REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
4186 ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
4189 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN
4190 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4191 [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN
4192 REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
4193 ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
4196 X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
4197 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4198 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4199 REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN
4200 CONV_TAC NUM_REDUCE_CONV THEN
4201 ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`;
4202 ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN
4203 SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN
4204 STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
4205 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4206 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4208 ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`;
4209 ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN
4210 FIRST_X_ASSUM(MP_TAC o SPECL
4211 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4212 `b(&(2 * j + 1) / &2 pow n):real^1`;
4213 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4215 [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4217 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4218 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4219 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4220 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
4221 REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4222 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4223 MATCH_MP_TAC(MESON[]
4224 `a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN
4225 REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4226 ASM_MESON_TAC[REAL_LE_TRANS]]];
4229 `!n j. 0 < j /\ j < 2 EXP n
4230 ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) =
4231 f(c(&j / &2 pow n)) /\
4232 f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))`
4234 [MATCH_MP_TAC num_INDUCTION THEN
4235 REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN
4236 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
4237 X_GEN_TAC `j:num` THEN
4238 DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL
4239 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4240 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4241 REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`;
4242 ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN
4243 REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN
4244 ASM_REWRITE_TAC[] THEN
4245 MATCH_MP_TAC(MESON[]
4246 `c' = c /\ a' = a /\ b' = b
4247 ==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN
4248 REPEAT CONJ_TAC THEN AP_TERM_TAC THENL
4250 REWRITE_TAC[real_pow; real_div; REAL_INV_MUL;
4251 GSYM REAL_OF_NUM_MUL] THEN
4253 REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN
4254 FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
4255 SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL
4256 [ASM_ARITH_TAC; ALL_TAC] THEN
4257 REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`;
4258 ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN
4259 REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC];
4260 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4261 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4262 REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN
4263 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
4264 [`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
4265 `b(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
4266 `c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN
4268 [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
4269 REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4270 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
4271 REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
4272 DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN
4273 ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1;
4274 ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`;
4275 ARITH_RULE `0 < n + 1`] THEN
4276 ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN
4277 ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
4278 ASM_REAL_ARITH_TAC];
4280 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
4281 MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
4282 REWRITE_TAC[COMPACT_INTERVAL] THEN
4283 MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`;
4284 `interval(vec 0,vec 1) INTER
4285 {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`]
4286 UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
4287 SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1;
4288 CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL;
4289 UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4290 CLOSURE_OPEN_INTERVAL] THEN
4291 REWRITE_TAC[dyadics_in_open_unit_interval] THEN
4293 [REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN
4294 X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN
4295 `(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]`
4297 [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL];
4298 REWRITE_TAC[uniformly_continuous_on]] THEN
4299 DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
4300 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4301 MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN
4302 ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
4303 CONV_TAC REAL_RAT_REDUCE_CONV THEN
4304 DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
4305 ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
4306 CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
4307 EXISTS_TAC `inv(&2 pow n)` THEN
4308 REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN
4309 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4310 REWRITE_TAC[FORALL_IN_GSPEC] THEN
4312 `!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
4313 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
4314 ==> norm((f:real^1->real^N)(c(&i / &2 pow m)) -
4315 f(c(&j / &2 pow n))) < e / &2`
4317 [REPEAT GEN_TAC THEN
4318 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4319 DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH
4322 abs(x - (a - e / &2)) < e / &2 \/
4323 abs(x - (a + e / &2)) < e / &2`))
4325 [DISCH_THEN SUBST1_TAC THEN
4326 ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF];
4329 `&j / &2 pow n = &(2 * j) / &2 pow (n + 1)`
4330 (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])
4332 [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL;
4333 GSYM REAL_OF_NUM_MUL] THEN
4336 REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN
4337 REWRITE_TAC[GSYM real_div;
4338 GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN
4339 REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`;
4340 REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN
4341 ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN
4342 REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL
4343 [SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
4344 f(b (&(2 * j - 1) / &2 pow (n + 1)))`
4345 SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC];
4346 SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
4347 f(a (&(2 * j + 1) / &2 pow (n + 1)))`
4348 SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN
4349 REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4350 REWRITE_TAC[IN_INTERVAL_1] THEN
4351 REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4352 FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL
4353 [DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB];
4354 DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN
4355 ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN
4356 REWRITE_TAC[DIST_REAL; GSYM drop] THENL
4357 [MATCH_MP_TAC(NORM_ARITH
4358 `!t. abs(a - b) <= t /\ t < d
4359 ==> a <= c /\ c <= b ==> abs(c - b) < d`);
4360 MATCH_MP_TAC(NORM_ARITH
4361 `!t. abs(a - b) <= t /\ t < d
4362 ==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN
4363 EXISTS_TAC `&2 / &2 pow (n + 1)` THEN
4365 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4366 REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN
4367 ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`];
4368 REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
4369 ASM_REAL_ARITH_TAC]);
4371 MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN
4372 MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
4373 REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN
4375 `?j. 0 < j /\ j < 2 EXP n /\
4376 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
4377 abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
4378 STRIP_ASSUME_TAC THENL
4379 [MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
4380 (&2 pow n * &k / &2 pow p)`
4382 SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV;
4383 REAL_POS; REAL_POW_LE] THEN
4384 DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN
4385 MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
4386 (&2 pow n * &k / &2 pow p)` FLOOR) THEN
4387 ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN
4388 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4389 SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4390 REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN
4391 ASM_CASES_TAC `j = 0` THENL
4392 [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN
4393 DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
4394 REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN
4395 ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN
4396 MATCH_MP_TAC(REAL_ARITH
4397 `&0 < x /\ x < inv n /\ &0 < y /\ y < inv n
4398 ==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN
4399 ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2];
4400 DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN
4401 REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
4402 CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
4403 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
4404 SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN
4405 REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN
4406 REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN
4407 SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN
4408 ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]];
4409 MATCH_MP_TAC(NORM_ARITH
4410 `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
4411 ==> dist(w,z) < e`) THEN
4412 EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN
4413 REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4416 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
4417 REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN
4418 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN
4419 FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN
4420 ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN
4421 REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN
4422 ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN
4423 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
4424 SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
4425 REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
4426 REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN
4427 REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN
4429 [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4430 [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
4431 closure_dyadic_rationals_in_convex_set_pos_1) THEN
4432 SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4433 INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4434 CLOSURE_OPEN_INTERVAL] THEN
4435 DISCH_THEN(fun th ->
4436 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN
4437 MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
4438 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4439 CONTINUOUS_ON_SUBSET)) THEN
4440 MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
4441 MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4442 REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED];
4443 MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
4444 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
4445 ASM_REWRITE_TAC[COMPACT_INTERVAL];
4446 SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN
4447 ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN
4448 MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4449 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
4450 ASM_MESON_TAC[REAL_LE_TRANS]];
4451 MATCH_MP_TAC SUBSET_TRANS THEN
4452 EXISTS_TAC `closure(IMAGE (h:real^1->real^N)
4453 (interval (vec 0,vec 1) INTER
4454 {lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN
4457 MATCH_MP_TAC CLOSURE_MINIMAL THEN
4458 ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL;
4459 COMPACT_CONTINUOUS_IMAGE] THEN
4460 MATCH_MP_TAC IMAGE_SUBSET THEN
4461 MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4462 REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN
4463 REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN
4464 REWRITE_TAC[dyadics_in_open_unit_interval;
4465 EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
4466 X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
4467 X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC
4468 `(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN
4469 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4470 COMPACT_UNIFORMLY_CONTINUOUS)) THEN
4471 REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
4472 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
4473 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4476 ==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\
4477 y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\
4478 (f:real^1->real^N) y = f x`
4481 MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`]
4482 REAL_ARCH_POW_INV) THEN
4483 ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
4484 CONV_TAC REAL_RAT_REDUCE_CONV THEN
4485 DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
4486 ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
4487 CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
4488 DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
4489 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
4490 DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN
4491 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4492 DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN
4493 ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4494 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4495 REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN
4496 REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4497 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4499 ==> a <= c /\ c <= b /\ abs(a - b) < d
4500 ==> abs(c - y) < d`)) THEN
4501 REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4502 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN
4503 ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
4504 MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN
4505 X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL
4506 [EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
4507 ASM_REWRITE_TAC[REAL_POW_1] THEN
4509 `x IN interval[vec 0:real^1,u] \/
4510 x IN interval[u,v] \/
4511 x IN interval[v,vec 1]`
4512 STRIP_ASSUME_TAC THENL
4513 [REWRITE_TAC[IN_INTERVAL_1] THEN
4514 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4516 EXISTS_TAC `u:real^1` THEN
4517 ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1];
4518 EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[];
4519 EXISTS_TAC `v:real^1` THEN
4520 ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]];
4521 DISCH_THEN(X_CHOOSE_THEN `m:num`
4522 (X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN
4523 REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4524 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
4525 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4526 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN
4527 REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
4529 `y IN interval[a(&(2 * j + 1) / &2 pow n):real^1,
4530 b(&(4 * j + 1) / &2 pow (n + 1))] \/
4531 y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)),
4532 a(&(4 * j + 3) / &2 pow (n + 1))] \/
4533 y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)),
4534 b(&(2 * j + 1) / &2 pow n)]`
4535 STRIP_ASSUME_TAC THENL
4536 [REWRITE_TAC[IN_INTERVAL_1] THEN
4537 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4539 EXISTS_TAC `4 * j + 1` THEN
4540 EXISTS_TAC `y:real^1` THEN
4541 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4542 REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4543 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4545 ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4546 ASM_MESON_TAC[LE_1];
4547 EXISTS_TAC `4 * j + 1` THEN
4548 EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN
4549 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4550 REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4551 REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4552 CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4553 FIRST_X_ASSUM(MP_TAC o SPECL
4554 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4555 `b(&(2 * j + 1) / &2 pow n):real^1`;
4556 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4558 [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
4560 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4561 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
4562 MATCH_MP_TAC(MESON[]
4563 `a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN
4565 `leftcut (a (&(2 * j + 1) / &2 pow n))
4566 (b (&(2 * j + 1) / &2 pow n))
4567 (c (&(2 * j + 1) / &2 pow n):real^1):real^1 =
4568 b(&(4 * j + 1) / &2 pow (n + 1)) /\
4569 rightcut (a (&(2 * j + 1) / &2 pow n))
4570 (b (&(2 * j + 1) / &2 pow n))
4571 (c (&(2 * j + 1) / &2 pow n)):real^1 =
4572 a(&(4 * j + 3) / &2 pow (n + 1))`
4573 (CONJUNCTS_THEN SUBST_ALL_TAC) THENL
4574 [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN
4575 REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4576 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4577 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4579 ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4580 ASM_MESON_TAC[LE_1];
4581 EXISTS_TAC `4 * j + 3` THEN
4582 EXISTS_TAC `y:real^1` THEN
4583 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4584 REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4585 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4587 ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4588 ASM_MESON_TAC[LE_1]]]];
4591 `!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\
4592 (!x. drop(a(&m / &2 pow n)) < drop x /\
4593 drop x <= drop(b(&m / &2 pow n))
4594 ==> ~(f x = f(a(&m / &2 pow n)))) /\
4595 (!x. drop(a(&m / &2 pow n)) <= drop x /\
4596 drop x < drop(b(&m / &2 pow n))
4597 ==> ~(f x :real^N = f(b(&m / &2 pow n))))`
4599 [SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL
4600 [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
4601 RULE_ASSUM_TAC(REWRITE_RULE
4602 [IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN
4603 ASM_MESON_TAC[DROP_EQ];
4606 `(!x. drop u < drop x /\ drop x <= drop v
4607 ==> ~((f:real^1->real^N) x = f u)) /\
4608 (!x. drop u <= drop x /\ drop x < drop v
4610 STRIP_ASSUME_TAC THENL
4612 `(f:real^1->real^N) u = f(vec 0) /\
4613 (f:real^1->real^N) v = f(vec 1)`
4614 (CONJUNCTS_THEN SUBST1_TAC)
4616 [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4617 ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL];
4619 CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN
4620 FIRST_X_ASSUM MATCH_MP_TAC THEN
4621 ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN
4624 MATCH_MP_TAC num_INDUCTION THEN
4625 ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN
4626 ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN
4627 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
4628 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN
4629 ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
4630 X_GEN_TAC `j:num` THEN
4631 DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL
4632 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4633 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4634 SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN
4635 ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`];
4637 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4638 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4639 DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL
4640 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4641 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
4642 ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN
4643 FIRST_X_ASSUM(MP_TAC o SPECL
4644 [`a(&(2 * m + 1) / &2 pow n):real^1`;
4645 `b(&(2 * m + 1) / &2 pow n):real^1`;
4646 `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
4648 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4649 ASM_MESON_TAC[REAL_LE_TRANS];
4650 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4651 DISCH_THEN(K ALL_TAC)] THEN
4654 (leftcut (a (&(2 * m + 1) / &2 pow n):real^1)
4655 (b (&(2 * m + 1) / &2 pow n):real^1)
4656 (c (&(2 * m + 1) / &2 pow n):real^1)) =
4657 (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
4659 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4660 ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
4661 ASM_REWRITE_TAC[]] THEN
4662 GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
4663 REPEAT CONJ_TAC THENL
4664 [DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
4666 `(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) =
4667 f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
4669 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
4670 REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
4671 midpoint; DROP_CMUL; DROP_ADD] THEN
4672 ASM_REWRITE_TAC[REAL_ARITH
4673 `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`];
4674 GEN_TAC THEN STRIP_TAC THEN
4675 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
4676 ASM_MESON_TAC[REAL_LE_TRANS];
4677 GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
4678 (fun th -> MATCH_MP_TAC th THEN
4679 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4680 GEN_REWRITE_TAC I [REAL_ARITH
4681 `(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN
4683 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4684 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
4685 ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1 = 4 * m + 3`; ADD1] THEN
4686 FIRST_X_ASSUM(MP_TAC o SPECL
4687 [`a(&(2 * m + 1) / &2 pow n):real^1`;
4688 `b(&(2 * m + 1) / &2 pow n):real^1`;
4689 `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
4691 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4692 ASM_MESON_TAC[REAL_LE_TRANS];
4693 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4694 DISCH_THEN(K ALL_TAC)] THEN
4697 (rightcut (a (&(2 * m + 1) / &2 pow n):real^1)
4698 (b (&(2 * m + 1) / &2 pow n):real^1)
4699 (c (&(2 * m + 1) / &2 pow n):real^1)) =
4700 (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
4702 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4703 ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
4704 ASM_REWRITE_TAC[]] THEN
4705 GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
4706 REPEAT CONJ_TAC THENL
4707 [DISCH_THEN SUBST_ALL_TAC THEN
4709 `(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) =
4710 f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
4712 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
4713 REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
4714 midpoint; DROP_CMUL; DROP_ADD] THEN
4715 ASM_REWRITE_TAC[REAL_ARITH
4716 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`];
4717 GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
4718 (fun th -> MATCH_MP_TAC th THEN
4719 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4720 GEN_REWRITE_TAC I [REAL_ARITH
4721 `(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN
4723 GEN_TAC THEN STRIP_TAC THEN
4724 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
4725 ASM_MESON_TAC[REAL_LE_TRANS]]];
4728 `!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
4729 &i / &2 pow m < &j / &2 pow n
4730 ==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))`
4734 0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\
4735 &i / &2 pow m < &k / &2 pow p /\ m + p = N
4736 ==> ?j n. ODD(j) /\ ~(n = 0) /\
4737 &i / &2 pow m <= &j / &2 pow n /\
4738 &j / &2 pow n <= &k / &2 pow p /\
4739 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
4740 abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
4742 [MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN
4743 DISCH_THEN(LABEL_TAC "I") THEN
4744 MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN
4747 `&i / &2 pow m <= &1 / &2 pow 1 /\
4748 &1 / &2 pow 1 <= &k / &2 pow p \/
4749 &k / &2 pow p < &1 / &2 \/
4750 &1 / &2 < &i / &2 pow m`
4751 (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC)
4753 [ASM_REAL_ARITH_TAC;
4754 MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN
4755 MATCH_MP_TAC(REAL_ARITH
4756 `&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1
4757 ==> abs(i - &1 / &2 pow 1) < inv(&2 pow 1) /\
4758 abs(k - &1 / &2 pow 1) < inv(&2 pow 1)`) THEN
4759 ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
4760 REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN
4761 ASM_REWRITE_TAC[REAL_OF_NUM_LT];
4762 REMOVE_THEN "I" MP_TAC THEN
4763 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
4764 SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
4765 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4766 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4767 SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
4768 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4769 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4770 STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
4771 ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
4772 DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN
4773 ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
4774 [MAP_EVERY UNDISCH_TAC
4775 [`&k / &2 pow SUC p < &1 / &2`;
4776 `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
4777 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4778 REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
4779 SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
4780 REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
4781 `x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN
4782 SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
4783 REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT];
4784 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
4785 DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
4786 EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN
4787 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4788 REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
4789 REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
4790 REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
4791 REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
4792 ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
4793 REAL_OF_NUM_LT; ARITH]];
4794 REMOVE_THEN "I" MP_TAC THEN
4795 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
4796 SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
4797 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4798 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4799 SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
4800 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4801 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4802 STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
4803 ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
4804 DISCH_THEN(MP_TAC o SPECL
4805 [`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN
4806 ASM_REWRITE_TAC[] THEN
4807 MAP_EVERY UNDISCH_TAC
4808 [`&1 / &2 < &i / &2 pow SUC m`;
4809 `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
4810 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4811 REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
4812 SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
4813 GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
4814 STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP
4815 (REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN
4816 SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
4817 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN
4818 SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
4819 STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL
4820 [ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN
4821 ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4822 REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
4823 ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4824 ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=>
4825 u / v < w / z`] THEN
4826 CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE
4827 `i < 2 * m ==> i - m < m`) THEN
4828 ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)];
4829 REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
4830 ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4831 REWRITE_TAC[GSYM real_div] THEN
4832 DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num`
4833 STRIP_ASSUME_TAC)) THEN
4834 EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN
4835 ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN
4836 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN
4837 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4838 REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
4839 REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
4840 REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
4841 REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
4842 ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
4843 REAL_OF_NUM_LT; ARITH] THEN
4844 REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
4845 ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4846 REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]];
4847 DISCH_THEN(fun th ->
4848 MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN
4849 STRIP_TAC THEN MP_TAC(ISPECL
4850 [`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN
4851 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4852 MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN
4853 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4854 REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN
4855 X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
4856 MATCH_MP_TAC REAL_LE_TRANS THEN
4857 EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL
4858 [ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN
4859 ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4861 `drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\
4862 drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))`
4864 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4865 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
4866 SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4867 REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
4868 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4870 ==> i <= q /\ ~(i = q) /\ q = q' + n / &2
4871 ==> abs(i - q') < n / &2`)) THEN
4872 ASM_REWRITE_TAC[] THEN
4873 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4875 ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
4876 `l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN
4877 FIRST_X_ASSUM(MP_TAC o SPECL
4878 [`a(&(2 * q + 1) / &2 pow n):real^1`;
4879 `b(&(2 * q + 1) / &2 pow n):real^1`;
4880 `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
4882 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4883 ASM_MESON_TAC[REAL_LE_TRANS];
4884 DISCH_THEN(fun th -> REWRITE_TAC[th])]];
4885 ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN
4886 ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4888 `drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\
4889 drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))`
4891 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4892 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
4893 SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4894 REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
4895 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4897 ==> q <= i /\ ~(i = q) /\ q' = q + n / &2
4898 ==> abs(i - q') < n / &2`)) THEN
4899 ASM_REWRITE_TAC[] THEN
4900 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4902 ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
4903 `d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN
4904 FIRST_X_ASSUM(MP_TAC o SPECL
4905 [`a(&(2 * q + 1) / &2 pow n):real^1`;
4906 `b(&(2 * q + 1) / &2 pow n):real^1`;
4907 `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
4909 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4910 ASM_MESON_TAC[REAL_LE_TRANS];
4911 DISCH_THEN(fun th -> REWRITE_TAC[th])]]]];
4913 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
4914 REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
4915 REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN
4916 MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN
4918 `?m n. 0 < m /\ m < 2 EXP n /\
4919 drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\
4920 ~(h(x1):real^N = h(lift(&m / &2 pow n)))`
4921 STRIP_ASSUME_TAC THENL
4922 [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
4923 closure_dyadic_rationals_in_convex_set_pos_1) THEN
4924 SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4925 INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4926 CLOSURE_OPEN_INTERVAL] THEN
4927 REWRITE_TAC[EXTENSION] THEN
4928 DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN
4929 REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN
4930 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4931 MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN
4932 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN
4933 DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN
4934 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN
4935 REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN
4938 `?m n. (0 < m /\ m < 2 EXP n) /\
4939 abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) <
4940 (drop x2 - drop x1) / &64 /\
4941 inv(&2 pow n) < (drop x2 - drop x1) / &128`
4942 STRIP_ASSUME_TAC THENL
4943 [MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`]
4944 REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4945 DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
4946 ASM_CASES_TAC `N = 0` THENL
4947 [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN
4948 REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN
4950 FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num`
4951 STRIP_ASSUME_TAC)) THEN
4952 EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN
4953 ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1;
4956 [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
4957 REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH
4958 `(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN
4959 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ;
4960 REAL_MUL_LID; GSYM real_div];
4961 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN
4962 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN
4963 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]];
4964 REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
4965 `!m n m' n'. (P m n /\ P m' n') /\
4966 (P m n /\ P m' n' ==> ~(g m n = g m' n'))
4967 ==> (?m n. P m n /\ ~(a = g m n))`) THEN
4968 MAP_EVERY EXISTS_TAC
4969 [`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN
4971 [REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN
4972 (REWRITE_TAC[GSYM CONJ_ASSOC] THEN
4973 REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN
4974 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4975 `abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64
4976 ==> abs(x - y) < (x2 - x1) / &4
4977 ==> x1 < y /\ y < x2`)) THEN
4978 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4979 `n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN
4980 ASM_REWRITE_TAC[REAL_SUB_LT] THEN
4981 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4982 MATCH_MP_TAC(REAL_ARITH
4983 `a / y = x /\ abs(b / y) < z
4984 ==> abs(x - (a + b) / y) < z`) THEN
4985 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN
4986 SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN
4987 REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4988 SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ;
4989 REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ;
4990 REAL_OF_NUM_EQ] THEN
4991 CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC;
4992 ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
4993 FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN
4994 UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x`
4995 (fun th -> REWRITE_TAC[GSYM th] THEN
4996 ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN
4997 REWRITE_TAC[th] THEN ASSUME_TAC th) THEN
4999 CONV_TAC(RAND_CONV SYM_CONV) THEN
5000 FIRST_X_ASSUM(MP_TAC o SPECL
5001 [`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
5002 `b(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
5003 `c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN
5005 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
5006 ASM_MESON_TAC[REAL_LE_TRANS];
5007 REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5008 DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN
5009 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
5010 REWRITE_TAC[REAL_ARITH
5011 `(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN
5012 REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN
5013 ASM_REWRITE_TAC[REAL_ARITH
5014 `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN
5015 ASM_REWRITE_TAC[REAL_LT_LE]]];
5018 `IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET
5019 IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\
5020 IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET
5021 IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])`
5023 [MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)`
5024 closure_dyadic_rationals_in_convex_set_pos_1) THEN
5025 MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))`
5026 closure_dyadic_rationals_in_convex_set_pos_1) THEN
5027 SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1`
5028 STRIP_ASSUME_TAC THENL
5029 [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ;
5030 REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES];
5033 `(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2)
5034 ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN
5035 ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
5036 INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
5037 CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN
5038 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5039 CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
5040 (MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
5041 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5042 CONTINUOUS_ON_SUBSET)) THEN
5043 MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
5044 MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
5045 ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC;
5047 MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
5048 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
5049 ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN
5050 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5051 CONTINUOUS_ON_SUBSET)) THEN
5052 REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
5053 ASM_MESON_TAC[REAL_LE_TRANS];
5054 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
5055 MATCH_MP_TAC(SET_RULE
5056 `i SUBSET interval(vec 0,vec 1) /\
5057 (!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x)
5058 ==> !x. x IN i INTER l ==> P x`) THEN
5059 ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
5060 REAL_LT_IMP_LE; REAL_LE_REFL] THEN
5061 REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN
5062 MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
5063 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
5064 STRIP_TAC THEN ASM_SIMP_TAC[] THEN
5065 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
5066 ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]);
5067 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
5068 `IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t'
5069 ==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN
5070 DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN
5071 ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN
5072 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
5073 `a IN IMAGE f s /\ a IN IMAGE f t
5074 ==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN
5075 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5076 MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN
5077 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
5078 FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o
5079 GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN
5080 REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN
5081 DISCH_THEN(MP_TAC o SPECL
5082 [`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN
5083 UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN
5084 ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN
5085 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
5086 ASM_MESON_TAC[REAL_LE_TRANS]]);;
5088 let PATH_CONTAINS_ARC = prove
5089 (`!p:real^1->real^N a b.
5090 path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b)
5091 ==> ?q. arc q /\ path_image q SUBSET path_image p /\
5092 pathstart q = a /\ pathfinish q = b`,
5093 REWRITE_TAC[pathstart; pathfinish; path] THEN
5094 MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN
5095 STRIP_TAC THEN MP_TAC(ISPECL
5096 [`\s. s SUBSET interval[vec 0,vec 1] /\
5097 vec 0 IN s /\ vec 1 IN s /\
5098 (!x y. x IN s /\ y IN s /\ segment(x,y) INTER s = {}
5099 ==> (f:real^1->real^N)(x) = f(y))`;
5100 `interval[vec 0:real^1,vec 1]`]
5101 BROUWER_REDUCTION_THEOREM_GEN) THEN
5102 ASM_REWRITE_TAC[GSYM path_image; CLOSED_INTERVAL; SUBSET_REFL] THEN
5106 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
5107 REPEAT GEN_TAC THEN STRIP_TAC THEN
5108 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5109 `s INTER i = {} ==> s SUBSET i ==> s = {}`)) THEN
5110 REWRITE_TAC[SEGMENT_EQ_EMPTY] THEN
5111 ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN
5112 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF i SUBSET t`) THEN
5113 ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]] THEN
5114 X_GEN_TAC `s:num->real^1->bool` THEN
5115 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL
5116 [REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
5119 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
5120 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
5121 REWRITE_TAC[] THEN CONJ_TAC THENL
5122 [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[];
5123 REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN
5124 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
5125 REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
5126 SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN
5127 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
5128 FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5129 COMPACT_UNIFORMLY_CONTINUOUS)) THEN
5130 REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
5131 DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN
5132 ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN
5133 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
5135 `?u v. u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
5136 norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v`
5137 STRIP_ASSUME_TAC THENL
5139 FIRST_X_ASSUM(fun th ->
5140 MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN
5141 MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN
5142 ASM_REWRITE_TAC[dist] THEN
5143 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5144 MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN
5145 CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN
5147 `?w z. w IN interval(x,y) /\ z IN interval(x,y) /\ drop w < drop z /\
5148 norm(w - x) < e /\ norm(z - y) < e`
5149 STRIP_ASSUME_TAC THENL
5150 [EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN
5151 EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN
5152 REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP;
5153 NORM_REAL; GSYM drop] THEN
5156 MP_TAC(ISPECL [`interval[w:real^1,z]`;
5157 `{s n :real^1->bool | n IN (:num)}`] COMPACT_IMP_FIP) THEN
5158 ASM_REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_GSPEC] THEN
5159 MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN
5161 [REWRITE_TAC[INTERS_GSPEC; IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
5163 `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
5164 REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5165 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5168 REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=>
5169 (?x. P x /\ Q x /\ ~R x)`] THEN
5170 ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
5171 REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
5172 DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN
5173 FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP
5174 UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5175 X_GEN_TAC `n:num` THEN DISCH_TAC THEN
5177 `interval[w,z] INTER (s:num->real^1->bool) n = {}`
5179 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5180 `a INTER t = {} ==> s SUBSET t ==> a INTER s = {}`)) THEN
5181 REWRITE_TAC[SUBSET; INTERS_IMAGE; IN_ELIM_THM] THEN
5182 REWRITE_TAC[SET_RULE
5183 `(!x. x IN s n ==> !i. i IN k ==> x IN s i) <=>
5184 (!i. i IN k ==> s n SUBSET s i)`] THEN
5186 `!i n. i <= n ==> (s:num->real^1->bool) n SUBSET s i`
5187 (fun th -> ASM_MESON_TAC[th]) THEN
5188 MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
5192 `?u. u IN (s:num->real^1->bool) n /\ u IN interval[x,w] /\
5193 (interval[u,w] DELETE u) INTER (s n) = {}`
5195 [ASM_CASES_TAC `w IN (s:num->real^1->bool) n` THENL
5196 [EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
5197 REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
5198 REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
5199 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5201 MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[x,w]`;
5202 `w:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
5203 ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
5204 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN
5205 ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
5206 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5207 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
5208 REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5209 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5210 `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
5211 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5212 [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5213 ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM];
5215 [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5216 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5218 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]];
5220 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN
5222 `?v. v IN (s:num->real^1->bool) n /\ v IN interval[z,y] /\
5223 (interval[z,v] DELETE v) INTER (s n) = {}`
5225 [ASM_CASES_TAC `z IN (s:num->real^1->bool) n` THENL
5226 [EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
5227 REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
5228 REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
5229 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5231 MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[z,y]`;
5232 `z:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
5233 ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
5234 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN
5235 ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
5236 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5237 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN
5238 REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5239 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5240 `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
5241 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5243 [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5244 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5246 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]];
5247 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5248 ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]]];
5250 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
5251 REPEAT CONJ_TAC THENL
5254 RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
5255 REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5256 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5257 RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
5258 REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5259 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5260 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN
5261 ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5262 [MAP_EVERY UNDISCH_TAC
5263 [`interval[w,z] INTER (s:num->real^1->bool) n = {}`;
5264 `interval[u,w] DELETE u INTER (s:num->real^1->bool) n = {}`;
5265 `interval[z,v] DELETE v INTER (s:num->real^1->bool) n = {}`] THEN
5266 REWRITE_TAC[IMP_IMP; SET_RULE
5267 `s1 INTER t = {} /\ s2 INTER t = {} <=>
5268 (s1 UNION s2) INTER t = {}`] THEN
5269 MATCH_MP_TAC(SET_RULE
5270 `t SUBSET s ==> s INTER u = {} ==> t INTER u = {}`) THEN
5271 REWRITE_TAC[SUBSET; IN_UNION; IN_DELETE;
5272 GSYM DROP_EQ; IN_INTERVAL_1] THEN
5274 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]];
5276 DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN
5277 ASM_CASES_TAC `t:real^1->bool = {}` THENL
5278 [ASM_MESON_TAC[IN_IMAGE; NOT_IN_EMPTY]; ALL_TAC] THEN
5280 `h = \x. (f:real^1->real^N)(@y. y IN t /\ segment(x,y) INTER t = {})` THEN
5282 `!x y. y IN t /\ segment(x,y) INTER t = {} ==> h(x) = (f:real^1->real^N)(y)`
5285 `!x y z. y IN t /\ segment(x,y) INTER t = {} /\
5286 z IN t /\ segment(x,z) INTER t = {}
5287 ==> (f:real^1->real^N)(y) = f(z)`
5289 [REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1) IN t` THENL
5290 [ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1) IN t)`] THEN
5291 ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=>
5292 (a /\ c) ==> p /\ b /\ d ==> q`] THEN
5294 REWRITE_TAC[SET_RULE `~(x IN t) /\ s INTER t = {} /\ s' INTER t = {} <=>
5295 (x INSERT (s UNION s')) INTER t = {}`] THEN
5296 DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
5297 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
5298 `s SUBSET s' ==> s' INTER t = {} ==> s INTER t = {}`) THEN
5299 REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
5300 GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
5301 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5303 REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]];
5305 SUBGOAL_THEN `!x. x IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL
5306 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5307 ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY];
5309 SUBGOAL_THEN `!x:real^1. ?y. y IN t /\ segment(x,y) INTER t = {}`
5311 [X_GEN_TAC `x:real^1` THEN
5312 EXISTS_TAC `closest_point t (x:real^1)` THEN
5313 ASM_SIMP_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS];
5316 `!x y. segment(x,y) INTER t = {} ==> (h:real^1->real^N) x = h y`
5318 [MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN
5319 ASM_CASES_TAC `(x:real^1) IN t` THENL
5320 [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
5321 ASM_CASES_TAC `(x':real^1) IN t` THENL
5322 [ASM_MESON_TAC[]; ALL_TAC] THEN
5324 `?y y'. y IN t /\ segment(x,y) INTER t = {} /\ h x = f y /\
5325 y' IN t /\ segment(x',y') INTER t = {} /\
5326 (h:real^1->real^N) x' = f y'`
5327 STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5328 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5329 ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC
5330 [`~((x:real^1) IN t)`; `~((x':real^1) IN t)`;
5331 `segment(x:real^1,y) INTER t = {}`;
5332 `segment(x':real^1,y') INTER t = {}`;
5333 `segment(x:real^1,x') INTER t = {}`] THEN
5334 MATCH_MP_TAC(SET_RULE
5335 `s SUBSET (x1 INSERT x2 INSERT (s0 UNION s1 UNION s2))
5336 ==> s0 INTER t = {} ==> s1 INTER t = {} ==> s2 INTER t = {}
5337 ==> ~(x1 IN t) ==> ~(x2 IN t) ==> s INTER t = {}`) THEN
5338 REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
5339 GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
5340 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5343 MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN
5345 [REPEAT CONJ_TAC THENL
5346 [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
5347 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5348 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
5349 DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN
5350 DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
5351 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
5352 ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
5353 ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
5354 [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN
5356 `(?w:real^1. w IN t /\ w IN segment[u,v] /\ segment(u,w) INTER t = {}) /\
5357 (?z:real^1. z IN t /\ z IN segment[u,v] /\ segment(v,z) INTER t = {})`
5358 STRIP_ASSUME_TAC THENL
5360 [MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `u:real^1`]
5361 SEGMENT_TO_POINT_EXISTS);
5362 MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `v:real^1`]
5363 SEGMENT_TO_POINT_EXISTS)] THEN
5364 (ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT] THEN ANTS_TAC THENL
5365 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5366 `~(segment(u,v) INTER t = {})
5367 ==> segment(u,v) SUBSET segment[u,v]
5368 ==> ~(segment[u,v] INTER t = {})`)) THEN
5369 REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED];
5371 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN
5372 SIMP_TAC[IN_INTER] THEN
5373 MATCH_MP_TAC(SET_RULE
5374 `(w IN uv ==> uw SUBSET uv)
5375 ==> (w IN uv /\ w IN t) /\ (uw INTER uv INTER t = {})
5376 ==> uw INTER t = {}`) THEN
5377 DISCH_TAC THEN REWRITE_TAC[open_segment] THEN
5378 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN
5379 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
5380 REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_SEGMENT] THEN
5381 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT]);
5382 SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\
5383 (h:real^1->real^N) v = (f:real^1->real^N) z`
5384 (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5385 MATCH_MP_TAC(NORM_ARITH
5386 `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
5387 ==> dist(w,z) < e`) THEN
5388 EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN
5389 FIRST_X_ASSUM MATCH_MP_TAC THEN
5391 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5392 `x IN s ==> s SUBSET t ==> x IN t`)) THEN
5393 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
5394 ASM_REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET];
5395 ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]])];
5396 X_GEN_TAC `z:real^N` THEN
5397 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
5398 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
5399 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
5400 REWRITE_TAC[connected_component] THEN
5401 EXISTS_TAC `segment[u:real^1,v]` THEN
5402 REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN
5403 ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
5404 [REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ P x} <=>
5405 s SUBSET t /\ !x. x IN s ==> P x`] THEN
5407 [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL];
5408 X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
5409 SUBGOAL_THEN `segment(u:real^1,x) INTER t = {}`
5410 (fun th -> ASM_MESON_TAC[th]) THEN
5411 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5412 `uv INTER t = {} ==> ux SUBSET uv ==> ux INTER t = {}`)) THEN
5413 UNDISCH_TAC `(x:real^1) IN segment[u,v]` THEN
5414 REWRITE_TAC[SEGMENT_1] THEN
5415 REPEAT(COND_CASES_TAC THEN
5416 ASM_REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1]) THEN
5417 ASM_REAL_ARITH_TAC];
5419 FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF segment(u:real^1,v)`) THEN
5420 ASM_REWRITE_TAC[SET_RULE `t DIFF s PSUBSET t <=> ~(s INTER t = {})`] THEN
5421 MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
5422 REPEAT CONJ_TAC THENL
5424 MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[OPEN_SEGMENT_1];
5426 ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
5427 [`(u:real^1) IN interval[vec 0,vec 1]`;
5428 `(v:real^1) IN interval[vec 0,vec 1]`] THEN
5429 REWRITE_TAC[SEGMENT_1] THEN
5430 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5432 ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
5433 [`(u:real^1) IN interval[vec 0,vec 1]`;
5434 `(v:real^1) IN interval[vec 0,vec 1]`] THEN
5435 REWRITE_TAC[SEGMENT_1] THEN
5436 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5438 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
5439 REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
5440 ASM_CASES_TAC `segment(x:real^1,y) INTER segment(u,v) = {}` THENL
5441 [ASM SET_TAC[]; ALL_TAC] THEN
5443 `(segment(x:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
5444 segment(y:real^1,v) SUBSET segment(x,y) DIFF segment(u,v)) \/
5445 (segment(y:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
5446 segment(x:real^1,v) SUBSET segment(x,y) DIFF segment(u,v))`
5448 [MAP_EVERY UNDISCH_TAC
5449 [`~(x IN segment(u:real^1,v))`; `~(y IN segment(u:real^1,v))`;
5450 `~(segment(x:real^1,y) INTER segment (u,v) = {})`] THEN
5451 POP_ASSUM_LIST(K ALL_TAC) THEN
5452 MAP_EVERY (fun t -> SPEC_TAC(t,t))
5453 [`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN
5454 REWRITE_TAC[FORALL_LIFT] THEN
5455 MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
5456 [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
5457 REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
5458 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
5459 REWRITE_TAC[FORALL_LIFT] THEN
5460 MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
5461 [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
5462 REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
5463 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
5464 ASM_REWRITE_TAC[SEGMENT_1] THEN
5465 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
5466 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
5467 REWRITE_TAC[IN_INTERVAL_1; SUBSET; IN_DIFF; AND_FORALL_THM] THEN
5469 DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN
5471 `i SUBSET xy DIFF uv
5472 ==> xy INTER (t DIFF uv) = {} ==> i INTER t = {}` in
5473 fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN
5479 arc q /\ path_image q SUBSET path_image f /\
5480 a IN path_image q /\ b IN path_image q`
5481 STRIP_ASSUME_TAC THENL
5482 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
5483 REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
5484 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
5485 REWRITE_TAC[arc; path; path_image] THEN
5486 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
5488 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; path_image] THEN ASM SET_TAC[];
5489 REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
5490 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
5491 REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN
5492 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]];
5494 `?u v. u IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\
5495 v IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v`
5496 STRIP_ASSUME_TAC THENL
5497 [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[];
5499 EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL
5500 [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
5501 ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH];
5502 ASM_MESON_TAC[SUBSET_TRANS; PATH_IMAGE_SUBPATH_SUBSET; ARC_IMP_PATH];
5503 ASM_MESON_TAC[pathstart; PATHSTART_SUBPATH];
5504 ASM_MESON_TAC[pathfinish; PATHFINISH_SUBPATH]]]);;
5506 let PATH_CONNECTED_ARCWISE = prove
5508 path_connected s <=>
5509 !x y. x IN s /\ y IN s /\ ~(x = y)
5511 path_image g SUBSET s /\
5514 GEN_TAC THEN REWRITE_TAC[path_connected] THEN EQ_TAC THEN DISCH_TAC THEN
5515 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
5516 FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
5517 ASM_REWRITE_TAC[] THENL
5518 [DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
5519 MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`]
5520 PATH_CONTAINS_ARC) THEN
5521 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
5522 ASM_MESON_TAC[SUBSET_TRANS];
5523 ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THENL
5524 [EXISTS_TAC `linepath(y:real^N,y)` THEN
5525 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
5526 PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
5527 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARC_IMP_PATH]]]);;
5529 let ARC_CONNECTED_TRANS = prove
5530 (`!g h:real^1->real^N.
5532 pathfinish g = pathstart h /\ ~(pathstart g = pathfinish h)
5534 path_image i SUBSET (path_image g UNION path_image h) /\
5535 pathstart i = pathstart g /\
5536 pathfinish i = pathfinish h`,
5537 REPEAT STRIP_TAC THEN
5538 MP_TAC(ISPECL [`g ++ h:real^1->real^N`; `pathstart(g):real^N`;
5539 `pathfinish(h):real^N`] PATH_CONTAINS_ARC) THEN
5540 ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_JOIN_EQ; ARC_IMP_PATH;
5543 (* ------------------------------------------------------------------------- *)
5544 (* Local versions of topological properties in general. *)
5545 (* ------------------------------------------------------------------------- *)
5547 let locally = new_definition
5548 `locally P (s:real^N->bool) <=>
5549 !w x. open_in (subtopology euclidean s) w /\ x IN w
5550 ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\
5551 x IN u /\ u SUBSET v /\ v SUBSET w`;;
5553 let LOCALLY_MONO = prove
5554 (`!P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s`,
5555 REWRITE_TAC[locally] THEN MESON_TAC[]);;
5557 let LOCALLY_OPEN_SUBSET = prove
5558 (`!P s t:real^N->bool.
5559 locally P s /\ open_in (subtopology euclidean s) t
5561 REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN
5562 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5563 FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
5564 ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
5565 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
5566 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5567 MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
5568 EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[open_in; SUBSET]);;
5570 let LOCALLY_DIFF_CLOSED = prove
5571 (`!P s t:real^N->bool.
5572 locally P s /\ closed_in (subtopology euclidean s) t
5573 ==> locally P (s DIFF t)`,
5574 REPEAT STRIP_TAC THEN
5575 MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
5576 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5577 MATCH_MP_TAC OPEN_IN_DIFF THEN
5578 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]);;
5580 let LOCALLY_EMPTY = prove
5581 (`!P. locally P {}`,
5582 REWRITE_TAC[locally] THEN MESON_TAC[open_in; SUBSET; NOT_IN_EMPTY]);;
5584 let LOCALLY_SING = prove
5585 (`!P a. locally P {a} <=> P {a}`,
5586 REWRITE_TAC[locally; open_in] THEN
5587 REWRITE_TAC[SET_RULE
5588 `(w SUBSET {a} /\ P) /\ x IN w <=> w = {a} /\ x = a /\ P`] THEN
5589 SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_SING] THEN
5590 REWRITE_TAC[SET_RULE
5591 `(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=>
5592 u = {a} /\ v = {a} /\ P /\ Q`] THEN
5593 REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; IN_SING] THEN
5594 REWRITE_TAC[FORALL_UNWIND_THM2; MESON[REAL_LT_01] `?x. &0 < x`]);;
5596 let LOCALLY_INTER = prove
5597 (`!P:(real^N->bool)->bool.
5598 (!s t. P s /\ P t ==> P(s INTER t))
5599 ==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)`,
5600 GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
5601 REWRITE_TAC[locally; OPEN_IN_OPEN] THEN
5602 REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; MESON[]
5603 `(!w x. (?t. P t /\ w = f t) /\ Q w x ==> R w x) <=>
5604 (!t x. P t /\ Q (f t) x ==> R (f t) x)`] THEN
5605 ONCE_REWRITE_TAC[MESON[]
5606 `(?a b c. P a b c /\ Q a b c /\ R a b c) <=>
5607 (?b c a. Q a b c /\ P a b c /\ R a b c)`] THEN
5608 REWRITE_TAC[AND_FORALL_THM; UNWIND_THM2; IN_INTER] THEN
5609 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:real^N->bool` THEN
5610 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
5611 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5612 ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2
5613 (X_CHOOSE_THEN `u1:real^N->bool` (X_CHOOSE_THEN `v1:real^N->bool`
5615 (X_CHOOSE_THEN `u2:real^N->bool` (X_CHOOSE_THEN `v2:real^N->bool`
5616 STRIP_ASSUME_TAC))) THEN
5617 EXISTS_TAC `u1 INTER u2:real^N->bool` THEN
5618 EXISTS_TAC `v1 INTER v2:real^N->bool` THEN
5619 ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);;
5621 let HOMEOMORPHISM_LOCALLY = prove
5622 (`!P Q f:real^N->real^M g.
5623 (!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t))
5624 ==> (!s t. homeomorphism (s,t) (f,g)
5625 ==> (locally P s <=> locally Q t))`,
5629 (!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t)
5630 ==> (!s:real^N->bool t:real^M->bool.
5631 locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)`,
5632 REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
5633 REWRITE_TAC[locally] THEN STRIP_TAC THEN
5634 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
5635 MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `y:real^M`] THEN STRIP_TAC THEN
5636 FIRST_X_ASSUM(MP_TAC o SPECL
5637 [`IMAGE (g:real^M->real^N) w`; `(g:real^M->real^N) y`]) THEN
5639 [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5640 SUBGOAL_THEN `IMAGE (g:real^M->real^N) w =
5641 {x | x IN s /\ f(x) IN w}`
5643 [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
5644 MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
5645 REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
5646 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
5647 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
5648 [`IMAGE (f:real^N->real^M) u`; `IMAGE (f:real^N->real^M) v`] THEN
5650 [SUBGOAL_THEN `IMAGE (f:real^N->real^M) u =
5651 {x | x IN t /\ g(x) IN u}`
5653 [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
5654 MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
5657 [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N->bool` THEN
5658 ASM_REWRITE_TAC[homeomorphism] THEN
5659 REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN
5660 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5661 CONTINUOUS_ON_SUBSET)));
5663 RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]) in
5664 REPEAT STRIP_TAC THEN EQ_TAC THEN
5665 MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM;
5666 TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN
5667 ASM_MESON_TAC[HOMEOMORPHISM_SYM]);;
5669 let HOMEOMORPHIC_LOCALLY = prove
5670 (`!P Q. (!s:real^N->bool t:real^M->bool. s homeomorphic t ==> (P s <=> Q t))
5671 ==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))`,
5672 REPEAT GEN_TAC THEN STRIP_TAC THEN
5673 REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
5674 ONCE_REWRITE_TAC[MESON[]
5675 `(!a b c d. P a b c d) <=> (!c d a b. P a b c d)`] THEN
5676 GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_LOCALLY THEN
5677 ASM_MESON_TAC[homeomorphic]);;
5679 let LOCALLY_TRANSLATION = prove
5680 (`!P:(real^N->bool)->bool.
5681 (!a s. P (IMAGE (\x. a + x) s) <=> P s)
5682 ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)`,
5683 GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
5685 [`P:(real^N->bool)->bool`; `P:(real^N->bool)->bool`;
5686 `\x:real^N. a + x`; `\x:real^N. --a + x`]
5687 HOMEOMORPHISM_LOCALLY) THEN
5688 REWRITE_TAC[homeomorphism] THEN
5689 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
5690 REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; GSYM IMAGE_o; o_DEF; IMAGE_ID;
5691 VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`] THEN
5694 let LOCALLY_INJECTIVE_LINEAR_IMAGE = prove
5695 (`!P:(real^N->bool)->bool Q:(real^M->bool)->bool.
5696 (!f s. linear f /\ (!x y. f x = f y ==> x = y)
5697 ==> (P (IMAGE f s) <=> Q s))
5698 ==> (!f s. linear f /\ (!x y. f x = f y ==> x = y)
5699 ==> (locally P (IMAGE f s) <=> locally Q s))`,
5700 GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
5701 ASM_CASES_TAC `linear(f:real^M->real^N) /\ (!x y. f x = f y ==> x = y)` THEN
5702 ASM_REWRITE_TAC[] THEN
5703 FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5704 REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5705 DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
5707 [`Q:(real^M->bool)->bool`; `P:(real^N->bool)->bool`;
5708 `f:real^M->real^N`; `g:real^N->real^M`]
5709 HOMEOMORPHISM_LOCALLY) THEN
5710 ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN
5711 ASM_REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; FORALL_IN_IMAGE] THEN
5712 ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN MESON_TAC[]);;
5714 let LOCALLY_OPEN_MAP_IMAGE = prove
5715 (`!P Q f:real^M->real^N s.
5716 f continuous_on s /\
5717 (!t. open_in (subtopology euclidean s) t
5718 ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\
5719 (!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\
5721 ==> locally Q (IMAGE f s)`,
5723 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5724 REWRITE_TAC[locally] THEN DISCH_TAC THEN
5725 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN
5727 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
5728 FIRST_ASSUM(MP_TAC o SPEC `w:real^N->bool` o
5729 GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
5730 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5731 SUBGOAL_THEN `?x. x IN s /\ (f:real^M->real^N) x = y` STRIP_ASSUME_TAC THENL
5732 [ASM SET_TAC[]; ALL_TAC] THEN
5733 FIRST_X_ASSUM(MP_TAC o SPECL
5734 [`{x | x IN s /\ (f:real^M->real^N) x IN w}`; `x:real^M`]) THEN
5735 ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5736 MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
5737 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
5738 [`IMAGE (f:real^M->real^N) u`; `IMAGE (f:real^M->real^N) v`] THEN
5739 ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5740 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);;
5742 (* ------------------------------------------------------------------------- *)
5743 (* Important special cases of local connectedness & path connectedness. *)
5744 (* ------------------------------------------------------------------------- *)
5746 let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT =
5749 locally connected s <=>
5750 !v x. open_in (subtopology euclidean s) v /\ x IN v
5751 ==> ?u. open_in (subtopology euclidean s) u /\
5753 x IN u /\ u SUBSET v) /\
5755 locally connected s <=>
5756 !t x. open_in (subtopology euclidean s) t /\ x IN t
5757 ==> open_in (subtopology euclidean s)
5758 (connected_component t x))`,
5759 REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
5761 `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
5762 REPEAT CONJ_TAC THENL
5763 [MESON_TAC[SUBSET_REFL];
5765 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
5766 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5767 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5768 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
5769 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
5770 THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5771 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
5772 STRIP_ASSUME_TAC)) THEN
5773 EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5774 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
5775 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
5776 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5778 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5779 EXISTS_TAC `connected_component u (x:real^N)` THEN
5780 REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
5781 ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);;
5783 let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT =
5786 locally path_connected s <=>
5787 !v x. open_in (subtopology euclidean s) v /\ x IN v
5788 ==> ?u. open_in (subtopology euclidean s) u /\
5790 x IN u /\ u SUBSET v) /\
5792 locally path_connected s <=>
5793 !t x. open_in (subtopology euclidean s) t /\ x IN t
5794 ==> open_in (subtopology euclidean s)
5795 (path_component t x))`,
5796 REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
5798 `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
5799 REPEAT CONJ_TAC THENL
5800 [MESON_TAC[SUBSET_REFL];
5802 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
5803 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5804 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5805 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
5806 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
5807 THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5808 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
5809 STRIP_ASSUME_TAC)) THEN
5810 EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5811 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
5812 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
5813 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5815 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5816 EXISTS_TAC `path_component u (x:real^N)` THEN
5817 REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
5818 ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);;
5820 let LOCALLY_CONNECTED_OPEN_COMPONENT = prove
5822 locally connected s <=>
5823 !t c. open_in (subtopology euclidean s) t /\ c IN components t
5824 ==> open_in (subtopology euclidean s) c`,
5825 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
5826 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC]);;
5828 let LOCALLY_CONNECTED_IM_KLEINEN = prove
5830 locally connected s <=>
5831 !v x. open_in (subtopology euclidean s) v /\ x IN v
5832 ==> ?u. open_in (subtopology euclidean s) u /\
5833 x IN u /\ u SUBSET v /\
5835 ==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`,
5836 GEN_TAC THEN EQ_TAC THENL
5837 [REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN
5838 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
5839 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN
5840 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5841 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5842 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
5843 ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN
5844 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
5845 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5846 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5847 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
5848 DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
5849 SUBGOAL_THEN `(k:real^N->bool) SUBSET c` MP_TAC THENL
5850 [ALL_TAC; ASM SET_TAC[]] THEN
5851 MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
5852 EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);;
5854 let LOCALLY_PATH_CONNECTED_IM_KLEINEN = prove
5856 locally path_connected s <=>
5857 !v x. open_in (subtopology euclidean s) v /\ x IN v
5858 ==> ?u. open_in (subtopology euclidean s) u /\
5859 x IN u /\ u SUBSET v /\
5861 ==> ?p. path p /\ path_image p SUBSET v /\
5862 pathstart p = x /\ pathfinish p = y`,
5863 GEN_TAC THEN EQ_TAC THENL
5864 [REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
5865 REWRITE_TAC[path_connected] THEN
5866 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
5867 MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
5868 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
5869 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5870 REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN DISCH_TAC THEN
5871 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `z:real^N`] THEN STRIP_TAC THEN
5872 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5873 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5874 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
5875 ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5876 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
5877 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5878 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5879 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
5880 DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
5882 `(path_image p) SUBSET path_component u (z:real^N)` MP_TAC
5883 THENL [ALL_TAC; ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]] THEN
5884 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
5885 MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
5886 ASM_SIMP_TAC[PATH_CONNECTED_PATH_IMAGE] THEN
5887 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);;
5889 let LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED = prove
5890 (`!s:real^N->bool. locally path_connected s ==> locally connected s`,
5891 MESON_TAC[LOCALLY_MONO; PATH_CONNECTED_IMP_CONNECTED]);;
5893 let LOCALLY_CONNECTED_COMPONENTS = prove
5894 (`!s c:real^N->bool.
5895 locally connected s /\ c IN components s ==> locally connected c`,
5896 REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5897 (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
5898 FIRST_X_ASSUM(MATCH_MP_TAC o
5899 GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
5900 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;
5902 let LOCALLY_CONNECTED_CONNECTED_COMPONENT = prove
5905 ==> locally connected (connected_component s x)`,
5906 REPEAT STRIP_TAC THEN
5907 ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
5908 ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
5909 MATCH_MP_TAC LOCALLY_CONNECTED_COMPONENTS THEN
5910 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
5911 ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
5913 let LOCALLY_PATH_CONNECTED_COMPONENTS = prove
5914 (`!s c:real^N->bool.
5915 locally path_connected s /\ c IN components s
5916 ==> locally path_connected c`,
5917 REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5918 (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
5919 FIRST_X_ASSUM(MATCH_MP_TAC o
5920 GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT] o
5921 MATCH_MP LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED) THEN
5922 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;
5924 let LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT = prove
5926 locally path_connected s
5927 ==> locally path_connected (connected_component s x)`,
5928 REPEAT STRIP_TAC THEN
5929 ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
5930 ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
5931 MATCH_MP_TAC LOCALLY_PATH_CONNECTED_COMPONENTS THEN
5932 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
5933 ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
5935 let OPEN_IMP_LOCALLY_PATH_CONNECTED = prove
5936 (`!s:real^N->bool. open s ==> locally path_connected s`,
5937 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
5938 EXISTS_TAC `convex:(real^N->bool)->bool` THEN
5939 REWRITE_TAC[CONVEX_IMP_PATH_CONNECTED] THEN
5940 ASM_SIMP_TAC[locally; OPEN_IN_OPEN_EQ] THEN
5941 ASM_MESON_TAC[OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; CONVEX_BALL;
5944 let OPEN_IMP_LOCALLY_CONNECTED = prove
5945 (`!s:real^N->bool. open s ==> locally connected s`,
5946 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
5947 EXISTS_TAC `path_connected:(real^N->bool)->bool` THEN
5948 ASM_SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED;
5949 PATH_CONNECTED_IMP_CONNECTED]);;
5951 let LOCALLY_PATH_CONNECTED_UNIV = prove
5952 (`locally path_connected (:real^N)`,
5953 SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; OPEN_UNIV]);;
5955 let LOCALLY_CONNECTED_UNIV = prove
5956 (`locally connected (:real^N)`,
5957 SIMP_TAC[OPEN_IMP_LOCALLY_CONNECTED; OPEN_UNIV]);;
5959 let OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED = prove
5962 ==> open_in (subtopology euclidean s) (connected_component s x)`,
5963 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
5964 REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
5965 [FIRST_X_ASSUM MATCH_MP_TAC THEN
5966 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
5967 ASM_MESON_TAC[OPEN_IN_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]]);;
5969 let OPEN_IN_COMPONENTS_LOCALLY_CONNECTED = prove
5970 (`!s c:real^N->bool.
5971 locally connected s /\ c IN components s
5972 ==> open_in (subtopology euclidean s) c`,
5973 MESON_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT; OPEN_IN_REFL]);;
5975 let OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
5977 locally path_connected s
5978 ==> open_in (subtopology euclidean s) (path_component s x)`,
5979 REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
5980 REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
5981 [FIRST_X_ASSUM MATCH_MP_TAC THEN
5982 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
5983 ASM_MESON_TAC[OPEN_IN_EMPTY; PATH_COMPONENT_EQ_EMPTY]]);;
5985 let CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
5987 locally path_connected s
5988 ==> closed_in (subtopology euclidean s) (path_component s x)`,
5989 REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
5990 PATH_COMPONENT_SUBSET] THEN
5991 REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEMENT_PATH_COMPONENT_UNIONS] THEN
5992 MATCH_MP_TAC OPEN_IN_UNIONS THEN
5993 REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
5994 ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED]);;
5996 let CONVEX_IMP_LOCALLY_PATH_CONNECTED = prove
5997 (`!s:real^N->bool. convex s ==> locally path_connected s`,
5998 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
5999 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
6000 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6001 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6002 FIRST_X_ASSUM SUBST_ALL_TAC THEN
6003 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
6004 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
6005 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6006 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6007 EXISTS_TAC `s INTER ball(x:real^N,e)` THEN REPEAT CONJ_TAC THENL
6008 [REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[OPEN_BALL];
6009 MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
6010 ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL];
6011 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL];
6014 let OPEN_IN_CONNECTED_COMPONENTS = prove
6015 (`!s c:real^N->bool.
6016 FINITE(components s) /\ c IN components s
6017 ==> open_in (subtopology euclidean s) c`,
6018 REWRITE_TAC[components; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
6019 SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT]);;
6021 let FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS = prove
6023 compact s /\ locally connected s
6024 ==> FINITE {connected_component s x |x| x IN s}`,
6025 REPEAT STRIP_TAC THEN
6026 FIRST_X_ASSUM(MP_TAC o SPEC `{connected_component s (x:real^N) |x| x IN s}` o
6027 GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
6028 ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; FORALL_IN_GSPEC;
6029 UNIONS_CONNECTED_COMPONENT; SUBSET_REFL] THEN
6030 DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN
6031 ASM_CASES_TAC `{connected_component s (x:real^N) |x| x IN s} = cs` THEN
6033 MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN
6035 `?x:real^N. x IN s /\ ~(connected_component s x IN cs)`
6036 MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN
6037 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
6038 REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6039 SUBGOAL_THEN `?y:real^N. y IN s /\ x IN connected_component s y /\
6040 connected_component s y IN cs`
6041 STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6042 FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
6045 let FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS = prove
6047 compact s /\ locally path_connected s
6048 ==> FINITE {path_component s x |x| x IN s}`,
6049 REPEAT STRIP_TAC THEN
6050 FIRST_X_ASSUM(MP_TAC o SPEC `{path_component s (x:real^N) |x| x IN s}` o
6051 GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
6052 ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; FORALL_IN_GSPEC;
6053 UNIONS_PATH_COMPONENT; SUBSET_REFL] THEN
6054 DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN
6055 ASM_CASES_TAC `{path_component s (x:real^N) |x| x IN s} = cs` THEN
6057 MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN
6059 `?x:real^N. x IN s /\ ~(path_component s x IN cs)`
6060 MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN
6062 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
6063 REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6064 SUBGOAL_THEN `?y:real^N. y IN s /\ x IN path_component s y /\
6065 path_component s y IN cs`
6066 STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6067 FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_EQ) THEN
6070 let FINITE_COMPONENTS = prove
6071 (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE(components s)`,
6072 REWRITE_TAC[components; FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS]);;
6074 let CONVEX_IMP_LOCALLY_CONNECTED = prove
6075 (`!s:real^N->bool. convex s ==> locally connected s`,
6076 MESON_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED;
6077 LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
6079 let HOMEOMORPHIC_LOCAL_CONNECTEDNESS = prove
6080 (`!s t. s homeomorphic t ==> (locally connected s <=> locally connected t)`,
6081 MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6082 REWRITE_TAC[HOMEOMORPHIC_CONNECTEDNESS]);;
6084 let HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS = prove
6085 (`!s t. s homeomorphic t
6086 ==> (locally path_connected s <=> locally path_connected t)`,
6087 MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6088 REWRITE_TAC[HOMEOMORPHIC_PATH_CONNECTEDNESS]);;
6090 let LOCALLY_PATH_CONNECTED_TRANSLATION_EQ = prove
6091 (`!a:real^N s. locally path_connected (IMAGE (\x. a + x) s) <=>
6092 locally path_connected s`,
6093 MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6094 REWRITE_TAC[PATH_CONNECTED_TRANSLATION_EQ]);;
6096 add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];;
6098 let LOCALLY_CONNECTED_TRANSLATION_EQ = prove
6099 (`!a:real^N s. locally connected (IMAGE (\x. a + x) s) <=>
6100 locally connected s`,
6101 MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6102 REWRITE_TAC[CONNECTED_TRANSLATION_EQ]);;
6104 add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];;
6106 let LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
6107 (`!f:real^M->real^N s.
6108 linear f /\ (!x y. f x = f y ==> x = y)
6109 ==> (locally path_connected (IMAGE f s) <=> locally path_connected s)`,
6110 MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6111 REWRITE_TAC[PATH_CONNECTED_LINEAR_IMAGE_EQ]);;
6113 add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];;
6115 let LOCALLY_CONNECTED_LINEAR_IMAGE_EQ = prove
6116 (`!f:real^M->real^N s.
6117 linear f /\ (!x y. f x = f y ==> x = y)
6118 ==> (locally connected (IMAGE f s) <=> locally connected s)`,
6119 MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6120 REWRITE_TAC[CONNECTED_LINEAR_IMAGE_EQ]);;
6122 add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];;
6124 let LOCALLY_CONNECTED_QUOTIENT_IMAGE = prove
6125 (`!f:real^M->real^N s.
6126 (!t. t SUBSET IMAGE f s
6127 ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
6128 open_in (subtopology euclidean (IMAGE f s)) t)) /\
6130 ==> locally connected (IMAGE f s)`,
6131 REPEAT STRIP_TAC THEN
6132 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
6133 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN
6135 FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
6136 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
6137 FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
6138 ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
6139 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN
6140 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC
6141 `connected_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN
6142 REPEAT CONJ_TAC THENL
6143 [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
6144 ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
6145 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6146 [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
6147 REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN
6148 REWRITE_TAC[IN_COMPONENTS; IN_ELIM_THM] THEN ASM SET_TAC[];
6150 ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`]
6151 CONNECTED_COMPONENT_SUBSET) THEN
6153 `IMAGE (f:real^M->real^N) (connected_component {w | w IN s /\ f w IN u} x)
6155 MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6156 MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `u:real^N->bool` THEN
6157 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6158 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
6159 REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
6160 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
6162 [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in];
6165 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
6166 EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_REWRITE_TAC[] THEN
6167 MATCH_MP_TAC FUN_IN_IMAGE]] THEN
6168 GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
6171 let LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE = prove
6172 (`!f:real^M->real^N s.
6173 (!t. t SUBSET IMAGE f s
6174 ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
6175 open_in (subtopology euclidean (IMAGE f s)) t)) /\
6176 locally path_connected s
6177 ==> locally path_connected (IMAGE f s)`,
6178 REPEAT STRIP_TAC THEN
6179 REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
6180 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN
6182 ASSUME_TAC(ISPECL [`u:real^N->bool`; `y:real^N`] PATH_COMPONENT_SUBSET) THEN
6183 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
6184 FIRST_ASSUM(MP_TAC o SPEC `path_component u (y:real^N)`) THEN
6185 ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
6186 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN
6187 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC
6188 `path_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN
6189 REPEAT CONJ_TAC THENL
6190 [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
6191 ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
6192 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6193 [LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT]) THEN
6194 REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[];
6196 ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`]
6197 PATH_COMPONENT_SUBSET) THEN
6199 `IMAGE (f:real^M->real^N) (path_component {w | w IN s /\ f w IN u} x)
6200 SUBSET path_component u y`
6201 MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6202 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
6203 MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
6204 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6205 [MATCH_MP_TAC FUN_IN_IMAGE;
6206 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
6207 REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
6208 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
6210 [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in];
6212 ASM SET_TAC[]]] THEN
6213 GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
6216 let LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
6217 (`!f:real^M->real^N s.
6218 locally connected s /\ compact s /\ f continuous_on s
6219 ==> locally connected (IMAGE f s)`,
6220 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_QUOTIENT_IMAGE THEN
6221 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
6222 ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
6223 COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
6224 ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
6225 CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6227 let LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
6228 (`!f:real^M->real^N s.
6229 locally path_connected s /\ compact s /\ f continuous_on s
6230 ==> locally path_connected (IMAGE f s)`,
6231 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE THEN
6232 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
6233 ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
6234 COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
6235 ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
6236 CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6238 let LOCALLY_PATH_CONNECTED_PATH_IMAGE = prove
6239 (`!p:real^1->real^N. path p ==> locally path_connected (path_image p)`,
6240 REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
6241 MATCH_MP_TAC LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN
6242 ASM_SIMP_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL;
6243 CONVEX_IMP_LOCALLY_PATH_CONNECTED]);;
6245 let LOCALLY_CONNECTED_PATH_IMAGE = prove
6246 (`!p:real^1->real^N. path p ==> locally connected (path_image p)`,
6247 SIMP_TAC[LOCALLY_PATH_CONNECTED_PATH_IMAGE;
6248 LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
6250 let LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
6251 (`!f:real^M->real^N g s.
6252 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6253 (!x. x IN s ==> g(f x) = x) /\
6255 ==> locally connected (IMAGE f s)`,
6257 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6258 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
6259 MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;
6261 let LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
6262 (`!f:real^M->real^N g s.
6263 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6264 IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
6266 ==> locally connected (IMAGE f s)`,
6268 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6269 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
6270 MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
6271 EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;
6273 let LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
6274 (`!f:real^M->real^N g s.
6275 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6276 (!x. x IN s ==> g(f x) = x) /\
6277 locally path_connected s
6278 ==> locally path_connected (IMAGE f s)`,
6280 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6281 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
6282 LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
6283 MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;
6285 let LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
6286 (`!f:real^M->real^N g s.
6287 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6288 IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
6289 locally path_connected s
6290 ==> locally path_connected (IMAGE f s)`,
6292 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6293 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
6294 LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
6295 MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
6296 EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;
6298 let LOCALLY_PCROSS = prove
6300 (!s:real^M->bool t:real^N->bool. P s /\ Q t ==> R(s PCROSS t))
6301 ==> (!s t. locally P s /\ locally Q t ==> locally R (s PCROSS t))`,
6302 REPEAT STRIP_TAC THEN REWRITE_TAC[locally; FORALL_PASTECART] THEN
6304 [`w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] THEN
6305 DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN
6306 MP_TAC(MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY
6307 (ONCE_REWRITE_RULE[CONJ_SYM] th))) THEN
6308 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6309 MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
6311 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`] o
6312 GEN_REWRITE_RULE I [locally]) THEN
6313 FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `y:real^N`] o
6314 GEN_REWRITE_RULE I [locally]) THEN
6315 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6316 MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `v'':real^N->bool`] THEN
6318 MAP_EVERY X_GEN_TAC [`u':real^M->bool`; `u'':real^M->bool`] THEN
6320 EXISTS_TAC `(u':real^M->bool) PCROSS (v':real^N->bool)` THEN
6321 EXISTS_TAC `(u'':real^M->bool) PCROSS (v'':real^N->bool)` THEN
6322 ASM_SIMP_TAC[PASTECART_IN_PCROSS; PCROSS_MONO; OPEN_IN_PCROSS] THEN
6323 ASM_MESON_TAC[PCROSS_MONO; SUBSET_TRANS]);;
6325 let LOCALLY_CONNECTED_PCROSS = prove
6326 (`!s:real^M->bool t:real^N->bool.
6327 locally connected s /\ locally connected t
6328 ==> locally connected (s PCROSS t)`,
6329 MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[CONNECTED_PCROSS]);;
6331 let LOCALLY_PATH_CONNECTED_PCROSS = prove
6332 (`!s:real^M->bool t:real^N->bool.
6333 locally path_connected s /\ locally path_connected t
6334 ==> locally path_connected (s PCROSS t)`,
6335 MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[PATH_CONNECTED_PCROSS]);;
6337 let LOCALLY_CONNECTED_PCROSS_EQ = prove
6338 (`!s:real^M->bool t:real^N->bool.
6339 locally connected (s PCROSS t) <=>
6340 s = {} \/ t = {} \/ locally connected s /\ locally connected t`,
6341 REPEAT STRIP_TAC THEN
6342 ASM_CASES_TAC `s:real^M->bool = {}` THEN
6343 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6344 ASM_CASES_TAC `t:real^N->bool = {}` THEN
6345 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6346 EQ_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_PCROSS] THEN
6347 GEN_REWRITE_TAC LAND_CONV [LOCALLY_CONNECTED] THEN DISCH_TAC THEN
6348 REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
6349 [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
6350 UNDISCH_TAC `~(t:real^N->bool = {})` THEN
6351 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6352 DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
6353 FIRST_X_ASSUM(MP_TAC o SPECL
6354 [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
6355 `pastecart (x:real^M) (y:real^N)`]);
6356 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
6357 UNDISCH_TAC `~(s:real^M->bool = {})` THEN
6358 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6359 DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
6360 FIRST_X_ASSUM(MP_TAC o SPECL
6361 [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
6362 `pastecart (x:real^M) (y:real^N)`])] THEN
6363 ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
6364 OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
6365 X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
6367 [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
6368 `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
6369 ASM_REWRITE_TAC[] THENL
6370 [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
6371 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6372 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6374 X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
6375 EXISTS_TAC `IMAGE fstcart (w:real^(M,N)finite_sum->bool)` THEN
6376 ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_FSTCART] THEN
6377 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]];
6378 DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
6379 MATCH_MP_TAC MONO_EXISTS THEN
6380 X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
6381 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6383 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
6384 EXISTS_TAC `IMAGE sndcart (w:real^(M,N)finite_sum->bool)` THEN
6385 ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_SNDCART] THEN
6386 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]]] THEN
6387 RULE_ASSUM_TAC(REWRITE_RULE
6388 [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
6391 let LOCALLY_PATH_CONNECTED_PCROSS_EQ = prove
6392 (`!s:real^M->bool t:real^N->bool.
6393 locally path_connected (s PCROSS t) <=>
6395 locally path_connected s /\ locally path_connected t`,
6396 REPEAT STRIP_TAC THEN
6397 ASM_CASES_TAC `s:real^M->bool = {}` THEN
6398 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6399 ASM_CASES_TAC `t:real^N->bool = {}` THEN
6400 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6401 EQ_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_PCROSS] THEN
6402 GEN_REWRITE_TAC LAND_CONV [LOCALLY_PATH_CONNECTED] THEN DISCH_TAC THEN
6403 REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
6404 [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
6405 UNDISCH_TAC `~(t:real^N->bool = {})` THEN
6406 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6407 DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
6408 FIRST_X_ASSUM(MP_TAC o SPECL
6409 [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
6410 `pastecart (x:real^M) (y:real^N)`]);
6411 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
6412 UNDISCH_TAC `~(s:real^M->bool = {})` THEN
6413 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6414 DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
6415 FIRST_X_ASSUM(MP_TAC o SPECL
6416 [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
6417 `pastecart (x:real^M) (y:real^N)`])] THEN
6418 ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
6419 OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
6420 X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
6422 [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
6423 `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
6424 ASM_REWRITE_TAC[] THENL
6425 [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
6426 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6427 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6429 X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
6430 MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
6431 `w:real^(M,N)finite_sum->bool`]
6432 PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN
6433 REWRITE_TAC[path_connected] THEN
6434 DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `z:real^M`]) THEN ANTS_TAC THENL
6435 [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART];
6436 MATCH_MP_TAC MONO_EXISTS THEN
6437 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART] THEN
6438 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]];
6439 DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
6440 MATCH_MP_TAC MONO_EXISTS THEN
6441 X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
6442 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6444 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
6445 MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
6446 `w:real^(M,N)finite_sum->bool`]
6447 PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN
6448 REWRITE_TAC[path_connected] THEN
6449 DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ANTS_TAC THENL
6450 [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART];
6451 MATCH_MP_TAC MONO_EXISTS THEN
6452 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART] THEN
6453 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]] THEN
6454 RULE_ASSUM_TAC(REWRITE_RULE
6455 [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
6458 let CARD_EQ_OPEN_IN = prove
6459 (`!u s:real^N->bool.
6460 locally connected u /\
6461 open_in (subtopology euclidean u) s /\
6462 (?x. x IN s /\ x limit_point_of u)
6464 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
6465 [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
6466 SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN
6467 MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV];
6469 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6470 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6471 UNDISCH_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_INTER] THEN
6473 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
6474 DISCH_THEN(MP_TAC o SPECL [`u INTER t:real^N->bool`; `x:real^N`]) THEN
6475 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN
6476 REWRITE_TAC[OPEN_IN_OPEN; GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN
6477 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6478 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6479 REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN
6480 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6481 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [limit_point_of]) THEN
6482 DISCH_THEN(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN
6483 ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN
6484 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
6485 TRANS_TAC CARD_LE_TRANS `u INTER v:real^N->bool` THEN
6486 ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
6487 ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN
6490 let CARD_EQ_OPEN_IN_AFFINE = prove
6491 (`!u s:real^N->bool.
6492 affine u /\ ~(aff_dim u = &0) /\
6493 open_in (subtopology euclidean u) s /\ ~(s = {})
6495 REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_OPEN_IN THEN
6496 EXISTS_TAC `u:real^N->bool` THEN
6497 ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; AFFINE_IMP_CONVEX] THEN
6498 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
6499 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
6500 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
6501 ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED] THEN
6502 FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);;
6504 (* ------------------------------------------------------------------------- *)
6505 (* Locally convex sets. *)
6506 (* ------------------------------------------------------------------------- *)
6508 let LOCALLY_CONVEX = prove
6510 locally convex s <=>
6511 !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
6512 open_in (subtopology euclidean s) u /\
6514 GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
6515 [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
6516 (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
6517 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6518 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6519 MESON_TAC[SUBSET_INTER];
6520 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
6521 REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
6522 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6523 ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
6524 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6525 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6526 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6528 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6529 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6530 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6531 EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
6532 EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
6533 ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
6534 CONVEX_INTER; CONVEX_CBALL; IN_INTER] THEN
6535 MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
6538 (* ------------------------------------------------------------------------- *)
6539 (* Basic properties of local compactness. *)
6540 (* ------------------------------------------------------------------------- *)
6542 let LOCALLY_COMPACT = prove
6544 locally compact s <=>
6545 !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
6546 open_in (subtopology euclidean s) u /\
6548 GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
6549 [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
6550 (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
6551 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6552 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6553 MESON_TAC[SUBSET_INTER];
6554 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
6555 REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
6556 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6557 ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
6558 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6559 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6560 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6562 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6563 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6564 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6565 EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
6566 EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
6567 ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
6568 COMPACT_INTER; COMPACT_CBALL; IN_INTER] THEN
6569 MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
6572 let LOCALLY_COMPACT_ALT = prove
6574 locally compact s <=>
6577 open_in (subtopology euclidean s) u /\
6578 compact(closure u) /\ closure u SUBSET s`,
6579 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN EQ_TAC THEN
6580 DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6581 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6582 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
6583 MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL;
6584 COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6586 let LOCALLY_COMPACT_INTER_CBALL = prove
6588 locally compact s <=>
6589 !x. x IN s ==> ?e. &0 < e /\ closed(cball(x,e) INTER s)`,
6590 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT; OPEN_IN_CONTAINS_CBALL] THEN
6591 EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
6592 ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL
6593 [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6594 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6595 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
6596 X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6597 SUBGOAL_THEN `cball(x:real^N,e) INTER s = cball (x,e) INTER v`
6598 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6599 ASM_SIMP_TAC[COMPACT_CBALL; COMPACT_INTER; COMPACT_IMP_CLOSED];
6600 X_GEN_TAC `e:real` THEN STRIP_TAC THEN
6601 EXISTS_TAC `ball(x:real^N,e) INTER s` THEN
6602 EXISTS_TAC `cball(x:real^N,e) INTER s` THEN
6603 REWRITE_TAC[GSYM OPEN_IN_CONTAINS_CBALL] THEN
6604 ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET] THEN
6605 ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; BOUNDED_CBALL] THEN
6606 ONCE_REWRITE_TAC[INTER_COMM] THEN
6607 SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6608 MESON_TAC[SUBSET; IN_INTER; BALL_SUBSET_CBALL]]);;
6610 let LOCALLY_COMPACT_INTER_CBALLS = prove
6612 locally compact s <=>
6613 !x. x IN s ==> ?e. &0 < e /\ !d. d <= e ==> closed(cball(x,d) INTER s)`,
6614 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL] THEN
6615 EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_REFL]] THEN
6616 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
6617 ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
6618 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
6619 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN
6621 `cball(x:real^N,d) INTER s = cball(x,d) INTER cball(x,e) INTER s`
6623 [REWRITE_TAC[GSYM INTER_ASSOC; GSYM CBALL_MIN_INTER] THEN
6624 AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
6625 BINOP_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
6626 ASM_SIMP_TAC[CLOSED_INTER; CLOSED_CBALL]]);;
6628 let LOCALLY_COMPACT_COMPACT = prove
6630 locally compact s <=>
6631 !k. k SUBSET s /\ compact k
6632 ==> ?u v. k SUBSET u /\
6635 open_in (subtopology euclidean s) u /\
6638 GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_COMPACT] THEN EQ_TAC THEN
6639 REPEAT STRIP_TAC THENL
6640 [ALL_TAC; ASM_MESON_TAC[SING_SUBSET; COMPACT_SING]] THEN
6641 FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM] o
6642 check (is_forall o concl)) THEN
6643 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6644 MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
6646 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6647 [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
6648 DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. k INTER u x) k`) THEN
6649 ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL
6650 [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6651 REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
6652 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
6653 MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN
6655 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6656 REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN
6657 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6658 EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) t)` THEN
6659 EXISTS_TAC `UNIONS(IMAGE (v:real^N->real^N->bool) t)` THEN
6660 REPEAT CONJ_TAC THENL
6661 [ALL_TAC; ALL_TAC; ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS;
6662 MATCH_MP_TAC COMPACT_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE]] THEN
6665 let LOCALLY_COMPACT_COMPACT_ALT = prove
6667 locally compact s <=>
6668 !k. k SUBSET s /\ compact k
6669 ==> ?u. k SUBSET u /\
6670 open_in (subtopology euclidean s) u /\
6671 compact(closure u) /\ closure u SUBSET s`,
6672 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN
6673 DISCH_TAC THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
6674 FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
6675 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
6676 MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL;
6677 COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6679 let LOCALLY_COMPACT_COMPACT_SUBOPEN = prove
6681 locally compact s <=>
6682 !k t. k SUBSET s /\ compact k /\ open t /\ k SUBSET t
6683 ==> ?u v. k SUBSET u /\ u SUBSET v /\ u SUBSET t /\ v SUBSET s /\
6684 open_in (subtopology euclidean s) u /\
6686 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN
6687 EQ_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THENL
6688 [FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN
6689 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6690 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6691 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
6692 [`u INTER t:real^N->bool`; `closure(u INTER t:real^N->bool)`] THEN
6693 REWRITE_TAC[CLOSURE_SUBSET; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL
6695 TRANS_TAC SUBSET_TRANS `closure(u:real^N->bool)` THEN
6696 SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
6697 TRANS_TAC SUBSET_TRANS `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
6698 MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
6699 ASM_SIMP_TAC[OPEN_IN_INTER_OPEN];
6700 REWRITE_TAC[COMPACT_CLOSURE] THEN
6701 ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; SUBSET_TRANS;
6702 COMPACT_IMP_BOUNDED]];
6703 FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `(:real^N)`]) THEN
6704 ASM_REWRITE_TAC[OPEN_UNIV; SUBSET_UNIV]]);;
6706 let OPEN_IMP_LOCALLY_COMPACT = prove
6707 (`!s:real^N->bool. open s ==> locally compact s`,
6708 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6709 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM
6710 (MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6711 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
6712 ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
6713 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6714 MAP_EVERY EXISTS_TAC [`ball(x:real^N,e)`; `cball(x:real^N,e)`] THEN
6715 ASM_REWRITE_TAC[BALL_SUBSET_CBALL; CENTRE_IN_BALL; COMPACT_CBALL] THEN
6716 MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN
6717 ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]);;
6719 let CLOSED_IMP_LOCALLY_COMPACT = prove
6720 (`!s:real^N->bool. closed s ==> locally compact s`,
6721 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6722 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
6723 [`s INTER ball(x:real^N,&1)`; `s INTER cball(x:real^N,&1)`] THEN
6724 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET; REAL_LT_01] THEN
6725 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6726 ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
6727 MP_TAC(ISPECL [`x:real^N`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;
6729 let IS_INTERVAL_IMP_LOCALLY_COMPACT = prove
6730 (`!s:real^N->bool. is_interval s ==> locally compact s`,
6731 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6732 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6733 MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
6734 INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
6735 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6736 MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `d:real`] THEN STRIP_TAC THEN
6737 MAP_EVERY EXISTS_TAC
6738 [`s INTER ball(x:real^N,d)`; `interval[a:real^N,b]`] THEN
6739 ASM_SIMP_TAC[COMPACT_INTERVAL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6740 ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[]);;
6742 let LOCALLY_COMPACT_UNIV = prove
6743 (`locally compact (:real^N)`,
6744 SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; OPEN_UNIV]);;
6746 let LOCALLY_COMPACT_INTER = prove
6747 (`!s t:real^N->bool.
6748 locally compact s /\ locally compact t
6749 ==> locally compact (s INTER t)`,
6750 MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]);;
6752 let LOCALLY_COMPACT_OPEN_IN = prove
6753 (`!s t:real^N->bool.
6754 open_in (subtopology euclidean s) t /\ locally compact s
6755 ==> locally compact t`,
6756 REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
6757 ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; OPEN_IMP_LOCALLY_COMPACT]);;
6759 let LOCALLY_COMPACT_CLOSED_IN = prove
6760 (`!s t:real^N->bool.
6761 closed_in (subtopology euclidean s) t /\ locally compact s
6762 ==> locally compact t`,
6763 REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
6764 ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; CLOSED_IMP_LOCALLY_COMPACT]);;
6766 let LOCALLY_COMPACT_DELETE = prove
6767 (`!s a:real^N. locally compact s ==> locally compact (s DELETE a)`,
6768 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_COMPACT_OPEN_IN THEN
6769 EXISTS_TAC `s:real^N->bool` THEN
6770 ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL]);;
6772 let SIGMA_COMPACT = prove
6775 ==> ?f. COUNTABLE f /\ (!t. t IN f ==> compact t) /\ UNIONS f = s`,
6776 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6777 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6778 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6779 MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `c:real^N->real^N->bool`] THEN
6781 MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]
6782 LINDELOF_OPEN_IN) THEN
6783 ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
6784 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6785 REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
6786 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6787 EXISTS_TAC `IMAGE (c:real^N->real^N->bool) t` THEN
6788 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; FORALL_IN_IMAGE; FORALL_IN_UNIONS] THEN
6789 ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);;
6791 let HOMEOMORPHIC_LOCAL_COMPACTNESS = prove
6792 (`!s t:real^N->bool.
6793 s homeomorphic t ==> (locally compact s <=> locally compact t)`,
6794 MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6795 REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]);;
6797 let LOCALLY_COMPACT_TRANSLATION_EQ = prove
6798 (`!a:real^N s. locally compact (IMAGE (\x. a + x) s) <=>
6800 MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6801 REWRITE_TAC[COMPACT_TRANSLATION_EQ]);;
6803 add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];;
6805 let LOCALLY_COMPACT_LINEAR_IMAGE_EQ = prove
6806 (`!f:real^M->real^N s.
6807 linear f /\ (!x y. f x = f y ==> x = y)
6808 ==> (locally compact (IMAGE f s) <=> locally compact s)`,
6809 MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6810 REWRITE_TAC[COMPACT_LINEAR_IMAGE_EQ]);;
6812 add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];;
6814 let LOCALLY_CLOSED = prove
6815 (`!s:real^N->bool. locally closed s <=> locally compact s`,
6816 GEN_TAC THEN EQ_TAC THENL
6817 [ALL_TAC; MESON_TAC[LOCALLY_MONO; COMPACT_IMP_CLOSED]] THEN
6818 REWRITE_TAC[locally] THEN DISCH_TAC THEN
6819 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
6820 FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
6821 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6822 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6824 EXISTS_TAC `u INTER ball(x:real^N,&1)` THEN
6825 EXISTS_TAC `v INTER cball(x:real^N,&1)` THEN
6826 ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL] THEN
6827 ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
6828 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6829 MP_TAC(ISPEC `x:real^N` BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;
6831 let LOCALLY_COMPACT_OPEN_UNION = prove
6832 (`!s t:real^N->bool.
6833 locally compact s /\ locally compact t /\
6834 open_in (subtopology euclidean (s UNION t)) s /\
6835 open_in (subtopology euclidean (s UNION t)) t
6836 ==> locally compact (s UNION t)`,
6837 REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN
6838 INTRO_TAC "lcs lct os ot" THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL
6839 [REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN
6841 (MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]);
6842 REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN
6844 (MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL])] THEN
6845 DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
6846 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6847 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6848 EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6849 REWRITE_TAC[CBALL_MIN_INTER; INTER_ASSOC] THEN
6850 FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
6851 `u INTER st SUBSET s ==> s SUBSET st ==> u INTER st = u INTER s`)) THEN
6852 REWRITE_TAC[SUBSET_UNION] THEN DISCH_THEN SUBST1_TAC THEN
6853 ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL; INTER_ACI]);;
6855 let LOCALLY_COMPACT_CLOSED_UNION = prove
6856 (`!s t:real^N->bool.
6857 locally compact s /\ locally compact t /\
6858 closed_in (subtopology euclidean (s UNION t)) s /\
6859 closed_in (subtopology euclidean (s UNION t)) t
6860 ==> locally compact (s UNION t)`,
6861 REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN
6862 INTRO_TAC "lcs lct cs ct" THEN X_GEN_TAC `x:real^N` THEN
6863 DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (TAUT
6864 `p \/ q ==> p /\ q \/ p /\ ~q \/ q /\ ~p`))
6866 [REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN
6867 REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN
6868 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6869 X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6870 X_GEN_TAC `e:real` THEN STRIP_TAC THEN
6871 EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6872 SIMP_TAC[SET_RULE `u INTER (s UNION t) = u INTER s UNION u INTER t`] THEN
6873 MATCH_MP_TAC CLOSED_UNION THEN REWRITE_TAC[CBALL_MIN_INTER] THEN
6874 ASM_MESON_TAC[CLOSED_CBALL; CLOSED_INTER; INTER_ACI];
6875 REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6876 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6877 REMOVE_THEN "ct" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in]);
6878 REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6879 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6880 REMOVE_THEN "cs" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in])] THEN
6881 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
6882 REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IN_DIFF; IN_UNION] THEN
6883 DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
6884 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6885 EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THENL
6886 [SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) =
6887 cball(x,d) INTER cball (x,e) INTER s` SUBST1_TAC
6888 THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC];
6889 SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) =
6890 cball(x,d) INTER cball (x,e) INTER t` SUBST1_TAC
6891 THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]] THEN
6892 ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL]);;
6894 let LOCALLY_COMPACT_PCROSS = prove
6895 (`!s:real^M->bool t:real^N->bool.
6896 locally compact s /\ locally compact t
6897 ==> locally compact (s PCROSS t)`,
6898 MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[COMPACT_PCROSS]);;
6900 let LOCALLY_COMPACT_PCROSS_EQ = prove
6901 (`!s:real^M->bool t:real^N->bool.
6902 locally compact (s PCROSS t) <=>
6903 s = {} \/ t = {} \/ locally compact s /\ locally compact t`,
6904 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
6905 ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6906 MATCH_MP_TAC(TAUT `(~p ==> s) /\ (~q ==> r) ==> p \/ q \/ r /\ s`) THEN
6907 CONJ_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL
6908 [X_GEN_TAC `a:real^M`; X_GEN_TAC `b:real^N`] THEN
6909 DISCH_TAC THEN FIRST_ASSUM
6910 (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_COMPACT_INTER))
6912 [DISCH_THEN(MP_TAC o SPEC `{a:real^M} PCROSS (:real^N)`);
6913 DISCH_THEN(MP_TAC o SPEC `(:real^M) PCROSS {b:real^N}`)] THEN
6914 ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; CLOSED_IMP_LOCALLY_COMPACT;
6915 CLOSED_UNIV; CLOSED_SING; INTER_PCROSS; INTER_UNIV;
6916 SET_RULE `a IN s ==> s INTER {a} = {a}`] THEN
6917 ASM_MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_LOCAL_COMPACTNESS]);;
6919 let OPEN_IN_LOCALLY_COMPACT = prove
6920 (`!s t:real^N->bool.
6922 ==> (open_in (subtopology euclidean s) t <=>
6924 !k. compact k /\ k SUBSET s
6925 ==> open_in (subtopology euclidean k) (k INTER t))`,
6926 REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
6927 [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
6928 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6929 REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
6930 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
6931 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
6932 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT]) THEN
6933 DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
6934 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
6935 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6936 STRIP_TAC THEN EXISTS_TAC `t INTER u:real^N->bool` THEN
6937 ASM_REWRITE_TAC[IN_INTER; INTER_SUBSET] THEN
6938 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
6939 ASM_REWRITE_TAC[] THEN
6940 FIRST_X_ASSUM(MP_TAC o SPEC `closure u:real^N->bool`) THEN
6942 [SUBGOAL_THEN `(closure u:real^N->bool) SUBSET v` MP_TAC THENL
6943 [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
6944 REWRITE_TAC[COMPACT_CLOSURE] THEN
6945 ASM_MESON_TAC[SUBSET_TRANS; BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]];
6946 REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
6947 MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);;
6949 let LOCALLY_COMPACT_PROPER_IMAGE_EQ = prove
6950 (`!f:real^M->real^N s.
6951 f continuous_on s /\
6952 (!k. k SUBSET (IMAGE f s) /\ compact k
6953 ==> compact {x | x IN s /\ f x IN k})
6954 ==> (locally compact s <=> locally compact (IMAGE f s))`,
6955 REPEAT STRIP_TAC THEN
6956 MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
6957 `IMAGE (f:real^M->real^N) s`] PROPER_MAP) THEN
6958 ASM_REWRITE_TAC[SUBSET_REFL] THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
6959 [REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC `y:real^N` THEN
6960 DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
6961 ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC] THEN
6962 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_ALT]) THEN
6963 DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN
6964 ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
6965 DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
6967 `?v. open_in (subtopology euclidean (IMAGE f s)) v /\
6969 {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET u`
6971 [GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV)
6972 [GSYM SING_SUBSET] THEN
6973 MATCH_MP_TAC CLOSED_MAP_OPEN_SUPERSET_PREIMAGE THEN
6974 ASM_REWRITE_TAC[SING_SUBSET; IN_SING];
6975 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
6976 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6977 SUBGOAL_THEN `closure v SUBSET IMAGE (f:real^M->real^N) (closure u)`
6979 [TRANS_TAC SUBSET_TRANS `closure(IMAGE (f:real^M->real^N) u)` THEN
6981 [MATCH_MP_TAC SUBSET_CLOSURE THEN
6982 REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
6984 MATCH_MP_TAC CLOSURE_MINIMAL THEN
6985 SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
6986 MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
6987 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
6988 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]];
6989 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6990 REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
6991 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
6992 BOUNDED_SUBSET)) THEN
6993 MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
6994 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
6995 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]];
6996 REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN
6997 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6998 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_ALT]) THEN
6999 DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
7000 ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
7001 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
7002 FIRST_X_ASSUM(MP_TAC o SPEC `closure v:real^N->bool`) THEN
7003 ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
7004 EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN v}` THEN
7005 ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
7006 [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
7007 ASM_MESON_TAC[SUBSET_REFL];
7010 `closure {x | x IN s /\ f x IN v} SUBSET
7011 {x | x IN s /\ (f:real^M->real^N) x IN closure v}`
7013 [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
7014 MP_TAC(ISPEC `v:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
7015 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7016 REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
7017 ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]]]);;
7019 let LOCALLY_COMPACT_PROPER_IMAGE = prove
7020 (`!f:real^M->real^N s.
7021 f continuous_on s /\
7022 (!k. k SUBSET (IMAGE f s) /\ compact k
7023 ==> compact {x | x IN s /\ f x IN k}) /\
7025 ==> locally compact (IMAGE f s)`,
7026 MESON_TAC[LOCALLY_COMPACT_PROPER_IMAGE_EQ]);;
7028 let MUMFORD_LEMMA = prove
7029 (`!f:real^M->real^N s t y.
7030 f continuous_on s /\ IMAGE f s SUBSET t /\ locally compact s /\
7031 y IN t /\ compact {x | x IN s /\ f x = y}
7032 ==> ?u v. open_in (subtopology euclidean s) u /\
7033 open_in (subtopology euclidean t) v /\
7034 {x | x IN s /\ f x = y} SUBSET u /\ y IN v /\
7035 IMAGE f u SUBSET v /\
7036 (!k. k SUBSET v /\ compact k
7037 ==> compact {x | x IN u /\ f x IN k})`,
7038 REPEAT STRIP_TAC THEN
7039 FIRST_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}` o
7040 GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT]) THEN
7041 ASM_REWRITE_TAC[SUBSET_RESTRICT; LEFT_IMP_EXISTS_THM] THEN
7042 MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
7044 SUBGOAL_THEN `(closure u:real^M->bool) SUBSET v` ASSUME_TAC THENL
7045 [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
7047 SUBGOAL_THEN `compact(closure u:real^M->bool)` ASSUME_TAC THENL
7048 [ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
7049 ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED];
7051 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7053 `!b. open_in (subtopology euclidean t) b /\ y IN b
7054 ==> u INTER {x | x IN s /\ (f:real^M->real^N) x IN b} PSUBSET
7055 closure u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`
7057 [REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET] THEN
7058 SIMP_TAC[CLOSURE_SUBSET;
7059 SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`] THEN
7060 MATCH_MP_TAC(MESON[] `!P. ~P s /\ P t ==> ~(s = t)`) THEN
7062 `\a. !k. k SUBSET b /\ compact k
7063 ==> compact {x | x IN a /\ (f:real^M->real^N) x IN k}` THEN
7064 REWRITE_TAC[] THEN CONJ_TAC THENL
7065 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
7066 REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL
7067 [`u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`;
7068 `b:real^N->bool`]) THEN
7069 ASM_REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN ANTS_TAC THENL
7070 [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
7071 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM SET_TAC[];
7073 X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
7075 `{x | x IN closure u INTER {x | x IN s /\ f x IN b} /\ f x IN k} =
7076 v INTER {x | x IN closure u /\ (f:real^M->real^N) x IN k}`
7077 SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_INTER_CLOSED] THEN
7078 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
7079 ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_CLOSURE] THEN
7080 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]];
7081 DISCH_THEN(MP_TAC o GEN `n:num` o SPEC
7082 `t INTER ball(y:real^N,inv(&n + &1))`) THEN
7083 SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
7084 ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
7085 SIMP_TAC[CLOSURE_SUBSET; SET_RULE
7087 ==> (u INTER t PSUBSET u' INTER t <=>
7088 ?x. x IN u' /\ ~(x IN u) /\ x IN t)`] THEN
7089 REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN
7090 DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN
7091 MP_TAC(ISPEC `closure u:real^M->bool` compact) THEN
7092 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN
7093 ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
7094 MAP_EVERY X_GEN_TAC [`l:real^M`; `r:num->num`] THEN STRIP_TAC THEN
7095 SUBGOAL_THEN `(f:real^M->real^N) l = y` ASSUME_TAC THENL
7096 [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
7097 EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN
7098 ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
7099 [SUBGOAL_THEN `(f:real^M->real^N) continuous_on closure u` MP_TAC THENL
7100 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN
7101 REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN
7102 DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[o_THM];
7103 REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
7104 ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
7105 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7106 MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
7107 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
7108 X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
7109 DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
7110 TRANS_TAC REAL_LT_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
7111 TRANS_TAC REAL_LT_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN
7112 MATCH_MP_TAC REAL_LT_INV2 THEN
7113 ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC];
7114 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
7115 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `l:real^M`)) THEN
7116 REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN
7117 CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `e:real` THEN STRIP_TAC] THEN
7118 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
7119 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
7120 DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
7121 ASM_REWRITE_TAC[LE_REFL; o_THM] THEN ASM SET_TAC[]]]);;
7123 (* ------------------------------------------------------------------------- *)
7124 (* Locally compact sets are closed in an open set and are homeomorphic *)
7125 (* to an absolutely closed set if we have one more dimension to play with. *)
7126 (* ------------------------------------------------------------------------- *)
7128 let LOCALLY_COMPACT_OPEN_INTER_CLOSURE = prove
7129 (`!s:real^N->bool. locally compact s ==> ?t. open t /\ s = t INTER closure s`,
7130 GEN_TAC THEN SIMP_TAC[LOCALLY_COMPACT; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN
7131 REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
7132 REWRITE_TAC[GSYM CONJ_ASSOC; TAUT `p /\ x = y /\ q <=> x = y /\ p /\ q`] THEN
7133 ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN
7134 REWRITE_TAC[UNWIND_THM2] THEN
7135 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7136 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
7137 MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
7138 DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (u:real^N->real^N->bool) s)` THEN
7139 ASM_SIMP_TAC[CLOSED_CLOSURE; OPEN_UNIONS; FORALL_IN_IMAGE] THEN
7140 REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
7141 `UNIONS {v INTER s | v | v IN IMAGE (u:real^N->real^N->bool) s}` THEN
7143 [SIMP_TAC[UNIONS_GSPEC; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN
7144 AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
7145 `(!x. x IN s ==> f(g x) = f'(g x))
7146 ==> {f x | x IN IMAGE g s} = {f' x | x IN IMAGE g s}`) THEN
7147 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7148 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL
7149 [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
7150 REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
7151 EXISTS_TAC `closure((u:real^N->real^N->bool) x INTER s)` THEN
7152 ASM_SIMP_TAC[OPEN_INTER_CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
7153 EXISTS_TAC `(v:real^N->real^N->bool) x` THEN
7154 ASM_SIMP_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
7155 ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);;
7157 let LOCALLY_COMPACT_CLOSED_IN_OPEN = prove
7159 locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s`,
7161 DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
7162 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
7163 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7164 FIRST_X_ASSUM SUBST1_TAC THEN
7165 SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]);;
7167 let LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED = prove
7170 ==> ?t:real^(M,N)finite_sum->bool f.
7171 closed t /\ homeomorphism (s,t) (f,fstcart)`,
7172 REPEAT STRIP_TAC THEN ASM_CASES_TAC `closed(s:real^M->bool)` THENL
7173 [EXISTS_TAC `(s:real^M->bool) PCROSS {vec 0:real^N}` THEN
7174 EXISTS_TAC `\x. (pastecart x (vec 0):real^(M,N)finite_sum)` THEN
7175 ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_SING; HOMEOMORPHISM] THEN
7176 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
7177 LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN
7178 REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN
7179 SIMP_TAC[FSTCART_PASTECART];
7181 FIRST_X_ASSUM(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
7182 DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
7183 DISJ_CASES_TAC(SET_RULE `t = (:real^M) \/ ~((:real^M) DIFF t = {})`) THENL
7184 [ASM_MESON_TAC[CLOSURE_EQ; INTER_UNIV]; ALL_TAC] THEN
7186 `f:real^M->real^(M,N)finite_sum =
7187 \x. pastecart x (inv(setdist({x},(:real^M) DIFF t)) % vec 1)` THEN
7189 `homeomorphism (t,IMAGE (f:real^M->real^(M,N)finite_sum) t) (f,fstcart)`
7191 [SIMP_TAC[HOMEOMORPHISM; SUBSET_REFL; LINEAR_CONTINUOUS_ON;
7192 LINEAR_FSTCART; FORALL_IN_IMAGE] THEN
7193 MATCH_MP_TAC(TAUT `(r ==> q /\ s) /\ r /\ p ==> p /\ q /\ r /\ s`) THEN
7194 CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "f"] THEN
7195 SIMP_TAC[FSTCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
7196 REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
7197 REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN
7198 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
7199 REWRITE_TAC[SETDIST_EQ_0_SING; CONTINUOUS_ON_LIFT_SETDIST] THEN
7200 ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN];
7202 EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) s` THEN
7203 EXISTS_TAC `f:real^M->real^(M,N)finite_sum` THEN CONJ_TAC THENL
7204 [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
7205 EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) t` THEN CONJ_TAC THENL
7206 [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC
7207 [`fstcart:real^(M,N)finite_sum->real^M`; `t:real^M->bool`] THEN
7208 ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN
7209 SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE];
7211 `IMAGE (f:real^M->real^(M,N)finite_sum) t =
7212 {z | (setdist({fstcart z},(:real^M) DIFF t) % sndcart z) IN {vec 1}}`
7214 [EXPAND_TAC "f" THEN
7215 REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_INJ;
7216 FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; IN_INTER;
7217 GSYM CONJ_ASSOC; UNWIND_THM1; IN_SING] THEN
7218 REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
7219 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN
7220 MP_TAC(ISPECL [`(:real^M) DIFF t`; `x:real^M`]
7221 (CONJUNCT1 SETDIST_EQ_0_SING)) THEN
7222 ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN] THEN
7223 ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_SIMP_TAC[REAL_FIELD
7224 `~(x = &0) ==> (y = inv x * &1 <=> x * y = &1)`] THEN
7225 DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN
7226 REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC;
7227 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
7228 REWRITE_TAC[CLOSED_SING] THEN X_GEN_TAC `z:real^(M,N)finite_sum` THEN
7229 MATCH_MP_TAC CONTINUOUS_MUL THEN
7230 SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_SNDCART; o_DEF] THEN
7232 `(\z:real^(M,N)finite_sum.
7233 lift(setdist({fstcart z},(:real^M) DIFF t))) =
7234 (\x. lift (setdist ({x},(:real^M) DIFF t))) o fstcart`
7235 SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
7236 MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
7237 SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART] THEN
7238 REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST]]];
7239 MATCH_MP_TAC HOMEOMORPHISM_OF_SUBSETS THEN MAP_EVERY EXISTS_TAC
7240 [`t:real^M->bool`; `IMAGE (f:real^M->real^(M,N)finite_sum) t`] THEN
7243 let LOCALLY_COMPACT_CLOSED_INTER_OPEN = prove
7245 locally compact s <=> ?t u. closed t /\ open u /\ s = t INTER u`,
7246 MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT;
7247 LOCALLY_COMPACT_INTER; INTER_COMM; CLOSED_CLOSURE;
7248 LOCALLY_COMPACT_OPEN_INTER_CLOSURE]);;
7250 (* ------------------------------------------------------------------------- *)
7251 (* Sura-Bura's results about compact components of sets. *)
7252 (* ------------------------------------------------------------------------- *)
7254 let SURA_BURA_COMPACT = prove
7255 (`!s c:real^N->bool.
7256 compact s /\ c IN components s
7257 ==> c = INTERS {t | c SUBSET t /\
7258 open_in (subtopology euclidean s) t /\
7259 closed_in (subtopology euclidean s) t}`,
7260 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7261 CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
7262 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [components]) THEN
7263 REWRITE_TAC[IN_ELIM_THM] THEN
7264 DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7265 DISCH_THEN(fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THEN
7266 MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7267 SUBGOAL_THEN `(x:real^N) IN c` ASSUME_TAC THENL
7268 [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN
7269 SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL
7270 [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
7271 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
7273 MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN
7274 REWRITE_TAC[IN_ELIM_THM; CONNECTED_COMPONENT_SUBSET;
7275 OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN
7276 REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]] THEN
7277 W(fun (asl,w) -> ABBREV_TAC(mk_eq(`k:real^N->bool`,rand w))) THEN
7278 SUBGOAL_THEN `closed(k:real^N->bool)` ASSUME_TAC THENL
7279 [EXPAND_TAC "k" THEN MATCH_MP_TAC CLOSED_INTERS THEN
7280 REWRITE_TAC[IN_ELIM_THM] THEN
7281 ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED];
7283 REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN
7284 MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN
7286 MP_TAC(ISPECL [`k1:real^N->bool`; `k2:real^N->bool`] SEPARATION_NORMAL) THEN
7287 ASM_REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP] THEN CONJ_TAC THENL
7288 [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
7289 MAP_EVERY X_GEN_TAC [`v1:real^N->bool`; `v2:real^N->bool`] THEN
7291 MP_TAC(ISPECL [`s DIFF (v1 UNION v2):real^N->bool`;
7292 `{t:real^N->bool | connected_component s x SUBSET t /\
7293 open_in (subtopology euclidean s) t /\
7294 closed_in (subtopology euclidean s) t}`]
7295 COMPACT_IMP_FIP) THEN
7296 ASM_SIMP_TAC[NOT_IMP; COMPACT_DIFF; OPEN_UNION; IN_ELIM_THM] THEN
7297 REPEAT CONJ_TAC THENL
7298 [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED];
7299 ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM];
7301 X_GEN_TAC `f:(real^N->bool)->bool` THEN REPEAT STRIP_TAC THEN
7304 c SUBSET c0 /\ c0 SUBSET (v1 UNION v2) /\
7305 open_in (subtopology euclidean s) c0 /\
7306 closed_in (subtopology euclidean s) c0`
7307 STRIP_ASSUME_TAC THENL
7308 [ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
7309 [EXISTS_TAC `s:real^N->bool` THEN
7310 ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV;
7311 OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN
7313 `(s DIFF (v1 UNION v2)) INTER INTERS f :real^N->bool = {}` THEN
7314 ASM_REWRITE_TAC[INTERS_0; INTER_UNIV] THEN SET_TAC[];
7315 EXISTS_TAC `INTERS f :real^N->bool` THEN REPEAT CONJ_TAC THENL
7317 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7318 `(s DIFF u) INTER t = {}
7320 ==> t SUBSET u`)) THEN
7321 MATCH_MP_TAC(SET_RULE
7322 `~(f = {}) /\ (!s. s IN f ==> s SUBSET t) ==> INTERS f SUBSET t`) THEN
7323 ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY];
7324 MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[];
7325 MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_SIMP_TAC[]]];
7327 SUBGOAL_THEN `connected(c:real^N->bool)` MP_TAC THENL
7328 [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN
7330 `closed_in (subtopology euclidean c0) (c0 INTER v1 :real^N->bool) /\
7331 closed_in (subtopology euclidean c0) (c0 INTER v2 :real^N->bool)`
7334 MATCH_MP_TAC(MESON[]
7335 `closed_in top (c INTER closure v) /\
7336 c INTER closure v = c INTER v
7337 ==> closed_in top (c INTER v)`) THEN
7339 [MESON_TAC[CLOSED_IN_CLOSED; CLOSED_CLOSURE]; ALL_TAC]) THEN
7340 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7341 `c0 SUBSET vv ==> c0 INTER (vv INTER v') = c0 INTER v
7342 ==> c0 INTER v' = c0 INTER v`)) THEN
7343 REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER;
7344 UNION_OVER_INTER] THEN
7345 SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; CLOSURE_SUBSET] THENL
7346 [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM]] THEN
7347 MATCH_MP_TAC(SET_RULE `t = {} ==> s UNION (u INTER t) = s`) THEN
7348 ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[];
7350 REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(CONJUNCTS_THEN2
7351 (X_CHOOSE_THEN `u1:real^N->bool` STRIP_ASSUME_TAC)
7352 (X_CHOOSE_THEN `u2:real^N->bool` STRIP_ASSUME_TAC)) THEN
7353 SUBGOAL_THEN `closed(c0:real^N->bool)` ASSUME_TAC THENL
7354 [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
7355 REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC
7356 [`c0 INTER u1:real^N->bool`; `c0 INTER u2:real^N->bool`] THEN
7357 ASM_SIMP_TAC[CLOSED_INTER] THEN
7358 REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL
7360 SUBGOAL_THEN `c SUBSET (c0 INTER v2 :real^N->bool)` MP_TAC THENL
7361 [ASM SET_TAC[]; ALL_TAC] THEN
7362 SUBGOAL_THEN `k SUBSET (c0 INTER v2 :real^N->bool)` ASSUME_TAC THENL
7363 [ALL_TAC; ASM SET_TAC[]];
7365 SUBGOAL_THEN `c SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL
7366 [ASM SET_TAC[]; ALL_TAC] THEN
7367 SUBGOAL_THEN `k SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL
7368 [ALL_TAC; ASM SET_TAC[]]] THEN
7369 (UNDISCH_THEN `k1 UNION k2 :real^N->bool = k` (K ALL_TAC) THEN
7371 MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN
7372 REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
7374 MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN ASM_REWRITE_TAC[];
7375 ASM_REWRITE_TAC[] THEN
7376 MATCH_MP_TAC CLOSED_IN_INTER_CLOSED THEN ASM_REWRITE_TAC[]]));;
7378 let SURA_BURA_CLOPEN_SUBSET = prove
7379 (`!s c u:real^N->bool.
7380 locally compact s /\
7381 c IN components s /\ compact c /\
7382 open u /\ c SUBSET u
7383 ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\
7384 c SUBSET k /\ k SUBSET u`,
7385 REPEAT STRIP_TAC THEN FIRST_X_ASSUM
7386 (MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_SUBOPEN]) THEN
7387 DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `u:real^N->bool`]) THEN
7388 ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; LEFT_IMP_EXISTS_THM] THEN
7389 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN
7391 MP_TAC(ISPECL [`k:real^N->bool`; `c:real^N->bool`]
7392 SURA_BURA_COMPACT) THEN
7393 ASM_SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN ANTS_TAC THENL
7394 [MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN
7395 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7396 DISCH_THEN(ASSUME_TAC o SYM)] THEN
7397 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
7398 DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
7400 [`(:real^N) DIFF (u INTER w)`;
7401 `{t:real^N->bool | c SUBSET t /\ open_in (subtopology euclidean k) t /\
7402 compact t /\ t SUBSET k}`]
7403 CLOSED_IMP_FIP_COMPACT) THEN
7404 ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_INTER; FORALL_IN_GSPEC] THEN
7405 GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
7406 FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
7407 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7408 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN
7409 REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM; SET_RULE
7410 `(UNIV DIFF u) INTER s = {} <=> s SUBSET u`] THEN
7411 DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN
7412 ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
7413 [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; FINITE_EMPTY] THEN
7414 REWRITE_TAC[SET_RULE `UNIV SUBSET s INTER t <=> s = UNIV /\ t = UNIV`] THEN
7415 DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN
7416 RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN
7417 UNDISCH_THEN `s:real^N->bool = v` (SUBST_ALL_TAC o SYM) THEN
7418 SUBGOAL_THEN `k:real^N->bool = s` SUBST_ALL_TAC THENL
7419 [ASM SET_TAC[]; REWRITE_TAC[SUBSET_UNIV]] THEN
7420 EXISTS_TAC `s:real^N->bool` THEN
7421 ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; OPEN_IN_REFL];
7422 STRIP_TAC THEN EXISTS_TAC `INTERS f:real^N->bool` THEN
7423 ASM_SIMP_TAC[COMPACT_INTERS] THEN
7424 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7425 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
7426 ASM_REWRITE_TAC[] THEN
7427 MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
7428 EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
7429 [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[];
7430 EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET_INTER] THEN
7431 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7432 MATCH_MP_TAC(SET_RULE
7433 `(!t. t IN f ==> t SUBSET s) /\ ~(f = {}) ==> INTERS f SUBSET s`) THEN
7434 ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]]]);;
7436 let SURA_BURA = prove
7437 (`!s c:real^N->bool.
7438 locally compact s /\ c IN components s /\ compact c
7439 ==> c = INTERS {k | c SUBSET k /\ compact k /\
7440 open_in (subtopology euclidean s) k}`,
7441 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
7442 [SET_TAC[]; ALL_TAC] THEN
7443 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
7444 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7445 MP_TAC(ISPECL [`{x:real^N}`; `c:real^N->bool`] SEPARATION_NORMAL) THEN
7446 ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SING] THEN
7447 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
7448 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
7450 MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`]
7451 SURA_BURA_CLOPEN_SUBSET) THEN
7452 ASM_REWRITE_TAC[IN_INTERS; NOT_FORALL_THM; IN_ELIM_THM; NOT_IMP] THEN
7453 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM SET_TAC[]);;
7455 (* ------------------------------------------------------------------------- *)
7456 (* Relations between components and path components. *)
7457 (* ------------------------------------------------------------------------- *)
7459 let OPEN_CONNECTED_COMPONENT = prove
7460 (`!s x:real^N. open s ==> open(connected_component s x)`,
7461 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
7462 DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
7463 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
7465 [ASM_MESON_TAC[SUBSET; CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
7466 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN
7467 ASM_REWRITE_TAC[] THEN
7468 SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y`
7470 [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
7471 MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7472 ASM_REWRITE_TAC[CENTRE_IN_BALL; CONNECTED_BALL]]);;
7474 let IN_CLOSURE_CONNECTED_COMPONENT = prove
7477 ==> (x IN closure(connected_component s y) <=>
7478 x IN connected_component s y)`,
7479 REPEAT STRIP_TAC THEN EQ_TAC THEN
7480 REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
7481 DISCH_TAC THEN SUBGOAL_THEN
7482 `~((connected_component s (x:real^N)) INTER
7483 closure(connected_component s y) = {})`
7485 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
7486 ASM_REWRITE_TAC[IN_INTER] THEN
7487 ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
7488 ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_CONNECTED_COMPONENT] THEN
7489 REWRITE_TAC[CONNECTED_COMPONENT_OVERLAP] THEN
7490 STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
7491 ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]]);;
7493 let PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT = prove
7494 (`!s x:real^N. (path_component s x) SUBSET (connected_component s x)`,
7495 REPEAT STRIP_TAC THEN
7496 ASM_CASES_TAC `(x:real^N) IN s` THENL
7497 [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7498 ASM_REWRITE_TAC[PATH_COMPONENT_SUBSET; IN; PATH_COMPONENT_REFL_EQ] THEN
7499 SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_PATH_COMPONENT];
7500 ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET_REFL;
7501 CONNECTED_COMPONENT_EQ_EMPTY]]);;
7503 let PATH_COMPONENT_EQ_CONNECTED_COMPONENT = prove
7505 locally path_connected s
7506 ==> (path_component s x = connected_component s x)`,
7507 REPEAT STRIP_TAC THEN
7508 ASM_CASES_TAC `(x:real^N) IN s` THENL
7510 ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]] THEN
7511 MP_TAC(ISPECL[`s:real^N->bool`; `x:real^N`]
7512 CONNECTED_CONNECTED_COMPONENT) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN
7513 REWRITE_TAC[TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] THEN
7514 DISCH_THEN MATCH_MP_TAC THEN
7515 ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN CONJ_TAC THENL
7516 [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS;
7517 MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS] THEN
7518 EXISTS_TAC `s:real^N->bool` THEN
7519 ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
7520 CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
7521 PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT;
7522 CONNECTED_COMPONENT_SUBSET]);;
7524 let LOCALLY_PATH_CONNECTED_PATH_COMPONENT = prove
7526 locally path_connected s
7527 ==> locally path_connected (path_component s x)`,
7528 MESON_TAC[LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT;
7529 PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;
7531 let OPEN_PATH_CONNECTED_COMPONENT = prove
7532 (`!s x:real^N. open s ==> path_component s x = connected_component s x`,
7533 SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT;
7534 OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
7536 let PATH_CONNECTED_EQ_CONNECTED_LPC = prove
7537 (`!s. locally path_connected s ==> (path_connected s <=> connected s)`,
7538 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT;
7539 CONNECTED_IFF_CONNECTED_COMPONENT] THEN
7540 SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;
7542 let PATH_CONNECTED_EQ_CONNECTED = prove
7543 (`!s. open s ==> (path_connected s <=> connected s)`,
7544 SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
7546 let CONNECTED_OPEN_PATH_CONNECTED = prove
7547 (`!s:real^N->bool. open s /\ connected s ==> path_connected s`,
7548 SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED]);;
7550 let CONNECTED_OPEN_ARC_CONNECTED = prove
7552 open s /\ connected s
7553 ==> !x y. x IN s /\ y IN s
7556 path_image g SUBSET s /\
7559 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_OPEN_PATH_CONNECTED) THEN
7560 REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
7561 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);;
7563 let OPEN_COMPONENTS = prove
7564 (`!u:real^N->bool s. open u /\ s IN components u ==> open s`,
7565 REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS;
7566 ASSUME `s:real^N->bool IN components u`] `?x. s:real^N->bool =
7567 connected_component u x`) THEN ASM_SIMP_TAC [OPEN_CONNECTED_COMPONENT]);;
7569 let COMPONENTS_OPEN_UNIQUE = prove
7570 (`!f:(real^N->bool)->bool s.
7571 (!c. c IN f ==> open c /\ connected c /\ ~(c = {})) /\
7572 pairwise DISJOINT f /\ UNIONS f = s
7573 ==> components s = f`,
7574 REPEAT STRIP_TAC THEN
7575 MATCH_MP_TAC CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE THEN
7576 ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; PAIRWISE_DISJOINT_COMPONENTS] THEN
7577 ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_NONEMPTY;
7578 IN_COMPONENTS_CONNECTED; OPEN_UNIONS]);;
7580 let CONTINUOUS_ON_COMPONENTS = prove
7581 (`!f:real^M->real^N s.
7582 locally connected s /\ (!c. c IN components s ==> f continuous_on c)
7583 ==> f continuous_on s`,
7584 REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_GEN THEN
7585 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);;
7587 let CONTINUOUS_ON_COMPONENTS_EQ = prove
7588 (`!f s. locally connected s
7589 ==> (f continuous_on s <=>
7590 !c. c IN components s ==> f continuous_on c)`,
7591 REPEAT STRIP_TAC THEN EQ_TAC THENL
7592 [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
7593 ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS]]);;
7595 let CONTINUOUS_ON_COMPONENTS_OPEN = prove
7596 (`!f:real^M->real^N s.
7597 open s /\ (!c. c IN components s ==> f continuous_on c)
7598 ==> f continuous_on s`,
7599 ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS; OPEN_IMP_LOCALLY_CONNECTED]);;
7601 let CONTINUOUS_ON_COMPONENTS_OPEN_EQ = prove
7603 ==> (f continuous_on s <=>
7604 !c. c IN components s ==> f continuous_on c)`,
7605 REPEAT STRIP_TAC THEN EQ_TAC THENL
7606 [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
7607 ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS_OPEN]]);;
7609 let CLOSED_IN_UNION_COMPLEMENT_COMPONENTS = prove
7610 (`!u s:real^N->bool c.
7611 locally connected u /\
7612 closed_in (subtopology euclidean u) s /\ c SUBSET components(u DIFF s)
7613 ==> closed_in (subtopology euclidean u) (s UNION UNIONS c)`,
7614 REPEAT STRIP_TAC THEN
7616 `s UNION UNIONS c:real^N->bool =
7617 u DIFF (UNIONS(components(u DIFF s) DIFF c))`
7619 [MATCH_MP_TAC(SET_RULE
7620 `s SUBSET u /\ u DIFF s = c UNION c' /\ DISJOINT c c'
7621 ==> s UNION c = u DIFF c'`) THEN
7622 FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
7623 ASM_SIMP_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE
7624 `s SUBSET t ==> s UNION (t DIFF s) = t`] THEN
7625 MATCH_MP_TAC(SET_RULE
7626 `(!s t. s IN c /\ t IN c' ==> DISJOINT s t)
7627 ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN
7628 REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
7629 MP_TAC(ISPEC `(u:real^N->bool) DIFF s`
7630 PAIRWISE_DISJOINT_COMPONENTS) THEN
7631 REWRITE_TAC[pairwise] THEN DISCH_THEN MATCH_MP_TAC THEN
7632 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[];
7633 REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_DIFF] THEN
7634 MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
7635 MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
7636 MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_DIFF] THEN
7637 X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
7638 MATCH_MP_TAC OPEN_IN_TRANS THEN
7639 EXISTS_TAC `u DIFF s:real^N->bool` THEN CONJ_TAC THENL
7640 [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
7641 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
7642 EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[];
7644 MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);;
7646 let CLOSED_UNION_COMPLEMENT_COMPONENTS = prove
7647 (`!s c. closed s /\ c SUBSET components((:real^N) DIFF s)
7648 ==> closed(s UNION UNIONS c)`,
7649 ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
7650 REPEAT STRIP_TAC THEN
7651 MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN
7652 ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;
7654 let CLOSED_IN_UNION_COMPLEMENT_COMPONENT = prove
7655 (`!u s c:real^N->bool.
7656 locally connected u /\
7657 closed_in (subtopology euclidean u) s /\
7658 c IN components(u DIFF s)
7659 ==> closed_in (subtopology euclidean u) (s UNION c)`,
7660 REPEAT STRIP_TAC THEN
7661 GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN
7662 MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN
7663 ASM_REWRITE_TAC[SING_SUBSET]);;
7665 let CLOSED_UNION_COMPLEMENT_COMPONENT = prove
7666 (`!s c. closed s /\ c IN components((:real^N) DIFF s) ==> closed(s UNION c)`,
7667 ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
7668 REPEAT STRIP_TAC THEN
7669 MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
7670 ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;
7672 let COUNTABLE_CONNECTED_COMPONENTS = prove
7673 (`!s:real^N->bool t.
7674 locally connected s ==> COUNTABLE {connected_component s x | x IN t}`,
7675 REPEAT STRIP_TAC THEN
7676 MP_TAC(ISPECL [`{connected_component s (x:real^N) |x| x IN s}`;
7677 `s:real^N->bool`] LINDELOF_OPEN_IN) THEN
7678 ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED;
7679 UNIONS_CONNECTED_COMPONENT] THEN
7680 DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
7681 MATCH_MP_TAC COUNTABLE_SUBSET THEN
7682 EXISTS_TAC `({}:real^N->bool) INSERT u` THEN
7683 ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
7684 REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN
7685 X_GEN_TAC `x:real^N` THEN REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
7686 DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
7687 MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
7688 COMPLEMENT_CONNECTED_COMPONENT_UNIONS) THEN
7689 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7690 REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
7691 ASM_REWRITE_TAC[IN_DIFF] THEN
7692 ASM_CASES_TAC `(x:real^N) IN connected_component s x` THENL
7693 [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN
7694 ASM_REWRITE_TAC[] THEN
7695 SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL
7696 [ASM_MESON_TAC[]; ALL_TAC] THEN
7697 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
7698 MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);;
7700 let COUNTABLE_PATH_COMPONENTS = prove
7701 (`!s:real^N->bool t.
7702 locally path_connected s ==> COUNTABLE {path_component s x | x IN t}`,
7703 REPEAT STRIP_TAC THEN
7704 MP_TAC(ISPECL [`{path_component s (x:real^N) |x| x IN s}`;
7705 `s:real^N->bool`] LINDELOF_OPEN_IN) THEN
7706 ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
7707 UNIONS_PATH_COMPONENT] THEN
7708 DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
7709 MATCH_MP_TAC COUNTABLE_SUBSET THEN
7710 EXISTS_TAC `({}:real^N->bool) INSERT u` THEN
7711 ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
7712 REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN
7713 X_GEN_TAC `x:real^N` THEN REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
7714 DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
7715 MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
7716 COMPLEMENT_PATH_COMPONENT_UNIONS) THEN
7717 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7718 REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
7719 ASM_REWRITE_TAC[IN_DIFF] THEN
7720 ASM_CASES_TAC `(x:real^N) IN path_component s x` THENL
7721 [ALL_TAC; ASM_MESON_TAC[IN; PATH_COMPONENT_REFL]] THEN
7722 ASM_REWRITE_TAC[] THEN
7723 SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL
7724 [ASM_MESON_TAC[]; ALL_TAC] THEN
7725 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
7726 MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);;
7728 let COUNTABLE_COMPONENTS = prove
7729 (`!s:real^N->bool. locally connected s ==> COUNTABLE(components s)`,
7730 SIMP_TAC[components; COUNTABLE_CONNECTED_COMPONENTS]);;
7732 let FRONTIER_MINIMAL_SEPARATING_CLOSED = prove
7733 (`!s c. closed s /\ ~connected((:real^N) DIFF s) /\
7734 (!t. closed t /\ t PSUBSET s ==> connected((:real^N) DIFF t)) /\
7735 c IN components ((:real^N) DIFF s)
7736 ==> frontier c = s`,
7737 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
7738 GEN_REWRITE_RULE RAND_CONV [CONNECTED_EQ_CONNECTED_COMPONENTS_EQ]) THEN
7739 DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
7740 `~(!x x'. x IN s /\ x' IN s ==> x = x')
7741 ==> !x. x IN s ==> ?y. y IN s /\ ~(y = x)`)) THEN
7742 DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
7743 DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
7744 FIRST_X_ASSUM(MP_TAC o SPEC `frontier c:real^N->bool`) THEN
7745 REWRITE_TAC[SET_RULE `s PSUBSET t <=> s SUBSET t /\ ~(t SUBSET s)`;
7746 GSYM SUBSET_ANTISYM_EQ] THEN
7747 ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; FRONTIER_CLOSED] THEN
7748 MATCH_MP_TAC(TAUT `~r ==> (~p ==> r) ==> p`) THEN
7749 REWRITE_TAC[connected] THEN
7750 MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `(:real^N) DIFF closure c`] THEN
7751 REPEAT CONJ_TAC THENL
7752 [ASM_MESON_TAC[OPEN_COMPONENTS; closed];
7753 REWRITE_TAC[GSYM closed; CLOSED_CLOSURE];
7754 MP_TAC(ISPEC `c:real^N->bool` INTERIOR_SUBSET) THEN
7755 REWRITE_TAC[frontier] THEN SET_TAC[];
7756 MATCH_MP_TAC(SET_RULE
7757 `c SUBSET c' ==> c INTER (UNIV DIFF c') INTER s = {}`) THEN
7758 REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; CLOSURE_SUBSET];
7759 REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
7760 `ci = c /\ ~(c = {})
7761 ==> ~(c INTER (UNIV DIFF (cc DIFF ci)) = {})`) THEN
7762 ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; INTERIOR_OPEN; closed;
7764 REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
7765 `~(UNIV DIFF c = {})
7766 ==> ~((UNIV DIFF c) INTER (UNIV DIFF (c DIFF i)) = {})`) THEN
7767 REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN
7768 MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ ~(t = {}) ==> ~(s = {})`) THEN
7769 EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL
7770 [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN
7771 MATCH_MP_TAC INTERIOR_MAXIMAL THEN
7772 REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
7773 ASM_MESON_TAC[COMPONENTS_NONOVERLAP; OPEN_COMPONENTS; GSYM closed]]);;
7775 let FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE = prove
7776 (`!s a b. closed s /\ ~(a IN s) /\
7777 ~connected_component ((:real^N) DIFF s) a b /\
7778 (!t. closed t /\ t PSUBSET s
7779 ==> connected_component((:real^N) DIFF t) a b)
7780 ==> frontier(connected_component ((:real^N) DIFF s) a) = s`,
7781 REPEAT STRIP_TAC THEN
7782 MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN
7784 [MATCH_MP_TAC FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT THEN
7785 ASM_REWRITE_TAC[IN_COMPONENTS; IN_UNIV; IN_DIFF] THEN ASM SET_TAC[];
7786 DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
7787 `frontier (connected_component ((:real^N) DIFF s) a)`) THEN
7788 ASM_REWRITE_TAC[FRONTIER_CLOSED] THEN
7789 GEN_REWRITE_TAC RAND_CONV [connected_component] THEN
7790 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
7791 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7792 `t SUBSET UNIV DIFF f ==> ~(t INTER f = {}) ==> F`)) THEN
7793 MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
7794 ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
7795 CONJ_TAC THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN
7796 ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN] THEN
7797 ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNIV; IN_DIFF]]);;
7799 (* ------------------------------------------------------------------------- *)
7800 (* If two points are separated by a closed set, there's a minimal one. *)
7801 (* ------------------------------------------------------------------------- *)
7803 let CLOSED_IRREDUCIBLE_SEPARATOR = prove
7805 closed s /\ ~connected_component ((:real^N) DIFF s) a b
7806 ==> ?t. t SUBSET s /\ closed t /\ ~(t = {}) /\
7807 ~connected_component ((:real^N) DIFF t) a b /\
7808 !u. u PSUBSET t ==> connected_component ((:real^N) DIFF u) a b`,
7809 MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`; `b:real^N`] THEN
7810 STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN c` THENL
7811 [EXISTS_TAC `{a:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN
7812 SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN
7813 REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
7814 CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN
7815 DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[];
7817 ASM_CASES_TAC `(b:real^N) IN c` THENL
7818 [EXISTS_TAC `{b:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN
7819 SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN
7820 REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
7821 CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN
7822 DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[];
7824 MAP_EVERY ABBREV_TAC
7825 [`r = connected_component ((:real^N) DIFF c) a`;
7826 `s = connected_component ((:real^N) DIFF closure r) b`] THEN
7827 EXISTS_TAC `frontier s:real^N->bool` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
7828 SUBGOAL_THEN `(a:real^N) IN r` ASSUME_TAC THENL
7829 [EXPAND_TAC "r" THEN REWRITE_TAC[IN] THEN
7830 REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
7832 SUBGOAL_THEN `(b:real^N) IN s` ASSUME_TAC THENL
7833 [EXPAND_TAC "s" THEN
7834 REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
7835 ASM_REWRITE_TAC[IN_UNIV; IN_DIFF] THEN
7836 REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION; DE_MORGAN_THM] THEN
7837 CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; EXPAND_TAC "r"] THEN
7838 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
7839 FRONTIER_OF_CONNECTED_COMPONENT_SUBSET)) THEN
7840 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7841 `~(b IN s) ==> t SUBSET s ==> b IN t ==> F`)) THEN
7842 ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ];
7844 SUBGOAL_THEN `frontier(s:real^N->bool) SUBSET frontier r` ASSUME_TAC THENL
7845 [EXPAND_TAC "s" THEN
7846 MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]
7847 `frontier s SUBSET t ==> frontier(connected_component s a) SUBSET t`) THEN
7848 REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET];
7851 `(q ==> r) /\ p /\ ~r /\ s ==> p /\ ~q /\ ~r /\ s`) THEN
7853 [SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN REWRITE_TAC[UNIV];
7855 REPEAT CONJ_TAC THENL
7856 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7859 MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]
7860 `frontier s SUBSET t ==>frontier (connected_component s a) SUBSET t`) THEN
7861 ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ];
7862 REWRITE_TAC[connected_component; NOT_EXISTS_THM; SET_RULE
7863 `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
7864 X_GEN_TAC `t:real^N->bool` THEN
7865 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7866 (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
7867 REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
7868 ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL
7869 [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `a:real^N`] THEN
7870 ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN] THEN
7871 DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP CONNECTED_COMPONENT_IN) THEN
7872 REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
7873 MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
7875 X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[PSUBSET_ALT] THEN
7876 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7877 DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN
7878 REWRITE_TAC[connected_component] THEN
7879 EXISTS_TAC `(p:real^N) INSERT (s UNION r)` THEN
7880 ASM_REWRITE_TAC[IN_INSERT; IN_UNION] THEN CONJ_TAC THENL
7881 [ONCE_REWRITE_TAC[SET_RULE
7882 `a INSERT (s UNION t) = (a INSERT s) UNION (a INSERT t)`] THEN
7883 MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN
7884 CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
7885 CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL
7886 [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `r:real^N->bool`] THEN
7888 [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN
7889 CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN
7890 REWRITE_TAC[CLOSURE_SUBSET] THEN
7891 ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN ASM SET_TAC[]);
7892 MATCH_MP_TAC(SET_RULE
7893 `s INTER u = {} /\ t INTER u = {} /\ ~(p IN u)
7894 ==> p INSERT (s UNION t) SUBSET UNIV DIFF u`) THEN
7895 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
7896 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7897 `u SUBSET t ==> t INTER s = {} ==> s INTER u = {}`)) THEN
7898 REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "s";
7899 SUBGOAL_THEN `frontier(r:real^N->bool) INTER r = {}`
7900 (fun th -> ASM SET_TAC[th]) THEN
7901 REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "r"] THEN
7902 MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN
7903 ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]]]);;
7905 (* ------------------------------------------------------------------------- *)
7906 (* Lower bound on norms within segment between vectors. *)
7907 (* Could have used these for connectedness results below, in fact. *)
7908 (* ------------------------------------------------------------------------- *)
7910 let NORM_SEGMENT_LOWERBOUND = prove
7911 (`!a b x:real^N r d.
7913 norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\
7914 a dot b = d * r pow 2
7915 ==> sqrt((&1 - abs d) / &2) * r <= norm(x)`,
7916 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
7917 REWRITE_TAC[NORM_GE_SQUARE] THEN DISJ2_TAC THEN
7918 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
7919 DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
7920 ASM_REWRITE_TAC[real_ge; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
7921 `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
7922 MATCH_MP_TAC REAL_LE_TRANS THEN
7923 EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2 -
7924 &2 * (&1 - u) * u * abs d * r pow 2` THEN
7926 [REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN
7927 REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
7928 MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
7929 REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH
7930 `(&1 - u) pow 2 + u pow 2 - ((&2 * (&1 - u)) * u) * d =
7931 (&1 + d) * (&1 - &2 * u + &2 * u pow 2) - d`] THEN
7932 MATCH_MP_TAC REAL_LE_TRANS THEN
7933 EXISTS_TAC `(&1 + abs d) * &1 / &2 - abs d` THEN CONJ_TAC THENL
7934 [REWRITE_TAC[REAL_ARITH `(&1 + d) * &1 / &2 - d = (&1 - d) / &2`] THEN
7935 MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SQRT_POW_2 THEN
7936 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN
7937 ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_POW2_ABS] THEN
7938 ASM_REWRITE_TAC[REAL_ARITH `r * r = &1 * r pow 2`] THEN
7939 ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC;
7940 MATCH_MP_TAC(REAL_ARITH `x <= y ==> x - a <= y - a`) THEN
7941 MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
7943 MATCH_MP_TAC(REAL_ARITH
7944 `&0 <= (u - &1 / &2) * (u - &1 / &2)
7945 ==> &1 / &2 <= &1 - &2 * u + &2 * u pow 2`) THEN
7946 REWRITE_TAC[REAL_LE_SQUARE]]];
7947 ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_LE_LADD; real_sub] THEN
7948 MATCH_MP_TAC(REAL_ARITH `abs(a) <= --x ==> x <= a`) THEN
7949 ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_LNEG; REAL_NEG_NEG] THEN
7950 REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; REAL_ABS_NUM] THEN
7951 REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
7952 REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
7953 ASM_REWRITE_TAC[real_abs; GSYM real_sub; REAL_SUB_LE; REAL_POS] THEN
7954 MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN
7955 REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN
7956 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
7957 ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);;
7959 (* ------------------------------------------------------------------------- *)
7960 (* Special case of orthogonality (could replace 2 by sqrt(2)). *)
7961 (* ------------------------------------------------------------------------- *)
7963 let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove
7965 r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b]
7966 ==> r / &2 <= norm(x)`,
7967 REPEAT GEN_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
7968 REWRITE_TAC[NORM_GE_SQUARE] THEN REWRITE_TAC[real_ge] THEN
7969 ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL
7970 [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
7971 REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN
7972 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
7973 DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
7974 ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
7975 `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
7976 MATCH_MP_TAC REAL_LE_TRANS THEN
7977 EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN
7979 [REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN
7980 REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
7981 MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
7982 MATCH_MP_TAC(REAL_ARITH
7983 `&0 <= (u - &1 / &2) * (u - &1 / &2)
7984 ==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN
7985 REWRITE_TAC[REAL_LE_SQUARE];
7986 REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
7988 REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN
7989 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
7990 ASM_REWRITE_TAC[]]);;
7992 (* ------------------------------------------------------------------------- *)
7993 (* Accessibility of frontier points. *)
7994 (* ------------------------------------------------------------------------- *)
7996 let DENSE_ACCESSIBLE_FRONTIER_POINTS = prove
7997 (`!s:real^N->bool v.
7998 open s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
8000 IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
8001 pathstart g IN s /\ pathfinish g IN v`,
8002 REPEAT STRIP_TAC THEN
8003 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8004 DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
8005 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
8006 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `z:real^N`)) THEN
8007 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8008 X_GEN_TAC `r:real` THEN STRIP_TAC THEN
8009 SUBGOAL_THEN `(z:real^N) IN frontier s` MP_TAC THENL
8011 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
8012 REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN]] THEN
8013 REWRITE_TAC[closure; IN_UNION; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN
8014 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
8015 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_BALL]) THEN
8016 DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN
8017 ASM_CASES_TAC `s INTER ball(z:real^N,r) = {}` THENL
8018 [ASM_MESON_TAC[INFINITE; FINITE_EMPTY]; DISCH_THEN(K ALL_TAC)] THEN
8019 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8020 REWRITE_TAC[IN_INTER] THEN
8021 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
8022 SUBGOAL_THEN `~((y:real^N) IN frontier s)` ASSUME_TAC THENL
8023 [ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN; frontier]; ALL_TAC] THEN
8024 SUBGOAL_THEN `path_connected(ball(z:real^N,r))` MP_TAC THENL
8025 [ASM_SIMP_TAC[CONVEX_BALL; CONVEX_IMP_PATH_CONNECTED]; ALL_TAC] THEN
8026 REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
8027 DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
8028 ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN
8029 ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
8030 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
8032 `IMAGE drop {t | t IN interval[vec 0,vec 1] /\
8033 (g:real^1->real^N) t IN frontier s}`
8034 COMPACT_ATTAINS_INF) THEN
8035 REWRITE_TAC[EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IMP_CONJ] THEN
8036 REWRITE_TAC[IMP_IMP; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM IMAGE_o] THEN
8037 REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_ID] THEN
8040 [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
8041 [MATCH_MP_TAC BOUNDED_SUBSET THEN
8042 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
8043 REWRITE_TAC[BOUNDED_INTERVAL; SUBSET_RESTRICT];
8044 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
8045 REWRITE_TAC[FRONTIER_CLOSED; CLOSED_INTERVAL; GSYM path] THEN
8046 ASM_MESON_TAC[arc]];
8047 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 1:real^1` THEN
8048 ASM_REWRITE_TAC[IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
8049 ASM_MESON_TAC[pathfinish; SUBSET]];
8050 DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
8051 EXISTS_TAC `subpath (vec 0) t (g:real^1->real^N)` THEN
8052 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
8053 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
8054 [MATCH_MP_TAC ARC_SUBPATH_ARC THEN
8055 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
8056 ASM_MESON_TAC[pathstart];
8057 REWRITE_TAC[arc] THEN STRIP_TAC] THEN
8058 GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [GSYM pathstart] THEN
8059 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
8060 [ALL_TAC; RULE_ASSUM_TAC(SIMP_RULE[path_image]) THEN ASM SET_TAC[]] THEN
8061 MATCH_MP_TAC(SET_RULE
8062 `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
8063 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
8064 ==> IMAGE f (s DELETE a) SUBSET t`) THEN
8065 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN
8066 W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SUBPATH o lhand o lhand o
8068 ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN
8069 REWRITE_TAC[REWRITE_RULE[pathfinish] PATHFINISH_SUBPATH] THEN
8070 MATCH_MP_TAC(SET_RULE
8071 `IMAGE f (s DELETE a) DIFF t = {}
8072 ==> IMAGE f s DELETE f a SUBSET t`) THEN
8073 MATCH_MP_TAC(REWRITE_RULE[TAUT
8074 `p /\ q /\ ~r ==> ~s <=> p /\ q /\ s ==> r`]
8075 CONNECTED_INTER_FRONTIER) THEN
8076 REPEAT CONJ_TAC THENL
8077 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
8078 [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [arc]) THEN
8079 REWRITE_TAC[path] THEN MATCH_MP_TAC
8080 (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN
8081 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
8082 REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
8084 MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
8085 EXISTS_TAC `interval(vec 0:real^1,t)` THEN
8086 REWRITE_TAC[CONNECTED_INTERVAL; CLOSURE_INTERVAL] THEN
8087 REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN
8088 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
8090 ASM_REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
8091 REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC];
8092 REWRITE_TAC[SET_RULE
8093 `~(IMAGE f s INTER t = {}) <=> ?x. x IN s /\ f x IN t`] THEN
8094 EXISTS_TAC `vec 0:real^1` THEN
8095 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; REAL_LE_REFL] THEN
8096 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
8097 ASM SET_TAC[pathstart];
8098 REWRITE_TAC[SET_RULE
8099 `IMAGE g i INTER s = {} <=> !x. x IN i ==> ~(g x IN s)`] THEN
8100 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; IN_DIFF] THEN
8101 X_GEN_TAC `z:real^1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8102 REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1] THEN DISCH_TAC THEN
8103 DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
8104 ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
8105 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
8106 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
8107 ASM_REAL_ARITH_TAC]]);;
8109 let DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED = prove
8110 (`!s:real^N->bool v x.
8111 open s /\ connected s /\ x IN s /\
8112 open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
8114 IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
8115 pathstart g = x /\ pathfinish g IN v`,
8116 REPEAT STRIP_TAC THEN
8117 MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`]
8118 DENSE_ACCESSIBLE_FRONTIER_POINTS) THEN
8119 ASM_REWRITE_TAC[] THEN
8120 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
8121 SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL
8122 [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN
8123 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8124 DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `pathstart g:real^N`]) THEN
8125 ASM_REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
8126 X_GEN_TAC `f:real^1->real^N` THEN STRIP_TAC THEN
8127 MP_TAC(ISPECL [`f ++ g:real^1->real^N`; `x:real^N`; `pathfinish g:real^N`]
8128 PATH_CONTAINS_ARC) THEN
8129 ASM_SIMP_TAC[PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN;
8130 PATHSTART_JOIN; PATHFINISH_JOIN] THEN
8131 FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
8132 GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
8133 ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN
8134 DISCH_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
8135 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
8136 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
8137 `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
8138 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
8139 ==> IMAGE f (s DELETE a) SUBSET t`) THEN
8140 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
8141 CONJ_TAC THENL [REWRITE_TAC[GSYM path_image]; ASM_MESON_TAC[arc]] THEN
8142 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8144 ==> f SUBSET s /\ g DELETE a SUBSET s ==> h DELETE a SUBSET s`)) THEN
8145 ASM_REWRITE_TAC[] THEN
8146 RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish]) THEN
8147 REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
8149 let DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS = prove
8150 (`!s u v:real^N->bool.
8151 open s /\ connected s /\
8152 open_in (subtopology euclidean (frontier s)) u /\
8153 open_in (subtopology euclidean (frontier s)) v /\
8154 ~(u = {}) /\ ~(v = {}) /\ ~(u = v)
8156 pathstart g IN u /\ pathfinish g IN v /\
8157 IMAGE g (interval(vec 0,vec 1)) SUBSET s`,
8158 GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
8159 ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
8160 GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o RAND_CONV)
8161 [GSYM SUBSET_ANTISYM_EQ] THEN
8162 REWRITE_TAC[DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN
8163 MATCH_MP_TAC(MESON[]
8164 `(!u v. R u v ==> R v u) /\ (!u v. P u v ==> R u v)
8165 ==> !u v. P u v \/ P v u ==> R u v`) THEN
8167 [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
8168 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN
8169 STRIP_TAC THEN EXISTS_TAC `reversepath g:real^1->real^N` THEN
8170 ASM_SIMP_TAC[ARC_REVERSEPATH; PATHSTART_REVERSEPATH;
8171 PATHFINISH_REVERSEPATH] THEN
8172 REWRITE_TAC[reversepath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
8173 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
8174 (SET_RULE `IMAGE f i SUBSET t
8175 ==> IMAGE r i SUBSET i ==> IMAGE f (IMAGE r i) SUBSET t`)) THEN
8176 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
8179 REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
8180 ASM_REWRITE_TAC[FRONTIER_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THENL
8181 [CONV_TAC TAUT; STRIP_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})`] THEN
8182 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
8183 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8185 [`s:real^N->bool`; `v:real^N->bool`; `x:real^N`]
8186 DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
8187 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8188 X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
8190 [`s:real^N->bool`; `(u DELETE pathfinish g):real^N->bool`; `x:real^N`]
8191 DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
8192 ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN
8193 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
8194 X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
8195 MP_TAC(ISPECL [`(reversepath h ++ g):real^1->real^N`;
8196 `pathfinish h:real^N`; `pathfinish g:real^N`]
8197 PATH_CONTAINS_ARC) THEN
8198 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
8199 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
8200 PATH_REVERSEPATH; ARC_IMP_PATH; PATH_IMAGE_JOIN;
8201 PATH_IMAGE_REVERSEPATH] THEN
8202 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
8203 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8204 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN
8205 MATCH_MP_TAC(SET_RULE
8206 `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
8207 t SUBSET s /\ IMAGE f s SUBSET u UNION IMAGE f t
8208 ==> IMAGE f (s DIFF t) SUBSET u`) THEN
8209 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN
8210 CONJ_TAC THENL [ASM_MESON_TAC[arc]; REWRITE_TAC[GSYM path_image]] THEN
8211 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8213 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN
8214 REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
8216 (* ------------------------------------------------------------------------- *)
8217 (* Some simple positive connection theorems. *)
8218 (* ------------------------------------------------------------------------- *)
8220 let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove
8221 (`!u s:real^N->bool.
8222 convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`,
8223 REPEAT STRIP_TAC THEN
8224 REWRITE_TAC[path_connected; IN_DIFF; IN_UNIV] THEN
8225 MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
8226 ASM_CASES_TAC `a:real^N = b` THENL
8227 [EXISTS_TAC `linepath(a:real^N,b)` THEN
8228 REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
8229 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[];
8231 ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
8232 SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL
8233 [ASM_MESON_TAC[MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN
8234 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
8235 GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN
8236 GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN
8237 GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN
8238 DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8239 ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
8240 DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN
8241 REPEAT GEN_TAC THEN REWRITE_TAC[midpoint; VECTOR_MUL_LID] THEN
8242 REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
8243 ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN
8244 POP_ASSUM(K ALL_TAC) THEN
8245 REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
8246 DISCH_THEN(K ALL_TAC) THEN
8247 SUBGOAL_THEN `segment[--basis 1:real^N,basis 1] SUBSET u` ASSUME_TAC THENL
8248 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
8251 SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL
8252 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
8253 REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN
8254 CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC;
8256 SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\
8257 c IN u /\ ~(c$k = &0)`
8258 STRIP_ASSUME_TAC THENL
8259 [REWRITE_TAC[GSYM NOT_FORALL_THM; TAUT
8260 `a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN
8261 DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN
8262 REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
8263 MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN
8264 SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN
8265 REWRITE_TAC[SPAN_SING; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
8266 X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN
8267 SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
8268 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
8269 ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN
8272 SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL
8273 [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
8274 SUBGOAL_THEN `segment[vec 0:real^N,c] SUBSET u` ASSUME_TAC THENL
8275 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
8279 `?z:real^N. z IN segment[vec 0,c] /\
8280 (segment[--basis 1,z] UNION segment[z,basis 1]) INTER s = {}`
8281 STRIP_ASSUME_TAC THENL
8283 EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN
8284 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_LINEPATH;
8285 PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN
8286 REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN
8287 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8288 `(t UNION v) INTER s = {}
8289 ==> t SUBSET u /\ v SUBSET u
8290 ==> (t UNION v) SUBSET u DIFF s`)) THEN
8291 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
8292 CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]] THEN
8293 MATCH_MP_TAC(SET_RULE
8294 `~(s SUBSET {z | z IN s /\ ~P z}) ==> ?z. z IN s /\ P z`) THEN
8295 DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
8296 REWRITE_TAC[CARD_NOT_LE; SET_RULE
8297 `~((b UNION c) INTER s = {}) <=>
8298 ~(b INTER s = {}) \/ ~(c INTER s = {})`] THEN
8299 REWRITE_TAC[SET_RULE
8300 `{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN
8301 W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN
8302 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_LET_TRANS) THEN
8303 TRANS_TAC CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL
8304 [MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[real_INFINITE];
8305 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
8306 ASM_SIMP_TAC[CARD_EQ_SEGMENT]] THEN
8307 REWRITE_TAC[MESON[SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN
8310 b IN u /\ ~(b IN s) /\ ~(b = vec 0) /\ b$k = &0
8311 ==> {z | z IN segment[vec 0,c] /\ ~(segment[z,b] INTER s = {})} <_c
8313 (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN
8314 REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_NEG_COMPONENT] THEN
8315 ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
8316 BASIS_COMPONENT] THEN
8317 REWRITE_TAC[REAL_NEG_0]) THEN
8318 REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN
8319 ASM_REWRITE_TAC[] THEN
8320 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; RIGHT_AND_EXISTS_THM] THEN
8321 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN
8322 MATCH_MP_TAC CARD_LE_RELATIONAL THEN
8323 MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN
8324 REWRITE_TAC[SEGMENT_SYM] THEN STRIP_TAC THEN
8325 ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN
8327 [`x1:real^N`; `b:real^N`; `x2:real^N`] INTER_SEGMENT) THEN
8328 REWRITE_TAC[NOT_IMP; SEGMENT_SYM] THEN
8329 CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[SEGMENT_SYM] THEN ASM SET_TAC[]] THEN
8330 ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN
8331 ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN
8332 SUBGOAL_THEN `(b:real^N) IN affine hull {vec 0,c}` MP_TAC THENL
8333 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8334 `b IN s ==> s SUBSET t ==> b IN t`)) THEN
8335 MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN
8336 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN
8337 CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN
8338 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
8339 REWRITE_TAC[AFFINE_HULL_2_ALT; IN_ELIM_THM; IN_UNIV] THEN
8340 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_RZERO; NOT_EXISTS_THM] THEN
8341 X_GEN_TAC `r:real` THEN
8342 ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
8343 CONV_TAC(RAND_CONV SYM_CONV) THEN
8344 DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN
8345 ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ENTIRE]]);;
8347 let CONNECTED_CONVEX_DIFF_CARD_LT = prove
8348 (`!u s. convex u /\ ~collinear u /\ s <_c (:real) ==> connected(u DIFF s)`,
8349 SIMP_TAC[PATH_CONNECTED_CONVEX_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;
8351 let PATH_CONNECTED_CONVEX_DIFF_COUNTABLE = prove
8352 (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> path_connected(u DIFF s)`,
8353 MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; PATH_CONNECTED_CONVEX_DIFF_CARD_LT]);;
8355 let CONNECTED_CONVEX_DIFF_COUNTABLE = prove
8356 (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> connected(u DIFF s)`,
8357 MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; CONNECTED_CONVEX_DIFF_CARD_LT]);;
8359 let PATH_CONNECTED_PUNCTURED_CONVEX = prove
8360 (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> path_connected(s DELETE a)`,
8361 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH
8362 `~(x:int = &1) ==> --(&1) <= x ==> x = -- &1 \/ x = &0 \/ &2 <= x`)) THEN
8363 ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
8364 DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN
8365 ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{} DELETE a = {}`] THENL
8366 [FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` SUBST1_TAC) THEN
8367 ASM_CASES_TAC `b:real^N = a` THEN
8368 ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{a} DELETE a = {}`] THEN
8369 ASM_SIMP_TAC[SET_RULE `~(b = a) ==> {a} DELETE b = {a}`] THEN
8370 REWRITE_TAC[PATH_CONNECTED_SING];
8371 REPEAT STRIP_TAC THEN
8372 ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
8373 MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN
8374 ASM_REWRITE_TAC[COUNTABLE_SING; COLLINEAR_AFF_DIM] THEN
8375 ASM_INT_ARITH_TAC]);;
8377 let CONNECTED_PUNCTURED_CONVEX = prove
8378 (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> connected(s DELETE a)`,
8379 SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; PATH_CONNECTED_IMP_CONNECTED]);;
8381 let PATH_CONNECTED_COMPLEMENT_CARD_LT = prove
8382 (`!s. 2 <= dimindex(:N) /\ s <_c (:real)
8383 ==> path_connected((:real^N) DIFF s)`,
8384 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN
8385 ASM_REWRITE_TAC[CONVEX_UNIV; COLLINEAR_AFF_DIM; AFF_DIM_UNIV] THEN
8386 REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);;
8388 let PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
8389 (`!s t:real^N->bool.
8390 connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
8391 ~collinear s /\ t <_c (:real)
8392 ==> path_connected(s DIFF t)`,
8393 REPEAT STRIP_TAC THEN
8394 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IN_DIFF] THEN
8395 REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN
8396 MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN
8397 ASM_REWRITE_TAC[IN_DIFF] THEN
8398 REWRITE_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] THEN CONJ_TAC THENL
8399 [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
8401 `open_in (subtopology euclidean (affine hull s)) (u:real^N->bool)`
8402 MP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
8403 REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN
8404 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
8405 ASM_REWRITE_TAC[] THEN
8406 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8407 MATCH_MP_TAC(SET_RULE `~(s SUBSET t) ==> ?x. x IN s /\ ~(x IN t)`) THEN
8408 DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
8409 REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
8410 ASM_REWRITE_TAC[] THEN
8411 TRANS_TAC CARD_LE_TRANS `ball(x:real^N,r) INTER affine hull s` THEN
8412 ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
8413 ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONVEX THEN
8414 EXISTS_TAC `x:real^N` THEN
8415 ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL;
8416 AFFINE_AFFINE_HULL; IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN
8417 SUBGOAL_THEN `~(s SUBSET {x:real^N})` MP_TAC THENL
8418 [ASM_MESON_TAC[COLLINEAR_SUBSET; COLLINEAR_SING]; ALL_TAC] THEN
8419 REWRITE_TAC[SUBSET; IN_SING; NOT_FORALL_THM; NOT_IMP] THEN
8420 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
8421 EXISTS_TAC `x + r / &2 / norm(y - x) % (y - x):real^N` THEN
8422 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
8423 ASM_SIMP_TAC[HULL_INC; IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL] THEN
8424 REWRITE_TAC[IN_BALL; VECTOR_ARITH `x:real^N = x + y <=> y = vec 0`] THEN
8425 ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ;
8426 REAL_LT_IMP_NZ; NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN
8427 REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN
8428 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8430 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8431 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
8432 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
8433 ASM_REWRITE_TAC[] THEN
8434 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8435 EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN
8436 ASM_SIMP_TAC[IN_INTER; HULL_INC; CENTRE_IN_BALL] THEN CONJ_TAC THENL
8437 [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
8438 EXISTS_TAC `affine hull s:real^N->bool` THEN
8439 ASM_SIMP_TAC[ONCE_REWRITE_RULE[INTER_COMM]OPEN_IN_OPEN_INTER; OPEN_BALL];
8440 MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN
8441 MP_TAC(ISPECL [`ball(x:real^N,r) INTER affine hull s`; `t:real^N->bool`]
8442 PATH_CONNECTED_CONVEX_DIFF_CARD_LT) THEN
8443 ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL;
8444 AFFINE_AFFINE_HULL] THEN
8446 [REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
8447 W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_OPEN o
8448 lhand o rand o snd) THEN
8449 SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN
8450 ANTS_TAC THENL [ASM SET_TAC[CENTRE_IN_BALL]; ALL_TAC] THEN
8451 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN
8452 ASM_REWRITE_TAC[GSYM COLLINEAR_AFF_DIM];
8453 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8454 DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
8455 ASM_REWRITE_TAC[IN_INTER; IN_DIFF] THEN
8456 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] PATH_COMPONENT_OF_SUBSET) THEN
8459 let CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
8460 (`!s t:real^N->bool.
8461 connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
8462 ~collinear s /\ t <_c (:real)
8463 ==> connected(s DIFF t)`,
8464 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
8465 MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
8466 ASM_REWRITE_TAC[]);;
8468 let PATH_CONNECTED_OPEN_DIFF_CARD_LT = prove
8469 (`!s t:real^N->bool.
8470 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
8471 ==> path_connected(s DIFF t)`,
8472 REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
8473 ASM_REWRITE_TAC[EMPTY_DIFF; PATH_CONNECTED_EMPTY] THEN
8474 MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
8475 ASM_REWRITE_TAC[COLLINEAR_AFF_DIM] THEN
8476 ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFF_DIM_OPEN] THEN
8477 ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
8480 let CONNECTED_OPEN_DIFF_CARD_LT = prove
8481 (`!s t:real^N->bool.
8482 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
8483 ==> connected(s DIFF t)`,
8484 SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;
8486 let PATH_CONNECTED_OPEN_DIFF_COUNTABLE = prove
8487 (`!s t:real^N->bool.
8488 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
8489 ==> path_connected(s DIFF t)`,
8490 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_CARD_LT THEN
8491 ASM_REWRITE_TAC[GSYM CARD_NOT_LE] THEN
8492 ASM_MESON_TAC[UNCOUNTABLE_REAL; CARD_LE_COUNTABLE]);;
8494 let CONNECTED_OPEN_DIFF_COUNTABLE = prove
8495 (`!s t:real^N->bool.
8496 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
8497 ==> connected(s DIFF t)`,
8498 SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_COUNTABLE; PATH_CONNECTED_IMP_CONNECTED]);;
8500 let PATH_CONNECTED_OPEN_DELETE = prove
8501 (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
8502 ==> path_connected(s DELETE a)`,
8503 REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
8504 MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
8505 ASM_REWRITE_TAC[COUNTABLE_SING]);;
8507 let CONNECTED_OPEN_DELETE = prove
8508 (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
8509 ==> connected(s DELETE a)`,
8510 SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; PATH_CONNECTED_IMP_CONNECTED]);;
8512 let PATH_CONNECTED_PUNCTURED_UNIVERSE = prove
8513 (`!a. 2 <= dimindex(:N) ==> path_connected((:real^N) DIFF {a})`,
8514 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
8515 ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; COUNTABLE_SING]);;
8517 let CONNECTED_PUNCTURED_UNIVERSE = prove
8518 (`!a. 2 <= dimindex(:N) ==> connected((:real^N) DIFF {a})`,
8519 SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; PATH_CONNECTED_IMP_CONNECTED]);;
8521 let PATH_CONNECTED_PUNCTURED_BALL = prove
8522 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(ball(a,r) DELETE a)`,
8523 SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;
8525 let CONNECTED_PUNCTURED_BALL = prove
8526 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(ball(a,r) DELETE a)`,
8527 SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;
8529 let PATH_CONNECTED_SPHERE = prove
8530 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(sphere(a,r))`,
8532 REWRITE_TAC[sphere; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN
8533 GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN
8534 REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN
8535 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
8536 (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
8538 [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN
8539 REWRITE_TAC[EMPTY_GSPEC; PATH_CONNECTED_EMPTY];
8540 ASM_REWRITE_TAC[NORM_EQ_0; SING_GSPEC; PATH_CONNECTED_SING];
8542 `{x:real^N | norm x = r} =
8543 IMAGE (\x. r / norm x % x) ((:real^N) DIFF {vec 0})`
8545 [MATCH_MP_TAC SUBSET_ANTISYM THEN
8546 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
8547 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF; IN_SING; IN_UNIV] THEN
8548 ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL;
8549 NORM_EQ_0; REAL_ARITH `&0 < r ==> abs r = r`] THEN
8550 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
8551 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN
8552 ASM_MESON_TAC[NORM_0; REAL_LT_IMP_NZ];
8553 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
8554 ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE] THEN
8555 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
8556 REWRITE_TAC[o_DEF; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
8557 X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN
8558 DISCH_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN
8559 MATCH_MP_TAC CONTINUOUS_CMUL THEN
8560 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN
8561 ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
8562 REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]]);;
8564 let CONNECTED_SPHERE = prove
8565 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(sphere(a,r))`,
8566 SIMP_TAC[PATH_CONNECTED_SPHERE; PATH_CONNECTED_IMP_CONNECTED]);;
8568 let CONNECTED_SPHERE_EQ = prove
8569 (`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
8571 (`!a:real^1 r. &0 < r
8572 ==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`,
8573 MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
8574 COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8575 REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN
8576 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
8577 `~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN
8578 REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN
8579 REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in
8580 REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
8581 ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN
8582 ASM_CASES_TAC `r = &0` THEN
8583 ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN
8584 SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL
8585 [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
8586 EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN
8587 DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN
8588 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8589 SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
8590 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN
8591 DISCH_TAC THEN FIRST_ASSUM (fun th ->
8592 REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN
8593 REWRITE_TAC[SET_RULE
8594 `~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN
8595 REWRITE_TAC[IN_SPHERE] THEN
8596 FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN
8597 ASM_REWRITE_TAC[]);;
8599 let PATH_CONNECTED_SPHERE_EQ = prove
8600 (`!a:real^N r. path_connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
8601 REPEAT GEN_TAC THEN EQ_TAC THENL
8602 [REWRITE_TAC[GSYM CONNECTED_SPHERE_EQ; PATH_CONNECTED_IMP_CONNECTED];
8603 STRIP_TAC THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]] THEN
8604 ASM_CASES_TAC `r < &0` THEN
8605 ASM_SIMP_TAC[SPHERE_EMPTY; PATH_CONNECTED_EMPTY] THEN
8606 ASM_CASES_TAC `r = &0` THEN
8607 ASM_SIMP_TAC[SPHERE_SING; PATH_CONNECTED_SING] THEN
8608 ASM_REAL_ARITH_TAC);;
8610 let FINITE_SPHERE = prove
8611 (`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`,
8612 REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN
8613 ASM_REWRITE_TAC[] THENL
8614 [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN
8615 FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP
8616 (GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
8618 ASM_SIMP_TAC[CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`;
8619 DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN
8620 REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=>
8621 (!a b. a IN s /\ b IN s ==> a = b)`] THEN
8622 SIMP_TAC[IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
8623 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8624 REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
8625 MP_TAC(ISPECL [`a:real^N`; `r:real`] VECTOR_CHOOSE_DIST) THEN
8626 ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
8627 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8628 DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN
8629 FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN
8630 REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);;
8632 let LIMIT_POINT_OF_SPHERE = prove
8633 (`!a r x:real^N. x limit_point_of sphere(a,r) <=>
8634 &0 < r /\ 2 <= dimindex(:N) /\ x IN sphere(a,r)`,
8635 REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL
8636 [ASM_SIMP_TAC[LIMIT_POINT_FINITE]; ALL_TAC] THEN
8637 FIRST_ASSUM(MP_TAC o REWRITE_RULE[FINITE_SPHERE]) THEN
8638 REWRITE_TAC[DE_MORGAN_THM] THEN
8639 STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH; REAL_NOT_LT] THEN
8640 ASM_SIMP_TAC[GSYM REAL_NOT_LE; DIMINDEX_GE_1;
8641 ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
8642 EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[CLOSED_LIMPT] CLOSED_SPHERE] THEN
8643 DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN
8644 ASM_SIMP_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_GE_1;
8645 ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
8646 ASM_MESON_TAC[FINITE_SING]);;
8648 let CARD_EQ_SPHERE = prove
8649 (`!a:real^N r. 2 <= dimindex(:N) /\ &0 < r ==> sphere(a,r) =_c (:real)`,
8650 SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SPHERE] THEN
8651 REPEAT STRIP_TAC THEN
8652 FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN
8653 ASM_REWRITE_TAC[FINITE_SING; FINITE_SPHERE; REAL_NOT_LE; DE_MORGAN_THM] THEN
8656 let PATH_CONNECTED_ANNULUS = prove
8659 ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
8662 ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
8665 ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
8668 ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
8671 2 <= dimindex(:N) /\ path_connected {lift r | &0 <= r /\ P r}
8672 ==> path_connected {x | P(norm(x - a))}`,
8673 REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
8674 REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN
8676 `{x:real^N | P(norm(x))} =
8677 IMAGE (\z. drop(fstcart z) % sndcart z)
8678 {pastecart x y | x IN {lift x | &0 <= x /\ P x} /\
8679 y IN {y | norm y = &1}}`
8681 [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
8682 REWRITE_TAC[EXISTS_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
8683 X_GEN_TAC `z:real^N` THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN
8684 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
8685 REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IMAGE_ID] THEN
8686 REWRITE_TAC[IN_ELIM_THM] THEN
8687 EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; REAL_MUL_RID] THEN
8688 ASM_REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL
8689 [MAP_EVERY EXISTS_TAC [`&0`; `basis 1:real^N`] THEN
8690 ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO] THEN
8691 ASM_MESON_TAC[NORM_0; REAL_ABS_NUM; REAL_LE_REFL];
8692 MAP_EVERY EXISTS_TAC [`norm(z:real^N)`; `inv(norm z) % z:real^N`] THEN
8693 ASM_SIMP_TAC[REAL_ABS_NORM; NORM_MUL; VECTOR_MUL_ASSOC; VECTOR_MUL_LID;
8694 NORM_POS_LE; REAL_ABS_INV; REAL_MUL_RINV; REAL_MUL_LINV; NORM_EQ_0]];
8695 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
8696 [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
8697 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
8698 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
8699 REWRITE_TAC[GSYM PCROSS] THEN
8700 MATCH_MP_TAC PATH_CONNECTED_PCROSS THEN ASM_REWRITE_TAC[] THEN
8701 ONCE_REWRITE_TAC[NORM_ARITH `norm y = norm(y - vec 0:real^N)`] THEN
8702 ONCE_REWRITE_TAC[NORM_SUB] THEN
8703 REWRITE_TAC[REWRITE_RULE[dist] (GSYM sphere)] THEN
8704 ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]]]) in
8705 REPEAT STRIP_TAC THEN
8706 MP_TAC(ISPEC `a:real^N` lemma) THEN
8707 DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
8708 MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
8709 MATCH_MP_TAC IS_INTERVAL_CONVEX THEN
8710 REWRITE_TAC[is_interval] THEN
8711 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
8712 REWRITE_TAC[IN_IMAGE_LIFT_DROP; FORALL_1; DIMINDEX_1] THEN
8713 REWRITE_TAC[IN_ELIM_THM; GSYM drop] THEN REAL_ARITH_TAC);;
8715 let CONNECTED_ANNULUS = prove
8718 ==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
8721 ==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
8724 ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
8727 ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
8728 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
8729 ASM_SIMP_TAC[PATH_CONNECTED_ANNULUS]);;
8731 let PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
8732 (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
8733 ==> path_connected((:real^N) DIFF s)`,
8734 REPEAT STRIP_TAC THEN
8735 ASM_CASES_TAC `s:real^N->bool = {}` THEN
8736 ASM_SIMP_TAC[DIFF_EMPTY; CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV] THEN
8737 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8738 DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
8739 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8740 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
8741 REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
8742 SUBGOAL_THEN `~(x:real^N = a) /\ ~(y = a)` STRIP_ASSUME_TAC THENL
8743 [ASM_MESON_TAC[]; ALL_TAC] THEN
8744 SUBGOAL_THEN `bounded((x:real^N) INSERT y INSERT s)` MP_TAC THENL
8745 [ASM_REWRITE_TAC[BOUNDED_INSERT]; ALL_TAC] THEN
8746 DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
8747 REWRITE_TAC[INSERT_SUBSET] THEN
8748 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
8749 MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
8750 ABBREV_TAC `C = (B / norm(x - a:real^N))` THEN
8751 EXISTS_TAC `a + C % (x - a):real^N` THEN CONJ_TAC THENL
8752 [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
8753 REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
8754 REWRITE_TAC[VECTOR_ARITH
8755 `(&1 - u) % x + u % (a + B % (x - a)):real^N =
8756 a + (&1 + (B - &1) * u) % (x - a)`] THEN
8757 X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
8758 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
8759 DISCH_THEN(MP_TAC o SPECL
8760 [`a:real^N`; `a + (&1 + (C - &1) * u) % (x - a):real^N`;
8761 `&1 / (&1 + (C - &1) * u)`]) THEN
8762 SUBGOAL_THEN `&1 <= &1 + (C - &1) * u` ASSUME_TAC THENL
8763 [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
8764 ASM_REWRITE_TAC[REAL_SUB_LE] THEN
8766 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
8767 RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
8768 ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(x - a) = norm(a - x)`];
8769 FIRST_ASSUM(ASSUME_TAC o MATCH_MP
8770 (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
8771 ASM_REWRITE_TAC[NOT_IMP] THEN
8772 ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
8774 ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
8775 REAL_LT_IMP_NZ] THEN
8776 UNDISCH_TAC `~((x:real^N) IN s)` THEN
8777 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8780 MATCH_MP_TAC PATH_COMPONENT_SYM THEN
8781 MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
8782 ABBREV_TAC `D = (B / norm(y - a:real^N))` THEN
8783 EXISTS_TAC `a + D % (y - a):real^N` THEN CONJ_TAC THENL
8784 [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
8785 REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
8786 REWRITE_TAC[VECTOR_ARITH
8787 `(&1 - u) % y + u % (a + B % (y - a)):real^N =
8788 a + (&1 + (B - &1) * u) % (y - a)`] THEN
8789 X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
8790 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
8791 DISCH_THEN(MP_TAC o SPECL
8792 [`a:real^N`; `a + (&1 + (D - &1) * u) % (y - a):real^N`;
8793 `&1 / (&1 + (D - &1) * u)`]) THEN
8794 SUBGOAL_THEN `&1 <= &1 + (D - &1) * u` ASSUME_TAC THENL
8795 [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
8796 ASM_REWRITE_TAC[REAL_SUB_LE] THEN
8798 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
8799 RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
8800 ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(y - a) = norm(a - y)`];
8801 FIRST_ASSUM(ASSUME_TAC o MATCH_MP
8802 (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
8803 ASM_REWRITE_TAC[NOT_IMP] THEN
8804 ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
8806 ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
8807 REAL_LT_IMP_NZ] THEN
8808 UNDISCH_TAC `~((y:real^N) IN s)` THEN
8809 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8812 MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN
8813 EXISTS_TAC `{x:real^N | norm(x - a) = B}` THEN CONJ_TAC THENL
8814 [UNDISCH_TAC `s SUBSET ball(a:real^N,B)` THEN
8815 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_BALL; dist] THEN
8816 MESON_TAC[NORM_SUB; REAL_LT_REFL];
8817 MP_TAC(ISPECL [`a:real^N`; `B:real`] PATH_CONNECTED_SPHERE) THEN
8818 REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] THEN
8819 ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8820 DISCH_THEN MATCH_MP_TAC THEN
8821 REWRITE_TAC[IN_ELIM_THM; VECTOR_ADD_SUB; NORM_MUL] THEN
8822 MAP_EVERY EXPAND_TAC ["C"; "D"] THEN
8823 REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN
8824 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8825 ASM_REAL_ARITH_TAC]);;
8827 let CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
8828 (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
8829 ==> connected((:real^N) DIFF s)`,
8830 SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED;
8831 PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX]);;
8833 let CONNECTED_DIFF_BALL = prove
8835 2 <= dimindex(:N) /\ connected s /\ cball(a,r) SUBSET s
8836 ==> connected(s DIFF ball(a,r))`,
8837 REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DIFF_OPEN_FROM_CLOSED THEN
8838 EXISTS_TAC `cball(a:real^N,r)` THEN
8839 ASM_REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BALL_SUBSET_CBALL] THEN
8840 REWRITE_TAC[CBALL_DIFF_BALL] THEN
8841 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
8842 ASM_SIMP_TAC[CONNECTED_SPHERE]);;
8844 let PATH_CONNECTED_DIFF_BALL = prove
8846 2 <= dimindex(:N) /\ path_connected s /\ cball(a,r) SUBSET s
8847 ==> path_connected(s DIFF ball(a,r))`,
8848 REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
8849 ASM_SIMP_TAC[DIFF_EMPTY] THEN
8850 RULE_ASSUM_TAC(REWRITE_RULE[BALL_EQ_EMPTY; REAL_NOT_LE]) THEN
8851 REWRITE_TAC[path_connected] THEN
8852 FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
8853 ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN DISCH_TAC THEN
8854 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
8855 REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
8856 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
8857 DISCH_THEN(fun th ->
8858 MP_TAC(SPECL [`x:real^N`; `a:real^N`] th) THEN
8859 MP_TAC(SPECL [`y:real^N`; `a:real^N`] th)) THEN
8860 ASM_REWRITE_TAC[] THEN
8861 DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN
8862 DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN
8863 MP_TAC(ISPECL [`g2:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
8864 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
8865 MP_TAC(ISPECL [`g1:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
8866 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
8867 ASM_SIMP_TAC[CENTRE_IN_BALL; IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
8868 ASM_SIMP_TAC[FRONTIER_COMPLEMENT; INTERIOR_COMPLEMENT; CLOSURE_BALL] THEN
8869 ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE] THEN
8870 X_GEN_TAC `h1:real^1->real^N` THEN STRIP_TAC THEN
8871 X_GEN_TAC `h2:real^1->real^N` THEN STRIP_TAC THEN
8872 MP_TAC(ISPECL [`a:real^N`; `r:real`] PATH_CONNECTED_SPHERE) THEN
8873 ASM_REWRITE_TAC[path_connected] THEN
8874 DISCH_THEN(MP_TAC o SPECL
8875 [`pathfinish h1:real^N`; `pathfinish h2:real^N`]) THEN
8876 ASM_SIMP_TAC[IN_SPHERE] THEN
8877 DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN
8878 EXISTS_TAC `h1 ++ h ++ reversepath h2:real^1->real^N` THEN
8879 ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH;
8880 PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH;
8881 PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
8882 REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL
8884 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8886 UNDISCH_TAC `cball(a:real^N,r) SUBSET s` THEN
8887 SIMP_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_BALL; IN_DIFF] THEN
8888 MESON_TAC[REAL_LE_REFL; REAL_LT_REFL];
8890 MATCH_MP_TAC(SET_RULE
8891 `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN
8892 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
8893 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8894 `s DELETE a SUBSET (UNIV DIFF t) ==> ~(a IN u) /\ u SUBSET t
8895 ==> s INTER u = {}`)) THEN
8896 ASM_REWRITE_TAC[BALL_SUBSET_CBALL; IN_BALL; REAL_LT_REFL]);;
8898 let CONNECTED_OPEN_DIFF_CBALL = prove
8900 2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s
8901 ==> connected(s DIFF cball(a,r))`,
8902 REPEAT STRIP_TAC THEN
8903 ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN
8904 RULE_ASSUM_TAC(REWRITE_RULE[CBALL_EQ_EMPTY; REAL_NOT_LT]) THEN
8905 SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r') SUBSET s`
8906 STRIP_ASSUME_TAC THENL
8907 [ASM_CASES_TAC `s = (:real^N)` THENL
8908 [EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN REAL_ARITH_TAC;
8910 MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`]
8911 SETDIST_POS_LE) THEN
8912 REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN
8913 ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED;
8914 COMPACT_CBALL; CBALL_EQ_EMPTY] THEN
8915 ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN
8916 ASM_SIMP_TAC[SET_RULE `b INTER (UNIV DIFF s) = {} <=> b SUBSET s`;
8917 REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN
8919 EXISTS_TAC `r + setdist(cball(a,r),(:real^N) DIFF s) / &2` THEN
8920 ASM_REWRITE_TAC[REAL_LT_ADDR; REAL_HALF; SUBSET; IN_CBALL] THEN
8921 X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL
8922 [ASM_MESON_TAC[SUBSET; DIST_REFL; IN_CBALL]; ALL_TAC] THEN
8923 ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN
8924 MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`;
8925 `a + r / dist(a,x) % (x - a):real^N`; `x:real^N`]
8926 SETDIST_LE_DIST) THEN
8927 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN
8928 REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
8929 ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; ONCE_REWRITE_RULE[DIST_SYM] dist;
8930 REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8931 ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN
8932 REWRITE_TAC[NORM_MUL; VECTOR_ARITH
8933 `x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN
8934 ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
8935 REWRITE_TAC[GSYM REAL_ABS_MUL] THEN
8936 REWRITE_TAC[REAL_ABS_NORM; REAL_SUB_RDISTRIB] THEN
8937 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8938 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN
8939 ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
8941 SUBGOAL_THEN `s DIFF cball(a:real^N,r) =
8942 s DIFF ball(a,r') UNION
8943 {x | r < norm(x - a) /\ norm(x - a) <= r'}`
8945 [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
8946 REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
8947 `b' SUBSET c' /\ c' SUBSET s /\ c SUBSET b'
8948 ==> s DIFF c = (s DIFF b') UNION {x | ~(x IN c) /\ x IN c'}`) THEN
8949 ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN
8950 REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC;
8951 MATCH_MP_TAC CONNECTED_UNION THEN
8952 ASM_SIMP_TAC[CONNECTED_ANNULUS; PATH_CONNECTED_DIFF_BALL;
8953 PATH_CONNECTED_IMP_CONNECTED; CONNECTED_OPEN_PATH_CONNECTED] THEN
8954 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
8955 REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
8956 `c' SUBSET s /\ (?x. x IN c' /\ ~(x IN b') /\ ~(x IN c))
8957 ==> ~((s DIFF b') INTER {x | ~(x IN c) /\ x IN c'} = {})`) THEN
8958 ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN
8959 REWRITE_TAC[IN_BALL; IN_CBALL] THEN
8960 REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
8961 SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8962 ASM_REAL_ARITH_TAC]]);;
8964 (* ------------------------------------------------------------------------- *)
8965 (* Existence of unbounded components. *)
8966 (* ------------------------------------------------------------------------- *)
8968 let COBOUNDED_UNBOUNDED_COMPONENT = prove
8969 (`!s. bounded((:real^N) DIFF s)
8970 ==> ?x. x IN s /\ ~bounded(connected_component s x)`,
8971 REPEAT STRIP_TAC THEN
8972 FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
8973 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
8974 EXISTS_TAC `B % basis 1:real^N` THEN CONJ_TAC THENL
8975 [FIRST_X_ASSUM(MP_TAC o SPEC `B % basis 1:real^N` o
8976 GEN_REWRITE_RULE I [SUBSET]) THEN
8977 REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0] THEN
8978 SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8979 ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> ~(abs B * &1 < B)`];
8980 MP_TAC(ISPECL [`basis 1:real^N`; `B:real`] BOUNDED_HALFSPACE_GE) THEN
8981 SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; CONTRAPOS_THM] THEN
8982 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
8983 MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
8984 SIMP_TAC[CONVEX_HALFSPACE_GE; CONVEX_CONNECTED] THEN
8985 ASM_SIMP_TAC[IN_ELIM_THM; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_GE_1;
8986 LE_REFL; real_ge; REAL_MUL_RID; REAL_LE_REFL] THEN
8987 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8988 `UNIV DIFF s SUBSET b ==> (!x. x IN h ==> ~(x IN b)) ==> h SUBSET s`)) THEN
8989 SIMP_TAC[IN_ELIM_THM; DOT_BASIS; IN_BALL_0; DIMINDEX_GE_1; LE_REFL] THEN
8990 GEN_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
8991 MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> b <= x ==> b <= n`) THEN
8992 SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_GE_1; LE_REFL]]);;
8994 let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT = prove
8996 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\
8997 ~bounded(connected_component s x) /\
8998 ~bounded(connected_component s y)
8999 ==> connected_component s x = connected_component s y`,
9000 REPEAT STRIP_TAC THEN
9001 FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
9002 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
9003 MP_TAC(ISPEC `ball(vec 0:real^N,B)` CONNECTED_COMPLEMENT_BOUNDED_CONVEX) THEN
9004 ASM_REWRITE_TAC[BOUNDED_BALL; CONVEX_BALL] THEN DISCH_TAC THEN
9006 (MP_TAC o SPEC `B:real` o REWRITE_RULE[bounded; NOT_EXISTS_THM] o ASSUME)
9007 [`~bounded(connected_component s (y:real^N))`;
9008 `~bounded(connected_component s (x:real^N))`] THEN
9009 REWRITE_TAC[NOT_FORALL_THM; IN; NOT_IMP] THEN
9010 DISCH_THEN(X_CHOOSE_THEN `x':real^N` STRIP_ASSUME_TAC) THEN
9011 DISCH_THEN(X_CHOOSE_THEN `y':real^N` STRIP_ASSUME_TAC) THEN
9012 MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
9013 SUBGOAL_THEN `connected_component s (x':real^N) (y':real^N)` ASSUME_TAC THENL
9014 [REWRITE_TAC[connected_component] THEN
9015 EXISTS_TAC `(:real^N) DIFF ball (vec 0,B)` THEN ASM_REWRITE_TAC[] THEN
9016 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN
9017 REWRITE_TAC[IN_BALL_0] THEN ASM_MESON_TAC[REAL_LT_IMP_LE];
9018 ASM_MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]]);;
9020 let COBOUNDED_UNBOUNDED_COMPONENTS = prove
9021 (`!s. bounded ((:real^N) DIFF s) ==> ?c. c IN components s /\ ~bounded c`,
9022 REWRITE_TAC[components; EXISTS_IN_GSPEC; COBOUNDED_UNBOUNDED_COMPONENT]);;
9024 let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS = prove
9026 2 <= dimindex(:N) /\
9027 bounded ((:real^N) DIFF s) /\
9028 c IN components s /\ ~bounded c /\
9029 c' IN components s /\ ~bounded c'
9031 REWRITE_TAC[components; IN_ELIM_THM] THEN
9032 MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT]);;
9034 let COBOUNDED_HAS_BOUNDED_COMPONENT = prove
9035 (`!s. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~connected s
9036 ==> ?c. c IN components s /\ bounded c`,
9037 REPEAT STRIP_TAC THEN
9039 `?c c':real^N->bool. c IN components s /\ c' IN components s /\ ~(c = c')`
9040 STRIP_ASSUME_TAC THENL
9041 [MATCH_MP_TAC(SET_RULE
9042 `~(s = {}) /\ ~(?a. s = {a}) ==> ?x y. x IN s /\ y IN s /\ ~(x = y)`) THEN
9043 ASM_REWRITE_TAC[COMPONENTS_EQ_SING_EXISTS; COMPONENTS_EQ_EMPTY] THEN
9044 ASM_MESON_TAC[DIFF_EMPTY; NOT_BOUNDED_UNIV];
9045 ASM_MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS]]);;
9047 (* ------------------------------------------------------------------------- *)
9048 (* Self-homeomorphisms shuffling points about in various ways. *)
9049 (* ------------------------------------------------------------------------- *)
9051 let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove
9053 open_in (subtopology euclidean (affine hull s)) s /\
9054 s SUBSET t /\ t SUBSET affine hull s /\
9055 connected s /\ a IN s /\ b IN s
9056 ==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\
9057 {x | ~(f x = x /\ g x = x)} SUBSET s /\
9058 bounded {x | ~(f x = x /\ g x = x)}`,
9061 affine t /\ a IN t /\ u IN ball(a,r) INTER t
9062 ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
9064 f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`,
9065 REPEAT STRIP_TAC THEN
9066 DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
9067 [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN
9068 EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN
9069 REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
9070 [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
9071 ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE];
9072 ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist;
9073 REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN
9074 REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN
9075 REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN
9077 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
9078 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN
9079 SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
9080 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
9081 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN
9082 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
9083 MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
9084 SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB];
9087 [MATCH_MP_TAC(SET_RULE
9088 `(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y)
9089 ==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN
9090 ONCE_REWRITE_TAC[VECTOR_ARITH
9091 `(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`];
9093 REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN
9094 REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN
9095 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID;
9096 VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
9097 VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=>
9098 (n - m) % u:real^N = x - y`] THEN
9099 REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL
9101 REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN
9102 ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN
9103 ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN
9104 ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO;
9105 VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN
9106 STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN
9107 ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
9108 DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
9109 `r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN
9110 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN
9111 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN
9112 ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ;
9113 REAL_ARITH `&0 < r ==> &0 < abs r`] THEN
9114 ASM_REAL_ARITH_TAC] THEN
9116 ASM_CASES_TAC `subspace(t:real^N->bool)` THENL
9117 [ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN
9118 ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN
9119 REPEAT STRIP_TAC THENL
9120 [MATCH_MP_TAC(NORM_ARITH
9121 `norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN
9122 ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH
9123 `(a * u + x) / r:real = a * u / r + x / r`] THEN
9124 MATCH_MP_TAC(REAL_ARITH
9125 `x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN
9126 ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN
9127 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9128 MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
9129 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE];
9132 [`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`;
9133 `vec 0:real^1`; `vec 1:real^1`; `&0`; `1`]
9134 IVT_DECREASING_COMPONENT_1) THEN
9135 REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN
9136 REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN
9137 REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN
9138 REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN
9139 ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN
9141 [REPEAT STRIP_TAC THEN
9142 REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN
9143 REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
9144 REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
9145 REWRITE_TAC[CONTINUOUS_CONST]) THEN
9146 SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN
9147 MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
9148 MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
9149 MATCH_MP_TAC CONTINUOUS_MUL THEN
9150 REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
9152 ASM_SIMP_TAC[DROP_VEC; REAL_FIELD
9153 `&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN
9154 DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN
9155 EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN
9156 CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
9157 ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
9158 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
9159 ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in
9161 (`!a t u v:real^N r.
9162 affine t /\ a IN t /\
9163 u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
9164 ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
9165 (f,g) /\ f(u) = v /\
9166 !x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`,
9168 DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
9169 [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY];
9170 REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9172 MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN
9173 ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
9174 FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN
9175 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9176 MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
9178 MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
9180 EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN
9181 EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN
9182 REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
9183 [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM];
9184 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL
9185 [MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN
9186 ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[];
9187 MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
9190 (`!a t u v:real^N r s.
9191 affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\
9192 u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
9193 ==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\
9194 {x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`,
9195 REPEAT STRIP_TAC THEN
9196 MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`;
9197 `r:real`] lemma2) THEN
9198 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9199 MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
9201 EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN
9202 EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN
9203 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
9204 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
9205 REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN
9207 SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\
9208 (!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))`
9209 STRIP_ASSUME_TAC THENL
9210 [REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN
9211 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
9212 REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN
9213 TRY(X_GEN_TAC `x:real^N` THEN
9214 ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN
9215 MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
9216 REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN
9218 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
9219 EXISTS_TAC `(cball(a,r) INTER t) UNION
9220 ((t:real^N->bool) DIFF ball(a,r))` THEN
9223 MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
9224 ASM SET_TAC[]]) THEN
9225 MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
9226 ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID;
9227 GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN
9228 MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
9229 MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN
9231 REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=>
9232 p /\ q /\ r /\ s ==> t ==> u`] THEN
9233 REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
9234 FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
9235 ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN
9236 MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN
9237 REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL
9238 [X_GEN_TAC `b:real^N` THEN
9239 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9240 ASM_REWRITE_TAC[] THEN
9241 GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
9242 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN
9243 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN
9244 REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9245 ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN
9246 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
9247 MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN
9248 MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[])
9249 [`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN
9250 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
9251 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9252 MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
9254 MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
9256 EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN
9257 EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN
9258 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
9259 [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
9260 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9261 MATCH_MP_TAC BOUNDED_SUBSET THEN
9262 EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION
9263 {x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN
9264 ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[];
9266 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
9267 DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
9268 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
9269 EXISTS_TAC `s INTER ball(a:real^N,r)` THEN
9270 ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
9271 X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
9273 [`a:real^N`; `affine hull s:real^N->bool`;
9274 `a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`]
9276 ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN
9277 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9278 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
9279 ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);;
9281 let HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN = prove
9282 (`!s t x (y:A->real^N) k.
9283 &2 <= aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s /\
9284 s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
9285 FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
9286 pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
9287 ==> ?f g. homeomorphism (t,t) (f,g) /\
9288 (!i. i IN k ==> f(x i) = y i) /\
9289 {x | ~(f x = x /\ g x = x)} SUBSET s /\
9290 bounded {x | ~(f x = x /\ g x = x)}`,
9292 ASM_CASES_TAC `FINITE(k:A->bool)` THEN ASM_REWRITE_TAC[] THEN
9293 SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN POP_ASSUM MP_TAC THEN
9294 SPEC_TAC(`k:A->bool`,`k:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
9296 [GEN_TAC THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
9297 REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
9298 REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY];
9300 MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN STRIP_TAC THEN
9301 X_GEN_TAC `s:real^N->bool` THEN
9302 REWRITE_TAC[PAIRWISE_INSERT; FORALL_IN_INSERT] THEN STRIP_TAC THEN
9303 FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
9304 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9305 MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
9306 STRIP_TAC THEN MP_TAC(ISPECL
9307 [`s DIFF IMAGE (y:A->real^N) k`; `t:real^N->bool`;
9308 `(f:real^N->real^N) ((x:A->real^N) i)`; `(y:A->real^N) i`]
9309 HOMEOMORPHISM_MOVING_POINT_EXISTS) THEN
9311 `affine hull (s DIFF (IMAGE (y:A->real^N) k)) = affine hull s`
9313 [MATCH_MP_TAC AFFINE_HULL_OPEN_IN THEN CONJ_TAC THENL
9314 [TRANS_TAC OPEN_IN_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
9315 MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
9316 MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN
9317 ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[];
9319 REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
9320 DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
9321 FINITE_SUBSET)) THEN
9322 ASM_SIMP_TAC[FINITE_IMAGE; CONNECTED_FINITE_IFF_SING] THEN
9323 UNDISCH_TAC `&2 <= aff_dim(s:real^N->bool)` THEN
9324 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9325 REWRITE_TAC[] THEN STRIP_TAC THEN
9326 ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_SING] THEN
9327 CONV_TAC INT_REDUCE_CONV];
9328 ASM_REWRITE_TAC[]] THEN
9330 [REPEAT CONJ_TAC THENL
9331 [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN
9332 MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
9333 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
9334 MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[];
9336 MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
9337 ASM_REWRITE_TAC[COLLINEAR_AFF_DIM;
9338 INT_ARITH `~(s:int <= &1) <=> &2 <= s`] THEN
9339 MATCH_MP_TAC CARD_LT_FINITE_INFINITE THEN
9340 ASM_SIMP_TAC[FINITE_IMAGE; real_INFINITE];
9341 ALL_TAC; ALL_TAC] THEN
9342 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[IN_DIFF] THEN
9343 (CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF]]) THEN
9344 SIMP_TAC[SET_RULE `~(y IN IMAGE f s) <=> !x. x IN s ==> ~(f x = y)`] THEN
9346 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9347 MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
9348 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
9349 [`(h:real^N->real^N) o (f:real^N->real^N)`;
9350 `(g:real^N->real^N) o (k:real^N->real^N)`] THEN
9351 CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
9352 ASM_SIMP_TAC[o_THM] THEN
9353 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
9354 MATCH_MP_TAC BOUNDED_SUBSET THEN
9355 EXISTS_TAC `{x | ~(f x = x /\ g x = x)} UNION
9356 {x:real^N | ~(h x = x /\ k x = x)}` THEN
9357 ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]]);;
9359 let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove
9360 (`!s t x (y:A->real^N) k.
9361 2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\
9362 FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
9363 pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
9364 ==> ?f g. homeomorphism (t,t) (f,g) /\
9365 (!i. i IN k ==> f(x i) = y i) /\
9366 {x | ~(f x = x /\ g x = x)} SUBSET s /\
9367 bounded {x | ~(f x = x /\ g x = x)}`,
9368 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
9369 [STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
9370 REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
9371 REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY] THEN ASM SET_TAC[];
9373 MATCH_MP_TAC HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN THEN
9374 ASM_REWRITE_TAC[] THEN
9375 ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
9376 SUBGOAL_THEN `affine hull s = (:real^N)` SUBST1_TAC THENL
9377 [MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM SET_TAC[];
9378 ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFF_DIM_UNIV] THEN
9379 ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBSET_UNIV]]);;
9381 let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove
9382 (`!u s t k:real^N->bool.
9383 open u /\ open s /\ connected s /\ ~(u = {}) /\
9384 FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
9385 ==> ?f g. homeomorphism (t,t) (f,g) /\
9386 {x | ~(f x = x /\ g x = x)} SUBSET s /\
9387 bounded {x | ~(f x = x /\ g x = x)} /\
9388 !x. x IN k ==> (f x) IN u`,
9390 (`!a b:real^1 c d:real^1.
9391 drop a < drop b /\ drop c < drop d
9392 ==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\
9393 f(a) = c /\ f(b) = d`,
9394 REPEAT STRIP_TAC THEN EXISTS_TAC
9395 `\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN
9396 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ;
9397 REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN
9398 CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
9399 MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
9400 REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
9401 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
9402 MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
9403 REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN
9404 MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
9405 REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
9406 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
9407 REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN
9408 ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD
9410 ==> (x = c + (y - a) / (b - a) * (d - c) <=>
9411 a + (x - c) / (d - c) * (b - a) = y)`] THEN
9412 REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN
9413 REWRITE_TAC[REAL_ARITH
9414 `c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN
9415 ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
9416 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
9418 ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
9419 REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`;
9420 REAL_ARITH `x - a:real = y - a <=> x = y`;
9421 VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN
9422 ASM_MESON_TAC[REAL_LT_REFL]]) in
9424 (`!a b c:real^1 u v w:real^1 f1 g1 f2 g2.
9425 homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\
9426 homeomorphism (interval[b,c],interval[v,w]) (f2,g2)
9427 ==> b IN interval[a,c] /\ v IN interval[u,w] /\
9428 f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w
9429 ==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\
9430 f a = u /\ f c = w /\
9431 (!x. x IN interval[a,b] ==> f x = f1 x) /\
9432 (!x. x IN interval[b,c] ==> f x = f2 x)`,
9433 REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM
9434 (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN
9435 EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x
9437 ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN
9438 ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN
9439 CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN
9440 MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
9441 REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
9442 [MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
9443 ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN
9445 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9446 CONTINUOUS_ON_SUBSET)) THEN
9447 SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1];
9449 `interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\
9450 interval[u:real^1,w] = interval[u,v] UNION interval[v,w]`
9451 (CONJUNCTS_THEN SUBST1_TAC) THENL
9452 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
9454 REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th ->
9455 GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
9456 MATCH_MP_TAC(SET_RULE
9457 `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
9458 SIMP_TAC[IN_INTERVAL_1; REAL_ARITH
9459 `b <= c ==> (c <= b <=> c = b)`] THEN
9460 ASM_MESON_TAC[DROP_EQ]];
9461 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
9462 REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
9463 REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN
9464 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
9465 ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL
9466 [COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
9467 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN
9470 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9471 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL
9472 [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN
9474 SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]`
9476 [REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
9477 [ALL_TAC; ASM_REWRITE_TAC[]] THEN
9478 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
9479 MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
9482 REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP
9483 (REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN
9484 REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN
9486 `(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b`
9487 MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9488 MATCH_MP_TAC(MESON[]
9489 `!g1:real^1->real^1 g2:real^1->real^1.
9490 g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b
9491 ==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN
9492 MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN
9493 REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9494 ASM_REAL_ARITH_TAC]) in
9496 (`!a b c d u v:real^1.
9497 interval[c,d] SUBSET interval(a,b) /\
9498 interval[u,v] SUBSET interval(a,b) /\
9499 ~(interval(c,d) = {}) /\ ~(interval(u,v) = {})
9500 ==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\
9501 f a = a /\ f b = b /\
9502 !x. x IN interval[c,d] ==> f(x) IN interval[u,v]`,
9504 REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
9505 ASM_CASES_TAC `drop u < drop v` THEN
9506 ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN
9507 ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL
9508 [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9509 REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN
9510 REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM];
9511 RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN
9512 ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN
9513 MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN
9514 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9515 MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN
9516 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9517 MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN
9518 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9519 MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN
9520 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9521 MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN
9522 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9523 MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN
9524 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9525 GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
9526 ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN
9527 ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
9528 MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN
9529 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9530 GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN
9531 ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
9532 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9533 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN
9534 DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
9535 X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN
9536 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
9537 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN
9538 SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL
9539 [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in
9541 (`!s k u t:real^1->bool.
9542 open u /\ open s /\ connected s /\ ~(u = {}) /\
9543 FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
9544 ==> ?f g. homeomorphism (t,t) (f,g) /\
9545 (!x. x IN k ==> f(x) IN u) /\
9546 {x | ~(f x = x /\ g x = x)} SUBSET s /\
9547 bounded {x | ~(f x = x /\ g x = x)}`,
9548 REPEAT STRIP_TAC THEN
9550 `?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u`
9551 STRIP_ASSUME_TAC THENL
9552 [UNDISCH_TAC `open(u:real^1->bool)` THEN
9553 REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
9554 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
9555 DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN
9556 DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN
9557 ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[];
9560 `?a b:real^1. ~(interval(a,b) = {}) /\
9561 k SUBSET interval[a,b] /\
9562 interval[a,b] SUBSET s`
9563 STRIP_ASSUME_TAC THENL
9564 [ASM_CASES_TAC `k:real^1->bool = {}` THENL
9565 [ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN
9566 MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN
9567 MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN
9568 ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY;
9569 IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
9570 DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN
9571 DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN
9572 UNDISCH_TAC `open(s:real^1->bool)` THEN
9573 REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
9574 DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN
9575 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
9576 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
9577 REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN
9578 MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN
9579 REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o
9580 GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
9581 REWRITE_TAC[IS_INTERVAL_1] THEN
9582 ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS;
9583 REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL];
9586 `?w z:real^1. interval[w,z] SUBSET s /\
9587 interval[a,b] UNION interval[c,d] SUBSET interval(w,z)`
9588 STRIP_ASSUME_TAC THENL
9590 `?w z:real^1. interval[w,z] SUBSET s /\
9591 interval[a,b] UNION interval[c,d] SUBSET interval[w,z]`
9592 STRIP_ASSUME_TAC THENL
9593 [EXISTS_TAC `lift(min (drop a) (drop c))` THEN
9594 EXISTS_TAC `lift(max (drop b) (drop d))` THEN
9595 REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN
9597 [FIRST_X_ASSUM(MP_TAC o
9598 GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
9599 REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN
9600 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9601 EXISTS_TAC `lift(min (drop a) (drop c))` THEN
9602 EXISTS_TAC `lift(max (drop b) (drop d))` THEN
9603 ASM_REWRITE_TAC[LIFT_DROP] THEN
9604 REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN
9605 COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN
9606 ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1;
9608 ASM_REAL_ARITH_TAC];
9609 UNDISCH_TAC `open(s:real^1->bool)` THEN
9610 REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th ->
9611 MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN
9612 SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]`
9613 STRIP_ASSUME_TAC THENL
9614 [REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC
9615 (ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
9617 REWRITE_TAC[UNION_SUBSET]] THEN
9618 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
9619 MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN
9620 REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN
9621 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
9622 MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN
9623 STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN
9625 (REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1;
9626 UNION_SUBSET; SUBSET_INTERVAL_1]) THEN
9627 CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
9628 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN
9629 X_GEN_TAC `x:real^1` THEN
9630 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
9631 ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN
9632 ASM_REAL_ARITH_TAC];
9634 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN
9636 [`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`]
9638 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9639 MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
9640 REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
9641 EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN
9642 EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN
9643 ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN
9644 REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
9653 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN
9654 REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN
9656 `t = interval[w:real^1,z] UNION (t DIFF interval(w,z))`
9657 (fun th -> SUBST1_TAC th THEN
9658 MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
9660 THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
9661 ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL
9662 [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
9664 MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
9665 MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN
9667 REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE
9668 `p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN
9669 MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`])
9670 (CONJUNCTS ENDS_IN_INTERVAL) THEN
9672 REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL
9674 [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
9675 ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN
9676 REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
9677 X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN
9678 MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
9679 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9680 X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
9682 [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
9683 `y:real^N->real^N`; `k:real^N->bool`]
9684 HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN
9685 ASM_REWRITE_TAC[pairwise] THEN
9686 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9687 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
9688 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
9690 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN
9691 SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN
9692 REWRITE_TAC[GSYM DIMINDEX_1] THEN
9693 DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN
9694 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9695 MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
9696 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9698 [`IMAGE (h:real^N->real^1) s`;
9699 `IMAGE (h:real^N->real^1) k`;
9700 `IMAGE (h:real^N->real^1) u`;
9701 `IMAGE (h:real^N->real^1) t`]
9703 ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY;
9704 CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN
9706 [ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];
9707 REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
9708 MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
9709 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
9710 [`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`;
9711 `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN
9712 ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN
9713 ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN
9714 ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN
9715 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9717 `{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} =
9718 IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
9719 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9720 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9721 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
9722 ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);;
9724 let HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN = prove
9725 (`!u s t k:real^N->bool.
9726 open_in (subtopology euclidean (affine hull s)) s /\
9727 s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
9728 FINITE k /\ k SUBSET s /\
9729 open_in (subtopology euclidean s) u /\ ~(u = {})
9730 ==> ?f g. homeomorphism (t,t) (f,g) /\
9731 (!x. x IN k ==> f(x) IN u) /\
9732 {x | ~(f x = x /\ g x = x)} SUBSET s /\
9733 bounded {x | ~(f x = x /\ g x = x)}`,
9734 REPEAT STRIP_TAC THEN ASM_CASES_TAC `&2 <= aff_dim(s:real^N->bool)` THENL
9736 [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
9738 [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM INFINITE] THEN
9739 MATCH_MP_TAC INFINITE_OPEN_IN THEN
9740 EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL
9741 [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
9742 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
9743 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
9744 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9745 MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
9746 ASM_SIMP_TAC[CONVEX_CONNECTED; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX;
9747 AFF_DIM_AFFINE_HULL] THEN
9748 CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
9749 ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET];
9750 REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
9751 X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC
9752 (ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
9753 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9754 X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
9756 [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
9757 `y:real^N->real^N`; `k:real^N->bool`]
9758 HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN) THEN
9759 ASM_REWRITE_TAC[pairwise] THEN
9760 REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
9761 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9762 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
9763 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
9765 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_NOT_LE])] THEN
9766 SIMP_TAC[AFF_DIM_GE; INT_ARITH
9767 `--(&1):int <= x ==> (x < &2 <=> x = --(&1) \/ x = &0 \/ x = &1)`] THEN
9768 REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
9770 `(u:real^N->bool) SUBSET s /\ s SUBSET affine hull s`
9771 STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
9772 DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
9774 [REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
9775 REWRITE_TAC[HOMEOMORPHISM_I; I_THM; EMPTY_GSPEC; BOUNDED_EMPTY] THEN
9778 MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`]
9779 HOMEOMORPHIC_AFFINE_SETS) THEN
9780 ASM_REWRITE_TAC[AFF_DIM_UNIV; AFFINE_AFFINE_HULL; AFFINE_UNIV] THEN
9781 ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_AFFINE_HULL] THEN
9782 REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
9783 MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
9784 STRIP_TAC THEN MP_TAC(ISPECL
9785 [`IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) s`;
9786 `IMAGE (h:real^N->real^1) t`; `IMAGE (h:real^N->real^1) k`]
9787 HOMEOMORPHISM_GROUPING_POINTS_EXISTS) THEN
9788 ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY] THEN
9791 [`h:real^N->real^1`; `j:real^1->real^N`;
9792 `affine hull s:real^N->bool`; `(:real^1)`]
9793 HOMEOMORPHISM_IMP_OPEN_MAP) THEN
9794 ASM_SIMP_TAC[homeomorphism; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
9795 REPEAT STRIP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
9796 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
9797 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
9798 REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
9799 MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
9800 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
9801 [`\x. if x IN affine hull s
9802 then ((j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)) x
9804 `\x. if x IN affine hull s
9805 then ((j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)) x
9807 ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
9809 ASM_SIMP_TAC[SET_RULE
9810 `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
9811 REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
9812 ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
9813 MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
9814 `(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)` THEN
9815 REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9816 REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
9817 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9818 CONTINUOUS_ON_SUBSET)) THEN
9821 ASM_SIMP_TAC[SET_RULE
9822 `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
9823 REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
9824 ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
9825 MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
9826 `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)` THEN
9827 REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9828 REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
9829 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9830 CONTINUOUS_ON_SUBSET)) THEN
9835 REWRITE_TAC[MESON[] `(if P then f x else x) = x <=> ~P \/ f x = x`] THEN
9836 REWRITE_TAC[DE_MORGAN_THM; GSYM LEFT_OR_DISTRIB] THEN
9838 `{x | x IN affine hull s /\ (~(j (f (h x)) = x) \/ ~(j (g (h x)) = x))} =
9839 IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
9840 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC])
9842 [TRANS_TAC SUBSET_TRANS
9843 `IMAGE (j:real^1->real^N) (IMAGE (h:real^N->real^1) s)` THEN
9845 MATCH_MP_TAC(MESON[CLOSURE_SUBSET; BOUNDED_SUBSET; IMAGE_SUBSET]
9846 `bounded (IMAGE f (closure s)) ==> bounded (IMAGE f s)`) THEN
9847 MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
9848 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
9849 ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
9850 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]);;
9852 (* ------------------------------------------------------------------------- *)
9853 (* The "inside" and "outside" of a set, i.e. the points respectively in a *)
9854 (* bounded or unbounded connected component of the set's complement. *)
9855 (* ------------------------------------------------------------------------- *)
9857 let inside = new_definition
9858 `inside s = {x | ~(x IN s) /\
9859 bounded(connected_component ((:real^N) DIFF s) x)}`;;
9861 let outside = new_definition
9862 `outside s = {x | ~(x IN s) /\
9863 ~bounded(connected_component ((:real^N) DIFF s) x)}`;;
9865 let INSIDE_TRANSLATION = prove
9866 (`!a s. inside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (inside s)`,
9867 REWRITE_TAC[inside] THEN GEOM_TRANSLATE_TAC[]);;
9869 let OUTSIDE_TRANSLATION = prove
9870 (`!a s. outside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (outside s)`,
9871 REWRITE_TAC[outside] THEN GEOM_TRANSLATE_TAC[]);;
9873 add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];;
9875 let INSIDE_LINEAR_IMAGE = prove
9876 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
9877 ==> inside(IMAGE f s) = IMAGE f (inside s)`,
9878 REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);;
9880 let OUTSIDE_LINEAR_IMAGE = prove
9881 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
9882 ==> outside(IMAGE f s) = IMAGE f (outside s)`,
9883 REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);;
9885 add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];;
9888 (`!s. outside s = {x | ~bounded(connected_component((:real^N) DIFF s) x)}`,
9889 GEN_TAC THEN REWRITE_TAC[outside; EXTENSION; IN_ELIM_THM] THEN
9890 X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
9891 ASM_REWRITE_TAC[] THEN
9892 ASM_MESON_TAC[BOUNDED_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF]);;
9894 let INSIDE_NO_OVERLAP = prove
9895 (`!s. inside s INTER s = {}`,
9896 REWRITE_TAC[inside] THEN SET_TAC[]);;
9898 let OUTSIDE_NO_OVERLAP = prove
9899 (`!s. outside s INTER s = {}`,
9900 REWRITE_TAC[outside] THEN SET_TAC[]);;
9902 let INSIDE_INTER_OUTSIDE = prove
9903 (`!s. inside s INTER outside s = {}`,
9904 REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
9906 let INSIDE_UNION_OUTSIDE = prove
9907 (`!s. inside s UNION outside s = (:real^N) DIFF s`,
9908 REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
9910 let INSIDE_EQ_OUTSIDE = prove
9911 (`!s. inside s = outside s <=> s = (:real^N)`,
9912 REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
9914 let INSIDE_OUTSIDE = prove
9915 (`!s. inside s = (:real^N) DIFF (s UNION outside s)`,
9916 GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
9917 [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
9920 let OUTSIDE_INSIDE = prove
9921 (`!s. outside s = (:real^N) DIFF (s UNION inside s)`,
9922 GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
9923 [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
9926 let UNION_WITH_INSIDE = prove
9927 (`!s. s UNION inside s = (:real^N) DIFF outside s`,
9928 REWRITE_TAC[OUTSIDE_INSIDE] THEN SET_TAC[]);;
9930 let UNION_WITH_OUTSIDE = prove
9931 (`!s. s UNION outside s = (:real^N) DIFF inside s`,
9932 REWRITE_TAC[INSIDE_OUTSIDE] THEN SET_TAC[]);;
9934 let OUTSIDE_MONO = prove
9935 (`!s t. s SUBSET t ==> outside t SUBSET outside s`,
9936 REPEAT GEN_TAC THEN REWRITE_TAC[OUTSIDE; SUBSET; IN_ELIM_THM] THEN
9937 DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
9938 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
9939 MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;
9941 let INSIDE_MONO = prove
9942 (`!s t. s SUBSET t ==> inside s DIFF t SUBSET inside t`,
9943 REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; IN_DIFF; inside; IN_ELIM_THM] THEN
9945 DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)
9947 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
9948 MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;
9950 let COBOUNDED_OUTSIDE = prove
9951 (`!s:real^N->bool. bounded s ==> bounded((:real^N) DIFF outside s)`,
9952 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[outside] THEN
9953 REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~(x IN s) /\ ~P x} =
9954 s UNION {x | P x}`] THEN
9955 ASM_REWRITE_TAC[BOUNDED_UNION] THEN
9956 FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
9957 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
9958 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,B)` THEN
9959 REWRITE_TAC[BOUNDED_BALL; SUBSET; IN_ELIM_THM; IN_BALL_0] THEN
9960 X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9961 REWRITE_TAC[REAL_NOT_LT] THEN
9962 ASM_CASES_TAC `x:real^N = vec 0` THENL
9963 [ASM_REWRITE_TAC[NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
9964 REWRITE_TAC[BOUNDED_POS] THEN
9965 DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
9966 FIRST_X_ASSUM(MP_TAC o SPEC `(B + C) / norm(x) % x:real^N`) THEN
9967 REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
9968 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN
9969 CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
9970 REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
9971 EXISTS_TAC `segment[x:real^N,(B + C) / norm(x) % x]` THEN
9972 REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
9973 MATCH_MP_TAC SUBSET_TRANS THEN
9974 EXISTS_TAC `(:real^N) DIFF ball(vec 0,B)` THEN
9975 ASM_REWRITE_TAC[SET_RULE
9976 `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
9977 REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL_0] THEN
9978 REWRITE_TAC[segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
9979 STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
9980 REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_ASSOC] THEN
9981 GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN
9982 REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH
9983 `&0 < B /\ B <= x ==> B <= abs x`) THEN
9984 ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; GSYM
9985 REAL_MUL_ASSOC] THEN
9986 MATCH_MP_TAC REAL_LE_TRANS THEN
9987 EXISTS_TAC `(&1 - u) * B + u * (B + C)` THEN
9988 ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE] THEN
9989 SIMP_TAC[REAL_ARITH `B <= (&1 - u) * B + u * (B + C) <=> &0 <= u * C`] THEN
9990 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);;
9992 let UNBOUNDED_OUTSIDE = prove
9993 (`!s:real^N->bool. bounded s ==> ~bounded(outside s)`,
9994 MESON_TAC[COBOUNDED_IMP_UNBOUNDED; COBOUNDED_OUTSIDE]);;
9996 let BOUNDED_INSIDE = prove
9997 (`!s:real^N->bool. bounded s ==> bounded(inside s)`,
9998 REPEAT STRIP_TAC THEN
9999 MATCH_MP_TAC BOUNDED_SUBSET THEN
10000 EXISTS_TAC `(:real^N) DIFF outside s` THEN
10001 ASM_SIMP_TAC[COBOUNDED_OUTSIDE] THEN
10002 MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN SET_TAC[]);;
10004 let CONNECTED_OUTSIDE = prove
10005 (`!s:real^N->bool. 2 <= dimindex(:N) /\ bounded s ==> connected(outside s)`,
10006 REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10007 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
10008 REWRITE_TAC[outside; IN_ELIM_THM] THEN STRIP_TAC THEN
10009 MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
10010 EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
10011 REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THENL
10012 [X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN
10013 FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
10014 CONNECTED_COMPONENT_SUBSET)) THEN
10015 REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
10016 REWRITE_TAC[CONNECTED_COMPONENT_IDEMP] THEN
10017 SUBGOAL_THEN `connected_component ((:real^N) DIFF s) x =
10018 connected_component ((:real^N) DIFF s) y`
10020 [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
10021 ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`];
10022 ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]]);;
10024 let OUTSIDE_CONNECTED_COMPONENT_LT = prove
10026 {x | !B. ?y. B < norm(y) /\
10027 connected_component((:real^N) DIFF s) x y}`,
10028 REWRITE_TAC[OUTSIDE; bounded; EXTENSION; IN_ELIM_THM] THEN
10029 REWRITE_TAC[IN] THEN ASM_MESON_TAC[REAL_NOT_LE]);;
10031 let OUTSIDE_CONNECTED_COMPONENT_LE = prove
10033 {x | !B. ?y. B <= norm(y) /\
10034 connected_component((:real^N) DIFF s) x y}`,
10035 GEN_TAC THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT] THEN
10036 GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
10037 REWRITE_TAC[IN_ELIM_THM] THEN
10038 MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;
10040 let NOT_OUTSIDE_CONNECTED_COMPONENT_LT = prove
10041 (`!s. 2 <= dimindex(:N) /\ bounded s
10042 ==> (:real^N) DIFF (outside s) =
10043 {x | !B. ?y. B < norm(y) /\
10044 ~(connected_component((:real^N) DIFF s) x y)}`,
10045 REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE] THEN
10046 REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
10047 X_GEN_TAC `x:real^N` THEN REWRITE_TAC[bounded] THEN EQ_TAC THENL
10048 [DISCH_THEN(X_CHOOSE_TAC `C:real`) THEN X_GEN_TAC `B:real` THEN
10049 EXISTS_TAC `(abs B + abs C + &1) % basis 1:real^N` THEN
10050 RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN
10051 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10052 CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN
10053 SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
10056 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
10057 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN
10058 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN
10059 ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
10060 FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN DISCH_THEN
10061 (X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
10062 REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
10063 EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN
10064 MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
10065 EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
10066 ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL_0; IN_UNIV; CONTRAPOS_THM] THEN
10067 REWRITE_TAC[connected_component] THEN
10068 EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
10069 ASM_SIMP_TAC[SUBSET_REFL; IN_DIFF; IN_UNIV; IN_CBALL_0; REAL_NOT_LE] THEN
10070 MATCH_MP_TAC CONNECTED_COMPLEMENT_BOUNDED_CONVEX THEN
10071 ASM_SIMP_TAC[BOUNDED_CBALL; CONVEX_CBALL]]);;
10073 let NOT_OUTSIDE_CONNECTED_COMPONENT_LE = prove
10074 (`!s. 2 <= dimindex(:N) /\ bounded s
10075 ==> (:real^N) DIFF (outside s) =
10076 {x | !B. ?y. B <= norm(y) /\
10077 ~(connected_component((:real^N) DIFF s) x y)}`,
10078 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN
10079 GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
10080 REWRITE_TAC[IN_ELIM_THM] THEN
10081 MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;
10083 let INSIDE_CONNECTED_COMPONENT_LT = prove
10084 (`!s. 2 <= dimindex(:N) /\ bounded s
10086 {x:real^N | ~(x IN s) /\
10087 !B. ?y. B < norm(y) /\
10088 ~(connected_component((:real^N) DIFF s) x y)}`,
10089 REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
10090 REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
10091 ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN SET_TAC[]);;
10093 let INSIDE_CONNECTED_COMPONENT_LE = prove
10094 (`!s. 2 <= dimindex(:N) /\ bounded s
10096 {x:real^N | ~(x IN s) /\
10097 !B. ?y. B <= norm(y) /\
10098 ~(connected_component((:real^N) DIFF s) x y)}`,
10099 REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
10100 REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
10101 ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LE] THEN SET_TAC[]);;
10103 let OUTSIDE_UNION_OUTSIDE_UNION = prove
10104 (`!c c1 c2:real^N->bool.
10105 c INTER outside(c1 UNION c2) = {}
10106 ==> outside(c1 UNION c2) SUBSET outside(c1 UNION c)`,
10107 REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
10108 X_GEN_TAC `x:real^N` THEN
10109 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
10110 REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT; IN_ELIM_THM] THEN
10111 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `B:real` THEN
10112 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
10113 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10114 ASM_REWRITE_TAC[connected_component] THEN
10115 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
10116 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10117 SUBGOAL_THEN `t SUBSET outside(c1 UNION c2:real^N->bool)`
10118 MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10119 MATCH_MP_TAC SUBSET_TRANS THEN
10120 EXISTS_TAC `connected_component((:real^N) DIFF (c1 UNION c2)) x` THEN
10121 CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]; ALL_TAC] THEN
10122 UNDISCH_TAC `(x:real^N) IN outside(c1 UNION c2)` THEN
10123 REWRITE_TAC[OUTSIDE; IN_ELIM_THM; SUBSET] THEN
10124 MESON_TAC[CONNECTED_COMPONENT_EQ]);;
10126 let INSIDE_SUBSET = prove
10127 (`!s t u. connected u /\ ~bounded u /\ t UNION u = (:real^N) DIFF s
10128 ==> inside s SUBSET t`,
10129 REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
10130 X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
10131 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
10132 UNDISCH_TAC `~bounded(u:real^N->bool)` THEN REWRITE_TAC[] THEN
10133 MATCH_MP_TAC BOUNDED_SUBSET THEN
10134 EXISTS_TAC `connected_component((:real^N) DIFF s) x` THEN
10135 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
10136 ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
10138 let INSIDE_UNIQUE = prove
10139 (`!s t u. connected t /\ bounded t /\
10140 connected u /\ ~(bounded u) /\
10141 ~connected((:real^N) DIFF s) /\
10142 t UNION u = (:real^N) DIFF s
10144 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
10145 [ASM_MESON_TAC[INSIDE_SUBSET]; ALL_TAC] THEN
10146 REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
10147 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10148 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10149 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN
10150 ASM_REWRITE_TAC[] THEN
10151 MATCH_MP_TAC(SET_RULE
10152 `!s u. c INTER s = {} /\ c INTER u = {} /\ t UNION u = UNIV DIFF s
10153 ==> c SUBSET t`) THEN
10154 MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
10155 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
10156 [REWRITE_TAC[SET_RULE `c INTER s = {} <=> c SUBSET (UNIV DIFF s)`] THEN
10157 REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
10159 MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t = {}`) THEN
10160 X_GEN_TAC `y:real^N` THEN
10161 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [IN] THEN STRIP_TAC THEN
10162 UNDISCH_TAC `~connected((:real^N) DIFF s)` THEN
10163 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10164 MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
10166 `(!w. w IN t ==> connected_component ((:real^N) DIFF s) x w) /\
10167 (!w. w IN u ==> connected_component ((:real^N) DIFF s) y w)`
10168 STRIP_ASSUME_TAC THENL
10169 [CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
10170 REWRITE_TAC[connected_component] THENL
10171 [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `u:real^N->bool`] THEN
10172 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
10173 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_UNION] THEN
10174 ASM_REWRITE_TAC[] THEN
10175 ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]]);;
10177 let INSIDE_OUTSIDE_UNIQUE = prove
10178 (`!s t u. connected t /\ bounded t /\
10179 connected u /\ ~(bounded u) /\
10180 ~connected((:real^N) DIFF s) /\
10181 t UNION u = (:real^N) DIFF s
10182 ==> inside s = t /\ outside s = u`,
10183 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
10184 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
10185 [ASM_MESON_TAC[INSIDE_UNIQUE];
10186 MP_TAC(ISPEC `(:real^N) DIFF s` INSIDE_NO_OVERLAP) THEN
10187 SUBGOAL_THEN `t INTER u:real^N->bool = {}` MP_TAC THENL
10188 [ALL_TAC; ASM SET_TAC[]] THEN
10189 UNDISCH_TAC `~connected ((:real^N) DIFF s)` THEN
10190 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
10191 FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN
10192 REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_UNION THEN
10193 ASM_REWRITE_TAC[]]);;
10195 let INTERIOR_INSIDE_FRONTIER = prove
10196 (`!s:real^N->bool. bounded s ==> interior s SUBSET inside(frontier s)`,
10197 REPEAT STRIP_TAC THEN REWRITE_TAC[inside; SUBSET; IN_ELIM_THM] THEN
10198 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10199 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
10200 [ASM_REWRITE_TAC[frontier; IN_DIFF]; DISCH_TAC] THEN
10201 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
10202 ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10203 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
10204 SUBGOAL_THEN `~(connected_component((:real^N) DIFF frontier s) x INTER
10207 [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
10208 REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; GSYM MEMBER_NOT_EMPTY] THEN
10209 CONJ_TAC THENL [REWRITE_TAC[IN_INTER]; ASM SET_TAC[]] THEN
10210 EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL
10211 [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
10212 GEN_REWRITE_TAC I [GSYM IN] THEN ASM SET_TAC[];
10213 ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]];
10214 REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN
10215 REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;
10217 let INSIDE_EMPTY = prove
10219 REWRITE_TAC[inside; NOT_IN_EMPTY; DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
10220 REWRITE_TAC[NOT_BOUNDED_UNIV; EMPTY_GSPEC]);;
10222 let OUTSIDE_EMPTY = prove
10223 (`outside {} = (:real^N)`,
10224 REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_EMPTY] THEN SET_TAC[]);;
10226 let INSIDE_SAME_COMPONENT = prove
10227 (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN inside s
10228 ==> y IN inside s`,
10229 REPEAT GEN_TAC THEN
10230 DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
10232 REWRITE_TAC[inside; IN_ELIM_THM] THEN
10233 FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
10234 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10235 FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
10236 SIMP_TAC[IN_DIFF]);;
10238 let OUTSIDE_SAME_COMPONENT = prove
10239 (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN outside s
10240 ==> y IN outside s`,
10241 REPEAT GEN_TAC THEN
10242 DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
10244 REWRITE_TAC[outside; IN_ELIM_THM] THEN
10245 FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
10246 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10247 FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
10248 SIMP_TAC[IN_DIFF]);;
10250 let OUTSIDE_CONVEX = prove
10251 (`!s. convex s ==> outside s = (:real^N) DIFF s`,
10252 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ;
10253 REWRITE_RULE[SET_RULE `t INTER s = {} <=> t SUBSET UNIV DIFF s`]
10254 OUTSIDE_NO_OVERLAP] THEN
10255 REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN
10256 MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[OUTSIDE_EMPTY; IN_UNIV] THEN
10257 X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN
10258 X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN
10259 MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT t)`) THEN
10260 SPEC_TAC(`(vec 0:real^N) INSERT t`,`s:real^N->bool`) THEN
10261 GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN
10262 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10263 ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN
10264 SUBGOAL_THEN `~(x:real^N = vec 0)` ASSUME_TAC THENL
10265 [ASM_MESON_TAC[]; ALL_TAC] THEN
10266 REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN
10267 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10268 DISCH_THEN(MP_TAC o SPEC `(max (&2) ((B + &1) / norm(x))) % x:real^N`) THEN
10269 REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
10270 [REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
10271 EXISTS_TAC `segment[x:real^N,(max (&2) ((B + &1) / norm(x))) % x]` THEN
10272 REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
10273 REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
10274 ASM_CASES_TAC `u = &0` THEN
10275 ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_RZERO;
10276 VECTOR_ADD_RID; IN_DIFF; IN_UNIV] THEN
10278 REWRITE_TAC[VECTOR_ARITH `a % x + b % c % x:real^N = (a + b * c) % x`] THEN
10279 ABBREV_TAC `c = &1 - u + u * max (&2) ((B + &1) / norm(x:real^N))` THEN
10280 DISCH_TAC THEN SUBGOAL_THEN `&1 < c` ASSUME_TAC THENL
10281 [EXPAND_TAC "c" THEN
10282 REWRITE_TAC[REAL_ARITH `&1 < &1 - u + u * x <=> &0 < u * (x - &1)`] THEN
10283 MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
10284 UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN
10285 SUBGOAL_THEN `x:real^N = (&1 - inv c) % vec 0 + inv c % c % x`
10287 [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_ASSOC] THEN
10288 ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < x ==> ~(x = &0)`] THEN
10289 REWRITE_TAC[VECTOR_MUL_LID];
10290 MATCH_MP_TAC IN_CONVEX_SET THEN
10291 ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_LT_IMP_LE] THEN
10292 ASM_REAL_ARITH_TAC]];
10293 ASM_SIMP_TAC[NORM_MUL; REAL_NOT_LE; GSYM REAL_LT_LDIV_EQ; NORM_POS_LT] THEN
10294 MATCH_MP_TAC(REAL_ARITH `&0 < b /\ b < c ==> b < abs(max (&2) c)`) THEN
10295 ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_DIV2_EQ] THEN
10298 let INSIDE_CONVEX = prove
10299 (`!s. convex s ==> inside s = {}`,
10300 SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_CONVEX] THEN SET_TAC[]);;
10302 let OUTSIDE_SUBSET_CONVEX = prove
10303 (`!s t. convex t /\ s SUBSET t ==> (:real^N) DIFF t SUBSET outside s`,
10304 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
10305 EXISTS_TAC `outside(t:real^N->bool)` THEN
10306 ASM_SIMP_TAC[OUTSIDE_MONO] THEN
10307 ASM_SIMP_TAC[OUTSIDE_CONVEX; SUBSET_REFL]);;
10309 let OUTSIDE_FRONTIER_MISSES_CLOSURE = prove
10310 (`!s. bounded s ==> outside(frontier s) SUBSET (:real^N) DIFF closure s`,
10311 REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
10312 SIMP_TAC[SET_RULE `(UNIV DIFF s) SUBSET (UNIV DIFF t) <=> t SUBSET s`] THEN
10313 REWRITE_TAC[frontier] THEN
10314 MATCH_MP_TAC(SET_RULE
10315 `i SUBSET ins ==> c SUBSET (c DIFF i) UNION ins`) THEN
10316 ASM_SIMP_TAC[GSYM frontier; INTERIOR_INSIDE_FRONTIER]);;
10318 let OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE = prove
10319 (`!s. bounded s /\ convex s
10320 ==> outside(frontier s) = (:real^N) DIFF closure s`,
10321 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
10322 ASM_SIMP_TAC[OUTSIDE_FRONTIER_MISSES_CLOSURE] THEN
10323 MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
10324 ASM_SIMP_TAC[CONVEX_CLOSURE; frontier] THEN SET_TAC[]);;
10326 let INSIDE_FRONTIER_EQ_INTERIOR = prove
10328 bounded s /\ convex s ==> inside(frontier s) = interior s`,
10329 REPEAT STRIP_TAC THEN
10330 ASM_SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE] THEN
10331 REWRITE_TAC[frontier] THEN
10332 MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
10333 [CLOSURE_SUBSET; INTERIOR_SUBSET] THEN
10336 let OPEN_INSIDE = prove
10337 (`!s:real^N->bool. closed s ==> open(inside s)`,
10338 REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
10339 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10340 SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
10341 [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
10342 REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
10344 [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
10345 GEN_REWRITE_TAC I [GSYM IN] THEN
10346 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
10347 MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN
10349 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
10350 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
10351 X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10352 MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
10353 EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
10354 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10355 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;
10357 let OPEN_OUTSIDE = prove
10358 (`!s:real^N->bool. closed s ==> open(outside s)`,
10359 REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
10360 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10361 SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
10362 [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
10363 REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
10365 [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
10366 GEN_REWRITE_TAC I [GSYM IN] THEN
10367 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
10368 MP_TAC(ISPEC `s:real^N->bool` OUTSIDE_NO_OVERLAP) THEN
10370 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
10371 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
10372 X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10373 MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
10374 EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
10375 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10376 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;
10378 let CLOSURE_INSIDE_SUBSET = prove
10379 (`!s:real^N->bool. closed s ==> closure(inside s) SUBSET s UNION inside s`,
10380 REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
10381 ASM_SIMP_TAC[closed; GSYM OUTSIDE_INSIDE; OPEN_OUTSIDE] THEN SET_TAC[]);;
10383 let FRONTIER_INSIDE_SUBSET = prove
10384 (`!s:real^N->bool. closed s ==> frontier(inside s) SUBSET s`,
10385 REPEAT STRIP_TAC THEN
10386 ASM_SIMP_TAC[frontier; OPEN_INSIDE; INTERIOR_OPEN] THEN
10387 FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN SET_TAC[]);;
10389 let CLOSURE_OUTSIDE_SUBSET = prove
10390 (`!s:real^N->bool. closed s ==> closure(outside s) SUBSET s UNION outside s`,
10391 REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
10392 ASM_SIMP_TAC[closed; GSYM INSIDE_OUTSIDE; OPEN_INSIDE] THEN SET_TAC[]);;
10394 let FRONTIER_OUTSIDE_SUBSET = prove
10395 (`!s:real^N->bool. closed s ==> frontier(outside s) SUBSET s`,
10396 REPEAT STRIP_TAC THEN
10397 ASM_SIMP_TAC[frontier; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
10398 FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_OUTSIDE_SUBSET) THEN SET_TAC[]);;
10400 let INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY = prove
10401 (`!s. connected((:real^N) DIFF s) /\ ~bounded((:real^N) DIFF s)
10402 ==> inside s = {}`,
10403 REWRITE_TAC[inside; CONNECTED_CONNECTED_COMPONENT_SET] THEN
10404 REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN
10405 SIMP_TAC[IN_ELIM_THM; IN_DIFF; IN_UNIV; TAUT `~(a /\ b) <=> a ==> ~b`]);;
10407 let INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY = prove
10408 (`!s. connected((:real^N) DIFF s) /\ bounded s
10409 ==> inside s = {}`,
10410 MESON_TAC[INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY;
10411 COBOUNDED_IMP_UNBOUNDED]);;
10413 let INSIDE_INSIDE = prove
10414 (`!s t:real^N->bool.
10415 s SUBSET inside t ==> inside s DIFF t SUBSET inside t`,
10416 REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; inside; IN_DIFF; IN_ELIM_THM] THEN
10417 X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
10418 ASM_CASES_TAC `s INTER connected_component ((:real^N) DIFF t) x = {}` THENL
10419 [MATCH_MP_TAC BOUNDED_SUBSET THEN
10420 EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
10421 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
10422 REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN
10423 REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
10424 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10425 `~(s INTER t = {}) ==> ?x. x IN s /\ x IN t`)) THEN
10426 DISCH_THEN(X_CHOOSE_THEN `y:real^N`
10427 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
10428 DISCH_THEN(SUBST_ALL_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
10429 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
10430 DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
10431 ASM_SIMP_TAC[inside; IN_ELIM_THM]]);;
10433 let INSIDE_INSIDE_SUBSET = prove
10434 (`!s:real^N->bool. inside(inside s) SUBSET s`,
10435 GEN_TAC THEN MP_TAC
10436 (ISPECL [`inside s:real^N->bool`; `s:real^N->bool`] INSIDE_INSIDE) THEN
10437 REWRITE_TAC[SUBSET_REFL] THEN
10438 MP_TAC(ISPEC `inside s:real^N->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]);;
10440 let INSIDE_OUTSIDE_INTERSECT_CONNECTED = prove
10441 (`!s t:real^N->bool.
10442 connected t /\ ~(inside s INTER t = {}) /\ ~(outside s INTER t = {})
10443 ==> ~(s INTER t = {})`,
10444 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10445 DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
10446 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
10447 REWRITE_TAC[inside; outside; IN_ELIM_THM] THEN
10448 DISCH_THEN(CONJUNCTS_THEN2
10449 (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC)
10450 (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)) THEN
10452 `connected_component ((:real^N) DIFF s) y =
10453 connected_component ((:real^N) DIFF s) x`
10454 (fun th -> ASM_MESON_TAC[th]) THEN
10455 ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV] THEN
10456 REWRITE_TAC[connected_component] THEN
10457 EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]);;
10459 let OUTSIDE_BOUNDED_NONEMPTY = prove
10460 (`!s:real^N->bool. bounded s ==> ~(outside s = {})`,
10462 DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
10463 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
10464 FIRST_ASSUM(MP_TAC o MATCH_MP
10465 (REWRITE_RULE[IMP_CONJ_ALT] OUTSIDE_SUBSET_CONVEX)) THEN
10466 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
10467 SIMP_TAC[CONVEX_BALL; SUBSET_EMPTY] THEN
10468 REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
10469 MESON_TAC[BOUNDED_BALL; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]);;
10471 let OUTSIDE_COMPACT_IN_OPEN = prove
10472 (`!s t:real^N->bool.
10473 compact s /\ open t /\ s SUBSET t /\ ~(t = {})
10474 ==> ~(outside s INTER t = {})`,
10475 REPEAT GEN_TAC THEN STRIP_TAC THEN
10476 FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY o
10477 MATCH_MP COMPACT_IMP_BOUNDED) THEN
10478 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
10479 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
10480 X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
10481 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10482 ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
10483 MP_TAC(ISPECL [`linepath(a:real^N,b)`; `(:real^N) DIFF t`]
10484 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
10485 REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
10486 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
10487 X_GEN_TAC `g:real^1->real^N` THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
10488 REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_DIFF; INTERIOR_UNIV] THEN
10489 ABBREV_TAC `c:real^N = pathfinish g` THEN STRIP_TAC THEN
10490 SUBGOAL_THEN `frontier t SUBSET (:real^N) DIFF s` MP_TAC THENL
10491 [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
10492 REWRITE_TAC[frontier] THEN
10493 ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[];
10494 REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV]] THEN
10495 DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
10496 DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` OPEN_CONTAINS_CBALL) THEN
10497 ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; IN_DIFF; IN_UNIV] THEN
10498 DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
10499 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
10500 MP_TAC(ISPECL [`c:real^N`; `t:real^N->bool`]
10501 CLOSURE_APPROACHABLE) THEN
10502 RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
10503 ASM_REWRITE_TAC[] THEN
10504 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
10505 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN
10506 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10507 MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
10508 EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
10509 REWRITE_TAC[connected_component] THEN
10510 EXISTS_TAC `path_image(g) UNION segment[c:real^N,d]` THEN
10511 REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN CONJ_TAC THENL
10512 [MATCH_MP_TAC CONNECTED_UNION THEN
10513 ASM_SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY;
10514 CONNECTED_PATH_IMAGE] THEN
10515 EXISTS_TAC `c:real^N` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN
10516 ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
10517 CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]] THEN
10518 REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL
10519 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
10521 ==> (t DELETE c) SUBSET (UNIV DIFF s)
10522 ==> t SUBSET (UNIV DIFF s)`)) THEN
10523 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10524 SUBSET_TRANS)) THEN
10525 SIMP_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
10526 ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET];
10527 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
10528 SUBSET_TRANS)) THEN
10529 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
10530 ASM_SIMP_TAC[CONVEX_CBALL; INSERT_SUBSET; REAL_LT_IMP_LE;
10531 EMPTY_SUBSET; CENTRE_IN_CBALL] THEN
10532 REWRITE_TAC[IN_CBALL] THEN
10533 ASM_MESON_TAC[DIST_SYM; REAL_LT_IMP_LE]]]);;
10535 let INSIDE_INSIDE_COMPACT_CONNECTED = prove
10536 (`!s t:real^N->bool.
10537 closed s /\ compact t /\ s SUBSET inside t /\ connected t
10538 ==> inside s SUBSET inside t`,
10539 REPEAT GEN_TAC THEN
10540 ASM_CASES_TAC `inside t:real^N->bool = {}` THEN
10541 ASM_SIMP_TAC[INSIDE_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET] THEN
10542 SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
10543 [REWRITE_TAC[DIMINDEX_GE_1];
10544 REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN
10545 STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONNECTED_CONVEX_1_GEN] THENL
10546 [ASM_MESON_TAC[INSIDE_CONVEX]; ALL_TAC] THEN
10547 STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_INSIDE) THEN
10548 MATCH_MP_TAC(SET_RULE
10549 `s INTER t = {} ==> s DIFF t SUBSET u ==> s SUBSET u`) THEN
10550 SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
10551 [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_INSIDE];
10553 MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
10554 INSIDE_OUTSIDE_INTERSECT_CONNECTED) THEN
10555 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT
10556 `r /\ q ==> (~p /\ q ==> ~r) ==> p`) THEN
10558 [MP_TAC(ISPEC `t:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[];
10559 ONCE_REWRITE_TAC[INTER_COMM]] THEN
10560 MATCH_MP_TAC INSIDE_OUTSIDE_INTERSECT_CONNECTED THEN
10561 ASM_SIMP_TAC[CONNECTED_OUTSIDE; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THENL
10562 [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OUTSIDE_COMPACT_IN_OPEN THEN
10563 ASM_SIMP_TAC[OPEN_INSIDE; COMPACT_IMP_CLOSED];
10564 MP_TAC(ISPECL [`s UNION t:real^N->bool`; `vec 0:real^N`]
10565 BOUNDED_SUBSET_BALL) THEN
10566 ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
10567 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
10568 MATCH_MP_TAC(SET_RULE
10569 `!u. ~(u = UNIV) /\ UNIV DIFF u SUBSET s /\ UNIV DIFF u SUBSET t
10570 ==> ~(s INTER t = {})`) THEN
10571 EXISTS_TAC `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL
10572 [ASM_MESON_TAC[NOT_BOUNDED_UNIV; BOUNDED_BALL]; ALL_TAC] THEN
10573 CONJ_TAC THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
10574 REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]]);;
10576 let CONNECTED_WITH_INSIDE = prove
10577 (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION inside s)`,
10578 GEN_TAC THEN ASM_CASES_TAC `s UNION inside s = (:real^N)` THEN
10579 ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
10580 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10581 REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
10583 `!x. x IN (s UNION inside s)
10584 ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
10585 t SUBSET (s UNION inside s)`
10587 [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
10588 [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
10589 ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
10590 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10591 `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
10592 DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
10593 MP_TAC(ISPECL [`linepath(a:real^N,b)`; `inside s:real^N->bool`]
10594 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
10595 ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
10596 IN_UNION; OPEN_INSIDE; INTERIOR_OPEN] THEN
10597 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
10598 EXISTS_TAC `pathfinish g :real^N` THEN
10599 EXISTS_TAC `path_image g :real^N->bool` THEN
10600 ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
10601 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
10602 REPEAT STRIP_TAC THENL
10603 [ASM_MESON_TAC[FRONTIER_INSIDE_SUBSET; SUBSET];
10604 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
10606 DISCH_THEN(fun th ->
10607 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10608 MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
10609 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10610 MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
10611 MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
10612 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
10613 ASM_REWRITE_TAC[] THEN
10614 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
10615 EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
10616 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10617 REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
10618 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
10621 let CONNECTED_WITH_OUTSIDE = prove
10622 (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION outside s)`,
10623 GEN_TAC THEN ASM_CASES_TAC `s UNION outside s = (:real^N)` THEN
10624 ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
10625 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10626 REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
10628 `!x. x IN (s UNION outside s)
10629 ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
10630 t SUBSET (s UNION outside s)`
10632 [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
10633 [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
10634 ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
10635 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10636 `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
10637 DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
10638 MP_TAC(ISPECL [`linepath(a:real^N,b)`; `outside s:real^N->bool`]
10639 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
10640 ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
10641 IN_UNION; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
10642 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
10643 EXISTS_TAC `pathfinish g :real^N` THEN
10644 EXISTS_TAC `path_image g :real^N->bool` THEN
10645 ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
10646 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
10647 REPEAT STRIP_TAC THENL
10648 [ASM_MESON_TAC[FRONTIER_OUTSIDE_SUBSET; SUBSET];
10649 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
10651 DISCH_THEN(fun th ->
10652 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10653 MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
10654 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10655 MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
10656 MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
10657 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
10658 ASM_REWRITE_TAC[] THEN
10659 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
10660 EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
10661 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10662 REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
10663 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
10666 let INSIDE_INSIDE_EQ_EMPTY = prove
10668 closed s /\ connected s ==> inside(inside s) = {}`,
10669 REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
10670 X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[inside] THEN
10671 REWRITE_TAC[IN_ELIM_THM] THEN
10672 ONCE_REWRITE_TAC[INSIDE_OUTSIDE] THEN
10673 REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
10674 REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
10675 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10676 ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_SELF; CONNECTED_WITH_OUTSIDE] THEN
10677 REWRITE_TAC[BOUNDED_UNION] THEN MESON_TAC[UNBOUNDED_OUTSIDE]);;
10679 let INSIDE_IN_COMPONENTS = prove
10680 (`!s. (inside s) IN components((:real^N) DIFF s) <=>
10681 connected(inside s) /\ ~(inside s = {})`,
10682 X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
10683 ASM_CASES_TAC `inside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
10684 ASM_CASES_TAC `connected(inside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
10685 REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
10686 REWRITE_TAC[INSIDE_NO_OVERLAP] THEN
10687 X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
10688 ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
10689 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10690 MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
10691 UNDISCH_TAC `~(inside s:real^N->bool = {})` THEN
10692 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
10693 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10694 ASM_REWRITE_TAC[connected_component] THEN
10695 EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;
10697 let OUTSIDE_IN_COMPONENTS = prove
10698 (`!s. (outside s) IN components((:real^N) DIFF s) <=>
10699 connected(outside s) /\ ~(outside s = {})`,
10700 X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
10701 ASM_CASES_TAC `outside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
10702 ASM_CASES_TAC `connected(outside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
10703 REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
10704 REWRITE_TAC[OUTSIDE_NO_OVERLAP] THEN
10705 X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
10706 ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
10707 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10708 MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
10709 UNDISCH_TAC `~(outside s:real^N->bool = {})` THEN
10710 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
10711 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10712 ASM_REWRITE_TAC[connected_component] THEN
10713 EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;
10715 let BOUNDED_UNIQUE_OUTSIDE = prove
10716 (`!c s. 2 <= dimindex(:N) /\ bounded s
10717 ==> (c IN components ((:real^N) DIFF s) /\ ~bounded c <=>
10719 REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
10720 [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN
10721 EXISTS_TAC `(:real^N) DIFF s` THEN
10722 ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
10723 ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS];
10724 ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]] THEN
10725 ASM_SIMP_TAC[UNBOUNDED_OUTSIDE; OUTSIDE_BOUNDED_NONEMPTY;
10726 CONNECTED_OUTSIDE]);;
10728 (* ------------------------------------------------------------------------- *)
10729 (* Homotopy of maps p,q : X->Y with property P of all intermediate maps. *)
10730 (* We often just want to require that it fixes some subset, but to take in *)
10731 (* the case of loop homotopy it's convenient to have a general property P. *)
10732 (* ------------------------------------------------------------------------- *)
10734 let homotopic_with = new_definition
10735 `homotopic_with P (X,Y) p q <=>
10736 ?h:real^(1,M)finite_sum->real^N.
10737 h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
10738 IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
10739 (!x. h(pastecart (vec 0) x) = p x) /\
10740 (!x. h(pastecart (vec 1) x) = q x) /\
10741 (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`;;
10743 (* ------------------------------------------------------------------------- *)
10744 (* We often want to just localize the ending function equality or whatever. *)
10745 (* ------------------------------------------------------------------------- *)
10747 let HOMOTOPIC_WITH = prove
10748 (`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
10749 ==> (homotopic_with P (X,Y) p q <=>
10750 ?h:real^(1,M)finite_sum->real^N.
10751 h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
10752 IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
10753 (!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\
10754 (!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\
10755 (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`,
10756 REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
10757 [REWRITE_TAC[homotopic_with; PCROSS] THEN
10758 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
10759 REWRITE_TAC[homotopic_with; PCROSS] THEN
10760 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10761 (fun th -> EXISTS_TAC
10762 `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
10763 else if fstcart(y) = vec 0 then p(sndcart y)
10764 else q(sndcart y)` THEN
10766 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
10767 REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
10768 [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
10769 SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
10770 SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
10771 SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
10774 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
10775 MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
10776 MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10779 let HOMOTOPIC_WITH_EQ = prove
10780 (`!P X Y f g f' g':real^M->real^N.
10781 homotopic_with P (X,Y) f g /\
10782 (!x. x IN X ==> f' x = f x /\ g' x = g x) /\
10783 (!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
10784 ==> homotopic_with P (X,Y) f' g'`,
10785 REPEAT GEN_TAC THEN
10786 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
10787 REWRITE_TAC[homotopic_with] THEN
10788 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10789 (fun th -> EXISTS_TAC
10790 `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
10791 else if fstcart(y) = vec 0 then f'(sndcart y)
10792 else g'(sndcart y)` THEN
10794 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
10795 REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
10796 [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
10797 SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART];
10798 SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
10799 SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART];
10802 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
10803 MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
10804 MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10807 let HOMOTOPIC_WITH_EQUAL = prove
10808 (`!P f:real^M->real^N g s t.
10810 f continuous_on s /\ IMAGE f s SUBSET t /\
10811 (!x. x IN s ==> g x = f x)
10812 ==> homotopic_with P (s,t) f g`,
10813 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN
10814 EXISTS_TAC `\z:real^(1,M)finite_sum.
10815 if fstcart z = vec 1 then g(sndcart z):real^N else f(sndcart z)` THEN
10816 REWRITE_TAC[VEC_EQ; ARITH_EQ; SNDCART_PASTECART; FSTCART_PASTECART] THEN
10818 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
10819 EXISTS_TAC `\z:real^(1,M)finite_sum. (f:real^M->real^N)(sndcart z)` THEN
10820 ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10821 REWRITE_TAC[COND_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
10822 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10823 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN
10824 ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY];
10825 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
10826 REWRITE_TAC[ FSTCART_PASTECART; SNDCART_PASTECART] THEN
10827 CONJ_TAC THEN X_GEN_TAC `t:real^1` THEN REPEAT STRIP_TAC THEN
10828 ASM_CASES_TAC `t:real^1 = vec 1` THEN ASM_REWRITE_TAC[ETA_AX] THEN
10831 let HOMOTOPIC_CONSTANT_MAPS = prove
10832 (`!s:real^M->bool t:real^N->bool a b.
10833 homotopic_with (\x. T) (s,t) (\x. a) (\x. b) <=>
10834 s = {} \/ path_component t a b`,
10835 REPEAT GEN_TAC THEN SIMP_TAC[HOMOTOPIC_WITH; path_component] THEN
10836 ASM_CASES_TAC `s:real^M->bool = {}` THEN
10837 ASM_REWRITE_TAC[NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES] THEN
10838 REWRITE_TAC[EMPTY_SUBSET; CONTINUOUS_ON_EMPTY] THEN
10839 ASM_CASES_TAC `t:real^N->bool = {}` THEN
10840 ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY; SUBSET_EMPTY; PCROSS_EQ_EMPTY;
10841 IMAGE_EQ_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
10843 [DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10844 STRIP_ASSUME_TAC) THEN
10845 SUBGOAL_THEN `?c:real^M. c IN s` STRIP_ASSUME_TAC THENL
10846 [ASM SET_TAC[]; ALL_TAC] THEN
10847 EXISTS_TAC `(h:real^(1,M)finite_sum->real^N) o (\t. pastecart t c)` THEN
10848 ASM_SIMP_TAC[pathstart; pathfinish; o_THM; PATH_IMAGE_COMPOSE] THEN
10850 [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10851 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
10852 CONTINUOUS_ON_CONST] THEN
10853 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10854 CONTINUOUS_ON_SUBSET));
10855 REWRITE_TAC[path_image]] THEN
10856 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
10857 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
10858 ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS];
10859 REWRITE_TAC[path; pathstart; path_image; pathfinish] THEN
10860 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
10862 `(g:real^1->real^N) o (fstcart:real^(1,M)finite_sum->real^1)` THEN
10863 ASM_SIMP_TAC[FSTCART_PASTECART; o_THM; IMAGE_o; IMAGE_FSTCART_PCROSS] THEN
10864 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10865 ASM_SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON;
10866 IMAGE_FSTCART_PCROSS]]);;
10868 (* ------------------------------------------------------------------------- *)
10869 (* Trivial properties. *)
10870 (* ------------------------------------------------------------------------- *)
10872 let HOMOTOPIC_WITH_IMP_PROPERTY = prove
10873 (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> P f /\ P g`,
10874 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10875 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
10876 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN
10877 (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
10878 MP_TAC(SPEC `vec 1:real^1` th)) THEN
10879 ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; ETA_AX]);;
10881 let HOMOTOPIC_WITH_IMP_CONTINUOUS = prove
10882 (`!P X Y (f:real^M->real^N) g.
10883 homotopic_with P (X,Y) f g ==> f continuous_on X /\ g continuous_on X`,
10884 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10885 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
10888 `((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 0) x))
10890 ((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 1) x))
10892 MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
10893 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10894 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
10895 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10896 CONTINUOUS_ON_SUBSET)) THEN
10897 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
10898 ONCE_REWRITE_TAC[CONJ_SYM] THEN
10899 REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10900 SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
10901 REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);;
10903 let HOMOTOPIC_WITH_IMP_SUBSET = prove
10904 (`!P X Y (f:real^M->real^N) g.
10905 homotopic_with P (X,Y) f g ==> IMAGE f X SUBSET Y /\ IMAGE g X SUBSET Y`,
10906 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10907 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
10908 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
10909 REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN DISCH_THEN
10910 (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
10911 MP_TAC(SPEC `vec 1:real^1` th)) THEN
10912 ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;
10914 let HOMOTOPIC_WITH_MONO = prove
10915 (`!P Q X Y f g:real^M->real^N.
10916 homotopic_with P (X,Y) f g /\
10917 (!h. h continuous_on X /\ IMAGE h X SUBSET Y /\ P h ==> Q h)
10918 ==> homotopic_with Q (X,Y) f g`,
10919 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10920 REWRITE_TAC[homotopic_with; PCROSS] THEN
10921 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10922 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL
10923 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10924 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10925 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
10926 CONTINUOUS_ON_CONST] THEN
10927 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10928 CONTINUOUS_ON_SUBSET)) THEN
10932 let HOMOTOPIC_WITH_SUBSET_LEFT = prove
10934 homotopic_with P (X,Y) f g /\ Z SUBSET X
10935 ==> homotopic_with P (Z,Y) f g`,
10936 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10937 REWRITE_TAC[homotopic_with; PCROSS] THEN
10938 MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
10939 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
10940 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10941 CONTINUOUS_ON_SUBSET)) THEN
10945 let HOMOTOPIC_WITH_SUBSET_RIGHT = prove
10946 (`!P X Y Z (f:real^M->real^N) g h.
10947 homotopic_with P (X,Y) f g /\ Y SUBSET Z
10948 ==> homotopic_with P (X,Z) f g`,
10949 REPEAT GEN_TAC THEN
10950 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10951 REWRITE_TAC[homotopic_with] THEN
10952 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
10953 ASM_MESON_TAC[SUBSET_TRANS]);;
10955 let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT = prove
10956 (`!p f:real^N->real^P g h:real^M->real^N W X Y.
10957 homotopic_with (\f. p(f o h)) (X,Y) f g /\
10958 h continuous_on W /\ IMAGE h W SUBSET X
10959 ==> homotopic_with p (W,Y) (f o h) (g o h)`,
10960 REPEAT GEN_TAC THEN
10961 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
10962 REWRITE_TAC[homotopic_with; o_DEF; PCROSS] THEN
10963 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,N)finite_sum->real^P`
10964 STRIP_ASSUME_TAC) THEN
10965 EXISTS_TAC `\y:real^(1,M)finite_sum.
10966 (k:real^(1,N)finite_sum->real^P)
10967 (pastecart (fstcart y) (h(sndcart y)))` THEN
10968 ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10970 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10971 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
10972 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
10973 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
10974 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10975 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10976 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
10978 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
10979 CONTINUOUS_ON_SUBSET));
10981 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10982 SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10985 let HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT = prove
10986 (`!f:real^N->real^P g h:real^M->real^N W X Y.
10987 homotopic_with (\f. T) (X,Y) f g /\
10988 h continuous_on W /\ IMAGE h W SUBSET X
10989 ==> homotopic_with (\f. T) (W,Y) (f o h) (g o h)`,
10990 REPEAT STRIP_TAC THEN
10991 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
10992 EXISTS_TAC `X:real^N->bool` THEN ASM_REWRITE_TAC[]);;
10994 let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT = prove
10995 (`!p f:real^M->real^N g h:real^N->real^P X Y Z.
10996 homotopic_with (\f. p(h o f)) (X,Y) f g /\
10997 h continuous_on Y /\ IMAGE h Y SUBSET Z
10998 ==> homotopic_with p (X,Z) (h o f) (h o g)`,
10999 REPEAT GEN_TAC THEN
11000 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
11001 REWRITE_TAC[homotopic_with; o_DEF] THEN
11002 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N`
11003 STRIP_ASSUME_TAC) THEN
11004 EXISTS_TAC `(h:real^N->real^P) o (k:real^(1,M)finite_sum->real^N)` THEN
11005 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
11006 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
11007 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
11008 CONTINUOUS_ON_SUBSET));
11010 REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]);;
11012 let HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT = prove
11013 (`!f:real^M->real^N g h:real^N->real^P X Y Z.
11014 homotopic_with (\f. T) (X,Y) f g /\
11015 h continuous_on Y /\ IMAGE h Y SUBSET Z
11016 ==> homotopic_with (\f. T) (X,Z) (h o f) (h o g)`,
11017 REPEAT STRIP_TAC THEN
11018 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11019 EXISTS_TAC `Y:real^N->bool` THEN ASM_REWRITE_TAC[]);;
11021 let HOMOTOPIC_WITH_PCROSS = prove
11022 (`!f:real^M->real^N f':real^P->real^Q g g' p p' q s s' t t'.
11023 homotopic_with p (s,t) f g /\
11024 homotopic_with p' (s',t') f' g' /\
11025 (!f g. p f /\ p' g ==> q(\x. pastecart (f(fstcart x)) (g(sndcart x))))
11026 ==> homotopic_with q (s PCROSS s',t PCROSS t')
11027 (\z. pastecart (f(fstcart z)) (f'(sndcart z)))
11028 (\z. pastecart (g(fstcart z)) (g'(sndcart z)))`,
11029 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
11030 REWRITE_TAC[CONJ_ASSOC] THEN
11031 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
11032 REWRITE_TAC[GSYM CONJ_ASSOC] THEN
11033 DISCH_THEN(CONJUNCTS_THEN2
11034 (X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
11035 (X_CHOOSE_THEN `k':real^(1,P)finite_sum->real^Q` STRIP_ASSUME_TAC)) THEN
11037 `\z:real^(1,(M,P)finite_sum)finite_sum.
11038 pastecart (k(pastecart (fstcart z) (fstcart(sndcart z))):real^N)
11039 (k'(pastecart (fstcart z) (sndcart(sndcart z))):real^Q)` THEN
11040 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11041 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN
11042 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
11043 FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS;
11044 IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11045 MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
11046 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11047 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11049 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
11050 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
11051 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11052 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11053 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
11054 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11055 CONTINUOUS_ON_SUBSET)) THEN
11056 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
11057 IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11058 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART;
11059 PASTECART_IN_PCROSS]]));;
11061 let HOMOTOPIC_ON_EMPTY = prove
11062 (`!t f g. homotopic_with (\x. T) ({},t) f g`,
11063 SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY] THEN
11064 REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET]);;
11066 (* ------------------------------------------------------------------------- *)
11067 (* Homotopy with P is an equivalence relation (on continuous functions *)
11068 (* mapping X into Y that satisfy P, though this only affects reflexivity). *)
11069 (* ------------------------------------------------------------------------- *)
11071 let HOMOTOPIC_WITH_REFL = prove
11072 (`!P X Y (f:real^M->real^N).
11073 homotopic_with P (X,Y) f f <=>
11074 f continuous_on X /\ IMAGE f X SUBSET Y /\ P f`,
11075 REPEAT GEN_TAC THEN EQ_TAC THENL
11076 [MESON_TAC[HOMOTOPIC_WITH_IMP_PROPERTY; HOMOTOPIC_WITH_IMP_CONTINUOUS;
11077 HOMOTOPIC_WITH_IMP_SUBSET];
11078 STRIP_TAC THEN REWRITE_TAC[homotopic_with; PCROSS]] THEN
11079 EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) (sndcart y)` THEN
11080 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
11081 ASM_SIMP_TAC[SNDCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_IMAGE;
11082 FORALL_IN_GSPEC] THEN
11083 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11084 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11085 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11086 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11087 CONTINUOUS_ON_SUBSET)) THEN
11088 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]);;
11090 let HOMOTOPIC_WITH_SYM = prove
11091 (`!P X Y (f:real^M->real^N) g.
11092 homotopic_with P (X,Y) f g <=> homotopic_with P (X,Y) g f`,
11093 REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC(MESON[]
11094 `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN
11095 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN
11096 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
11097 STRIP_ASSUME_TAC) THEN
11098 EXISTS_TAC `\y:real^(1,M)finite_sum.
11099 (h:real^(1,M)finite_sum->real^N)
11100 (pastecart (vec 1 - fstcart y) (sndcart y))` THEN
11101 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11102 ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN REPEAT CONJ_TAC THENL
11103 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11104 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11105 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
11106 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
11107 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11108 CONTINUOUS_ON_SUBSET));
11109 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
11110 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11111 `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
11112 ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
11113 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC];
11114 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
11115 FIRST_X_ASSUM MATCH_MP_TAC] THEN
11116 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11117 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
11118 ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[PASTECART_EQ] THEN
11119 REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11120 SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
11121 REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL; DROP_SUB] THEN
11122 ASM_REAL_ARITH_TAC);;
11124 let HOMOTOPIC_WITH_TRANS = prove
11125 (`!P X Y (f:real^M->real^N) g h.
11126 homotopic_with P (X,Y) f g /\ homotopic_with P (X,Y) g h
11127 ==> homotopic_with P (X,Y) f h`,
11128 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN
11129 DISCH_THEN(CONJUNCTS_THEN2
11130 (X_CHOOSE_THEN `k1:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
11131 (X_CHOOSE_THEN `k2:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
11132 EXISTS_TAC `\y:real^(1,M)finite_sum.
11133 if drop(fstcart y) <= &1 / &2
11134 then (k1:real^(1,M)finite_sum->real^N)
11135 (pastecart (&2 % fstcart y) (sndcart y))
11136 else (k2:real^(1,M)finite_sum->real^N)
11137 (pastecart (&2 % fstcart y - vec 1) (sndcart y))` THEN
11138 REWRITE_TAC[FSTCART_PASTECART; DROP_VEC] THEN
11139 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
11140 ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; SNDCART_PASTECART] THEN
11141 REPEAT CONJ_TAC THENL
11143 `interval[vec 0:real^1,vec 1] =
11144 interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
11146 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
11149 REWRITE_TAC[SET_RULE `{f x y | x IN s UNION t /\ y IN u} =
11150 {f x y | x IN s /\ y IN u} UNION
11151 {f x y | x IN t /\ y IN u}`] THEN
11152 MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
11153 ONCE_REWRITE_TAC[TAUT
11154 `a /\ b /\ c /\ d /\ e <=> (a /\ b) /\ (c /\ d) /\ e`] THEN
11156 [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
11157 [EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
11158 t IN interval[vec 0,lift(&1 / &2)] /\ x IN UNIV }`;
11159 EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
11160 t IN interval[lift(&1 / &2),vec 1] /\ x IN UNIV}`] THEN
11161 SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS;
11162 CLOSED_INTERVAL; CLOSED_UNIV] THEN
11163 MATCH_MP_TAC SUBSET_ANTISYM THEN
11164 REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; TAUT
11165 `(x IN (s UNION t) /\ x IN u ==> x IN v) <=>
11166 (x IN u ==> x IN (s UNION t) ==> x IN v)`] THEN
11167 REWRITE_TAC[PASTECART_EQ; IN_ELIM_THM; IN_UNION] THEN
11168 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV] THEN
11172 [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11173 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11174 (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
11175 [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB;
11176 CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
11177 LINEAR_SNDCART] THEN
11178 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11179 CONTINUOUS_ON_SUBSET)) THEN
11180 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11181 REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART;
11182 SNDCART_PASTECART] THEN
11183 REWRITE_TAC[MESON[] `(?t x. P t x /\ a = t /\ b = x) <=> P a b`] THEN
11184 SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
11186 REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
11187 REWRITE_TAC[FORALL_AND_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN
11188 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
11189 SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_ARITH
11190 `&1 / &2 <= t ==> (t <= &1 / &2 <=> t = &1 / &2)`] THEN
11191 SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
11192 REWRITE_TAC[GSYM LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11193 ASM_REWRITE_TAC[LIFT_NUM]];
11194 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11195 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11196 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
11197 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
11198 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11199 `IMAGE k s SUBSET t ==> x IN s ==> k x IN t`)) THEN
11200 ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_INTERVAL_1; DROP_VEC;
11201 DROP_CMUL; DROP_SUB] THEN
11202 ASM_REAL_ARITH_TAC;
11203 X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
11204 STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_SIMP_TAC[] THEN
11205 FIRST_X_ASSUM MATCH_MP_TAC THEN
11206 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
11207 ASM_REAL_ARITH_TAC]);;
11209 let HOMOTOPIC_COMPOSE = prove
11210 (`!f f':real^M->real^N g g':real^N->real^P s t u.
11211 homotopic_with (\x. T) (s,t) f f' /\
11212 homotopic_with (\x. T) (t,u) g g'
11213 ==> homotopic_with (\x. T) (s,u) (g o f) (g' o f')`,
11214 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
11215 EXISTS_TAC `(g:real^N->real^P) o (f':real^M->real^N)` THEN
11217 [MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT;
11218 MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT] THEN
11219 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
11220 REPEAT(FIRST_X_ASSUM(fun th ->
11221 ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS th) THEN
11222 ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th))) THEN
11223 ASM_REWRITE_TAC[]);;
11225 (* ------------------------------------------------------------------------- *)
11226 (* Two characterizations of homotopic triviality, one of which *)
11227 (* implicitly incorporates path-connectedness. *)
11228 (* ------------------------------------------------------------------------- *)
11230 let HOMOTOPIC_TRIVIALITY = prove
11231 (`!s:real^M->bool t:real^N->bool.
11232 (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\
11233 g continuous_on s /\ IMAGE g s SUBSET t
11234 ==> homotopic_with (\x. T) (s,t) f g) <=>
11235 (s = {} \/ path_connected t) /\
11236 (!f. f continuous_on s /\ IMAGE f s SUBSET t
11237 ==> ?c. homotopic_with (\x. T) (s,t) f (\x. c))`,
11238 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
11239 [ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; HOMOTOPIC_WITH; NOT_IN_EMPTY;
11240 PCROSS_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET];
11241 ASM_CASES_TAC `t:real^N->bool = {}` THEN
11242 ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; PATH_CONNECTED_EMPTY]] THEN
11243 EQ_TAC THEN REPEAT STRIP_TAC THENL
11244 [REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
11245 REPEAT STRIP_TAC THEN
11246 W(MP_TAC o PART_MATCH (rand o rand) HOMOTOPIC_CONSTANT_MAPS o snd) THEN
11247 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
11248 FIRST_X_ASSUM MATCH_MP_TAC THEN
11249 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST] THEN
11251 SUBGOAL_THEN `?c:real^N. c IN t` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
11252 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
11253 FIRST_X_ASSUM MATCH_MP_TAC THEN
11254 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST];
11255 FIRST_X_ASSUM(fun th ->
11256 MP_TAC(ISPEC `g:real^M->real^N` th) THEN
11257 MP_TAC(ISPEC `f:real^M->real^N` th)) THEN
11258 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11259 X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
11260 X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN
11261 TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. c):real^M->real^N` THEN
11262 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
11263 TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. d):real^M->real^N` THEN
11264 ASM_REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN
11265 FIRST_X_ASSUM(MATCH_MP_TAC o
11266 REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
11267 REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
11270 (* ------------------------------------------------------------------------- *)
11271 (* Homotopy on a union of closed-open sets. *)
11272 (* ------------------------------------------------------------------------- *)
11274 let HOMOTOPIC_ON_CLOPEN_UNIONS = prove
11275 (`!f:real^M->real^N g t u.
11277 ==> closed_in (subtopology euclidean (UNIONS u)) s /\
11278 open_in (subtopology euclidean (UNIONS u)) s /\
11279 homotopic_with (\x. T) (s,t) f g)
11280 ==> homotopic_with (\x. T) (UNIONS u,t) f g`,
11281 REPEAT STRIP_TAC THEN
11283 `?v. v SUBSET u /\ COUNTABLE v /\ UNIONS v :real^M->bool = UNIONS u`
11284 STRIP_ASSUME_TAC THENL
11285 [MATCH_MP_TAC LINDELOF_OPEN_IN THEN ASM_MESON_TAC[];
11286 FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)] THEN
11287 ASM_CASES_TAC `v:(real^M->bool)->bool = {}` THEN
11288 ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY; UNIONS_0] THEN
11289 MP_TAC(ISPEC `v:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN
11290 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11291 X_GEN_TAC `f:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN
11292 FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `(f:num->real^M->bool) n`) THEN
11293 DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN
11294 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN
11295 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11296 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homotopic_with] THEN
11297 SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH] THEN
11298 X_GEN_TAC `h:num->real^(1,M)finite_sum->real^N` THEN
11299 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
11301 [`h:num->real^(1,M)finite_sum->real^N`;
11302 `(\n. interval[vec 0,vec 1] PCROSS (f n DIFF UNIONS {f m | m < n}))
11303 :num->real^(1,M)finite_sum->bool`;
11304 `(interval[vec 0,vec 1] PCROSS UNIONS(IMAGE f (:num)))
11305 :real^(1,M)finite_sum->bool`;
11306 `(:num)`] PASTING_LEMMA_EXISTS) THEN
11307 REWRITE_TAC[IN_UNIV; FORALL_AND_THM; INTER_PCROSS] THEN ANTS_TAC THENL
11308 [REPEAT CONJ_TAC THENL
11309 [REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_ELIM_THM; FORALL_PASTECART] THEN
11310 REWRITE_TAC[PASTECART_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM;
11311 FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_UNIV; IMP_CONJ] THEN
11312 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
11313 ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN
11314 REWRITE_TAC[LEFT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN
11315 GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[];
11316 X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IN_PCROSS THEN
11317 REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN
11318 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN
11319 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11320 SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN ASM SET_TAC[];
11321 X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(fun th ->
11322 MATCH_MP_TAC(MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)
11323 (SPEC `n:num` th))) THEN
11324 REWRITE_TAC[SUBSET_PCROSS; SUBSET_REFL; SUBSET_DIFF];
11325 MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL
11326 [REWRITE_TAC[INTER_ACI] THEN MESON_TAC[];
11327 REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN SET_TAC[]]];
11328 MATCH_MP_TAC MONO_EXISTS THEN
11329 X_GEN_TAC `g:real^(1,M)finite_sum->real^N` THEN
11330 REWRITE_TAC[INTER_ACI; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
11331 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11332 REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; SUBSET;
11333 RIGHT_FORALL_IMP_THM; IN_UNIV; FORALL_IN_PCROSS] THEN
11335 [X_GEN_TAC `t:real^1` THEN DISCH_TAC; CONJ_TAC] THEN
11336 ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN
11337 REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN
11338 GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
11339 DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL
11340 [FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^1`; `y:real^M`; `n:num`]);
11341 FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `y:real^M`; `n:num`]);
11342 FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1:real^1`; `y:real^M`; `n:num`])] THEN
11343 ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_UNIV; IN_DIFF;
11344 UNIONS_GSPEC; IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
11345 (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
11347 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN
11348 REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);;
11350 let INESSENTIAL_ON_CLOPEN_UNIONS = prove
11351 (`!f:real^M->real^N t u.
11352 path_connected t /\
11354 ==> closed_in (subtopology euclidean (UNIONS u)) s /\
11355 open_in (subtopology euclidean (UNIONS u)) s /\
11356 ?a. homotopic_with (\x. T) (s,t) f (\x. a))
11357 ==> ?a. homotopic_with (\x. T) (UNIONS u,t) f (\x. a)`,
11358 REPEAT GEN_TAC THEN ASM_CASES_TAC `UNIONS u:real^M->bool = {}` THEN
11359 ASM_REWRITE_TAC[UNIONS_0; HOMOTOPIC_ON_EMPTY] THEN STRIP_TAC THEN
11360 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EMPTY_UNIONS]) THEN
11361 REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN
11362 X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
11363 FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
11364 ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
11365 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11366 DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN
11367 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11368 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
11369 `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN
11370 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `a:real^N` THEN
11371 MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN
11372 X_GEN_TAC `s:real^M->bool` THEN STRIP_TAC THEN
11373 FIRST_X_ASSUM(MP_TAC o SPEC `s:real^M->bool`) THEN
11374 ASM_REWRITE_TAC[] THEN
11375 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11376 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11377 ASM_CASES_TAC `s:real^M->bool = {}` THEN
11378 ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY] THEN X_GEN_TAC `b:real^N` THEN
11379 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
11380 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
11381 REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
11382 FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11383 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
11384 `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN
11385 ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);;
11387 (* ------------------------------------------------------------------------- *)
11388 (* Homotopy of paths, maintaining the same endpoints. *)
11389 (* ------------------------------------------------------------------------- *)
11391 let homotopic_paths = new_definition
11392 `homotopic_paths s p q =
11394 (\r. pathstart r = pathstart p /\ pathfinish r = pathfinish p)
11395 (interval[vec 0:real^1,vec 1],s)
11398 let HOMOTOPIC_PATHS = prove
11399 (`!s p q:real^1->real^N.
11400 homotopic_paths s p q <=>
11401 ?h. h continuous_on
11402 interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
11403 IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
11405 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
11406 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
11407 (!t. t IN interval[vec 0:real^1,vec 1]
11408 ==> pathstart(h o pastecart t) = pathstart p /\
11409 pathfinish(h o pastecart t) = pathfinish p)`,
11410 REPEAT GEN_TAC THEN
11411 REWRITE_TAC[homotopic_paths] THEN
11412 W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN
11414 [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
11415 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;
11417 let HOMOTOPIC_PATHS_IMP_PATHSTART = prove
11418 (`!s p q. homotopic_paths s p q ==> pathstart p = pathstart q`,
11419 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11420 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
11423 let HOMOTOPIC_PATHS_IMP_PATHFINISH = prove
11424 (`!s p q. homotopic_paths s p q ==> pathfinish p = pathfinish q`,
11425 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11426 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
11429 let HOMOTOPIC_PATHS_IMP_PATH = prove
11430 (`!s p q. homotopic_paths s p q ==> path p /\ path q`,
11431 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11432 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
11435 let HOMOTOPIC_PATHS_IMP_SUBSET = prove
11437 homotopic_paths s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
11438 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11439 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11440 SIMP_TAC[path_image]);;
11442 let HOMOTOPIC_PATHS_REFL = prove
11443 (`!s p. homotopic_paths s p p <=>
11444 path p /\ path_image p SUBSET s`,
11445 REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_REFL; path; path_image]);;
11447 let HOMOTOPIC_PATHS_SYM = prove
11448 (`!s p q. homotopic_paths s p q <=> homotopic_paths s q p`,
11449 REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN
11450 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
11451 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
11452 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
11453 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[homotopic_paths]);;
11455 let HOMOTOPIC_PATHS_TRANS = prove
11457 homotopic_paths s p q /\ homotopic_paths s q r
11458 ==> homotopic_paths s p r`,
11459 REPEAT GEN_TAC THEN DISCH_TAC THEN
11460 FIRST_ASSUM(CONJUNCTS_THEN
11461 (fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART th) THEN
11462 ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN
11463 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINOP_CONV [homotopic_paths]) THEN
11464 ASM_REWRITE_TAC[HOMOTOPIC_WITH_TRANS; homotopic_paths]);;
11466 let HOMOTOPIC_PATHS_EQ = prove
11467 (`!p:real^1->real^N q s.
11468 path p /\ path_image p SUBSET s /\
11469 (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
11470 ==> homotopic_paths s p q`,
11471 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11472 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
11473 REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
11474 ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN
11475 ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
11476 REWRITE_TAC[pathstart; pathfinish] THEN
11477 MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
11479 let HOMOTOPIC_PATHS_REPARAMETRIZE = prove
11480 (`!p:real^1->real^N q f:real^1->real^1.
11481 path p /\ path_image p SUBSET s /\
11482 (?f. f continuous_on interval[vec 0,vec 1] /\
11483 IMAGE f (interval[vec 0,vec 1]) SUBSET interval[vec 0,vec 1] /\
11484 f(vec 0) = vec 0 /\ f(vec 1) = vec 1 /\
11485 !t. t IN interval[vec 0,vec 1] ==> q(t) = p(f t))
11486 ==> homotopic_paths s p q`,
11487 REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
11488 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11489 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11490 EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN CONJ_TAC THENL
11491 [MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN
11492 ASM_SIMP_TAC[o_THM; pathstart; pathfinish; o_THM;
11493 IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
11494 REWRITE_TAC[path; path_image] THEN CONJ_TAC THENL
11495 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
11496 EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN
11497 ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11498 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
11500 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
11501 EXISTS_TAC `(p:real^1->real^N) o
11502 (\y. (&1 - drop(fstcart y)) % f(sndcart y) +
11503 drop(fstcart y) % sndcart y)` THEN
11504 ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC;
11505 pathstart; pathfinish] THEN
11506 CONV_TAC REAL_RAT_REDUCE_CONV THEN
11507 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
11508 VECTOR_MUL_LID; VECTOR_ADD_RID] THEN
11509 REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`] THEN
11511 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11512 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
11513 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11514 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB] THEN
11515 SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART;
11516 LINEAR_SNDCART; CONTINUOUS_ON_SUB] THEN
11517 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
11518 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11519 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11520 CONTINUOUS_ON_SUBSET)) THEN
11521 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART];
11522 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11523 CONTINUOUS_ON_SUBSET))];
11524 ONCE_REWRITE_TAC[IMAGE_o] THEN
11525 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11526 `IMAGE p i SUBSET s
11527 ==> IMAGE f x SUBSET i
11528 ==> IMAGE p (IMAGE f x) SUBSET s`))] THEN
11529 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART;
11530 FSTCART_PASTECART] THEN
11531 REPEAT STRIP_TAC THEN
11532 MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] (CONJUNCT1(SPEC_ALL
11533 CONVEX_INTERVAL))) THEN
11534 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET; IN_IMAGE]]);;
11536 let HOMOTOPIC_PATHS_SUBSET = prove
11538 homotopic_paths s p q /\ s SUBSET t
11539 ==> homotopic_paths t p q`,
11540 REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_SUBSET_RIGHT]);;
11542 (* ------------------------------------------------------------------------- *)
11543 (* A slightly ad-hoc but useful lemma in constructing homotopies. *)
11544 (* ------------------------------------------------------------------------- *)
11546 let HOMOTOPIC_JOIN_LEMMA = prove
11547 (`!p q:real^1->real^1->real^N.
11548 (\y. p (fstcart y) (sndcart y)) continuous_on
11549 (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
11550 (\y. q (fstcart y) (sndcart y)) continuous_on
11551 (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
11552 (!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t))
11553 ==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on
11554 (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`,
11555 REWRITE_TAC[joinpaths; PCROSS] THEN REPEAT STRIP_TAC THEN
11556 MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
11558 `(\y. p (fstcart y) (&2 % sndcart y)):real^(1,1)finite_sum->real^N =
11559 (\y. p (fstcart y) (sndcart y)) o
11560 (\y. pastecart (fstcart y) (&2 % sndcart y))`
11562 [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
11564 `(\y. q (fstcart y) (&2 % sndcart y - vec 1)):real^(1,1)finite_sum->real^N =
11565 (\y. q (fstcart y) (sndcart y)) o
11566 (\y. pastecart (fstcart y) (&2 % sndcart y - vec 1))`
11568 [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
11569 SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX];
11570 SIMP_TAC[IMP_CONJ; FORALL_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART;
11571 GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
11572 CONV_TAC REAL_RAT_REDUCE_CONV THEN
11573 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11574 ASM_SIMP_TAC[LIFT_NUM; VECTOR_SUB_REFL]] THEN
11575 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11576 (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART; ALL_TAC]) THEN
11577 SIMP_TAC[CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUB;
11578 CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART] THEN
11579 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11580 CONTINUOUS_ON_SUBSET)) THEN
11581 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ] THEN
11582 SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11583 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
11586 (* ------------------------------------------------------------------------- *)
11587 (* Congruence properties of homotopy w.r.t. path-combining operations. *)
11588 (* ------------------------------------------------------------------------- *)
11590 let HOMOTOPIC_PATHS_REVERSEPATH = prove
11591 (`!s p q:real^1->real^N.
11592 homotopic_paths s (reversepath p) (reversepath q) <=>
11593 homotopic_paths s p q`,
11594 GEN_TAC THEN MATCH_MP_TAC(MESON[]
11595 `(!p. f(f p) = p) /\
11596 (!a b. homotopic_paths s a b ==> homotopic_paths s (f a) (f b))
11597 ==> !a b. homotopic_paths s (f a) (f b) <=>
11598 homotopic_paths s a b`) THEN
11599 REWRITE_TAC[REVERSEPATH_REVERSEPATH] THEN REPEAT GEN_TAC THEN
11600 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS; o_DEF] THEN DISCH_THEN
11601 (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
11602 EXISTS_TAC `\y:real^(1,1)finite_sum.
11603 (h:real^(1,1)finite_sum->real^N)
11604 (pastecart(fstcart y) (vec 1 - sndcart y))` THEN
11605 ASM_REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11606 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11607 ASM_SIMP_TAC[reversepath; pathstart; pathfinish; VECTOR_SUB_REFL;
11608 VECTOR_SUB_RZERO] THEN
11610 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11611 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11612 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
11613 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11614 CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
11615 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11616 CONTINUOUS_ON_SUBSET)) THEN
11617 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
11618 IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11619 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC];
11620 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
11621 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11622 `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
11623 ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
11624 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
11625 IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11626 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]);;
11628 let HOMOTOPIC_PATHS_JOIN = prove
11629 (`!s p q p' q':real^1->real^N.
11630 homotopic_paths s p p' /\ homotopic_paths s q q' /\
11631 pathfinish p = pathstart q
11632 ==> homotopic_paths s (p ++ q) (p' ++ q')`,
11633 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
11634 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
11635 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
11636 DISCH_THEN(CONJUNCTS_THEN2
11637 (X_CHOOSE_THEN `k1:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)
11638 (X_CHOOSE_THEN `k2:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
11639 EXISTS_TAC `(\y. ((k1 o pastecart (fstcart y)) ++
11640 (k2 o pastecart (fstcart y))) (sndcart y))
11641 :real^(1,1)finite_sum->real^N` THEN
11642 REPEAT CONJ_TAC THENL
11643 [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
11644 ASM_REWRITE_TAC[o_DEF; PASTECART_FST_SND; ETA_AX] THEN
11645 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11646 ASM_REWRITE_TAC[pathstart; pathfinish] THEN ASM_MESON_TAC[];
11647 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11648 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11649 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11650 REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
11651 `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
11652 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
11653 REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[];
11654 ALL_TAC; ALL_TAC; ALL_TAC] THEN
11655 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11656 ASM_REWRITE_TAC[joinpaths; o_DEF] THEN
11657 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11658 REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN
11659 CONV_TAC REAL_RAT_REDUCE_CONV THEN
11660 ASM_SIMP_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; VECTOR_MUL_RZERO]);;
11662 let HOMOTOPIC_PATHS_CONTINUOUS_IMAGE = prove
11663 (`!f:real^1->real^M g h:real^M->real^N s t.
11664 homotopic_paths s f g /\
11665 h continuous_on s /\ IMAGE h s SUBSET t
11666 ==> homotopic_paths t (h o f) (h o g)`,
11667 REWRITE_TAC[homotopic_paths] THEN REPEAT STRIP_TAC THEN
11668 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11669 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
11670 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11671 HOMOTOPIC_WITH_MONO)) THEN
11672 SIMP_TAC[pathstart; pathfinish; o_THM]);;
11674 (* ------------------------------------------------------------------------- *)
11675 (* Group properties for homotopy of paths (so taking equivalence classes *)
11676 (* under homotopy would give the fundamental group). *)
11677 (* ------------------------------------------------------------------------- *)
11679 let HOMOTOPIC_PATHS_RID = prove
11680 (`!s p. path p /\ path_image p SUBSET s
11681 ==> homotopic_paths s (p ++ linepath(pathfinish p,pathfinish p)) p`,
11682 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11683 MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
11684 ASM_REWRITE_TAC[joinpaths] THEN
11685 EXISTS_TAC `\t. if drop t <= &1 / &2 then &2 % t else vec 1` THEN
11686 ASM_REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11687 REWRITE_TAC[VECTOR_MUL_RZERO; linepath; pathfinish;
11688 VECTOR_ARITH `(&1 - t) % x + t % x:real^N = x`] THEN
11689 REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
11692 `interval[vec 0:real^1,vec 1] =
11693 interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
11695 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
11697 MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
11698 SIMP_TAC[CLOSED_INTERVAL; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
11699 CONTINUOUS_ON_CONST; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
11700 GSYM DROP_EQ; DROP_CMUL] THEN
11702 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
11703 GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN
11704 ASM_REAL_ARITH_TAC]);;
11706 let HOMOTOPIC_PATHS_LID = prove
11707 (`!s p:real^1->real^N.
11708 path p /\ path_image p SUBSET s
11709 ==> homotopic_paths s (linepath(pathstart p,pathstart p) ++ p) p`,
11710 REPEAT STRIP_TAC THEN
11711 ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
11712 REWRITE_TAC[o_DEF; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
11713 SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH;
11714 PATHFINISH_LINEPATH] THEN
11715 ONCE_REWRITE_TAC[CONJ_SYM] THEN
11716 MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p :real^1->real^N`]
11717 HOMOTOPIC_PATHS_RID) THEN
11718 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
11719 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);;
11721 let HOMOTOPIC_PATHS_ASSOC = prove
11722 (`!s p q r:real^1->real^N.
11723 path p /\ path_image p SUBSET s /\
11724 path q /\ path_image q SUBSET s /\
11725 path r /\ path_image r SUBSET s /\
11726 pathfinish p = pathstart q /\ pathfinish q = pathstart r
11727 ==> homotopic_paths s (p ++ (q ++ r)) ((p ++ q) ++ r)`,
11728 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11729 MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
11730 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET;
11731 PATHSTART_JOIN; PATHFINISH_JOIN] THEN
11732 REWRITE_TAC[joinpaths] THEN
11733 EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(&2) % t
11734 else if drop t <= &3 / &4 then t - lift(&1 / &4)
11735 else &2 % t - vec 1` THEN
11736 REPEAT CONJ_TAC THENL
11737 [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
11738 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; LIFT_DROP] THEN
11739 REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN
11740 CONV_TAC REAL_RAT_REDUCE_CONV THEN
11741 MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
11742 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
11743 CONTINUOUS_ON_CONST] THEN
11744 REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
11745 CONV_TAC REAL_RAT_REDUCE_CONV;
11746 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
11747 REPEAT STRIP_TAC THEN
11748 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
11749 REWRITE_TAC[DROP_CMUL; DROP_VEC; LIFT_DROP; DROP_SUB] THEN
11750 ASM_REAL_ARITH_TAC;
11751 REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11752 REWRITE_TAC[VECTOR_MUL_RZERO];
11753 REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11755 X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
11757 ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[DROP_CMUL] THEN
11758 ASM_REWRITE_TAC[REAL_ARITH `inv(&2) * t <= &1 / &2 <=> t <= &1`] THEN
11759 REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
11760 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN
11761 ASM_CASES_TAC `drop t <= &3 / &4` THEN
11762 ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP;
11763 REAL_ARITH `&2 * (t - &1 / &4) <= &1 / &2 <=> t <= &1 / &2`;
11764 REAL_ARITH `&2 * t - &1 <= &1 / &2 <=> t <= &3 / &4`;
11765 REAL_ARITH `t - &1 / &4 <= &1 / &2 <=> t <= &3 / &4`] THEN
11766 REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; GSYM LIFT_CMUL] THEN
11767 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
11768 REWRITE_TAC[VECTOR_ARITH `a - b - b:real^N = a - &2 % b`]]);;
11770 let HOMOTOPIC_PATHS_RINV = prove
11771 (`!s p:real^1->real^N.
11772 path p /\ path_image p SUBSET s
11773 ==> homotopic_paths s
11774 (p ++ reversepath p) (linepath(pathstart p,pathstart p))`,
11775 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11776 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
11777 EXISTS_TAC `(\y. (subpath (vec 0) (fstcart y) p ++
11778 reversepath(subpath (vec 0) (fstcart y) p)) (sndcart y))
11779 : real^(1,1)finite_sum->real^N` THEN
11780 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL] THEN
11781 REWRITE_TAC[ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN] THEN
11782 REWRITE_TAC[REVERSEPATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
11783 REPEAT CONJ_TAC THENL
11784 [REWRITE_TAC[joinpaths] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
11785 RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN REPEAT CONJ_TAC THENL
11786 [REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
11787 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11788 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11789 [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11790 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
11791 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11792 CONTINUOUS_ON_CMUL];
11793 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11794 CONTINUOUS_ON_SUBSET)) THEN
11795 REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
11796 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11797 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
11798 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN
11799 MATCH_MP_TAC REAL_LE_TRANS THEN
11800 EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
11801 REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
11802 ASM_REAL_ARITH_TAC];
11803 REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
11804 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11805 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11806 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
11807 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
11808 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11809 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
11810 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11811 CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
11812 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11813 CONTINUOUS_ON_SUBSET)) THEN
11814 REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
11815 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11816 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC; DROP_ADD;
11817 REAL_ARITH `t + (&0 - t) * (&2 * x - &1) =
11818 t * &2 * (&1 - x)`] THEN
11819 REPEAT STRIP_TAC THEN
11820 ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN
11821 MATCH_MP_TAC REAL_LE_TRANS THEN
11822 EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
11823 REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
11824 ASM_REAL_ARITH_TAC];
11825 SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
11826 REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
11827 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[subpath] THEN AP_TERM_TAC THEN
11828 REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC; DROP_ADD; DROP_CMUL;
11831 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11832 REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
11833 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
11834 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX;
11835 SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
11836 REWRITE_TAC[GSYM path_image] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
11837 REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN
11838 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
11839 MATCH_MP_TAC(SET_RULE
11840 `t SUBSET s /\ u SUBSET s
11841 ==> IMAGE p s SUBSET v
11842 ==> IMAGE p t SUBSET v /\ IMAGE p u SUBSET v`) THEN
11843 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN
11844 MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL] THEN
11845 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
11846 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
11847 REWRITE_TAC[subpath; linepath; pathstart; joinpaths] THEN
11848 REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
11849 REWRITE_TAC[VECTOR_ADD_RID; COND_ID] THEN VECTOR_ARITH_TAC;
11850 REWRITE_TAC[pathstart; PATHFINISH_LINEPATH; PATHSTART_LINEPATH]]);;
11852 let HOMOTOPIC_PATHS_LINV = prove
11853 (`!s p:real^1->real^N.
11854 path p /\ path_image p SUBSET s
11855 ==> homotopic_paths s
11856 (reversepath p ++ p) (linepath(pathfinish p,pathfinish p))`,
11857 REPEAT STRIP_TAC THEN
11858 MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p:real^1->real^N`]
11859 HOMOTOPIC_PATHS_RINV) THEN
11860 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
11861 REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
11862 REVERSEPATH_REVERSEPATH]);;
11864 (* ------------------------------------------------------------------------- *)
11865 (* Homotopy of loops without requiring preservation of endpoints. *)
11866 (* ------------------------------------------------------------------------- *)
11868 let homotopic_loops = new_definition
11869 `homotopic_loops s p q =
11871 (\r. pathfinish r = pathstart r)
11872 (interval[vec 0:real^1,vec 1],s)
11875 let HOMOTOPIC_LOOPS = prove
11876 (`!s p q:real^1->real^N.
11877 homotopic_loops s p q <=>
11878 ?h. h continuous_on
11879 interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
11880 IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
11882 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
11883 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
11884 (!t. t IN interval[vec 0:real^1,vec 1]
11885 ==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`,
11886 REPEAT GEN_TAC THEN
11887 REWRITE_TAC[homotopic_loops] THEN
11888 W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN
11890 [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
11891 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;
11893 let HOMOTOPIC_LOOPS_IMP_LOOP = prove
11894 (`!s p q. homotopic_loops s p q
11895 ==> pathfinish p = pathstart p /\
11896 pathfinish q = pathstart q`,
11897 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11898 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
11901 let HOMOTOPIC_LOOPS_IMP_PATH = prove
11902 (`!s p q. homotopic_loops s p q ==> path p /\ path q`,
11903 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11904 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
11907 let HOMOTOPIC_LOOPS_IMP_SUBSET = prove
11909 homotopic_loops s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
11910 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11911 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11912 SIMP_TAC[path_image]);;
11914 let HOMOTOPIC_LOOPS_REFL = prove
11915 (`!s p. homotopic_loops s p p <=>
11916 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p`,
11917 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_REFL; path; path_image]);;
11919 let HOMOTOPIC_LOOPS_SYM = prove
11920 (`!s p q. homotopic_loops s p q <=> homotopic_loops s q p`,
11921 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SYM]);;
11923 let HOMOTOPIC_LOOPS_TRANS = prove
11925 homotopic_loops s p q /\ homotopic_loops s q r
11926 ==> homotopic_loops s p r`,
11927 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_TRANS]);;
11929 let HOMOTOPIC_LOOPS_SUBSET = prove
11931 homotopic_loops s p q /\ s SUBSET t
11932 ==> homotopic_loops t p q`,
11933 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SUBSET_RIGHT]);;
11935 let HOMOTOPIC_LOOPS_EQ = prove
11936 (`!p:real^1->real^N q s.
11937 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
11938 (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
11939 ==> homotopic_loops s p q`,
11940 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11941 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
11942 REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
11943 ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN
11944 ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
11945 REWRITE_TAC[pathstart; pathfinish] THEN
11946 MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
11948 let HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE = prove
11949 (`!f:real^1->real^M g h:real^M->real^N s t.
11950 homotopic_loops s f g /\
11951 h continuous_on s /\ IMAGE h s SUBSET t
11952 ==> homotopic_loops t (h o f) (h o g)`,
11953 REWRITE_TAC[homotopic_loops] THEN REPEAT STRIP_TAC THEN
11954 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11955 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
11956 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11957 HOMOTOPIC_WITH_MONO)) THEN
11958 SIMP_TAC[pathstart; pathfinish; o_THM]);;
11960 let HOMOTOPIC_LOOPS_SHIFTPATH_SELF = prove
11961 (`!p:real^1->real^N t s.
11962 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
11963 t IN interval[vec 0,vec 1]
11964 ==> homotopic_loops s p (shiftpath t p)`,
11965 REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_LOOPS] THEN EXISTS_TAC
11966 `\z. shiftpath (drop t % fstcart z) (p:real^1->real^N) (sndcart z)` THEN
11967 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_DEF] THEN
11968 REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; ETA_AX] THEN
11969 REPEAT CONJ_TAC THENL
11971 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
11972 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11973 MATCH_MP_TAC(SET_RULE
11974 `IMAGE p t SUBSET u /\
11975 (!x. x IN s ==> IMAGE(shiftpath (f x) p) t = IMAGE p t)
11976 ==> (!x y. x IN s /\ y IN t ==> shiftpath (f x) p y IN u)`) THEN
11977 ASM_REWRITE_TAC[GSYM path_image] THEN REPEAT STRIP_TAC THEN
11978 MATCH_MP_TAC PATH_IMAGE_SHIFTPATH THEN
11979 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
11980 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11981 ASM_SIMP_TAC[REAL_LE_MUL] THEN
11982 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
11983 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[];
11984 SIMP_TAC[shiftpath; VECTOR_ADD_LID; IN_INTERVAL_1; DROP_VEC];
11985 REWRITE_TAC[LIFT_DROP];
11986 X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN
11987 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
11988 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11989 ASM_SIMP_TAC[REAL_LE_MUL] THEN
11990 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
11991 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]] THEN
11992 REWRITE_TAC[shiftpath; DROP_ADD; DROP_CMUL] THEN
11993 MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
11994 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11995 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11996 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
11997 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11998 CONTINUOUS_ON_CONST] THEN
11999 RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
12000 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12001 CONTINUOUS_ON_SUBSET)) THEN
12002 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
12003 REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
12004 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12005 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
12006 DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL];
12007 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12008 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12009 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
12010 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
12011 CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
12012 RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
12013 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12014 CONTINUOUS_ON_SUBSET)) THEN
12015 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
12016 REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
12017 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12018 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB;
12019 DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL] THEN
12020 SIMP_TAC[REAL_ARITH `&0 <= x + y - &1 <=> &1 <= x + y`] THEN
12021 REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
12022 `t * x <= &1 * &1 /\ y <= &1 ==> t * x + y - &1 <= &1`) THEN
12023 ASM_SIMP_TAC[REAL_LE_MUL2; REAL_POS];
12024 REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
12025 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON;
12026 LINEAR_FSTCART; LINEAR_SNDCART];
12027 SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_CMUL; LIFT_DROP; LIFT_NUM;
12028 VECTOR_ARITH `a + b - c:real^1 = (a + b) - c`] THEN
12029 ASM_MESON_TAC[VECTOR_SUB_REFL; pathstart; pathfinish]]);;
12031 (* ------------------------------------------------------------------------- *)
12032 (* Relations between the two variants of homotopy. *)
12033 (* ------------------------------------------------------------------------- *)
12035 let HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS = prove
12036 (`!s p q. homotopic_paths s p q /\
12037 pathfinish p = pathstart p /\
12038 pathfinish q = pathstart p
12039 ==> homotopic_loops s p q`,
12040 REPEAT GEN_TAC THEN
12041 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
12042 REWRITE_TAC[homotopic_paths; homotopic_loops] THEN
12043 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_MONO) THEN
12046 let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove
12048 homotopic_loops s p (linepath(a,a))
12049 ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
12050 REPEAT STRIP_TAC THEN
12051 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN
12052 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN
12053 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN
12054 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN
12055 REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
12056 X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN
12057 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
12058 `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN
12060 [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN
12061 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
12062 `linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++
12063 linepath(pathfinish p,pathfinish p)` THEN
12065 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12066 MP_TAC(ISPECL [`s:real^N->bool`;
12067 `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`]
12068 HOMOTOPIC_PATHS_LID) THEN
12069 REWRITE_TAC[PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN
12070 ASM_SIMP_TAC[PATH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN
12071 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
12072 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
12073 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
12074 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
12076 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
12077 `((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++
12079 reversepath(\u. h (pastecart u (vec 0))))` THEN
12082 MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_LID; HOMOTOPIC_PATHS_JOIN;
12083 HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM;
12084 HOMOTOPIC_PATHS_RINV]
12085 `(path p /\ path(reversepath p)) /\
12086 (path_image p SUBSET s /\ path_image(reversepath p) SUBSET s) /\
12087 (pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\
12088 pathstart(reversepath p) = b) /\
12090 ==> homotopic_paths s (p ++ linepath(b,b) ++ reversepath p)
12091 (linepath(a,a))`) THEN
12092 REWRITE_TAC[PATHSTART_REVERSEPATH; PATHSTART_JOIN; PATH_REVERSEPATH;
12093 PATH_IMAGE_REVERSEPATH; PATHSTART_LINEPATH] THEN
12094 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish;
12095 LINEPATH_REFL] THEN
12097 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12098 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12099 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
12100 CONTINUOUS_ON_CONST] THEN
12101 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12102 CONTINUOUS_ON_SUBSET)) THEN
12103 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
12104 ENDS_IN_UNIT_INTERVAL];
12105 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
12106 SUBSET_TRANS)) THEN
12107 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
12108 REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
12109 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
12110 ENDS_IN_UNIT_INTERVAL]]] THEN
12111 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
12113 `\y:real^(1,1)finite_sum.
12114 (subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++
12115 (\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++
12116 subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0))))
12118 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
12119 SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
12120 PATHSTART_JOIN; PATHFINISH_JOIN;
12121 PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
12122 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
12123 ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
12124 [ALL_TAC; REWRITE_TAC[pathstart]] THEN
12126 [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12127 REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
12129 MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12130 ASM_REWRITE_TAC[PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL
12132 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12133 REWRITE_TAC[PATHSTART_SUBPATH] THEN
12134 ASM_SIMP_TAC[pathstart; pathfinish]];
12135 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12136 REWRITE_TAC[PATHFINISH_SUBPATH; PATHSTART_JOIN] THEN
12137 ASM_SIMP_TAC[pathstart]] THEN
12138 REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12139 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12140 REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; VECTOR_ADD_LID] THEN
12141 (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
12142 [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL;
12143 LIFT_DROP; CONTINUOUS_ON_NEG; DROP_NEG; CONTINUOUS_ON_CONST;
12144 CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
12145 LIFT_NEG; o_DEF; ETA_AX] THEN
12146 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12147 CONTINUOUS_ON_SUBSET)) THEN
12148 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12149 REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
12150 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
12151 REWRITE_TAC[DROP_ADD; DROP_NEG; DROP_VEC; DROP_CMUL; REAL_POS] THEN
12152 SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
12153 `t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN
12154 MATCH_MP_TAC(REAL_ARITH
12155 `t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN
12156 CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC;
12158 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ;
12159 RIGHT_FORALL_IMP_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
12160 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
12161 REWRITE_TAC[SET_RULE
12162 `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
12163 REWRITE_TAC[GSYM path_image; ETA_AX] THEN
12164 REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
12165 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
12166 SUBSET_TRANS)) THEN
12167 REWRITE_TAC[path_image; subpath] THEN
12168 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
12169 REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
12170 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN
12171 SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
12172 REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; REAL_POS] THEN
12173 REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN
12174 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12175 ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN
12176 REPEAT STRIP_TAC THEN
12177 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
12178 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);;
12180 let HOMOTOPIC_LOOPS_CONJUGATE = prove
12181 (`!p q s:real^N->bool.
12182 path p /\ path_image p SUBSET s /\
12183 path q /\ path_image q SUBSET s /\
12184 pathfinish p = pathstart q /\ pathfinish q = pathstart q
12185 ==> homotopic_loops s (p ++ q ++ reversepath p) q`,
12186 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC
12187 `linepath(pathstart q,pathstart q) ++ (q:real^1->real^N) ++
12188 linepath(pathstart q,pathstart q)` THEN
12191 MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
12192 MP_TAC(ISPECL [`s:real^N->bool`;
12193 `(q:real^1->real^N) ++ linepath(pathfinish q,pathfinish q)`]
12194 HOMOTOPIC_PATHS_LID) THEN
12195 ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; SING_SUBSET;
12196 PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH;
12197 PATH_JOIN; PATH_IMAGE_JOIN; PATH_LINEPATH; SEGMENT_REFL] THEN
12199 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN
12200 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
12201 ASM_MESON_TAC[HOMOTOPIC_PATHS_RID]] THEN
12202 REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN
12204 `(\y. (subpath (fstcart y) (vec 1) p ++ q ++ subpath (vec 1) (fstcart y) p)
12205 (sndcart y)):real^(1,1)finite_sum->real^N` THEN
12206 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
12207 SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
12208 PATHSTART_JOIN; PATHFINISH_JOIN;
12209 PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
12210 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
12211 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12212 ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
12213 [RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN
12214 MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12215 REPEAT CONJ_TAC THENL
12217 MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12218 REPEAT CONJ_TAC THENL
12219 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12220 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12221 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12222 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12223 CONTINUOUS_ON_SUBSET)) THEN
12224 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12225 SIMP_TAC[SNDCART_PASTECART];
12227 REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_REWRITE_TAC[pathfinish]];
12228 REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_SUBPATH] THEN
12229 ASM_REWRITE_TAC[pathstart]] THEN
12230 REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12231 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12233 [REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
12234 SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART] THEN
12235 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12236 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12237 REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
12238 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
12240 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12241 CONTINUOUS_ON_SUBSET)) THEN
12242 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12243 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
12244 REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; DROP_CMUL]])
12246 [REPEAT STRIP_TAC THENL
12247 [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN
12248 TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC;
12249 REWRITE_TAC[REAL_ARITH `t + (&1 - t) * x <= &1 <=>
12250 (&1 - t) * x <= (&1 - t) * &1`] THEN
12251 MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC];
12252 REPEAT STRIP_TAC THENL
12253 [MATCH_MP_TAC(REAL_ARITH
12254 `x * (&1 - t) <= x * &1 /\ x <= &1
12255 ==> &0 <= &1 + (t - &1) * x`) THEN
12256 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
12257 ASM_REAL_ARITH_TAC;
12258 REWRITE_TAC[REAL_ARITH
12259 `a + (t - &1) * x <= a <=> &0 <= (&1 - t) * x`] THEN
12260 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]];
12261 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12262 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12263 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12264 REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
12265 `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
12266 REPEAT STRIP_TAC THEN
12267 REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
12268 ASM_REWRITE_TAC[] THEN
12269 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image p:real^N->bool` THEN
12270 ASM_REWRITE_TAC[] THEN
12271 MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
12272 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;
12274 (* ------------------------------------------------------------------------- *)
12275 (* Relating homotopy of trivial loops to path-connectedness. *)
12276 (* ------------------------------------------------------------------------- *)
12278 let PATH_COMPONENT_IMP_HOMOTOPIC_POINTS = prove
12280 path_component s a b
12281 ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
12282 REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN
12283 REPEAT GEN_TAC THEN REWRITE_TAC[pathstart; pathfinish; path_image; path] THEN
12284 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12285 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
12286 EXISTS_TAC `\y:real^(1,1)finite_sum. (g(fstcart y):real^N)` THEN
12287 ASM_SIMP_TAC[FSTCART_PASTECART; linepath] THEN
12288 REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % a:real^N = a`] THEN
12289 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
12290 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
12291 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12292 CONTINUOUS_ON_SUBSET)) THEN
12293 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; FSTCART_PASTECART]);;
12295 let HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE = prove
12296 (`!s p q:real^1->real^N t.
12297 homotopic_loops s p q /\ t IN interval[vec 0,vec 1]
12298 ==> path_component s (p t) (q t)`,
12299 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
12300 REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN
12301 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` MP_TAC) THEN
12303 EXISTS_TAC `\u. (h:real^(1,1)finite_sum->real^N) (pastecart u t)` THEN
12304 ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
12305 [REWRITE_TAC[path] THEN
12306 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
12308 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
12309 REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
12310 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12311 CONTINUOUS_ON_SUBSET)) THEN
12312 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12314 REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;
12316 let HOMOTOPIC_POINTS_EQ_PATH_COMPONENT = prove
12318 homotopic_loops s (linepath(a,a)) (linepath(b,b)) <=>
12319 path_component s a b`,
12320 REPEAT GEN_TAC THEN EQ_TAC THEN
12321 REWRITE_TAC[PATH_COMPONENT_IMP_HOMOTOPIC_POINTS] THEN
12322 DISCH_THEN(MP_TAC o SPEC `vec 0:real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12323 HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE)) THEN
12324 REWRITE_TAC[linepath; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
12325 REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
12327 let PATH_CONNECTED_EQ_HOMOTOPIC_POINTS = prove
12329 path_connected s <=>
12330 !a b. a IN s /\ b IN s
12331 ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
12332 GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
12333 REWRITE_TAC[path_connected; path_component]);;
12335 (* ------------------------------------------------------------------------- *)
12336 (* Homotopy of "nearby" function, paths and loops. *)
12337 (* ------------------------------------------------------------------------- *)
12339 let HOMOTOPIC_WITH_LINEAR = prove
12340 (`!f g:real^M->real^N s t.
12341 f continuous_on s /\ g continuous_on s /\
12342 (!x. x IN s ==> segment[f x,g x] SUBSET t)
12343 ==> homotopic_with (\z. T) (s,t) f g`,
12344 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN
12346 `\y. ((&1 - drop(fstcart y)) % (f:real^M->real^N)(sndcart y) +
12347 drop(fstcart y) % g(sndcart y):real^N)` THEN
12348 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
12349 ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_SUB_RZERO] THEN
12350 REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
12351 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
12352 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
12353 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
12354 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12355 REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
12356 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
12357 LINEAR_FSTCART; ETA_AX] THEN
12358 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12359 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12360 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12361 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12362 CONTINUOUS_ON_SUBSET)) THEN
12363 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12364 SIMP_TAC[SNDCART_PASTECART; FORALL_IN_PCROSS];
12365 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
12366 MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^M`] THEN STRIP_TAC THEN
12367 SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12368 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN
12369 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^M` THEN
12370 ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
12371 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]);;
12373 let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove)
12374 (`(!g s:real^N->bool h.
12375 path g /\ path h /\
12376 pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
12377 (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
12378 ==> homotopic_paths s g h) /\
12379 (!g s:real^N->bool h.
12380 path g /\ path h /\
12381 pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
12382 (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
12383 ==> homotopic_loops s g h)`,
12385 (REWRITE_TAC[pathstart; pathfinish] THEN
12386 REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN
12387 REWRITE_TAC[homotopic_paths; homotopic_loops; homotopic_with; PCROSS] THEN
12389 `\y:real^(1,1)finite_sum.
12390 ((&1 - drop(fstcart y)) % g(sndcart y) +
12391 drop(fstcart y) % h(sndcart y):real^N)` THEN
12392 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
12393 ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN
12394 REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
12395 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
12396 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
12397 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
12398 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12399 REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
12400 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
12401 LINEAR_FSTCART; ETA_AX] THEN
12402 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12403 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12404 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12405 RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
12406 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12407 CONTINUOUS_ON_SUBSET)) THEN
12408 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12409 SIMP_TAC[SNDCART_PASTECART];
12410 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12411 MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN
12412 SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12413 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN
12414 ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
12415 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));;
12417 let HOMOTOPIC_PATHS_NEARBY_EXPLICIT,
12418 HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove)
12419 (`(!g s:real^N->bool h.
12420 path g /\ path h /\
12421 pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
12422 (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
12423 ==> norm(h t - g t) < norm(g t - x))
12424 ==> homotopic_paths s g h) /\
12425 (!g s:real^N->bool h.
12426 path g /\ path h /\
12427 pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
12428 (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
12429 ==> norm(h t - g t) < norm(g t - x))
12430 ==> homotopic_loops s g h)`,
12431 ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
12432 REPEAT STRIP_TAC THENL
12433 [MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR;
12434 MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN
12435 ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN
12436 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
12437 X_GEN_TAC `u:real` THEN STRIP_TAC THEN
12438 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN
12439 ASM_REWRITE_TAC[REAL_NOT_LT] THEN
12440 MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`]
12441 DIST_IN_CLOSED_SEGMENT) THEN
12442 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12443 REWRITE_TAC[segment; FORALL_IN_GSPEC;
12444 ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
12447 let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove)
12448 (`(!g s:real^N->bool.
12449 path g /\ open s /\ path_image g SUBSET s
12452 pathstart h = pathstart g /\
12453 pathfinish h = pathfinish g /\
12454 (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
12455 ==> homotopic_paths s g h) /\
12456 (!g s:real^N->bool.
12457 path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s
12460 pathfinish h = pathstart h /\
12461 (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
12462 ==> homotopic_loops s g h)`,
12464 REPEAT STRIP_TAC THEN
12465 MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`]
12466 SEPARATE_COMPACT_CLOSED) THEN
12467 ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN
12468 (ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN
12469 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
12470 REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
12471 X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL
12472 [MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT;
12473 MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN
12474 ASM_REWRITE_TAC[] THEN
12475 MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN
12476 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN
12477 ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12478 ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
12480 (* ------------------------------------------------------------------------- *)
12481 (* Homotopy of non-antipodal sphere maps. *)
12482 (* ------------------------------------------------------------------------- *)
12484 let HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS = prove
12485 (`!f g:real^M->real^N s a r.
12486 f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
12487 g continuous_on s /\ IMAGE g s SUBSET sphere(a,r) /\
12488 (!x. x IN s ==> ~(midpoint(f x,g x) = a))
12489 ==> homotopic_with (\x. T) (s,sphere(a,r)) f g`,
12490 REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
12491 [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
12492 REPEAT(EXISTS_TAC `g:real^M->real^N`) THEN
12493 ASM_REWRITE_TAC[HOMOTOPIC_WITH_REFL] THEN
12494 SUBGOAL_THEN `?c:real^N. sphere(a,r) SUBSET {c}` MP_TAC THENL
12495 [ALL_TAC; ASM SET_TAC[]] THEN
12496 ASM_CASES_TAC `r = &0` THEN
12497 ASM_SIMP_TAC[SPHERE_SING; SPHERE_EMPTY; REAL_LT_LE] THEN
12498 MESON_TAC[SUBSET_REFL; EMPTY_SUBSET];
12499 RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN STRIP_TAC] THEN
12501 `homotopic_with (\z. T) (s:real^M->bool,(:real^N) DELETE a) f g`
12503 [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
12504 ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE a <=> ~(a IN s)`] THEN
12505 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
12506 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN
12507 REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE; IMP_IMP] THEN
12508 REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
12509 FIRST_X_ASSUM(MP_TAC o GSYM o SPEC `x:real^M`) THEN
12510 ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; MIDPOINT_BETWEEN] THEN
12511 MESON_TAC[DIST_SYM];
12513 DISCH_THEN(MP_TAC o
12514 ISPECL [`\y:real^N. a + r / norm(y - a) % (y - a)`;
12515 `sphere(a:real^N,r)`] o
12516 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12517 HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
12518 REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
12520 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
12521 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12522 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
12523 REWRITE_TAC[real_div; o_DEF; LIFT_CMUL] THEN
12524 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
12525 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
12526 SIMP_TAC[IN_DELETE; NORM_EQ_0; VECTOR_SUB_EQ] THEN
12527 MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
12528 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
12529 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE; IN_SPHERE] THEN
12530 REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b`] THEN
12531 SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
12532 ASM_SIMP_TAC[real_abs; REAL_LE_RMUL; REAL_DIV_RMUL;
12533 NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_LE]];
12534 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
12535 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE]) THEN
12536 ASM_SIMP_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN
12537 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN
12538 VECTOR_ARITH_TAC]);;
12540 let HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS = prove
12541 (`!f g:real^M->real^N s r.
12542 f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,r) /\
12543 g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,r) /\
12544 (!x. x IN s ==> ~(f x = --g x))
12545 ==> homotopic_with (\x. T) (s,sphere(vec 0,r)) f g`,
12546 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS THEN
12547 ASM_REWRITE_TAC[midpoint; VECTOR_ARITH
12548 `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`]);;
12550 (* ------------------------------------------------------------------------- *)
12551 (* Retracts, in a general sense, preserve (co)homotopic triviality. *)
12552 (* ------------------------------------------------------------------------- *)
12554 let HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
12555 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12556 (h continuous_on s /\ IMAGE h s = t /\
12557 k continuous_on t /\ IMAGE k t SUBSET s /\
12558 (!y. y IN t ==> h(k y) = y) /\
12559 (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
12560 (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
12561 (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
12562 (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ P f /\
12563 g continuous_on u /\ IMAGE g u SUBSET s /\ P g
12564 ==> homotopic_with P (u,s) f g)
12565 ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f /\
12566 g continuous_on u /\ IMAGE g u SUBSET t /\ Q g
12567 ==> homotopic_with Q (u,t) f g)`,
12568 REPEAT GEN_TAC THEN STRIP_TAC THEN
12569 MAP_EVERY X_GEN_TAC [`p:real^P->real^N`; `q:real^P->real^N`] THEN
12570 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
12571 [`(k:real^N->real^M) o (p:real^P->real^N)`;
12572 `(k:real^N->real^M) o (q:real^P->real^N)`]) THEN
12574 [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
12575 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12576 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12577 CONTINUOUS_ON_SUBSET))) THEN
12580 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12581 [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
12582 `(h:real^M->real^N) o (k:real^N->real^M) o (q:real^P->real^N)`] THEN
12583 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12584 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12585 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12586 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12587 HOMOTOPIC_WITH_MONO)) THEN
12590 let HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
12591 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12592 (h continuous_on s /\ IMAGE h s = t /\
12593 k continuous_on t /\ IMAGE k t SUBSET s /\
12594 (!y. y IN t ==> h(k y) = y) /\
12595 (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
12596 (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
12597 (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
12598 (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f
12599 ==> ?c. homotopic_with P (u,s) f (\x. c))
12600 ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f
12601 ==> ?c. homotopic_with Q (u,t) f (\x. c))`,
12602 REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^P->real^N` THEN
12603 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
12604 `(k:real^N->real^M) o (p:real^P->real^N)`) THEN
12606 [ASM_SIMP_TAC[IMAGE_o] THEN CONJ_TAC THEN
12607 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12608 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12609 CONTINUOUS_ON_SUBSET))) THEN
12611 DISCH_THEN(X_CHOOSE_TAC `c:real^M`)] THEN
12612 EXISTS_TAC `(h:real^M->real^N) c` THEN
12613 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12614 [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
12615 `(h:real^M->real^N) o ((\x. c):real^P->real^M)`] THEN
12616 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12617 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12618 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12619 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12620 HOMOTOPIC_WITH_MONO)) THEN
12623 let COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
12624 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12625 (h continuous_on s /\ IMAGE h s = t /\
12626 k continuous_on t /\ IMAGE k t SUBSET s /\
12627 (!y. y IN t ==> h(k y) = y) /\
12628 (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
12629 (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
12630 (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
12631 (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ P f /\
12632 g continuous_on s /\ IMAGE g s SUBSET u /\ P g
12633 ==> homotopic_with P (s,u) f g)
12634 ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f /\
12635 g continuous_on t /\ IMAGE g t SUBSET u /\ Q g
12636 ==> homotopic_with Q (t,u) f g)`,
12637 REPEAT GEN_TAC THEN STRIP_TAC THEN
12638 MAP_EVERY X_GEN_TAC [`p:real^N->real^P`; `q:real^N->real^P`] THEN
12639 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
12640 [`(p:real^N->real^P) o (h:real^M->real^N)`;
12641 `(q:real^N->real^P) o (h:real^M->real^N)`]) THEN
12643 [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
12644 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12645 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12646 CONTINUOUS_ON_SUBSET))) THEN
12649 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12650 [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
12651 `((q:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`] THEN
12652 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12653 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12654 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12655 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12656 HOMOTOPIC_WITH_MONO)) THEN
12659 let COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
12660 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12661 (h continuous_on s /\ IMAGE h s = t /\
12662 k continuous_on t /\ IMAGE k t SUBSET s /\
12663 (!y. y IN t ==> h(k y) = y) /\
12664 (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
12665 (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
12666 (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
12667 (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f
12668 ==> ?c. homotopic_with P (s,u) f (\x. c))
12669 ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f
12670 ==> ?c. homotopic_with Q (t,u) f (\x. c))`,
12671 REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^N->real^P` THEN
12672 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
12673 `(p:real^N->real^P) o (h:real^M->real^N)`) THEN
12675 [ASM_SIMP_TAC[IMAGE_o] THEN
12676 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12677 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12678 CONTINUOUS_ON_SUBSET))) THEN
12680 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
12681 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12682 [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
12683 `((\x. c):real^M->real^P) o (k:real^N->real^M)`] THEN
12684 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12685 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12686 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12687 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12688 HOMOTOPIC_WITH_MONO)) THEN
12691 (* ------------------------------------------------------------------------- *)
12692 (* Another useful lemma. *)
12693 (* ------------------------------------------------------------------------- *)
12695 let HOMOTOPIC_JOIN_SUBPATHS = prove
12696 (`!g:real^1->real^N s.
12697 path g /\ path_image g SUBSET s /\
12698 u IN interval[vec 0,vec 1] /\
12699 v IN interval[vec 0,vec 1] /\
12700 w IN interval[vec 0,vec 1]
12701 ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`,
12703 (`!g:real^1->real^N s.
12704 drop u <= drop v /\ drop v <= drop w
12705 ==> path g /\ path_image g SUBSET s /\
12706 u IN interval[vec 0,vec 1] /\
12707 v IN interval[vec 0,vec 1] /\
12708 w IN interval[vec 0,vec 1] /\
12709 drop u <= drop v /\ drop v <= drop w
12710 ==> homotopic_paths s
12711 (subpath u v g ++ subpath v w g) (subpath u w g)`,
12712 REPEAT STRIP_TAC THEN
12713 MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
12714 EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
12715 ASM_CASES_TAC `w:real^1 = u` THENL
12717 [`path_image g:real^N->bool`;
12718 `subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN
12719 ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN
12720 REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN
12721 ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET];
12723 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12724 MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
12725 ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
12727 `\t. if drop t <= &1 / &2
12728 then inv(drop(w - u)) % (&2 * drop(v - u)) % t
12729 else inv(drop(w - u)) %
12730 ((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN
12731 REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
12732 REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
12733 [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
12734 REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM;
12735 DROP_ADD; DROP_SUB] THEN
12736 (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
12737 [CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
12738 CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN
12739 REPEAT STRIP_TAC THEN REAL_ARITH_TAC;
12740 SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL
12741 [ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC;
12743 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
12744 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN
12745 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN
12746 ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
12747 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
12748 REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
12749 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12751 [REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN
12752 REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN
12753 ASM_REAL_ARITH_TAC;
12755 REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`;
12756 REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN
12757 MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN
12758 (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN
12759 ASM_REAL_ARITH_TAC;
12760 REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
12761 CONV_TAC REAL_RAT_REDUCE_CONV THEN
12762 REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN
12763 ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV];
12764 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
12765 REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN
12766 ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
12767 ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN
12769 REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
12770 REAL_ARITH_TAC]) in
12772 (`path g /\ path_image g SUBSET s /\
12773 u IN interval[vec 0,vec 1] /\
12774 v IN interval[vec 0,vec 1] /\
12775 w IN interval[vec 0,vec 1] /\
12776 homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
12777 ==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`,
12778 REPEAT STRIP_TAC THEN
12779 ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
12780 SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
12781 ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in
12783 (`path (g:real^1->real^N) /\ path_image g SUBSET s /\
12784 u IN interval[vec 0,vec 1] /\
12785 v IN interval[vec 0,vec 1] /\
12786 w IN interval[vec 0,vec 1] /\
12787 homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
12788 ==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`,
12790 ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH;
12791 HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS;
12792 PATHSTART_JOIN; PATHFINISH_JOIN] in
12793 REPEAT STRIP_TAC THEN
12794 ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
12795 SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
12796 ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN
12797 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12799 `(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN
12801 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12802 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12803 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac;
12805 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12807 `subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN
12809 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12810 MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac;
12812 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12814 `(subpath u v g :real^1->real^N) ++
12815 linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN
12816 CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN
12817 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12818 REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN
12819 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12821 `linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN
12823 [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN
12824 MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac;
12826 REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL;
12827 PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
12828 INSERT_SUBSET; EMPTY_SUBSET] THEN
12829 ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in
12830 REPEAT STRIP_TAC THEN
12831 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
12832 (REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/
12833 drop w <= drop v /\ drop v <= drop u) \/
12834 (drop u <= drop w /\ drop w <= drop v \/
12835 drop v <= drop w /\ drop w <= drop u) \/
12836 (drop v <= drop u /\ drop u <= drop w \/
12837 drop w <= drop u /\ drop u <= drop v)`) THEN
12838 FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o
12839 MATCH_MP lemma1) THEN
12840 ASM_MESON_TAC[lemma2; lemma3]);;
12842 let HOMOTOPIC_LOOPS_SHIFTPATH = prove
12843 (`!s:real^N->bool p q u.
12844 homotopic_loops s p q /\ u IN interval[vec 0,vec 1]
12845 ==> homotopic_loops s (shiftpath u p) (shiftpath u q)`,
12846 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN
12847 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(
12848 (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
12850 `\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N)
12851 (pastecart (fstcart z) t)) (sndcart z)` THEN
12852 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX] THEN
12853 ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN CONJ_TAC THENL
12854 [REWRITE_TAC[shiftpath; DROP_ADD; REAL_ARITH
12855 `u + z <= &1 <=> z <= &1 - u`] THEN
12857 `{ pastecart (t:real^1) (x:real^1) |
12858 t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1]} =
12859 { pastecart (t:real^1) (x:real^1) |
12860 t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1 - u]} UNION
12861 { pastecart (t:real^1) (x:real^1) |
12862 t IN interval[vec 0,vec 1] /\ x IN interval[vec 1 - u,vec 1]}`
12864 [MATCH_MP_TAC(SET_RULE `s UNION s' = u
12865 ==> {f t x | t IN i /\ x IN u} =
12866 {f t x | t IN i /\ x IN s} UNION
12867 {f t x | t IN i /\ x IN s'}`) THEN
12868 UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
12869 REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; DROP_SUB; DROP_VEC] THEN
12872 MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
12873 SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL] THEN
12874 REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; TAUT
12875 `p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN
12876 SIMP_TAC[SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
12877 SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN
12878 SIMP_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
12879 REWRITE_TAC[FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`;
12880 VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN
12881 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12882 ASM_SIMP_TAC[GSYM IN_INTERVAL_1; GSYM DROP_VEC] THEN CONJ_TAC THEN
12883 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12884 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12885 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST;
12886 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
12887 VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN
12888 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12889 CONTINUOUS_ON_SUBSET)) THEN
12890 UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
12891 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12892 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
12893 IN_ELIM_PASTECART_THM; DROP_ADD; DROP_SUB; DROP_VEC] THEN
12895 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12896 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE
12897 `(!t x. t IN i /\ x IN i ==> f t x IN s) <=>
12898 (!t. t IN i ==> IMAGE (f t) i SUBSET s)`] THEN
12899 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN
12900 ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; ETA_AX] THEN
12901 REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;
12903 let HOMOTOPIC_PATHS_LOOP_PARTS = prove
12905 homotopic_loops s (p ++ reversepath q) (linepath(a,a)) /\ path q
12906 ==> homotopic_paths s p q`,
12907 REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
12908 MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL) THEN
12909 REWRITE_TAC[PATHSTART_JOIN] THEN STRIP_TAC THEN
12910 FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
12911 ASM_CASES_TAC `pathfinish p:real^N = pathstart(reversepath q)` THENL
12912 [ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH] THEN STRIP_TAC;
12913 ASM_MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_REVERSEPATH]] THEN
12914 RULE_ASSUM_TAC(REWRITE_RULE[PATHSTART_REVERSEPATH]) THEN
12915 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
12916 ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
12917 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; UNION_SUBSET; SING_SUBSET;
12918 PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
12920 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12921 EXISTS_TAC `p ++ (linepath(pathfinish p:real^N,pathfinish p))` THEN
12923 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12924 MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[];
12926 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12927 EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL
12928 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12929 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12930 ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; PATHSTART_JOIN; PATHSTART_REVERSEPATH;
12931 HOMOTOPIC_PATHS_REFL];
12933 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12934 EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL
12935 [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
12936 ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
12937 PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH];
12939 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12940 EXISTS_TAC `linepath(pathstart p:real^N,pathstart p) ++ q` THEN
12942 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12943 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
12944 REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
12945 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
12946 REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH;
12947 PATHFINISH_REVERSEPATH] THEN
12948 DISCH_THEN(SUBST1_TAC o SYM) THEN
12949 MATCH_MP_TAC HOMOTOPIC_PATHS_LID THEN ASM_REWRITE_TAC[]]);;
12951 let HOMOTOPIC_LOOPS_ADD_SYM = prove
12952 (`!p q:real^1->real^N.
12953 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
12954 path q /\ path_image q SUBSET s /\ pathfinish q = pathstart q /\
12955 pathstart q = pathstart p
12956 ==> homotopic_loops s (p ++ q) (q ++ p)`,
12957 REPEAT STRIP_TAC THEN
12958 MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
12959 SUBGOAL_THEN `lift(&1 / &2) IN interval[vec 0,vec 1]` ASSUME_TAC THENL
12960 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
12961 CONV_TAC REAL_RAT_REDUCE_CONV;
12963 EXISTS_TAC `shiftpath (lift(&1 / &2)) (p ++ q:real^1->real^N)` THEN
12965 [MATCH_MP_TAC HOMOTOPIC_LOOPS_SHIFTPATH_SELF;
12966 MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ] THEN
12967 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
12968 UNION_SUBSET; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
12969 PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH] THEN
12970 SIMP_TAC[shiftpath; joinpaths; LIFT_DROP; DROP_ADD; DROP_SUB; DROP_VEC;
12971 REAL_ARITH `&0 <= t ==> (a + t <= a <=> t = &0)`;
12972 REAL_ARITH `t <= &1 ==> &1 / &2 + t - &1 <= &1 / &2`;
12973 REAL_ARITH `&1 / &2 + t <= &1 <=> t <= &1 / &2`] THEN
12974 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
12975 ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
12976 [REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
12977 COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THENL
12978 [REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_MUL_RZERO] THEN
12979 CONV_TAC REAL_RAT_REDUCE_CONV THEN
12980 ASM_MESON_TAC[LIFT_NUM; pathstart; pathfinish];
12984 REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_ADD; DROP_VEC; DROP_CMUL;
12985 LIFT_DROP] THEN REAL_ARITH_TAC);;
12987 (* ------------------------------------------------------------------------- *)
12988 (* Simply connected sets defined as "all loops are homotopic (as loops)". *)
12989 (* ------------------------------------------------------------------------- *)
12991 let simply_connected = new_definition
12992 `simply_connected(s:real^N->bool) <=>
12993 !p q. path p /\ pathfinish p = pathstart p /\ path_image p SUBSET s /\
12994 path q /\ pathfinish q = pathstart q /\ path_image q SUBSET s
12995 ==> homotopic_loops s p q`;;
12997 let SIMPLY_CONNECTED_EMPTY = prove
12998 (`simply_connected {}`,
12999 REWRITE_TAC[simply_connected; SUBSET_EMPTY] THEN
13000 MESON_TAC[PATH_IMAGE_NONEMPTY]);;
13002 let SIMPLY_CONNECTED_IMP_PATH_CONNECTED = prove
13003 (`!s:real^N->bool. simply_connected s ==> path_connected s`,
13004 REWRITE_TAC[simply_connected; PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
13005 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13006 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
13007 PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
13010 let SIMPLY_CONNECTED_IMP_CONNECTED = prove
13011 (`!s:real^N->bool. simply_connected s ==> connected s`,
13012 SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED;
13013 PATH_CONNECTED_IMP_CONNECTED]);;
13015 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY = prove
13017 simply_connected s <=>
13018 !p a. path p /\ path_image p SUBSET s /\
13019 pathfinish p = pathstart p /\ a IN s
13020 ==> homotopic_loops s p (linepath(a,a))`,
13021 GEN_TAC THEN REWRITE_TAC[simply_connected] THEN EQ_TAC THEN DISCH_TAC THENL
13022 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13023 ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
13024 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
13025 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN
13026 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13027 EXISTS_TAC `linepath(pathstart p:real^N,pathstart p)` THEN
13028 CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM]] THEN
13029 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
13030 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;
13032 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME = prove
13034 simply_connected s <=>
13035 path_connected s /\
13036 !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
13037 ==> ?a. a IN s /\ homotopic_loops s p (linepath(a,a))`,
13038 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
13039 ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THENL
13040 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13041 [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13042 MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE];
13043 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13044 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN
13045 FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
13046 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
13047 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13048 EXISTS_TAC `linepath(b:real^N,b)` THEN
13049 ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
13050 ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]]);;
13052 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL = prove
13054 simply_connected s <=>
13057 !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
13058 ==> homotopic_loops s p (linepath(a,a))`,
13059 GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
13060 ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
13061 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN
13064 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
13065 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
13066 ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN
13067 FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
13068 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
13069 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13070 EXISTS_TAC `linepath(b:real^N,b)` THEN
13071 ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
13072 ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT];
13073 DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
13074 CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
13075 REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
13076 MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN
13077 MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13078 EXISTS_TAC `linepath(a:real^N,a)` THEN
13079 GEN_REWRITE_TAC RAND_CONV [HOMOTOPIC_LOOPS_SYM] THEN
13080 CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13081 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
13082 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
13085 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH = prove
13087 simply_connected s <=>
13088 path_connected s /\
13089 !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
13090 ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
13091 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
13092 [ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
13093 REPEAT STRIP_TAC THEN
13094 MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN
13095 EXISTS_TAC `pathstart p :real^N` THEN
13096 FIRST_X_ASSUM(MATCH_MP_TAC o
13097 REWRITE_RULE[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13098 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
13099 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13100 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN
13101 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13102 EXISTS_TAC `linepath(pathstart p:real^N,pathfinish p)` THEN
13104 [MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
13105 ASM_SIMP_TAC[PATHFINISH_LINEPATH];
13106 ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
13107 RULE_ASSUM_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
13108 FIRST_X_ASSUM MATCH_MP_TAC THEN
13109 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]]);;
13111 let SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS = prove
13113 simply_connected s <=>
13114 path_connected s /\
13115 !p q. path p /\ path_image p SUBSET s /\
13116 path q /\ path_image q SUBSET s /\
13117 pathstart q = pathstart p /\ pathfinish q = pathfinish p
13118 ==> homotopic_paths s p q`,
13119 REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN
13120 EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13121 X_GEN_TAC `p:real^1->real^N` THENL
13122 [X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN
13123 FIRST_X_ASSUM(MP_TAC o SPEC `p ++ reversepath q :real^1->real^N`) THEN
13124 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_REVERSEPATH; PATH_REVERSEPATH;
13125 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH;
13126 PATH_IMAGE_JOIN; UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN
13128 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13129 EXISTS_TAC `p ++ linepath(pathfinish p,pathfinish p):real^1->real^N` THEN
13130 GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_PATHS_SYM] THEN
13131 ASM_SIMP_TAC[HOMOTOPIC_PATHS_RID] THEN
13132 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13133 EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN
13135 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
13136 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_LINEPATH] THEN
13137 ASM_MESON_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_SYM];
13139 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13140 EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN
13142 [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
13143 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
13144 ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH];
13146 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13147 EXISTS_TAC `linepath(pathstart q,pathstart q) ++ q:real^1->real^N` THEN
13149 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
13150 ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL] THEN
13151 ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
13152 ASM_MESON_TAC[HOMOTOPIC_PATHS_LID]];
13153 STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13154 ASM_SIMP_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
13155 REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
13156 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;
13158 let SIMPLY_CONNECTED_RETRACTION_GEN = prove
13159 (`!s:real^M->bool t:real^N->bool h k.
13160 h continuous_on s /\ IMAGE h s = t /\
13161 k continuous_on t /\ IMAGE k t SUBSET s /\
13162 (!y. y IN t ==> h(k y) = y) /\
13164 ==> simply_connected t`,
13165 REPEAT GEN_TAC THEN
13166 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
13167 REWRITE_TAC[simply_connected; path; path_image; homotopic_loops] THEN
13168 ONCE_REWRITE_TAC[TAUT
13169 `a /\ b /\ c /\ a' /\ b' /\ c' <=> a /\ c /\ b /\ a' /\ c' /\ b'`] THEN
13170 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
13171 HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN
13172 MAP_EVERY EXISTS_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
13173 ASM_SIMP_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
13174 REWRITE_TAC[pathfinish; pathstart] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
13176 let HOMEOMORPHIC_SIMPLY_CONNECTED = prove
13177 (`!s:real^M->bool t:real^N->bool.
13178 s homeomorphic t /\ simply_connected s
13179 ==> simply_connected t`,
13180 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13181 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
13182 (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN
13183 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
13184 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
13185 SIMP_TAC[homeomorphism; SUBSET_REFL]);;
13187 let HOMEOMORPHIC_SIMPLY_CONNECTED_EQ = prove
13188 (`!s:real^M->bool t:real^N->bool.
13190 ==> (simply_connected s <=> simply_connected t)`,
13191 REPEAT STRIP_TAC THEN EQ_TAC THEN
13192 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SIMPLY_CONNECTED) THEN
13193 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
13194 ASM_REWRITE_TAC[]);;
13196 let SIMPLY_CONNECTED_TRANSLATION = prove
13197 (`!a:real^N s. simply_connected (IMAGE (\x. a + x) s) <=> simply_connected s`,
13198 REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
13199 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
13200 REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;
13202 add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];;
13204 let SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE = prove
13205 (`!f:real^M->real^N s.
13206 linear f /\ (!x y. f x = f y ==> x = y)
13207 ==> (simply_connected (IMAGE f s) <=> simply_connected s)`,
13208 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
13209 ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
13210 HOMEOMORPHIC_REFL]);;
13212 add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];;
13214 let SIMPLY_CONNECTED_PCROSS = prove
13215 (`!s:real^M->bool t:real^N->bool.
13216 simply_connected s /\ simply_connected t
13217 ==> simply_connected(s PCROSS t)`,
13218 REPEAT GEN_TAC THEN
13219 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13220 REWRITE_TAC[path; path_image; pathstart; pathfinish; FORALL_PASTECART] THEN
13222 MAP_EVERY X_GEN_TAC
13223 [`p:real^1->real^(M,N)finite_sum`; `a:real^M`; `b:real^N`] THEN
13224 REWRITE_TAC[PASTECART_IN_PCROSS; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN
13225 FIRST_X_ASSUM(CONJUNCTS_THEN2
13226 (MP_TAC o SPECL [`fstcart o (p:real^1->real^(M,N)finite_sum)`; `a:real^M`])
13227 (MP_TAC o SPECL [`sndcart o (p:real^1->real^(M,N)finite_sum)`;
13229 ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_FSTCART; LINEAR_SNDCART;
13230 LINEAR_CONTINUOUS_ON; homotopic_loops; homotopic_with;
13231 pathfinish; pathstart; IMAGE_o; o_THM] THEN
13232 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
13233 [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
13234 ASM_MESON_TAC[SNDCART_PASTECART];
13235 DISCH_THEN(X_CHOOSE_THEN
13236 `k:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)] THEN
13238 [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
13239 ASM_MESON_TAC[FSTCART_PASTECART];
13240 DISCH_THEN(X_CHOOSE_THEN
13241 `h:real^(1,1)finite_sum->real^M` STRIP_ASSUME_TAC)] THEN
13243 `(\z. pastecart (h z) (k z))
13244 :real^(1,1)finite_sum->real^(M,N)finite_sum` THEN
13245 ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX] THEN
13246 REWRITE_TAC[LINEPATH_REFL; PASTECART_FST_SND] THEN
13247 ASM_SIMP_TAC[PASTECART_IN_PCROSS]);;
13249 let SIMPLY_CONNECTED_PCROSS_EQ = prove
13250 (`!s:real^M->bool t:real^N->bool.
13251 simply_connected(s PCROSS t) <=>
13252 s = {} \/ t = {} \/ simply_connected s /\ simply_connected t`,
13253 REPEAT GEN_TAC THEN
13254 ASM_CASES_TAC `s:real^M->bool = {}` THEN
13255 ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
13256 ASM_CASES_TAC `t:real^N->bool = {}` THEN
13257 ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
13258 EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
13259 [REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13260 MAP_EVERY X_GEN_TAC [`p:real^1->real^M`; `a:real^M`] THEN
13261 REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13262 FORALL_IN_IMAGE] THEN
13263 STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN
13264 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
13265 DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
13266 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13267 [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13268 DISCH_THEN(MP_TAC o SPECL
13269 [`(\t. pastecart (p t) (b)):real^1->real^(M,N)finite_sum`;
13270 `pastecart (a:real^M) (b:real^N)`]) THEN
13271 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
13272 ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13273 FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
13274 CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
13277 [`(\t. pastecart (p t) b):real^1->real^(M,N)finite_sum`;
13278 `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
13279 `fstcart:real^(M,N)finite_sum->real^M`;
13280 `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`]
13281 HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
13282 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
13283 SIMP_TAC[o_DEF; LINEPATH_REFL; FSTCART_PASTECART; ETA_AX;
13284 SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE];
13285 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13286 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `b:real^N`] THEN
13287 REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13288 FORALL_IN_IMAGE] THEN
13289 STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN
13290 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
13291 DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
13292 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13293 [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13294 DISCH_THEN(MP_TAC o SPECL
13295 [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
13296 `pastecart (a:real^M) (b:real^N)`]) THEN
13297 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
13298 ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13299 FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
13300 CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
13303 [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
13304 `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
13305 `sndcart:real^(M,N)finite_sum->real^N`;
13306 `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`]
13307 HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
13308 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
13309 SIMP_TAC[o_DEF; LINEPATH_REFL; SNDCART_PASTECART; ETA_AX;
13310 SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]]);;
13312 (* ------------------------------------------------------------------------- *)
13313 (* A mapping out of a sphere is nullhomotopic iff it extends to the ball. *)
13314 (* This even works out in the degenerate cases when the radius is <= 0, and *)
13315 (* we also don't need to explicitly assume continuity since it's already *)
13316 (* implicit in both sides of the equivalence. *)
13317 (* ------------------------------------------------------------------------- *)
13319 let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove
13320 (`!f:real^M->real^N s a r.
13321 (?c. homotopic_with (\x. T) (sphere(a,r),s) f (\x. c)) <=>
13322 (?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\
13323 !x. x IN sphere(a,r) ==> g x = f x)`,
13325 (`!f:real^M->real^N g a r.
13328 !x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\
13329 g continuous_on (cball(a,r) DELETE a) /\
13330 (!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x)
13331 ==> f continuous_on cball(a,r)`,
13332 REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
13333 X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN
13334 ASM_CASES_TAC `x:real^M = a` THENL
13335 [ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN
13336 RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN
13337 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
13338 FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
13339 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
13340 GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
13341 X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN
13342 ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0];
13343 MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
13344 EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN
13345 ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN
13347 [RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]);
13349 `(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN
13350 REWRITE_TAC[continuous_on; continuous_within] THEN
13351 DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
13352 ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN
13353 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
13354 ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
13355 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
13356 EXISTS_TAC `min d (norm(x - a:real^M))` THEN
13357 ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN
13358 ASM_MESON_TAC[NORM_SUB; NORM_ARITH
13359 `norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in
13360 REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
13361 REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
13362 (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
13364 [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN
13365 FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN
13366 ASM_SIMP_TAC[HOMOTOPIC_WITH; IMAGE_CLAUSES; EMPTY_GSPEC; NOT_IN_EMPTY;
13367 PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN
13368 REWRITE_TAC[CONTINUOUS_ON_EMPTY];
13369 ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN
13370 SIMP_TAC[HOMOTOPIC_WITH; PCROSS; FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN
13371 ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL
13372 [MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL
13373 [EXISTS_TAC `(f:real^M->real^N) a` THEN
13374 EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN
13375 ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE];
13376 EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN
13378 MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL
13379 [ASM SET_TAC[]; STRIP_TAC] THEN
13380 UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN
13381 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13382 `IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN
13383 REWRITE_TAC[EXISTS_IN_GSPEC] THEN
13384 EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN
13385 ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]];
13388 `!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN
13390 `(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\
13391 IMAGE f {x | norm(x - a) = r} SUBSET s` THEN
13392 REPEAT CONJ_TAC THENL
13394 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
13395 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
13397 DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
13399 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN
13400 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
13401 EXISTS_TAC `cball(a:real^M,r)`;
13402 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13403 `IMAGE g t SUBSET s
13404 ==> u SUBSET t /\ (!x. x IN u ==> f x = g x)
13405 ==> IMAGE f u SUBSET s`)) THEN
13406 ASM_SIMP_TAC[]] THEN
13407 ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN
13408 MESON_TAC[REAL_LE_REFL; NORM_SUB];
13410 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL
13411 [REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
13412 MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN
13414 EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
13415 (pastecart (lift(inv(r) * norm(x - a)))
13416 (a + (if x = a then r % basis 1
13417 else r / norm(x - a) % (x - a))))` THEN
13418 ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ;
13419 LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
13420 REPEAT CONJ_TAC THENL
13421 [MATCH_MP_TAC lemma THEN
13422 EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
13423 (pastecart (lift(inv(r) * norm(x - a)))
13424 (a + r / norm(x - a) % (x - a)))` THEN
13425 SIMP_TAC[] THEN CONJ_TAC THENL
13426 [X_GEN_TAC `e:real` THEN DISCH_TAC THEN
13427 ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN
13428 FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13429 COMPACT_UNIFORMLY_CONTINUOUS)) THEN
13430 SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS;
13431 REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere]
13432 COMPACT_SPHERE; COMPACT_INTERVAL] THEN
13433 REWRITE_TAC[uniformly_continuous_on] THEN
13434 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
13435 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
13436 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
13437 EXISTS_TAC `min r (d * r):real` THEN
13438 ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN
13439 X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN
13440 FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN
13441 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN
13442 ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
13443 DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
13444 `(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN
13445 REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
13446 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
13447 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
13448 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
13449 ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
13450 ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN
13451 REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
13452 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
13453 ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN
13454 REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN
13455 REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN
13456 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN
13457 REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN
13458 ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM;
13459 REAL_ARITH `&0 < r ==> abs r = r`];
13460 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13461 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
13462 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
13463 SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB;
13464 CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
13465 CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
13466 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
13467 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13468 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13469 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
13470 o_DEF; real_div; LIFT_CMUL] THEN
13471 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
13472 REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
13473 GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN
13474 MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
13475 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN
13476 ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN
13477 MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
13478 SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
13479 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13480 CONTINUOUS_ON_SUBSET)) THEN
13481 REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
13482 REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN
13483 SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
13484 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
13485 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
13486 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
13487 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
13488 ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
13489 SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
13490 REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
13491 ASM_REAL_ARITH_TAC]];
13492 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
13493 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13494 `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN
13495 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
13496 REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN
13497 X_GEN_TAC `x:real^M` THEN
13498 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL
13499 [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
13500 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
13501 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
13502 ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE];
13503 REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN
13504 ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL;
13505 REAL_ABS_DIV; REAL_ABS_NORM;
13506 REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN
13507 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]];
13508 GEN_TAC THEN COND_CASES_TAC THEN
13509 ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN
13510 REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]];
13511 DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
13512 EXISTS_TAC `(g:real^M->real^N) a` THEN
13513 ASM_SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN
13514 EXISTS_TAC `\y:real^(1,M)finite_sum.
13516 (a + drop(fstcart y) % (sndcart y - a))` THEN
13517 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
13518 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN
13519 ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL
13520 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13521 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
13522 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
13523 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13524 SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
13525 LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX];
13526 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13527 CONTINUOUS_ON_SUBSET))];
13528 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
13529 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13530 `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN
13531 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
13532 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
13533 REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
13534 ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ;
13535 REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN
13538 (* ------------------------------------------------------------------------- *)
13539 (* Homotopy equivalence. *)
13540 (* ------------------------------------------------------------------------- *)
13542 parse_as_infix("homotopy_equivalent",(12,"right"));;
13544 let homotopy_equivalent = new_definition
13545 `(s:real^M->bool) homotopy_equivalent (t:real^N->bool) <=>
13546 ?f g. f continuous_on s /\ IMAGE f s SUBSET t /\
13547 g continuous_on t /\ IMAGE g t SUBSET s /\
13548 homotopic_with (\x. T) (s,s) (g o f) I /\
13549 homotopic_with (\x. T) (t,t) (f o g) I`;;
13551 let HOMOTOPY_EQUIVALENT = prove
13552 (`!s:real^M->bool t:real^N->bool.
13553 s homotopy_equivalent t <=>
13554 ?f g h. f continuous_on s /\ IMAGE f s SUBSET t /\
13555 g continuous_on t /\ IMAGE g t SUBSET s /\
13556 h continuous_on t /\ IMAGE h t SUBSET s /\
13557 homotopic_with (\x. T) (s,s) (g o f) I /\
13558 homotopic_with (\x. T) (t,t) (f o h) I`,
13559 REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
13560 MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((?x. P x) <=> (?x. Q x))`) THEN
13561 X_GEN_TAC `f:real^M->real^N` THEN
13562 EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN
13563 EXISTS_TAC `(g:real^N->real^M) o f o (h:real^N->real^M)` THEN
13564 ASM_REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THENL
13565 [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
13566 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
13567 (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
13569 TRANS_TAC HOMOTOPIC_WITH_TRANS
13570 `((g:real^N->real^M) o I) o (f:real^M->real^N)` THEN
13571 CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
13572 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13573 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
13574 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13575 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
13576 TRANS_TAC HOMOTOPIC_WITH_TRANS
13577 `(f:real^M->real^N) o I o (h:real^N->real^M)` THEN
13578 CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
13579 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13580 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
13581 REWRITE_TAC[o_ASSOC] THEN
13582 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13583 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]]);;
13585 let HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT = prove
13586 (`!s:real^M->bool t:real^N->bool.
13587 s homeomorphic t ==> s homotopy_equivalent t`,
13588 REPEAT GEN_TAC THEN
13589 REWRITE_TAC[homeomorphic; homotopy_equivalent; homeomorphism] THEN
13590 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
13591 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
13592 CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN
13593 ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM; I_THM; SUBSET_REFL]);;
13595 let HOMOTOPY_EQUIVALENT_REFL = prove
13596 (`!s:real^N->bool. s homotopy_equivalent s`,
13597 SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_REFL]);;
13599 let HOMOTOPY_EQUIVALENT_SYM = prove
13600 (`!s:real^M->bool t:real^N->bool.
13601 s homotopy_equivalent t <=> t homotopy_equivalent s`,
13602 REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
13603 GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
13604 REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);;
13606 let HOMOTOPY_EQUIVALENT_TRANS = prove
13607 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13608 s homotopy_equivalent t /\ t homotopy_equivalent u
13609 ==> s homotopy_equivalent u`,
13610 REPEAT GEN_TAC THEN
13611 SIMP_TAC[homotopy_equivalent; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
13612 SIMP_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
13613 MAP_EVERY X_GEN_TAC
13614 [`f1:real^M->real^N`; `g1:real^N->real^M`;
13615 `f2:real^N->real^P`; `g2:real^P->real^N`] THEN
13617 MAP_EVERY EXISTS_TAC
13618 [`(f2:real^N->real^P) o (f1:real^M->real^N)`;
13619 `(g1:real^N->real^M) o (g2:real^P->real^N)`] THEN
13620 REWRITE_TAC[IMAGE_o] THEN
13623 [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET];ALL_TAC] THEN
13624 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
13625 CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THENL
13626 [EXISTS_TAC `(g1:real^N->real^M) o I o (f1:real^M->real^N)`;
13627 EXISTS_TAC `(f2:real^N->real^P) o I o (g2:real^P->real^N)`] THEN
13628 (CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]]) THEN
13629 REWRITE_TAC[GSYM o_ASSOC] THEN
13630 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13631 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
13632 REWRITE_TAC[o_ASSOC] THEN
13633 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13634 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]);;
13636 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF = prove
13637 (`!f:real^M->real^N s.
13638 linear f /\ (!x y. f x = f y ==> x = y)
13639 ==> (IMAGE f s) homotopy_equivalent s`,
13640 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
13641 MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
13642 ASM_REWRITE_TAC[]);;
13644 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove
13645 (`!f:real^M->real^N s t.
13646 linear f /\ (!x y. f x = f y ==> x = y)
13647 ==> ((IMAGE f s) homotopy_equivalent t <=> s homotopy_equivalent t)`,
13648 REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o
13649 MATCH_MP HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF) THEN
13651 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPY_EQUIVALENT_SYM]);
13652 POP_ASSUM MP_TAC] THEN
13653 REWRITE_TAC[IMP_IMP; HOMOTOPY_EQUIVALENT_TRANS]);;
13655 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove
13656 (`!f:real^M->real^N s t.
13657 linear f /\ (!x y. f x = f y ==> x = y)
13658 ==> (s homotopy_equivalent (IMAGE f t) <=> s homotopy_equivalent t)`,
13659 ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
13660 REWRITE_TAC[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);;
13662 add_linear_invariants
13663 [HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
13664 HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;
13666 let HOMOTOPY_EQUIVALENT_TRANSLATION_SELF = prove
13667 (`!a:real^N s. (IMAGE (\x. a + x) s) homotopy_equivalent s`,
13668 REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
13669 REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
13671 let HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ = prove
13673 (IMAGE (\x. a + x) s) homotopy_equivalent t <=> s homotopy_equivalent t`,
13674 MESON_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_SELF;
13675 HOMOTOPY_EQUIVALENT_SYM; HOMOTOPY_EQUIVALENT_TRANS]);;
13677 let HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ = prove
13679 s homotopy_equivalent (IMAGE (\x. a + x) t) <=> s homotopy_equivalent t`,
13680 ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
13681 REWRITE_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ]);;
13683 add_translation_invariants
13684 [HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ;
13685 HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];;
13687 let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY = prove
13688 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13689 s homotopy_equivalent t
13690 ==> ((!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
13691 g continuous_on u /\ IMAGE g u SUBSET s
13692 ==> homotopic_with (\x. T) (u,s) f g) <=>
13693 (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
13694 g continuous_on u /\ IMAGE g u SUBSET t
13695 ==> homotopic_with (\x. T) (u,t) f g))`,
13697 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13698 s homotopy_equivalent t /\
13699 (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
13700 g continuous_on u /\ IMAGE g u SUBSET s
13701 ==> homotopic_with (\x. T) (u,s) f g)
13702 ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
13703 g continuous_on u /\ IMAGE g u SUBSET t
13704 ==> homotopic_with (\x. T) (u,t) f g)`,
13705 REPEAT STRIP_TAC THEN
13706 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13707 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13708 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13710 `homotopic_with (\x. T) (u,t)
13711 ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
13714 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13715 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
13716 FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
13717 REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
13718 ASM_REWRITE_TAC[] THEN
13719 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13720 CONTINUOUS_ON_SUBSET))) THEN
13722 MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
13723 `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g'
13724 ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN
13726 GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
13727 REWRITE_TAC[o_ASSOC] THEN
13728 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13729 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
13730 REPEAT STRIP_TAC THEN EQ_TAC THEN
13731 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13732 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13734 let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY = prove
13735 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13736 s homotopy_equivalent t
13737 ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
13738 g continuous_on s /\ IMAGE g s SUBSET u
13739 ==> homotopic_with (\x. T) (s,u) f g) <=>
13740 (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
13741 g continuous_on t /\ IMAGE g t SUBSET u
13742 ==> homotopic_with (\x. T) (t,u) f g))`,
13744 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13745 s homotopy_equivalent t /\
13746 (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
13747 g continuous_on s /\ IMAGE g s SUBSET u
13748 ==> homotopic_with (\x. T) (s,u) f g)
13749 ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
13750 g continuous_on t /\ IMAGE g t SUBSET u
13751 ==> homotopic_with (\x. T) (t,u) f g)`,
13752 REPEAT STRIP_TAC THEN
13753 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13754 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13755 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13757 `homotopic_with (\x. T) (t,u)
13758 (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((g o h) o k)`
13760 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13761 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
13762 FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
13763 REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
13764 ASM_REWRITE_TAC[] THEN
13765 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13766 CONTINUOUS_ON_SUBSET))) THEN
13768 MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
13769 `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g'
13770 ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN
13772 GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
13773 REWRITE_TAC[GSYM o_ASSOC] THEN
13774 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13775 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
13776 REPEAT STRIP_TAC THEN EQ_TAC THEN
13777 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13778 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13780 let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL = prove
13781 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13782 s homotopy_equivalent t
13783 ==> ((!f. f continuous_on u /\ IMAGE f u SUBSET s
13784 ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) <=>
13785 (!f. f continuous_on u /\ IMAGE f u SUBSET t
13786 ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c)))`,
13788 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13789 s homotopy_equivalent t /\
13790 (!f. f continuous_on u /\ IMAGE f u SUBSET s
13791 ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c))
13792 ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t
13793 ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`,
13794 REPEAT STRIP_TAC THEN
13795 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13796 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13797 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13798 FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (f:real^P->real^N)`) THEN
13799 REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
13800 [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
13801 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
13802 DISCH_THEN(X_CHOOSE_TAC `c:real^M`) THEN
13803 EXISTS_TAC `(h:real^M->real^N) c`] THEN
13805 `homotopic_with (\x. T) (u,t)
13806 ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
13809 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13810 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
13811 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
13813 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
13814 GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
13815 REWRITE_TAC[o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
13816 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13817 EXISTS_TAC `t:real^N->bool` THEN
13818 ASM_REWRITE_TAC[]]) in
13819 REPEAT STRIP_TAC THEN EQ_TAC THEN
13820 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13821 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13823 let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL = prove
13824 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13825 s homotopy_equivalent t
13826 ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET u
13827 ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) <=>
13828 (!f. f continuous_on t /\ IMAGE f t SUBSET u
13829 ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c)))`,
13831 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13832 s homotopy_equivalent t /\
13833 (!f. f continuous_on s /\ IMAGE f s SUBSET u
13834 ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c))
13835 ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u
13836 ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`,
13837 REPEAT STRIP_TAC THEN
13838 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13839 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13840 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13841 FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^P) o (h:real^M->real^N)`) THEN
13842 REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
13843 [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
13844 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
13845 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
13847 `homotopic_with (\x. T) (t,u)
13848 (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((\x. c) o k)`
13850 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13851 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
13852 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
13854 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
13855 GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
13856 REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
13857 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13858 EXISTS_TAC `t:real^N->bool` THEN
13859 ASM_REWRITE_TAC[]]) in
13860 REPEAT STRIP_TAC THEN EQ_TAC THEN
13861 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13862 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13864 let HOMOTOPY_INVARIANT_CONNECTEDNESS = prove
13865 (`!f:real^M->real^N g s t.
13866 f continuous_on s /\ IMAGE f s SUBSET t /\
13867 g continuous_on t /\ IMAGE g t SUBSET s /\
13868 homotopic_with (\x. T) (t,t) (f o g) I /\
13871 REPEAT STRIP_TAC THEN
13872 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
13873 REWRITE_TAC[o_THM; I_THM] THEN
13874 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
13875 STRIP_ASSUME_TAC) THEN
13877 `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)`
13879 [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
13880 REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
13881 DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
13882 REWRITE_TAC[EXISTS_IN_PCROSS] THEN
13883 ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
13885 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IMP_CONJ] THEN
13886 REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
13887 MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN
13888 MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN
13889 MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]
13890 `!a b. (connected_component t a a' /\ connected_component t b b') /\
13891 connected_component t a b
13892 ==> connected_component t a' b'`) THEN
13893 MAP_EVERY EXISTS_TAC
13894 [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`;
13895 `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN
13897 [REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
13899 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1))
13900 (interval[vec 0,vec 1])`;
13902 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2))
13903 (interval[vec 0,vec 1])`] THEN
13905 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
13906 REWRITE_TAC[CONNECTED_INTERVAL] THEN
13907 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13908 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
13909 CONTINUOUS_ON_CONST] THEN
13910 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13911 CONTINUOUS_ON_SUBSET)) THEN
13912 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13913 REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL
13914 [MATCH_MP_TAC IMAGE_SUBSET THEN
13915 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13916 CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN
13917 REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]);
13918 ASM_REWRITE_TAC[connected_component] THEN
13919 EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
13920 ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN
13921 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
13922 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN
13923 REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
13924 X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
13925 MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN
13926 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);;
13928 let HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS = prove
13929 (`!f:real^M->real^N g s t.
13930 f continuous_on s /\ IMAGE f s SUBSET t /\
13931 g continuous_on t /\ IMAGE g t SUBSET s /\
13932 homotopic_with (\x. T) (t,t) (f o g) I /\
13934 ==> path_connected t`,
13935 REPEAT STRIP_TAC THEN
13936 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
13937 REWRITE_TAC[o_THM; I_THM] THEN
13938 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
13939 STRIP_ASSUME_TAC) THEN
13941 `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)`
13943 [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
13944 REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
13945 DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
13946 REWRITE_TAC[EXISTS_IN_PCROSS] THEN
13947 ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
13949 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IMP_CONJ] THEN
13950 REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
13951 MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN
13952 MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN
13953 MATCH_MP_TAC(MESON[PATH_COMPONENT_TRANS; PATH_COMPONENT_SYM]
13954 `!a b. (path_component t a a' /\ path_component t b b') /\
13955 path_component t a b
13956 ==> path_component t a' b'`) THEN
13957 MAP_EVERY EXISTS_TAC
13958 [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`;
13959 `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN
13961 [REWRITE_TAC[PATH_COMPONENT] THEN CONJ_TAC THENL
13963 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1))
13964 (interval[vec 0,vec 1])`;
13966 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2))
13967 (interval[vec 0,vec 1])`] THEN
13969 [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
13970 REWRITE_TAC[PATH_CONNECTED_INTERVAL] THEN
13971 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13972 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
13973 CONTINUOUS_ON_CONST] THEN
13974 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13975 CONTINUOUS_ON_SUBSET)) THEN
13976 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13977 REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL
13978 [MATCH_MP_TAC IMAGE_SUBSET THEN
13979 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13980 CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN
13981 REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]);
13982 ASM_REWRITE_TAC[PATH_COMPONENT] THEN
13983 EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
13984 ASM_SIMP_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE] THEN
13985 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
13986 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN
13987 REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
13988 X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
13989 MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN
13990 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);;
13992 let HOMOTOPY_EQUIVALENT_CONNECTEDNESS = prove
13993 (`!s:real^M->bool t:real^N->bool.
13994 s homotopy_equivalent t ==> (connected s <=> connected t)`,
13995 REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
13996 EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
13997 (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_CONNECTEDNESS)) THEN
14000 let HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS = prove
14001 (`!s:real^M->bool t:real^N->bool.
14002 s homotopy_equivalent t ==> (path_connected s <=> path_connected t)`,
14003 REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
14004 EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
14005 (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS)) THEN
14008 (* ------------------------------------------------------------------------- *)
14009 (* Contractible sets. *)
14010 (* ------------------------------------------------------------------------- *)
14012 let contractible = new_definition
14013 `contractible s <=> ?a. homotopic_with (\x. T) (s,s) (\x. x) (\x. a)`;;
14015 let CONTRACTIBLE_IMP_SIMPLY_CONNECTED = prove
14016 (`!s:real^N->bool. contractible s ==> simply_connected s`,
14017 GEN_TAC THEN REWRITE_TAC[contractible] THEN
14018 ASM_CASES_TAC `s:real^N->bool = {}` THEN
14019 ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
14020 ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL] THEN
14021 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
14022 DISCH_TAC THEN REWRITE_TAC[homotopic_loops; PCROSS] THEN
14023 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
14024 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
14025 CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN
14026 X_GEN_TAC `p:real^1->real^N` THEN
14027 REWRITE_TAC[path; path_image; pathfinish; pathstart] THEN
14028 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
14029 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
14030 REWRITE_TAC[homotopic_with; SUBSET; FORALL_IN_IMAGE; PCROSS] THEN
14031 REWRITE_TAC[FORALL_IN_GSPEC] THEN
14032 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
14033 STRIP_ASSUME_TAC) THEN
14034 EXISTS_TAC `(h o (\y. pastecart (fstcart y) (p(sndcart y):real^N)))
14035 :real^(1,1)finite_sum->real^N` THEN
14036 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; linepath; o_THM] THEN
14037 CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN
14038 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
14039 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
14040 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
14041 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
14042 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14043 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
14045 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
14046 CONTINUOUS_ON_SUBSET)) THEN
14047 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
14048 ASM_SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART]);;
14050 let CONTRACTIBLE_IMP_CONNECTED = prove
14051 (`!s:real^N->bool. contractible s ==> connected s`,
14052 SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
14053 SIMPLY_CONNECTED_IMP_CONNECTED]);;
14055 let CONTRACTIBLE_IMP_PATH_CONNECTED = prove
14056 (`!s:real^N->bool. contractible s ==> path_connected s`,
14057 SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
14058 SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;
14060 let NULLHOMOTOPIC_THROUGH_CONTRACTIBLE = prove
14061 (`!f:real^M->real^N g:real^N->real^P s t u.
14062 f continuous_on s /\ IMAGE f s SUBSET t /\
14063 g continuous_on t /\ IMAGE g t SUBSET u /\
14065 ==> ?c. homotopic_with (\h. T) (s,u) (g o f) (\x. c)`,
14066 REPEAT STRIP_TAC THEN
14067 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN
14068 DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN
14069 DISCH_THEN(MP_TAC o ISPECL [`g:real^N->real^P`; `u:real^P->bool`] o MATCH_MP
14070 (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
14071 ASM_REWRITE_TAC[] THEN
14072 DISCH_THEN(MP_TAC o ISPECL [`f:real^M->real^N`; `s:real^M->bool`] o MATCH_MP
14073 (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT)) THEN
14074 ASM_REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN
14075 EXISTS_TAC `(g:real^N->real^P) b` THEN ASM_REWRITE_TAC[]);;
14077 let NULLHOMOTOPIC_INTO_CONTRACTIBLE = prove
14078 (`!f:real^M->real^N s t.
14079 f continuous_on s /\ IMAGE f s SUBSET t /\ contractible t
14080 ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`,
14081 REPEAT STRIP_TAC THEN
14082 SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f` SUBST1_TAC THENL
14083 [REWRITE_TAC[o_THM; FUN_EQ_THM];
14084 MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14085 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14088 let NULLHOMOTOPIC_FROM_CONTRACTIBLE = prove
14089 (`!f:real^M->real^N s t.
14090 f continuous_on s /\ IMAGE f s SUBSET t /\ contractible s
14091 ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`,
14092 REPEAT STRIP_TAC THEN
14093 SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x)` SUBST1_TAC THENL
14094 [REWRITE_TAC[o_THM; FUN_EQ_THM];
14095 MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14096 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14099 let HOMOTOPIC_THROUGH_CONTRACTIBLE = prove
14100 (`!f1:real^M->real^N g1:real^N->real^P f2 g2 s t u.
14101 f1 continuous_on s /\ IMAGE f1 s SUBSET t /\
14102 g1 continuous_on t /\ IMAGE g1 t SUBSET u /\
14103 f2 continuous_on s /\ IMAGE f2 s SUBSET t /\
14104 g2 continuous_on t /\ IMAGE g2 t SUBSET u /\
14105 contractible t /\ path_connected u
14106 ==> homotopic_with (\h. T) (s,u) (g1 o f1) (g2 o f2)`,
14107 REPEAT STRIP_TAC THEN MP_TAC(ISPECL
14108 [`f1:real^M->real^N`; `g1:real^N->real^P`; `s:real^M->bool`;
14109 `t:real^N->bool`; `u:real^P->bool`]
14110 NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
14111 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c1:real^P` THEN
14112 DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
14114 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
14115 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MP_TAC(ISPECL
14116 [`f2:real^M->real^N`; `g2:real^N->real^P`; `s:real^M->bool`;
14117 `t:real^N->bool`; `u:real^P->bool`]
14118 NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
14119 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c2:real^P` THEN
14120 DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
14122 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
14123 REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN FIRST_X_ASSUM
14124 (MP_TAC o GEN_REWRITE_RULE I [PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
14127 let HOMOTOPIC_INTO_CONTRACTIBLE = prove
14128 (`!f:real^M->real^N g s t.
14129 f continuous_on s /\ IMAGE f s SUBSET t /\
14130 g continuous_on s /\ IMAGE g s SUBSET t /\
14132 ==> homotopic_with (\h. T) (s,t) f g`,
14133 REPEAT STRIP_TAC THEN SUBGOAL_THEN
14134 `(f:real^M->real^N) = (\x. x) o f /\ (g:real^M->real^N) = (\x. x) o g`
14135 (CONJUNCTS_THEN SUBST1_TAC)
14136 THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN
14137 MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14138 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14139 ASM_SIMP_TAC[IMAGE_ID; SUBSET_REFL; CONTRACTIBLE_IMP_PATH_CONNECTED]);;
14141 let HOMOTOPIC_FROM_CONTRACTIBLE = prove
14142 (`!f:real^M->real^N g s t.
14143 f continuous_on s /\ IMAGE f s SUBSET t /\
14144 g continuous_on s /\ IMAGE g s SUBSET t /\
14145 contractible s /\ path_connected t
14146 ==> homotopic_with (\h. T) (s,t) f g`,
14147 REPEAT STRIP_TAC THEN
14148 REPEAT STRIP_TAC THEN SUBGOAL_THEN
14149 `(f:real^M->real^N) = f o (\x. x) /\ (g:real^M->real^N) = g o (\x. x)`
14150 (CONJUNCTS_THEN SUBST1_TAC)
14151 THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN
14152 MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14153 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14154 ASM_REWRITE_TAC[IMAGE_ID; SUBSET_REFL]);;
14156 let HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS = prove
14157 (`!s:real^M->bool t:real^N->bool.
14158 contractible s /\ contractible t /\ (s = {} <=> t = {})
14159 ==> s homotopy_equivalent t`,
14160 REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
14161 ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_EMPTY] THEN
14162 FIRST_X_ASSUM(X_CHOOSE_TAC `b:real^N` o
14163 GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
14164 STRIP_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
14165 FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^M` o
14166 GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
14167 EXISTS_TAC `(\x. b):real^M->real^N` THEN
14168 EXISTS_TAC `(\y. a):real^N->real^M` THEN
14169 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14170 REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
14171 CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE THEN
14172 ASM_REWRITE_TAC[o_DEF; IMAGE_ID; I_DEF; SUBSET_REFL; CONTINUOUS_ON_ID;
14173 CONTINUOUS_ON_CONST] THEN
14176 let STARLIKE_IMP_CONTRACTIBLE_GEN = prove
14178 (!a t. a IN s /\ &0 <= t /\ t <= &1 ==> P(\x. (&1 - t) % x + t % a)) /\
14180 ==> ?a:real^N. homotopic_with P (s,s) (\x. x) (\x. a)`,
14181 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14182 REWRITE_TAC[starlike] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN
14183 REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN
14184 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
14185 REWRITE_TAC[homotopic_with; PCROSS] THEN
14186 EXISTS_TAC `\y:real^(1,N)finite_sum.
14187 (&1 - drop(fstcart y)) % sndcart y +
14188 drop(fstcart y) % a` THEN
14189 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; IN_INTERVAL_1;
14190 SUBSET; FORALL_IN_IMAGE; REAL_SUB_RZERO; REAL_SUB_REFL; FORALL_IN_GSPEC;
14191 VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN
14192 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
14193 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14194 SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB; CONTINUOUS_ON_SUB;
14195 CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; ETA_AX;
14196 LINEAR_FSTCART; LINEAR_SNDCART]);;
14198 let STARLIKE_IMP_CONTRACTIBLE = prove
14199 (`!s:real^N->bool. starlike s ==> contractible s`,
14200 SIMP_TAC[contractible; STARLIKE_IMP_CONTRACTIBLE_GEN]);;
14202 let CONTRACTIBLE_UNIV = prove
14203 (`contractible(:real^N)`,
14204 SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV]);;
14206 let STARLIKE_IMP_SIMPLY_CONNECTED = prove
14207 (`!s:real^N->bool. starlike s ==> simply_connected s`,
14208 REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
14209 MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);;
14211 let CONVEX_IMP_SIMPLY_CONNECTED = prove
14212 (`!s:real^N->bool. convex s ==> simply_connected s`,
14213 MESON_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_SIMPLY_CONNECTED;
14214 SIMPLY_CONNECTED_EMPTY]);;
14216 let STARLIKE_IMP_PATH_CONNECTED = prove
14217 (`!s:real^N->bool. starlike s ==> path_connected s`,
14218 MESON_TAC[STARLIKE_IMP_SIMPLY_CONNECTED;
14219 SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;
14221 let STARLIKE_IMP_CONNECTED = prove
14222 (`!s:real^N->bool. starlike s ==> connected s`,
14223 MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;
14225 let IS_INTERVAL_SIMPLY_CONNECTED_1 = prove
14226 (`!s:real^1->bool. is_interval s <=> simply_connected s`,
14227 MESON_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
14228 CONVEX_IMP_SIMPLY_CONNECTED; IS_INTERVAL_CONVEX_1]);;
14230 let CONTRACTIBLE_EMPTY = prove
14231 (`contractible {}`,
14232 SIMP_TAC[contractible; HOMOTOPIC_WITH; PCROSS_EMPTY; NOT_IN_EMPTY] THEN
14233 REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN SET_TAC[]);;
14235 let CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS = prove
14236 (`!s t:real^N->bool.
14237 convex s /\ relative_interior s SUBSET t /\ t SUBSET closure s
14238 ==> contractible t`,
14239 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
14240 ASM_SIMP_TAC[SUBSET_EMPTY; CLOSURE_EMPTY; CONTRACTIBLE_EMPTY] THEN
14241 STRIP_TAC THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
14242 MATCH_MP_TAC STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS THEN ASM_MESON_TAC[]);;
14244 let CONVEX_IMP_CONTRACTIBLE = prove
14245 (`!s:real^N->bool. convex s ==> contractible s`,
14246 MESON_TAC[CONVEX_IMP_STARLIKE; CONTRACTIBLE_EMPTY;
14247 STARLIKE_IMP_CONTRACTIBLE]);;
14249 let CONTRACTIBLE_SING = prove
14250 (`!a:real^N. contractible {a}`,
14251 SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SING]);;
14253 let IS_INTERVAL_CONTRACTIBLE_1 = prove
14254 (`!s:real^1->bool. is_interval s <=> contractible s`,
14255 MESON_TAC[CONTRACTIBLE_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
14256 CONVEX_IMP_CONTRACTIBLE; IS_INTERVAL_CONVEX_1]);;
14258 let CONTRACTIBLE_PCROSS = prove
14259 (`!s:real^M->bool t:real^N->bool.
14260 contractible s /\ contractible t ==> contractible(s PCROSS t)`,
14261 REPEAT GEN_TAC THEN REWRITE_TAC[contractible; homotopic_with] THEN
14262 REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
14263 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14264 MAP_EVERY X_GEN_TAC [`a:real^M`; `h:real^(1,M)finite_sum->real^M`] THEN
14265 REPEAT DISCH_TAC THEN
14266 MAP_EVERY X_GEN_TAC [`b:real^N`; `k:real^(1,N)finite_sum->real^N`] THEN
14267 REPEAT DISCH_TAC THEN
14268 EXISTS_TAC `pastecart (a:real^M) (b:real^N)` THEN
14269 EXISTS_TAC `\z. pastecart
14270 ((h:real^(1,M)finite_sum->real^M)
14271 (pastecart (fstcart z) (fstcart(sndcart z))))
14272 ((k:real^(1,N)finite_sum->real^N)
14273 (pastecart (fstcart z) (sndcart(sndcart z))))` THEN
14274 ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
14275 FSTCART_PASTECART; SNDCART_PASTECART] THEN
14276 MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
14277 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
14278 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14279 SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
14280 LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_ID;
14281 GSYM o_DEF; CONTINUOUS_ON_COMPOSE] THEN
14282 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14283 CONTINUOUS_ON_SUBSET)) THEN
14284 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
14285 SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);;
14287 let CONTRACTIBLE_PCROSS_EQ = prove
14288 (`!s:real^M->bool t:real^N->bool.
14289 contractible(s PCROSS t) <=>
14290 s = {} \/ t = {} \/ contractible s /\ contractible t`,
14291 REPEAT GEN_TAC THEN
14292 ASM_CASES_TAC `s:real^M->bool = {}` THEN
14293 ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
14294 ASM_CASES_TAC `t:real^N->bool = {}` THEN
14295 ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
14296 EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_PCROSS] THEN
14297 REWRITE_TAC[contractible; homotopic_with; LEFT_IMP_EXISTS_THM] THEN
14298 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
14299 MAP_EVERY X_GEN_TAC
14300 [`a:real^M`; `b:real^N`;
14301 `h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum`] THEN
14303 SUBGOAL_THEN `(a:real^M) IN s /\ (b:real^N) IN t` STRIP_ASSUME_TAC THENL
14304 [REWRITE_TAC[GSYM PASTECART_IN_PCROSS] THEN
14305 RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
14306 ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
14309 [EXISTS_TAC `a:real^M` THEN
14312 (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
14313 (\z. pastecart (fstcart z) (pastecart (sndcart z) b))`;
14314 EXISTS_TAC `b:real^N` THEN
14317 (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
14318 (\z. pastecart (fstcart z) (pastecart a (sndcart z)))`] THEN
14319 ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
14320 SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; o_THM] THEN
14322 [ALL_TAC; ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS]]) THEN
14323 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14324 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
14325 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14326 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
14327 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
14328 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14329 CONTINUOUS_ON_SUBSET)) THEN
14330 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14331 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]);;
14333 let HOMOTOPY_EQUIVALENT_EMPTY = prove
14334 (`(!s. (s:real^M->bool) homotopy_equivalent ({}:real^N->bool) <=> s = {}) /\
14335 (!t. ({}:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> t = {})`,
14336 REPEAT STRIP_TAC THEN EQ_TAC THEN
14337 SIMP_TAC[HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; CONTRACTIBLE_EMPTY] THEN
14338 REWRITE_TAC[homotopy_equivalent] THEN SET_TAC[]);;
14340 let HOMOTOPY_DOMINATED_CONTRACTIBILITY = prove
14341 (`!f:real^M->real^N g s t.
14342 f continuous_on s /\
14343 IMAGE f s SUBSET t /\
14344 g continuous_on t /\
14345 IMAGE g t SUBSET s /\
14346 homotopic_with (\x. T) (t,t) (f o g) I /\
14348 ==> contractible t`,
14349 REPEAT GEN_TAC THEN SIMP_TAC[contractible; I_DEF] THEN STRIP_TAC THEN
14350 MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
14351 NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
14352 ASM_REWRITE_TAC[contractible; I_DEF] THEN
14353 ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
14354 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN
14355 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN DISCH_TAC THEN
14356 MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
14357 EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN
14358 ASM_REWRITE_TAC[] THEN
14359 SUBGOAL_THEN `(\x. (b:real^N)) = (\x. b) o (g:real^N->real^M)`
14360 SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
14361 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
14362 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]);;
14364 let HOMOTOPY_EQUIVALENT_CONTRACTIBILITY = prove
14365 (`!s:real^M->bool t:real^N->bool.
14366 s homotopy_equivalent t ==> (contractible s <=> contractible t)`,
14367 REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN
14368 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
14369 (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_DOMINATED_CONTRACTIBILITY)) THEN
14372 let HOMOTOPY_EQUIVALENT_SING = prove
14373 (`!s:real^M->bool a:real^N.
14374 s homotopy_equivalent {a} <=> ~(s = {}) /\ contractible s`,
14375 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
14376 ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY; NOT_INSERT_EMPTY] THEN
14378 [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CONTRACTIBILITY) THEN
14379 REWRITE_TAC[CONTRACTIBLE_SING];
14380 DISCH_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS THEN
14381 ASM_REWRITE_TAC[CONTRACTIBLE_SING; NOT_INSERT_EMPTY]]);;
14383 let HOMEOMORPHIC_CONTRACTIBLE_EQ = prove
14384 (`!s:real^M->bool t:real^N->bool.
14385 s homeomorphic t ==> (contractible s <=> contractible t)`,
14386 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBILITY THEN
14387 ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]);;
14389 let HOMEOMORPHIC_CONTRACTIBLE = prove
14390 (`!s:real^M->bool t:real^N->bool.
14391 s homeomorphic t /\ contractible s ==> contractible t`,
14392 MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ]);;
14394 let CONTRACTIBLE_TRANSLATION = prove
14395 (`!a:real^N s. contractible (IMAGE (\x. a + x) s) <=> contractible s`,
14396 REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
14397 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
14398 REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;
14400 add_translation_invariants [CONTRACTIBLE_TRANSLATION];;
14402 let CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE = prove
14403 (`!f:real^M->real^N s.
14404 linear f /\ (!x y. f x = f y ==> x = y)
14405 ==> (contractible (IMAGE f s) <=> contractible s)`,
14406 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
14407 ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
14408 HOMEOMORPHIC_REFL]);;
14410 add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];;
14412 (* ------------------------------------------------------------------------- *)
14413 (* Homeomorphisms between punctured spheres and affine sets. *)
14414 (* ------------------------------------------------------------------------- *)
14416 let HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE = prove
14417 (`!a r b t:real^N->bool p:real^M->bool.
14418 &0 < r /\ b IN sphere(a,r) /\ affine t /\ a IN t /\ b IN t /\
14419 affine p /\ aff_dim t = aff_dim p + &1
14420 ==> ((sphere(a:real^N,r) INTER t) DELETE b) homeomorphic p`,
14421 GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
14422 REWRITE_TAC[sphere; DIST_0; IN_ELIM_THM] THEN
14423 SIMP_TAC[CONJ_ASSOC; NORM_ARITH
14424 `&0 < r /\ norm(b:real^N) = r <=> norm(b) = r /\ ~(b = vec 0)`] THEN
14425 GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN
14426 GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
14427 SIMP_TAC[NORM_MUL; real_abs; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
14428 X_GEN_TAC `b:real` THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_MUL_EQ_0] THEN
14429 DISCH_THEN(K ALL_TAC) THEN DISCH_THEN SUBST1_TAC THEN
14430 REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN
14431 ASM_CASES_TAC `r = &1` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN
14432 CONV_TAC REAL_RAT_REDUCE_CONV THEN
14433 SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN STRIP_TAC THEN
14434 SUBGOAL_THEN `subspace(t:real^N->bool)` ASSUME_TAC THENL
14435 [ASM_MESON_TAC[AFFINE_EQ_SUBSPACE]; ALL_TAC] THEN
14436 TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0} INTER t` THEN
14439 MATCH_MP_TAC HOMEOMORPHIC_AFFINE_SETS THEN
14440 ASM_SIMP_TAC[AFFINE_INTER; AFFINE_STANDARD_HYPERPLANE] THEN
14441 ONCE_REWRITE_TAC[INTER_COMM] THEN
14442 MP_TAC(ISPECL [`basis 1:real^N`; `&0`; `t:real^N->bool`]
14443 AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN
14444 ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
14445 DISCH_THEN SUBST1_TAC THEN
14446 SUBGOAL_THEN `~(t INTER {x:real^N | x$1 = &0} = {})` ASSUME_TAC THENL
14447 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN
14448 EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VEC_COMPONENT];
14450 SUBGOAL_THEN `~(t SUBSET {v:real^N | v$1 = &0})` ASSUME_TAC THENL
14451 [REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN
14452 ASM_SIMP_TAC[IN_ELIM_THM; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
14454 ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]] THEN
14456 `({x:real^N | norm x = &1} INTER t) DELETE (basis 1) =
14457 {x | norm x = &1 /\ ~(x$1 = &1)} INTER t`
14459 [MATCH_MP_TAC(SET_RULE
14460 `s DELETE a = s' ==> (s INTER t) DELETE a = s' INTER t`) THEN
14461 MATCH_MP_TAC(SET_RULE
14462 `Q a /\ (!x. P x /\ Q x ==> x = a)
14463 ==> {x | P x} DELETE a = {x | P x /\ ~Q x}`) THEN
14464 SIMP_TAC[BASIS_COMPONENT; CART_EQ; DIMINDEX_GE_1; LE_REFL] THEN
14465 REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN
14466 X_GEN_TAC `x:real^N` THEN
14467 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
14468 ASM_SIMP_TAC[dot; SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN
14469 REWRITE_TAC[REAL_ARITH `&1 * &1 + s = &1 <=> s = &0`] THEN
14470 DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
14471 SUM_POS_EQ_0_NUMSEG)) THEN
14472 REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN
14473 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
14474 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
14476 REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY ABBREV_TAC
14477 [`f = \x:real^N. &2 % basis 1 + &2 / (&1 - x$1) % (x - basis 1)`;
14479 basis 1 + &4 / (norm y pow 2 + &4) % (y - &2 % basis 1)`] THEN
14480 MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
14481 REPEAT CONJ_TAC THENL
14482 [MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
14483 `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
14484 EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
14485 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14486 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14487 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
14488 REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
14489 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
14490 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
14491 SIMP_TAC[REAL_SUB_0; IN_ELIM_THM] THEN
14492 REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
14493 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14494 MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT THEN
14495 REWRITE_TAC[LE_REFL; DIMINDEX_GE_1];
14496 MATCH_MP_TAC(SET_RULE
14497 `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
14498 ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
14499 EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
14500 ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB] THEN
14501 REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
14502 SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
14503 LE_REFL; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT] THEN
14504 CONV_TAC REAL_FIELD;
14505 MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
14506 `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
14507 EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
14508 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14509 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14510 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
14511 REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
14512 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
14513 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
14514 SIMP_TAC[LIFT_ADD; REAL_POW_LE; NORM_POS_LE; REAL_ARITH
14515 `&0 <= x ==> ~(x + &4 = &0)`] THEN
14516 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
14517 REWRITE_TAC[REAL_POW_2; LIFT_CMUL; CONTINUOUS_ON_CONST] THEN
14518 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14519 REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF];
14520 MATCH_MP_TAC(SET_RULE
14521 `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
14522 ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
14523 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
14524 REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN EXPAND_TAC "g" THEN
14526 [ALL_TAC; ASM_MESON_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB]] THEN
14527 X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
14528 REWRITE_TAC[VECTOR_ARITH
14529 `b + a % (y - &2 % b):real^N = (&1 - &2 * a) % b + a % y`] THEN
14530 REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
14531 `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
14532 ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; LE_REFL;
14533 VECTOR_ADD_COMPONENT; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN
14534 REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; GSYM REAL_POW_2] THEN
14535 SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` MP_TAC THENL
14536 [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
14537 CONV_TAC REAL_FIELD];
14539 `!x. norm x = &1 /\ ~(x$1 = &1)
14540 ==> norm((f:real^N->real^N) x) pow 2 = &4 * (&1 + x$1) / (&1 - x$1)`
14542 [REPEAT STRIP_TAC THEN EXPAND_TAC "f" THEN
14543 REWRITE_TAC[VECTOR_ARITH
14544 `a % b + m % (x - b):real^N = (a - m) % b + m % x`] THEN
14545 REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
14546 `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
14547 SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT;
14548 DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_COMPONENT] THEN
14549 ASM_REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_MUL_RID;
14551 UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
14553 EXPAND_TAC "g" THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
14554 ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
14555 ASM_SIMP_TAC[REAL_FIELD
14557 ==> &4 * (&1 + x) / (&1 - x) + &4 = &8 / (&1 - x)`] THEN
14558 REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN
14559 REWRITE_TAC[REAL_ARITH `&4 * inv(&8) * x = x / &2`] THEN
14560 EXPAND_TAC "f" THEN
14561 REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
14562 REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
14563 `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
14564 REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN
14565 UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
14566 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
14568 SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` ASSUME_TAC THENL
14569 [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
14571 SUBGOAL_THEN `((g:real^N->real^N) y)$1 =
14572 (y dot y - &4) / (y dot y + &4)` ASSUME_TAC THENL
14573 [EXPAND_TAC "g" THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN
14574 REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN
14575 ASM_SIMP_TAC[BASIS_COMPONENT; LE_REFL; NORM_POW_2; DIMINDEX_GE_1] THEN
14576 UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN
14577 CONV_TAC REAL_FIELD;
14579 EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
14580 EXPAND_TAC "g" THEN SIMP_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
14581 REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
14582 `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
14583 REWRITE_TAC[VECTOR_MUL_EQ_0; NORM_POW_2] THEN DISJ1_TAC THEN
14584 UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD]);;
14586 let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN = prove
14587 (`!s:real^N->bool t:real^M->bool a.
14588 convex s /\ bounded s /\ a IN relative_frontier s /\
14589 affine t /\ aff_dim s = aff_dim t + &1
14590 ==> (relative_frontier s DELETE a) homeomorphic t`,
14591 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
14592 ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_GE; INT_ARITH
14593 `--(&1):int <= s ==> ~(--(&1) = s + &1)`] THEN
14594 MP_TAC(ISPECL [`(:real^N)`; `aff_dim(s:real^N->bool)`]
14595 CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV] THEN
14596 REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFFINE_UNIV] THEN
14597 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
14598 SUBGOAL_THEN `~(t:real^N->bool = {})` MP_TAC THENL
14599 [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN
14600 GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
14601 DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN STRIP_TAC THEN
14603 [`s:real^N->bool`; `ball(z:real^N,&1) INTER t`]
14604 HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
14605 MP_TAC(ISPECL [`t:real^N->bool`; `ball(z:real^N,&1)`]
14606 (ONCE_REWRITE_RULE[INTER_COMM] AFF_DIM_CONVEX_INTER_OPEN)) THEN
14607 MP_TAC(ISPECL [`ball(z:real^N,&1)`; `t:real^N->bool`]
14608 RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
14609 ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; CONVEX_BALL;
14610 AFFINE_IMP_CONVEX; INTERIOR_OPEN; OPEN_BALL;
14611 FRONTIER_BALL; REAL_LT_01] THEN
14612 SUBGOAL_THEN `~(ball(z:real^N,&1) INTER t = {})` ASSUME_TAC THENL
14613 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
14614 EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01];
14615 ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN SIMP_TAC[]] THEN
14616 REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
14617 MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
14618 STRIP_TAC THEN REWRITE_TAC[GSYM homeomorphic] THEN
14619 TRANS_TAC HOMEOMORPHIC_TRANS
14620 `(sphere(z,&1) INTER t) DELETE (h:real^N->real^N) a` THEN
14622 [REWRITE_TAC[homeomorphic] THEN
14623 MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
14624 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
14625 REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
14626 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
14628 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
14632 MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN
14633 ASM_REWRITE_TAC[REAL_LT_01; GSYM IN_INTER] THEN
14634 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
14637 let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE = prove
14638 (`!a r b:real^N t:real^M->bool.
14639 &0 < r /\ b IN sphere(a,r) /\ affine t /\ aff_dim(t) + &1 = &(dimindex(:N))
14640 ==> (sphere(a:real^N,r) DELETE b) homeomorphic t`,
14641 REPEAT STRIP_TAC THEN
14642 MP_TAC(ISPECL [`cball(a:real^N,r)`; `t:real^M->bool`; `b:real^N`]
14643 HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
14644 ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL;
14645 CONVEX_CBALL; BOUNDED_CBALL]);;
14647 let HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE = prove
14649 &0 < r /\ b IN sphere(a,r) /\ ~(c = vec 0)
14650 ==> (sphere(a:real^N,r) DELETE b) homeomorphic
14651 {x:real^N | c dot x = d}`,
14652 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE THEN
14653 ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);;
14655 let HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV = prove
14657 &0 < r /\ b IN sphere(a,r) /\ dimindex(:N) = dimindex(:M) + 1
14658 ==> (sphere(a:real^N,r) DELETE b) homeomorphic (:real^M)`,
14659 REPEAT STRIP_TAC THEN
14660 TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis 1 dot x = &0}` THEN
14661 ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANE_UNIV; BASIS_NONZERO; LE_REFL;
14662 DIMINDEX_GE_1; HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE]);;
14664 let CONTRACTIBLE_PUNCTURED_SPHERE = prove
14666 &0 < r /\ b IN sphere(a,r) ==> contractible(sphere(a,r) DELETE b)`,
14667 REPEAT STRIP_TAC THEN
14668 SUBGOAL_THEN `contractible {x:real^N | basis 1 dot x = &0}` MP_TAC THENL
14669 [SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_HYPERPLANE];
14670 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_CONTRACTIBLE) THEN
14671 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
14672 MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE THEN
14673 ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]]);;
14675 (* ------------------------------------------------------------------------- *)
14676 (* When dealing with AR, ANR and ANR later, it's useful to know that any set *)
14677 (* at all is homeomorphic to a closed subset of a convex set, and if the *)
14678 (* set is locally compact we can take the convex set to be the universe. *)
14679 (* ------------------------------------------------------------------------- *)
14681 let HOMEOMORPHIC_CLOSED_IN_CONVEX = prove
14683 aff_dim s < &(dimindex(:N))
14684 ==> ?u t:real^N->bool.
14687 closed_in (subtopology euclidean u) t /\
14689 GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
14690 [REPEAT STRIP_TAC THEN
14691 MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN
14692 REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; CLOSED_IN_EMPTY] THEN
14693 ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY];
14694 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN
14695 DISCH_THEN(X_CHOOSE_THEN `a:real^M` MP_TAC) THEN
14696 GEOM_ORIGIN_TAC `a:real^M` THEN
14697 SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LT] THEN REPEAT STRIP_TAC THEN
14698 MP_TAC(ISPECL [`{x:real^N | x$1 = &0}`; `dim(s:real^M->bool)`]
14699 CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
14700 SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_GE_1; LE_REFL; SUBSET; IN_ELIM_THM;
14701 SPAN_OF_SUBSPACE; SUBSPACE_SPECIAL_HYPERPLANE] THEN
14702 ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
14703 X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
14704 MP_TAC(ISPECL [`span s:real^M->bool`; `t:real^N->bool`]
14705 ISOMETRIES_SUBSPACES) THEN
14706 ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; LEFT_IMP_EXISTS_THM] THEN
14707 MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
14708 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
14710 MP_TAC(ISPECL [`vec 0:real^N`; `&1`; `basis 1:real^N`;
14711 `{x:real^N | basis 1 dot x = &0}`]
14712 HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE) THEN
14713 SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; BASIS_NONZERO;
14714 DIMINDEX_GE_1; LE_REFL; REAL_LT_01; IN_SPHERE_0; NORM_BASIS] THEN
14715 ANTS_TAC THENL [INT_ARITH_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
14716 SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; homeomorphic] THEN
14717 REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM;
14718 SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN
14719 MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
14721 EXISTS_TAC `ball(vec 0,&1) UNION
14722 IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN
14723 EXISTS_TAC `IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN
14724 REPEAT CONJ_TAC THENL
14725 [MATCH_MP_TAC CONVEX_INTERMEDIATE_BALL THEN
14726 MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN
14727 REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; BALL_SUBSET_CBALL] THEN
14728 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_CBALL_0] THEN
14729 ASM_MESON_TAC[SPAN_SUPERSET; REAL_LE_REFL];
14730 REWRITE_TAC[NOT_IN_EMPTY; IMAGE_o] THEN ASM SET_TAC[];
14731 REWRITE_TAC[CLOSED_IN_CLOSED] THEN
14732 EXISTS_TAC `sphere(vec 0:real^N,&1)` THEN
14733 REWRITE_TAC[CLOSED_SPHERE] THEN MATCH_MP_TAC(SET_RULE
14734 `b INTER t = {} /\ s SUBSET t ==> s = (b UNION s) INTER t`) THEN
14735 REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN
14736 CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[SUBSET]] THEN
14737 REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_SPHERE_0] THEN
14738 ASM_MESON_TAC[SPAN_SUPERSET];
14739 MAP_EVERY EXISTS_TAC
14740 [`(k:real^N->real^M) o (g:real^N->real^N)`;
14741 `(f:real^N->real^N) o (h:real^M->real^N)`] THEN
14742 REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IMAGE_o] THEN
14743 REPEAT CONJ_TAC THEN
14744 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14745 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN
14746 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14747 CONTINUOUS_ON_SUBSET))) THEN
14748 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN
14749 MP_TAC(ISPEC `s:real^M->bool` SPAN_INC) THEN ASM SET_TAC[]]);;
14751 let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove
14753 locally compact s /\ dimindex(:M) < dimindex(:N)
14754 ==> ?t:real^N->bool. closed t /\ s homeomorphic t`,
14755 REPEAT STRIP_TAC THEN SUBGOAL_THEN
14756 `?t:real^(M,1)finite_sum->bool h.
14757 closed t /\ homeomorphism (s,t) (h,fstcart)`
14758 STRIP_ASSUME_TAC THENL
14759 [ASM_SIMP_TAC[LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED];
14762 `f:real^(M,1)finite_sum->real^N =
14763 \x. lambda i. if i <= dimindex(:M) then x$i
14764 else x$(dimindex(:M)+1)` THEN
14766 `g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN
14767 EXISTS_TAC `IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN
14768 SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL
14769 [EXPAND_TAC "f" THEN REWRITE_TAC[linear; CART_EQ] THEN
14770 SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
14773 SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL
14774 [EXPAND_TAC "g" THEN REWRITE_TAC[linear; CART_EQ] THEN
14775 SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
14779 `!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) =
14782 [MAP_EVERY EXPAND_TAC ["f"; "g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP
14783 (ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN
14784 SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN
14785 REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN
14788 CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN
14789 TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN
14790 CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN
14791 REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC
14792 [`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN
14793 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;
14795 (* ------------------------------------------------------------------------- *)
14796 (* Simple connectedness of a union. This is essentially a stripped-down *)
14797 (* version of the Seifert - Van Kampen theorem. *)
14798 (* ------------------------------------------------------------------------- *)
14800 let SIMPLY_CONNECTED_UNION = prove
14801 (`!s t:real^N->bool.
14802 open_in (subtopology euclidean (s UNION t)) s /\
14803 open_in (subtopology euclidean (s UNION t)) t /\
14804 simply_connected s /\ simply_connected t /\
14805 path_connected (s INTER t) /\ ~(s INTER t = {})
14806 ==> simply_connected (s UNION t)`,
14807 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
14808 DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool`
14809 (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
14810 DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->bool`
14811 (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
14812 SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; PATH_CONNECTED_UNION] THEN
14813 REPEAT STRIP_TAC THEN
14814 SUBGOAL_THEN `(pathstart p:real^N) IN s UNION t` MP_TAC THENL
14815 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[IN_UNION]] THEN
14816 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
14817 ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
14818 MAP_EVERY (fun s -> let x = mk_var(s,`:real^N->bool`) in SPEC_TAC(x,x))
14819 ["v"; "u"; "t"; "s"] THEN
14820 MATCH_MP_TAC(MESON[]
14821 `(!s t u v. x IN s ==> P x s t u v) /\
14822 (!x s t u v. P x s t u v ==> P x t s v u)
14823 ==> (!s t u v. x IN s \/ x IN t ==> P x s t u v)`) THEN
14826 REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN
14827 MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN
14830 !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\
14832 ==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/
14833 path_image(subpath x y p) SUBSET t`
14834 STRIP_ASSUME_TAC THENL
14835 [MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN
14836 ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN
14837 DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN
14838 SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
14839 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14840 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
14841 MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`]
14842 COMPACT_UNIFORMLY_CONTINUOUS) THEN
14843 ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN
14844 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN
14845 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
14846 ASM_REWRITE_TAC[] THEN
14847 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
14848 FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN
14849 ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN
14850 MATCH_MP_TAC(SET_RULE
14851 `!p'. p SUBSET b /\
14852 (s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\
14853 p SUBSET p' /\ p' SUBSET s UNION t
14854 ==> (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN
14855 EXISTS_TAC `path_image(p:real^1->real^N)` THEN
14856 ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN
14857 REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN
14858 SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL
14859 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
14860 ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN
14861 ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist];
14862 REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN
14863 X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN
14864 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
14865 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN
14866 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
14867 COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
14868 ASM_REAL_ARITH_TAC];
14869 MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
14870 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
14871 X_GEN_TAC `N:num` THEN STRIP_TAC] THEN
14873 `!n. n <= N /\ p(lift(&n / &N)) IN s
14874 ==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\
14875 homotopic_paths (s UNION t)
14876 (subpath (vec 0) (lift(&n / &N)) p) q`
14879 DISCH_THEN(MP_TAC o SPEC `N:num`) THEN
14880 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN
14881 ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
14882 DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN
14883 REWRITE_TAC[SUBPATH_TRIVIAL] THEN
14884 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14885 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
14886 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
14887 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
14888 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
14889 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
14890 EXISTS_TAC `s:real^N->bool` THEN
14891 ASM_MESON_TAC[SUBSET_UNION]] THEN
14894 ==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
14895 SUBSET (s:real^N->bool) \/
14896 path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
14899 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
14900 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC;
14901 NORM_REAL; GSYM drop;
14902 REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN
14903 ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ;
14904 REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN
14905 ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV;
14906 REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
14909 MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
14910 REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN
14911 ASM_CASES_TAC `n = 0` THENL
14912 [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN
14913 EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN
14914 REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN
14915 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
14916 UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN
14919 MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN
14921 MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
14923 [CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN
14924 ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN
14925 ASM_MESON_TAC[pathstart];
14926 DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN
14929 path_image(q:real^1->real^N) SUBSET s /\
14930 homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q`
14931 STRIP_ASSUME_TAC THENL
14932 [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
14935 `!i. m < i /\ i <= n
14936 ==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/
14937 path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET
14940 [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN
14941 X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
14942 ASM_CASES_TAC `i:num = m` THENL
14943 [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
14944 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
14945 ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN
14947 `p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)`
14948 STRIP_ASSUME_TAC THENL
14949 [MATCH_MP_TAC(SET_RULE
14950 `x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN
14952 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14953 `s SUBSET t ==> x IN s ==> x IN t`)) THEN
14954 REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
14955 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
14956 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
14957 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
14959 SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL
14960 [ASM_ARITH_TAC; ASM_MESON_TAC[]]];
14963 `path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/
14964 path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET
14966 MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
14967 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14969 ==> (x IN p /\ x IN q) /\ (q UNION p = r)
14970 ==> p SUBSET s \/ p SUBSET t
14971 ==> q SUBSET s \/ q SUBSET t
14972 ==> r SUBSET s \/ r SUBSET t`)) THEN
14973 SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN
14974 REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN
14975 MATCH_MP_TAC UNION_SEGMENT THEN
14976 ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
14977 LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN
14979 DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN
14981 [EXISTS_TAC `(q:real^1->real^N) ++
14982 subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN
14983 REPEAT CONJ_TAC THENL
14984 [MATCH_MP_TAC PATH_JOIN_IMP THEN
14985 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
14986 ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
14987 DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN
14988 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
14989 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
14990 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
14992 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[];
14993 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
14994 EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
14995 subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
14997 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
14998 MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
14999 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL];
15000 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
15001 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
15002 MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
15003 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN
15004 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
15005 MATCH_MP_TAC PATH_SUBPATH] THEN
15006 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15007 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
15008 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15011 `(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t`
15012 STRIP_ASSUME_TAC THENL
15013 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
15014 PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET];
15016 UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN
15017 REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL
15018 [`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN
15019 ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
15020 DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN
15022 `!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p
15023 ==> homotopic_paths t p (linepath (pathstart p,pathstart p))`
15024 (MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++
15025 reversepath(r:real^1->real^N)`) THEN
15026 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
15027 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
15029 [ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
15030 MATCH_MP_TAC PATH_JOIN_IMP THEN
15031 ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH;
15032 PATHSTART_REVERSEPATH] THEN
15033 MATCH_MP_TAC PATH_SUBPATH THEN
15034 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15035 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
15036 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15039 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15040 HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN
15041 ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH;
15042 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
15043 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15044 HOMOTOPIC_PATHS_LOOP_PARTS)) THEN
15045 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
15046 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
15047 REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
15048 REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN
15049 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
15050 EXISTS_TAC `(q:real^1->real^N) ++ r` THEN
15051 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
15052 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
15053 EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
15054 subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
15056 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
15057 MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
15058 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
15059 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15060 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
15061 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15063 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
15064 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
15065 MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
15066 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);;
15068 (* ------------------------------------------------------------------------- *)
15069 (* Covering spaces and lifting results for them. *)
15070 (* ------------------------------------------------------------------------- *)
15072 let covering_space = new_definition
15073 `covering_space(c,(p:real^M->real^N)) s <=>
15074 p continuous_on c /\ IMAGE p c = s /\
15076 ==> ?t. x IN t /\ open_in (subtopology euclidean s) t /\
15077 ?v. UNIONS v = {x | x IN c /\ p(x) IN t} /\
15078 (!u. u IN v ==> open_in (subtopology euclidean c) u) /\
15079 pairwise DISJOINT v /\
15080 (!u. u IN v ==> ?q. homeomorphism (u,t) (p,q))`;;
15082 let COVERING_SPACE_IMP_CONTINUOUS = prove
15083 (`!p:real^M->real^N c s. covering_space (c,p) s ==> p continuous_on c`,
15084 SIMP_TAC[covering_space]);;
15086 let COVERING_SPACE_IMP_SURJECTIVE = prove
15087 (`!p:real^M->real^N c s. covering_space (c,p) s ==> IMAGE p c = s`,
15088 SIMP_TAC[covering_space]);;
15090 let HOMEOMORPHISM_IMP_COVERING_SPACE = prove
15091 (`!f:real^M->real^N g s t.
15092 homeomorphism (s,t) (f,g) ==> covering_space (s,f) t`,
15093 REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
15094 ASM_REWRITE_TAC[covering_space] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
15095 EXISTS_TAC `t:real^N->bool` THEN
15096 ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
15097 EXISTS_TAC `{s:real^M->bool}` THEN
15098 REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_1; PAIRWISE_SING] THEN
15099 ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
15100 CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `g:real^N->real^M`] THEN
15101 ASM_REWRITE_TAC[homeomorphism]);;
15103 let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove
15104 (`!p:real^M->real^N c s.
15105 covering_space (c,p) s
15107 ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\
15108 p(x) IN u /\ open_in (subtopology euclidean s) u /\
15109 ?q. homeomorphism (t,u) (p,q)`,
15110 REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
15111 FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN
15112 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15113 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN
15114 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15115 DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
15116 SUBGOAL_THEN `(x:real^M) IN UNIONS v` MP_TAC THENL
15117 [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
15118 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN
15119 STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);;
15121 let COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT = prove
15122 (`!p:real^M->real^N c s.
15123 covering_space (c,p) s
15125 ==> ?x t u. p(x) = y /\
15126 x IN t /\ open_in (subtopology euclidean c) t /\
15127 y IN u /\ open_in (subtopology euclidean s) u /\
15128 ?q. homeomorphism (t,u) (p,q)`,
15129 REPEAT STRIP_TAC THEN
15130 SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL
15131 [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15133 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
15134 FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP
15135 COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
15136 ASM_MESON_TAC[]]);;
15138 let COVERING_SPACE_OPEN_MAP = prove
15139 (`!p:real^M->real^N c s t.
15140 covering_space (c,p) s /\
15141 open_in (subtopology euclidean c) t
15142 ==> open_in (subtopology euclidean s) (IMAGE p t)`,
15143 REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
15144 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
15145 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN
15146 DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
15147 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15148 DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
15149 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15150 DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool`
15151 (STRIP_ASSUME_TAC o GSYM)) THEN
15153 `?x. x IN {x | x IN c /\ (p:real^M->real^N) x IN u} /\ x IN t /\ p x = y`
15154 MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
15155 DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
15156 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
15157 DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
15158 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
15159 ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN
15160 FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
15161 EXISTS_TAC `IMAGE (p:real^M->real^N) (t INTER v)` THEN CONJ_TAC THENL
15162 [ALL_TAC; ASM SET_TAC[]] THEN
15164 `IMAGE (p:real^M->real^N) (t INTER v) =
15165 {z | z IN u /\ q z IN (t INTER v)}`
15166 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15167 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
15168 ASM_REWRITE_TAC[] THEN
15169 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
15170 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
15171 MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
15172 EXISTS_TAC `c:real^M->bool` THEN
15173 CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER; ASM_MESON_TAC[open_in]] THEN
15174 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;
15176 let COVERING_SPACE_QUOTIENT_MAP = prove
15177 (`!p:real^M->real^N c s.
15178 covering_space (c,p) s
15180 ==> (open_in (subtopology euclidean c) {x | x IN c /\ p x IN u} <=>
15181 open_in (subtopology euclidean s) u)`,
15182 REPEAT GEN_TAC THEN DISCH_TAC THEN
15183 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15184 MATCH_MP_TAC OPEN_MAP_IMP_QUOTIENT_MAP THEN
15185 CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
15186 FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15187 ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;
15189 let COVERING_SPACE_LOCALLY = prove
15190 (`!P Q p:real^M->real^N c s.
15191 covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
15194 REPEAT STRIP_TAC THEN
15195 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15196 MATCH_MP_TAC LOCALLY_OPEN_MAP_IMAGE THEN
15197 EXISTS_TAC `P:(real^M->bool)->bool` THEN
15198 CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
15199 ASM_SIMP_TAC[] THEN
15200 FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15201 ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;
15203 let COVERING_SPACE_LOCALLY_EQ = prove
15204 (`!P Q p:real^M->real^N c s.
15205 covering_space (c,p) s /\
15206 (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
15207 (!q u. u SUBSET s /\ q continuous_on u /\ Q u ==> P(IMAGE q u))
15209 ==> (locally Q s <=> locally P c)`,
15210 REPEAT STRIP_TAC THEN EQ_TAC THENL
15211 [ALL_TAC; ASM_MESON_TAC[COVERING_SPACE_LOCALLY]] THEN
15212 REWRITE_TAC[locally] THEN STRIP_TAC THEN
15213 MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
15214 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
15215 DISCH_THEN(MP_TAC o SPEC `(p:real^M->real^N) x` o last o CONJUNCTS) THEN
15217 [ASM_MESON_TAC[covering_space; FUN_IN_IMAGE; OPEN_IN_IMP_SUBSET; SUBSET];
15218 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC)] THEN
15219 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15220 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
15221 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
15222 DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
15223 MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
15224 CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN
15225 REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN
15226 X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN
15227 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
15228 ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
15229 FIRST_X_ASSUM(MP_TAC o SPECL
15230 [`IMAGE (p:real^M->real^N) (u INTER v)`; `(p:real^M->real^N) x`]) THEN
15231 ASM_SIMP_TAC[FUN_IN_IMAGE; IN_INTER] THEN ANTS_TAC THENL
15232 [ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER]; ALL_TAC] THEN
15233 DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool`
15234 (X_CHOOSE_THEN `w':real^N->bool` STRIP_ASSUME_TAC)) THEN
15235 FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
15236 REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
15237 EXISTS_TAC `IMAGE (q:real^N->real^M) w` THEN
15238 EXISTS_TAC `IMAGE (q:real^N->real^M) w'` THEN REPEAT CONJ_TAC THENL
15239 [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
15240 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
15241 MAP_EVERY EXISTS_TAC [`p:real^M->real^N`; `t:real^N->bool`] THEN
15242 ASM_REWRITE_TAC[homeomorphism] THEN
15244 MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
15245 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
15246 REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
15248 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
15249 [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
15251 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15252 CONTINUOUS_ON_SUBSET)) THEN
15258 let COVERING_SPACE_LOCALLY_COMPACT_EQ = prove
15259 (`!p:real^M->real^N c s.
15260 covering_space (c,p) s
15261 ==> (locally compact s <=> locally compact c)`,
15262 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
15263 EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
15264 RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
15265 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; COMPACT_CONTINUOUS_IMAGE]);;
15267 let COVERING_SPACE_LOCALLY_CONNECTED_EQ = prove
15268 (`!p:real^M->real^N c s.
15269 covering_space (c,p) s
15270 ==> (locally connected s <=> locally connected c)`,
15271 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
15272 EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
15273 RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
15274 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_CONTINUOUS_IMAGE]);;
15276 let COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ = prove
15277 (`!p:real^M->real^N c s.
15278 covering_space (c,p) s
15279 ==> (locally path_connected s <=> locally path_connected c)`,
15280 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
15281 EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
15282 RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
15283 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONNECTED_CONTINUOUS_IMAGE]);;
15285 let COVERING_SPACE_LOCALLY_COMPACT = prove
15286 (`!p:real^M->real^N c s.
15287 covering_space (c,p) s /\ locally compact c
15288 ==> locally compact s`,
15289 MESON_TAC[COVERING_SPACE_LOCALLY_COMPACT_EQ]);;
15291 let COVERING_SPACE_LOCALLY_CONNECTED = prove
15292 (`!p:real^M->real^N c s.
15293 covering_space (c,p) s /\ locally connected c ==> locally connected s`,
15294 MESON_TAC[COVERING_SPACE_LOCALLY_CONNECTED_EQ]);;
15296 let COVERING_SPACE_LOCALLY_PATH_CONNECTED = prove
15297 (`!p:real^M->real^N c s.
15298 covering_space (c,p) s /\ locally path_connected c
15299 ==> locally path_connected s`,
15300 MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ]);;
15302 let COVERING_SPACE_LIFT_UNIQUE_GEN = prove
15303 (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t u a x.
15304 covering_space (c,p) s /\
15305 f continuous_on t /\ IMAGE f t SUBSET s /\
15306 g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
15307 (!x. x IN t ==> f(x) = p(g1 x)) /\
15308 g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
15309 (!x. x IN t ==> f(x) = p(g2 x)) /\
15310 u IN components t /\ a IN u /\ g1(a) = g2(a) /\ x IN u
15311 ==> g1(x) = g2(x)`,
15312 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
15313 UNDISCH_TAC `(x:real^P) IN u` THEN SPEC_TAC(`x:real^P`,`x:real^P`) THEN
15314 MATCH_MP_TAC(SET_RULE
15315 `(?a. a IN u /\ g a = z) /\
15316 ({x | x IN u /\ g x = z} = {} \/ {x | x IN u /\ g x = z} = u)
15317 ==> !x. x IN u ==> g x = z`) THEN
15318 CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ]; ALL_TAC] THEN
15319 FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
15320 REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN MATCH_MP_TAC THEN
15321 FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL
15322 [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN
15323 X_GEN_TAC `x:real^P` THEN STRIP_TAC THEN
15324 FIRST_ASSUM(MP_TAC o SPEC `(g1:real^P->real^M) x` o
15325 MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
15326 ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN
15327 MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`] THEN
15328 RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN
15329 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15330 REWRITE_TAC[homeomorphism] THEN
15331 DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
15332 EXISTS_TAC `{x | x IN u /\ (g1:real^P->real^M) x IN v} INTER
15333 {x | x IN u /\ (g2:real^P->real^M) x IN v}` THEN
15335 [MATCH_MP_TAC OPEN_IN_INTER THEN ONCE_REWRITE_TAC[SET_RULE
15336 `{x | x IN u /\ g x IN v} =
15337 {x | x IN u /\ g x IN (v INTER IMAGE g u)}`] THEN
15338 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN
15339 (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN
15340 UNDISCH_TAC `open_in (subtopology euclidean c) (v:real^M->bool)` THEN
15341 REWRITE_TAC[OPEN_IN_OPEN] THEN
15342 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[];
15343 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER; VECTOR_SUB_EQ] THEN
15345 MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN
15346 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
15347 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;
15349 let COVERING_SPACE_LIFT_UNIQUE = prove
15350 (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t a x.
15351 covering_space (c,p) s /\
15352 f continuous_on t /\ IMAGE f t SUBSET s /\
15353 g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
15354 (!x. x IN t ==> f(x) = p(g1 x)) /\
15355 g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
15356 (!x. x IN t ==> f(x) = p(g2 x)) /\
15357 connected t /\ a IN t /\ g1(a) = g2(a) /\ x IN t
15358 ==> g1(x) = g2(x)`,
15359 REPEAT STRIP_TAC THEN MP_TAC(ISPECL
15360 [`p:real^M->real^N`; `f:real^P->real^N`;
15361 `g1:real^P->real^M`; `g2:real^P->real^M`;
15362 `c:real^M->bool`; `s:real^N->bool`; `t:real^P->bool`; `t:real^P->bool`;
15363 `a:real^P`; `x:real^P`] COVERING_SPACE_LIFT_UNIQUE_GEN) THEN
15364 ASM_REWRITE_TAC[IN_COMPONENTS_SELF] THEN ASM SET_TAC[]);;
15366 let COVERING_SPACE_LIFT_UNIQUE_IDENTITY = prove
15367 (`!p:real^M->real^N c f s a.
15368 covering_space (c,p) s /\
15369 path_connected c /\
15370 f continuous_on c /\ IMAGE f c SUBSET c /\
15371 (!x. x IN c ==> p(f x) = p x) /\
15373 ==> !x. x IN c ==> f x = x`,
15374 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
15375 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
15376 DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `x:real^M`]) THEN
15377 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
15378 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15379 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
15381 [`p:real^M->real^N`; `(p:real^M->real^N) o (g:real^1->real^M)`;
15382 `(f:real^M->real^M) o (g:real^1->real^M)`; `g:real^1->real^M`;
15383 `c:real^M->bool`; `s:real^N->bool`;
15384 `interval[vec 0:real^1,vec 1]`;
15385 `vec 0:real^1`; `vec 1:real^1`]
15386 COVERING_SPACE_LIFT_UNIQUE) THEN
15387 ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN
15388 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
15389 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
15390 STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
15391 `IMAGE p c = s ==> !x. x IN c ==> p(x) IN s`)) THEN
15392 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15393 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15394 ASM_REWRITE_TAC[] THEN
15395 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15396 CONTINUOUS_ON_SUBSET)) THEN
15397 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);;
15399 let COVERING_SPACE_LIFT_HOMOTOPY = prove
15400 (`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u.
15401 covering_space (c,p) s /\
15402 h continuous_on (interval[vec 0,vec 1] PCROSS u) /\
15403 IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\
15404 (!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\
15405 f continuous_on u /\ IMAGE f u SUBSET c
15406 ==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\
15407 IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\
15408 (!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\
15409 (!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`,
15410 REPEAT STRIP_TAC THEN
15413 ==> ?v. open_in (subtopology euclidean u) v /\ y IN v /\
15414 ?k:real^(1,P)finite_sum->real^M.
15415 k continuous_on (interval[vec 0,vec 1] PCROSS v) /\
15416 IMAGE k (interval[vec 0,vec 1] PCROSS v) SUBSET c /\
15417 (!y. y IN v ==> k(pastecart (vec 0) y) = f y) /\
15418 (!z. z IN interval[vec 0,vec 1] PCROSS v
15419 ==> h z :real^N = p(k z))`
15422 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
15423 [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
15424 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15425 MAP_EVERY X_GEN_TAC
15426 [`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN
15427 DISCH_THEN(LABEL_TAC "*") THEN
15429 [`fs:real^P->real^(1,P)finite_sum->real^M`;
15430 `(\x. interval[vec 0,vec 1] PCROSS (v x))
15431 :real^P->real^(1,P)finite_sum->bool`;
15432 `(interval[vec 0,vec 1] PCROSS u):real^(1,P)finite_sum->bool`;
15434 PASTING_LEMMA_EXISTS) THEN
15435 ASM_SIMP_TAC[] THEN ANTS_TAC THENL
15437 MATCH_MP_TAC MONO_EXISTS THEN
15438 X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN
15439 ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
15440 REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN
15441 X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL
15442 [FIRST_X_ASSUM(MP_TAC o SPECL
15443 [`pastecart (t:real^1) (y:real^P)`; `y:real^P`]);
15444 FIRST_X_ASSUM(MP_TAC o SPECL
15445 [`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]);
15446 FIRST_X_ASSUM(MP_TAC o SPECL
15447 [`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN
15448 ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_INTER; ENDS_IN_UNIT_INTERVAL] THEN
15449 DISCH_THEN SUBST1_TAC THEN
15450 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15451 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15452 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
15453 ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
15454 REPEAT CONJ_TAC THENL
15455 [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; UNIONS_GSPEC; IN_ELIM_THM] THEN
15456 MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN
15457 EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS];
15458 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15459 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15460 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
15461 REWRITE_TAC[OPEN_IN_OPEN] THEN
15462 DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN
15463 EXISTS_TAC `(:real^1) PCROSS (t:real^P->bool)` THEN
15464 ASM_SIMP_TAC[REWRITE_RULE[GSYM PCROSS] OPEN_PCROSS; OPEN_UNIV] THEN
15465 REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
15466 IN_INTER; IN_UNIV] THEN
15467 REPEAT GEN_TAC THEN CONV_TAC TAUT;
15468 REWRITE_TAC[FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN
15469 MAP_EVERY X_GEN_TAC
15470 [`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN
15471 REWRITE_TAC[CONJ_ACI] THEN STRIP_TAC THEN
15472 FIRST_ASSUM(MP_TAC o
15473 ISPECL [`h:real^(1,P)finite_sum->real^N`;
15474 `(fs:real^P->real^(1,P)finite_sum->real^M) x`;
15475 `(fs:real^P->real^(1,P)finite_sum->real^M) z`;
15476 `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`;
15477 `pastecart (vec 0:real^1) (y:real^P)`;
15478 `pastecart (t:real^1) (y:real^P)`] o
15479 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
15480 DISCH_THEN MATCH_MP_TAC THEN
15481 ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_SING; ENDS_IN_UNIT_INTERVAL] THEN
15482 SIMP_TAC[REWRITE_RULE[GSYM PCROSS] CONNECTED_PCROSS;
15483 CONNECTED_INTERVAL; CONNECTED_SING] THEN
15485 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15486 CONTINUOUS_ON_SUBSET)) THEN
15487 REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
15488 ASM_SIMP_TAC[IN_SING];
15491 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15492 (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN
15493 MATCH_MP_TAC IMAGE_SUBSET THEN
15494 REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
15495 ASM_SIMP_TAC[IN_SING];
15497 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN
15499 [REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`);
15500 REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN
15501 ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; FORALL_IN_IMAGE] THEN
15502 ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING] THEN
15504 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15505 CONTINUOUS_ON_SUBSET)) THEN
15506 REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
15507 ASM_SIMP_TAC[IN_SING]]] THEN
15508 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15509 FIRST_ASSUM(MP_TAC o last o CONJUNCTS o
15510 GEN_REWRITE_RULE I [covering_space]) THEN
15511 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
15512 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15513 X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN
15515 `!t. t IN interval[vec 0,vec 1]
15517 open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\
15518 open_in (subtopology euclidean u) n /\
15519 t IN k /\ y IN n /\ i IN s /\
15520 IMAGE (h:real^(1,P)finite_sum->real^N) (k PCROSS n) SUBSET uu i`
15522 [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
15523 SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y) IN s`
15525 [FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[FORALL_IN_IMAGE] o
15526 GEN_REWRITE_RULE I [SUBSET]) THEN
15527 ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
15530 `open_in (subtopology euclidean (interval[vec 0,vec 1] PCROSS u))
15531 {z | z IN (interval[vec 0,vec 1] PCROSS u) /\
15532 (h:real^(1,P)finite_sum->real^N) z IN
15533 uu(h(pastecart t y))}`
15535 [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15536 EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[];
15538 DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
15539 PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN
15540 DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN
15541 ASM_SIMP_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
15542 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
15543 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN
15545 EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN
15546 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
15548 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN
15549 REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
15550 REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
15551 REWRITE_TAC[MESON[]
15552 `(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN
15553 REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
15554 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
15555 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15556 MAP_EVERY X_GEN_TAC
15557 [`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`;
15558 `xx:real^1->real^N`] THEN
15559 DISCH_THEN(LABEL_TAC "+") THEN
15560 MP_TAC(ISPEC `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`
15561 COMPACT_IMP_HEINE_BOREL) THEN
15562 SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_SING] THEN
15563 DISCH_THEN(MP_TAC o SPEC
15564 `IMAGE ((\i. kk i PCROSS nn i):real^1->real^(1,P)finite_sum->bool)
15565 (interval[vec 0,vec 1])`) THEN
15566 ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_PCROSS] THEN ANTS_TAC THENL
15567 [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IN_SING] THEN
15568 MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN
15569 ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
15570 ASM_MESON_TAC[IN_INTER];
15571 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
15572 [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
15573 REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
15574 DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN
15575 ABBREV_TAC `n = INTERS (IMAGE (nn:real^1->real^P->bool) tk)` THEN
15576 SUBGOAL_THEN `(y:real^P) IN n /\ open n` STRIP_ASSUME_TAC THENL
15577 [EXPAND_TAC "n" THEN CONJ_TAC THENL
15578 [REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM];
15579 MATCH_MP_TAC OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
15580 ASM_SIMP_TAC[FINITE_IMAGE]] THEN
15581 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
15582 REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
15583 (ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_INTER]]);
15586 [`interval[vec 0:real^1,vec 1]`; `IMAGE (kk:real^1->real^1->bool) tk`]
15587 LEBESGUE_COVERING_LEMMA) THEN
15588 REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
15590 `q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t)
15591 ==> (~p /\ q /\ r ==> s) ==> t`) THEN
15592 SIMP_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
15594 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
15595 REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IMP_CONJ; IN_SING] THEN
15596 REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
15597 REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
15600 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15601 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
15602 MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN
15603 ASM_REWRITE_TAC[] THEN
15604 DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
15607 ==> ?v k:real^(1,P)finite_sum->real^M.
15608 open_in (subtopology euclidean u) v /\
15610 k continuous_on interval[vec 0,lift(&n / &N)] PCROSS v /\
15611 IMAGE k (interval[vec 0,lift(&n / &N)] PCROSS v) SUBSET c /\
15612 (!y. y IN v ==> k (pastecart (vec 0) y) = f y) /\
15613 (!z. z IN interval[vec 0,lift(&n / &N)] PCROSS v
15614 ==> h z:real^N = p (k z))`
15617 DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN
15618 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM]] THEN
15619 MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
15620 [DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN
15621 EXISTS_TAC `u:real^P->bool` THEN
15622 EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN
15623 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; INTERVAL_SING] THEN
15624 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; o_THM] THEN
15625 ASM_REWRITE_TAC[FORALL_UNWIND_THM2; SNDCART_PASTECART] THEN
15626 REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
15627 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15628 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15629 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
15630 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15631 CONTINUOUS_ON_SUBSET)) THEN
15632 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
15633 SIMP_TAC[SNDCART_PASTECART];
15635 X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN
15636 ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`; LEFT_IMP_EXISTS_THM] THEN
15637 MAP_EVERY X_GEN_TAC
15638 [`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN
15639 STRIP_TAC THEN FIRST_X_ASSUM
15640 (MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN
15642 [REWRITE_TAC[DIAMETER_INTERVAL; SUBSET_INTERVAL_1] THEN
15643 REWRITE_TAC[LIFT_DROP; DROP_VEC; INTERVAL_EQ_EMPTY_1;
15644 GSYM LIFT_SUB; NORM_LIFT] THEN
15645 ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1;
15646 REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN
15647 SIMP_TAC[GSYM NOT_LE; ARITH_RULE `m <= SUC m`; REAL_OF_NUM_SUB] THEN
15648 ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_DIV; REAL_POS;
15649 REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN
15650 ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`; REAL_LT_IMP_LE] THEN
15651 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
15652 ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC;
15654 REWRITE_TAC[EXISTS_IN_IMAGE] THEN
15655 DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
15656 REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
15657 ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
15658 FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN
15659 ASM_REWRITE_TAC[] THEN
15660 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15661 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
15662 ONCE_REWRITE_TAC[IMP_CONJ] THEN
15663 GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
15664 DISCH_THEN(MP_TAC o SPEC
15665 `(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN
15666 REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT
15667 `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
15668 REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER])) THEN
15670 `lift(&m / &N) IN interval[vec 0,lift (&m / &N)] /\
15671 lift(&m / &N) IN interval[lift(&m / &N),lift(&(SUC m) / &N)]`
15672 STRIP_ASSUME_TAC THENL
15673 [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15674 SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_REFL] THEN
15675 ASM_SIMP_TAC[REAL_LE_DIV2_EQ; LE_1; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
15678 REPEAT CONJ_TAC THENL
15679 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15680 MATCH_MP_TAC FUN_IN_IMAGE THEN
15681 ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
15682 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN
15683 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
15684 DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15685 (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
15686 ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
15687 ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_LE_DIV; REAL_LE_LDIV_EQ;
15688 REAL_POS; REAL_OF_NUM_LT; LE_1; DROP_VEC] THEN
15689 REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15690 CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
15691 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15693 GEN_REWRITE_TAC LAND_CONV [IN_UNIONS] THEN
15694 DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
15695 DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN
15696 DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN
15697 ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
15698 DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool) IN vv` (K ALL_TAC)] THEN
15699 ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN
15701 `?n'. open_in (subtopology euclidean u) n' /\ y IN n' /\
15702 IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)} PCROSS n')
15704 STRIP_ASSUME_TAC THENL
15706 `{z | z IN v /\ ((k:real^(1,P)finite_sum->real^M) o
15707 pastecart (lift(&m / &N))) z IN w}` THEN
15708 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
15709 ASM_SIMP_TAC[IN_ELIM_THM; IN_SING; o_THM] THEN
15710 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN
15711 ASM_REWRITE_TAC[] THEN
15712 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15713 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
15714 ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THENL
15715 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15716 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
15717 CONTINUOUS_ON_ID] THEN
15718 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15719 CONTINUOUS_ON_SUBSET));
15720 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15721 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
15722 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
15725 `?q q':real^P->bool.
15726 open_in (subtopology euclidean u) q /\
15727 closed_in (subtopology euclidean u) q' /\
15728 y IN q /\ y IN q' /\ q SUBSET q' /\
15729 q SUBSET (u INTER nn(t:real^1)) INTER n' INTER v /\
15730 q' SUBSET (u INTER nn(t:real^1)) INTER n' INTER v`
15731 STRIP_ASSUME_TAC THENL
15732 [REWRITE_TAC[SET_RULE
15733 `y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET s /\ q' SUBSET s <=>
15734 y IN q /\ q SUBSET q' /\ q' SUBSET s`] THEN
15735 UNDISCH_TAC `open_in (subtopology euclidean u) (v:real^P->bool)` THEN
15736 UNDISCH_TAC `open_in (subtopology euclidean u) (n':real^P->bool)` THEN
15737 REWRITE_TAC[OPEN_IN_OPEN] THEN
15738 DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN
15739 DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN
15740 MP_TAC(ISPEC `nn(t:real^1) INTER vo INTER vx:real^P->bool`
15741 OPEN_CONTAINS_CBALL) THEN
15742 ASM_SIMP_TAC[OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN
15743 ASM_REWRITE_TAC[IN_INTER] THEN
15744 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15745 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
15746 EXISTS_TAC `u INTER ball(y:real^P,e)` THEN
15747 EXISTS_TAC `u INTER cball(y:real^P,e)` THEN
15748 REWRITE_TAC[CLOSED_IN_CLOSED] THEN
15749 CONJ_TAC THENL [MESON_TAC[OPEN_BALL]; ALL_TAC] THEN
15750 CONJ_TAC THENL [MESON_TAC[CLOSED_CBALL]; ALL_TAC] THEN
15751 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
15752 MP_TAC(ISPECL [`y:real^P`; `e:real`] BALL_SUBSET_CBALL) THEN
15755 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
15756 EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
15758 [`\x:real^(1,P)finite_sum.
15759 x IN interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
15760 `k:real^(1,P)finite_sum->real^M`;
15761 `(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`;
15762 `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
15763 `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (q':real^P->bool)`]
15764 CONTINUOUS_ON_CASES_LOCAL) THEN
15765 REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL
15766 [REPEAT CONJ_TAC THENL
15767 [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
15768 EXISTS_TAC `interval[vec 0,lift(&m / &N)] PCROSS (:real^P)` THEN
15769 SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
15770 REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
15771 REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
15772 REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC
15773 `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (:real^P)` THEN
15774 SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
15775 REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
15776 REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
15777 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15778 CONTINUOUS_ON_SUBSET)) THEN
15779 REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15781 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
15782 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15783 CONTINUOUS_ON_SUBSET))
15786 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15787 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
15788 MATCH_MP_TAC PCROSS_MONO THEN
15789 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
15790 ASM_REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
15792 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15793 ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
15795 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1;
15796 REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15797 DISJ2_TAC THEN ARITH_TAC;
15798 REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15799 MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN
15800 ASM_CASES_TAC `(z:real^P) IN q'` THEN ASM_REWRITE_TAC[] THEN
15801 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP
15802 (REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN
15803 REWRITE_TAC[DROP_EQ; o_THM] THEN DISCH_THEN SUBST1_TAC THEN
15804 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
15805 `(!x. x IN w ==> p' (p x) = x)
15806 ==> h z = p(k z) /\ k z IN w
15807 ==> k z = p' (h z)`)) THEN
15809 [FIRST_X_ASSUM MATCH_MP_TAC THEN
15810 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
15811 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15812 MATCH_MP_TAC FUN_IN_IMAGE THEN
15813 REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]]];
15815 `interval[vec 0,lift(&m / &N)] UNION
15816 interval [lift(&m / &N),lift(&(SUC m) / &N)] =
15817 interval[vec 0,lift(&(SUC m) / &N)]`
15819 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN GEN_TAC THEN
15820 MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==>
15821 (a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN
15822 SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_DIV; REAL_POS] THEN
15823 ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1] THEN
15827 `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool) UNION
15828 interval [lift(&m / &N),lift(&(SUC m) / &N)] PCROSS q' =
15829 interval[vec 0,lift(&(SUC m) / &N)] PCROSS q'`
15831 [SIMP_TAC[EXTENSION; IN_UNION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15834 MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
15835 `t SUBSET s /\ (f continuous_on s ==> P f)
15836 ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
15837 ASM_SIMP_TAC[PCROSS_MONO; SUBSET_REFL] THEN DISCH_TAC THEN
15838 REPEAT CONJ_TAC THENL
15839 [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
15840 MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
15841 SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
15842 [ASM SET_TAC[]; ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
15843 COND_CASES_TAC THEN REWRITE_TAC[o_THM] THENL
15844 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15845 MATCH_MP_TAC FUN_IN_IMAGE THEN
15846 REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[];
15847 FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o
15848 CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
15849 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15850 `IMAGE p w' = w ==> x IN w' ==> p x IN w`))];
15851 X_GEN_TAC `z:real^P` THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN
15852 DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN
15853 SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
15854 [ASM SET_TAC[]; ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC]] THEN
15855 SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN ASM SET_TAC[];
15856 REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15857 MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
15858 SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
15859 [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
15860 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
15861 [FIRST_X_ASSUM MATCH_MP_TAC THEN
15862 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
15863 REWRITE_TAC[o_THM] THEN CONV_TAC SYM_CONV THEN
15864 FIRST_X_ASSUM MATCH_MP_TAC]] THEN
15865 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15866 (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
15867 ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
15868 REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
15869 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
15870 REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15871 (REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN
15872 ASM_SIMP_TAC[LIFT_DROP; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
15873 ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);;
15875 let COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION = prove
15876 (`!p:real^M->real^N c s f f' g u:real^P->bool.
15877 covering_space (c,p) s /\
15878 g continuous_on u /\ IMAGE g u SUBSET c /\
15879 (!y. y IN u ==> p(g y) = f y) /\
15880 homotopic_with (\x. T) (u,s) f f'
15881 ==> ?g'. g' continuous_on u /\ IMAGE g' u SUBSET c /\
15882 (!y. y IN u ==> p(g' y) = f' y)`,
15883 REPEAT STRIP_TAC THEN
15884 FIRST_X_ASSUM(X_CHOOSE_THEN `h:real^(1,P)finite_sum->real^N`
15885 STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
15886 FIRST_ASSUM(MP_TAC o
15887 ISPECL [`h:real^(1,P)finite_sum->real^N`;
15888 `g:real^P->real^M`; `u:real^P->bool`] o
15889 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
15890 ASM_SIMP_TAC[] THEN
15891 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
15892 STRIP_ASSUME_TAC) THEN
15893 EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
15894 (\x. pastecart (vec 1) x)` THEN
15895 ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL
15896 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15897 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
15898 CONTINUOUS_ON_ID] THEN
15899 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15900 CONTINUOUS_ON_SUBSET)) THEN
15901 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
15902 ENDS_IN_UNIT_INTERVAL];
15903 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15904 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
15905 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
15906 ENDS_IN_UNIT_INTERVAL];
15907 ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]]);;
15909 let COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION = prove
15910 (`!p:real^M->real^N c s f a u:real^P->bool.
15911 covering_space (c,p) s /\ homotopic_with (\x. T) (u,s) f (\x. a)
15912 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
15913 (!y. y IN u ==> p(g y) = f y)`,
15914 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
15915 ASM_CASES_TAC `u:real^P->bool = {}` THEN
15916 ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
15917 CONTINUOUS_ON_EMPTY] THEN
15918 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE
15919 [TAUT `a /\ b /\ c /\ d /\ e ==> f <=> a /\ e ==> b /\ c /\ d ==> f`]
15920 COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION)) THEN
15921 FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
15922 FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
15923 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15924 SUBGOAL_THEN `?b. b IN c /\ (p:real^M->real^N) b = a` CHOOSE_TAC THENL
15926 EXISTS_TAC `(\x. b):real^P->real^M`] THEN
15927 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);;
15929 let COVERING_SPACE_LIFT_HOMOTOPY_ALT = prove
15930 (`!p:real^M->real^N c s (h:real^(P,1)finite_sum->real^N) f u.
15931 covering_space (c,p) s /\
15932 h continuous_on (u PCROSS interval[vec 0,vec 1]) /\
15933 IMAGE h (u PCROSS interval[vec 0,vec 1]) SUBSET s /\
15934 (!y. y IN u ==> h (pastecart y (vec 0)) = p(f y)) /\
15935 f continuous_on u /\ IMAGE f u SUBSET c
15936 ==> ?k. k continuous_on (u PCROSS interval[vec 0,vec 1]) /\
15937 IMAGE k (u PCROSS interval[vec 0,vec 1]) SUBSET c /\
15938 (!y. y IN u ==> k(pastecart y (vec 0)) = f y) /\
15939 (!z. z IN u PCROSS interval[vec 0,vec 1] ==> h z = p(k z))`,
15940 REPEAT STRIP_TAC THEN
15941 FIRST_ASSUM(MP_TAC o ISPECL
15942 [`(h:real^(P,1)finite_sum->real^N) o
15943 (\z. pastecart (sndcart z) (fstcart z))`;
15944 `f:real^P->real^M`; `u:real^P->bool`] o
15945 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
15946 ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL
15948 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15949 SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
15950 LINEAR_FSTCART; LINEAR_SNDCART] THEN
15951 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15952 CONTINUOUS_ON_SUBSET));
15953 REWRITE_TAC[IMAGE_o] THEN
15954 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15955 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
15956 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
15957 FSTCART_PASTECART; SNDCART_PASTECART];
15958 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
15959 STRIP_ASSUME_TAC) THEN
15960 EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
15961 (\z. pastecart (sndcart z) (fstcart z))` THEN
15962 ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
15963 FORALL_IN_PCROSS; PASTECART_IN_PCROSS] THEN
15964 REPEAT CONJ_TAC THENL
15965 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15966 SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
15967 LINEAR_FSTCART; LINEAR_SNDCART] THEN
15968 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15969 CONTINUOUS_ON_SUBSET));
15970 REWRITE_TAC[IMAGE_o] THEN
15971 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15972 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
15973 MAP_EVERY X_GEN_TAC [`x:real^P`; `t:real^1`] THEN STRIP_TAC THEN
15974 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (x:real^P)`)] THEN
15975 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
15976 FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS]]);;
15978 let COVERING_SPACE_LIFT_PATH_STRONG = prove
15979 (`!p:real^M->real^N c s g a.
15980 covering_space (c,p) s /\
15981 path g /\ path_image g SUBSET s /\ pathstart g = p(a) /\ a IN c
15982 ==> ?h. path h /\ path_image h SUBSET c /\ pathstart h = a /\
15983 !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
15984 REWRITE_TAC[path_image; path; pathstart] THEN
15985 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
15986 ISPECL [`(g:real^1->real^N) o (fstcart:real^(1,P)finite_sum->real^1)`;
15987 `(\y. a):real^P->real^M`; `{arb:real^P}`] o
15988 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
15989 REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; o_THM; FSTCART_PASTECART] THEN
15991 [ASM_REWRITE_TAC[IMAGE_o; CONTINUOUS_ON_CONST] THEN
15992 ASM_REWRITE_TAC[SET_RULE `IMAGE (\y. a) {b} SUBSET s <=> a IN s`] THEN
15994 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15995 SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN
15996 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15997 CONTINUOUS_ON_SUBSET));
15999 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
16000 SIMP_TAC[FSTCART_PASTECART] THEN ASM SET_TAC[];
16001 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
16002 STRIP_ASSUME_TAC) THEN
16003 EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\t. pastecart t arb)` THEN
16004 ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
16005 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16006 SIMP_TAC[CONTINUOUS_ON_PASTECART;
16007 CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
16008 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16009 CONTINUOUS_ON_SUBSET)) THEN
16010 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
16011 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
16012 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
16013 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
16014 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
16015 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (arb:real^P)`) THEN
16016 ASM_SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; IN_SING]]]);;
16018 let COVERING_SPACE_LIFT_PATH = prove
16019 (`!p:real^M->real^N c s g.
16020 covering_space (c,p) s /\ path g /\ path_image g SUBSET s
16021 ==> ?h. path h /\ path_image h SUBSET c /\
16022 !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
16023 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
16024 `IMAGE g i SUBSET s ==> vec 0 IN i ==> g(vec 0) IN s`) o
16025 GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
16026 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
16027 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16028 REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
16029 X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
16030 MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
16031 `g:real^1->real^N`; `a:real^M`]
16032 COVERING_SPACE_LIFT_PATH_STRONG) THEN
16033 ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC MONO_EXISTS THEN
16034 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);;
16036 let COVERING_SPACE_LIFT_HOMOTOPIC_PATHS = prove
16037 (`!p:real^M->real^N c s g1 g2 h1 h2.
16038 covering_space (c,p) s /\
16039 path g1 /\ path_image g1 SUBSET s /\
16040 path g2 /\ path_image g2 SUBSET s /\
16041 homotopic_paths s g1 g2 /\
16042 path h1 /\ path_image h1 SUBSET c /\
16043 (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
16044 path h2 /\ path_image h2 SUBSET c /\
16045 (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
16046 pathstart h1 = pathstart h2
16047 ==> homotopic_paths c h1 h2`,
16048 REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_PATHS] THEN
16049 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
16050 REWRITE_TAC[homotopic_with; pathstart; pathfinish] THEN
16051 DISCH_THEN(X_CHOOSE_THEN
16052 `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
16053 FIRST_ASSUM(MP_TAC o ISPECL
16054 [`h:real^(1,1)finite_sum->real^N`; `(\x. pathstart h2):real^1->real^M`;
16055 `interval[vec 0:real^1,vec 1]`] o
16056 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY_ALT)) THEN
16057 ASM_SIMP_TAC[] THEN ANTS_TAC THENL
16058 [REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE] THEN
16059 ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; PATHSTART_IN_PATH_IMAGE;
16062 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,1)finite_sum->real^M` THEN
16063 STRIP_TAC THEN ASM_SIMP_TAC[o_DEF] THEN
16064 MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN
16067 FIRST_ASSUM(MATCH_MP_TAC o
16068 REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
16069 ONCE_REWRITE_RULE[IMP_CONJ] o
16070 REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
16071 (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16072 REWRITE_TAC[GSYM CONJ_ASSOC] THENL
16073 [MAP_EVERY EXISTS_TAC [`g1:real^1->real^N`; `vec 0:real^1`];
16074 MAP_EVERY EXISTS_TAC [`g2:real^1->real^N`; `vec 0:real^1`]] THEN
16075 ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
16076 RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish; path]) THEN
16077 ASM_REWRITE_TAC[CONNECTED_INTERVAL; pathstart; pathfinish] THEN
16078 REWRITE_TAC[CONJ_ASSOC] THEN
16079 (REPEAT CONJ_TAC THENL
16080 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
16081 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16082 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
16083 CONTINUOUS_ON_ID] THEN
16084 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16085 CONTINUOUS_ON_SUBSET));
16086 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
16087 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
16088 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
16089 ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]] THEN
16090 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
16091 FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]);
16093 REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
16094 REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL
16095 [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
16096 FIRST_ASSUM(MATCH_MP_TAC o
16097 REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
16098 ONCE_REWRITE_RULE[IMP_CONJ] o
16099 REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
16100 (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16101 MAP_EVERY EXISTS_TAC
16102 [`(\x. pathfinish g1):real^1->real^N`; `vec 0:real^1`] THEN
16103 ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
16104 REWRITE_TAC[CONTINUOUS_ON_CONST; pathfinish] THEN
16105 REPEAT CONJ_TAC THENL
16106 [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16107 ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE];
16108 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
16109 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16110 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
16111 CONTINUOUS_ON_ID] THEN
16112 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16113 CONTINUOUS_ON_SUBSET)) THEN
16114 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
16115 FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL];
16116 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16117 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
16118 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (vec 1:real^1)` o
16119 REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN
16120 ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
16121 ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
16122 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16123 ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]]]);;
16125 let COVERING_SPACE_MONODROMY = prove
16126 (`!p:real^M->real^N c s g1 g2 h1 h2.
16127 covering_space (c,p) s /\
16128 path g1 /\ path_image g1 SUBSET s /\
16129 path g2 /\ path_image g2 SUBSET s /\
16130 homotopic_paths s g1 g2 /\
16131 path h1 /\ path_image h1 SUBSET c /\
16132 (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
16133 path h2 /\ path_image h2 SUBSET c /\
16134 (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
16135 pathstart h1 = pathstart h2
16136 ==> pathfinish h1 = pathfinish h2`,
16137 REPEAT GEN_TAC THEN
16138 DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_HOMOTOPIC_PATHS) THEN
16139 REWRITE_TAC[HOMOTOPIC_PATHS_IMP_PATHFINISH]);;
16141 let COVERING_SPACE_LIFT_HOMOTOPIC_PATH = prove
16142 (`!p:real^M->real^N c s f f' g a b.
16143 covering_space (c,p) s /\
16144 homotopic_paths s f f' /\
16145 path g /\ path_image g SUBSET c /\
16146 pathstart g = a /\ pathfinish g = b /\
16147 (!t. t IN interval[vec 0,vec 1] ==> p(g t) = f t)
16148 ==> ?g'. path g' /\ path_image g' SUBSET c /\
16149 pathstart g' = a /\ pathfinish g' = b /\
16150 (!t. t IN interval[vec 0,vec 1] ==> p(g' t) = f' t)`,
16151 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REPEAT STRIP_TAC THEN
16152 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
16153 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
16154 FIRST_ASSUM(MP_TAC o ISPECL [`f':real^1->real^N`; `a:real^M`] o
16155 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN
16157 [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
16158 [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL;
16159 HOMOTOPIC_PATHS_IMP_PATHSTART];
16160 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]];
16161 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^1->real^M` THEN
16162 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
16163 SUBST1_TAC(SYM(ASSUME `pathfinish g:real^M = b`)) THEN
16164 FIRST_ASSUM(MATCH_MP_TAC o
16165 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN
16166 MAP_EVERY EXISTS_TAC [`f':real^1->real^N`; `f:real^1->real^N`] THEN
16167 ASM_REWRITE_TAC[]]);;
16169 let COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP = prove
16170 (`!p:real^M->real^N c s g h a.
16171 covering_space (c,p) s /\
16172 path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
16173 homotopic_paths s g (linepath(a,a)) /\
16174 path h /\ path_image h SUBSET c /\
16175 (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
16176 ==> pathfinish h = pathstart h`,
16177 REPEAT STRIP_TAC THEN
16178 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
16179 REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
16180 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16181 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
16182 REWRITE_TAC[PATHSTART_LINEPATH] THEN REPEAT STRIP_TAC THEN
16183 FIRST_X_ASSUM(MP_TAC o
16184 ISPECL [`g:real^1->real^N`; `linepath(a:real^N,a)`;
16185 `h:real^1->real^M`; `linepath(pathstart h:real^M,pathstart h)`] o
16186 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16187 COVERING_SPACE_MONODROMY)) THEN
16188 ASM_REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
16189 ASM_REWRITE_TAC[SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16190 DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEPATH_REFL] THEN CONJ_TAC THENL
16191 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
16192 REPEAT STRIP_TAC THEN
16193 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
16194 REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
16195 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;
16197 let COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP = prove
16198 (`!p:real^M->real^N c s g h.
16199 covering_space (c,p) s /\ simply_connected s /\
16200 path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
16201 path h /\ path_image h SUBSET c /\
16202 (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
16203 ==> pathfinish h = pathstart h`,
16204 REPEAT STRIP_TAC THEN
16205 FIRST_X_ASSUM(MATCH_MP_TAC o
16206 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16207 COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP)) THEN
16208 EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN
16209 ASM_MESON_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH]);;
16211 (* ------------------------------------------------------------------------- *)
16212 (* Lifting of general functions to covering space *)
16213 (* ------------------------------------------------------------------------- *)
16215 let COVERING_SPACE_LIFT_GENERAL = prove
16216 (`!p:real^M->real^N c s f:real^P->real^N u a z.
16217 covering_space (c,p) s /\ a IN c /\ z IN u /\
16218 path_connected u /\ locally path_connected u /\
16219 f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
16220 (!r. path r /\ path_image r SUBSET u /\
16221 pathstart r = z /\ pathfinish r = z
16222 ==> ?q. path q /\ path_image q SUBSET c /\
16223 pathstart q = a /\ pathfinish q = a /\
16224 homotopic_paths s (f o r) (p o q))
16225 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
16226 (!y. y IN u ==> p(g y) = f y)`,
16227 REPEAT STRIP_TAC THEN
16230 ==> ?g h. path g /\ path_image g SUBSET u /\
16231 pathstart g = z /\ pathfinish g = y /\
16232 path h /\ path_image h SUBSET c /\ pathstart h = a /\
16233 (!t. t IN interval[vec 0,vec 1]
16234 ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))`
16237 [X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
16238 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
16239 DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN
16240 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
16241 X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN
16242 ASM_REWRITE_TAC[] THEN
16243 MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN
16244 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN
16245 ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATHSTART_COMPOSE] THEN
16247 [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
16248 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
16252 `?l. !y g h. path g /\ path_image g SUBSET u /\
16253 pathstart g = z /\ pathfinish g = y /\
16254 path h /\ path_image h SUBSET c /\ pathstart h = a /\
16255 (!t. t IN interval[vec 0,vec 1]
16256 ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))
16257 ==> pathfinish h = l y`
16259 [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN
16260 MATCH_MP_TAC(MESON[]
16261 `(!g h g' h'. P g h /\ P g' h' ==> f h = f h')
16262 ==> ?z. !g h. P g h ==> f h = z`) THEN
16263 REPEAT STRIP_TAC THEN
16264 FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN
16265 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
16266 PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
16267 SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
16268 DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN
16269 FIRST_ASSUM(MP_TAC o
16270 ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`;
16271 `(f:real^P->real^N) o (g ++ reversepath g')`;
16272 `q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o
16273 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
16274 (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM]
16275 COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN
16276 ASM_REWRITE_TAC[o_THM] THEN
16277 DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN
16278 SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL
16280 ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_REVERSEPATH; PATHSTART_REVERSEPATH]] THEN
16281 MATCH_MP_TAC PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN
16282 ASM_REWRITE_TAC[] THEN
16283 X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
16284 STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL
16285 [FIRST_ASSUM(MP_TAC o
16286 ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`;
16287 `q':real^1->real^M`;
16288 `(h:real^1->real^M) o (\t. &2 % t)`;
16289 `interval[vec 0,lift(&1 / &2)]`;
16290 `vec 0:real^1`; `t:real^1`] o
16291 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16292 REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
16293 REPEAT CONJ_TAC THENL
16294 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
16295 EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
16297 [SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; joinpaths; o_THM];
16299 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16300 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
16301 [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
16302 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
16304 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16305 `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
16306 CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
16307 REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
16308 `(!x. x IN s ==> f x = g x) /\ s SUBSET t
16309 ==> IMAGE f s SUBSET IMAGE g t`) THEN
16310 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_INTERVAL_1] THEN
16311 CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths; o_THM];
16312 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16313 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16314 ASM_REWRITE_TAC[GSYM path] THEN
16315 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
16317 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16318 `path_image(q':real^1->real^M)` THEN
16319 ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
16320 MATCH_MP_TAC IMAGE_SUBSET THEN
16321 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
16323 X_GEN_TAC `t':real^1` THEN
16324 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
16325 FIRST_X_ASSUM(fun th ->
16326 W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
16327 ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC] THEN
16328 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
16329 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16330 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
16331 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16332 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16333 ASM_SIMP_TAC[GSYM path] THEN
16334 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16335 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
16337 MATCH_MP_TAC SUBSET_TRANS THEN
16338 EXISTS_TAC `path_image(h:real^1->real^M)` THEN
16339 CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN
16340 REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
16341 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
16342 REWRITE_TAC[DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
16344 X_GEN_TAC `t':real^1` THEN
16345 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
16346 CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
16347 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
16348 ASM_REAL_ARITH_TAC;
16349 REWRITE_TAC[CONNECTED_INTERVAL];
16350 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC;
16351 GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN
16352 ASM_REWRITE_TAC[] THEN
16353 SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN
16354 REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
16355 REWRITE_TAC[VECTOR_MUL_RZERO];
16356 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
16357 ASM_REAL_ARITH_TAC];
16358 FIRST_ASSUM(MP_TAC o
16359 ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o
16360 (\t. &2 % t - vec 1)`;
16361 `q':real^1->real^M`;
16362 `reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`;
16363 `{t | &1 / &2 < drop t /\ drop t <= &1}`;
16364 `vec 1:real^1`; `t:real^1`] o
16365 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16366 REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
16367 REPEAT CONJ_TAC THENL
16368 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
16369 EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
16371 [SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM];
16373 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16374 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
16375 [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
16376 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16378 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16379 `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
16380 CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
16381 REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
16382 `(!x. x IN s ==> f x = g x) /\ s SUBSET t
16383 ==> IMAGE f s SUBSET IMAGE g t`) THEN
16384 SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM] THEN
16385 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16387 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16388 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16389 ASM_REWRITE_TAC[GSYM path] THEN
16390 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16392 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16393 `path_image(q':real^1->real^M)` THEN
16394 ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
16395 MATCH_MP_TAC IMAGE_SUBSET THEN
16396 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16398 X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
16399 FIRST_X_ASSUM(fun th ->
16400 W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
16401 ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC; GSYM REAL_NOT_LT] THEN
16402 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
16403 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16404 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
16405 CONTINUOUS_ON_CONST] THEN
16406 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16407 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16408 ASM_SIMP_TAC[GSYM path; PATH_REVERSEPATH] THEN
16409 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
16410 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
16412 MATCH_MP_TAC SUBSET_TRANS THEN
16413 EXISTS_TAC `path_image(reversepath h':real^1->real^M)` THEN
16414 CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH]] THEN
16415 REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
16416 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
16417 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
16419 X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
16420 REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN
16421 FIRST_X_ASSUM MATCH_MP_TAC THEN
16422 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL] THEN
16423 ASM_REAL_ARITH_TAC;
16424 REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN
16425 REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
16426 REWRITE_TAC[IN_ELIM_THM; DROP_VEC] THEN REAL_ARITH_TAC;
16427 GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN
16428 ASM_REWRITE_TAC[reversepath] THEN
16429 SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN
16430 REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
16431 REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_CMUL; DROP_VEC] THEN
16433 REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]];
16435 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN
16436 DISCH_THEN(LABEL_TAC "+") THEN
16437 MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL
16439 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16440 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
16441 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
16442 ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
16443 FIRST_ASSUM(MP_TAC o SPECL
16444 [`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN
16445 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
16446 REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16447 ASM_SIMP_TAC[LINEPATH_REFL; SING_SUBSET];
16448 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
16449 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
16450 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16451 MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN
16452 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
16453 [`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN
16454 ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]] THEN
16455 FIRST_ASSUM(fun th ->
16456 GEN_REWRITE_TAC I [MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
16457 X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN
16458 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN
16459 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
16460 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
16461 FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o
16462 GEN_REWRITE_RULE I [covering_space]) THEN
16463 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16464 DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN
16465 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16466 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
16467 ONCE_REWRITE_TAC[IMP_CONJ] THEN
16468 GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
16469 DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN
16470 MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
16471 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
16472 DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN
16473 DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN
16474 DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN
16475 ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
16476 DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool) IN vv` (K ALL_TAC) THEN
16478 `?v. y IN v /\ y IN u /\ IMAGE (f:real^P->real^N) v SUBSET w /\
16479 v SUBSET u /\ path_connected v /\ open_in (subtopology euclidean u) v`
16480 STRIP_ASSUME_TAC THENL
16481 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN
16482 DISCH_THEN(MP_TAC o SPECL
16483 [`{x | x IN u /\ (f:real^P->real^N) x IN w}`; `y:real^P`]) THEN
16484 ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]] THEN
16485 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
16486 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
16487 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
16489 FIRST_X_ASSUM(STRIP_ASSUME_TAC o
16490 GEN_REWRITE_RULE I [homeomorphism]) THEN
16491 SUBGOAL_THEN `(w':real^M->bool) SUBSET c /\ (w:real^N->bool) SUBSET s`
16492 STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
16495 {x | x IN u /\ (f:real^P->real^N) x IN
16496 {x | x IN w /\ (p':real^N->real^M) x IN w' INTER n}}` THEN
16497 REPEAT CONJ_TAC THENL
16498 [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
16499 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
16500 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
16501 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN
16502 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
16503 EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
16504 UNDISCH_TAC `open_in (subtopology euclidean c) (n:real^M->bool)` THEN
16505 REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
16508 SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
16509 X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN
16510 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
16511 DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN
16512 ASM_REWRITE_TAC[] THEN
16513 DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN
16514 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
16515 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16516 MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN
16518 FIRST_ASSUM(MP_TAC o SPECL
16519 [`y':real^P`; `(pp:real^1->real^P) ++ r`;
16520 `(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o
16521 (r:real^1->real^P))`]) THEN
16522 FIRST_X_ASSUM(MP_TAC o SPECL
16523 [`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN
16524 ASM_SIMP_TAC[o_THM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN DISCH_TAC THEN
16526 `path_image ((pp:real^1->real^P) ++ r) SUBSET u`
16528 [MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN
16531 ASM_REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN
16532 REPEAT CONJ_TAC THENL
16533 [ASM_SIMP_TAC[PATH_JOIN];
16534 ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN];
16535 MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATHSTART_COMPOSE] THEN
16537 [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
16538 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16540 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16541 CONTINUOUS_ON_SUBSET)) THEN
16543 REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]];
16544 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN
16545 REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[];
16546 X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
16547 STRIP_TAC THEN REWRITE_TAC[joinpaths; o_THM] THEN COND_CASES_TAC THEN
16548 ASM_REWRITE_TAC[] THENL
16549 [ABBREV_TAC `t:real^1 = &2 % tt`;
16550 ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN
16551 (SUBGOAL_THEN `t IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
16552 [EXPAND_TAC "t" THEN
16553 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
16554 ASM_REAL_ARITH_TAC;
16556 ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
16557 RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]);;
16559 let COVERING_SPACE_LIFT_STRONGER = prove
16560 (`!p:real^M->real^N c s f:real^P->real^N u a z.
16561 covering_space (c,p) s /\ a IN c /\ z IN u /\
16562 path_connected u /\ locally path_connected u /\
16563 f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
16564 (!r. path r /\ path_image r SUBSET u /\
16565 pathstart r = z /\ pathfinish r = z
16566 ==> ?b. homotopic_paths s (f o r) (linepath(b,b)))
16567 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
16568 (!y. y IN u ==> p(g y) = f y)`,
16569 REPEAT STRIP_TAC THEN
16570 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16571 COVERING_SPACE_LIFT_GENERAL)) THEN ASM_REWRITE_TAC[] THEN
16572 X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
16573 FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1->real^P`) THEN ASM_REWRITE_TAC[] THEN
16574 DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN
16575 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
16576 ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
16577 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
16578 EXISTS_TAC `linepath(a:real^M,a)` THEN
16579 REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16580 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
16581 RULE_ASSUM_TAC(REWRITE_RULE[o_DEF; LINEPATH_REFL]) THEN
16582 ASM_REWRITE_TAC[o_DEF; LINEPATH_REFL]);;
16584 let COVERING_SPACE_LIFT_STRONG = prove
16585 (`!p:real^M->real^N c s f:real^P->real^N u a z.
16586 covering_space (c,p) s /\ a IN c /\ z IN u /\
16587 simply_connected u /\ locally path_connected u /\
16588 f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a
16589 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
16590 (!y. y IN u ==> p(g y) = f y)`,
16591 REPEAT STRIP_TAC THEN
16592 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16593 COVERING_SPACE_LIFT_STRONGER)) THEN
16594 ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
16595 X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
16596 EXISTS_TAC `(f:real^P->real^N) z` THEN
16598 `linepath(f z,f z) = (f:real^P->real^N) o linepath(z,z)`
16599 SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LINEPATH_REFL]; ALL_TAC] THEN
16600 MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN
16601 EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
16602 FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I
16603 [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
16604 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16605 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]);;
16607 let COVERING_SPACE_LIFT = prove
16608 (`!p:real^M->real^N c s f:real^P->real^N u.
16609 covering_space (c,p) s /\
16610 simply_connected u /\ locally path_connected u /\
16611 f continuous_on u /\ IMAGE f u SUBSET s
16612 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
16613 (!y. y IN u ==> p(g y) = f y)`,
16614 MP_TAC COVERING_SPACE_LIFT_STRONG THEN
16615 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
16616 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN
16617 ASM_CASES_TAC `u:real^P->bool = {}` THEN
16618 ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
16620 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
16621 DISCH_THEN(X_CHOOSE_TAC `a:real^P`) THEN
16622 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16623 GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
16624 DISCH_THEN(MP_TAC o SPEC `(f:real^P->real^N) a`) THEN
16625 MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
16626 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
16629 (* ------------------------------------------------------------------------- *)
16630 (* Some additional lemmas about covering spaces. *)
16631 (* ------------------------------------------------------------------------- *)
16633 let CARD_EQ_COVERING_MAP_FIBRES = prove
16634 (`!p:real^M->real^N c s a b.
16635 covering_space (c,p) s /\ path_connected s /\ a IN s /\ b IN s
16636 ==> {x | x IN c /\ p(x) = a} =_c {x | x IN c /\ p(x) = b}`,
16637 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
16638 REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN
16639 REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN
16640 REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; FORALL_AND_THM;
16641 TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
16642 GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV)
16644 MATCH_MP_TAC(MESON[]
16645 `(!a b. P a b) ==> (!a b. P a b) /\ (!a b. P b a)`) THEN
16646 REPEAT STRIP_TAC THEN
16647 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`] o
16648 GEN_REWRITE_RULE I [path_connected]) THEN
16649 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16650 X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
16652 `!z. ?h. z IN c /\ p z = a
16653 ==> path h /\ path_image h SUBSET c /\ pathstart h = z /\
16654 !t. t IN interval[vec 0,vec 1]
16655 ==> (p:real^M->real^N)(h t) = g t`
16657 [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
16658 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN
16659 REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[];
16660 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
16661 X_GEN_TAC `h:real^M->real^1->real^M` THEN DISCH_TAC] THEN
16662 REWRITE_TAC[le_c; IN_ELIM_THM] THEN
16663 EXISTS_TAC `\z. pathfinish((h:real^M->real^1->real^M) z)` THEN
16664 ASM_REWRITE_TAC[pathfinish] THEN CONJ_TAC THENL
16665 [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
16666 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
16667 ASM_REWRITE_TAC[SUBSET; path_image; pathstart; FORALL_IN_IMAGE] THEN
16668 ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL];
16669 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
16671 [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
16672 `reversepath(g:real^1->real^N)`; `reversepath(g:real^1->real^N)`;
16673 `reversepath((h:real^M->real^1->real^M) x)`;
16674 `reversepath((h:real^M->real^1->real^M) y)`]
16675 COVERING_SPACE_MONODROMY) THEN
16676 ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
16677 DISCH_THEN MATCH_MP_TAC THEN
16678 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
16679 HOMOTOPIC_PATHS_REFL] THEN
16680 ASM_REWRITE_TAC[pathfinish; reversepath; IN_INTERVAL_1; DROP_VEC] THEN
16681 REPEAT STRIP_TAC THENL
16682 [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`);
16683 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`)] THEN
16684 ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS) THEN
16685 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);;
16687 let COVERING_SPACE_INJECTIVE = prove
16688 (`!p:real^M->real^N c s.
16689 covering_space (c,p) s /\ path_connected c /\ simply_connected s
16690 ==> (!x y. x IN c /\ y IN c /\ p x = p y ==> x = y)`,
16691 REPEAT STRIP_TAC THEN
16692 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16693 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_CONTINUOUS) THEN
16694 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
16695 DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
16696 ASM_REWRITE_TAC[] THEN
16697 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
16698 FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16699 COVERING_SPACE_LIFT_PATH_STRONG)) THEN
16700 GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
16701 DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
16702 DISCH_THEN(fun th ->
16703 MP_TAC(SPEC `(p:real^M->real^N) o (g:real^1->real^M)` th) THEN
16704 MP_TAC(SPEC `(p:real^M->real^N) o linepath(x:real^M,x)` th)) THEN
16706 `(path ((p:real^M->real^N) o linepath(x,x)) /\
16708 (path_image (p o linepath(x:real^M,x)) SUBSET s /\
16709 path_image (p o g) SUBSET s)`
16710 STRIP_ASSUME_TAC THENL
16712 [CONJ_TAC THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
16713 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN
16714 ASM_REWRITE_TAC[CONTINUOUS_ON_SING; SEGMENT_REFL] THEN
16715 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
16716 REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN
16717 REWRITE_TAC[SEGMENT_REFL] THEN ASM SET_TAC[]];
16719 ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
16720 DISCH_THEN(X_CHOOSE_THEN `h1:real^1->real^M` STRIP_ASSUME_TAC) THEN
16721 DISCH_THEN(X_CHOOSE_THEN `h2:real^1->real^M` STRIP_ASSUME_TAC) THEN
16722 FIRST_ASSUM(MP_TAC o
16723 SPECL [`(p:real^M->real^N) o linepath(x:real^M,x)`;
16724 `(p:real^M->real^N) o (g:real^1->real^M)`;
16725 `h1:real^1->real^M`; `h2:real^1->real^M`] o
16726 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16727 COVERING_SPACE_MONODROMY)) THEN
16728 ASM_SIMP_TAC[] THEN ANTS_TAC THENL
16729 [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o
16730 GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
16731 ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
16732 ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH];
16734 MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
16735 [MATCH_MP_TAC EQ_TRANS THEN
16736 EXISTS_TAC `pathfinish(linepath(x:real^M,x))` THEN
16737 CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATHFINISH_LINEPATH]];
16738 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])] THEN
16739 REWRITE_TAC[pathfinish] THEN
16740 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16741 COVERING_SPACE_LIFT_UNIQUE))
16743 [EXISTS_TAC `(p:real^M->real^N) o (h1:real^1->real^M)`;
16744 EXISTS_TAC `(p:real^M->real^N) o (h2:real^1->real^M)`] THEN
16745 MAP_EVERY EXISTS_TAC [`interval[vec 0:real^1,vec 1]`; `vec 0:real^1`] THEN
16746 REWRITE_TAC[CONNECTED_INTERVAL; ENDS_IN_UNIT_INTERVAL] THEN
16747 ASM_REWRITE_TAC[GSYM path; PATH_LINEPATH; GSYM path_image] THEN
16748 RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[o_THM] THEN
16749 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
16750 RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN
16751 ASM_REWRITE_TAC[LINEPATH_REFL; PATH_IMAGE_COMPOSE] THEN
16753 [ASM_MESON_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET];
16756 let COVERING_SPACE_HOMEOMORPHISM = prove
16757 (`!p:real^M->real^N c s.
16758 covering_space (c,p) s /\ path_connected c /\ simply_connected s
16759 ==> ?q. homeomorphism (c,s) (p,q)`,
16760 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
16761 REPEAT CONJ_TAC THENL
16762 [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
16763 ASM_MESON_TAC[COVERING_SPACE_IMP_SURJECTIVE];
16764 ASM_MESON_TAC[COVERING_SPACE_INJECTIVE];
16765 ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]]);;
16767 (* ------------------------------------------------------------------------- *)
16768 (* Results on finiteness of the number of sheets in a covering space. *)
16769 (* ------------------------------------------------------------------------- *)
16771 let COVERING_SPACE_FIBRE_NO_LIMPT = prove
16772 (`!p:real^M->real^N c s a b.
16773 covering_space (c,p) s /\ a IN c
16774 ==> ~(a limit_point_of {x | x IN c /\ p x = b})`,
16775 REPEAT STRIP_TAC THEN
16776 FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
16777 FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN
16778 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16779 DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
16780 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16781 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
16782 GEN_REWRITE_TAC I [IMP_CONJ] THEN
16783 REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN
16784 DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
16785 DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
16787 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN
16788 ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
16789 FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
16790 REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
16791 UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN
16792 REWRITE_TAC[OPEN_IN_OPEN] THEN
16793 DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
16794 FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o
16795 GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
16796 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INFINITE]] THEN
16797 MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET]
16798 `(?a. s SUBSET {a}) ==> FINITE s`) THEN
16801 let COVERING_SPACE_COUNTABLE_SHEETS = prove
16802 (`!p:real^M->real^N c s b.
16803 covering_space (c,p) s ==> COUNTABLE {x | x IN c /\ p x = b}`,
16804 REPEAT STRIP_TAC THEN
16805 MATCH_MP_TAC(REWRITE_RULE[] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]
16806 UNCOUNTABLE_CONTAINS_LIMIT_POINT)) THEN
16807 REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;
16809 let COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE = prove
16810 (`!p:real^M->real^N c s b.
16811 covering_space (c,p) s
16812 ==> (FINITE {x | x IN c /\ p x = b} <=>
16813 compact {x | x IN c /\ p x = b})`,
16814 REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FINITE_IMP_COMPACT] THEN
16815 DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL
16816 [ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_TAC THEN
16817 FIRST_ASSUM(MP_TAC o
16818 SPEC `{x | x IN c /\ (p:real^M->real^N) x = b}` o
16819 GEN_REWRITE_RULE I [COMPACT_EQ_BOLZANO_WEIERSTRASS]) THEN
16820 ASM_REWRITE_TAC[INFINITE; SUBSET_REFL; IN_ELIM_THM] THEN
16821 DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
16822 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^N`] o
16823 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16824 COVERING_SPACE_FIBRE_NO_LIMPT)) THEN
16826 SUBGOAL_THEN `{x | x IN c /\ (p:real^M->real^N) x = b} = {}`
16827 (fun th -> REWRITE_TAC[th; FINITE_EMPTY]) THEN
16828 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16831 let COVERING_SPACE_CLOSED_MAP = prove
16832 (`!p:real^M->real^N c s t.
16833 covering_space (c,p) s /\
16834 (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\
16835 closed_in (subtopology euclidean c) t
16836 ==> closed_in (subtopology euclidean s) (IMAGE p t)`,
16837 REPEAT STRIP_TAC THEN
16838 FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
16839 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16840 REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL
16841 [ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN]] THEN
16842 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
16843 FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o
16844 GEN_REWRITE_RULE I [covering_space]) THEN
16845 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN
16846 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16847 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
16849 DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
16850 ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL
16851 [ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN
16852 EXISTS_TAC `INTERS {IMAGE (p:real^M->real^N) (u DIFF t) | u IN uu}` THEN
16853 REPEAT CONJ_TAC THENL
16854 [MATCH_MP_TAC OPEN_IN_INTERS THEN
16855 ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
16857 [MATCH_MP_TAC FINITE_IMAGE THEN
16859 `!u. u IN uu ==> ?x. x IN u /\ (p:real^M->real^N) x = y`
16861 [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
16864 `FINITE (IMAGE (\u. @x. x IN u /\ (p:real^M->real^N) x = y) uu)`
16866 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16867 FINITE_SUBSET)) THEN ASM SET_TAC[];
16868 MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN
16869 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
16870 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]];
16871 X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
16872 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
16873 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
16874 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN
16875 ASM_SIMP_TAC[LEFT_EXISTS_AND_THM] THEN
16876 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
16877 DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
16878 ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
16879 EXISTS_TAC `(:real^M) DIFF k` THEN
16880 ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]];
16881 REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN
16882 X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
16883 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
16884 ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[];
16885 REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_DIFF; IN_ELIM_THM] THEN
16886 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
16887 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
16888 DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
16889 FIRST_X_ASSUM SUBST_ALL_TAC THEN
16890 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
16891 DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN
16892 REWRITE_TAC[IN_ELIM_THM] THEN
16893 MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN
16894 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
16895 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
16896 REWRITE_TAC[IN_UNIONS] THEN ASM SET_TAC[]]);;
16898 let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove
16899 (`!p:real^M->real^N c s.
16900 covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s)
16901 ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
16902 (!t. closed_in (subtopology euclidean c) t
16903 ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
16906 (!n. ~(s = v n) ==> DISJOINT s (v n))
16907 ==> (!n. f n IN v n) /\
16908 (!m n. v m = v n <=> m = n)
16909 ==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`,
16910 ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL
16911 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
16912 MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS);
16913 RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN
16914 ASM_REWRITE_TAC[]] THEN
16916 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
16917 [MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN
16918 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[];
16920 REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN
16921 FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o
16922 GEN_REWRITE_RULE I [covering_space]) THEN
16923 ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN
16924 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16925 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
16926 SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL
16927 [MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[];
16928 PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN
16929 DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN
16930 SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL
16931 [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16932 CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN
16934 `!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v`
16935 MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN
16936 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN
16937 REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
16938 [ASM SET_TAC[]; ALL_TAC] THEN
16939 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
16940 FIRST_X_ASSUM(fun th ->
16941 MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN
16942 ASM_REWRITE_TAC[] THEN
16943 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
16945 REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN
16946 REWRITE_TAC[IN_UNIV] THEN
16947 DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN
16949 `!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)`
16950 (MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
16951 ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN
16952 DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN
16954 `closed_in (subtopology euclidean s)
16955 (IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))`
16957 [FIRST_X_ASSUM MATCH_MP_TAC THEN
16958 REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN
16959 CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN
16960 FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
16961 DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
16962 SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL
16963 [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
16965 `(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN
16966 REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
16967 [MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
16968 (fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN
16969 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
16970 [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
16971 REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]];
16972 REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
16973 ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
16974 (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN
16975 MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN
16977 SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL
16978 [ASM SET_TAC[]; ALL_TAC] THEN
16979 SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w`
16980 (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))
16981 THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN
16982 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
16983 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
16984 DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN
16985 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
16986 `INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN
16987 DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL
16988 [ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN
16989 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
16990 REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
16991 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
16992 DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN
16993 ASM_REWRITE_TAC[] THEN
16994 DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
16995 ASM_REWRITE_TAC[] THEN
16996 DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o
16997 MATCH_MP lemma) THEN
16998 ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16999 MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]];
17001 `IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) =
17004 [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN
17005 REWRITE_TAC[CLOSED_IN_LIMPT] THEN
17006 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN
17007 ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
17008 REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN
17009 EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);;
17011 let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP = prove
17012 (`!p:real^M->real^N c s.
17013 covering_space (c,p) s /\ connected s /\ ~(?a. s = {a})
17014 ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
17015 (!t. closed_in (subtopology euclidean c) t
17016 ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
17017 REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
17018 [SUBGOAL_THEN `c:real^M->bool = {}` ASSUME_TAC THENL
17019 [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
17020 ASM_REWRITE_TAC[IMAGE_EQ_EMPTY];
17021 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; CLOSED_IN_SUBTOPOLOGY_EMPTY;
17022 IMAGE_EQ_EMPTY; NOT_IN_EMPTY]];
17023 MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG THEN
17024 ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
17025 MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM SET_TAC[]]);;
17027 let COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP = prove
17028 (`!p:real^M->real^N c s.
17029 covering_space (c,p) s
17030 ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
17031 (!k. k SUBSET s /\ compact k
17032 ==> compact {x | x IN c /\ p(x) IN k}))`,
17033 REPEAT STRIP_TAC THEN
17034 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
17035 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
17036 DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP PROPER_MAP th]) THEN
17037 FIRST_ASSUM(fun th -> REWRITE_TAC
17038 [GSYM(MATCH_MP COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE th)]) THEN
17039 REWRITE_TAC[TAUT `(p <=> q /\ p) <=> (p ==> q)`] THEN
17040 ASM_MESON_TAC[COVERING_SPACE_CLOSED_MAP]);;
17042 (* ------------------------------------------------------------------------- *)
17043 (* Special cases where one or both of the sets is compact. *)
17044 (* ------------------------------------------------------------------------- *)
17046 let COVERING_SPACE_FINITE_SHEETS = prove
17047 (`!p:real^M->real^N c s b.
17048 covering_space (c,p) s /\ compact c ==> FINITE {x | x IN c /\ p x = b}`,
17049 REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN
17050 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
17051 ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;
17053 let COVERING_SPACE_COMPACT = prove
17054 (`!p:real^M->real^N c s.
17055 covering_space (c,p) s
17057 compact s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}))`,
17058 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
17059 [ASM_MESON_TAC[covering_space; COMPACT_CONTINUOUS_IMAGE];
17060 MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS THEN ASM_MESON_TAC[];
17061 FIRST_ASSUM(MP_TAC o
17062 MATCH_MP COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP) THEN
17063 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
17064 ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
17065 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN