(* ========================================================================= *)
(* Paths, connectedness, homotopy, simple connectedness & contractibility. *)
(* *)
(* (c) Copyright, John Harrison 1998-2008 *)
(* (c) Copyright, Valentina Bruno 2010 *)
(* ========================================================================= *)
needs "Multivariate/convex.ml";;
(* ------------------------------------------------------------------------- *)
(* Paths and arcs. *)
(* ------------------------------------------------------------------------- *)
let simple_path = new_definition
`simple_path (g:real^1->real^N) <=>
path g /\
!x y. x IN interval[vec 0,vec 1] /\
y IN interval[vec 0,vec 1] /\
g x = g y
==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0`;;
let arc = new_definition
`arc (g:real^1->real^N) <=>
path g /\
!x y. x IN interval [vec 0,vec 1] /\
y IN interval [vec 0,vec 1] /\
g x = g y
==> x = y`;;
(* ------------------------------------------------------------------------- *)
(* Invariance theorems. *)
(* ------------------------------------------------------------------------- *)
let PATH_EQ = prove
(`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ path p
==> path q`,
add_translation_invariants [PATH_TRANSLATION_EQ];;
let PATH_LINEAR_IMAGE_EQ = prove
(`!f:real^M->real^N g.
linear f /\ (!x y. f x = f y ==> x = y)
==> (path(f o g) <=> path g)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o
MATCH_MP
LINEAR_INJECTIVE_LEFT_INVERSE) THEN
REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
[SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g`
SUBST1_TAC THENL [ASM_REWRITE_TAC[
o_ASSOC;
I_O_ID]; ALL_TAC];
ALL_TAC] THEN
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
ASM_SIMP_TAC[
LINEAR_CONTINUOUS_ON]);;
add_linear_invariants [PATH_LINEAR_IMAGE_EQ];;
add_translation_invariants [PATHSTART_TRANSLATION];;
add_linear_invariants [PATHSTART_LINEAR_IMAGE_EQ];;
add_translation_invariants [PATHFINISH_TRANSLATION];;
add_linear_invariants [PATHFINISH_LINEAR_IMAGE];;
add_translation_invariants [PATH_IMAGE_TRANSLATION];;
add_linear_invariants [PATH_IMAGE_LINEAR_IMAGE];;
add_translation_invariants [REVERSEPATH_TRANSLATION];;
add_linear_invariants [REVERSEPATH_LINEAR_IMAGE];;
let JOINPATHS_TRANSLATION = prove
(`!a:real^N g1 g2. ((\x. a + x) o g1) ++ ((\x. a + x) o g2) =
(\x. a + x) o (g1 ++ g2)`,
REWRITE_TAC[joinpaths;
FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
COND_CASES_TAC THEN ASM_REWRITE_TAC[
o_THM]);;
add_translation_invariants [JOINPATHS_TRANSLATION];;
add_linear_invariants [JOINPATHS_LINEAR_IMAGE];;
add_translation_invariants [SIMPLE_PATH_TRANSLATION_EQ];;
add_linear_invariants [SIMPLE_PATH_LINEAR_IMAGE_EQ];;
add_translation_invariants [ARC_TRANSLATION_EQ];;
add_linear_invariants [ARC_LINEAR_IMAGE_EQ];;
(* ------------------------------------------------------------------------- *)
(* Basic lemmas about paths. *)
(* ------------------------------------------------------------------------- *)
let SIMPLE_PATH_CASES = prove
(`!g:real^1->real^N. simple_path g ==> arc g \/ pathfinish g = pathstart g`,
REWRITE_TAC[
simple_path; arc; pathfinish; pathstart] THEN
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `(g:real^1->real^N) (vec 0) = g(vec 1)` THEN
ASM_REWRITE_TAC[] THEN
MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`]) THEN
ASM_MESON_TAC[]);;
let ARC_DISTINCT_ENDS = prove
(`!g:real^1->real^N. arc g ==> ~(pathfinish g = pathstart g)`,
GEN_TAC THEN REWRITE_TAC[arc; pathfinish; pathstart] THEN
ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b /\ ~d ==> ~c`] THEN
DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN
REWRITE_TAC[GSYM
DROP_EQ;
IN_INTERVAL_1;
DROP_VEC] THEN
CONV_TAC REAL_RAT_REDUCE_CONV);;
let JOIN_PATHS_EQ = prove
(`!p q:real^1->real^N.
(!t. t IN interval[vec 0,vec 1] ==> p t = p' t) /\
(!t. t IN interval[vec 0,vec 1] ==> q t = q' t)
==> !t. t IN interval[vec 0,vec 1] ==> (p ++ q) t = (p' ++ q') t`,
(* ------------------------------------------------------------------------- *)
(* Simple paths with the endpoints removed. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* The operations on paths. *)
(* ------------------------------------------------------------------------- *)
let JOINPATHS = prove
(`!g1 g2. pathfinish g1 = pathstart g2
==> g1 ++ g2 = \x. if drop x < &1 / &2 then g1(&2 % x)
else g2 (&2 % x - vec 1)`,
REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN
REWRITE_TAC[joinpaths;
FUN_EQ_THM] THEN
X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `drop x = &1 / &2` THENL
[FIRST_X_ASSUM(MP_TAC o AP_TERM `lift`) THEN
REWRITE_TAC[
LIFT_DROP] THEN DISCH_THEN SUBST1_TAC THEN
REWRITE_TAC[
LIFT_DROP;
REAL_LE_REFL; GSYM
LIFT_CMUL;
REAL_LT_REFL] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN
ASM_REWRITE_TAC[
LIFT_NUM;
VECTOR_SUB_REFL];
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]);;
let REVERSEPATH_REVERSEPATH = prove
(`!g:real^1->real^N. reversepath(reversepath g) = g`,
REWRITE_TAC[reversepath; ETA_AX;
VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);;
let PATHFINISH_JOIN = prove
(`!g1 g2. pathfinish(g1 ++ g2) = pathfinish g2`,
REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; pathfinish;
DROP_VEC] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);;
let PATH_JOIN = prove
(`!g1 g2:real^1->real^N.
pathfinish g1 = pathstart g2
==> (path(g1 ++ g2) <=> path g1 /\ path g2)`,
let PATH_JOIN_IMP = prove
(`!g1 g2:real^1->real^N.
path g1 /\ path g2 /\ pathfinish g1 = pathstart g2
==> path(g1 ++ g2)`,
let ARC_REVERSEPATH = prove
(`!g. arc g ==> arc(reversepath g)`,
GEN_TAC THEN SIMP_TAC[arc;
PATH_REVERSEPATH] THEN
REWRITE_TAC[arc; reversepath] THEN STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
REWRITE_TAC[
IN_INTERVAL_1; GSYM
DROP_EQ;
DROP_SUB;
DROP_VEC] THEN
REAL_ARITH_TAC);;
let SIMPLE_PATH_JOIN_LOOP = prove
(`!g1 g2:real^1->real^N.
arc g1 /\ arc g2 /\
pathfinish g1 = pathstart g2 /\
pathfinish g2 = pathstart g1 /\
(path_image g1 INTER path_image g2) SUBSET
{pathstart g1,pathstart g2}
==> simple_path(g1 ++ g2)`,
REPEAT GEN_TAC THEN REWRITE_TAC[arc;
simple_path] THEN
MATCH_MP_TAC(TAUT
`(a /\ b /\ c /\ d ==> f) /\
(a' /\ b' /\ c /\ d /\ e ==> g)
==> (a /\ a') /\ (b /\ b') /\ c /\ d /\ e ==> f /\ g`) THEN
CONJ_TAC THENL [MESON_TAC[
PATH_JOIN]; ALL_TAC] THEN
REWRITE_TAC[arc;
simple_path;
SUBSET;
IN_INTER; pathstart;
pathfinish;
IN_INTERVAL_1;
DROP_VEC;
IN_INSERT;
NOT_IN_EMPTY] THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
MATCH_MP_TAC
DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
[REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
ASM_REWRITE_TAC[
DROP_CMUL;
DROP_VEC;
DROP_SUB] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC;
ALL_TAC;
ASM_REAL_ARITH_TAC;
REMOVE_THEN "G2" (MP_TAC o SPECL
[`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
ASM_REWRITE_TAC[
DROP_CMUL;
DROP_VEC;
DROP_SUB] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
ANTS_TAC THENL
[CONJ_TAC THENL
[REWRITE_TAC[
path_image;
IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL] THEN
ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC[
path_image;
IN_IMAGE] THEN
EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
ASM_REAL_ARITH_TAC];
ALL_TAC] THEN
STRIP_TAC THENL
[DISJ2_TAC THEN DISJ1_TAC;
DISJ1_TAC THEN MATCH_MP_TAC
EQ_TRANS THEN
EXISTS_TAC `&1 / &2 % vec 1:real^1`] THEN
MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
[SUBGOAL_THEN `&2 % x:real^1 = vec 0` MP_TAC THENL
[ALL_TAC; VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G1" MATCH_MP_TAC;
DISCH_THEN SUBST_ALL_TAC THEN
RULE_ASSUM_TAC(REWRITE_RULE[
VECTOR_MUL_RZERO]) THEN
UNDISCH_TAC `T` THEN REWRITE_TAC[] THEN
SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 1` MP_TAC THENL
[ALL_TAC; VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G2" MATCH_MP_TAC;
SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
[ALL_TAC; VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G1" MATCH_MP_TAC;
DISCH_THEN SUBST_ALL_TAC THEN
SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
[ALL_TAC; VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G2" MATCH_MP_TAC] THEN
(REWRITE_TAC[
CONJ_ASSOC] THEN CONJ_TAC THENL
[ALL_TAC; ASM_MESON_TAC[]] THEN
ASM_REWRITE_TAC[
DROP_CMUL;
DROP_SUB;
DROP_VEC] THEN
ASM_REAL_ARITH_TAC));;
let ARC_JOIN = prove
(`!g1 g2:real^1->real^N.
arc g1 /\ arc g2 /\
pathfinish g1 = pathstart g2 /\
(path_image g1 INTER path_image g2) SUBSET {pathstart g2}
==> arc(g1 ++ g2)`,
REPEAT GEN_TAC THEN REWRITE_TAC[arc;
simple_path] THEN
MATCH_MP_TAC(TAUT
`(a /\ b /\ c /\ d ==> f) /\
(a' /\ b' /\ c /\ d ==> g)
==> (a /\ a') /\ (b /\ b') /\ c /\ d ==> f /\ g`) THEN
CONJ_TAC THENL [MESON_TAC[
PATH_JOIN]; ALL_TAC] THEN
REWRITE_TAC[arc;
simple_path;
SUBSET;
IN_INTER; pathstart;
pathfinish;
IN_INTERVAL_1;
DROP_VEC;
IN_INSERT;
NOT_IN_EMPTY] THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
MATCH_MP_TAC
DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
[REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
ASM_REWRITE_TAC[
DROP_CMUL;
DROP_VEC;
DROP_SUB] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
VECTOR_ARITH_TAC;
ALL_TAC;
ASM_REAL_ARITH_TAC;
REMOVE_THEN "G2" (MP_TAC o SPECL
[`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
ASM_REWRITE_TAC[
DROP_CMUL;
DROP_VEC;
DROP_SUB] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
ANTS_TAC THENL
[CONJ_TAC THENL
[REWRITE_TAC[
path_image;
IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL] THEN
ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC[
path_image;
IN_IMAGE] THEN
EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
ASM_REAL_ARITH_TAC];
ALL_TAC] THEN
STRIP_TAC THEN
SUBGOAL_THEN `x:real^1 = &1 / &2 % vec 1` SUBST_ALL_TAC THENL
[SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
[ALL_TAC; VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G1" MATCH_MP_TAC;
SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
[ALL_TAC; VECTOR_ARITH_TAC] THEN
REMOVE_THEN "G2" MATCH_MP_TAC] THEN
(REWRITE_TAC[
CONJ_ASSOC] THEN CONJ_TAC THENL
[ALL_TAC; ASM_MESON_TAC[]] THEN
ASM_REWRITE_TAC[
DROP_CMUL;
DROP_SUB;
DROP_VEC] THEN
ASM_REAL_ARITH_TAC));;
let REVERSEPATH_JOINPATHS = prove
(`!g1 g2. pathfinish g1 = pathstart g2
==> reversepath(g1 ++ g2) = reversepath g2 ++ reversepath g1`,
REPEAT GEN_TAC THEN
REWRITE_TAC[reversepath; joinpaths; pathfinish; pathstart;
FUN_EQ_THM] THEN
DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN
REWRITE_TAC[
DROP_VEC;
DROP_SUB; REAL_ARITH
`&1 - x <= &1 / &2 <=> &1 / &2 <= x`] THEN
ASM_CASES_TAC `t = lift(&1 / &2)` THENL
[ASM_REWRITE_TAC[
LIFT_DROP;
REAL_LE_REFL; GSYM
LIFT_NUM; GSYM
LIFT_SUB;
GSYM
LIFT_CMUL] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[
LIFT_NUM];
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM
DROP_EQ]) THEN
REWRITE_TAC[
LIFT_DROP] THEN DISCH_TAC THEN
ASM_SIMP_TAC[REAL_ARITH
`~(x = &1 / &2) ==> (&1 / &2 <= x <=> ~(x <= &1 / &2))`] THEN
ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THEN
AP_TERM_TAC THEN REWRITE_TAC[
VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC]);;
(* ------------------------------------------------------------------------- *)
(* Some reversed and "if and only if" versions of joining theorems. *)
(* ------------------------------------------------------------------------- *)
let PATH_JOIN_PATH_ENDS = prove
(`!g1 g2:real^1->real^N.
path g2 /\ path(g1 ++ g2) ==> pathfinish g1 = pathstart g2`,
REPEAT GEN_TAC THEN DISJ_CASES_TAC(NORM_ARITH
`pathfinish g1:real^N = pathstart g2 \/
&0 < dist(pathfinish g1,pathstart g2)`) THEN
ASM_REWRITE_TAC[path;
continuous_on; joinpaths] THEN
RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
REWRITE_TAC[pathstart; pathfinish] THEN
ABBREV_TAC `e = dist((g1:real^1->real^N)(vec 1),g2(vec 0:real^1))` THEN
DISCH_THEN(CONJUNCTS_THEN2
(MP_TAC o SPEC `vec 0:real^1`) (MP_TAC o SPEC `lift(&1 / &2)`)) THEN
REWRITE_TAC[
ENDS_IN_UNIT_INTERVAL;
LIFT_DROP;
REAL_LE_REFL] THEN
REWRITE_TAC[GSYM
LIFT_CMUL;
IN_INTERVAL_1;
DROP_VEC;
LIFT_DROP] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[
LIFT_NUM] THEN
DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[
REAL_HALF] THEN
DISCH_THEN(X_CHOOSE_THEN `d1:real`
(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[
REAL_HALF] THEN
DISCH_THEN(X_CHOOSE_THEN `d2:real`
(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
REMOVE_THEN "2" (MP_TAC o SPEC `lift(min (&1 / &2) (min d1 d2) / &2)`) THEN
REWRITE_TAC[
LIFT_DROP;
DIST_LIFT;
DIST_0;
NORM_REAL; GSYM drop] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
REMOVE_THEN "1" (MP_TAC o SPEC
`lift(&1 / &2 + min (&1 / &2) (min d1 d2) / &4)`) THEN
REWRITE_TAC[
LIFT_DROP;
DIST_LIFT] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
REWRITE_TAC[GSYM
LIFT_CMUL;
LIFT_ADD; REAL_ADD_LDISTRIB] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[
LIFT_NUM] THEN
REWRITE_TAC[
VECTOR_ADD_SUB; REAL_ARITH `&2 * x / &4 = x / &2`] THEN
REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
let PATH_JOIN_EQ = prove
(`!g1 g2:real^1->real^N.
path g1 /\ path g2
==> (path(g1 ++ g2) <=> pathfinish g1 = pathstart g2)`,
(* ------------------------------------------------------------------------- *)
(* Reassociating a joined path doesn't matter for various properties. *)
(* ------------------------------------------------------------------------- *)
let PATH_ASSOC = prove
(`!p q r:real^1->real^N.
pathfinish p = pathstart q /\ pathfinish q = pathstart r
==> (path(p ++ (q ++ r)) <=> path((p ++ q) ++ r))`,
let ARC_ASSOC = prove
(`!p q r:real^1->real^N.
pathfinish p = pathstart q /\ pathfinish q = pathstart r
==> (arc(p ++ (q ++ r)) <=> arc((p ++ q) ++ r))`,
(* ------------------------------------------------------------------------- *)
(* In the case of a loop, neither does symmetry. *)
(* ------------------------------------------------------------------------- *)
let PATH_SYM = prove
(`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
==> (path(p ++ q) <=> path(q ++ p))`,
(* ------------------------------------------------------------------------- *)
(* Reparametrizing a closed curve to start at some chosen point. *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [SHIFTPATH_TRANSLATION];;
add_linear_invariants [SHIFTPATH_LINEAR_IMAGE];;
let PATHFINISH_SHIFTPATH = prove
(`!a g. &0 <= drop a /\ pathfinish g = pathstart g
==> pathfinish(shiftpath a g) = g(a)`,
SIMP_TAC[pathfinish; shiftpath; pathstart;
DROP_ADD;
DROP_VEC] THEN
REWRITE_TAC[VECTOR_ARITH `a + vec 1 - vec 1 = a`] THEN
ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x + &1 <= &1 <=> x = &0)`] THEN
SIMP_TAC[
DROP_EQ_0;
VECTOR_ADD_LID] THEN MESON_TAC[]);;
let ENDPOINTS_SHIFTPATH = prove
(`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
==> pathfinish(shiftpath a g) = g a /\
pathstart(shiftpath a g) = g a`,
let CLOSED_SHIFTPATH = prove
(`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
==> pathfinish(shiftpath a g) = pathstart(shiftpath a g)`,
let PATH_SHIFTPATH = prove
(`!g a. path g /\ pathfinish g:real^N = pathstart g /\
a IN interval[vec 0,vec 1]
==> path(shiftpath a g)`,
let SHIFTPATH_SHIFTPATH = prove
(`!g a x. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g /\
x IN interval[vec 0,vec 1]
==> shiftpath (vec 1 - a) (shiftpath a g) x = g x`,
REWRITE_TAC[shiftpath; pathfinish; pathstart] THEN
REWRITE_TAC[
DROP_ADD;
DROP_SUB;
DROP_VEC] THEN
REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
IN_INTERVAL_1])) THEN
REWRITE_TAC[
DROP_VEC] THEN REPEAT STRIP_TAC THENL
[ALL_TAC;
AP_TERM_TAC THEN VECTOR_ARITH_TAC;
AP_TERM_TAC THEN VECTOR_ARITH_TAC;
ASM_REAL_ARITH_TAC] THEN
SUBGOAL_THEN `x:real^1 = vec 0` SUBST1_TAC THENL
[REWRITE_TAC[GSYM
DROP_EQ;
DROP_VEC] THEN
ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a + vec 0:real^1 = vec 1`]]);;
let PATH_IMAGE_SHIFTPATH = prove
(`!a g:real^1->real^N.
a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g
==> path_image(shiftpath a g) = path_image g`,
REWRITE_TAC[
IN_INTERVAL_1; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
MATCH_MP_TAC
SUBSET_ANTISYM THEN CONJ_TAC THEN
REWRITE_TAC[
path_image; shiftpath;
FORALL_IN_IMAGE;
SUBSET] THEN
REWRITE_TAC[
IN_IMAGE] THEN REPEAT STRIP_TAC THEN
REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[
IN_IMAGE] THENL
[EXISTS_TAC `a + x:real^1`;
EXISTS_TAC `a + x - vec 1:real^1`;
ALL_TAC] THEN
REPEAT(POP_ASSUM MP_TAC) THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_SUB;
DROP_ADD] THEN
TRY REAL_ARITH_TAC THEN REPEAT STRIP_TAC THEN
ASM_CASES_TAC `drop a <= drop x` THENL
[EXISTS_TAC `x - a:real^1` THEN
REWRITE_TAC[VECTOR_ARITH `a + x - a:real^1 = x`;
DROP_SUB] THEN
COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
ASM_REAL_ARITH_TAC;
EXISTS_TAC `vec 1 + x - a:real^1` THEN
REWRITE_TAC[VECTOR_ARITH `a + (v + x - a) - v:real^1 = x`] THEN
REWRITE_TAC[
DROP_ADD;
DROP_SUB;
DROP_VEC] THEN
ASM_CASES_TAC `x:real^1 = vec 0` THEN
ASM_REWRITE_TAC[VECTOR_ARITH `a + v + x - a:real^1 = v + x`] THEN
ASM_REWRITE_TAC[
VECTOR_ADD_RID;
DROP_VEC;
COND_ID] THEN
ASM_REWRITE_TAC[REAL_ARITH `a + &1 + x - a <= &1 <=> x <= &0`] THEN
REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM
DROP_EQ;
DROP_VEC] THEN
TRY(COND_CASES_TAC THEN POP_ASSUM MP_TAC) THEN REWRITE_TAC[] THEN
REAL_ARITH_TAC]);;
let SIMPLE_PATH_SHIFTPATH = prove
(`!g a. simple_path g /\ pathfinish g = pathstart g /\
a IN interval[vec 0,vec 1]
==> simple_path(shiftpath a g)`,
REPEAT GEN_TAC THEN REWRITE_TAC[
simple_path] THEN
MATCH_MP_TAC(TAUT
`(a /\ c /\ d ==> e) /\ (b /\ c /\ d ==> f)
==> (a /\ b) /\ c /\ d ==> e /\ f`) THEN
CONJ_TAC THENL [MESON_TAC[
PATH_SHIFTPATH]; ALL_TAC] THEN
REWRITE_TAC[
simple_path; shiftpath;
IN_INTERVAL_1;
DROP_VEC;
DROP_ADD;
DROP_SUB] THEN
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
STRIP_TAC THEN REPEAT GEN_TAC THEN
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN
REPEAT(POP_ASSUM MP_TAC) THEN
REWRITE_TAC[
DROP_ADD;
DROP_SUB;
DROP_VEC; GSYM
DROP_EQ] THEN
REAL_ARITH_TAC);;
(* ------------------------------------------------------------------------- *)
(* Choosing a sub-path of an existing path. *)
(* ------------------------------------------------------------------------- *)
let PATH_SUBPATH = prove
(`!u v g:real^1->real^N.
path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
==> path(subpath u v g)`,
add_translation_invariants [SUBPATH_TRANSLATION];;
add_linear_invariants [SUBPATH_LINEAR_IMAGE];;
let ARC_SUBPATH_EQ = prove
(`!g u v. arc(subpath u v g) <=>
path(subpath u v g) /\ ~(u = v) /\
(!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
==> x = y)`,
let ARC_SUBPATH_ARC = prove
(`!u v g. arc g /\
u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\
~(u = v)
==> arc(subpath u v g)`,
let ARC_SIMPLE_PATH_SUBPATH_INTERIOR = prove
(`!g u v. simple_path g /\
u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
~(u = v) /\ abs(drop u - drop v) < &1
==> arc(subpath u v g)`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC
ARC_SIMPLE_PATH_SUBPATH THEN
ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
simple_path]) THEN
DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o CONJUNCT2) THEN
ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
STRIP_TAC THEN ASM_REWRITE_TAC[
DROP_VEC] THEN REAL_ARITH_TAC);;
(* ------------------------------------------------------------------------- *)
(* Some additional lemmas about choosing sub-paths. *)
(* ------------------------------------------------------------------------- *)
let SUBPATH_TO_FRONTIER_EXPLICIT = prove
(`!g:real^1->real^N s.
path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
==> ?u. u IN interval[vec 0,vec 1] /\
(!x. &0 <= drop x /\ drop x < drop u ==> g x IN interior s) /\
~(g u IN interior s) /\
(u = vec 0 \/ g u IN closure s)`,
let SUBPATH_TO_FRONTIER_STRONG = prove
(`!g:real^1->real^N s.
path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
==> ?u. u IN interval[vec 0,vec 1] /\
~(pathfinish(subpath (vec 0) u g) IN interior s) /\
(u = vec 0 \/
(!x. x IN interval[vec 0,vec 1] /\ ~(x = vec 1)
==> (subpath (vec 0) u g x) IN interior s) /\
pathfinish(subpath (vec 0) u g) IN closure s)`,
let SUBPATH_TO_FRONTIER = prove
(`!g:real^1->real^N s.
path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
==> ?u. u IN interval[vec 0,vec 1] /\
pathfinish(subpath (vec 0) u g) IN frontier s /\
(path_image(subpath (vec 0) u g) DELETE
pathfinish(subpath (vec 0) u g))
SUBSET interior s`,
(* ------------------------------------------------------------------------- *)
(* Special case of straight-line paths. *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [LINEPATH_TRANSLATION];;
add_linear_invariants [LINEPATH_LINEAR_IMAGE];;
let LINEPATH_REFL = prove
(`!a. linepath(a,a) = \x. a`,
REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`]);;
(* ------------------------------------------------------------------------- *)
(* Bounding a point away from a path. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Homeomorphisms of arc images. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Path component, considered as a "joinability" relation (from Tom Hales). *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Can also consider it as a set, as the name suggests. *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [PATH_COMPONENT_TRANSLATION];;
add_linear_invariants [PATH_COMPONENT_LINEAR_IMAGE];;
(* ------------------------------------------------------------------------- *)
(* Path connectedness of a space. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* General "locally connected implies connected" type results. *)
(* ------------------------------------------------------------------------- *)
let OPEN_GENERAL_COMPONENT = prove
(`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
(!s x y. c s x y ==> c s y x) /\
(!s x y z. c s x y /\ c s y z ==> c s x z) /\
(!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
(!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
==> c (ball(x,e)) x y)
==> !s x:real^N. open s ==> open(c s x)`,
GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
REPEAT GEN_TAC THEN REWRITE_TAC[
OPEN_CONTAINS_BALL;
SUBSET;
IN_BALL] THEN
DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
REWRITE_TAC[
SUBSET;
IN] THEN STRIP_TAC THEN
SUBGOAL_THEN `(x:real^N)
IN s /\ y
IN s` STRIP_ASSUME_TAC THENL
[ASM_MESON_TAC[]; ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N)
IN s`)) THEN
MATCH_MP_TAC
MONO_EXISTS THEN
X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN
ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[
SUBSET;
IN_BALL] THEN
REMOVE_THEN "BALL" MATCH_MP_TAC THEN
REWRITE_TAC[
SUBSET;
IN_BALL] THEN ASM_MESON_TAC[]);;
let OPEN_NON_GENERAL_COMPONENT = prove
(`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
(!s x y. c s x y ==> c s y x) /\
(!s x y z. c s x y /\ c s y z ==> c s x z) /\
(!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
(!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
==> c (ball(x,e)) x y)
==> !s x:real^N. open s ==> open(s DIFF c s x)`,
GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
REPEAT GEN_TAC THEN REWRITE_TAC[
OPEN_CONTAINS_BALL;
SUBSET;
IN_BALL] THEN
DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[
IN_DIFF] THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[
IN])) THEN
FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N)
IN s`)) THEN
MATCH_MP_TAC
MONO_EXISTS THEN
X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
REWRITE_TAC[
IN] THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN
REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN
ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[
SUBSET;
IN_BALL] THEN
REMOVE_THEN "SYM" MATCH_MP_TAC THEN
REMOVE_THEN "BALL" MATCH_MP_TAC THEN
REWRITE_TAC[
SUBSET;
IN_BALL] THEN ASM_MESON_TAC[]);;
let GENERAL_CONNECTED_OPEN = prove
(`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
(!s x y. c s x y ==> c s y x) /\
(!s x y z. c s x y /\ c s y z ==> c s x z) /\
(!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
(!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
==> c (ball(x,e)) x y)
==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s
==> c s x y`,
REPEAT STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
REWRITE_TAC[
IN] THEN REWRITE_TAC[
NOT_EXISTS_THM;
LEFT_IMP_FORALL_THM] THEN
MAP_EVERY EXISTS_TAC
[`c (s:real^N->bool) (x:real^N):real^N->bool`;
`s
DIFF (c (s:real^N->bool) (x:real^N))`] THEN
MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g)
==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN
REPEAT CONJ_TAC THENL
[MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
SET_TAC[];
SET_TAC[];
ALL_TAC;
ASM SET_TAC[]] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
OPEN_CONTAINS_BALL]) THEN
DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
REWRITE_TAC[GSYM
MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
ASM_REWRITE_TAC[
IN_INTER] THEN REWRITE_TAC[
IN] THEN
FIRST_ASSUM(MATCH_MP_TAC o
SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN
ASM_MESON_TAC[
CENTRE_IN_BALL]);;
(* ------------------------------------------------------------------------- *)
(* Some useful lemmas about path-connectedness. *)
(* ------------------------------------------------------------------------- *)
add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];;
add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];;
(* ------------------------------------------------------------------------- *)
(* Bounds on components of a continuous image. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* More stuff about segments. *)
(* ------------------------------------------------------------------------- *)
let SEGMENT_IMAGE_INTERVAL = prove
(`(!a b. segment[a,b] =
IMAGE (\u. (&1 - drop u) % a + drop u % b)
(interval[vec 0,vec 1])) /\
(!a b. ~(a = b)
==> segment(a,b) =
IMAGE (\u. (&1 - drop u) % a + drop u % b)
(interval(vec 0,vec 1)))`,
let CLOSURE_SEGMENT = prove
(`(!a b:real^N. closure(segment[a,b]) = segment[a,b]) /\
(!a b:real^N. closure(segment(a,b)) = if a = b then {} else segment[a,b])`,
let CLOSED_SEGMENT = prove
(`(!a b:real^N. closed(segment[a,b])) /\
(!a b:real^N. closed(segment(a,b)) <=> a = b)`,
let COMPACT_SEGMENT = prove
(`(!a b:real^N. compact(segment[a,b])) /\
(!a b:real^N. compact(segment(a,b)) <=> a = b)`,
let AFFINE_HULL_SEGMENT = prove
(`(!a b:real^N. affine hull (segment [a,b]) = affine hull {a,b}) /\
(!a b:real^N. affine hull (segment(a,b)) =
if a = b then {} else affine hull {a,b})`,
let SEGMENT_AS_BALL = prove
(`(!a b. segment[a:real^N,b] =
affine hull {a,b} INTER cball(inv(&2) % (a + b),norm(b - a) / &2)) /\
(!a b. segment(a:real^N,b) =
affine hull {a,b} INTER ball(inv(&2) % (a + b),norm(b - a) / &2))`,
let CONVEX_SEMIOPEN_SEGMENT = prove
(`(!a b:real^N. convex(segment[a,b] DELETE a)) /\
(!a b:real^N. convex(segment[a,b] DELETE b))`,
MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN
CONJ_TAC THENL [MESON_TAC[
SEGMENT_SYM]; ALL_TAC] THEN
REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN
ASM_SIMP_TAC[
SEGMENT_REFL; SET_RULE `{a}
DELETE a = {}`;
CONVEX_EMPTY] THEN
REWRITE_TAC[
CONVEX_ALT;
IN_DELETE] THEN
SIMP_TAC[REWRITE_RULE[
CONVEX_ALT]
CONVEX_SEGMENT] THEN
REWRITE_TAC[
IN_SEGMENT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
ASM_REWRITE_TAC[
VECTOR_ADD_LDISTRIB;
VECTOR_MUL_ASSOC;
GSYM
VECTOR_ADD_ASSOC] THEN
ASM_REWRITE_TAC[VECTOR_ARITH
`x % a + y % b + z % a + w % b:real^N = a <=>
(&1 - x - z) % a = (w + y) % b`] THEN
ASM_REWRITE_TAC[
VECTOR_MUL_LCANCEL; REAL_ARITH
`&1 - (&1 - u) * (&1 - v) - u * (&1 - w) =
u * w + (&1 - u) * v`] THEN
ASM_SIMP_TAC[
REAL_LE_MUL;
REAL_SUB_LE; REAL_ARITH
`&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN
REWRITE_TAC[
REAL_ENTIRE; REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN
DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
`(u = &0 \/ w = &0) /\ (u = &1 \/ v = &0)
==> u = &0 /\ v = &0 \/ u = &1 /\ w = &0 \/ v = &0 /\ w = &0`)) THEN
DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
ASM_MESON_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
let SEGMENT_EQ_SING = prove
(`(!a b c:real^N. segment[a,b] = {c} <=> a = c /\ b = c) /\
(!a b c:real^N. ~(segment(a,b) = {c}))`,
let SUBSET_SEGMENT = prove
(`(!a b c d:real^N.
segment[a,b] SUBSET segment[c,d] <=>
a IN segment[c,d] /\ b IN segment[c,d]) /\
(!a b c d:real^N.
segment[a,b] SUBSET segment(c,d) <=>
a IN segment(c,d) /\ b IN segment(c,d)) /\
(!a b c d:real^N.
segment(a,b) SUBSET segment[c,d] <=>
a = b \/ a IN segment[c,d] /\ b IN segment[c,d]) /\
(!a b c d:real^N.
segment(a,b) SUBSET segment(c,d) <=>
a = b \/ a IN segment[c,d] /\ b IN segment[c,d])`,
let INTERIOR_SEGMENT = prove
(`(!a b:real^N. interior(segment[a,b]) =
if 2 <= dimindex(:N) then {} else segment(a,b)) /\
(!a b:real^N. interior(segment(a,b)) =
if 2 <= dimindex(:N) then {} else segment(a,b))`,
let SEGMENT_EQ = prove
(`(!a b c d:real^N.
segment[a,b] = segment[c,d] <=> {a,b} = {c,d}) /\
(!a b c d:real^N.
~(segment[a,b] = segment(c,d))) /\
(!a b c d:real^N.
~(segment(a,b) = segment[c,d])) /\
(!a b c d:real^N.
segment(a,b) = segment(c,d) <=> a = b /\ c = d \/ {a,b} = {c,d})`,
let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove
(`!f:real^N->real^1 a b.
f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b)
==> ?z. z IN segment(a,b) /\
((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/
(!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`,
REPEAT STRIP_TAC THEN
MAP_EVERY (MP_TAC o ISPECL
[`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`])
[
CONTINUOUS_ATTAINS_SUP;
CONTINUOUS_ATTAINS_INF] THEN
ASM_REWRITE_TAC[
o_DEF;
LIFT_DROP; ETA_AX] THEN
REWRITE_TAC[
COMPACT_SEGMENT;
SEGMENT_EQ_EMPTY] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN
ASM_CASES_TAC `(d:real^N)
IN segment(a,b)` THENL
[ASM_MESON_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
ASM_CASES_TAC `(c:real^N)
IN segment(a,b)` THENL
[ASM_MESON_TAC[]; ALL_TAC] THEN
EXISTS_TAC `midpoint(a:real^N,b)` THEN
MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
[ASM_REWRITE_TAC[
MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o
GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN
ASM_REWRITE_TAC[
IN_DIFF;
IN_INSERT;
NOT_IN_EMPTY] THEN
REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN
FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM;
DROP_EQ]);;
(* ------------------------------------------------------------------------- *)
(* An injective function into R is a homeomorphism and so an open map. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Injective function on an interval is strictly increasing or decreasing. *)
(* ------------------------------------------------------------------------- *)
let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove
(`!f:real^1->real^1 s.
f continuous_on s /\ is_interval s
==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
(!x y. x IN s /\ y IN s /\ drop x < drop y
==> drop(f x) < drop(f y)) \/
(!x y. x IN s /\ y IN s /\ drop x < drop y
==> drop(f y) < drop(f x)))`,
let lemma = prove
(`!s f:real^1->real^1.
f continuous_on s /\ is_interval s /\
(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
==> !u v w. u IN s /\ v IN s /\ w IN s /\
drop u < drop v /\ drop v < drop w /\
drop(f u) <= drop(f v) /\ drop(f w) <= drop(f v) ==> F`,
REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT] THEN
REPEAT STRIP_TAC THEN
MP_TAC(ISPECL [`f:real^1->real^1`; `u:real^1`; `w:real^1`]
CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN
REWRITE_TAC[EXTENSION] THEN
DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) v`) THEN
MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
[MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[SEGMENT_1] THEN
COND_CASES_TAC THENL
[ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC];
REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
ASM_REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THENL
[SUBGOAL_THEN `drop(f(w:real^1)) = drop(f v)` ASSUME_TAC THENL
[ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]];
SUBGOAL_THEN `drop(f(u:real^1)) = drop(f v)` ASSUME_TAC THENL
[ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]]])
and tac s1 s2 =
let [l1;l2] = map (map (fun x -> mk_var(x,`:real^1`)) o explode) [s1;s2] in
REPEAT(FIRST_X_ASSUM(fun th ->
MP_TAC(ISPECL l1 th) THEN MP_TAC(ISPECL l2 th))) THEN
ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC in
REPEAT STRIP_TAC THEN EQ_TAC THENL
[ALL_TAC;
REWRITE_TAC[GSYM DROP_EQ] THEN
MESON_TAC[REAL_LT_TOTAL; REAL_LT_REFL]] THEN
DISCH_TAC THEN MATCH_MP_TAC(MESON[]
`(!a b c d. ~(~P a b /\ ~Q c d)) ==> (!x y. P x y) \/ (!x y. Q x y)`) THEN
MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN
REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN STRIP_TAC THEN
REPEAT
(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN
REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL
[ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]]) THEN
MP_TAC(ISPEC `s:real^1->bool` lemma) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(fun th ->
MP_TAC(SPEC `(--) o (f:real^1->real^1)` th) THEN
MP_TAC(SPEC `f:real^1->real^1` th)) THEN
ASM_REWRITE_TAC[o_THM; VECTOR_ARITH `--x:real^N = --y <=> x = y`] THEN
DISCH_TAC THEN REWRITE_TAC[NOT_IMP; DROP_NEG; REAL_LE_NEG2] THEN
CONJ_TAC THENL
[ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE;LINEAR_CONTINUOUS_ON; LINEAR_NEGATION];
DISCH_TAC] THEN
ASM_CASES_TAC `drop d <= drop a` THENL [tac "cab" "cdb";
ALL_TAC] THEN
ASM_CASES_TAC `drop b <= drop c` THENL [tac "abd" "acd"; ALL_TAC] THEN
ASM_CASES_TAC `c:real^1 = a /\ d:real^1 = b` THENL
[ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
`~(c = a /\ d = b)
==> (c = a ==> d = b) /\ (d = b ==> c = a) /\
(~(c = a) /\ ~(d = b) ==> F) ==> F`)) THEN
REPEAT CONJ_TAC THENL
[DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "adb" "abd";
DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "acb" "cab";
REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC] THEN
ASM_CASES_TAC `drop a <= drop c` THENL [tac "acb" "acd"; tac "cab" "cad"]);;
(* ------------------------------------------------------------------------- *)
(* Some uncountability results for relevant sets. *)
(* ------------------------------------------------------------------------- *)
let CARD_EQ_SEGMENT = prove
(`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\
(!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`,
let UNCOUNTABLE_SEGMENT = prove
(`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\
(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`,
let [CONNECTED_FINITE_IFF_SING;
CONNECTED_FINITE_IFF_COUNTABLE;
CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove)
(`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\
(!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\
(!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`,
REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
ASM_CASES_TAC `connected(s:real^N->bool)` THEN
ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT
`(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r)
==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN
REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN
REPEAT CONJ_TAC THEN STRIP_TAC THEN
ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN
MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);;
let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS =
(CONJ_PAIR o prove)
(`(!s:real^N->bool.
{x | x condensation_point_of s} = {} <=> COUNTABLE s) /\
(!s:real^N->bool.
{x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`,
REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
`(r ==> p) /\ (~r ==> q) /\ (p ==> ~q)
==> (p <=> r) /\ (q <=> ~r)`) THEN
REPEAT CONJ_TAC THENL
[DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
REWRITE_TAC[condensation_point_of] THEN
ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV];
DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE
[TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN
REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN
FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN
ASM_REWRITE_TAC[CONTRAPOS_THM] THEN
MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[];
DISCH_THEN SUBST1_TAC THEN
DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN
REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);;
(* ------------------------------------------------------------------------- *)
(* Density of sets with small complement, including irrationals. *)
(* ------------------------------------------------------------------------- *)
let OPEN_SET_COSMALL_COORDINATES = prove
(`!P. (!i. 1 <= i /\ i <= dimindex(:N)
==> (:real) DIFF {x | P i x} <_c (:real))
==> !s:real^N->bool.
open s /\ ~(s = {})
==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
let CLOSURE_COSMALL_COORDINATES = prove
(`!P. (!i. 1 <= i /\ i <= dimindex(:N)
==> (:real) DIFF {x | P i x} <_c (:real))
==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
(:real^N)`,
(* ------------------------------------------------------------------------- *)
(* Every path between distinct points contains an arc, and hence *)
(* that path connection is equivalent to arcwise connection, for distinct *)
(* points. The proof is based on Whyburn's "Topological Analysis". *)
(* ------------------------------------------------------------------------- *)
let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove
(`!f:real^1->real^N.
f continuous_on interval[vec 0,vec 1] /\
(!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\
~(f(vec 1) = f(vec 0))
==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic
(interval[vec 0:real^1,vec 1])`,
let closure_dyadic_rationals_in_convex_set_pos_1 = prove
(`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x)
==> closure(s INTER { lift(&m / &2 pow n) |
m IN (:num) /\ n IN (:num)}) =
closure s`,
REPEAT STRIP_TAC THEN
MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
MATCH_MP_TAC(SET_RULE
`(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t)
==> s INTER t = s INTER u`) THEN
REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN
REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN
REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN
CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN
MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN
ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN
ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in
let function_on_dyadic_rationals = prove
(`!f:num->num->A.
(!m n. f (2 * m) (n + 1) = f m n)
==> ?g. !m n. g(&m / &2 pow n) = f m n`,
REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL
[`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`]
FUNCTION_FACTORS_LEFT) THEN
REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN
DISCH_THEN (SUBST1_TAC o SYM) THEN
ONCE_REWRITE_TAC[MESON[]
`(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN
MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0)
==> (x / y = x' / y' <=> y' / y * x = x')`;
REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN
SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN
REWRITE_TAC[MESON[]
`(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=>
(!d m n. P m (g d m) n d)`] THEN
INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN
REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in
let recursion_on_dyadic_rationals = prove
(`!b:num->A l r.
?f. (!m. f(&m) = b m) /\
(!m n. f(&(4 * m + 1) / &2 pow (n + 1)) =
l(f(&(2 * m + 1) / &2 pow n))) /\
(!m n. f(&(4 * m + 3) / &2 pow (n + 1)) =
r(f(&(2 * m + 1) / &2 pow n)))`,
REPEAT GEN_TAC THEN
SUBGOAL_THEN
`?f:num->num->A.
(!m n. f (2 * m) (n + 1) = f m n) /\
(!m. f m 0 = b m) /\
(!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\
(!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))`
MP_TAC THENL
[MP_TAC(prove_recursive_functions_exist num_RECURSION
`(!m. f m 0 = (b:num->A) m) /\
(!m n. f m (SUC n) =
if EVEN m then f (m DIV 2) n
else if EVEN(m DIV 2)
then l(f ((m + 1) DIV 2) n)
else r(f (m DIV 2) n))`) THEN
MATCH_MP_TAC MONO_EXISTS THEN
X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN
RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN
REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN
REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`;
ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`;
ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`;
ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN
REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND];
DISCH_THEN(X_CHOOSE_THEN `f:num->num->A`
(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN
MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN
RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN
ASM_REWRITE_TAC[]]) in
let recursion_on_dyadic_rationals_1 = prove
(`!b:A l r.
?f. (!m. f(&m / &2) = b) /\
(!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) =
l(f(&(2 * m + 1) / &2 pow n))) /\
(!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) =
r(f(&(2 * m + 1) / &2 pow n)))`,
REPEAT GEN_TAC THEN
MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`]
recursion_on_dyadic_rationals) THEN
REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN
ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN
CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ;
ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in
let exists_function_unpair = prove
(`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`,
EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN
EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN
EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN
ASM_REWRITE_TAC[PAIR; ETA_AX]) in
let dyadics_in_open_unit_interval = prove
(`interval(vec 0,vec 1) INTER
{lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} =
{lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`,
MATCH_MP_TAC(SET_RULE
`(!m n. (f m n) IN s <=> P m n)
==> s INTER {f m n | m IN UNIV /\ n IN UNIV} =
{f m n | P m n}`) THEN
REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in
REPEAT STRIP_TAC THEN
SUBGOAL_THEN
`!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1]
==> ?c d. drop a <= drop c /\ drop c <= drop m /\
drop m <= drop d /\ drop d <= drop b /\
(!x. x IN interval[c,d] ==> f x = f m) /\
(!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\
(!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\
(!x y. x IN interval[a,c] DELETE c /\
y IN interval[d,b] DELETE d
==> ~((f:real^1->real^N) x = f y))`
MP_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN
REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
SUBGOAL_THEN
`?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
interval[c,d]`
MP_TAC THENL
[SUBGOAL_THEN
`{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
interval[a,b] INTER
{x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}`
SUBST1_TAC THENL
[REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM;
DROP_VEC] THEN
GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
SUBGOAL_THEN
`?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} =
interval[c,d]`
MP_TAC THENL
[ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN
ONCE_REWRITE_TAC[SET_RULE
`{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN
MATCH_MP_TAC COMPACT_INTER_CLOSED THEN
REWRITE_TAC[COMPACT_INTERVAL] THEN
MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
ASM_REWRITE_TAC[CLOSED_INTERVAL];
STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]];
ALL_TAC] THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN
SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL
[FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN
SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL
[ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN
ASM_REAL_ARITH_TAC;
FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
[GSYM th]) THEN
REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN
STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
CONJ_TAC THENL
[GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
[GSYM th]) THEN SIMP_TAC[IN_ELIM_THM];
ALL_TAC] THEN
GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
[CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`{x | x IN s /\ f x = a} = t
==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t))
==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN
REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN
SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL
[REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`;
IN_INTERVAL_1] THEN
ASM_REAL_ARITH_TAC;
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
(LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN
REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN
ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL
[ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL
[ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o
SPEC `(f:real^1->real^N) y`) THEN
ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL
[`x:real^1`; `y:real^1`; `m:real^1`]) THEN
ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC
[`leftcut:real^1->real^1->real^1->real^1`;
`rightcut:real^1->real^1->real^1->real^1`] THEN
STRIP_TAC] THEN
FIRST_ASSUM(MP_TAC o SPECL
[`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN
REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC
`u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN
REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN
REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
DISCH_THEN(SUBST1_TAC o SYM) THEN
REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o SPECL
[`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN
REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC
`v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN
ONCE_REWRITE_TAC[TAUT
`a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN
REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN
ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
STRIP_TAC THEN
SUBGOAL_THEN
`!x. x IN interval[vec 0,v] DELETE v
==> ~((f:real^1->real^N) x = f(vec 1))`
ASSUME_TAC THENL
[X_GEN_TAC `t:real^1` THEN
REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN
ASM_CASES_TAC `drop t < drop u` THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
`~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`));
ALL_TAC] THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
ASM_REAL_ARITH_TAC;
UNDISCH_THEN
`!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))`
(K ALL_TAC)] THEN
MP_TAC(ISPECL
[`(u:real^1,v:real^1)`;
`\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`;
`\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`]
recursion_on_dyadic_rationals_1) THEN
REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN
ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN
REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
SUBGOAL_THEN
`!m n. drop u <= drop(a(&m / &2 pow n)) /\
drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\
drop(b(&m / &2 pow n)) <= drop v`
MP_TAC THENL
[GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN
CONJ_TAC THENL
[REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL];
X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN
X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN
ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD
`&0 < y ==> (&2 * x) / (&2 * y) = x / y`];
ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
[ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL];
REWRITE_TAC[ADD1]] THEN
DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`];
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN
(FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * r + 1) / &2 pow n):real^1`;
`b(&(2 * r + 1) / &2 pow n):real^1`;
`c(&(2 * r + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
[GSYM th]) THEN
REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
UNDISCH_TAC `drop(vec 0) <= drop u` THEN
UNDISCH_TAC `drop v <= drop (vec 1)`;
ALL_TAC] THEN
REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC);
REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL
[ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL
[ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
SUBGOAL_THEN
`!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\
drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))`
MP_TAC THENL
[UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
(fun th -> REWRITE_TAC[GSYM th]) THEN
REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
`a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
SUBGOAL_THEN
`!i m n j. ODD j /\
abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\
drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))`
ASSUME_TAC THENL
[REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN
DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL
[GEN_TAC THEN STRIP_TAC THEN
MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)`
REAL_ABS_INTEGER_LEMMA) THEN
MATCH_MP_TAC(TAUT
`i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN
REPEAT CONJ_TAC THENL
[REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN
REWRITE_TAC[REAL_ARITH
`n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN
ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
MESON_TAC[INTEGER_CLOSED];
SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN
REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN
SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`];
ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ;
REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]];
ALL_TAC] THEN
X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
[ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS];
ALL_TAC] THEN
UNDISCH_THEN `n:num < m`
(fun th -> let th' = MATCH_MP
(ARITH_RULE `n < m ==> m - SUC n < m - n`) th in
FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN
REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
`&i / &2 pow m = &(2 * j + 1) / &2 pow n \/
&i / &2 pow m < &(2 * j + 1) / &2 pow n \/
&(2 * j + 1) / &2 pow n < &i / &2 pow m`)
THENL
[ASM_REWRITE_TAC[ADD1];
DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
[MATCH_MP_TAC(REAL_ARITH
`x < i /\ &2 * n1 = n /\ j + n1 = i
==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN
REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC(REAL_ARITH
`b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * j + 1) / &2 pow n):real^1`;
`b(&(2 * j + 1) / &2 pow n):real^1`;
`c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
[GSYM th]) THEN
REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
`a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]];
DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
[MATCH_MP_TAC(REAL_ARITH
`i < x /\ &2 * n1 = n /\ j - n1 = i
==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN
REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC(REAL_ARITH
`a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * j + 1) / &2 pow n):real^1`;
`b(&(2 * j + 1) / &2 pow n):real^1`;
`c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
[GSYM th]) THEN
REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
`a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]];
ALL_TAC] THEN
SUBGOAL_THEN
`!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n)))
<= &2 / &2 pow n`
ASSUME_TAC THENL
[ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL
[ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN
RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN
DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
[ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN
ASM_SIMP_TAC[ADD1] THEN
MATCH_MP_TAC(REAL_ARITH
`drop c = (drop a + drop b) / &2 /\
abs(drop a - drop b) <= &2 * k /\
drop a <= drop(leftcut a b c) /\
drop(leftcut a b c) <= drop c
==> abs(drop a - drop(leftcut a b c)) <= k`);
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN
ASM_SIMP_TAC[ADD1] THEN
MATCH_MP_TAC(REAL_ARITH
`drop c = (drop a + drop b) / &2 /\
abs(drop a - drop b) <= &2 * k /\
drop c <= drop(rightcut a b c) /\
drop(rightcut a b c) <= drop b
==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN
(CONJ_TAC THENL
[UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
(fun th -> REWRITE_TAC[GSYM th]) THEN
REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC;
ALL_TAC] THEN
CONJ_TAC THENL
[REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN
ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH];
ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * j + 1) / &2 pow n):real^1`;
`b(&(2 * j + 1) / &2 pow n):real^1`;
`c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
[GSYM th]) THEN
REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
`a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]);
ALL_TAC] THEN
SUBGOAL_THEN
`!n j. 0 < 2 * j /\ 2 * j < 2 EXP n
==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) =
f(a(&(2 * j + 1) / &2 pow n))`
ASSUME_TAC THENL
[MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
[REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
ARITH_TAC;
ALL_TAC] THEN
X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN
DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
[ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN
REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
ARITH_TAC;
ALL_TAC] THEN
X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN
CONV_TAC NUM_REDUCE_CONV THEN
ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`;
ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN
SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN
STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
STRIP_TAC THEN
ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`;
ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * j + 1) / &2 pow n):real^1`;
`b(&(2 * j + 1) / &2 pow n):real^1`;
`c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
[GSYM th]) THEN
REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
`a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
MATCH_MP_TAC(MESON[]
`a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN
REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS]]];
ALL_TAC] THEN
SUBGOAL_THEN
`!n j. 0 < j /\ j < 2 EXP n
==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) =
f(c(&j / &2 pow n)) /\
f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))`
ASSUME_TAC THENL
[MATCH_MP_TAC num_INDUCTION THEN
REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN
X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
X_GEN_TAC `j:num` THEN
DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`;
ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN
REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC(MESON[]
`c' = c /\ a' = a /\ b' = b
==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN
REPEAT CONJ_TAC THEN AP_TERM_TAC THENL
[AP_TERM_TAC THEN
REWRITE_TAC[real_pow; real_div; REAL_INV_MUL;
GSYM REAL_OF_NUM_MUL] THEN
REAL_ARITH_TAC;
REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL
[ASM_ARITH_TAC; ALL_TAC] THEN
REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`;
ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN
REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC];
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN
STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
`b(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
`c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN
ANTS_TAC THENL
[ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN
ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1;
ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`;
ARITH_RULE `0 < n + 1`] THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN
ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
ASM_REAL_ARITH_TAC];
ALL_TAC] THEN
ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
REWRITE_TAC[COMPACT_INTERVAL] THEN
MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`;
`interval(vec 0,vec 1) INTER
{lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`]
UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1;
CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL;
UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
CLOSURE_OPEN_INTERVAL] THEN
REWRITE_TAC[dyadics_in_open_unit_interval] THEN
ANTS_TAC THENL
[REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN
`(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]`
MP_TAC THENL
[ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL];
REWRITE_TAC[uniformly_continuous_on]] THEN
DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN
ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN
DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
EXISTS_TAC `inv(&2 pow n)` THEN
REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN
REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
REWRITE_TAC[FORALL_IN_GSPEC] THEN
SUBGOAL_THEN
`!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
==> norm((f:real^1->real^N)(c(&i / &2 pow m)) -
f(c(&j / &2 pow n))) < e / &2`
ASSUME_TAC THENL
[REPEAT GEN_TAC THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH
`abs(x - a) < e
==> x = a \/
abs(x - (a - e / &2)) < e / &2 \/
abs(x - (a + e / &2)) < e / &2`))
THENL
[DISCH_THEN SUBST1_TAC THEN
ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF];
ALL_TAC] THEN
SUBGOAL_THEN
`&j / &2 pow n = &(2 * j) / &2 pow (n + 1)`
(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])
THENL
[REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL;
GSYM REAL_OF_NUM_MUL] THEN
REAL_ARITH_TAC;
ALL_TAC] THEN
REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN
REWRITE_TAC[GSYM real_div;
GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN
REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`;
REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN
ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN
REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL
[SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
f(b (&(2 * j - 1) / &2 pow (n + 1)))`
SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC];
SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
f(a (&(2 * j + 1) / &2 pow (n + 1)))`
SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN
REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[IN_INTERVAL_1] THEN
REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL
[DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB];
DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN
ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN
REWRITE_TAC[DIST_REAL; GSYM drop] THENL
[MATCH_MP_TAC(NORM_ARITH
`!t. abs(a - b) <= t /\ t < d
==> a <= c /\ c <= b ==> abs(c - b) < d`);
MATCH_MP_TAC(NORM_ARITH
`!t. abs(a - b) <= t /\ t < d
==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN
EXISTS_TAC `&2 / &2 pow (n + 1)` THEN
(CONJ_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN
ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`];
REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
ASM_REAL_ARITH_TAC]);
ALL_TAC] THEN
MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN
SUBGOAL_THEN
`?j. 0 < j /\ j < 2 EXP n /\
abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
STRIP_ASSUME_TAC THENL
[MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
(&2 pow n * &k / &2 pow p)`
FLOOR_POS) THEN
SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV;
REAL_POS; REAL_POW_LE] THEN
DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN
MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
(&2 pow n * &k / &2 pow p)` FLOOR) THEN
ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN
ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN
ASM_CASES_TAC `j = 0` THENL
[ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN
DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN
ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN
MATCH_MP_TAC(REAL_ARITH
`&0 < x /\ x < inv n /\ &0 < y /\ y < inv n
==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN
ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2];
DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN
REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN
REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN
SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN
ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]];
MATCH_MP_TAC(NORM_ARITH
`!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
==> dist(w,z) < e`) THEN
EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN
REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[]];
ALL_TAC] THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN
ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN
REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN
ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN
REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN
CONJ_TAC THENL
[MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
[MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
closure_dyadic_rationals_in_convex_set_pos_1) THEN
SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
CLOSURE_OPEN_INTERVAL] THEN
DISCH_THEN(fun th ->
GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN
MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED];
MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
ASM_REWRITE_TAC[COMPACT_INTERVAL];
SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN
ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN
MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS]];
MATCH_MP_TAC SUBSET_TRANS THEN
EXISTS_TAC `closure(IMAGE (h:real^1->real^N)
(interval (vec 0,vec 1) INTER
{lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN
CONJ_TAC THENL
[ALL_TAC;
MATCH_MP_TAC CLOSURE_MINIMAL THEN
ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL;
COMPACT_CONTINUOUS_IMAGE] THEN
MATCH_MP_TAC IMAGE_SUBSET THEN
MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN
REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN
REWRITE_TAC[dyadics_in_open_unit_interval;
EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC
`(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN
DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
COMPACT_UNIFORMLY_CONTINUOUS)) THEN
REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN
`!n. ~(n = 0)
==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\
y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\
(f:real^1->real^N) y = f x`
MP_TAC THENL
[ALL_TAC;
MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`]
REAL_ARCH_POW_INV) THEN
ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN
DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN
ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN
REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
`a <= y /\ y <= b
==> a <= c /\ c <= b /\ abs(a - b) < d
==> abs(c - y) < d`)) THEN
REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN
ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN
X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL
[EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
ASM_REWRITE_TAC[REAL_POW_1] THEN
SUBGOAL_THEN
`x IN interval[vec 0:real^1,u] \/
x IN interval[u,v] \/
x IN interval[v,vec 1]`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
EXISTS_TAC `u:real^1` THEN
ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1];
EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[];
EXISTS_TAC `v:real^1` THEN
ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]];
DISCH_THEN(X_CHOOSE_THEN `m:num`
(X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN
REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN
REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
SUBGOAL_THEN
`y IN interval[a(&(2 * j + 1) / &2 pow n):real^1,
b(&(4 * j + 1) / &2 pow (n + 1))] \/
y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)),
a(&(4 * j + 3) / &2 pow (n + 1))] \/
y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)),
b(&(2 * j + 1) / &2 pow n)]`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
EXISTS_TAC `4 * j + 1` THEN
EXISTS_TAC `y:real^1` THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
`y IN interval[a,b]
==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
ASM_MESON_TAC[LE_1];
EXISTS_TAC `4 * j + 1` THEN
EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * j + 1) / &2 pow n):real^1`;
`b(&(2 * j + 1) / &2 pow n):real^1`;
`c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
REPLICATE_TAC 4
(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
MATCH_MP_TAC(MESON[]
`a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN
SUBGOAL_THEN
`leftcut (a (&(2 * j + 1) / &2 pow n))
(b (&(2 * j + 1) / &2 pow n))
(c (&(2 * j + 1) / &2 pow n):real^1):real^1 =
b(&(4 * j + 1) / &2 pow (n + 1)) /\
rightcut (a (&(2 * j + 1) / &2 pow n))
(b (&(2 * j + 1) / &2 pow n))
(c (&(2 * j + 1) / &2 pow n)):real^1 =
a(&(4 * j + 3) / &2 pow (n + 1))`
(CONJUNCTS_THEN SUBST_ALL_TAC) THENL
[ASM_MESON_TAC[LE_1]; ALL_TAC] THEN
REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
`y IN interval[a,b]
==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
ASM_MESON_TAC[LE_1];
EXISTS_TAC `4 * j + 3` THEN
EXISTS_TAC `y:real^1` THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
`y IN interval[a,b]
==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
ASM_MESON_TAC[LE_1]]]];
ALL_TAC] THEN
SUBGOAL_THEN
`!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\
(!x. drop(a(&m / &2 pow n)) < drop x /\
drop x <= drop(b(&m / &2 pow n))
==> ~(f x = f(a(&m / &2 pow n)))) /\
(!x. drop(a(&m / &2 pow n)) <= drop x /\
drop x < drop(b(&m / &2 pow n))
==> ~(f x :real^N = f(b(&m / &2 pow n))))`
ASSUME_TAC THENL
[SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL
[ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
RULE_ASSUM_TAC(REWRITE_RULE
[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN
ASM_MESON_TAC[DROP_EQ];
ALL_TAC] THEN
SUBGOAL_THEN
`(!x. drop u < drop x /\ drop x <= drop v
==> ~((f:real^1->real^N) x = f u)) /\
(!x. drop u <= drop x /\ drop x < drop v
==> ~(f x = f v))`
STRIP_ASSUME_TAC THENL
[SUBGOAL_THEN
`(f:real^1->real^N) u = f(vec 0) /\
(f:real^1->real^N) v = f(vec 1)`
(CONJUNCTS_THEN SUBST1_TAC)
THENL
[CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL];
ALL_TAC] THEN
CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN
ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
MATCH_MP_TAC num_INDUCTION THEN
ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN
ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN
X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN
ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
X_GEN_TAC `j:num` THEN
DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN
ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`];
ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * m + 1) / &2 pow n):real^1`;
`b(&(2 * m + 1) / &2 pow n):real^1`;
`c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS];
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(K ALL_TAC)] THEN
SUBGOAL_THEN
`(f:real^1->real^N)
(leftcut (a (&(2 * m + 1) / &2 pow n):real^1)
(b (&(2 * m + 1) / &2 pow n):real^1)
(c (&(2 * m + 1) / &2 pow n):real^1)) =
(f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
ASSUME_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC[]] THEN
GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
REPEAT CONJ_TAC THENL
[DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
UNDISCH_THEN
`(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) =
f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
REWRITE_TAC[] THEN
FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
midpoint; DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[REAL_ARITH
`a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`];
GEN_TAC THEN STRIP_TAC THEN
FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
ASM_MESON_TAC[REAL_LE_TRANS];
GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
(fun th -> MATCH_MP_TAC th THEN
REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
GEN_REWRITE_TAC I [REAL_ARITH
`(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN
ASM_REWRITE_TAC[]];
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1 = 4 * m + 3`; ADD1] THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * m + 1) / &2 pow n):real^1`;
`b(&(2 * m + 1) / &2 pow n):real^1`;
`c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS];
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(K ALL_TAC)] THEN
SUBGOAL_THEN
`(f:real^1->real^N)
(rightcut (a (&(2 * m + 1) / &2 pow n):real^1)
(b (&(2 * m + 1) / &2 pow n):real^1)
(c (&(2 * m + 1) / &2 pow n):real^1)) =
(f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
ASSUME_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC[]] THEN
GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
REPEAT CONJ_TAC THENL
[DISCH_THEN SUBST_ALL_TAC THEN
UNDISCH_THEN
`(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) =
f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
REWRITE_TAC[] THEN
FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
midpoint; DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[REAL_ARITH
`a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`];
GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
(fun th -> MATCH_MP_TAC th THEN
REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
GEN_REWRITE_TAC I [REAL_ARITH
`(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN
ASM_REWRITE_TAC[];
GEN_TAC THEN STRIP_TAC THEN
FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
ASM_MESON_TAC[REAL_LE_TRANS]]];
ALL_TAC] THEN
SUBGOAL_THEN
`!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
&i / &2 pow m < &j / &2 pow n
==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))`
ASSUME_TAC THENL
[SUBGOAL_THEN
`!N m p i k.
0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\
&i / &2 pow m < &k / &2 pow p /\ m + p = N
==> ?j n. ODD(j) /\ ~(n = 0) /\
&i / &2 pow m <= &j / &2 pow n /\
&j / &2 pow n <= &k / &2 pow p /\
abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
MP_TAC THENL
[MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN
DISCH_THEN(LABEL_TAC "I") THEN
MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN
STRIP_TAC THEN
SUBGOAL_THEN
`&i / &2 pow m <= &1 / &2 pow 1 /\
&1 / &2 pow 1 <= &k / &2 pow p \/
&k / &2 pow p < &1 / &2 \/
&1 / &2 < &i / &2 pow m`
(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC)
THENL
[ASM_REAL_ARITH_TAC;
MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN
MATCH_MP_TAC(REAL_ARITH
`&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1
==> abs(i - &1 / &2 pow 1) < inv(&2 pow 1) /\
abs(k - &1 / &2 pow 1) < inv(&2 pow 1)`) THEN
ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN
ASM_REWRITE_TAC[REAL_OF_NUM_LT];
REMOVE_THEN "I" MP_TAC THEN
POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN
ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
[MAP_EVERY UNDISCH_TAC
[`&k / &2 pow SUC p < &1 / &2`;
`&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
`x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN
SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT];
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN
REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
REAL_OF_NUM_LT; ARITH]];
REMOVE_THEN "I" MP_TAC THEN
POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
DISCH_THEN(MP_TAC o SPECL
[`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN
ASM_REWRITE_TAC[] THEN
MAP_EVERY UNDISCH_TAC
[`&1 / &2 < &i / &2 pow SUC m`;
`&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP
(REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN
SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN
SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL
[ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN
ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=>
u / v < w / z`] THEN
CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE
`i < 2 * m ==> i - m < m`) THEN
ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)];
REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
REWRITE_TAC[GSYM real_div] THEN
DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num`
STRIP_ASSUME_TAC)) THEN
EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN
ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN
REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
REAL_OF_NUM_LT; ARITH] THEN
REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]];
DISCH_THEN(fun th ->
MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN
STRIP_TAC THEN MP_TAC(ISPECL
[`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
MATCH_MP_TAC REAL_LE_TRANS THEN
EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL
[ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN
ASM_REWRITE_TAC[REAL_LE_REFL] THEN
SUBGOAL_THEN
`drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\
drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))`
MP_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
`abs(i - q) < n
==> i <= q /\ ~(i = q) /\ q = q' + n / &2
==> abs(i - q') < n / &2`)) THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
REAL_ARITH_TAC;
ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
`l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * q + 1) / &2 pow n):real^1`;
`b(&(2 * q + 1) / &2 pow n):real^1`;
`c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS];
DISCH_THEN(fun th -> REWRITE_TAC[th])]];
ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN
ASM_REWRITE_TAC[REAL_LE_REFL] THEN
SUBGOAL_THEN
`drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\
drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))`
MP_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
`abs(i - q) < n
==> q <= i /\ ~(i = q) /\ q' = q + n / &2
==> abs(i - q') < n / &2`)) THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
REAL_ARITH_TAC;
ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
`d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * q + 1) / &2 pow n):real^1`;
`b(&(2 * q + 1) / &2 pow n):real^1`;
`c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
ANTS_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS];
DISCH_THEN(fun th -> REWRITE_TAC[th])]]]];
ALL_TAC] THEN
REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN
MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN
SUBGOAL_THEN
`?m n. 0 < m /\ m < 2 EXP n /\
drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\
~(h(x1):real^N = h(lift(&m / &2 pow n)))`
STRIP_ASSUME_TAC THENL
[MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
closure_dyadic_rationals_in_convex_set_pos_1) THEN
SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
CLOSURE_OPEN_INTERVAL] THEN
REWRITE_TAC[EXTENSION] THEN
DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN
REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN
REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN
DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN
REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN
DISCH_TAC THEN
SUBGOAL_THEN
`?m n. (0 < m /\ m < 2 EXP n) /\
abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) <
(drop x2 - drop x1) / &64 /\
inv(&2 pow n) < (drop x2 - drop x1) / &128`
STRIP_ASSUME_TAC THENL
[MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`]
REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
ASM_CASES_TAC `N = 0` THENL
[ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN
REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN
STRIP_TAC THEN
FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num`
STRIP_ASSUME_TAC)) THEN
EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN
ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1;
ARITH_EQ] THEN
CONJ_TAC THENL
[REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH
`(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN
ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ;
REAL_MUL_LID; GSYM real_div];
MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]];
REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
`!m n m' n'. (P m n /\ P m' n') /\
(P m n /\ P m' n' ==> ~(g m n = g m' n'))
==> (?m n. P m n /\ ~(a = g m n))`) THEN
MAP_EVERY EXISTS_TAC
[`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN
CONJ_TAC THENL
[REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN
(REWRITE_TAC[GSYM CONJ_ASSOC] THEN
REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
`abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64
==> abs(x - y) < (x2 - x1) / &4
==> x1 < y /\ y < x2`)) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
`n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN
ASM_REWRITE_TAC[REAL_SUB_LT] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
MATCH_MP_TAC(REAL_ARITH
`a / y = x /\ abs(b / y) < z
==> abs(x - (a + b) / y) < z`) THEN
ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN
SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN
REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ;
REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ;
REAL_OF_NUM_EQ] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC;
ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN
UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x`
(fun th -> REWRITE_TAC[GSYM th] THEN
ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN
REWRITE_TAC[th] THEN ASSUME_TAC th) THEN
DISCH_TAC THEN
CONV_TAC(RAND_CONV SYM_CONV) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
`b(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
`c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN
ANTS_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
ASM_MESON_TAC[REAL_LE_TRANS];
REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN
REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
REWRITE_TAC[REAL_ARITH
`(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN
REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN
ASM_REWRITE_TAC[REAL_ARITH
`a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN
ASM_REWRITE_TAC[REAL_LT_LE]]];
ALL_TAC] THEN
SUBGOAL_THEN
`IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET
IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\
IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET
IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])`
MP_TAC THENL
[MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)`
closure_dyadic_rationals_in_convex_set_pos_1) THEN
MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))`
closure_dyadic_rationals_in_convex_set_pos_1) THEN
SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1`
STRIP_ASSUME_TAC THENL
[ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ;
REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES];
ALL_TAC] THEN
MATCH_MP_TAC(TAUT
`(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2)
==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN
ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
(MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC;
REAL_LE_REFL];
MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
ASM_MESON_TAC[REAL_LE_TRANS];
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
MATCH_MP_TAC(SET_RULE
`i SUBSET interval(vec 0,vec 1) /\
(!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x)
==> !x. x IN i INTER l ==> P x`) THEN
ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
REAL_LT_IMP_LE; REAL_LE_REFL] THEN
REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN
MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
STRIP_TAC THEN ASM_SIMP_TAC[] THEN
MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]);
DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
`IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t'
==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN
DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN
ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN
DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
`a IN IMAGE f s /\ a IN IMAGE f t
==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN
REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o
GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN
REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN
DISCH_THEN(MP_TAC o SPECL
[`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN
UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN
ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
ASM_MESON_TAC[REAL_LE_TRANS]]);;
let PATH_CONTAINS_ARC = prove
(`!p:real^1->real^N a b.
path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b)
==> ?q. arc q /\ path_image q SUBSET path_image p /\
pathstart q = a /\ pathfinish q = b`,
REWRITE_TAC[pathstart; pathfinish; path] THEN
MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN
STRIP_TAC THEN MP_TAC(ISPECL
[`\s. s
SUBSET interval[vec 0,vec 1] /\
vec 0
IN s /\ vec 1
IN s /\
(!x y. x
IN s /\ y
IN s /\ segment(x,y)
INTER s = {}
==> (f:real^1->real^N)(x) = f(y))`;
`interval[vec 0:real^1,vec 1]`]
BROUWER_REDUCTION_THEOREM_GEN) THEN
ASM_REWRITE_TAC[GSYM
path_image;
CLOSED_INTERVAL;
SUBSET_REFL] THEN
ANTS_TAC THENL
[CONJ_TAC THENL
[ALL_TAC;
REWRITE_TAC[
ENDS_IN_UNIT_INTERVAL] THEN
REPEAT GEN_TAC THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
`s
INTER i = {} ==> s
SUBSET i ==> s = {}`)) THEN
REWRITE_TAC[
SEGMENT_EQ_EMPTY] THEN
ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN
MATCH_MP_TAC(SET_RULE `s
SUBSET t ==> s
DIFF i
SUBSET t`) THEN
ASM_MESON_TAC[
CONVEX_CONTAINS_SEGMENT;
CONVEX_INTERVAL]] THEN
X_GEN_TAC `s:num->real^1->bool` THEN
REWRITE_TAC[
FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL
[REWRITE_TAC[
INTERS_GSPEC;
SUBSET;
IN_ELIM_THM;
IN_UNIV] THEN
ASM SET_TAC[];
ALL_TAC] THEN
REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
REWRITE_TAC[
FORALL_LIFT] THEN MATCH_MP_TAC
REAL_WLOG_LT THEN
REWRITE_TAC[] THEN CONJ_TAC THENL
[REWRITE_TAC[
SEGMENT_SYM] THEN MESON_TAC[];
REWRITE_TAC[
FORALL_DROP;
LIFT_DROP]] THEN
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
REWRITE_TAC[
INTERS_GSPEC;
IN_UNIV;
IN_ELIM_THM] THEN
SIMP_TAC[
SEGMENT_1;
REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN
MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
COMPACT_UNIFORMLY_CONTINUOUS)) THEN
REWRITE_TAC[
COMPACT_INTERVAL;
uniformly_continuous_on] THEN
DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN
ASM_REWRITE_TAC[
REAL_HALF;
NORM_POS_LT;
VECTOR_SUB_EQ] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN
`?u v. u
IN interval[vec 0,vec 1] /\ v
IN interval[vec 0,vec 1] /\
norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v`
STRIP_ASSUME_TAC THENL
[ALL_TAC;
FIRST_X_ASSUM(fun th ->
MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN
MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN
ASM_REWRITE_TAC[dist] THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN
CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN
SUBGOAL_THEN
`?w z. w
IN interval(x,y) /\ z
IN interval(x,y) /\ drop w < drop z /\
norm(w - x) < e /\ norm(z - y) < e`
STRIP_ASSUME_TAC THENL
[EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN
EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_ADD;
DROP_SUB;
LIFT_DROP;
NORM_REAL; GSYM drop] THEN
ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
MP_TAC(ISPECL [`interval[w:real^1,z]`;
`{s n :real^1->bool | n
IN (:num)}`]
COMPACT_IMP_FIP) THEN
ASM_REWRITE_TAC[
COMPACT_INTERVAL;
FORALL_IN_GSPEC] THEN
MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN
CONJ_TAC THENL
[REWRITE_TAC[
INTERS_GSPEC;
IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
MATCH_MP (SET_RULE
`s
INTER u = {} ==> t
SUBSET s ==> t
INTER u = {}`)) THEN
REWRITE_TAC[
SUBSET_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=>
(?x. P x /\ Q x /\ ~R x)`] THEN
ONCE_REWRITE_TAC[
SIMPLE_IMAGE] THEN
REWRITE_TAC[
EXISTS_FINITE_SUBSET_IMAGE] THEN
DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP
UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `n:num` THEN DISCH_TAC THEN
SUBGOAL_THEN
`interval[w,z]
INTER (s:num->real^1->bool) n = {}`
ASSUME_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`a
INTER t = {} ==> s
SUBSET t ==> a
INTER s = {}`)) THEN
REWRITE_TAC[
SUBSET;
INTERS_IMAGE;
IN_ELIM_THM] THEN
REWRITE_TAC[SET_RULE
`(!x. x
IN s n ==> !i. i
IN k ==> x
IN s i) <=>
(!i. i
IN k ==> s n
SUBSET s i)`] THEN
SUBGOAL_THEN
`!i n. i <= n ==> (s:num->real^1->bool) n
SUBSET s i`
(fun th -> ASM_MESON_TAC[th]) THEN
MATCH_MP_TAC
TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
SET_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN
`?u. u
IN (s:num->real^1->bool) n /\ u
IN interval[x,w] /\
(interval[u,w]
DELETE u)
INTER (s n) = {}`
MP_TAC THENL
[ASM_CASES_TAC `w
IN (s:num->real^1->bool) n` THENL
[EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[
ENDS_IN_INTERVAL] THEN
REWRITE_TAC[
INTERVAL_SING; SET_RULE `{a}
DELETE a = {}`] THEN
REWRITE_TAC[
INTER_EMPTY;
INTERVAL_NE_EMPTY_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
MP_TAC(ISPECL [`(s:num->real^1->bool) n
INTER interval[x,w]`;
`w:real^1`]
SEGMENT_TO_POINT_EXISTS) THEN
ASM_SIMP_TAC[
CLOSED_INTER;
CLOSED_INTERVAL] THEN ANTS_TAC THENL
[REWRITE_TAC[GSYM
MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN
ASM_REWRITE_TAC[
IN_INTER;
IN_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
REWRITE_TAC[
IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
`s
INTER t
INTER u = {} ==> s
SUBSET u ==> s
INTER t = {}`)) THEN
REWRITE_TAC[
SEGMENT_1] THEN COND_CASES_TAC THENL
[RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN
ASM_MESON_TAC[
DROP_EQ; REAL_LE_ANTISYM];
ANTS_TAC THENL
[REWRITE_TAC[
SUBSET_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[
OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]];
ALL_TAC] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN
SUBGOAL_THEN
`?v. v
IN (s:num->real^1->bool) n /\ v
IN interval[z,y] /\
(interval[z,v]
DELETE v)
INTER (s n) = {}`
MP_TAC THENL
[ASM_CASES_TAC `z
IN (s:num->real^1->bool) n` THENL
[EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[
ENDS_IN_INTERVAL] THEN
REWRITE_TAC[
INTERVAL_SING; SET_RULE `{a}
DELETE a = {}`] THEN
REWRITE_TAC[
INTER_EMPTY;
INTERVAL_NE_EMPTY_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
MP_TAC(ISPECL [`(s:num->real^1->bool) n
INTER interval[z,y]`;
`z:real^1`]
SEGMENT_TO_POINT_EXISTS) THEN
ASM_SIMP_TAC[
CLOSED_INTER;
CLOSED_INTERVAL] THEN ANTS_TAC THENL
[REWRITE_TAC[GSYM
MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN
ASM_REWRITE_TAC[
IN_INTER;
IN_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN
REWRITE_TAC[
IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
`s
INTER t
INTER u = {} ==> s
SUBSET u ==> s
INTER t = {}`)) THEN
REWRITE_TAC[
SEGMENT_1] THEN COND_CASES_TAC THENL
[ANTS_TAC THENL
[REWRITE_TAC[
SUBSET_INTERVAL_1] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[
OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]];
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN
ASM_MESON_TAC[
DROP_EQ; REAL_LE_ANTISYM]]];
ALL_TAC] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
REPEAT CONJ_TAC THENL
[ASM SET_TAC[];
ASM SET_TAC[];
RULE_ASSUM_TAC(REWRITE_RULE[
NORM_REAL; GSYM drop;
DROP_SUB]) THEN
REWRITE_TAC[
NORM_REAL; GSYM drop;
DROP_SUB] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
RULE_ASSUM_TAC(REWRITE_RULE[
NORM_REAL; GSYM drop;
DROP_SUB]) THEN
REWRITE_TAC[
NORM_REAL; GSYM drop;
DROP_SUB] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN
ASM_REWRITE_TAC[
SEGMENT_1] THEN COND_CASES_TAC THENL
[MAP_EVERY UNDISCH_TAC
[`interval[w,z]
INTER (s:num->real^1->bool) n = {}`;
`interval[u,w]
DELETE u
INTER (s:num->real^1->bool) n = {}`;
`interval[z,v]
DELETE v
INTER (s:num->real^1->bool) n = {}`] THEN
REWRITE_TAC[IMP_IMP; SET_RULE
`s1
INTER t = {} /\ s2
INTER t = {} <=>
(s1
UNION s2)
INTER t = {}`] THEN
MATCH_MP_TAC(SET_RULE
`t
SUBSET s ==> s
INTER u = {} ==> t
INTER u = {}`) THEN
REWRITE_TAC[
SUBSET;
IN_UNION;
IN_DELETE;
GSYM
DROP_EQ;
IN_INTERVAL_1] THEN
ASM_REAL_ARITH_TAC;
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]];
ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN
ASM_CASES_TAC `t:real^1->bool = {}` THENL
[ASM_MESON_TAC[
IN_IMAGE;
NOT_IN_EMPTY]; ALL_TAC] THEN
ABBREV_TAC
`h = \x. (f:real^1->real^N)(@y. y
IN t /\ segment(x,y)
INTER t = {})` THEN
SUBGOAL_THEN
`!x y. y
IN t /\ segment(x,y)
INTER t = {} ==> h(x) = (f:real^1->real^N)(y)`
ASSUME_TAC THENL
[SUBGOAL_THEN
`!x y z. y
IN t /\ segment(x,y)
INTER t = {} /\
z
IN t /\ segment(x,z)
INTER t = {}
==> (f:real^1->real^N)(y) = f(z)`
ASSUME_TAC THENL
[REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1)
IN t` THENL
[ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1)
IN t)`] THEN
ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=>
(a /\ c) ==> p /\ b /\ d ==> q`] THEN
STRIP_TAC THEN
REWRITE_TAC[SET_RULE `~(x
IN t) /\ s
INTER t = {} /\ s'
INTER t = {} <=>
(x
INSERT (s
UNION s'))
INTER t = {}`] THEN
DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
`s
SUBSET s' ==> s'
INTER t = {} ==> s
INTER t = {}`) THEN
REWRITE_TAC[
SEGMENT_1;
SUBSET;
IN_UNION;
IN_INSERT;
IN_INTERVAL_1] THEN
GEN_TAC THEN REWRITE_TAC[GSYM
DROP_EQ] THEN
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]];
ALL_TAC] THEN
SUBGOAL_THEN `!x. x
IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL
[REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[
SEGMENT_REFL;
INTER_EMPTY];
ALL_TAC] THEN
SUBGOAL_THEN `!x:real^1. ?y. y
IN t /\ segment(x,y)
INTER t = {}`
ASSUME_TAC THENL
[X_GEN_TAC `x:real^1` THEN
EXISTS_TAC `
closest_point t (x:real^1)` THEN
ASM_SIMP_TAC[
SEGMENT_TO_CLOSEST_POINT;
CLOSEST_POINT_EXISTS];
ALL_TAC] THEN
SUBGOAL_THEN
`!x y. segment(x,y)
INTER t = {} ==> (h:real^1->real^N) x = h y`
ASSUME_TAC THENL
[MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN
ASM_CASES_TAC `(x:real^1)
IN t` THENL
[ASM_MESON_TAC[
SEGMENT_SYM]; ALL_TAC] THEN
ASM_CASES_TAC `(x':real^1)
IN t` THENL
[ASM_MESON_TAC[]; ALL_TAC] THEN
SUBGOAL_THEN
`?y y'. y
IN t /\ segment(x,y)
INTER t = {} /\ h x = f y /\
y'
IN t /\ segment(x',y')
INTER t = {} /\
(h:real^1->real^N) x' = f y'`
STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC
[`~((x:real^1)
IN t)`; `~((x':real^1)
IN t)`;
`segment(x:real^1,y)
INTER t = {}`;
`segment(x':real^1,y')
INTER t = {}`;
`segment(x:real^1,x')
INTER t = {}`] THEN
MATCH_MP_TAC(SET_RULE
`s
SUBSET (x1
INSERT x2
INSERT (s0
UNION s1
UNION s2))
==> s0
INTER t = {} ==> s1
INTER t = {} ==> s2
INTER t = {}
==> ~(x1
IN t) ==> ~(x2
IN t) ==> s
INTER t = {}`) THEN
REWRITE_TAC[
SEGMENT_1;
SUBSET;
IN_UNION;
IN_INSERT;
IN_INTERVAL_1] THEN
GEN_TAC THEN REWRITE_TAC[GSYM
DROP_EQ] THEN
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
MP_TAC(ISPEC `h:real^1->real^N`
HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN
ANTS_TAC THENL
[REPEAT CONJ_TAC THENL
[REWRITE_TAC[
continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
continuous_on]) THEN
DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[
REAL_HALF] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
ASM_CASES_TAC `segment(u:real^1,v)
INTER t = {}` THENL
[ASM_MESON_TAC[
DIST_REFL]; ALL_TAC] THEN
SUBGOAL_THEN
`(?w:real^1. w
IN t /\ w
IN segment[u,v] /\ segment(u,w)
INTER t = {}) /\
(?z:real^1. z
IN t /\ z
IN segment[u,v] /\ segment(v,z)
INTER t = {})`
STRIP_ASSUME_TAC THENL
[CONJ_TAC THENL
[MP_TAC(ISPECL [`segment[u:real^1,v]
INTER t`; `u:real^1`]
SEGMENT_TO_POINT_EXISTS);
MP_TAC(ISPECL [`segment[u:real^1,v]
INTER t`; `v:real^1`]
SEGMENT_TO_POINT_EXISTS)] THEN
(ASM_SIMP_TAC[
CLOSED_INTER;
CLOSED_SEGMENT] THEN ANTS_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`~(segment(u,v)
INTER t = {})
==> segment(u,v)
SUBSET segment[u,v]
==> ~(segment[u,v]
INTER t = {})`)) THEN
REWRITE_TAC[
SEGMENT_OPEN_SUBSET_CLOSED];
ALL_TAC] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN
SIMP_TAC[
IN_INTER] THEN
MATCH_MP_TAC(SET_RULE
`(w
IN uv ==> uw
SUBSET uv)
==> (w
IN uv /\ w
IN t) /\ (uw
INTER uv
INTER t = {})
==> uw
INTER t = {}`) THEN
DISCH_TAC THEN REWRITE_TAC[
open_segment] THEN
MATCH_MP_TAC(SET_RULE `s
SUBSET t ==> s
DIFF u
SUBSET t`) THEN
REWRITE_TAC[
SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC
HULL_MINIMAL THEN
REWRITE_TAC[GSYM
SEGMENT_CONVEX_HULL;
CONVEX_SEGMENT] THEN
ASM_REWRITE_TAC[
INSERT_SUBSET;
EMPTY_SUBSET;
ENDS_IN_SEGMENT]);
SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\
(h:real^1->real^N) v = (f:real^1->real^N) z`
(fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
MATCH_MP_TAC(NORM_ARITH
`!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
==> dist(w,z) < e`) THEN
EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN
(CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`x
IN s ==> s
SUBSET t ==> x
IN t`)) THEN
REWRITE_TAC[
SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC
HULL_MINIMAL THEN
ASM_REWRITE_TAC[
CONVEX_INTERVAL;
INSERT_SUBSET;
EMPTY_SUBSET];
ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT;
REAL_LET_TRANS;
DIST_SYM]])];
X_GEN_TAC `z:real^N` THEN
REWRITE_TAC[
CONNECTED_IFF_CONNECTED_COMPONENT] THEN
MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
REWRITE_TAC[
IN_ELIM_THM] THEN STRIP_TAC THEN
REWRITE_TAC[
connected_component] THEN
EXISTS_TAC `segment[u:real^1,v]` THEN
REWRITE_TAC[
CONNECTED_SEGMENT;
ENDS_IN_SEGMENT] THEN
ASM_CASES_TAC `segment(u:real^1,v)
INTER t = {}` THENL
[REWRITE_TAC[SET_RULE `s
SUBSET {x | x
IN t /\ P x} <=>
s
SUBSET t /\ !x. x
IN s ==> P x`] THEN
CONJ_TAC THENL
[ASM_MESON_TAC[
CONVEX_CONTAINS_SEGMENT;
CONVEX_INTERVAL];
X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
SUBGOAL_THEN `segment(u:real^1,x)
INTER t = {}`
(fun th -> ASM_MESON_TAC[th]) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`uv
INTER t = {} ==> ux
SUBSET uv ==> ux
INTER t = {}`)) THEN
UNDISCH_TAC `(x:real^1)
IN segment[u,v]` THEN
REWRITE_TAC[
SEGMENT_1] THEN
REPEAT(COND_CASES_TAC THEN
ASM_REWRITE_TAC[
IN_INTERVAL_1;
SUBSET_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC];
ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o SPEC `t
DIFF segment(u:real^1,v)`) THEN
ASM_REWRITE_TAC[SET_RULE `t
DIFF s
PSUBSET t <=> ~(s
INTER t = {})`] THEN
MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
REPEAT CONJ_TAC THENL
[ASM SET_TAC[];
MATCH_MP_TAC
CLOSED_DIFF THEN ASM_REWRITE_TAC[
OPEN_SEGMENT_1];
ASM SET_TAC[];
ASM_REWRITE_TAC[
IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
[`(u:real^1)
IN interval[vec 0,vec 1]`;
`(v:real^1)
IN interval[vec 0,vec 1]`] THEN
REWRITE_TAC[
SEGMENT_1] THEN
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC[
IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
[`(u:real^1)
IN interval[vec 0,vec 1]`;
`(v:real^1)
IN interval[vec 0,vec 1]`] THEN
REWRITE_TAC[
SEGMENT_1] THEN
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[
IN_INTERVAL_1]) THEN
ASM_REAL_ARITH_TAC;
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
REWRITE_TAC[
IN_DIFF] THEN STRIP_TAC THEN
ASM_CASES_TAC `segment(x:real^1,y)
INTER segment(u,v) = {}` THENL
[ASM SET_TAC[]; ALL_TAC] THEN
SUBGOAL_THEN
`(segment(x:real^1,u)
SUBSET segment(x,y)
DIFF segment(u,v) /\
segment(y:real^1,v)
SUBSET segment(x,y)
DIFF segment(u,v)) \/
(segment(y:real^1,u)
SUBSET segment(x,y)
DIFF segment(u,v) /\
segment(x:real^1,v)
SUBSET segment(x,y)
DIFF segment(u,v))`
MP_TAC THENL
[MAP_EVERY UNDISCH_TAC
[`~(x
IN segment(u:real^1,v))`; `~(y
IN segment(u:real^1,v))`;
`~(segment(x:real^1,y)
INTER segment (u,v) = {})`] THEN
POP_ASSUM_LIST(K ALL_TAC) THEN
MAP_EVERY (fun t -> SPEC_TAC(t,t))
[`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN
REWRITE_TAC[
FORALL_LIFT] THEN
MATCH_MP_TAC
REAL_WLOG_LE THEN CONJ_TAC THENL
[REWRITE_TAC[
SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
REWRITE_TAC[
FORALL_DROP;
LIFT_DROP] THEN
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
REWRITE_TAC[
FORALL_LIFT] THEN
MATCH_MP_TAC
REAL_WLOG_LE THEN CONJ_TAC THENL
[REWRITE_TAC[
SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
REWRITE_TAC[
FORALL_DROP;
LIFT_DROP] THEN
MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
ASM_REWRITE_TAC[
SEGMENT_1] THEN
REWRITE_TAC[GSYM
MEMBER_NOT_EMPTY;
IN_INTER] THEN
REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
REWRITE_TAC[
IN_INTERVAL_1;
SUBSET;
IN_DIFF;
AND_FORALL_THM] THEN
ASM_REAL_ARITH_TAC;
DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN
(let sl = SET_RULE
`i
SUBSET xy
DIFF uv
==> xy
INTER (t
DIFF uv) = {} ==> i
INTER t = {}` in
fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN
ASM_MESON_TAC[]]];
ASM_MESON_TAC[]];
DISCH_TAC] THEN
SUBGOAL_THEN
`?q:real^1->real^N.
arc q /\
path_image q
SUBSET path_image f /\
a
IN path_image q /\ b
IN path_image q`
STRIP_ASSUME_TAC THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[
SWAP_EXISTS_THM] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
REWRITE_TAC[arc; path;
path_image] THEN
REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
[ASM MESON_TAC[];
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
path_image] THEN ASM SET_TAC[];
REWRITE_TAC[
IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
REWRITE_TAC[
ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
REWRITE_TAC[
IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN
REWRITE_TAC[
ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]];
SUBGOAL_THEN
`?u v. u
IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\
v
IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v`
STRIP_ASSUME_TAC THENL
[RULE_ASSUM_TAC(REWRITE_RULE[
path_image]) THEN ASM SET_TAC[];
ALL_TAC] THEN
EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL
[MATCH_MP_TAC
ARC_SIMPLE_PATH_SUBPATH THEN
ASM_MESON_TAC[
ARC_IMP_SIMPLE_PATH];
ASM_MESON_TAC[
SUBSET_TRANS;
PATH_IMAGE_SUBPATH_SUBSET;
ARC_IMP_PATH];
ASM_MESON_TAC[pathstart;
PATHSTART_SUBPATH];
ASM_MESON_TAC[pathfinish;
PATHFINISH_SUBPATH]]]);;
(* ------------------------------------------------------------------------- *)
(* Local versions of topological properties in general. *)
(* ------------------------------------------------------------------------- *)
let LOCALLY_MONO = prove
(`!P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s`,
REWRITE_TAC[locally] THEN MESON_TAC[]);;
let LOCALLY_OPEN_SUBSET = prove
(`!P s t:real^N->bool.
locally P s /\ open_in (subtopology euclidean s) t
==> locally P t`,
REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
ANTS_TAC THENL [ASM_MESON_TAC[
OPEN_IN_TRANS]; ALL_TAC] THEN
REPEAT(MATCH_MP_TAC
MONO_EXISTS THEN GEN_TAC) THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
OPEN_IN_SUBSET_TRANS THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[
open_in;
SUBSET]);;
let LOCALLY_INTER = prove
(`!P:(real^N->bool)->bool.
(!s t. P s /\ P t ==> P(s INTER t))
==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)`,
GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
REWRITE_TAC[locally;
OPEN_IN_OPEN] THEN
REWRITE_TAC[
LEFT_AND_EXISTS_THM; GSYM
CONJ_ASSOC; MESON[]
`(!w x. (?t. P t /\ w = f t) /\ Q w x ==> R w x) <=>
(!t x. P t /\ Q (f t) x ==> R (f t) x)`] THEN
ONCE_REWRITE_TAC[MESON[]
`(?a b c. P a b c /\ Q a b c /\ R a b c) <=>
(?b c a. Q a b c /\ P a b c /\ R a b c)`] THEN
REWRITE_TAC[
AND_FORALL_THM;
UNWIND_THM2;
IN_INTER] THEN
MATCH_MP_TAC
MONO_FORALL THEN X_GEN_TAC `w:real^N->bool` THEN
MATCH_MP_TAC
MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2
(X_CHOOSE_THEN `u1:real^N->bool` (X_CHOOSE_THEN `v1:real^N->bool`
STRIP_ASSUME_TAC))
(X_CHOOSE_THEN `u2:real^N->bool` (X_CHOOSE_THEN `v2:real^N->bool`
STRIP_ASSUME_TAC))) THEN
EXISTS_TAC `u1
INTER u2:real^N->bool` THEN
EXISTS_TAC `v1
INTER v2:real^N->bool` THEN
ASM_SIMP_TAC[
OPEN_INTER] THEN ASM SET_TAC[]);;
let HOMEOMORPHISM_LOCALLY = prove
(`!P Q f:real^N->real^M g.
(!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t))
==> (!s t. homeomorphism (s,t) (f,g)
==> (locally P s <=> locally Q t))`,
let lemma = prove
(`!P Q f g.
(!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t)
==> (!s:real^N->bool t:real^M->bool.
locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
REWRITE_TAC[locally] THEN STRIP_TAC THEN
FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `y:real^M`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`IMAGE (g:real^M->real^N) w`; `(g:real^M->real^N) y`]) THEN
ANTS_TAC THENL
[CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
SUBGOAL_THEN `IMAGE (g:real^M->real^N) w =
{x | x IN s /\ f(x) IN w}`
SUBST1_TAC THENL
[RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
STRIP_TAC THEN MAP_EVERY EXISTS_TAC
[`IMAGE (f:real^N->real^M) u`; `IMAGE (f:real^N->real^M) v`] THEN
CONJ_TAC THENL
[SUBGOAL_THEN `IMAGE (f:real^N->real^M) u =
{x | x IN t /\ g(x) IN u}`
SUBST1_TAC THENL
[RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
ALL_TAC] THEN
CONJ_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N->bool` THEN
ASM_REWRITE_TAC[homeomorphism] THEN
REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN
TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)));
ALL_TAC] THEN
RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]) in
REPEAT STRIP_TAC THEN EQ_TAC THEN
MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM;
TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN
ASM_MESON_TAC[HOMEOMORPHISM_SYM]);;
let HOMEOMORPHIC_LOCALLY = prove
(`!P Q. (!s:real^N->bool t:real^M->bool. s homeomorphic t ==> (P s <=> Q t))
==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))`,
REPEAT GEN_TAC THEN STRIP_TAC THEN
REWRITE_TAC[homeomorphic;
LEFT_IMP_EXISTS_THM] THEN
ONCE_REWRITE_TAC[MESON[]
`(!a b c d. P a b c d) <=> (!c d a b. P a b c d)`] THEN
GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC
HOMEOMORPHISM_LOCALLY THEN
ASM_MESON_TAC[homeomorphic]);;
let LOCALLY_INJECTIVE_LINEAR_IMAGE = prove
(`!P:(real^N->bool)->bool Q:(real^M->bool)->bool.
(!f s. linear f /\ (!x y. f x = f y ==> x = y)
==> (P (IMAGE f s) <=> Q s))
==> (!f s. linear f /\ (!x y. f x = f y ==> x = y)
==> (locally P (IMAGE f s) <=> locally Q s))`,
let LOCALLY_OPEN_MAP_IMAGE = prove
(`!P Q f:real^M->real^N s.
f continuous_on s /\
(!t. open_in (subtopology euclidean s) t
==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\
(!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\
locally P s
==> locally Q (IMAGE f s)`,
REPEAT GEN_TAC THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
REWRITE_TAC[locally] THEN DISCH_TAC THEN
MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN
STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [
open_in]) THEN
FIRST_ASSUM(MP_TAC o SPEC `w:real^N->bool` o
GEN_REWRITE_RULE I [
CONTINUOUS_ON_OPEN]) THEN
ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
SUBGOAL_THEN `?x. x
IN s /\ (f:real^M->real^N) x = y` STRIP_ASSUME_TAC THENL
[ASM SET_TAC[]; ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`{x | x
IN s /\ (f:real^M->real^N) x
IN w}`; `x:real^M`]) THEN
ASM_REWRITE_TAC[
IN_ELIM_THM;
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
STRIP_TAC THEN MAP_EVERY EXISTS_TAC
[`
IMAGE (f:real^M->real^N) u`; `
IMAGE (f:real^M->real^N) v`] THEN
ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);;
(* ------------------------------------------------------------------------- *)
(* Important special cases of local connectedness & path connectedness. *)
(* ------------------------------------------------------------------------- *)
let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT =
(CONJ_PAIR o prove)
(`(!s:real^N->bool.
locally connected s <=>
!v x. open_in (subtopology euclidean s) v /\ x IN v
==> ?u. open_in (subtopology euclidean s) u /\
connected u /\
x IN u /\ u SUBSET v) /\
(!s:real^N->bool.
locally connected s <=>
!t x. open_in (subtopology euclidean s) t /\ x IN t
==> open_in (subtopology euclidean s)
(connected_component t x))`,
REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
MATCH_MP_TAC(TAUT
`(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
REPEAT CONJ_TAC THENL
[MESON_TAC[SUBSET_REFL];
DISCH_TAC THEN
MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
STRIP_ASSUME_TAC)) THEN
EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
DISCH_TAC THEN
MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
EXISTS_TAC `connected_component u (x:real^N)` THEN
REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);;
let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT =
(CONJ_PAIR o prove)
(`(!s:real^N->bool.
locally path_connected s <=>
!v x. open_in (subtopology euclidean s) v /\ x IN v
==> ?u. open_in (subtopology euclidean s) u /\
path_connected u /\
x IN u /\ u SUBSET v) /\
(!s:real^N->bool.
locally path_connected s <=>
!t x. open_in (subtopology euclidean s) t /\ x IN t
==> open_in (subtopology euclidean s)
(path_component t x))`,
REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
MATCH_MP_TAC(TAUT
`(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
REPEAT CONJ_TAC THENL
[MESON_TAC[SUBSET_REFL];
DISCH_TAC THEN
MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
STRIP_ASSUME_TAC)) THEN
EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
DISCH_TAC THEN
MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
EXISTS_TAC `path_component u (x:real^N)` THEN
REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);;
let LOCALLY_CONNECTED_IM_KLEINEN = prove
(`!s:real^N->bool.
locally connected s <=>
!v x. open_in (subtopology euclidean s) v /\ x IN v
==> ?u. open_in (subtopology euclidean s) u /\
x IN u /\ u SUBSET v /\
!y. y IN u
==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`,
GEN_TAC THEN EQ_TAC THENL
[REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[
SUBSET_REFL]; DISCH_TAC] THEN
REWRITE_TAC[
LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN
ONCE_REWRITE_TAC[
OPEN_IN_SUBOPEN] THEN
X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
ANTS_TAC THENL [ASM_MESON_TAC[
IN_COMPONENTS_SUBSET;
SUBSET]; ALL_TAC] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
REWRITE_TAC[
SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN `(k:real^N->bool)
SUBSET c` MP_TAC THENL
[ALL_TAC; ASM SET_TAC[]] THEN
MATCH_MP_TAC
COMPONENTS_MAXIMAL THEN
EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);;
add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];;
add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];;
add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];;
add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];;
let LOCALLY_PCROSS = prove
(`!P Q R.
(!s:real^M->bool t:real^N->bool. P s /\ Q t ==> R(s PCROSS t))
==> (!s t. locally P s /\ locally Q t ==> locally R (s PCROSS t))`,
REPEAT STRIP_TAC THEN REWRITE_TAC[locally;
FORALL_PASTECART] THEN
MAP_EVERY X_GEN_TAC
[`w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] THEN
DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN
MP_TAC(MATCH_MP
PASTECART_IN_INTERIOR_SUBTOPOLOGY
(ONCE_REWRITE_RULE[
CONJ_SYM] th))) THEN
REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`] o
GEN_REWRITE_RULE I [locally]) THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `y:real^N`] o
GEN_REWRITE_RULE I [locally]) THEN
ASM_REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `v'':real^N->bool`] THEN
STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`u':real^M->bool`; `u'':real^M->bool`] THEN
STRIP_TAC THEN
EXISTS_TAC `(u':real^M->bool)
PCROSS (v':real^N->bool)` THEN
EXISTS_TAC `(u'':real^M->bool)
PCROSS (v'':real^N->bool)` THEN
ASM_SIMP_TAC[
PASTECART_IN_PCROSS;
PCROSS_MONO;
OPEN_IN_PCROSS] THEN
ASM_MESON_TAC[
PCROSS_MONO;
SUBSET_TRANS]);;
(* ------------------------------------------------------------------------- *)
(* Locally convex sets. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Basic properties of local compactness. *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];;
add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];;
let LOCALLY_COMPACT_CLOSED_UNION = prove
(`!s t:real^N->bool.
locally compact s /\ locally compact t /\
closed_in (subtopology euclidean (s UNION t)) s /\
closed_in (subtopology euclidean (s UNION t)) t
==> locally compact (s UNION t)`,
REPEAT GEN_TAC THEN REWRITE_TAC[
LOCALLY_COMPACT_INTER_CBALL;
IN_UNION] THEN
INTRO_TAC "lcs lct cs ct" THEN X_GEN_TAC `x:real^N` THEN
DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (TAUT
`p \/ q ==> p /\ q \/ p /\ ~q \/ q /\ ~p`))
THENL
[REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN
REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN
ASM_REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `d:real` THEN STRIP_TAC THEN
X_GEN_TAC `e:real` THEN STRIP_TAC THEN
EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[
REAL_LT_MIN] THEN
SIMP_TAC[SET_RULE `u
INTER (s
UNION t) = u
INTER s
UNION u
INTER t`] THEN
MATCH_MP_TAC
CLOSED_UNION THEN REWRITE_TAC[
CBALL_MIN_INTER] THEN
ASM_MESON_TAC[
CLOSED_CBALL;
CLOSED_INTER;
INTER_ACI];
REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
REMOVE_THEN "ct" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [
closed_in]);
REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
REMOVE_THEN "cs" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [
closed_in])] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
OPEN_IN_CONTAINS_CBALL]) THEN
REWRITE_TAC[
TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
IN_DIFF;
IN_UNION] THEN
DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[
REAL_LT_MIN] THENL
[SUBGOAL_THEN `cball (x:real^N,min d e)
INTER (s
UNION t) =
cball(x,d)
INTER cball (x,e)
INTER s` SUBST1_TAC
THENL [REWRITE_TAC[
CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC];
SUBGOAL_THEN `cball (x:real^N,min d e)
INTER (s
UNION t) =
cball(x,d)
INTER cball (x,e)
INTER t` SUBST1_TAC
THENL [REWRITE_TAC[
CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]] THEN
ASM_MESON_TAC[
CLOSED_INTER;
CLOSED_CBALL]);;
(* ------------------------------------------------------------------------- *)
(* Locally compact sets are closed in an open set and are homeomorphic *)
(* to an absolutely closed set if we have one more dimension to play with. *)
(* ------------------------------------------------------------------------- *)
let LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED = prove
(`!s:real^M->bool.
locally compact s
==> ?t:real^(M,N)finite_sum->bool f.
closed t /\ homeomorphism (s,t) (f,fstcart)`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `closed(s:real^M->bool)` THENL
[EXISTS_TAC `(s:real^M->bool)
PCROSS {vec 0:real^N}` THEN
EXISTS_TAC `\x. (pastecart x (vec 0):real^(M,N)finite_sum)` THEN
ASM_SIMP_TAC[
CLOSED_PCROSS;
CLOSED_SING;
HOMEOMORPHISM] THEN
SIMP_TAC[
CONTINUOUS_ON_PASTECART;
CONTINUOUS_ON_CONST;
CONTINUOUS_ON_ID;
LINEAR_FSTCART;
LINEAR_CONTINUOUS_ON;
SUBSET;
FORALL_IN_IMAGE] THEN
REWRITE_TAC[
FORALL_IN_PCROSS;
PASTECART_IN_PCROSS;
IN_SING] THEN
SIMP_TAC[
FSTCART_PASTECART];
ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP
LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
DISJ_CASES_TAC(SET_RULE `t = (:real^M) \/ ~((:real^M)
DIFF t = {})`) THENL
[ASM_MESON_TAC[
CLOSURE_EQ;
INTER_UNIV]; ALL_TAC] THEN
ABBREV_TAC
`f:real^M->real^(M,N)finite_sum =
\x. pastecart x (inv(setdist({x},(:real^M)
DIFF t)) % vec 1)` THEN
SUBGOAL_THEN
`homeomorphism (t,
IMAGE (f:real^M->real^(M,N)finite_sum) t) (f,fstcart)`
ASSUME_TAC THENL
[SIMP_TAC[
HOMEOMORPHISM;
SUBSET_REFL;
LINEAR_CONTINUOUS_ON;
LINEAR_FSTCART;
FORALL_IN_IMAGE] THEN
MATCH_MP_TAC(TAUT `(r ==> q /\ s) /\ r /\ p ==> p /\ q /\ r /\ s`) THEN
CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "f"] THEN
SIMP_TAC[
FSTCART_PASTECART] THEN MATCH_MP_TAC
CONTINUOUS_ON_PASTECART THEN
REWRITE_TAC[
CONTINUOUS_ON_ID] THEN MATCH_MP_TAC
CONTINUOUS_ON_MUL THEN
REWRITE_TAC[
o_DEF;
CONTINUOUS_ON_CONST] THEN
MATCH_MP_TAC(REWRITE_RULE[
o_DEF]
CONTINUOUS_ON_INV) THEN
REWRITE_TAC[
SETDIST_EQ_0_SING;
CONTINUOUS_ON_LIFT_SETDIST] THEN
ASM_SIMP_TAC[
CLOSURE_COMPLEMENT;
IN_DIFF;
IN_UNIV;
INTERIOR_OPEN];
ALL_TAC] THEN
EXISTS_TAC `
IMAGE (f:real^M->real^(M,N)finite_sum) s` THEN
EXISTS_TAC `f:real^M->real^(M,N)finite_sum` THEN CONJ_TAC THENL
[MATCH_MP_TAC
CLOSED_IN_CLOSED_TRANS THEN
EXISTS_TAC `
IMAGE (f:real^M->real^(M,N)finite_sum) t` THEN CONJ_TAC THENL
[MATCH_MP_TAC
HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC
[`fstcart:real^(M,N)finite_sum->real^M`; `t:real^M->bool`] THEN
ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN
SIMP_TAC[
CLOSED_IN_CLOSED_INTER;
CLOSED_CLOSURE];
SUBGOAL_THEN
`
IMAGE (f:real^M->real^(M,N)finite_sum) t =
{z | (setdist({fstcart z},(:real^M)
DIFF t) % sndcart z)
IN {vec 1}}`
SUBST1_TAC THENL
[EXPAND_TAC "f" THEN
REWRITE_TAC[
EXTENSION;
FORALL_PASTECART;
IN_ELIM_THM;
PASTECART_INJ;
FSTCART_PASTECART;
SNDCART_PASTECART;
IN_IMAGE;
IN_INTER;
GSYM
CONJ_ASSOC;
UNWIND_THM1;
IN_SING] THEN
REWRITE_TAC[
CART_EQ;
VECTOR_MUL_COMPONENT;
VEC_COMPONENT] THEN
MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN
MP_TAC(ISPECL [`(:real^M)
DIFF t`; `x:real^M`]
(CONJUNCT1
SETDIST_EQ_0_SING)) THEN
ASM_SIMP_TAC[
CLOSURE_COMPLEMENT;
IN_DIFF;
IN_UNIV;
INTERIOR_OPEN] THEN
ASM_CASES_TAC `(x:real^M)
IN t` THEN ASM_SIMP_TAC[REAL_FIELD
`~(x = &0) ==> (y = inv x * &1 <=> x * y = &1)`] THEN
DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN
REWRITE_TAC[
LE_REFL;
DIMINDEX_GE_1] THEN REAL_ARITH_TAC;
MATCH_MP_TAC
CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
REWRITE_TAC[
CLOSED_SING] THEN X_GEN_TAC `z:real^(M,N)finite_sum` THEN
MATCH_MP_TAC
CONTINUOUS_MUL THEN
SIMP_TAC[
LINEAR_CONTINUOUS_AT;
LINEAR_SNDCART;
o_DEF] THEN
SUBGOAL_THEN
`(\z:real^(M,N)finite_sum.
lift(setdist({fstcart z},(:real^M)
DIFF t))) =
(\x. lift (setdist ({x},(:real^M)
DIFF t))) o fstcart`
SUBST1_TAC THENL [REWRITE_TAC[
o_DEF]; ALL_TAC] THEN
MATCH_MP_TAC
CONTINUOUS_AT_COMPOSE THEN
SIMP_TAC[
LINEAR_CONTINUOUS_AT;
LINEAR_FSTCART] THEN
REWRITE_TAC[
CONTINUOUS_AT_LIFT_SETDIST]]];
MATCH_MP_TAC
HOMEOMORPHISM_OF_SUBSETS THEN MAP_EVERY EXISTS_TAC
[`t:real^M->bool`; `
IMAGE (f:real^M->real^(M,N)finite_sum) t`] THEN
ASM SET_TAC[]]);;
(* ------------------------------------------------------------------------- *)
(* Sura-Bura's results about compact components of sets. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Relations between components and path components. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* If two points are separated by a closed set, there's a minimal one. *)
(* ------------------------------------------------------------------------- *)
SUBGOAL_THEN `frontier(r:real^N->bool) INTER r = {}`
(fun th -> ASM SET_TAC[th]) THEN
REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "r"] THEN
MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN
ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]]]);;
(* ------------------------------------------------------------------------- *)
(* Lower bound on norms within segment between vectors. *)
(* Could have used these for connectedness results below, in fact. *)
(* ------------------------------------------------------------------------- *)
let NORM_SEGMENT_LOWERBOUND = prove
(`!a b x:real^N r d.
&0 < r /\
norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\
a dot b = d * r pow 2
==> sqrt((&1 - abs d) / &2) * r <= norm(x)`,
(* ------------------------------------------------------------------------- *)
(* Special case of orthogonality (could replace 2 by sqrt(2)). *)
(* ------------------------------------------------------------------------- *)
let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove
(`!a b:real^N x r.
r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b]
==> r / &2 <= norm(x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM
real_ge] THEN
REWRITE_TAC[
NORM_GE_SQUARE] THEN REWRITE_TAC[
real_ge] THEN
ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL
[ASM_REAL_ARITH_TAC; ALL_TAC] THEN
REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
IN_SEGMENT]) THEN
DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
ASM_REWRITE_TAC[
DOT_LMUL;
DOT_RMUL;
REAL_MUL_RZERO; VECTOR_ARITH
`(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
MATCH_MP_TAC
REAL_LE_TRANS THEN
EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN
CONJ_TAC THENL
[REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN
REWRITE_TAC[GSYM
REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
MATCH_MP_TAC
REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2;
REAL_LE_SQUARE] THEN
MATCH_MP_TAC(REAL_ARITH
`&0 <= (u - &1 / &2) * (u - &1 / &2)
==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN
REWRITE_TAC[
REAL_LE_SQUARE];
REWRITE_TAC[
REAL_ADD_RID] THEN MATCH_MP_TAC
REAL_LE_ADD2 THEN
CONJ_TAC THEN
REPEAT(MATCH_MP_TAC
REAL_LE_LMUL THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
ASM_REWRITE_TAC[]]);;
(* ------------------------------------------------------------------------- *)
(* Accessibility of frontier points. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Some simple positive connection theorems. *)
(* ------------------------------------------------------------------------- *)
let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove
(`!u s:real^N->bool.
convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`,
REPEAT STRIP_TAC THEN
REWRITE_TAC[
path_connected;
IN_DIFF;
IN_UNIV] THEN
MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
ASM_CASES_TAC `a:real^N = b` THENL
[EXISTS_TAC `linepath(a:real^N,b)` THEN
REWRITE_TAC[
PATHSTART_LINEPATH;
PATHFINISH_LINEPATH;
PATH_LINEPATH] THEN
ASM_REWRITE_TAC[
PATH_IMAGE_LINEPATH;
SEGMENT_REFL] THEN ASM SET_TAC[];
ALL_TAC] THEN
ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL
[ASM_MESON_TAC[
MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN
POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN
GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN
GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN
DISCH_TAC THEN SIMP_TAC[
NORM_MUL;
NORM_BASIS;
DIMINDEX_GE_1;
LE_REFL] THEN
ASM_REWRITE_TAC[
real_abs;
REAL_MUL_RID] THEN
DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN
REPEAT GEN_TAC THEN REWRITE_TAC[midpoint;
VECTOR_MUL_LID] THEN
REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN
POP_ASSUM(K ALL_TAC) THEN
REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(K ALL_TAC) THEN
SUBGOAL_THEN `segment[--basis 1:real^N,basis 1]
SUBSET u` ASSUME_TAC THENL
[REWRITE_TAC[
SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC
HULL_MINIMAL THEN
ASM SET_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN `(vec 0:real^N)
IN u` ASSUME_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [
SUBSET]) THEN
REWRITE_TAC[
IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC;
ALL_TAC] THEN
SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\
c
IN u /\ ~(c$k = &0)`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[GSYM
NOT_FORALL_THM; TAUT
`a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN
DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN
REWRITE_TAC[
COLLINEAR_AFFINE_HULL] THEN
MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN
SIMP_TAC[
AFFINE_HULL_EQ_SPAN;
HULL_INC;
IN_INSERT;
SPAN_INSERT_0] THEN
REWRITE_TAC[
SPAN_SING;
SUBSET;
IN_ELIM_THM;
IN_UNIV] THEN
X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN
SIMP_TAC[
CART_EQ;
VECTOR_MUL_COMPONENT;
BASIS_COMPONENT] THEN
REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
ASM_REWRITE_TAC[
REAL_MUL_RID;
REAL_MUL_RZERO] THEN
ASM_MESON_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL
[ASM_SIMP_TAC[
CART_EQ;
VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
SUBGOAL_THEN `segment[vec 0:real^N,c]
SUBSET u` ASSUME_TAC THENL
[REWRITE_TAC[
SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC
HULL_MINIMAL THEN
ASM SET_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN
`?z:real^N. z
IN segment[vec 0,c] /\
(segment[--basis 1,z]
UNION segment[z,basis 1])
INTER s = {}`
STRIP_ASSUME_TAC THENL
[ALL_TAC;
EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN
ASM_SIMP_TAC[
PATH_JOIN;
PATHSTART_JOIN;
PATHFINISH_JOIN;
PATH_LINEPATH;
PATHSTART_LINEPATH;
PATHFINISH_LINEPATH;
PATH_IMAGE_JOIN] THEN
REWRITE_TAC[
PATH_IMAGE_LINEPATH] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`(t
UNION v)
INTER s = {}
==> t
SUBSET u /\ v
SUBSET u
==> (t
UNION v)
SUBSET u
DIFF s`)) THEN
REWRITE_TAC[
SEGMENT_CONVEX_HULL] THEN
CONJ_TAC THEN MATCH_MP_TAC
HULL_MINIMAL THEN ASM SET_TAC[]] THEN
MATCH_MP_TAC(SET_RULE
`~(s
SUBSET {z | z
IN s /\ ~P z}) ==> ?z. z
IN s /\ P z`) THEN
DISCH_THEN(MP_TAC o MATCH_MP
CARD_LE_SUBSET) THEN
REWRITE_TAC[
CARD_NOT_LE; SET_RULE
`~((b
UNION c)
INTER s = {}) <=>
~(b
INTER s = {}) \/ ~(c
INTER s = {})`] THEN
REWRITE_TAC[SET_RULE
`{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x}
UNION {x | P x /\ R x}`] THEN
W(MP_TAC o PART_MATCH lhand
UNION_LE_ADD_C o lhand o snd) THEN
MATCH_MP_TAC(ONCE_REWRITE_RULE[
IMP_CONJ_ALT]
CARD_LET_TRANS) THEN
TRANS_TAC
CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL
[MATCH_MP_TAC
CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[
real_INFINITE];
MATCH_MP_TAC
CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[
CARD_EQ_SYM] THEN
ASM_SIMP_TAC[
CARD_EQ_SEGMENT]] THEN
REWRITE_TAC[MESON[
SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN
SUBGOAL_THEN
`!b:real^N.
b
IN u /\ ~(b
IN s) /\ ~(b = vec 0) /\ b$k = &0
==> {z | z
IN segment[vec 0,c] /\ ~(segment[z,b]
INTER s = {})} <_c
(:real)`
(fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN
REWRITE_TAC[
VECTOR_NEG_EQ_0;
VECTOR_NEG_COMPONENT] THEN
ASM_SIMP_TAC[
BASIS_NONZERO;
DIMINDEX_GE_1;
LE_REFL;
BASIS_COMPONENT] THEN
REWRITE_TAC[
REAL_NEG_0]) THEN
REPEAT STRIP_TAC THEN TRANS_TAC
CARD_LET_TRANS `s:real^N->bool` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[GSYM
MEMBER_NOT_EMPTY;
IN_INTER;
RIGHT_AND_EXISTS_THM] THEN
ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN
MATCH_MP_TAC
CARD_LE_RELATIONAL THEN
MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN
REWRITE_TAC[
SEGMENT_SYM] THEN STRIP_TAC THEN
ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN
MP_TAC(ISPECL
[`x1:real^N`; `b:real^N`; `x2:real^N`]
INTER_SEGMENT) THEN
REWRITE_TAC[NOT_IMP;
SEGMENT_SYM] THEN
CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[
SEGMENT_SYM] THEN ASM SET_TAC[]] THEN
ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN
ASM_SIMP_TAC[
COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN
SUBGOAL_THEN `(b:real^N)
IN affine hull {vec 0,c}` MP_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`b
IN s ==> s
SUBSET t ==> b
IN t`)) THEN
MATCH_MP_TAC
HULL_MINIMAL THEN REWRITE_TAC[
AFFINE_AFFINE_HULL] THEN
MATCH_MP_TAC
SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN
CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[
SEGMENT_SYM]] THEN
REWRITE_TAC[
SEGMENT_CONVEX_HULL;
CONVEX_HULL_SUBSET_AFFINE_HULL];
REWRITE_TAC[
AFFINE_HULL_2_ALT;
IN_ELIM_THM;
IN_UNIV] THEN
REWRITE_TAC[
VECTOR_ADD_LID;
VECTOR_SUB_RZERO;
NOT_EXISTS_THM] THEN
X_GEN_TAC `r:real` THEN
ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[
VECTOR_MUL_LZERO] THEN
CONV_TAC(RAND_CONV SYM_CONV) THEN
DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN
ASM_SIMP_TAC[
VECTOR_MUL_COMPONENT;
REAL_ENTIRE]]);;
let CONNECTED_SPHERE_EQ = prove
(`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
let lemma = prove
(`!a:real^1 r. &0 < r
==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`,
MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN
REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
`~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN
REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN
REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in
REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN
ASM_CASES_TAC `r = &0` THEN
ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN
SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL
[ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN
DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN
ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN
DISCH_TAC THEN FIRST_ASSUM (fun th ->
REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN
REWRITE_TAC[SET_RULE
`~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN
REWRITE_TAC[IN_SPHERE] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN
ASM_REWRITE_TAC[]);;
let FINITE_SPHERE = prove
(`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`,
REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN
ASM_REWRITE_TAC[] THENL
[RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN
FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP
(GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
FINITE_SPHERE_1));
ASM_SIMP_TAC[
CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`;
DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN
REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=>
(!a b. a
IN s /\ b
IN s ==> a = b)`] THEN
SIMP_TAC[
IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
REWRITE_TAC[
REAL_NOT_LE] THEN DISCH_TAC THEN
MP_TAC(ISPECL [`a:real^N`; `r:real`]
VECTOR_CHOOSE_DIST) THEN
ASM_SIMP_TAC[
REAL_LT_IMP_LE;
LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN
FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN
REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);;
let PATH_CONNECTED_ANNULUS = prove
(`(!a:real^N r1 r2.
2 <= dimindex(:N)
==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
(!a:real^N r1 r2.
2 <= dimindex(:N)
==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
(!a:real^N r1 r2.
2 <= dimindex(:N)
==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
(!a:real^N r1 r2.
2 <= dimindex(:N)
==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
let CONNECTED_ANNULUS = prove
(`(!a:real^N r1 r2.
2 <= dimindex(:N)
==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
(!a:real^N r1 r2.
2 <= dimindex(:N)
==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
(!a:real^N r1 r2.
2 <= dimindex(:N)
==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
(!a:real^N r1 r2.
2 <= dimindex(:N)
==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
"D"] THEN
REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN
ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
ASM_REAL_ARITH_TAC]);;
let CONNECTED_OPEN_DIFF_CBALL = prove
(`!s a:real^N r.
2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s
==> connected(s DIFF cball(a,r))`,
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[
DIFF_EMPTY] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
CBALL_EQ_EMPTY;
REAL_NOT_LT]) THEN
SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r')
SUBSET s`
STRIP_ASSUME_TAC THENL
[ASM_CASES_TAC `s = (:real^N)` THENL
[EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[
SUBSET_UNIV] THEN REAL_ARITH_TAC;
ALL_TAC] THEN
MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N)
DIFF s`]
SETDIST_POS_LE) THEN
REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN
ASM_SIMP_TAC[
SETDIST_EQ_0_COMPACT_CLOSED; GSYM
OPEN_CLOSED;
COMPACT_CBALL;
CBALL_EQ_EMPTY] THEN
ASM_REWRITE_TAC[SET_RULE `
UNIV DIFF s = {} <=> s =
UNIV`] THEN
ASM_SIMP_TAC[SET_RULE `b
INTER (
UNIV DIFF s) = {} <=> b
SUBSET s`;
REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN
STRIP_TAC THEN
EXISTS_TAC `r + setdist(cball(a,r),(:real^N)
DIFF s) / &2` THEN
ASM_REWRITE_TAC[
REAL_LT_ADDR;
REAL_HALF;
SUBSET;
IN_CBALL] THEN
X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL
[ASM_MESON_TAC[
SUBSET;
DIST_REFL;
IN_CBALL]; ALL_TAC] THEN
ASM_CASES_TAC `(x:real^N)
IN s` THEN ASM_REWRITE_TAC[
REAL_NOT_LE] THEN
MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N)
DIFF s`;
`a + r / dist(a,x) % (x - a):real^N`; `x:real^N`]
SETDIST_LE_DIST) THEN
ASM_REWRITE_TAC[
IN_DIFF;
IN_UNIV;
IN_CBALL] THEN
REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
ASM_SIMP_TAC[
NORM_MUL;
REAL_ABS_DIV; ONCE_REWRITE_RULE[
DIST_SYM] dist;
REAL_ABS_NORM;
REAL_DIV_RMUL;
NORM_EQ_0;
VECTOR_SUB_EQ] THEN
ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN
REWRITE_TAC[
NORM_MUL; VECTOR_ARITH
`x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN
ONCE_REWRITE_TAC[GSYM
REAL_ABS_NORM] THEN
REWRITE_TAC[GSYM
REAL_ABS_MUL] THEN
REWRITE_TAC[
REAL_ABS_NORM;
REAL_SUB_RDISTRIB] THEN
ASM_SIMP_TAC[
REAL_DIV_RMUL;
NORM_EQ_0;
VECTOR_SUB_EQ] THEN
FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[
SUBSET]) THEN
ASM_REWRITE_TAC[
IN_CBALL; ONCE_REWRITE_RULE[
DIST_SYM] dist] THEN
REAL_ARITH_TAC;
SUBGOAL_THEN `s
DIFF cball(a:real^N,r) =
s
DIFF ball(a,r')
UNION
{x | r < norm(x - a) /\ norm(x - a) <= r'}`
SUBST1_TAC THENL
[REWRITE_TAC[ONCE_REWRITE_RULE[
DIST_SYM] (GSYM dist)] THEN
REWRITE_TAC[GSYM
REAL_NOT_LE; GSYM
IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
`b'
SUBSET c' /\ c'
SUBSET s /\ c
SUBSET b'
==> s
DIFF c = (s
DIFF b')
UNION {x | ~(x
IN c) /\ x
IN c'}`) THEN
ASM_REWRITE_TAC[
BALL_SUBSET_CBALL] THEN
REWRITE_TAC[
SUBSET;
IN_BALL;
IN_CBALL] THEN ASM_REAL_ARITH_TAC;
MATCH_MP_TAC
CONNECTED_UNION THEN
ASM_SIMP_TAC[
CONNECTED_ANNULUS;
PATH_CONNECTED_DIFF_BALL;
PATH_CONNECTED_IMP_CONNECTED;
CONNECTED_OPEN_PATH_CONNECTED] THEN
REWRITE_TAC[ONCE_REWRITE_RULE[
DIST_SYM] (GSYM dist)] THEN
REWRITE_TAC[GSYM
REAL_NOT_LE; GSYM
IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
`c'
SUBSET s /\ (?x. x
IN c' /\ ~(x
IN b') /\ ~(x
IN c))
==> ~((s
DIFF b')
INTER {x | ~(x
IN c) /\ x
IN c'} = {})`) THEN
ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN
REWRITE_TAC[
IN_BALL;
IN_CBALL] THEN
REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
SIMP_TAC[
NORM_MUL;
NORM_BASIS;
DIMINDEX_GE_1;
LE_REFL] THEN
ASM_REAL_ARITH_TAC]]);;
(* ------------------------------------------------------------------------- *)
(* Existence of unbounded components. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Self-homeomorphisms shuffling points about in various ways. *)
(* ------------------------------------------------------------------------- *)
let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove
(`!s t a b:real^N.
open_in (subtopology euclidean (affine hull s)) s /\
s SUBSET t /\ t SUBSET affine hull s /\
connected s /\ a IN s /\ b IN s
==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\
{x | ~(f x = x /\ g x = x)} SUBSET s /\
bounded {x | ~(f x = x /\ g x = x)}`,
let lemma1 = prove
(`!a t r u:real^N.
affine t /\ a IN t /\ u IN ball(a,r) INTER t
==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
(f,g) /\
f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`,
REPEAT STRIP_TAC THEN
DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
[ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN
EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN
REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
[MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE];
ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist;
REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN
REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN
REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN
CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN
SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN
MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB];
ALL_TAC] THEN
CONJ_TAC THENL
[MATCH_MP_TAC(SET_RULE
`(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y)
==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[VECTOR_ARITH
`(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`];
ALL_TAC] THEN
REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN
REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN
REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID;
VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=>
(n - m) % u:real^N = x - y`] THEN
REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL
[ALL_TAC;
REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN
ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN
ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN
ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO;
VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN
STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN
ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
`r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN
REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN
ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ;
REAL_ARITH `&0 < r ==> &0 < abs r`] THEN
ASM_REAL_ARITH_TAC] THEN
REPEAT GEN_TAC THEN
ASM_CASES_TAC `subspace(t:real^N->bool)` THENL
[ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN
ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN
REPEAT STRIP_TAC THENL
[MATCH_MP_TAC(NORM_ARITH
`norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN
ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH
`(a * u + x) / r:real = a * u / r + x / r`] THEN
MATCH_MP_TAC(REAL_ARITH
`x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN
ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE];
ALL_TAC] THEN
MP_TAC(ISPECL
[`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`;
`vec 0:real^1`; `vec 1:real^1`; `&0`; `1`]
IVT_DECREASING_COMPONENT_1) THEN
REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN
REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN
REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN
REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN
ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN
ANTS_TAC THENL
[REPEAT STRIP_TAC THEN
REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN
REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
REWRITE_TAC[CONTINUOUS_CONST]) THEN
SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN
MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
MATCH_MP_TAC CONTINUOUS_MUL THEN
REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
ASM_SIMP_TAC[DROP_VEC; REAL_FIELD
`&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN
DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN
CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in
let lemma2 = prove
(`!a t u v:real^N r.
affine t /\ a IN t /\
u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
(f,g) /\ f(u) = v /\
!x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`,
REPEAT GEN_TAC THEN
DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
[ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY];
REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_TAC] THEN
MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
STRIP_TAC THEN
EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN
EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN
REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
[MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM];
RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL
[MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN
ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[];
MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
ASM SET_TAC[]]]) in
let lemma3 = prove
(`!a t u v:real^N r s.
affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\
u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\
{x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`,
REPEAT STRIP_TAC THEN
MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`;
`r:real`] lemma2) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
STRIP_TAC THEN
EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN
EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN
ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN
STRIP_TAC THEN
SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\
(!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN
RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN
TRY(X_GEN_TAC `x:real^N` THEN
ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN
MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN
ASM SET_TAC[]) THEN
MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `(cball(a,r) INTER t) UNION
((t:real^N->bool) DIFF ball(a,r))` THEN
(CONJ_TAC THENL
[ALL_TAC;
MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
ASM SET_TAC[]]) THEN
MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID;
GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN
MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN
ASM SET_TAC[]) in
REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=>
p /\ q /\ r /\ s ==> t ==> u`] THEN
REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN
MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN
REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL
[X_GEN_TAC `b:real^N` THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
ASM_REWRITE_TAC[] THEN
GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN
REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN
ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN
MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[])
[`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN
ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
STRIP_TAC THEN
EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN
EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN
ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
[ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
MATCH_MP_TAC BOUNDED_SUBSET THEN
EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION
{x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN
ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[];
DISCH_TAC THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `s INTER ball(a:real^N,r)` THEN
ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
MP_TAC(ISPECL
[`a:real^N`; `affine hull s:real^N->bool`;
`a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`]
lemma3) THEN
ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);;
let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove
(`!s t x (y:A->real^N) k.
2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\
FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
==> ?f g. homeomorphism (t,t) (f,g) /\
(!i. i IN k ==> f(x i) = y i) /\
{x | ~(f x = x /\ g x = x)} SUBSET s /\
bounded {x | ~(f x = x /\ g x = x)}`,
let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove
(`!u s t k:real^N->bool.
open u /\ open s /\ connected s /\ ~(u = {}) /\
FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
==> ?f g. homeomorphism (t,t) (f,g) /\
{x | ~(f x = x /\ g x = x)} SUBSET s /\
bounded {x | ~(f x = x /\ g x = x)} /\
!x. x IN k ==> (f x) IN u`,
let lemma1 = prove
(`!a b:real^1 c d:real^1.
drop a < drop b /\ drop c < drop d
==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\
f(a) = c /\ f(b) = d`,
REPEAT STRIP_TAC THEN EXISTS_TAC
`\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN
ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ;
REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN
CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN
MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN
ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD
`a < b /\ c < d
==> (x = c + (y - a) / (b - a) * (d - c) <=>
a + (x - c) / (d - c) * (b - a) = y)`] THEN
REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN
REWRITE_TAC[REAL_ARITH
`c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN
ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
REAL_ARITH_TAC;
ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`;
REAL_ARITH `x - a:real = y - a <=> x = y`;
VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN
ASM_MESON_TAC[REAL_LT_REFL]]) in
let lemma2 = prove
(`!a b c:real^1 u v w:real^1 f1 g1 f2 g2.
homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\
homeomorphism (interval[b,c],interval[v,w]) (f2,g2)
==> b IN interval[a,c] /\ v IN interval[u,w] /\
f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w
==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\
f a = u /\ f c = w /\
(!x. x IN interval[a,b] ==> f x = f1 x) /\
(!x. x IN interval[b,c] ==> f x = f2 x)`,
REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM
(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN
EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x
else f2 x` THEN
ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN
ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN
CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN
MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN
CONJ_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1];
SUBGOAL_THEN
`interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\
interval[u:real^1,w] = interval[u,v] UNION interval[v,w]`
(CONJUNCTS_THEN SUBST1_TAC) THENL
[REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th ->
GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
MATCH_MP_TAC(SET_RULE
`(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
SIMP_TAC[IN_INTERVAL_1; REAL_ARITH
`b <= c ==> (c <= b <=> c = b)`] THEN
ASM_MESON_TAC[DROP_EQ]];
REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL
[COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN
ASM_MESON_TAC[];
ALL_TAC] THEN
COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL
[ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN
STRIP_TAC THEN
SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]`
MP_TAC THENL
[REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
[ALL_TAC; ASM_REWRITE_TAC[]] THEN
FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP
(REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN
REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN
SUBGOAL_THEN
`(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b`
MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
MATCH_MP_TAC(MESON[]
`!g1:real^1->real^1 g2:real^1->real^1.
g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b
==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN
MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN
REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REAL_ARITH_TAC]) in
let lemma3 = prove
(`!a b c d u v:real^1.
interval[c,d] SUBSET interval(a,b) /\
interval[u,v] SUBSET interval(a,b) /\
~(interval(c,d) = {}) /\ ~(interval(u,v) = {})
==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\
f a = a /\ f b = b /\
!x. x IN interval[c,d] ==> f(x) IN interval[u,v]`,
REPEAT GEN_TAC THEN
REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
ASM_CASES_TAC `drop u < drop v` THEN
ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN
ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL
[DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN
REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM];
RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN
ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN
MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN
ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN
ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN
DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN
FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN
SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL
[ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in
let lemma4 = prove
(`!s k u t:real^1->bool.
open u /\ open s /\ connected s /\ ~(u = {}) /\
FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
==> ?f g. homeomorphism (t,t) (f,g) /\
(!x. x IN k ==> f(x) IN u) /\
{x | ~(f x = x /\ g x = x)} SUBSET s /\
bounded {x | ~(f x = x /\ g x = x)}`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN
`?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u`
STRIP_ASSUME_TAC THENL
[UNDISCH_TAC `open(u:real^1->bool)` THEN
REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN
DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN
ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN
`?a b:real^1. ~(interval(a,b) = {}) /\
k SUBSET interval[a,b] /\
interval[a,b] SUBSET s`
STRIP_ASSUME_TAC THENL
[ASM_CASES_TAC `k:real^1->bool = {}` THENL
[ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN
MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN
MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN
ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY;
IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN
DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN
UNDISCH_TAC `open(s:real^1->bool)` THEN
REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN
ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN
MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN
REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o
GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
REWRITE_TAC[IS_INTERVAL_1] THEN
ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS;
REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL];
ALL_TAC] THEN
SUBGOAL_THEN
`?w z:real^1. interval[w,z] SUBSET s /\
interval[a,b] UNION interval[c,d] SUBSET interval(w,z)`
STRIP_ASSUME_TAC THENL
[SUBGOAL_THEN
`?w z:real^1. interval[w,z] SUBSET s /\
interval[a,b] UNION interval[c,d] SUBSET interval[w,z]`
STRIP_ASSUME_TAC THENL
[EXISTS_TAC `lift(min (drop a) (drop c))` THEN
EXISTS_TAC `lift(max (drop b) (drop d))` THEN
REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN
CONJ_TAC THENL
[FIRST_X_ASSUM(MP_TAC o
GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN
REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
EXISTS_TAC `lift(min (drop a) (drop c))` THEN
EXISTS_TAC `lift(max (drop b) (drop d))` THEN
ASM_REWRITE_TAC[LIFT_DROP] THEN
REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN
COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN
ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1;
REAL_LT_IMP_LE];
ASM_REAL_ARITH_TAC];
UNDISCH_TAC `open(s:real^1->bool)` THEN
REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th ->
MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN
SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC
(ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
ASM SET_TAC[];
REWRITE_TAC[UNION_SUBSET]] THEN
ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN
REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN
ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN
STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN
RULE_ASSUM_TAC
(REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1;
UNION_SUBSET; SUBSET_INTERVAL_1]) THEN
CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN
X_GEN_TAC `x:real^1` THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN
ASM_REAL_ARITH_TAC];
ALL_TAC] THEN
FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN
MP_TAC(ISPECL
[`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`]
lemma3) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN
EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN
ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN
REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
[ASM SET_TAC[];
ASM SET_TAC[];
ALL_TAC;
ASM SET_TAC[];
ASM SET_TAC[];
ALL_TAC;
ASM SET_TAC[];
ASM SET_TAC[];
MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN
REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN
(SUBGOAL_THEN
`t = interval[w:real^1,z] UNION (t DIFF interval(w,z))`
(fun th -> SUBST1_TAC th THEN
MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
ASSUME_TAC(SYM th))
THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL
[MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
ASM SET_TAC[];
MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN
ASM SET_TAC[];
REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE
`p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN
MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`])
(CONJUNCTS ENDS_IN_INTERVAL) THEN
ASM SET_TAC[]])) in
REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL
[MP_TAC(ISPECL
[`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN
REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN
MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
MP_TAC(ISPECL
[`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
`y:real^N->real^N`; `k:real^N->bool`]
HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN
ASM_REWRITE_TAC[pairwise] THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
ASM SET_TAC[];
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN
SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN
REWRITE_TAC[GSYM DIMINDEX_1] THEN
DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
MP_TAC(ISPECL
[`IMAGE (h:real^N->real^1) s`;
`IMAGE (h:real^N->real^1) k`;
`IMAGE (h:real^N->real^1) u`;
`IMAGE (h:real^N->real^1) t`]
lemma4) THEN
ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY;
CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN
ANTS_TAC THENL
[ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];
REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
STRIP_TAC THEN MAP_EVERY EXISTS_TAC
[`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`;
`(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN
ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN
ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN
ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN
CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
SUBGOAL_THEN
`{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} =
IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);;
(* ------------------------------------------------------------------------- *)
(* The "inside" and "outside" of a set, i.e. the points respectively in a *)
(* bounded or unbounded connected component of the set's complement. *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];;
let INSIDE_LINEAR_IMAGE = prove
(`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
==> inside(IMAGE f s) = IMAGE f (inside s)`,
REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);;
let OUTSIDE_LINEAR_IMAGE = prove
(`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
==> outside(IMAGE f s) = IMAGE f (outside s)`,
REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);;
add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];;
let INSIDE_UNIQUE = prove
(`!s t u. connected t /\ bounded t /\
connected u /\ ~(bounded u) /\
~connected((:real^N) DIFF s) /\
t UNION u = (:real^N) DIFF s
==> inside s = t`,
let INSIDE_OUTSIDE_UNIQUE = prove
(`!s t u. connected t /\ bounded t /\
connected u /\ ~(bounded u) /\
~connected((:real^N) DIFF s) /\
t UNION u = (:real^N) DIFF s
==> inside s = t /\ outside s = u`,
REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[
OUTSIDE_INSIDE] THEN
MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
[ASM_MESON_TAC[
INSIDE_UNIQUE];
MP_TAC(ISPEC `(:real^N)
DIFF s`
INSIDE_NO_OVERLAP) THEN
SUBGOAL_THEN `t
INTER u:real^N->bool = {}` MP_TAC THENL
[ALL_TAC; ASM SET_TAC[]] THEN
UNDISCH_TAC `~connected ((:real^N)
DIFF s)` THEN
ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN
REWRITE_TAC[] THEN MATCH_MP_TAC
CONNECTED_UNION THEN
ASM_REWRITE_TAC[]]);;
(* ------------------------------------------------------------------------- *)
(* Homotopy of maps p,q : X->Y with property P of all intermediate maps. *)
(* We often just want to require that it fixes some subset, but to take in *)
(* the case of loop homotopy it's convenient to have a general property P. *)
(* ------------------------------------------------------------------------- *)
let homotopic_with = new_definition
`homotopic_with P (X,Y) p q <=>
?h:real^(1,M)finite_sum->real^N.
h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
(!x. h(pastecart (vec 0) x) = p x) /\
(!x. h(pastecart (vec 1) x) = q x) /\
(!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`;;
(* ------------------------------------------------------------------------- *)
(* We often want to just localize the ending function equality or whatever. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_WITH = prove
(`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
==> (homotopic_with P (X,Y) p q <=>
?h:real^(1,M)finite_sum->real^N.
h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
(!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\
(!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\
(!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`,
(* ------------------------------------------------------------------------- *)
(* Trivial properties. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Homotopy with P is an equivalence relation (on continuous functions *)
(* mapping X into Y that satisfy P, though this only affects reflexivity). *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_WITH_TRANS = prove
(`!P X Y (f:real^M->real^N) g h.
homotopic_with P (X,Y) f g /\ homotopic_with P (X,Y) g h
==> homotopic_with P (X,Y) f h`,
REPEAT GEN_TAC THEN REWRITE_TAC[
homotopic_with;
PCROSS] THEN
DISCH_THEN(CONJUNCTS_THEN2
(X_CHOOSE_THEN `k1:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
(X_CHOOSE_THEN `k2:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
EXISTS_TAC `\y:real^(1,M)finite_sum.
if drop(fstcart y) <= &1 / &2
then (k1:real^(1,M)finite_sum->real^N)
(pastecart (&2 % fstcart y) (sndcart y))
else (k2:real^(1,M)finite_sum->real^N)
(pastecart (&2 % fstcart y - vec 1) (sndcart y))` THEN
REWRITE_TAC[
FSTCART_PASTECART;
DROP_VEC] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[
VECTOR_MUL_RZERO] THEN
ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`;
SNDCART_PASTECART] THEN
REPEAT CONJ_TAC THENL
[SUBGOAL_THEN
`interval[vec 0:real^1,vec 1] =
interval[vec 0,lift(&1 / &2)]
UNION interval[lift(&1 / &2),vec 1]`
SUBST1_TAC THENL
[REWRITE_TAC[
EXTENSION;
IN_UNION;
IN_INTERVAL_1;
LIFT_DROP;
DROP_VEC] THEN
REAL_ARITH_TAC;
ALL_TAC] THEN
REWRITE_TAC[SET_RULE `{f x y | x
IN s
UNION t /\ y
IN u} =
{f x y | x
IN s /\ y
IN u}
UNION
{f x y | x
IN t /\ y
IN u}`] THEN
MATCH_MP_TAC
CONTINUOUS_ON_CASES_LOCAL THEN
ONCE_REWRITE_TAC[TAUT
`a /\ b /\ c /\ d /\ e <=> (a /\ b) /\ (c /\ d) /\ e`] THEN
CONJ_TAC THENL
[REWRITE_TAC[
CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
[EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
t
IN interval[vec 0,lift(&1 / &2)] /\ x
IN UNIV }`;
EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
t
IN interval[lift(&1 / &2),vec 1] /\ x
IN UNIV}`] THEN
SIMP_TAC[REWRITE_RULE[
PCROSS]
CLOSED_PCROSS;
CLOSED_INTERVAL;
CLOSED_UNIV] THEN
MATCH_MP_TAC
SUBSET_ANTISYM THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_GSPEC;
IN_INTER; TAUT
`(x
IN (s
UNION t) /\ x
IN u ==> x
IN v) <=>
(x
IN u ==> x
IN (s
UNION t) ==> x
IN v)`] THEN
REWRITE_TAC[
PASTECART_EQ;
IN_ELIM_THM;
IN_UNION] THEN
REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART;
IN_UNIV] THEN
MESON_TAC[];
ALL_TAC] THEN
CONJ_TAC THENL
[CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM
o_DEF] THEN
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
(CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
[
CONTINUOUS_ON_PASTECART;
CONTINUOUS_ON_CMUL;
CONTINUOUS_ON_SUB;
CONTINUOUS_ON_CONST;
LINEAR_CONTINUOUS_ON;
LINEAR_FSTCART;
LINEAR_SNDCART] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_GSPEC] THEN
REWRITE_TAC[
IN_ELIM_THM;
PASTECART_EQ;
FSTCART_PASTECART;
SNDCART_PASTECART] THEN
REWRITE_TAC[MESON[] `(?t x. P t x /\ a = t /\ b = x) <=> P a b`] THEN
SIMP_TAC[
IN_INTERVAL_1;
DROP_SUB;
DROP_VEC;
DROP_CMUL;
LIFT_DROP] THEN
REAL_ARITH_TAC;
REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
REWRITE_TAC[
FORALL_AND_THM;
IMP_CONJ;
FORALL_IN_GSPEC] THEN
REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART;
IN_INTERVAL_1] THEN
SIMP_TAC[
LIFT_DROP;
DROP_VEC; REAL_ARITH
`&1 / &2 <= t ==> (t <= &1 / &2 <=> t = &1 / &2)`] THEN
SIMP_TAC[GSYM
LIFT_EQ;
LIFT_DROP; GSYM
LIFT_CMUL; GSYM
LIFT_NUM] THEN
REWRITE_TAC[GSYM
LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
ASM_REWRITE_TAC[
LIFT_NUM]];
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_GSPEC] THEN
REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART] THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
LIFT_DROP] THEN
REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`
IMAGE k s
SUBSET t ==> x
IN s ==> k x
IN t`)) THEN
ASM_REWRITE_TAC[
IN_ELIM_PASTECART_THM;
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
ASM_REAL_ARITH_TAC;
X_GEN_TAC `t:real^1` THEN REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC] THEN
STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_SIMP_TAC[] THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
ASM_REAL_ARITH_TAC]);;
(* ------------------------------------------------------------------------- *)
(* Two characterizations of homotopic triviality, one of which *)
(* implicitly incorporates path-connectedness. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Homotopy on a union of closed-open sets. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Homotopy of paths, maintaining the same endpoints. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_PATHS = prove
(`!s p q:real^1->real^N.
homotopic_paths s p q <=>
?h. h continuous_on
interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
SUBSET s /\
(!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
(!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
(!t. t IN interval[vec 0:real^1,vec 1]
==> pathstart(h o pastecart t) = pathstart p /\
pathfinish(h o pastecart t) = pathfinish p)`,
(* ------------------------------------------------------------------------- *)
(* A slightly ad-hoc but useful lemma in constructing homotopies. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_JOIN_LEMMA = prove
(`!p q:real^1->real^1->real^N.
(\y. p (fstcart y) (sndcart y)) continuous_on
(interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
(\y. q (fstcart y) (sndcart y)) continuous_on
(interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
(!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t))
==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on
(interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`,
(* ------------------------------------------------------------------------- *)
(* Congruence properties of homotopy w.r.t. path-combining operations. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Group properties for homotopy of paths (so taking equivalence classes *)
(* under homotopy would give the fundamental group). *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Homotopy of loops without requiring preservation of endpoints. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_LOOPS = prove
(`!s p q:real^1->real^N.
homotopic_loops s p q <=>
?h. h continuous_on
interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
SUBSET s /\
(!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
(!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
(!t. t IN interval[vec 0:real^1,vec 1]
==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`,
(* ------------------------------------------------------------------------- *)
(* Relations between the two variants of homotopy. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove
(`!s p a:real^N.
homotopic_loops s p (linepath(a,a))
==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
REPEAT STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP
HOMOTOPIC_LOOPS_IMP_LOOP) THEN
FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP
HOMOTOPIC_LOOPS_IMP_PATH) THEN
FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP
HOMOTOPIC_LOOPS_IMP_SUBSET) THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
homotopic_loops]) THEN
REWRITE_TAC[
homotopic_with;
PCROSS;
LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN
MATCH_MP_TAC
HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
`(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN
CONJ_TAC THENL
[ASM_MESON_TAC[
HOMOTOPIC_PATHS_RID;
HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN
MATCH_MP_TAC
HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
`linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++
linepath(pathfinish p,pathfinish p)` THEN
CONJ_TAC THENL
[ONCE_REWRITE_TAC[
HOMOTOPIC_PATHS_SYM] THEN
MP_TAC(ISPECL [`s:real^N->bool`;
`(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`]
HOMOTOPIC_PATHS_LID) THEN
REWRITE_TAC[
PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN
ASM_SIMP_TAC[
PATH_JOIN;
PATH_LINEPATH;
PATHSTART_LINEPATH] THEN
MATCH_MP_TAC
SUBSET_PATH_IMAGE_JOIN THEN
ASM_REWRITE_TAC[
PATH_IMAGE_LINEPATH;
SEGMENT_REFL] THEN
REWRITE_TAC[
INSERT_SUBSET;
EMPTY_SUBSET] THEN
ASM_MESON_TAC[
PATHSTART_IN_PATH_IMAGE;
SUBSET];
ALL_TAC] THEN
MATCH_MP_TAC
HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
`((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++
linepath(a,a) ++
reversepath(\u. h (pastecart u (vec 0))))` THEN
CONJ_TAC THENL
[ALL_TAC;
MATCH_MP_TAC(MESON[
HOMOTOPIC_PATHS_LID;
HOMOTOPIC_PATHS_JOIN;
HOMOTOPIC_PATHS_TRANS;
HOMOTOPIC_PATHS_SYM;
HOMOTOPIC_PATHS_RINV]
`(path p /\ path(reversepath p)) /\
(
path_image p
SUBSET s /\
path_image(reversepath p)
SUBSET s) /\
(pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\
pathstart(reversepath p) = b) /\
pathstart p = a
==>
homotopic_paths s (p ++ linepath(b,b) ++ reversepath p)
(linepath(a,a))`) THEN
REWRITE_TAC[
PATHSTART_REVERSEPATH;
PATHSTART_JOIN;
PATH_REVERSEPATH;
PATH_IMAGE_REVERSEPATH;
PATHSTART_LINEPATH] THEN
ASM_REWRITE_TAC[path;
path_image; pathstart; pathfinish;
LINEPATH_REFL] THEN
CONJ_TAC THENL
[GEN_REWRITE_TAC LAND_CONV [GSYM
o_DEF] THEN
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[
CONTINUOUS_ON_PASTECART;
CONTINUOUS_ON_ID;
CONTINUOUS_ON_CONST] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
SIMP_TAC[
SUBSET;
FORALL_IN_IMAGE;
IN_ELIM_PASTECART_THM;
ENDS_IN_UNIT_INTERVAL];
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ_ALT]
SUBSET_TRANS)) THEN
GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM
o_DEF] THEN
REWRITE_TAC[
IMAGE_o] THEN MATCH_MP_TAC
IMAGE_SUBSET THEN
SIMP_TAC[
SUBSET;
FORALL_IN_IMAGE;
IN_ELIM_PASTECART_THM;
ENDS_IN_UNIT_INTERVAL]]] THEN
REWRITE_TAC[
homotopic_paths;
homotopic_with;
PCROSS] THEN
EXISTS_TAC
`\y:real^(1,1)finite_sum.
(subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++
(\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++
subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0))))
(sndcart y)` THEN
ASM_REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART;
SUBPATH_TRIVIAL;
SUBPATH_REFL;
SUBPATH_REVERSEPATH; ETA_AX;
PATHSTART_JOIN;
PATHFINISH_JOIN;
PATHSTART_SUBPATH;
PATHFINISH_SUBPATH;
PATHSTART_LINEPATH;
PATHFINISH_LINEPATH] THEN
ONCE_REWRITE_TAC[
CONJ_ASSOC] THEN CONJ_TAC THENL
[ALL_TAC; REWRITE_TAC[pathstart]] THEN
CONJ_TAC THENL
[MATCH_MP_TAC(REWRITE_RULE[
PCROSS]
HOMOTOPIC_JOIN_LEMMA) THEN
REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
[ALL_TAC;
MATCH_MP_TAC(REWRITE_RULE[
PCROSS]
HOMOTOPIC_JOIN_LEMMA) THEN
ASM_REWRITE_TAC[
PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL
[ALL_TAC;
RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
REWRITE_TAC[
PATHSTART_SUBPATH] THEN
ASM_SIMP_TAC[pathstart; pathfinish]];
RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
REWRITE_TAC[
PATHFINISH_SUBPATH;
PATHSTART_JOIN] THEN
ASM_SIMP_TAC[pathstart]] THEN
REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM
o_DEF] THEN
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
REWRITE_TAC[
VECTOR_SUB_RZERO;
VECTOR_SUB_LZERO;
VECTOR_ADD_LID] THEN
(CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
[
CONTINUOUS_ON_PASTECART;
CONTINUOUS_ON_ADD;
CONTINUOUS_ON_MUL;
LIFT_DROP;
CONTINUOUS_ON_NEG;
DROP_NEG;
CONTINUOUS_ON_CONST;
CONTINUOUS_ON_ID;
LINEAR_CONTINUOUS_ON;
LINEAR_FSTCART;
LINEAR_SNDCART;
LIFT_NEG;
o_DEF; ETA_AX] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_GSPEC] THEN
REWRITE_TAC[
IN_ELIM_PASTECART_THM] THEN
REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART;
IN_INTERVAL_1] THEN
REWRITE_TAC[
DROP_ADD;
DROP_NEG;
DROP_VEC;
DROP_CMUL;
REAL_POS] THEN
SIMP_TAC[
REAL_LE_MUL;
REAL_SUB_LE; REAL_ARITH
`t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN
MATCH_MP_TAC(REAL_ARITH
`t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN
CONJ_TAC THEN MATCH_MP_TAC
REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC;
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_GSPEC;
IMP_CONJ;
RIGHT_FORALL_IMP_THM;
FSTCART_PASTECART;
SNDCART_PASTECART] THEN
X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
REWRITE_TAC[SET_RULE
`(!x. x
IN s ==> f x
IN t) <=>
IMAGE f s
SUBSET t`] THEN
REWRITE_TAC[GSYM
path_image; ETA_AX] THEN
REPEAT(MATCH_MP_TAC
SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ_ALT]
SUBSET_TRANS)) THEN
REWRITE_TAC[
path_image; subpath] THEN
GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM
o_DEF] THEN
REWRITE_TAC[
IMAGE_o] THEN MATCH_MP_TAC
IMAGE_SUBSET THEN
ASM_SIMP_TAC[
SUBSET;
FORALL_IN_IMAGE;
IN_ELIM_PASTECART_THM] THEN
SIMP_TAC[
IN_INTERVAL_1;
DROP_SUB;
DROP_VEC;
DROP_CMUL;
DROP_ADD] THEN
REWRITE_TAC[REAL_ADD_LID;
REAL_SUB_RZERO;
REAL_POS] THEN
REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1;
DROP_VEC]) THEN
ASM_SIMP_TAC[
REAL_LE_MUL;
REAL_SUB_LE] THEN
REPEAT STRIP_TAC THEN
GEN_REWRITE_TAC RAND_CONV [GSYM
REAL_MUL_RID] THEN
MATCH_MP_TAC
REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);;
(* ------------------------------------------------------------------------- *)
(* Relating homotopy of trivial loops to path-connectedness. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Homotopy of "nearby" function, paths and loops. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove)
(`(!g s:real^N->bool h.
path g /\ path h /\
pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
(!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
==> homotopic_paths s g h) /\
(!g s:real^N->bool h.
path g /\ path h /\
pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
(!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
==> homotopic_loops s g h)`,
CONJ_TAC THEN
(REWRITE_TAC[pathstart; pathfinish] THEN
REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN
REWRITE_TAC[homotopic_paths; homotopic_loops; homotopic_with; PCROSS] THEN
EXISTS_TAC
`\y:real^(1,1)finite_sum.
((&1 - drop(fstcart y)) % g(sndcart y) +
drop(fstcart y) % h(sndcart y):real^N)` THEN
REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN
REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
LINEAR_FSTCART; ETA_AX] THEN
GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
SIMP_TAC[SNDCART_PASTECART];
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN
SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN
ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));;
let HOMOTOPIC_PATHS_NEARBY_EXPLICIT,
HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove)
(`(!g s:real^N->bool h.
path g /\ path h /\
pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
(!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
==> norm(h t - g t) < norm(g t - x))
==> homotopic_paths s g h) /\
(!g s:real^N->bool h.
path g /\ path h /\
pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
(!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
==> norm(h t - g t) < norm(g t - x))
==> homotopic_loops s g h)`,
ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
REPEAT STRIP_TAC THENL
[MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR;
MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN
ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN
X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
X_GEN_TAC `u:real` THEN STRIP_TAC THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN
ASM_REWRITE_TAC[REAL_NOT_LT] THEN
MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`]
DIST_IN_CLOSED_SEGMENT) THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
REWRITE_TAC[segment; FORALL_IN_GSPEC;
ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
ASM_MESON_TAC[]);;
let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove)
(`(!g s:real^N->bool.
path g /\ open s /\ path_image g SUBSET s
==> ?e. &0 < e /\
!h. path h /\
pathstart h = pathstart g /\
pathfinish h = pathfinish g /\
(!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
==> homotopic_paths s g h) /\
(!g s:real^N->bool.
path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s
==> ?e. &0 < e /\
!h. path h /\
pathfinish h = pathstart h /\
(!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
==> homotopic_loops s g h)`,
CONJ_TAC THEN
REPEAT STRIP_TAC THEN
MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`]
SEPARATE_COMPACT_CLOSED) THEN
ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN
(ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL
[MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT;
MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN
ASM_REWRITE_TAC[] THEN
MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN
MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN
ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
(* ------------------------------------------------------------------------- *)
(* Homotopy of non-antipodal sphere maps. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Retracts, in a general sense, preserve (co)homotopic triviality. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Another useful lemma. *)
(* ------------------------------------------------------------------------- *)
let HOMOTOPIC_JOIN_SUBPATHS = prove
(`!g:real^1->real^N s.
path g /\ path_image g SUBSET s /\
u IN interval[vec 0,vec 1] /\
v IN interval[vec 0,vec 1] /\
w IN interval[vec 0,vec 1]
==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`,
let lemma1 = prove
(`!g:real^1->real^N s.
drop u <= drop v /\ drop v <= drop w
==> path g /\ path_image g SUBSET s /\
u IN interval[vec 0,vec 1] /\
v IN interval[vec 0,vec 1] /\
w IN interval[vec 0,vec 1] /\
drop u <= drop v /\ drop v <= drop w
==> homotopic_paths s
(subpath u v g ++ subpath v w g) (subpath u w g)`,
REPEAT STRIP_TAC THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
ASM_CASES_TAC `w:real^1 = u` THENL
[MP_TAC(ISPECL
[`path_image g:real^N->bool`;
`subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN
ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN
REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN
ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET];
ALL_TAC] THEN
ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
EXISTS_TAC
`\t. if drop t <= &1 / &2
then inv(drop(w - u)) % (&2 * drop(v - u)) % t
else inv(drop(w - u)) %
((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN
REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM;
DROP_ADD; DROP_SUB] THEN
(CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
[CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN
REPEAT STRIP_TAC THEN REAL_ARITH_TAC;
SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL
[ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN
REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN
ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
(CONJ_TAC THENL
[REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN
REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN
ASM_REAL_ARITH_TAC;
ALL_TAC]) THEN
REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`;
REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN
MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN
(CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN
REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN
ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV];
X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN
ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN
AP_TERM_TAC THEN
REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
REAL_ARITH_TAC]) in
let lemma2 = prove
(`path g /\ path_image g SUBSET s /\
u IN interval[vec 0,vec 1] /\
v IN interval[vec 0,vec 1] /\
w IN interval[vec 0,vec 1] /\
homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`,
REPEAT STRIP_TAC THEN
ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in
let lemma3 = prove
(`path (g:real^1->real^N) /\ path_image g SUBSET s /\
u IN interval[vec 0,vec 1] /\
v IN interval[vec 0,vec 1] /\
w IN interval[vec 0,vec 1] /\
homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`,
let tac =
ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH;
HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS;
PATHSTART_JOIN; PATHFINISH_JOIN] in
REPEAT STRIP_TAC THEN
ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
EXISTS_TAC
`(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN
CONJ_TAC THENL
[MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac;
ALL_TAC] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
EXISTS_TAC
`subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN
CONJ_TAC THENL
[ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac;
ALL_TAC] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
EXISTS_TAC
`(subpath u v g :real^1->real^N) ++
linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN
CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
EXISTS_TAC
`linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN
CONJ_TAC THENL
[GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac;
ALL_TAC] THEN
REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL;
PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
INSERT_SUBSET; EMPTY_SUBSET] THEN
ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in
REPEAT STRIP_TAC THEN
REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
(REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/
drop w <= drop v /\ drop v <= drop u) \/
(drop u <= drop w /\ drop w <= drop v \/
drop v <= drop w /\ drop w <= drop u) \/
(drop v <= drop u /\ drop u <= drop w \/
drop w <= drop u /\ drop u <= drop v)`) THEN
FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o
MATCH_MP lemma1) THEN
ASM_MESON_TAC[lemma2; lemma3]);;
let HOMOTOPIC_LOOPS_SHIFTPATH = prove
(`!s:real^N->bool p q u.
homotopic_loops s p q /\ u IN interval[vec 0,vec 1]
==> homotopic_loops s (shiftpath u p) (shiftpath u q)`,
REPEAT GEN_TAC THEN REWRITE_TAC[
homotopic_loops;
homotopic_with;
PCROSS] THEN
DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(
(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
EXISTS_TAC
`\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N)
(pastecart (fstcart z) t)) (sndcart z)` THEN
ASM_REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART; ETA_AX] THEN
ASM_SIMP_TAC[
CLOSED_SHIFTPATH] THEN CONJ_TAC THENL
[REWRITE_TAC[shiftpath;
DROP_ADD; REAL_ARITH
`u + z <= &1 <=> z <= &1 - u`] THEN
SUBGOAL_THEN
`{ pastecart (t:real^1) (x:real^1) |
t
IN interval[vec 0,vec 1] /\ x
IN interval[vec 0,vec 1]} =
{ pastecart (t:real^1) (x:real^1) |
t
IN interval[vec 0,vec 1] /\ x
IN interval[vec 0,vec 1 - u]}
UNION
{ pastecart (t:real^1) (x:real^1) |
t
IN interval[vec 0,vec 1] /\ x
IN interval[vec 1 - u,vec 1]}`
SUBST1_TAC THENL
[MATCH_MP_TAC(SET_RULE `s
UNION s' = u
==> {f t x | t
IN i /\ x
IN u} =
{f t x | t
IN i /\ x
IN s}
UNION
{f t x | t
IN i /\ x
IN s'}`) THEN
UNDISCH_TAC `(u:real^1)
IN interval[vec 0,vec 1]` THEN
REWRITE_TAC[
EXTENSION;
IN_INTERVAL_1;
IN_UNION;
DROP_SUB;
DROP_VEC] THEN
REAL_ARITH_TAC;
ALL_TAC] THEN
MATCH_MP_TAC
CONTINUOUS_ON_CASES THEN
SIMP_TAC[REWRITE_RULE[
PCROSS]
CLOSED_PCROSS;
CLOSED_INTERVAL] THEN
REWRITE_TAC[
FORALL_AND_THM;
FORALL_IN_GSPEC; TAUT
`p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN
SIMP_TAC[
SNDCART_PASTECART;
IN_INTERVAL_1;
DROP_SUB;
DROP_VEC] THEN
SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN
SIMP_TAC[GSYM
LIFT_EQ;
LIFT_SUB;
LIFT_DROP;
LIFT_NUM] THEN
REWRITE_TAC[
FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`;
VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN
RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
ASM_SIMP_TAC[GSYM
IN_INTERVAL_1; GSYM
DROP_VEC] THEN CONJ_TAC THEN
GEN_REWRITE_TAC LAND_CONV [GSYM
o_DEF] THEN
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[
CONTINUOUS_ON_PASTECART;
CONTINUOUS_ON_ADD;
CONTINUOUS_ON_CONST;
LINEAR_CONTINUOUS_ON;
LINEAR_FSTCART;
LINEAR_SNDCART;
VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
UNDISCH_TAC `(u:real^1)
IN interval[vec 0,vec 1]` THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_GSPEC] THEN
REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART;
IN_INTERVAL_1;
IN_ELIM_PASTECART_THM;
DROP_ADD;
DROP_SUB;
DROP_VEC] THEN
REAL_ARITH_TAC;
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_GSPEC] THEN
REWRITE_TAC[
FSTCART_PASTECART;
SNDCART_PASTECART; SET_RULE
`(!t x. t
IN i /\ x
IN i ==> f t x
IN s) <=>
(!t. t
IN i ==>
IMAGE (f t) i
SUBSET s)`] THEN
X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM
path_image] THEN
ASM_SIMP_TAC[
PATH_IMAGE_SHIFTPATH; ETA_AX] THEN
REWRITE_TAC[
path_image] THEN ASM SET_TAC[]]);;
(* ------------------------------------------------------------------------- *)
(* Simply connected sets defined as "all loops are homotopic (as loops)". *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];;
add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];;
(* ------------------------------------------------------------------------- *)
(* A mapping out of a sphere is nullhomotopic iff it extends to the ball. *)
(* This even works out in the degenerate cases when the radius is <= 0, and *)
(* we also don't need to explicitly assume continuity since it's already *)
(* implicit in both sides of the equivalence. *)
(* ------------------------------------------------------------------------- *)
let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove
(`!f:real^M->real^N s a r.
(?c. homotopic_with (\x. T) (sphere(a,r),s) f (\x. c)) <=>
(?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\
!x. x IN sphere(a,r) ==> g x = f x)`,
let lemma = prove
(`!f:real^M->real^N g a r.
(!e. &0 < e
==> ?d. &0 < d /\
!x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\
g continuous_on (cball(a,r) DELETE a) /\
(!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x)
==> f continuous_on cball(a,r)`,
REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN
ASM_CASES_TAC `x:real^M = a` THENL
[ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN
ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0];
MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN
ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN
CONJ_TAC THENL
[RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]);
UNDISCH_TAC
`(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN
REWRITE_TAC[continuous_on; continuous_within] THEN
DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN
MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `min d (norm(x - a:real^M))` THEN
ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN
ASM_MESON_TAC[NORM_SUB; NORM_ARITH
`norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in
REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
(REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
THENL
[ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN
FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN
ASM_SIMP_TAC[HOMOTOPIC_WITH; IMAGE_CLAUSES; EMPTY_GSPEC; NOT_IN_EMPTY;
PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN
REWRITE_TAC[CONTINUOUS_ON_EMPTY];
ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN
SIMP_TAC[HOMOTOPIC_WITH; PCROSS; FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN
ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL
[MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL
[EXISTS_TAC `(f:real^M->real^N) a` THEN
EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN
ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE];
EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN
ASM SET_TAC[]];
MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL
[ASM SET_TAC[]; STRIP_TAC] THEN
UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN
REWRITE_TAC[EXISTS_IN_GSPEC] THEN
EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN
ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]];
ALL_TAC] THEN
MATCH_MP_TAC(TAUT
`!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN
EXISTS_TAC
`(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\
IMAGE f {x | norm(x - a) = r} SUBSET s` THEN
REPEAT CONJ_TAC THENL
[STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
ASM_REWRITE_TAC[];
DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `cball(a:real^M,r)`;
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`IMAGE g t SUBSET s
==> u SUBSET t /\ (!x. x IN u ==> f x = g x)
==> IMAGE f u SUBSET s`)) THEN
ASM_SIMP_TAC[]] THEN
ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN
MESON_TAC[REAL_LE_REFL; NORM_SUB];
STRIP_TAC] THEN
ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL
[REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN
STRIP_TAC THEN
EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
(pastecart (lift(inv(r) * norm(x - a)))
(a + (if x = a then r % basis 1
else r / norm(x - a) % (x - a))))` THEN
ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ;
LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
REPEAT CONJ_TAC THENL
[MATCH_MP_TAC lemma THEN
EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
(pastecart (lift(inv(r) * norm(x - a)))
(a + r / norm(x - a) % (x - a)))` THEN
SIMP_TAC[] THEN CONJ_TAC THENL
[X_GEN_TAC `e:real` THEN DISCH_TAC THEN
ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
COMPACT_UNIFORMLY_CONTINUOUS)) THEN
SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS;
REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere]
COMPACT_SPHERE; COMPACT_INTERVAL] THEN
REWRITE_TAC[uniformly_continuous_on] THEN
DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `min r (d * r):real` THEN
ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN
X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN
REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN
ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
`(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN
REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN
REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN
REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN
REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN
REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN
ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM;
REAL_ARITH `&0 < r ==> abs r = r`];
GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB;
CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
o_DEF; real_div; LIFT_CMUL] THEN
MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN
MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN
ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN
MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN
SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
ASM_REAL_ARITH_TAC]];
GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN
X_GEN_TAC `x:real^M` THEN
REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL
[REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE];
REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN
ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL;
REAL_ABS_DIV; REAL_ABS_NORM;
REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN
ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]];
GEN_TAC THEN COND_CASES_TAC THEN
ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN
REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]];
DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `(g:real^M->real^N) a` THEN
ASM_SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN
EXISTS_TAC `\y:real^(1,M)finite_sum.
(g:real^M->real^N)
(a + drop(fstcart y) % (sndcart y - a))` THEN
REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN
ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL
[GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
[MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX];
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CONTINUOUS_ON_SUBSET))];
GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ;
REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN
REAL_ARITH_TAC]);;
(* ------------------------------------------------------------------------- *)
(* Homotopy equivalence. *)
(* ------------------------------------------------------------------------- *)
parse_as_infix("homotopy_equivalent",(12,"right"));;
add_linear_invariants
[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;
add_translation_invariants
[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ;
HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];;
(* ------------------------------------------------------------------------- *)
(* Contractible sets. *)
(* ------------------------------------------------------------------------- *)
add_translation_invariants [CONTRACTIBLE_TRANSLATION];;
add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];;
(* ------------------------------------------------------------------------- *)
(* Homeomorphisms between punctured spheres and affine sets. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* When dealing with AR, ANR and ANR later, it's useful to know that any set *)
(* at all is homeomorphic to a closed subset of a convex set, and if the *)
(* set is locally compact we can take the convex set to be the universe. *)
(* ------------------------------------------------------------------------- *)
let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove
(`!s:real^M->bool.
locally compact s /\ dimindex(:M) < dimindex(:N)
==> ?t:real^N->bool. closed t /\ s homeomorphic t`,
REPEAT STRIP_TAC THEN SUBGOAL_THEN
`?t:real^(M,1)finite_sum->bool h.
closed t /\ homeomorphism (s,t) (h,fstcart)`
STRIP_ASSUME_TAC THENL
[ASM_SIMP_TAC[
LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED];
ALL_TAC] THEN
ABBREV_TAC
`f:real^(M,1)finite_sum->real^N =
\x. lambda i. if i <= dimindex(:M) then x$i
else x$(dimindex(:M)+1)` THEN
ABBREV_TAC
`g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN
EXISTS_TAC `
IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN
SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL
[EXPAND_TAC "f" THEN REWRITE_TAC[linear;
CART_EQ] THEN
SIMP_TAC[
LAMBDA_BETA;
VECTOR_ADD_COMPONENT;
VECTOR_MUL_COMPONENT] THEN
MESON_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL
[EXPAND_TAC "g" THEN REWRITE_TAC[linear;
CART_EQ] THEN
SIMP_TAC[
LAMBDA_BETA;
VECTOR_ADD_COMPONENT;
VECTOR_MUL_COMPONENT] THEN
MESON_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN
`!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) =
x`
ASSUME_TAC THENL
[MAP_EVERY EXPAND_TAC ["f";
"g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP
(ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN
SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN
REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN
MESON_TAC[];
ALL_TAC] THEN
CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN
TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN
CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN
REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC
[`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN
ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;
(* ------------------------------------------------------------------------- *)
(* Simple connectedness of a union. This is essentially a stripped-down *)
(* version of the Seifert - Van Kampen theorem. *)
(* ------------------------------------------------------------------------- *)
"u"; "t"; "s"] THEN
MATCH_MP_TAC(MESON[]
`(!s t u v. x IN s ==> P x s t u v) /\
(!x s t u v. P x s t u v ==> P x t s v u)
==> (!s t u v. x IN s \/ x IN t ==> P x s t u v)`) THEN
CONJ_TAC THENL
[REPEAT STRIP_TAC;
REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN
MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN
SUBGOAL_THEN
`?e. &0 < e /\
!x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\
norm(x - y) < e
==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/
path_image(subpath x y p) SUBSET t`
STRIP_ASSUME_TAC THENL
[MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN
ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN
DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN
SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`]
COMPACT_UNIFORMLY_CONTINUOUS) THEN
ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN
DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN
ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN
MATCH_MP_TAC(SET_RULE
`!p'. p SUBSET b /\
(s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\
p SUBSET p' /\ p' SUBSET s UNION t
==> (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN
EXISTS_TAC `path_image(p:real^1->real^N)` THEN
ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN
REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN
SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL
[REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN
ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist];
REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN
X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
ASM_REAL_ARITH_TAC];
MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `N:num` THEN STRIP_TAC] THEN
SUBGOAL_THEN
`!n. n <= N /\ p(lift(&n / &N)) IN s
==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\
homotopic_paths (s UNION t)
(subpath (vec 0) (lift(&n / &N)) p) q`
MP_TAC THENL
[ALL_TAC;
DISCH_THEN(MP_TAC o SPEC `N:num`) THEN
ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN
ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN
REWRITE_TAC[SUBPATH_TRIVIAL] THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
EXISTS_TAC `s:real^N->bool` THEN
ASM_MESON_TAC[SUBSET_UNION]] THEN
SUBGOAL_THEN
`!n. n < N
==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
SUBSET (s:real^N->bool) \/
path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
SUBSET t`
ASSUME_TAC THENL
[REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC;
NORM_REAL; GSYM drop;
REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN
ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ;
REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN
ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV;
REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
ASM_ARITH_TAC;
ALL_TAC] THEN
MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN
ASM_CASES_TAC `n = 0` THENL
[ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN
EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN
REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN
REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN
SET_TAC[];
ALL_TAC] THEN
MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN
REWRITE_TAC[] THEN
MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
CONJ_TAC THENL
[CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN
ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN
ASM_MESON_TAC[pathstart];
DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN
SUBGOAL_THEN
`?q. path q /\
path_image(q:real^1->real^N) SUBSET s /\
homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q`
STRIP_ASSUME_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
ALL_TAC] THEN
SUBGOAL_THEN
`!i. m < i /\ i <= n
==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/
path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET
(t:real^N->bool)`
MP_TAC THENL
[MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN
X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
ASM_CASES_TAC `i:num = m` THENL
[DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN
SUBGOAL_THEN
`p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)`
STRIP_ASSUME_TAC THENL
[MATCH_MP_TAC(SET_RULE
`x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN
CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`s SUBSET t ==> x IN s ==> x IN t`)) THEN
REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
ASM_ARITH_TAC;
SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL
[ASM_ARITH_TAC; ASM_MESON_TAC[]]];
ALL_TAC] THEN
SUBGOAL_THEN
`path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/
path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET
(t:real^N->bool)`
MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`~(x IN s)
==> (x IN p /\ x IN q) /\ (q UNION p = r)
==> p SUBSET s \/ p SUBSET t
==> q SUBSET s \/ q SUBSET t
==> r SUBSET s \/ r SUBSET t`)) THEN
SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN
REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN
MATCH_MP_TAC UNION_SEGMENT THEN
ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN
ASM_ARITH_TAC;
DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN
STRIP_TAC THENL
[EXISTS_TAC `(q:real^1->real^N) ++
subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN
REPEAT CONJ_TAC THENL
[MATCH_MP_TAC PATH_JOIN_IMP THEN
FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
ASM_ARITH_TAC;
MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[];
MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
CONJ_TAC THENL
[ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL];
MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN
ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
MATCH_MP_TAC PATH_SUBPATH] THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
ASM_ARITH_TAC];
SUBGOAL_THEN
`(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t`
STRIP_ASSUME_TAC THENL
[ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET];
ALL_TAC] THEN
UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN
REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL
[`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN
ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN
UNDISCH_THEN
`!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p
==> homotopic_paths t p (linepath (pathstart p,pathstart p))`
(MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++
reversepath(r:real^1->real^N)`) THEN
ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
ANTS_TAC THENL
[ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
MATCH_MP_TAC PATH_JOIN_IMP THEN
ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH;
PATHSTART_REVERSEPATH] THEN
MATCH_MP_TAC PATH_SUBPATH THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
ASM_ARITH_TAC;
ALL_TAC] THEN
DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN
ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH;
PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
HOMOTOPIC_PATHS_LOOP_PARTS)) THEN
FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN
ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
EXISTS_TAC `(q:real^1->real^N) ++ r` THEN
ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
CONJ_TAC THENL
[ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
ASM_ARITH_TAC;
MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);;
(* ------------------------------------------------------------------------- *)
(* Covering spaces and lifting results for them. *)
(* ------------------------------------------------------------------------- *)
let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove
(`!p:real^M->real^N c s.
covering_space (c,p) s
==> !x. x IN c
==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\
p(x) IN u /\ open_in (subtopology euclidean s) u /\
?q. homeomorphism (t,u) (p,q)`,
REWRITE_TAC[
covering_space] THEN REPEAT STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN `(x:real^M)
IN UNIONS v` MP_TAC THENL
[ASM SET_TAC[]; REWRITE_TAC[
IN_UNIONS]] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN
STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);;
let COVERING_SPACE_OPEN_MAP = prove
(`!p:real^M->real^N c s t.
covering_space (c,p) s /\
open_in (subtopology euclidean c) t
==> open_in (subtopology euclidean s) (IMAGE p t)`,
REWRITE_TAC[
covering_space] THEN REPEAT STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [
open_in]) THEN
ONCE_REWRITE_TAC[
OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN
DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool`
(STRIP_ASSUME_TAC o GSYM)) THEN
SUBGOAL_THEN
`?x. x
IN {x | x
IN c /\ (p:real^M->real^N) x
IN u} /\ x
IN t /\ p x = y`
MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
IN_UNIONS]) THEN
DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN
FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `
IMAGE (p:real^M->real^N) (t
INTER v)` THEN CONJ_TAC THENL
[ALL_TAC; ASM SET_TAC[]] THEN
SUBGOAL_THEN
`
IMAGE (p:real^M->real^N) (t
INTER v) =
{z | z
IN u /\ q z
IN (t
INTER v)}`
SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
MATCH_MP_TAC
OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
ASM_REWRITE_TAC[] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [
CONTINUOUS_ON_OPEN]) THEN
ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[
INTER_COMM] THEN
MATCH_MP_TAC
OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
EXISTS_TAC `c:real^M->bool` THEN
CONJ_TAC THENL [MATCH_MP_TAC
OPEN_IN_INTER; ASM_MESON_TAC[
open_in]] THEN
ASM_REWRITE_TAC[
OPEN_IN_SUBTOPOLOGY_REFL;
TOPSPACE_EUCLIDEAN;
SUBSET_UNIV]);;
let COVERING_SPACE_LOCALLY_EQ = prove
(`!P Q p:real^M->real^N c s.
covering_space (c,p) s /\
(!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
(!q u. u SUBSET s /\ q continuous_on u /\ Q u ==> P(IMAGE q u))
==> (locally Q s <=> locally P c)`,
REPEAT STRIP_TAC THEN EQ_TAC THENL
[ALL_TAC; ASM_MESON_TAC[
COVERING_SPACE_LOCALLY]] THEN
REWRITE_TAC[locally] THEN STRIP_TAC THEN
MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
covering_space]) THEN
DISCH_THEN(MP_TAC o SPEC `(p:real^M->real^N) x` o last o CONJUNCTS) THEN
ANTS_TAC THENL
[ASM_MESON_TAC[
covering_space;
FUN_IN_IMAGE;
OPEN_IN_IMP_SUBSET;
SUBSET];
DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC)] THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
EXTENSION]) THEN
DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[
IN_ELIM_THM] THEN
MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
CONJ_TAC THENL [ASM_MESON_TAC[
OPEN_IN_IMP_SUBSET;
SUBSET]; ALL_TAC] THEN
REWRITE_TAC[
IN_UNIONS;
LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`
IMAGE (p:real^M->real^N) (u
INTER v)`; `(p:real^M->real^N) x`]) THEN
ASM_SIMP_TAC[
FUN_IN_IMAGE;
IN_INTER] THEN ANTS_TAC THENL
[ASM_MESON_TAC[
COVERING_SPACE_OPEN_MAP;
OPEN_IN_INTER]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool`
(X_CHOOSE_THEN `w':real^N->bool` STRIP_ASSUME_TAC)) THEN
FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
EXISTS_TAC `
IMAGE (q:real^N->real^M) w` THEN
EXISTS_TAC `
IMAGE (q:real^N->real^M) w'` THEN REPEAT CONJ_TAC THENL
[MATCH_MP_TAC
OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
HOMEOMORPHISM_IMP_OPEN_MAP THEN
MAP_EVERY EXISTS_TAC [`p:real^M->real^N`; `t:real^N->bool`] THEN
ASM_REWRITE_TAC[homeomorphism] THEN
MATCH_MP_TAC
OPEN_IN_SUBSET_TRANS THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP
OPEN_IN_IMP_SUBSET)) THEN
ASM SET_TAC[];
FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
[REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP
OPEN_IN_IMP_SUBSET)) THEN
ASM SET_TAC[];
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
ASM SET_TAC[]];
ASM SET_TAC[];
ASM SET_TAC[];
ASM SET_TAC[]]);;
let COVERING_SPACE_LIFT_HOMOTOPY = prove
(`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u.
covering_space (c,p) s /\
h continuous_on (interval[vec 0,vec 1] PCROSS u) /\
IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\
(!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\
f continuous_on u /\ IMAGE f u SUBSET c
==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\
IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\
(!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\
(!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN
`!y. y
IN u
==> ?v.
open_in (subtopology euclidean u) v /\ y
IN v /\
?k:real^(1,P)finite_sum->real^M.
k
continuous_on (interval[vec 0,vec 1]
PCROSS v) /\
IMAGE k (interval[vec 0,vec 1]
PCROSS v)
SUBSET c /\
(!y. y
IN v ==> k(pastecart (vec 0) y) = f y) /\
(!z. z
IN interval[vec 0,vec 1]
PCROSS v
==> h z :real^N = p(k z))`
MP_TAC THENL
[ALL_TAC;
GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
[
RIGHT_IMP_EXISTS_THM;
RIGHT_AND_EXISTS_THM] THEN
REWRITE_TAC[
SKOLEM_THM;
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC
[`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN
DISCH_THEN(LABEL_TAC "*") THEN
MP_TAC(ISPECL
[`fs:real^P->real^(1,P)finite_sum->real^M`;
`(\x. interval[vec 0,vec 1]
PCROSS (v x))
:real^P->real^(1,P)finite_sum->bool`;
`(interval[vec 0,vec 1]
PCROSS u):real^(1,P)finite_sum->bool`;
`u:real^P->bool`]
PASTING_LEMMA_EXISTS) THEN
ASM_SIMP_TAC[] THEN ANTS_TAC THENL
[ALL_TAC;
MATCH_MP_TAC
MONO_EXISTS THEN
X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN
ASM_REWRITE_TAC[
FORALL_IN_IMAGE;
FORALL_IN_PCROSS;
SUBSET] THEN
REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN
X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL
[FIRST_X_ASSUM(MP_TAC o SPECL
[`pastecart (t:real^1) (y:real^P)`; `y:real^P`]);
FIRST_X_ASSUM(MP_TAC o SPECL
[`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]);
FIRST_X_ASSUM(MP_TAC o SPECL
[`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN
ASM_SIMP_TAC[
PASTECART_IN_PCROSS;
IN_INTER;
ENDS_IN_UNIT_INTERVAL] THEN
DISCH_THEN SUBST1_TAC THEN
REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
ASM_REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE] THEN
REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS]] THEN
REPEAT CONJ_TAC THENL
[REWRITE_TAC[
SUBSET;
FORALL_IN_PCROSS;
UNIONS_GSPEC;
IN_ELIM_THM] THEN
MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN
EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[
PASTECART_IN_PCROSS];
X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
REWRITE_TAC[
OPEN_IN_OPEN] THEN
DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `(:real^1)
PCROSS (t:real^P->bool)` THEN
ASM_SIMP_TAC[REWRITE_RULE[GSYM
PCROSS]
OPEN_PCROSS;
OPEN_UNIV] THEN
REWRITE_TAC[
EXTENSION;
FORALL_PASTECART;
PASTECART_IN_PCROSS;
IN_INTER;
IN_UNIV] THEN
REPEAT GEN_TAC THEN CONV_TAC TAUT;
REWRITE_TAC[
FORALL_PASTECART;
IN_INTER;
PASTECART_IN_PCROSS] THEN
MAP_EVERY X_GEN_TAC
[`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN
REWRITE_TAC[
CONJ_ACI] THEN STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o
ISPECL [`h:real^(1,P)finite_sum->real^N`;
`(fs:real^P->real^(1,P)finite_sum->real^M) x`;
`(fs:real^P->real^(1,P)finite_sum->real^M) z`;
`interval[vec 0:real^1,vec 1]
PCROSS {y:real^P}`;
`pastecart (vec 0:real^1) (y:real^P)`;
`pastecart (t:real^1) (y:real^P)`] o
MATCH_MP (ONCE_REWRITE_RULE[
IMP_CONJ]
COVERING_SPACE_LIFT_UNIQUE)) THEN
DISCH_THEN MATCH_MP_TAC THEN
ASM_SIMP_TAC[
PASTECART_IN_PCROSS;
IN_SING;
ENDS_IN_UNIT_INTERVAL] THEN
SIMP_TAC[REWRITE_RULE[GSYM
PCROSS]
CONNECTED_PCROSS;
CONNECTED_INTERVAL;
CONNECTED_SING] THEN
CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[
FORALL_PASTECART;
SUBSET;
PASTECART_IN_PCROSS] THEN
ASM_SIMP_TAC[
IN_SING];
ALL_TAC] THEN
CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
(REWRITE_RULE[
IMP_CONJ_ALT]
SUBSET_TRANS)) THEN
MATCH_MP_TAC
IMAGE_SUBSET THEN
REWRITE_TAC[
FORALL_PASTECART;
SUBSET;
PASTECART_IN_PCROSS] THEN
ASM_SIMP_TAC[
IN_SING];
ALL_TAC] THEN
ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN
CONJ_TAC THENL
[REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`);
REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN
ASM_REWRITE_TAC[
FORALL_IN_GSPEC;
SUBSET;
FORALL_IN_IMAGE] THEN
ASM_SIMP_TAC[
FORALL_PASTECART;
PASTECART_IN_PCROSS;
IN_SING] THEN
STRIP_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[
FORALL_PASTECART;
SUBSET;
PASTECART_IN_PCROSS] THEN
ASM_SIMP_TAC[
IN_SING]]] THEN
X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
FIRST_ASSUM(MP_TAC o last o CONJUNCTS o
GEN_REWRITE_RULE I [
covering_space]) THEN
GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [
RIGHT_IMP_EXISTS_THM] THEN
REWRITE_TAC[
SKOLEM_THM;
LEFT_IMP_EXISTS_THM] THEN
X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN
SUBGOAL_THEN
`!t. t
IN interval[vec 0,vec 1]
==> ?k n i:real^N.
open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\
open_in (subtopology euclidean u) n /\
t
IN k /\ y
IN n /\ i
IN s /\
IMAGE (h:real^(1,P)finite_sum->real^N) (k
PCROSS n)
SUBSET uu i`
MP_TAC THENL
[X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y)
IN s`
ASSUME_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[
FORALL_IN_IMAGE] o
GEN_REWRITE_RULE I [
SUBSET]) THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS];
ALL_TAC] THEN
SUBGOAL_THEN
`
open_in (subtopology euclidean (interval[vec 0,vec 1]
PCROSS u))
{z | z
IN (interval[vec 0,vec 1]
PCROSS u) /\
(h:real^(1,P)finite_sum->real^N) z
IN
uu(h(pastecart t y))}`
MP_TAC THENL
[MATCH_MP_TAC
CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[];
ALL_TAC] THEN
DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[
IMP_CONJ_ALT]
PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN
DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN
ASM_SIMP_TAC[
IN_ELIM_THM;
PASTECART_IN_PCROSS] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN
STRIP_TAC THEN
EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN
ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
ALL_TAC] THEN
GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [
OPEN_IN_OPEN] THEN
REWRITE_TAC[
RIGHT_EXISTS_AND_THM] THEN
REWRITE_TAC[
LEFT_AND_EXISTS_THM] THEN
REWRITE_TAC[MESON[]
`(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN
REWRITE_TAC[
RIGHT_AND_EXISTS_THM] THEN
GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [
RIGHT_IMP_EXISTS_THM] THEN
REWRITE_TAC[
SKOLEM_THM;
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC
[`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`;
`xx:real^1->real^N`] THEN
DISCH_THEN(LABEL_TAC "+") THEN
MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]
PCROSS {y:real^P}`
COMPACT_IMP_HEINE_BOREL) THEN
SIMP_TAC[
COMPACT_PCROSS;
COMPACT_INTERVAL;
COMPACT_SING] THEN
DISCH_THEN(MP_TAC o SPEC
`
IMAGE ((\i. kk i
PCROSS nn i):real^1->real^(1,P)finite_sum->bool)
(interval[vec 0,vec 1])`) THEN
ASM_SIMP_TAC[
FORALL_IN_IMAGE;
OPEN_PCROSS] THEN ANTS_TAC THENL
[REWRITE_TAC[
SUBSET;
FORALL_IN_PCROSS;
IN_SING] THEN
MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN
ASM_REWRITE_TAC[
UNIONS_IMAGE;
IN_ELIM_THM;
PASTECART_IN_PCROSS] THEN
ASM_MESON_TAC[
IN_INTER];
GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
REWRITE_TAC[
EXISTS_FINITE_SUBSET_IMAGE] THEN
DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN
ABBREV_TAC `n =
INTERS (
IMAGE (nn:real^1->real^P->bool) tk)` THEN
SUBGOAL_THEN `(y:real^P)
IN n /\ open n` STRIP_ASSUME_TAC THENL
[EXPAND_TAC "n" THEN CONJ_TAC THENL
[REWRITE_TAC[
INTERS_IMAGE;
IN_ELIM_THM];
MATCH_MP_TAC
OPEN_INTERS THEN REWRITE_TAC[
FORALL_IN_IMAGE] THEN
ASM_SIMP_TAC[
FINITE_IMAGE]] THEN
X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
(ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[
IN_INTER]]);
ALL_TAC] THEN
MP_TAC(ISPECL
[`interval[vec 0:real^1,vec 1]`; `
IMAGE (kk:real^1->real^1->bool) tk`]
LEBESGUE_COVERING_LEMMA) THEN
REWRITE_TAC[
COMPACT_INTERVAL;
FORALL_IN_IMAGE;
IMAGE_EQ_EMPTY] THEN
MATCH_MP_TAC(TAUT
`q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t)
==> (~p /\ q /\ r ==> s) ==> t`) THEN
SIMP_TAC[
UNIONS_0;
IMAGE_CLAUSES;
SUBSET_EMPTY;
UNIT_INTERVAL_NONEMPTY] THEN
CONJ_TAC THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [
UNIONS_IMAGE]) THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_PCROSS;
IMP_CONJ;
IN_SING] THEN
REWRITE_TAC[
RIGHT_FORALL_IMP_THM;
FORALL_UNWIND_THM2] THEN
REWRITE_TAC[
UNIONS_IMAGE;
IN_ELIM_THM;
PASTECART_IN_PCROSS] THEN
MESON_TAC[];
DISCH_TAC] THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
MP_TAC(ISPEC `d:real`
REAL_ARCH_INV) THEN
ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN
`!n. n <= N
==> ?v k:real^(1,P)finite_sum->real^M.
open_in (subtopology euclidean u) v /\
y
IN v /\
k
continuous_on interval[vec 0,lift(&n / &N)]
PCROSS v /\
IMAGE k (interval[vec 0,lift(&n / &N)]
PCROSS v)
SUBSET c /\
(!y. y
IN v ==> k (pastecart (vec 0) y) = f y) /\
(!z. z
IN interval[vec 0,lift(&n / &N)]
PCROSS v
==> h z:real^N = p (k z))`
MP_TAC THENL
[ALL_TAC;
DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[
LE_REFL] THEN
ASM_SIMP_TAC[
REAL_DIV_REFL; REAL_OF_NUM_EQ;
LIFT_NUM]] THEN
MATCH_MP_TAC
num_INDUCTION THEN CONJ_TAC THENL
[DISCH_TAC THEN REWRITE_TAC[
real_div;
REAL_MUL_LZERO;
LIFT_NUM] THEN
EXISTS_TAC `u:real^P->bool` THEN
EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_PCROSS;
INTERVAL_SING] THEN
REWRITE_TAC[
IMP_CONJ;
RIGHT_FORALL_IMP_THM;
IN_SING;
o_THM] THEN
ASM_REWRITE_TAC[
FORALL_UNWIND_THM2;
SNDCART_PASTECART] THEN
REWRITE_TAC[
OPEN_IN_SUBTOPOLOGY_REFL;
TOPSPACE_EUCLIDEAN;
SUBSET_UNIV] THEN
CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[
LINEAR_CONTINUOUS_ON;
LINEAR_SNDCART] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_PCROSS] THEN
SIMP_TAC[
SNDCART_PASTECART];
ALL_TAC] THEN
X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN
ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`;
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC
[`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN
STRIP_TAC THEN FIRST_X_ASSUM
(MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN
ANTS_TAC THENL
[REWRITE_TAC[
DIAMETER_INTERVAL;
SUBSET_INTERVAL_1] THEN
REWRITE_TAC[
LIFT_DROP;
DROP_VEC;
INTERVAL_EQ_EMPTY_1;
GSYM
LIFT_SUB;
NORM_LIFT] THEN
ASM_SIMP_TAC[
REAL_LT_DIV2_EQ;
REAL_LE_DIV2_EQ;
REAL_OF_NUM_LT;
LE_1;
REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN
SIMP_TAC[GSYM
NOT_LE; ARITH_RULE `m <= SUC m`;
REAL_OF_NUM_SUB] THEN
ASM_SIMP_TAC[
REAL_ABS_DIV;
REAL_ABS_NUM;
REAL_LE_DIV;
REAL_POS;
REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN
ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`;
REAL_LT_IMP_LE] THEN
ASM_SIMP_TAC[
REAL_LE_LDIV_EQ;
REAL_OF_NUM_LT;
LE_1] THEN
ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC;
ALL_TAC] THEN
REWRITE_TAC[
EXISTS_IN_IMAGE] THEN
DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN
ASM_REWRITE_TAC[] THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
ONCE_REWRITE_TAC[
IMP_CONJ] THEN
GEN_REWRITE_TAC LAND_CONV [
EXTENSION] THEN
DISCH_THEN(MP_TAC o SPEC
`(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN
REWRITE_TAC[
IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT
`q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [
IN_INTER])) THEN
SUBGOAL_THEN
`lift(&m / &N)
IN interval[vec 0,lift (&m / &N)] /\
lift(&m / &N)
IN interval[lift(&m / &N),lift(&(SUC m) / &N)]`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[
IN_INTERVAL_1;
LIFT_DROP;
DROP_VEC] THEN
SIMP_TAC[
REAL_LE_DIV;
REAL_POS;
REAL_LE_REFL] THEN
ASM_SIMP_TAC[
REAL_LE_DIV2_EQ;
LE_1;
REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
ARITH_TAC;
ALL_TAC] THEN
REPEAT CONJ_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [
SUBSET]) THEN
MATCH_MP_TAC
FUN_IN_IMAGE THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS];
FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS] THEN
DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
(SET_RULE `
IMAGE h s
SUBSET t ==> x
IN s ==> h x
IN t`)) THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS;
IN_INTER] THEN
ASM_SIMP_TAC[
IN_INTERVAL_1;
LIFT_DROP;
REAL_LE_DIV;
REAL_LE_LDIV_EQ;
REAL_POS;
REAL_OF_NUM_LT;
LE_1;
DROP_VEC] THEN
REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN
CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [
SUBSET]) THEN
ASM_REWRITE_TAC[];
GEN_REWRITE_TAC LAND_CONV [
IN_UNIONS] THEN
DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN
DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool)
IN vv` (K ALL_TAC)] THEN
ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN
SUBGOAL_THEN
`?n'.
open_in (subtopology euclidean u) n' /\ y
IN n' /\
IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)}
PCROSS n')
SUBSET w`
STRIP_ASSUME_TAC THENL
[EXISTS_TAC
`{z | z
IN v /\ ((k:real^(1,P)finite_sum->real^M) o
pastecart (lift(&m / &N))) z
IN w}` THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_PCROSS] THEN
ASM_SIMP_TAC[
IN_ELIM_THM;
IN_SING;
o_THM] THEN
MATCH_MP_TAC
OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[GSYM
o_DEF] THEN CONJ_TAC THENL
[MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[
CONTINUOUS_ON_PASTECART;
CONTINUOUS_ON_CONST;
CONTINUOUS_ON_ID] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET));
REWRITE_TAC[
IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`
IMAGE k s
SUBSET c ==> t
SUBSET s ==>
IMAGE k t
SUBSET c`))] THEN
ASM_SIMP_TAC[
SUBSET;
FORALL_IN_IMAGE;
PASTECART_IN_PCROSS];
ALL_TAC] THEN
SUBGOAL_THEN
`?q q':real^P->bool.
open_in (subtopology euclidean u) q /\
closed_in (subtopology euclidean u) q' /\
y
IN q /\ y
IN q' /\ q
SUBSET q' /\
q
SUBSET (u
INTER nn(t:real^1))
INTER n'
INTER v /\
q'
SUBSET (u
INTER nn(t:real^1))
INTER n'
INTER v`
STRIP_ASSUME_TAC THENL
[REWRITE_TAC[SET_RULE
`y
IN q /\ y
IN q' /\ q
SUBSET q' /\ q
SUBSET s /\ q'
SUBSET s <=>
y
IN q /\ q
SUBSET q' /\ q'
SUBSET s`] THEN
UNDISCH_TAC `
open_in (subtopology euclidean u) (v:real^P->bool)` THEN
UNDISCH_TAC `
open_in (subtopology euclidean u) (n':real^P->bool)` THEN
REWRITE_TAC[
OPEN_IN_OPEN] THEN
DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN
DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN
MP_TAC(ISPEC `nn(t:real^1)
INTER vo
INTER vx:real^P->bool`
OPEN_CONTAINS_CBALL) THEN
ASM_SIMP_TAC[
OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN
ASM_REWRITE_TAC[
IN_INTER] THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `u
INTER ball(y:real^P,e)` THEN
EXISTS_TAC `u
INTER cball(y:real^P,e)` THEN
REWRITE_TAC[
CLOSED_IN_CLOSED] THEN
CONJ_TAC THENL [MESON_TAC[
OPEN_BALL]; ALL_TAC] THEN
CONJ_TAC THENL [MESON_TAC[
CLOSED_CBALL]; ALL_TAC] THEN
ASM_REWRITE_TAC[
IN_INTER;
CENTRE_IN_BALL] THEN
MP_TAC(ISPECL [`y:real^P`; `e:real`]
BALL_SUBSET_CBALL) THEN
ASM SET_TAC[];
ALL_TAC] THEN
FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
MP_TAC(ISPECL
[`\x:real^(1,P)finite_sum.
x
IN interval[vec 0,lift(&m / &N)]
PCROSS (q':real^P->bool)`;
`k:real^(1,P)finite_sum->real^M`;
`(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`;
`interval[vec 0,lift(&m / &N)]
PCROSS (q':real^P->bool)`;
`interval[lift(&m / &N),lift(&(SUC m) / &N)]
PCROSS (q':real^P->bool)`]
CONTINUOUS_ON_CASES_LOCAL) THEN
REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL
[REPEAT CONJ_TAC THENL
[REWRITE_TAC[
CLOSED_IN_CLOSED] THEN
EXISTS_TAC `interval[vec 0,lift(&m / &N)]
PCROSS (:real^P)` THEN
SIMP_TAC[
CLOSED_PCROSS;
CLOSED_INTERVAL;
CLOSED_UNIV] THEN
REWRITE_TAC[
EXTENSION;
IN_INTER;
IN_UNION;
FORALL_PASTECART] THEN
REWRITE_TAC[
PASTECART_IN_PCROSS;
IN_UNIV] THEN CONV_TAC TAUT;
REWRITE_TAC[
CLOSED_IN_CLOSED] THEN EXISTS_TAC
`interval[lift(&m / &N),lift(&(SUC m) / &N)]
PCROSS (:real^P)` THEN
SIMP_TAC[
CLOSED_PCROSS;
CLOSED_INTERVAL;
CLOSED_UNIV] THEN
REWRITE_TAC[
EXTENSION;
IN_INTER;
IN_UNION;
FORALL_PASTECART] THEN
REWRITE_TAC[
PASTECART_IN_PCROSS;
IN_UNIV] THEN CONV_TAC TAUT;
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
REWRITE_TAC[
SUBSET;
FORALL_PASTECART;
PASTECART_IN_PCROSS] THEN
ASM SET_TAC[];
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET))
THENL
[ALL_TAC;
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`
IMAGE k s
SUBSET c ==> t
SUBSET s ==>
IMAGE k t
SUBSET c`))] THEN
MATCH_MP_TAC
PCROSS_MONO THEN
(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
ASM_REWRITE_TAC[
SUBSET_INTERVAL_1;
LIFT_DROP;
DROP_VEC;
SUBSET_INTER] THEN
REWRITE_TAC[
SUBSET_INTERVAL_1;
LIFT_DROP;
DROP_VEC] THEN
ASM_SIMP_TAC[
REAL_LE_MUL;
REAL_POS;
REAL_LE_DIV2_EQ;
REAL_OF_NUM_LT;
LE_1] THEN
ASM_SIMP_TAC[
REAL_LE_LDIV_EQ;
REAL_LE_RDIV_EQ;
REAL_OF_NUM_LT;
LE_1;
REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
DISJ2_TAC THEN ARITH_TAC;
REWRITE_TAC[
FORALL_PASTECART;
PASTECART_IN_PCROSS] THEN
MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN
ASM_CASES_TAC `(z:real^P)
IN q'` THEN ASM_REWRITE_TAC[] THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP
(REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN
REWRITE_TAC[
DROP_EQ;
o_THM] THEN DISCH_THEN SUBST1_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
`(!x. x
IN w ==> p' (p x) = x)
==> h z = p(k z) /\ k z
IN w
==> k z = p' (h z)`)) THEN
CONJ_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [
SUBSET]) THEN
MATCH_MP_TAC
FUN_IN_IMAGE THEN
REWRITE_TAC[
PASTECART_IN_PCROSS;
IN_SING] THEN ASM SET_TAC[]]];
SUBGOAL_THEN
`interval[vec 0,lift(&m / &N)]
UNION
interval [lift(&m / &N),lift(&(SUC m) / &N)] =
interval[vec 0,lift(&(SUC m) / &N)]`
ASSUME_TAC THENL
[REWRITE_TAC[
EXTENSION;
IN_UNION;
IN_INTERVAL_1] THEN GEN_TAC THEN
MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==>
(a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN
SIMP_TAC[
LIFT_DROP;
DROP_VEC;
REAL_LE_DIV;
REAL_POS] THEN
ASM_SIMP_TAC[
REAL_LE_DIV2_EQ;
REAL_OF_NUM_LT; REAL_OF_NUM_LE;
LE_1] THEN
ARITH_TAC;
ALL_TAC] THEN
SUBGOAL_THEN
`interval[vec 0,lift(&m / &N)]
PCROSS (q':real^P->bool)
UNION
interval [lift(&m / &N),lift(&(SUC m) / &N)]
PCROSS q' =
interval[vec 0,lift(&(SUC m) / &N)]
PCROSS q'`
SUBST1_TAC THENL
[SIMP_TAC[
EXTENSION;
IN_UNION;
FORALL_PASTECART;
PASTECART_IN_PCROSS] THEN
ASM SET_TAC[];
ALL_TAC] THEN
MATCH_MP_TAC(MESON[
CONTINUOUS_ON_SUBSET]
`t
SUBSET s /\ (f
continuous_on s ==> P f)
==> f
continuous_on s ==> ?g. g
continuous_on t /\ P g`) THEN
ASM_SIMP_TAC[
PCROSS_MONO;
SUBSET_REFL] THEN DISCH_TAC THEN
REPEAT CONJ_TAC THENL
[REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
FORALL_IN_PCROSS] THEN
MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
SUBGOAL_THEN `(z:real^P)
IN q'` ASSUME_TAC THENL
[ASM SET_TAC[]; ASM_REWRITE_TAC[
PASTECART_IN_PCROSS]] THEN
COND_CASES_TAC THEN REWRITE_TAC[
o_THM] THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [
SUBSET]) THEN
MATCH_MP_TAC
FUN_IN_IMAGE THEN
REWRITE_TAC[
PASTECART_IN_PCROSS;
IN_SING] THEN ASM SET_TAC[];
FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[
SUBSET] o
CONJUNCT1 o GEN_REWRITE_RULE I [
open_in]) THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
`
IMAGE p w' = w ==> x
IN w' ==> p x
IN w`))];
X_GEN_TAC `z:real^P` THEN REWRITE_TAC[
PASTECART_IN_PCROSS] THEN
DISCH_TAC THEN REWRITE_TAC[
IN_INTERVAL_1;
REAL_LE_REFL] THEN
SUBGOAL_THEN `(z:real^P)
IN q'` ASSUME_TAC THENL
[ASM SET_TAC[]; ASM_REWRITE_TAC[
LIFT_DROP;
DROP_VEC]] THEN
SIMP_TAC[
REAL_LE_DIV;
REAL_POS] THEN ASM SET_TAC[];
REWRITE_TAC[
FORALL_PASTECART;
PASTECART_IN_PCROSS] THEN
MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
SUBGOAL_THEN `(z:real^P)
IN q'` ASSUME_TAC THENL
[ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
REWRITE_TAC[
o_THM] THEN CONV_TAC SYM_CONV THEN
FIRST_X_ASSUM MATCH_MP_TAC]] THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
(SET_RULE `
IMAGE h s
SUBSET t ==> x
IN s ==> h x
IN t`)) THEN
ASM_REWRITE_TAC[
PASTECART_IN_PCROSS;
IN_INTER] THEN
REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
RULE_ASSUM_TAC(REWRITE_RULE[
IN_INTERVAL_1]) THEN
REWRITE_TAC[
IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
(REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN
ASM_SIMP_TAC[
LIFT_DROP;
REAL_LE_LDIV_EQ;
REAL_OF_NUM_LT;
LE_1] THEN
ASM_REWRITE_TAC[
DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);;
(* ------------------------------------------------------------------------- *)
(* Lifting of general functions to covering space *)
(* ------------------------------------------------------------------------- *)
let COVERING_SPACE_LIFT_GENERAL = prove
(`!p:real^M->real^N c s f:real^P->real^N u a z.
covering_space (c,p) s /\ a IN c /\ z IN u /\
path_connected u /\ locally path_connected u /\
f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
(!r. path r /\ path_image r SUBSET u /\
pathstart r = z /\ pathfinish r = z
==> ?q. path q /\ path_image q SUBSET c /\
pathstart q = a /\ pathfinish q = a /\
homotopic_paths s (f o r) (p o q))
==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
(!y. y IN u ==> p(g y) = f y)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN
`!y. y
IN u
==> ?g h. path g /\
path_image g
SUBSET u /\
pathstart g = z /\ pathfinish g = y /\
path h /\
path_image h
SUBSET c /\ pathstart h = a /\
(!t. t
IN interval[vec 0,vec 1]
==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))`
(LABEL_TAC "*")
THENL
[X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
path_connected]) THEN
DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
MONO_EXISTS THEN
X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
COVERING_SPACE_LIFT_PATH_STRONG THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM
o_DEF] THEN
ASM_REWRITE_TAC[
PATH_IMAGE_COMPOSE;
PATHSTART_COMPOSE] THEN
CONJ_TAC THENL
[MATCH_MP_TAC
PATH_CONTINUOUS_IMAGE THEN
ASM_MESON_TAC[
CONTINUOUS_ON_SUBSET];
ASM SET_TAC[]];
ALL_TAC] THEN
SUBGOAL_THEN
`?l. !y g h. path g /\
path_image g
SUBSET u /\
pathstart g = z /\ pathfinish g = y /\
path h /\
path_image h
SUBSET c /\ pathstart h = a /\
(!t. t
IN interval[vec 0,vec 1]
==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))
==> pathfinish h = l y`
MP_TAC THENL
[REWRITE_TAC[GSYM
SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN
MATCH_MP_TAC(MESON[]
`(!g h g' h'. P g h /\ P g' h' ==> f h = f h')
==> ?z. !g h. P g h ==> f h = z`) THEN
REPEAT STRIP_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN
ASM_SIMP_TAC[
PATH_JOIN;
PATHSTART_JOIN;
PATHFINISH_JOIN;
PATH_REVERSEPATH;
PATHSTART_REVERSEPATH;
PATHFINISH_REVERSEPATH;
SUBSET_PATH_IMAGE_JOIN;
PATH_IMAGE_REVERSEPATH] THEN
DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN
FIRST_ASSUM(MP_TAC o
ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`;
`(f:real^P->real^N) o (g ++ reversepath g')`;
`q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o
MATCH_MP(ONCE_REWRITE_RULE[
IMP_CONJ]
(ONCE_REWRITE_RULE[
HOMOTOPIC_PATHS_SYM]
COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN
ASM_REWRITE_TAC[
o_THM] THEN
DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL
[ALL_TAC;
ASM_SIMP_TAC[
PATH_JOIN_EQ;
PATH_REVERSEPATH;
PATHSTART_REVERSEPATH]] THEN
MATCH_MP_TAC
PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN
ASM_REWRITE_TAC[] THEN
X_GEN_TAC `t:real^1` THEN REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC] THEN
STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL
[FIRST_ASSUM(MP_TAC o
ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`;
`q':real^1->real^M`;
`(h:real^1->real^M) o (\t. &2 % t)`;
`interval[vec 0,lift(&1 / &2)]`;
`vec 0:real^1`; `t:real^1`] o
MATCH_MP (ONCE_REWRITE_RULE[
IMP_CONJ]
COVERING_SPACE_LIFT_UNIQUE)) THEN
REWRITE_TAC[
o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
REPEAT CONJ_TAC THENL
[MATCH_MP_TAC
CONTINUOUS_ON_EQ THEN
EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
CONJ_TAC THENL
[SIMP_TAC[
IN_INTERVAL_1;
LIFT_DROP; joinpaths;
o_THM];
ALL_TAC] THEN
MATCH_MP_TAC
CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
[ASM_MESON_TAC[
HOMOTOPIC_PATHS_IMP_PATH; path];
REWRITE_TAC[
SUBSET_INTERVAL_1;
LIFT_DROP;
DROP_VEC] THEN
REAL_ARITH_TAC];
MATCH_MP_TAC
SUBSET_TRANS THEN EXISTS_TAC
`
path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[
HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
REWRITE_TAC[
path_image] THEN MATCH_MP_TAC(SET_RULE
`(!x. x
IN s ==> f x = g x) /\ s
SUBSET t
==>
IMAGE f s
SUBSET IMAGE g t`) THEN
REWRITE_TAC[
SUBSET_INTERVAL_1;
LIFT_DROP;
DROP_VEC;
IN_INTERVAL_1] THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths;
o_THM];
MATCH_MP_TAC
CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
ASM_REWRITE_TAC[GSYM path] THEN
REWRITE_TAC[
SUBSET_INTERVAL_1;
LIFT_DROP;
DROP_VEC] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC
SUBSET_TRANS THEN EXISTS_TAC
`
path_image(q':real^1->real^M)` THEN
ASM_REWRITE_TAC[] THEN REWRITE_TAC[
path_image] THEN
MATCH_MP_TAC
IMAGE_SUBSET THEN
REWRITE_TAC[
SUBSET_INTERVAL_1;
LIFT_DROP;
DROP_VEC] THEN
REAL_ARITH_TAC;
X_GEN_TAC `t':real^1` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
LIFT_DROP] THEN STRIP_TAC THEN
FIRST_X_ASSUM(fun th ->
W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
ASM_SIMP_TAC[
IN_INTERVAL_1; joinpaths;
DROP_VEC] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[
CONTINUOUS_ON_CMUL;
CONTINUOUS_ON_ID] THEN
MATCH_MP_TAC
CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
ASM_SIMP_TAC[GSYM path] THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE] THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
LIFT_DROP] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC
SUBSET_TRANS THEN
EXISTS_TAC `
path_image(h:real^1->real^M)` THEN
CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN
REWRITE_TAC[
path_image;
IMAGE_o] THEN MATCH_MP_TAC
IMAGE_SUBSET THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
IN_INTERVAL_1] THEN
REWRITE_TAC[
DROP_VEC;
DROP_CMUL;
LIFT_DROP] THEN
REAL_ARITH_TAC;
X_GEN_TAC `t':real^1` THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
LIFT_DROP] THEN STRIP_TAC THEN
CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL] THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[
CONNECTED_INTERVAL];
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
LIFT_DROP] THEN REAL_ARITH_TAC;
GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN
ASM_REWRITE_TAC[] THEN
SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN
REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
REWRITE_TAC[
VECTOR_MUL_RZERO];
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
LIFT_DROP] THEN
ASM_REAL_ARITH_TAC];
FIRST_ASSUM(MP_TAC o
ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o
(\t. &2 % t - vec 1)`;
`q':real^1->real^M`;
`reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`;
`{t | &1 / &2 < drop t /\ drop t <= &1}`;
`vec 1:real^1`; `t:real^1`] o
MATCH_MP (ONCE_REWRITE_RULE[
IMP_CONJ]
COVERING_SPACE_LIFT_UNIQUE)) THEN
REWRITE_TAC[
o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
REPEAT CONJ_TAC THENL
[MATCH_MP_TAC
CONTINUOUS_ON_EQ THEN
EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
CONJ_TAC THENL
[SIMP_TAC[
IN_ELIM_THM; GSYM
REAL_NOT_LE; joinpaths;
o_THM];
ALL_TAC] THEN
MATCH_MP_TAC
CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
[ASM_MESON_TAC[
HOMOTOPIC_PATHS_IMP_PATH; path];
REWRITE_TAC[
SUBSET;
IN_ELIM_THM;
IN_INTERVAL_1;
DROP_VEC] THEN
REAL_ARITH_TAC];
MATCH_MP_TAC
SUBSET_TRANS THEN EXISTS_TAC
`
path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[
HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
REWRITE_TAC[
path_image] THEN MATCH_MP_TAC(SET_RULE
`(!x. x
IN s ==> f x = g x) /\ s
SUBSET t
==>
IMAGE f s
SUBSET IMAGE g t`) THEN
SIMP_TAC[
IN_ELIM_THM; GSYM
REAL_NOT_LE; joinpaths;
o_THM] THEN
REWRITE_TAC[
SUBSET;
IN_ELIM_THM;
IN_INTERVAL_1;
DROP_VEC] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC
CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
ASM_REWRITE_TAC[GSYM path] THEN
REWRITE_TAC[
SUBSET;
IN_ELIM_THM;
IN_INTERVAL_1;
DROP_VEC] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC
SUBSET_TRANS THEN EXISTS_TAC
`
path_image(q':real^1->real^M)` THEN
ASM_REWRITE_TAC[] THEN REWRITE_TAC[
path_image] THEN
MATCH_MP_TAC
IMAGE_SUBSET THEN
REWRITE_TAC[
SUBSET;
IN_ELIM_THM;
IN_INTERVAL_1;
DROP_VEC] THEN
REAL_ARITH_TAC;
X_GEN_TAC `t':real^1` THEN REWRITE_TAC[
IN_ELIM_THM] THEN STRIP_TAC THEN
FIRST_X_ASSUM(fun th ->
W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
ASM_SIMP_TAC[
IN_INTERVAL_1; joinpaths;
DROP_VEC; GSYM
REAL_NOT_LT] THEN
ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
SIMP_TAC[
CONTINUOUS_ON_SUB;
CONTINUOUS_ON_CMUL;
CONTINUOUS_ON_ID;
CONTINUOUS_ON_CONST] THEN
MATCH_MP_TAC
CONTINUOUS_ON_SUBSET THEN
EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
ASM_SIMP_TAC[GSYM path;
PATH_REVERSEPATH] THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
IN_ELIM_THM] THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
REAL_ARITH_TAC;
MATCH_MP_TAC
SUBSET_TRANS THEN
EXISTS_TAC `
path_image(reversepath h':real^1->real^M)` THEN
CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[
PATH_IMAGE_REVERSEPATH]] THEN
REWRITE_TAC[
path_image;
IMAGE_o] THEN MATCH_MP_TAC
IMAGE_SUBSET THEN
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE;
IN_ELIM_THM] THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
REAL_ARITH_TAC;
X_GEN_TAC `t':real^1` THEN REWRITE_TAC[
IN_ELIM_THM] THEN STRIP_TAC THEN
REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN
FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_SUB;
DROP_VEC;
DROP_CMUL] THEN
ASM_REAL_ARITH_TAC;
REWRITE_TAC[GSYM
IS_INTERVAL_CONNECTED_1;
IS_INTERVAL_1] THEN
REWRITE_TAC[
IN_ELIM_THM] THEN REAL_ARITH_TAC;
REWRITE_TAC[
IN_ELIM_THM;
DROP_VEC] THEN REAL_ARITH_TAC;
GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN
ASM_REWRITE_TAC[reversepath] THEN
SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN
REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
REWRITE_TAC[GSYM
DROP_EQ;
DROP_SUB;
DROP_CMUL;
DROP_VEC] THEN
REAL_ARITH_TAC;
REWRITE_TAC[
IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]];
ALL_TAC] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN
DISCH_THEN(LABEL_TAC "+") THEN
MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL
[STRIP_TAC;
REWRITE_TAC[
SUBSET;
FORALL_IN_IMAGE] THEN
X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
ASM_MESON_TAC[
PATHFINISH_IN_PATH_IMAGE;
SUBSET];
FIRST_ASSUM(MP_TAC o SPECL
[`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN
REWRITE_TAC[
PATH_LINEPATH;
PATH_IMAGE_LINEPATH;
SEGMENT_REFL] THEN
REWRITE_TAC[
PATHSTART_LINEPATH;
PATHFINISH_LINEPATH] THEN
ASM_SIMP_TAC[
LINEPATH_REFL;
SING_SUBSET];
X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
ASM_REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN
STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
[`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN
ASM_MESON_TAC[pathfinish;
ENDS_IN_UNIT_INTERVAL]] THEN
FIRST_ASSUM(fun th ->
GEN_REWRITE_TAC I [MATCH_MP
CONTINUOUS_ON_OPEN_GEN th]) THEN
X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN
ONCE_REWRITE_TAC[
OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN
REWRITE_TAC[
IN_ELIM_THM] THEN STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [
open_in]) THEN
FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o
GEN_REWRITE_RULE I [
covering_space]) THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
ONCE_REWRITE_TAC[
IMP_CONJ] THEN
GEN_REWRITE_TAC LAND_CONV [
EXTENSION] THEN
DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN
MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[
IN_UNIONS]] THEN
DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN
DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN
DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool)
IN vv` (K ALL_TAC) THEN
SUBGOAL_THEN
`?v. y
IN v /\ y
IN u /\
IMAGE (f:real^P->real^N) v
SUBSET w /\
v
SUBSET u /\
path_connected v /\
open_in (subtopology euclidean u) v`
STRIP_ASSUME_TAC THENL
[FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN
DISCH_THEN(MP_TAC o SPECL
[`{x | x
IN u /\ (f:real^P->real^N) x
IN w}`; `y:real^P`]) THEN
ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC
MONO_EXISTS THEN ASM SET_TAC[]] THEN
CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
MATCH_MP_TAC
CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
ALL_TAC] THEN
FIRST_X_ASSUM(STRIP_ASSUME_TAC o
GEN_REWRITE_RULE I [homeomorphism]) THEN
SUBGOAL_THEN `(w':real^M->bool)
SUBSET c /\ (w:real^N->bool)
SUBSET s`
STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[
open_in]; ALL_TAC] THEN
EXISTS_TAC
`v
INTER
{x | x
IN u /\ (f:real^P->real^N) x
IN
{x | x
IN w /\ (p':real^N->real^M) x
IN w'
INTER n}}` THEN
REPEAT CONJ_TAC THENL
[MATCH_MP_TAC
OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[
SUBSET_REFL] THEN
UNDISCH_TAC `
open_in (subtopology euclidean c) (n:real^M->bool)` THEN
REWRITE_TAC[
OPEN_IN_OPEN] THEN MATCH_MP_TAC
MONO_EXISTS THEN ASM SET_TAC[];
ASM SET_TAC[];
ALL_TAC] THEN
SIMP_TAC[
SUBSET;
IN_INTER;
IN_ELIM_THM] THEN
X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
path_connected]) THEN
DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN
ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN
REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
ASM_REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN
MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN
STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o SPECL
[`y':real^P`; `(pp:real^1->real^P) ++ r`;
`(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o
(r:real^1->real^P))`]) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN
ASM_SIMP_TAC[
o_THM;
PATHSTART_JOIN;
PATHFINISH_JOIN] THEN DISCH_TAC THEN
SUBGOAL_THEN
`
path_image ((pp:real^1->real^P) ++ r)
SUBSET u`
ASSUME_TAC THENL
[MATCH_MP_TAC
SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN
ANTS_TAC THENL
[ALL_TAC;
ASM_REWRITE_TAC[
PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN
REPEAT CONJ_TAC THENL
[ASM_SIMP_TAC[
PATH_JOIN];
ASM_SIMP_TAC[
SUBSET_PATH_IMAGE_JOIN];
MATCH_MP_TAC
PATH_JOIN_IMP THEN ASM_SIMP_TAC[
PATHSTART_COMPOSE] THEN
CONJ_TAC THENL
[REWRITE_TAC[
o_ASSOC] THEN MATCH_MP_TAC
PATH_CONTINUOUS_IMAGE THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
CONTINUOUS_ON_COMPOSE THEN
CONJ_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
CONTINUOUS_ON_SUBSET)) THEN
ASM SET_TAC[];
REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]];
MATCH_MP_TAC
SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN
REWRITE_TAC[
PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[];
X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC] THEN
STRIP_TAC THEN REWRITE_TAC[joinpaths;
o_THM] THEN COND_CASES_TAC THEN
ASM_REWRITE_TAC[] THENL
[ABBREV_TAC `t:real^1 = &2 % tt`;
ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN
(SUBGOAL_THEN `t
IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
[EXPAND_TAC "t" THEN
REWRITE_TAC[
IN_INTERVAL_1;
DROP_VEC;
DROP_CMUL;
DROP_SUB] THEN
ASM_REAL_ARITH_TAC;
ALL_TAC]) THEN
ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
RULE_ASSUM_TAC(REWRITE_RULE[
path_image]) THEN ASM SET_TAC[]]);;
(* ------------------------------------------------------------------------- *)
(* Some additional lemmas about covering spaces. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Results on finiteness of the number of sheets in a covering space. *)
(* ------------------------------------------------------------------------- *)
let COVERING_SPACE_FIBRE_NO_LIMPT = prove
(`!p:real^M->real^N c s a b.
covering_space (c,p) s /\ a IN c
==> ~(a limit_point_of {x | x IN c /\ p x = b})`,
REPEAT STRIP_TAC THEN
FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [
covering_space]) THEN
FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN
ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
GEN_REWRITE_TAC I [
IMP_CONJ] THEN
REWRITE_TAC[
EXTENSION;
IN_UNIONS;
IN_ELIM_THM] THEN
DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
STRIP_TAC THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN
ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
UNDISCH_TAC `
open_in (subtopology euclidean c) (t:real^M->bool)` THEN
REWRITE_TAC[
OPEN_IN_OPEN] THEN
DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o
GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[
INFINITE]] THEN
MATCH_MP_TAC(MESON[
FINITE_SING;
FINITE_SUBSET]
`(?a. s
SUBSET {a}) ==>
FINITE s`) THEN
ASM SET_TAC[]);;
let COVERING_SPACE_CLOSED_MAP = prove
(`!p:real^M->real^N c s t.
covering_space (c,p) s /\
(!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\
closed_in (subtopology euclidean c) t
==> closed_in (subtopology euclidean s) (IMAGE p t)`,
REPEAT STRIP_TAC THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP
CLOSED_IN_IMP_SUBSET) THEN
FIRST_ASSUM(ASSUME_TAC o MATCH_MP
COVERING_SPACE_IMP_SURJECTIVE) THEN
REWRITE_TAC[
closed_in;
TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL
[ASM SET_TAC[]; ONCE_REWRITE_TAC[
OPEN_IN_SUBOPEN]] THEN
X_GEN_TAC `y:real^N` THEN REWRITE_TAC[
IN_DIFF] THEN STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o
GEN_REWRITE_RULE I [
covering_space]) THEN
ASM_REWRITE_TAC[
LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
DISCH_TAC THEN
DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL
[ASM_REWRITE_TAC[
UNIONS_0;
NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN
EXISTS_TAC `
INTERS {
IMAGE (p:real^M->real^N) (u
DIFF t) | u
IN uu}` THEN
REPEAT CONJ_TAC THENL
[MATCH_MP_TAC
OPEN_IN_INTERS THEN
ASM_REWRITE_TAC[
SIMPLE_IMAGE;
FORALL_IN_IMAGE;
IMAGE_EQ_EMPTY] THEN
CONJ_TAC THENL
[MATCH_MP_TAC
FINITE_IMAGE THEN
SUBGOAL_THEN
`!u. u
IN uu ==> ?x. x
IN u /\ (p:real^M->real^N) x = y`
ASSUME_TAC THENL
[RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
ALL_TAC] THEN
SUBGOAL_THEN
`
FINITE (
IMAGE (\u. @x. x
IN u /\ (p:real^M->real^N) x = y) uu)`
MP_TAC THENL
[FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[
IMP_CONJ]
FINITE_SUBSET)) THEN ASM SET_TAC[];
MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC
FINITE_IMAGE_INJ_EQ THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
REPEAT(MATCH_MP_TAC
MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]];
X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
MATCH_MP_TAC
OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
HOMEOMORPHISM_IMP_OPEN_MAP THEN
ONCE_REWRITE_TAC[
SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN
ASM_SIMP_TAC[
LEFT_EXISTS_AND_THM] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
CLOSED_IN_CLOSED]) THEN
DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
ASM_REWRITE_TAC[
OPEN_IN_OPEN] THEN
EXISTS_TAC `(:real^M)
DIFF k` THEN
ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]];
REWRITE_TAC[
IN_INTERS;
FORALL_IN_GSPEC] THEN
X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[];
REWRITE_TAC[
SUBSET;
INTERS_GSPEC;
IN_DIFF;
IN_ELIM_THM] THEN
X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[
IN_IMAGE]] THEN
DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM SUBST_ALL_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
EXTENSION]) THEN
DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN
REWRITE_TAC[
IN_ELIM_THM] THEN
MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN
RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
REWRITE_TAC[
IN_UNIONS] THEN ASM SET_TAC[]]);;
let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove
(`!p:real^M->real^N c s.
covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s)
==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
(!t. closed_in (subtopology euclidean c) t
==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
let lemma = prove
(`!f:num->real^N.
(!n. ~(s = v n) ==> DISJOINT s (v n))
==> (!n. f n IN v n) /\
(!m n. v m = v n <=> m = n)
==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`,
ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL
[REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS);
RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN
ASM_REWRITE_TAC[]] THEN
ASM SET_TAC[]) in
REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
[MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN
EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[];
ALL_TAC] THEN
REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN
FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o
GEN_REWRITE_RULE I [covering_space]) THEN
ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN
REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL
[MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[];
PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN
DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL
[FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN
SUBGOAL_THEN
`!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v`
MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN
REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
[ASM SET_TAC[]; ALL_TAC] THEN
MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
FIRST_X_ASSUM(fun th ->
MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN
ASM_REWRITE_TAC[] THEN
RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
ALL_TAC] THEN
REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN
REWRITE_TAC[IN_UNIV] THEN
DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN
UNDISCH_THEN
`!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)`
(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN
DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN
`closed_in (subtopology euclidean s)
(IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))`
MP_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC THEN
REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN
CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN
FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL
[MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
EXISTS_TAC
`(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN
REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
[MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
(fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN
EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
[ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]];
REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
(REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN
MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN
ASM SET_TAC[]];
SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL
[ASM SET_TAC[]; ALL_TAC] THEN
SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w`
(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))
THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN
ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
`INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN
DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL
[ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN
ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN
ASM_REWRITE_TAC[] THEN
DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
ASM_REWRITE_TAC[] THEN
DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o
MATCH_MP lemma) THEN
ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]];
SUBGOAL_THEN
`IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) =
IMAGE y (:num)`
SUBST1_TAC THENL
[REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN
REWRITE_TAC[CLOSED_IN_LIMPT] THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN
ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN
EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);;
(* ------------------------------------------------------------------------- *)
(* Special cases where one or both of the sets is compact. *)
(* ------------------------------------------------------------------------- *)