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 (* ------------------------------------------------------------------------- *)
2121 (* General "locally connected implies connected" type results. *)
2122 (* ------------------------------------------------------------------------- *)
2124 let OPEN_GENERAL_COMPONENT = prove
2125 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2126 (!s x y. c s x y ==> c s y x) /\
2127 (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2128 (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2129 (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2130 ==> c (ball(x,e)) x y)
2131 ==> !s x:real^N. open s ==> open(c s x)`,
2132 GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
2133 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
2134 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
2135 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
2136 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
2137 DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
2138 REWRITE_TAC[SUBSET; IN] THEN STRIP_TAC THEN
2139 SUBGOAL_THEN `(x:real^N) IN s /\ y IN s` STRIP_ASSUME_TAC THENL
2140 [ASM_MESON_TAC[]; ALL_TAC] THEN
2141 FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
2142 MATCH_MP_TAC MONO_EXISTS THEN
2143 X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2144 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
2145 REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN
2146 ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
2147 EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
2148 REMOVE_THEN "BALL" MATCH_MP_TAC THEN
2149 REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;
2151 let OPEN_NON_GENERAL_COMPONENT = prove
2152 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2153 (!s x y. c s x y ==> c s y x) /\
2154 (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2155 (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2156 (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2157 ==> c (ball(x,e)) x y)
2158 ==> !s x:real^N. open s ==> open(s DIFF c s x)`,
2159 GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
2160 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
2161 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
2162 DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
2163 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
2164 DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN
2165 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[IN])) THEN
2166 FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
2167 MATCH_MP_TAC MONO_EXISTS THEN
2168 X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2169 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
2170 REWRITE_TAC[IN] THEN DISCH_TAC THEN
2171 FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN
2172 REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN
2173 ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
2174 EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
2175 REMOVE_THEN "SYM" MATCH_MP_TAC THEN
2176 REMOVE_THEN "BALL" MATCH_MP_TAC THEN
2177 REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;
2179 let GENERAL_CONNECTED_OPEN = prove
2180 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2181 (!s x y. c s x y ==> c s y x) /\
2182 (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2183 (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2184 (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2185 ==> c (ball(x,e)) x y)
2186 ==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s
2188 REPEAT STRIP_TAC THEN
2189 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
2190 REWRITE_TAC[IN] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN
2191 MAP_EVERY EXISTS_TAC
2192 [`c (s:real^N->bool) (x:real^N):real^N->bool`;
2193 `s DIFF (c (s:real^N->bool) (x:real^N))`] THEN
2194 MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g)
2195 ==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN
2196 REPEAT CONJ_TAC THENL
2197 [MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
2198 OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
2199 MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
2200 OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
2205 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
2206 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
2207 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2208 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
2209 ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN
2210 FIRST_ASSUM(MATCH_MP_TAC o
2211 SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN
2212 ASM_MESON_TAC[CENTRE_IN_BALL]);;
2214 (* ------------------------------------------------------------------------- *)
2215 (* Some useful lemmas about path-connectedness. *)
2216 (* ------------------------------------------------------------------------- *)
2218 let CONVEX_IMP_PATH_CONNECTED = prove
2219 (`!s:real^N->bool. convex s ==> path_connected s`,
2220 REWRITE_TAC[CONVEX_ALT; path_connected] THEN REPEAT GEN_TAC THEN
2221 DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
2222 STRIP_TAC THEN EXISTS_TAC `\u. (&1 - drop u) % x + drop u % y:real^N` THEN
2223 ASM_SIMP_TAC[pathstart; pathfinish; DROP_VEC; path; path_image;
2224 SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN
2225 CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN VECTOR_ARITH_TAC] THEN
2226 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
2227 MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
2228 REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
2229 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;
2231 let PATH_CONNECTED_UNIV = prove
2232 (`path_connected(:real^N)`,
2233 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV]);;
2235 let IS_INTERVAL_PATH_CONNECTED = prove
2236 (`!s. is_interval s ==> path_connected s`,
2237 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; IS_INTERVAL_CONVEX]);;
2239 let PATH_CONNECTED_INTERVAL = prove
2240 (`(!a b:real^N. path_connected(interval[a,b])) /\
2241 (!a b:real^N. path_connected(interval(a,b)))`,
2242 SIMP_TAC[IS_INTERVAL_PATH_CONNECTED; IS_INTERVAL_INTERVAL]);;
2244 let PATH_COMPONENT_UNIV = prove
2245 (`!x. path_component(:real^N) x = (:real^N)`,
2246 MESON_TAC[PATH_CONNECTED_COMPONENT_SET; PATH_CONNECTED_UNIV; IN_UNIV]);;
2248 let PATH_CONNECTED_IMP_CONNECTED = prove
2249 (`!s:real^N->bool. path_connected s ==> connected s`,
2251 REWRITE_TAC[path_connected; CONNECTED_IFF_CONNECTED_COMPONENT] THEN
2252 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
2253 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN
2254 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
2255 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
2256 REWRITE_TAC[connected_component] THEN
2257 EXISTS_TAC `path_image(g:real^1->real^N)` THEN
2258 ASM_MESON_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE;
2259 PATHFINISH_IN_PATH_IMAGE]);;
2261 let OPEN_PATH_COMPONENT = prove
2262 (`!s x:real^N. open s ==> open(path_component s x)`,
2263 MATCH_MP_TAC OPEN_GENERAL_COMPONENT THEN
2264 REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
2265 PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
2266 MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
2267 (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
2268 ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;
2270 let OPEN_NON_PATH_COMPONENT = prove
2271 (`!s x:real^N. open s ==> open(s DIFF path_component s x)`,
2272 MATCH_MP_TAC OPEN_NON_GENERAL_COMPONENT THEN
2273 REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
2274 PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
2275 MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
2276 (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
2277 ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;
2279 let PATH_CONNECTED_CONTINUOUS_IMAGE = prove
2280 (`!f:real^M->real^N s.
2281 f continuous_on s /\ path_connected s ==> path_connected (IMAGE f s)`,
2282 REPEAT GEN_TAC THEN REWRITE_TAC[path_connected] THEN STRIP_TAC THEN
2283 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2284 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
2285 X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
2286 FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
2287 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
2288 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
2289 EXISTS_TAC `(f:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL
2290 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2291 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
2292 ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;
2294 let HOMEOMORPHIC_PATH_CONNECTEDNESS = prove
2295 (`!s t. s homeomorphic t ==> (path_connected s <=> path_connected t)`,
2296 REWRITE_TAC[homeomorphic; homeomorphism] THEN
2297 MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2299 let PATH_CONNECTED_LINEAR_IMAGE = prove
2300 (`!f:real^M->real^N s.
2301 path_connected s /\ linear f ==> path_connected(IMAGE f s)`,
2302 SIMP_TAC[LINEAR_CONTINUOUS_ON; PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2304 let PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
2305 (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
2306 ==> (path_connected (IMAGE f s) <=> path_connected s)`,
2307 MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE PATH_CONNECTED_LINEAR_IMAGE));;
2309 add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];;
2311 let PATH_CONNECTED_EMPTY = prove
2312 (`path_connected {}`,
2313 REWRITE_TAC[path_connected; NOT_IN_EMPTY]);;
2315 let PATH_CONNECTED_SING = prove
2316 (`!a:real^N. path_connected {a}`,
2317 GEN_TAC THEN REWRITE_TAC[path_connected; IN_SING] THEN
2318 REPEAT STRIP_TAC THEN EXISTS_TAC `linepath(a:real^N,a)` THEN
2319 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
2320 REWRITE_TAC[SEGMENT_REFL; PATH_IMAGE_LINEPATH; SUBSET_REFL]);;
2322 let PATH_CONNECTED_UNION = prove
2323 (`!s t. path_connected s /\ path_connected t /\ ~(s INTER t = {})
2324 ==> path_connected (s UNION t)`,
2325 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
2326 REWRITE_TAC[IN_INTER; IN_UNION] THEN
2327 MESON_TAC[PATH_COMPONENT_OF_SUBSET; SUBSET_UNION; PATH_COMPONENT_TRANS]);;
2329 let PATH_CONNECTED_TRANSLATION = prove
2330 (`!a s. path_connected s ==> path_connected (IMAGE (\x:real^N. a + x) s)`,
2331 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
2332 ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;
2334 let PATH_CONNECTED_TRANSLATION_EQ = prove
2335 (`!a s. path_connected (IMAGE (\x:real^N. a + x) s) <=> path_connected s`,
2336 REWRITE_TAC[path_connected] THEN GEOM_TRANSLATE_TAC[]);;
2338 add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];;
2340 let PATH_CONNECTED_PCROSS = prove
2341 (`!s:real^M->bool t:real^N->bool.
2342 path_connected s /\ path_connected t
2343 ==> path_connected (s PCROSS t)`,
2344 REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; path_connected] THEN DISCH_TAC THEN
2345 REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
2346 MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN
2347 STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2
2348 (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`])
2349 (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN
2350 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2351 X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
2352 X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN
2353 EXISTS_TAC `(\t. pastecart (x1:real^M) ((h:real^1->real^N) t)) ++
2354 (\t. pastecart ((g:real^1->real^M) t) (y2:real^N))` THEN
2355 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path]) THEN
2356 RULE_ASSUM_TAC(REWRITE_RULE[path_image; FORALL_IN_IMAGE; SUBSET]) THEN
2357 REPEAT CONJ_TAC THENL
2358 [MATCH_MP_TAC PATH_JOIN_IMP THEN REPEAT CONJ_TAC THENL
2359 [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2360 ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
2361 REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2362 ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
2363 ASM_REWRITE_TAC[pathstart; pathfinish]];
2364 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
2365 ASM_SIMP_TAC[path_image; FORALL_IN_IMAGE; SUBSET; IN_ELIM_PASTECART_THM];
2366 REWRITE_TAC[PATHSTART_JOIN] THEN ASM_REWRITE_TAC[pathstart];
2367 REWRITE_TAC[PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[pathfinish]]);;
2369 let PATH_CONNECTED_PCROSS_EQ = prove
2370 (`!s:real^M->bool t:real^N->bool.
2371 path_connected(s PCROSS t) <=>
2372 s = {} \/ t = {} \/ path_connected s /\ path_connected t`,
2374 ASM_CASES_TAC `s:real^M->bool = {}` THEN
2375 ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
2376 ASM_CASES_TAC `t:real^N->bool = {}` THEN
2377 ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
2378 EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
2379 [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
2380 `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2381 PATH_CONNECTED_LINEAR_IMAGE) THEN
2382 ASM_REWRITE_TAC[LINEAR_FSTCART];
2383 MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
2384 `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2385 PATH_CONNECTED_LINEAR_IMAGE) THEN
2386 ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
2387 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2388 REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
2389 FSTCART_PASTECART; SNDCART_PASTECART] THEN
2392 let PATH_CONNECTED_SCALING = prove
2393 (`!s:real^N->bool c.
2394 path_connected s ==> path_connected (IMAGE (\x. c % x) s)`,
2395 REPEAT STRIP_TAC THEN
2396 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2397 MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
2398 REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
2399 REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2401 let PATH_CONNECTED_NEGATIONS = prove
2403 path_connected s ==> path_connected (IMAGE (--) s)`,
2404 REPEAT STRIP_TAC THEN
2405 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2406 MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
2407 REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
2408 REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2410 let PATH_CONNECTED_SUMS = prove
2411 (`!s t:real^N->bool.
2412 path_connected s /\ path_connected t
2413 ==> path_connected {x + y | x IN s /\ y IN t}`,
2415 DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_PCROSS) THEN
2416 DISCH_THEN(MP_TAC o ISPEC
2417 `\z. (fstcart z + sndcart z:real^N)` o
2418 MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2419 PATH_CONNECTED_CONTINUOUS_IMAGE)) THEN
2420 SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
2421 LINEAR_SNDCART; PCROSS] THEN
2422 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2423 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN
2424 REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
2427 let IS_INTERVAL_PATH_CONNECTED_1 = prove
2428 (`!s:real^1->bool. is_interval s <=> path_connected s`,
2429 MESON_TAC[CONVEX_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED;
2430 IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1]);;
2432 (* ------------------------------------------------------------------------- *)
2433 (* More stuff about segments. *)
2434 (* ------------------------------------------------------------------------- *)
2436 let SEGMENT_OPEN_SUBSET_CLOSED = prove
2437 (`!a b. segment(a,b) SUBSET segment[a,b]`,
2438 REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]);;
2440 let CLOSED_SEGMENT = prove
2441 (`!a b. closed(segment[a,b])`,
2442 REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2443 MATCH_MP_TAC COMPACT_IMP_CLOSED THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN
2444 MATCH_MP_TAC FINITE_IMP_COMPACT THEN SIMP_TAC[FINITE_RULES]);;
2446 let SEGMENT_IMAGE_INTERVAL = prove
2447 (`(!a b. segment[a,b] =
2448 IMAGE (\u. (&1 - drop u) % a + drop u % b)
2449 (interval[vec 0,vec 1])) /\
2452 IMAGE (\u. (&1 - drop u) % a + drop u % b)
2453 (interval(vec 0,vec 1)))`,
2454 REPEAT STRIP_TAC THEN
2455 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_SEGMENT] THEN
2456 ASM_REWRITE_TAC[GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]);;
2458 let CLOSURE_SEGMENT = prove
2459 (`(!a b:real^N. closure(segment[a,b]) = segment[a,b]) /\
2460 (!a b:real^N. closure(segment(a,b)) = if a = b then {} else segment[a,b])`,
2461 REWRITE_TAC[CLOSURE_EQ; CLOSED_SEGMENT] THEN
2462 REPEAT GEN_TAC THEN COND_CASES_TAC THEN
2463 ASM_REWRITE_TAC[SEGMENT_REFL; CLOSURE_EMPTY] THEN
2464 ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THEN
2465 ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL CLOSURE_OPEN_INTERVAL);
2466 INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_ARITH `~(&1 <= &0)`] THEN
2468 `(\u. (&1 - drop u) % a + drop u % (b:real^N)) =
2469 (\x. a + x) o (\u. drop u % (b - a))`
2471 [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
2472 REWRITE_TAC[IMAGE_o; CLOSURE_TRANSLATION] THEN AP_TERM_TAC THEN
2473 MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
2474 ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_SUB_EQ; DROP_EQ] THEN
2475 REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;
2477 let AFFINE_HULL_SEGMENT = prove
2478 (`(!a b:real^N. affine hull (segment [a,b]) = affine hull {a,b}) /\
2479 (!a b:real^N. affine hull (segment(a,b)) =
2480 if a = b then {} else affine hull {a,b})`,
2481 REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL] THEN
2482 REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN
2483 REWRITE_TAC[CLOSURE_SEGMENT] THEN
2484 COND_CASES_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN
2485 REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL]);;
2487 let SEGMENT_AS_BALL = prove
2488 (`(!a b. segment[a:real^N,b] =
2489 affine hull {a,b} INTER cball(inv(&2) % (a + b),norm(b - a) / &2)) /\
2490 (!a b. segment(a:real^N,b) =
2491 affine hull {a,b} INTER ball(inv(&2) % (a + b),norm(b - a) / &2))`,
2492 REPEAT STRIP_TAC THEN
2493 (ASM_CASES_TAC `b:real^N = a` THEN
2494 ASM_REWRITE_TAC[SEGMENT_REFL; VECTOR_SUB_REFL; NORM_0] THEN
2495 CONV_TAC REAL_RAT_REDUCE_CONV THEN
2496 REWRITE_TAC[BALL_TRIVIAL; CBALL_TRIVIAL] THENL
2497 [REWRITE_TAC[INTER_EMPTY; INSERT_AC] THEN
2498 REWRITE_TAC[VECTOR_ARITH `&1 / &2 % (a + a) = a`] THEN
2499 REWRITE_TAC[SET_RULE `a = b INTER a <=> a SUBSET b`; HULL_SUBSET];
2500 ASM_REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_INTER; AFFINE_HULL_2] THEN
2501 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
2502 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2503 REWRITE_TAC[REAL_ARITH `u + v:real = &1 <=> u = &1 - v`] THEN
2504 REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
2505 AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
2506 X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN
2507 ASM_CASES_TAC `y:real^N = (&1 - u) % a + u % b` THEN
2508 ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_BALL; IN_CBALL; dist; VECTOR_ARITH
2509 `&1 / &2 % (a + b) - ((&1 - u) % a + u % b):real^N =
2510 (&1 / &2 - u) % (b - a)`] THEN
2511 ASM_SIMP_TAC[NORM_MUL; REAL_LT_MUL_EQ; REAL_LE_MUL_EQ; NORM_POS_LT;
2512 VECTOR_SUB_EQ; REAL_ARITH `a * n < n / &2 <=> &0 < n * (inv(&2) - a)`;
2513 REAL_ARITH `a * n <= n / &2 <=> &0 <= n * (inv(&2) - a)`] THEN
2516 let CONVEX_SEGMENT = prove
2517 (`(!a b. convex(segment[a,b])) /\ (!a b. convex(segment(a,b)))`,
2518 REWRITE_TAC[SEGMENT_AS_BALL] THEN
2519 SIMP_TAC[CONVEX_INTER; CONVEX_BALL; CONVEX_CBALL;
2520 AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);;
2522 let RELATIVE_INTERIOR_SEGMENT = prove
2524 relative_interior(segment[a,b]) = if a = b then {a} else segment(a,b)) /\
2525 (!a b:real^N. relative_interior(segment(a,b)) = segment(a,b))`,
2526 MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
2527 [REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
2528 ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_EMPTY] THEN
2529 REWRITE_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_OPEN] THEN
2530 ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN
2531 EXISTS_TAC `ball(inv(&2) % (a + b):real^N,norm(b - a) / &2)` THEN
2532 REWRITE_TAC[OPEN_BALL; SEGMENT_AS_BALL];
2533 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
2534 ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_SING] THEN
2535 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 CLOSURE_SEGMENT)) THEN
2536 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2537 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
2538 MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN
2539 REWRITE_TAC[CONVEX_SEGMENT]]);;
2541 let PATH_CONNECTED_SEGMENT = prove
2542 (`(!a b. path_connected(segment[a,b])) /\
2543 (!a b. path_connected(segment(a,b)))`,
2544 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEGMENT]);;
2546 let CONNECTED_SEGMENT = prove
2547 (`(!a b. connected(segment[a,b])) /\ (!a b. connected(segment(a,b)))`,
2548 SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEGMENT]);;
2550 let CONVEX_SEMIOPEN_SEGMENT = prove
2551 (`(!a b:real^N. convex(segment[a,b] DELETE a)) /\
2552 (!a b:real^N. convex(segment[a,b] DELETE b))`,
2553 MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN
2554 CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
2555 REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN
2556 ASM_SIMP_TAC[SEGMENT_REFL; SET_RULE `{a} DELETE a = {}`; CONVEX_EMPTY] THEN
2557 REWRITE_TAC[CONVEX_ALT; IN_DELETE] THEN
2558 SIMP_TAC[REWRITE_RULE[CONVEX_ALT] CONVEX_SEGMENT] THEN
2559 REWRITE_TAC[IN_SEGMENT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
2560 ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
2561 GSYM VECTOR_ADD_ASSOC] THEN
2562 ASM_REWRITE_TAC[VECTOR_ARITH
2563 `x % a + y % b + z % a + w % b:real^N = a <=>
2564 (&1 - x - z) % a = (w + y) % b`] THEN
2565 ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_ARITH
2566 `&1 - (&1 - u) * (&1 - v) - u * (&1 - w) =
2567 u * w + (&1 - u) * v`] THEN
2568 ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
2569 `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN
2570 REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN
2571 DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2572 `(u = &0 \/ w = &0) /\ (u = &1 \/ v = &0)
2573 ==> u = &0 /\ v = &0 \/ u = &1 /\ w = &0 \/ v = &0 /\ w = &0`)) THEN
2574 DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
2575 ASM_MESON_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
2577 let PATH_CONNECTED_SEMIOPEN_SEGMENT = prove
2578 (`(!a b:real^N. path_connected(segment[a,b] DELETE a)) /\
2579 (!a b:real^N. path_connected(segment[a,b] DELETE b))`,
2580 SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;
2582 let CONNECTED_SEMIOPEN_SEGMENT = prove
2583 (`(!a b:real^N. connected(segment[a,b] DELETE a)) /\
2584 (!a b:real^N. connected(segment[a,b] DELETE b))`,
2585 SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;
2587 let SEGMENT_EQ_EMPTY = prove
2588 (`(!a b:real^N. ~(segment[a,b] = {})) /\
2589 (!a b:real^N. segment(a,b) = {} <=> a = b)`,
2590 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN
2591 REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
2592 ASM_REWRITE_TAC[SEGMENT_REFL] THEN
2593 ASM_MESON_TAC[NOT_IN_EMPTY; MIDPOINT_IN_SEGMENT]);;
2595 let FINITE_SEGMENT = prove
2596 (`(!a b:real^N. FINITE(segment[a,b]) <=> a = b) /\
2597 (!a b:real^N. FINITE(segment(a,b)) <=> a = b)`,
2598 REWRITE_TAC[open_segment; SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN
2599 REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN
2600 ASM_CASES_TAC `a:real^N = b` THEN
2601 ASM_REWRITE_TAC[SEGMENT_REFL; FINITE_SING] THEN
2602 REWRITE_TAC[SEGMENT_IMAGE_INTERVAL] THEN
2603 W(MP_TAC o PART_MATCH (lhs o rand) FINITE_IMAGE_INJ_EQ o rand o snd) THEN
2605 [REWRITE_TAC[VECTOR_ARITH
2606 `(&1 - u) % a + u % b:real^N = (&1 - v) % a + v % b <=>
2607 (u - v) % (b - a) = vec 0`] THEN
2608 ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ];
2609 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_INTERVAL_1] THEN
2610 REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC]);;
2612 let SEGMENT_EQ_SING = prove
2613 (`(!a b c:real^N. segment[a,b] = {c} <=> a = c /\ b = c) /\
2614 (!a b c:real^N. ~(segment(a,b) = {c}))`,
2615 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_SING] THEN
2616 CONJ_TAC THENL [SET_TAC[]; REPEAT GEN_TAC] THEN
2617 ASM_CASES_TAC `a:real^N = b` THEN
2618 ASM_REWRITE_TAC[SEGMENT_REFL; NOT_INSERT_EMPTY] THEN
2620 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 FINITE_SEGMENT)) THEN
2621 ASM_REWRITE_TAC[FINITE_SING]);;
2623 let SUBSET_SEGMENT_OPEN_CLOSED = prove
2625 segment(a,b) SUBSET segment(c,d) <=>
2626 a = b \/ segment[a,b] SUBSET segment[c,d]`,
2627 REPEAT GEN_TAC THEN EQ_TAC THENL
2628 [ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[] THEN
2629 DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN
2630 ASM_REWRITE_TAC[CLOSURE_SEGMENT] THEN
2631 COND_CASES_TAC THEN REWRITE_TAC[SUBSET_EMPTY; SEGMENT_EQ_EMPTY];
2633 DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN
2634 REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET] THEN
2635 ABBREV_TAC `m:real^N = d - c` THEN POP_ASSUM MP_TAC THEN
2636 GEOM_NORMALIZE_TAC `m:real^N` THEN
2637 SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; SEGMENT_EQ_SING; SEGMENT_EQ_EMPTY;
2638 SET_RULE `s SUBSET {a} <=> s = {a} \/ s = {}`; SUBSET_REFL] THEN
2639 X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
2640 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN
2641 GEOM_ORIGIN_TAC `c:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `d:real^N` THEN
2642 X_GEN_TAC `d:real` THEN DISCH_TAC THEN
2643 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
2644 SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
2645 ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN
2646 POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
2647 SUBGOAL_THEN `collinear{vec 0:real^N,&1 % basis 1,x} /\
2648 collinear{vec 0:real^N,&1 % basis 1,y}`
2650 [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
2651 CONJ_TAC THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN
2652 REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN
2653 ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT];
2655 SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
2656 VECTOR_ARITH `&1 % x:real^N = vec 0 <=> x = vec 0`] THEN
2657 REWRITE_TAC[IMP_CONJ; VECTOR_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN
2658 X_GEN_TAC `a:real` THEN REWRITE_TAC[REAL_MUL_RID] THEN
2659 DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `b:real` THEN
2660 DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN
2661 SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN
2662 ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; VECTOR_MUL_RCANCEL; BASIS_NONZERO;
2663 DIMINDEX_GE_1; LE_REFL; SET_RULE
2664 `(!x y. x % v = y % v <=> x = y)
2665 ==> ({x % v | P x} SUBSET {x % v | Q x} <=>
2666 {x | P x} SUBSET {x | Q x})`] THEN
2667 REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=>
2668 min a b <= x /\ x <= max a b`;
2669 REAL_ARITH `a < x /\ x < b \/ b < x /\ x < a <=>
2670 min a b < x /\ x < max a b`] THEN
2671 CONV_TAC REAL_RAT_REDUCE_CONV THEN
2672 REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN
2673 X_GEN_TAC `x:real` THEN
2674 FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th)
2675 [`min (a:real) b`; `max (a:real) b`]) THEN
2678 let SUBSET_SEGMENT = prove
2680 segment[a,b] SUBSET segment[c,d] <=>
2681 a IN segment[c,d] /\ b IN segment[c,d]) /\
2683 segment[a,b] SUBSET segment(c,d) <=>
2684 a IN segment(c,d) /\ b IN segment(c,d)) /\
2686 segment(a,b) SUBSET segment[c,d] <=>
2687 a = b \/ a IN segment[c,d] /\ b IN segment[c,d]) /\
2689 segment(a,b) SUBSET segment(c,d) <=>
2690 a = b \/ a IN segment[c,d] /\ b IN segment[c,d])`,
2691 MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
2693 [REPEAT STRIP_TAC THEN
2694 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_CONVEX_HULL] THEN
2695 SIMP_TAC[SUBSET_HULL; CONVEX_SEGMENT] THEN SET_TAC[];
2696 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_SEGMENT_OPEN_CLOSED] THEN
2697 REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2698 EXISTS_TAC `closure(segment(a:real^N,b)) SUBSET segment[c,d]` THEN
2699 CONJ_TAC THENL [SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_SEGMENT]; ALL_TAC] THEN
2700 REWRITE_TAC[CLOSURE_SEGMENT] THEN
2701 COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_SUBSET]]);;
2703 let INTERIOR_SEGMENT = prove
2704 (`(!a b:real^N. interior(segment[a,b]) =
2705 if 2 <= dimindex(:N) then {} else segment(a,b)) /\
2706 (!a b:real^N. interior(segment(a,b)) =
2707 if 2 <= dimindex(:N) then {} else segment(a,b))`,
2708 REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2709 ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL
2710 [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ s = {} ==> s = {} /\ t = {}`) THEN
2711 SIMP_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SUBSET_INTERIOR] THEN
2712 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2713 MATCH_MP_TAC EMPTY_INTERIOR_CONVEX_HULL THEN
2714 REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN FIRST_ASSUM
2715 (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS)) THEN
2716 SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC;
2717 ASM_CASES_TAC `a:real^N = b` THEN
2718 ASM_SIMP_TAC[SEGMENT_REFL; INTERIOR_EMPTY; EMPTY_INTERIOR_FINITE;
2721 `affine hull (segment[a,b]) = (:real^N) /\
2722 affine hull (segment(a,b)) = (:real^N)`
2723 (fun th -> ASM_SIMP_TAC[th; GSYM RELATIVE_INTERIOR_INTERIOR;
2724 RELATIVE_INTERIOR_SEGMENT]) THEN
2725 ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN
2726 MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN
2727 REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
2728 ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
2731 let SEGMENT_EQ = prove
2733 segment[a,b] = segment[c,d] <=> {a,b} = {c,d}) /\
2735 ~(segment[a,b] = segment(c,d))) /\
2737 ~(segment(a,b) = segment[c,d])) /\
2739 segment(a,b) = segment(c,d) <=> a = b /\ c = d \/ {a,b} = {c,d})`,
2740 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2741 [REPEAT GEN_TAC THEN EQ_TAC THENL
2742 [DISCH_THEN(fun th -> MP_TAC th THEN
2743 MP_TAC(AP_TERM `\s:real^N->bool. s DIFF relative_interior s` th)) THEN
2744 REWRITE_TAC[RELATIVE_INTERIOR_SEGMENT] THEN
2745 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL]) THEN
2746 SIMP_TAC[ENDS_IN_SEGMENT; open_segment; SET_RULE
2747 `a IN s /\ b IN s ==> s DIFF (s DIFF {a,b}) = {a,b}`] THEN
2748 ASM SET_TAC[SEGMENT_EQ_SING];
2749 SIMP_TAC[SEGMENT_CONVEX_HULL]];
2751 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2752 [REPEAT STRIP_TAC THEN
2753 FIRST_ASSUM(MP_TAC o AP_TERM `closed:(real^N->bool)->bool`) THEN
2754 REWRITE_TAC[CLOSED_SEGMENT] THEN
2755 REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN
2756 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
2757 [ASM SET_TAC[SEGMENT_EQ_EMPTY];
2758 REWRITE_TAC[open_segment; ENDS_IN_SEGMENT; SET_RULE
2759 `s = s DIFF {a,b} <=> ~(a IN s) /\ ~(b IN s)`]];
2760 DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
2761 REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = d` THEN
2762 ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL
2763 [ASM SET_TAC[]; ALL_TAC] THEN
2764 CONV_TAC(BINOP_CONV SYM_CONV)THEN
2765 ASM_CASES_TAC `a:real^N = b` THEN
2766 ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL
2767 [ASM SET_TAC[]; ALL_TAC] THEN
2768 ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_SEGMENT_OPEN_CLOSED] THEN
2769 ASM_REWRITE_TAC[SUBSET_ANTISYM_EQ]]);;
2771 let COMPACT_SEGMENT = prove
2772 (`!a b. compact(segment[a,b])`,
2773 SIMP_TAC[SEGMENT_CONVEX_HULL; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT;
2774 FINITE_INSERT; FINITE_EMPTY]);;
2776 let BOUNDED_SEGMENT = prove
2777 (`(!a b:real^N. bounded(segment[a,b])) /\
2778 (!a b:real^N. bounded(segment(a,b)))`,
2779 REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2780 MATCH_MP_TAC(MESON[BOUNDED_SUBSET]
2781 `bounded s /\ t SUBSET s ==> bounded s /\ bounded t`) THEN
2782 REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN
2783 MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_SEGMENT]);;
2785 let COLLINEAR_SEGMENT = prove
2786 (`(!a b:real^N. collinear(segment[a,b])) /\
2787 (!a b:real^N. collinear(segment(a,b)))`,
2788 REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2789 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2790 [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
2791 MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
2792 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
2793 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN
2794 REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]]);;
2796 let UNION_SEGMENT = prove
2799 ==> segment[a,b] UNION segment[b,c] = segment[a,c]`,
2800 REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL
2801 [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; UNION_IDEMPOT];
2802 ONCE_REWRITE_TAC[UNION_COMM] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2803 DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_HULL_EXCHANGE_UNION) THEN
2804 ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
2805 REWRITE_TAC[IMAGE_CLAUSES; UNIONS_2] THEN
2806 BINOP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
2808 let INTER_SEGMENT = prove
2810 b IN segment[a,c] \/ ~collinear{a,b,c}
2811 ==> segment[a,b] INTER segment[b,c] = {b}`,
2812 REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL
2813 [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; INTER_IDEMPOT; INSERT_AC; COLLINEAR_2];
2815 DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
2816 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN DISCH_TAC THEN
2817 MP_TAC(ISPECL [`{a:real^N,c}`; `b:real^N`; `{a:real^N}`; `{c:real^N}`]
2818 CONVEX_HULL_EXCHANGE_INTER) THEN
2819 ASM_REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
2820 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INSERT_AC]] THEN
2821 DISCH_THEN SUBST1_TAC THEN
2822 ASM_SIMP_TAC[SET_RULE `~(a = c) ==> {a} INTER {c} = {}`] THEN
2823 REWRITE_TAC[CONVEX_HULL_SING];
2824 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
2825 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
2827 ==> b IN s /\ b IN t
2828 ==> ?a. ~(a = b) /\ a IN s /\ b IN s /\ a IN t /\ b IN t`)) THEN
2829 ANTS_TAC THENL [REWRITE_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
2830 REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN
2831 X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN
2832 REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN
2833 MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `d:real^N` THEN
2834 REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);;
2836 let SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 = prove
2837 (`!f:real^N->real^1 a b.
2838 f continuous_on segment[a,b]
2839 ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b])`,
2840 REPEAT STRIP_TAC THEN
2841 FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2842 CONNECTED_CONTINUOUS_IMAGE)) THEN
2843 REWRITE_TAC[CONNECTED_SEGMENT] THEN
2844 REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1] THEN
2845 REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN
2846 MESON_TAC[IN_IMAGE; ENDS_IN_SEGMENT]);;
2848 let CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1 = prove
2849 (`!f:real^N->real^1 a b.
2850 f continuous_on segment[a,b] /\
2851 (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
2852 ==> IMAGE f (segment[a,b]) = segment[f a,f b]`,
2855 ~(a = b) /\ ~(a IN segment(c,b)) /\ ~(b IN segment(a,c))
2856 ==> c IN segment[a,b]`,
2857 REWRITE_TAC[FORALL_LIFT; SEGMENT_1; LIFT_DROP] THEN
2858 REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_EQ] THEN
2859 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]) THEN
2860 ASM_REAL_ARITH_TAC) in
2861 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2862 REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; LEFT_IMP_EXISTS_THM] THEN
2863 X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN
2864 MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^1->real^N`;
2865 `segment[a:real^N,b]`]
2866 CONTINUOUS_ON_INVERSE) THEN
2867 ASM_REWRITE_TAC[COMPACT_SEGMENT] THEN DISCH_TAC THEN
2868 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
2869 MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
2870 [ASM_SIMP_TAC[SUBSET_CONTINUOUS_IMAGE_SEGMENT_1]; DISCH_TAC] THEN
2871 ASM_CASES_TAC `a:real^N = b` THEN
2872 ASM_REWRITE_TAC[SEGMENT_REFL] THENL [SET_TAC[]; ALL_TAC] THEN
2873 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N` THEN
2874 DISCH_TAC THEN MATCH_MP_TAC lemma THEN
2875 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2876 [ASM_MESON_TAC[ENDS_IN_SEGMENT]; DISCH_TAC] THEN
2877 ONCE_REWRITE_TAC[segment] THEN
2878 ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
2879 REPEAT STRIP_TAC THENL
2880 [MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `b:real^N`]
2881 SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
2882 SUBGOAL_THEN `segment[c:real^N,b] SUBSET segment[a,b]` ASSUME_TAC THENL
2883 [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2884 REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2885 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
2886 DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) a`) THEN
2887 ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
2888 X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = a` THENL
2889 [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT];
2890 ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]];
2891 MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `c:real^N`]
2892 SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
2893 SUBGOAL_THEN `segment[a:real^N,c] SUBSET segment[a,b]` ASSUME_TAC THENL
2894 [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2895 REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2896 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
2897 DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN
2898 ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
2899 X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = b` THENL
2900 [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT; BETWEEN_SYM];
2901 ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]]);;
2903 let CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1 = prove
2904 (`!f:real^N->real^1 a b.
2905 f continuous_on segment[a,b] /\
2906 (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
2907 ==> IMAGE f (segment(a,b)) = segment(f a,f b)`,
2908 REPEAT GEN_TAC THEN DISCH_TAC THEN
2909 ONCE_REWRITE_TAC[segment] THEN
2910 FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
2911 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN
2912 MP_TAC(ISPECL [`(f:real^N->real^1) a`; `(f:real^1->real^1) b`]
2913 ENDS_IN_SEGMENT) THEN
2916 let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove
2917 (`!f:real^N->real^1 a b.
2918 f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b)
2919 ==> ?z. z IN segment(a,b) /\
2920 ((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/
2921 (!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`,
2922 REPEAT STRIP_TAC THEN
2923 MAP_EVERY (MP_TAC o ISPECL
2924 [`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`])
2925 [CONTINUOUS_ATTAINS_SUP; CONTINUOUS_ATTAINS_INF] THEN
2926 ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
2927 REWRITE_TAC[COMPACT_SEGMENT; SEGMENT_EQ_EMPTY] THEN
2928 DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN
2929 ASM_CASES_TAC `(d:real^N) IN segment(a,b)` THENL
2930 [ASM_MESON_TAC[]; ALL_TAC] THEN
2931 DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
2932 ASM_CASES_TAC `(c:real^N) IN segment(a,b)` THENL
2933 [ASM_MESON_TAC[]; ALL_TAC] THEN
2934 EXISTS_TAC `midpoint(a:real^N,b)` THEN
2935 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2936 [ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN
2937 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN
2938 REPEAT(FIRST_X_ASSUM(MP_TAC o
2939 GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN
2940 ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
2941 REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN
2942 FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]);;
2944 let FRONTIER_UNIONS_SUBSET_CLOSURE = prove
2945 (`!f:(real^N->bool)->bool.
2946 frontier(UNIONS f) SUBSET closure(UNIONS {frontier t | t IN f})`,
2947 GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN
2948 REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN
2949 X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
2950 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2951 FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
2952 ASM_REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN
2953 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
2954 ASM_CASES_TAC `(t:real^N->bool) IN f` THEN ASM_REWRITE_TAC[] THEN
2955 ASM_CASES_TAC `(x:real^N) IN t` THENL
2956 [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `x:real^N` THEN
2957 ASM_REWRITE_TAC[frontier; DIST_REFL; IN_DIFF] THEN
2958 ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
2959 FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
2960 SPEC_TAC(`x:real^N`,`z:real^N`) THEN
2961 REWRITE_TAC[CONTRAPOS_THM; GSYM SUBSET] THEN
2962 MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[];
2963 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
2964 MP_TAC(ISPECL [`segment[x:real^N,y]`; `t:real^N->bool`]
2965 CONNECTED_INTER_FRONTIER) THEN
2966 SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
2967 ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
2968 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
2969 ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM; REAL_LET_TRANS]]);;
2971 let CLOSURE_CONVEX_INTER_AFFINE = prove
2972 (`!s t:real^N->bool.
2973 convex s /\ affine t /\ ~(relative_interior s INTER t = {})
2974 ==> closure(s INTER t) = closure(s) INTER t`,
2975 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
2976 REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL
2977 [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[];
2978 TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN
2979 SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
2980 ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE; SUBSET_REFL];
2982 FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` MP_TAC o
2983 GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
2984 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
2985 GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN
2986 REWRITE_TAC[IN_INTER] THEN
2987 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
2988 ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN
2989 FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET]
2990 RELATIVE_INTERIOR_SUBSET)) THEN
2991 REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
2992 STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL
2993 [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
2994 ASM_REWRITE_TAC[IN_INTER];
2996 SUBGOAL_THEN `x IN closure(segment(vec 0:real^N,x))` MP_TAC THENL
2997 [ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2998 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
2999 MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET_INTER] THEN
3001 [TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN
3002 REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN
3003 MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN
3005 ASM_SIMP_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
3006 SUBSPACE_MUL; LEFT_IMP_EXISTS_THM]]);;
3008 let RELATIVE_FRONTIER_CONVEX_INTER_AFFINE = prove
3009 (`!s t:real^N->bool.
3010 convex s /\ affine t /\ ~(interior s INTER t = {})
3011 ==> relative_frontier(s INTER t) = frontier s INTER t`,
3012 SIMP_TAC[relative_frontier; RELATIVE_INTERIOR_CONVEX_INTER_AFFINE;
3014 REPEAT STRIP_TAC THEN
3015 SUBGOAL_THEN `~(relative_interior s INTER t:real^N->bool = {})`
3017 [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN
3019 ASM_SIMP_TAC[CLOSURE_CONVEX_INTER_AFFINE] THEN SET_TAC[]]);;
3021 let CONNECTED_COMPONENT_1_GEN = prove
3024 ==> (connected_component s a b <=> segment[a,b] SUBSET s)`,
3025 SIMP_TAC[connected_component; GSYM CONNECTED_CONVEX_1_GEN] THEN
3026 MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET; CONVEX_SEGMENT;
3029 let CONNECTED_COMPONENT_1 = prove
3030 (`!s a b:real^1. connected_component s a b <=> segment[a,b] SUBSET s`,
3031 SIMP_TAC[CONNECTED_COMPONENT_1_GEN; DIMINDEX_1]);;
3033 (* ------------------------------------------------------------------------- *)
3034 (* An injective function into R is a homeomorphism and so an open map. *)
3035 (* ------------------------------------------------------------------------- *)
3037 let INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM = prove
3038 (`!f:real^N->real^1 s.
3039 f continuous_on s /\ path_connected s
3040 ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3041 ?g. homeomorphism (s,IMAGE f s) (f,g))`,
3042 REPEAT STRIP_TAC THEN EQ_TAC THENL
3043 [REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE];
3044 REWRITE_TAC[homeomorphism] THEN MESON_TAC[]] THEN
3045 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN
3046 STRIP_TAC THEN ASM_SIMP_TAC[homeomorphism; FORALL_IN_IMAGE] THEN
3047 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3048 SUBGOAL_THEN `is_interval (IMAGE (f:real^N->real^1) s)` ASSUME_TAC THENL
3049 [REWRITE_TAC[IS_INTERVAL_PATH_CONNECTED_1] THEN
3050 ASM_MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE];
3052 REWRITE_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN
3053 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3054 ABBREV_TAC `y = (f:real^N->real^1) x` THEN
3055 ABBREV_TAC `t = IMAGE (f:real^N->real^1) s` THEN
3056 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3058 `?a b d. a IN s /\ b IN s /\ &0 < d /\
3059 ball(y,d) INTER t SUBSET segment[(f:real^N->real^1) a,f b]`
3060 STRIP_ASSUME_TAC THENL
3061 [MP_TAC(ISPECL [`t:real^1->bool`; `y:real^1`]
3062 INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
3063 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3064 ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN
3065 REWRITE_TAC[SET_RULE
3066 `P /\ y IN s /\ (s = {} \/ a IN t /\ b IN t) /\ R <=>
3067 a IN t /\ b IN t /\ P /\ y IN s /\ R`] THEN
3068 REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
3069 EXPAND_TAC "t" THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
3070 REWRITE_TAC[SEGMENT_1; IN_INTERVAL_1] THEN
3071 MESON_TAC[REAL_LE_TRANS];
3072 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
3073 DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3074 ASM_REWRITE_TAC[] THEN
3075 DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
3077 `(g:real^1->real^N) continuous_on segment[(f:real^N->real^1) a,f b]`
3079 [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
3080 EXISTS_TAC `IMAGE (f:real^N->real^1) (path_image p)` THEN CONJ_TAC THENL
3081 [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN
3082 ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN CONJ_TAC THENL
3083 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
3084 SUBGOAL_THEN `convex(IMAGE (f:real^N->real^1) (path_image p))`
3086 [REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; IS_INTERVAL_CONNECTED_1] THEN
3087 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
3088 ASM_SIMP_TAC[CONNECTED_PATH_IMAGE] THEN
3089 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
3090 REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN
3091 CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
3092 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]];
3093 REWRITE_TAC[continuous_on] THEN
3094 DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL
3095 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3096 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM SET_TAC[];
3098 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
3099 DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
3100 EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
3101 X_GEN_TAC `x':real^N` THEN REPEAT STRIP_TAC THEN
3102 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3103 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3104 ASM_REWRITE_TAC[IN_INTER; IN_BALL] THEN
3105 ONCE_REWRITE_TAC[DIST_SYM] THEN ASM SET_TAC[]]]);;
3107 let INJECTIVE_INTO_1D_IMP_OPEN_MAP = prove
3108 (`!f:real^N->real^1 s t.
3109 f continuous_on s /\ path_connected s /\
3110 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3111 open_in (subtopology euclidean s) t
3112 ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)`,
3113 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
3114 ASM_MESON_TAC[INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM]);;
3116 (* ------------------------------------------------------------------------- *)
3117 (* Injective function on an interval is strictly increasing or decreasing. *)
3118 (* ------------------------------------------------------------------------- *)
3120 let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove
3121 (`!f:real^1->real^1 s.
3122 f continuous_on s /\ is_interval s
3123 ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3124 (!x y. x IN s /\ y IN s /\ drop x < drop y
3125 ==> drop(f x) < drop(f y)) \/
3126 (!x y. x IN s /\ y IN s /\ drop x < drop y
3127 ==> drop(f y) < drop(f x)))`,
3129 (`!s f:real^1->real^1.
3130 f continuous_on s /\ is_interval s /\
3131 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3132 ==> !u v w. u IN s /\ v IN s /\ w IN s /\
3133 drop u < drop v /\ drop v < drop w /\
3134 drop(f u) <= drop(f v) /\ drop(f w) <= drop(f v) ==> F`,
3135 REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT] THEN
3136 REPEAT STRIP_TAC THEN
3137 MP_TAC(ISPECL [`f:real^1->real^1`; `u:real^1`; `w:real^1`]
3138 CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
3139 ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN
3140 REWRITE_TAC[EXTENSION] THEN
3141 DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) v`) THEN
3142 MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
3143 [MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[SEGMENT_1] THEN
3144 COND_CASES_TAC THENL
3145 [ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC];
3146 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
3147 ASM_REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THENL
3148 [SUBGOAL_THEN `drop(f(w:real^1)) = drop(f v)` ASSUME_TAC THENL
3149 [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]];
3150 SUBGOAL_THEN `drop(f(u:real^1)) = drop(f v)` ASSUME_TAC THENL
3151 [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]]])
3153 let [l1;l2] = map (map (fun x -> mk_var(x,`:real^1`)) o explode) [s1;s2] in
3154 REPEAT(FIRST_X_ASSUM(fun th ->
3155 MP_TAC(ISPECL l1 th) THEN MP_TAC(ISPECL l2 th))) THEN
3156 ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC in
3157 REPEAT STRIP_TAC THEN EQ_TAC THENL
3159 REWRITE_TAC[GSYM DROP_EQ] THEN
3160 MESON_TAC[REAL_LT_TOTAL; REAL_LT_REFL]] THEN
3161 DISCH_TAC THEN MATCH_MP_TAC(MESON[]
3162 `(!a b c d. ~(~P a b /\ ~Q c d)) ==> (!x y. P x y) \/ (!x y. Q x y)`) THEN
3163 MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN
3164 REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN STRIP_TAC THEN
3166 (FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN
3167 REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL
3168 [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]]) THEN
3169 MP_TAC(ISPEC `s:real^1->bool` lemma) THEN ASM_REWRITE_TAC[] THEN
3170 DISCH_THEN(fun th ->
3171 MP_TAC(SPEC `(--) o (f:real^1->real^1)` th) THEN
3172 MP_TAC(SPEC `f:real^1->real^1` th)) THEN
3173 ASM_REWRITE_TAC[o_THM; VECTOR_ARITH `--x:real^N = --y <=> x = y`] THEN
3174 DISCH_TAC THEN REWRITE_TAC[NOT_IMP; DROP_NEG; REAL_LE_NEG2] THEN
3176 [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE;LINEAR_CONTINUOUS_ON; LINEAR_NEGATION];
3178 ASM_CASES_TAC `drop d <= drop a` THENL [tac "cab" "cdb"; ALL_TAC] THEN
3179 ASM_CASES_TAC `drop b <= drop c` THENL [tac "abd" "acd"; ALL_TAC] THEN
3180 ASM_CASES_TAC `c:real^1 = a /\ d:real^1 = b` THENL
3181 [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN
3182 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
3184 ==> (c = a ==> d = b) /\ (d = b ==> c = a) /\
3185 (~(c = a) /\ ~(d = b) ==> F) ==> F`)) THEN
3186 REPEAT CONJ_TAC THENL
3187 [DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "adb" "abd";
3188 DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "acb" "cab";
3189 REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC] THEN
3190 ASM_CASES_TAC `drop a <= drop c` THENL [tac "acb" "acd"; tac "cab" "cad"]);;
3192 (* ------------------------------------------------------------------------- *)
3193 (* Some uncountability results for relevant sets. *)
3194 (* ------------------------------------------------------------------------- *)
3196 let CARD_EQ_SEGMENT = prove
3197 (`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\
3198 (!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`,
3199 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL
3200 [TRANS_TAC CARD_EQ_TRANS `interval[vec 0:real^1,vec 1]`;
3201 TRANS_TAC CARD_EQ_TRANS `interval(vec 0:real^1,vec 1)`] THEN
3202 SIMP_TAC[CARD_EQ_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
3203 MATCH_MP_TAC CARD_EQ_IMAGE THEN
3204 ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH
3205 `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
3206 (x - y) % (a - b) = vec 0`] THEN
3207 SIMP_TAC[REAL_SUB_0; DROP_EQ]);;
3209 let UNCOUNTABLE_SEGMENT = prove
3210 (`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\
3211 (!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`,
3212 SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_SEGMENT]);;
3214 let CARD_EQ_PATH_CONNECTED = prove
3216 path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
3217 MESON_TAC[CARD_EQ_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;
3219 let UNCOUNTABLE_PATH_CONNECTED = prove
3221 path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
3222 REPEAT GEN_TAC THEN STRIP_TAC THEN
3223 MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
3224 MATCH_MP_TAC CARD_EQ_PATH_CONNECTED THEN
3227 let CARD_EQ_CONVEX = prove
3229 convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
3230 MESON_TAC[CARD_EQ_PATH_CONNECTED; CONVEX_IMP_PATH_CONNECTED]);;
3232 let UNCOUNTABLE_CONVEX = prove
3234 convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
3235 REPEAT GEN_TAC THEN STRIP_TAC THEN
3236 MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
3237 MATCH_MP_TAC CARD_EQ_CONVEX THEN
3240 let CARD_EQ_NONEMPTY_INTERIOR = prove
3241 (`!s:real^N->bool. ~(interior s = {}) ==> s =_c (:real)`,
3242 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
3243 [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
3244 SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN];
3245 TRANS_TAC CARD_LE_TRANS `interior(s:real^N->bool)` THEN
3246 SIMP_TAC[CARD_LE_SUBSET; INTERIOR_SUBSET] THEN
3247 MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
3248 MATCH_MP_TAC CARD_EQ_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]]);;
3250 let UNCOUNTABLE_NONEMPTY_INTERIOR = prove
3251 (`!s:real^N->bool. ~(interior s = {}) ==> ~(COUNTABLE s)`,
3252 SIMP_TAC[CARD_EQ_NONEMPTY_INTERIOR; CARD_EQ_REAL_IMP_UNCOUNTABLE]);;
3254 let COUNTABLE_EMPTY_INTERIOR = prove
3255 (`!s:real^N->bool. COUNTABLE s ==> interior s = {}`,
3256 MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]);;
3258 let FINITE_EMPTY_INTERIOR = prove
3259 (`!s:real^N->bool. FINITE s ==> interior s = {}`,
3260 SIMP_TAC[COUNTABLE_EMPTY_INTERIOR; FINITE_IMP_COUNTABLE]);;
3262 let [CONNECTED_FINITE_IFF_SING;
3263 CONNECTED_FINITE_IFF_COUNTABLE;
3264 CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove)
3265 (`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\
3266 (!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\
3267 (!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`,
3268 REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
3269 ASM_CASES_TAC `connected(s:real^N->bool)` THEN
3270 ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT
3271 `(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r)
3272 ==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN
3273 REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN
3274 REPEAT CONJ_TAC THEN STRIP_TAC THEN
3275 ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN
3276 MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);;
3278 let CLOSED_AS_FRONTIER_OF_SUBSET = prove
3279 (`!s:real^N->bool. closed s <=> ?t. t SUBSET s /\ s = frontier t`,
3280 GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRONTIER_CLOSED]] THEN
3281 DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEPARABLE) THEN
3282 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
3283 SIMP_TAC[frontier] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3284 `s SUBSET c /\ c SUBSET s /\ i = {} ==> s = c DIFF i`) THEN
3285 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3286 [ASM_MESON_TAC[SUBSET_CLOSURE; CLOSURE_CLOSED];
3287 ASM_MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]]);;
3289 let CLOSED_AS_FRONTIER = prove
3290 (`!s:real^N->bool. closed s <=> ?t. s = frontier t`,
3291 GEN_TAC THEN EQ_TAC THENL
3292 [MESON_TAC[CLOSED_AS_FRONTIER_OF_SUBSET]; MESON_TAC[FRONTIER_CLOSED]]);;
3294 let CARD_EQ_CLOSED = prove
3295 (`!s:real^N->bool. closed s ==> s <=_c (:num) \/ s =_c (:real)`,
3299 ==> ?x y. ~(x = y) /\ x IN s /\ y IN s /\
3300 x condensation_point_of s /\
3301 y condensation_point_of s`,
3302 REPEAT STRIP_TAC THEN
3303 FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
3304 DISCH_THEN(MP_TAC o MATCH_MP CARD_INFINITE_CONG) THEN
3305 REWRITE_TAC[INFINITE] THEN
3306 MATCH_MP_TAC(TAUT `q /\ (p ==> s) ==> (p <=> q) ==> s`) THEN
3307 CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMP_COUNTABLE]; ALL_TAC] THEN
3309 MP_TAC(ISPECL [`2`; `{x:real^N | x IN s /\ x condensation_point_of s}`]
3310 CHOOSE_SUBSET_STRONG) THEN
3311 ASM_REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`; RIGHT_AND_EXISTS_THM] THEN
3312 DISCH_THEN(CHOOSE_THEN MP_TAC) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
3313 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
3314 STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
3315 RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; NOT_IN_EMPTY]) THEN
3316 ASM_REWRITE_TAC[]) in
3317 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM COUNTABLE_ALT] THEN
3318 ASM_CASES_TAC `COUNTABLE(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
3321 closed t /\ ~COUNTABLE t
3322 ==> ?l r. (compact l /\ ~COUNTABLE l) /\ (compact r /\ ~COUNTABLE r) /\
3323 l INTER r = {} /\ l SUBSET t /\ r SUBSET t /\
3324 diameter l <= inv(&2 pow n) /\
3325 diameter r <= inv(&2 pow n)`
3327 [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
3328 (MP_TAC o MATCH_MP slemma)) THEN
3329 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3330 MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
3331 MAP_EVERY EXISTS_TAC
3332 [`t INTER cball(a:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`;
3333 `t INTER cball(b:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`] THEN
3334 ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
3335 REPEAT CONJ_TAC THENL
3336 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
3337 [CONDENSATION_POINT_INFINITE_CBALL]) THEN
3338 REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
3339 UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3340 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
3341 [CONDENSATION_POINT_INFINITE_CBALL]) THEN
3342 REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
3343 UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3344 MATCH_MP_TAC(SET_RULE
3345 `(!x. ~(x IN t /\ x IN u)) ==> (s INTER t) INTER (s INTER u) = {}`) THEN
3346 REWRITE_TAC[IN_CBALL; REAL_LE_MIN] THEN
3347 UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3350 MATCH_MP_TAC DIAMETER_LE THEN
3351 SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
3352 REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN
3353 CONV_TAC NORM_ARITH;
3354 MATCH_MP_TAC DIAMETER_LE THEN
3355 SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
3356 REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN
3357 CONV_TAC NORM_ARITH];
3358 REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3360 [`l:num->(real^N->bool)->(real^N->bool)`;
3361 `r:num->(real^N->bool)->(real^N->bool)`] THEN
3364 `!b. ?x:num->real^N->bool.
3365 (x 0 = s) /\ (!n. x(SUC n) = if b(n) then r n (x n) else l n (x n))`
3368 W(ACCEPT_TAC o prove_recursive_functions_exist num_RECURSION o
3369 snd o dest_exists o snd);
3370 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN
3371 X_GEN_TAC `x:(num->bool)->num->real^N->bool` THEN STRIP_TAC THEN
3372 REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
3373 [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
3374 SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE];
3375 TRANS_TAC CARD_LE_TRANS `(:num->bool)` THEN
3376 SIMP_TAC[CARD_EQ_REAL; CARD_EQ_IMP_LE]] THEN
3377 REWRITE_TAC[le_c; IN_UNIV] THEN
3379 `!b n. closed((x:(num->bool)->num->real^N->bool) b n) /\
3382 [GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[] THEN
3383 COND_CASES_TAC THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
3384 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
3385 MP_TAC(GEN `b:num->bool` (ISPEC `(x:(num->bool)->num->real^N->bool) b`
3386 DECREASING_CLOSED_NEST_SING)) THEN
3387 DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
3388 [ASM_SIMP_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL
3389 [ASM_MESON_TAC[COUNTABLE_EMPTY];
3390 GEN_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
3391 REWRITE_TAC[SUBSET_REFL] THEN ASM SET_TAC[];
3392 MAP_EVERY X_GEN_TAC [`b:num->bool`; `e:real`] THEN DISCH_TAC THEN
3393 MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
3394 ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3395 DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN
3396 EXISTS_TAC `SUC m` THEN ASM_SIMP_TAC[] THEN
3397 REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
3398 DISCH_THEN(MP_TAC o MATCH_MP
3399 (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q /\ r ==> p ==> s`]
3400 DIAMETER_BOUNDED_BOUND)) THEN
3401 ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
3402 UNDISCH_TAC `inv(&2 pow m) < e` THEN MATCH_MP_TAC(NORM_ARITH
3403 `d <= i ==> i < e ==> norm(x - y) <= d ==> dist(x:real^N,y) < e`) THEN
3406 REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3407 X_GEN_TAC `f:(num->bool)->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL
3408 [X_GEN_TAC `b:num->bool` THEN
3409 REWRITE_TAC[SET_RULE `x IN s <=> {x} SUBSET s`] THEN
3410 FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
3411 REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
3412 ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
3413 SIMP_TAC[FORALL_UNWIND_THM2] THEN GEN_TAC THEN ASM SET_TAC[];
3414 MAP_EVERY X_GEN_TAC [`b:num->bool`; `c:num->bool`] THEN
3415 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3416 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [FUN_EQ_THM] THEN
3417 REWRITE_TAC[NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN
3418 SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
3419 MATCH_MP_TAC(SET_RULE
3420 `!f g. INTERS f = {a} /\ INTERS g = {b} /\
3421 (?s t. s IN f /\ t IN g /\ s INTER t = {})
3423 EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) b n}` THEN
3424 EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) c n}` THEN
3425 ASM_REWRITE_TAC[IN_ELIM_THM] THEN
3426 EXISTS_TAC `(x:(num->bool)->num->real^N->bool) b (SUC k)` THEN
3427 EXISTS_TAC `(x:(num->bool)->num->real^N->bool) c (SUC k)` THEN
3428 REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[] THEN
3430 `!i. i <= k ==> (x:(num->bool)->num->real^N->bool) b i = x c i`
3432 [INDUCT_TAC THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE];
3433 DISCH_THEN(MP_TAC o SPEC `k:num`)] THEN
3434 REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN
3435 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
3436 [TAUT `~(p <=> q) <=> (q <=> ~p)`]) THEN
3437 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
3438 ASM_MESON_TAC[INTER_COMM]]]);;
3440 let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS =
3443 {x | x condensation_point_of s} = {} <=> COUNTABLE s) /\
3445 {x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`,
3446 REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
3447 `(r ==> p) /\ (~r ==> q) /\ (p ==> ~q)
3448 ==> (p <=> r) /\ (q <=> ~r)`) THEN
3449 REPEAT CONJ_TAC THENL
3450 [DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
3451 REWRITE_TAC[condensation_point_of] THEN
3452 ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV];
3453 DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE
3454 [TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN
3455 REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN
3456 FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
3457 DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN
3458 ASM_REWRITE_TAC[CONTRAPOS_THM] THEN
3459 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[];
3460 DISCH_THEN SUBST1_TAC THEN
3461 DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN
3462 REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);;
3464 let UNCOUNTABLE_HAS_CONDENSATION_POINT = prove
3465 (`!s:real^N->bool. ~COUNTABLE s ==> ?x. x condensation_point_of s`,
3466 REWRITE_TAC[GSYM CONDENSATION_POINTS_EQ_EMPTY] THEN SET_TAC[]);;
3468 (* ------------------------------------------------------------------------- *)
3469 (* Density of sets with small complement, including irrationals. *)
3470 (* ------------------------------------------------------------------------- *)
3472 let COSMALL_APPROXIMATION = prove
3473 (`!s. ((:real) DIFF s) <_c (:real)
3474 ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
3476 (`!s. ((:real^1) DIFF s) <_c (:real)
3477 ==> !x e. &0 < e ==> ?y. y IN s /\ norm(y - x) < e`,
3478 REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3479 `~({x | P x} SUBSET UNIV DIFF s) ==> ?x. x IN s /\ P x`) THEN
3480 MP_TAC(ISPEC `ball(x:real^1,e)` CARD_EQ_OPEN) THEN
3481 ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE] THEN DISCH_TAC THEN
3482 DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
3483 REWRITE_TAC[CARD_NOT_LE] THEN
3484 REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM ball] THEN
3485 TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
3486 ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE]) in
3487 REWRITE_TAC[FORALL_DROP_IMAGE; FORALL_DROP; EXISTS_DROP] THEN
3488 REWRITE_TAC[GSYM IMAGE_DROP_UNIV; GSYM DROP_SUB; GSYM ABS_DROP] THEN
3489 REWRITE_TAC[DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN
3490 SIMP_TAC[GSYM IMAGE_DIFF_INJ; DROP_EQ] THEN GEN_TAC THEN
3491 DISCH_TAC THEN MATCH_MP_TAC lemma THEN POP_ASSUM MP_TAC THEN
3492 MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_LT_CONG THEN
3493 REWRITE_TAC[IMAGE_DROP_UNIV; CARD_EQ_REFL] THEN
3494 MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[DROP_EQ]);;
3496 let COCOUNTABLE_APPROXIMATION = prove
3497 (`!s. COUNTABLE((:real) DIFF s)
3498 ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
3499 GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_TAC THEN
3500 MATCH_MP_TAC COSMALL_APPROXIMATION THEN
3501 TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_REWRITE_TAC[] THEN
3502 TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3503 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3504 REWRITE_TAC[CARD_EQ_REAL]);;
3506 let IRRATIONAL_APPROXIMATION = prove
3507 (`!x e. &0 < e ==> ?y. ~(rational y) /\ abs(y - x) < e`,
3508 REWRITE_TAC[SET_RULE `~rational y <=> y IN UNIV DIFF rational`] THEN
3509 MATCH_MP_TAC COCOUNTABLE_APPROXIMATION THEN
3510 REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COUNTABLE_RATIONAL]);;
3512 let OPEN_SET_COSMALL_COORDINATES = prove
3513 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3514 ==> (:real) DIFF {x | P i x} <_c (:real))
3515 ==> !s:real^N->bool.
3517 ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
3518 REPEAT STRIP_TAC THEN
3519 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
3520 DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
3521 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
3522 DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
3523 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
3525 `!i. 1 <= i /\ i <= dimindex(:N)
3526 ==> ?y:real. P i y /\ abs(y - (a:real^N)$i) < d / &(dimindex(:N))`
3528 [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
3529 FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
3530 DISCH_THEN(MP_TAC o MATCH_MP COSMALL_APPROXIMATION) THEN
3531 REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
3532 ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1];
3533 REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3534 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
3535 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3536 REWRITE_TAC[IN_CBALL; dist] THEN
3537 W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
3538 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
3539 MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
3540 REWRITE_TAC[VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN
3541 ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
3542 ASM_SIMP_TAC[REAL_LT_IMP_LE; CARD_NUMSEG_1]]);;
3544 let OPEN_SET_COCOUNTABLE_COORDINATES = prove
3545 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3546 ==> COUNTABLE((:real) DIFF {x | P i x}))
3547 ==> !s:real^N->bool.
3549 ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
3550 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SET_COSMALL_COORDINATES THEN
3551 REPEAT STRIP_TAC THEN
3552 TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
3553 TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3554 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3555 REWRITE_TAC[CARD_EQ_REAL]);;
3557 let OPEN_SET_IRRATIONAL_COORDINATES = prove
3560 ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> ~rational(x$i)`,
3561 MATCH_MP_TAC OPEN_SET_COCOUNTABLE_COORDINATES THEN
3562 REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;
3564 let CLOSURE_COSMALL_COORDINATES = prove
3565 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3566 ==> (:real) DIFF {x | P i x} <_c (:real))
3567 ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
3569 GEN_TAC THEN DISCH_TAC THEN
3570 REWRITE_TAC[CLOSURE_APPROACHABLE; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
3571 MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN
3572 FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_SET_COSMALL_COORDINATES) THEN
3573 DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e)`) THEN
3574 ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; IN_BALL] THEN
3575 MESON_TAC[DIST_SYM]);;
3577 let CLOSURE_COCOUNTABLE_COORDINATES = prove
3578 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3579 ==> COUNTABLE((:real) DIFF {x | P i x}))
3580 ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
3582 REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_COSMALL_COORDINATES THEN
3583 REPEAT STRIP_TAC THEN
3584 TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
3585 TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3586 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3587 REWRITE_TAC[CARD_EQ_REAL]);;
3589 let CLOSURE_IRRATIONAL_COORDINATES = prove
3590 (`closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> ~rational(x$i)} =
3592 MATCH_MP_TAC CLOSURE_COCOUNTABLE_COORDINATES THEN
3593 REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;
3595 (* ------------------------------------------------------------------------- *)
3596 (* Every path between distinct points contains an arc, and hence *)
3597 (* that path connection is equivalent to arcwise connection, for distinct *)
3598 (* points. The proof is based on Whyburn's "Topological Analysis". *)
3599 (* ------------------------------------------------------------------------- *)
3601 let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove
3602 (`!f:real^1->real^N.
3603 f continuous_on interval[vec 0,vec 1] /\
3604 (!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\
3605 ~(f(vec 1) = f(vec 0))
3606 ==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic
3607 (interval[vec 0:real^1,vec 1])`,
3608 let closure_dyadic_rationals_in_convex_set_pos_1 = prove
3609 (`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x)
3610 ==> closure(s INTER { lift(&m / &2 pow n) |
3611 m IN (:num) /\ n IN (:num)}) =
3613 REPEAT STRIP_TAC THEN
3614 MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN
3615 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
3616 MATCH_MP_TAC(SET_RULE
3617 `(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t)
3618 ==> s INTER t = s INTER u`) THEN
3619 REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN
3620 REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN
3621 REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN
3622 CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN
3623 MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN
3624 FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN
3625 ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN
3626 ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in
3627 let function_on_dyadic_rationals = prove
3629 (!m n. f (2 * m) (n + 1) = f m n)
3630 ==> ?g. !m n. g(&m / &2 pow n) = f m n`,
3631 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL
3632 [`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`]
3633 FUNCTION_FACTORS_LEFT) THEN
3634 REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN
3635 DISCH_THEN (SUBST1_TAC o SYM) THEN
3636 ONCE_REWRITE_TAC[MESON[]
3637 `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN
3638 MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
3639 SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0)
3640 ==> (x / y = x' / y' <=> y' / y * x = x')`;
3641 REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN
3642 SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
3643 SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN
3645 `(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=>
3646 (!d m n. P m (g d m) n d)`] THEN
3647 INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN
3648 REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in
3649 let recursion_on_dyadic_rationals = prove
3651 ?f. (!m. f(&m) = b m) /\
3652 (!m n. f(&(4 * m + 1) / &2 pow (n + 1)) =
3653 l(f(&(2 * m + 1) / &2 pow n))) /\
3654 (!m n. f(&(4 * m + 3) / &2 pow (n + 1)) =
3655 r(f(&(2 * m + 1) / &2 pow n)))`,
3659 (!m n. f (2 * m) (n + 1) = f m n) /\
3660 (!m. f m 0 = b m) /\
3661 (!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\
3662 (!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))`
3664 [MP_TAC(prove_recursive_functions_exist num_RECURSION
3665 `(!m. f m 0 = (b:num->A) m) /\
3666 (!m n. f m (SUC n) =
3667 if EVEN m then f (m DIV 2) n
3668 else if EVEN(m DIV 2)
3669 then l(f ((m + 1) DIV 2) n)
3670 else r(f (m DIV 2) n))`) THEN
3671 MATCH_MP_TAC MONO_EXISTS THEN
3672 X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN
3673 RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN
3674 REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN
3675 REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`;
3676 ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`;
3677 ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`;
3678 ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN
3679 REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND];
3680 DISCH_THEN(X_CHOOSE_THEN `f:num->num->A`
3681 (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
3682 DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN
3683 MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
3684 DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN
3685 RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN
3686 ASM_REWRITE_TAC[]]) in
3687 let recursion_on_dyadic_rationals_1 = prove
3689 ?f. (!m. f(&m / &2) = b) /\
3690 (!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) =
3691 l(f(&(2 * m + 1) / &2 pow n))) /\
3692 (!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) =
3693 r(f(&(2 * m + 1) / &2 pow n)))`,
3695 MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`]
3696 recursion_on_dyadic_rationals) THEN
3698 DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN
3699 EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN
3700 ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN
3701 CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
3702 ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ;
3703 ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in
3704 let exists_function_unpair = prove
3705 (`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`,
3706 EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN
3707 EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN
3708 EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN
3709 ASM_REWRITE_TAC[PAIR; ETA_AX]) in
3710 let dyadics_in_open_unit_interval = prove
3711 (`interval(vec 0,vec 1) INTER
3712 {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} =
3713 {lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`,
3714 MATCH_MP_TAC(SET_RULE
3715 `(!m n. (f m n) IN s <=> P m n)
3716 ==> s INTER {f m n | m IN UNIV /\ n IN UNIV} =
3717 {f m n | P m n}`) THEN
3718 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
3719 SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
3720 SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in
3721 REPEAT STRIP_TAC THEN
3723 `!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1]
3724 ==> ?c d. drop a <= drop c /\ drop c <= drop m /\
3725 drop m <= drop d /\ drop d <= drop b /\
3726 (!x. x IN interval[c,d] ==> f x = f m) /\
3727 (!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\
3728 (!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\
3729 (!x y. x IN interval[a,c] DELETE c /\
3730 y IN interval[d,b] DELETE d
3731 ==> ~((f:real^1->real^N) x = f y))`
3733 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN
3734 REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3736 `?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
3740 `{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
3742 {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}`
3744 [REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM;
3746 GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
3749 `?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} =
3752 [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN
3753 ONCE_REWRITE_TAC[SET_RULE
3754 `{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN
3755 MATCH_MP_TAC COMPACT_INTER_CLOSED THEN
3756 REWRITE_TAC[COMPACT_INTERVAL] THEN
3757 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
3758 ASM_REWRITE_TAC[CLOSED_INTERVAL];
3759 STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]];
3761 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN
3762 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN
3763 SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL
3764 [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
3765 REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
3767 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN
3768 SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL
3769 [ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN
3771 FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
3773 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN
3774 STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
3776 [GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN
3777 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
3778 [GSYM th]) THEN SIMP_TAC[IN_ELIM_THM];
3780 GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
3781 [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
3782 `{x | x IN s /\ f x = a} = t
3783 ==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t))
3784 ==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN
3785 REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC;
3787 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
3788 REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN
3789 SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL
3790 [REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`;
3793 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
3794 (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
3795 REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN
3796 REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN
3797 ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL
3798 [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3799 ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL
3800 [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3801 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3802 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o
3803 SPEC `(f:real^1->real^N) y`) THEN
3804 ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL
3805 [`x:real^1`; `y:real^1`; `m:real^1`]) THEN
3806 ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
3808 REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3810 [`leftcut:real^1->real^1->real^1->real^1`;
3811 `rightcut:real^1->real^1->real^1->real^1`] THEN
3813 FIRST_ASSUM(MP_TAC o SPECL
3814 [`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN
3815 REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC
3816 `u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN
3817 REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN
3818 REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
3819 DISCH_THEN(SUBST1_TAC o SYM) THEN
3820 REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
3822 FIRST_ASSUM(MP_TAC o SPECL
3823 [`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN
3824 REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
3825 ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC
3826 `v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN
3827 ONCE_REWRITE_TAC[TAUT
3828 `a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN
3829 REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN
3830 ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3831 REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
3834 `!x. x IN interval[vec 0,v] DELETE v
3835 ==> ~((f:real^1->real^N) x = f(vec 1))`
3837 [X_GEN_TAC `t:real^1` THEN
3838 REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN
3839 ASM_CASES_TAC `drop t < drop u` THENL
3840 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
3841 `~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`));
3843 FIRST_X_ASSUM MATCH_MP_TAC THEN
3844 ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
3847 `!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))`
3850 [`(u:real^1,v:real^1)`;
3851 `\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`;
3852 `\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`]
3853 recursion_on_dyadic_rationals_1) THEN
3854 REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN
3855 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3856 MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN
3857 ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN
3858 REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
3859 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
3861 `!m n. drop u <= drop(a(&m / &2 pow n)) /\
3862 drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\
3863 drop(b(&m / &2 pow n)) <= drop v`
3865 [GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN
3867 [REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
3868 ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL];
3869 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN
3870 X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL
3871 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
3872 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3873 REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN
3874 ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD
3875 `&0 < y ==> (&2 * x) / (&2 * y) = x / y`];
3877 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
3878 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3879 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
3880 [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL];
3881 REWRITE_TAC[ADD1]] THEN
3882 DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL
3883 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
3884 DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
3885 ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`];
3886 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
3887 DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
3888 ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN
3889 (FIRST_X_ASSUM(MP_TAC o SPECL
3890 [`a(&(2 * r + 1) / &2 pow n):real^1`;
3891 `b(&(2 * r + 1) / &2 pow n):real^1`;
3892 `c(&(2 * r + 1) / &2 pow n):real^1`]) THEN
3894 [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
3896 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
3897 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
3898 UNDISCH_TAC `drop(vec 0) <= drop u` THEN
3899 UNDISCH_TAC `drop v <= drop (vec 1)`;
3901 REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC);
3902 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
3903 SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL
3904 [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
3905 SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL
3906 [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
3908 `!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\
3909 drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))`
3911 [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
3912 (fun th -> REWRITE_TAC[GSYM th]) THEN
3913 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
3914 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
3915 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
3916 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
3919 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
3920 ==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\
3921 drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))`
3923 [REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN
3924 DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL
3925 [GEN_TAC THEN STRIP_TAC THEN
3926 MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)`
3927 REAL_ABS_INTEGER_LEMMA) THEN
3929 `i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN
3930 REPEAT CONJ_TAC THENL
3931 [REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN
3932 REWRITE_TAC[REAL_ARITH
3933 `n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN
3934 ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
3935 MESON_TAC[INTEGER_CLOSED];
3936 SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN
3937 REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN
3938 SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
3939 ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`];
3940 ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ;
3941 REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]];
3943 X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN
3944 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
3945 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
3946 [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
3947 ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS];
3949 UNDISCH_THEN `n:num < m`
3950 (fun th -> let th' = MATCH_MP
3951 (ARITH_RULE `n < m ==> m - SUC n < m - n`) th in
3952 FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN
3953 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
3954 `&i / &2 pow m = &(2 * j + 1) / &2 pow n \/
3955 &i / &2 pow m < &(2 * j + 1) / &2 pow n \/
3956 &(2 * j + 1) / &2 pow n < &i / &2 pow m`)
3958 [ASM_REWRITE_TAC[ADD1];
3959 DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN
3960 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
3961 MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
3962 [MATCH_MP_TAC(REAL_ARITH
3963 `x < i /\ &2 * n1 = n /\ j + n1 = i
3964 ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
3965 ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN
3966 REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
3967 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
3969 MATCH_MP_TAC(REAL_ARITH
3970 `b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN
3971 FIRST_X_ASSUM(MP_TAC o SPECL
3972 [`a(&(2 * j + 1) / &2 pow n):real^1`;
3973 `b(&(2 * j + 1) / &2 pow n):real^1`;
3974 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
3975 ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
3976 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
3978 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
3979 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
3980 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
3981 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]];
3982 DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN
3983 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
3984 MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
3985 [MATCH_MP_TAC(REAL_ARITH
3986 `i < x /\ &2 * n1 = n /\ j - n1 = i
3987 ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
3988 ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN
3989 REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
3990 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
3992 MATCH_MP_TAC(REAL_ARITH
3993 `a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN
3994 FIRST_X_ASSUM(MP_TAC o SPECL
3995 [`a(&(2 * j + 1) / &2 pow n):real^1`;
3996 `b(&(2 * j + 1) / &2 pow n):real^1`;
3997 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
3998 ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
3999 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4001 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4002 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4003 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4004 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]];
4007 `!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n)))
4010 [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL
4011 [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
4012 ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN
4013 RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
4015 X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN
4016 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4017 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4018 [ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
4019 RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
4021 DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
4022 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4023 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4024 REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN
4025 ASM_SIMP_TAC[ADD1] THEN
4026 MATCH_MP_TAC(REAL_ARITH
4027 `drop c = (drop a + drop b) / &2 /\
4028 abs(drop a - drop b) <= &2 * k /\
4029 drop a <= drop(leftcut a b c) /\
4030 drop(leftcut a b c) <= drop c
4031 ==> abs(drop a - drop(leftcut a b c)) <= k`);
4032 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4033 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4034 REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN
4035 ASM_SIMP_TAC[ADD1] THEN
4036 MATCH_MP_TAC(REAL_ARITH
4037 `drop c = (drop a + drop b) / &2 /\
4038 abs(drop a - drop b) <= &2 * k /\
4039 drop c <= drop(rightcut a b c) /\
4040 drop(rightcut a b c) <= drop b
4041 ==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN
4043 [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
4044 (fun th -> REWRITE_TAC[GSYM th]) THEN
4045 REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC;
4048 [REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4049 REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN
4050 ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH];
4052 FIRST_X_ASSUM(MP_TAC o SPECL
4053 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4054 `b(&(2 * j + 1) / &2 pow n):real^1`;
4055 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4056 ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4057 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4059 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4060 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4061 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4062 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]);
4065 `!n j. 0 < 2 * j /\ 2 * j < 2 EXP n
4066 ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) =
4067 f(a(&(2 * j + 1) / &2 pow n))`
4069 [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
4070 [REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
4071 ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
4074 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN
4075 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4076 [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN
4077 REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
4078 ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
4081 X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
4082 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4083 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4084 REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN
4085 CONV_TAC NUM_REDUCE_CONV THEN
4086 ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`;
4087 ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN
4088 SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN
4089 STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
4090 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4091 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4093 ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`;
4094 ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN
4095 FIRST_X_ASSUM(MP_TAC o SPECL
4096 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4097 `b(&(2 * j + 1) / &2 pow n):real^1`;
4098 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4100 [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4102 REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4103 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4104 ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4105 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
4106 REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4107 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4108 MATCH_MP_TAC(MESON[]
4109 `a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN
4110 REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4111 ASM_MESON_TAC[REAL_LE_TRANS]]];
4114 `!n j. 0 < j /\ j < 2 EXP n
4115 ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) =
4116 f(c(&j / &2 pow n)) /\
4117 f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))`
4119 [MATCH_MP_TAC num_INDUCTION THEN
4120 REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN
4121 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
4122 X_GEN_TAC `j:num` THEN
4123 DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL
4124 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4125 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4126 REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`;
4127 ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN
4128 REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN
4129 ASM_REWRITE_TAC[] THEN
4130 MATCH_MP_TAC(MESON[]
4131 `c' = c /\ a' = a /\ b' = b
4132 ==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN
4133 REPEAT CONJ_TAC THEN AP_TERM_TAC THENL
4135 REWRITE_TAC[real_pow; real_div; REAL_INV_MUL;
4136 GSYM REAL_OF_NUM_MUL] THEN
4138 REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN
4139 FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
4140 SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL
4141 [ASM_ARITH_TAC; ALL_TAC] THEN
4142 REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`;
4143 ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN
4144 REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC];
4145 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4146 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4147 REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN
4148 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
4149 [`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
4150 `b(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
4151 `c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN
4153 [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
4154 REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4155 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
4156 REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
4157 DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN
4158 ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1;
4159 ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`;
4160 ARITH_RULE `0 < n + 1`] THEN
4161 ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN
4162 ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
4163 ASM_REAL_ARITH_TAC];
4165 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
4166 MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
4167 REWRITE_TAC[COMPACT_INTERVAL] THEN
4168 MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`;
4169 `interval(vec 0,vec 1) INTER
4170 {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`]
4171 UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
4172 SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1;
4173 CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL;
4174 UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4175 CLOSURE_OPEN_INTERVAL] THEN
4176 REWRITE_TAC[dyadics_in_open_unit_interval] THEN
4178 [REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN
4179 X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN
4180 `(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]`
4182 [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL];
4183 REWRITE_TAC[uniformly_continuous_on]] THEN
4184 DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
4185 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4186 MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN
4187 ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
4188 CONV_TAC REAL_RAT_REDUCE_CONV THEN
4189 DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
4190 ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
4191 CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
4192 EXISTS_TAC `inv(&2 pow n)` THEN
4193 REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN
4194 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4195 REWRITE_TAC[FORALL_IN_GSPEC] THEN
4197 `!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
4198 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
4199 ==> norm((f:real^1->real^N)(c(&i / &2 pow m)) -
4200 f(c(&j / &2 pow n))) < e / &2`
4202 [REPEAT GEN_TAC THEN
4203 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4204 DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH
4207 abs(x - (a - e / &2)) < e / &2 \/
4208 abs(x - (a + e / &2)) < e / &2`))
4210 [DISCH_THEN SUBST1_TAC THEN
4211 ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF];
4214 `&j / &2 pow n = &(2 * j) / &2 pow (n + 1)`
4215 (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])
4217 [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL;
4218 GSYM REAL_OF_NUM_MUL] THEN
4221 REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN
4222 REWRITE_TAC[GSYM real_div;
4223 GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN
4224 REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`;
4225 REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN
4226 ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN
4227 REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL
4228 [SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
4229 f(b (&(2 * j - 1) / &2 pow (n + 1)))`
4230 SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC];
4231 SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
4232 f(a (&(2 * j + 1) / &2 pow (n + 1)))`
4233 SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN
4234 REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4235 REWRITE_TAC[IN_INTERVAL_1] THEN
4236 REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4237 FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL
4238 [DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB];
4239 DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN
4240 ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN
4241 REWRITE_TAC[DIST_REAL; GSYM drop] THENL
4242 [MATCH_MP_TAC(NORM_ARITH
4243 `!t. abs(a - b) <= t /\ t < d
4244 ==> a <= c /\ c <= b ==> abs(c - b) < d`);
4245 MATCH_MP_TAC(NORM_ARITH
4246 `!t. abs(a - b) <= t /\ t < d
4247 ==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN
4248 EXISTS_TAC `&2 / &2 pow (n + 1)` THEN
4250 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4251 REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN
4252 ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`];
4253 REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
4254 ASM_REAL_ARITH_TAC]);
4256 MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN
4257 MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
4258 REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN
4260 `?j. 0 < j /\ j < 2 EXP n /\
4261 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
4262 abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
4263 STRIP_ASSUME_TAC THENL
4264 [MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
4265 (&2 pow n * &k / &2 pow p)`
4267 SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV;
4268 REAL_POS; REAL_POW_LE] THEN
4269 DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN
4270 MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
4271 (&2 pow n * &k / &2 pow p)` FLOOR) THEN
4272 ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN
4273 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4274 SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4275 REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN
4276 ASM_CASES_TAC `j = 0` THENL
4277 [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN
4278 DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
4279 REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN
4280 ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN
4281 MATCH_MP_TAC(REAL_ARITH
4282 `&0 < x /\ x < inv n /\ &0 < y /\ y < inv n
4283 ==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN
4284 ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2];
4285 DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN
4286 REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
4287 CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
4288 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
4289 SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN
4290 REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN
4291 REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN
4292 SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN
4293 ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]];
4294 MATCH_MP_TAC(NORM_ARITH
4295 `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
4296 ==> dist(w,z) < e`) THEN
4297 EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN
4298 REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4301 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
4302 REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN
4303 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN
4304 FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN
4305 ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN
4306 REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN
4307 ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN
4308 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
4309 SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
4310 REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
4311 REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN
4312 REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN
4314 [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4315 [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
4316 closure_dyadic_rationals_in_convex_set_pos_1) THEN
4317 SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4318 INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4319 CLOSURE_OPEN_INTERVAL] THEN
4320 DISCH_THEN(fun th ->
4321 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN
4322 MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
4323 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4324 CONTINUOUS_ON_SUBSET)) THEN
4325 MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
4326 MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4327 REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED];
4328 MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
4329 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
4330 ASM_REWRITE_TAC[COMPACT_INTERVAL];
4331 SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN
4332 ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN
4333 MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4334 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
4335 ASM_MESON_TAC[REAL_LE_TRANS]];
4336 MATCH_MP_TAC SUBSET_TRANS THEN
4337 EXISTS_TAC `closure(IMAGE (h:real^1->real^N)
4338 (interval (vec 0,vec 1) INTER
4339 {lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN
4342 MATCH_MP_TAC CLOSURE_MINIMAL THEN
4343 ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL;
4344 COMPACT_CONTINUOUS_IMAGE] THEN
4345 MATCH_MP_TAC IMAGE_SUBSET THEN
4346 MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4347 REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN
4348 REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN
4349 REWRITE_TAC[dyadics_in_open_unit_interval;
4350 EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
4351 X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
4352 X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC
4353 `(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN
4354 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4355 COMPACT_UNIFORMLY_CONTINUOUS)) THEN
4356 REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
4357 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
4358 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4361 ==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\
4362 y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\
4363 (f:real^1->real^N) y = f x`
4366 MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`]
4367 REAL_ARCH_POW_INV) THEN
4368 ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
4369 CONV_TAC REAL_RAT_REDUCE_CONV THEN
4370 DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
4371 ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
4372 CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
4373 DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
4374 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
4375 DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN
4376 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4377 DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN
4378 ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4379 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4380 REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN
4381 REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4382 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4384 ==> a <= c /\ c <= b /\ abs(a - b) < d
4385 ==> abs(c - y) < d`)) THEN
4386 REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4387 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN
4388 ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
4389 MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN
4390 X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL
4391 [EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
4392 ASM_REWRITE_TAC[REAL_POW_1] THEN
4394 `x IN interval[vec 0:real^1,u] \/
4395 x IN interval[u,v] \/
4396 x IN interval[v,vec 1]`
4397 STRIP_ASSUME_TAC THENL
4398 [REWRITE_TAC[IN_INTERVAL_1] THEN
4399 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4401 EXISTS_TAC `u:real^1` THEN
4402 ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1];
4403 EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[];
4404 EXISTS_TAC `v:real^1` THEN
4405 ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]];
4406 DISCH_THEN(X_CHOOSE_THEN `m:num`
4407 (X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN
4408 REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4409 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
4410 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4411 DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN
4412 REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
4414 `y IN interval[a(&(2 * j + 1) / &2 pow n):real^1,
4415 b(&(4 * j + 1) / &2 pow (n + 1))] \/
4416 y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)),
4417 a(&(4 * j + 3) / &2 pow (n + 1))] \/
4418 y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)),
4419 b(&(2 * j + 1) / &2 pow n)]`
4420 STRIP_ASSUME_TAC THENL
4421 [REWRITE_TAC[IN_INTERVAL_1] THEN
4422 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4424 EXISTS_TAC `4 * j + 1` THEN
4425 EXISTS_TAC `y:real^1` THEN
4426 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4427 REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4428 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4430 ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4431 ASM_MESON_TAC[LE_1];
4432 EXISTS_TAC `4 * j + 1` THEN
4433 EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN
4434 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4435 REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4436 REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4437 CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4438 FIRST_X_ASSUM(MP_TAC o SPECL
4439 [`a(&(2 * j + 1) / &2 pow n):real^1`;
4440 `b(&(2 * j + 1) / &2 pow n):real^1`;
4441 `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4443 [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
4445 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4446 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
4447 MATCH_MP_TAC(MESON[]
4448 `a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN
4450 `leftcut (a (&(2 * j + 1) / &2 pow n))
4451 (b (&(2 * j + 1) / &2 pow n))
4452 (c (&(2 * j + 1) / &2 pow n):real^1):real^1 =
4453 b(&(4 * j + 1) / &2 pow (n + 1)) /\
4454 rightcut (a (&(2 * j + 1) / &2 pow n))
4455 (b (&(2 * j + 1) / &2 pow n))
4456 (c (&(2 * j + 1) / &2 pow n)):real^1 =
4457 a(&(4 * j + 3) / &2 pow (n + 1))`
4458 (CONJUNCTS_THEN SUBST_ALL_TAC) THENL
4459 [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN
4460 REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4461 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4462 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4464 ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4465 ASM_MESON_TAC[LE_1];
4466 EXISTS_TAC `4 * j + 3` THEN
4467 EXISTS_TAC `y:real^1` THEN
4468 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4469 REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4470 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4472 ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4473 ASM_MESON_TAC[LE_1]]]];
4476 `!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\
4477 (!x. drop(a(&m / &2 pow n)) < drop x /\
4478 drop x <= drop(b(&m / &2 pow n))
4479 ==> ~(f x = f(a(&m / &2 pow n)))) /\
4480 (!x. drop(a(&m / &2 pow n)) <= drop x /\
4481 drop x < drop(b(&m / &2 pow n))
4482 ==> ~(f x :real^N = f(b(&m / &2 pow n))))`
4484 [SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL
4485 [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
4486 RULE_ASSUM_TAC(REWRITE_RULE
4487 [IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN
4488 ASM_MESON_TAC[DROP_EQ];
4491 `(!x. drop u < drop x /\ drop x <= drop v
4492 ==> ~((f:real^1->real^N) x = f u)) /\
4493 (!x. drop u <= drop x /\ drop x < drop v
4495 STRIP_ASSUME_TAC THENL
4497 `(f:real^1->real^N) u = f(vec 0) /\
4498 (f:real^1->real^N) v = f(vec 1)`
4499 (CONJUNCTS_THEN SUBST1_TAC)
4501 [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4502 ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL];
4504 CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN
4505 FIRST_X_ASSUM MATCH_MP_TAC THEN
4506 ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN
4509 MATCH_MP_TAC num_INDUCTION THEN
4510 ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN
4511 ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN
4512 X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
4513 DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN
4514 ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
4515 X_GEN_TAC `j:num` THEN
4516 DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL
4517 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4518 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4519 SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN
4520 ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`];
4522 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4523 DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4524 DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL
4525 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4526 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
4527 ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN
4528 FIRST_X_ASSUM(MP_TAC o SPECL
4529 [`a(&(2 * m + 1) / &2 pow n):real^1`;
4530 `b(&(2 * m + 1) / &2 pow n):real^1`;
4531 `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
4533 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4534 ASM_MESON_TAC[REAL_LE_TRANS];
4535 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4536 DISCH_THEN(K ALL_TAC)] THEN
4539 (leftcut (a (&(2 * m + 1) / &2 pow n):real^1)
4540 (b (&(2 * m + 1) / &2 pow n):real^1)
4541 (c (&(2 * m + 1) / &2 pow n):real^1)) =
4542 (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
4544 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4545 ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
4546 ASM_REWRITE_TAC[]] THEN
4547 GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
4548 REPEAT CONJ_TAC THENL
4549 [DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
4551 `(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) =
4552 f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
4554 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
4555 REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
4556 midpoint; DROP_CMUL; DROP_ADD] THEN
4557 ASM_REWRITE_TAC[REAL_ARITH
4558 `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`];
4559 GEN_TAC THEN STRIP_TAC THEN
4560 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
4561 ASM_MESON_TAC[REAL_LE_TRANS];
4562 GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
4563 (fun th -> MATCH_MP_TAC th THEN
4564 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4565 GEN_REWRITE_TAC I [REAL_ARITH
4566 `(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN
4568 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4569 DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
4570 ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1 = 4 * m + 3`; ADD1] THEN
4571 FIRST_X_ASSUM(MP_TAC o SPECL
4572 [`a(&(2 * m + 1) / &2 pow n):real^1`;
4573 `b(&(2 * m + 1) / &2 pow n):real^1`;
4574 `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
4576 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4577 ASM_MESON_TAC[REAL_LE_TRANS];
4578 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4579 DISCH_THEN(K ALL_TAC)] THEN
4582 (rightcut (a (&(2 * m + 1) / &2 pow n):real^1)
4583 (b (&(2 * m + 1) / &2 pow n):real^1)
4584 (c (&(2 * m + 1) / &2 pow n):real^1)) =
4585 (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
4587 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4588 ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
4589 ASM_REWRITE_TAC[]] THEN
4590 GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
4591 REPEAT CONJ_TAC THENL
4592 [DISCH_THEN SUBST_ALL_TAC THEN
4594 `(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) =
4595 f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
4597 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
4598 REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
4599 midpoint; DROP_CMUL; DROP_ADD] THEN
4600 ASM_REWRITE_TAC[REAL_ARITH
4601 `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`];
4602 GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
4603 (fun th -> MATCH_MP_TAC th THEN
4604 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4605 GEN_REWRITE_TAC I [REAL_ARITH
4606 `(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN
4608 GEN_TAC THEN STRIP_TAC THEN
4609 FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
4610 ASM_MESON_TAC[REAL_LE_TRANS]]];
4613 `!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
4614 &i / &2 pow m < &j / &2 pow n
4615 ==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))`
4619 0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\
4620 &i / &2 pow m < &k / &2 pow p /\ m + p = N
4621 ==> ?j n. ODD(j) /\ ~(n = 0) /\
4622 &i / &2 pow m <= &j / &2 pow n /\
4623 &j / &2 pow n <= &k / &2 pow p /\
4624 abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
4625 abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
4627 [MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN
4628 DISCH_THEN(LABEL_TAC "I") THEN
4629 MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN
4632 `&i / &2 pow m <= &1 / &2 pow 1 /\
4633 &1 / &2 pow 1 <= &k / &2 pow p \/
4634 &k / &2 pow p < &1 / &2 \/
4635 &1 / &2 < &i / &2 pow m`
4636 (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC)
4638 [ASM_REAL_ARITH_TAC;
4639 MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN
4640 MATCH_MP_TAC(REAL_ARITH
4641 `&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1
4642 ==> abs(i - &1 / &2 pow 1) < inv(&2 pow 1) /\
4643 abs(k - &1 / &2 pow 1) < inv(&2 pow 1)`) THEN
4644 ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
4645 REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN
4646 ASM_REWRITE_TAC[REAL_OF_NUM_LT];
4647 REMOVE_THEN "I" MP_TAC THEN
4648 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
4649 SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
4650 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4651 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4652 SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
4653 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4654 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4655 STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
4656 ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
4657 DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN
4658 ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
4659 [MAP_EVERY UNDISCH_TAC
4660 [`&k / &2 pow SUC p < &1 / &2`;
4661 `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
4662 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4663 REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
4664 SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
4665 REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
4666 `x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN
4667 SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
4668 REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT];
4669 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
4670 DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
4671 EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN
4672 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4673 REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
4674 REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
4675 REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
4676 REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
4677 ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
4678 REAL_OF_NUM_LT; ARITH]];
4679 REMOVE_THEN "I" MP_TAC THEN
4680 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
4681 SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
4682 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4683 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4684 SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
4685 REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4686 REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4687 STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
4688 ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
4689 DISCH_THEN(MP_TAC o SPECL
4690 [`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN
4691 ASM_REWRITE_TAC[] THEN
4692 MAP_EVERY UNDISCH_TAC
4693 [`&1 / &2 < &i / &2 pow SUC m`;
4694 `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
4695 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4696 REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
4697 SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
4698 GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
4699 STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP
4700 (REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN
4701 SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
4702 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN
4703 SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
4704 STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL
4705 [ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN
4706 ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4707 REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
4708 ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4709 ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=>
4710 u / v < w / z`] THEN
4711 CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE
4712 `i < 2 * m ==> i - m < m`) THEN
4713 ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)];
4714 REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
4715 ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4716 REWRITE_TAC[GSYM real_div] THEN
4717 DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num`
4718 STRIP_ASSUME_TAC)) THEN
4719 EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN
4720 ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN
4721 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN
4722 REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4723 REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
4724 REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
4725 REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
4726 REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
4727 ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
4728 REAL_OF_NUM_LT; ARITH] THEN
4729 REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
4730 ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4731 REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]];
4732 DISCH_THEN(fun th ->
4733 MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN
4734 STRIP_TAC THEN MP_TAC(ISPECL
4735 [`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN
4736 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4737 MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN
4738 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4739 REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN
4740 X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
4741 MATCH_MP_TAC REAL_LE_TRANS THEN
4742 EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL
4743 [ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN
4744 ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4746 `drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\
4747 drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))`
4749 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4750 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
4751 SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4752 REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
4753 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4755 ==> i <= q /\ ~(i = q) /\ q = q' + n / &2
4756 ==> abs(i - q') < n / &2`)) THEN
4757 ASM_REWRITE_TAC[] THEN
4758 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4760 ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
4761 `l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN
4762 FIRST_X_ASSUM(MP_TAC o SPECL
4763 [`a(&(2 * q + 1) / &2 pow n):real^1`;
4764 `b(&(2 * q + 1) / &2 pow n):real^1`;
4765 `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
4767 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4768 ASM_MESON_TAC[REAL_LE_TRANS];
4769 DISCH_THEN(fun th -> REWRITE_TAC[th])]];
4770 ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN
4771 ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4773 `drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\
4774 drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))`
4776 [FIRST_X_ASSUM MATCH_MP_TAC THEN
4777 REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
4778 SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4779 REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
4780 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4782 ==> q <= i /\ ~(i = q) /\ q' = q + n / &2
4783 ==> abs(i - q') < n / &2`)) THEN
4784 ASM_REWRITE_TAC[] THEN
4785 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4787 ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
4788 `d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN
4789 FIRST_X_ASSUM(MP_TAC o SPECL
4790 [`a(&(2 * q + 1) / &2 pow n):real^1`;
4791 `b(&(2 * q + 1) / &2 pow n):real^1`;
4792 `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
4794 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4795 ASM_MESON_TAC[REAL_LE_TRANS];
4796 DISCH_THEN(fun th -> REWRITE_TAC[th])]]]];
4798 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
4799 REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
4800 REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN
4801 MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN
4803 `?m n. 0 < m /\ m < 2 EXP n /\
4804 drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\
4805 ~(h(x1):real^N = h(lift(&m / &2 pow n)))`
4806 STRIP_ASSUME_TAC THENL
4807 [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
4808 closure_dyadic_rationals_in_convex_set_pos_1) THEN
4809 SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4810 INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4811 CLOSURE_OPEN_INTERVAL] THEN
4812 REWRITE_TAC[EXTENSION] THEN
4813 DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN
4814 REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN
4815 REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4816 MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN
4817 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN
4818 DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN
4819 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN
4820 REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN
4823 `?m n. (0 < m /\ m < 2 EXP n) /\
4824 abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) <
4825 (drop x2 - drop x1) / &64 /\
4826 inv(&2 pow n) < (drop x2 - drop x1) / &128`
4827 STRIP_ASSUME_TAC THENL
4828 [MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`]
4829 REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4830 DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
4831 ASM_CASES_TAC `N = 0` THENL
4832 [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN
4833 REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN
4835 FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num`
4836 STRIP_ASSUME_TAC)) THEN
4837 EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN
4838 ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1;
4841 [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
4842 REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH
4843 `(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN
4844 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ;
4845 REAL_MUL_LID; GSYM real_div];
4846 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN
4847 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN
4848 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]];
4849 REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
4850 `!m n m' n'. (P m n /\ P m' n') /\
4851 (P m n /\ P m' n' ==> ~(g m n = g m' n'))
4852 ==> (?m n. P m n /\ ~(a = g m n))`) THEN
4853 MAP_EVERY EXISTS_TAC
4854 [`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN
4856 [REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN
4857 (REWRITE_TAC[GSYM CONJ_ASSOC] THEN
4858 REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN
4859 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4860 `abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64
4861 ==> abs(x - y) < (x2 - x1) / &4
4862 ==> x1 < y /\ y < x2`)) THEN
4863 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4864 `n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN
4865 ASM_REWRITE_TAC[REAL_SUB_LT] THEN
4866 REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4867 MATCH_MP_TAC(REAL_ARITH
4868 `a / y = x /\ abs(b / y) < z
4869 ==> abs(x - (a + b) / y) < z`) THEN
4870 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN
4871 SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN
4872 REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4873 SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ;
4874 REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ;
4875 REAL_OF_NUM_EQ] THEN
4876 CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC;
4877 ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
4878 FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN
4879 UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x`
4880 (fun th -> REWRITE_TAC[GSYM th] THEN
4881 ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN
4882 REWRITE_TAC[th] THEN ASSUME_TAC th) THEN
4884 CONV_TAC(RAND_CONV SYM_CONV) THEN
4885 FIRST_X_ASSUM(MP_TAC o SPECL
4886 [`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
4887 `b(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
4888 `c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN
4890 [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4891 ASM_MESON_TAC[REAL_LE_TRANS];
4892 REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4893 DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN
4894 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4895 REWRITE_TAC[REAL_ARITH
4896 `(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN
4897 REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN
4898 ASM_REWRITE_TAC[REAL_ARITH
4899 `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN
4900 ASM_REWRITE_TAC[REAL_LT_LE]]];
4903 `IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET
4904 IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\
4905 IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET
4906 IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])`
4908 [MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)`
4909 closure_dyadic_rationals_in_convex_set_pos_1) THEN
4910 MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))`
4911 closure_dyadic_rationals_in_convex_set_pos_1) THEN
4912 SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1`
4913 STRIP_ASSUME_TAC THENL
4914 [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ;
4915 REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES];
4918 `(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2)
4919 ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN
4920 ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4921 INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4922 CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN
4923 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4924 CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4925 (MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
4926 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4927 CONTINUOUS_ON_SUBSET)) THEN
4928 MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
4929 MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4930 ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC;
4932 MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
4933 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
4934 ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN
4935 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4936 CONTINUOUS_ON_SUBSET)) THEN
4937 REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
4938 ASM_MESON_TAC[REAL_LE_TRANS];
4939 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
4940 MATCH_MP_TAC(SET_RULE
4941 `i SUBSET interval(vec 0,vec 1) /\
4942 (!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x)
4943 ==> !x. x IN i INTER l ==> P x`) THEN
4944 ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
4945 REAL_LT_IMP_LE; REAL_LE_REFL] THEN
4946 REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN
4947 MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
4948 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
4949 STRIP_TAC THEN ASM_SIMP_TAC[] THEN
4950 MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
4951 ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]);
4952 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
4953 `IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t'
4954 ==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN
4955 DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN
4956 ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN
4957 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
4958 `a IN IMAGE f s /\ a IN IMAGE f t
4959 ==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN
4960 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4961 MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN
4962 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
4963 FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o
4964 GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN
4965 REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN
4966 DISCH_THEN(MP_TAC o SPECL
4967 [`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN
4968 UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN
4969 ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN
4970 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
4971 ASM_MESON_TAC[REAL_LE_TRANS]]);;
4973 let PATH_CONTAINS_ARC = prove
4974 (`!p:real^1->real^N a b.
4975 path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b)
4976 ==> ?q. arc q /\ path_image q SUBSET path_image p /\
4977 pathstart q = a /\ pathfinish q = b`,
4978 REWRITE_TAC[pathstart; pathfinish; path] THEN
4979 MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN
4980 STRIP_TAC THEN MP_TAC(ISPECL
4981 [`\s. s SUBSET interval[vec 0,vec 1] /\
4982 vec 0 IN s /\ vec 1 IN s /\
4983 (!x y. x IN s /\ y IN s /\ segment(x,y) INTER s = {}
4984 ==> (f:real^1->real^N)(x) = f(y))`;
4985 `interval[vec 0:real^1,vec 1]`]
4986 BROUWER_REDUCTION_THEOREM_GEN) THEN
4987 ASM_REWRITE_TAC[GSYM path_image; CLOSED_INTERVAL; SUBSET_REFL] THEN
4991 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
4992 REPEAT GEN_TAC THEN STRIP_TAC THEN
4993 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
4994 `s INTER i = {} ==> s SUBSET i ==> s = {}`)) THEN
4995 REWRITE_TAC[SEGMENT_EQ_EMPTY] THEN
4996 ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN
4997 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF i SUBSET t`) THEN
4998 ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]] THEN
4999 X_GEN_TAC `s:num->real^1->bool` THEN
5000 REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL
5001 [REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
5004 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
5005 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
5006 REWRITE_TAC[] THEN CONJ_TAC THENL
5007 [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[];
5008 REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN
5009 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
5010 REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
5011 SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN
5012 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
5013 FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5014 COMPACT_UNIFORMLY_CONTINUOUS)) THEN
5015 REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
5016 DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN
5017 ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN
5018 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
5020 `?u v. u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
5021 norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v`
5022 STRIP_ASSUME_TAC THENL
5024 FIRST_X_ASSUM(fun th ->
5025 MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN
5026 MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN
5027 ASM_REWRITE_TAC[dist] THEN
5028 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5029 MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN
5030 CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN
5032 `?w z. w IN interval(x,y) /\ z IN interval(x,y) /\ drop w < drop z /\
5033 norm(w - x) < e /\ norm(z - y) < e`
5034 STRIP_ASSUME_TAC THENL
5035 [EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN
5036 EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN
5037 REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP;
5038 NORM_REAL; GSYM drop] THEN
5041 MP_TAC(ISPECL [`interval[w:real^1,z]`;
5042 `{s n :real^1->bool | n IN (:num)}`] COMPACT_IMP_FIP) THEN
5043 ASM_REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_GSPEC] THEN
5044 MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN
5046 [REWRITE_TAC[INTERS_GSPEC; IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
5048 `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
5049 REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5050 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5053 REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=>
5054 (?x. P x /\ Q x /\ ~R x)`] THEN
5055 ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
5056 REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
5057 DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN
5058 FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP
5059 UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5060 X_GEN_TAC `n:num` THEN DISCH_TAC THEN
5062 `interval[w,z] INTER (s:num->real^1->bool) n = {}`
5064 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5065 `a INTER t = {} ==> s SUBSET t ==> a INTER s = {}`)) THEN
5066 REWRITE_TAC[SUBSET; INTERS_IMAGE; IN_ELIM_THM] THEN
5067 REWRITE_TAC[SET_RULE
5068 `(!x. x IN s n ==> !i. i IN k ==> x IN s i) <=>
5069 (!i. i IN k ==> s n SUBSET s i)`] THEN
5071 `!i n. i <= n ==> (s:num->real^1->bool) n SUBSET s i`
5072 (fun th -> ASM_MESON_TAC[th]) THEN
5073 MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
5077 `?u. u IN (s:num->real^1->bool) n /\ u IN interval[x,w] /\
5078 (interval[u,w] DELETE u) INTER (s n) = {}`
5080 [ASM_CASES_TAC `w IN (s:num->real^1->bool) n` THENL
5081 [EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
5082 REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
5083 REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
5084 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5086 MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[x,w]`;
5087 `w:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
5088 ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
5089 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN
5090 ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
5091 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5092 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
5093 REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5094 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5095 `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
5096 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5097 [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5098 ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM];
5100 [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5101 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5103 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]];
5105 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN
5107 `?v. v IN (s:num->real^1->bool) n /\ v IN interval[z,y] /\
5108 (interval[z,v] DELETE v) INTER (s n) = {}`
5110 [ASM_CASES_TAC `z IN (s:num->real^1->bool) n` THENL
5111 [EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
5112 REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
5113 REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
5114 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5116 MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[z,y]`;
5117 `z:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
5118 ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
5119 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN
5120 ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
5121 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5122 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN
5123 REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5124 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5125 `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
5126 REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5128 [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5129 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5131 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]];
5132 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5133 ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]]];
5135 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
5136 REPEAT CONJ_TAC THENL
5139 RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
5140 REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5141 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5142 RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
5143 REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5144 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5145 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN
5146 ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5147 [MAP_EVERY UNDISCH_TAC
5148 [`interval[w,z] INTER (s:num->real^1->bool) n = {}`;
5149 `interval[u,w] DELETE u INTER (s:num->real^1->bool) n = {}`;
5150 `interval[z,v] DELETE v INTER (s:num->real^1->bool) n = {}`] THEN
5151 REWRITE_TAC[IMP_IMP; SET_RULE
5152 `s1 INTER t = {} /\ s2 INTER t = {} <=>
5153 (s1 UNION s2) INTER t = {}`] THEN
5154 MATCH_MP_TAC(SET_RULE
5155 `t SUBSET s ==> s INTER u = {} ==> t INTER u = {}`) THEN
5156 REWRITE_TAC[SUBSET; IN_UNION; IN_DELETE;
5157 GSYM DROP_EQ; IN_INTERVAL_1] THEN
5159 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]];
5161 DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN
5162 ASM_CASES_TAC `t:real^1->bool = {}` THENL
5163 [ASM_MESON_TAC[IN_IMAGE; NOT_IN_EMPTY]; ALL_TAC] THEN
5165 `h = \x. (f:real^1->real^N)(@y. y IN t /\ segment(x,y) INTER t = {})` THEN
5167 `!x y. y IN t /\ segment(x,y) INTER t = {} ==> h(x) = (f:real^1->real^N)(y)`
5170 `!x y z. y IN t /\ segment(x,y) INTER t = {} /\
5171 z IN t /\ segment(x,z) INTER t = {}
5172 ==> (f:real^1->real^N)(y) = f(z)`
5174 [REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1) IN t` THENL
5175 [ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1) IN t)`] THEN
5176 ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=>
5177 (a /\ c) ==> p /\ b /\ d ==> q`] THEN
5179 REWRITE_TAC[SET_RULE `~(x IN t) /\ s INTER t = {} /\ s' INTER t = {} <=>
5180 (x INSERT (s UNION s')) INTER t = {}`] THEN
5181 DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
5182 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
5183 `s SUBSET s' ==> s' INTER t = {} ==> s INTER t = {}`) THEN
5184 REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
5185 GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
5186 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5188 REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]];
5190 SUBGOAL_THEN `!x. x IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL
5191 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5192 ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY];
5194 SUBGOAL_THEN `!x:real^1. ?y. y IN t /\ segment(x,y) INTER t = {}`
5196 [X_GEN_TAC `x:real^1` THEN
5197 EXISTS_TAC `closest_point t (x:real^1)` THEN
5198 ASM_SIMP_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS];
5201 `!x y. segment(x,y) INTER t = {} ==> (h:real^1->real^N) x = h y`
5203 [MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN
5204 ASM_CASES_TAC `(x:real^1) IN t` THENL
5205 [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
5206 ASM_CASES_TAC `(x':real^1) IN t` THENL
5207 [ASM_MESON_TAC[]; ALL_TAC] THEN
5209 `?y y'. y IN t /\ segment(x,y) INTER t = {} /\ h x = f y /\
5210 y' IN t /\ segment(x',y') INTER t = {} /\
5211 (h:real^1->real^N) x' = f y'`
5212 STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5213 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5214 ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC
5215 [`~((x:real^1) IN t)`; `~((x':real^1) IN t)`;
5216 `segment(x:real^1,y) INTER t = {}`;
5217 `segment(x':real^1,y') INTER t = {}`;
5218 `segment(x:real^1,x') INTER t = {}`] THEN
5219 MATCH_MP_TAC(SET_RULE
5220 `s SUBSET (x1 INSERT x2 INSERT (s0 UNION s1 UNION s2))
5221 ==> s0 INTER t = {} ==> s1 INTER t = {} ==> s2 INTER t = {}
5222 ==> ~(x1 IN t) ==> ~(x2 IN t) ==> s INTER t = {}`) THEN
5223 REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
5224 GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
5225 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5228 MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN
5230 [REPEAT CONJ_TAC THENL
5231 [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
5232 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5233 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
5234 DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN
5235 DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
5236 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
5237 ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
5238 ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
5239 [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN
5241 `(?w:real^1. w IN t /\ w IN segment[u,v] /\ segment(u,w) INTER t = {}) /\
5242 (?z:real^1. z IN t /\ z IN segment[u,v] /\ segment(v,z) INTER t = {})`
5243 STRIP_ASSUME_TAC THENL
5245 [MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `u:real^1`]
5246 SEGMENT_TO_POINT_EXISTS);
5247 MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `v:real^1`]
5248 SEGMENT_TO_POINT_EXISTS)] THEN
5249 (ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT] THEN ANTS_TAC THENL
5250 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5251 `~(segment(u,v) INTER t = {})
5252 ==> segment(u,v) SUBSET segment[u,v]
5253 ==> ~(segment[u,v] INTER t = {})`)) THEN
5254 REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED];
5256 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN
5257 SIMP_TAC[IN_INTER] THEN
5258 MATCH_MP_TAC(SET_RULE
5259 `(w IN uv ==> uw SUBSET uv)
5260 ==> (w IN uv /\ w IN t) /\ (uw INTER uv INTER t = {})
5261 ==> uw INTER t = {}`) THEN
5262 DISCH_TAC THEN REWRITE_TAC[open_segment] THEN
5263 MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN
5264 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
5265 REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_SEGMENT] THEN
5266 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT]);
5267 SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\
5268 (h:real^1->real^N) v = (f:real^1->real^N) z`
5269 (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5270 MATCH_MP_TAC(NORM_ARITH
5271 `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
5272 ==> dist(w,z) < e`) THEN
5273 EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN
5274 FIRST_X_ASSUM MATCH_MP_TAC THEN
5276 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5277 `x IN s ==> s SUBSET t ==> x IN t`)) THEN
5278 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
5279 ASM_REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET];
5280 ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]])];
5281 X_GEN_TAC `z:real^N` THEN
5282 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
5283 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
5284 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
5285 REWRITE_TAC[connected_component] THEN
5286 EXISTS_TAC `segment[u:real^1,v]` THEN
5287 REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN
5288 ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
5289 [REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ P x} <=>
5290 s SUBSET t /\ !x. x IN s ==> P x`] THEN
5292 [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL];
5293 X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
5294 SUBGOAL_THEN `segment(u:real^1,x) INTER t = {}`
5295 (fun th -> ASM_MESON_TAC[th]) THEN
5296 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5297 `uv INTER t = {} ==> ux SUBSET uv ==> ux INTER t = {}`)) THEN
5298 UNDISCH_TAC `(x:real^1) IN segment[u,v]` THEN
5299 REWRITE_TAC[SEGMENT_1] THEN
5300 REPEAT(COND_CASES_TAC THEN
5301 ASM_REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1]) THEN
5302 ASM_REAL_ARITH_TAC];
5304 FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF segment(u:real^1,v)`) THEN
5305 ASM_REWRITE_TAC[SET_RULE `t DIFF s PSUBSET t <=> ~(s INTER t = {})`] THEN
5306 MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
5307 REPEAT CONJ_TAC THENL
5309 MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[OPEN_SEGMENT_1];
5311 ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
5312 [`(u:real^1) IN interval[vec 0,vec 1]`;
5313 `(v:real^1) IN interval[vec 0,vec 1]`] THEN
5314 REWRITE_TAC[SEGMENT_1] THEN
5315 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5317 ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
5318 [`(u:real^1) IN interval[vec 0,vec 1]`;
5319 `(v:real^1) IN interval[vec 0,vec 1]`] THEN
5320 REWRITE_TAC[SEGMENT_1] THEN
5321 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5323 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
5324 REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
5325 ASM_CASES_TAC `segment(x:real^1,y) INTER segment(u,v) = {}` THENL
5326 [ASM SET_TAC[]; ALL_TAC] THEN
5328 `(segment(x:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
5329 segment(y:real^1,v) SUBSET segment(x,y) DIFF segment(u,v)) \/
5330 (segment(y:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
5331 segment(x:real^1,v) SUBSET segment(x,y) DIFF segment(u,v))`
5333 [MAP_EVERY UNDISCH_TAC
5334 [`~(x IN segment(u:real^1,v))`; `~(y IN segment(u:real^1,v))`;
5335 `~(segment(x:real^1,y) INTER segment (u,v) = {})`] THEN
5336 POP_ASSUM_LIST(K ALL_TAC) THEN
5337 MAP_EVERY (fun t -> SPEC_TAC(t,t))
5338 [`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN
5339 REWRITE_TAC[FORALL_LIFT] THEN
5340 MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
5341 [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
5342 REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
5343 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
5344 REWRITE_TAC[FORALL_LIFT] THEN
5345 MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
5346 [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
5347 REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
5348 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
5349 ASM_REWRITE_TAC[SEGMENT_1] THEN
5350 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
5351 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
5352 REWRITE_TAC[IN_INTERVAL_1; SUBSET; IN_DIFF; AND_FORALL_THM] THEN
5354 DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN
5356 `i SUBSET xy DIFF uv
5357 ==> xy INTER (t DIFF uv) = {} ==> i INTER t = {}` in
5358 fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN
5364 arc q /\ path_image q SUBSET path_image f /\
5365 a IN path_image q /\ b IN path_image q`
5366 STRIP_ASSUME_TAC THENL
5367 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
5368 REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
5369 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
5370 REWRITE_TAC[arc; path; path_image] THEN
5371 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
5373 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; path_image] THEN ASM SET_TAC[];
5374 REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
5375 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
5376 REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN
5377 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]];
5379 `?u v. u IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\
5380 v IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v`
5381 STRIP_ASSUME_TAC THENL
5382 [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[];
5384 EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL
5385 [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
5386 ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH];
5387 ASM_MESON_TAC[SUBSET_TRANS; PATH_IMAGE_SUBPATH_SUBSET; ARC_IMP_PATH];
5388 ASM_MESON_TAC[pathstart; PATHSTART_SUBPATH];
5389 ASM_MESON_TAC[pathfinish; PATHFINISH_SUBPATH]]]);;
5391 let PATH_CONNECTED_ARCWISE = prove
5393 path_connected s <=>
5394 !x y. x IN s /\ y IN s /\ ~(x = y)
5396 path_image g SUBSET s /\
5399 GEN_TAC THEN REWRITE_TAC[path_connected] THEN EQ_TAC THEN DISCH_TAC THEN
5400 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
5401 FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
5402 ASM_REWRITE_TAC[] THENL
5403 [DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
5404 MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`]
5405 PATH_CONTAINS_ARC) THEN
5406 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
5407 ASM_MESON_TAC[SUBSET_TRANS];
5408 ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THENL
5409 [EXISTS_TAC `linepath(y:real^N,y)` THEN
5410 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
5411 PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
5412 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARC_IMP_PATH]]]);;
5414 let ARC_CONNECTED_TRANS = prove
5415 (`!g h:real^1->real^N.
5417 pathfinish g = pathstart h /\ ~(pathstart g = pathfinish h)
5419 path_image i SUBSET (path_image g UNION path_image h) /\
5420 pathstart i = pathstart g /\
5421 pathfinish i = pathfinish h`,
5422 REPEAT STRIP_TAC THEN
5423 MP_TAC(ISPECL [`g ++ h:real^1->real^N`; `pathstart(g):real^N`;
5424 `pathfinish(h):real^N`] PATH_CONTAINS_ARC) THEN
5425 ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_JOIN_EQ; ARC_IMP_PATH;
5428 (* ------------------------------------------------------------------------- *)
5429 (* Local versions of topological properties in general. *)
5430 (* ------------------------------------------------------------------------- *)
5432 let locally = new_definition
5433 `locally P (s:real^N->bool) <=>
5434 !w x. open_in (subtopology euclidean s) w /\ x IN w
5435 ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\
5436 x IN u /\ u SUBSET v /\ v SUBSET w`;;
5438 let LOCALLY_MONO = prove
5439 (`!P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s`,
5440 REWRITE_TAC[locally] THEN MESON_TAC[]);;
5442 let LOCALLY_OPEN_SUBSET = prove
5443 (`!P s t:real^N->bool.
5444 locally P s /\ open_in (subtopology euclidean s) t
5446 REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN
5447 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5448 FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
5449 ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
5450 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
5451 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5452 MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
5453 EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[open_in; SUBSET]);;
5455 let LOCALLY_DIFF_CLOSED = prove
5456 (`!P s t:real^N->bool.
5457 locally P s /\ closed_in (subtopology euclidean s) t
5458 ==> locally P (s DIFF t)`,
5459 REPEAT STRIP_TAC THEN
5460 MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
5461 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5462 MATCH_MP_TAC OPEN_IN_DIFF THEN
5463 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]);;
5465 let LOCALLY_EMPTY = prove
5466 (`!P. locally P {}`,
5467 REWRITE_TAC[locally] THEN MESON_TAC[open_in; SUBSET; NOT_IN_EMPTY]);;
5469 let LOCALLY_SING = prove
5470 (`!P a. locally P {a} <=> P {a}`,
5471 REWRITE_TAC[locally; open_in] THEN
5472 REWRITE_TAC[SET_RULE
5473 `(w SUBSET {a} /\ P) /\ x IN w <=> w = {a} /\ x = a /\ P`] THEN
5474 SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_SING] THEN
5475 REWRITE_TAC[SET_RULE
5476 `(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=>
5477 u = {a} /\ v = {a} /\ P /\ Q`] THEN
5478 REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; IN_SING] THEN
5479 REWRITE_TAC[FORALL_UNWIND_THM2; MESON[REAL_LT_01] `?x. &0 < x`]);;
5481 let LOCALLY_INTER = prove
5482 (`!P:(real^N->bool)->bool.
5483 (!s t. P s /\ P t ==> P(s INTER t))
5484 ==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)`,
5485 GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
5486 REWRITE_TAC[locally; OPEN_IN_OPEN] THEN
5487 REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; MESON[]
5488 `(!w x. (?t. P t /\ w = f t) /\ Q w x ==> R w x) <=>
5489 (!t x. P t /\ Q (f t) x ==> R (f t) x)`] THEN
5490 ONCE_REWRITE_TAC[MESON[]
5491 `(?a b c. P a b c /\ Q a b c /\ R a b c) <=>
5492 (?b c a. Q a b c /\ P a b c /\ R a b c)`] THEN
5493 REWRITE_TAC[AND_FORALL_THM; UNWIND_THM2; IN_INTER] THEN
5494 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:real^N->bool` THEN
5495 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
5496 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5497 ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2
5498 (X_CHOOSE_THEN `u1:real^N->bool` (X_CHOOSE_THEN `v1:real^N->bool`
5500 (X_CHOOSE_THEN `u2:real^N->bool` (X_CHOOSE_THEN `v2:real^N->bool`
5501 STRIP_ASSUME_TAC))) THEN
5502 EXISTS_TAC `u1 INTER u2:real^N->bool` THEN
5503 EXISTS_TAC `v1 INTER v2:real^N->bool` THEN
5504 ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);;
5506 let HOMEOMORPHISM_LOCALLY = prove
5507 (`!P Q f:real^N->real^M g.
5508 (!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t))
5509 ==> (!s t. homeomorphism (s,t) (f,g)
5510 ==> (locally P s <=> locally Q t))`,
5514 (!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t)
5515 ==> (!s:real^N->bool t:real^M->bool.
5516 locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)`,
5517 REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
5518 REWRITE_TAC[locally] THEN STRIP_TAC THEN
5519 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
5520 MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `y:real^M`] THEN STRIP_TAC THEN
5521 FIRST_X_ASSUM(MP_TAC o SPECL
5522 [`IMAGE (g:real^M->real^N) w`; `(g:real^M->real^N) y`]) THEN
5524 [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5525 SUBGOAL_THEN `IMAGE (g:real^M->real^N) w =
5526 {x | x IN s /\ f(x) IN w}`
5528 [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
5529 MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
5530 REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
5531 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
5532 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
5533 [`IMAGE (f:real^N->real^M) u`; `IMAGE (f:real^N->real^M) v`] THEN
5535 [SUBGOAL_THEN `IMAGE (f:real^N->real^M) u =
5536 {x | x IN t /\ g(x) IN u}`
5538 [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
5539 MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
5542 [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N->bool` THEN
5543 ASM_REWRITE_TAC[homeomorphism] THEN
5544 REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN
5545 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5546 CONTINUOUS_ON_SUBSET)));
5548 RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]) in
5549 REPEAT STRIP_TAC THEN EQ_TAC THEN
5550 MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM;
5551 TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN
5552 ASM_MESON_TAC[HOMEOMORPHISM_SYM]);;
5554 let HOMEOMORPHIC_LOCALLY = prove
5555 (`!P Q. (!s:real^N->bool t:real^M->bool. s homeomorphic t ==> (P s <=> Q t))
5556 ==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))`,
5557 REPEAT GEN_TAC THEN STRIP_TAC THEN
5558 REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
5559 ONCE_REWRITE_TAC[MESON[]
5560 `(!a b c d. P a b c d) <=> (!c d a b. P a b c d)`] THEN
5561 GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_LOCALLY THEN
5562 ASM_MESON_TAC[homeomorphic]);;
5564 let LOCALLY_TRANSLATION = prove
5565 (`!P:(real^N->bool)->bool.
5566 (!a s. P (IMAGE (\x. a + x) s) <=> P s)
5567 ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)`,
5568 GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
5570 [`P:(real^N->bool)->bool`; `P:(real^N->bool)->bool`;
5571 `\x:real^N. a + x`; `\x:real^N. --a + x`]
5572 HOMEOMORPHISM_LOCALLY) THEN
5573 REWRITE_TAC[homeomorphism] THEN
5574 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
5575 REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; GSYM IMAGE_o; o_DEF; IMAGE_ID;
5576 VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`] THEN
5579 let LOCALLY_INJECTIVE_LINEAR_IMAGE = prove
5580 (`!P:(real^N->bool)->bool Q:(real^M->bool)->bool.
5581 (!f s. linear f /\ (!x y. f x = f y ==> x = y)
5582 ==> (P (IMAGE f s) <=> Q s))
5583 ==> (!f s. linear f /\ (!x y. f x = f y ==> x = y)
5584 ==> (locally P (IMAGE f s) <=> locally Q s))`,
5585 GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
5586 ASM_CASES_TAC `linear(f:real^M->real^N) /\ (!x y. f x = f y ==> x = y)` THEN
5587 ASM_REWRITE_TAC[] THEN
5588 FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5589 REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5590 DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
5592 [`Q:(real^M->bool)->bool`; `P:(real^N->bool)->bool`;
5593 `f:real^M->real^N`; `g:real^N->real^M`]
5594 HOMEOMORPHISM_LOCALLY) THEN
5595 ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN
5596 ASM_REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; FORALL_IN_IMAGE] THEN
5597 ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN MESON_TAC[]);;
5599 let LOCALLY_OPEN_MAP_IMAGE = prove
5600 (`!P Q f:real^M->real^N s.
5601 f continuous_on s /\
5602 (!t. open_in (subtopology euclidean s) t
5603 ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\
5604 (!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\
5606 ==> locally Q (IMAGE f s)`,
5608 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5609 REWRITE_TAC[locally] THEN DISCH_TAC THEN
5610 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN
5612 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
5613 FIRST_ASSUM(MP_TAC o SPEC `w:real^N->bool` o
5614 GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
5615 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5616 SUBGOAL_THEN `?x. x IN s /\ (f:real^M->real^N) x = y` STRIP_ASSUME_TAC THENL
5617 [ASM SET_TAC[]; ALL_TAC] THEN
5618 FIRST_X_ASSUM(MP_TAC o SPECL
5619 [`{x | x IN s /\ (f:real^M->real^N) x IN w}`; `x:real^M`]) THEN
5620 ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5621 MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
5622 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
5623 [`IMAGE (f:real^M->real^N) u`; `IMAGE (f:real^M->real^N) v`] THEN
5624 ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5625 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);;
5627 (* ------------------------------------------------------------------------- *)
5628 (* Important special cases of local connectedness & path connectedness. *)
5629 (* ------------------------------------------------------------------------- *)
5631 let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT =
5634 locally connected s <=>
5635 !v x. open_in (subtopology euclidean s) v /\ x IN v
5636 ==> ?u. open_in (subtopology euclidean s) u /\
5638 x IN u /\ u SUBSET v) /\
5640 locally connected s <=>
5641 !t x. open_in (subtopology euclidean s) t /\ x IN t
5642 ==> open_in (subtopology euclidean s)
5643 (connected_component t x))`,
5644 REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
5646 `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
5647 REPEAT CONJ_TAC THENL
5648 [MESON_TAC[SUBSET_REFL];
5650 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
5651 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5652 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5653 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
5654 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
5655 THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5656 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
5657 STRIP_ASSUME_TAC)) THEN
5658 EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5659 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
5660 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
5661 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5663 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5664 EXISTS_TAC `connected_component u (x:real^N)` THEN
5665 REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
5666 ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);;
5668 let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT =
5671 locally path_connected s <=>
5672 !v x. open_in (subtopology euclidean s) v /\ x IN v
5673 ==> ?u. open_in (subtopology euclidean s) u /\
5675 x IN u /\ u SUBSET v) /\
5677 locally path_connected s <=>
5678 !t x. open_in (subtopology euclidean s) t /\ x IN t
5679 ==> open_in (subtopology euclidean s)
5680 (path_component t x))`,
5681 REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
5683 `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
5684 REPEAT CONJ_TAC THENL
5685 [MESON_TAC[SUBSET_REFL];
5687 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
5688 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5689 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5690 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
5691 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
5692 THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5693 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
5694 STRIP_ASSUME_TAC)) THEN
5695 EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5696 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
5697 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
5698 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5700 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5701 EXISTS_TAC `path_component u (x:real^N)` THEN
5702 REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
5703 ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);;
5705 let LOCALLY_CONNECTED_OPEN_COMPONENT = prove
5707 locally connected s <=>
5708 !t c. open_in (subtopology euclidean s) t /\ c IN components t
5709 ==> open_in (subtopology euclidean s) c`,
5710 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
5711 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC]);;
5713 let LOCALLY_CONNECTED_IM_KLEINEN = prove
5715 locally connected s <=>
5716 !v x. open_in (subtopology euclidean s) v /\ x IN v
5717 ==> ?u. open_in (subtopology euclidean s) u /\
5718 x IN u /\ u SUBSET v /\
5720 ==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`,
5721 GEN_TAC THEN EQ_TAC THENL
5722 [REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN
5723 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
5724 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN
5725 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5726 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5727 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
5728 ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN
5729 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
5730 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5731 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5732 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
5733 DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
5734 SUBGOAL_THEN `(k:real^N->bool) SUBSET c` MP_TAC THENL
5735 [ALL_TAC; ASM SET_TAC[]] THEN
5736 MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
5737 EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);;
5739 let LOCALLY_PATH_CONNECTED_IM_KLEINEN = prove
5741 locally path_connected s <=>
5742 !v x. open_in (subtopology euclidean s) v /\ x IN v
5743 ==> ?u. open_in (subtopology euclidean s) u /\
5744 x IN u /\ u SUBSET v /\
5746 ==> ?p. path p /\ path_image p SUBSET v /\
5747 pathstart p = x /\ pathfinish p = y`,
5748 GEN_TAC THEN EQ_TAC THENL
5749 [REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
5750 REWRITE_TAC[path_connected] THEN
5751 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
5752 MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
5753 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
5754 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5755 REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN DISCH_TAC THEN
5756 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `z:real^N`] THEN STRIP_TAC THEN
5757 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5758 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5759 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
5760 ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5761 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
5762 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5763 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5764 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
5765 DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
5767 `(path_image p) SUBSET path_component u (z:real^N)` MP_TAC
5768 THENL [ALL_TAC; ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]] THEN
5769 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
5770 MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
5771 ASM_SIMP_TAC[PATH_CONNECTED_PATH_IMAGE] THEN
5772 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);;
5774 let LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED = prove
5775 (`!s:real^N->bool. locally path_connected s ==> locally connected s`,
5776 MESON_TAC[LOCALLY_MONO; PATH_CONNECTED_IMP_CONNECTED]);;
5778 let LOCALLY_CONNECTED_COMPONENTS = prove
5779 (`!s c:real^N->bool.
5780 locally connected s /\ c IN components s ==> locally connected c`,
5781 REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5782 (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
5783 FIRST_X_ASSUM(MATCH_MP_TAC o
5784 GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
5785 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;
5787 let LOCALLY_CONNECTED_CONNECTED_COMPONENT = prove
5790 ==> locally connected (connected_component s x)`,
5791 REPEAT STRIP_TAC THEN
5792 ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
5793 ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
5794 MATCH_MP_TAC LOCALLY_CONNECTED_COMPONENTS THEN
5795 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
5796 ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
5798 let LOCALLY_PATH_CONNECTED_COMPONENTS = prove
5799 (`!s c:real^N->bool.
5800 locally path_connected s /\ c IN components s
5801 ==> locally path_connected c`,
5802 REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5803 (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
5804 FIRST_X_ASSUM(MATCH_MP_TAC o
5805 GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT] o
5806 MATCH_MP LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED) THEN
5807 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;
5809 let LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT = prove
5811 locally path_connected s
5812 ==> locally path_connected (connected_component s x)`,
5813 REPEAT STRIP_TAC THEN
5814 ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
5815 ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
5816 MATCH_MP_TAC LOCALLY_PATH_CONNECTED_COMPONENTS THEN
5817 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
5818 ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
5820 let OPEN_IMP_LOCALLY_PATH_CONNECTED = prove
5821 (`!s:real^N->bool. open s ==> locally path_connected s`,
5822 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
5823 EXISTS_TAC `convex:(real^N->bool)->bool` THEN
5824 REWRITE_TAC[CONVEX_IMP_PATH_CONNECTED] THEN
5825 ASM_SIMP_TAC[locally; OPEN_IN_OPEN_EQ] THEN
5826 ASM_MESON_TAC[OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; CONVEX_BALL;
5829 let OPEN_IMP_LOCALLY_CONNECTED = prove
5830 (`!s:real^N->bool. open s ==> locally connected s`,
5831 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
5832 EXISTS_TAC `path_connected:(real^N->bool)->bool` THEN
5833 ASM_SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED;
5834 PATH_CONNECTED_IMP_CONNECTED]);;
5836 let LOCALLY_PATH_CONNECTED_UNIV = prove
5837 (`locally path_connected (:real^N)`,
5838 SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; OPEN_UNIV]);;
5840 let LOCALLY_CONNECTED_UNIV = prove
5841 (`locally connected (:real^N)`,
5842 SIMP_TAC[OPEN_IMP_LOCALLY_CONNECTED; OPEN_UNIV]);;
5844 let OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED = prove
5847 ==> open_in (subtopology euclidean s) (connected_component s x)`,
5848 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
5849 REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
5850 [FIRST_X_ASSUM MATCH_MP_TAC THEN
5851 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
5852 ASM_MESON_TAC[OPEN_IN_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]]);;
5854 let OPEN_IN_COMPONENTS_LOCALLY_CONNECTED = prove
5855 (`!s c:real^N->bool.
5856 locally connected s /\ c IN components s
5857 ==> open_in (subtopology euclidean s) c`,
5858 MESON_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT; OPEN_IN_REFL]);;
5860 let OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
5862 locally path_connected s
5863 ==> open_in (subtopology euclidean s) (path_component s x)`,
5864 REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
5865 REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
5866 [FIRST_X_ASSUM MATCH_MP_TAC THEN
5867 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
5868 ASM_MESON_TAC[OPEN_IN_EMPTY; PATH_COMPONENT_EQ_EMPTY]]);;
5870 let CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
5872 locally path_connected s
5873 ==> closed_in (subtopology euclidean s) (path_component s x)`,
5874 REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
5875 PATH_COMPONENT_SUBSET] THEN
5876 REPEAT STRIP_TAC THEN
5878 `s DIFF path_component s (x:real^N) =
5879 UNIONS({path_component s y | y | y IN s} DELETE (path_component s x))`
5881 [GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_PATH_COMPONENT] THEN
5882 MATCH_MP_TAC(SET_RULE
5883 `(!x. x IN s DELETE a ==> DISJOINT a x)
5884 ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN
5885 REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
5886 SIMP_TAC[PATH_COMPONENT_DISJOINT; PATH_COMPONENT_EQ_EQ] THEN
5887 MESON_TAC[IN; SUBSET; PATH_COMPONENT_SUBSET];
5888 MATCH_MP_TAC OPEN_IN_UNIONS THEN
5889 REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
5890 ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED]]);;
5892 let CONVEX_IMP_LOCALLY_PATH_CONNECTED = prove
5893 (`!s:real^N->bool. convex s ==> locally path_connected s`,
5894 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
5895 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5896 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
5897 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
5898 FIRST_X_ASSUM SUBST_ALL_TAC THEN
5899 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
5900 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
5901 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
5902 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
5903 EXISTS_TAC `s INTER ball(x:real^N,e)` THEN REPEAT CONJ_TAC THENL
5904 [REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[OPEN_BALL];
5905 MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
5906 ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL];
5907 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL];
5910 let OPEN_IN_CONNECTED_COMPONENTS = prove
5911 (`!s c:real^N->bool.
5912 FINITE(components s) /\ c IN components s
5913 ==> open_in (subtopology euclidean s) c`,
5914 REWRITE_TAC[components; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
5915 SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT]);;
5917 let FINITE_COMPONENTS = prove
5918 (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE(components s)`,
5919 REPEAT STRIP_TAC THEN FIRST_ASSUM
5920 (MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
5921 DISCH_THEN(MP_TAC o SPEC `components(s:real^N->bool)`) THEN
5922 REWRITE_TAC[GSYM UNIONS_COMPONENTS; SUBSET_REFL] THEN ANTS_TAC THENL
5923 [ASM_MESON_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; ALL_TAC] THEN
5924 DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
5925 SUBGOAL_THEN `components(s:real^N->bool) = f`
5926 (fun th -> ASM_REWRITE_TAC[th]) THEN
5927 ASM_CASES_TAC `?c:real^N->bool. c IN components s /\ ~(c IN f)` THENL
5928 [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC); ASM SET_TAC[]] THEN
5930 `~(c:real^N->bool = {}) /\ c SUBSET UNIONS f /\ DISJOINT c (UNIONS f)`
5931 MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN REPEAT CONJ_TAC THENL
5932 [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
5933 ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET_TRANS];
5934 REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
5935 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN
5936 MATCH_MP_TAC(REWRITE_RULE[pairwise] PAIRWISE_DISJOINT_COMPONENTS) THEN
5937 ASM_MESON_TAC[SUBSET]]);;
5939 let CONVEX_IMP_LOCALLY_CONNECTED = prove
5940 (`!s:real^N->bool. convex s ==> locally connected s`,
5941 MESON_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED;
5942 LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
5944 let HOMEOMORPHIC_LOCAL_CONNECTEDNESS = prove
5945 (`!s t. s homeomorphic t ==> (locally connected s <=> locally connected t)`,
5946 MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
5947 REWRITE_TAC[HOMEOMORPHIC_CONNECTEDNESS]);;
5949 let HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS = prove
5950 (`!s t. s homeomorphic t
5951 ==> (locally path_connected s <=> locally path_connected t)`,
5952 MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
5953 REWRITE_TAC[HOMEOMORPHIC_PATH_CONNECTEDNESS]);;
5955 let LOCALLY_PATH_CONNECTED_TRANSLATION_EQ = prove
5956 (`!a:real^N s. locally path_connected (IMAGE (\x. a + x) s) <=>
5957 locally path_connected s`,
5958 MATCH_MP_TAC LOCALLY_TRANSLATION THEN
5959 REWRITE_TAC[PATH_CONNECTED_TRANSLATION_EQ]);;
5961 add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];;
5963 let LOCALLY_CONNECTED_TRANSLATION_EQ = prove
5964 (`!a:real^N s. locally connected (IMAGE (\x. a + x) s) <=>
5965 locally connected s`,
5966 MATCH_MP_TAC LOCALLY_TRANSLATION THEN
5967 REWRITE_TAC[CONNECTED_TRANSLATION_EQ]);;
5969 add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];;
5971 let LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
5972 (`!f:real^M->real^N s.
5973 linear f /\ (!x y. f x = f y ==> x = y)
5974 ==> (locally path_connected (IMAGE f s) <=> locally path_connected s)`,
5975 MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
5976 REWRITE_TAC[PATH_CONNECTED_LINEAR_IMAGE_EQ]);;
5978 add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];;
5980 let LOCALLY_CONNECTED_LINEAR_IMAGE_EQ = prove
5981 (`!f:real^M->real^N s.
5982 linear f /\ (!x y. f x = f y ==> x = y)
5983 ==> (locally connected (IMAGE f s) <=> locally connected s)`,
5984 MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
5985 REWRITE_TAC[CONNECTED_LINEAR_IMAGE_EQ]);;
5987 add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];;
5989 let LOCALLY_CONNECTED_QUOTIENT_IMAGE = prove
5990 (`!f:real^M->real^N s.
5991 (!t. t SUBSET IMAGE f s
5992 ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
5993 open_in (subtopology euclidean (IMAGE f s)) t)) /\
5995 ==> locally connected (IMAGE f s)`,
5996 REPEAT STRIP_TAC THEN
5997 REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
5998 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN
6000 FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
6001 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
6002 FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
6003 ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
6004 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN
6005 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC
6006 `connected_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN
6007 REPEAT CONJ_TAC THENL
6008 [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
6009 ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
6010 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6011 [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
6012 REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN
6013 REWRITE_TAC[IN_COMPONENTS; IN_ELIM_THM] THEN ASM SET_TAC[];
6015 ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`]
6016 CONNECTED_COMPONENT_SUBSET) THEN
6018 `IMAGE (f:real^M->real^N) (connected_component {w | w IN s /\ f w IN u} x)
6020 MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6021 MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `u:real^N->bool` THEN
6022 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6023 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
6024 REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
6025 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
6027 [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in];
6030 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
6031 EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_REWRITE_TAC[] THEN
6032 MATCH_MP_TAC FUN_IN_IMAGE]] THEN
6033 GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
6036 let LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE = prove
6037 (`!f:real^M->real^N s.
6038 (!t. t SUBSET IMAGE f s
6039 ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
6040 open_in (subtopology euclidean (IMAGE f s)) t)) /\
6041 locally path_connected s
6042 ==> locally path_connected (IMAGE f s)`,
6043 REPEAT STRIP_TAC THEN
6044 REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
6045 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN
6047 ASSUME_TAC(ISPECL [`u:real^N->bool`; `y:real^N`] PATH_COMPONENT_SUBSET) THEN
6048 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
6049 FIRST_ASSUM(MP_TAC o SPEC `path_component u (y:real^N)`) THEN
6050 ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
6051 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN
6052 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC
6053 `path_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN
6054 REPEAT CONJ_TAC THENL
6055 [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
6056 ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
6057 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6058 [LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT]) THEN
6059 REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[];
6061 ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`]
6062 PATH_COMPONENT_SUBSET) THEN
6064 `IMAGE (f:real^M->real^N) (path_component {w | w IN s /\ f w IN u} x)
6065 SUBSET path_component u y`
6066 MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6067 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
6068 MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
6069 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6070 [MATCH_MP_TAC FUN_IN_IMAGE;
6071 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
6072 REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
6073 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
6075 [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in];
6077 ASM SET_TAC[]]] THEN
6078 GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
6081 let LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
6082 (`!f:real^M->real^N s.
6083 locally connected s /\ compact s /\ f continuous_on s
6084 ==> locally connected (IMAGE f s)`,
6085 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_QUOTIENT_IMAGE THEN
6086 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
6087 ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
6088 COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
6089 ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
6090 CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6092 let LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
6093 (`!f:real^M->real^N s.
6094 locally path_connected s /\ compact s /\ f continuous_on s
6095 ==> locally path_connected (IMAGE f s)`,
6096 REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE THEN
6097 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
6098 ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
6099 COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
6100 ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
6101 CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6103 let LOCALLY_PATH_CONNECTED_PATH_IMAGE = prove
6104 (`!p:real^1->real^N. path p ==> locally path_connected (path_image p)`,
6105 REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
6106 MATCH_MP_TAC LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN
6107 ASM_SIMP_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL;
6108 CONVEX_IMP_LOCALLY_PATH_CONNECTED]);;
6110 let LOCALLY_CONNECTED_PATH_IMAGE = prove
6111 (`!p:real^1->real^N. path p ==> locally connected (path_image p)`,
6112 SIMP_TAC[LOCALLY_PATH_CONNECTED_PATH_IMAGE;
6113 LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
6115 let LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
6116 (`!f:real^M->real^N g s.
6117 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6118 (!x. x IN s ==> g(f x) = x) /\
6120 ==> locally connected (IMAGE f s)`,
6122 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6123 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
6124 MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;
6126 let LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
6127 (`!f:real^M->real^N g s.
6128 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6129 IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
6131 ==> locally connected (IMAGE f s)`,
6133 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6134 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
6135 MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
6136 EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;
6138 let LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
6139 (`!f:real^M->real^N g s.
6140 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6141 (!x. x IN s ==> g(f x) = x) /\
6142 locally path_connected s
6143 ==> locally path_connected (IMAGE f s)`,
6145 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6146 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
6147 LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
6148 MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;
6150 let LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
6151 (`!f:real^M->real^N g s.
6152 f continuous_on s /\ g continuous_on (IMAGE f s) /\
6153 IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
6154 locally path_connected s
6155 ==> locally path_connected (IMAGE f s)`,
6157 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6158 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
6159 LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
6160 MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
6161 EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;
6163 let LOCALLY_PCROSS = prove
6165 (!s:real^M->bool t:real^N->bool. P s /\ Q t ==> R(s PCROSS t))
6166 ==> (!s t. locally P s /\ locally Q t ==> locally R (s PCROSS t))`,
6167 REPEAT STRIP_TAC THEN REWRITE_TAC[locally; FORALL_PASTECART] THEN
6169 [`w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] THEN
6170 DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN
6171 MP_TAC(MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY
6172 (ONCE_REWRITE_RULE[CONJ_SYM] th))) THEN
6173 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6174 MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
6176 FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`] o
6177 GEN_REWRITE_RULE I [locally]) THEN
6178 FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `y:real^N`] o
6179 GEN_REWRITE_RULE I [locally]) THEN
6180 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6181 MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `v'':real^N->bool`] THEN
6183 MAP_EVERY X_GEN_TAC [`u':real^M->bool`; `u'':real^M->bool`] THEN
6185 EXISTS_TAC `(u':real^M->bool) PCROSS (v':real^N->bool)` THEN
6186 EXISTS_TAC `(u'':real^M->bool) PCROSS (v'':real^N->bool)` THEN
6187 ASM_SIMP_TAC[PASTECART_IN_PCROSS; PCROSS_MONO; OPEN_IN_PCROSS] THEN
6188 ASM_MESON_TAC[PCROSS_MONO; SUBSET_TRANS]);;
6190 let LOCALLY_CONNECTED_PCROSS = prove
6191 (`!s:real^M->bool t:real^N->bool.
6192 locally connected s /\ locally connected t
6193 ==> locally connected (s PCROSS t)`,
6194 MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[CONNECTED_PCROSS]);;
6196 let LOCALLY_PATH_CONNECTED_PCROSS = prove
6197 (`!s:real^M->bool t:real^N->bool.
6198 locally path_connected s /\ locally path_connected t
6199 ==> locally path_connected (s PCROSS t)`,
6200 MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[PATH_CONNECTED_PCROSS]);;
6202 let LOCALLY_CONNECTED_PCROSS_EQ = prove
6203 (`!s:real^M->bool t:real^N->bool.
6204 locally connected (s PCROSS t) <=>
6205 s = {} \/ t = {} \/ locally connected s /\ locally connected t`,
6206 REPEAT STRIP_TAC THEN
6207 ASM_CASES_TAC `s:real^M->bool = {}` THEN
6208 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6209 ASM_CASES_TAC `t:real^N->bool = {}` THEN
6210 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6211 EQ_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_PCROSS] THEN
6212 GEN_REWRITE_TAC LAND_CONV [LOCALLY_CONNECTED] THEN DISCH_TAC THEN
6213 REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
6214 [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
6215 UNDISCH_TAC `~(t:real^N->bool = {})` THEN
6216 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6217 DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
6218 FIRST_X_ASSUM(MP_TAC o SPECL
6219 [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
6220 `pastecart (x:real^M) (y:real^N)`]);
6221 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
6222 UNDISCH_TAC `~(s:real^M->bool = {})` THEN
6223 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6224 DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
6225 FIRST_X_ASSUM(MP_TAC o SPECL
6226 [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
6227 `pastecart (x:real^M) (y:real^N)`])] THEN
6228 ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
6229 OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
6230 X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
6232 [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
6233 `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
6234 ASM_REWRITE_TAC[] THENL
6235 [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
6236 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6237 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6239 X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
6240 EXISTS_TAC `IMAGE fstcart (w:real^(M,N)finite_sum->bool)` THEN
6241 ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_FSTCART] THEN
6242 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]];
6243 DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
6244 MATCH_MP_TAC MONO_EXISTS THEN
6245 X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
6246 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6248 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
6249 EXISTS_TAC `IMAGE sndcart (w:real^(M,N)finite_sum->bool)` THEN
6250 ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_SNDCART] THEN
6251 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]]] THEN
6252 RULE_ASSUM_TAC(REWRITE_RULE
6253 [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
6256 let LOCALLY_PATH_CONNECTED_PCROSS_EQ = prove
6257 (`!s:real^M->bool t:real^N->bool.
6258 locally path_connected (s PCROSS t) <=>
6260 locally path_connected s /\ locally path_connected t`,
6261 REPEAT STRIP_TAC THEN
6262 ASM_CASES_TAC `s:real^M->bool = {}` THEN
6263 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6264 ASM_CASES_TAC `t:real^N->bool = {}` THEN
6265 ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6266 EQ_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_PCROSS] THEN
6267 GEN_REWRITE_TAC LAND_CONV [LOCALLY_PATH_CONNECTED] THEN DISCH_TAC THEN
6268 REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
6269 [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
6270 UNDISCH_TAC `~(t:real^N->bool = {})` THEN
6271 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6272 DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
6273 FIRST_X_ASSUM(MP_TAC o SPECL
6274 [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
6275 `pastecart (x:real^M) (y:real^N)`]);
6276 MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
6277 UNDISCH_TAC `~(s:real^M->bool = {})` THEN
6278 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6279 DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
6280 FIRST_X_ASSUM(MP_TAC o SPECL
6281 [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
6282 `pastecart (x:real^M) (y:real^N)`])] THEN
6283 ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
6284 OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
6285 X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
6287 [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
6288 `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
6289 ASM_REWRITE_TAC[] THENL
6290 [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
6291 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6292 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6294 X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
6295 MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
6296 `w:real^(M,N)finite_sum->bool`]
6297 PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN
6298 REWRITE_TAC[path_connected] THEN
6299 DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `z:real^M`]) THEN ANTS_TAC THENL
6300 [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART];
6301 MATCH_MP_TAC MONO_EXISTS THEN
6302 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART] THEN
6303 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]];
6304 DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
6305 MATCH_MP_TAC MONO_EXISTS THEN
6306 X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
6307 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6309 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
6310 MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
6311 `w:real^(M,N)finite_sum->bool`]
6312 PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN
6313 REWRITE_TAC[path_connected] THEN
6314 DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ANTS_TAC THENL
6315 [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART];
6316 MATCH_MP_TAC MONO_EXISTS THEN
6317 REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART] THEN
6318 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]] THEN
6319 RULE_ASSUM_TAC(REWRITE_RULE
6320 [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
6323 let CARD_EQ_OPEN_IN = prove
6324 (`!u s:real^N->bool.
6325 locally connected u /\
6326 open_in (subtopology euclidean u) s /\
6327 (?x. x IN s /\ x limit_point_of u)
6329 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
6330 [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
6331 SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN
6332 MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV];
6334 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6335 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6336 UNDISCH_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_INTER] THEN
6338 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
6339 DISCH_THEN(MP_TAC o SPECL [`u INTER t:real^N->bool`; `x:real^N`]) THEN
6340 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN
6341 REWRITE_TAC[OPEN_IN_OPEN; GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN
6342 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6343 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6344 REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN
6345 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6346 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [limit_point_of]) THEN
6347 DISCH_THEN(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN
6348 ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN
6349 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
6350 TRANS_TAC CARD_LE_TRANS `u INTER v:real^N->bool` THEN
6351 ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
6352 ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN
6355 let CARD_EQ_OPEN_IN_AFFINE = prove
6356 (`!u s:real^N->bool.
6357 affine u /\ ~(aff_dim u = &0) /\
6358 open_in (subtopology euclidean u) s /\ ~(s = {})
6360 REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_OPEN_IN THEN
6361 EXISTS_TAC `u:real^N->bool` THEN
6362 ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; AFFINE_IMP_CONVEX] THEN
6363 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
6364 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
6365 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
6366 ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED] THEN
6367 FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);;
6369 (* ------------------------------------------------------------------------- *)
6370 (* Basic properties of local compactness. *)
6371 (* ------------------------------------------------------------------------- *)
6373 let LOCALLY_COMPACT = prove
6375 locally compact s <=>
6376 !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
6377 open_in (subtopology euclidean s) u /\
6379 GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
6380 [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
6381 (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
6382 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6383 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6384 MESON_TAC[SUBSET_INTER];
6385 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
6386 REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
6387 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6388 ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
6389 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6390 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6391 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6393 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6394 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6395 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6396 EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
6397 EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
6398 ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
6399 COMPACT_INTER; COMPACT_CBALL; IN_INTER] THEN
6400 MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
6403 let OPEN_IMP_LOCALLY_COMPACT = prove
6404 (`!s:real^N->bool. open s ==> locally compact s`,
6405 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6406 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM
6407 (MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6408 DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
6409 ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
6410 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6411 MAP_EVERY EXISTS_TAC [`ball(x:real^N,e)`; `cball(x:real^N,e)`] THEN
6412 ASM_REWRITE_TAC[BALL_SUBSET_CBALL; CENTRE_IN_BALL; COMPACT_CBALL] THEN
6413 MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN
6414 ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]);;
6416 let CLOSED_IMP_LOCALLY_COMPACT = prove
6417 (`!s:real^N->bool. closed s ==> locally compact s`,
6418 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6419 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
6420 [`s INTER ball(x:real^N,&1)`; `s INTER cball(x:real^N,&1)`] THEN
6421 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET; REAL_LT_01] THEN
6422 ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6423 ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
6424 MP_TAC(ISPECL [`x:real^N`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;
6426 let IS_INTERVAL_IMP_LOCALLY_COMPACT = prove
6427 (`!s:real^N->bool. is_interval s ==> locally compact s`,
6428 REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6429 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6430 MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
6431 INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
6432 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6433 MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `d:real`] THEN STRIP_TAC THEN
6434 MAP_EVERY EXISTS_TAC
6435 [`s INTER ball(x:real^N,d)`; `interval[a:real^N,b]`] THEN
6436 ASM_SIMP_TAC[COMPACT_INTERVAL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6437 ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[]);;
6439 let LOCALLY_COMPACT_UNIV = prove
6440 (`locally compact (:real^N)`,
6441 SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; OPEN_UNIV]);;
6443 let LOCALLY_COMPACT_INTER = prove
6444 (`!s t:real^N->bool.
6445 locally compact s /\ locally compact t
6446 ==> locally compact (s INTER t)`,
6447 MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]);;
6449 let LOCALLY_COMPACT_OPEN_IN = prove
6450 (`!s t:real^N->bool.
6451 open_in (subtopology euclidean s) t /\ locally compact s
6452 ==> locally compact t`,
6453 REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
6454 ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; OPEN_IMP_LOCALLY_COMPACT]);;
6456 let LOCALLY_COMPACT_CLOSED_IN = prove
6457 (`!s t:real^N->bool.
6458 closed_in (subtopology euclidean s) t /\ locally compact s
6459 ==> locally compact t`,
6460 REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
6461 ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; CLOSED_IMP_LOCALLY_COMPACT]);;
6463 let SIGMA_COMPACT = prove
6466 ==> ?f. COUNTABLE f /\ (!t. t IN f ==> compact t) /\ UNIONS f = s`,
6467 GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6468 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6469 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6470 MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `c:real^N->real^N->bool`] THEN
6472 MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]
6473 LINDELOF_OPEN_IN) THEN
6474 ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
6475 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6476 REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
6477 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6478 EXISTS_TAC `IMAGE (c:real^N->real^N->bool) t` THEN
6479 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; FORALL_IN_IMAGE; FORALL_IN_UNIONS] THEN
6480 ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);;
6482 let HOMEOMORPHIC_LOCAL_COMPACTNESS = prove
6483 (`!s t:real^N->bool.
6484 s homeomorphic t ==> (locally compact s <=> locally compact t)`,
6485 MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6486 REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]);;
6488 let LOCALLY_COMPACT_TRANSLATION_EQ = prove
6489 (`!a:real^N s. locally compact (IMAGE (\x. a + x) s) <=>
6491 MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6492 REWRITE_TAC[COMPACT_TRANSLATION_EQ]);;
6494 add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];;
6496 let LOCALLY_COMPACT_LINEAR_IMAGE_EQ = prove
6497 (`!f:real^M->real^N s.
6498 linear f /\ (!x y. f x = f y ==> x = y)
6499 ==> (locally compact (IMAGE f s) <=> locally compact s)`,
6500 MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6501 REWRITE_TAC[COMPACT_LINEAR_IMAGE_EQ]);;
6503 add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];;
6505 let LOCALLY_CLOSED = prove
6506 (`!s:real^N->bool. locally closed s <=> locally compact s`,
6507 GEN_TAC THEN EQ_TAC THENL
6508 [ALL_TAC; MESON_TAC[LOCALLY_MONO; COMPACT_IMP_CLOSED]] THEN
6509 REWRITE_TAC[locally] THEN DISCH_TAC THEN
6510 MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
6511 FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
6512 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6513 MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6515 EXISTS_TAC `u INTER ball(x:real^N,&1)` THEN
6516 EXISTS_TAC `v INTER cball(x:real^N,&1)` THEN
6517 ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL] THEN
6518 ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
6519 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6520 MP_TAC(ISPEC `x:real^N` BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;
6522 (* ------------------------------------------------------------------------- *)
6523 (* Locally compact sets are closed in an open set and are homeomorphic *)
6524 (* to an absolutely closed set if we have one more dimension to play with. *)
6525 (* ------------------------------------------------------------------------- *)
6527 let LOCALLY_COMPACT_OPEN_INTER_CLOSURE = prove
6528 (`!s:real^N->bool. locally compact s ==> ?t. open t /\ s = t INTER closure s`,
6529 GEN_TAC THEN SIMP_TAC[LOCALLY_COMPACT; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN
6530 REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
6531 REWRITE_TAC[GSYM CONJ_ASSOC; TAUT `p /\ x = y /\ q <=> x = y /\ p /\ q`] THEN
6532 ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN
6533 REWRITE_TAC[UNWIND_THM2] THEN
6534 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6535 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6536 MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
6537 DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (u:real^N->real^N->bool) s)` THEN
6538 ASM_SIMP_TAC[CLOSED_CLOSURE; OPEN_UNIONS; FORALL_IN_IMAGE] THEN
6539 REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
6540 `UNIONS {v INTER s | v | v IN IMAGE (u:real^N->real^N->bool) s}` THEN
6542 [SIMP_TAC[UNIONS_GSPEC; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN
6543 AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
6544 `(!x. x IN s ==> f(g x) = f'(g x))
6545 ==> {f x | x IN IMAGE g s} = {f' x | x IN IMAGE g s}`) THEN
6546 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6547 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL
6548 [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
6549 REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
6550 EXISTS_TAC `closure((u:real^N->real^N->bool) x INTER s)` THEN
6551 ASM_SIMP_TAC[OPEN_INTER_CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
6552 EXISTS_TAC `(v:real^N->real^N->bool) x` THEN
6553 ASM_SIMP_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
6554 ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);;
6556 let LOCALLY_COMPACT_CLOSED_IN_OPEN = prove
6558 locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s`,
6560 DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
6561 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
6562 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6563 FIRST_X_ASSUM SUBST1_TAC THEN
6564 SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]);;
6566 let LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED = prove
6569 ==> ?t:real^(M,N)finite_sum->bool f.
6570 closed t /\ homeomorphism (s,t) (f,fstcart)`,
6571 REPEAT STRIP_TAC THEN ASM_CASES_TAC `closed(s:real^M->bool)` THENL
6572 [EXISTS_TAC `(s:real^M->bool) PCROSS {vec 0:real^N}` THEN
6573 EXISTS_TAC `\x. (pastecart x (vec 0):real^(M,N)finite_sum)` THEN
6574 ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_SING; HOMEOMORPHISM] THEN
6575 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
6576 LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN
6577 REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN
6578 SIMP_TAC[FSTCART_PASTECART];
6580 FIRST_X_ASSUM(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
6581 DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
6582 DISJ_CASES_TAC(SET_RULE `t = (:real^M) \/ ~((:real^M) DIFF t = {})`) THENL
6583 [ASM_MESON_TAC[CLOSURE_EQ; INTER_UNIV]; ALL_TAC] THEN
6585 `f:real^M->real^(M,N)finite_sum =
6586 \x. pastecart x (inv(setdist({x},(:real^M) DIFF t)) % vec 1)` THEN
6588 `homeomorphism (t,IMAGE (f:real^M->real^(M,N)finite_sum) t) (f,fstcart)`
6590 [SIMP_TAC[HOMEOMORPHISM; SUBSET_REFL; LINEAR_CONTINUOUS_ON;
6591 LINEAR_FSTCART; FORALL_IN_IMAGE] THEN
6592 MATCH_MP_TAC(TAUT `(r ==> q /\ s) /\ r /\ p ==> p /\ q /\ r /\ s`) THEN
6593 CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "f"] THEN
6594 SIMP_TAC[FSTCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
6595 REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
6596 REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN
6597 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
6598 REWRITE_TAC[SETDIST_EQ_0_SING; CONTINUOUS_ON_LIFT_SETDIST] THEN
6599 ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN];
6601 EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) s` THEN
6602 EXISTS_TAC `f:real^M->real^(M,N)finite_sum` THEN CONJ_TAC THENL
6603 [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
6604 EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) t` THEN CONJ_TAC THENL
6605 [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC
6606 [`fstcart:real^(M,N)finite_sum->real^M`; `t:real^M->bool`] THEN
6607 ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN
6608 SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE];
6610 `IMAGE (f:real^M->real^(M,N)finite_sum) t =
6611 {z | (setdist({fstcart z},(:real^M) DIFF t) % sndcart z) IN {vec 1}}`
6613 [EXPAND_TAC "f" THEN
6614 REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_INJ;
6615 FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; IN_INTER;
6616 GSYM CONJ_ASSOC; UNWIND_THM1; IN_SING] THEN
6617 REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
6618 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN
6619 MP_TAC(ISPECL [`(:real^M) DIFF t`; `x:real^M`]
6620 (CONJUNCT1 SETDIST_EQ_0_SING)) THEN
6621 ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN] THEN
6622 ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_SIMP_TAC[REAL_FIELD
6623 `~(x = &0) ==> (y = inv x * &1 <=> x * y = &1)`] THEN
6624 DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN
6625 REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC;
6626 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
6627 REWRITE_TAC[CLOSED_SING] THEN X_GEN_TAC `z:real^(M,N)finite_sum` THEN
6628 MATCH_MP_TAC CONTINUOUS_MUL THEN
6629 SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_SNDCART; o_DEF] THEN
6631 `(\z:real^(M,N)finite_sum.
6632 lift(setdist({fstcart z},(:real^M) DIFF t))) =
6633 (\x. lift (setdist ({x},(:real^M) DIFF t))) o fstcart`
6634 SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
6635 MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
6636 SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART] THEN
6637 REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST]]];
6638 MATCH_MP_TAC HOMEOMORPHISM_OF_SUBSETS THEN MAP_EVERY EXISTS_TAC
6639 [`t:real^M->bool`; `IMAGE (f:real^M->real^(M,N)finite_sum) t`] THEN
6642 let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove
6644 locally compact s /\ dimindex(:M) < dimindex(:N)
6645 ==> ?t:real^N->bool. closed t /\ s homeomorphic t`,
6646 REPEAT STRIP_TAC THEN SUBGOAL_THEN
6647 `?t:real^(M,1)finite_sum->bool h.
6648 closed t /\ homeomorphism (s,t) (h,fstcart)`
6649 STRIP_ASSUME_TAC THENL
6650 [ASM_SIMP_TAC[LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED];
6653 `f:real^(M,1)finite_sum->real^N =
6654 \x. lambda i. if i <= dimindex(:M) then x$i
6655 else x$(dimindex(:M)+1)` THEN
6657 `g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN
6658 EXISTS_TAC `IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN
6659 SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL
6660 [EXPAND_TAC "f" THEN REWRITE_TAC[linear; CART_EQ] THEN
6661 SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
6664 SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL
6665 [EXPAND_TAC "g" THEN REWRITE_TAC[linear; CART_EQ] THEN
6666 SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
6670 `!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) =
6673 [MAP_EVERY EXPAND_TAC ["f"; "g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP
6674 (ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN
6675 SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN
6676 REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN
6679 CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN
6680 TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN
6681 CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN
6682 REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC
6683 [`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN
6684 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;
6686 (* ------------------------------------------------------------------------- *)
6687 (* Relations between components and path components. *)
6688 (* ------------------------------------------------------------------------- *)
6690 let OPEN_CONNECTED_COMPONENT = prove
6691 (`!s x:real^N. open s ==> open(connected_component s x)`,
6692 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
6693 DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
6694 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
6696 [ASM_MESON_TAC[SUBSET; CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
6697 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN
6698 ASM_REWRITE_TAC[] THEN
6699 SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y`
6701 [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
6702 MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
6703 ASM_REWRITE_TAC[CENTRE_IN_BALL; CONNECTED_BALL]]);;
6705 let IN_CLOSURE_CONNECTED_COMPONENT = prove
6708 ==> (x IN closure(connected_component s y) <=>
6709 x IN connected_component s y)`,
6710 REPEAT STRIP_TAC THEN EQ_TAC THEN
6711 REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
6712 DISCH_TAC THEN SUBGOAL_THEN
6713 `~((connected_component s (x:real^N)) INTER
6714 closure(connected_component s y) = {})`
6716 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
6717 ASM_REWRITE_TAC[IN_INTER] THEN
6718 ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
6719 ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_CONNECTED_COMPONENT] THEN
6720 REWRITE_TAC[CONNECTED_COMPONENT_OVERLAP] THEN
6721 STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6722 ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]]);;
6724 let PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT = prove
6725 (`!s x:real^N. (path_component s x) SUBSET (connected_component s x)`,
6726 REPEAT STRIP_TAC THEN
6727 ASM_CASES_TAC `(x:real^N) IN s` THENL
6728 [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
6729 ASM_REWRITE_TAC[PATH_COMPONENT_SUBSET; IN; PATH_COMPONENT_REFL_EQ] THEN
6730 SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_PATH_COMPONENT];
6731 ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET_REFL;
6732 CONNECTED_COMPONENT_EQ_EMPTY]]);;
6734 let PATH_COMPONENT_EQ_CONNECTED_COMPONENT = prove
6736 locally path_connected s
6737 ==> (path_component s x = connected_component s x)`,
6738 REPEAT STRIP_TAC THEN
6739 ASM_CASES_TAC `(x:real^N) IN s` THENL
6741 ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]] THEN
6742 MP_TAC(ISPECL[`s:real^N->bool`; `x:real^N`]
6743 CONNECTED_CONNECTED_COMPONENT) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN
6744 REWRITE_TAC[TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] THEN
6745 DISCH_THEN MATCH_MP_TAC THEN
6746 ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN CONJ_TAC THENL
6747 [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS;
6748 MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS] THEN
6749 EXISTS_TAC `s:real^N->bool` THEN
6750 ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
6751 CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
6752 PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT;
6753 CONNECTED_COMPONENT_SUBSET]);;
6755 let LOCALLY_PATH_CONNECTED_PATH_COMPONENT = prove
6757 locally path_connected s
6758 ==> locally path_connected (path_component s x)`,
6759 MESON_TAC[LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT;
6760 PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;
6762 let OPEN_PATH_CONNECTED_COMPONENT = prove
6763 (`!s x:real^N. open s ==> path_component s x = connected_component s x`,
6764 SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT;
6765 OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
6767 let PATH_CONNECTED_EQ_CONNECTED_LPC = prove
6768 (`!s. locally path_connected s ==> (path_connected s <=> connected s)`,
6769 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT;
6770 CONNECTED_IFF_CONNECTED_COMPONENT] THEN
6771 SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;
6773 let PATH_CONNECTED_EQ_CONNECTED = prove
6774 (`!s. open s ==> (path_connected s <=> connected s)`,
6775 SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
6777 let CONNECTED_OPEN_PATH_CONNECTED = prove
6778 (`!s:real^N->bool. open s /\ connected s ==> path_connected s`,
6779 SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED]);;
6781 let CONNECTED_OPEN_ARC_CONNECTED = prove
6783 open s /\ connected s
6784 ==> !x y. x IN s /\ y IN s
6787 path_image g SUBSET s /\
6790 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_OPEN_PATH_CONNECTED) THEN
6791 REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
6792 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);;
6794 let OPEN_COMPONENTS = prove
6795 (`!u:real^N->bool s. open u /\ s IN components u ==> open s`,
6796 REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS;
6797 ASSUME `s:real^N->bool IN components u`] `?x. s:real^N->bool =
6798 connected_component u x`) THEN ASM_SIMP_TAC [OPEN_CONNECTED_COMPONENT]);;
6800 let COMPONENTS_OPEN_UNIQUE = prove
6801 (`!f:(real^N->bool)->bool s.
6802 (!c. c IN f ==> open c /\ connected c /\ ~(c = {})) /\
6803 pairwise DISJOINT f /\ UNIONS f = s
6804 ==> components s = f`,
6805 REPEAT STRIP_TAC THEN
6806 MATCH_MP_TAC CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE THEN
6807 ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; PAIRWISE_DISJOINT_COMPONENTS] THEN
6808 ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_NONEMPTY;
6809 IN_COMPONENTS_CONNECTED; OPEN_UNIONS]);;
6811 let CONTINUOUS_ON_COMPONENTS = prove
6812 (`!f:real^M->real^N s.
6813 open s /\ (!c. c IN components s ==> f continuous_on c)
6814 ==> f continuous_on s`,
6815 REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_GEN THEN
6816 ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_SUBSET THEN
6817 ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_SUBSET]);;
6819 let CONTINUOUS_ON_COMPONENTS_EQ = prove
6821 ==> (f continuous_on s <=>
6822 !c. c IN components s ==> f continuous_on c)`,
6823 REPEAT STRIP_TAC THEN EQ_TAC THENL
6824 [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
6825 ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS]]);;
6827 let CLOSED_IN_UNION_COMPLEMENT_COMPONENT = prove
6828 (`!u s c:real^N->bool.
6829 locally connected u /\
6830 closed_in (subtopology euclidean u) s /\
6831 c IN components(u DIFF s)
6832 ==> closed_in (subtopology euclidean u) (s UNION c)`,
6833 REPEAT STRIP_TAC THEN
6835 `s UNION c:real^N->bool = u DIFF (UNIONS(components(u DIFF s) DELETE c))`
6837 [MP_TAC(ISPEC `(u:real^N->bool) DIFF s` UNIONS_COMPONENTS) THEN
6838 ONCE_REWRITE_TAC [EXTENSION] THEN
6839 REWRITE_TAC[IN_UNION; IN_UNIV; IN_UNIONS; IN_DELETE; IN_DIFF] THEN
6840 MP_TAC(ISPEC `(u:real^N->bool) DIFF s` PAIRWISE_DISJOINT_COMPONENTS) THEN
6841 REWRITE_TAC[pairwise; SET_RULE
6842 `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN
6843 FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
6844 FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
6845 REWRITE_TAC[SUBSET] THEN ASM_MESON_TAC[];
6846 REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_DIFF] THEN
6847 MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
6848 MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
6849 MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_DELETE] THEN
6850 X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
6851 MATCH_MP_TAC OPEN_IN_TRANS THEN
6852 EXISTS_TAC `u DIFF s:real^N->bool` THEN CONJ_TAC THENL
6853 [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
6854 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
6855 EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[];
6857 MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);;
6859 let CLOSED_UNION_COMPLEMENT_COMPONENT = prove
6860 (`!s c. closed s /\ c IN components((:real^N) DIFF s) ==> closed(s UNION c)`,
6861 ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
6862 REPEAT STRIP_TAC THEN
6863 MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
6864 ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;
6866 let COUNTABLE_COMPONENTS = prove
6867 (`!s:real^N->bool. open s ==> COUNTABLE(components s)`,
6868 REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_DISJOINT_OPEN_SUBSETS THEN
6869 REWRITE_TAC[PAIRWISE_DISJOINT_COMPONENTS] THEN
6870 ASM_MESON_TAC[OPEN_COMPONENTS]);;
6872 let FRONTIER_MINIMAL_SEPARATING_CLOSED = prove
6873 (`!s c. closed s /\ ~connected((:real^N) DIFF s) /\
6874 (!t. closed t /\ t PSUBSET s ==> connected((:real^N) DIFF t)) /\
6875 c IN components ((:real^N) DIFF s)
6876 ==> frontier c = s`,
6877 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
6878 GEN_REWRITE_RULE RAND_CONV [CONNECTED_EQ_CONNECTED_COMPONENTS_EQ]) THEN
6879 DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
6880 `~(!x x'. x IN s /\ x' IN s ==> x = x')
6881 ==> !x. x IN s ==> ?y. y IN s /\ ~(y = x)`)) THEN
6882 DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
6883 DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
6884 FIRST_X_ASSUM(MP_TAC o SPEC `frontier c:real^N->bool`) THEN
6885 REWRITE_TAC[SET_RULE `s PSUBSET t <=> s SUBSET t /\ ~(t SUBSET s)`;
6886 GSYM SUBSET_ANTISYM_EQ] THEN
6887 ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; FRONTIER_CLOSED] THEN
6888 MATCH_MP_TAC(TAUT `~r ==> (~p ==> r) ==> p`) THEN
6889 REWRITE_TAC[connected] THEN
6890 MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `(:real^N) DIFF closure c`] THEN
6891 REPEAT CONJ_TAC THENL
6892 [ASM_MESON_TAC[OPEN_COMPONENTS; closed];
6893 REWRITE_TAC[GSYM closed; CLOSED_CLOSURE];
6894 MP_TAC(ISPEC `c:real^N->bool` INTERIOR_SUBSET) THEN
6895 REWRITE_TAC[frontier] THEN SET_TAC[];
6896 MATCH_MP_TAC(SET_RULE
6897 `c SUBSET c' ==> c INTER (UNIV DIFF c') INTER s = {}`) THEN
6898 REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; CLOSURE_SUBSET];
6899 REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
6900 `ci = c /\ ~(c = {})
6901 ==> ~(c INTER (UNIV DIFF (cc DIFF ci)) = {})`) THEN
6902 ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; INTERIOR_OPEN; closed;
6904 REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
6905 `~(UNIV DIFF c = {})
6906 ==> ~((UNIV DIFF c) INTER (UNIV DIFF (c DIFF i)) = {})`) THEN
6907 REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN
6908 MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ ~(t = {}) ==> ~(s = {})`) THEN
6909 EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL
6910 [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN
6911 MATCH_MP_TAC INTERIOR_MAXIMAL THEN
6912 REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
6913 ASM_MESON_TAC[COMPONENTS_NONOVERLAP; OPEN_COMPONENTS; GSYM closed]]);;
6915 (* ------------------------------------------------------------------------- *)
6916 (* Lower bound on norms within segment between vectors. *)
6917 (* Could have used these for connectedness results below, in fact. *)
6918 (* ------------------------------------------------------------------------- *)
6920 let NORM_SEGMENT_LOWERBOUND = prove
6921 (`!a b x:real^N r d.
6923 norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\
6924 a dot b = d * r pow 2
6925 ==> sqrt((&1 - abs d) / &2) * r <= norm(x)`,
6926 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
6927 REWRITE_TAC[NORM_GE_SQUARE] THEN DISJ2_TAC THEN
6928 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
6929 DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
6930 ASM_REWRITE_TAC[real_ge; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
6931 `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
6932 MATCH_MP_TAC REAL_LE_TRANS THEN
6933 EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2 -
6934 &2 * (&1 - u) * u * abs d * r pow 2` THEN
6936 [REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN
6937 REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
6938 MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
6939 REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH
6940 `(&1 - u) pow 2 + u pow 2 - ((&2 * (&1 - u)) * u) * d =
6941 (&1 + d) * (&1 - &2 * u + &2 * u pow 2) - d`] THEN
6942 MATCH_MP_TAC REAL_LE_TRANS THEN
6943 EXISTS_TAC `(&1 + abs d) * &1 / &2 - abs d` THEN CONJ_TAC THENL
6944 [REWRITE_TAC[REAL_ARITH `(&1 + d) * &1 / &2 - d = (&1 - d) / &2`] THEN
6945 MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SQRT_POW_2 THEN
6946 MP_TAC(ISPECL [`a:real^N`; `b:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN
6947 ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_POW2_ABS] THEN
6948 ASM_REWRITE_TAC[REAL_ARITH `r * r = &1 * r pow 2`] THEN
6949 ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC;
6950 MATCH_MP_TAC(REAL_ARITH `x <= y ==> x - a <= y - a`) THEN
6951 MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
6953 MATCH_MP_TAC(REAL_ARITH
6954 `&0 <= (u - &1 / &2) * (u - &1 / &2)
6955 ==> &1 / &2 <= &1 - &2 * u + &2 * u pow 2`) THEN
6956 REWRITE_TAC[REAL_LE_SQUARE]]];
6957 ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_LE_LADD; real_sub] THEN
6958 MATCH_MP_TAC(REAL_ARITH `abs(a) <= --x ==> x <= a`) THEN
6959 ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_LNEG; REAL_NEG_NEG] THEN
6960 REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; REAL_ABS_NUM] THEN
6961 REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
6962 REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
6963 ASM_REWRITE_TAC[real_abs; GSYM real_sub; REAL_SUB_LE; REAL_POS] THEN
6964 MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN
6965 REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN
6966 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
6967 ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);;
6969 (* ------------------------------------------------------------------------- *)
6970 (* Special case of orthogonality (could replace 2 by sqrt(2)). *)
6971 (* ------------------------------------------------------------------------- *)
6973 let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove
6975 r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b]
6976 ==> r / &2 <= norm(x)`,
6977 REPEAT GEN_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
6978 REWRITE_TAC[NORM_GE_SQUARE] THEN REWRITE_TAC[real_ge] THEN
6979 ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL
6980 [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6981 REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN
6982 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
6983 DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
6984 ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
6985 `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
6986 MATCH_MP_TAC REAL_LE_TRANS THEN
6987 EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN
6989 [REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN
6990 REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
6991 MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
6992 MATCH_MP_TAC(REAL_ARITH
6993 `&0 <= (u - &1 / &2) * (u - &1 / &2)
6994 ==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN
6995 REWRITE_TAC[REAL_LE_SQUARE];
6996 REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
6998 REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN
6999 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
7000 ASM_REWRITE_TAC[]]);;
7002 (* ------------------------------------------------------------------------- *)
7003 (* Accessibility of frontier points. *)
7004 (* ------------------------------------------------------------------------- *)
7006 let DENSE_ACCESSIBLE_FRONTIER_POINTS = prove
7007 (`!s:real^N->bool v.
7008 open s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
7010 IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
7011 pathstart g IN s /\ pathfinish g IN v`,
7012 REPEAT STRIP_TAC THEN
7013 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7014 DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
7015 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
7016 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `z:real^N`)) THEN
7017 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7018 X_GEN_TAC `r:real` THEN STRIP_TAC THEN
7019 SUBGOAL_THEN `(z:real^N) IN frontier s` MP_TAC THENL
7021 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
7022 REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN]] THEN
7023 REWRITE_TAC[closure; IN_UNION; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN
7024 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
7025 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_BALL]) THEN
7026 DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN
7027 ASM_CASES_TAC `s INTER ball(z:real^N,r) = {}` THENL
7028 [ASM_MESON_TAC[INFINITE; FINITE_EMPTY]; DISCH_THEN(K ALL_TAC)] THEN
7029 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7030 REWRITE_TAC[IN_INTER] THEN
7031 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
7032 SUBGOAL_THEN `~((y:real^N) IN frontier s)` ASSUME_TAC THENL
7033 [ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN; frontier]; ALL_TAC] THEN
7034 SUBGOAL_THEN `path_connected(ball(z:real^N,r))` MP_TAC THENL
7035 [ASM_SIMP_TAC[CONVEX_BALL; CONVEX_IMP_PATH_CONNECTED]; ALL_TAC] THEN
7036 REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
7037 DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
7038 ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN
7039 ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
7040 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
7042 `IMAGE drop {t | t IN interval[vec 0,vec 1] /\
7043 (g:real^1->real^N) t IN frontier s}`
7044 COMPACT_ATTAINS_INF) THEN
7045 REWRITE_TAC[EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IMP_CONJ] THEN
7046 REWRITE_TAC[IMP_IMP; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM IMAGE_o] THEN
7047 REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_ID] THEN
7050 [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
7051 [MATCH_MP_TAC BOUNDED_SUBSET THEN
7052 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
7053 REWRITE_TAC[BOUNDED_INTERVAL; SUBSET_RESTRICT];
7054 MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
7055 REWRITE_TAC[FRONTIER_CLOSED; CLOSED_INTERVAL; GSYM path] THEN
7056 ASM_MESON_TAC[arc]];
7057 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 1:real^1` THEN
7058 ASM_REWRITE_TAC[IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
7059 ASM_MESON_TAC[pathfinish; SUBSET]];
7060 DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
7061 EXISTS_TAC `subpath (vec 0) t (g:real^1->real^N)` THEN
7062 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
7063 MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
7064 [MATCH_MP_TAC ARC_SUBPATH_ARC THEN
7065 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
7066 ASM_MESON_TAC[pathstart];
7067 REWRITE_TAC[arc] THEN STRIP_TAC] THEN
7068 GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [GSYM pathstart] THEN
7069 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
7070 [ALL_TAC; RULE_ASSUM_TAC(SIMP_RULE[path_image]) THEN ASM SET_TAC[]] THEN
7071 MATCH_MP_TAC(SET_RULE
7072 `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
7073 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
7074 ==> IMAGE f (s DELETE a) SUBSET t`) THEN
7075 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN
7076 W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SUBPATH o lhand o lhand o
7078 ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN
7079 REWRITE_TAC[REWRITE_RULE[pathfinish] PATHFINISH_SUBPATH] THEN
7080 MATCH_MP_TAC(SET_RULE
7081 `IMAGE f (s DELETE a) DIFF t = {}
7082 ==> IMAGE f s DELETE f a SUBSET t`) THEN
7083 MATCH_MP_TAC(REWRITE_RULE[TAUT
7084 `p /\ q /\ ~r ==> ~s <=> p /\ q /\ s ==> r`]
7085 CONNECTED_INTER_FRONTIER) THEN
7086 REPEAT CONJ_TAC THENL
7087 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
7088 [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [arc]) THEN
7089 REWRITE_TAC[path] THEN MATCH_MP_TAC
7090 (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN
7091 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
7092 REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
7094 MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
7095 EXISTS_TAC `interval(vec 0:real^1,t)` THEN
7096 REWRITE_TAC[CONNECTED_INTERVAL; CLOSURE_INTERVAL] THEN
7097 REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN
7098 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
7100 ASM_REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
7101 REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC];
7102 REWRITE_TAC[SET_RULE
7103 `~(IMAGE f s INTER t = {}) <=> ?x. x IN s /\ f x IN t`] THEN
7104 EXISTS_TAC `vec 0:real^1` THEN
7105 REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; REAL_LE_REFL] THEN
7106 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
7107 ASM SET_TAC[pathstart];
7108 REWRITE_TAC[SET_RULE
7109 `IMAGE g i INTER s = {} <=> !x. x IN i ==> ~(g x IN s)`] THEN
7110 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; IN_DIFF] THEN
7111 X_GEN_TAC `z:real^1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
7112 REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1] THEN DISCH_TAC THEN
7113 DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
7114 ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
7115 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
7116 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
7117 ASM_REAL_ARITH_TAC]]);;
7119 let DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED = prove
7120 (`!s:real^N->bool v x.
7121 open s /\ connected s /\ x IN s /\
7122 open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
7124 IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
7125 pathstart g = x /\ pathfinish g IN v`,
7126 REPEAT STRIP_TAC THEN
7127 MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`]
7128 DENSE_ACCESSIBLE_FRONTIER_POINTS) THEN
7129 ASM_REWRITE_TAC[] THEN
7130 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
7131 SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL
7132 [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN
7133 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
7134 DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `pathstart g:real^N`]) THEN
7135 ASM_REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
7136 X_GEN_TAC `f:real^1->real^N` THEN STRIP_TAC THEN
7137 MP_TAC(ISPECL [`f ++ g:real^1->real^N`; `x:real^N`; `pathfinish g:real^N`]
7138 PATH_CONTAINS_ARC) THEN
7139 ASM_SIMP_TAC[PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN;
7140 PATHSTART_JOIN; PATHFINISH_JOIN] THEN
7141 FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
7142 GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
7143 ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN
7144 DISCH_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
7145 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
7146 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
7147 `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
7148 (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
7149 ==> IMAGE f (s DELETE a) SUBSET t`) THEN
7150 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
7151 CONJ_TAC THENL [REWRITE_TAC[GSYM path_image]; ASM_MESON_TAC[arc]] THEN
7152 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7154 ==> f SUBSET s /\ g DELETE a SUBSET s ==> h DELETE a SUBSET s`)) THEN
7155 ASM_REWRITE_TAC[] THEN
7156 RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish]) THEN
7157 REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
7159 let DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS = prove
7160 (`!s u v:real^N->bool.
7161 open s /\ connected s /\
7162 open_in (subtopology euclidean (frontier s)) u /\
7163 open_in (subtopology euclidean (frontier s)) v /\
7164 ~(u = {}) /\ ~(v = {}) /\ ~(u = v)
7166 pathstart g IN u /\ pathfinish g IN v /\
7167 IMAGE g (interval(vec 0,vec 1)) SUBSET s`,
7168 GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
7169 ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
7170 GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o RAND_CONV)
7171 [GSYM SUBSET_ANTISYM_EQ] THEN
7172 REWRITE_TAC[DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN
7173 MATCH_MP_TAC(MESON[]
7174 `(!u v. R u v ==> R v u) /\ (!u v. P u v ==> R u v)
7175 ==> !u v. P u v \/ P v u ==> R u v`) THEN
7177 [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
7178 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN
7179 STRIP_TAC THEN EXISTS_TAC `reversepath g:real^1->real^N` THEN
7180 ASM_SIMP_TAC[ARC_REVERSEPATH; PATHSTART_REVERSEPATH;
7181 PATHFINISH_REVERSEPATH] THEN
7182 REWRITE_TAC[reversepath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
7183 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
7184 (SET_RULE `IMAGE f i SUBSET t
7185 ==> IMAGE r i SUBSET i ==> IMAGE f (IMAGE r i) SUBSET t`)) THEN
7186 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
7189 REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
7190 ASM_REWRITE_TAC[FRONTIER_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THENL
7191 [CONV_TAC TAUT; STRIP_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})`] THEN
7192 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
7193 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7195 [`s:real^N->bool`; `v:real^N->bool`; `x:real^N`]
7196 DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
7197 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7198 X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
7200 [`s:real^N->bool`; `(u DELETE pathfinish g):real^N->bool`; `x:real^N`]
7201 DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
7202 ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN
7203 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
7204 X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
7205 MP_TAC(ISPECL [`(reversepath h ++ g):real^1->real^N`;
7206 `pathfinish h:real^N`; `pathfinish g:real^N`]
7207 PATH_CONTAINS_ARC) THEN
7208 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
7209 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
7210 PATH_REVERSEPATH; ARC_IMP_PATH; PATH_IMAGE_JOIN;
7211 PATH_IMAGE_REVERSEPATH] THEN
7212 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
7213 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7214 REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN
7215 MATCH_MP_TAC(SET_RULE
7216 `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
7217 t SUBSET s /\ IMAGE f s SUBSET u UNION IMAGE f t
7218 ==> IMAGE f (s DIFF t) SUBSET u`) THEN
7219 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN
7220 CONJ_TAC THENL [ASM_MESON_TAC[arc]; REWRITE_TAC[GSYM path_image]] THEN
7221 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7223 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN
7224 REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
7226 (* ------------------------------------------------------------------------- *)
7227 (* Some simple positive connection theorems. *)
7228 (* ------------------------------------------------------------------------- *)
7230 let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove
7231 (`!u s:real^N->bool.
7232 convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`,
7233 REPEAT STRIP_TAC THEN
7234 REWRITE_TAC[path_connected; IN_DIFF; IN_UNIV] THEN
7235 MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
7236 ASM_CASES_TAC `a:real^N = b` THENL
7237 [EXISTS_TAC `linepath(a:real^N,b)` THEN
7238 REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
7239 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[];
7241 ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
7242 SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL
7243 [ASM_MESON_TAC[MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN
7244 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
7245 GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN
7246 GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN
7247 GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN
7248 DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
7249 ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
7250 DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN
7251 REPEAT GEN_TAC THEN REWRITE_TAC[midpoint; VECTOR_MUL_LID] THEN
7252 REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
7253 ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN
7254 POP_ASSUM(K ALL_TAC) THEN
7255 REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7256 DISCH_THEN(K ALL_TAC) THEN
7257 SUBGOAL_THEN `segment[--basis 1:real^N,basis 1] SUBSET u` ASSUME_TAC THENL
7258 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
7261 SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL
7262 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7263 REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN
7264 CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC;
7266 SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\
7267 c IN u /\ ~(c$k = &0)`
7268 STRIP_ASSUME_TAC THENL
7269 [REWRITE_TAC[GSYM NOT_FORALL_THM; TAUT
7270 `a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN
7271 DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN
7272 REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
7273 MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN
7274 SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN
7275 REWRITE_TAC[SPAN_SING; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
7276 X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN
7277 SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
7278 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
7279 ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN
7282 SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL
7283 [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
7284 SUBGOAL_THEN `segment[vec 0:real^N,c] SUBSET u` ASSUME_TAC THENL
7285 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
7289 `?z:real^N. z IN segment[vec 0,c] /\
7290 (segment[--basis 1,z] UNION segment[z,basis 1]) INTER s = {}`
7291 STRIP_ASSUME_TAC THENL
7293 EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN
7294 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_LINEPATH;
7295 PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN
7296 REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN
7297 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7298 `(t UNION v) INTER s = {}
7299 ==> t SUBSET u /\ v SUBSET u
7300 ==> (t UNION v) SUBSET u DIFF s`)) THEN
7301 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
7302 CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]] THEN
7303 MATCH_MP_TAC(SET_RULE
7304 `~(s SUBSET {z | z IN s /\ ~P z}) ==> ?z. z IN s /\ P z`) THEN
7305 DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
7306 REWRITE_TAC[CARD_NOT_LE; SET_RULE
7307 `~((b UNION c) INTER s = {}) <=>
7308 ~(b INTER s = {}) \/ ~(c INTER s = {})`] THEN
7309 REWRITE_TAC[SET_RULE
7310 `{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN
7311 W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN
7312 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_LET_TRANS) THEN
7313 TRANS_TAC CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL
7314 [MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[real_INFINITE];
7315 MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
7316 ASM_SIMP_TAC[CARD_EQ_SEGMENT]] THEN
7317 REWRITE_TAC[MESON[SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN
7320 b IN u /\ ~(b IN s) /\ ~(b = vec 0) /\ b$k = &0
7321 ==> {z | z IN segment[vec 0,c] /\ ~(segment[z,b] INTER s = {})} <_c
7323 (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN
7324 REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_NEG_COMPONENT] THEN
7325 ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
7326 BASIS_COMPONENT] THEN
7327 REWRITE_TAC[REAL_NEG_0]) THEN
7328 REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN
7329 ASM_REWRITE_TAC[] THEN
7330 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; RIGHT_AND_EXISTS_THM] THEN
7331 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN
7332 MATCH_MP_TAC CARD_LE_RELATIONAL THEN
7333 MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN
7334 REWRITE_TAC[SEGMENT_SYM] THEN STRIP_TAC THEN
7335 ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN
7337 [`x1:real^N`; `b:real^N`; `x2:real^N`] INTER_SEGMENT) THEN
7338 REWRITE_TAC[NOT_IMP; SEGMENT_SYM] THEN
7339 CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[SEGMENT_SYM] THEN ASM SET_TAC[]] THEN
7340 ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN
7341 ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN
7342 SUBGOAL_THEN `(b:real^N) IN affine hull {vec 0,c}` MP_TAC THENL
7343 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7344 `b IN s ==> s SUBSET t ==> b IN t`)) THEN
7345 MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN
7346 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN
7347 CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN
7348 REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
7349 REWRITE_TAC[AFFINE_HULL_2_ALT; IN_ELIM_THM; IN_UNIV] THEN
7350 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_RZERO; NOT_EXISTS_THM] THEN
7351 X_GEN_TAC `r:real` THEN
7352 ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
7353 CONV_TAC(RAND_CONV SYM_CONV) THEN
7354 DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN
7355 ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ENTIRE]]);;
7357 let PATH_CONNECTED_COMPLEMENT_CARD_LT = prove
7358 (`!s. 2 <= dimindex(:N) /\ s <_c (:real)
7359 ==> path_connected((:real^N) DIFF s)`,
7360 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN
7361 ASM_REWRITE_TAC[CONVEX_UNIV; COLLINEAR_AFF_DIM; AFF_DIM_UNIV] THEN
7362 REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);;
7364 let PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
7365 (`!s t:real^N->bool.
7366 connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
7367 ~collinear s /\ t <_c (:real)
7368 ==> path_connected(s DIFF t)`,
7369 REPEAT STRIP_TAC THEN
7370 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IN_DIFF] THEN
7371 REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN
7372 MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN
7373 ASM_REWRITE_TAC[IN_DIFF] THEN
7374 REWRITE_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] THEN CONJ_TAC THENL
7375 [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
7377 `open_in (subtopology euclidean (affine hull s)) (u:real^N->bool)`
7378 MP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
7379 REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN
7380 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
7381 ASM_REWRITE_TAC[] THEN
7382 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
7383 MATCH_MP_TAC(SET_RULE `~(s SUBSET t) ==> ?x. x IN s /\ ~(x IN t)`) THEN
7384 DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
7385 REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
7386 ASM_REWRITE_TAC[] THEN
7387 TRANS_TAC CARD_LE_TRANS `ball(x:real^N,r) INTER affine hull s` THEN
7388 ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
7389 ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONVEX THEN
7390 EXISTS_TAC `x:real^N` THEN
7391 ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL;
7392 AFFINE_AFFINE_HULL; IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN
7393 SUBGOAL_THEN `~(s SUBSET {x:real^N})` MP_TAC THENL
7394 [ASM_MESON_TAC[COLLINEAR_SUBSET; COLLINEAR_SING]; ALL_TAC] THEN
7395 REWRITE_TAC[SUBSET; IN_SING; NOT_FORALL_THM; NOT_IMP] THEN
7396 DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
7397 EXISTS_TAC `x + r / &2 / norm(y - x) % (y - x):real^N` THEN
7398 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
7399 ASM_SIMP_TAC[HULL_INC; IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL] THEN
7400 REWRITE_TAC[IN_BALL; VECTOR_ARITH `x:real^N = x + y <=> y = vec 0`] THEN
7401 ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ;
7402 REAL_LT_IMP_NZ; NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN
7403 REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN
7404 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
7406 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7407 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
7408 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
7409 ASM_REWRITE_TAC[] THEN
7410 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
7411 EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN
7412 ASM_SIMP_TAC[IN_INTER; HULL_INC; CENTRE_IN_BALL] THEN CONJ_TAC THENL
7413 [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
7414 EXISTS_TAC `affine hull s:real^N->bool` THEN
7415 ASM_SIMP_TAC[ONCE_REWRITE_RULE[INTER_COMM]OPEN_IN_OPEN_INTER; OPEN_BALL];
7416 MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN
7417 MP_TAC(ISPECL [`ball(x:real^N,r) INTER affine hull s`; `t:real^N->bool`]
7418 PATH_CONNECTED_CONVEX_DIFF_CARD_LT) THEN
7419 ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL;
7420 AFFINE_AFFINE_HULL] THEN
7422 [REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
7423 W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_OPEN o
7424 lhand o rand o snd) THEN
7425 SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN
7426 ANTS_TAC THENL [ASM SET_TAC[CENTRE_IN_BALL]; ALL_TAC] THEN
7427 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN
7428 ASM_REWRITE_TAC[GSYM COLLINEAR_AFF_DIM];
7429 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
7430 DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
7431 ASM_REWRITE_TAC[IN_INTER; IN_DIFF] THEN
7432 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] PATH_COMPONENT_OF_SUBSET) THEN
7435 let CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
7436 (`!s t:real^N->bool.
7437 connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
7438 ~collinear s /\ t <_c (:real)
7439 ==> connected(s DIFF t)`,
7440 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
7441 MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
7442 ASM_REWRITE_TAC[]);;
7444 let PATH_CONNECTED_OPEN_DIFF_CARD_LT = prove
7445 (`!s t:real^N->bool.
7446 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
7447 ==> path_connected(s DIFF t)`,
7448 REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
7449 ASM_REWRITE_TAC[EMPTY_DIFF; PATH_CONNECTED_EMPTY] THEN
7450 MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
7451 ASM_REWRITE_TAC[COLLINEAR_AFF_DIM] THEN
7452 ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFF_DIM_OPEN] THEN
7453 ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
7456 let CONNECTED_OPEN_DIFF_CARD_LT = prove
7457 (`!s t:real^N->bool.
7458 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
7459 ==> connected(s DIFF t)`,
7460 SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;
7462 let PATH_CONNECTED_OPEN_DIFF_COUNTABLE = prove
7463 (`!s t:real^N->bool.
7464 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
7465 ==> path_connected(s DIFF t)`,
7466 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_CARD_LT THEN
7467 ASM_REWRITE_TAC[GSYM CARD_NOT_LE] THEN
7468 ASM_MESON_TAC[UNCOUNTABLE_REAL; CARD_LE_COUNTABLE]);;
7470 let CONNECTED_OPEN_DIFF_COUNTABLE = prove
7471 (`!s t:real^N->bool.
7472 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
7473 ==> connected(s DIFF t)`,
7474 SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_COUNTABLE; PATH_CONNECTED_IMP_CONNECTED]);;
7476 let PATH_CONNECTED_OPEN_DELETE = prove
7477 (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
7478 ==> path_connected(s DELETE a)`,
7479 REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
7480 MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
7481 ASM_REWRITE_TAC[COUNTABLE_SING]);;
7483 let CONNECTED_OPEN_DELETE = prove
7484 (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
7485 ==> connected(s DELETE a)`,
7486 SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; PATH_CONNECTED_IMP_CONNECTED]);;
7488 let PATH_CONNECTED_PUNCTURED_UNIVERSE = prove
7489 (`!a. 2 <= dimindex(:N) ==> path_connected((:real^N) DIFF {a})`,
7490 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
7491 ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; COUNTABLE_SING]);;
7493 let CONNECTED_PUNCTURED_UNIVERSE = prove
7494 (`!a. 2 <= dimindex(:N) ==> connected((:real^N) DIFF {a})`,
7495 SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; PATH_CONNECTED_IMP_CONNECTED]);;
7497 let PATH_CONNECTED_PUNCTURED_BALL = prove
7498 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(ball(a,r) DELETE a)`,
7499 SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;
7501 let CONNECTED_PUNCTURED_BALL = prove
7502 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(ball(a,r) DELETE a)`,
7503 SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;
7505 let PATH_CONNECTED_SPHERE = prove
7506 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(sphere(a,r))`,
7508 REWRITE_TAC[sphere; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN
7509 GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN
7510 REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN
7511 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
7512 (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
7514 [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN
7515 REWRITE_TAC[EMPTY_GSPEC; PATH_CONNECTED_EMPTY];
7516 ASM_REWRITE_TAC[NORM_EQ_0; SING_GSPEC; PATH_CONNECTED_SING];
7518 `{x:real^N | norm x = r} =
7519 IMAGE (\x. r / norm x % x) ((:real^N) DIFF {vec 0})`
7521 [MATCH_MP_TAC SUBSET_ANTISYM THEN
7522 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
7523 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF; IN_SING; IN_UNIV] THEN
7524 ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL;
7525 NORM_EQ_0; REAL_ARITH `&0 < r ==> abs r = r`] THEN
7526 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
7527 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN
7528 ASM_MESON_TAC[NORM_0; REAL_LT_IMP_NZ];
7529 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
7530 ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE] THEN
7531 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
7532 REWRITE_TAC[o_DEF; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
7533 X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN
7534 DISCH_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN
7535 MATCH_MP_TAC CONTINUOUS_CMUL THEN
7536 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN
7537 ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
7538 REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]]);;
7540 let CONNECTED_SPHERE = prove
7541 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(sphere(a,r))`,
7542 SIMP_TAC[PATH_CONNECTED_SPHERE; PATH_CONNECTED_IMP_CONNECTED]);;
7544 let CONNECTED_SPHERE_EQ = prove
7545 (`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
7547 (`!a:real^1 r. &0 < r
7548 ==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`,
7549 MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
7550 COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
7551 REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN
7552 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
7553 `~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN
7554 REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN
7555 REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in
7556 REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
7557 ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN
7558 ASM_CASES_TAC `r = &0` THEN
7559 ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN
7560 SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL
7561 [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
7562 EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN
7563 DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN
7564 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
7565 SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
7566 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN
7567 DISCH_TAC THEN FIRST_ASSUM (fun th ->
7568 REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN
7569 REWRITE_TAC[SET_RULE
7570 `~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN
7571 REWRITE_TAC[IN_SPHERE] THEN
7572 FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN
7573 ASM_REWRITE_TAC[]);;
7575 let PATH_CONNECTED_SPHERE_EQ = prove
7576 (`!a:real^N r. path_connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
7577 REPEAT GEN_TAC THEN EQ_TAC THENL
7578 [REWRITE_TAC[GSYM CONNECTED_SPHERE_EQ; PATH_CONNECTED_IMP_CONNECTED];
7579 STRIP_TAC THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]] THEN
7580 ASM_CASES_TAC `r < &0` THEN
7581 ASM_SIMP_TAC[SPHERE_EMPTY; PATH_CONNECTED_EMPTY] THEN
7582 ASM_CASES_TAC `r = &0` THEN
7583 ASM_SIMP_TAC[SPHERE_SING; PATH_CONNECTED_SING] THEN
7584 ASM_REAL_ARITH_TAC);;
7586 let FINITE_SPHERE = prove
7587 (`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`,
7588 REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN
7589 ASM_REWRITE_TAC[] THENL
7590 [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN
7591 FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP
7592 (GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
7594 ASM_SIMP_TAC[CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`;
7595 DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN
7596 REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=>
7597 (!a b. a IN s /\ b IN s ==> a = b)`] THEN
7598 SIMP_TAC[IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
7599 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
7600 REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
7601 MP_TAC(ISPECL [`a:real^N`; `r:real`] VECTOR_CHOOSE_DIST) THEN
7602 ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
7603 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7604 DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN
7605 FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN
7606 REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);;
7608 let LIMIT_POINT_OF_SPHERE = prove
7609 (`!a r x:real^N. x limit_point_of sphere(a,r) <=>
7610 &0 < r /\ 2 <= dimindex(:N) /\ x IN sphere(a,r)`,
7611 REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL
7612 [ASM_SIMP_TAC[LIMIT_POINT_FINITE]; ALL_TAC] THEN
7613 FIRST_ASSUM(MP_TAC o REWRITE_RULE[FINITE_SPHERE]) THEN
7614 REWRITE_TAC[DE_MORGAN_THM] THEN
7615 STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH; REAL_NOT_LT] THEN
7616 ASM_SIMP_TAC[GSYM REAL_NOT_LE; DIMINDEX_GE_1;
7617 ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
7618 EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[CLOSED_LIMPT] CLOSED_SPHERE] THEN
7619 DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN
7620 ASM_SIMP_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_GE_1;
7621 ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
7622 ASM_MESON_TAC[FINITE_SING]);;
7624 let CARD_EQ_SPHERE = prove
7625 (`!a:real^N r. 2 <= dimindex(:N) /\ &0 < r ==> sphere(a,r) =_c (:real)`,
7626 SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SPHERE] THEN
7627 REPEAT STRIP_TAC THEN
7628 FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN
7629 ASM_REWRITE_TAC[FINITE_SING; FINITE_SPHERE; REAL_NOT_LE; DE_MORGAN_THM] THEN
7632 let PATH_CONNECTED_ANNULUS = prove
7635 ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
7638 ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
7641 ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
7644 ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
7647 2 <= dimindex(:N) /\ path_connected {lift r | &0 <= r /\ P r}
7648 ==> path_connected {x | P(norm(x - a))}`,
7649 REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
7650 REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN
7652 `{x:real^N | P(norm(x))} =
7653 IMAGE (\z. drop(fstcart z) % sndcart z)
7654 {pastecart x y | x IN {lift x | &0 <= x /\ P x} /\
7655 y IN {y | norm y = &1}}`
7657 [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
7658 REWRITE_TAC[EXISTS_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
7659 X_GEN_TAC `z:real^N` THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN
7660 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
7661 REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IMAGE_ID] THEN
7662 REWRITE_TAC[IN_ELIM_THM] THEN
7663 EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; REAL_MUL_RID] THEN
7664 ASM_REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL
7665 [MAP_EVERY EXISTS_TAC [`&0`; `basis 1:real^N`] THEN
7666 ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO] THEN
7667 ASM_MESON_TAC[NORM_0; REAL_ABS_NUM; REAL_LE_REFL];
7668 MAP_EVERY EXISTS_TAC [`norm(z:real^N)`; `inv(norm z) % z:real^N`] THEN
7669 ASM_SIMP_TAC[REAL_ABS_NORM; NORM_MUL; VECTOR_MUL_ASSOC; VECTOR_MUL_LID;
7670 NORM_POS_LE; REAL_ABS_INV; REAL_MUL_RINV; REAL_MUL_LINV; NORM_EQ_0]];
7671 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
7672 [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
7673 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
7674 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
7675 REWRITE_TAC[GSYM PCROSS] THEN
7676 MATCH_MP_TAC PATH_CONNECTED_PCROSS THEN ASM_REWRITE_TAC[] THEN
7677 ONCE_REWRITE_TAC[NORM_ARITH `norm y = norm(y - vec 0:real^N)`] THEN
7678 ONCE_REWRITE_TAC[NORM_SUB] THEN
7679 REWRITE_TAC[REWRITE_RULE[dist] (GSYM sphere)] THEN
7680 ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]]]) in
7681 REPEAT STRIP_TAC THEN
7682 MP_TAC(ISPEC `a:real^N` lemma) THEN
7683 DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
7684 MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
7685 MATCH_MP_TAC IS_INTERVAL_CONVEX THEN
7686 REWRITE_TAC[is_interval] THEN
7687 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
7688 REWRITE_TAC[IN_IMAGE_LIFT_DROP; FORALL_1; DIMINDEX_1] THEN
7689 REWRITE_TAC[IN_ELIM_THM; GSYM drop] THEN REAL_ARITH_TAC);;
7691 let CONNECTED_ANNULUS = prove
7694 ==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
7697 ==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
7700 ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
7703 ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
7704 REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
7705 ASM_SIMP_TAC[PATH_CONNECTED_ANNULUS]);;
7707 let PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
7708 (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
7709 ==> path_connected((:real^N) DIFF s)`,
7710 REPEAT STRIP_TAC THEN
7711 ASM_CASES_TAC `s:real^N->bool = {}` THEN
7712 ASM_SIMP_TAC[DIFF_EMPTY; CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV] THEN
7713 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7714 DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
7715 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
7716 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
7717 REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
7718 SUBGOAL_THEN `~(x:real^N = a) /\ ~(y = a)` STRIP_ASSUME_TAC THENL
7719 [ASM_MESON_TAC[]; ALL_TAC] THEN
7720 SUBGOAL_THEN `bounded((x:real^N) INSERT y INSERT s)` MP_TAC THENL
7721 [ASM_REWRITE_TAC[BOUNDED_INSERT]; ALL_TAC] THEN
7722 DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
7723 REWRITE_TAC[INSERT_SUBSET] THEN
7724 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
7725 MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
7726 ABBREV_TAC `C = (B / norm(x - a:real^N))` THEN
7727 EXISTS_TAC `a + C % (x - a):real^N` THEN CONJ_TAC THENL
7728 [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
7729 REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
7730 REWRITE_TAC[VECTOR_ARITH
7731 `(&1 - u) % x + u % (a + B % (x - a)):real^N =
7732 a + (&1 + (B - &1) * u) % (x - a)`] THEN
7733 X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
7734 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
7735 DISCH_THEN(MP_TAC o SPECL
7736 [`a:real^N`; `a + (&1 + (C - &1) * u) % (x - a):real^N`;
7737 `&1 / (&1 + (C - &1) * u)`]) THEN
7738 SUBGOAL_THEN `&1 <= &1 + (C - &1) * u` ASSUME_TAC THENL
7739 [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
7740 ASM_REWRITE_TAC[REAL_SUB_LE] THEN
7742 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
7743 RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
7744 ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(x - a) = norm(a - x)`];
7745 FIRST_ASSUM(ASSUME_TAC o MATCH_MP
7746 (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
7747 ASM_REWRITE_TAC[NOT_IMP] THEN
7748 ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
7750 ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
7751 REAL_LT_IMP_NZ] THEN
7752 UNDISCH_TAC `~((x:real^N) IN s)` THEN
7753 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7756 MATCH_MP_TAC PATH_COMPONENT_SYM THEN
7757 MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
7758 ABBREV_TAC `D = (B / norm(y - a:real^N))` THEN
7759 EXISTS_TAC `a + D % (y - a):real^N` THEN CONJ_TAC THENL
7760 [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
7761 REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
7762 REWRITE_TAC[VECTOR_ARITH
7763 `(&1 - u) % y + u % (a + B % (y - a)):real^N =
7764 a + (&1 + (B - &1) * u) % (y - a)`] THEN
7765 X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
7766 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
7767 DISCH_THEN(MP_TAC o SPECL
7768 [`a:real^N`; `a + (&1 + (D - &1) * u) % (y - a):real^N`;
7769 `&1 / (&1 + (D - &1) * u)`]) THEN
7770 SUBGOAL_THEN `&1 <= &1 + (D - &1) * u` ASSUME_TAC THENL
7771 [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
7772 ASM_REWRITE_TAC[REAL_SUB_LE] THEN
7774 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
7775 RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
7776 ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(y - a) = norm(a - y)`];
7777 FIRST_ASSUM(ASSUME_TAC o MATCH_MP
7778 (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
7779 ASM_REWRITE_TAC[NOT_IMP] THEN
7780 ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
7782 ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
7783 REAL_LT_IMP_NZ] THEN
7784 UNDISCH_TAC `~((y:real^N) IN s)` THEN
7785 MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7788 MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN
7789 EXISTS_TAC `{x:real^N | norm(x - a) = B}` THEN CONJ_TAC THENL
7790 [UNDISCH_TAC `s SUBSET ball(a:real^N,B)` THEN
7791 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_BALL; dist] THEN
7792 MESON_TAC[NORM_SUB; REAL_LT_REFL];
7793 MP_TAC(ISPECL [`a:real^N`; `B:real`] PATH_CONNECTED_SPHERE) THEN
7794 REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] THEN
7795 ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
7796 DISCH_THEN MATCH_MP_TAC THEN
7797 REWRITE_TAC[IN_ELIM_THM; VECTOR_ADD_SUB; NORM_MUL] THEN
7798 MAP_EVERY EXPAND_TAC ["C"; "D"] THEN
7799 REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN
7800 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
7801 ASM_REAL_ARITH_TAC]);;
7803 let CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
7804 (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
7805 ==> connected((:real^N) DIFF s)`,
7806 SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED;
7807 PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX]);;
7809 let CONNECTED_DIFF_BALL = prove
7811 2 <= dimindex(:N) /\ connected s /\ cball(a,r) SUBSET s
7812 ==> connected(s DIFF ball(a,r))`,
7813 REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DIFF_OPEN_FROM_CLOSED THEN
7814 EXISTS_TAC `cball(a:real^N,r)` THEN
7815 ASM_REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BALL_SUBSET_CBALL] THEN
7816 REWRITE_TAC[CBALL_DIFF_BALL] THEN
7817 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
7818 ASM_SIMP_TAC[CONNECTED_SPHERE]);;
7820 let PATH_CONNECTED_DIFF_BALL = prove
7822 2 <= dimindex(:N) /\ path_connected s /\ cball(a,r) SUBSET s
7823 ==> path_connected(s DIFF ball(a,r))`,
7824 REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
7825 ASM_SIMP_TAC[DIFF_EMPTY] THEN
7826 RULE_ASSUM_TAC(REWRITE_RULE[BALL_EQ_EMPTY; REAL_NOT_LE]) THEN
7827 REWRITE_TAC[path_connected] THEN
7828 FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
7829 ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN DISCH_TAC THEN
7830 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
7831 REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
7832 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
7833 DISCH_THEN(fun th ->
7834 MP_TAC(SPECL [`x:real^N`; `a:real^N`] th) THEN
7835 MP_TAC(SPECL [`y:real^N`; `a:real^N`] th)) THEN
7836 ASM_REWRITE_TAC[] THEN
7837 DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN
7838 DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN
7839 MP_TAC(ISPECL [`g2:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
7840 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
7841 MP_TAC(ISPECL [`g1:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
7842 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
7843 ASM_SIMP_TAC[CENTRE_IN_BALL; IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
7844 ASM_SIMP_TAC[FRONTIER_COMPLEMENT; INTERIOR_COMPLEMENT; CLOSURE_BALL] THEN
7845 ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE] THEN
7846 X_GEN_TAC `h1:real^1->real^N` THEN STRIP_TAC THEN
7847 X_GEN_TAC `h2:real^1->real^N` THEN STRIP_TAC THEN
7848 MP_TAC(ISPECL [`a:real^N`; `r:real`] PATH_CONNECTED_SPHERE) THEN
7849 ASM_REWRITE_TAC[path_connected] THEN
7850 DISCH_THEN(MP_TAC o SPECL
7851 [`pathfinish h1:real^N`; `pathfinish h2:real^N`]) THEN
7852 ASM_SIMP_TAC[IN_SPHERE] THEN
7853 DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN
7854 EXISTS_TAC `h1 ++ h ++ reversepath h2:real^1->real^N` THEN
7855 ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH;
7856 PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH;
7857 PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
7858 REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL
7860 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7862 UNDISCH_TAC `cball(a:real^N,r) SUBSET s` THEN
7863 SIMP_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_BALL; IN_DIFF] THEN
7864 MESON_TAC[REAL_LE_REFL; REAL_LT_REFL];
7866 MATCH_MP_TAC(SET_RULE
7867 `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN
7868 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
7869 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7870 `s DELETE a SUBSET (UNIV DIFF t) ==> ~(a IN u) /\ u SUBSET t
7871 ==> s INTER u = {}`)) THEN
7872 ASM_REWRITE_TAC[BALL_SUBSET_CBALL; IN_BALL; REAL_LT_REFL]);;
7874 let CONNECTED_OPEN_DIFF_CBALL = prove
7876 2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s
7877 ==> connected(s DIFF cball(a,r))`,
7878 REPEAT STRIP_TAC THEN
7879 ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN
7880 RULE_ASSUM_TAC(REWRITE_RULE[CBALL_EQ_EMPTY; REAL_NOT_LT]) THEN
7881 SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r') SUBSET s`
7882 STRIP_ASSUME_TAC THENL
7883 [ASM_CASES_TAC `s = (:real^N)` THENL
7884 [EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN REAL_ARITH_TAC;
7886 MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`]
7887 SETDIST_POS_LE) THEN
7888 REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN
7889 ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED;
7890 COMPACT_CBALL; CBALL_EQ_EMPTY] THEN
7891 ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN
7892 ASM_SIMP_TAC[SET_RULE `b INTER (UNIV DIFF s) = {} <=> b SUBSET s`;
7893 REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN
7895 EXISTS_TAC `r + setdist(cball(a,r),(:real^N) DIFF s) / &2` THEN
7896 ASM_REWRITE_TAC[REAL_LT_ADDR; REAL_HALF; SUBSET; IN_CBALL] THEN
7897 X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL
7898 [ASM_MESON_TAC[SUBSET; DIST_REFL; IN_CBALL]; ALL_TAC] THEN
7899 ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN
7900 MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`;
7901 `a + r / dist(a,x) % (x - a):real^N`; `x:real^N`]
7902 SETDIST_LE_DIST) THEN
7903 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN
7904 REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
7905 ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; ONCE_REWRITE_RULE[DIST_SYM] dist;
7906 REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
7907 ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN
7908 REWRITE_TAC[NORM_MUL; VECTOR_ARITH
7909 `x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN
7910 ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
7911 REWRITE_TAC[GSYM REAL_ABS_MUL] THEN
7912 REWRITE_TAC[REAL_ABS_NORM; REAL_SUB_RDISTRIB] THEN
7913 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
7914 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN
7915 ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
7917 SUBGOAL_THEN `s DIFF cball(a:real^N,r) =
7918 s DIFF ball(a,r') UNION
7919 {x | r < norm(x - a) /\ norm(x - a) <= r'}`
7921 [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
7922 REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
7923 `b' SUBSET c' /\ c' SUBSET s /\ c SUBSET b'
7924 ==> s DIFF c = (s DIFF b') UNION {x | ~(x IN c) /\ x IN c'}`) THEN
7925 ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN
7926 REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC;
7927 MATCH_MP_TAC CONNECTED_UNION THEN
7928 ASM_SIMP_TAC[CONNECTED_ANNULUS; PATH_CONNECTED_DIFF_BALL;
7929 PATH_CONNECTED_IMP_CONNECTED; CONNECTED_OPEN_PATH_CONNECTED] THEN
7930 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
7931 REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
7932 `c' SUBSET s /\ (?x. x IN c' /\ ~(x IN b') /\ ~(x IN c))
7933 ==> ~((s DIFF b') INTER {x | ~(x IN c) /\ x IN c'} = {})`) THEN
7934 ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN
7935 REWRITE_TAC[IN_BALL; IN_CBALL] THEN
7936 REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
7937 SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
7938 ASM_REAL_ARITH_TAC]]);;
7940 (* ------------------------------------------------------------------------- *)
7941 (* Existence of unbounded components. *)
7942 (* ------------------------------------------------------------------------- *)
7944 let COBOUNDED_UNBOUNDED_COMPONENT = prove
7945 (`!s. bounded((:real^N) DIFF s)
7946 ==> ?x. x IN s /\ ~bounded(connected_component s x)`,
7947 REPEAT STRIP_TAC THEN
7948 FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
7949 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
7950 EXISTS_TAC `B % basis 1:real^N` THEN CONJ_TAC THENL
7951 [FIRST_X_ASSUM(MP_TAC o SPEC `B % basis 1:real^N` o
7952 GEN_REWRITE_RULE I [SUBSET]) THEN
7953 REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0] THEN
7954 SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
7955 ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> ~(abs B * &1 < B)`];
7956 MP_TAC(ISPECL [`basis 1:real^N`; `B:real`] BOUNDED_HALFSPACE_GE) THEN
7957 SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; CONTRAPOS_THM] THEN
7958 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
7959 MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7960 SIMP_TAC[CONVEX_HALFSPACE_GE; CONVEX_CONNECTED] THEN
7961 ASM_SIMP_TAC[IN_ELIM_THM; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_GE_1;
7962 LE_REFL; real_ge; REAL_MUL_RID; REAL_LE_REFL] THEN
7963 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7964 `UNIV DIFF s SUBSET b ==> (!x. x IN h ==> ~(x IN b)) ==> h SUBSET s`)) THEN
7965 SIMP_TAC[IN_ELIM_THM; DOT_BASIS; IN_BALL_0; DIMINDEX_GE_1; LE_REFL] THEN
7966 GEN_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
7967 MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> b <= x ==> b <= n`) THEN
7968 SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_GE_1; LE_REFL]]);;
7970 let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT = prove
7972 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\
7973 ~bounded(connected_component s x) /\
7974 ~bounded(connected_component s y)
7975 ==> connected_component s x = connected_component s y`,
7976 REPEAT STRIP_TAC THEN
7977 FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
7978 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
7979 MP_TAC(ISPEC `ball(vec 0:real^N,B)` CONNECTED_COMPLEMENT_BOUNDED_CONVEX) THEN
7980 ASM_REWRITE_TAC[BOUNDED_BALL; CONVEX_BALL] THEN DISCH_TAC THEN
7982 (MP_TAC o SPEC `B:real` o REWRITE_RULE[bounded; NOT_EXISTS_THM] o ASSUME)
7983 [`~bounded(connected_component s (y:real^N))`;
7984 `~bounded(connected_component s (x:real^N))`] THEN
7985 REWRITE_TAC[NOT_FORALL_THM; IN; NOT_IMP] THEN
7986 DISCH_THEN(X_CHOOSE_THEN `x':real^N` STRIP_ASSUME_TAC) THEN
7987 DISCH_THEN(X_CHOOSE_THEN `y':real^N` STRIP_ASSUME_TAC) THEN
7988 MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
7989 SUBGOAL_THEN `connected_component s (x':real^N) (y':real^N)` ASSUME_TAC THENL
7990 [REWRITE_TAC[connected_component] THEN
7991 EXISTS_TAC `(:real^N) DIFF ball (vec 0,B)` THEN ASM_REWRITE_TAC[] THEN
7992 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN
7993 REWRITE_TAC[IN_BALL_0] THEN ASM_MESON_TAC[REAL_LT_IMP_LE];
7994 ASM_MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]]);;
7996 let COBOUNDED_UNBOUNDED_COMPONENTS = prove
7997 (`!s. bounded ((:real^N) DIFF s) ==> ?c. c IN components s /\ ~bounded c`,
7998 REWRITE_TAC[components; EXISTS_IN_GSPEC; COBOUNDED_UNBOUNDED_COMPONENT]);;
8000 let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS = prove
8002 2 <= dimindex(:N) /\
8003 bounded ((:real^N) DIFF s) /\
8004 c IN components s /\ ~bounded c /\
8005 c' IN components s /\ ~bounded c'
8007 REWRITE_TAC[components; IN_ELIM_THM] THEN
8008 MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT]);;
8010 let COBOUNDED_HAS_BOUNDED_COMPONENT = prove
8011 (`!s. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~connected s
8012 ==> ?c. c IN components s /\ bounded c`,
8013 REPEAT STRIP_TAC THEN
8015 `?c c':real^N->bool. c IN components s /\ c' IN components s /\ ~(c = c')`
8016 STRIP_ASSUME_TAC THENL
8017 [MATCH_MP_TAC(SET_RULE
8018 `~(s = {}) /\ ~(?a. s = {a}) ==> ?x y. x IN s /\ y IN s /\ ~(x = y)`) THEN
8019 ASM_REWRITE_TAC[COMPONENTS_EQ_SING_EXISTS; COMPONENTS_EQ_EMPTY] THEN
8020 ASM_MESON_TAC[DIFF_EMPTY; NOT_BOUNDED_UNIV];
8021 ASM_MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS]]);;
8023 (* ------------------------------------------------------------------------- *)
8024 (* Self-homeomorphisms shuffling points about in various ways. *)
8025 (* ------------------------------------------------------------------------- *)
8027 let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove
8029 open_in (subtopology euclidean (affine hull s)) s /\
8030 s SUBSET t /\ t SUBSET affine hull s /\
8031 connected s /\ a IN s /\ b IN s
8032 ==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\
8033 {x | ~(f x = x /\ g x = x)} SUBSET s /\
8034 bounded {x | ~(f x = x /\ g x = x)}`,
8037 affine t /\ a IN t /\ u IN ball(a,r) INTER t
8038 ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
8040 f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`,
8041 REPEAT STRIP_TAC THEN
8042 DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
8043 [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN
8044 EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN
8045 REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
8046 [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
8047 ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE];
8048 ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist;
8049 REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN
8050 REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN
8051 REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN
8053 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
8054 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN
8055 SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
8056 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
8057 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN
8058 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
8059 MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
8060 SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB];
8063 [MATCH_MP_TAC(SET_RULE
8064 `(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y)
8065 ==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN
8066 ONCE_REWRITE_TAC[VECTOR_ARITH
8067 `(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`];
8069 REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN
8070 REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN
8071 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID;
8072 VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
8073 VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=>
8074 (n - m) % u:real^N = x - y`] THEN
8075 REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL
8077 REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN
8078 ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN
8079 ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN
8080 ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO;
8081 VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN
8082 STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN
8083 ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
8084 DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
8085 `r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN
8086 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN
8087 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN
8088 ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ;
8089 REAL_ARITH `&0 < r ==> &0 < abs r`] THEN
8090 ASM_REAL_ARITH_TAC] THEN
8092 ASM_CASES_TAC `subspace(t:real^N->bool)` THENL
8093 [ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN
8094 ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN
8095 REPEAT STRIP_TAC THENL
8096 [MATCH_MP_TAC(NORM_ARITH
8097 `norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN
8098 ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH
8099 `(a * u + x) / r:real = a * u / r + x / r`] THEN
8100 MATCH_MP_TAC(REAL_ARITH
8101 `x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN
8102 ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN
8103 CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8104 MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
8105 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE];
8108 [`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`;
8109 `vec 0:real^1`; `vec 1:real^1`; `&0`; `1`]
8110 IVT_DECREASING_COMPONENT_1) THEN
8111 REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN
8112 REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN
8113 REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN
8114 REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN
8115 ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN
8117 [REPEAT STRIP_TAC THEN
8118 REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN
8119 REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
8120 REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
8121 REWRITE_TAC[CONTINUOUS_CONST]) THEN
8122 SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN
8123 MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
8124 MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
8125 MATCH_MP_TAC CONTINUOUS_MUL THEN
8126 REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
8128 ASM_SIMP_TAC[DROP_VEC; REAL_FIELD
8129 `&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN
8130 DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN
8131 EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN
8132 CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
8133 ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
8134 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
8135 ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in
8137 (`!a t u v:real^N r.
8138 affine t /\ a IN t /\
8139 u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
8140 ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
8141 (f,g) /\ f(u) = v /\
8142 !x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`,
8144 DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
8145 [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY];
8146 REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
8148 MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN
8149 ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
8150 FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN
8151 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8152 MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
8154 MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
8156 EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN
8157 EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN
8158 REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
8159 [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM];
8160 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL
8161 [MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN
8162 ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[];
8163 MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
8166 (`!a t u v:real^N r s.
8167 affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\
8168 u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
8169 ==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\
8170 {x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`,
8171 REPEAT STRIP_TAC THEN
8172 MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`;
8173 `r:real`] lemma2) THEN
8174 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8175 MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
8177 EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN
8178 EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN
8179 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
8180 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
8181 REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN
8183 SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\
8184 (!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))`
8185 STRIP_ASSUME_TAC THENL
8186 [REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN
8187 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
8188 REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN
8189 TRY(X_GEN_TAC `x:real^N` THEN
8190 ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN
8191 MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
8192 REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN
8194 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
8195 EXISTS_TAC `(cball(a,r) INTER t) UNION
8196 ((t:real^N->bool) DIFF ball(a,r))` THEN
8199 MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
8200 ASM SET_TAC[]]) THEN
8201 MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
8202 ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID;
8203 GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN
8204 MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
8205 MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN
8207 REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=>
8208 p /\ q /\ r /\ s ==> t ==> u`] THEN
8209 REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
8210 FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
8211 ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN
8212 MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN
8213 REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL
8214 [X_GEN_TAC `b:real^N` THEN
8215 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
8216 ASM_REWRITE_TAC[] THEN
8217 GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
8218 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN
8219 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN
8220 REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8221 ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN
8222 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
8223 MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN
8224 MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[])
8225 [`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN
8226 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
8227 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8228 MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
8230 MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
8232 EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN
8233 EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN
8234 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
8235 [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
8236 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8237 MATCH_MP_TAC BOUNDED_SUBSET THEN
8238 EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION
8239 {x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN
8240 ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[];
8242 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
8243 DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
8244 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8245 EXISTS_TAC `s INTER ball(a:real^N,r)` THEN
8246 ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
8247 X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
8249 [`a:real^N`; `affine hull s:real^N->bool`;
8250 `a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`]
8252 ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN
8253 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8254 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
8255 ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);;
8257 let HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN = prove
8258 (`!s t x (y:A->real^N) k.
8259 &2 <= aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s /\
8260 s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
8261 FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
8262 pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
8263 ==> ?f g. homeomorphism (t,t) (f,g) /\
8264 (!i. i IN k ==> f(x i) = y i) /\
8265 {x | ~(f x = x /\ g x = x)} SUBSET s /\
8266 bounded {x | ~(f x = x /\ g x = x)}`,
8268 ASM_CASES_TAC `FINITE(k:A->bool)` THEN ASM_REWRITE_TAC[] THEN
8269 SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN POP_ASSUM MP_TAC THEN
8270 SPEC_TAC(`k:A->bool`,`k:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
8272 [GEN_TAC THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
8273 REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
8274 REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY];
8276 MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN STRIP_TAC THEN
8277 X_GEN_TAC `s:real^N->bool` THEN
8278 REWRITE_TAC[PAIRWISE_INSERT; FORALL_IN_INSERT] THEN STRIP_TAC THEN
8279 FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
8280 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8281 MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
8282 STRIP_TAC THEN MP_TAC(ISPECL
8283 [`s DIFF IMAGE (y:A->real^N) k`; `t:real^N->bool`;
8284 `(f:real^N->real^N) ((x:A->real^N) i)`; `(y:A->real^N) i`]
8285 HOMEOMORPHISM_MOVING_POINT_EXISTS) THEN
8287 `affine hull (s DIFF (IMAGE (y:A->real^N) k)) = affine hull s`
8289 [MATCH_MP_TAC AFFINE_HULL_OPEN_IN THEN CONJ_TAC THENL
8290 [TRANS_TAC OPEN_IN_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
8291 MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
8292 MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN
8293 ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[];
8295 REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
8296 DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
8297 FINITE_SUBSET)) THEN
8298 ASM_SIMP_TAC[FINITE_IMAGE; CONNECTED_FINITE_IFF_SING] THEN
8299 UNDISCH_TAC `&2 <= aff_dim(s:real^N->bool)` THEN
8300 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8301 REWRITE_TAC[] THEN STRIP_TAC THEN
8302 ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_SING] THEN
8303 CONV_TAC INT_REDUCE_CONV];
8304 ASM_REWRITE_TAC[]] THEN
8306 [REPEAT CONJ_TAC THENL
8307 [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN
8308 MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
8309 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
8310 MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[];
8312 MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
8313 ASM_REWRITE_TAC[COLLINEAR_AFF_DIM;
8314 INT_ARITH `~(s:int <= &1) <=> &2 <= s`] THEN
8315 MATCH_MP_TAC CARD_LT_FINITE_INFINITE THEN
8316 ASM_SIMP_TAC[FINITE_IMAGE; real_INFINITE];
8317 ALL_TAC; ALL_TAC] THEN
8318 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[IN_DIFF] THEN
8319 (CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF]]) THEN
8320 SIMP_TAC[SET_RULE `~(y IN IMAGE f s) <=> !x. x IN s ==> ~(f x = y)`] THEN
8322 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8323 MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
8324 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
8325 [`(h:real^N->real^N) o (f:real^N->real^N)`;
8326 `(g:real^N->real^N) o (k:real^N->real^N)`] THEN
8327 CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
8328 ASM_SIMP_TAC[o_THM] THEN
8329 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
8330 MATCH_MP_TAC BOUNDED_SUBSET THEN
8331 EXISTS_TAC `{x | ~(f x = x /\ g x = x)} UNION
8332 {x:real^N | ~(h x = x /\ k x = x)}` THEN
8333 ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]]);;
8335 let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove
8336 (`!s t x (y:A->real^N) k.
8337 2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\
8338 FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
8339 pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
8340 ==> ?f g. homeomorphism (t,t) (f,g) /\
8341 (!i. i IN k ==> f(x i) = y i) /\
8342 {x | ~(f x = x /\ g x = x)} SUBSET s /\
8343 bounded {x | ~(f x = x /\ g x = x)}`,
8344 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
8345 [STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
8346 REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
8347 REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY] THEN ASM SET_TAC[];
8349 MATCH_MP_TAC HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN THEN
8350 ASM_REWRITE_TAC[] THEN
8351 ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
8352 SUBGOAL_THEN `affine hull s = (:real^N)` SUBST1_TAC THENL
8353 [MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM SET_TAC[];
8354 ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFF_DIM_UNIV] THEN
8355 ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBSET_UNIV]]);;
8357 let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove
8358 (`!u s t k:real^N->bool.
8359 open u /\ open s /\ connected s /\ ~(u = {}) /\
8360 FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
8361 ==> ?f g. homeomorphism (t,t) (f,g) /\
8362 {x | ~(f x = x /\ g x = x)} SUBSET s /\
8363 bounded {x | ~(f x = x /\ g x = x)} /\
8364 !x. x IN k ==> (f x) IN u`,
8366 (`!a b:real^1 c d:real^1.
8367 drop a < drop b /\ drop c < drop d
8368 ==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\
8369 f(a) = c /\ f(b) = d`,
8370 REPEAT STRIP_TAC THEN EXISTS_TAC
8371 `\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN
8372 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ;
8373 REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN
8374 CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
8375 MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
8376 REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
8377 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
8378 MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
8379 REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN
8380 MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
8381 REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
8382 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
8383 REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN
8384 ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD
8386 ==> (x = c + (y - a) / (b - a) * (d - c) <=>
8387 a + (x - c) / (d - c) * (b - a) = y)`] THEN
8388 REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN
8389 REWRITE_TAC[REAL_ARITH
8390 `c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN
8391 ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
8392 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
8394 ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
8395 REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`;
8396 REAL_ARITH `x - a:real = y - a <=> x = y`;
8397 VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN
8398 ASM_MESON_TAC[REAL_LT_REFL]]) in
8400 (`!a b c:real^1 u v w:real^1 f1 g1 f2 g2.
8401 homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\
8402 homeomorphism (interval[b,c],interval[v,w]) (f2,g2)
8403 ==> b IN interval[a,c] /\ v IN interval[u,w] /\
8404 f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w
8405 ==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\
8406 f a = u /\ f c = w /\
8407 (!x. x IN interval[a,b] ==> f x = f1 x) /\
8408 (!x. x IN interval[b,c] ==> f x = f2 x)`,
8409 REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM
8410 (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN
8411 EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x
8413 ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN
8414 ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN
8415 CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN
8416 MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
8417 REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
8418 [MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
8419 ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN
8421 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8422 CONTINUOUS_ON_SUBSET)) THEN
8423 SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1];
8425 `interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\
8426 interval[u:real^1,w] = interval[u,v] UNION interval[v,w]`
8427 (CONJUNCTS_THEN SUBST1_TAC) THENL
8428 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
8430 REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th ->
8431 GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
8432 MATCH_MP_TAC(SET_RULE
8433 `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
8434 SIMP_TAC[IN_INTERVAL_1; REAL_ARITH
8435 `b <= c ==> (c <= b <=> c = b)`] THEN
8436 ASM_MESON_TAC[DROP_EQ]];
8437 REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
8438 REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
8439 REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN
8440 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
8441 ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL
8442 [COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
8443 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN
8446 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
8447 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL
8448 [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN
8450 SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]`
8452 [REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
8453 [ALL_TAC; ASM_REWRITE_TAC[]] THEN
8454 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
8455 MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
8458 REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP
8459 (REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN
8460 REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN
8462 `(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b`
8463 MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
8464 MATCH_MP_TAC(MESON[]
8465 `!g1:real^1->real^1 g2:real^1->real^1.
8466 g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b
8467 ==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN
8468 MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN
8469 REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
8470 ASM_REAL_ARITH_TAC]) in
8472 (`!a b c d u v:real^1.
8473 interval[c,d] SUBSET interval(a,b) /\
8474 interval[u,v] SUBSET interval(a,b) /\
8475 ~(interval(c,d) = {}) /\ ~(interval(u,v) = {})
8476 ==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\
8477 f a = a /\ f b = b /\
8478 !x. x IN interval[c,d] ==> f(x) IN interval[u,v]`,
8480 REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
8481 ASM_CASES_TAC `drop u < drop v` THEN
8482 ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN
8483 ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL
8484 [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
8485 REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN
8486 REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM];
8487 RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN
8488 ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN
8489 MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN
8490 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8491 MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN
8492 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
8493 MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN
8494 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8495 MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN
8496 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
8497 MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN
8498 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8499 MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN
8500 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
8501 GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
8502 ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN
8503 ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
8504 MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN
8505 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
8506 GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN
8507 ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
8508 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8509 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN
8510 DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
8511 X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN
8512 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
8513 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN
8514 SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL
8515 [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in
8517 (`!s k u t:real^1->bool.
8518 open u /\ open s /\ connected s /\ ~(u = {}) /\
8519 FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
8520 ==> ?f g. homeomorphism (t,t) (f,g) /\
8521 (!x. x IN k ==> f(x) IN u) /\
8522 {x | ~(f x = x /\ g x = x)} SUBSET s /\
8523 bounded {x | ~(f x = x /\ g x = x)}`,
8524 REPEAT STRIP_TAC THEN
8526 `?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u`
8527 STRIP_ASSUME_TAC THENL
8528 [UNDISCH_TAC `open(u:real^1->bool)` THEN
8529 REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
8530 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8531 DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN
8532 DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN
8533 ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[];
8536 `?a b:real^1. ~(interval(a,b) = {}) /\
8537 k SUBSET interval[a,b] /\
8538 interval[a,b] SUBSET s`
8539 STRIP_ASSUME_TAC THENL
8540 [ASM_CASES_TAC `k:real^1->bool = {}` THENL
8541 [ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN
8542 MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN
8543 MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN
8544 ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY;
8545 IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
8546 DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN
8547 DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN
8548 UNDISCH_TAC `open(s:real^1->bool)` THEN
8549 REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
8550 DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN
8551 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
8552 MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
8553 REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN
8554 MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN
8555 REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o
8556 GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
8557 REWRITE_TAC[IS_INTERVAL_1] THEN
8558 ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS;
8559 REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL];
8562 `?w z:real^1. interval[w,z] SUBSET s /\
8563 interval[a,b] UNION interval[c,d] SUBSET interval(w,z)`
8564 STRIP_ASSUME_TAC THENL
8566 `?w z:real^1. interval[w,z] SUBSET s /\
8567 interval[a,b] UNION interval[c,d] SUBSET interval[w,z]`
8568 STRIP_ASSUME_TAC THENL
8569 [EXISTS_TAC `lift(min (drop a) (drop c))` THEN
8570 EXISTS_TAC `lift(max (drop b) (drop d))` THEN
8571 REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN
8573 [FIRST_X_ASSUM(MP_TAC o
8574 GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
8575 REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN
8576 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
8577 EXISTS_TAC `lift(min (drop a) (drop c))` THEN
8578 EXISTS_TAC `lift(max (drop b) (drop d))` THEN
8579 ASM_REWRITE_TAC[LIFT_DROP] THEN
8580 REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN
8581 COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN
8582 ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1;
8584 ASM_REAL_ARITH_TAC];
8585 UNDISCH_TAC `open(s:real^1->bool)` THEN
8586 REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th ->
8587 MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN
8588 SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]`
8589 STRIP_ASSUME_TAC THENL
8590 [REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC
8591 (ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
8593 REWRITE_TAC[UNION_SUBSET]] THEN
8594 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
8595 MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN
8596 REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN
8597 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
8598 MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN
8599 STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN
8601 (REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1;
8602 UNION_SUBSET; SUBSET_INTERVAL_1]) THEN
8603 CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
8604 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN
8605 X_GEN_TAC `x:real^1` THEN
8606 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
8607 ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN
8608 ASM_REAL_ARITH_TAC];
8610 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN
8612 [`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`]
8614 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8615 MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
8616 REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
8617 EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN
8618 EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN
8619 ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN
8620 REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8629 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN
8630 REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN
8632 `t = interval[w:real^1,z] UNION (t DIFF interval(w,z))`
8633 (fun th -> SUBST1_TAC th THEN
8634 MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
8636 THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
8637 ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL
8638 [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
8640 MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
8641 MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN
8643 REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE
8644 `p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN
8645 MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`])
8646 (CONJUNCTS ENDS_IN_INTERVAL) THEN
8648 REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL
8650 [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
8651 ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN
8652 REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
8653 X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN
8654 MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
8655 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8656 X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
8658 [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
8659 `y:real^N->real^N`; `k:real^N->bool`]
8660 HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN
8661 ASM_REWRITE_TAC[pairwise] THEN
8662 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8663 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
8664 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
8666 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN
8667 SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN
8668 REWRITE_TAC[GSYM DIMINDEX_1] THEN
8669 DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN
8670 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8671 MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
8672 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8674 [`IMAGE (h:real^N->real^1) s`;
8675 `IMAGE (h:real^N->real^1) k`;
8676 `IMAGE (h:real^N->real^1) u`;
8677 `IMAGE (h:real^N->real^1) t`]
8679 ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY;
8680 CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN
8682 [ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];
8683 REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
8684 MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
8685 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
8686 [`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`;
8687 `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN
8688 ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN
8689 ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN
8690 ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN
8691 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8693 `{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} =
8694 IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
8695 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8696 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8697 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
8698 ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);;
8700 let HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN = prove
8701 (`!u s t k:real^N->bool.
8702 open_in (subtopology euclidean (affine hull s)) s /\
8703 s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
8704 FINITE k /\ k SUBSET s /\
8705 open_in (subtopology euclidean s) u /\ ~(u = {})
8706 ==> ?f g. homeomorphism (t,t) (f,g) /\
8707 (!x. x IN k ==> f(x) IN u) /\
8708 {x | ~(f x = x /\ g x = x)} SUBSET s /\
8709 bounded {x | ~(f x = x /\ g x = x)}`,
8710 REPEAT STRIP_TAC THEN ASM_CASES_TAC `&2 <= aff_dim(s:real^N->bool)` THENL
8712 [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
8714 [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM INFINITE] THEN
8715 MATCH_MP_TAC INFINITE_OPEN_IN THEN
8716 EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL
8717 [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
8718 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8719 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
8720 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8721 MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
8722 ASM_SIMP_TAC[CONVEX_CONNECTED; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX;
8723 AFF_DIM_AFFINE_HULL] THEN
8724 CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
8725 ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET];
8726 REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
8727 X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC
8728 (ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
8729 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8730 X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
8732 [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
8733 `y:real^N->real^N`; `k:real^N->bool`]
8734 HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN) THEN
8735 ASM_REWRITE_TAC[pairwise] THEN
8736 REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
8737 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8738 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
8739 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
8741 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_NOT_LE])] THEN
8742 SIMP_TAC[AFF_DIM_GE; INT_ARITH
8743 `--(&1):int <= x ==> (x < &2 <=> x = --(&1) \/ x = &0 \/ x = &1)`] THEN
8744 REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
8746 `(u:real^N->bool) SUBSET s /\ s SUBSET affine hull s`
8747 STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
8748 DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
8750 [REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
8751 REWRITE_TAC[HOMEOMORPHISM_I; I_THM; EMPTY_GSPEC; BOUNDED_EMPTY] THEN
8754 MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`]
8755 HOMEOMORPHIC_AFFINE_SETS) THEN
8756 ASM_REWRITE_TAC[AFF_DIM_UNIV; AFFINE_AFFINE_HULL; AFFINE_UNIV] THEN
8757 ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_AFFINE_HULL] THEN
8758 REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
8759 MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
8760 STRIP_TAC THEN MP_TAC(ISPECL
8761 [`IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) s`;
8762 `IMAGE (h:real^N->real^1) t`; `IMAGE (h:real^N->real^1) k`]
8763 HOMEOMORPHISM_GROUPING_POINTS_EXISTS) THEN
8764 ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY] THEN
8767 [`h:real^N->real^1`; `j:real^1->real^N`;
8768 `affine hull s:real^N->bool`; `(:real^1)`]
8769 HOMEOMORPHISM_IMP_OPEN_MAP) THEN
8770 ASM_SIMP_TAC[homeomorphism; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
8771 REPEAT STRIP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
8772 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
8773 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
8774 REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
8775 MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
8776 STRIP_TAC THEN MAP_EVERY EXISTS_TAC
8777 [`\x. if x IN affine hull s
8778 then ((j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)) x
8780 `\x. if x IN affine hull s
8781 then ((j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)) x
8783 ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
8785 ASM_SIMP_TAC[SET_RULE
8786 `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
8787 REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
8788 ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
8789 MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
8790 `(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)` THEN
8791 REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8792 REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
8793 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8794 CONTINUOUS_ON_SUBSET)) THEN
8797 ASM_SIMP_TAC[SET_RULE
8798 `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
8799 REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
8800 ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
8801 MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
8802 `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)` THEN
8803 REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8804 REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
8805 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8806 CONTINUOUS_ON_SUBSET)) THEN
8811 REWRITE_TAC[MESON[] `(if P then f x else x) = x <=> ~P \/ f x = x`] THEN
8812 REWRITE_TAC[DE_MORGAN_THM; GSYM LEFT_OR_DISTRIB] THEN
8814 `{x | x IN affine hull s /\ (~(j (f (h x)) = x) \/ ~(j (g (h x)) = x))} =
8815 IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
8816 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC])
8818 [TRANS_TAC SUBSET_TRANS
8819 `IMAGE (j:real^1->real^N) (IMAGE (h:real^N->real^1) s)` THEN
8821 MATCH_MP_TAC(MESON[CLOSURE_SUBSET; BOUNDED_SUBSET; IMAGE_SUBSET]
8822 `bounded (IMAGE f (closure s)) ==> bounded (IMAGE f s)`) THEN
8823 MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
8824 MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
8825 ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
8826 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]);;
8828 (* ------------------------------------------------------------------------- *)
8829 (* The "inside" and "outside" of a set, i.e. the points respectively in a *)
8830 (* bounded or unbounded connected component of the set's complement. *)
8831 (* ------------------------------------------------------------------------- *)
8833 let inside = new_definition
8834 `inside s = {x | ~(x IN s) /\
8835 bounded(connected_component ((:real^N) DIFF s) x)}`;;
8837 let outside = new_definition
8838 `outside s = {x | ~(x IN s) /\
8839 ~bounded(connected_component ((:real^N) DIFF s) x)}`;;
8841 let INSIDE_TRANSLATION = prove
8842 (`!a s. inside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (inside s)`,
8843 REWRITE_TAC[inside] THEN GEOM_TRANSLATE_TAC[]);;
8845 let OUTSIDE_TRANSLATION = prove
8846 (`!a s. outside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (outside s)`,
8847 REWRITE_TAC[outside] THEN GEOM_TRANSLATE_TAC[]);;
8849 add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];;
8851 let INSIDE_LINEAR_IMAGE = prove
8852 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
8853 ==> inside(IMAGE f s) = IMAGE f (inside s)`,
8854 REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);;
8856 let OUTSIDE_LINEAR_IMAGE = prove
8857 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
8858 ==> outside(IMAGE f s) = IMAGE f (outside s)`,
8859 REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);;
8861 add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];;
8864 (`!s. outside s = {x | ~bounded(connected_component((:real^N) DIFF s) x)}`,
8865 GEN_TAC THEN REWRITE_TAC[outside; EXTENSION; IN_ELIM_THM] THEN
8866 X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
8867 ASM_REWRITE_TAC[] THEN
8868 ASM_MESON_TAC[BOUNDED_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF]);;
8870 let INSIDE_NO_OVERLAP = prove
8871 (`!s. inside s INTER s = {}`,
8872 REWRITE_TAC[inside] THEN SET_TAC[]);;
8874 let OUTSIDE_NO_OVERLAP = prove
8875 (`!s. outside s INTER s = {}`,
8876 REWRITE_TAC[outside] THEN SET_TAC[]);;
8878 let INSIDE_INTER_OUTSIDE = prove
8879 (`!s. inside s INTER outside s = {}`,
8880 REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
8882 let INSIDE_UNION_OUTSIDE = prove
8883 (`!s. inside s UNION outside s = (:real^N) DIFF s`,
8884 REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
8886 let INSIDE_EQ_OUTSIDE = prove
8887 (`!s. inside s = outside s <=> s = (:real^N)`,
8888 REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
8890 let INSIDE_OUTSIDE = prove
8891 (`!s. inside s = (:real^N) DIFF (s UNION outside s)`,
8892 GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
8893 [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
8896 let OUTSIDE_INSIDE = prove
8897 (`!s. outside s = (:real^N) DIFF (s UNION inside s)`,
8898 GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
8899 [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
8902 let UNION_WITH_INSIDE = prove
8903 (`!s. s UNION inside s = (:real^N) DIFF outside s`,
8904 REWRITE_TAC[OUTSIDE_INSIDE] THEN SET_TAC[]);;
8906 let UNION_WITH_OUTSIDE = prove
8907 (`!s. s UNION outside s = (:real^N) DIFF inside s`,
8908 REWRITE_TAC[INSIDE_OUTSIDE] THEN SET_TAC[]);;
8910 let OUTSIDE_MONO = prove
8911 (`!s t. s SUBSET t ==> outside t SUBSET outside s`,
8912 REPEAT GEN_TAC THEN REWRITE_TAC[OUTSIDE; SUBSET; IN_ELIM_THM] THEN
8913 DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
8914 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
8915 MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;
8917 let INSIDE_MONO = prove
8918 (`!s t. s SUBSET t ==> inside s DIFF t SUBSET inside t`,
8919 REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; IN_DIFF; inside; IN_ELIM_THM] THEN
8921 DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)
8923 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
8924 MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;
8926 let COBOUNDED_OUTSIDE = prove
8927 (`!s:real^N->bool. bounded s ==> bounded((:real^N) DIFF outside s)`,
8928 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[outside] THEN
8929 REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~(x IN s) /\ ~P x} =
8930 s UNION {x | P x}`] THEN
8931 ASM_REWRITE_TAC[BOUNDED_UNION] THEN
8932 FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
8933 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
8934 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,B)` THEN
8935 REWRITE_TAC[BOUNDED_BALL; SUBSET; IN_ELIM_THM; IN_BALL_0] THEN
8936 X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8937 REWRITE_TAC[REAL_NOT_LT] THEN
8938 ASM_CASES_TAC `x:real^N = vec 0` THENL
8939 [ASM_REWRITE_TAC[NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
8940 REWRITE_TAC[BOUNDED_POS] THEN
8941 DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
8942 FIRST_X_ASSUM(MP_TAC o SPEC `(B + C) / norm(x) % x:real^N`) THEN
8943 REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
8944 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN
8945 CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
8946 REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
8947 EXISTS_TAC `segment[x:real^N,(B + C) / norm(x) % x]` THEN
8948 REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
8949 MATCH_MP_TAC SUBSET_TRANS THEN
8950 EXISTS_TAC `(:real^N) DIFF ball(vec 0,B)` THEN
8951 ASM_REWRITE_TAC[SET_RULE
8952 `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
8953 REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL_0] THEN
8954 REWRITE_TAC[segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
8955 STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
8956 REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_ASSOC] THEN
8957 GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN
8958 REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH
8959 `&0 < B /\ B <= x ==> B <= abs x`) THEN
8960 ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; GSYM
8961 REAL_MUL_ASSOC] THEN
8962 MATCH_MP_TAC REAL_LE_TRANS THEN
8963 EXISTS_TAC `(&1 - u) * B + u * (B + C)` THEN
8964 ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE] THEN
8965 SIMP_TAC[REAL_ARITH `B <= (&1 - u) * B + u * (B + C) <=> &0 <= u * C`] THEN
8966 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);;
8968 let UNBOUNDED_OUTSIDE = prove
8969 (`!s:real^N->bool. bounded s ==> ~bounded(outside s)`,
8970 MESON_TAC[COBOUNDED_IMP_UNBOUNDED; COBOUNDED_OUTSIDE]);;
8972 let BOUNDED_INSIDE = prove
8973 (`!s:real^N->bool. bounded s ==> bounded(inside s)`,
8974 REPEAT STRIP_TAC THEN
8975 MATCH_MP_TAC BOUNDED_SUBSET THEN
8976 EXISTS_TAC `(:real^N) DIFF outside s` THEN
8977 ASM_SIMP_TAC[COBOUNDED_OUTSIDE] THEN
8978 MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN SET_TAC[]);;
8980 let CONNECTED_OUTSIDE = prove
8981 (`!s:real^N->bool. 2 <= dimindex(:N) /\ bounded s ==> connected(outside s)`,
8982 REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
8983 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
8984 REWRITE_TAC[outside; IN_ELIM_THM] THEN STRIP_TAC THEN
8985 MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
8986 EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
8987 REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THENL
8988 [X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN
8989 FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
8990 CONNECTED_COMPONENT_SUBSET)) THEN
8991 REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
8992 REWRITE_TAC[CONNECTED_COMPONENT_IDEMP] THEN
8993 SUBGOAL_THEN `connected_component ((:real^N) DIFF s) x =
8994 connected_component ((:real^N) DIFF s) y`
8996 [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
8997 ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`];
8998 ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]]);;
9000 let OUTSIDE_CONNECTED_COMPONENT_LT = prove
9002 {x | !B. ?y. B < norm(y) /\
9003 connected_component((:real^N) DIFF s) x y}`,
9004 REWRITE_TAC[OUTSIDE; bounded; EXTENSION; IN_ELIM_THM] THEN
9005 REWRITE_TAC[IN] THEN ASM_MESON_TAC[REAL_NOT_LE]);;
9007 let OUTSIDE_CONNECTED_COMPONENT_LE = prove
9009 {x | !B. ?y. B <= norm(y) /\
9010 connected_component((:real^N) DIFF s) x y}`,
9011 GEN_TAC THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT] THEN
9012 GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
9013 REWRITE_TAC[IN_ELIM_THM] THEN
9014 MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;
9016 let NOT_OUTSIDE_CONNECTED_COMPONENT_LT = prove
9017 (`!s. 2 <= dimindex(:N) /\ bounded s
9018 ==> (:real^N) DIFF (outside s) =
9019 {x | !B. ?y. B < norm(y) /\
9020 ~(connected_component((:real^N) DIFF s) x y)}`,
9021 REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE] THEN
9022 REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
9023 X_GEN_TAC `x:real^N` THEN REWRITE_TAC[bounded] THEN EQ_TAC THENL
9024 [DISCH_THEN(X_CHOOSE_TAC `C:real`) THEN X_GEN_TAC `B:real` THEN
9025 EXISTS_TAC `(abs B + abs C + &1) % basis 1:real^N` THEN
9026 RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN
9027 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
9028 CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN
9029 SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
9032 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
9033 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN
9034 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN
9035 ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
9036 FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN DISCH_THEN
9037 (X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9038 REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
9039 EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN
9040 MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
9041 EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
9042 ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL_0; IN_UNIV; CONTRAPOS_THM] THEN
9043 REWRITE_TAC[connected_component] THEN
9044 EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
9045 ASM_SIMP_TAC[SUBSET_REFL; IN_DIFF; IN_UNIV; IN_CBALL_0; REAL_NOT_LE] THEN
9046 MATCH_MP_TAC CONNECTED_COMPLEMENT_BOUNDED_CONVEX THEN
9047 ASM_SIMP_TAC[BOUNDED_CBALL; CONVEX_CBALL]]);;
9049 let NOT_OUTSIDE_CONNECTED_COMPONENT_LE = prove
9050 (`!s. 2 <= dimindex(:N) /\ bounded s
9051 ==> (:real^N) DIFF (outside s) =
9052 {x | !B. ?y. B <= norm(y) /\
9053 ~(connected_component((:real^N) DIFF s) x y)}`,
9054 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN
9055 GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
9056 REWRITE_TAC[IN_ELIM_THM] THEN
9057 MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;
9059 let INSIDE_CONNECTED_COMPONENT_LT = prove
9060 (`!s. 2 <= dimindex(:N) /\ bounded s
9062 {x:real^N | ~(x IN s) /\
9063 !B. ?y. B < norm(y) /\
9064 ~(connected_component((:real^N) DIFF s) x y)}`,
9065 REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
9066 REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
9067 ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN SET_TAC[]);;
9069 let INSIDE_CONNECTED_COMPONENT_LE = prove
9070 (`!s. 2 <= dimindex(:N) /\ bounded s
9072 {x:real^N | ~(x IN s) /\
9073 !B. ?y. B <= norm(y) /\
9074 ~(connected_component((:real^N) DIFF s) x y)}`,
9075 REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
9076 REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
9077 ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LE] THEN SET_TAC[]);;
9079 let OUTSIDE_UNION_OUTSIDE_UNION = prove
9080 (`!c c1 c2:real^N->bool.
9081 c INTER outside(c1 UNION c2) = {}
9082 ==> outside(c1 UNION c2) SUBSET outside(c1 UNION c)`,
9083 REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
9084 X_GEN_TAC `x:real^N` THEN
9085 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
9086 REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT; IN_ELIM_THM] THEN
9087 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `B:real` THEN
9088 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
9089 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9090 ASM_REWRITE_TAC[connected_component] THEN
9091 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
9092 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9093 SUBGOAL_THEN `t SUBSET outside(c1 UNION c2:real^N->bool)`
9094 MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
9095 MATCH_MP_TAC SUBSET_TRANS THEN
9096 EXISTS_TAC `connected_component((:real^N) DIFF (c1 UNION c2)) x` THEN
9097 CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]; ALL_TAC] THEN
9098 UNDISCH_TAC `(x:real^N) IN outside(c1 UNION c2)` THEN
9099 REWRITE_TAC[OUTSIDE; IN_ELIM_THM; SUBSET] THEN
9100 MESON_TAC[CONNECTED_COMPONENT_EQ]);;
9102 let INSIDE_SUBSET = prove
9103 (`!s t u. connected u /\ ~bounded u /\ t UNION u = (:real^N) DIFF s
9104 ==> inside s SUBSET t`,
9105 REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
9106 X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
9107 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
9108 UNDISCH_TAC `~bounded(u:real^N->bool)` THEN REWRITE_TAC[] THEN
9109 MATCH_MP_TAC BOUNDED_SUBSET THEN
9110 EXISTS_TAC `connected_component((:real^N) DIFF s) x` THEN
9111 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
9112 ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
9114 let INSIDE_UNIQUE = prove
9115 (`!s t u. connected t /\ bounded t /\
9116 connected u /\ ~(bounded u) /\
9117 ~connected((:real^N) DIFF s) /\
9118 t UNION u = (:real^N) DIFF s
9120 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
9121 [ASM_MESON_TAC[INSIDE_SUBSET]; ALL_TAC] THEN
9122 REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
9123 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9124 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9125 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN
9126 ASM_REWRITE_TAC[] THEN
9127 MATCH_MP_TAC(SET_RULE
9128 `!s u. c INTER s = {} /\ c INTER u = {} /\ t UNION u = UNIV DIFF s
9129 ==> c SUBSET t`) THEN
9130 MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
9131 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
9132 [REWRITE_TAC[SET_RULE `c INTER s = {} <=> c SUBSET (UNIV DIFF s)`] THEN
9133 REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
9135 MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t = {}`) THEN
9136 X_GEN_TAC `y:real^N` THEN
9137 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [IN] THEN STRIP_TAC THEN
9138 UNDISCH_TAC `~connected((:real^N) DIFF s)` THEN
9139 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
9140 MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
9142 `(!w. w IN t ==> connected_component ((:real^N) DIFF s) x w) /\
9143 (!w. w IN u ==> connected_component ((:real^N) DIFF s) y w)`
9144 STRIP_ASSUME_TAC THENL
9145 [CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
9146 REWRITE_TAC[connected_component] THENL
9147 [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `u:real^N->bool`] THEN
9148 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
9149 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_UNION] THEN
9150 ASM_REWRITE_TAC[] THEN
9151 ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]]);;
9153 let INSIDE_OUTSIDE_UNIQUE = prove
9154 (`!s t u. connected t /\ bounded t /\
9155 connected u /\ ~(bounded u) /\
9156 ~connected((:real^N) DIFF s) /\
9157 t UNION u = (:real^N) DIFF s
9158 ==> inside s = t /\ outside s = u`,
9159 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
9160 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
9161 [ASM_MESON_TAC[INSIDE_UNIQUE];
9162 MP_TAC(ISPEC `(:real^N) DIFF s` INSIDE_NO_OVERLAP) THEN
9163 SUBGOAL_THEN `t INTER u:real^N->bool = {}` MP_TAC THENL
9164 [ALL_TAC; ASM SET_TAC[]] THEN
9165 UNDISCH_TAC `~connected ((:real^N) DIFF s)` THEN
9166 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9167 FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN
9168 REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_UNION THEN
9169 ASM_REWRITE_TAC[]]);;
9171 let INTERIOR_INSIDE_FRONTIER = prove
9172 (`!s:real^N->bool. bounded s ==> interior s SUBSET inside(frontier s)`,
9173 REPEAT STRIP_TAC THEN REWRITE_TAC[inside; SUBSET; IN_ELIM_THM] THEN
9174 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9175 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
9176 [ASM_REWRITE_TAC[frontier; IN_DIFF]; DISCH_TAC] THEN
9177 MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
9178 ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
9179 MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
9180 SUBGOAL_THEN `~(connected_component((:real^N) DIFF frontier s) x INTER
9183 [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
9184 REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; GSYM MEMBER_NOT_EMPTY] THEN
9185 CONJ_TAC THENL [REWRITE_TAC[IN_INTER]; ASM SET_TAC[]] THEN
9186 EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL
9187 [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
9188 GEN_REWRITE_TAC I [GSYM IN] THEN ASM SET_TAC[];
9189 ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]];
9190 REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN
9191 REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;
9193 let INSIDE_EMPTY = prove
9195 REWRITE_TAC[inside; NOT_IN_EMPTY; DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
9196 REWRITE_TAC[NOT_BOUNDED_UNIV; EMPTY_GSPEC]);;
9198 let OUTSIDE_EMPTY = prove
9199 (`outside {} = (:real^N)`,
9200 REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_EMPTY] THEN SET_TAC[]);;
9202 let INSIDE_SAME_COMPONENT = prove
9203 (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN inside s
9206 DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
9208 REWRITE_TAC[inside; IN_ELIM_THM] THEN
9209 FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
9210 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
9211 FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
9212 SIMP_TAC[IN_DIFF]);;
9214 let OUTSIDE_SAME_COMPONENT = prove
9215 (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN outside s
9216 ==> y IN outside s`,
9218 DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
9220 REWRITE_TAC[outside; IN_ELIM_THM] THEN
9221 FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
9222 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
9223 FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
9224 SIMP_TAC[IN_DIFF]);;
9226 let OUTSIDE_CONVEX = prove
9227 (`!s. convex s ==> outside s = (:real^N) DIFF s`,
9228 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ;
9229 REWRITE_RULE[SET_RULE `t INTER s = {} <=> t SUBSET UNIV DIFF s`]
9230 OUTSIDE_NO_OVERLAP] THEN
9231 REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN
9232 MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[OUTSIDE_EMPTY; IN_UNIV] THEN
9233 X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN
9234 X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN
9235 MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT t)`) THEN
9236 SPEC_TAC(`(vec 0:real^N) INSERT t`,`s:real^N->bool`) THEN
9237 GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN
9238 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9239 ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN
9240 SUBGOAL_THEN `~(x:real^N = vec 0)` ASSUME_TAC THENL
9241 [ASM_MESON_TAC[]; ALL_TAC] THEN
9242 REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN
9243 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9244 DISCH_THEN(MP_TAC o SPEC `(max (&2) ((B + &1) / norm(x))) % x:real^N`) THEN
9245 REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
9246 [REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
9247 EXISTS_TAC `segment[x:real^N,(max (&2) ((B + &1) / norm(x))) % x]` THEN
9248 REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
9249 REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
9250 ASM_CASES_TAC `u = &0` THEN
9251 ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_RZERO;
9252 VECTOR_ADD_RID; IN_DIFF; IN_UNIV] THEN
9254 REWRITE_TAC[VECTOR_ARITH `a % x + b % c % x:real^N = (a + b * c) % x`] THEN
9255 ABBREV_TAC `c = &1 - u + u * max (&2) ((B + &1) / norm(x:real^N))` THEN
9256 DISCH_TAC THEN SUBGOAL_THEN `&1 < c` ASSUME_TAC THENL
9257 [EXPAND_TAC "c" THEN
9258 REWRITE_TAC[REAL_ARITH `&1 < &1 - u + u * x <=> &0 < u * (x - &1)`] THEN
9259 MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
9260 UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN
9261 SUBGOAL_THEN `x:real^N = (&1 - inv c) % vec 0 + inv c % c % x`
9263 [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_ASSOC] THEN
9264 ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < x ==> ~(x = &0)`] THEN
9265 REWRITE_TAC[VECTOR_MUL_LID];
9266 MATCH_MP_TAC IN_CONVEX_SET THEN
9267 ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_LT_IMP_LE] THEN
9268 ASM_REAL_ARITH_TAC]];
9269 ASM_SIMP_TAC[NORM_MUL; REAL_NOT_LE; GSYM REAL_LT_LDIV_EQ; NORM_POS_LT] THEN
9270 MATCH_MP_TAC(REAL_ARITH `&0 < b /\ b < c ==> b < abs(max (&2) c)`) THEN
9271 ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_DIV2_EQ] THEN
9274 let INSIDE_CONVEX = prove
9275 (`!s. convex s ==> inside s = {}`,
9276 SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_CONVEX] THEN SET_TAC[]);;
9278 let OUTSIDE_SUBSET_CONVEX = prove
9279 (`!s t. convex t /\ s SUBSET t ==> (:real^N) DIFF t SUBSET outside s`,
9280 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
9281 EXISTS_TAC `outside(t:real^N->bool)` THEN
9282 ASM_SIMP_TAC[OUTSIDE_MONO] THEN
9283 ASM_SIMP_TAC[OUTSIDE_CONVEX; SUBSET_REFL]);;
9285 let OUTSIDE_FRONTIER_MISSES_CLOSURE = prove
9286 (`!s. bounded s ==> outside(frontier s) SUBSET (:real^N) DIFF closure s`,
9287 REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
9288 SIMP_TAC[SET_RULE `(UNIV DIFF s) SUBSET (UNIV DIFF t) <=> t SUBSET s`] THEN
9289 REWRITE_TAC[frontier] THEN
9290 MATCH_MP_TAC(SET_RULE
9291 `i SUBSET ins ==> c SUBSET (c DIFF i) UNION ins`) THEN
9292 ASM_SIMP_TAC[GSYM frontier; INTERIOR_INSIDE_FRONTIER]);;
9294 let OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE = prove
9295 (`!s. bounded s /\ convex s
9296 ==> outside(frontier s) = (:real^N) DIFF closure s`,
9297 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
9298 ASM_SIMP_TAC[OUTSIDE_FRONTIER_MISSES_CLOSURE] THEN
9299 MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
9300 ASM_SIMP_TAC[CONVEX_CLOSURE; frontier] THEN SET_TAC[]);;
9302 let INSIDE_FRONTIER_EQ_INTERIOR = prove
9304 bounded s /\ convex s ==> inside(frontier s) = interior s`,
9305 REPEAT STRIP_TAC THEN
9306 ASM_SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE] THEN
9307 REWRITE_TAC[frontier] THEN
9308 MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
9309 [CLOSURE_SUBSET; INTERIOR_SUBSET] THEN
9312 let OPEN_INSIDE = prove
9313 (`!s:real^N->bool. closed s ==> open(inside s)`,
9314 REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
9315 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9316 SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
9317 [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
9318 REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
9320 [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
9321 GEN_REWRITE_TAC I [GSYM IN] THEN
9322 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
9323 MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN
9325 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
9326 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
9327 X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
9328 MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
9329 EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
9330 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
9331 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;
9333 let OPEN_OUTSIDE = prove
9334 (`!s:real^N->bool. closed s ==> open(outside s)`,
9335 REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
9336 X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9337 SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
9338 [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
9339 REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
9341 [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
9342 GEN_REWRITE_TAC I [GSYM IN] THEN
9343 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
9344 MP_TAC(ISPEC `s:real^N->bool` OUTSIDE_NO_OVERLAP) THEN
9346 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
9347 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
9348 X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
9349 MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
9350 EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
9351 RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
9352 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;
9354 let CLOSURE_INSIDE_SUBSET = prove
9355 (`!s:real^N->bool. closed s ==> closure(inside s) SUBSET s UNION inside s`,
9356 REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
9357 ASM_SIMP_TAC[closed; GSYM OUTSIDE_INSIDE; OPEN_OUTSIDE] THEN SET_TAC[]);;
9359 let FRONTIER_INSIDE_SUBSET = prove
9360 (`!s:real^N->bool. closed s ==> frontier(inside s) SUBSET s`,
9361 REPEAT STRIP_TAC THEN
9362 ASM_SIMP_TAC[frontier; OPEN_INSIDE; INTERIOR_OPEN] THEN
9363 FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN SET_TAC[]);;
9365 let CLOSURE_OUTSIDE_SUBSET = prove
9366 (`!s:real^N->bool. closed s ==> closure(outside s) SUBSET s UNION outside s`,
9367 REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
9368 ASM_SIMP_TAC[closed; GSYM INSIDE_OUTSIDE; OPEN_INSIDE] THEN SET_TAC[]);;
9370 let FRONTIER_OUTSIDE_SUBSET = prove
9371 (`!s:real^N->bool. closed s ==> frontier(outside s) SUBSET s`,
9372 REPEAT STRIP_TAC THEN
9373 ASM_SIMP_TAC[frontier; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
9374 FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_OUTSIDE_SUBSET) THEN SET_TAC[]);;
9376 let INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY = prove
9377 (`!s. connected((:real^N) DIFF s) /\ ~bounded((:real^N) DIFF s)
9379 REWRITE_TAC[inside; CONNECTED_CONNECTED_COMPONENT_SET] THEN
9380 REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN
9381 SIMP_TAC[IN_ELIM_THM; IN_DIFF; IN_UNIV; TAUT `~(a /\ b) <=> a ==> ~b`]);;
9383 let INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY = prove
9384 (`!s. connected((:real^N) DIFF s) /\ bounded s
9386 MESON_TAC[INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY;
9387 COBOUNDED_IMP_UNBOUNDED]);;
9389 let INSIDE_INSIDE = prove
9390 (`!s t:real^N->bool.
9391 s SUBSET inside t ==> inside s DIFF t SUBSET inside t`,
9392 REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; inside; IN_DIFF; IN_ELIM_THM] THEN
9393 X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
9394 ASM_CASES_TAC `s INTER connected_component ((:real^N) DIFF t) x = {}` THENL
9395 [MATCH_MP_TAC BOUNDED_SUBSET THEN
9396 EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
9397 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
9398 REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN
9399 REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
9400 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
9401 `~(s INTER t = {}) ==> ?x. x IN s /\ x IN t`)) THEN
9402 DISCH_THEN(X_CHOOSE_THEN `y:real^N`
9403 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9404 DISCH_THEN(SUBST_ALL_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
9405 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
9406 DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
9407 ASM_SIMP_TAC[inside; IN_ELIM_THM]]);;
9409 let INSIDE_INSIDE_SUBSET = prove
9410 (`!s:real^N->bool. inside(inside s) SUBSET s`,
9412 (ISPECL [`inside s:real^N->bool`; `s:real^N->bool`] INSIDE_INSIDE) THEN
9413 REWRITE_TAC[SUBSET_REFL] THEN
9414 MP_TAC(ISPEC `inside s:real^N->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]);;
9416 let INSIDE_OUTSIDE_INTERSECT_CONNECTED = prove
9417 (`!s t:real^N->bool.
9418 connected t /\ ~(inside s INTER t = {}) /\ ~(outside s INTER t = {})
9419 ==> ~(s INTER t = {})`,
9420 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9421 DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
9422 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
9423 REWRITE_TAC[inside; outside; IN_ELIM_THM] THEN
9424 DISCH_THEN(CONJUNCTS_THEN2
9425 (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC)
9426 (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)) THEN
9428 `connected_component ((:real^N) DIFF s) y =
9429 connected_component ((:real^N) DIFF s) x`
9430 (fun th -> ASM_MESON_TAC[th]) THEN
9431 ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV] THEN
9432 REWRITE_TAC[connected_component] THEN
9433 EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]);;
9435 let OUTSIDE_BOUNDED_NONEMPTY = prove
9436 (`!s:real^N->bool. bounded s ==> ~(outside s = {})`,
9438 DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
9439 DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
9440 FIRST_ASSUM(MP_TAC o MATCH_MP
9441 (REWRITE_RULE[IMP_CONJ_ALT] OUTSIDE_SUBSET_CONVEX)) THEN
9442 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9443 SIMP_TAC[CONVEX_BALL; SUBSET_EMPTY] THEN
9444 REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
9445 MESON_TAC[BOUNDED_BALL; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]);;
9447 let OUTSIDE_COMPACT_IN_OPEN = prove
9448 (`!s t:real^N->bool.
9449 compact s /\ open t /\ s SUBSET t /\ ~(t = {})
9450 ==> ~(outside s INTER t = {})`,
9451 REPEAT GEN_TAC THEN STRIP_TAC THEN
9452 FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY o
9453 MATCH_MP COMPACT_IMP_BOUNDED) THEN
9454 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
9455 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
9456 X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
9457 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
9458 ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9459 MP_TAC(ISPECL [`linepath(a:real^N,b)`; `(:real^N) DIFF t`]
9460 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
9461 REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
9462 ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
9463 X_GEN_TAC `g:real^1->real^N` THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
9464 REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_DIFF; INTERIOR_UNIV] THEN
9465 ABBREV_TAC `c:real^N = pathfinish g` THEN STRIP_TAC THEN
9466 SUBGOAL_THEN `frontier t SUBSET (:real^N) DIFF s` MP_TAC THENL
9467 [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
9468 REWRITE_TAC[frontier] THEN
9469 ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[];
9470 REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV]] THEN
9471 DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
9472 DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` OPEN_CONTAINS_CBALL) THEN
9473 ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; IN_DIFF; IN_UNIV] THEN
9474 DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
9475 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
9476 MP_TAC(ISPECL [`c:real^N`; `t:real^N->bool`]
9477 CLOSURE_APPROACHABLE) THEN
9478 RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
9479 ASM_REWRITE_TAC[] THEN
9480 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
9481 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN
9482 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9483 MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
9484 EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
9485 REWRITE_TAC[connected_component] THEN
9486 EXISTS_TAC `path_image(g) UNION segment[c:real^N,d]` THEN
9487 REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN CONJ_TAC THENL
9488 [MATCH_MP_TAC CONNECTED_UNION THEN
9489 ASM_SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY;
9490 CONNECTED_PATH_IMAGE] THEN
9491 EXISTS_TAC `c:real^N` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN
9492 ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
9493 CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]] THEN
9494 REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL
9495 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
9497 ==> (t DELETE c) SUBSET (UNIV DIFF s)
9498 ==> t SUBSET (UNIV DIFF s)`)) THEN
9499 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9501 SIMP_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
9502 ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET];
9503 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
9505 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
9506 ASM_SIMP_TAC[CONVEX_CBALL; INSERT_SUBSET; REAL_LT_IMP_LE;
9507 EMPTY_SUBSET; CENTRE_IN_CBALL] THEN
9508 REWRITE_TAC[IN_CBALL] THEN
9509 ASM_MESON_TAC[DIST_SYM; REAL_LT_IMP_LE]]]);;
9511 let INSIDE_INSIDE_COMPACT_CONNECTED = prove
9512 (`!s t:real^N->bool.
9513 closed s /\ compact t /\ s SUBSET inside t /\ connected t
9514 ==> inside s SUBSET inside t`,
9516 ASM_CASES_TAC `inside t:real^N->bool = {}` THEN
9517 ASM_SIMP_TAC[INSIDE_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET] THEN
9518 SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
9519 [REWRITE_TAC[DIMINDEX_GE_1];
9520 REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN
9521 STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONNECTED_CONVEX_1_GEN] THENL
9522 [ASM_MESON_TAC[INSIDE_CONVEX]; ALL_TAC] THEN
9523 STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_INSIDE) THEN
9524 MATCH_MP_TAC(SET_RULE
9525 `s INTER t = {} ==> s DIFF t SUBSET u ==> s SUBSET u`) THEN
9526 SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
9527 [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_INSIDE];
9529 MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
9530 INSIDE_OUTSIDE_INTERSECT_CONNECTED) THEN
9531 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT
9532 `r /\ q ==> (~p /\ q ==> ~r) ==> p`) THEN
9534 [MP_TAC(ISPEC `t:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[];
9535 ONCE_REWRITE_TAC[INTER_COMM]] THEN
9536 MATCH_MP_TAC INSIDE_OUTSIDE_INTERSECT_CONNECTED THEN
9537 ASM_SIMP_TAC[CONNECTED_OUTSIDE; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THENL
9538 [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OUTSIDE_COMPACT_IN_OPEN THEN
9539 ASM_SIMP_TAC[OPEN_INSIDE; COMPACT_IMP_CLOSED];
9540 MP_TAC(ISPECL [`s UNION t:real^N->bool`; `vec 0:real^N`]
9541 BOUNDED_SUBSET_BALL) THEN
9542 ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
9543 DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
9544 MATCH_MP_TAC(SET_RULE
9545 `!u. ~(u = UNIV) /\ UNIV DIFF u SUBSET s /\ UNIV DIFF u SUBSET t
9546 ==> ~(s INTER t = {})`) THEN
9547 EXISTS_TAC `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL
9548 [ASM_MESON_TAC[NOT_BOUNDED_UNIV; BOUNDED_BALL]; ALL_TAC] THEN
9549 CONJ_TAC THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
9550 REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]]);;
9552 let CONNECTED_WITH_INSIDE = prove
9553 (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION inside s)`,
9554 GEN_TAC THEN ASM_CASES_TAC `s UNION inside s = (:real^N)` THEN
9555 ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
9556 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
9557 REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
9559 `!x. x IN (s UNION inside s)
9560 ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
9561 t SUBSET (s UNION inside s)`
9563 [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
9564 [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
9565 ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
9566 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
9567 `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
9568 DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
9569 MP_TAC(ISPECL [`linepath(a:real^N,b)`; `inside s:real^N->bool`]
9570 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
9571 ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
9572 IN_UNION; OPEN_INSIDE; INTERIOR_OPEN] THEN
9573 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
9574 EXISTS_TAC `pathfinish g :real^N` THEN
9575 EXISTS_TAC `path_image g :real^N->bool` THEN
9576 ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
9577 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
9578 REPEAT STRIP_TAC THENL
9579 [ASM_MESON_TAC[FRONTIER_INSIDE_SUBSET; SUBSET];
9580 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
9582 DISCH_THEN(fun th ->
9583 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
9584 MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
9585 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9586 MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
9587 MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
9588 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
9589 ASM_REWRITE_TAC[] THEN
9590 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
9591 EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
9592 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
9593 REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
9594 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
9597 let CONNECTED_WITH_OUTSIDE = prove
9598 (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION outside s)`,
9599 GEN_TAC THEN ASM_CASES_TAC `s UNION outside s = (:real^N)` THEN
9600 ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
9601 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
9602 REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
9604 `!x. x IN (s UNION outside s)
9605 ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
9606 t SUBSET (s UNION outside s)`
9608 [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
9609 [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
9610 ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
9611 FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
9612 `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
9613 DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
9614 MP_TAC(ISPECL [`linepath(a:real^N,b)`; `outside s:real^N->bool`]
9615 EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
9616 ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
9617 IN_UNION; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
9618 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
9619 EXISTS_TAC `pathfinish g :real^N` THEN
9620 EXISTS_TAC `path_image g :real^N->bool` THEN
9621 ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
9622 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
9623 REPEAT STRIP_TAC THENL
9624 [ASM_MESON_TAC[FRONTIER_OUTSIDE_SUBSET; SUBSET];
9625 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
9627 DISCH_THEN(fun th ->
9628 MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
9629 MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
9630 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9631 MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
9632 MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
9633 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
9634 ASM_REWRITE_TAC[] THEN
9635 DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
9636 EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
9637 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
9638 REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
9639 ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
9642 let INSIDE_INSIDE_EQ_EMPTY = prove
9644 closed s /\ connected s ==> inside(inside s) = {}`,
9645 REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
9646 X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[inside] THEN
9647 REWRITE_TAC[IN_ELIM_THM] THEN
9648 ONCE_REWRITE_TAC[INSIDE_OUTSIDE] THEN
9649 REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
9650 REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
9651 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
9652 ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_SELF; CONNECTED_WITH_OUTSIDE] THEN
9653 REWRITE_TAC[BOUNDED_UNION] THEN MESON_TAC[UNBOUNDED_OUTSIDE]);;
9655 let INSIDE_IN_COMPONENTS = prove
9656 (`!s. (inside s) IN components((:real^N) DIFF s) <=>
9657 connected(inside s) /\ ~(inside s = {})`,
9658 X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
9659 ASM_CASES_TAC `inside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
9660 ASM_CASES_TAC `connected(inside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
9661 REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
9662 REWRITE_TAC[INSIDE_NO_OVERLAP] THEN
9663 X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
9664 ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
9665 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9666 MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
9667 UNDISCH_TAC `~(inside s:real^N->bool = {})` THEN
9668 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
9669 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
9670 ASM_REWRITE_TAC[connected_component] THEN
9671 EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;
9673 let OUTSIDE_IN_COMPONENTS = prove
9674 (`!s. (outside s) IN components((:real^N) DIFF s) <=>
9675 connected(outside s) /\ ~(outside s = {})`,
9676 X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
9677 ASM_CASES_TAC `outside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
9678 ASM_CASES_TAC `connected(outside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
9679 REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
9680 REWRITE_TAC[OUTSIDE_NO_OVERLAP] THEN
9681 X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
9682 ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
9683 REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9684 MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
9685 UNDISCH_TAC `~(outside s:real^N->bool = {})` THEN
9686 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
9687 X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
9688 ASM_REWRITE_TAC[connected_component] THEN
9689 EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;
9691 let BOUNDED_UNIQUE_OUTSIDE = prove
9692 (`!c s. 2 <= dimindex(:N) /\ bounded s
9693 ==> (c IN components ((:real^N) DIFF s) /\ ~bounded c <=>
9695 REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
9696 [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN
9697 EXISTS_TAC `(:real^N) DIFF s` THEN
9698 ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
9699 ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS];
9700 ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]] THEN
9701 ASM_SIMP_TAC[UNBOUNDED_OUTSIDE; OUTSIDE_BOUNDED_NONEMPTY;
9702 CONNECTED_OUTSIDE]);;
9704 (* ------------------------------------------------------------------------- *)
9705 (* Homotopy of maps p,q : X->Y with property P of all intermediate maps. *)
9706 (* We often just want to require that it fixes some subset, but to take in *)
9707 (* the case of loop homotopy it's convenient to have a general property P. *)
9708 (* ------------------------------------------------------------------------- *)
9710 let homotopic_with = new_definition
9711 `homotopic_with P (X,Y) p q <=>
9712 ?h:real^(1,M)finite_sum->real^N.
9713 h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
9714 IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
9715 (!x. h(pastecart (vec 0) x) = p x) /\
9716 (!x. h(pastecart (vec 1) x) = q x) /\
9717 (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`;;
9719 (* ------------------------------------------------------------------------- *)
9720 (* We often want to just localize the ending function equality or whatever. *)
9721 (* ------------------------------------------------------------------------- *)
9723 let HOMOTOPIC_WITH = prove
9724 (`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
9725 ==> (homotopic_with P (X,Y) p q <=>
9726 ?h:real^(1,M)finite_sum->real^N.
9727 h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
9728 IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
9729 (!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\
9730 (!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\
9731 (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`,
9732 REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
9733 [REWRITE_TAC[homotopic_with; PCROSS] THEN
9734 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
9735 REWRITE_TAC[homotopic_with; PCROSS] THEN
9736 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
9737 (fun th -> EXISTS_TAC
9738 `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
9739 else if fstcart(y) = vec 0 then p(sndcart y)
9740 else q(sndcart y)` THEN
9742 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
9743 REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
9744 [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
9745 SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
9746 SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
9747 SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
9750 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
9751 MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
9752 MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9755 let HOMOTOPIC_WITH_EQ = prove
9756 (`!P X Y f g f' g':real^M->real^N.
9757 homotopic_with P (X,Y) f g /\
9758 (!x. x IN X ==> f' x = f x /\ g' x = g x) /\
9759 (!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
9760 ==> homotopic_with P (X,Y) f' g'`,
9762 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9763 REWRITE_TAC[homotopic_with] THEN
9764 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
9765 (fun th -> EXISTS_TAC
9766 `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
9767 else if fstcart(y) = vec 0 then f'(sndcart y)
9768 else g'(sndcart y)` THEN
9770 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
9771 REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
9772 [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
9773 SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART];
9774 SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
9775 SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART];
9778 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
9779 MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
9780 MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9783 let HOMOTOPIC_WITH_EQUAL = prove
9784 (`!P f:real^M->real^N g s t.
9786 f continuous_on s /\ IMAGE f s SUBSET t /\
9787 (!x. x IN s ==> g x = f x)
9788 ==> homotopic_with P (s,t) f g`,
9789 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN
9790 EXISTS_TAC `\z:real^(1,M)finite_sum.
9791 if fstcart z = vec 1 then g(sndcart z):real^N else f(sndcart z)` THEN
9792 REWRITE_TAC[VEC_EQ; ARITH_EQ; SNDCART_PASTECART; FSTCART_PASTECART] THEN
9794 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
9795 EXISTS_TAC `\z:real^(1,M)finite_sum. (f:real^M->real^N)(sndcart z)` THEN
9796 ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN
9797 REWRITE_TAC[COND_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
9798 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9799 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN
9800 ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY];
9801 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
9802 REWRITE_TAC[ FSTCART_PASTECART; SNDCART_PASTECART] THEN
9803 CONJ_TAC THEN X_GEN_TAC `t:real^1` THEN REPEAT STRIP_TAC THEN
9804 ASM_CASES_TAC `t:real^1 = vec 1` THEN ASM_REWRITE_TAC[ETA_AX] THEN
9807 let HOMOTOPIC_CONSTANT_MAPS = prove
9808 (`!s:real^M->bool t:real^N->bool a b.
9809 homotopic_with (\x. T) (s,t) (\x. a) (\x. b) <=>
9810 s = {} \/ path_component t a b`,
9811 REPEAT GEN_TAC THEN SIMP_TAC[HOMOTOPIC_WITH; path_component] THEN
9812 ASM_CASES_TAC `s:real^M->bool = {}` THEN
9813 ASM_REWRITE_TAC[NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES] THEN
9814 REWRITE_TAC[EMPTY_SUBSET; CONTINUOUS_ON_EMPTY] THEN
9815 ASM_CASES_TAC `t:real^N->bool = {}` THEN
9816 ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY; SUBSET_EMPTY; PCROSS_EQ_EMPTY;
9817 IMAGE_EQ_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
9819 [DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
9820 STRIP_ASSUME_TAC) THEN
9821 SUBGOAL_THEN `?c:real^M. c IN s` STRIP_ASSUME_TAC THENL
9822 [ASM SET_TAC[]; ALL_TAC] THEN
9823 EXISTS_TAC `(h:real^(1,M)finite_sum->real^N) o (\t. pastecart t c)` THEN
9824 ASM_SIMP_TAC[pathstart; pathfinish; o_THM; PATH_IMAGE_COMPOSE] THEN
9826 [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9827 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
9828 CONTINUOUS_ON_CONST] THEN
9829 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9830 CONTINUOUS_ON_SUBSET));
9831 REWRITE_TAC[path_image]] THEN
9832 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
9833 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
9834 ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS];
9835 REWRITE_TAC[path; pathstart; path_image; pathfinish] THEN
9836 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
9838 `(g:real^1->real^N) o (fstcart:real^(1,M)finite_sum->real^1)` THEN
9839 ASM_SIMP_TAC[FSTCART_PASTECART; o_THM; IMAGE_o; IMAGE_FSTCART_PCROSS] THEN
9840 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9841 ASM_SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON;
9842 IMAGE_FSTCART_PCROSS]]);;
9844 (* ------------------------------------------------------------------------- *)
9845 (* Trivial properties. *)
9846 (* ------------------------------------------------------------------------- *)
9848 let HOMOTOPIC_WITH_IMP_PROPERTY = prove
9849 (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> P f /\ P g`,
9850 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
9851 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
9852 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN
9853 (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
9854 MP_TAC(SPEC `vec 1:real^1` th)) THEN
9855 ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; ETA_AX]);;
9857 let HOMOTOPIC_WITH_IMP_CONTINUOUS = prove
9858 (`!P X Y (f:real^M->real^N) g.
9859 homotopic_with P (X,Y) f g ==> f continuous_on X /\ g continuous_on X`,
9860 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
9861 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
9864 `((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 0) x))
9866 ((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 1) x))
9868 MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
9869 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9870 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
9871 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9872 CONTINUOUS_ON_SUBSET)) THEN
9873 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
9874 ONCE_REWRITE_TAC[CONJ_SYM] THEN
9875 REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
9876 SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
9877 REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);;
9879 let HOMOTOPIC_WITH_IMP_SUBSET = prove
9880 (`!P X Y (f:real^M->real^N) g.
9881 homotopic_with P (X,Y) f g ==> IMAGE f X SUBSET Y /\ IMAGE g X SUBSET Y`,
9882 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
9883 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
9884 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
9885 REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN DISCH_THEN
9886 (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
9887 MP_TAC(SPEC `vec 1:real^1` th)) THEN
9888 ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;
9890 let HOMOTOPIC_WITH_MONO = prove
9891 (`!P Q X Y f g:real^M->real^N.
9892 homotopic_with P (X,Y) f g /\
9893 (!h. h continuous_on X /\ IMAGE h X SUBSET Y /\ P h ==> Q h)
9894 ==> homotopic_with Q (X,Y) f g`,
9895 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
9896 REWRITE_TAC[homotopic_with; PCROSS] THEN
9897 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9898 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL
9899 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
9900 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9901 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
9902 CONTINUOUS_ON_CONST] THEN
9903 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9904 CONTINUOUS_ON_SUBSET)) THEN
9908 let HOMOTOPIC_WITH_SUBSET_LEFT = prove
9910 homotopic_with P (X,Y) f g /\ Z SUBSET X
9911 ==> homotopic_with P (Z,Y) f g`,
9912 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
9913 REWRITE_TAC[homotopic_with; PCROSS] THEN
9914 MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
9915 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
9916 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9917 CONTINUOUS_ON_SUBSET)) THEN
9921 let HOMOTOPIC_WITH_SUBSET_RIGHT = prove
9922 (`!P X Y Z (f:real^M->real^N) g h.
9923 homotopic_with P (X,Y) f g /\ Y SUBSET Z
9924 ==> homotopic_with P (X,Z) f g`,
9926 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
9927 REWRITE_TAC[homotopic_with] THEN
9928 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
9929 ASM_MESON_TAC[SUBSET_TRANS]);;
9931 let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT = prove
9932 (`!p f:real^N->real^P g h:real^M->real^N W X Y.
9933 homotopic_with (\f. p(f o h)) (X,Y) f g /\
9934 h continuous_on W /\ IMAGE h W SUBSET X
9935 ==> homotopic_with p (W,Y) (f o h) (g o h)`,
9937 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9938 REWRITE_TAC[homotopic_with; o_DEF; PCROSS] THEN
9939 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,N)finite_sum->real^P`
9940 STRIP_ASSUME_TAC) THEN
9941 EXISTS_TAC `\y:real^(1,M)finite_sum.
9942 (k:real^(1,N)finite_sum->real^P)
9943 (pastecart (fstcart y) (h(sndcart y)))` THEN
9944 ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
9946 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
9947 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
9948 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
9949 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
9950 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
9951 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9952 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
9954 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
9955 CONTINUOUS_ON_SUBSET));
9957 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
9958 SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
9961 let HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT = prove
9962 (`!f:real^N->real^P g h:real^M->real^N W X Y.
9963 homotopic_with (\f. T) (X,Y) f g /\
9964 h continuous_on W /\ IMAGE h W SUBSET X
9965 ==> homotopic_with (\f. T) (W,Y) (f o h) (g o h)`,
9966 REPEAT STRIP_TAC THEN
9967 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
9968 EXISTS_TAC `X:real^N->bool` THEN ASM_REWRITE_TAC[]);;
9970 let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT = prove
9971 (`!p f:real^M->real^N g h:real^N->real^P X Y Z.
9972 homotopic_with (\f. p(h o f)) (X,Y) f g /\
9973 h continuous_on Y /\ IMAGE h Y SUBSET Z
9974 ==> homotopic_with p (X,Z) (h o f) (h o g)`,
9976 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9977 REWRITE_TAC[homotopic_with; o_DEF] THEN
9978 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N`
9979 STRIP_ASSUME_TAC) THEN
9980 EXISTS_TAC `(h:real^N->real^P) o (k:real^(1,M)finite_sum->real^N)` THEN
9981 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
9982 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
9983 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
9984 CONTINUOUS_ON_SUBSET));
9986 REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]);;
9988 let HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT = prove
9989 (`!f:real^M->real^N g h:real^N->real^P X Y Z.
9990 homotopic_with (\f. T) (X,Y) f g /\
9991 h continuous_on Y /\ IMAGE h Y SUBSET Z
9992 ==> homotopic_with (\f. T) (X,Z) (h o f) (h o g)`,
9993 REPEAT STRIP_TAC THEN
9994 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
9995 EXISTS_TAC `Y:real^N->bool` THEN ASM_REWRITE_TAC[]);;
9997 let HOMOTOPIC_WITH_PCROSS = prove
9998 (`!f:real^M->real^N f':real^P->real^Q g g' p p' q s s' t t'.
9999 homotopic_with p (s,t) f g /\
10000 homotopic_with p' (s',t') f' g' /\
10001 (!f g. p f /\ p' g ==> q(\x. pastecart (f(fstcart x)) (g(sndcart x))))
10002 ==> homotopic_with q (s PCROSS s',t PCROSS t')
10003 (\z. pastecart (f(fstcart z)) (f'(sndcart z)))
10004 (\z. pastecart (g(fstcart z)) (g'(sndcart z)))`,
10005 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10006 REWRITE_TAC[CONJ_ASSOC] THEN
10007 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10008 REWRITE_TAC[GSYM CONJ_ASSOC] THEN
10009 DISCH_THEN(CONJUNCTS_THEN2
10010 (X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
10011 (X_CHOOSE_THEN `k':real^(1,P)finite_sum->real^Q` STRIP_ASSUME_TAC)) THEN
10013 `\z:real^(1,(M,P)finite_sum)finite_sum.
10014 pastecart (k(pastecart (fstcart z) (fstcart(sndcart z))):real^N)
10015 (k'(pastecart (fstcart z) (sndcart(sndcart z))):real^Q)` THEN
10016 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10017 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN
10018 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
10019 FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS;
10020 IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
10021 MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
10022 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10023 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10025 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
10026 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
10027 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10028 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10029 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
10030 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10031 CONTINUOUS_ON_SUBSET)) THEN
10032 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
10033 IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
10034 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART;
10035 PASTECART_IN_PCROSS]]));;
10037 (* ------------------------------------------------------------------------- *)
10038 (* Homotopy with P is an equivalence relation (on continuous functions *)
10039 (* mapping X into Y that satisfy P, though this only affects reflexivity). *)
10040 (* ------------------------------------------------------------------------- *)
10042 let HOMOTOPIC_WITH_REFL = prove
10043 (`!P X Y (f:real^M->real^N).
10044 homotopic_with P (X,Y) f f <=>
10045 f continuous_on X /\ IMAGE f X SUBSET Y /\ P f`,
10046 REPEAT GEN_TAC THEN EQ_TAC THENL
10047 [MESON_TAC[HOMOTOPIC_WITH_IMP_PROPERTY; HOMOTOPIC_WITH_IMP_CONTINUOUS;
10048 HOMOTOPIC_WITH_IMP_SUBSET];
10049 STRIP_TAC THEN REWRITE_TAC[homotopic_with; PCROSS]] THEN
10050 EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) (sndcart y)` THEN
10051 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
10052 ASM_SIMP_TAC[SNDCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_IMAGE;
10053 FORALL_IN_GSPEC] THEN
10054 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10055 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10056 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
10057 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10058 CONTINUOUS_ON_SUBSET)) THEN
10059 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]);;
10061 let HOMOTOPIC_WITH_SYM = prove
10062 (`!P X Y (f:real^M->real^N) g.
10063 homotopic_with P (X,Y) f g <=> homotopic_with P (X,Y) g f`,
10064 REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC(MESON[]
10065 `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN
10066 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN
10067 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10068 STRIP_ASSUME_TAC) THEN
10069 EXISTS_TAC `\y:real^(1,M)finite_sum.
10070 (h:real^(1,M)finite_sum->real^N)
10071 (pastecart (vec 1 - fstcart y) (sndcart y))` THEN
10072 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10073 ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN REPEAT CONJ_TAC THENL
10074 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10075 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10076 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
10077 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
10078 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10079 CONTINUOUS_ON_SUBSET));
10080 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
10081 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
10082 `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
10083 ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
10084 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC];
10085 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
10086 FIRST_X_ASSUM MATCH_MP_TAC] THEN
10087 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10088 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
10089 ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[PASTECART_EQ] THEN
10090 REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10091 SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
10092 REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL; DROP_SUB] THEN
10093 ASM_REAL_ARITH_TAC);;
10095 let HOMOTOPIC_WITH_TRANS = prove
10096 (`!P X Y (f:real^M->real^N) g h.
10097 homotopic_with P (X,Y) f g /\ homotopic_with P (X,Y) g h
10098 ==> homotopic_with P (X,Y) f h`,
10099 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN
10100 DISCH_THEN(CONJUNCTS_THEN2
10101 (X_CHOOSE_THEN `k1:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
10102 (X_CHOOSE_THEN `k2:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
10103 EXISTS_TAC `\y:real^(1,M)finite_sum.
10104 if drop(fstcart y) <= &1 / &2
10105 then (k1:real^(1,M)finite_sum->real^N)
10106 (pastecart (&2 % fstcart y) (sndcart y))
10107 else (k2:real^(1,M)finite_sum->real^N)
10108 (pastecart (&2 % fstcart y - vec 1) (sndcart y))` THEN
10109 REWRITE_TAC[FSTCART_PASTECART; DROP_VEC] THEN
10110 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
10111 ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; SNDCART_PASTECART] THEN
10112 REPEAT CONJ_TAC THENL
10114 `interval[vec 0:real^1,vec 1] =
10115 interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
10117 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
10120 REWRITE_TAC[SET_RULE `{f x y | x IN s UNION t /\ y IN u} =
10121 {f x y | x IN s /\ y IN u} UNION
10122 {f x y | x IN t /\ y IN u}`] THEN
10123 MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
10124 ONCE_REWRITE_TAC[TAUT
10125 `a /\ b /\ c /\ d /\ e <=> (a /\ b) /\ (c /\ d) /\ e`] THEN
10127 [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
10128 [EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
10129 t IN interval[vec 0,lift(&1 / &2)] /\ x IN UNIV }`;
10130 EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
10131 t IN interval[lift(&1 / &2),vec 1] /\ x IN UNIV}`] THEN
10132 SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS;
10133 CLOSED_INTERVAL; CLOSED_UNIV] THEN
10134 MATCH_MP_TAC SUBSET_ANTISYM THEN
10135 REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; TAUT
10136 `(x IN (s UNION t) /\ x IN u ==> x IN v) <=>
10137 (x IN u ==> x IN (s UNION t) ==> x IN v)`] THEN
10138 REWRITE_TAC[PASTECART_EQ; IN_ELIM_THM; IN_UNION] THEN
10139 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV] THEN
10143 [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10144 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10145 (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
10146 [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB;
10147 CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
10148 LINEAR_SNDCART] THEN
10149 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10150 CONTINUOUS_ON_SUBSET)) THEN
10151 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10152 REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART;
10153 SNDCART_PASTECART] THEN
10154 REWRITE_TAC[MESON[] `(?t x. P t x /\ a = t /\ b = x) <=> P a b`] THEN
10155 SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
10157 REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
10158 REWRITE_TAC[FORALL_AND_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN
10159 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
10160 SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_ARITH
10161 `&1 / &2 <= t ==> (t <= &1 / &2 <=> t = &1 / &2)`] THEN
10162 SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
10163 REWRITE_TAC[GSYM LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
10164 ASM_REWRITE_TAC[LIFT_NUM]];
10165 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10166 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10167 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
10168 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
10169 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
10170 `IMAGE k s SUBSET t ==> x IN s ==> k x IN t`)) THEN
10171 ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_INTERVAL_1; DROP_VEC;
10172 DROP_CMUL; DROP_SUB] THEN
10173 ASM_REAL_ARITH_TAC;
10174 X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
10175 STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_SIMP_TAC[] THEN
10176 FIRST_X_ASSUM MATCH_MP_TAC THEN
10177 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
10178 ASM_REAL_ARITH_TAC]);;
10180 (* ------------------------------------------------------------------------- *)
10181 (* Two characterizations of homotopic triviality, one of which *)
10182 (* implicitly incorporates path-connectedness. *)
10183 (* ------------------------------------------------------------------------- *)
10185 let HOMOTOPIC_TRIVIALITY = prove
10186 (`!s:real^M->bool t:real^N->bool.
10187 (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\
10188 g continuous_on s /\ IMAGE g s SUBSET t
10189 ==> homotopic_with (\x. T) (s,t) f g) <=>
10190 (s = {} \/ path_connected t) /\
10191 (!f. f continuous_on s /\ IMAGE f s SUBSET t
10192 ==> ?c. homotopic_with (\x. T) (s,t) f (\x. c))`,
10193 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
10194 [ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; HOMOTOPIC_WITH; NOT_IN_EMPTY;
10195 PCROSS_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET];
10196 ASM_CASES_TAC `t:real^N->bool = {}` THEN
10197 ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; PATH_CONNECTED_EMPTY]] THEN
10198 EQ_TAC THEN REPEAT STRIP_TAC THENL
10199 [REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
10200 REPEAT STRIP_TAC THEN
10201 W(MP_TAC o PART_MATCH (rand o rand) HOMOTOPIC_CONSTANT_MAPS o snd) THEN
10202 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
10203 FIRST_X_ASSUM MATCH_MP_TAC THEN
10204 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST] THEN
10206 SUBGOAL_THEN `?c:real^N. c IN t` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10207 MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
10208 FIRST_X_ASSUM MATCH_MP_TAC THEN
10209 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST];
10210 FIRST_X_ASSUM(fun th ->
10211 MP_TAC(ISPEC `g:real^M->real^N` th) THEN
10212 MP_TAC(ISPEC `f:real^M->real^N` th)) THEN
10213 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10214 X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
10215 X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN
10216 TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. c):real^M->real^N` THEN
10217 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
10218 TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. d):real^M->real^N` THEN
10219 ASM_REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN
10220 FIRST_X_ASSUM(MATCH_MP_TAC o
10221 REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
10222 REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
10225 (* ------------------------------------------------------------------------- *)
10226 (* Homotopy of paths, maintaining the same endpoints. *)
10227 (* ------------------------------------------------------------------------- *)
10229 let homotopic_paths = new_definition
10230 `homotopic_paths s p q =
10232 (\r. pathstart r = pathstart p /\ pathfinish r = pathfinish p)
10233 (interval[vec 0:real^1,vec 1],s)
10236 let HOMOTOPIC_PATHS = prove
10237 (`!s p q:real^1->real^N.
10238 homotopic_paths s p q <=>
10239 ?h. h continuous_on
10240 interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
10241 IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
10243 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
10244 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
10245 (!t. t IN interval[vec 0:real^1,vec 1]
10246 ==> pathstart(h o pastecart t) = pathstart p /\
10247 pathfinish(h o pastecart t) = pathfinish p)`,
10248 REPEAT GEN_TAC THEN
10249 REWRITE_TAC[homotopic_paths] THEN
10250 W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN
10252 [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
10253 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;
10255 let HOMOTOPIC_PATHS_IMP_PATHSTART = prove
10256 (`!s p q. homotopic_paths s p q ==> pathstart p = pathstart q`,
10257 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
10258 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
10261 let HOMOTOPIC_PATHS_IMP_PATHFINISH = prove
10262 (`!s p q. homotopic_paths s p q ==> pathfinish p = pathfinish q`,
10263 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
10264 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
10267 let HOMOTOPIC_PATHS_IMP_PATH = prove
10268 (`!s p q. homotopic_paths s p q ==> path p /\ path q`,
10269 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
10270 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
10273 let HOMOTOPIC_PATHS_IMP_SUBSET = prove
10275 homotopic_paths s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
10276 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
10277 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
10278 SIMP_TAC[path_image]);;
10280 let HOMOTOPIC_PATHS_REFL = prove
10281 (`!s p. homotopic_paths s p p <=>
10282 path p /\ path_image p SUBSET s`,
10283 REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_REFL; path; path_image]);;
10285 let HOMOTOPIC_PATHS_SYM = prove
10286 (`!s p q. homotopic_paths s p q <=> homotopic_paths s q p`,
10287 REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN
10288 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
10289 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
10290 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
10291 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[homotopic_paths]);;
10293 let HOMOTOPIC_PATHS_TRANS = prove
10295 homotopic_paths s p q /\ homotopic_paths s q r
10296 ==> homotopic_paths s p r`,
10297 REPEAT GEN_TAC THEN DISCH_TAC THEN
10298 FIRST_ASSUM(CONJUNCTS_THEN
10299 (fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART th) THEN
10300 ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN
10301 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINOP_CONV [homotopic_paths]) THEN
10302 ASM_REWRITE_TAC[HOMOTOPIC_WITH_TRANS; homotopic_paths]);;
10304 let HOMOTOPIC_PATHS_EQ = prove
10305 (`!p:real^1->real^N q s.
10306 path p /\ path_image p SUBSET s /\
10307 (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
10308 ==> homotopic_paths s p q`,
10309 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths] THEN
10310 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
10311 REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
10312 ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN
10313 ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
10314 REWRITE_TAC[pathstart; pathfinish] THEN
10315 MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
10317 let HOMOTOPIC_PATHS_REPARAMETRIZE = prove
10318 (`!p:real^1->real^N q f:real^1->real^1.
10319 path p /\ path_image p SUBSET s /\
10320 (?f. f continuous_on interval[vec 0,vec 1] /\
10321 IMAGE f (interval[vec 0,vec 1]) SUBSET interval[vec 0,vec 1] /\
10322 f(vec 0) = vec 0 /\ f(vec 1) = vec 1 /\
10323 !t. t IN interval[vec 0,vec 1] ==> q(t) = p(f t))
10324 ==> homotopic_paths s p q`,
10325 REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
10326 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
10327 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
10328 EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN CONJ_TAC THENL
10329 [MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN
10330 ASM_SIMP_TAC[o_THM; pathstart; pathfinish; o_THM;
10331 IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
10332 REWRITE_TAC[path; path_image] THEN CONJ_TAC THENL
10333 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
10334 EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN
10335 ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10336 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
10338 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
10339 EXISTS_TAC `(p:real^1->real^N) o
10340 (\y. (&1 - drop(fstcart y)) % f(sndcart y) +
10341 drop(fstcart y) % sndcart y)` THEN
10342 ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC;
10343 pathstart; pathfinish] THEN
10344 CONV_TAC REAL_RAT_REDUCE_CONV THEN
10345 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
10346 VECTOR_MUL_LID; VECTOR_ADD_RID] THEN
10347 REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`] THEN
10349 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
10350 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
10351 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
10352 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB] THEN
10353 SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART;
10354 LINEAR_SNDCART; CONTINUOUS_ON_SUB] THEN
10355 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
10356 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
10357 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10358 CONTINUOUS_ON_SUBSET)) THEN
10359 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART];
10360 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10361 CONTINUOUS_ON_SUBSET))];
10362 ONCE_REWRITE_TAC[IMAGE_o] THEN
10363 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
10364 `IMAGE p i SUBSET s
10365 ==> IMAGE f x SUBSET i
10366 ==> IMAGE p (IMAGE f x) SUBSET s`))] THEN
10367 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART;
10368 FSTCART_PASTECART] THEN
10369 REPEAT STRIP_TAC THEN
10370 MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] (CONJUNCT1(SPEC_ALL
10371 CONVEX_INTERVAL))) THEN
10372 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET; IN_IMAGE]]);;
10374 let HOMOTOPIC_PATHS_SUBSET = prove
10376 homotopic_paths s p q /\ s SUBSET t
10377 ==> homotopic_paths t p q`,
10378 REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_SUBSET_RIGHT]);;
10380 (* ------------------------------------------------------------------------- *)
10381 (* A slightly ad-hoc but useful lemma in constructing homotopies. *)
10382 (* ------------------------------------------------------------------------- *)
10384 let HOMOTOPIC_JOIN_LEMMA = prove
10385 (`!p q:real^1->real^1->real^N.
10386 (\y. p (fstcart y) (sndcart y)) continuous_on
10387 (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
10388 (\y. q (fstcart y) (sndcart y)) continuous_on
10389 (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
10390 (!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t))
10391 ==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on
10392 (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`,
10393 REWRITE_TAC[joinpaths; PCROSS] THEN REPEAT STRIP_TAC THEN
10394 MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
10396 `(\y. p (fstcart y) (&2 % sndcart y)):real^(1,1)finite_sum->real^N =
10397 (\y. p (fstcart y) (sndcart y)) o
10398 (\y. pastecart (fstcart y) (&2 % sndcart y))`
10400 [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
10402 `(\y. q (fstcart y) (&2 % sndcart y - vec 1)):real^(1,1)finite_sum->real^N =
10403 (\y. q (fstcart y) (sndcart y)) o
10404 (\y. pastecart (fstcart y) (&2 % sndcart y - vec 1))`
10406 [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
10407 SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX];
10408 SIMP_TAC[IMP_CONJ; FORALL_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART;
10409 GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
10410 CONV_TAC REAL_RAT_REDUCE_CONV THEN
10411 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
10412 ASM_SIMP_TAC[LIFT_NUM; VECTOR_SUB_REFL]] THEN
10413 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10414 (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART; ALL_TAC]) THEN
10415 SIMP_TAC[CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUB;
10416 CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART] THEN
10417 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10418 CONTINUOUS_ON_SUBSET)) THEN
10419 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ] THEN
10420 SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10421 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
10424 (* ------------------------------------------------------------------------- *)
10425 (* Congruence properties of homotopy w.r.t. path-combining operations. *)
10426 (* ------------------------------------------------------------------------- *)
10428 let HOMOTOPIC_PATHS_REVERSEPATH = prove
10429 (`!s p q:real^1->real^N.
10430 homotopic_paths s (reversepath p) (reversepath q) <=>
10431 homotopic_paths s p q`,
10432 GEN_TAC THEN MATCH_MP_TAC(MESON[]
10433 `(!p. f(f p) = p) /\
10434 (!a b. homotopic_paths s a b ==> homotopic_paths s (f a) (f b))
10435 ==> !a b. homotopic_paths s (f a) (f b) <=>
10436 homotopic_paths s a b`) THEN
10437 REWRITE_TAC[REVERSEPATH_REVERSEPATH] THEN REPEAT GEN_TAC THEN
10438 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS; o_DEF] THEN DISCH_THEN
10439 (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
10440 EXISTS_TAC `\y:real^(1,1)finite_sum.
10441 (h:real^(1,1)finite_sum->real^N)
10442 (pastecart(fstcart y) (vec 1 - sndcart y))` THEN
10443 ASM_REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10444 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
10445 ASM_SIMP_TAC[reversepath; pathstart; pathfinish; VECTOR_SUB_REFL;
10446 VECTOR_SUB_RZERO] THEN
10448 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10449 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
10450 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
10451 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
10452 CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
10453 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10454 CONTINUOUS_ON_SUBSET)) THEN
10455 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
10456 IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10457 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC];
10458 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
10459 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
10460 `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
10461 ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
10462 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
10463 IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10464 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]);;
10466 let HOMOTOPIC_PATHS_JOIN = prove
10467 (`!s p q p' q':real^1->real^N.
10468 homotopic_paths s p p' /\ homotopic_paths s q q' /\
10469 pathfinish p = pathstart q
10470 ==> homotopic_paths s (p ++ q) (p' ++ q')`,
10471 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
10472 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
10473 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
10474 DISCH_THEN(CONJUNCTS_THEN2
10475 (X_CHOOSE_THEN `k1:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)
10476 (X_CHOOSE_THEN `k2:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
10477 EXISTS_TAC `(\y. ((k1 o pastecart (fstcart y)) ++
10478 (k2 o pastecart (fstcart y))) (sndcart y))
10479 :real^(1,1)finite_sum->real^N` THEN
10480 REPEAT CONJ_TAC THENL
10481 [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
10482 ASM_REWRITE_TAC[o_DEF; PASTECART_FST_SND; ETA_AX] THEN
10483 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
10484 ASM_REWRITE_TAC[pathstart; pathfinish] THEN ASM_MESON_TAC[];
10485 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10486 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10487 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
10488 REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
10489 `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
10490 REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
10491 REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[];
10492 ALL_TAC; ALL_TAC; ALL_TAC] THEN
10493 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10494 ASM_REWRITE_TAC[joinpaths; o_DEF] THEN
10495 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
10496 REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN
10497 CONV_TAC REAL_RAT_REDUCE_CONV THEN
10498 ASM_SIMP_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; VECTOR_MUL_RZERO]);;
10500 let HOMOTOPIC_PATHS_CONTINUOUS_IMAGE = prove
10501 (`!f:real^1->real^M g h:real^M->real^N s t.
10502 homotopic_paths s f g /\
10503 h continuous_on s /\ IMAGE h s SUBSET t
10504 ==> homotopic_paths t (h o f) (h o g)`,
10505 REWRITE_TAC[homotopic_paths] THEN REPEAT STRIP_TAC THEN
10506 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
10507 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
10508 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10509 HOMOTOPIC_WITH_MONO)) THEN
10510 SIMP_TAC[pathstart; pathfinish; o_THM]);;
10512 (* ------------------------------------------------------------------------- *)
10513 (* Group properties for homotopy of paths (so taking equivalence classes *)
10514 (* under homotopy would give the fundamental group). *)
10515 (* ------------------------------------------------------------------------- *)
10517 let HOMOTOPIC_PATHS_RID = prove
10518 (`!s p. path p /\ path_image p SUBSET s
10519 ==> homotopic_paths s (p ++ linepath(pathfinish p,pathfinish p)) p`,
10520 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
10521 MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
10522 ASM_REWRITE_TAC[joinpaths] THEN
10523 EXISTS_TAC `\t. if drop t <= &1 / &2 then &2 % t else vec 1` THEN
10524 ASM_REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
10525 REWRITE_TAC[VECTOR_MUL_RZERO; linepath; pathfinish;
10526 VECTOR_ARITH `(&1 - t) % x + t % x:real^N = x`] THEN
10527 REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
10530 `interval[vec 0:real^1,vec 1] =
10531 interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
10533 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
10535 MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
10536 SIMP_TAC[CLOSED_INTERVAL; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
10537 CONTINUOUS_ON_CONST; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
10538 GSYM DROP_EQ; DROP_CMUL] THEN
10540 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
10541 GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN
10542 ASM_REAL_ARITH_TAC]);;
10544 let HOMOTOPIC_PATHS_LID = prove
10545 (`!s p:real^1->real^N.
10546 path p /\ path_image p SUBSET s
10547 ==> homotopic_paths s (linepath(pathstart p,pathstart p) ++ p) p`,
10548 REPEAT STRIP_TAC THEN
10549 ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
10550 REWRITE_TAC[o_DEF; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
10551 SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH;
10552 PATHFINISH_LINEPATH] THEN
10553 ONCE_REWRITE_TAC[CONJ_SYM] THEN
10554 MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p :real^1->real^N`]
10555 HOMOTOPIC_PATHS_RID) THEN
10556 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
10557 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);;
10559 let HOMOTOPIC_PATHS_ASSOC = prove
10560 (`!s p q r:real^1->real^N.
10561 path p /\ path_image p SUBSET s /\
10562 path q /\ path_image q SUBSET s /\
10563 path r /\ path_image r SUBSET s /\
10564 pathfinish p = pathstart q /\ pathfinish q = pathstart r
10565 ==> homotopic_paths s (p ++ (q ++ r)) ((p ++ q) ++ r)`,
10566 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
10567 MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
10568 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET;
10569 PATHSTART_JOIN; PATHFINISH_JOIN] THEN
10570 REWRITE_TAC[joinpaths] THEN
10571 EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(&2) % t
10572 else if drop t <= &3 / &4 then t - lift(&1 / &4)
10573 else &2 % t - vec 1` THEN
10574 REPEAT CONJ_TAC THENL
10575 [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
10576 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; LIFT_DROP] THEN
10577 REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN
10578 CONV_TAC REAL_RAT_REDUCE_CONV THEN
10579 MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
10580 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
10581 CONTINUOUS_ON_CONST] THEN
10582 REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
10583 CONV_TAC REAL_RAT_REDUCE_CONV;
10584 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
10585 REPEAT STRIP_TAC THEN
10586 REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
10587 REWRITE_TAC[DROP_CMUL; DROP_VEC; LIFT_DROP; DROP_SUB] THEN
10588 ASM_REAL_ARITH_TAC;
10589 REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
10590 REWRITE_TAC[VECTOR_MUL_RZERO];
10591 REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
10593 X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
10595 ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[DROP_CMUL] THEN
10596 ASM_REWRITE_TAC[REAL_ARITH `inv(&2) * t <= &1 / &2 <=> t <= &1`] THEN
10597 REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
10598 CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN
10599 ASM_CASES_TAC `drop t <= &3 / &4` THEN
10600 ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP;
10601 REAL_ARITH `&2 * (t - &1 / &4) <= &1 / &2 <=> t <= &1 / &2`;
10602 REAL_ARITH `&2 * t - &1 <= &1 / &2 <=> t <= &3 / &4`;
10603 REAL_ARITH `t - &1 / &4 <= &1 / &2 <=> t <= &3 / &4`] THEN
10604 REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; GSYM LIFT_CMUL] THEN
10605 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
10606 REWRITE_TAC[VECTOR_ARITH `a - b - b:real^N = a - &2 % b`]]);;
10608 let HOMOTOPIC_PATHS_RINV = prove
10609 (`!s p:real^1->real^N.
10610 path p /\ path_image p SUBSET s
10611 ==> homotopic_paths s
10612 (p ++ reversepath p) (linepath(pathstart p,pathstart p))`,
10613 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
10614 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
10615 EXISTS_TAC `(\y. (subpath (vec 0) (fstcart y) p ++
10616 reversepath(subpath (vec 0) (fstcart y) p)) (sndcart y))
10617 : real^(1,1)finite_sum->real^N` THEN
10618 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL] THEN
10619 REWRITE_TAC[ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN] THEN
10620 REWRITE_TAC[REVERSEPATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
10621 REPEAT CONJ_TAC THENL
10622 [REWRITE_TAC[joinpaths] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
10623 RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN REPEAT CONJ_TAC THENL
10624 [REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
10625 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10626 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
10627 [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
10628 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
10629 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
10630 CONTINUOUS_ON_CMUL];
10631 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10632 CONTINUOUS_ON_SUBSET)) THEN
10633 REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
10634 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10635 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
10636 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN
10637 MATCH_MP_TAC REAL_LE_TRANS THEN
10638 EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
10639 REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
10640 ASM_REAL_ARITH_TAC];
10641 REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
10642 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10643 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
10644 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
10645 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
10646 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
10647 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
10648 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
10649 CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
10650 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10651 CONTINUOUS_ON_SUBSET)) THEN
10652 REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
10653 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10654 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC; DROP_ADD;
10655 REAL_ARITH `t + (&0 - t) * (&2 * x - &1) =
10656 t * &2 * (&1 - x)`] THEN
10657 REPEAT STRIP_TAC THEN
10658 ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN
10659 MATCH_MP_TAC REAL_LE_TRANS THEN
10660 EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
10661 REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
10662 ASM_REAL_ARITH_TAC];
10663 SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
10664 REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
10665 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[subpath] THEN AP_TERM_TAC THEN
10666 REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC; DROP_ADD; DROP_CMUL;
10669 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10670 REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
10671 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
10672 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX;
10673 SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
10674 REWRITE_TAC[GSYM path_image] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
10675 REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN
10676 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
10677 MATCH_MP_TAC(SET_RULE
10678 `t SUBSET s /\ u SUBSET s
10679 ==> IMAGE p s SUBSET v
10680 ==> IMAGE p t SUBSET v /\ IMAGE p u SUBSET v`) THEN
10681 REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN
10682 MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL] THEN
10683 ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
10684 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
10685 REWRITE_TAC[subpath; linepath; pathstart; joinpaths] THEN
10686 REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
10687 REWRITE_TAC[VECTOR_ADD_RID; COND_ID] THEN VECTOR_ARITH_TAC;
10688 REWRITE_TAC[pathstart; PATHFINISH_LINEPATH; PATHSTART_LINEPATH]]);;
10690 let HOMOTOPIC_PATHS_LINV = prove
10691 (`!s p:real^1->real^N.
10692 path p /\ path_image p SUBSET s
10693 ==> homotopic_paths s
10694 (reversepath p ++ p) (linepath(pathfinish p,pathfinish p))`,
10695 REPEAT STRIP_TAC THEN
10696 MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p:real^1->real^N`]
10697 HOMOTOPIC_PATHS_RINV) THEN
10698 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
10699 REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
10700 REVERSEPATH_REVERSEPATH]);;
10702 (* ------------------------------------------------------------------------- *)
10703 (* Homotopy of loops without requiring preservation of endpoints. *)
10704 (* ------------------------------------------------------------------------- *)
10706 let homotopic_loops = new_definition
10707 `homotopic_loops s p q =
10709 (\r. pathfinish r = pathstart r)
10710 (interval[vec 0:real^1,vec 1],s)
10713 let HOMOTOPIC_LOOPS = prove
10714 (`!s p q:real^1->real^N.
10715 homotopic_loops s p q <=>
10716 ?h. h continuous_on
10717 interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
10718 IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
10720 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
10721 (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
10722 (!t. t IN interval[vec 0:real^1,vec 1]
10723 ==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`,
10724 REPEAT GEN_TAC THEN
10725 REWRITE_TAC[homotopic_loops] THEN
10726 W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN
10728 [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
10729 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;
10731 let HOMOTOPIC_LOOPS_IMP_LOOP = prove
10732 (`!s p q. homotopic_loops s p q
10733 ==> pathfinish p = pathstart p /\
10734 pathfinish q = pathstart q`,
10735 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
10736 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
10739 let HOMOTOPIC_LOOPS_IMP_PATH = prove
10740 (`!s p q. homotopic_loops s p q ==> path p /\ path q`,
10741 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
10742 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
10745 let HOMOTOPIC_LOOPS_IMP_SUBSET = prove
10747 homotopic_loops s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
10748 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
10749 DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
10750 SIMP_TAC[path_image]);;
10752 let HOMOTOPIC_LOOPS_REFL = prove
10753 (`!s p. homotopic_loops s p p <=>
10754 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p`,
10755 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_REFL; path; path_image]);;
10757 let HOMOTOPIC_LOOPS_SYM = prove
10758 (`!s p q. homotopic_loops s p q <=> homotopic_loops s q p`,
10759 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SYM]);;
10761 let HOMOTOPIC_LOOPS_TRANS = prove
10763 homotopic_loops s p q /\ homotopic_loops s q r
10764 ==> homotopic_loops s p r`,
10765 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_TRANS]);;
10767 let HOMOTOPIC_LOOPS_SUBSET = prove
10769 homotopic_loops s p q /\ s SUBSET t
10770 ==> homotopic_loops t p q`,
10771 REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SUBSET_RIGHT]);;
10773 let HOMOTOPIC_LOOPS_EQ = prove
10774 (`!p:real^1->real^N q s.
10775 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
10776 (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
10777 ==> homotopic_loops s p q`,
10778 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_loops] THEN
10779 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
10780 REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
10781 ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN
10782 ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
10783 REWRITE_TAC[pathstart; pathfinish] THEN
10784 MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
10786 let HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE = prove
10787 (`!f:real^1->real^M g h:real^M->real^N s t.
10788 homotopic_loops s f g /\
10789 h continuous_on s /\ IMAGE h s SUBSET t
10790 ==> homotopic_loops t (h o f) (h o g)`,
10791 REWRITE_TAC[homotopic_loops] THEN REPEAT STRIP_TAC THEN
10792 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
10793 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
10794 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10795 HOMOTOPIC_WITH_MONO)) THEN
10796 SIMP_TAC[pathstart; pathfinish; o_THM]);;
10798 let HOMOTOPIC_LOOPS_SHIFTPATH_SELF = prove
10799 (`!p:real^1->real^N t s.
10800 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
10801 t IN interval[vec 0,vec 1]
10802 ==> homotopic_loops s p (shiftpath t p)`,
10803 REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_LOOPS] THEN EXISTS_TAC
10804 `\z. shiftpath (drop t % fstcart z) (p:real^1->real^N) (sndcart z)` THEN
10805 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_DEF] THEN
10806 REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; ETA_AX] THEN
10807 REPEAT CONJ_TAC THENL
10809 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
10810 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
10811 MATCH_MP_TAC(SET_RULE
10812 `IMAGE p t SUBSET u /\
10813 (!x. x IN s ==> IMAGE(shiftpath (f x) p) t = IMAGE p t)
10814 ==> (!x y. x IN s /\ y IN t ==> shiftpath (f x) p y IN u)`) THEN
10815 ASM_REWRITE_TAC[GSYM path_image] THEN REPEAT STRIP_TAC THEN
10816 MATCH_MP_TAC PATH_IMAGE_SHIFTPATH THEN
10817 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
10818 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
10819 ASM_SIMP_TAC[REAL_LE_MUL] THEN
10820 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
10821 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[];
10822 SIMP_TAC[shiftpath; VECTOR_ADD_LID; IN_INTERVAL_1; DROP_VEC];
10823 REWRITE_TAC[LIFT_DROP];
10824 X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN
10825 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
10826 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
10827 ASM_SIMP_TAC[REAL_LE_MUL] THEN
10828 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
10829 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]] THEN
10830 REWRITE_TAC[shiftpath; DROP_ADD; DROP_CMUL] THEN
10831 MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
10832 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10833 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10834 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
10835 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
10836 CONTINUOUS_ON_CONST] THEN
10837 RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
10838 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10839 CONTINUOUS_ON_SUBSET)) THEN
10840 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
10841 REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
10842 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
10843 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
10844 DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL];
10845 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10846 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10847 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
10848 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
10849 CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
10850 RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
10851 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10852 CONTINUOUS_ON_SUBSET)) THEN
10853 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
10854 REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
10855 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
10856 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB;
10857 DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL] THEN
10858 SIMP_TAC[REAL_ARITH `&0 <= x + y - &1 <=> &1 <= x + y`] THEN
10859 REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
10860 `t * x <= &1 * &1 /\ y <= &1 ==> t * x + y - &1 <= &1`) THEN
10861 ASM_SIMP_TAC[REAL_LE_MUL2; REAL_POS];
10862 REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
10863 SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON;
10864 LINEAR_FSTCART; LINEAR_SNDCART];
10865 SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_CMUL; LIFT_DROP; LIFT_NUM;
10866 VECTOR_ARITH `a + b - c:real^1 = (a + b) - c`] THEN
10867 ASM_MESON_TAC[VECTOR_SUB_REFL; pathstart; pathfinish]]);;
10869 (* ------------------------------------------------------------------------- *)
10870 (* Relations between the two variants of homotopy. *)
10871 (* ------------------------------------------------------------------------- *)
10873 let HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS = prove
10874 (`!s p q. homotopic_paths s p q /\
10875 pathfinish p = pathstart p /\
10876 pathfinish q = pathstart p
10877 ==> homotopic_loops s p q`,
10878 REPEAT GEN_TAC THEN
10879 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
10880 REWRITE_TAC[homotopic_paths; homotopic_loops] THEN
10881 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_MONO) THEN
10884 let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove
10886 homotopic_loops s p (linepath(a,a))
10887 ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
10888 REPEAT STRIP_TAC THEN
10889 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN
10890 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN
10891 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN
10892 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN
10893 REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
10894 X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN
10895 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
10896 `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN
10898 [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN
10899 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
10900 `linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++
10901 linepath(pathfinish p,pathfinish p)` THEN
10903 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
10904 MP_TAC(ISPECL [`s:real^N->bool`;
10905 `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`]
10906 HOMOTOPIC_PATHS_LID) THEN
10907 REWRITE_TAC[PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN
10908 ASM_SIMP_TAC[PATH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN
10909 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
10910 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
10911 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
10912 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
10914 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
10915 `((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++
10917 reversepath(\u. h (pastecart u (vec 0))))` THEN
10920 MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_LID; HOMOTOPIC_PATHS_JOIN;
10921 HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM;
10922 HOMOTOPIC_PATHS_RINV]
10923 `(path p /\ path(reversepath p)) /\
10924 (path_image p SUBSET s /\ path_image(reversepath p) SUBSET s) /\
10925 (pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\
10926 pathstart(reversepath p) = b) /\
10928 ==> homotopic_paths s (p ++ linepath(b,b) ++ reversepath p)
10929 (linepath(a,a))`) THEN
10930 REWRITE_TAC[PATHSTART_REVERSEPATH; PATHSTART_JOIN; PATH_REVERSEPATH;
10931 PATH_IMAGE_REVERSEPATH; PATHSTART_LINEPATH] THEN
10932 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish;
10933 LINEPATH_REFL] THEN
10935 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10936 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10937 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
10938 CONTINUOUS_ON_CONST] THEN
10939 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10940 CONTINUOUS_ON_SUBSET)) THEN
10941 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
10942 ENDS_IN_UNIT_INTERVAL];
10943 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
10944 SUBSET_TRANS)) THEN
10945 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
10946 REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
10947 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
10948 ENDS_IN_UNIT_INTERVAL]]] THEN
10949 REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
10951 `\y:real^(1,1)finite_sum.
10952 (subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++
10953 (\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++
10954 subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0))))
10956 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
10957 SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
10958 PATHSTART_JOIN; PATHFINISH_JOIN;
10959 PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
10960 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
10961 ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
10962 [ALL_TAC; REWRITE_TAC[pathstart]] THEN
10964 [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
10965 REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
10967 MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
10968 ASM_REWRITE_TAC[PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL
10970 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
10971 REWRITE_TAC[PATHSTART_SUBPATH] THEN
10972 ASM_SIMP_TAC[pathstart; pathfinish]];
10973 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
10974 REWRITE_TAC[PATHFINISH_SUBPATH; PATHSTART_JOIN] THEN
10975 ASM_SIMP_TAC[pathstart]] THEN
10976 REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10977 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10978 REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; VECTOR_ADD_LID] THEN
10979 (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
10980 [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL;
10981 LIFT_DROP; CONTINUOUS_ON_NEG; DROP_NEG; CONTINUOUS_ON_CONST;
10982 CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
10983 LIFT_NEG; o_DEF; ETA_AX] THEN
10984 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10985 CONTINUOUS_ON_SUBSET)) THEN
10986 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10987 REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
10988 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
10989 REWRITE_TAC[DROP_ADD; DROP_NEG; DROP_VEC; DROP_CMUL; REAL_POS] THEN
10990 SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
10991 `t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN
10992 MATCH_MP_TAC(REAL_ARITH
10993 `t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN
10994 CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC;
10996 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ;
10997 RIGHT_FORALL_IMP_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10998 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
10999 REWRITE_TAC[SET_RULE
11000 `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
11001 REWRITE_TAC[GSYM path_image; ETA_AX] THEN
11002 REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
11003 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
11004 SUBSET_TRANS)) THEN
11005 REWRITE_TAC[path_image; subpath] THEN
11006 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
11007 REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
11008 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN
11009 SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
11010 REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; REAL_POS] THEN
11011 REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN
11012 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11013 ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN
11014 REPEAT STRIP_TAC THEN
11015 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
11016 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);;
11018 let HOMOTOPIC_LOOPS_CONJUGATE = prove
11019 (`!p q s:real^N->bool.
11020 path p /\ path_image p SUBSET s /\
11021 path q /\ path_image q SUBSET s /\
11022 pathfinish p = pathstart q /\ pathfinish q = pathstart q
11023 ==> homotopic_loops s (p ++ q ++ reversepath p) q`,
11024 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC
11025 `linepath(pathstart q,pathstart q) ++ (q:real^1->real^N) ++
11026 linepath(pathstart q,pathstart q)` THEN
11029 MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
11030 MP_TAC(ISPECL [`s:real^N->bool`;
11031 `(q:real^1->real^N) ++ linepath(pathfinish q,pathfinish q)`]
11032 HOMOTOPIC_PATHS_LID) THEN
11033 ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; SING_SUBSET;
11034 PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH;
11035 PATH_JOIN; PATH_IMAGE_JOIN; PATH_LINEPATH; SEGMENT_REFL] THEN
11037 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN
11038 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
11039 ASM_MESON_TAC[HOMOTOPIC_PATHS_RID]] THEN
11040 REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN
11042 `(\y. (subpath (fstcart y) (vec 1) p ++ q ++ subpath (vec 1) (fstcart y) p)
11043 (sndcart y)):real^(1,1)finite_sum->real^N` THEN
11044 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
11045 SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
11046 PATHSTART_JOIN; PATHFINISH_JOIN;
11047 PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
11048 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
11049 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11050 ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
11051 [RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN
11052 MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
11053 REPEAT CONJ_TAC THENL
11055 MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
11056 REPEAT CONJ_TAC THENL
11057 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11058 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11059 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11060 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11061 CONTINUOUS_ON_SUBSET)) THEN
11062 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11063 SIMP_TAC[SNDCART_PASTECART];
11065 REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_REWRITE_TAC[pathfinish]];
11066 REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_SUBPATH] THEN
11067 ASM_REWRITE_TAC[pathstart]] THEN
11068 REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11069 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11071 [REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
11072 SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART] THEN
11073 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11074 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11075 REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
11076 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
11078 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11079 CONTINUOUS_ON_SUBSET)) THEN
11080 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11081 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
11082 REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; DROP_CMUL]])
11084 [REPEAT STRIP_TAC THENL
11085 [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN
11086 TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC;
11087 REWRITE_TAC[REAL_ARITH `t + (&1 - t) * x <= &1 <=>
11088 (&1 - t) * x <= (&1 - t) * &1`] THEN
11089 MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC];
11090 REPEAT STRIP_TAC THENL
11091 [MATCH_MP_TAC(REAL_ARITH
11092 `x * (&1 - t) <= x * &1 /\ x <= &1
11093 ==> &0 <= &1 + (t - &1) * x`) THEN
11094 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
11095 ASM_REAL_ARITH_TAC;
11096 REWRITE_TAC[REAL_ARITH
11097 `a + (t - &1) * x <= a <=> &0 <= (&1 - t) * x`] THEN
11098 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]];
11099 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11100 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11101 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11102 REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
11103 `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
11104 REPEAT STRIP_TAC THEN
11105 REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
11106 ASM_REWRITE_TAC[] THEN
11107 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image p:real^N->bool` THEN
11108 ASM_REWRITE_TAC[] THEN
11109 MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
11110 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;
11112 (* ------------------------------------------------------------------------- *)
11113 (* Relating homotopy of trivial loops to path-connectedness. *)
11114 (* ------------------------------------------------------------------------- *)
11116 let PATH_COMPONENT_IMP_HOMOTOPIC_POINTS = prove
11118 path_component s a b
11119 ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
11120 REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN
11121 REPEAT GEN_TAC THEN REWRITE_TAC[pathstart; pathfinish; path_image; path] THEN
11122 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11123 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
11124 EXISTS_TAC `\y:real^(1,1)finite_sum. (g(fstcart y):real^N)` THEN
11125 ASM_SIMP_TAC[FSTCART_PASTECART; linepath] THEN
11126 REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % a:real^N = a`] THEN
11127 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
11128 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
11129 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11130 CONTINUOUS_ON_SUBSET)) THEN
11131 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; FSTCART_PASTECART]);;
11133 let HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE = prove
11134 (`!s p q:real^1->real^N t.
11135 homotopic_loops s p q /\ t IN interval[vec 0,vec 1]
11136 ==> path_component s (p t) (q t)`,
11137 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
11138 REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN
11139 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` MP_TAC) THEN
11141 EXISTS_TAC `\u. (h:real^(1,1)finite_sum->real^N) (pastecart u t)` THEN
11142 ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
11143 [REWRITE_TAC[path] THEN
11144 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
11146 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
11147 REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
11148 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11149 CONTINUOUS_ON_SUBSET)) THEN
11150 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11152 REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;
11154 let HOMOTOPIC_POINTS_EQ_PATH_COMPONENT = prove
11156 homotopic_loops s (linepath(a,a)) (linepath(b,b)) <=>
11157 path_component s a b`,
11158 REPEAT GEN_TAC THEN EQ_TAC THEN
11159 REWRITE_TAC[PATH_COMPONENT_IMP_HOMOTOPIC_POINTS] THEN
11160 DISCH_THEN(MP_TAC o SPEC `vec 0:real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11161 HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE)) THEN
11162 REWRITE_TAC[linepath; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
11163 REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
11165 let PATH_CONNECTED_EQ_HOMOTOPIC_POINTS = prove
11167 path_connected s <=>
11168 !a b. a IN s /\ b IN s
11169 ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
11170 GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
11171 REWRITE_TAC[path_connected; path_component]);;
11173 (* ------------------------------------------------------------------------- *)
11174 (* Homotopy of "nearby" function, paths and loops. *)
11175 (* ------------------------------------------------------------------------- *)
11177 let HOMOTOPIC_WITH_LINEAR = prove
11178 (`!f g:real^M->real^N s t.
11179 f continuous_on s /\ g continuous_on s /\
11180 (!x. x IN s ==> segment[f x,g x] SUBSET t)
11181 ==> homotopic_with (\z. T) (s,t) f g`,
11182 REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN
11184 `\y. ((&1 - drop(fstcart y)) % (f:real^M->real^N)(sndcart y) +
11185 drop(fstcart y) % g(sndcart y):real^N)` THEN
11186 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
11187 ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_SUB_RZERO] THEN
11188 REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
11189 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
11190 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
11191 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
11192 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11193 REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
11194 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
11195 LINEAR_FSTCART; ETA_AX] THEN
11196 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11197 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11198 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11199 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11200 CONTINUOUS_ON_SUBSET)) THEN
11201 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11202 SIMP_TAC[SNDCART_PASTECART; FORALL_IN_PCROSS];
11203 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
11204 MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^M`] THEN STRIP_TAC THEN
11205 SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11206 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN
11207 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^M` THEN
11208 ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
11209 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]);;
11211 let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove)
11212 (`(!g s:real^N->bool h.
11213 path g /\ path h /\
11214 pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
11215 (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
11216 ==> homotopic_paths s g h) /\
11217 (!g s:real^N->bool h.
11218 path g /\ path h /\
11219 pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
11220 (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
11221 ==> homotopic_loops s g h)`,
11223 (REWRITE_TAC[pathstart; pathfinish] THEN
11224 REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN
11225 REWRITE_TAC[homotopic_paths; homotopic_loops; homotopic_with; PCROSS] THEN
11227 `\y:real^(1,1)finite_sum.
11228 ((&1 - drop(fstcart y)) % g(sndcart y) +
11229 drop(fstcart y) % h(sndcart y):real^N)` THEN
11230 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
11231 ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN
11232 REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
11233 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
11234 REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
11235 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
11236 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11237 REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
11238 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
11239 LINEAR_FSTCART; ETA_AX] THEN
11240 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11241 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11242 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11243 RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
11244 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11245 CONTINUOUS_ON_SUBSET)) THEN
11246 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11247 SIMP_TAC[SNDCART_PASTECART];
11248 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11249 MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN
11250 SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11251 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN
11252 ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
11253 ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));;
11255 let HOMOTOPIC_PATHS_NEARBY_EXPLICIT,
11256 HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove)
11257 (`(!g s:real^N->bool h.
11258 path g /\ path h /\
11259 pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
11260 (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
11261 ==> norm(h t - g t) < norm(g t - x))
11262 ==> homotopic_paths s g h) /\
11263 (!g s:real^N->bool h.
11264 path g /\ path h /\
11265 pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
11266 (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
11267 ==> norm(h t - g t) < norm(g t - x))
11268 ==> homotopic_loops s g h)`,
11269 ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
11270 REPEAT STRIP_TAC THENL
11271 [MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR;
11272 MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN
11273 ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN
11274 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
11275 X_GEN_TAC `u:real` THEN STRIP_TAC THEN
11276 FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN
11277 ASM_REWRITE_TAC[REAL_NOT_LT] THEN
11278 MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`]
11279 DIST_IN_CLOSED_SEGMENT) THEN
11280 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11281 REWRITE_TAC[segment; FORALL_IN_GSPEC;
11282 ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
11285 let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove)
11286 (`(!g s:real^N->bool.
11287 path g /\ open s /\ path_image g SUBSET s
11290 pathstart h = pathstart g /\
11291 pathfinish h = pathfinish g /\
11292 (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
11293 ==> homotopic_paths s g h) /\
11294 (!g s:real^N->bool.
11295 path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s
11298 pathfinish h = pathstart h /\
11299 (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
11300 ==> homotopic_loops s g h)`,
11302 REPEAT STRIP_TAC THEN
11303 MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`]
11304 SEPARATE_COMPACT_CLOSED) THEN
11305 ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN
11306 (ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN
11307 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
11308 REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11309 X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL
11310 [MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT;
11311 MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN
11312 ASM_REWRITE_TAC[] THEN
11313 MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN
11314 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN
11315 ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11316 ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
11318 (* ------------------------------------------------------------------------- *)
11319 (* Homotopy of non-antipodal sphere maps. *)
11320 (* ------------------------------------------------------------------------- *)
11322 let HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS = prove
11323 (`!f g:real^M->real^N s a r.
11324 f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
11325 g continuous_on s /\ IMAGE g s SUBSET sphere(a,r) /\
11326 (!x. x IN s ==> ~(midpoint(f x,g x) = a))
11327 ==> homotopic_with (\x. T) (s,sphere(a,r)) f g`,
11328 REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
11329 [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
11330 REPEAT(EXISTS_TAC `g:real^M->real^N`) THEN
11331 ASM_REWRITE_TAC[HOMOTOPIC_WITH_REFL] THEN
11332 SUBGOAL_THEN `?c:real^N. sphere(a,r) SUBSET {c}` MP_TAC THENL
11333 [ALL_TAC; ASM SET_TAC[]] THEN
11334 ASM_CASES_TAC `r = &0` THEN
11335 ASM_SIMP_TAC[SPHERE_SING; SPHERE_EMPTY; REAL_LT_LE] THEN
11336 MESON_TAC[SUBSET_REFL; EMPTY_SUBSET];
11337 RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN STRIP_TAC] THEN
11339 `homotopic_with (\z. T) (s:real^M->bool,(:real^N) DELETE a) f g`
11341 [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
11342 ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE a <=> ~(a IN s)`] THEN
11343 X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11344 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN
11345 REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE; IMP_IMP] THEN
11346 REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
11347 FIRST_X_ASSUM(MP_TAC o GSYM o SPEC `x:real^M`) THEN
11348 ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; MIDPOINT_BETWEEN] THEN
11349 MESON_TAC[DIST_SYM];
11351 DISCH_THEN(MP_TAC o
11352 ISPECL [`\y:real^N. a + r / norm(y - a) % (y - a)`;
11353 `sphere(a:real^N,r)`] o
11354 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
11355 HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
11356 REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
11358 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
11359 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11360 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
11361 REWRITE_TAC[real_div; o_DEF; LIFT_CMUL] THEN
11362 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
11363 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
11364 SIMP_TAC[IN_DELETE; NORM_EQ_0; VECTOR_SUB_EQ] THEN
11365 MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
11366 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
11367 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE; IN_SPHERE] THEN
11368 REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b`] THEN
11369 SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
11370 ASM_SIMP_TAC[real_abs; REAL_LE_RMUL; REAL_DIV_RMUL;
11371 NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_LE]];
11372 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
11373 RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE]) THEN
11374 ASM_SIMP_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN
11375 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN
11376 VECTOR_ARITH_TAC]);;
11378 let HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS = prove
11379 (`!f g:real^M->real^N s r.
11380 f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,r) /\
11381 g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,r) /\
11382 (!x. x IN s ==> ~(f x = --g x))
11383 ==> homotopic_with (\x. T) (s,sphere(vec 0,r)) f g`,
11384 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS THEN
11385 ASM_REWRITE_TAC[midpoint; VECTOR_ARITH
11386 `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`]);;
11388 (* ------------------------------------------------------------------------- *)
11389 (* Retracts, in a general sense, preserve (co)homotopic triviality. *)
11390 (* ------------------------------------------------------------------------- *)
11392 let HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
11393 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
11394 (h continuous_on s /\ IMAGE h s = t /\
11395 k continuous_on t /\ IMAGE k t SUBSET s /\
11396 (!y. y IN t ==> h(k y) = y) /\
11397 (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
11398 (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
11399 (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
11400 (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ P f /\
11401 g continuous_on u /\ IMAGE g u SUBSET s /\ P g
11402 ==> homotopic_with P (u,s) f g)
11403 ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f /\
11404 g continuous_on u /\ IMAGE g u SUBSET t /\ Q g
11405 ==> homotopic_with Q (u,t) f g)`,
11406 REPEAT GEN_TAC THEN STRIP_TAC THEN
11407 MAP_EVERY X_GEN_TAC [`p:real^P->real^N`; `q:real^P->real^N`] THEN
11408 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
11409 [`(k:real^N->real^M) o (p:real^P->real^N)`;
11410 `(k:real^N->real^M) o (q:real^P->real^N)`]) THEN
11412 [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
11413 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
11414 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11415 CONTINUOUS_ON_SUBSET))) THEN
11418 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
11419 [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
11420 `(h:real^M->real^N) o (k:real^N->real^M) o (q:real^P->real^N)`] THEN
11421 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
11422 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11423 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
11424 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
11425 HOMOTOPIC_WITH_MONO)) THEN
11428 let HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
11429 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
11430 (h continuous_on s /\ IMAGE h s = t /\
11431 k continuous_on t /\ IMAGE k t SUBSET s /\
11432 (!y. y IN t ==> h(k y) = y) /\
11433 (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
11434 (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
11435 (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
11436 (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f
11437 ==> ?c. homotopic_with P (u,s) f (\x. c))
11438 ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f
11439 ==> ?c. homotopic_with Q (u,t) f (\x. c))`,
11440 REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^P->real^N` THEN
11441 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
11442 `(k:real^N->real^M) o (p:real^P->real^N)`) THEN
11444 [ASM_SIMP_TAC[IMAGE_o] THEN CONJ_TAC THEN
11445 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
11446 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11447 CONTINUOUS_ON_SUBSET))) THEN
11449 DISCH_THEN(X_CHOOSE_TAC `c:real^M`)] THEN
11450 EXISTS_TAC `(h:real^M->real^N) c` THEN
11451 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
11452 [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
11453 `(h:real^M->real^N) o ((\x. c):real^P->real^M)`] THEN
11454 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
11455 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11456 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
11457 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
11458 HOMOTOPIC_WITH_MONO)) THEN
11461 let COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
11462 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
11463 (h continuous_on s /\ IMAGE h s = t /\
11464 k continuous_on t /\ IMAGE k t SUBSET s /\
11465 (!y. y IN t ==> h(k y) = y) /\
11466 (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
11467 (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
11468 (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
11469 (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ P f /\
11470 g continuous_on s /\ IMAGE g s SUBSET u /\ P g
11471 ==> homotopic_with P (s,u) f g)
11472 ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f /\
11473 g continuous_on t /\ IMAGE g t SUBSET u /\ Q g
11474 ==> homotopic_with Q (t,u) f g)`,
11475 REPEAT GEN_TAC THEN STRIP_TAC THEN
11476 MAP_EVERY X_GEN_TAC [`p:real^N->real^P`; `q:real^N->real^P`] THEN
11477 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
11478 [`(p:real^N->real^P) o (h:real^M->real^N)`;
11479 `(q:real^N->real^P) o (h:real^M->real^N)`]) THEN
11481 [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
11482 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
11483 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11484 CONTINUOUS_ON_SUBSET))) THEN
11487 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
11488 [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
11489 `((q:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`] THEN
11490 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
11491 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
11492 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
11493 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
11494 HOMOTOPIC_WITH_MONO)) THEN
11497 let COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
11498 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
11499 (h continuous_on s /\ IMAGE h s = t /\
11500 k continuous_on t /\ IMAGE k t SUBSET s /\
11501 (!y. y IN t ==> h(k y) = y) /\
11502 (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
11503 (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
11504 (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
11505 (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f
11506 ==> ?c. homotopic_with P (s,u) f (\x. c))
11507 ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f
11508 ==> ?c. homotopic_with Q (t,u) f (\x. c))`,
11509 REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^N->real^P` THEN
11510 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
11511 `(p:real^N->real^P) o (h:real^M->real^N)`) THEN
11513 [ASM_SIMP_TAC[IMAGE_o] THEN
11514 TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
11515 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11516 CONTINUOUS_ON_SUBSET))) THEN
11518 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
11519 MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
11520 [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
11521 `((\x. c):real^M->real^P) o (k:real^N->real^M)`] THEN
11522 ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
11523 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
11524 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
11525 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
11526 HOMOTOPIC_WITH_MONO)) THEN
11529 (* ------------------------------------------------------------------------- *)
11530 (* Another useful lemma. *)
11531 (* ------------------------------------------------------------------------- *)
11533 let HOMOTOPIC_JOIN_SUBPATHS = prove
11534 (`!g:real^1->real^N s.
11535 path g /\ path_image g SUBSET s /\
11536 u IN interval[vec 0,vec 1] /\
11537 v IN interval[vec 0,vec 1] /\
11538 w IN interval[vec 0,vec 1]
11539 ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`,
11541 (`!g:real^1->real^N s.
11542 drop u <= drop v /\ drop v <= drop w
11543 ==> path g /\ path_image g SUBSET s /\
11544 u IN interval[vec 0,vec 1] /\
11545 v IN interval[vec 0,vec 1] /\
11546 w IN interval[vec 0,vec 1] /\
11547 drop u <= drop v /\ drop v <= drop w
11548 ==> homotopic_paths s
11549 (subpath u v g ++ subpath v w g) (subpath u w g)`,
11550 REPEAT STRIP_TAC THEN
11551 MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
11552 EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
11553 ASM_CASES_TAC `w:real^1 = u` THENL
11555 [`path_image g:real^N->bool`;
11556 `subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN
11557 ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN
11558 REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN
11559 ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET];
11561 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11562 MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
11563 ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
11565 `\t. if drop t <= &1 / &2
11566 then inv(drop(w - u)) % (&2 * drop(v - u)) % t
11567 else inv(drop(w - u)) %
11568 ((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN
11569 REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11570 REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
11571 [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
11572 REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM;
11573 DROP_ADD; DROP_SUB] THEN
11574 (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
11575 [CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
11576 CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN
11577 REPEAT STRIP_TAC THEN REAL_ARITH_TAC;
11578 SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL
11579 [ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC;
11581 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
11582 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN
11583 REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN
11584 ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
11585 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
11586 REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
11587 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11589 [REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN
11590 REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN
11591 ASM_REAL_ARITH_TAC;
11593 REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`;
11594 REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN
11595 MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN
11596 (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN
11597 ASM_REAL_ARITH_TAC;
11598 REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
11599 CONV_TAC REAL_RAT_REDUCE_CONV THEN
11600 REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN
11601 ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV];
11602 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
11603 REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN
11604 ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
11605 ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN
11607 REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
11608 REAL_ARITH_TAC]) in
11610 (`path g /\ path_image g SUBSET s /\
11611 u IN interval[vec 0,vec 1] /\
11612 v IN interval[vec 0,vec 1] /\
11613 w IN interval[vec 0,vec 1] /\
11614 homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
11615 ==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`,
11616 REPEAT STRIP_TAC THEN
11617 ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
11618 SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
11619 ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in
11621 (`path (g:real^1->real^N) /\ path_image g SUBSET s /\
11622 u IN interval[vec 0,vec 1] /\
11623 v IN interval[vec 0,vec 1] /\
11624 w IN interval[vec 0,vec 1] /\
11625 homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
11626 ==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`,
11628 ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH;
11629 HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS;
11630 PATHSTART_JOIN; PATHFINISH_JOIN] in
11631 REPEAT STRIP_TAC THEN
11632 ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
11633 SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
11634 ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN
11635 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11637 `(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN
11639 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
11640 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11641 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac;
11643 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11645 `subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN
11647 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11648 MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac;
11650 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11652 `(subpath u v g :real^1->real^N) ++
11653 linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN
11654 CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN
11655 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
11656 REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN
11657 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11659 `linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN
11661 [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN
11662 MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac;
11664 REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL;
11665 PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
11666 INSERT_SUBSET; EMPTY_SUBSET] THEN
11667 ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in
11668 REPEAT STRIP_TAC THEN
11669 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
11670 (REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/
11671 drop w <= drop v /\ drop v <= drop u) \/
11672 (drop u <= drop w /\ drop w <= drop v \/
11673 drop v <= drop w /\ drop w <= drop u) \/
11674 (drop v <= drop u /\ drop u <= drop w \/
11675 drop w <= drop u /\ drop u <= drop v)`) THEN
11676 FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o
11677 MATCH_MP lemma1) THEN
11678 ASM_MESON_TAC[lemma2; lemma3]);;
11680 let HOMOTOPIC_LOOPS_SHIFTPATH = prove
11681 (`!s:real^N->bool p q u.
11682 homotopic_loops s p q /\ u IN interval[vec 0,vec 1]
11683 ==> homotopic_loops s (shiftpath u p) (shiftpath u q)`,
11684 REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN
11685 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(
11686 (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
11688 `\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N)
11689 (pastecart (fstcart z) t)) (sndcart z)` THEN
11690 ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX] THEN
11691 ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN CONJ_TAC THENL
11692 [REWRITE_TAC[shiftpath; DROP_ADD; REAL_ARITH
11693 `u + z <= &1 <=> z <= &1 - u`] THEN
11695 `{ pastecart (t:real^1) (x:real^1) |
11696 t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1]} =
11697 { pastecart (t:real^1) (x:real^1) |
11698 t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1 - u]} UNION
11699 { pastecart (t:real^1) (x:real^1) |
11700 t IN interval[vec 0,vec 1] /\ x IN interval[vec 1 - u,vec 1]}`
11702 [MATCH_MP_TAC(SET_RULE `s UNION s' = u
11703 ==> {f t x | t IN i /\ x IN u} =
11704 {f t x | t IN i /\ x IN s} UNION
11705 {f t x | t IN i /\ x IN s'}`) THEN
11706 UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
11707 REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; DROP_SUB; DROP_VEC] THEN
11710 MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
11711 SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL] THEN
11712 REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; TAUT
11713 `p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN
11714 SIMP_TAC[SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
11715 SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN
11716 SIMP_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
11717 REWRITE_TAC[FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`;
11718 VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN
11719 RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11720 ASM_SIMP_TAC[GSYM IN_INTERVAL_1; GSYM DROP_VEC] THEN CONJ_TAC THEN
11721 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11722 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11723 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST;
11724 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11725 VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN
11726 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11727 CONTINUOUS_ON_SUBSET)) THEN
11728 UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
11729 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11730 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
11731 IN_ELIM_PASTECART_THM; DROP_ADD; DROP_SUB; DROP_VEC] THEN
11733 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11734 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE
11735 `(!t x. t IN i /\ x IN i ==> f t x IN s) <=>
11736 (!t. t IN i ==> IMAGE (f t) i SUBSET s)`] THEN
11737 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN
11738 ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; ETA_AX] THEN
11739 REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;
11741 let HOMOTOPIC_PATHS_LOOP_PARTS = prove
11743 homotopic_loops s (p ++ reversepath q) (linepath(a,a)) /\ path q
11744 ==> homotopic_paths s p q`,
11745 REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
11746 MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL) THEN
11747 REWRITE_TAC[PATHSTART_JOIN] THEN STRIP_TAC THEN
11748 FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
11749 ASM_CASES_TAC `pathfinish p:real^N = pathstart(reversepath q)` THENL
11750 [ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH] THEN STRIP_TAC;
11751 ASM_MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_REVERSEPATH]] THEN
11752 RULE_ASSUM_TAC(REWRITE_RULE[PATHSTART_REVERSEPATH]) THEN
11753 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
11754 ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
11755 PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; UNION_SUBSET; SING_SUBSET;
11756 PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
11758 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11759 EXISTS_TAC `p ++ (linepath(pathfinish p:real^N,pathfinish p))` THEN
11761 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11762 MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[];
11764 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11765 EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL
11766 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11767 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
11768 ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; PATHSTART_JOIN; PATHSTART_REVERSEPATH;
11769 HOMOTOPIC_PATHS_REFL];
11771 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11772 EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL
11773 [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
11774 ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
11775 PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH];
11777 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11778 EXISTS_TAC `linepath(pathstart p:real^N,pathstart p) ++ q` THEN
11780 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
11781 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
11782 REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
11783 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
11784 REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH;
11785 PATHFINISH_REVERSEPATH] THEN
11786 DISCH_THEN(SUBST1_TAC o SYM) THEN
11787 MATCH_MP_TAC HOMOTOPIC_PATHS_LID THEN ASM_REWRITE_TAC[]]);;
11789 let HOMOTOPIC_LOOPS_ADD_SYM = prove
11790 (`!p q:real^1->real^N.
11791 path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
11792 path q /\ path_image q SUBSET s /\ pathfinish q = pathstart q /\
11793 pathstart q = pathstart p
11794 ==> homotopic_loops s (p ++ q) (q ++ p)`,
11795 REPEAT STRIP_TAC THEN
11796 MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
11797 SUBGOAL_THEN `lift(&1 / &2) IN interval[vec 0,vec 1]` ASSUME_TAC THENL
11798 [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
11799 CONV_TAC REAL_RAT_REDUCE_CONV;
11801 EXISTS_TAC `shiftpath (lift(&1 / &2)) (p ++ q:real^1->real^N)` THEN
11803 [MATCH_MP_TAC HOMOTOPIC_LOOPS_SHIFTPATH_SELF;
11804 MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ] THEN
11805 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
11806 UNION_SUBSET; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
11807 PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH] THEN
11808 SIMP_TAC[shiftpath; joinpaths; LIFT_DROP; DROP_ADD; DROP_SUB; DROP_VEC;
11809 REAL_ARITH `&0 <= t ==> (a + t <= a <=> t = &0)`;
11810 REAL_ARITH `t <= &1 ==> &1 / &2 + t - &1 <= &1 / &2`;
11811 REAL_ARITH `&1 / &2 + t <= &1 <=> t <= &1 / &2`] THEN
11812 X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
11813 ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
11814 [REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
11815 COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THENL
11816 [REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_MUL_RZERO] THEN
11817 CONV_TAC REAL_RAT_REDUCE_CONV THEN
11818 ASM_MESON_TAC[LIFT_NUM; pathstart; pathfinish];
11822 REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_ADD; DROP_VEC; DROP_CMUL;
11823 LIFT_DROP] THEN REAL_ARITH_TAC);;
11825 (* ------------------------------------------------------------------------- *)
11826 (* Simply connected sets defined as "all loops are homotopic (as loops)". *)
11827 (* ------------------------------------------------------------------------- *)
11829 let simply_connected = new_definition
11830 `simply_connected(s:real^N->bool) <=>
11831 !p q. path p /\ pathfinish p = pathstart p /\ path_image p SUBSET s /\
11832 path q /\ pathfinish q = pathstart q /\ path_image q SUBSET s
11833 ==> homotopic_loops s p q`;;
11835 let SIMPLY_CONNECTED_EMPTY = prove
11836 (`simply_connected {}`,
11837 REWRITE_TAC[simply_connected; SUBSET_EMPTY] THEN
11838 MESON_TAC[PATH_IMAGE_NONEMPTY]);;
11840 let SIMPLY_CONNECTED_IMP_PATH_CONNECTED = prove
11841 (`!s:real^N->bool. simply_connected s ==> path_connected s`,
11842 REWRITE_TAC[simply_connected; PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
11843 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11844 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
11845 PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
11848 let SIMPLY_CONNECTED_IMP_CONNECTED = prove
11849 (`!s:real^N->bool. simply_connected s ==> connected s`,
11850 SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED;
11851 PATH_CONNECTED_IMP_CONNECTED]);;
11853 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY = prove
11855 simply_connected s <=>
11856 !p a. path p /\ path_image p SUBSET s /\
11857 pathfinish p = pathstart p /\ a IN s
11858 ==> homotopic_loops s p (linepath(a,a))`,
11859 GEN_TAC THEN REWRITE_TAC[simply_connected] THEN EQ_TAC THEN DISCH_TAC THENL
11860 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11861 ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
11862 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
11863 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN
11864 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
11865 EXISTS_TAC `linepath(pathstart p:real^N,pathstart p)` THEN
11866 CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM]] THEN
11867 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
11868 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;
11870 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME = prove
11872 simply_connected s <=>
11873 path_connected s /\
11874 !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
11875 ==> ?a. a IN s /\ homotopic_loops s p (linepath(a,a))`,
11876 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
11877 ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THENL
11878 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
11879 [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
11880 MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE];
11881 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
11882 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN
11883 FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
11884 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
11885 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
11886 EXISTS_TAC `linepath(b:real^N,b)` THEN
11887 ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
11888 ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]]);;
11890 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL = prove
11892 simply_connected s <=>
11895 !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
11896 ==> homotopic_loops s p (linepath(a,a))`,
11897 GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
11898 ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
11899 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN
11902 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
11903 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
11904 ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN
11905 FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
11906 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
11907 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
11908 EXISTS_TAC `linepath(b:real^N,b)` THEN
11909 ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
11910 ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT];
11911 DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
11912 CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
11913 REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
11914 MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN
11915 MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
11916 EXISTS_TAC `linepath(a:real^N,a)` THEN
11917 GEN_REWRITE_TAC RAND_CONV [HOMOTOPIC_LOOPS_SYM] THEN
11918 CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11919 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
11920 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
11923 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH = prove
11925 simply_connected s <=>
11926 path_connected s /\
11927 !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
11928 ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
11929 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
11930 [ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
11931 REPEAT STRIP_TAC THEN
11932 MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN
11933 EXISTS_TAC `pathstart p :real^N` THEN
11934 FIRST_X_ASSUM(MATCH_MP_TAC o
11935 REWRITE_RULE[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
11936 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
11937 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
11938 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN
11939 STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
11940 EXISTS_TAC `linepath(pathstart p:real^N,pathfinish p)` THEN
11942 [MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
11943 ASM_SIMP_TAC[PATHFINISH_LINEPATH];
11944 ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
11945 RULE_ASSUM_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
11946 FIRST_X_ASSUM MATCH_MP_TAC THEN
11947 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]]);;
11949 let SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS = prove
11951 simply_connected s <=>
11952 path_connected s /\
11953 !p q. path p /\ path_image p SUBSET s /\
11954 path q /\ path_image q SUBSET s /\
11955 pathstart q = pathstart p /\ pathfinish q = pathfinish p
11956 ==> homotopic_paths s p q`,
11957 REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN
11958 EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11959 X_GEN_TAC `p:real^1->real^N` THENL
11960 [X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN
11961 FIRST_X_ASSUM(MP_TAC o SPEC `p ++ reversepath q :real^1->real^N`) THEN
11962 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_REVERSEPATH; PATH_REVERSEPATH;
11963 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH;
11964 PATH_IMAGE_JOIN; UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN
11966 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11967 EXISTS_TAC `p ++ linepath(pathfinish p,pathfinish p):real^1->real^N` THEN
11968 GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_PATHS_SYM] THEN
11969 ASM_SIMP_TAC[HOMOTOPIC_PATHS_RID] THEN
11970 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11971 EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN
11973 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
11974 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_LINEPATH] THEN
11975 ASM_MESON_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_SYM];
11977 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11978 EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN
11980 [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
11981 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
11982 ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH];
11984 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11985 EXISTS_TAC `linepath(pathstart q,pathstart q) ++ q:real^1->real^N` THEN
11987 [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
11988 ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL] THEN
11989 ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
11990 ASM_MESON_TAC[HOMOTOPIC_PATHS_LID]];
11991 STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11992 ASM_SIMP_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
11993 REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
11994 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;
11996 let SIMPLY_CONNECTED_RETRACTION_GEN = prove
11997 (`!s:real^M->bool t:real^N->bool h k.
11998 h continuous_on s /\ IMAGE h s = t /\
11999 k continuous_on t /\ IMAGE k t SUBSET s /\
12000 (!y. y IN t ==> h(k y) = y) /\
12002 ==> simply_connected t`,
12003 REPEAT GEN_TAC THEN
12004 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12005 REWRITE_TAC[simply_connected; path; path_image; homotopic_loops] THEN
12006 ONCE_REWRITE_TAC[TAUT
12007 `a /\ b /\ c /\ a' /\ b' /\ c' <=> a /\ c /\ b /\ a' /\ c' /\ b'`] THEN
12008 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
12009 HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN
12010 MAP_EVERY EXISTS_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
12011 ASM_SIMP_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
12012 REWRITE_TAC[pathfinish; pathstart] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
12014 let HOMEOMORPHIC_SIMPLY_CONNECTED = prove
12015 (`!s:real^M->bool t:real^N->bool.
12016 s homeomorphic t /\ simply_connected s
12017 ==> simply_connected t`,
12018 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
12019 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
12020 (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN
12021 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
12022 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
12023 SIMP_TAC[homeomorphism; SUBSET_REFL]);;
12025 let HOMEOMORPHIC_SIMPLY_CONNECTED_EQ = prove
12026 (`!s:real^M->bool t:real^N->bool.
12028 ==> (simply_connected s <=> simply_connected t)`,
12029 REPEAT STRIP_TAC THEN EQ_TAC THEN
12030 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SIMPLY_CONNECTED) THEN
12031 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
12032 ASM_REWRITE_TAC[]);;
12034 let SIMPLY_CONNECTED_TRANSLATION = prove
12035 (`!a:real^N s. simply_connected (IMAGE (\x. a + x) s) <=> simply_connected s`,
12036 REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
12037 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
12038 REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;
12040 add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];;
12042 let SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE = prove
12043 (`!f:real^M->real^N s.
12044 linear f /\ (!x y. f x = f y ==> x = y)
12045 ==> (simply_connected (IMAGE f s) <=> simply_connected s)`,
12046 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
12047 ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
12048 HOMEOMORPHIC_REFL]);;
12050 add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];;
12052 let SIMPLY_CONNECTED_PCROSS = prove
12053 (`!s:real^M->bool t:real^N->bool.
12054 simply_connected s /\ simply_connected t
12055 ==> simply_connected(s PCROSS t)`,
12056 REPEAT GEN_TAC THEN
12057 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
12058 REWRITE_TAC[path; path_image; pathstart; pathfinish; FORALL_PASTECART] THEN
12060 MAP_EVERY X_GEN_TAC
12061 [`p:real^1->real^(M,N)finite_sum`; `a:real^M`; `b:real^N`] THEN
12062 REWRITE_TAC[PASTECART_IN_PCROSS; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN
12063 FIRST_X_ASSUM(CONJUNCTS_THEN2
12064 (MP_TAC o SPECL [`fstcart o (p:real^1->real^(M,N)finite_sum)`; `a:real^M`])
12065 (MP_TAC o SPECL [`sndcart o (p:real^1->real^(M,N)finite_sum)`;
12067 ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_FSTCART; LINEAR_SNDCART;
12068 LINEAR_CONTINUOUS_ON; homotopic_loops; homotopic_with;
12069 pathfinish; pathstart; IMAGE_o; o_THM] THEN
12070 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
12071 [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
12072 ASM_MESON_TAC[SNDCART_PASTECART];
12073 DISCH_THEN(X_CHOOSE_THEN
12074 `k:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)] THEN
12076 [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
12077 ASM_MESON_TAC[FSTCART_PASTECART];
12078 DISCH_THEN(X_CHOOSE_THEN
12079 `h:real^(1,1)finite_sum->real^M` STRIP_ASSUME_TAC)] THEN
12081 `(\z. pastecart (h z) (k z))
12082 :real^(1,1)finite_sum->real^(M,N)finite_sum` THEN
12083 ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX] THEN
12084 REWRITE_TAC[LINEPATH_REFL; PASTECART_FST_SND] THEN
12085 ASM_SIMP_TAC[PASTECART_IN_PCROSS]);;
12087 let SIMPLY_CONNECTED_PCROSS_EQ = prove
12088 (`!s:real^M->bool t:real^N->bool.
12089 simply_connected(s PCROSS t) <=>
12090 s = {} \/ t = {} \/ simply_connected s /\ simply_connected t`,
12091 REPEAT GEN_TAC THEN
12092 ASM_CASES_TAC `s:real^M->bool = {}` THEN
12093 ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
12094 ASM_CASES_TAC `t:real^N->bool = {}` THEN
12095 ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
12096 EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
12097 [REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
12098 MAP_EVERY X_GEN_TAC [`p:real^1->real^M`; `a:real^M`] THEN
12099 REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
12100 FORALL_IN_IMAGE] THEN
12101 STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN
12102 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
12103 DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
12104 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
12105 [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
12106 DISCH_THEN(MP_TAC o SPECL
12107 [`(\t. pastecart (p t) (b)):real^1->real^(M,N)finite_sum`;
12108 `pastecart (a:real^M) (b:real^N)`]) THEN
12109 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
12110 ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
12111 FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
12112 CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
12115 [`(\t. pastecart (p t) b):real^1->real^(M,N)finite_sum`;
12116 `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
12117 `fstcart:real^(M,N)finite_sum->real^M`;
12118 `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`]
12119 HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
12120 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
12121 SIMP_TAC[o_DEF; LINEPATH_REFL; FSTCART_PASTECART; ETA_AX;
12122 SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE];
12123 REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
12124 MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `b:real^N`] THEN
12125 REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
12126 FORALL_IN_IMAGE] THEN
12127 STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN
12128 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
12129 DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
12130 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
12131 [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
12132 DISCH_THEN(MP_TAC o SPECL
12133 [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
12134 `pastecart (a:real^M) (b:real^N)`]) THEN
12135 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
12136 ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
12137 FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
12138 CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
12141 [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
12142 `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
12143 `sndcart:real^(M,N)finite_sum->real^N`;
12144 `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`]
12145 HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
12146 ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12147 SIMP_TAC[o_DEF; LINEPATH_REFL; SNDCART_PASTECART; ETA_AX;
12148 SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]]);;
12150 (* ------------------------------------------------------------------------- *)
12151 (* A mapping out of a sphere is nullhomotopic iff it extends to the ball. *)
12152 (* This even works out in the degenerate cases when the radius is <= 0, and *)
12153 (* we also don't need to explicitly assume continuity since it's already *)
12154 (* implicit in both sides of the equivalence. *)
12155 (* ------------------------------------------------------------------------- *)
12157 let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove
12158 (`!f:real^M->real^N s a r.
12159 (?c. homotopic_with (\x. T) (sphere(a,r),s) f (\x. c)) <=>
12160 (?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\
12161 !x. x IN sphere(a,r) ==> g x = f x)`,
12163 (`!f:real^M->real^N g a r.
12166 !x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\
12167 g continuous_on (cball(a,r) DELETE a) /\
12168 (!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x)
12169 ==> f continuous_on cball(a,r)`,
12170 REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
12171 X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN
12172 ASM_CASES_TAC `x:real^M = a` THENL
12173 [ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN
12174 RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN
12175 X_GEN_TAC `e:real` THEN DISCH_TAC THEN
12176 FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
12177 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
12178 GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
12179 X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN
12180 ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0];
12181 MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
12182 EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN
12183 ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN
12185 [RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]);
12187 `(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN
12188 REWRITE_TAC[continuous_on; continuous_within] THEN
12189 DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
12190 ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN
12191 MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
12192 ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
12193 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
12194 EXISTS_TAC `min d (norm(x - a:real^M))` THEN
12195 ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN
12196 ASM_MESON_TAC[NORM_SUB; NORM_ARITH
12197 `norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in
12198 REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
12199 REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
12200 (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
12202 [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN
12203 FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN
12204 ASM_SIMP_TAC[HOMOTOPIC_WITH; IMAGE_CLAUSES; EMPTY_GSPEC; NOT_IN_EMPTY;
12205 PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN
12206 REWRITE_TAC[CONTINUOUS_ON_EMPTY];
12207 ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN
12208 SIMP_TAC[HOMOTOPIC_WITH; PCROSS; FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN
12209 ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL
12210 [MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL
12211 [EXISTS_TAC `(f:real^M->real^N) a` THEN
12212 EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN
12213 ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE];
12214 EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN
12216 MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL
12217 [ASM SET_TAC[]; STRIP_TAC] THEN
12218 UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN
12219 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
12220 `IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN
12221 REWRITE_TAC[EXISTS_IN_GSPEC] THEN
12222 EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN
12223 ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]];
12226 `!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN
12228 `(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\
12229 IMAGE f {x | norm(x - a) = r} SUBSET s` THEN
12230 REPEAT CONJ_TAC THENL
12232 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
12233 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
12235 DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
12237 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN
12238 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
12239 EXISTS_TAC `cball(a:real^M,r)`;
12240 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
12241 `IMAGE g t SUBSET s
12242 ==> u SUBSET t /\ (!x. x IN u ==> f x = g x)
12243 ==> IMAGE f u SUBSET s`)) THEN
12244 ASM_SIMP_TAC[]] THEN
12245 ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN
12246 MESON_TAC[REAL_LE_REFL; NORM_SUB];
12248 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL
12249 [REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
12250 MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN
12252 EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
12253 (pastecart (lift(inv(r) * norm(x - a)))
12254 (a + (if x = a then r % basis 1
12255 else r / norm(x - a) % (x - a))))` THEN
12256 ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ;
12257 LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
12258 REPEAT CONJ_TAC THENL
12259 [MATCH_MP_TAC lemma THEN
12260 EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
12261 (pastecart (lift(inv(r) * norm(x - a)))
12262 (a + r / norm(x - a) % (x - a)))` THEN
12263 SIMP_TAC[] THEN CONJ_TAC THENL
12264 [X_GEN_TAC `e:real` THEN DISCH_TAC THEN
12265 ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN
12266 FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12267 COMPACT_UNIFORMLY_CONTINUOUS)) THEN
12268 SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS;
12269 REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere]
12270 COMPACT_SPHERE; COMPACT_INTERVAL] THEN
12271 REWRITE_TAC[uniformly_continuous_on] THEN
12272 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
12273 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
12274 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
12275 EXISTS_TAC `min r (d * r):real` THEN
12276 ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN
12277 X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN
12278 FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN
12279 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN
12280 ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
12281 DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
12282 `(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN
12283 REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
12284 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
12285 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
12286 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
12287 ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
12288 ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN
12289 REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
12290 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
12291 ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN
12292 REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN
12293 REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN
12294 CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN
12295 REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN
12296 ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM;
12297 REAL_ARITH `&0 < r ==> abs r = r`];
12298 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12299 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
12300 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
12301 SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB;
12302 CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
12303 CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
12304 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
12305 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
12306 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12307 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
12308 o_DEF; real_div; LIFT_CMUL] THEN
12309 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
12310 REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
12311 GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN
12312 MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
12313 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN
12314 ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN
12315 MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
12316 SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
12317 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12318 CONTINUOUS_ON_SUBSET)) THEN
12319 REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
12320 REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN
12321 SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
12322 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
12323 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
12324 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
12325 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
12326 ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
12327 SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
12328 REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
12329 ASM_REAL_ARITH_TAC]];
12330 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
12331 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
12332 `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN
12333 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12334 REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN
12335 X_GEN_TAC `x:real^M` THEN
12336 REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL
12337 [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
12338 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
12339 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
12340 ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE];
12341 REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN
12342 ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL;
12343 REAL_ABS_DIV; REAL_ABS_NORM;
12344 REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN
12345 ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]];
12346 GEN_TAC THEN COND_CASES_TAC THEN
12347 ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN
12348 REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]];
12349 DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
12350 EXISTS_TAC `(g:real^M->real^N) a` THEN
12351 ASM_SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN
12352 EXISTS_TAC `\y:real^(1,M)finite_sum.
12354 (a + drop(fstcart y) % (sndcart y - a))` THEN
12355 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
12356 REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN
12357 ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL
12358 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12359 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
12360 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
12361 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12362 SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
12363 LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX];
12364 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12365 CONTINUOUS_ON_SUBSET))];
12366 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
12367 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
12368 `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN
12369 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12370 REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
12371 REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
12372 ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ;
12373 REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN
12376 (* ------------------------------------------------------------------------- *)
12377 (* Homotopy equivalence. *)
12378 (* ------------------------------------------------------------------------- *)
12380 parse_as_infix("homotopy_equivalent",(12,"right"));;
12382 let homotopy_equivalent = new_definition
12383 `(s:real^M->bool) homotopy_equivalent (t:real^N->bool) <=>
12384 ?f g. f continuous_on s /\ IMAGE f s SUBSET t /\
12385 g continuous_on t /\ IMAGE g t SUBSET s /\
12386 homotopic_with (\x. T) (s,s) (g o f) I /\
12387 homotopic_with (\x. T) (t,t) (f o g) I`;;
12389 let HOMOTOPY_EQUIVALENT = prove
12390 (`!s:real^M->bool t:real^N->bool.
12391 s homotopy_equivalent t <=>
12392 ?f g h. f continuous_on s /\ IMAGE f s SUBSET t /\
12393 g continuous_on t /\ IMAGE g t SUBSET s /\
12394 h continuous_on t /\ IMAGE h t SUBSET s /\
12395 homotopic_with (\x. T) (s,s) (g o f) I /\
12396 homotopic_with (\x. T) (t,t) (f o h) I`,
12397 REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
12398 MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((?x. P x) <=> (?x. Q x))`) THEN
12399 X_GEN_TAC `f:real^M->real^N` THEN
12400 EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN
12401 EXISTS_TAC `(g:real^N->real^M) o f o (h:real^N->real^M)` THEN
12402 ASM_REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THENL
12403 [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
12404 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
12405 (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
12407 TRANS_TAC HOMOTOPIC_WITH_TRANS
12408 `((g:real^N->real^M) o I) o (f:real^M->real^N)` THEN
12409 CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
12410 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12411 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
12412 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12413 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
12414 TRANS_TAC HOMOTOPIC_WITH_TRANS
12415 `(f:real^M->real^N) o I o (h:real^N->real^M)` THEN
12416 CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
12417 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12418 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
12419 REWRITE_TAC[o_ASSOC] THEN
12420 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12421 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]]);;
12423 let HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT = prove
12424 (`!s:real^M->bool t:real^N->bool.
12425 s homeomorphic t ==> s homotopy_equivalent t`,
12426 REPEAT GEN_TAC THEN
12427 REWRITE_TAC[homeomorphic; homotopy_equivalent; homeomorphism] THEN
12428 REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
12429 STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12430 CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN
12431 ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM; I_THM; SUBSET_REFL]);;
12433 let HOMOTOPY_EQUIVALENT_REFL = prove
12434 (`!s:real^N->bool. s homotopy_equivalent s`,
12435 SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_REFL]);;
12437 let HOMOTOPY_EQUIVALENT_SYM = prove
12438 (`!s:real^M->bool t:real^N->bool.
12439 s homotopy_equivalent t <=> t homotopy_equivalent s`,
12440 REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
12441 GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
12442 REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);;
12444 let HOMOTOPY_EQUIVALENT_TRANS = prove
12445 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12446 s homotopy_equivalent t /\ t homotopy_equivalent u
12447 ==> s homotopy_equivalent u`,
12448 REPEAT GEN_TAC THEN
12449 SIMP_TAC[homotopy_equivalent; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
12450 SIMP_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
12451 MAP_EVERY X_GEN_TAC
12452 [`f1:real^M->real^N`; `g1:real^N->real^M`;
12453 `f2:real^N->real^P`; `g2:real^P->real^N`] THEN
12455 MAP_EVERY EXISTS_TAC
12456 [`(f2:real^N->real^P) o (f1:real^M->real^N)`;
12457 `(g1:real^N->real^M) o (g2:real^P->real^N)`] THEN
12458 REWRITE_TAC[IMAGE_o] THEN
12461 [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET];ALL_TAC] THEN
12462 CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
12463 CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THENL
12464 [EXISTS_TAC `(g1:real^N->real^M) o I o (f1:real^M->real^N)`;
12465 EXISTS_TAC `(f2:real^N->real^P) o I o (g2:real^P->real^N)`] THEN
12466 (CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]]) THEN
12467 REWRITE_TAC[GSYM o_ASSOC] THEN
12468 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12469 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
12470 REWRITE_TAC[o_ASSOC] THEN
12471 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12472 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]);;
12474 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF = prove
12475 (`!f:real^M->real^N s.
12476 linear f /\ (!x y. f x = f y ==> x = y)
12477 ==> (IMAGE f s) homotopy_equivalent s`,
12478 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
12479 MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
12480 ASM_REWRITE_TAC[]);;
12482 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove
12483 (`!f:real^M->real^N s t.
12484 linear f /\ (!x y. f x = f y ==> x = y)
12485 ==> ((IMAGE f s) homotopy_equivalent t <=> s homotopy_equivalent t)`,
12486 REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o
12487 MATCH_MP HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF) THEN
12489 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPY_EQUIVALENT_SYM]);
12490 POP_ASSUM MP_TAC] THEN
12491 REWRITE_TAC[IMP_IMP; HOMOTOPY_EQUIVALENT_TRANS]);;
12493 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove
12494 (`!f:real^M->real^N s t.
12495 linear f /\ (!x y. f x = f y ==> x = y)
12496 ==> (s homotopy_equivalent (IMAGE f t) <=> s homotopy_equivalent t)`,
12497 ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
12498 REWRITE_TAC[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);;
12500 add_linear_invariants
12501 [HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
12502 HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;
12504 let HOMOTOPY_EQUIVALENT_TRANSLATION_SELF = prove
12505 (`!a:real^N s. (IMAGE (\x. a + x) s) homotopy_equivalent s`,
12506 REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
12507 REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
12509 let HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ = prove
12511 (IMAGE (\x. a + x) s) homotopy_equivalent t <=> s homotopy_equivalent t`,
12512 MESON_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_SELF;
12513 HOMOTOPY_EQUIVALENT_SYM; HOMOTOPY_EQUIVALENT_TRANS]);;
12515 let HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ = prove
12517 s homotopy_equivalent (IMAGE (\x. a + x) t) <=> s homotopy_equivalent t`,
12518 ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
12519 REWRITE_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ]);;
12521 add_translation_invariants
12522 [HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ;
12523 HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];;
12525 let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY = prove
12526 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12527 s homotopy_equivalent t
12528 ==> ((!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
12529 g continuous_on u /\ IMAGE g u SUBSET s
12530 ==> homotopic_with (\x. T) (u,s) f g) <=>
12531 (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
12532 g continuous_on u /\ IMAGE g u SUBSET t
12533 ==> homotopic_with (\x. T) (u,t) f g))`,
12535 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12536 s homotopy_equivalent t /\
12537 (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
12538 g continuous_on u /\ IMAGE g u SUBSET s
12539 ==> homotopic_with (\x. T) (u,s) f g)
12540 ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
12541 g continuous_on u /\ IMAGE g u SUBSET t
12542 ==> homotopic_with (\x. T) (u,t) f g)`,
12543 REPEAT STRIP_TAC THEN
12544 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
12545 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
12546 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
12548 `homotopic_with (\x. T) (u,t)
12549 ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
12552 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12553 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
12554 FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
12555 REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
12556 ASM_REWRITE_TAC[] THEN
12557 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12558 CONTINUOUS_ON_SUBSET))) THEN
12560 MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
12561 `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g'
12562 ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN
12564 GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
12565 REWRITE_TAC[o_ASSOC] THEN
12566 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12567 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
12568 REPEAT STRIP_TAC THEN EQ_TAC THEN
12569 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
12570 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
12572 let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY = prove
12573 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12574 s homotopy_equivalent t
12575 ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
12576 g continuous_on s /\ IMAGE g s SUBSET u
12577 ==> homotopic_with (\x. T) (s,u) f g) <=>
12578 (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
12579 g continuous_on t /\ IMAGE g t SUBSET u
12580 ==> homotopic_with (\x. T) (t,u) f g))`,
12582 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12583 s homotopy_equivalent t /\
12584 (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
12585 g continuous_on s /\ IMAGE g s SUBSET u
12586 ==> homotopic_with (\x. T) (s,u) f g)
12587 ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
12588 g continuous_on t /\ IMAGE g t SUBSET u
12589 ==> homotopic_with (\x. T) (t,u) f g)`,
12590 REPEAT STRIP_TAC THEN
12591 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
12592 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
12593 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
12595 `homotopic_with (\x. T) (t,u)
12596 (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((g o h) o k)`
12598 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12599 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
12600 FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
12601 REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
12602 ASM_REWRITE_TAC[] THEN
12603 TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12604 CONTINUOUS_ON_SUBSET))) THEN
12606 MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
12607 `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g'
12608 ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN
12610 GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
12611 REWRITE_TAC[GSYM o_ASSOC] THEN
12612 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12613 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
12614 REPEAT STRIP_TAC THEN EQ_TAC THEN
12615 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
12616 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
12618 let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL = prove
12619 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12620 s homotopy_equivalent t
12621 ==> ((!f. f continuous_on u /\ IMAGE f u SUBSET s
12622 ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) <=>
12623 (!f. f continuous_on u /\ IMAGE f u SUBSET t
12624 ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c)))`,
12626 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12627 s homotopy_equivalent t /\
12628 (!f. f continuous_on u /\ IMAGE f u SUBSET s
12629 ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c))
12630 ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t
12631 ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`,
12632 REPEAT STRIP_TAC THEN
12633 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
12634 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
12635 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
12636 FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (f:real^P->real^N)`) THEN
12637 REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
12638 [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
12639 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
12640 DISCH_THEN(X_CHOOSE_TAC `c:real^M`) THEN
12641 EXISTS_TAC `(h:real^M->real^N) c`] THEN
12643 `homotopic_with (\x. T) (u,t)
12644 ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
12647 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12648 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
12649 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
12651 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
12652 GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
12653 REWRITE_TAC[o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
12654 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12655 EXISTS_TAC `t:real^N->bool` THEN
12656 ASM_REWRITE_TAC[]]) in
12657 REPEAT STRIP_TAC THEN EQ_TAC THEN
12658 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
12659 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
12661 let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL = prove
12662 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12663 s homotopy_equivalent t
12664 ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET u
12665 ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) <=>
12666 (!f. f continuous_on t /\ IMAGE f t SUBSET u
12667 ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c)))`,
12669 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
12670 s homotopy_equivalent t /\
12671 (!f. f continuous_on s /\ IMAGE f s SUBSET u
12672 ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c))
12673 ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u
12674 ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`,
12675 REPEAT STRIP_TAC THEN
12676 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
12677 DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
12678 (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
12679 FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^P) o (h:real^M->real^N)`) THEN
12680 REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
12681 [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
12682 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
12683 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
12685 `homotopic_with (\x. T) (t,u)
12686 (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((\x. c) o k)`
12688 [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12689 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
12690 GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
12692 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
12693 GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
12694 REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
12695 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12696 EXISTS_TAC `t:real^N->bool` THEN
12697 ASM_REWRITE_TAC[]]) in
12698 REPEAT STRIP_TAC THEN EQ_TAC THEN
12699 MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
12700 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
12702 let HOMOTOPY_INVARIANT_CONNECTEDNESS = prove
12703 (`!f:real^M->real^N g s t.
12704 f continuous_on s /\ IMAGE f s SUBSET t /\
12705 g continuous_on t /\ IMAGE g t SUBSET s /\
12706 homotopic_with (\x. T) (t,t) (f o g) I /\
12709 REPEAT STRIP_TAC THEN
12710 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
12711 REWRITE_TAC[o_THM; I_THM] THEN
12712 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
12713 STRIP_ASSUME_TAC) THEN
12715 `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)`
12717 [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
12718 REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
12719 DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
12720 REWRITE_TAC[EXISTS_IN_PCROSS] THEN
12721 ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
12723 REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IMP_CONJ] THEN
12724 REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
12725 MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN
12726 MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN
12727 MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]
12728 `!a b. (connected_component t a a' /\ connected_component t b b') /\
12729 connected_component t a b
12730 ==> connected_component t a' b'`) THEN
12731 MAP_EVERY EXISTS_TAC
12732 [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`;
12733 `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN
12735 [REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
12737 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1))
12738 (interval[vec 0,vec 1])`;
12740 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2))
12741 (interval[vec 0,vec 1])`] THEN
12743 [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
12744 REWRITE_TAC[CONNECTED_INTERVAL] THEN
12745 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12746 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
12747 CONTINUOUS_ON_CONST] THEN
12748 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12749 CONTINUOUS_ON_SUBSET)) THEN
12750 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
12751 REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL
12752 [MATCH_MP_TAC IMAGE_SUBSET THEN
12753 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
12754 CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN
12755 REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]);
12756 ASM_REWRITE_TAC[connected_component] THEN
12757 EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
12758 ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN
12759 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12760 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN
12761 REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
12762 X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
12763 MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN
12764 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);;
12766 let HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS = prove
12767 (`!f:real^M->real^N g s t.
12768 f continuous_on s /\ IMAGE f s SUBSET t /\
12769 g continuous_on t /\ IMAGE g t SUBSET s /\
12770 homotopic_with (\x. T) (t,t) (f o g) I /\
12772 ==> path_connected t`,
12773 REPEAT STRIP_TAC THEN
12774 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
12775 REWRITE_TAC[o_THM; I_THM] THEN
12776 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
12777 STRIP_ASSUME_TAC) THEN
12779 `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)`
12781 [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
12782 REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
12783 DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
12784 REWRITE_TAC[EXISTS_IN_PCROSS] THEN
12785 ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
12787 REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IMP_CONJ] THEN
12788 REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
12789 MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN
12790 MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN
12791 MATCH_MP_TAC(MESON[PATH_COMPONENT_TRANS; PATH_COMPONENT_SYM]
12792 `!a b. (path_component t a a' /\ path_component t b b') /\
12793 path_component t a b
12794 ==> path_component t a' b'`) THEN
12795 MAP_EVERY EXISTS_TAC
12796 [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`;
12797 `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN
12799 [REWRITE_TAC[PATH_COMPONENT] THEN CONJ_TAC THENL
12801 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1))
12802 (interval[vec 0,vec 1])`;
12804 `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2))
12805 (interval[vec 0,vec 1])`] THEN
12807 [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
12808 REWRITE_TAC[PATH_CONNECTED_INTERVAL] THEN
12809 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12810 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
12811 CONTINUOUS_ON_CONST] THEN
12812 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12813 CONTINUOUS_ON_SUBSET)) THEN
12814 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
12815 REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL
12816 [MATCH_MP_TAC IMAGE_SUBSET THEN
12817 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
12818 CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN
12819 REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]);
12820 ASM_REWRITE_TAC[PATH_COMPONENT] THEN
12821 EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
12822 ASM_SIMP_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE] THEN
12823 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12824 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN
12825 REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
12826 X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
12827 MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN
12828 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);;
12830 let HOMOTOPY_EQUIVALENT_CONNECTEDNESS = prove
12831 (`!s:real^M->bool t:real^N->bool.
12832 s homotopy_equivalent t ==> (connected s <=> connected t)`,
12833 REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
12834 EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
12835 (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_CONNECTEDNESS)) THEN
12838 let HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS = prove
12839 (`!s:real^M->bool t:real^N->bool.
12840 s homotopy_equivalent t ==> (path_connected s <=> path_connected t)`,
12841 REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
12842 EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
12843 (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS)) THEN
12846 (* ------------------------------------------------------------------------- *)
12847 (* Contractible sets. *)
12848 (* ------------------------------------------------------------------------- *)
12850 let contractible = new_definition
12851 `contractible s <=> ?a. homotopic_with (\x. T) (s,s) (\x. x) (\x. a)`;;
12853 let CONTRACTIBLE_IMP_SIMPLY_CONNECTED = prove
12854 (`!s:real^N->bool. contractible s ==> simply_connected s`,
12855 GEN_TAC THEN REWRITE_TAC[contractible] THEN
12856 ASM_CASES_TAC `s:real^N->bool = {}` THEN
12857 ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
12858 ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL] THEN
12859 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
12860 DISCH_TAC THEN REWRITE_TAC[homotopic_loops; PCROSS] THEN
12861 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
12862 MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
12863 CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN
12864 X_GEN_TAC `p:real^1->real^N` THEN
12865 REWRITE_TAC[path; path_image; pathfinish; pathstart] THEN
12866 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
12867 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
12868 REWRITE_TAC[homotopic_with; SUBSET; FORALL_IN_IMAGE; PCROSS] THEN
12869 REWRITE_TAC[FORALL_IN_GSPEC] THEN
12870 DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
12871 STRIP_ASSUME_TAC) THEN
12872 EXISTS_TAC `(h o (\y. pastecart (fstcart y) (p(sndcart y):real^N)))
12873 :real^(1,1)finite_sum->real^N` THEN
12874 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; linepath; o_THM] THEN
12875 CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN
12876 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
12877 [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
12878 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
12879 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12880 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12881 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
12883 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
12884 CONTINUOUS_ON_SUBSET)) THEN
12885 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12886 ASM_SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART]);;
12888 let CONTRACTIBLE_IMP_CONNECTED = prove
12889 (`!s:real^N->bool. contractible s ==> connected s`,
12890 SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
12891 SIMPLY_CONNECTED_IMP_CONNECTED]);;
12893 let CONTRACTIBLE_IMP_PATH_CONNECTED = prove
12894 (`!s:real^N->bool. contractible s ==> path_connected s`,
12895 SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
12896 SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;
12898 let NULLHOMOTOPIC_THROUGH_CONTRACTIBLE = prove
12899 (`!f:real^M->real^N g:real^N->real^P s t u.
12900 f continuous_on s /\ IMAGE f s SUBSET t /\
12901 g continuous_on t /\ IMAGE g t SUBSET u /\
12903 ==> ?c. homotopic_with (\h. T) (s,u) (g o f) (\x. c)`,
12904 REPEAT STRIP_TAC THEN
12905 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN
12906 DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN
12907 DISCH_THEN(MP_TAC o ISPECL [`g:real^N->real^P`; `u:real^P->bool`] o MATCH_MP
12908 (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
12909 ASM_REWRITE_TAC[] THEN
12910 DISCH_THEN(MP_TAC o ISPECL [`f:real^M->real^N`; `s:real^M->bool`] o MATCH_MP
12911 (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT)) THEN
12912 ASM_REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN
12913 EXISTS_TAC `(g:real^N->real^P) b` THEN ASM_REWRITE_TAC[]);;
12915 let NULLHOMOTOPIC_INTO_CONTRACTIBLE = prove
12916 (`!f:real^M->real^N s t.
12917 f continuous_on s /\ IMAGE f s SUBSET t /\ contractible t
12918 ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`,
12919 REPEAT STRIP_TAC THEN
12920 SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f` SUBST1_TAC THENL
12921 [REWRITE_TAC[o_THM; FUN_EQ_THM];
12922 MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
12923 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
12926 let NULLHOMOTOPIC_FROM_CONTRACTIBLE = prove
12927 (`!f:real^M->real^N s t.
12928 f continuous_on s /\ IMAGE f s SUBSET t /\ contractible s
12929 ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`,
12930 REPEAT STRIP_TAC THEN
12931 SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x)` SUBST1_TAC THENL
12932 [REWRITE_TAC[o_THM; FUN_EQ_THM];
12933 MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
12934 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
12937 let HOMOTOPIC_THROUGH_CONTRACTIBLE = prove
12938 (`!f1:real^M->real^N g1:real^N->real^P f2 g2 s t u.
12939 f1 continuous_on s /\ IMAGE f1 s SUBSET t /\
12940 g1 continuous_on t /\ IMAGE g1 t SUBSET u /\
12941 f2 continuous_on s /\ IMAGE f2 s SUBSET t /\
12942 g2 continuous_on t /\ IMAGE g2 t SUBSET u /\
12943 contractible t /\ path_connected u
12944 ==> homotopic_with (\h. T) (s,u) (g1 o f1) (g2 o f2)`,
12945 REPEAT STRIP_TAC THEN MP_TAC(ISPECL
12946 [`f1:real^M->real^N`; `g1:real^N->real^P`; `s:real^M->bool`;
12947 `t:real^N->bool`; `u:real^P->bool`]
12948 NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
12949 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c1:real^P` THEN
12950 DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
12952 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
12953 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MP_TAC(ISPECL
12954 [`f2:real^M->real^N`; `g2:real^N->real^P`; `s:real^M->bool`;
12955 `t:real^N->bool`; `u:real^P->bool`]
12956 NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
12957 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c2:real^P` THEN
12958 DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
12960 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
12961 REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN FIRST_X_ASSUM
12962 (MP_TAC o GEN_REWRITE_RULE I [PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
12965 let HOMOTOPIC_INTO_CONTRACTIBLE = prove
12966 (`!f:real^M->real^N g s t.
12967 f continuous_on s /\ IMAGE f s SUBSET t /\
12968 g continuous_on s /\ IMAGE g s SUBSET t /\
12970 ==> homotopic_with (\h. T) (s,t) f g`,
12971 REPEAT STRIP_TAC THEN SUBGOAL_THEN
12972 `(f:real^M->real^N) = (\x. x) o f /\ (g:real^M->real^N) = (\x. x) o g`
12973 (CONJUNCTS_THEN SUBST1_TAC)
12974 THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN
12975 MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN
12976 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
12977 ASM_SIMP_TAC[IMAGE_ID; SUBSET_REFL; CONTRACTIBLE_IMP_PATH_CONNECTED]);;
12979 let HOMOTOPIC_FROM_CONTRACTIBLE = prove
12980 (`!f:real^M->real^N g s t.
12981 f continuous_on s /\ IMAGE f s SUBSET t /\
12982 g continuous_on s /\ IMAGE g s SUBSET t /\
12983 contractible s /\ path_connected t
12984 ==> homotopic_with (\h. T) (s,t) f g`,
12985 REPEAT STRIP_TAC THEN
12986 REPEAT STRIP_TAC THEN SUBGOAL_THEN
12987 `(f:real^M->real^N) = f o (\x. x) /\ (g:real^M->real^N) = g o (\x. x)`
12988 (CONJUNCTS_THEN SUBST1_TAC)
12989 THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN
12990 MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN
12991 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
12992 ASM_REWRITE_TAC[IMAGE_ID; SUBSET_REFL]);;
12994 let HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS = prove
12995 (`!s:real^M->bool t:real^N->bool.
12996 contractible s /\ contractible t /\ (s = {} <=> t = {})
12997 ==> s homotopy_equivalent t`,
12998 REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
12999 ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_EMPTY] THEN
13000 FIRST_X_ASSUM(X_CHOOSE_TAC `b:real^N` o
13001 GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
13002 STRIP_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
13003 FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^M` o
13004 GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
13005 EXISTS_TAC `(\x. b):real^M->real^N` THEN
13006 EXISTS_TAC `(\y. a):real^N->real^M` THEN
13007 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13008 REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
13009 CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE THEN
13010 ASM_REWRITE_TAC[o_DEF; IMAGE_ID; I_DEF; SUBSET_REFL; CONTINUOUS_ON_ID;
13011 CONTINUOUS_ON_CONST] THEN
13014 let STARLIKE_IMP_CONTRACTIBLE_GEN = prove
13016 (!a t. a IN s /\ &0 <= t /\ t <= &1 ==> P(\x. (&1 - t) % x + t % a)) /\
13018 ==> ?a:real^N. homotopic_with P (s,s) (\x. x) (\x. a)`,
13019 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13020 REWRITE_TAC[starlike] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN
13021 REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN
13022 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
13023 REWRITE_TAC[homotopic_with; PCROSS] THEN
13024 EXISTS_TAC `\y:real^(1,N)finite_sum.
13025 (&1 - drop(fstcart y)) % sndcart y +
13026 drop(fstcart y) % a` THEN
13027 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; IN_INTERVAL_1;
13028 SUBSET; FORALL_IN_IMAGE; REAL_SUB_RZERO; REAL_SUB_REFL; FORALL_IN_GSPEC;
13029 VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN
13030 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
13031 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13032 SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB; CONTINUOUS_ON_SUB;
13033 CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; ETA_AX;
13034 LINEAR_FSTCART; LINEAR_SNDCART]);;
13036 let STARLIKE_IMP_CONTRACTIBLE = prove
13037 (`!s:real^N->bool. starlike s ==> contractible s`,
13038 SIMP_TAC[contractible; STARLIKE_IMP_CONTRACTIBLE_GEN]);;
13040 let CONTRACTIBLE_UNIV = prove
13041 (`contractible(:real^N)`,
13042 SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV]);;
13044 let STARLIKE_IMP_SIMPLY_CONNECTED = prove
13045 (`!s:real^N->bool. starlike s ==> simply_connected s`,
13046 REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
13047 MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);;
13049 let CONVEX_IMP_SIMPLY_CONNECTED = prove
13050 (`!s:real^N->bool. convex s ==> simply_connected s`,
13051 MESON_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_SIMPLY_CONNECTED;
13052 SIMPLY_CONNECTED_EMPTY]);;
13054 let STARLIKE_IMP_PATH_CONNECTED = prove
13055 (`!s:real^N->bool. starlike s ==> path_connected s`,
13056 MESON_TAC[STARLIKE_IMP_SIMPLY_CONNECTED;
13057 SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;
13059 let STARLIKE_IMP_CONNECTED = prove
13060 (`!s:real^N->bool. starlike s ==> connected s`,
13061 MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;
13063 let IS_INTERVAL_SIMPLY_CONNECTED_1 = prove
13064 (`!s:real^1->bool. is_interval s <=> simply_connected s`,
13065 MESON_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
13066 CONVEX_IMP_SIMPLY_CONNECTED; IS_INTERVAL_CONVEX_1]);;
13068 let CONTRACTIBLE_EMPTY = prove
13069 (`contractible {}`,
13070 SIMP_TAC[contractible; HOMOTOPIC_WITH; PCROSS_EMPTY; NOT_IN_EMPTY] THEN
13071 REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN SET_TAC[]);;
13073 let CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS = prove
13074 (`!s t:real^N->bool.
13075 convex s /\ relative_interior s SUBSET t /\ t SUBSET closure s
13076 ==> contractible t`,
13077 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
13078 ASM_SIMP_TAC[SUBSET_EMPTY; CLOSURE_EMPTY; CONTRACTIBLE_EMPTY] THEN
13079 STRIP_TAC THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
13080 MATCH_MP_TAC STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS THEN ASM_MESON_TAC[]);;
13082 let CONVEX_IMP_CONTRACTIBLE = prove
13083 (`!s:real^N->bool. convex s ==> contractible s`,
13084 MESON_TAC[CONVEX_IMP_STARLIKE; CONTRACTIBLE_EMPTY;
13085 STARLIKE_IMP_CONTRACTIBLE]);;
13087 let CONTRACTIBLE_SING = prove
13088 (`!a:real^N. contractible {a}`,
13089 SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SING]);;
13091 let IS_INTERVAL_CONTRACTIBLE_1 = prove
13092 (`!s:real^1->bool. is_interval s <=> contractible s`,
13093 MESON_TAC[CONTRACTIBLE_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
13094 CONVEX_IMP_CONTRACTIBLE; IS_INTERVAL_CONVEX_1]);;
13096 let CONTRACTIBLE_PCROSS = prove
13097 (`!s:real^M->bool t:real^N->bool.
13098 contractible s /\ contractible t ==> contractible(s PCROSS t)`,
13099 REPEAT GEN_TAC THEN REWRITE_TAC[contractible; homotopic_with] THEN
13100 REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
13101 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
13102 MAP_EVERY X_GEN_TAC [`a:real^M`; `h:real^(1,M)finite_sum->real^M`] THEN
13103 REPEAT DISCH_TAC THEN
13104 MAP_EVERY X_GEN_TAC [`b:real^N`; `k:real^(1,N)finite_sum->real^N`] THEN
13105 REPEAT DISCH_TAC THEN
13106 EXISTS_TAC `pastecart (a:real^M) (b:real^N)` THEN
13107 EXISTS_TAC `\z. pastecart
13108 ((h:real^(1,M)finite_sum->real^M)
13109 (pastecart (fstcart z) (fstcart(sndcart z))))
13110 ((k:real^(1,N)finite_sum->real^N)
13111 (pastecart (fstcart z) (sndcart(sndcart z))))` THEN
13112 ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
13113 FSTCART_PASTECART; SNDCART_PASTECART] THEN
13114 MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
13115 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13116 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13117 SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
13118 LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_ID;
13119 GSYM o_DEF; CONTINUOUS_ON_COMPOSE] THEN
13120 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13121 CONTINUOUS_ON_SUBSET)) THEN
13122 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
13123 SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);;
13125 let CONTRACTIBLE_PCROSS_EQ = prove
13126 (`!s:real^M->bool t:real^N->bool.
13127 contractible(s PCROSS t) <=>
13128 s = {} \/ t = {} \/ contractible s /\ contractible t`,
13129 REPEAT GEN_TAC THEN
13130 ASM_CASES_TAC `s:real^M->bool = {}` THEN
13131 ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
13132 ASM_CASES_TAC `t:real^N->bool = {}` THEN
13133 ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
13134 EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_PCROSS] THEN
13135 REWRITE_TAC[contractible; homotopic_with; LEFT_IMP_EXISTS_THM] THEN
13136 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
13137 MAP_EVERY X_GEN_TAC
13138 [`a:real^M`; `b:real^N`;
13139 `h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum`] THEN
13141 SUBGOAL_THEN `(a:real^M) IN s /\ (b:real^N) IN t` STRIP_ASSUME_TAC THENL
13142 [REWRITE_TAC[GSYM PASTECART_IN_PCROSS] THEN
13143 RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
13144 ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
13147 [EXISTS_TAC `a:real^M` THEN
13150 (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
13151 (\z. pastecart (fstcart z) (pastecart (sndcart z) b))`;
13152 EXISTS_TAC `b:real^N` THEN
13155 (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
13156 (\z. pastecart (fstcart z) (pastecart a (sndcart z)))`] THEN
13157 ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
13158 SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; o_THM] THEN
13160 [ALL_TAC; ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS]]) THEN
13161 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13162 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
13163 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13164 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
13165 LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
13166 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13167 CONTINUOUS_ON_SUBSET)) THEN
13168 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
13169 ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]);;
13171 let HOMOTOPY_EQUIVALENT_EMPTY = prove
13172 (`(!s. (s:real^M->bool) homotopy_equivalent ({}:real^N->bool) <=> s = {}) /\
13173 (!t. ({}:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> t = {})`,
13174 REPEAT STRIP_TAC THEN EQ_TAC THEN
13175 SIMP_TAC[HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; CONTRACTIBLE_EMPTY] THEN
13176 REWRITE_TAC[homotopy_equivalent] THEN SET_TAC[]);;
13178 let HOMOTOPY_EQUIVALENT_CONTRACTIBILITY = prove
13179 (`!s:real^M->bool t:real^N->bool.
13180 s homotopy_equivalent t ==> (contractible s <=> contractible t)`,
13182 (`!s:real^M->bool t:real^N->bool.
13183 s homotopy_equivalent t /\ contractible s ==> contractible t`,
13184 REPEAT GEN_TAC THEN SIMP_TAC[homotopy_equivalent; contractible; I_DEF] THEN
13185 DISCH_THEN(CONJUNCTS_THEN2
13186 (X_CHOOSE_THEN `f:real^M->real^N` (X_CHOOSE_THEN `g:real^N->real^M`
13188 (X_CHOOSE_TAC `a:real^M`)) THEN
13189 MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
13190 NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
13191 ASM_REWRITE_TAC[contractible; I_DEF] THEN
13192 ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
13193 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN
13194 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN DISCH_TAC THEN
13195 MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
13196 EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN
13197 ASM_REWRITE_TAC[] THEN
13198 SUBGOAL_THEN `(\x. (b:real^N)) = (\x. b) o (g:real^N->real^M)`
13199 SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
13200 MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13201 EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]) in
13202 REPEAT STRIP_TAC THEN EQ_TAC THEN
13203 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] lemma) THEN
13204 ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13206 let HOMOTOPY_EQUIVALENT_SING = prove
13207 (`!s:real^M->bool a:real^N.
13208 s homotopy_equivalent {a} <=> ~(s = {}) /\ contractible s`,
13209 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
13210 ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY; NOT_INSERT_EMPTY] THEN
13212 [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CONTRACTIBILITY) THEN
13213 REWRITE_TAC[CONTRACTIBLE_SING];
13214 DISCH_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS THEN
13215 ASM_REWRITE_TAC[CONTRACTIBLE_SING; NOT_INSERT_EMPTY]]);;
13217 let HOMEOMORPHIC_CONTRACTIBLE_EQ = prove
13218 (`!s:real^M->bool t:real^N->bool.
13219 s homeomorphic t ==> (contractible s <=> contractible t)`,
13220 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBILITY THEN
13221 ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]);;
13223 let HOMEOMORPHIC_CONTRACTIBLE = prove
13224 (`!s:real^M->bool t:real^N->bool.
13225 s homeomorphic t /\ contractible s ==> contractible t`,
13226 MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ]);;
13228 let CONTRACTIBLE_TRANSLATION = prove
13229 (`!a:real^N s. contractible (IMAGE (\x. a + x) s) <=> contractible s`,
13230 REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
13231 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
13232 REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;
13234 add_translation_invariants [CONTRACTIBLE_TRANSLATION];;
13236 let CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE = prove
13237 (`!f:real^M->real^N s.
13238 linear f /\ (!x y. f x = f y ==> x = y)
13239 ==> (contractible (IMAGE f s) <=> contractible s)`,
13240 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
13241 ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
13242 HOMEOMORPHIC_REFL]);;
13244 add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];;
13246 (* ------------------------------------------------------------------------- *)
13247 (* Homeomorphisms between punctured spheres and affine sets. *)
13248 (* ------------------------------------------------------------------------- *)
13250 let HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE = prove
13251 (`!a r b t:real^N->bool p:real^M->bool.
13252 &0 < r /\ b IN sphere(a,r) /\ affine t /\ a IN t /\ b IN t /\
13253 affine p /\ aff_dim t = aff_dim p + &1
13254 ==> ((sphere(a:real^N,r) INTER t) DELETE b) homeomorphic p`,
13255 GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
13256 REWRITE_TAC[sphere; DIST_0; IN_ELIM_THM] THEN
13257 SIMP_TAC[CONJ_ASSOC; NORM_ARITH
13258 `&0 < r /\ norm(b:real^N) = r <=> norm(b) = r /\ ~(b = vec 0)`] THEN
13259 GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN
13260 GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
13261 SIMP_TAC[NORM_MUL; real_abs; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
13262 X_GEN_TAC `b:real` THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_MUL_EQ_0] THEN
13263 DISCH_THEN(K ALL_TAC) THEN DISCH_THEN SUBST1_TAC THEN
13264 REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN
13265 ASM_CASES_TAC `r = &1` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN
13266 CONV_TAC REAL_RAT_REDUCE_CONV THEN
13267 SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN STRIP_TAC THEN
13268 SUBGOAL_THEN `subspace(t:real^N->bool)` ASSUME_TAC THENL
13269 [ASM_MESON_TAC[AFFINE_EQ_SUBSPACE]; ALL_TAC] THEN
13270 TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0} INTER t` THEN
13273 MATCH_MP_TAC HOMEOMORPHIC_AFFINE_SETS THEN
13274 ASM_SIMP_TAC[AFFINE_INTER; AFFINE_STANDARD_HYPERPLANE] THEN
13275 ONCE_REWRITE_TAC[INTER_COMM] THEN
13276 MP_TAC(ISPECL [`basis 1:real^N`; `&0`; `t:real^N->bool`]
13277 AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN
13278 ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
13279 DISCH_THEN SUBST1_TAC THEN
13280 SUBGOAL_THEN `~(t INTER {x:real^N | x$1 = &0} = {})` ASSUME_TAC THENL
13281 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN
13282 EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VEC_COMPONENT];
13284 SUBGOAL_THEN `~(t SUBSET {v:real^N | v$1 = &0})` ASSUME_TAC THENL
13285 [REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN
13286 ASM_SIMP_TAC[IN_ELIM_THM; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13288 ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]] THEN
13290 `({x:real^N | norm x = &1} INTER t) DELETE (basis 1) =
13291 {x | norm x = &1 /\ ~(x$1 = &1)} INTER t`
13293 [MATCH_MP_TAC(SET_RULE
13294 `s DELETE a = s' ==> (s INTER t) DELETE a = s' INTER t`) THEN
13295 MATCH_MP_TAC(SET_RULE
13296 `Q a /\ (!x. P x /\ Q x ==> x = a)
13297 ==> {x | P x} DELETE a = {x | P x /\ ~Q x}`) THEN
13298 SIMP_TAC[BASIS_COMPONENT; CART_EQ; DIMINDEX_GE_1; LE_REFL] THEN
13299 REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN
13300 X_GEN_TAC `x:real^N` THEN
13301 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
13302 ASM_SIMP_TAC[dot; SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN
13303 REWRITE_TAC[REAL_ARITH `&1 * &1 + s = &1 <=> s = &0`] THEN
13304 DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
13305 SUM_POS_EQ_0_NUMSEG)) THEN
13306 REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN
13307 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
13308 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
13310 REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY ABBREV_TAC
13311 [`f = \x:real^N. &2 % basis 1 + &2 / (&1 - x$1) % (x - basis 1)`;
13313 basis 1 + &4 / (norm y pow 2 + &4) % (y - &2 % basis 1)`] THEN
13314 MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
13315 REPEAT CONJ_TAC THENL
13316 [MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
13317 `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
13318 EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
13319 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13320 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13321 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
13322 REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
13323 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
13324 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
13325 SIMP_TAC[REAL_SUB_0; IN_ELIM_THM] THEN
13326 REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
13327 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13328 MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT THEN
13329 REWRITE_TAC[LE_REFL; DIMINDEX_GE_1];
13330 MATCH_MP_TAC(SET_RULE
13331 `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
13332 ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
13333 EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
13334 ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB] THEN
13335 REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
13336 SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
13337 LE_REFL; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT] THEN
13338 CONV_TAC REAL_FIELD;
13339 MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
13340 `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
13341 EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
13342 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13343 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13344 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
13345 REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
13346 MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
13347 MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
13348 SIMP_TAC[LIFT_ADD; REAL_POW_LE; NORM_POS_LE; REAL_ARITH
13349 `&0 <= x ==> ~(x + &4 = &0)`] THEN
13350 MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
13351 REWRITE_TAC[REAL_POW_2; LIFT_CMUL; CONTINUOUS_ON_CONST] THEN
13352 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13353 REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF];
13354 MATCH_MP_TAC(SET_RULE
13355 `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
13356 ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
13357 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
13358 REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN EXPAND_TAC "g" THEN
13360 [ALL_TAC; ASM_MESON_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB]] THEN
13361 X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
13362 REWRITE_TAC[VECTOR_ARITH
13363 `b + a % (y - &2 % b):real^N = (&1 - &2 * a) % b + a % y`] THEN
13364 REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
13365 `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
13366 ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; LE_REFL;
13367 VECTOR_ADD_COMPONENT; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN
13368 REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; GSYM REAL_POW_2] THEN
13369 SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` MP_TAC THENL
13370 [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
13371 CONV_TAC REAL_FIELD];
13373 `!x. norm x = &1 /\ ~(x$1 = &1)
13374 ==> norm((f:real^N->real^N) x) pow 2 = &4 * (&1 + x$1) / (&1 - x$1)`
13376 [REPEAT STRIP_TAC THEN EXPAND_TAC "f" THEN
13377 REWRITE_TAC[VECTOR_ARITH
13378 `a % b + m % (x - b):real^N = (a - m) % b + m % x`] THEN
13379 REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
13380 `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
13381 SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT;
13382 DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_COMPONENT] THEN
13383 ASM_REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_MUL_RID;
13385 UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
13387 EXPAND_TAC "g" THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
13388 ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
13389 ASM_SIMP_TAC[REAL_FIELD
13391 ==> &4 * (&1 + x) / (&1 - x) + &4 = &8 / (&1 - x)`] THEN
13392 REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN
13393 REWRITE_TAC[REAL_ARITH `&4 * inv(&8) * x = x / &2`] THEN
13394 EXPAND_TAC "f" THEN
13395 REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
13396 REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
13397 `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
13398 REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN
13399 UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
13400 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
13402 SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` ASSUME_TAC THENL
13403 [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
13405 SUBGOAL_THEN `((g:real^N->real^N) y)$1 =
13406 (y dot y - &4) / (y dot y + &4)` ASSUME_TAC THENL
13407 [EXPAND_TAC "g" THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN
13408 REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN
13409 ASM_SIMP_TAC[BASIS_COMPONENT; LE_REFL; NORM_POW_2; DIMINDEX_GE_1] THEN
13410 UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN
13411 CONV_TAC REAL_FIELD;
13413 EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
13414 EXPAND_TAC "g" THEN SIMP_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
13415 REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
13416 `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
13417 REWRITE_TAC[VECTOR_MUL_EQ_0; NORM_POW_2] THEN DISJ1_TAC THEN
13418 UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD]);;
13420 let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN = prove
13421 (`!s:real^N->bool t:real^M->bool a.
13422 convex s /\ bounded s /\ a IN relative_frontier s /\
13423 affine t /\ aff_dim s = aff_dim t + &1
13424 ==> (relative_frontier s DELETE a) homeomorphic t`,
13425 REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
13426 ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_GE; INT_ARITH
13427 `--(&1):int <= s ==> ~(--(&1) = s + &1)`] THEN
13428 MP_TAC(ISPECL [`(:real^N)`; `aff_dim(s:real^N->bool)`]
13429 CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV] THEN
13430 REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFFINE_UNIV] THEN
13431 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
13432 SUBGOAL_THEN `~(t:real^N->bool = {})` MP_TAC THENL
13433 [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN
13434 GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
13435 DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN STRIP_TAC THEN
13437 [`s:real^N->bool`; `ball(z:real^N,&1) INTER t`]
13438 HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
13439 MP_TAC(ISPECL [`t:real^N->bool`; `ball(z:real^N,&1)`]
13440 (ONCE_REWRITE_RULE[INTER_COMM] AFF_DIM_CONVEX_INTER_OPEN)) THEN
13441 MP_TAC(ISPECL [`ball(z:real^N,&1)`; `t:real^N->bool`]
13442 RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
13443 ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; CONVEX_BALL;
13444 AFFINE_IMP_CONVEX; INTERIOR_OPEN; OPEN_BALL;
13445 FRONTIER_BALL; REAL_LT_01] THEN
13446 SUBGOAL_THEN `~(ball(z:real^N,&1) INTER t = {})` ASSUME_TAC THENL
13447 [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
13448 EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01];
13449 ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN SIMP_TAC[]] THEN
13450 REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
13451 MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
13452 STRIP_TAC THEN REWRITE_TAC[GSYM homeomorphic] THEN
13453 TRANS_TAC HOMEOMORPHIC_TRANS
13454 `(sphere(z,&1) INTER t) DELETE (h:real^N->real^N) a` THEN
13456 [REWRITE_TAC[homeomorphic] THEN
13457 MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
13458 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
13459 REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
13460 [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
13462 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
13466 MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN
13467 ASM_REWRITE_TAC[REAL_LT_01; GSYM IN_INTER] THEN
13468 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
13471 let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE = prove
13472 (`!a r b:real^N t:real^M->bool.
13473 &0 < r /\ b IN sphere(a,r) /\ affine t /\ aff_dim(t) + &1 = &(dimindex(:N))
13474 ==> (sphere(a:real^N,r) DELETE b) homeomorphic t`,
13475 REPEAT STRIP_TAC THEN
13476 MP_TAC(ISPECL [`cball(a:real^N,r)`; `t:real^M->bool`; `b:real^N`]
13477 HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
13478 ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL;
13479 CONVEX_CBALL; BOUNDED_CBALL]);;
13481 let HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE = prove
13483 &0 < r /\ b IN sphere(a,r) /\ ~(c = vec 0)
13484 ==> (sphere(a:real^N,r) DELETE b) homeomorphic
13485 {x:real^N | c dot x = d}`,
13486 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE THEN
13487 ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);;
13489 let HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV = prove
13491 &0 < r /\ b IN sphere(a,r) /\ dimindex(:N) = dimindex(:M) + 1
13492 ==> (sphere(a:real^N,r) DELETE b) homeomorphic (:real^M)`,
13493 REPEAT STRIP_TAC THEN
13494 TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis 1 dot x = &0}` THEN
13495 ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANE_UNIV; BASIS_NONZERO; LE_REFL;
13496 DIMINDEX_GE_1; HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE]);;
13498 let CONTRACTIBLE_PUNCTURED_SPHERE = prove
13500 &0 < r /\ b IN sphere(a,r) ==> contractible(sphere(a,r) DELETE b)`,
13501 REPEAT STRIP_TAC THEN
13502 SUBGOAL_THEN `contractible {x:real^N | basis 1 dot x = &0}` MP_TAC THENL
13503 [SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_HYPERPLANE];
13504 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_CONTRACTIBLE) THEN
13505 ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
13506 MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE THEN
13507 ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]]);;
13509 (* ------------------------------------------------------------------------- *)
13510 (* Simple connectedness of a union. This is essentially a stripped-down *)
13511 (* version of the Seifert - Van Kampen theorem. *)
13512 (* ------------------------------------------------------------------------- *)
13514 let SIMPLY_CONNECTED_UNION = prove
13515 (`!s t:real^N->bool.
13516 open_in (subtopology euclidean (s UNION t)) s /\
13517 open_in (subtopology euclidean (s UNION t)) t /\
13518 simply_connected s /\ simply_connected t /\
13519 path_connected (s INTER t) /\ ~(s INTER t = {})
13520 ==> simply_connected (s UNION t)`,
13521 REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
13522 DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool`
13523 (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
13524 DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->bool`
13525 (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
13526 SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; PATH_CONNECTED_UNION] THEN
13527 REPEAT STRIP_TAC THEN
13528 SUBGOAL_THEN `(pathstart p:real^N) IN s UNION t` MP_TAC THENL
13529 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[IN_UNION]] THEN
13530 POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
13531 ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
13532 MAP_EVERY (fun s -> let x = mk_var(s,`:real^N->bool`) in SPEC_TAC(x,x))
13533 ["v"; "u"; "t"; "s"] THEN
13534 MATCH_MP_TAC(MESON[]
13535 `(!s t u v. x IN s ==> P x s t u v) /\
13536 (!x s t u v. P x s t u v ==> P x t s v u)
13537 ==> (!s t u v. x IN s \/ x IN t ==> P x s t u v)`) THEN
13540 REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN
13541 MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN
13544 !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\
13546 ==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/
13547 path_image(subpath x y p) SUBSET t`
13548 STRIP_ASSUME_TAC THENL
13549 [MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN
13550 ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN
13551 DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN
13552 SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
13553 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
13554 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
13555 MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`]
13556 COMPACT_UNIFORMLY_CONTINUOUS) THEN
13557 ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN
13558 DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN
13559 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
13560 ASM_REWRITE_TAC[] THEN
13561 MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
13562 FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN
13563 ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN
13564 MATCH_MP_TAC(SET_RULE
13565 `!p'. p SUBSET b /\
13566 (s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\
13567 p SUBSET p' /\ p' SUBSET s UNION t
13568 ==> (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN
13569 EXISTS_TAC `path_image(p:real^1->real^N)` THEN
13570 ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN
13571 REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN
13572 SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL
13573 [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
13574 ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN
13575 ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist];
13576 REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN
13577 X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN
13578 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
13579 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN
13580 REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
13581 COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
13582 ASM_REAL_ARITH_TAC];
13583 MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
13584 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
13585 X_GEN_TAC `N:num` THEN STRIP_TAC] THEN
13587 `!n. n <= N /\ p(lift(&n / &N)) IN s
13588 ==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\
13589 homotopic_paths (s UNION t)
13590 (subpath (vec 0) (lift(&n / &N)) p) q`
13593 DISCH_THEN(MP_TAC o SPEC `N:num`) THEN
13594 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN
13595 ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
13596 DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN
13597 REWRITE_TAC[SUBPATH_TRIVIAL] THEN
13598 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
13599 DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
13600 MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
13601 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
13602 FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
13603 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
13604 EXISTS_TAC `s:real^N->bool` THEN
13605 ASM_MESON_TAC[SUBSET_UNION]] THEN
13608 ==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
13609 SUBSET (s:real^N->bool) \/
13610 path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
13613 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13614 REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC;
13615 NORM_REAL; GSYM drop;
13616 REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN
13617 ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ;
13618 REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN
13619 ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV;
13620 REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
13623 MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
13624 REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN
13625 ASM_CASES_TAC `n = 0` THENL
13626 [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN
13627 EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN
13628 REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN
13629 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
13630 UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN
13633 MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN
13635 MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
13637 [CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN
13638 ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN
13639 ASM_MESON_TAC[pathstart];
13640 DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN
13643 path_image(q:real^1->real^N) SUBSET s /\
13644 homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q`
13645 STRIP_ASSUME_TAC THENL
13646 [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
13649 `!i. m < i /\ i <= n
13650 ==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/
13651 path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET
13654 [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN
13655 X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
13656 ASM_CASES_TAC `i:num = m` THENL
13657 [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
13658 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
13659 ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN
13661 `p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)`
13662 STRIP_ASSUME_TAC THENL
13663 [MATCH_MP_TAC(SET_RULE
13664 `x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN
13666 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13667 `s SUBSET t ==> x IN s ==> x IN t`)) THEN
13668 REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
13669 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
13670 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
13671 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
13673 SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL
13674 [ASM_ARITH_TAC; ASM_MESON_TAC[]]];
13677 `path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/
13678 path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET
13680 MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
13681 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13683 ==> (x IN p /\ x IN q) /\ (q UNION p = r)
13684 ==> p SUBSET s \/ p SUBSET t
13685 ==> q SUBSET s \/ q SUBSET t
13686 ==> r SUBSET s \/ r SUBSET t`)) THEN
13687 SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN
13688 REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN
13689 MATCH_MP_TAC UNION_SEGMENT THEN
13690 ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
13691 LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN
13693 DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN
13695 [EXISTS_TAC `(q:real^1->real^N) ++
13696 subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN
13697 REPEAT CONJ_TAC THENL
13698 [MATCH_MP_TAC PATH_JOIN_IMP THEN
13699 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
13700 ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
13701 DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN
13702 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
13703 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
13704 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
13706 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[];
13707 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13708 EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
13709 subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
13711 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
13712 MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
13713 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL];
13714 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
13715 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
13716 MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
13717 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN
13718 ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
13719 MATCH_MP_TAC PATH_SUBPATH] THEN
13720 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
13721 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
13722 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
13725 `(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t`
13726 STRIP_ASSUME_TAC THENL
13727 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
13728 PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET];
13730 UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN
13731 REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL
13732 [`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN
13733 ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
13734 DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN
13736 `!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p
13737 ==> homotopic_paths t p (linepath (pathstart p,pathstart p))`
13738 (MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++
13739 reversepath(r:real^1->real^N)`) THEN
13740 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
13741 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
13743 [ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
13744 MATCH_MP_TAC PATH_JOIN_IMP THEN
13745 ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH;
13746 PATHSTART_REVERSEPATH] THEN
13747 MATCH_MP_TAC PATH_SUBPATH THEN
13748 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
13749 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
13750 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
13753 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13754 HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN
13755 ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH;
13756 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
13757 DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13758 HOMOTOPIC_PATHS_LOOP_PARTS)) THEN
13759 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
13760 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
13761 REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
13762 REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN
13763 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
13764 EXISTS_TAC `(q:real^1->real^N) ++ r` THEN
13765 ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
13766 MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13767 EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
13768 subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
13770 [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
13771 MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
13772 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
13773 ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
13774 ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
13775 LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
13777 MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
13778 ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
13779 MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
13780 EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);;
13782 let SIMPLY_CONNECTED_SPHERE = prove
13783 (`!a:real^N r. 3 <= dimindex(:N) ==> simply_connected(sphere(a,r))`,
13784 REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN GEOM_ORIGIN_TAC `a:real^N` THEN
13785 REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_0] THEN
13786 ASM_CASES_TAC `r < &0` THENL
13787 [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN
13788 REWRITE_TAC[EMPTY_GSPEC; SIMPLY_CONNECTED_EMPTY];
13789 RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN
13790 FIRST_ASSUM(X_CHOOSE_THEN `b:real^N` (SUBST1_TAC o SYM) o
13791 MATCH_MP VECTOR_CHOOSE_SIZE) THEN
13792 UNDISCH_THEN `&0 <= r` (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN
13793 GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN
13794 REWRITE_TAC[NORM_EQ_0; SING_GSPEC; NORM_0] THEN
13795 SIMP_TAC[CONVEX_SING; CONVEX_IMP_SIMPLY_CONNECTED] THEN
13796 X_GEN_TAC `bbb:real^N` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN
13798 `{x:real^N | norm x = &1} =
13799 {x | norm x = &1} DELETE (basis 1) UNION
13800 {x | norm x = &1} DELETE (--(basis 1))`
13801 (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th))
13803 [MATCH_MP_TAC(SET_RULE
13804 `~(x = y) ==> s = s DELETE x UNION s DELETE y`) THEN
13805 REWRITE_TAC[VECTOR_ARITH `x:real^N = --x <=> x = vec 0`] THEN
13806 ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO;
13807 DIMINDEX_GE_1; LE_REFL];
13809 MATCH_MP_TAC SIMPLY_CONNECTED_UNION THEN
13810 ASM_SIMP_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> (p /\ q) /\ (r /\ s) /\ t`] THEN
13812 [ONCE_REWRITE_TAC[SET_RULE `s DELETE x = s INTER (UNIV DELETE x)`] THEN
13813 CONJ_TAC THEN MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN
13814 SIMP_TAC[OPEN_DELETE; OPEN_UNIV; OPEN_IN_SUBTOPOLOGY_REFL] THEN
13815 REWRITE_TAC[SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
13818 [CONJ_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
13819 ONCE_REWRITE_TAC[NORM_ARITH `norm(x:real^N) = dist(vec 0,x)`] THEN
13820 REWRITE_TAC[GSYM sphere] THEN
13821 MATCH_MP_TAC CONTRACTIBLE_PUNCTURED_SPHERE THEN
13822 SIMP_TAC[IN_SPHERE; DIST_0; NORM_BASIS; DIMINDEX_GE_1;
13823 LE_REFL; REAL_LT_01; NORM_NEG];
13827 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DELETE] THEN
13828 EXISTS_TAC `basis 2:real^N` THEN
13829 ASM_SIMP_TAC[IN_ELIM_THM; NORM_MUL; NORM_BASIS; ARITH;
13830 ARITH_RULE `3 <= n ==> 2 <= n`] THEN
13831 ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r * &1 = r`] THEN
13832 CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$1`) THEN
13833 ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT; BASIS_COMPONENT;
13834 ARITH; DIMINDEX_GE_1] THEN
13835 ASM_REAL_ARITH_TAC] THEN
13837 `({x:real^N | norm x = &1} DELETE basis 1) INTER
13838 ({x | norm x = &1} DELETE --basis 1) =
13839 ({x:real^N | norm x = &1} DELETE basis 1) INTER {x | &0 <= x$1} UNION
13840 ({x:real^N | norm x = &1} DELETE --basis 1) INTER {x | x$1 <= &0}`
13842 [MATCH_MP_TAC(SET_RULE
13843 `t UNION u = UNIV /\ ~(b IN u) /\ ~(c IN t)
13844 ==> (s DELETE b) INTER (s DELETE c) =
13845 (s DELETE b) INTER t UNION (s DELETE c) INTER u`) THEN
13846 SIMP_TAC[IN_ELIM_THM; EXTENSION; IN_UNION; IN_UNIV; BASIS_COMPONENT;
13847 DIMINDEX_GE_1; LE_REFL; VECTOR_NEG_COMPONENT] THEN
13850 MATCH_MP_TAC PATH_CONNECTED_UNION THEN
13851 REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
13853 REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `basis 2:real^N` THEN
13854 ASM_SIMP_TAC[IN_INTER; IN_DELETE; IN_ELIM_THM; NORM_BASIS; BASIS_NE; ARITH;
13855 BASIS_COMPONENT; ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`] THEN
13856 REWRITE_TAC[REAL_LE_REFL] THEN
13857 DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$1`) THEN
13858 ASM_SIMP_TAC[VECTOR_NEG_COMPONENT; BASIS_COMPONENT;
13859 ARITH; ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`] THEN
13860 CONV_TAC REAL_RAT_REDUCE_CONV] THEN
13862 `path_connected((cball(vec 0,&1) INTER {x:real^N | x$1 = &0}) DELETE
13865 [REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
13866 MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN
13867 SIMP_TAC[CARD_LT_FINITE_INFINITE; FINITE_SING; real_INFINITE] THEN
13868 SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; CONVEX_STANDARD_HYPERPLANE] THEN
13869 DISCH_THEN(MP_TAC o
13870 SPEC `{vec 0:real^N,basis 2,basis 3}` o
13871 MATCH_MP (REWRITE_RULE [IMP_CONJ] COLLINEAR_SUBSET)) THEN
13872 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTER; IN_CBALL_0;
13873 IN_ELIM_THM; NORM_0; VEC_COMPONENT; REAL_POS] THEN
13874 ASM_SIMP_TAC[NORM_BASIS; BASIS_COMPONENT; ARITH; REAL_LE_REFL;
13875 ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`;
13876 COLLINEAR_3_AFFINE_HULL; BASIS_NONZERO] THEN
13877 REWRITE_TAC[AFFINE_HULL_2_ALT; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
13878 REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN
13879 DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$3`) THEN
13880 ASM_SIMP_TAC[BASIS_COMPONENT; VECTOR_MUL_COMPONENT;
13881 ARITH; ARITH_RULE `3 <= n ==> 1 <= n /\ 2 <= n`] THEN
13884 MATCH_MP_TAC(MESON[PATH_CONNECTED_CONTINUOUS_IMAGE]
13885 `(?f g. f continuous_on s /\ g continuous_on s /\
13886 IMAGE f s = t /\ IMAGE g s = u)
13887 ==> path_connected s ==> path_connected t /\ path_connected u`) THEN
13888 EXISTS_TAC `\x:real^N. x + sqrt(&1 - norm(x) pow 2) % basis 1` THEN
13889 EXISTS_TAC `\x:real^N. x - sqrt(&1 - norm(x) pow 2) % basis 1` THEN
13890 REPEAT CONJ_TAC THENL
13891 [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
13892 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13893 REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF]
13894 CONTINUOUS_ON_LIFT_SQRT_COMPOSE) THEN
13895 SIMP_TAC[IN_INTER; IN_DELETE; IN_CBALL_0; REAL_SUB_LE;
13896 REAL_POW_1_LE; NORM_POS_LE; LIFT_SUB] THEN
13897 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
13898 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13899 REWRITE_TAC[REAL_POW_2; LIFT_CMUL] THEN
13900 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13901 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
13902 REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
13903 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
13904 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13905 REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REWRITE_RULE[o_DEF]
13906 CONTINUOUS_ON_LIFT_SQRT_COMPOSE) THEN
13907 SIMP_TAC[IN_INTER; IN_DELETE; IN_CBALL_0; REAL_SUB_LE;
13908 REAL_POW_1_LE; NORM_POS_LE; LIFT_SUB] THEN
13909 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
13910 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13911 REWRITE_TAC[REAL_POW_2; LIFT_CMUL] THEN
13912 MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13913 REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
13914 REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
13915 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTER; IN_DELETE; IN_CBALL_0;
13917 X_GEN_TAC `y:real^N` THEN EQ_TAC THENL
13918 [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
13919 ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
13920 SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13921 REWRITE_TAC[NORM_EQ_SQUARE; REAL_ADD_LID; REAL_MUL_RID; REAL_POS] THEN
13922 REWRITE_TAC[VECTOR_ARITH
13923 `(x + y:real^N) dot (x + y) = (x dot x + y dot y) + &2 * x dot y`] THEN
13924 ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; DOT_RMUL;
13925 VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
13926 REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_ADD_RID] THEN
13927 REWRITE_TAC[GSYM REAL_POW_2] THEN
13928 ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; REAL_POW_1_LE;
13930 CONJ_TAC THENL [REWRITE_TAC[NORM_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN
13931 DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$1`) THEN
13932 ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
13933 BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13934 REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN
13935 DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN
13936 ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; REAL_POW_1_LE;
13938 REWRITE_TAC[REAL_RING `&1 - x pow 2 = &1 pow 2 <=> x = &0`] THEN
13939 ASM_REWRITE_TAC[NORM_EQ_0];
13940 STRIP_TAC THEN EXISTS_TAC `y - y$1 % basis 1:real^N` THEN
13941 REPEAT CONJ_TAC THENL
13942 [REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH
13943 `y:real^N = y - r % b + s % b <=> (s - r) % b = vec 0`] THEN
13944 DISJ1_TAC THEN MATCH_MP_TAC SQRT_UNIQUE THEN
13945 ASM_REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
13946 `(x - y:real^N) dot (x - y) = (x dot x + y dot y) - &2 * x dot y`] THEN
13947 SIMP_TAC[DOT_RMUL] THEN
13948 SIMP_TAC[DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL;
13949 BASIS_COMPONENT] THEN
13950 ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REAL_ARITH_TAC;
13951 FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
13952 MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
13953 SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT;
13954 BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13955 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
13957 SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT;
13958 BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13960 REWRITE_TAC[VECTOR_SUB_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
13961 MAP_EVERY UNDISCH_TAC
13962 [`~((y:real^N)$1 % basis 1:real^N = basis 1)`;
13963 `norm((y:real^N)$1 % basis 1:real^N) = &1`;
13964 `&0 <= ((y:real^N)$1 % basis 1:real^N)$1`] THEN
13965 SIMP_TAC[NORM_MUL; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; NORM_BASIS;
13966 DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID; real_abs; VECTOR_MUL_LID]]];
13967 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTER; IN_DELETE; IN_CBALL_0;
13969 X_GEN_TAC `y:real^N` THEN EQ_TAC THENL
13970 [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
13971 ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN
13972 SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13973 REWRITE_TAC[NORM_EQ_SQUARE; REAL_ADD_LID; REAL_MUL_RID; REAL_POS] THEN
13974 REWRITE_TAC[VECTOR_ARITH
13975 `(x - y:real^N) dot (x - y) = (x dot x + y dot y) - &2 * x dot y`] THEN
13976 ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; DOT_RMUL;
13977 VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
13978 REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_SUB_RZERO] THEN
13979 REWRITE_TAC[GSYM REAL_POW_2] THEN
13980 REWRITE_TAC[REAL_ARITH `&0 - x <= &0 <=> &0 <= x`] THEN
13981 ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; REAL_POW_1_LE;
13983 CONJ_TAC THENL [REWRITE_TAC[NORM_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN
13984 DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$1`) THEN
13985 ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT;
13986 VECTOR_NEG_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
13987 REWRITE_TAC[REAL_ARITH `&0 - x * &1 = -- &1 <=> x = &1`] THEN
13988 DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN
13989 ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; REAL_POW_1_LE;
13991 REWRITE_TAC[REAL_RING `&1 - x pow 2 = &1 pow 2 <=> x = &0`] THEN
13992 ASM_REWRITE_TAC[NORM_EQ_0];
13993 STRIP_TAC THEN EXISTS_TAC `y - y$1 % basis 1:real^N` THEN
13994 REPEAT CONJ_TAC THENL
13995 [REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH
13996 `y:real^N = y - r % b - s % b <=> (s + r) % b = vec 0`] THEN
13997 DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `x + y = &0 <=> x = --y`] THEN
13998 MATCH_MP_TAC SQRT_UNIQUE THEN
13999 ASM_REWRITE_TAC[REAL_NEG_GE0; NORM_POW_2; VECTOR_ARITH
14000 `(x - y:real^N) dot (x - y) = (x dot x + y dot y) - &2 * x dot y`] THEN
14001 SIMP_TAC[DOT_RMUL] THEN
14002 SIMP_TAC[DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL;
14003 BASIS_COMPONENT] THEN
14004 ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REAL_ARITH_TAC;
14005 FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
14006 MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
14007 SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT;
14008 BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
14009 REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
14011 SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT;
14012 BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
14014 REWRITE_TAC[VECTOR_SUB_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
14015 MAP_EVERY UNDISCH_TAC
14016 [`~((y:real^N)$1 % basis 1:real^N = --basis 1)`;
14017 `norm((y:real^N)$1 % basis 1:real^N) = &1`;
14018 `((y:real^N)$1 % basis 1:real^N)$1 <= &0`] THEN
14019 SIMP_TAC[NORM_MUL; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; NORM_BASIS;
14020 DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID; VECTOR_MUL_LID;
14021 REAL_ARITH `y <= &0 ==> abs y = --y`;
14022 REAL_ARITH `--x = &1 <=> x = -- &1`] THEN
14023 REPEAT DISCH_TAC THEN VECTOR_ARITH_TAC]]]);;
14025 (* ------------------------------------------------------------------------- *)
14026 (* Covering spaces and lifting results for them. *)
14027 (* ------------------------------------------------------------------------- *)
14029 let covering_space = new_definition
14030 `covering_space(c,(p:real^M->real^N)) s <=>
14031 p continuous_on c /\ IMAGE p c = s /\
14033 ==> ?t. x IN t /\ open_in (subtopology euclidean s) t /\
14034 ?v. UNIONS v = {x | x IN c /\ p(x) IN t} /\
14035 (!u. u IN v ==> open_in (subtopology euclidean c) u) /\
14036 pairwise DISJOINT v /\
14037 (!u. u IN v ==> ?q. homeomorphism (u,t) (p,q))`;;
14039 let COVERING_SPACE_IMP_CONTINUOUS = prove
14040 (`!p:real^M->real^N c s. covering_space (c,p) s ==> p continuous_on c`,
14041 SIMP_TAC[covering_space]);;
14043 let COVERING_SPACE_IMP_SURJECTIVE = prove
14044 (`!p:real^M->real^N c s. covering_space (c,p) s ==> IMAGE p c = s`,
14045 SIMP_TAC[covering_space]);;
14047 let HOMEOMORPHISM_IMP_COVERING_SPACE = prove
14048 (`!f:real^M->real^N g s t.
14049 homeomorphism (s,t) (f,g) ==> covering_space (s,f) t`,
14050 REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
14051 ASM_REWRITE_TAC[covering_space] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
14052 EXISTS_TAC `t:real^N->bool` THEN
14053 ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
14054 EXISTS_TAC `{s:real^M->bool}` THEN
14055 REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_1; PAIRWISE_SING] THEN
14056 ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
14057 CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `g:real^N->real^M`] THEN
14058 ASM_REWRITE_TAC[homeomorphism]);;
14060 let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove
14061 (`!p:real^M->real^N c s.
14062 covering_space (c,p) s
14064 ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\
14065 p(x) IN u /\ open_in (subtopology euclidean s) u /\
14066 ?q. homeomorphism (t,u) (p,q)`,
14067 REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
14068 FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN
14069 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14070 DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN
14071 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14072 DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
14073 SUBGOAL_THEN `(x:real^M) IN UNIONS v` MP_TAC THENL
14074 [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
14075 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN
14076 STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);;
14078 let COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT = prove
14079 (`!p:real^M->real^N c s.
14080 covering_space (c,p) s
14082 ==> ?x t u. p(x) = y /\
14083 x IN t /\ open_in (subtopology euclidean c) t /\
14084 y IN u /\ open_in (subtopology euclidean s) u /\
14085 ?q. homeomorphism (t,u) (p,q)`,
14086 REPEAT STRIP_TAC THEN
14087 SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL
14088 [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14090 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
14091 FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP
14092 COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
14093 ASM_MESON_TAC[]]);;
14095 let COVERING_SPACE_OPEN_MAP = prove
14096 (`!p:real^M->real^N c s t.
14097 covering_space (c,p) s /\
14098 open_in (subtopology euclidean c) t
14099 ==> open_in (subtopology euclidean s) (IMAGE p t)`,
14100 REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
14101 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
14102 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN
14103 DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
14104 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14105 DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
14106 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14107 DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool`
14108 (STRIP_ASSUME_TAC o GSYM)) THEN
14110 `?x. x IN {x | x IN c /\ (p:real^M->real^N) x IN u} /\ x IN t /\ p x = y`
14111 MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
14112 DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
14113 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
14114 DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
14115 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
14116 ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN
14117 FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
14118 EXISTS_TAC `IMAGE (p:real^M->real^N) (t INTER v)` THEN CONJ_TAC THENL
14119 [ALL_TAC; ASM SET_TAC[]] THEN
14121 `IMAGE (p:real^M->real^N) (t INTER v) =
14122 {z | z IN u /\ q z IN (t INTER v)}`
14123 SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14124 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
14125 ASM_REWRITE_TAC[] THEN
14126 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
14127 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
14128 MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
14129 EXISTS_TAC `c:real^M->bool` THEN
14130 CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER; ASM_MESON_TAC[open_in]] THEN
14131 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;
14133 let COVERING_SPACE_QUOTIENT_MAP = prove
14134 (`!p:real^M->real^N c s.
14135 covering_space (c,p) s
14137 ==> (open_in (subtopology euclidean c) {x | x IN c /\ p x IN u} <=>
14138 open_in (subtopology euclidean s) u)`,
14139 REPEAT GEN_TAC THEN DISCH_TAC THEN
14140 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14141 MATCH_MP_TAC OPEN_MAP_IMP_QUOTIENT_MAP THEN
14142 CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
14143 FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14144 ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;
14146 let COVERING_SPACE_LOCALLY = prove
14147 (`!P Q p:real^M->real^N c s.
14148 covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
14151 REPEAT STRIP_TAC THEN
14152 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14153 MATCH_MP_TAC LOCALLY_OPEN_MAP_IMAGE THEN
14154 EXISTS_TAC `P:(real^M->bool)->bool` THEN
14155 CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
14156 ASM_SIMP_TAC[] THEN
14157 FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14158 ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;
14160 let COVERING_SPACE_LOCALLY_CONNECTED = prove
14161 (`!p:real^M->real^N c s.
14162 covering_space (c,p) s /\ locally connected c ==> locally connected s`,
14163 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY THEN
14164 MAP_EVERY EXISTS_TAC
14165 [`connected:(real^M->bool)->bool`;
14166 `p:real^M->real^N`; `c:real^M->bool`] THEN
14167 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14168 MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
14169 ASM_REWRITE_TAC[] THEN
14170 ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS; CONTINUOUS_ON_SUBSET]);;
14172 let COVERING_SPACE_LOCALLY_PATH_CONNECTED = prove
14173 (`!p:real^M->real^N c s.
14174 covering_space (c,p) s /\ locally path_connected c
14175 ==> locally path_connected s`,
14176 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY THEN
14177 MAP_EVERY EXISTS_TAC
14178 [`path_connected:(real^M->bool)->bool`;
14179 `p:real^M->real^N`; `c:real^M->bool`] THEN
14180 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14181 MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
14182 ASM_REWRITE_TAC[] THEN
14183 ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS; CONTINUOUS_ON_SUBSET]);;
14185 let COVERING_SPACE_LIFT_UNIQUE_GEN = prove
14186 (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t u a x.
14187 covering_space (c,p) s /\
14188 f continuous_on t /\ IMAGE f t SUBSET s /\
14189 g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
14190 (!x. x IN t ==> f(x) = p(g1 x)) /\
14191 g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
14192 (!x. x IN t ==> f(x) = p(g2 x)) /\
14193 u IN components t /\ a IN u /\ g1(a) = g2(a) /\ x IN u
14194 ==> g1(x) = g2(x)`,
14195 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
14196 UNDISCH_TAC `(x:real^P) IN u` THEN SPEC_TAC(`x:real^P`,`x:real^P`) THEN
14197 MATCH_MP_TAC(SET_RULE
14198 `(?a. a IN u /\ g a = z) /\
14199 ({x | x IN u /\ g x = z} = {} \/ {x | x IN u /\ g x = z} = u)
14200 ==> !x. x IN u ==> g x = z`) THEN
14201 CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ]; ALL_TAC] THEN
14202 FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
14203 REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN MATCH_MP_TAC THEN
14204 FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL
14205 [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN
14206 X_GEN_TAC `x:real^P` THEN STRIP_TAC THEN
14207 FIRST_ASSUM(MP_TAC o SPEC `(g1:real^P->real^M) x` o
14208 MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
14209 ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN
14210 MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`] THEN
14211 RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN
14212 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14213 REWRITE_TAC[homeomorphism] THEN
14214 DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
14215 EXISTS_TAC `{x | x IN u /\ (g1:real^P->real^M) x IN v} INTER
14216 {x | x IN u /\ (g2:real^P->real^M) x IN v}` THEN
14218 [MATCH_MP_TAC OPEN_IN_INTER THEN ONCE_REWRITE_TAC[SET_RULE
14219 `{x | x IN u /\ g x IN v} =
14220 {x | x IN u /\ g x IN (v INTER IMAGE g u)}`] THEN
14221 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN
14222 (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN
14223 UNDISCH_TAC `open_in (subtopology euclidean c) (v:real^M->bool)` THEN
14224 REWRITE_TAC[OPEN_IN_OPEN] THEN
14225 MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[];
14226 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER; VECTOR_SUB_EQ] THEN
14228 MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN
14229 MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
14230 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;
14232 let COVERING_SPACE_LIFT_UNIQUE = prove
14233 (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t a x.
14234 covering_space (c,p) s /\
14235 f continuous_on t /\ IMAGE f t SUBSET s /\
14236 g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
14237 (!x. x IN t ==> f(x) = p(g1 x)) /\
14238 g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
14239 (!x. x IN t ==> f(x) = p(g2 x)) /\
14240 connected t /\ a IN t /\ g1(a) = g2(a) /\ x IN t
14241 ==> g1(x) = g2(x)`,
14242 REPEAT STRIP_TAC THEN MP_TAC(ISPECL
14243 [`p:real^M->real^N`; `f:real^P->real^N`;
14244 `g1:real^P->real^M`; `g2:real^P->real^M`;
14245 `c:real^M->bool`; `s:real^N->bool`; `t:real^P->bool`; `t:real^P->bool`;
14246 `a:real^P`; `x:real^P`] COVERING_SPACE_LIFT_UNIQUE_GEN) THEN
14247 ASM_REWRITE_TAC[IN_COMPONENTS_SELF] THEN ASM SET_TAC[]);;
14249 let COVERING_SPACE_LIFT_UNIQUE_IDENTITY = prove
14250 (`!p:real^M->real^N c f s a.
14251 covering_space (c,p) s /\
14252 path_connected c /\
14253 f continuous_on c /\ IMAGE f c SUBSET c /\
14254 (!x. x IN c ==> p(f x) = p x) /\
14256 ==> !x. x IN c ==> f x = x`,
14257 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
14258 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
14259 DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `x:real^M`]) THEN
14260 ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
14261 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
14262 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
14264 [`p:real^M->real^N`; `(p:real^M->real^N) o (g:real^1->real^M)`;
14265 `(f:real^M->real^M) o (g:real^1->real^M)`; `g:real^1->real^M`;
14266 `c:real^M->bool`; `s:real^N->bool`;
14267 `interval[vec 0:real^1,vec 1]`;
14268 `vec 0:real^1`; `vec 1:real^1`]
14269 COVERING_SPACE_LIFT_UNIQUE) THEN
14270 ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN
14271 ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
14272 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
14273 STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
14274 `IMAGE p c = s ==> !x. x IN c ==> p(x) IN s`)) THEN
14275 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
14276 CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14277 ASM_REWRITE_TAC[] THEN
14278 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14279 CONTINUOUS_ON_SUBSET)) THEN
14280 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);;
14282 let COVERING_SPACE_LIFT_HOMOTOPY = prove
14283 (`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u.
14284 covering_space (c,p) s /\
14285 h continuous_on (interval[vec 0,vec 1] PCROSS u) /\
14286 IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\
14287 (!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\
14288 f continuous_on u /\ IMAGE f u SUBSET c
14289 ==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\
14290 IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\
14291 (!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\
14292 (!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`,
14293 REPEAT STRIP_TAC THEN
14296 ==> ?v. open_in (subtopology euclidean u) v /\ y IN v /\
14297 ?k:real^(1,P)finite_sum->real^M.
14298 k continuous_on (interval[vec 0,vec 1] PCROSS v) /\
14299 IMAGE k (interval[vec 0,vec 1] PCROSS v) SUBSET c /\
14300 (!y. y IN v ==> k(pastecart (vec 0) y) = f y) /\
14301 (!z. z IN interval[vec 0,vec 1] PCROSS v
14302 ==> h z :real^N = p(k z))`
14305 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
14306 [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
14307 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
14308 MAP_EVERY X_GEN_TAC
14309 [`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN
14310 DISCH_THEN(LABEL_TAC "*") THEN
14312 [`fs:real^P->real^(1,P)finite_sum->real^M`;
14313 `(\x. interval[vec 0,vec 1] PCROSS (v x))
14314 :real^P->real^(1,P)finite_sum->bool`;
14315 `(interval[vec 0,vec 1] PCROSS u):real^(1,P)finite_sum->bool`;
14317 PASTING_LEMMA_EXISTS) THEN
14318 ASM_SIMP_TAC[] THEN ANTS_TAC THENL
14320 MATCH_MP_TAC MONO_EXISTS THEN
14321 X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN
14322 ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
14323 REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN
14324 X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL
14325 [FIRST_X_ASSUM(MP_TAC o SPECL
14326 [`pastecart (t:real^1) (y:real^P)`; `y:real^P`]);
14327 FIRST_X_ASSUM(MP_TAC o SPECL
14328 [`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]);
14329 FIRST_X_ASSUM(MP_TAC o SPECL
14330 [`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN
14331 ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_INTER; ENDS_IN_UNIT_INTERVAL] THEN
14332 DISCH_THEN SUBST1_TAC THEN
14333 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
14334 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
14335 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
14336 ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
14337 REPEAT CONJ_TAC THENL
14338 [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; UNIONS_GSPEC; IN_ELIM_THM] THEN
14339 MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN
14340 EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS];
14341 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
14342 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
14343 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
14344 REWRITE_TAC[OPEN_IN_OPEN] THEN
14345 DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN
14346 EXISTS_TAC `(:real^1) PCROSS (t:real^P->bool)` THEN
14347 ASM_SIMP_TAC[REWRITE_RULE[GSYM PCROSS] OPEN_PCROSS; OPEN_UNIV] THEN
14348 REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
14349 IN_INTER; IN_UNIV] THEN
14350 REPEAT GEN_TAC THEN CONV_TAC TAUT;
14351 REWRITE_TAC[FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN
14352 MAP_EVERY X_GEN_TAC
14353 [`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN
14354 REWRITE_TAC[CONJ_ACI] THEN STRIP_TAC THEN
14355 FIRST_ASSUM(MP_TAC o
14356 ISPECL [`h:real^(1,P)finite_sum->real^N`;
14357 `(fs:real^P->real^(1,P)finite_sum->real^M) x`;
14358 `(fs:real^P->real^(1,P)finite_sum->real^M) z`;
14359 `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`;
14360 `pastecart (vec 0:real^1) (y:real^P)`;
14361 `pastecart (t:real^1) (y:real^P)`] o
14362 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
14363 DISCH_THEN MATCH_MP_TAC THEN
14364 ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_SING; ENDS_IN_UNIT_INTERVAL] THEN
14365 SIMP_TAC[REWRITE_RULE[GSYM PCROSS] CONNECTED_PCROSS;
14366 CONNECTED_INTERVAL; CONNECTED_SING] THEN
14368 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14369 CONTINUOUS_ON_SUBSET)) THEN
14370 REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
14371 ASM_SIMP_TAC[IN_SING];
14374 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14375 (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN
14376 MATCH_MP_TAC IMAGE_SUBSET THEN
14377 REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
14378 ASM_SIMP_TAC[IN_SING];
14380 ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN
14382 [REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`);
14383 REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN
14384 ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; FORALL_IN_IMAGE] THEN
14385 ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING] THEN
14387 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14388 CONTINUOUS_ON_SUBSET)) THEN
14389 REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
14390 ASM_SIMP_TAC[IN_SING]]] THEN
14391 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
14392 FIRST_ASSUM(MP_TAC o last o CONJUNCTS o
14393 GEN_REWRITE_RULE I [covering_space]) THEN
14394 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
14395 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
14396 X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN
14398 `!t. t IN interval[vec 0,vec 1]
14400 open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\
14401 open_in (subtopology euclidean u) n /\
14402 t IN k /\ y IN n /\ i IN s /\
14403 IMAGE (h:real^(1,P)finite_sum->real^N) (k PCROSS n) SUBSET uu i`
14405 [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
14406 SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y) IN s`
14408 [FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[FORALL_IN_IMAGE] o
14409 GEN_REWRITE_RULE I [SUBSET]) THEN
14410 ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
14413 `open_in (subtopology euclidean (interval[vec 0,vec 1] PCROSS u))
14414 {z | z IN (interval[vec 0,vec 1] PCROSS u) /\
14415 (h:real^(1,P)finite_sum->real^N) z IN
14416 uu(h(pastecart t y))}`
14418 [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
14419 EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[];
14421 DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
14422 PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN
14423 DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN
14424 ASM_SIMP_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
14425 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
14426 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN
14428 EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN
14429 ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
14431 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN
14432 REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
14433 REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
14434 REWRITE_TAC[MESON[]
14435 `(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN
14436 REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
14437 GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
14438 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
14439 MAP_EVERY X_GEN_TAC
14440 [`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`;
14441 `xx:real^1->real^N`] THEN
14442 DISCH_THEN(LABEL_TAC "+") THEN
14443 MP_TAC(ISPEC `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`
14444 COMPACT_IMP_HEINE_BOREL) THEN
14445 SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_SING] THEN
14446 DISCH_THEN(MP_TAC o SPEC
14447 `IMAGE ((\i. kk i PCROSS nn i):real^1->real^(1,P)finite_sum->bool)
14448 (interval[vec 0,vec 1])`) THEN
14449 ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_PCROSS] THEN ANTS_TAC THENL
14450 [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IN_SING] THEN
14451 MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN
14452 ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
14453 ASM_MESON_TAC[IN_INTER];
14454 GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
14455 [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
14456 REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
14457 DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN
14458 ABBREV_TAC `n = INTERS (IMAGE (nn:real^1->real^P->bool) tk)` THEN
14459 SUBGOAL_THEN `(y:real^P) IN n /\ open n` STRIP_ASSUME_TAC THENL
14460 [EXPAND_TAC "n" THEN CONJ_TAC THENL
14461 [REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM];
14462 MATCH_MP_TAC OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
14463 ASM_SIMP_TAC[FINITE_IMAGE]] THEN
14464 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
14465 REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
14466 (ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_INTER]]);
14469 [`interval[vec 0:real^1,vec 1]`; `IMAGE (kk:real^1->real^1->bool) tk`]
14470 LEBESGUE_COVERING_LEMMA) THEN
14471 REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
14473 `q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t)
14474 ==> (~p /\ q /\ r ==> s) ==> t`) THEN
14475 SIMP_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
14477 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
14478 REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IMP_CONJ; IN_SING] THEN
14479 REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
14480 REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
14483 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14484 DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
14485 MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN
14486 ASM_REWRITE_TAC[] THEN
14487 DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
14490 ==> ?v k:real^(1,P)finite_sum->real^M.
14491 open_in (subtopology euclidean u) v /\
14493 k continuous_on interval[vec 0,lift(&n / &N)] PCROSS v /\
14494 IMAGE k (interval[vec 0,lift(&n / &N)] PCROSS v) SUBSET c /\
14495 (!y. y IN v ==> k (pastecart (vec 0) y) = f y) /\
14496 (!z. z IN interval[vec 0,lift(&n / &N)] PCROSS v
14497 ==> h z:real^N = p (k z))`
14500 DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN
14501 ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM]] THEN
14502 MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
14503 [DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN
14504 EXISTS_TAC `u:real^P->bool` THEN
14505 EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN
14506 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; INTERVAL_SING] THEN
14507 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; o_THM] THEN
14508 ASM_REWRITE_TAC[FORALL_UNWIND_THM2; SNDCART_PASTECART] THEN
14509 REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
14510 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14511 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14512 SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
14513 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14514 CONTINUOUS_ON_SUBSET)) THEN
14515 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14516 SIMP_TAC[SNDCART_PASTECART];
14518 X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN
14519 ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`; LEFT_IMP_EXISTS_THM] THEN
14520 MAP_EVERY X_GEN_TAC
14521 [`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN
14522 STRIP_TAC THEN FIRST_X_ASSUM
14523 (MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN
14525 [REWRITE_TAC[DIAMETER_INTERVAL; SUBSET_INTERVAL_1] THEN
14526 REWRITE_TAC[LIFT_DROP; DROP_VEC; INTERVAL_EQ_EMPTY_1;
14527 GSYM LIFT_SUB; NORM_LIFT] THEN
14528 ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1;
14529 REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN
14530 SIMP_TAC[GSYM NOT_LE; ARITH_RULE `m <= SUC m`; REAL_OF_NUM_SUB] THEN
14531 ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_DIV; REAL_POS;
14532 REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN
14533 ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`; REAL_LT_IMP_LE] THEN
14534 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
14535 ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC;
14537 REWRITE_TAC[EXISTS_IN_IMAGE] THEN
14538 DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
14539 REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
14540 ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
14541 FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN
14542 ASM_REWRITE_TAC[] THEN
14543 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14544 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
14545 ONCE_REWRITE_TAC[IMP_CONJ] THEN
14546 GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
14547 DISCH_THEN(MP_TAC o SPEC
14548 `(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN
14549 REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT
14550 `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
14551 REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER])) THEN
14553 `lift(&m / &N) IN interval[vec 0,lift (&m / &N)] /\
14554 lift(&m / &N) IN interval[lift(&m / &N),lift(&(SUC m) / &N)]`
14555 STRIP_ASSUME_TAC THENL
14556 [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
14557 SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_REFL] THEN
14558 ASM_SIMP_TAC[REAL_LE_DIV2_EQ; LE_1; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
14561 REPEAT CONJ_TAC THENL
14562 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
14563 MATCH_MP_TAC FUN_IN_IMAGE THEN
14564 ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
14565 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN
14566 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
14567 DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14568 (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
14569 ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
14570 ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_LE_DIV; REAL_LE_LDIV_EQ;
14571 REAL_POS; REAL_OF_NUM_LT; LE_1; DROP_VEC] THEN
14572 REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN
14573 CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
14574 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
14576 GEN_REWRITE_TAC LAND_CONV [IN_UNIONS] THEN
14577 DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
14578 DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN
14579 DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN
14580 ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
14581 DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool) IN vv` (K ALL_TAC)] THEN
14582 ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN
14584 `?n'. open_in (subtopology euclidean u) n' /\ y IN n' /\
14585 IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)} PCROSS n')
14587 STRIP_ASSUME_TAC THENL
14589 `{z | z IN v /\ ((k:real^(1,P)finite_sum->real^M) o
14590 pastecart (lift(&m / &N))) z IN w}` THEN
14591 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14592 ASM_SIMP_TAC[IN_ELIM_THM; IN_SING; o_THM] THEN
14593 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN
14594 ASM_REWRITE_TAC[] THEN
14595 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
14596 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
14597 ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THENL
14598 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14599 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
14600 CONTINUOUS_ON_ID] THEN
14601 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14602 CONTINUOUS_ON_SUBSET));
14603 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14604 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
14605 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
14608 `?q q':real^P->bool.
14609 open_in (subtopology euclidean u) q /\
14610 closed_in (subtopology euclidean u) q' /\
14611 y IN q /\ y IN q' /\ q SUBSET q' /\
14612 q SUBSET (u INTER nn(t:real^1)) INTER n' INTER v /\
14613 q' SUBSET (u INTER nn(t:real^1)) INTER n' INTER v`
14614 STRIP_ASSUME_TAC THENL
14615 [REWRITE_TAC[SET_RULE
14616 `y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET s /\ q' SUBSET s <=>
14617 y IN q /\ q SUBSET q' /\ q' SUBSET s`] THEN
14618 UNDISCH_TAC `open_in (subtopology euclidean u) (v:real^P->bool)` THEN
14619 UNDISCH_TAC `open_in (subtopology euclidean u) (n':real^P->bool)` THEN
14620 REWRITE_TAC[OPEN_IN_OPEN] THEN
14621 DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN
14622 DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN
14623 MP_TAC(ISPEC `nn(t:real^1) INTER vo INTER vx:real^P->bool`
14624 OPEN_CONTAINS_CBALL) THEN
14625 ASM_SIMP_TAC[OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN
14626 ASM_REWRITE_TAC[IN_INTER] THEN
14627 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14628 DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
14629 EXISTS_TAC `u INTER ball(y:real^P,e)` THEN
14630 EXISTS_TAC `u INTER cball(y:real^P,e)` THEN
14631 REWRITE_TAC[CLOSED_IN_CLOSED] THEN
14632 CONJ_TAC THENL [MESON_TAC[OPEN_BALL]; ALL_TAC] THEN
14633 CONJ_TAC THENL [MESON_TAC[CLOSED_CBALL]; ALL_TAC] THEN
14634 ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
14635 MP_TAC(ISPECL [`y:real^P`; `e:real`] BALL_SUBSET_CBALL) THEN
14638 FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
14639 EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
14641 [`\x:real^(1,P)finite_sum.
14642 x IN interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
14643 `k:real^(1,P)finite_sum->real^M`;
14644 `(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`;
14645 `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
14646 `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (q':real^P->bool)`]
14647 CONTINUOUS_ON_CASES_LOCAL) THEN
14648 REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL
14649 [REPEAT CONJ_TAC THENL
14650 [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
14651 EXISTS_TAC `interval[vec 0,lift(&m / &N)] PCROSS (:real^P)` THEN
14652 SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
14653 REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
14654 REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
14655 REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC
14656 `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (:real^P)` THEN
14657 SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
14658 REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
14659 REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
14660 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14661 CONTINUOUS_ON_SUBSET)) THEN
14662 REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
14664 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
14665 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14666 CONTINUOUS_ON_SUBSET))
14669 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14670 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
14671 MATCH_MP_TAC PCROSS_MONO THEN
14672 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
14673 ASM_REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
14675 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
14676 ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
14678 ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1;
14679 REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
14680 DISJ2_TAC THEN ARITH_TAC;
14681 REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
14682 MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN
14683 ASM_CASES_TAC `(z:real^P) IN q'` THEN ASM_REWRITE_TAC[] THEN
14684 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP
14685 (REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN
14686 REWRITE_TAC[DROP_EQ; o_THM] THEN DISCH_THEN SUBST1_TAC THEN
14687 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
14688 `(!x. x IN w ==> p' (p x) = x)
14689 ==> h z = p(k z) /\ k z IN w
14690 ==> k z = p' (h z)`)) THEN
14692 [FIRST_X_ASSUM MATCH_MP_TAC THEN
14693 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
14694 FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
14695 MATCH_MP_TAC FUN_IN_IMAGE THEN
14696 REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]]];
14698 `interval[vec 0,lift(&m / &N)] UNION
14699 interval [lift(&m / &N),lift(&(SUC m) / &N)] =
14700 interval[vec 0,lift(&(SUC m) / &N)]`
14702 [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN GEN_TAC THEN
14703 MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==>
14704 (a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN
14705 SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_DIV; REAL_POS] THEN
14706 ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1] THEN
14710 `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool) UNION
14711 interval [lift(&m / &N),lift(&(SUC m) / &N)] PCROSS q' =
14712 interval[vec 0,lift(&(SUC m) / &N)] PCROSS q'`
14714 [SIMP_TAC[EXTENSION; IN_UNION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
14717 MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
14718 `t SUBSET s /\ (f continuous_on s ==> P f)
14719 ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
14720 ASM_SIMP_TAC[PCROSS_MONO; SUBSET_REFL] THEN DISCH_TAC THEN
14721 REPEAT CONJ_TAC THENL
14722 [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14723 MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
14724 SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
14725 [ASM SET_TAC[]; ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
14726 COND_CASES_TAC THEN REWRITE_TAC[o_THM] THENL
14727 [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
14728 MATCH_MP_TAC FUN_IN_IMAGE THEN
14729 REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[];
14730 FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o
14731 CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
14732 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14733 `IMAGE p w' = w ==> x IN w' ==> p x IN w`))];
14734 X_GEN_TAC `z:real^P` THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN
14735 DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN
14736 SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
14737 [ASM SET_TAC[]; ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC]] THEN
14738 SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN ASM SET_TAC[];
14739 REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
14740 MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
14741 SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
14742 [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
14743 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
14744 [FIRST_X_ASSUM MATCH_MP_TAC THEN
14745 ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
14746 REWRITE_TAC[o_THM] THEN CONV_TAC SYM_CONV THEN
14747 FIRST_X_ASSUM MATCH_MP_TAC]] THEN
14748 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14749 (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
14750 ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
14751 REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
14752 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
14753 REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14754 (REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN
14755 ASM_SIMP_TAC[LIFT_DROP; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
14756 ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);;
14758 let COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION = prove
14759 (`!p:real^M->real^N c s f f' g u:real^P->bool.
14760 covering_space (c,p) s /\
14761 g continuous_on u /\ IMAGE g u SUBSET c /\
14762 (!y. y IN u ==> p(g y) = f y) /\
14763 homotopic_with (\x. T) (u,s) f f'
14764 ==> ?g'. g' continuous_on u /\ IMAGE g' u SUBSET c /\
14765 (!y. y IN u ==> p(g' y) = f' y)`,
14766 REPEAT STRIP_TAC THEN
14767 FIRST_X_ASSUM(X_CHOOSE_THEN `h:real^(1,P)finite_sum->real^N`
14768 STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
14769 FIRST_ASSUM(MP_TAC o
14770 ISPECL [`h:real^(1,P)finite_sum->real^N`;
14771 `g:real^P->real^M`; `u:real^P->bool`] o
14772 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
14773 ASM_SIMP_TAC[] THEN
14774 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
14775 STRIP_ASSUME_TAC) THEN
14776 EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
14777 (\x. pastecart (vec 1) x)` THEN
14778 ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL
14779 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14780 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
14781 CONTINUOUS_ON_ID] THEN
14782 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14783 CONTINUOUS_ON_SUBSET)) THEN
14784 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
14785 ENDS_IN_UNIT_INTERVAL];
14786 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14787 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
14788 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
14789 ENDS_IN_UNIT_INTERVAL];
14790 ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]]);;
14792 let COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION = prove
14793 (`!p:real^M->real^N c s f a u:real^P->bool.
14794 covering_space (c,p) s /\ homotopic_with (\x. T) (u,s) f (\x. a)
14795 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
14796 (!y. y IN u ==> p(g y) = f y)`,
14797 ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
14798 ASM_CASES_TAC `u:real^P->bool = {}` THEN
14799 ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
14800 CONTINUOUS_ON_EMPTY] THEN
14801 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE
14802 [TAUT `a /\ b /\ c /\ d /\ e ==> f <=> a /\ e ==> b /\ c /\ d ==> f`]
14803 COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION)) THEN
14804 FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
14805 FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
14806 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14807 SUBGOAL_THEN `?b. b IN c /\ (p:real^M->real^N) b = a` CHOOSE_TAC THENL
14809 EXISTS_TAC `(\x. b):real^P->real^M`] THEN
14810 REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);;
14812 let COVERING_SPACE_LIFT_HOMOTOPY_ALT = prove
14813 (`!p:real^M->real^N c s (h:real^(P,1)finite_sum->real^N) f u.
14814 covering_space (c,p) s /\
14815 h continuous_on (u PCROSS interval[vec 0,vec 1]) /\
14816 IMAGE h (u PCROSS interval[vec 0,vec 1]) SUBSET s /\
14817 (!y. y IN u ==> h (pastecart y (vec 0)) = p(f y)) /\
14818 f continuous_on u /\ IMAGE f u SUBSET c
14819 ==> ?k. k continuous_on (u PCROSS interval[vec 0,vec 1]) /\
14820 IMAGE k (u PCROSS interval[vec 0,vec 1]) SUBSET c /\
14821 (!y. y IN u ==> k(pastecart y (vec 0)) = f y) /\
14822 (!z. z IN u PCROSS interval[vec 0,vec 1] ==> h z = p(k z))`,
14823 REPEAT STRIP_TAC THEN
14824 FIRST_ASSUM(MP_TAC o ISPECL
14825 [`(h:real^(P,1)finite_sum->real^N) o
14826 (\z. pastecart (sndcart z) (fstcart z))`;
14827 `f:real^P->real^M`; `u:real^P->bool`] o
14828 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
14829 ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL
14831 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14832 SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
14833 LINEAR_FSTCART; LINEAR_SNDCART] THEN
14834 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14835 CONTINUOUS_ON_SUBSET));
14836 REWRITE_TAC[IMAGE_o] THEN
14837 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14838 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
14839 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
14840 FSTCART_PASTECART; SNDCART_PASTECART];
14841 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
14842 STRIP_ASSUME_TAC) THEN
14843 EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
14844 (\z. pastecart (sndcart z) (fstcart z))` THEN
14845 ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
14846 FORALL_IN_PCROSS; PASTECART_IN_PCROSS] THEN
14847 REPEAT CONJ_TAC THENL
14848 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14849 SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
14850 LINEAR_FSTCART; LINEAR_SNDCART] THEN
14851 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14852 CONTINUOUS_ON_SUBSET));
14853 REWRITE_TAC[IMAGE_o] THEN
14854 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14855 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
14856 MAP_EVERY X_GEN_TAC [`x:real^P`; `t:real^1`] THEN STRIP_TAC THEN
14857 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (x:real^P)`)] THEN
14858 ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
14859 FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS]]);;
14861 let COVERING_SPACE_LIFT_PATH_STRONG = prove
14862 (`!p:real^M->real^N c s g a.
14863 covering_space (c,p) s /\
14864 path g /\ path_image g SUBSET s /\ pathstart g = p(a) /\ a IN c
14865 ==> ?h. path h /\ path_image h SUBSET c /\ pathstart h = a /\
14866 !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
14867 REWRITE_TAC[path_image; path; pathstart] THEN
14868 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
14869 ISPECL [`(g:real^1->real^N) o (fstcart:real^(1,P)finite_sum->real^1)`;
14870 `(\y. a):real^P->real^M`; `{arb:real^P}`] o
14871 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
14872 REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; o_THM; FSTCART_PASTECART] THEN
14874 [ASM_REWRITE_TAC[IMAGE_o; CONTINUOUS_ON_CONST] THEN
14875 ASM_REWRITE_TAC[SET_RULE `IMAGE (\y. a) {b} SUBSET s <=> a IN s`] THEN
14877 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14878 SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN
14879 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14880 CONTINUOUS_ON_SUBSET));
14882 ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14883 SIMP_TAC[FSTCART_PASTECART] THEN ASM SET_TAC[];
14884 DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
14885 STRIP_ASSUME_TAC) THEN
14886 EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\t. pastecart t arb)` THEN
14887 ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
14888 [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14889 SIMP_TAC[CONTINUOUS_ON_PASTECART;
14890 CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
14891 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14892 CONTINUOUS_ON_SUBSET)) THEN
14893 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
14894 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14895 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
14896 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
14897 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
14898 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (arb:real^P)`) THEN
14899 ASM_SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; IN_SING]]]);;
14901 let COVERING_SPACE_LIFT_PATH = prove
14902 (`!p:real^M->real^N c s g.
14903 covering_space (c,p) s /\ path g /\ path_image g SUBSET s
14904 ==> ?h. path h /\ path_image h SUBSET c /\
14905 !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
14906 REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
14907 `IMAGE g i SUBSET s ==> vec 0 IN i ==> g(vec 0) IN s`) o
14908 GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
14909 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
14910 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
14911 REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
14912 X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
14913 MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
14914 `g:real^1->real^N`; `a:real^M`]
14915 COVERING_SPACE_LIFT_PATH_STRONG) THEN
14916 ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC MONO_EXISTS THEN
14917 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);;
14919 let COVERING_SPACE_LIFT_HOMOTOPIC_PATHS = prove
14920 (`!p:real^M->real^N c s g1 g2 h1 h2.
14921 covering_space (c,p) s /\
14922 path g1 /\ path_image g1 SUBSET s /\
14923 path g2 /\ path_image g2 SUBSET s /\
14924 homotopic_paths s g1 g2 /\
14925 path h1 /\ path_image h1 SUBSET c /\
14926 (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
14927 path h2 /\ path_image h2 SUBSET c /\
14928 (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
14929 pathstart h1 = pathstart h2
14930 ==> homotopic_paths c h1 h2`,
14931 REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_PATHS] THEN
14932 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
14933 REWRITE_TAC[homotopic_with; pathstart; pathfinish] THEN
14934 DISCH_THEN(X_CHOOSE_THEN
14935 `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
14936 FIRST_ASSUM(MP_TAC o ISPECL
14937 [`h:real^(1,1)finite_sum->real^N`; `(\x. pathstart h2):real^1->real^M`;
14938 `interval[vec 0:real^1,vec 1]`] o
14939 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY_ALT)) THEN
14940 ASM_SIMP_TAC[] THEN ANTS_TAC THENL
14941 [REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE] THEN
14942 ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; PATHSTART_IN_PATH_IMAGE;
14945 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,1)finite_sum->real^M` THEN
14946 STRIP_TAC THEN ASM_SIMP_TAC[o_DEF] THEN
14947 MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN
14950 FIRST_ASSUM(MATCH_MP_TAC o
14951 REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
14952 ONCE_REWRITE_RULE[IMP_CONJ] o
14953 REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
14954 (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
14955 REWRITE_TAC[GSYM CONJ_ASSOC] THENL
14956 [MAP_EVERY EXISTS_TAC [`g1:real^1->real^N`; `vec 0:real^1`];
14957 MAP_EVERY EXISTS_TAC [`g2:real^1->real^N`; `vec 0:real^1`]] THEN
14958 ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
14959 RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish; path]) THEN
14960 ASM_REWRITE_TAC[CONNECTED_INTERVAL; pathstart; pathfinish] THEN
14961 REWRITE_TAC[CONJ_ASSOC] THEN
14962 (REPEAT CONJ_TAC THENL
14963 [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
14964 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14965 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
14966 CONTINUOUS_ON_ID] THEN
14967 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14968 CONTINUOUS_ON_SUBSET));
14969 GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
14970 REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14971 `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
14972 ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]] THEN
14973 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
14974 FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]);
14976 REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
14977 REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL
14978 [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
14979 FIRST_ASSUM(MATCH_MP_TAC o
14980 REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
14981 ONCE_REWRITE_RULE[IMP_CONJ] o
14982 REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
14983 (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
14984 MAP_EVERY EXISTS_TAC
14985 [`(\x. pathfinish g1):real^1->real^N`; `vec 0:real^1`] THEN
14986 ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
14987 REWRITE_TAC[CONTINUOUS_ON_CONST; pathfinish] THEN
14988 REPEAT CONJ_TAC THENL
14989 [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
14990 ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE];
14991 GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
14992 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14993 SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
14994 CONTINUOUS_ON_ID] THEN
14995 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14996 CONTINUOUS_ON_SUBSET)) THEN
14997 SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
14998 FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL];
14999 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15000 X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
15001 FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (vec 1:real^1)` o
15002 REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN
15003 ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
15004 ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
15005 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15006 ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]]]);;
15008 let COVERING_SPACE_MONODROMY = prove
15009 (`!p:real^M->real^N c s g1 g2 h1 h2.
15010 covering_space (c,p) s /\
15011 path g1 /\ path_image g1 SUBSET s /\
15012 path g2 /\ path_image g2 SUBSET s /\
15013 homotopic_paths s g1 g2 /\
15014 path h1 /\ path_image h1 SUBSET c /\
15015 (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
15016 path h2 /\ path_image h2 SUBSET c /\
15017 (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
15018 pathstart h1 = pathstart h2
15019 ==> pathfinish h1 = pathfinish h2`,
15020 REPEAT GEN_TAC THEN
15021 DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_HOMOTOPIC_PATHS) THEN
15022 REWRITE_TAC[HOMOTOPIC_PATHS_IMP_PATHFINISH]);;
15024 let COVERING_SPACE_LIFT_HOMOTOPIC_PATH = prove
15025 (`!p:real^M->real^N c s f f' g a b.
15026 covering_space (c,p) s /\
15027 homotopic_paths s f f' /\
15028 path g /\ path_image g SUBSET c /\
15029 pathstart g = a /\ pathfinish g = b /\
15030 (!t. t IN interval[vec 0,vec 1] ==> p(g t) = f t)
15031 ==> ?g'. path g' /\ path_image g' SUBSET c /\
15032 pathstart g' = a /\ pathfinish g' = b /\
15033 (!t. t IN interval[vec 0,vec 1] ==> p(g' t) = f' t)`,
15034 ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REPEAT STRIP_TAC THEN
15035 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
15036 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
15037 FIRST_ASSUM(MP_TAC o ISPECL [`f':real^1->real^N`; `a:real^M`] o
15038 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN
15040 [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
15041 [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL;
15042 HOMOTOPIC_PATHS_IMP_PATHSTART];
15043 ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]];
15044 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^1->real^M` THEN
15045 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
15046 SUBST1_TAC(SYM(ASSUME `pathfinish g:real^M = b`)) THEN
15047 FIRST_ASSUM(MATCH_MP_TAC o
15048 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN
15049 MAP_EVERY EXISTS_TAC [`f':real^1->real^N`; `f:real^1->real^N`] THEN
15050 ASM_REWRITE_TAC[]]);;
15052 let COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP = prove
15053 (`!p:real^M->real^N c s g h a.
15054 covering_space (c,p) s /\
15055 path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
15056 homotopic_paths s g (linepath(a,a)) /\
15057 path h /\ path_image h SUBSET c /\
15058 (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
15059 ==> pathfinish h = pathstart h`,
15060 REPEAT STRIP_TAC THEN
15061 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
15062 REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
15063 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15064 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
15065 REWRITE_TAC[PATHSTART_LINEPATH] THEN REPEAT STRIP_TAC THEN
15066 FIRST_X_ASSUM(MP_TAC o
15067 ISPECL [`g:real^1->real^N`; `linepath(a:real^N,a)`;
15068 `h:real^1->real^M`; `linepath(pathstart h:real^M,pathstart h)`] o
15069 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15070 COVERING_SPACE_MONODROMY)) THEN
15071 ASM_REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
15072 ASM_REWRITE_TAC[SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
15073 DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEPATH_REFL] THEN CONJ_TAC THENL
15074 [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
15075 REPEAT STRIP_TAC THEN
15076 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
15077 REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
15078 REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;
15080 let COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP = prove
15081 (`!p:real^M->real^N c s g h.
15082 covering_space (c,p) s /\ simply_connected s /\
15083 path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
15084 path h /\ path_image h SUBSET c /\
15085 (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
15086 ==> pathfinish h = pathstart h`,
15087 REPEAT STRIP_TAC THEN
15088 FIRST_X_ASSUM(MATCH_MP_TAC o
15089 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15090 COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP)) THEN
15091 EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN
15092 ASM_MESON_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH]);;
15094 (* ------------------------------------------------------------------------- *)
15095 (* Lifting of general functions to covering space *)
15096 (* ------------------------------------------------------------------------- *)
15098 let COVERING_SPACE_LIFT_GENERAL = prove
15099 (`!p:real^M->real^N c s f:real^P->real^N u a z.
15100 covering_space (c,p) s /\ a IN c /\ z IN u /\
15101 path_connected u /\ locally path_connected u /\
15102 f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
15103 (!r. path r /\ path_image r SUBSET u /\
15104 pathstart r = z /\ pathfinish r = z
15105 ==> ?q. path q /\ path_image q SUBSET c /\
15106 pathstart q = a /\ pathfinish q = a /\
15107 homotopic_paths s (f o r) (p o q))
15108 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
15109 (!y. y IN u ==> p(g y) = f y)`,
15110 REPEAT STRIP_TAC THEN
15113 ==> ?g h. path g /\ path_image g SUBSET u /\
15114 pathstart g = z /\ pathfinish g = y /\
15115 path h /\ path_image h SUBSET c /\ pathstart h = a /\
15116 (!t. t IN interval[vec 0,vec 1]
15117 ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))`
15120 [X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15121 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
15122 DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN
15123 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
15124 X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN
15125 ASM_REWRITE_TAC[] THEN
15126 MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN
15127 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN
15128 ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATHSTART_COMPOSE] THEN
15130 [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
15131 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
15135 `?l. !y g h. path g /\ path_image g SUBSET u /\
15136 pathstart g = z /\ pathfinish g = y /\
15137 path h /\ path_image h SUBSET c /\ pathstart h = a /\
15138 (!t. t IN interval[vec 0,vec 1]
15139 ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))
15140 ==> pathfinish h = l y`
15142 [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN
15143 MATCH_MP_TAC(MESON[]
15144 `(!g h g' h'. P g h /\ P g' h' ==> f h = f h')
15145 ==> ?z. !g h. P g h ==> f h = z`) THEN
15146 REPEAT STRIP_TAC THEN
15147 FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN
15148 ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
15149 PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
15150 SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
15151 DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN
15152 FIRST_ASSUM(MP_TAC o
15153 ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`;
15154 `(f:real^P->real^N) o (g ++ reversepath g')`;
15155 `q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o
15156 MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
15157 (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM]
15158 COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN
15159 ASM_REWRITE_TAC[o_THM] THEN
15160 DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN
15161 SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL
15163 ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_REVERSEPATH; PATHSTART_REVERSEPATH]] THEN
15164 MATCH_MP_TAC PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN
15165 ASM_REWRITE_TAC[] THEN
15166 X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
15167 STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL
15168 [FIRST_ASSUM(MP_TAC o
15169 ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`;
15170 `q':real^1->real^M`;
15171 `(h:real^1->real^M) o (\t. &2 % t)`;
15172 `interval[vec 0,lift(&1 / &2)]`;
15173 `vec 0:real^1`; `t:real^1`] o
15174 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
15175 REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
15176 REPEAT CONJ_TAC THENL
15177 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
15178 EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
15180 [SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; joinpaths; o_THM];
15182 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15183 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
15184 [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
15185 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15187 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
15188 `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
15189 CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
15190 REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
15191 `(!x. x IN s ==> f x = g x) /\ s SUBSET t
15192 ==> IMAGE f s SUBSET IMAGE g t`) THEN
15193 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_INTERVAL_1] THEN
15194 CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths; o_THM];
15195 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15196 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
15197 ASM_REWRITE_TAC[GSYM path] THEN
15198 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15200 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
15201 `path_image(q':real^1->real^M)` THEN
15202 ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
15203 MATCH_MP_TAC IMAGE_SUBSET THEN
15204 REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15206 X_GEN_TAC `t':real^1` THEN
15207 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
15208 FIRST_X_ASSUM(fun th ->
15209 W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
15210 ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC] THEN
15211 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
15212 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15213 SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
15214 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15215 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
15216 ASM_SIMP_TAC[GSYM path] THEN
15217 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15218 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
15220 MATCH_MP_TAC SUBSET_TRANS THEN
15221 EXISTS_TAC `path_image(h:real^1->real^M)` THEN
15222 CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN
15223 REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
15224 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
15225 REWRITE_TAC[DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
15227 X_GEN_TAC `t':real^1` THEN
15228 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
15229 CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
15230 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
15231 ASM_REAL_ARITH_TAC;
15232 REWRITE_TAC[CONNECTED_INTERVAL];
15233 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC;
15234 GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN
15235 ASM_REWRITE_TAC[] THEN
15236 SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN
15237 REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
15238 REWRITE_TAC[VECTOR_MUL_RZERO];
15239 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15240 ASM_REAL_ARITH_TAC];
15241 FIRST_ASSUM(MP_TAC o
15242 ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o
15243 (\t. &2 % t - vec 1)`;
15244 `q':real^1->real^M`;
15245 `reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`;
15246 `{t | &1 / &2 < drop t /\ drop t <= &1}`;
15247 `vec 1:real^1`; `t:real^1`] o
15248 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
15249 REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
15250 REPEAT CONJ_TAC THENL
15251 [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
15252 EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
15254 [SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM];
15256 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15257 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
15258 [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
15259 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
15261 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
15262 `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
15263 CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
15264 REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
15265 `(!x. x IN s ==> f x = g x) /\ s SUBSET t
15266 ==> IMAGE f s SUBSET IMAGE g t`) THEN
15267 SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM] THEN
15268 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
15270 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15271 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
15272 ASM_REWRITE_TAC[GSYM path] THEN
15273 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
15275 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
15276 `path_image(q':real^1->real^M)` THEN
15277 ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
15278 MATCH_MP_TAC IMAGE_SUBSET THEN
15279 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
15281 X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
15282 FIRST_X_ASSUM(fun th ->
15283 W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
15284 ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC; GSYM REAL_NOT_LT] THEN
15285 ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
15286 MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15287 SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
15288 CONTINUOUS_ON_CONST] THEN
15289 MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15290 EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
15291 ASM_SIMP_TAC[GSYM path; PATH_REVERSEPATH] THEN
15292 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
15293 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
15295 MATCH_MP_TAC SUBSET_TRANS THEN
15296 EXISTS_TAC `path_image(reversepath h':real^1->real^M)` THEN
15297 CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH]] THEN
15298 REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
15299 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
15300 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
15302 X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
15303 REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN
15304 FIRST_X_ASSUM MATCH_MP_TAC THEN
15305 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL] THEN
15306 ASM_REAL_ARITH_TAC;
15307 REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN
15308 REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
15309 REWRITE_TAC[IN_ELIM_THM; DROP_VEC] THEN REAL_ARITH_TAC;
15310 GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN
15311 ASM_REWRITE_TAC[reversepath] THEN
15312 SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN
15313 REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
15314 REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_CMUL; DROP_VEC] THEN
15316 REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]];
15318 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN
15319 DISCH_THEN(LABEL_TAC "+") THEN
15320 MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL
15322 REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15323 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15324 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15325 ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
15326 FIRST_ASSUM(MP_TAC o SPECL
15327 [`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN
15328 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
15329 REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
15330 ASM_SIMP_TAC[LINEPATH_REFL; SING_SUBSET];
15331 X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15332 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15333 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15334 MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN
15335 STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
15336 [`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN
15337 ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]] THEN
15338 FIRST_ASSUM(fun th ->
15339 GEN_REWRITE_TAC I [MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
15340 X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN
15341 ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN
15342 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
15343 FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
15344 FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o
15345 GEN_REWRITE_RULE I [covering_space]) THEN
15346 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15347 DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN
15348 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15349 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
15350 ONCE_REWRITE_TAC[IMP_CONJ] THEN
15351 GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
15352 DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN
15353 MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
15354 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
15355 DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN
15356 DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN
15357 DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN
15358 ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
15359 DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool) IN vv` (K ALL_TAC) THEN
15361 `?v. y IN v /\ y IN u /\ IMAGE (f:real^P->real^N) v SUBSET w /\
15362 v SUBSET u /\ path_connected v /\ open_in (subtopology euclidean u) v`
15363 STRIP_ASSUME_TAC THENL
15364 [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN
15365 DISCH_THEN(MP_TAC o SPECL
15366 [`{x | x IN u /\ (f:real^P->real^N) x IN w}`; `y:real^P`]) THEN
15367 ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]] THEN
15368 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15369 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15370 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
15372 FIRST_X_ASSUM(STRIP_ASSUME_TAC o
15373 GEN_REWRITE_RULE I [homeomorphism]) THEN
15374 SUBGOAL_THEN `(w':real^M->bool) SUBSET c /\ (w:real^N->bool) SUBSET s`
15375 STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
15378 {x | x IN u /\ (f:real^P->real^N) x IN
15379 {x | x IN w /\ (p':real^N->real^M) x IN w' INTER n}}` THEN
15380 REPEAT CONJ_TAC THENL
15381 [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
15382 MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15383 EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
15384 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN
15385 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15386 EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
15387 UNDISCH_TAC `open_in (subtopology euclidean c) (n:real^M->bool)` THEN
15388 REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
15391 SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
15392 X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN
15393 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
15394 DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN
15395 ASM_REWRITE_TAC[] THEN
15396 DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN
15397 REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15398 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15399 MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN
15401 FIRST_ASSUM(MP_TAC o SPECL
15402 [`y':real^P`; `(pp:real^1->real^P) ++ r`;
15403 `(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o
15404 (r:real^1->real^P))`]) THEN
15405 FIRST_X_ASSUM(MP_TAC o SPECL
15406 [`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN
15407 ASM_SIMP_TAC[o_THM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN DISCH_TAC THEN
15409 `path_image ((pp:real^1->real^P) ++ r) SUBSET u`
15411 [MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN
15414 ASM_REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN
15415 REPEAT CONJ_TAC THENL
15416 [ASM_SIMP_TAC[PATH_JOIN];
15417 ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN];
15418 MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATHSTART_COMPOSE] THEN
15420 [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
15421 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15423 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15424 CONTINUOUS_ON_SUBSET)) THEN
15426 REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]];
15427 MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN
15428 REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[];
15429 X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
15430 STRIP_TAC THEN REWRITE_TAC[joinpaths; o_THM] THEN COND_CASES_TAC THEN
15431 ASM_REWRITE_TAC[] THENL
15432 [ABBREV_TAC `t:real^1 = &2 % tt`;
15433 ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN
15434 (SUBGOAL_THEN `t IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
15435 [EXPAND_TAC "t" THEN
15436 REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
15437 ASM_REAL_ARITH_TAC;
15439 ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
15440 RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]);;
15442 let COVERING_SPACE_LIFT_STRONGER = prove
15443 (`!p:real^M->real^N c s f:real^P->real^N u a z.
15444 covering_space (c,p) s /\ a IN c /\ z IN u /\
15445 path_connected u /\ locally path_connected u /\
15446 f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
15447 (!r. path r /\ path_image r SUBSET u /\
15448 pathstart r = z /\ pathfinish r = z
15449 ==> ?b. homotopic_paths s (f o r) (linepath(b,b)))
15450 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
15451 (!y. y IN u ==> p(g y) = f y)`,
15452 REPEAT STRIP_TAC THEN
15453 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15454 COVERING_SPACE_LIFT_GENERAL)) THEN ASM_REWRITE_TAC[] THEN
15455 X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
15456 FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1->real^P`) THEN ASM_REWRITE_TAC[] THEN
15457 DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN
15458 FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
15459 ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
15460 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
15461 EXISTS_TAC `linepath(a:real^M,a)` THEN
15462 REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
15463 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
15464 RULE_ASSUM_TAC(REWRITE_RULE[o_DEF; LINEPATH_REFL]) THEN
15465 ASM_REWRITE_TAC[o_DEF; LINEPATH_REFL]);;
15467 let COVERING_SPACE_LIFT_STRONG = prove
15468 (`!p:real^M->real^N c s f:real^P->real^N u a z.
15469 covering_space (c,p) s /\ a IN c /\ z IN u /\
15470 simply_connected u /\ locally path_connected u /\
15471 f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a
15472 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
15473 (!y. y IN u ==> p(g y) = f y)`,
15474 REPEAT STRIP_TAC THEN
15475 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15476 COVERING_SPACE_LIFT_STRONGER)) THEN
15477 ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
15478 X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
15479 EXISTS_TAC `(f:real^P->real^N) z` THEN
15481 `linepath(f z,f z) = (f:real^P->real^N) o linepath(z,z)`
15482 SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LINEPATH_REFL]; ALL_TAC] THEN
15483 MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN
15484 EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
15485 FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I
15486 [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
15487 ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
15488 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]);;
15490 let COVERING_SPACE_LIFT = prove
15491 (`!p:real^M->real^N c s f:real^P->real^N u.
15492 covering_space (c,p) s /\
15493 simply_connected u /\ locally path_connected u /\
15494 f continuous_on u /\ IMAGE f u SUBSET s
15495 ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
15496 (!y. y IN u ==> p(g y) = f y)`,
15497 MP_TAC COVERING_SPACE_LIFT_STRONG THEN
15498 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
15499 DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN
15500 ASM_CASES_TAC `u:real^P->bool = {}` THEN
15501 ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
15503 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
15504 DISCH_THEN(X_CHOOSE_TAC `a:real^P`) THEN
15505 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15506 GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
15507 DISCH_THEN(MP_TAC o SPEC `(f:real^P->real^N) a`) THEN
15508 MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
15509 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
15512 (* ------------------------------------------------------------------------- *)
15513 (* Some additional lemmas about covering spaces. *)
15514 (* ------------------------------------------------------------------------- *)
15516 let CARD_EQ_COVERING_MAP_FIBRES = prove
15517 (`!p:real^M->real^N c s a b.
15518 covering_space (c,p) s /\ path_connected s /\ a IN s /\ b IN s
15519 ==> {x | x IN c /\ p(x) = a} =_c {x | x IN c /\ p(x) = b}`,
15520 REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
15521 REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN
15522 REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN
15523 REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; FORALL_AND_THM;
15524 TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
15525 GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV)
15527 MATCH_MP_TAC(MESON[]
15528 `(!a b. P a b) ==> (!a b. P a b) /\ (!a b. P b a)`) THEN
15529 REPEAT STRIP_TAC THEN
15530 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`] o
15531 GEN_REWRITE_RULE I [path_connected]) THEN
15532 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15533 X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
15535 `!z. ?h. z IN c /\ p z = a
15536 ==> path h /\ path_image h SUBSET c /\ pathstart h = z /\
15537 !t. t IN interval[vec 0,vec 1]
15538 ==> (p:real^M->real^N)(h t) = g t`
15540 [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
15541 REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN
15542 REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[];
15543 REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15544 X_GEN_TAC `h:real^M->real^1->real^M` THEN DISCH_TAC] THEN
15545 REWRITE_TAC[le_c; IN_ELIM_THM] THEN
15546 EXISTS_TAC `\z. pathfinish((h:real^M->real^1->real^M) z)` THEN
15547 ASM_REWRITE_TAC[pathfinish] THEN CONJ_TAC THENL
15548 [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
15549 FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
15550 ASM_REWRITE_TAC[SUBSET; path_image; pathstart; FORALL_IN_IMAGE] THEN
15551 ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL];
15552 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
15554 [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
15555 `reversepath(g:real^1->real^N)`; `reversepath(g:real^1->real^N)`;
15556 `reversepath((h:real^M->real^1->real^M) x)`;
15557 `reversepath((h:real^M->real^1->real^M) y)`]
15558 COVERING_SPACE_MONODROMY) THEN
15559 ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
15560 DISCH_THEN MATCH_MP_TAC THEN
15561 ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
15562 HOMOTOPIC_PATHS_REFL] THEN
15563 ASM_REWRITE_TAC[pathfinish; reversepath; IN_INTERVAL_1; DROP_VEC] THEN
15564 REPEAT STRIP_TAC THENL
15565 [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`);
15566 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`)] THEN
15567 ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS) THEN
15568 REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);;
15570 let COVERING_SPACE_INJECTIVE = prove
15571 (`!p:real^M->real^N c s.
15572 covering_space (c,p) s /\ path_connected c /\ simply_connected s
15573 ==> (!x y. x IN c /\ y IN c /\ p x = p y ==> x = y)`,
15574 REPEAT STRIP_TAC THEN
15575 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15576 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_CONTINUOUS) THEN
15577 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
15578 DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
15579 ASM_REWRITE_TAC[] THEN
15580 DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
15581 FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15582 COVERING_SPACE_LIFT_PATH_STRONG)) THEN
15583 GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
15584 DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
15585 DISCH_THEN(fun th ->
15586 MP_TAC(SPEC `(p:real^M->real^N) o (g:real^1->real^M)` th) THEN
15587 MP_TAC(SPEC `(p:real^M->real^N) o linepath(x:real^M,x)` th)) THEN
15589 `(path ((p:real^M->real^N) o linepath(x,x)) /\
15591 (path_image (p o linepath(x:real^M,x)) SUBSET s /\
15592 path_image (p o g) SUBSET s)`
15593 STRIP_ASSUME_TAC THENL
15595 [CONJ_TAC THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
15596 REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN
15597 ASM_REWRITE_TAC[CONTINUOUS_ON_SING; SEGMENT_REFL] THEN
15598 ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
15599 REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN
15600 REWRITE_TAC[SEGMENT_REFL] THEN ASM SET_TAC[]];
15602 ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
15603 DISCH_THEN(X_CHOOSE_THEN `h1:real^1->real^M` STRIP_ASSUME_TAC) THEN
15604 DISCH_THEN(X_CHOOSE_THEN `h2:real^1->real^M` STRIP_ASSUME_TAC) THEN
15605 FIRST_ASSUM(MP_TAC o
15606 SPECL [`(p:real^M->real^N) o linepath(x:real^M,x)`;
15607 `(p:real^M->real^N) o (g:real^1->real^M)`;
15608 `h1:real^1->real^M`; `h2:real^1->real^M`] o
15609 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15610 COVERING_SPACE_MONODROMY)) THEN
15611 ASM_SIMP_TAC[] THEN ANTS_TAC THENL
15612 [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o
15613 GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
15614 ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
15615 ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH];
15617 MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
15618 [MATCH_MP_TAC EQ_TRANS THEN
15619 EXISTS_TAC `pathfinish(linepath(x:real^M,x))` THEN
15620 CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATHFINISH_LINEPATH]];
15621 FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])] THEN
15622 REWRITE_TAC[pathfinish] THEN
15623 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15624 COVERING_SPACE_LIFT_UNIQUE))
15626 [EXISTS_TAC `(p:real^M->real^N) o (h1:real^1->real^M)`;
15627 EXISTS_TAC `(p:real^M->real^N) o (h2:real^1->real^M)`] THEN
15628 MAP_EVERY EXISTS_TAC [`interval[vec 0:real^1,vec 1]`; `vec 0:real^1`] THEN
15629 REWRITE_TAC[CONNECTED_INTERVAL; ENDS_IN_UNIT_INTERVAL] THEN
15630 ASM_REWRITE_TAC[GSYM path; PATH_LINEPATH; GSYM path_image] THEN
15631 RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[o_THM] THEN
15632 ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
15633 RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN
15634 ASM_REWRITE_TAC[LINEPATH_REFL; PATH_IMAGE_COMPOSE] THEN
15636 [ASM_MESON_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET];
15639 let COVERING_SPACE_HOMEOMORPHISM = prove
15640 (`!p:real^M->real^N c s.
15641 covering_space (c,p) s /\ path_connected c /\ simply_connected s
15642 ==> ?q. homeomorphism (c,s) (p,q)`,
15643 REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
15644 REPEAT CONJ_TAC THENL
15645 [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
15646 ASM_MESON_TAC[COVERING_SPACE_IMP_SURJECTIVE];
15647 ASM_MESON_TAC[COVERING_SPACE_INJECTIVE];
15648 ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]]);;
15650 (* ------------------------------------------------------------------------- *)
15651 (* Results on finiteness of the number of sheets in a covering space. *)
15652 (* ------------------------------------------------------------------------- *)
15654 let COVERING_SPACE_FIBRE_NO_LIMPT = prove
15655 (`!p:real^M->real^N c s a b.
15656 covering_space (c,p) s /\ a IN c
15657 ==> ~(a limit_point_of {x | x IN c /\ p x = b})`,
15658 REPEAT STRIP_TAC THEN
15659 FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
15660 FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN
15661 ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15662 DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
15663 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15664 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
15665 GEN_REWRITE_TAC I [IMP_CONJ] THEN
15666 REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN
15667 DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
15668 DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
15670 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN
15671 ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
15672 FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
15673 REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
15674 UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN
15675 REWRITE_TAC[OPEN_IN_OPEN] THEN
15676 DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
15677 FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o
15678 GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
15679 ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INFINITE]] THEN
15680 MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET]
15681 `(?a. s SUBSET {a}) ==> FINITE s`) THEN
15684 let COVERING_SPACE_COUNTABLE_SHEETS = prove
15685 (`!p:real^M->real^N c s b.
15686 covering_space (c,p) s ==> COUNTABLE {x | x IN c /\ p x = b}`,
15687 REPEAT STRIP_TAC THEN
15688 MATCH_MP_TAC(REWRITE_RULE[] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]
15689 UNCOUNTABLE_CONTAINS_LIMIT_POINT)) THEN
15690 REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;
15692 let COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE = prove
15693 (`!p:real^M->real^N c s b.
15694 covering_space (c,p) s
15695 ==> (FINITE {x | x IN c /\ p x = b} <=>
15696 compact {x | x IN c /\ p x = b})`,
15697 REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FINITE_IMP_COMPACT] THEN
15698 DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL
15699 [ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_TAC THEN
15700 FIRST_ASSUM(MP_TAC o
15701 SPEC `{x | x IN c /\ (p:real^M->real^N) x = b}` o
15702 GEN_REWRITE_RULE I [COMPACT_EQ_BOLZANO_WEIERSTRASS]) THEN
15703 ASM_REWRITE_TAC[INFINITE; SUBSET_REFL; IN_ELIM_THM] THEN
15704 DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
15705 FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^N`] o
15706 MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
15707 COVERING_SPACE_FIBRE_NO_LIMPT)) THEN
15709 SUBGOAL_THEN `{x | x IN c /\ (p:real^M->real^N) x = b} = {}`
15710 (fun th -> REWRITE_TAC[th; FINITE_EMPTY]) THEN
15711 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15714 let COVERING_SPACE_CLOSED_MAP = prove
15715 (`!p:real^M->real^N c s t.
15716 covering_space (c,p) s /\
15717 (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\
15718 closed_in (subtopology euclidean c) t
15719 ==> closed_in (subtopology euclidean s) (IMAGE p t)`,
15720 REPEAT STRIP_TAC THEN
15721 FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
15722 FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15723 REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL
15724 [ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN]] THEN
15725 X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
15726 FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o
15727 GEN_REWRITE_RULE I [covering_space]) THEN
15728 ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN
15729 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15730 FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
15732 DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
15733 ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL
15734 [ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN
15735 EXISTS_TAC `INTERS {IMAGE (p:real^M->real^N) (u DIFF t) | u IN uu}` THEN
15736 REPEAT CONJ_TAC THENL
15737 [MATCH_MP_TAC OPEN_IN_INTERS THEN
15738 ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
15740 [MATCH_MP_TAC FINITE_IMAGE THEN
15742 `!u. u IN uu ==> ?x. x IN u /\ (p:real^M->real^N) x = y`
15744 [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
15747 `FINITE (IMAGE (\u. @x. x IN u /\ (p:real^M->real^N) x = y) uu)`
15749 [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15750 FINITE_SUBSET)) THEN ASM SET_TAC[];
15751 MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN
15752 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
15753 REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]];
15754 X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
15755 MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
15756 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
15757 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN
15758 ASM_SIMP_TAC[LEFT_EXISTS_AND_THM] THEN
15759 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
15760 DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
15761 ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
15762 EXISTS_TAC `(:real^M) DIFF k` THEN
15763 ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]];
15764 REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN
15765 X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
15766 REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
15767 ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[];
15768 REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_DIFF; IN_ELIM_THM] THEN
15769 X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
15770 CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
15771 DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
15772 FIRST_X_ASSUM SUBST_ALL_TAC THEN
15773 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
15774 DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN
15775 REWRITE_TAC[IN_ELIM_THM] THEN
15776 MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN
15777 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
15778 REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
15779 REWRITE_TAC[IN_UNIONS] THEN ASM SET_TAC[]]);;
15781 let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove
15782 (`!p:real^M->real^N c s.
15783 covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s)
15784 ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
15785 (!t. closed_in (subtopology euclidean c) t
15786 ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
15789 (!n. ~(s = v n) ==> DISJOINT s (v n))
15790 ==> (!n. f n IN v n) /\
15791 (!m n. v m = v n <=> m = n)
15792 ==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`,
15793 ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL
15794 [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
15795 MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS);
15796 RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN
15797 ASM_REWRITE_TAC[]] THEN
15799 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
15800 [MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN
15801 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[];
15803 REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN
15804 FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o
15805 GEN_REWRITE_RULE I [covering_space]) THEN
15806 ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN
15807 REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15808 DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
15809 SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL
15810 [MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[];
15811 PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN
15812 DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN
15813 SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL
15814 [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15815 CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN
15817 `!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v`
15818 MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN
15819 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN
15820 REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
15821 [ASM SET_TAC[]; ALL_TAC] THEN
15822 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
15823 FIRST_X_ASSUM(fun th ->
15824 MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN
15825 ASM_REWRITE_TAC[] THEN
15826 RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
15828 REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN
15829 REWRITE_TAC[IN_UNIV] THEN
15830 DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN
15832 `!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)`
15833 (MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
15834 ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN
15835 DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN
15837 `closed_in (subtopology euclidean s)
15838 (IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))`
15840 [FIRST_X_ASSUM MATCH_MP_TAC THEN
15841 REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN
15842 CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN
15843 FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
15844 DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
15845 SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL
15846 [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
15848 `(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN
15849 REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
15850 [MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
15851 (fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN
15852 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
15853 [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
15854 REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]];
15855 REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
15856 ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15857 (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN
15858 MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN
15860 SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL
15861 [ASM SET_TAC[]; ALL_TAC] THEN
15862 SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w`
15863 (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))
15864 THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN
15865 RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
15866 FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
15867 DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN
15868 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
15869 `INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN
15870 DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL
15871 [ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN
15872 ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
15873 REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
15874 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
15875 DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN
15876 ASM_REWRITE_TAC[] THEN
15877 DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
15878 ASM_REWRITE_TAC[] THEN
15879 DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o
15880 MATCH_MP lemma) THEN
15881 ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15882 MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]];
15884 `IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) =
15887 [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN
15888 REWRITE_TAC[CLOSED_IN_LIMPT] THEN
15889 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN
15890 ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15891 REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN
15892 EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);;
15894 let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP = prove
15895 (`!p:real^M->real^N c s.
15896 covering_space (c,p) s /\ connected s /\ ~(?a. s = {a})
15897 ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
15898 (!t. closed_in (subtopology euclidean c) t
15899 ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
15900 REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
15901 [SUBGOAL_THEN `c:real^M->bool = {}` ASSUME_TAC THENL
15902 [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15903 ASM_REWRITE_TAC[IMAGE_EQ_EMPTY];
15904 ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; CLOSED_IN_SUBTOPOLOGY_EMPTY;
15905 IMAGE_EQ_EMPTY; NOT_IN_EMPTY]];
15906 MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG THEN
15907 ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
15908 MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM SET_TAC[]]);;
15910 let COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP = prove
15911 (`!p:real^M->real^N c s.
15912 covering_space (c,p) s
15913 ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
15914 (!k. k SUBSET s /\ compact k
15915 ==> compact {x | x IN c /\ p(x) IN k}))`,
15916 REPEAT STRIP_TAC THEN
15917 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15918 DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
15919 DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP PROPER_MAP th]) THEN
15920 FIRST_ASSUM(fun th -> REWRITE_TAC
15921 [GSYM(MATCH_MP COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE th)]) THEN
15922 REWRITE_TAC[TAUT `(p <=> q /\ p) <=> (p ==> q)`] THEN
15923 ASM_MESON_TAC[COVERING_SPACE_CLOSED_MAP]);;
15925 (* ------------------------------------------------------------------------- *)
15926 (* Special cases where one or both of the sets is compact. *)
15927 (* ------------------------------------------------------------------------- *)
15929 let COVERING_SPACE_FINITE_SHEETS = prove
15930 (`!p:real^M->real^N c s b.
15931 covering_space (c,p) s /\ compact c ==> FINITE {x | x IN c /\ p x = b}`,
15932 REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN
15933 EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
15934 ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;
15936 let COVERING_SPACE_COMPACT = prove
15937 (`!p:real^M->real^N c s.
15938 covering_space (c,p) s
15940 compact s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}))`,
15941 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
15942 [ASM_MESON_TAC[covering_space; COMPACT_CONTINUOUS_IMAGE];
15943 MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS THEN ASM_MESON_TAC[];
15944 FIRST_ASSUM(MP_TAC o
15945 MATCH_MP COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP) THEN
15946 ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
15947 ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
15948 FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN