(* ========================================================================= *)
(* Elementary topology in Euclidean space.                                   *)
(*                                                                           *)
(*              (c) Copyright, John Harrison 1998-2017                       *)
(*                (c) Copyright, Valentina Bruno 2010                        *)
(*               (c) Copyright, Marco Maggesi 2014-2017                      *)
(*             (c) Copyright, Andrea Gabrielli 2016-2017                     *)
(* ========================================================================= *)

needs "Library/card.ml";;
needs "Library/iter.ml";;
needs "Multivariate/metric.ml";;
needs "Multivariate/determinants.ml";;

(* ------------------------------------------------------------------------- *)
(* The universal Euclidean topology that we use most of the time.            *)
(* ------------------------------------------------------------------------- *)

let open_def = new_definition
  `open s <=> !x. x IN s ==> ?e. &0 < e /\ !x'. dist(x',x) < e ==> x' IN s`;;

let euclidean = new_definition
 `euclidean = topology open`;;

let euclidean_metric = new_definition
  `euclidean_metric = metric ((:real^N), dist)`;;

let EUCLIDEAN_METRIC = prove
 (`mdist (euclidean_metric:(real^N)metric) = dist /\
   mspace euclidean_metric = (:real^N)`,
  SUBGOAL_THEN `is_metric_space ((:real^N),dist)` MP_TAC THENL
  [REWRITE_TAC[is_metric_space; IN_UNIV; DIST_POS_LE; DIST_EQ_0;
               DIST_SYM; DIST_TRIANGLE];
   SIMP_TAC[euclidean_metric; MDIST; MSPACE]]);;

let OPEN_IN_EUCLIDEAN_METRIC = prove
 (`open_in (mtopology euclidean_metric) = open:(real^N->bool)->bool`,
  REWRITE_TAC[FUN_EQ_THM; OPEN_IN_MTOPOLOGY; open_def; EUCLIDEAN_METRIC;
              SUBSET_UNIV; SUBSET; IN_MBALL; IN_UNIV; DIST_SYM]);;

let OPEN_IN_EUCLIDEAN = prove
 (`open_in euclidean = open`,
  REWRITE_TAC[euclidean; GSYM OPEN_IN_EUCLIDEAN_METRIC] THEN
  MESON_TAC[topology_tybij]);;

let OPEN_IN = prove
 (`!s:real^N->bool. open s <=> open_in euclidean s`,
  REWRITE_TAC[OPEN_IN_EUCLIDEAN]);;

let MTOPOLOGY_EUCLIDEAN_METRIC = prove
 (`mtopology euclidean_metric = euclidean:(real^N)topology`,
  REWRITE_TAC[TOPOLOGY_EQ; OPEN_IN_EUCLIDEAN_METRIC; OPEN_IN]);;

let METRIZABLE_SPACE_EUCLIDEAN = prove
 (`metrizable_space euclidean`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC;
              METRIZABLE_SPACE_MTOPOLOGY]);;

let HAUSDORFF_SPACE_EUCLIDEAN = prove
 (`hausdorff_space euclidean`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; HAUSDORFF_SPACE_MTOPOLOGY]);;

let KC_SPACE_EUCLIDEAN = prove
 (`kc_space(euclidean:(real^N)topology)`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; KC_SPACE_MTOPOLOGY]);;

let T1_SPACE_EUCLIDEAN = prove
 (`t1_space euclidean`,
  SIMP_TAC[HAUSDORFF_SPACE_EUCLIDEAN; HAUSDORFF_IMP_T1_SPACE]);;

let REGULAR_SPACE_EUCLIDEAN = prove
 (`regular_space euclidean`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; REGULAR_SPACE_MTOPOLOGY]);;

let K_SPACE_EUCLIDEAN = prove
 (`k_space(euclidean:(real^N)topology)`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; K_SPACE_MTOPOLOGY]);;

let OPEN_EMPTY = prove
 (`open {}`,
  REWRITE_TAC[open_def; NOT_IN_EMPTY]);;

let OPEN_UNIV = prove
 (`open(:real^N)`,
  REWRITE_TAC[open_def; IN_UNIV] THEN MESON_TAC[REAL_LT_01]);;

let OPEN_INTER = prove
 (`!s t. open s /\ open t ==> open (s INTER t)`,
  REWRITE_TAC[OPEN_IN; OPEN_IN_INTER]);;

let OPEN_UNIONS = prove
 (`(!s. s IN f ==> open s) ==> open(UNIONS f)`,
  REWRITE_TAC[open_def; IN_UNIONS] THEN MESON_TAC[]);;

let OPEN_EXISTS_IN = prove
 (`!P Q:A->real^N->bool.
        (!a. P a ==> open {x | Q a x}) ==> open {x | ?a. P a /\ Q a x}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `open(UNIONS {{x | Q (a:A) (x:real^N)} | P a})` MP_TAC THENL
   [MATCH_MP_TAC OPEN_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC];
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[UNIONS_GSPEC] THEN
    SET_TAC[]]);;

let OPEN_EXISTS = prove
 (`!Q:A->real^N->bool. (!a. open {x | Q a x}) ==> open {x | ?a. Q a x}`,
  MP_TAC(ISPEC `\x:A. T` OPEN_EXISTS_IN) THEN REWRITE_TAC[]);;

let OPEN_RELATIVE_TO = prove
 (`!s t:real^N->bool.
        (open relative_to s) t <=> open_in (subtopology euclidean s) t`,
  REWRITE_TAC[GSYM OPEN_IN_RELATIVE_TO] THEN
  REWRITE_TAC[relative_to; OPEN_IN]);;

let TOPSPACE_EUCLIDEAN = prove
 (`topspace euclidean = (:real^N)`,
  REWRITE_TAC[topspace; EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN
  MESON_TAC[OPEN_UNIV; IN_UNIV; OPEN_IN]);;

let TOPSPACE_EUCLIDEAN_SUBTOPOLOGY = prove
 (`!s. topspace (subtopology euclidean s) = s`,
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; TOPSPACE_SUBTOPOLOGY; INTER_UNIV]);;

let OPEN_IN_REFL = prove
 (`!s:real^N->bool. open_in (subtopology euclidean s) s`,
  REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let SUBTOPOLOGY_EUCLIDEAN_EQ_DISCRETE_TOPOLOGY_FINITE = prove
 (`!s:real^N->bool.
        FINITE s ==> subtopology euclidean s = discrete_topology s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUBTOPOLOGY_EQ_DISCRETE_TOPOLOGY_FINITE THEN
  ASM_REWRITE_TAC[T1_SPACE_EUCLIDEAN; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Closed sets.                                                              *)
(* ------------------------------------------------------------------------- *)

let closed = new_definition
  `closed(s:real^N->bool) <=> open(UNIV DIFF s)`;;

let CLOSED_IN = prove
 (`!s:real^N->bool. closed s <=> closed_in euclidean s`,
  REWRITE_TAC[closed; closed_in; TOPSPACE_EUCLIDEAN; OPEN_IN; SUBSET_UNIV]);;

let CLOSED_IN_EUCLIDEAN = prove
 (`closed_in euclidean = closed:(real^N->bool)->bool`,
  REWRITE_TAC[CLOSED_IN; FUN_EQ_THM]);;

let CLOSED_IN_EUCLIDEAN_METRIC = prove
 (`closed_in (mtopology euclidean_metric) = closed:(real^N->bool)->bool`,
  REWRITE_TAC[CLOSED_IN_EUCLIDEAN; MTOPOLOGY_EUCLIDEAN_METRIC]);;

let CLOSED_IN_REFL = prove
 (`!s:real^N->bool. closed_in (subtopology euclidean s) s`,
  REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let CLOSED_RELATIVE_TO = prove
 (`!s t:real^N->bool.
        (closed relative_to s) t <=> closed_in (subtopology euclidean s) t`,
  REWRITE_TAC[GSYM CLOSED_IN_RELATIVE_TO] THEN
  REWRITE_TAC[relative_to; CLOSED_IN]);;

let OPEN_UNION = prove
 (`!s t. open s /\ open t ==> open(s UNION t)`,
  REWRITE_TAC[OPEN_IN; OPEN_IN_UNION]);;

let OPEN_SUBOPEN = prove
 (`!s. open s <=> !x. x IN s ==> ?t. open t /\ x IN t /\ t SUBSET s`,
  REWRITE_TAC[OPEN_IN; GSYM OPEN_IN_SUBOPEN]);;

let CLOSED_EMPTY = prove
 (`closed {}`,
  REWRITE_TAC[CLOSED_IN; CLOSED_IN_EMPTY]);;

let CLOSED_UNIV = prove
 (`closed(UNIV:real^N->bool)`,
  REWRITE_TAC[CLOSED_IN; GSYM TOPSPACE_EUCLIDEAN; CLOSED_IN_TOPSPACE]);;

let CLOSED_UNION = prove
 (`!s t. closed s /\ closed t ==> closed(s UNION t)`,
  REWRITE_TAC[CLOSED_IN; CLOSED_IN_UNION]);;

let CLOSED_INTER = prove
 (`!s t. closed s /\ closed t ==> closed(s INTER t)`,
  REWRITE_TAC[CLOSED_IN; CLOSED_IN_INTER]);;

let CLOSED_INTERS = prove
 (`!f. (!s:real^N->bool. s IN f ==> closed s) ==> closed(INTERS f)`,
  REWRITE_TAC[CLOSED_IN] THEN REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
  ASM_SIMP_TAC[CLOSED_IN_INTERS; INTERS_0] THEN
  REWRITE_TAC[GSYM TOPSPACE_EUCLIDEAN; CLOSED_IN_TOPSPACE]);;

let CLOSED_FORALL_IN = prove
 (`!P Q:A->real^N->bool.
        (!a. P a ==> closed {x | Q a x}) ==> closed {x | !a. P a ==> Q a x}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `closed(INTERS {{x | Q (a:A) (x:real^N)} | P a})` MP_TAC THENL
   [MATCH_MP_TAC CLOSED_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC];
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[INTERS_GSPEC] THEN
    SET_TAC[]]);;

let CLOSED_FORALL = prove
 (`!Q:A->real^N->bool. (!a. closed {x | Q a x}) ==> closed {x | !a. Q a x}`,
  MP_TAC(ISPEC `\x:A. T` CLOSED_FORALL_IN) THEN REWRITE_TAC[]);;

let OPEN_CLOSED = prove
 (`!s:real^N->bool. open s <=> closed(UNIV DIFF s)`,
  SIMP_TAC[OPEN_IN; CLOSED_IN; TOPSPACE_EUCLIDEAN; SUBSET_UNIV;
           OPEN_IN_CLOSED_IN_EQ]);;

let OPEN_DIFF = prove
 (`!s t. open s /\ closed t ==> open(s DIFF t)`,
  REWRITE_TAC[OPEN_IN; CLOSED_IN; OPEN_IN_DIFF]);;

let CLOSED_DIFF = prove
 (`!s t. closed s /\ open t ==> closed(s DIFF t)`,
  REWRITE_TAC[OPEN_IN; CLOSED_IN; CLOSED_IN_DIFF]);;

let OPEN_INTERS = prove
 (`!s. FINITE s /\ (!t. t IN s ==> open t) ==> open(INTERS s)`,
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[INTERS_INSERT; INTERS_0; OPEN_UNIV; IN_INSERT] THEN
  MESON_TAC[OPEN_INTER]);;

let CLOSED_UNIONS = prove
 (`!s. FINITE s /\ (!t. t IN s ==> closed t) ==> closed(UNIONS s)`,
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_INSERT; UNIONS_0; CLOSED_EMPTY; IN_INSERT] THEN
  MESON_TAC[CLOSED_UNION]);;

let CLOSED_LOCALLY_FINITE_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> closed s) /\ locally_finite_in euclidean f
        ==> closed(UNIONS f)`,
  REWRITE_TAC[CLOSED_IN; CLOSED_IN_LOCALLY_FINITE_UNIONS]);;

(* ------------------------------------------------------------------------- *)
(* Componentwise, lifted and dropped limits and continuity.                  *)
(* ------------------------------------------------------------------------- *)

let LIMIT_EQ_LIFT = prove
 (`!(net:A net) f l.
        limit euclideanreal f l net <=>
        limit euclidean (lift o f) (lift l) net`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC;
              GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[LIMIT_METRIC; EUCLIDEAN_METRIC;
              REAL_EUCLIDEAN_METRIC; IN_UNIV] THEN
  REWRITE_TAC[o_THM; DIST_LIFT; REAL_ABS_SUB]);;

let LIMIT_EQ_DROP = prove
 (`!(net:A net) f l.
        limit euclidean f l net <=>
        limit euclideanreal (drop o f) (drop l) net`,
  REWRITE_TAC[LIMIT_EQ_LIFT; o_DEF; LIFT_DROP; ETA_AX]);;

let CONTINUOUS_MAP_EQ_LIFT = prove
 (`!top f:A->real.
        continuous_map(top,euclideanreal) f <=>
        continuous_map(top,euclidean) (lift o f)`,
  REWRITE_TAC[CONTINUOUS_MAP_ATPOINTOF; LIMIT_EQ_LIFT; o_THM]);;

let CONTINUOUS_MAP_EQ_DROP = prove
 (`!top f:A->real^1.
        continuous_map(top,euclidean) f <=>
        continuous_map(top,euclideanreal) (drop o f)`,
  REWRITE_TAC[CONTINUOUS_MAP_EQ_LIFT; o_DEF; LIFT_DROP; ETA_AX]);;

let LIMIT_COMPONENTWISE_REAL = prove
 (`!net (f:A->real^N) l.
        limit euclidean f l net <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> limit euclideanreal (\x. f x$i) (l$i) net`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC;
              GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[LIMIT_METRIC; EUCLIDEAN_METRIC; REAL_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[IN_UNIV; RIGHT_IMP_FORALL_THM; GSYM IN_NUMSEG] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM; DIST_SYM] THEN
  ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC[FORALL_EVENTUALLY; FINITE_NUMSEG; NUMSEG_EMPTY;
           NOT_LT; DIMINDEX_GE_1] THEN
  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
    MESON_TAC[VECTOR_SUB_COMPONENT; dist; REAL_LET_TRANS; COMPONENT_LE_NORM];
    FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
    X_GEN_TAC `x:A` THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist] THEN
    DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
    MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN
    MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
    ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1;
                 CARD_NUMSEG_1; GSYM IN_NUMSEG]]);;

let CONTINUOUS_MAP_COMPONENTWISE_REAL = prove
 (`!top (f:A->real^N).
        continuous_map (top,euclidean) f <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> continuous_map (top,euclideanreal) (\x. f x$i)`,
  REWRITE_TAC[CONTINUOUS_MAP_ATPOINTOF; LIMIT_COMPONENTWISE_REAL] THEN
  MESON_TAC[]);;

let CONTINUOUS_MAP_LIFT = prove
 (`continuous_map (euclideanreal,euclidean) lift`,
  REWRITE_TAC[CONTINUOUS_MAP_EQ_DROP; o_DEF; LIFT_DROP; CONTINUOUS_MAP_ID]);;

let CONTINUOUS_MAP_DROP = prove
 (`continuous_map (euclidean,euclideanreal) drop`,
  REWRITE_TAC[CONTINUOUS_MAP_EQ_LIFT; o_DEF; LIFT_DROP; CONTINUOUS_MAP_ID]);;

let CONTINUOUS_MAP_LIFT_EQ = prove
 (`!top f:real^1->A.
        continuous_map(euclidean,top) f <=>
        continuous_map(euclideanreal,top) (f o lift)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_MAP_COMPOSE; CONTINUOUS_MAP_LIFT]; ALL_TAC] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN `f:real^1->A = (f o lift) o drop` SUBST1_TAC THENL
   [REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX];
    ASM_MESON_TAC[CONTINUOUS_MAP_COMPOSE; CONTINUOUS_MAP_DROP]]);;

let CONTINUOUS_MAP_DROP_EQ = prove
 (`!top f:real->A.
        continuous_map(euclideanreal,top) f <=>
        continuous_map(euclidean,top) (f o drop)`,
  REWRITE_TAC[CONTINUOUS_MAP_LIFT_EQ; o_DEF; LIFT_DROP; ETA_AX]);;

let CONTINUOUS_MAP_LIFT_EQ_GEN = prove
 (`!top s (f:real^1->A).
        continuous_map (subtopology euclidean s,top) f <=>
        continuous_map (subtopology euclideanreal (IMAGE drop s),top)
                       (f o lift)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
    EXISTS_TAC `subtopology euclidean (s:real^1->bool)` THEN
    ASM_SIMP_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY; CONTINUOUS_MAP_LIFT;
                 CONTINUOUS_MAP_FROM_SUBTOPOLOGY] THEN
    REWRITE_TAC[SUBSET; TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP];
    SUBGOAL_THEN `f:real^1->A = (f o lift) o drop` SUBST1_TAC THENL
     [REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
    EXISTS_TAC `subtopology euclideanreal (IMAGE drop (s:real^1->bool))` THEN
    ASM_SIMP_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY; CONTINUOUS_MAP_DROP;
                 CONTINUOUS_MAP_FROM_SUBTOPOLOGY] THEN
    REWRITE_TAC[SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP]]);;

let CONTINUOUS_MAP_DROP_EQ_GEN = prove
 (`!top s (f:real->A).
        continuous_map(subtopology euclideanreal s,top) f <=>
        continuous_map(subtopology euclidean (IMAGE lift s),top) (f o drop)`,
  REWRITE_TAC[CONTINUOUS_MAP_LIFT_EQ_GEN; o_DEF; LIFT_DROP; ETA_AX;
              GSYM IMAGE_o; IMAGE_ID]);;

(* ------------------------------------------------------------------------- *)
(* Arithmetic combining theorems for vector-valued continuous maps.          *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_MAP_VECTOR_CONST = prove
 (`!(top:A topology) (b:real^N).
        continuous_map (top,euclidean) (\x. b)`,
  REWRITE_TAC[CONTINUOUS_MAP_CONST; TOPSPACE_EUCLIDEAN; IN_UNIV]);;

let CONTINUOUS_MAP_VECTOR_ADD = prove
 (`!top f g:A->real^N.
        continuous_map(top,euclidean) f /\ continuous_map(top,euclidean) g
        ==> continuous_map(top,euclidean) (\x. f x + g x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN
  STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
  ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; CONTINUOUS_MAP_REAL_ADD]);;

let CONTINUOUS_MAP_VECTOR_SUB = prove
 (`!top f g:A->real^N.
        continuous_map(top,euclidean) f /\ continuous_map(top,euclidean) g
        ==> continuous_map(top,euclidean) (\x. f x - g x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN
  STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
  ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; CONTINUOUS_MAP_REAL_SUB]);;

let CONTINUOUS_MAP_VECTOR_MUL = prove
 (`!top c f:A->real^N.
        continuous_map(top,euclideanreal) c /\ continuous_map(top,euclidean) f
        ==> continuous_map(top,euclidean) (\x. c x % f x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN
  STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
  ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; CONTINUOUS_MAP_REAL_MUL]);;

let CONTINUOUS_MAP_DOT = prove
 (`!top f g:A->real^N.
        continuous_map(top,euclidean) f /\ continuous_map(top,euclidean) g
        ==> continuous_map(top,euclideanreal) (\x. f x dot g x)`,
  REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[dot] THEN MATCH_MP_TAC CONTINUOUS_MAP_SUM THEN
  ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; CONTINUOUS_MAP_REAL_MUL]);;

let CONTINUOUS_MAP_VSUM = prove
 (`!top k (f:A->K->real^N).
        FINITE k /\ (!i. i IN k ==> continuous_map(top,euclidean) (\x. f x i))
        ==> continuous_map(top,euclidean) (\x. vsum k (f x))`,
  GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT] THEN
  SIMP_TAC[VSUM_CLAUSES; CONTINUOUS_MAP_VECTOR_CONST;
           CONTINUOUS_MAP_VECTOR_ADD]);;

let CONTINUOUS_MAP_EUCLIDEAN_COMPONENT = prove
 (`!top (f:A->real^N) i.
        continuous_map(top,euclidean) f
        ==> continuous_map (top,euclideanreal) (\x. f x$i)`,
  REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !x:real^N. x$i = x$k`
  STRIP_ASSUME_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ASM_SIMP_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Open and closed balls and spheres.                                        *)
(* ------------------------------------------------------------------------- *)

let ball = new_definition
  `ball(x,e) = { y | dist(x,y) < e}`;;

let IN_BALL = prove
 (`!x y e. y IN ball(x,e) <=> dist(x,y) < e`,
  REWRITE_TAC[ball; IN_ELIM_THM]);;

let MBALL_EUCLIDEAN = prove
 (`!x:real^N r. mball euclidean_metric (x,r) = ball(x,r)`,
  REWRITE_TAC[EXTENSION; IN_MBALL; IN_BALL; EUCLIDEAN_METRIC; IN_UNIV]);;

let cball = new_definition
  `cball(x,e) = { y | dist(x,y) <= e}`;;

let IN_CBALL = prove
 (`!x y e. y IN cball(x,e) <=> dist(x,y) <= e`,
  REWRITE_TAC[cball; IN_ELIM_THM]);;

let MCBALL_EUCLIDEAN = prove
 (`!x:real^N r. mcball euclidean_metric (x,r) = cball(x,r)`,
  REWRITE_TAC[EXTENSION; IN_MCBALL; IN_CBALL; EUCLIDEAN_METRIC; IN_UNIV]);;

let sphere = new_definition
  `sphere(x,e) = { y | dist(x,y) = e}`;;

let IN_SPHERE = prove
 (`!x y e. y IN sphere(x,e) <=> dist(x,y) = e`,
  REWRITE_TAC[sphere; IN_ELIM_THM]);;

let IN_BALL_0 = prove
 (`!x e. x IN ball(vec 0,e) <=> norm(x) < e`,
  REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);;

let IN_CBALL_0 = prove
 (`!x e. x IN cball(vec 0,e) <=> norm(x) <= e`,
  REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);;

let IN_SPHERE_0 = prove
 (`!x e. x IN sphere(vec 0,e) <=> norm(x) = e`,
  REWRITE_TAC[IN_SPHERE; dist; VECTOR_SUB_LZERO; NORM_NEG]);;

let BALL_TRIVIAL = prove
 (`!x. ball(x,&0) = {}`,
  REWRITE_TAC[EXTENSION; IN_BALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);;

let CBALL_TRIVIAL = prove
 (`!x. cball(x,&0) = {x}`,
  REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);;

let CENTRE_IN_CBALL = prove
 (`!x e. x IN cball(x,e) <=> &0 <= e`,
  MESON_TAC[IN_CBALL; DIST_REFL]);;

let BALL_SUBSET_CBALL = prove
 (`!x e. ball(x,e) SUBSET cball(x,e)`,
  REWRITE_TAC[IN_BALL; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);;

let SPHERE_SUBSET_CBALL = prove
 (`!x e. sphere(x,e) SUBSET cball(x,e)`,
  REWRITE_TAC[IN_SPHERE; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);;

let SUBSET_BALL = prove
 (`!x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)`,
  REWRITE_TAC[SUBSET; IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]);;

let SUBSET_CBALL = prove
 (`!x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)`,
  REWRITE_TAC[SUBSET; IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]);;

let BALL_MAX_UNION = prove
 (`!a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)`,
  REWRITE_TAC[IN_BALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);;

let BALL_MIN_INTER = prove
 (`!a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)`,
  REWRITE_TAC[IN_BALL; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC);;

let CBALL_MAX_UNION = prove
 (`!a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)`,
  REWRITE_TAC[IN_CBALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);;

let CBALL_MIN_INTER = prove
 (`!x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)`,
  REWRITE_TAC[EXTENSION; IN_INTER; IN_CBALL] THEN REAL_ARITH_TAC);;

let BALL_TRANSLATION = prove
 (`!a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))`,
  REWRITE_TAC[ball] THEN GEOM_TRANSLATE_TAC[]);;

let CBALL_TRANSLATION = prove
 (`!a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))`,
  REWRITE_TAC[cball] THEN GEOM_TRANSLATE_TAC[]);;

let SPHERE_TRANSLATION = prove
 (`!a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))`,
  REWRITE_TAC[sphere] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants
  [BALL_TRANSLATION; CBALL_TRANSLATION; SPHERE_TRANSLATION];;

let BALL_LINEAR_IMAGE = prove
 (`!f:real^M->real^N x r.
        linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x)
        ==> ball(f x,r) = IMAGE f (ball(x,r))`,
  REWRITE_TAC[ball] THEN GEOM_TRANSFORM_TAC[]);;

let CBALL_LINEAR_IMAGE = prove
 (`!f:real^M->real^N x r.
        linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x)
        ==> cball(f x,r) = IMAGE f (cball(x,r))`,
  REWRITE_TAC[cball] THEN GEOM_TRANSFORM_TAC[]);;

let SPHERE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N x r.
        linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x)
        ==> sphere(f x,r) = IMAGE f (sphere(x,r))`,
  REWRITE_TAC[sphere] THEN GEOM_TRANSFORM_TAC[]);;

add_linear_invariants
  [BALL_LINEAR_IMAGE; CBALL_LINEAR_IMAGE; SPHERE_LINEAR_IMAGE];;

let BALL_SCALING = prove
 (`!c. &0 < c ==> !x r. ball(c % x,c * r) = IMAGE (\x. c % x) (ball(x,r))`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN
  REWRITE_TAC[IN_BALL; DIST_MUL] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LT_LMUL_EQ]);;

let CBALL_SCALING = prove
 (`!c. &0 < c ==> !x r. cball(c % x,c * r) = IMAGE (\x. c % x) (cball(x,r))`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN
  REWRITE_TAC[IN_CBALL; DIST_MUL] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LE_LMUL_EQ]);;

let SPHERE_SCALING = prove
 (`!c. &0 < c
       ==> !x r. sphere(c % x,c * r) = IMAGE (\x. c % x) (sphere(x,r))`,
 REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN
  REWRITE_TAC[IN_SPHERE; DIST_MUL] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_EQ_MUL_LCANCEL;
               REAL_LT_IMP_NZ]);;

add_scaling_theorems [BALL_SCALING; CBALL_SCALING; SPHERE_SCALING];;

let CBALL_DIFF_BALL = prove
 (`!a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)`,
  REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN
  REAL_ARITH_TAC);;

let BALL_UNION_SPHERE = prove
 (`!a r. ball(a,r) UNION sphere(a,r) = cball(a,r)`,
  REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN
  REAL_ARITH_TAC);;

let SPHERE_UNION_BALL = prove
 (`!a r. sphere(a,r) UNION ball(a,r)  = cball(a,r)`,
  REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN
  REAL_ARITH_TAC);;

let CBALL_DIFF_SPHERE = prove
 (`!a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)`,
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_SPHERE; IN_BALL; IN_CBALL] THEN
  REAL_ARITH_TAC);;

let OPEN_BALL = prove
 (`!x e. open(ball(x,e))`,
  REWRITE_TAC[open_def; ball; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
  MESON_TAC[REAL_SUB_LT; REAL_LT_SUB_LADD; REAL_ADD_SYM; REAL_LET_TRANS;
            DIST_TRIANGLE_ALT]);;

let CENTRE_IN_BALL = prove
 (`!x e. x IN ball(x,e) <=> &0 < e`,
  MESON_TAC[IN_BALL; DIST_REFL]);;

let OPEN_CONTAINS_BALL = prove
 (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s`,
  REWRITE_TAC[open_def; SUBSET; IN_BALL] THEN REWRITE_TAC[DIST_SYM]);;

let OPEN_CONTAINS_BALL_EQ = prove
 (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)`,
  MESON_TAC[OPEN_CONTAINS_BALL; SUBSET; CENTRE_IN_BALL]);;

let BALL_EQ_EMPTY = prove
 (`!x e. (ball(x,e) = {}) <=> e <= &0`,
  REWRITE_TAC[EXTENSION; IN_BALL; NOT_IN_EMPTY; REAL_NOT_LT] THEN
  MESON_TAC[DIST_POS_LE; REAL_LE_TRANS; DIST_REFL]);;

let BALL_EMPTY = prove
 (`!x e. e <= &0 ==> ball(x,e) = {}`,
  REWRITE_TAC[BALL_EQ_EMPTY]);;

let OPEN_CONTAINS_CBALL = prove
 (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s`,
  GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  SUBGOAL_THEN `e / &2 < e` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS]) THEN
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
  UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);;

let OPEN_CONTAINS_CBALL_EQ = prove
 (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)`,
  MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET; REAL_LT_IMP_LE; CENTRE_IN_CBALL]);;

let SPHERE_EQ_EMPTY = prove
 (`!a:real^N r. sphere(a,r) = {} <=> r < &0`,
  REWRITE_TAC[sphere; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
  REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
  MESON_TAC[VECTOR_CHOOSE_DIST; REAL_NOT_LE]);;

let SPHERE_EMPTY = prove
 (`!a:real^N r. r < &0 ==> sphere(a,r) = {}`,
  REWRITE_TAC[SPHERE_EQ_EMPTY]);;

let NEGATIONS_BALL = prove
 (`!r. IMAGE (--) (ball(vec 0:real^N,r)) = ball(vec 0,r)`,
  GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
  REWRITE_TAC[IN_BALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);;

let NEGATIONS_CBALL = prove
 (`!r. IMAGE (--) (cball(vec 0:real^N,r)) = cball(vec 0,r)`,
  GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
  REWRITE_TAC[IN_CBALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);;

let NEGATIONS_SPHERE = prove
 (`!r. IMAGE (--) (sphere(vec 0:real^N,r)) = sphere(vec 0,r)`,
  GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
  REWRITE_TAC[IN_SPHERE_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);;

let ORTHOGONAL_TRANSFORMATION_BALL = prove
 (`!f:real^N->real^N r.
    orthogonal_transformation f ==> IMAGE f (ball(vec 0,r)) = ball(vec 0,r)`,
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL_0] THEN
  MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);;

let ORTHOGONAL_TRANSFORMATION_CBALL = prove
 (`!f:real^N->real^N r.
    orthogonal_transformation f ==> IMAGE f (cball(vec 0,r)) = cball(vec 0,r)`,
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL_0] THEN
  MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);;

let ORTHOGONAL_TRANSFORMATION_SPHERE = prove
 (`!f:real^N->real^N r.
    orthogonal_transformation f
    ==> IMAGE f (sphere(vec 0,r)) = sphere(vec 0,r)`,
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPHERE_0] THEN
  MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);;

(* ------------------------------------------------------------------------- *)
(* Basic "localization" results.                                             *)
(* ------------------------------------------------------------------------- *)

let OPEN_IN_OPEN = prove
 (`!s:real^N->bool u.
        open_in (subtopology euclidean u) s <=> ?t. open t /\ (s = u INTER t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN] THEN
  REWRITE_TAC[INTER_ACI]);;

let OPEN_IN_INTER_OPEN = prove
 (`!s t u:real^N->bool.
        open_in (subtopology euclidean u) s /\ open t
        ==> open_in (subtopology euclidean u) (s INTER t)`,
  REWRITE_TAC[OPEN_IN; OPEN_IN_SUBTOPOLOGY_INTER_OPEN_IN]);;

let OPEN_IN_OPEN_INTER = prove
 (`!u s. open s ==> open_in (subtopology euclidean u) (u INTER s)`,
  REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[]);;

let OPEN_OPEN_IN_TRANS = prove
 (`!s t. open s /\ open t /\ t SUBSET s
         ==> open_in (subtopology euclidean s) t`,
  MESON_TAC[OPEN_IN_OPEN_INTER; SET_RULE `t SUBSET s ==> t = s INTER t`]);;

let OPEN_SUBSET = prove
 (`!s t:real^N->bool.
        s SUBSET t /\ open s ==> open_in (subtopology euclidean t) s`,
  REWRITE_TAC[GSYM OPEN_RELATIVE_TO; RELATIVE_TO_SUBSET]);;

let CLOSED_IN_DIFF_OPEN = prove
 (`!s t. open t ==> closed_in (subtopology euclidean s) (s DIFF t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
  SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL; OPEN_IN_OPEN_INTER]);;

let CLOSED_IN_CLOSED = prove
 (`!s:real^N->bool u.
    closed_in (subtopology euclidean u) s <=> ?t. closed t /\ (s = u INTER t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY; GSYM CLOSED_IN] THEN
  REWRITE_TAC[INTER_ACI]);;

let CLOSED_SUBSET_EQ = prove
 (`!u s:real^N->bool.
        closed s ==> (closed_in (subtopology euclidean u) s <=> s SUBSET u)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY];
    REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `s:real^N->bool` THEN
    ASM SET_TAC[]]);;

let CLOSED_IN_INTER_CLOSED = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean u) s /\ closed t
        ==> closed_in (subtopology euclidean u) (s INTER t)`,
  REWRITE_TAC[CLOSED_IN; CLOSED_IN_SUBTOPOLOGY_INTER_CLOSED_IN]);;

let CLOSED_IN_CLOSED_INTER = prove
 (`!u s. closed s ==> closed_in (subtopology euclidean u) (u INTER s)`,
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN MESON_TAC[]);;

let CLOSED_SUBSET = prove
 (`!s t:real^N->bool.
        s SUBSET t /\ closed s ==> closed_in (subtopology euclidean t) s`,
  REWRITE_TAC[GSYM CLOSED_RELATIVE_TO; RELATIVE_TO_SUBSET]);;

let OPEN_IN_DIFF_CLOSED = prove
 (`!s t. closed t ==> open_in (subtopology euclidean s) (s DIFF t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
  SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSED_INTER]);;

let open_in = prove
 (`!u s:real^N->bool.
        open_in (subtopology euclidean u) s <=>
          s SUBSET u /\
          !x. x IN s ==> ?e. &0 < e /\
                             !x'. x' IN u /\ dist(x',x) < e ==> x' IN s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN] THEN EQ_TAC THENL
   [REWRITE_TAC[open_def] THEN ASM SET_TAC[INTER_SUBSET; IN_INTER];
    ALL_TAC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `d:real^N->real`) THEN
  EXISTS_TAC `UNIONS {b | ?x:real^N. (b = ball(x,d x)) /\ x IN s}` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_UNIONS THEN
    ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM; OPEN_BALL];
    GEN_REWRITE_TAC I [EXTENSION] THEN
    REWRITE_TAC[IN_INTER; IN_UNIONS; IN_ELIM_THM] THEN
    ASM_MESON_TAC[SUBSET; DIST_REFL; DIST_SYM; IN_BALL]]);;

let OPEN_IN_CONTAINS_BALL = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean t) s <=>
        s SUBSET t /\
        !x. x IN s ==> ?e. &0 < e /\ ball(x,e) INTER t SUBSET s`,
  REWRITE_TAC[open_in; INTER; SUBSET; IN_ELIM_THM; IN_BALL] THEN
  MESON_TAC[DIST_SYM]);;

let OPEN_IN_CONTAINS_CBALL = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean t) s <=>
        s SUBSET t /\
        !x. x IN s ==> ?e. &0 < e /\ cball(x,e) INTER t SUBSET s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN
  AP_TERM_TAC THEN REWRITE_TAC[IN_BALL; IN_INTER; SUBSET; IN_CBALL] THEN
  MESON_TAC[REAL_ARITH `&0 < e ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)`;
            REAL_LT_IMP_LE]);;

(* ------------------------------------------------------------------------- *)
(* These "transitivity" results are handy too.                               *)
(* ------------------------------------------------------------------------- *)

let OPEN_IN_TRANS_EQ = prove
 (`!s t:real^N->bool.
        (!u. open_in (subtopology euclidean t) u
             ==> open_in (subtopology euclidean s) t)
        <=> open_in (subtopology euclidean s) t`,
  MESON_TAC[OPEN_IN_TRANS; OPEN_IN_REFL]);;

let OPEN_IN_OPEN_TRANS = prove
 (`!s t. open_in (subtopology euclidean t) s /\ open t ==> open s`,
  REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] OPEN_IN] THEN
  REWRITE_TAC[OPEN_IN_TRANS]);;

let CLOSED_IN_TRANS_EQ = prove
 (`!s t:real^N->bool.
        (!u. closed_in (subtopology euclidean t) u
             ==> closed_in (subtopology euclidean s) t)
        <=> closed_in (subtopology euclidean s) t`,
  MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_REFL]);;

let CLOSED_IN_CLOSED_TRANS = prove
 (`!s t. closed_in (subtopology euclidean t) s /\ closed t ==> closed s`,
  REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] CLOSED_IN] THEN
  REWRITE_TAC[CLOSED_IN_TRANS]);;

let OPEN_IN_OPEN_EQ = prove
 (`!s t. open s
         ==> (open_in (subtopology euclidean s) t <=> open t /\ t SUBSET s)`,
  MESON_TAC[OPEN_OPEN_IN_TRANS; OPEN_IN_OPEN_TRANS; open_in]);;

let CLOSED_IN_CLOSED_EQ = prove
 (`!s t. closed s
         ==> (closed_in (subtopology euclidean s) t <=>
              closed t /\ t SUBSET s)`,
  MESON_TAC[CLOSED_SUBSET; CLOSED_IN_CLOSED_TRANS; closed_in;
            TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

(* ------------------------------------------------------------------------- *)
(* Also some invariance theorems for relative topology.                      *)
(* ------------------------------------------------------------------------- *)

let OPEN_IN_TRANSLATION_EQ = prove
 (`!a s t. open_in (subtopology euclidean (IMAGE (\x. a + x) t))
                   (IMAGE (\x. a + x) s) <=>
           open_in (subtopology euclidean t) s`,
  REWRITE_TAC[open_in] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [OPEN_IN_TRANSLATION_EQ];;

let CLOSED_IN_TRANSLATION_EQ = prove
 (`!a s t. closed_in (subtopology euclidean (IMAGE (\x. a + x) t))
                   (IMAGE (\x. a + x) s) <=>
           closed_in (subtopology euclidean t) s`,
  REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [CLOSED_IN_TRANSLATION_EQ];;

let OPEN_IN_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s t.
          linear f /\ (!x y. f x = f y ==> x = y)
          ==> (open_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) <=>
               open_in (subtopology euclidean t) s)`,
  REWRITE_TAC[open_in; FORALL_IN_IMAGE; IMP_CONJ; SUBSET] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
   `(!x y. f x = f y ==> x = y) ==> (!x s. f x IN IMAGE f s <=> x IN s)`)) THEN
  ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS) THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `B2:real` THEN STRIP_TAC THEN
  X_GEN_TAC `B1:real` THEN STRIP_TAC THEN
  AP_TERM_TAC THEN AP_TERM_TAC THEN
  GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN
  REWRITE_TAC[] THEN AP_TERM_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP LINEAR_SUB) THEN
  ASM_REWRITE_TAC[dist; IMP_IMP] THEN EQ_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THENL
   [EXISTS_TAC `e / B1:real`; EXISTS_TAC `e * B2:real`] THEN
  ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL
   [MATCH_MP_TAC(REAL_ARITH
     `norm(f x) <= B1 * norm(x) /\ norm(x) * B1 < e ==> norm(f x) < e`) THEN
    ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ];
    MATCH_MP_TAC(REAL_ARITH
     `norm x <= norm (f x :real^N) / B2 /\ norm(f x) / B2 < e
      ==> norm x < e`) THEN
    ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ]]);;

add_linear_invariants [OPEN_IN_INJECTIVE_LINEAR_IMAGE];;

let CLOSED_IN_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s t.
          linear f /\ (!x y. f x = f y ==> x = y)
          ==> (closed_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) <=>
               closed_in (subtopology euclidean t) s)`,
  REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [CLOSED_IN_INJECTIVE_LINEAR_IMAGE];;

(* ------------------------------------------------------------------------- *)
(* Relating two variants of Euclidean space, one within product topology.    *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_MAPS_EUCLIDEAN_SPACE_EUCLIDEAN_GEN = prove
 (`!n. n <= dimindex(:N)
       ==> homeomorphic_maps
             (euclidean_space n,
              subtopology euclidean (span(IMAGE basis (1..n)):real^N->bool))
             ((\x. lambda i. if 1 <= i /\ i <= n then x i else &0),
              (\x i. if 1 <= i /\ i <= n then x$i else &0))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[homeomorphic_maps] THEN
  REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_EUCLIDEAN_SPACE;
              CONTINUOUS_MAP_IN_SUBTOPOLOGY; CONTINUOUS_MAP_COMPONENTWISE_UNIV;
              CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN
  SIMP_TAC[CONTINUOUS_MAP_FROM_SUBTOPOLOGY; CONTINUOUS_MAP_EUCLIDEAN_COMPONENT;
           LAMBDA_BETA; CONTINUOUS_MAP_ID] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; TOPSPACE_EUCLIDEAN_SPACE] THEN
  REPEAT CONJ_TAC THENL
   [X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= n` THEN
    ASM_REWRITE_TAC[CONTINUOUS_MAP_REAL_CONST] THEN
    SIMP_TAC[CONTINUOUS_MAP_PRODUCT_PROJECTION; IN_UNIV; euclidean_space;
             CONTINUOUS_MAP_FROM_SUBTOPOLOGY];
    X_GEN_TAC `x:num->real` THEN
    REWRITE_TAC[IN_SPAN_IMAGE_BASIS; IN_ELIM_THM; IN_NUMSEG] THEN
    SIMP_TAC[LAMBDA_BETA];
    REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
    GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN
    REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
    SUBGOAL_THEN `i <= dimindex(:N)` MP_TAC THENL
     [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]];
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IN_SPAN_IMAGE_BASIS] THEN
    SIMP_TAC[CART_EQ; IN_NUMSEG; LAMBDA_BETA] THEN MESON_TAC[]]);;

let HOMEOMORPHIC_MAPS_EUCLIDEAN_SPACE_EUCLIDEAN = prove
 (`homeomorphic_maps (euclidean_space(dimindex(:N)),euclidean:(real^N)topology)
                 ((\x. lambda i. x i),
                  (\x i. if 1 <= i /\ i <= dimindex(:N) then x$i else &0))`,
  MP_TAC(SPEC `dimindex(:N)`
        HOMEOMORPHIC_MAPS_EUCLIDEAN_SPACE_EUCLIDEAN_GEN) THEN
  REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_NUMSEG; SPAN_STDBASIS; LE_REFL] THEN
  REWRITE_TAC[SUBTOPOLOGY_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN
  BINOP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN ABS_TAC THEN
  SIMP_TAC[CART_EQ; LAMBDA_BETA]);;

let HOMEOMORPHIC_MAPS_NSPHERE_EUCLIDEAN_SPHERE = prove
 (`!n. 1 <= n /\ n <= dimindex(:N)
       ==> homeomorphic_maps
            (nsphere(n - 1),
             subtopology euclidean
              (sphere(vec 0:real^N,&1) INTER span(IMAGE basis (1..n))))
            ((\x. lambda i. if 1 <= i /\ i <= n then x i else &0),
             (\x i. if 1 <= i /\ i <= n then x$i else &0))`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[nsphere; SUB_ADD] THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN
  REWRITE_TAC[GSYM SUBTOPOLOGY_SUBTOPOLOGY] THEN
  MATCH_MP_TAC HOMEOMORPHIC_MAPS_SUBTOPOLOGIES_ALT THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_MAPS_EUCLIDEAN_SPACE_EUCLIDEAN_GEN] THEN
  REWRITE_TAC[SUBSET; TOPSPACE_EUCLIDEAN_SPACE; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[IN_INTER; IN_ELIM_THM; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[IN_SPHERE_0; NORM_EQ_1; dot; GSYM REAL_POW_2] THEN
  SUBGOAL_THEN `!j. j <= n ==> j <= dimindex(:N)` ASSUME_TAC THENL
   [ASM_ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[IN_NUMSEG; IN_SPAN_IMAGE_BASIS] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(fun th ->  GEN_REWRITE_TAC RAND_CONV [GSYM th]) THENL
   [ALL_TAC; CONV_TAC SYM_CONV] THEN
  MATCH_MP_TAC SUM_EQ_SUPERSET THEN
  ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN
  REWRITE_TAC[LE_REFL] THEN REPEAT STRIP_TAC THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

(* ------------------------------------------------------------------------- *)
(* Manhattan metric.                                                         *)
(* ------------------------------------------------------------------------- *)

let manhattan = new_definition
  `manhattan =
   metric ((:real^N), \(x,y). sum (1..dimindex(:N)) (\i. abs(x$i - y$i)))`;;

let MANHATTAN = prove
 (`mspace manhattan = (:real^N) /\
   (!x y. mdist manhattan (x:real^N,y) =
          sum (1..dimindex(:N)) (\i. abs(x$i - y$i)))`,
  SUBGOAL_THEN
    `is_metric_space
      ((:real^N), \(x,y). sum (1..dimindex(:N)) (\i. abs(x$i - y$i)))`
    (fun th -> SIMP_TAC[th; manhattan; MSPACE; MDIST]) THEN
  REWRITE_TAC[is_metric_space; IN_UNIV] THEN CONJ_TAC THENL
  [REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN
   REWRITE_TAC[REAL_ABS_POS];
   ALL_TAC] THEN
  CONJ_TAC THENL
  [REPEAT GEN_TAC THEN EQ_TAC THENL
   [INTRO_TAC "hp" THEN REWRITE_TAC[CART_EQ] THEN
    ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
    ONCE_REWRITE_TAC[GSYM REAL_ABS_ZERO] THEN
    MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN
    ASM_REWRITE_TAC[REAL_ABS_POS];
    DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0; SUM_0]];
   ALL_TAC] THEN
  CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_SUB]; ALL_TAC] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN
  MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Line segments, with open/closed overloading of (a,b) and [a,b].           *)
(* ------------------------------------------------------------------------- *)

let closed_segment = define
 `closed_segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1}`;;

let open_segment = new_definition
 `open_segment(a,b) = closed_segment[a,b] DIFF {a,b}`;;

let OPEN_SEGMENT_ALT = prove
 (`!a b:real^N.
        ~(a = b)
        ==> open_segment(a,b) = {(&1 - u) % a + u % b | &0 < u /\ u < &1}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment; closed_segment] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
  X_GEN_TAC `u:real` THEN ASM_CASES_TAC `x:real^N = (&1 - u) % a + u % b` THEN
  ASM_REWRITE_TAC[REAL_LE_LT;
    VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`;
    VECTOR_ARITH `(&1 - u) % a + u % b = b <=> (&1 - u) % (b - a) = vec 0`;
    VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ] THEN
  REAL_ARITH_TAC);;

make_overloadable "segment" `:A`;;

overload_interface("segment",`open_segment`);;
overload_interface("segment",`closed_segment`);;

let segment = prove
 (`segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1} /\
   segment(a,b) = segment[a,b] DIFF {a,b}`,
  REWRITE_TAC[open_segment; closed_segment]);;

let SEGMENT_REFL = prove
 (`(!a. segment[a,a] = {a}) /\
   (!a. segment(a,a) = {})`,
  REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % a = a`] THEN
  SET_TAC[REAL_POS]);;

let IN_SEGMENT = prove
 (`!a b x:real^N.
        (x IN segment[a,b] <=>
         ?u. &0 <= u /\ u <= &1 /\ x = (&1 - u) % a + u % b) /\
        (x IN segment(a,b) <=>
         ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ x = (&1 - u) % a + u % b)`,
  REPEAT STRIP_TAC THENL
   [REWRITE_TAC[segment; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN
  ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN
  ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM; CONJ_ASSOC]);;

let SEGMENT_SYM = prove
 (`(!a b:real^N. segment[a,b] = segment[b,a]) /\
   (!a b:real^N. segment(a,b) = segment(b,a))`,
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
  SIMP_TAC[open_segment] THEN
  CONJ_TAC THENL [ALL_TAC; SIMP_TAC[INSERT_AC]] THEN
  REWRITE_TAC[EXTENSION; IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN
  DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN VECTOR_ARITH_TAC);;

let ENDS_IN_SEGMENT = prove
 (`!a b. a IN segment[a,b] /\ b IN segment[a,b]`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THENL
   [EXISTS_TAC `&0`; EXISTS_TAC `&1`] THEN
  (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]));;

let ENDS_NOT_IN_SEGMENT = prove
 (`!a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))`,
  REWRITE_TAC[open_segment] THEN SET_TAC[]);;

let SEGMENT_CLOSED_OPEN = prove
 (`!a b. segment[a,b] = segment(a,b) UNION {a,b}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE
   `a IN s /\ b IN s ==> s = (s DIFF {a,b}) UNION {a,b}`) THEN
  REWRITE_TAC[ENDS_IN_SEGMENT]);;

let SEGMENT_OPEN_SUBSET_CLOSED = prove
 (`!a b. segment(a,b) SUBSET segment[a,b]`,
  REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]);;

let MIDPOINT_IN_SEGMENT = prove
 (`(!a b:real^N. midpoint(a,b) IN segment[a,b]) /\
   (!a b:real^N. midpoint(a,b) IN segment(a,b) <=> ~(a = b))`,
  REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL
   [ALL_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[]] THEN
  EXISTS_TAC `&1 / &2` THEN REWRITE_TAC[midpoint] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC);;

let BETWEEN_IN_SEGMENT = prove
 (`!x a b:real^N. between x (a,b) <=> x IN segment[a,b]`,
  REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN
  ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING] THENL [NORM_ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[segment; IN_ELIM_THM] THEN EQ_TAC THENL
   [DISCH_THEN(ASSUME_TAC o SYM) THEN
    EXISTS_TAC `dist(a:real^N,x) / dist(a,b)` THEN
    ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC
    THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN
    MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `dist(a:real^N,b)` THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB;
                 REAL_DIV_LMUL; DIST_EQ_0] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN
    FIRST_ASSUM(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN
    VECTOR_ARITH_TAC;
    STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN
    REWRITE_TAC[VECTOR_ARITH `a - ((&1 - u) % a + u % b) = u % (a - b)`;
                VECTOR_ARITH `((&1 - u) % a + u % b) - b = (&1 - u) % (a - b)`;
                NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);;

let IN_SEGMENT_COMPONENT = prove
 (`!a b x:real^N i.
        x IN segment[a,b] /\ 1 <= i /\ i <= dimindex(:N)
        ==> min (a$i) (b$i) <= x$i /\ x$i <= max (a$i) (b$i)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
  SIMP_TAC[REAL_ARITH `c <= u * a + t * b <=> u * --a + t * --b <= --c`] THEN
  MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REAL_ARITH_TAC);;

let SEGMENT_TRANSLATION = prove
 (`(!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\
   (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))`,
  REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_IMAGE] THEN
  REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (c + a) + u % (c + b) =
                            c + (&1 - u) % a + u % b`] THEN
  REWRITE_TAC[VECTOR_ARITH `c + a:real^N = c + b <=> a = b`] THEN
  MESON_TAC[]);;

add_translation_invariants
 [CONJUNCT1 SEGMENT_TRANSLATION; CONJUNCT2 SEGMENT_TRANSLATION];;

let CLOSED_SEGMENT_LINEAR_IMAGE = prove
 (`!f a b. linear f
           ==> segment[f a,f b] = IMAGE f (segment[a,b])`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SEGMENT] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN
  MESON_TAC[]);;

add_linear_invariants [CLOSED_SEGMENT_LINEAR_IMAGE];;

let OPEN_SEGMENT_LINEAR_IMAGE = prove
 (`!f:real^M->real^N a b.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> segment(f a,f b) = IMAGE f (segment(a,b))`,
  REWRITE_TAC[open_segment] THEN GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [OPEN_SEGMENT_LINEAR_IMAGE];;

let IN_OPEN_SEGMENT = prove
 (`!a b x:real^N.
        x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]);;

let IN_OPEN_SEGMENT_ALT = prove
 (`!a b x:real^N.
        x IN segment(a,b) <=>
        x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING; NOT_IN_EMPTY] THEN
  ASM_MESON_TAC[IN_OPEN_SEGMENT]);;

let COLLINEAR_DIST_IN_CLOSED_SEGMENT = prove
 (`!a b x. collinear {x,a,b} /\
           dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
           ==> x IN segment[a,b]`,
  REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; COLLINEAR_DIST_BETWEEN]);;

let COLLINEAR_DIST_IN_OPEN_SEGMENT = prove
 (`!a b x. collinear {x,a,b} /\
           dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b)
           ==> x IN segment(a,b)`,
  REWRITE_TAC[IN_OPEN_SEGMENT] THEN
  MESON_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT; REAL_LT_LE; DIST_SYM]);;

let DIST_IN_CLOSED_SEGMENT,DIST_IN_OPEN_SEGMENT = (CONJ_PAIR o prove)
 (`(!a b x:real^N.
    x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\
   (!a b x:real^N.
    x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))`,
  SIMP_TAC[IN_SEGMENT; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; dist;
           VECTOR_ARITH
    `((&1 - u) % a + u % b) - a:real^N = u % (b - a) /\
     ((&1 - u) % a + u % b) - b = --(&1 - u) % (b - a)`] THEN
  REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; NORM_SUB] THEN CONJ_TAC THEN
  REPEAT GEN_TAC THEN STRIP_TAC THENL
   [REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN
    CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
    REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC;
    REWRITE_TAC[REAL_ARITH `x * y < y <=> x * y < &1 * y`] THEN
    ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
    ASM_REAL_ARITH_TAC]);;

let DIST_DECREASES_OPEN_SEGMENT = prove
 (`!a b c x:real^N.
      x IN segment(a,b) ==> dist(c,x) < dist(c,a) \/ dist(c,x) < dist(c,b)`,
  GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_NORMALIZE_TAC `b:real^N` THEN
  REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN X_GEN_TAC `b:real^N` THEN
  GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN
  SIMP_TAC[NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_GE_1; LE_REFL;
           REAL_MUL_RID; VECTOR_MUL_LID] THEN
  REPEAT(DISCH_THEN(K ALL_TAC)) THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[IN_SEGMENT; dist] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
  SUBGOAL_THEN
   `norm((c$1 - u) % basis 1:real^N) < norm((c:real^N)$1 % basis 1:real^N) \/
    norm((c$1 - u) % basis 1:real^N) < norm((c$1 - &1) % basis 1:real^N)`
  MP_TAC THENL
   [SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    ASM_REAL_ARITH_TAC;
    ASM_SIMP_TAC[NORM_LT; DOT_LMUL; DOT_RMUL; DOT_BASIS; DIMINDEX_GE_1;
              DOT_LSUB; DOT_RSUB; LE_REFL; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
              BASIS_COMPONENT; DOT_LZERO; DOT_RZERO; VECTOR_SUB_COMPONENT] THEN
    ASM_REAL_ARITH_TAC]);;

let DIST_DECREASES_CLOSED_SEGMENT = prove
 (`!a b c x:real^N.
      x IN segment[a,b] ==> dist(c,x) <= dist(c,a) \/ dist(c,x) <= dist(c,b)`,
  REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN
  ASM_MESON_TAC[DIST_DECREASES_OPEN_SEGMENT; REAL_LE_REFL; REAL_LT_IMP_LE]);;

let DIST_IN_CLOSED_SEGMENT_2 = prove
 (`!a b x y:real^N.
        x IN segment[a,b] /\ y IN segment[a,b] ==> dist(x,y) <= dist(a,b)`,
  REWRITE_TAC[IN_SEGMENT; dist] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[NORM_MUL; VECTOR_ARITH
   `((&1 - u) % a + u % b) - ((&1 - v) % a + v % b):real^N =
    (v - u) % (a - b)`] THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
  MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
  ASM_REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Connectedness.                                                            *)
(* ------------------------------------------------------------------------- *)

let connected = new_definition
  `connected s <=>
      ~(?e1 e2. open e1 /\ open e2 /\ s SUBSET (e1 UNION e2) /\
                (e1 INTER e2 INTER s = {}) /\
                ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`;;

let CONNECTED_IN_EUCLIDEAN = prove
 (`!s:real^N->bool. connected_in euclidean s <=> connected s`,
  REWRITE_TAC[CONNECTED_IN; connected] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; GSYM OPEN_IN; SUBSET_UNIV; INTER_UNIV]);;

let CONNECTED_SPACE_EUCLIDEAN_SUBTOPOLOGY = prove
 (`!s:real^N->bool.
       connected_space(subtopology euclidean s) <=> connected s`,
  REWRITE_TAC[GSYM CONNECTED_IN_TOPSPACE] THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY] THEN
  REWRITE_TAC[CONNECTED_IN_EUCLIDEAN] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL]);;

let CONNECTED_CLOSED = prove
 (`!s:real^N->bool.
        connected s <=>
        ~(?e1 e2. closed e1 /\ closed e2 /\ s SUBSET (e1 UNION e2) /\
                  (e1 INTER e2 INTER s = {}) /\
                  ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN] THEN
  REWRITE_TAC[CONNECTED_IN_CLOSED_IN; CLOSED_IN] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; INTER_UNIV; SUBSET_UNIV; INTER_ACI]);;

let CONNECTED_OPEN_IN = prove
 (`!s. connected s <=>
           ~(?e1 e2.
                 open_in (subtopology euclidean s) e1 /\
                 open_in (subtopology euclidean s) e2 /\
                 s SUBSET e1 UNION e2 /\
                 e1 INTER e2 = {} /\
                 ~(e1 = {}) /\
                 ~(e2 = {}))`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; connected_in] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[connected_space; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONNECTED_OPEN_IN_EQ = prove
 (`!s. connected s <=>
           ~(?e1 e2.
                 open_in (subtopology euclidean s) e1 /\
                 open_in (subtopology euclidean s) e2 /\
                 e1 UNION e2 = s /\ e1 INTER e2 = {} /\
                 ~(e1 = {}) /\ ~(e2 = {}))`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; connected_in] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[CONNECTED_SPACE_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONNECTED_CLOSED_IN = prove
 (`!s. connected s <=>
           ~(?e1 e2.
                 closed_in (subtopology euclidean s) e1 /\
                 closed_in (subtopology euclidean s) e2 /\
                 s SUBSET e1 UNION e2 /\
                 e1 INTER e2 = {} /\
                 ~(e1 = {}) /\
                 ~(e2 = {}))`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; connected_in] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[CONNECTED_SPACE_CLOSED_IN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONNECTED_CLOSED_IN_EQ = prove
 (`!s. connected s <=>
           ~(?e1 e2.
                 closed_in (subtopology euclidean s) e1 /\
                 closed_in (subtopology euclidean s) e2 /\
                 e1 UNION e2 = s /\ e1 INTER e2 = {} /\
                 ~(e1 = {}) /\ ~(e2 = {}))`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; connected_in] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[CONNECTED_SPACE_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONNECTED_CLOPEN = prove
 (`!s. connected s <=>
        !t. open_in (subtopology euclidean s) t /\
            closed_in (subtopology euclidean s) t ==> t = {} \/ t = s`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; connected_in] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[CONNECTED_SPACE_CLOPEN_IN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONNECTED_CLOSED_SET = prove
 (`!s:real^N->bool.
        closed s
        ==> (connected s <=>
             ~(?e1 e2. closed e1 /\ closed e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\
                       e1 UNION e2 = s /\ e1 INTER e2 = {}))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN
  ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ] THEN AP_TERM_TAC THEN
  REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]);;

let CONNECTED_OPEN_SET = prove
 (`!s:real^N->bool.
        open s
        ==> (connected s <=>
             ~(?e1 e2. open e1 /\ open e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\
                       e1 UNION e2 = s /\ e1 INTER e2 = {}))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_OPEN_IN_EQ] THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_EQ] THEN AP_TERM_TAC THEN
  REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]);;

let CONNECTED_IFF_CONNECTABLE_POINTS = prove
 (`!s:real^N->bool.
        connected s <=>
        !a b. a IN s /\ b IN s
              ==> ?t. connected t /\ t SUBSET s /\ a IN t /\ b IN t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN] THEN
  GEN_REWRITE_TAC LAND_CONV [connected_in] THEN
  REWRITE_TAC[CONNECTED_SPACE_SUBCONNECTED; TOPSPACE_EUCLIDEAN; SUBSET_UNIV;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY; GSYM CONJ_ASSOC]);;

let CONNECTED_EMPTY = prove
 (`connected {}`,
  REWRITE_TAC[connected; INTER_EMPTY]);;

let CONNECTED_SING = prove
 (`!a. connected{a}`,
  REWRITE_TAC[connected] THEN SET_TAC[]);;

let CONNECTED_SEGMENT = prove
 (`(!a b:real^N. connected(segment[a,b])) /\
   (!a b:real^N. connected(segment(a,b)))`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `b:real^N = a` THEN
  ASM_SIMP_TAC[SEGMENT_REFL; CONNECTED_EMPTY; CONNECTED_SING] THEN
  GEN_REWRITE_TAC RAND_CONV [SET_RULE `s = {x | x IN s}`] THEN
  ASM_REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; IN_SEGMENT; SET_RULE
   `{x | ?u. P u /\ Q u /\ x = f u} = IMAGE f {u | P u /\ Q u}`] THEN
  MATCH_MP_TAC CONNECTED_IN_CONTINUOUS_MAP_IMAGE THEN
  EXISTS_TAC `euclideanreal` THEN
  REWRITE_TAC[GSYM real_interval; CONNECTED_IN_EUCLIDEANREAL_INTERVAL] THEN
  REWRITE_TAC[CONTINUOUS_MAP_COMPONENTWISE_REAL] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
  MATCH_MP_TAC CONTINUOUS_MAP_REAL_ADD THEN CONJ_TAC THEN
  MATCH_MP_TAC CONTINUOUS_MAP_REAL_RMUL THEN
  TRY(MATCH_MP_TAC CONTINUOUS_MAP_REAL_SUB) THEN
  REWRITE_TAC[CONTINUOUS_MAP_ID; CONTINUOUS_MAP_CONST] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEANREAL; IN_UNIV]);;

let CONNECTED_UNIV = prove
 (`connected(:real^N)`,
  ONCE_REWRITE_TAC[CONNECTED_IFF_CONNECTABLE_POINTS] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
  REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN
  EXISTS_TAC `segment[a:real^N,b]` THEN
  ASM_REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT]);;

let CLOPEN = prove
 (`!s. closed s /\ open s <=> s = {} \/ s = (:real^N)`,
  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[CLOSED_EMPTY; OPEN_EMPTY; CLOSED_UNIV; OPEN_UNIV] THEN
  MATCH_MP_TAC(REWRITE_RULE[CONNECTED_CLOPEN] CONNECTED_UNIV) THEN
  ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN]);;

let CONNECTED_UNIONS = prove
 (`!P:(real^N->bool)->bool.
        (!s. s IN P ==> connected s) /\ ~(INTERS P = {})
        ==> connected(UNIONS P)`,
  GEN_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`] THEN
  STRIP_TAC THEN UNDISCH_TAC `~(INTERS P :real^N->bool = {})` THEN
  PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `(a:real^N) IN e1 \/ a IN e2` STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[];
    UNDISCH_TAC `~(e2 INTER UNIONS P:real^N->bool = {})`;
    UNDISCH_TAC `~(e1 INTER UNIONS P:real^N->bool = {})`] THEN
  PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_UNIONS] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^N`
   (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
  UNDISCH_TAC `!t:real^N->bool. t IN P ==> a IN t` THEN
  DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPECL [`e1:real^N->bool`; `e2:real^N->bool`]) THEN
  ASM SET_TAC[]);;

let CONNECTED_UNION = prove
 (`!s t:real^N->bool.
        connected s /\ connected t /\ ~(s INTER t = {})
        ==> connected (s UNION t)`,
  REWRITE_TAC[GSYM UNIONS_2; GSYM INTERS_2] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
  ASM SET_TAC[]);;

let CONNECTED_DIFF_OPEN_FROM_CLOSED = prove
 (`!s t u:real^N->bool.
        s SUBSET t /\ t SUBSET u /\
        open s /\ closed t /\ connected u /\ connected(t DIFF s)
        ==> connected(u DIFF s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN
  UNDISCH_TAC `connected(t DIFF s:real^N->bool)` THEN SIMP_TAC[connected] THEN
  MAP_EVERY EXISTS_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN
  ASM_REWRITE_TAC[] THEN
  REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v:real^N->bool`; `w:real^N->bool`] THEN
  MATCH_MP_TAC(MESON[]
   `(!v w. P v w ==> P w v) /\ (!w v. P v w /\ Q w ==> F)
    ==> !w v. P v w ==> ~(Q v) /\ ~(Q w)`) THEN
  CONJ_TAC THENL [SIMP_TAC[CONJ_ACI; INTER_ACI; UNION_ACI]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN SIMP_TAC[] THEN
  MAP_EVERY EXISTS_TAC [`v UNION s:real^N->bool`; `w DIFF t:real^N->bool`] THEN
  ASM_SIMP_TAC[OPEN_UNION; OPEN_DIFF] THEN ASM SET_TAC[]);;

let CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE = prove
 (`!f:(real^N->bool)->bool f'.
         pairwise DISJOINT f /\ pairwise DISJOINT f' /\
        (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\
        (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\
        UNIONS f = UNIONS f'
        ==> f = f'`,
  GEN_REWRITE_TAC (funpow 2 BINDER_CONV o RAND_CONV) [EXTENSION] THEN
  MATCH_MP_TAC(MESON[]
   `(!s t. P s t ==> P t s) /\ (!s t x. P s t /\ x IN s ==> x IN t)
    ==> (!s t. P s t ==> (!x. x IN s <=> x IN t))`) THEN
  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `?t a:real^N. t IN f' /\ a IN s /\ a IN t` STRIP_ASSUME_TAC
  THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN
  REWRITE_TAC[EXTENSION] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t))
   [`s:real^N->bool`; `t:real^N->bool`;
    `f:(real^N->bool)->bool`; `f':(real^N->bool)->bool`] THEN
  MATCH_MP_TAC(MESON[]
   `(!f f' s t. P f f' s t ==> P f' f t s) /\
    (!f f' s t x. P f f' s t /\ x IN s ==> x IN t)
    ==> (!f' f t s. P f f' s t ==> (!x. x IN s <=> x IN t))`) THEN
  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  REPLICATE_TAC 4 GEN_TAC THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
  UNDISCH_TAC
   `!s:real^N->bool. s IN f ==> open s /\ connected s /\ ~(s = {})` THEN
  DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN ASM_CASES_TAC `(b:real^N) IN t` THEN
  ASM_REWRITE_TAC[] THEN
  UNDISCH_TAC `connected(s:real^N->bool)` THEN
  REWRITE_TAC[connected] THEN
  MAP_EVERY EXISTS_TAC
   [`t:real^N->bool`; `UNIONS(f' DELETE (t:real^N->bool))`] THEN
  REPEAT STRIP_TAC THENL
   [ASM_SIMP_TAC[];
    MATCH_MP_TAC OPEN_UNIONS THEN ASM_SIMP_TAC[IN_DELETE];
    REWRITE_TAC[GSYM UNIONS_INSERT] THEN ASM SET_TAC[];
    MATCH_MP_TAC(SET_RULE `t INTER u = {} ==> t INTER u INTER s = {}`) THEN
    REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[IN_DELETE; GSYM DISJOINT] THEN ASM_MESON_TAC[pairwise];
    ASM SET_TAC[];
    ASM SET_TAC[]]);;

let CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL = prove
 (`!u s t:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        connected(s UNION t) /\ connected(s INTER t)
        ==> connected s /\ connected t`,
  GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(!s t. P s t ==> P t s) /\ (!s t. P s t ==> Q s)
    ==> !s t. P s t ==> Q s /\ Q t`) THEN
  CONJ_TAC THENL [SIMP_TAC[UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC] THEN
  REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN
  STRIP_TAC THEN ASM_CASES_TAC
   `~(s INTER t SUBSET (a:real^N->bool)) /\ ~(s INTER t SUBSET b)`
  THENL
   [UNDISCH_TAC `connected(s INTER t:real^N->bool)` THEN
    ASM_SIMP_TAC[CONNECTED_CLOSED_IN] THEN
    MAP_EVERY EXISTS_TAC
     [`t INTER a:real^N->bool`; `t INTER b:real^N->bool`] THEN
    GEN_REWRITE_TAC I [CONJ_ASSOC] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL
     [UNDISCH_TAC `closed_in (subtopology euclidean s) (a:real^N->bool)`;
      UNDISCH_TAC `closed_in (subtopology euclidean s) (b:real^N->bool)`] THEN
    REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN
    ASM SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN
    REWRITE_TAC[] THEN STRIP_TAC THEN
    UNDISCH_TAC `connected(s UNION t:real^N->bool)` THEN
    ASM_SIMP_TAC[CONNECTED_CLOSED_IN] THENL
     [MAP_EVERY EXISTS_TAC [`t UNION a:real^N->bool`; `b:real^N->bool`];
      MAP_EVERY EXISTS_TAC [`t UNION b:real^N->bool`; `a:real^N->bool`]] THEN
    (GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
      [ALL_TAC;
       REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
       ASM SET_TAC[]] THEN
     CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC; ALL_TAC] THEN
     MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
     (CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS]; ALL_TAC]) THEN
     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
     ASM SET_TAC[])]);;

let CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL = prove
 (`!u s t:real^N->bool.
        open_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) t /\
        connected(s UNION t) /\ connected(s INTER t)
        ==> connected s /\ connected t`,
  GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(!s t. P s t ==> P t s) /\ (!s t. P s t ==> Q s)
    ==> !s t. P s t ==> Q s /\ Q t`) THEN
  CONJ_TAC THENL [SIMP_TAC[UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC] THEN
  REWRITE_TAC[CONNECTED_OPEN_IN; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN
  STRIP_TAC THEN ASM_CASES_TAC
   `~(s INTER t SUBSET (a:real^N->bool)) /\ ~(s INTER t SUBSET b)`
  THENL
   [UNDISCH_TAC `connected(s INTER t:real^N->bool)` THEN
    ASM_SIMP_TAC[CONNECTED_OPEN_IN] THEN
    MAP_EVERY EXISTS_TAC
     [`t INTER a:real^N->bool`; `t INTER b:real^N->bool`] THEN
    GEN_REWRITE_TAC I [CONJ_ASSOC] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL
     [UNDISCH_TAC `open_in (subtopology euclidean s) (a:real^N->bool)`;
      UNDISCH_TAC `open_in (subtopology euclidean s) (b:real^N->bool)`] THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
    ASM SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN
    REWRITE_TAC[] THEN STRIP_TAC THEN
    UNDISCH_TAC `connected(s UNION t:real^N->bool)` THEN
    ASM_SIMP_TAC[CONNECTED_OPEN_IN] THENL
     [MAP_EVERY EXISTS_TAC [`t UNION a:real^N->bool`; `b:real^N->bool`];
      MAP_EVERY EXISTS_TAC [`t UNION b:real^N->bool`; `a:real^N->bool`]] THEN
    (GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
      [ALL_TAC;
       REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
       ASM SET_TAC[]] THEN
     CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_UNION THEN CONJ_TAC; ALL_TAC] THEN
     MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
     (CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC]) THEN
     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
     ASM SET_TAC[])]);;

let CONNECTED_FROM_CLOSED_UNION_AND_INTER = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\ connected(s UNION t) /\ connected(s INTER t)
        ==> connected s /\ connected t`,
  ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL]);;

let CONNECTED_FROM_OPEN_UNION_AND_INTER = prove
 (`!s t:real^N->bool.
        open s /\ open t /\ connected(s UNION t) /\ connected(s INTER t)
        ==> connected s /\ connected t`,
  ONCE_REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL]);;

(* ------------------------------------------------------------------------- *)
(* Sort of induction principle for connected sets.                           *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_INDUCTION = prove
 (`!P Q s:real^N->bool.
        connected s /\
        (!t a. open_in (subtopology euclidean s) t /\ a IN t
               ==> ?z. z IN t /\ P z) /\
        (!a. a IN s
             ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
                     !x y. x IN t /\ y IN t /\ P x /\ P y /\ Q x ==> Q y)
        ==> !a b. a IN s /\ b IN s /\ P a /\ P b /\ Q a ==> Q b`,
  REPEAT STRIP_TAC THEN
  GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN
  REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
   [`{b:real^N | ?t. open_in (subtopology euclidean s) t /\ b IN t /\
                     !x. x IN t /\ P x ==> Q x}`;
    `{b:real^N | ?t. open_in (subtopology euclidean s) t /\ b IN t /\
                     !x. x IN t /\ P x ==> ~(Q x)}`] THEN
  REPEAT CONJ_TAC THENL
   [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `c:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `c:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
    REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN
    X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ASM SET_TAC[];
    REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN
    X_GEN_TAC `c:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2
     (X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC)
     (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`t INTER u:real^N->bool`; `c:real^N`]) THEN
    ASM_SIMP_TAC[OPEN_IN_INTER] THEN ASM SET_TAC[];
    ASM SET_TAC[];
    ASM SET_TAC[]]);;

let CONNECTED_EQUIVALENCE_RELATION_GEN = prove
 (`!P R s:real^N->bool.
        connected s /\
        (!x y. R x y ==> R y x) /\
        (!x y z. R x y /\ R y z ==> R x z) /\
        (!t a. open_in (subtopology euclidean s) t /\ a IN t
               ==> ?z. z IN t /\ P z) /\
        (!a. a IN s
             ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
                     !x y. x IN t /\ y IN t /\ P x /\ P y ==> R x y)
        ==> !a b. a IN s /\ b IN s /\ P a /\ P b ==> R a b`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!a:real^N. a IN s /\ P a
               ==> !b c. b IN s /\ c IN s /\ P b /\ P c /\ R a b ==> R a c`
  MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION THEN
  ASM_MESON_TAC[]);;

let CONNECTED_INDUCTION_SIMPLE = prove
 (`!P s:real^N->bool.
        connected s /\
        (!a. a IN s
             ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
                     !x y. x IN t /\ y IN t /\ P x ==> P y)
        ==> !a b. a IN s /\ b IN s /\ P a ==> P b`,
  MP_TAC(ISPEC `\x:real^N. T` CONNECTED_INDUCTION) THEN
  REWRITE_TAC[] THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);;

let CONNECTED_EQUIVALENCE_RELATION = prove
 (`!R s:real^N->bool.
        connected s /\
        (!x y. R x y ==> R y x) /\
        (!x y z. R x y /\ R y z ==> R x z) /\
        (!a. a IN s
             ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
                     !x. x IN t ==> R a x)
        ==> !a b. a IN s /\ b IN s ==> R a b`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!a:real^N. a IN s ==> !b c. b IN s /\ c IN s /\ R a b ==> R a c`
  MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION_SIMPLE THEN
  ASM_MESON_TAC[]);;

let LOCALLY_CONSTANT_IMP_CONSTANT = prove
 (`!f:real^N->A s.
        connected s /\
        (!x. x IN s
             ==> ?u. open_in (subtopology euclidean s) u /\ x IN u /\
                     !x'. x' IN u ==> f x' = f x)
        ==> ?c. !x. x IN s ==> f x = c`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[]
   `(?c. !x. P x ==> f x = c) <=> (!x y. P x /\ P y ==> f x = f y)`] THEN
  CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
  MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN
  ASM_SIMP_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Limit points.                                                             *)
(* ------------------------------------------------------------------------- *)

parse_as_infix ("limit_point_of",(12,"right"));;

let limit_point_of = new_definition
 `x limit_point_of s <=>
        !t. x IN t /\ open t ==> ?y. ~(y = x) /\ y IN s /\ y IN t`;;

let EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF = prove
  (`!s. euclidean derived_set_of s = {x:real^N | x limit_point_of s}`,
   GEN_TAC THEN
   REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; METRIC_DERIVED_SET_OF;
               EUCLIDEAN_METRIC; IN_UNIV; limit_point_of; EXTENSION;
               IN_ELIM_THM; MBALL_EUCLIDEAN] THEN
   GEN_TAC THEN EQ_TAC THENL
   [INTRO_TAC "hp; !t; x t" THEN HYP_TAC "t" (REWRITE_RULE[open_def]) THEN
    HYP_TAC "t: @r. r t" (C MATCH_MP (ASSUME `x:real^N IN t`)) THEN
    HYP_TAC "hp: @y. neq y dist" (C MATCH_MP (ASSUME `&0 < r`)) THEN
    EXISTS_TAC `y:real^N` THEN HYP REWRITE_TAC "neq y" [] THEN
    REMOVE_THEN "t" MATCH_MP_TAC THEN REMOVE_THEN "dist" MP_TAC THEN
    REWRITE_TAC[IN_BALL; DIST_SYM];
    INTRO_TAC "hp; !r; r" THEN REMOVE_THEN "hp" MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL]]);;

let LIMIT_POINT_IN_DERIVED_SET = prove
 (`!s x:real^N. x limit_point_of s <=> x IN euclidean derived_set_of s`,
  REWRITE_TAC[EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF; IN_ELIM_THM]);;

let LIMPT_SUBSET = prove
 (`!x s t. x limit_point_of s /\ s SUBSET t ==> x limit_point_of t`,
  REWRITE_TAC[limit_point_of; SUBSET] THEN MESON_TAC[]);;

let LIMPT_APPROACHABLE = prove
 (`!x s. x limit_point_of s <=>
                !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN
  MESON_TAC[open_def; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; IN_BALL]);;

let LIMPT_APPROACHABLE_LE = prove
 (`!x s. x limit_point_of s <=>
                !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
  MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
  REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`; APPROACHABLE_LT_LE]);;

let DISCRETE_SET = prove
 (`!s t:real^N->bool.
        {x | x IN t /\ x limit_point_of s} = {} <=>
        !x. x IN t
            ==> ?e. &0 < e /\ !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)`,
  REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN
  REWRITE_TAC[LIMPT_APPROACHABLE] THEN
  REWRITE_TAC[dist; GSYM REAL_NOT_LE] THEN MESON_TAC[]);;

let CLOSED_LIMPT = prove
 (`!s. closed s <=> !x. x limit_point_of s ==> x IN s`,
  REWRITE_TAC[closed] THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN
  REWRITE_TAC[limit_point_of; IN_DIFF; IN_UNIV; SUBSET] THEN MESON_TAC[]);;

let LIMPT_EMPTY = prove
 (`!x. ~(x limit_point_of {})`,
  REWRITE_TAC[LIMPT_APPROACHABLE; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);;

let NO_LIMIT_POINT_IMP_CLOSED = prove
 (`!s. ~(?x. x limit_point_of s) ==> closed s`,
  MESON_TAC[CLOSED_LIMPT]);;

let CLOSED_POSITIVE_ORTHANT = prove
 (`closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
                          ==> &0 <= x$i}`,
  REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `--(x:real^N $ i)`) THEN
  ASM_REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; NOT_EXISTS_THM] THEN
  X_GEN_TAC `y:real^N` THEN
  MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN
  MATCH_MP_TAC(REAL_ARITH `!b. abs x <= b /\ b <= a ==> ~(a + x < &0)`) THEN
  EXISTS_TAC `abs((y - x :real^N)$i)` THEN
  ASM_SIMP_TAC[dist; COMPONENT_LE_NORM] THEN
  ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH
   `x < &0 /\ &0 <= y ==> abs(x) <= abs(y - x)`]);;

let FINITE_SET_AVOID = prove
 (`!a:real^N s. FINITE s
                ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)`,
  GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[NOT_IN_EMPTY] THEN
  CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `x:real^N = a` THEN REWRITE_TAC[IN_INSERT] THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  EXISTS_TAC `min d (dist(a:real^N,x))` THEN
  ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_MIN_LE] THEN
  ASM_MESON_TAC[REAL_LE_REFL]);;

let LIMIT_POINT_FINITE = prove
 (`!s a. FINITE s ==> ~(a limit_point_of s)`,
  REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LE] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LE;
    REAL_NOT_LT; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN
  MESON_TAC[FINITE_SET_AVOID; DIST_SYM]);;

let LIMPT_SING = prove
 (`!x y:real^N. ~(x limit_point_of {y})`,
  SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING]);;

let LIMIT_POINT_UNION = prove
 (`!s t x:real^N. x limit_point_of (s UNION t) <=>
                  x limit_point_of s \/ x limit_point_of t`,
  REWRITE_TAC[LIMIT_POINT_IN_DERIVED_SET; DERIVED_SET_OF_UNION; IN_UNION]);;

let LIMPT_INSERT = prove
 (`!s x y:real^N. x limit_point_of (y INSERT s) <=> x limit_point_of s`,
  ONCE_REWRITE_TAC[SET_RULE `y INSERT s = {y} UNION s`] THEN
  REWRITE_TAC[LIMIT_POINT_UNION] THEN
  SIMP_TAC[FINITE_SING; LIMIT_POINT_FINITE]);;

let LIMPT_DELETE = prove
 (`!s a x:real^N. x limit_point_of (s DELETE a) <=> x limit_point_of s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN
  ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`] THEN
  TRANS_TAC EQ_TRANS `(x:real^N) limit_point_of a INSERT (s DELETE a)` THEN
  CONJ_TAC THENL [REWRITE_TAC[LIMPT_INSERT]; AP_TERM_TAC THEN ASM SET_TAC[]]);;

let LIMIT_POINT_UNIONS = prove
 (`!f x:real^N.
      FINITE f
      ==> (x limit_point_of (UNIONS f) <=> ?s. s IN f /\ x limit_point_of s)`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_0; LIMPT_EMPTY; NOT_IN_EMPTY] THEN
  SIMP_TAC[UNIONS_INSERT; LIMIT_POINT_UNION; EXISTS_IN_INSERT]);;

let LIMPT_OF_LIMPTS = prove
 (`!x:real^N s.
     x limit_point_of {y | y limit_point_of s} ==> x limit_point_of s`,
  REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `dist(y:real^N,x)`) THEN
  ASM_SIMP_TAC[DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN
  GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;

let CLOSED_LIMPTS = prove
 (`!s. closed {x:real^N | x limit_point_of s}`,
  REWRITE_TAC[CLOSED_LIMPT; IN_ELIM_THM; LIMPT_OF_LIMPTS]);;

let DISCRETE_IMP_CLOSED = prove
 (`!s:real^N->bool e.
        &0 < e /\
        (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x)
        ==> closed s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `!x:real^N. ~(x limit_point_of s)`
    (fun th -> MESON_TAC[th; CLOSED_LIMPT]) THEN
  GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  REWRITE_TAC[REAL_HALF; ASSUME `&0 < e`] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `min (e / &2) (dist(x:real^N,y))`) THEN
  ASM_SIMP_TAC[REAL_LT_MIN; DIST_POS_LT; REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
  ASM_REWRITE_TAC[] THEN ASM_NORM_ARITH_TAC);;

let LIMPT_OF_UNIV = prove
 (`!x. x limit_point_of (:real^N)`,
  GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`x:real^N`; `e / &2`] VECTOR_CHOOSE_DIST) THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
  POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH);;

let LIMPT_OF_OPEN_IN = prove
 (`!s t x:real^N.
        open_in (subtopology euclidean s) t /\ x limit_point_of s /\ x IN t
        ==> x limit_point_of t`,
  REWRITE_TAC[open_in; SUBSET; LIMPT_APPROACHABLE] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
  GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
  TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN
  ASM_REAL_ARITH_TAC);;

let LIMPT_OF_OPEN = prove
 (`!s x:real^N. open s /\ x IN s ==> x limit_point_of s`,
  REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  MESON_TAC[LIMPT_OF_OPEN_IN; LIMPT_OF_UNIV]);;

let OPEN_IN_SING = prove
 (`!s a. open_in (subtopology euclidean s) {a} <=>
         a IN s /\ ~(a limit_point_of s)`,
  REWRITE_TAC[open_in; LIMPT_APPROACHABLE; SING_SUBSET; IN_SING] THEN
  REWRITE_TAC[FORALL_UNWIND_THM2] THEN MESON_TAC[]);;

let CLOSED_SING = prove
 (`!a:real^N. closed {a}`,
  REWRITE_TAC[CLOSED_LIMPT; LIMPT_INSERT; LIMPT_EMPTY]);;

let CLOSED_IN_SING = prove
 (`!u x:real^N. closed_in (subtopology euclidean u) {x} <=> x IN u`,
  SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_SING] THEN SET_TAC[]);;

let CLOSED_IN_INSERT = prove
 (`!u s a:real^N.
        closed_in (subtopology euclidean u) s /\ a IN u
        ==> closed_in (subtopology euclidean u) (a INSERT s)`,
  ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
  SIMP_TAC[CLOSED_IN_UNION; CLOSED_IN_SING]);;

let LIMIT_POINT_OF_LOCAL_IMP = prove
 (`!u s t x:real^N.
        s SUBSET u /\ x limit_point_of s /\
        x IN t /\ open_in (subtopology euclidean u) t
        ==> ?y. ~(y = x) /\ y IN s /\ y IN t`,
  REWRITE_TAC[limit_point_of; OPEN_IN_OPEN] THEN SET_TAC[]);;

let LIMIT_POINT_OF_LOCAL = prove
 (`!u s x:real^N.
        s SUBSET u /\ x IN u
        ==> (x limit_point_of s <=>
             !t. x IN t /\ open_in (subtopology euclidean u) t
                 ==> ?y. ~(y = x) /\ y IN s /\ y IN t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of; OPEN_IN_OPEN] THEN
  REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] THEN
  REWRITE_TAC[FORALL_UNWIND_THM2; IN_INTER] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Interior of a set.                                                        *)
(* ------------------------------------------------------------------------- *)

let interior = new_definition
  `interior s = {x | ?t. open t /\ x IN t /\ t SUBSET s}`;;

let EUCLIDEAN_INTERIOR_OF = prove
 (`!s:real^N->bool. euclidean interior_of s = interior s`,
  REWRITE_TAC[interior_of; interior; OPEN_IN]);;

let INTERIOR_EQ = prove
 (`!s. (interior s = s) <=> open s`,
  GEN_TAC THEN REWRITE_TAC[EXTENSION; interior; IN_ELIM_THM] THEN
  GEN_REWRITE_TAC RAND_CONV [OPEN_SUBOPEN] THEN MESON_TAC[SUBSET]);;

let INTERIOR_OPEN = prove
 (`!s. open s ==> (interior s = s)`,
  MESON_TAC[INTERIOR_EQ]);;

let INTERIOR_EMPTY = prove
 (`interior {} = {}`,
  SIMP_TAC[INTERIOR_OPEN; OPEN_EMPTY]);;

let INTERIOR_UNIV = prove
 (`interior(:real^N) = (:real^N)`,
  SIMP_TAC[INTERIOR_OPEN; OPEN_UNIV]);;

let OPEN_INTERIOR = prove
 (`!s. open(interior s)`,
  GEN_TAC THEN REWRITE_TAC[interior] THEN GEN_REWRITE_TAC I [OPEN_SUBOPEN] THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);;

let INTERIOR_INTERIOR = prove
 (`!s. interior(interior s) = interior s`,
  MESON_TAC[INTERIOR_EQ; OPEN_INTERIOR]);;

let INTERIOR_SUBSET = prove
 (`!s. (interior s) SUBSET s`,
  REWRITE_TAC[SUBSET; interior; IN_ELIM_THM] THEN MESON_TAC[]);;

let SUBSET_INTERIOR_EQ = prove
 (`!s:real^N->bool. s SUBSET interior s <=> open s`,
  REWRITE_TAC[GSYM INTERIOR_EQ; GSYM SUBSET_ANTISYM_EQ; INTERIOR_SUBSET]);;

let SUBSET_INTERIOR = prove
 (`!s t. s SUBSET t ==> (interior s) SUBSET (interior t)`,
  REWRITE_TAC[interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);;

let INTERIOR_MAXIMAL = prove
 (`!s t. t SUBSET s /\ open t ==> t SUBSET (interior s)`,
  REWRITE_TAC[interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);;

let INTERIOR_MAXIMAL_EQ = prove
 (`!s t:real^N->bool. open s ==> (s SUBSET interior t <=> s SUBSET t)`,
  MESON_TAC[INTERIOR_MAXIMAL; SUBSET_TRANS; INTERIOR_SUBSET]);;

let INTERIOR_UNIQUE = prove
 (`!s t. t SUBSET s /\ open t /\ (!t'. t' SUBSET s /\ open t' ==> t' SUBSET t)
         ==> (interior s = t)`,
  MESON_TAC[SUBSET_ANTISYM; INTERIOR_MAXIMAL; INTERIOR_SUBSET;
            OPEN_INTERIOR]);;

let INTERIOR_EQ_UNIV = prove
 (`!s. interior s = (:real^N) <=> s = (:real^N)`,
  SIMP_TAC[SET_RULE `s = UNIV <=> UNIV SUBSET s`; OPEN_UNIV;
           INTERIOR_MAXIMAL_EQ]);;

let IN_INTERIOR = prove
 (`!x s. x IN interior s <=> ?e. &0 < e /\ ball(x,e) SUBSET s`,
  REWRITE_TAC[interior; IN_ELIM_THM] THEN
  MESON_TAC[OPEN_CONTAINS_BALL; SUBSET_TRANS; CENTRE_IN_BALL; OPEN_BALL]);;

let INTERIOR_INTER = prove
 (`!s t:real^N->bool. interior(s INTER t) = interior s INTER interior t`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; INTERIOR_OF_INTER]);;

let INTERIOR_FINITE_INTERS = prove
 (`!s:(real^N->bool)->bool.
        FINITE s ==> interior(INTERS s) = INTERS(IMAGE interior s)`,
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[INTERS_0; INTERS_INSERT; INTERIOR_UNIV; IMAGE_CLAUSES] THEN
  SIMP_TAC[INTERIOR_INTER]);;

let INTERIOR_INTERS_SUBSET = prove
 (`!f. interior(INTERS f) SUBSET INTERS (IMAGE interior f)`,
  REWRITE_TAC[SUBSET; IN_INTERIOR; IN_INTERS; FORALL_IN_IMAGE] THEN
  MESON_TAC[]);;

let UNION_INTERIOR_SUBSET = prove
 (`!s t:real^N->bool.
        interior s UNION interior t SUBSET interior(s UNION t)`,
  SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_UNION; OPEN_INTERIOR] THEN
  REPEAT GEN_TAC THEN MATCH_MP_TAC(SET_RULE
   `s SUBSET s' /\ t SUBSET t' ==> (s UNION t) SUBSET (s' UNION t')`) THEN
  REWRITE_TAC[INTERIOR_SUBSET]);;

let INTERIOR_EQ_EMPTY = prove
 (`!s:real^N->bool. interior s = {} <=> !t. open t /\ t SUBSET s ==> t = {}`,
  MESON_TAC[INTERIOR_MAXIMAL_EQ; SUBSET_EMPTY;
            OPEN_INTERIOR; INTERIOR_SUBSET]);;

let INTERIOR_EQ_EMPTY_ALT = prove
 (`!s:real^N->bool.
        interior s = {} <=>
        !t. open t /\ ~(t = {}) ==> ~(t DIFF s = {})`,
  GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN SET_TAC[]);;

let INTERIOR_LIMIT_POINT = prove
 (`!s x:real^N. x IN interior s ==> x limit_point_of s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[IN_INTERIOR; IN_ELIM_THM; SUBSET; IN_BALL] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `d:real` THEN
  DISCH_TAC THEN
  MP_TAC(ISPECL [`x:real^N`; `min d e / &2`] VECTOR_CHOOSE_DIST) THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
  REPEAT CONJ_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC;
    CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM DIST_EQ_0];
    ONCE_REWRITE_TAC[DIST_SYM]] THEN
  ASM_REAL_ARITH_TAC);;

let INTERIOR_SING = prove
 (`!a:real^N. interior {a} = {}`,
  REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
  MESON_TAC[INTERIOR_LIMIT_POINT; LIMPT_SING]);;

let INTERIOR_CLOSED_UNION_EMPTY_INTERIOR = prove
 (`!s t:real^N->bool.
        closed(s) /\ interior(t) = {}
        ==> interior(s UNION t) = interior(s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; CLOSED_IN] THEN
  REWRITE_TAC[INTERIOR_OF_CLOSED_IN_UNION_EMPTY_INTERIOR_OF]);;

let INTERIOR_UNION_EQ_EMPTY = prove
 (`!s t:real^N->bool.
        closed s \/ closed t
        ==> (interior(s UNION t) = {} <=>
             interior s = {} /\ interior t = {})`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
   [ASM_MESON_TAC[SUBSET_UNION; SUBSET_INTERIOR; SUBSET_EMPTY];
    ASM_MESON_TAC[UNION_COMM; INTERIOR_CLOSED_UNION_EMPTY_INTERIOR]]);;

let INTERIOR_UNIONS_OPEN_SUBSETS = prove
 (`!s:real^N->bool. UNIONS {t | open t /\ t SUBSET s} = interior s`,
  GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN
  SIMP_TAC[OPEN_UNIONS; IN_ELIM_THM] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Closure of a set.                                                         *)
(* ------------------------------------------------------------------------- *)

let closure = new_definition
  `closure s = s UNION {x | x limit_point_of s}`;;

let EUCLIDEAN_CLOSURE_OF = prove
  (`!s:real^N->bool. euclidean closure_of s = closure s`,
   GEN_TAC THEN
   REWRITE_TAC[closure; CLOSURE_OF; TOPSPACE_EUCLIDEAN; INTER_UNIV;
               EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF]);;

let CLOSURE_APPROACHABLE = prove
 (`!x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e`,
  REWRITE_TAC[closure; LIMPT_APPROACHABLE; IN_UNION; IN_ELIM_THM] THEN
  MESON_TAC[DIST_REFL]);;

let CLOSURE_NONEMPTY_OPEN_INTER = prove
 (`!s x:real^N. x IN closure s <=> !t. x IN t /\ open t ==> ~(s INTER t = {})`,
  REPEAT GEN_TAC THEN REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN
  REWRITE_TAC[limit_point_of] THEN SET_TAC[]);;

let CLOSURE_INTERIOR = prove
 (`!s:real^N->bool. closure s = UNIV DIFF (interior (UNIV DIFF s))`,
  REWRITE_TAC[EXTENSION; closure; IN_UNION; IN_DIFF; IN_UNIV; interior;
              IN_ELIM_THM; limit_point_of; SUBSET] THEN
  MESON_TAC[]);;

let INTERIOR_CLOSURE = prove
 (`!s:real^N->bool. interior s = UNIV DIFF (closure (UNIV DIFF s))`,
  REWRITE_TAC[CLOSURE_INTERIOR; COMPL_COMPL]);;

let CLOSED_CLOSURE = prove
 (`!s. closed(closure s)`,
  REWRITE_TAC[closed; CLOSURE_INTERIOR; COMPL_COMPL; OPEN_INTERIOR]);;

let CLOSURE_HULL = prove
 (`!s. closure s = closed hull s`,
  GEN_TAC THEN MATCH_MP_TAC(GSYM HULL_UNIQUE) THEN
  REWRITE_TAC[CLOSED_CLOSURE; SUBSET] THEN
  REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; CLOSED_LIMPT] THEN
  MESON_TAC[limit_point_of]);;

let CLOSURE_EQ = prove
 (`!s. (closure s = s) <=> closed s`,
  SIMP_TAC[CLOSURE_HULL; HULL_EQ; CLOSED_INTERS]);;

let CLOSURE_CLOSED = prove
 (`!s. closed s ==> (closure s = s)`,
  MESON_TAC[CLOSURE_EQ]);;

let CLOSURE_CLOSURE = prove
 (`!s. closure(closure s) = closure s`,
  REWRITE_TAC[CLOSURE_HULL; HULL_HULL]);;

let CLOSURE_SUBSET = prove
 (`!s. s SUBSET (closure s)`,
  REWRITE_TAC[CLOSURE_HULL; HULL_SUBSET]);;

let CLOSURE_INC = prove
 (`!s x:real^N. x IN s ==> x IN closure s`,
  REWRITE_TAC[GSYM SUBSET; CLOSURE_SUBSET]);;

let SUBSET_CLOSURE = prove
 (`!s t. s SUBSET t ==> (closure s) SUBSET (closure t)`,
  REWRITE_TAC[CLOSURE_HULL; HULL_MONO]);;

let CLOSURE_UNION = prove
 (`!s t:real^N->bool. closure(s UNION t) = closure s UNION closure t`,
  REWRITE_TAC[LIMIT_POINT_UNION; closure] THEN SET_TAC[]);;

let CLOSURE_UNIONS_SUBSET = prove
 (`!(f:(real^N->bool)->bool).
        UNIONS {closure s | s IN f} SUBSET closure(UNIONS f)`,
  REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);;

let CLOSURE_INTER_SUBSET = prove
 (`!s t. closure(s INTER t) SUBSET closure(s) INTER closure(t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_INTER] THEN
  CONJ_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]);;

let CLOSURE_INTERS_SUBSET = prove
 (`!f. closure(INTERS f) SUBSET INTERS(IMAGE closure f)`,
  REWRITE_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN
  REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);;

let CLOSURE_MINIMAL = prove
 (`!s t. s SUBSET t /\ closed t ==> (closure s) SUBSET t`,
  REWRITE_TAC[HULL_MINIMAL; CLOSURE_HULL]);;

let CLOSURE_MINIMAL_EQ = prove
 (`!s t:real^N->bool. closed t ==> (closure s SUBSET t <=> s SUBSET t)`,
  MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET; CLOSURE_MINIMAL]);;

let CLOSURE_UNIQUE = prove
 (`!s t. s SUBSET t /\ closed t /\
         (!t'. s SUBSET t' /\ closed t' ==> t SUBSET t')
         ==> closure s = t`,
  REWRITE_TAC[CLOSURE_HULL; HULL_UNIQUE]);;

let CLOSURE_EMPTY = prove
 (`closure {} = {}`,
  SIMP_TAC[CLOSURE_CLOSED; CLOSED_EMPTY]);;

let CLOSURE_UNIV = prove
 (`closure(:real^N) = (:real^N)`,
  SIMP_TAC[CLOSURE_CLOSED; CLOSED_UNIV]);;

let LIMPT_OF_OPEN_CLOSURE = prove
 (`!s x:real^N. open s /\ x IN closure s ==> x limit_point_of s`,
  REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[LIMPT_OF_OPEN]);;

let CLOSURE_UNIONS = prove
 (`!f. FINITE f ==> closure(UNIONS f) = UNIONS {closure s | s IN f}`,
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_0; UNIONS_INSERT; SET_RULE `{f x | x IN {}} = {}`;
     SET_RULE `{f x | x IN a INSERT s} = (f a) INSERT {f x | x IN s}`] THEN
  SIMP_TAC[CLOSURE_EMPTY; CLOSURE_UNION]);;

let CLOSURE_EQ_EMPTY = prove
 (`!s. closure s = {} <=> s = {}`,
  GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CLOSURE_EMPTY] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN
  REWRITE_TAC[CLOSURE_SUBSET]);;

let CLOSURE_SUBSET_EQ = prove
 (`!s:real^N->bool. closure s SUBSET s <=> closed s`,
  GEN_TAC THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN
  MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);;

let OPEN_INTER_CLOSURE_EQ_EMPTY = prove
 (`!s t:real^N->bool.
        open s ==> (s INTER (closure t) = {} <=> s INTER t = {})`,
  REWRITE_TAC[OPEN_IN; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY]);;

let CLOSURE_MINIMAL_LOCAL = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean s) u /\ t SUBSET u
        ==> s INTER closure t SUBSET u`,
  REPEAT GEN_TAC THEN
  SIMP_TAC[IMP_CONJ; CLOSED_IN_CLOSED; LEFT_IMP_EXISTS_THM; SUBSET_INTER] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[INTER_SUBSET] THEN
  MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET u`) THEN
  MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[]);;

let CLOSURE_OPEN_IN_INTER_CLOSURE = prove
 (`!s t u:real^N->bool.
        open_in (subtopology euclidean u) s /\ t SUBSET u
        ==> closure(s INTER closure t) = closure(s INTER t)`,
  REWRITE_TAC[OPEN_IN; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[CLOSURE_OF_OPEN_IN_SUBTOPOLOGY_INTER_CLOSURE_OF]);;

let OPEN_IN_INTER_CLOSURE_EQ_EMPTY = prove
 (`!u s t:real^N->bool.
        open_in (subtopology euclidean u) s /\ t SUBSET u
        ==> (s INTER closure t = {} <=> s INTER t = {})`,
  MESON_TAC[CLOSURE_OPEN_IN_INTER_CLOSURE; CLOSURE_EQ_EMPTY]);;

let CLOSURE_OPEN_INTER_CLOSURE = prove
 (`!s t:real^N->bool.
        open s ==> closure(s INTER closure t) = closure(s INTER t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_IN_INTER_CLOSURE THEN
  EXISTS_TAC `(:real^N)` THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; GSYM OPEN_IN; SUBTOPOLOGY_UNIV]);;

let OPEN_INTER_CLOSURE_SUBSET = prove
 (`!s t:real^N->bool.
        open s ==> (s INTER (closure t)) SUBSET closure(s INTER t)`,
  MESON_TAC[CLOSURE_OPEN_INTER_CLOSURE; CLOSURE_SUBSET]);;

let OPEN_INTER_CLOSURE_EQ = prove
 (`!s t:real^N->bool.
        open s ==> s INTER closure t = s INTER closure(s INTER t)`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; OPEN_IN] THEN
  REWRITE_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ]);;

let CLOSURE_OPEN_INTER_SUPERSET = prove
 (`!s t:real^N->bool.
        open s /\ s SUBSET closure t ==> closure(s INTER t) = closure s`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; OPEN_IN] THEN
  REWRITE_TAC[CLOSURE_OF_OPEN_IN_INTER_SUPERSET]);;

let CLOSURE_COMPLEMENT = prove
 (`!s:real^N->bool. closure(UNIV DIFF s) = UNIV DIFF interior(s)`,
  REWRITE_TAC[SET_RULE `s = UNIV DIFF t <=> UNIV DIFF s = t`] THEN
  REWRITE_TAC[GSYM INTERIOR_CLOSURE]);;

let INTERIOR_COMPLEMENT = prove
 (`!s:real^N->bool. interior(UNIV DIFF s) = UNIV DIFF closure(s)`,
  REWRITE_TAC[SET_RULE `s = UNIV DIFF t <=> UNIV DIFF s = t`] THEN
  REWRITE_TAC[GSYM CLOSURE_INTERIOR]);;

let CLOSURE_LOCALLY_FINITE_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        locally_finite_in euclidean f
        ==> closure(UNIONS f) = UNIONS {closure s | s IN f}`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; CLOSURE_OF_LOCALLY_FINITE_UNIONS]);;

let CONNECTED_INTERMEDIATE_CLOSURE = prove
 (`!s t:real^N->bool.
        connected s /\ s SUBSET t /\ t SUBSET closure s ==> connected t`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; GSYM EUCLIDEAN_CLOSURE_OF;
              CONNECTED_IN_INTERMEDIATE_CLOSURE_OF]);;

let CONNECTED_CLOSURE = prove
 (`!s:real^N->bool. connected s ==> connected(closure s)`,
  MESON_TAC[CONNECTED_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);;

let CONNECTED_UNION_STRONG = prove
 (`!s t:real^N->bool.
        connected s /\ connected t /\ ~(closure s INTER t = {})
        ==> connected(s UNION t)`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_IN_NONSEPARATED_UNION THEN
  ASM_REWRITE_TAC[separated_in] THEN ASM SET_TAC[]);;

let CONNECTED_INSERT = prove
 (`!s a:real^N. connected s
                ==> (connected(a INSERT s) <=> s = {} \/ a IN closure s)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[CLOSURE_EMPTY; CONNECTED_SING] THEN
  DISCH_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[CONNECTED_CLOSED; NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o SPECL [`{a:real^N}`; `closure s:real^N->bool`]) THEN
    REWRITE_TAC[CLOSED_CLOSURE; CLOSED_SING] THEN
    MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
    DISCH_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = s UNION {a}`] THEN
    MATCH_MP_TAC CONNECTED_UNION_STRONG THEN
    ASM_REWRITE_TAC[CONNECTED_SING] THEN ASM SET_TAC[]]);;

let CONNECTED_INSERT_LIMPT = prove
 (`!s a:real^N. connected s /\ a limit_point_of s ==> connected(a INSERT s)`,
  SIMP_TAC[CONNECTED_INSERT; closure; IN_UNION; IN_ELIM_THM]);;

let INTERIOR_DIFF = prove
 (`!s t. interior(s DIFF t) = interior(s) DIFF closure(t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
  REWRITE_TAC[INTERIOR_INTER; CLOSURE_INTERIOR] THEN SET_TAC[]);;

let LIMPT_OF_CLOSURE = prove
 (`!x:real^N s. x limit_point_of closure s <=> x limit_point_of s`,
  REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; LIMIT_POINT_UNION] THEN
  REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN
  REWRITE_TAC[LIMPT_OF_LIMPTS]);;

let PERFECT_FROM_CLOSURE = prove
 (`!s:real^N->bool.
        (!x. x IN closure s ==> x limit_point_of closure s)
        ==> !x. x IN s ==> x limit_point_of s`,
  REWRITE_TAC[LIMPT_OF_CLOSURE] THEN
  MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);;

let DENSE_IMP_PERFECT = prove
 (`!s. closure s = (:real^N) ==> !x. x IN s ==> x limit_point_of s`,
  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC PERFECT_FROM_CLOSURE THEN
  ASM_REWRITE_TAC[LIMPT_OF_UNIV]);;

let CLOSED_IN_LIMPT = prove
 (`!s t. closed_in (subtopology euclidean t) s <=>
         s SUBSET t /\ !x:real^N. x limit_point_of s /\ x IN t ==> x IN s`,
  REWRITE_TAC[CLOSED_IN_DERIVED_SET; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[LIMIT_POINT_IN_DERIVED_SET]);;

let CLOSED_IN_INTER_CLOSURE = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean s) t <=> s INTER closure t = t`,
  REWRITE_TAC[CLOSED_IN_INTER_CLOSURE_OF; EUCLIDEAN_CLOSURE_OF]);;

let INTERIOR_CLOSURE_IDEMP = prove
 (`!s:real^N->bool.
        interior(closure(interior(closure s))) = interior(closure s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[INTERIOR_OF_CLOSURE_OF_IDEMP]);;

let CLOSURE_INTERIOR_IDEMP = prove
 (`!s:real^N->bool.
        closure(interior(closure(interior s))) = closure(interior s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[CLOSURE_OF_INTERIOR_OF_IDEMP]);;

let NOWHERE_DENSE_UNION = prove
 (`!s t:real^N->bool.
        interior(closure(s UNION t)) = {} <=>
        interior(closure s) = {} /\ interior(closure t) = {}`,
  SIMP_TAC[CLOSURE_UNION; INTERIOR_UNION_EQ_EMPTY; CLOSED_CLOSURE]);;

let NOWHERE_DENSE = prove
 (`!s:real^N->bool.
        interior(closure s) = {} <=>
        !t. open t /\ ~(t = {})
            ==> ?u. open u /\ ~(u = {}) /\ u SUBSET t /\ u INTER s = {}`,
  GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY_ALT] THEN EQ_TAC THEN
  DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THENL
   [EXISTS_TAC `t DIFF closure s:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_DIFF; CLOSED_CLOSURE] THEN
    MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`]
        OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
    ASM SET_TAC[]]);;

let INTERIOR_CLOSURE_INTER_OPEN = prove
 (`!s t:real^N->bool.
        open s /\ open t
        ==> interior(closure(s INTER t)) =
            interior(closure s) INTER interior(closure t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
   `u = s INTER t <=> s INTER t SUBSET u /\ u SUBSET s /\ u SUBSET t`] THEN
  SIMP_TAC[SUBSET_INTERIOR; SUBSET_CLOSURE; INTER_SUBSET] THEN
  MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_INTER; OPEN_INTERIOR] THEN
  REWRITE_TAC[SET_RULE `s SUBSET t <=> s INTER (UNIV DIFF t) = {}`;
              GSYM INTERIOR_COMPLEMENT] THEN
  REWRITE_TAC[GSYM INTERIOR_INTER] THEN
  REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN
  X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`u INTER s:real^N->bool`; `t:real^N->bool`]
        OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
  MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`]
        OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
  ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);;

let CLOSURE_INTERIOR_UNION_CLOSED = prove
 (`!s t:real^N->bool.
        closed s /\ closed t
        ==> closure(interior(s UNION t)) =
            closure(interior s) UNION closure(interior t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[closed] THEN
  DISCH_THEN(MP_TAC o MATCH_MP INTERIOR_CLOSURE_INTER_OPEN) THEN
  REWRITE_TAC[CLOSURE_COMPLEMENT; INTERIOR_COMPLEMENT;
              SET_RULE `(UNIV DIFF s) INTER (UNIV DIFF t) =
                        UNIV DIFF (s UNION t)`] THEN
  SET_TAC[]);;

let REGULAR_OPEN_INTER = prove
 (`!s t:real^N->bool.
        interior(closure s) = s /\ interior(closure t) = t
        ==> interior(closure(s INTER t)) = s INTER t`,
  MESON_TAC[INTERIOR_CLOSURE_INTER_OPEN; OPEN_INTERIOR]);;

let REGULAR_CLOSED_UNION = prove
 (`!s t:real^N->bool.
        closure(interior s) = s /\ closure(interior t) = t
        ==> closure(interior(s UNION t)) = s UNION t`,
  MESON_TAC[CLOSURE_INTERIOR_UNION_CLOSED; CLOSED_CLOSURE]);;

let REGULAR_CLOSED_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        FINITE f /\ (!t. t IN f ==> closure(interior t) = t)
        ==> closure(interior(UNIONS f)) = UNIONS f`,
  REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_INSERT; UNIONS_0; INTERIOR_EMPTY; CLOSURE_EMPTY] THEN
  SIMP_TAC[FORALL_IN_INSERT; REGULAR_CLOSED_UNION]);;

let DIFF_CLOSURE_SUBSET = prove
 (`!s t:real^N->bool. closure(s) DIFF closure t SUBSET closure(s DIFF t)`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `s:real^N->bool`]
        OPEN_INTER_CLOSURE_SUBSET) THEN
  REWRITE_TAC[SET_RULE `(UNIV DIFF t) INTER s = s DIFF t`] THEN
  REWRITE_TAC[GSYM closed; CLOSED_CLOSURE] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
  MATCH_MP_TAC SUBSET_CLOSURE THEN
  MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s DIFF u SUBSET s DIFF t`) THEN
  REWRITE_TAC[CLOSURE_SUBSET]);;

let DENSE_OPEN_INTER = prove
 (`!s t u:real^N->bool.
        (open_in (subtopology euclidean u) s /\ t SUBSET u \/
         open_in (subtopology euclidean u) t /\ s SUBSET u)
        ==> (u SUBSET closure (s INTER t) <=>
             u SUBSET closure s /\ u SUBSET closure t)`,
  MATCH_MP_TAC(MESON[]
   `(!s t u. R s t u ==> R t s u) /\
    (!s t u. P s t u ==> R s t u)
    ==> !s t u. P s t u \/ P t s u ==> R s t u`) THEN
  CONJ_TAC THENL [SIMP_TAC[INTER_COMM; CONJ_ACI]; ALL_TAC] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL
   [ASM_MESON_TAC[SUBSET_TRANS; SUBSET_CLOSURE; INTER_SUBSET]; ALL_TAC] THEN
  REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN DISCH_TAC THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^N`) ASSUME_TAC) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
  REWRITE_TAC[SUBSET; IN_INTER] THEN
  DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `y:real^N`)) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d (e / &2)`) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN
  CONV_TAC NORM_ARITH);;

let DENSE_OPEN_INTERS = prove
 (`!g s:real^N->bool.
         FINITE g /\
         (!t. t IN g
              ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t)
         ==> s SUBSET closure (INTERS g)`,
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN
  REWRITE_TAC[FORALL_IN_INSERT; INTERS_INSERT] THEN
  MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:(real^N->bool)->bool`] THEN
  STRIP_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
  ASM_SIMP_TAC[INTERS_0; INTER_UNIV] THEN STRIP_TAC THEN
  W(MP_TAC o PART_MATCH (lhand o rand) DENSE_OPEN_INTER o snd) THEN
  ANTS_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN
  DISJ1_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `u:real^N->bool`) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET o CONJUNCT1) THEN
  ASM SET_TAC[]);;

let SEPARATION_CLOSED_IN_UNION = prove
 (`!s t:real^N->bool.
        s INTER closure t = {} /\ t INTER closure s = {} <=>
        DISJOINT s t /\
        closed_in (subtopology euclidean (s UNION t)) s /\
        closed_in (subtopology euclidean (s UNION t)) t`,
  REPEAT GEN_TAC THEN MP_TAC(ISPECL
   [`euclidean:(real^N)topology`; `s:real^N->bool`; `t:real^N->bool`]
   SEPARATION_CLOSED_IN_UNION_GEN) THEN
  REWRITE_TAC[separated_in; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[EUCLIDEAN_CLOSURE_OF]);;

let SEPARATION_OPEN_IN_UNION = prove
 (`!s t:real^N->bool.
        s INTER closure t = {} /\ t INTER closure s = {} <=>
        DISJOINT s t /\
        open_in (subtopology euclidean (s UNION t)) s /\
        open_in (subtopology euclidean (s UNION t)) t`,
  REPEAT GEN_TAC THEN MP_TAC(ISPECL
   [`euclidean:(real^N)topology`; `s:real^N->bool`; `t:real^N->bool`]
   SEPARATION_OPEN_IN_UNION_GEN) THEN
  REWRITE_TAC[separated_in; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  REWRITE_TAC[EUCLIDEAN_CLOSURE_OF]);;

let CONNECTED_SEPARATION,CONNECTED_SEPARATION_ALT = (CONJ_PAIR o prove)
 (`(!s:real^N->bool.
        connected s <=>
        ~(?c1 c2. c1 UNION c2 = s /\ ~(c1 = {}) /\ ~(c2 = {}) /\
                  c1 INTER closure c2 = {} /\ c2 INTER closure c1 = {})) /\
   (!s:real^N->bool.
        connected s <=>
        ~(?c1 c2.
            s SUBSET c1 UNION c2 /\ ~(c1 INTER s = {}) /\ ~(c2 INTER s = {}) /\
            c1 INTER closure c2 = {} /\ c2 INTER closure c1 = {}))`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN] THEN CONJ_TAC THENL
   [REWRITE_TAC[CONNECTED_IN_SEPARATION];
    REWRITE_TAC[CONNECTED_IN_SEPARATION_ALT]] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV; EUCLIDEAN_CLOSURE_OF]);;

(* ------------------------------------------------------------------------- *)
(* Frontier (aka boundary).                                                  *)
(* ------------------------------------------------------------------------- *)

let frontier = new_definition
  `frontier s = (closure s) DIFF (interior s)`;;

let EUCLIDEAN_FRONTIER_OF = prove
 (`!s:real^N->bool. euclidean frontier_of s = frontier s`,
  REWRITE_TAC[frontier; frontier_of] THEN
  REWRITE_TAC[EUCLIDEAN_CLOSURE_OF; EUCLIDEAN_INTERIOR_OF]);;

let FRONTIER_CLOSED = prove
 (`!s. closed(frontier s)`,
  SIMP_TAC[frontier; CLOSED_DIFF; CLOSED_CLOSURE; OPEN_INTERIOR]);;

let FRONTIER_CLOSURES = prove
 (`!s:real^N->bool. frontier s = (closure s) INTER (closure(UNIV DIFF s))`,
  let lemma = prove(`s DIFF (UNIV DIFF t) = s INTER t`,SET_TAC[]) in
  REWRITE_TAC[frontier; INTERIOR_CLOSURE; lemma]);;

let FRONTIER_OPEN_STRADDLE_INTER = prove
 (`!s u:real^N->bool.
        open u /\ ~(u INTER frontier s = {})
        ==> ~(u INTER s = {}) /\ ~(u DIFF s = {})`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[FRONTIER_CLOSURES] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   `~(s INTER t INTER u = {})
    ==> ~(s INTER t = {}) /\ ~(s INTER u = {})`)) THEN
  MATCH_MP_TAC MONO_AND THEN ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN
  SET_TAC[]);;

let FRONTIER_UNION_INTERIOR = prove
 (`!s:real^N->bool. frontier s UNION interior s = closure s`,
  GEN_TAC THEN REWRITE_TAC[frontier] THEN
  MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
  MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
  SET_TAC[]);;

let FRONTIER_STRADDLE = prove
 (`!a:real^N s.
     a IN frontier s <=>
        !e. &0 < e ==> (?x. x IN s /\ dist(a,x) < e) /\
                       (?x. ~(x IN s) /\ dist(a,x) < e)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES; IN_INTER] THEN
  REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; limit_point_of;
              IN_UNIV; IN_DIFF] THEN
  ASM_MESON_TAC[IN_BALL; SUBSET; OPEN_CONTAINS_BALL;
                CENTRE_IN_BALL; OPEN_BALL; DIST_REFL]);;

let FRONTIER_SUBSET_CLOSED = prove
 (`!s. closed s ==> (frontier s) SUBSET s`,
  MESON_TAC[frontier; CLOSURE_CLOSED; SUBSET_DIFF]);;

let FRONTIER_EMPTY = prove
 (`frontier {} = {}`,
  REWRITE_TAC[frontier; CLOSURE_EMPTY; EMPTY_DIFF]);;

let FRONTIER_UNIV = prove
 (`frontier(:real^N) = {}`,
  REWRITE_TAC[frontier; CLOSURE_UNIV; INTERIOR_UNIV] THEN SET_TAC[]);;

let FRONTIER_SUBSET_EQ = prove
 (`!s:real^N->bool. (frontier s) SUBSET s <=> closed s`,
  GEN_TAC THEN EQ_TAC THEN SIMP_TAC[FRONTIER_SUBSET_CLOSED] THEN
  REWRITE_TAC[frontier] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   `s DIFF t SUBSET u ==> t SUBSET u ==> s SUBSET u`)) THEN
  REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET_EQ]);;

let FRONTIER_COMPLEMENT = prove
 (`!s:real^N->bool. frontier(UNIV DIFF s) = frontier s`,
  REWRITE_TAC[frontier; CLOSURE_COMPLEMENT; INTERIOR_COMPLEMENT] THEN
  SET_TAC[]);;

let FRONTIER_DISJOINT_EQ = prove
 (`!s. (frontier s) INTER s = {} <=> open s`,
  ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT; OPEN_CLOSED] THEN
  REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN SET_TAC[]);;

let FRONTIER_INTER = prove
 (`!s t:real^N->bool.
        frontier(s INTER t) =
        closure(s INTER t) INTER (frontier s UNION frontier t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN
  SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET; GSYM CLOSURE_UNION; SET_RULE
    `u SUBSET s /\ u SUBSET t
     ==> u INTER (s INTER x UNION t INTER y) = u INTER (x UNION y)`] THEN
  REPLICATE_TAC 2 AP_TERM_TAC THEN SET_TAC[]);;

let FRONTIER_INTER_SUBSET = prove
 (`!s t. frontier(s INTER t) SUBSET frontier(s) UNION frontier(t)`,
  REWRITE_TAC[FRONTIER_INTER] THEN SET_TAC[]);;

let FRONTIER_INTER_CLOSED = prove
 (`!s t:real^N->bool.
        closed s /\ closed t
        ==> frontier(s INTER t) = frontier s INTER t UNION s INTER frontier t`,
  SIMP_TAC[FRONTIER_INTER; CLOSED_INTER; CLOSURE_CLOSED] THEN
  REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN SET_TAC[]);;

let FRONTIER_UNION_SUBSET = prove
 (`!s t:real^N->bool. frontier(s UNION t) SUBSET frontier s UNION frontier t`,
  ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
  REWRITE_TAC[SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`] THEN
  REWRITE_TAC[FRONTIER_INTER_SUBSET]);;

let FRONTIER_INTERIORS = prove
 (`!s. frontier s = (:real^N) DIFF interior(s) DIFF interior((:real^N) DIFF s)`,
  REWRITE_TAC[frontier; CLOSURE_INTERIOR] THEN SET_TAC[]);;

let FRONTIER_FRONTIER_SUBSET = prove
 (`!s:real^N->bool. frontier(frontier s) SUBSET frontier s`,
  GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN
  SIMP_TAC[CLOSURE_CLOSED; FRONTIER_CLOSED] THEN SET_TAC[]);;

let INTERIOR_FRONTIER = prove
 (`!s:real^N->bool.
        interior(frontier s) = interior(closure s) DIFF closure(interior s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; INTERIOR_OF_FRONTIER_OF]);;

let THIN_FRONTIER_SUBSET = prove
 (`!s:real^N->bool.
        interior(frontier s) = {} <=>
        interior(closure s) SUBSET closure(interior s)`,
  REWRITE_TAC[INTERIOR_FRONTIER] THEN SET_TAC[]);;

let THIN_FRONTIER_CIC = prove
 (`!s:real^N->bool.
        interior(frontier s) = {} <=>
        closure(interior(closure s)) = closure(interior s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; THIN_FRONTIER_OF_CIC]);;

let THIN_FRONTIER_ICI = prove
 (`!s:real^N->bool.
        interior(frontier s) = {} <=>
        interior(closure(interior s)) = interior(closure s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_INTERIOR_OF; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; THIN_FRONTIER_OF_ICI]);;

let INTERIOR_FRONTIER_EMPTY = prove
 (`!s:real^N->bool. open s \/ closed s ==> interior(frontier s) = {}`,
  REWRITE_TAC[OPEN_IN; CLOSED_IN; GSYM EUCLIDEAN_INTERIOR_OF] THEN
  REWRITE_TAC[GSYM EUCLIDEAN_FRONTIER_OF; INTERIOR_OF_FRONTIER_OF_EMPTY]);;

let FRONTIER_FRONTIER = prove
 (`!s:real^N->bool. open s \/ closed s ==> frontier(frontier s) = frontier s`,
  REWRITE_TAC[OPEN_IN; CLOSED_IN; GSYM EUCLIDEAN_FRONTIER_OF] THEN
  REWRITE_TAC[FRONTIER_OF_FRONTIER_OF]);;

let FRONTIER_FRONTIER_FRONTIER = prove
 (`!s:real^N->bool. frontier(frontier(frontier s)) = frontier(frontier s)`,
  SIMP_TAC[FRONTIER_FRONTIER; FRONTIER_CLOSED]);;

let REGULAR_CLOSURE_INTERIOR = prove
 (`!s:real^N->bool.
        s SUBSET closure(interior s) <=>
        closure(interior s) = closure s`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; GSYM EUCLIDEAN_INTERIOR_OF] THEN
  SIMP_TAC[REGULAR_CLOSURE_OF_INTERIOR_OF; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let REGULAR_INTERIOR_CLOSURE = prove
 (`!s:real^N->bool.
        interior(closure s) SUBSET s <=>
        interior(closure s) = interior s`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; GSYM EUCLIDEAN_INTERIOR_OF] THEN
  REWRITE_TAC[REGULAR_INTERIOR_OF_CLOSURE_OF]);;

let REGULAR_CLOSED = prove
 (`!s:real^N->bool.
      closure(interior s) = s <=>
      closed s /\ s SUBSET closure(interior s)`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; GSYM EUCLIDEAN_INTERIOR_OF] THEN
  REWRITE_TAC[CLOSED_IN; REGULAR_CLOSED_IN]);;

let REGULAR_OPEN = prove
 (`!s:real^N->bool.
        interior(closure s) = s <=>
        open s /\ interior(closure s) SUBSET s`,
  REWRITE_TAC[GSYM EUCLIDEAN_CLOSURE_OF; GSYM EUCLIDEAN_INTERIOR_OF] THEN
  REWRITE_TAC[OPEN_IN; REGULAR_OPEN_IN]);;

let REGULAR_CLOSURE_IMP_THIN_FRONTIER = prove
 (`!s:real^N->bool.
        s SUBSET closure(interior s) ==> interior(frontier s) = {}`,
  SIMP_TAC[REGULAR_CLOSURE_INTERIOR; THIN_FRONTIER_ICI]);;

let REGULAR_INTERIOR_IMP_THIN_FRONTIER = prove
 (`!s:real^N->bool.
        interior(closure s) SUBSET s ==> interior(frontier s) = {}`,
  SIMP_TAC[REGULAR_INTERIOR_CLOSURE; THIN_FRONTIER_CIC]);;

let UNION_FRONTIER = prove
 (`!s t:real^N->bool.
        frontier(s) UNION frontier(t) =
        frontier(s UNION t) UNION
        frontier(s INTER t) UNION
        frontier(s) INTER frontier(t)`,
  let lemma = prove
   (`!s t x. x IN frontier s /\ x IN interior t ==> x IN frontier(s INTER t)`,
    REWRITE_TAC[FRONTIER_STRADDLE; IN_INTER; IN_INTERIOR; SUBSET; IN_BALL] THEN
    REPEAT GEN_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `d:real`)) THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `min d e:real`) THEN
    ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]) in
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNION_SUBSET;
              FRONTIER_UNION_SUBSET; FRONTIER_INTER_SUBSET;
              SET_RULE `s INTER t SUBSET s UNION t`] THEN
  REWRITE_TAC[GSYM UNION_SUBSET] THEN REWRITE_TAC[SUBSET; IN_UNION] THEN
  MATCH_MP_TAC(MESON[]
   `(!s t x. P s x ==> R x s t) /\ (!s t x. R x s t <=> R x t s)
    ==> (!s t x. P s x \/ P t x ==> R x s t)`) THEN
  CONJ_TAC THENL [REPEAT STRIP_TAC; REWRITE_TAC[UNION_COMM; INTER_COMM]] THEN
  ASM_CASES_TAC `(x:real^N) IN frontier t` THEN ASM_REWRITE_TAC[IN_INTER] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV)
        [FRONTIER_INTERIORS]) THEN
  REWRITE_TAC[DE_MORGAN_THM; IN_DIFF; IN_UNIV] THEN
  GEN_REWRITE_TAC RAND_CONV [DISJ_SYM] THEN MATCH_MP_TAC MONO_OR THEN
  ASM_SIMP_TAC[lemma] THEN
  POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
  SIMP_TAC[lemma; SET_RULE
    `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`]);;

let CONNECTED_INTER_FRONTIER = prove
 (`!s t:real^N->bool.
        connected s /\ ~(s INTER t = {}) /\ ~(s DIFF t = {})
        ==> ~(s INTER frontier t = {})`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; GSYM EUCLIDEAN_FRONTIER_OF;
              CONNECTED_IN_INTER_FRONTIER_OF]);;

let FRONTIER_NOT_EMPTY = prove
 (`!s. ~(s = {}) /\ ~(s = (:real^N)) ==> ~(frontier s = {})`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN
  REWRITE_TAC[CONNECTED_UNIV] THEN ASM SET_TAC[]);;

let FRONTIER_EQ_EMPTY = prove
 (`!s. frontier s = {} <=> s = {} \/ s = (:real^N)`,
  MESON_TAC[FRONTIER_NOT_EMPTY; FRONTIER_EMPTY; FRONTIER_UNIV]);;

let INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER = prove
 (`!s:real^N->bool.
        closed s /\ interior s = {} <=> ?t. open t /\ s = frontier t`,
  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [EXISTS_TAC `(:real^N) DIFF s` THEN
    ASM_SIMP_TAC[OPEN_DIFF; OPEN_UNIV; FRONTIER_COMPLEMENT] THEN
    ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY];
    ASM_SIMP_TAC[FRONTIER_CLOSED; INTERIOR_FRONTIER_EMPTY]]);;

let FRONTIER_UNION = prove
 (`!s t:real^N->bool.
        closure s INTER closure t = {}
        ==> frontier(s UNION t) = frontier(s) UNION frontier(t)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[FRONTIER_UNION_SUBSET] THEN
  GEN_REWRITE_TAC RAND_CONV [frontier] THEN
  REWRITE_TAC[CLOSURE_UNION] THEN MATCH_MP_TAC(SET_RULE
   `(fs SUBSET cs /\ ft SUBSET ct) /\ k INTER fs = {} /\ k INTER ft = {}
    ==> (fs UNION ft) SUBSET (cs UNION ct) DIFF k`) THEN
  CONJ_TAC THENL [REWRITE_TAC[frontier] THEN SET_TAC[]; ALL_TAC] THEN
  CONJ_TAC THENL
   [ALL_TAC;
    ONCE_REWRITE_TAC[UNION_COMM] THEN
    RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTER_COMM])] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `s INTER t = {} ==> s' SUBSET s /\ s' INTER u INTER (UNIV DIFF t) = {}
      ==> u INTER s' = {}`)) THEN
  REWRITE_TAC[frontier; SUBSET_DIFF; GSYM INTERIOR_COMPLEMENT] THEN
  REWRITE_TAC[GSYM INTERIOR_INTER; SET_RULE
   `(s UNION t) INTER (UNIV DIFF t) = s DIFF t`] THEN
  MATCH_MP_TAC(SET_RULE
    `ti SUBSET si ==> (c DIFF si) INTER ti = {}`) THEN
  SIMP_TAC[SUBSET_INTERIOR; SUBSET_DIFF]);;

let CLOSURE_UNION_FRONTIER = prove
 (`!s:real^N->bool. closure s = s UNION frontier s`,
  GEN_TAC THEN REWRITE_TAC[frontier] THEN
  MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
  MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
  SET_TAC[]);;

let FRONTIER_INTERIOR_SUBSET = prove
 (`!s:real^N->bool. frontier(interior s) SUBSET frontier s`,
  GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTERIOR] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN
  SIMP_TAC[SUBSET_CLOSURE; INTERIOR_SUBSET]);;

let FRONTIER_CLOSURE_SUBSET = prove
 (`!s:real^N->bool. frontier(closure s) SUBSET frontier s`,
  GEN_TAC THEN REWRITE_TAC[frontier; CLOSURE_CLOSURE] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u DIFF t SUBSET u DIFF s`) THEN
  SIMP_TAC[SUBSET_INTERIOR; CLOSURE_SUBSET]);;

let SET_DIFF_FRONTIER = prove
 (`!s:real^N->bool. s DIFF frontier s = interior s`,
  GEN_TAC THEN REWRITE_TAC[frontier] THEN
  MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
  MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
  SET_TAC[]);;

let FRONTIER_INTER_SUBSET_INTER = prove
 (`!s t:real^N->bool.
        frontier(s INTER t) SUBSET closure s INTER frontier t UNION
                                   frontier s INTER closure t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTER] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
        CLOSURE_INTER_SUBSET) THEN
  SET_TAC[]);;

let COMMON_FRONTIER_DOMAINS = prove
 (`!s t:real^N->bool.
      open s /\ open t /\ connected s /\ connected t /\ frontier s = frontier t
      ==> s = t \/ DISJOINT s t`,
  REWRITE_TAC[SET_RULE
    `s = t \/ DISJOINT s t <=>
     (s SUBSET t \/ DISJOINT s t) /\ (t SUBSET s \/ DISJOINT t s)`] THEN
  MATCH_MP_TAC(MESON[]
   `(!x y. P x y ==> P y x) /\ (!x y. P x y ==> Q x y)
    ==> !x y. P x y ==> Q x y /\ Q y x`) THEN
  CONJ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
        CONNECTED_INTER_FRONTIER) THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
  ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN SET_TAC[]);;

let FRONTIER_OPEN_UNION = prove
 (`!s t:real^N->bool.
        open s /\ open t /\ DISJOINT s t
        ==> frontier(s UNION t) = frontier s UNION frontier t`,
  REWRITE_TAC[DISJOINT; FRONTIER_CLOSURES] THEN REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED; OPEN_UNION] THEN
  REWRITE_TAC[CLOSURE_UNION] THEN
  SUBGOAL_THEN
   `(s:real^N->bool) INTER closure t = {} /\ t INTER closure s = {}`
  MP_TAC THENL
   [ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[];
    ASM SET_TAC[]]);;

let FRONTIER_OPEN_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        FINITE f /\ (!s. s IN f ==> open s) /\ pairwise DISJOINT f
        ==> frontier(UNIONS f) = UNIONS {frontier s | s IN f}`,
  REWRITE_TAC[IMP_CONJ; SIMPLE_IMAGE] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_0; UNIONS_INSERT] THEN
  REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; FRONTIER_EMPTY; UNIONS_INSERT] THEN
  REWRITE_TAC[PAIRWISE_INSERT] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC) THEN
  MATCH_MP_TAC FRONTIER_OPEN_UNION THEN ASM_SIMP_TAC[OPEN_UNIONS] THEN
  REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
  ASM_MESON_TAC[DISJOINT]);;

let CONNECTED_CLOSURE_FROM_FRONTIER = prove
 (`!s:real^N->bool. connected(frontier s) ==> connected(closure s)`,
  REPEAT STRIP_TAC THEN  MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN
  EXISTS_TAC `connected(closure((:real^N) DIFF s))` THEN
  MATCH_MP_TAC CONNECTED_FROM_CLOSED_UNION_AND_INTER THEN
  ASM_REWRITE_TAC[CLOSED_CLOSURE; GSYM FRONTIER_CLOSURES] THEN
  SUBGOAL_THEN
   `closure s UNION closure ((:real^N) DIFF s) = (:real^N)`
   (fun th -> REWRITE_TAC[th; CONNECTED_UNIV]) THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s)
    ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN
  REWRITE_TAC[CLOSURE_SUBSET]);;

(* ------------------------------------------------------------------------- *)
(* Useful nets in Euclidean space.                                           *)
(* ------------------------------------------------------------------------- *)

parse_as_infix("in_direction",(14,"right"));;

let at = new_definition
  `at a = atpointof euclidean a`;;

let at_infinity = new_definition
  `at_infinity = mk_net({{x | b <= norm x} | b IN (:real)},{})`;;

let at_posinfinity = new_definition
  `at_posinfinity = mk_net({{x | a <= x} | a IN (:real)},{})`;;

let at_neginfinity = new_definition
  `at_neginfinity = mk_net({{x | x <= a} | a IN (:real)},{})`;;

let in_direction = new_definition
  `a in_direction v = (at a) within {b | ?c. &0 <= c /\ (b - a = c % v)}`;;

let AT = prove
 (`!a:real^N.
     netfilter (at a) = { u | open u /\ a IN u}`,
  REWRITE_TAC[at; ATPOINTOF; OPEN_IN]);;

let NETLIMIT_AT = prove
 (`!a. netlimit(at a) = a`,
  REWRITE_TAC[at; NETLIMIT_ATPOINTOF]);;

let NETLIMIT_WITHIN = prove
 (`!a:real^N s. netlimit (at a within s) = a`,
  REWRITE_TAC[netlimit; NETLIMITS_WITHIN] THEN
   REWRITE_TAC[GSYM netlimit] THEN REWRITE_TAC[NETLIMIT_AT]);;

let AT_INFINITY,NETLIMITS_AT_INFINITY = (CONJ_PAIR o prove)
 (`netfilter at_infinity = {{x:real^N | b <= norm x} | b IN (:real)} /\
   netlimits at_infinity = ({}:real^N->bool)`,
  REWRITE_TAC[netfilter; netlimits; at_infinity; GSYM PAIR_EQ] THEN
  REWRITE_TAC[GSYM(CONJUNCT2 net_tybij)] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`b1:real`; `b2:real`] THEN REWRITE_TAC[IN_ELIM_THM] THEN
  EXISTS_TAC `max b1 b2:real` THEN
  REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let AT_POSINFINITY,NETLIMITS_AT_POSINFINITY = (CONJ_PAIR o prove)
 (`netfilter at_posinfinity = {{x | a <= x} | a IN (:real)} /\
   netlimits at_posinfinity = {}`,
  REWRITE_TAC[netfilter; netlimits; at_posinfinity; GSYM PAIR_EQ] THEN
  REWRITE_TAC[GSYM(CONJUNCT2 net_tybij)] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`b1:real`; `b2:real`] THEN REWRITE_TAC[IN_ELIM_THM] THEN
  EXISTS_TAC `max b1 b2:real` THEN
  REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let AT_NEGINFINITY,NETLIMITS_AT_NEGINFINITY = (CONJ_PAIR o prove)
 (`netfilter at_neginfinity = {{x | x <= a} | a IN (:real)} /\
   netlimits at_neginfinity = {}`,
  REWRITE_TAC[netfilter; netlimits; at_neginfinity; GSYM PAIR_EQ] THEN
  REWRITE_TAC[GSYM(CONJUNCT2 net_tybij)] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`b1:real`; `b2:real`] THEN REWRITE_TAC[IN_ELIM_THM] THEN
  EXISTS_TAC `min b1 b2:real` THEN
  REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let WITHIN_UNIV = prove
 (`!x:real^N. at x within UNIV = at x`,
  REWRITE_TAC[NET_WITHIN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* The "eventually" property in Euclidean space.                             *)
(* ------------------------------------------------------------------------- *)

let EVENTUALLY_WITHIN = prove
 (`!s a:real^M p.
     eventually p (at a within s) <=>
        ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`,
  REWRITE_TAC[at; EVENTUALLY_WITHIN_IMP; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[EVENTUALLY_ATPOINTOF_METRIC] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; IN_UNIV] THEN MESON_TAC[]);;

let EVENTUALLY_WITHIN_LE = prove
 (`!s a:real^M p.
     eventually p (at a within s) <=>
        ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)`,
  REWRITE_TAC[EVENTUALLY_WITHIN] THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
  REWRITE_TAC[APPROACHABLE_LT_LE]);;

let EVENTUALLY_WITHIN_TOPOLOGICAL = prove
 (`!P s a:real^N.
        eventually P (at a within s) <=>
        ?t. open t /\ a IN t /\
            !x. x IN s INTER (t DELETE a) ==> P x`,
  REWRITE_TAC[at; EVENTUALLY_WITHIN_IMP; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  SIMP_TAC[EVENTUALLY_ATPOINTOF; HAUSDORFF_SPACE_MTOPOLOGY] THEN
  REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; TOPSPACE_EUCLIDEAN] THEN
  REWRITE_TAC[IN_UNIV; OPEN_IN] THEN SET_TAC[]);;

let TRIVIAL_LIMIT_WITHIN = prove
 (`!a:real^N. trivial_limit (at a within s) <=> ~(a limit_point_of s)`,
  REWRITE_TAC[at; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  SIMP_TAC[TRIVIAL_LIMIT_ATPOINTOF_WITHIN; HAUSDORFF_SPACE_MTOPOLOGY] THEN
  REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; LIMIT_POINT_IN_DERIVED_SET]);;

let LIM_WITHIN_CLOSED_TRIVIAL = prove
 (`!a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)`,
  REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]);;

let EVENTUALLY_AT = prove
 (`!a p. eventually p (at a) <=>
         ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[EVENTUALLY_WITHIN; IN_UNIV]);;

let EVENTUALLY_AT_TOPOLOGICAL = prove
 (`!P a:real^N.
        eventually P (at a) <=>
        ?t. open t /\ a IN t /\ !x. x IN t DELETE a ==> P x`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[EVENTUALLY_WITHIN_TOPOLOGICAL; IN_INTER; IN_UNIV]);;

let TRIVIAL_LIMIT_AT = prove
 (`!a. ~(trivial_limit (at a))`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_OF_UNIV]);;

let EVENTUALLY_HAPPENS_AT = prove
 (`!P a:real^N. eventually P (at a) ==> ?b. ~(b = a) /\ P b`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `eventually (\b:real^N. ~(b = a) /\ P b) (at a)` MP_TAC THENL
   [POP_ASSUM MP_TAC THEN REWRITE_TAC[EVENTUALLY_AT] THEN
    MESON_TAC[DIST_NZ; DIST_SYM];
    DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
    SIMP_TAC[TRIVIAL_LIMIT_AT]]);;

let EVENTUALLY_AT_INFINITY = prove
 (`!p. eventually p at_infinity <=> ?b. !x. norm(x) >= b ==> p x`,
  REWRITE_TAC[eventually; AT_INFINITY; NETLIMITS_AT_INFINITY] THEN
  REWRITE_TAC[EXISTS_IN_GSPEC; real_ge] THEN
  REWRITE_TAC[SET_RULE `~({f x | x IN UNIV} = {})`] THEN
  REWRITE_TAC[IN_ELIM_THM; IN_DIFF; INTERS_GSPEC; IN_UNIV; NOT_IN_EMPTY] THEN
  MESON_TAC[VECTOR_CHOOSE_SIZE; NORM_ARITH
   `&0 < norm(x:real^N) + &1 /\ ~(norm x + &1 <= norm x)`]);;

let EVENTUALLY_AT_INFINITY_WITHIN = prove
 (`!p s:real^N->bool.
        eventually p (at_infinity within s) <=>
        ?b. !x. x IN s /\ norm(x) >= b ==> p x`,
  REWRITE_TAC[EVENTUALLY_WITHIN_IMP; EVENTUALLY_AT_INFINITY] THEN
  MESON_TAC[]);;

let EVENTUALLY_AT_INFINITY_POS = prove
 (`!p:real^N->bool.
        eventually p at_infinity <=> ?b. &0 < b /\ !x. norm x >= b ==> p x`,
  GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN
  MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (abs b + &1 <= x ==> b <= x)`]);;

let TRIVIAL_LIMIT_AT_INFINITY = prove
 (`~(trivial_limit at_infinity)`,
  REWRITE_TAC[trivial_limit; EVENTUALLY_AT_INFINITY; real_ge] THEN
  MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_ARITH
    `&0 <= abs b + &1 /\ b <= abs b + &1 /\ ~(abs b + &2 <= abs b + &1)`]);;

let EVENTUALLY_AT_POSINFINITY = prove
 (`!p. eventually p at_posinfinity <=> ?b. !x. x >= b ==> p x`,
  REWRITE_TAC[eventually; AT_POSINFINITY; NETLIMITS_AT_POSINFINITY] THEN
  REWRITE_TAC[EXISTS_IN_GSPEC; real_ge] THEN
  REWRITE_TAC[SET_RULE `~({f x | x IN UNIV} = {})`] THEN
  REWRITE_TAC[real_ge; IN_ELIM_THM; INTERS_GSPEC; DIFF_EMPTY; IN_UNIV] THEN
  MESON_TAC[REAL_ARITH `~(x + &1 <= x)`]);;

let TRIVIAL_LIMIT_AT_POSINFINITY = prove
 (`~(trivial_limit at_posinfinity)`,
  REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; trivial_limit; real_ge] THEN
  MESON_TAC[REAL_ARITH `~(x + &1 <= x)`; REAL_LE_REFL]);;

let EVENTUALLY_AT_NEGINFINITY = prove
 (`!p. eventually p at_neginfinity <=> ?b. !x. x <= b ==> p x`,
  REWRITE_TAC[eventually; AT_NEGINFINITY; NETLIMITS_AT_NEGINFINITY] THEN
  REWRITE_TAC[EXISTS_IN_GSPEC; real_ge] THEN
  REWRITE_TAC[SET_RULE `~({f x | x IN UNIV} = {})`] THEN
  REWRITE_TAC[real_ge; IN_ELIM_THM; INTERS_GSPEC; DIFF_EMPTY; IN_UNIV] THEN
  MESON_TAC[REAL_ARITH `~(x <= x - &1)`]);;

let TRIVIAL_LIMIT_AT_NEGINFINITY = prove
 (`~(trivial_limit at_neginfinity)`,
  REWRITE_TAC[EVENTUALLY_AT_NEGINFINITY; trivial_limit; real_ge] THEN
  MESON_TAC[REAL_ARITH `~(x <= x - &1)`; REAL_LE_REFL]);;

let EVENTUALLY_AT_ZERO = prove
 (`!P:real^N->bool a.
        eventually P (at a) <=> eventually (\x. P(a + x)) (at (vec 0))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT] THEN
  AP_TERM_TAC THEN ABS_TAC THEN
  ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN
  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^N`) THEN
    REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_SUB_RZERO];
    FIRST_X_ASSUM(MP_TAC o SPEC `x - a:real^N`) THEN
    REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_ADD2]]);;

let EVENTUALLY_AT_WITHIN = prove
 (`!P s a:real^N.
        eventually P (at a) ==> eventually P (at a within s)`,
  REWRITE_TAC[EVENTUALLY_AT; EVENTUALLY_WITHIN] THEN MESON_TAC[]);;

let EVENTUALLY_WITHIN_ZERO = prove
 (`!P:real^N->bool s a.
        eventually P (at a within s) <=>
        eventually (\x. P(a + x)) (at (vec 0) within IMAGE (\x. x - a) s)`,
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN
  REWRITE_TAC[] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EVENTUALLY_AT_ZERO] THEN
  REWRITE_TAC[IN_TRANSLATION_GALOIS_ALT] THEN
  REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`]);;

let IN_INTERIOR_EVENTUALLY = prove
 (`!s a:real^N. a IN interior s <=> a IN s /\ eventually (\x. x IN s) (at a)`,
  REWRITE_TAC[IN_INTERIOR; EVENTUALLY_AT; SUBSET; IN_BALL; GSYM DIST_NZ] THEN
  MESON_TAC[DIST_SYM; DIST_REFL]);;

let EVENTUALLY_WITHIN_INTERIOR = prove
 (`!p s x:real^N.
        x IN interior s
        ==> (eventually p (at x within s) <=> eventually p (at x))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[IN_INTERIOR_EVENTUALLY] THEN
  MATCH_MP_TAC(TAUT
   `(p /\ q ==> r) /\ (p /\ r ==> q) ==> p' /\ p ==> (q <=> r)`) THEN
  REWRITE_TAC[GSYM EVENTUALLY_AND; EVENTUALLY_WITHIN_IMP] THEN
  CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  SIMP_TAC[]);;

let EVENTUALLY_IN_OPEN = prove
 (`!s a:real^N. open s /\ a IN s ==> eventually (\x. x IN s) (at a)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] IN_INTERIOR_EVENTUALLY) THEN
  ASM_SIMP_TAC[INTERIOR_OPEN]);;

let EVENTUALLY_WITHIN_OPEN = prove
 (`!f a:real^M s.
        a IN s /\ open s
        ==> (eventually P (at a within s) <=> eventually P (at a))`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC EVENTUALLY_WITHIN_INTERIOR THEN
  ASM_MESON_TAC[INTERIOR_OPEN]);;

let EVENTUALLY_WITHIN_OPEN_IN = prove
 (`!P a s t:real^N->bool.
         a IN t /\ open_in (subtopology euclidean s) t
         ==> (eventually P (at a within t) <=> eventually P (at a within s))`,
  REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN ONCE_REWRITE_TAC[SET_RULE
   `x IN s INTER t ==> P <=> x IN t ==> x IN s ==> P`] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_WITHIN_IMP] THEN
  MATCH_MP_TAC EVENTUALLY_WITHIN_OPEN THEN ASM SET_TAC[]);;

let EVENTUALLY_WITHIN_INTERIOR_LOCAL = prove
 (`!P a s t u:real^N->bool.
        a IN u /\ u SUBSET t /\ t SUBSET s /\
        open_in (subtopology euclidean s) u
        ==> (eventually P (at a within t) <=> eventually P (at a within s))`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC EQ_TRANS `eventually P (at (a:real^N) within u)` THEN
  MATCH_MP_TAC(TAUT
   `(s ==> t) /\ (t ==> u) /\ (u <=> s) ==> (t <=> u) /\ (u <=> s)`) THEN
  REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [ALL_TAC; ASM_SIMP_TAC[EVENTUALLY_WITHIN_OPEN_IN]] THEN
  REWRITE_TAC[EVENTUALLY_WITHIN_IMP] THEN CONJ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);;

let EVENTUALLY_SCALABLE_PROPERTY = prove
 (`!P. (!c x:real^N. &0 <= c /\ P x ==> P(c % x)) /\
       eventually P (at (vec 0))
       ==> !x. P x`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVENTUALLY_AT]) THEN
  REWRITE_TAC[EVENTUALLY_AT; DIST_0; NORM_POS_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `x:real^N = vec 0` THENL
   [SUBGOAL_THEN `?y:real^N. norm(y) = d / &2` STRIP_ASSUME_TAC THENL
     [MATCH_MP_TAC VECTOR_CHOOSE_SIZE THEN ASM_REAL_ARITH_TAC;
      FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN
    ASM_REWRITE_TAC[GSYM NORM_EQ_0] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`&0`; `y:real^N`]) THEN
    ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL];
    FIRST_X_ASSUM(MP_TAC o SPEC `d / &2 / norm(x) % x:real^N`) THEN
    ASM_SIMP_TAC[VECTOR_MUL_EQ_0; NORM_MUL; REAL_DIV_EQ_0] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_SIMP_TAC[NORM_EQ_0; REAL_LT_IMP_NZ; REAL_ABS_DIV; REAL_ABS_NUM] THEN
    ASM_SIMP_TAC[REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`norm(x:real^N) / (d / &2)`; `d / &2 / norm(x) % x:real^N`]) THEN
    ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_HALF; REAL_LT_IMP_LE] THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_FIELD
     `~(n = &0) /\ &0 < d ==> n / (d / &2) * d / &2 / n = &1`] THEN
    REWRITE_TAC[VECTOR_MUL_LID]]);;

let EVENTUALLY_SCALABLE_PROPERTY_EQ = prove
 (`!P. (!c x:real^N. &0 <= c /\ P x ==> P(c % x))
       ==> (eventually P (at (vec 0)) <=> !x. P x)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[ALWAYS_EVENTUALLY] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_SCALABLE_PROPERTY) THEN
  ASM_SIMP_TAC[]);;

let ONORM_LE_EVENTUALLY = prove
 (`!f:real^M->real^N b.
        linear f
        ==> (onorm f <= b <=>
             eventually (\y. norm(f y) <= b * norm y) (at (vec 0)))`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ONORM_LE_EQ] THEN
  CONV_TAC SYM_CONV THEN MATCH_MP_TAC EVENTUALLY_SCALABLE_PROPERTY_EQ THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN
  REWRITE_TAC[NORM_MUL] THEN
  MESON_TAC[REAL_LE_LMUL; REAL_ABS_POS; REAL_MUL_AC]);;

let EVENTUALLY_WITHIN_REFLECT = prove
 (`!P s a:real^N.
        eventually (\x. P(--x)) (at(--a) within IMAGE (--) s) <=>
        eventually P (at a within s)`,
  REWRITE_TAC[EVENTUALLY_WITHIN; IMP_CONJ; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[VECTOR_NEG_NEG; NORM_ARITH `dist(--a:real^N,--b) = dist(a,b)`]);;

let EVENTUALLY_AT_REFLECT = prove
 (`!P a:real^N.
        eventually (\x. P(--x)) (at(--a)) <=> eventually P (at a)`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM EVENTUALLY_WITHIN_REFLECT] THEN
  REWRITE_TAC[REFLECT_UNIV]);;

let EVENTUALLY_WITHIN_DELETE = prove
 (`!P:real^N->bool s a.
        eventually P (at a within (s DELETE a)) <=>
        eventually P (at a within s)`,
  REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; IN_DELETE] THEN MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Limits, defined as vacuously true when the limit is trivial.              *)
(* ------------------------------------------------------------------------- *)

parse_as_infix("-->",(12,"right"));;

let tendsto = new_definition
  `(f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net`;;

let LIMIT_EUCLIDEAN = prove
 (`!f:A->real^N x net. limit euclidean f x net <=> (f --> x) net`,
  REWRITE_TAC[LIMIT_METRIC; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; IN_UNIV; tendsto]);;

let lim = new_definition
 `lim net f = @l. (f --> l) net`;;

let TENDSTO_ALT = prove
 (`!f:A->real^N l net.
     (f --> l) net <=>
     (!s. open s /\ l IN s ==> eventually (\x. f x IN s) net)`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; limit; TOPSPACE_EUCLIDEAN; IN_UNIV] THEN
  REWRITE_TAC[OPEN_IN_EUCLIDEAN]);;

let TENDSTO_ALT_WITHIN = prove
 (`!net f:A->real^N l u.
        l IN u /\ eventually (\x. f x IN u) net
        ==> ((f --> l) net <=>
             !s. open_in (subtopology euclidean u) s /\ l IN s
                 ==> eventually (\x. f x IN s) net)`,
  REPEAT GEN_TAC THEN
  SIMP_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  SIMP_TAC[IMP_CONJ; IN_INTER; EVENTUALLY_AND] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
  REWRITE_TAC[IMP_IMP; GSYM TENDSTO_ALT]);;

let LIM_EVENTUALLY_IN_OPEN_IN = prove
 (`!net f:A->real^N l u s.
        l IN s /\ open_in (subtopology euclidean u) s /\
        eventually (\x. f x IN u) net /\ (f --> l) net
        ==> eventually (\x. f x IN s) net`,
  MP_TAC TENDSTO_ALT_WITHIN THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  STRIP_TAC THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
  ASM_REWRITE_TAC[] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);;

let LIM_EVENTUALLY_IN_OPEN = prove
 (`!net f:A->real^N l s.
        open s /\ (f --> l) net /\ l IN s ==> eventually (\x. f x IN s) net`,
  REWRITE_TAC[TENDSTO_ALT] THEN MESON_TAC[]);;

let LIM_TRIVIAL = prove
 (`!net (f:A->real^N) l. trivial_limit net ==> (f --> l) net`,
  SIMP_TAC[GSYM LIMIT_EUCLIDEAN; LIMIT_TRIVIAL; TOPSPACE_EUCLIDEAN; IN_UNIV]);;

let LIM_WITHIN_REFLECT = prove
 (`!f:real^M->real^N l a s.
        ((\x. f(--x)) --> l) (at(--a) within IMAGE (--) s) <=>
        (f --> l) (at a within s)`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_REFLECT]);;

let LIM_AT_REFLECT = prove
 (`!f:real^M->real^N l a.
        ((\x. f(--x)) --> l) (at(--a)) <=> (f --> l) (at a)`,
  REWRITE_TAC[tendsto; EVENTUALLY_AT_REFLECT]);;

let LIM_WITHIN_ZERO = prove
 (`!f:real^M->real^N l s a.
        (f --> l) (at a within s) <=>
        ((\x. f(a + x)) --> l) (at(vec 0) within IMAGE (\x. x - a) s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EVENTUALLY_WITHIN_ZERO] THEN
  REWRITE_TAC[]);;

let LIM_WITHIN_DELETE = prove
 (`!f:real^M->real^N l s a.
        (f --> l) (at a within (s DELETE a)) <=>
        (f --> l) (at a within s)`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_DELETE]);;

let LIM_COMPONENTWISE_REAL = prove
 (`!net f:A->real^N l.
        (f --> l) net <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> limit euclideanreal (\x. f x$i) (l$i) net`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; LIMIT_COMPONENTWISE_REAL]);;

let LIM_COMPONENTWISE_LIFT = prove
 (`!net f:A->real^N.
        (f --> l) net <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> ((\x. lift((f x)$i)) --> lift(l$i)) net`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; LIMIT_EQ_DROP; o_DEF; LIFT_DROP] THEN
  REWRITE_TAC[LIMIT_EUCLIDEAN; GSYM LIM_COMPONENTWISE_REAL]);;

let LIM_EQ_DROP = prove
 (`!(net:A net) f l:real^1.
        (f --> l) net <=> limit euclideanreal (drop o f) (drop l) net`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; LIMIT_EQ_LIFT; o_DEF; LIFT_DROP; ETA_AX]);;

let LIM_EQ_LIFT = prove
 (`!(net:A net) f l.
        limit euclideanreal f l net <=> ((lift o f) --> lift l) net`,
  REWRITE_TAC[LIM_EQ_DROP; o_DEF; LIFT_DROP; ETA_AX]);;

(* ------------------------------------------------------------------------- *)
(* Show that they yield usual definitions in the various cases.              *)
(* ------------------------------------------------------------------------- *)

let LIM_WITHIN_LE = prove
 (`!f:real^M->real^N l a s.
        (f --> l)(at a within s) <=>
           !e. &0 < e ==> ?d. &0 < d /\
                              !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d
                                   ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LE]);;

let LIM_WITHIN = prove
 (`!f:real^M->real^N l a s.
      (f --> l) (at a within s) <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d
                    ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN] THEN MESON_TAC[]);;

let LIM_AT_LE = prove
 (`!f l a. (f --> l) (at a) <=>
           !e. &0 < e
               ==> ?d. &0 < d /\
                       !x. &0 < dist(x,a) /\ dist(x,a) <= d
                           ==> dist (f x,l) < e`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[LIM_WITHIN_LE; IN_UNIV]);;

let LIM_AT = prove
 (`!f l:real^N a:real^M.
      (f --> l) (at a) <=>
              !e. &0 < e
                  ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d
                          ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_AT] THEN MESON_TAC[]);;

let LIM_AT_INFINITY = prove
 (`!f l. (f --> l) at_infinity <=>
               !e. &0 < e ==> ?b. !x. norm(x) >= b ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);;

let LIM_AT_INFINITY_POS = prove
 (`!f l. (f --> l) at_infinity <=>
         !e. &0 < e ==> ?b. &0 < b /\ !x. norm x >= b ==> dist(f x,l) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY] THEN
  MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);;

let LIM_AT_POSINFINITY = prove
 (`!f l. (f --> l) at_posinfinity <=>
               !e. &0 < e ==> ?b. !x. x >= b ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);;

let LIM_AT_NEGINFINITY = prove
 (`!f l. (f --> l) at_neginfinity <=>
               !e. &0 < e ==> ?b. !x. x <= b ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);;

let LIM_AT_INFINITY_WITHIN = prove
 (`!f:real^M->real^N l s.
        (f --> l) (at_infinity within s) <=>
        !e. &0 < e ==> ?b. !x. x IN s /\ norm(x) >= b ==> dist(f(x),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY_WITHIN] THEN MESON_TAC[]);;

let LIM_AT_INFINITY_WITHIN_POS = prove
 (`!f:real^M->real^N l s.
        (f --> l) (at_infinity within s) <=>
        !e. &0 < e
            ==> ?b. &0 < b /\ !x. x IN s /\ norm(x) >= b ==> dist(f(x),l) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY_WITHIN] THEN
  MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);;

let LIM_SEQUENTIALLY = prove
 (`!s l. (s --> l) sequentially <=>
          !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e`,
  REWRITE_TAC[tendsto; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);;

let LIM_EVENTUALLY = prove
 (`!net f l. eventually (\x. f x = l) net ==> (f --> l) net`,
  SIMP_TAC[tendsto] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        EVENTUALLY_MONO)) THEN
  ASM_SIMP_TAC[DIST_REFL]);;

let LIM_POSINFINITY_SEQUENTIALLY = prove
 (`!f l. (f --> l) at_posinfinity ==> ((\n. f(&n)) --> l) sequentially`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[LIM_AT_POSINFINITY; LIM_SEQUENTIALLY] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN
  MP_TAC(ISPEC `B:real` REAL_ARCH_SIMPLE) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);;

let LIM_INFINITY_POSINFINITY_LIFT = prove
 (`!f l:real^N. (f --> l) at_infinity ==> ((f o lift) --> l) at_posinfinity`,
  REWRITE_TAC[LIM_AT_INFINITY; LIM_AT_POSINFINITY; o_THM] THEN
  REWRITE_TAC[FORALL_DROP; NORM_REAL; GSYM drop; LIFT_DROP] THEN
  MESON_TAC[REAL_ARITH `x >= b ==> abs(x) >= b`]);;

let LIM_SELF_WITHIN = prove
 (`!f:real^M->real^N s a.
        (f --> f a) (at a within s) <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                     !x. x IN s /\ dist(x,a) < d ==> dist(f x,f a) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN
  AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[DIST_REFL]);;

let LIM_SELF_AT = prove
 (`!f:real^M->real^N a.
        (f --> f a) (at a) <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                     !x. dist(x,a) < d ==> dist(f x,f a) < e`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[LIM_SELF_WITHIN; IN_UNIV]);;

let LIM_SUBSEQUENCE = prove
 (`!s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially
           ==> (s o r --> l) sequentially`,
  REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
  MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);;

let SEQUENTIAL_LIMIT_URYSOHN = prove
 (`!s l:real^N.
        (s --> l) sequentially <=>
        !r. (!m n. m < n ==> r m < r n)
            ==> ?q:num->num.
                    (!m n. m < n ==> q m < q n) /\
                    ((s o r o q) --> l) sequentially`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [EXISTS_TAC `\n:num. n` THEN
    REWRITE_TAC[] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
    ASM_REWRITE_TAC[o_THM];
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    MP_TAC(ISPEC `{n |  e <= dist((s:num->real^N) n,l)}` num_INFINITE_EQ) THEN
    REWRITE_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE] THEN
    REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`; GSYM NOT_EXISTS_THM] THEN
    REWRITE_TAC[GSYM NOT_FORALL_THM] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    DISCH_THEN(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `r:num->num`) THEN
    ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN
    X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_REFL] THEN
    ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* The expected monotonicity property.                                       *)
(* ------------------------------------------------------------------------- *)

let LIM_WITHIN_EMPTY = prove
 (`!f l x. (f --> l) (at x within {})`,
  REWRITE_TAC[LIM_WITHIN; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);;

let LIM_WITHIN_SUBSET = prove
 (`!f l a s.
    (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)`,
  REWRITE_TAC[LIM_WITHIN; SUBSET] THEN MESON_TAC[]);;

let LIM_UNION = prove
 (`!f x l s t.
        (f --> l) (at x within s) /\ (f --> l) (at x within t)
        ==> (f --> l) (at x within (s UNION t))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; IN_UNION] THEN
  REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
  X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_SIMP_TAC[] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN
  EXISTS_TAC `min d1 d2` THEN ASM_MESON_TAC[REAL_LT_MIN]);;

let LIM_UNION_UNIV = prove
 (`!f x l s t.
        (f --> l) (at x within s) /\ (f --> l) (at x within t) /\
        s UNION t = (:real^N)
        ==> (f --> l) (at x)`,
  MESON_TAC[LIM_UNION; WITHIN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Composition of limits.                                                    *)
(* ------------------------------------------------------------------------- *)

let LIM_COMPOSE_WITHIN = prove
 (`!net f:A->real^N g:real^N->real^P s y z.
    (f --> y) net /\
    eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\
    (g --> z) (at y within s)
    ==> ((g o f) --> z) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; o_DEF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN
  ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  ASM_MESON_TAC[DIST_REFL]);;

let LIM_COMPOSE_AT = prove
 (`!net f:A->real^N g:real^N->real^P y z.
    (f --> y) net /\
    eventually (\w. f w = y ==> g y = z) net /\
    (g --> z) (at y)
    ==> ((g o f) --> z) net`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `g:real^N->real^P`;
                 `(:real^N)`; `y:real^N`; `z:real^P`]
        LIM_COMPOSE_WITHIN) THEN
  ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Interrelations between restricted and unrestricted limits.                *)
(* ------------------------------------------------------------------------- *)

let LIM_AT_WITHIN = prove
 (`!f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)`,
  REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MESON_TAC[]);;

let LIM_WITHIN_OPEN = prove
 (`!f l a:real^M s.
     a IN s /\ open s ==> ((f --> l) (at a within s) <=> (f --> l) (at a))`,
  SIMP_TAC[tendsto; EVENTUALLY_WITHIN_OPEN]);;

let LIM_WITHIN_OPEN_IN = prove
 (`!f:real^M->real^N l a s t.

        a IN t /\ open_in (subtopology euclidean s) t
        ==> ((f --> l) (at a within t) <=> (f --> l) (at a within s))`,
  REWRITE_TAC[tendsto] THEN MESON_TAC[EVENTUALLY_WITHIN_OPEN_IN]);;

(* ------------------------------------------------------------------------- *)
(* More limit point characterizations.                                       *)
(* ------------------------------------------------------------------------- *)

let [LIMPT_SEQUENTIAL; LIMPT_SEQUENTIAL_INJ; LIMPT_SEQUENTIAL_DECREASING] =
  (CONJUNCTS o prove)
  (`(!x:real^N s.
        x limit_point_of s <=>
        ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially) /\
    (!x:real^N s.
        x limit_point_of s <=>
        ?f. (!n. f(n) IN (s DELETE x)) /\
            (!m n. f m = f n <=> m = n) /\
            (f --> x) sequentially) /\
    (!x:real^N s.
        x limit_point_of s <=>
        ?f. (!n. f(n) IN (s DELETE x)) /\
            (!m n. m < n ==> dist(f n,x) < dist(f m,x)) /\
            (f --> x) sequentially)`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(s ==> r) /\ (r ==> q) /\ (q ==> p) /\ (p ==> s)
    ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[REAL_LT_REFL];
    MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
    REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN
    MESON_TAC[LE_REFL];
    REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `?f:num->real^N.
        (!n. (f n) IN s /\ ~(f n = x) /\ dist(f n,x) < inv(&n + &1)) /\
       (!n. dist(f(SUC n),x) < dist(f n,x))`
    MP_TAC THENL
     [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
      CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
      MAP_EVERY X_GEN_TAC [`n:num`; `z:real^N`] THEN
      STRIP_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC; GSYM REAL_LT_MIN] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; GSYM DIST_NZ] THEN
      REAL_ARITH_TAC;
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[IN_DELETE] THEN CONJ_TAC THENL
       [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN
        ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
        REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN
        CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
        X_GEN_TAC `N:num` THEN EXISTS_TAC `N:num` THEN
        X_GEN_TAC `n:num` THEN DISCH_TAC THEN
        TRANS_TAC REAL_LTE_TRANS `inv(&n + &1)` THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
        REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN
        ASM_ARITH_TAC]]]);;

let [LIMPT_INFINITE_OPEN; LIMPT_INFINITE_BALL; LIMPT_INFINITE_CBALL] =
    (CONJUNCTS o prove)
 (`(!s x:real^N.
        x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\
   (!s x:real^N.
        x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\
   (!s x:real^N.
        x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))`,
  REWRITE_TAC[LIMIT_POINT_IN_DERIVED_SET; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REPEAT STRIP_TAC THENL
   [REWRITE_TAC[DERIVED_SET_OF_INFINITE_OPEN_IN_METRIC];
    REWRITE_TAC[DERIVED_SET_OF_INFINITE_MBALL];
    REWRITE_TAC[DERIVED_SET_OF_INFINITE_MCBALL]] THEN
  REWRITE_TAC[IN_ELIM_THM; EUCLIDEAN_METRIC; IN_UNIV] THEN
  REWRITE_TAC[MBALL_EUCLIDEAN; MCBALL_EUCLIDEAN] THEN
  REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; GSYM OPEN_IN; IN_UNIV]);;

let INFINITE_OPEN_IN = prove
 (`!u s:real^N->bool.
      open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u)
      ==> INFINITE s`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o
        GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Condensation points.                                                      *)
(* ------------------------------------------------------------------------- *)

parse_as_infix ("condensation_point_of",(12,"right"));;

let condensation_point_of = new_definition
 `x condensation_point_of s <=>
        !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)`;;

let CONDENSATION_POINT_OF_SUBSET = prove
 (`!x:real^N s t.
        x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[condensation_point_of] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[CONTRAPOS_THM] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
  ASM SET_TAC[]);;

let CONDENSATION_POINT_IMP_LIMPT = prove
 (`!x s. x condensation_point_of s ==> x limit_point_of s`,
  REWRITE_TAC[condensation_point_of; LIMPT_INFINITE_OPEN; INFINITE] THEN
  MESON_TAC[FINITE_IMP_COUNTABLE]);;

let CONDENSATION_POINT_INFINITE_BALL,CONDENSATION_POINT_INFINITE_CBALL =
  (CONJ_PAIR o prove)
 (`(!s x:real^N.
        x condensation_point_of s <=>
        !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\
   (!s x:real^N.
        x condensation_point_of s <=>
        !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
   `(p ==> q) /\ (q ==> r) /\ (r ==> p)
    ==> (p <=> q) /\ (p <=> r)`) THEN
  REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL
   [MESON_TAC[OPEN_BALL; CENTRE_IN_BALL];
    MESON_TAC[BALL_SUBSET_CBALL; COUNTABLE_SUBSET;
              SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`];
    MESON_TAC[COUNTABLE_SUBSET; OPEN_CONTAINS_CBALL;
              SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]]);;

let CONDENSATION_POINT_ALT = prove
 (`!x:real^N s.
        x condensation_point_of s <=>
        !t. COUNTABLE t ==> x limit_point_of (s DIFF t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[condensation_point_of] THEN
  REWRITE_TAC[LIMPT_INFINITE_OPEN; RIGHT_IMP_FORALL_THM] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN AP_TERM_TAC THEN
  GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `u:real^N->bool` THEN
  ASM_CASES_TAC `(x:real^N) IN u /\ open u` THEN ASM_REWRITE_TAC[] THEN
  EQ_TAC THEN REPEAT STRIP_TAC THENL
   [REWRITE_TAC[SET_RULE
     `(s DIFF t) INTER u = (s INTER u) DIFF (t INTER u)`] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) CARD_DIFF_ABSORB o rand o snd) THEN
    ANTS_TAC THENL
     [CONJ_TAC THENL
       [ASM_MESON_TAC[INFINITE; FINITE_IMP_COUNTABLE]; ALL_TAC] THEN
      TRANS_TAC CARD_LET_TRANS `(:num)` THEN CONJ_TAC THENL
       [TRANS_TAC CARD_LE_TRANS `t:real^N->bool` THEN
        SIMP_TAC[CARD_LE_SUBSET; INTER_SUBSET] THEN
        ASM_REWRITE_TAC[GSYM COUNTABLE_ALT];
        ASM_REWRITE_TAC[GSYM COUNTABLE_ALT; GSYM CARD_NOT_LE]];
      DISCH_THEN(SUBST1_TAC o MATCH_MP CARD_INFINITE_CONG) THEN
      ASM_MESON_TAC[INFINITE; FINITE_IMP_COUNTABLE]];
    FIRST_X_ASSUM(MP_TAC o SPEC `s INTER u:real^N->bool`) THEN
    REWRITE_TAC[SET_RULE `(s DIFF s INTER u) INTER u = {}`] THEN
    ASM_REWRITE_TAC[INFINITE; FINITE_EMPTY]]);;

(* ------------------------------------------------------------------------- *)
(* Basic arithmetical combining theorems for limits.                         *)
(* ------------------------------------------------------------------------- *)

let LIM_LINEAR = prove
 (`!net:(A)net h f l.
        (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN
  STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
    MATCH_MP LINEAR_BOUNDED_POS) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; dist; GSYM LINEAR_SUB; REAL_LT_RDIV_EQ] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  ASM_MESON_TAC[REAL_LET_TRANS; REAL_MUL_SYM]);;

let LIM_CONST = prove
 (`!net a:real^N. ((\x. a) --> a) net`,
  SIMP_TAC[tendsto; DIST_REFL; EVENTUALLY_TRUE]);;

let LIM_CMUL = prove
 (`!f l c. (f --> l) net ==> ((\x. c % f x) --> c % l) net`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN
  ASM_REWRITE_TAC[REWRITE_RULE[ETA_AX]
    (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)]);;

let LIM_CMUL_EQ = prove
 (`!net f l c.
        ~(c = &0) ==> (((\x. c % f x) --> c % l) net <=> (f --> l) net)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_CMUL] THEN
  DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP LIM_CMUL) THEN
  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);;

let LIM_NEG = prove
 (`!net f l:real^N. (f --> l) net ==> ((\x. --(f x)) --> --l) net`,
  ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`] THEN
  REWRITE_TAC[LIM_CMUL]);;

let LIM_NEG_EQ = prove
 (`!net f l:real^N. ((\x. --(f x)) --> --l) net <=> (f --> l) net`,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN
  REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;

let LIM_ADD = prove
 (`!net:(A)net f g l m.
    (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> l + m) net`,
  REWRITE_TAC[LIM_COMPONENTWISE_REAL; VECTOR_ADD_COMPONENT] THEN
  SIMP_TAC[LIMIT_REAL_ADD]);;

let LIM_ABS = prove
 (`!net:(A)net f:A->real^N l.
     (f --> l) net
     ==> ((\x. lambda i. (abs(f(x)$i))) --> (lambda i. abs(l$i)):real^N) net`,
  SIMP_TAC[LIM_COMPONENTWISE_REAL; LAMBDA_BETA] THEN
  SIMP_TAC[LIMIT_REAL_ABS]);;

let LIM_LIFT_ABS_COMPONENT = prove
 (`!net:(A)net f:A->real^N l k.
     (f --> l) net ==> ((\x. lift(abs(f(x)$k))) --> lift(abs(l$k))) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  GEN_TAC THEN REWRITE_TAC[DIST_LIFT] THEN REWRITE_TAC[dist] THEN
  MATCH_MP_TAC(REAL_ARITH
   `abs(x - y) <= a ==> a < e ==> abs(abs x - abs y) < e`) THEN
  REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM]);;

let LIM_SUB = prove
 (`!net:(A)net f g l m.
    (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> l - m) net`,
  REWRITE_TAC[real_sub; VECTOR_SUB] THEN ASM_SIMP_TAC[LIM_ADD; LIM_NEG]);;

let LIM_MAX = prove
 (`!net:(A)net f g l:real^N m:real^N.
    (f --> l) net /\ (g --> m) net
    ==> ((\x. lambda i. max (f(x)$i) (g(x)$i))
         --> (lambda i. max (l$i) (m$i)):real^N) net`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN
  REWRITE_TAC[IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
  DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP LIM_CMUL) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN
  SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
           VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN
  REAL_ARITH_TAC);;

let LIM_MIN = prove
 (`!net:(A)net f g l:real^N m:real^N.
    (f --> l) net /\ (g --> m) net
    ==> ((\x. lambda i. min (f(x)$i) (g(x)$i))
         --> (lambda i. min (l$i) (m$i)):real^N) net`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN
  REWRITE_TAC[IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN
  SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN
  REAL_ARITH_TAC);;

let LIM_NORM = prove
 (`!net f:A->real^N l.
        (f --> l) net ==> ((\x. lift(norm(f x))) --> lift(norm l)) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; DIST_LIFT] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  REWRITE_TAC[] THEN NORM_ARITH_TAC);;

let LIM_NULL = prove
 (`!net f l. (f --> l) net <=> ((\x. f(x) - l) --> vec 0) net`,
  REWRITE_TAC[tendsto; dist; VECTOR_SUB_RZERO]);;

let LIM_NULL_NORM = prove
 (`!net f. (f --> vec 0) net <=> ((\x. lift(norm(f x))) --> vec 0) net`,
  REWRITE_TAC[tendsto; dist; VECTOR_SUB_RZERO; REAL_ABS_NORM; NORM_LIFT]);;

let LIM_NULL_CMUL_EQ = prove
 (`!net f:A->real^N c.
        ((\x. c % f x) --> vec 0) net <=> c = &0 \/ (f --> vec 0) net`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN
  ASM_REWRITE_TAC[VECTOR_MUL_LZERO; LIM_CONST] THEN
  ASM_MESON_TAC[LIM_CMUL_EQ; VECTOR_MUL_RZERO]);;

let LIM_NULL_CMUL = prove
 (`!net f c. (f --> vec 0) net ==> ((\x. c % f x) --> vec 0) net`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN
  ASM_SIMP_TAC[LIM_NULL_CMUL_EQ; VECTOR_MUL_LZERO; LIM_CONST]);;

let LIM_NULL_VMUL_EQ = prove
 (`!net:A net c v:real^N.
        ((\x. c x % v) --> vec 0) net <=>
        v = vec 0 \/ ((\x. lift(c x)) --> vec 0) net`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN
  REWRITE_TAC[NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  REWRITE_TAC[LIFT_CMUL; LIM_NULL_CMUL_EQ; NORM_EQ_0] THEN
  REWRITE_TAC[NORM_LIFT]);;

let LIM_NULL_VMUL = prove
 (`!net:A net c v:real^N.
    ((\x. lift(c x)) --> vec 0) net ==> ((\x. c x % v) --> vec 0) net`,
  SIMP_TAC[LIM_NULL_VMUL_EQ]);;

let LIM_NULL_NEG = prove
 (`!net f:A->real^N. ((\x. --(f x)) --> vec 0) net <=> (f --> vec 0) net`,
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`] THEN
  REWRITE_TAC[LIM_NULL_CMUL_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV);;

let LIM_NULL_ADD = prove
 (`!net f g:A->real^N.
        (f --> vec 0) net /\ (g --> vec 0) net
        ==> ((\x. f x + g x) --> vec 0) net`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
  REWRITE_TAC[VECTOR_ADD_LID]);;

let LIM_NULL_SUB = prove
 (`!net f g:A->real^N.
        (f --> vec 0) net /\ (g --> vec 0) net
        ==> ((\x. f x - g x) --> vec 0) net`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
  REWRITE_TAC[VECTOR_SUB_RZERO]);;

let LIM_NULL_COMPARISON = prove
 (`!net f g. eventually (\x. norm(f x) <= g x) net /\
             ((\x. lift(g x)) --> vec 0) net
             ==> (f --> vec 0) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN REAL_ARITH_TAC);;

let LIM_COMPONENT = prove
 (`!net f i l:real^N.
     (f --> l) net ==> ((\a. lift(f(a)$i)) --> lift(l$i)) net`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[tendsto; dist; GSYM LIFT_SUB; NORM_LIFT] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);;

let LIM_TRANSFORM_BOUND = prove
 (`!f g. eventually (\n. norm(f n) <= norm(g n)) net /\ (g --> vec 0) net
         ==> (f --> vec 0) net`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REAL_ARITH_TAC);;

let LIM_NULL_CMUL_BOUNDED = prove
 (`!f g:A->real^N B.
        eventually (\a. g a = vec 0 \/ abs(f a) <= B) net /\
        (g --> vec 0) net
        ==> ((\n. f n % g n) --> vec 0) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN
  UNDISCH_TAC `eventually (\a. g a:real^N = vec 0 \/ abs(f a) <= B)
                           (net:(A net))` THEN
  REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN
  REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN
  MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN
  ASM_CASES_TAC `(g:A->real^N) x = vec 0` THEN
  ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `B * e / (abs B + &1)` THEN
  ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN
  REWRITE_TAC[REAL_ARITH `c * (a / b) = (c * a) / b`] THEN
  SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN
  MATCH_MP_TAC(REAL_ARITH
   `e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1)`) THEN
  ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);;

let LIM_NULL_VMUL_BOUNDED = prove
 (`!f g:A->real^N B.
        ((lift o f) --> vec 0) net /\
        eventually (\a. f a = &0 \/ norm(g a) <= B) net
        ==> ((\n. f n % g n) --> vec 0) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN
  UNDISCH_TAC `eventually(\a. f a = &0 \/ norm((g:A->real^N) a) <= B) net` THEN
  REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN
  REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN
  MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN
  ASM_CASES_TAC `(f:A->real) x = &0` THEN
  ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `e / (abs B + &1) * B` THEN
  ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN
  REWRITE_TAC[REAL_ARITH `(a / b) * c = (a * c) / b`] THEN
  SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN
  MATCH_MP_TAC(REAL_ARITH
   `e * B <= e * abs B /\ &0 < e ==> e * B < e * (abs B + &1)`) THEN
  ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);;

let LIM_VSUM = prove
 (`!net f:A->B->real^N l s.
        FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net)
        ==> ((\x. vsum s (\i. f i x)) --> vsum s l) net`,
  REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[VSUM_CLAUSES; LIM_CONST; LIM_ADD; IN_INSERT; ETA_AX]);;

let LIM_NULL_VSUM = prove
 (`!net f:A->B->real^N s.
        FINITE s /\ (!a. a IN s ==> ((\x. f x a) --> vec 0) net)
        ==> ((\x. vsum s (f x)) --> vec 0) net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_VSUM) THEN
  REWRITE_TAC[VSUM_0; ETA_AX]);;

(* ------------------------------------------------------------------------- *)
(* Deducing things about the limit from the elements.                        *)
(* ------------------------------------------------------------------------- *)

let LIM_IN_CLOSED_SET = prove
 (`!net f:A->real^N s l.
        closed s /\ eventually (\x. f(x) IN s) net /\
        ~(trivial_limit net) /\ (f --> l) net
        ==> l IN s`,
  REWRITE_TAC[closed] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(SET_RULE `~(x IN (UNIV DIFF s)) ==> x IN s`) THEN
  DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `l:real^N` o GEN_REWRITE_RULE I
          [OPEN_CONTAINS_BALL]) THEN
  ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_UNION] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [tendsto]) THEN
  UNDISCH_TAC `eventually (\x. (f:A->real^N) x IN s) net` THEN
  ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
  MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]);;

(* ------------------------------------------------------------------------- *)
(* Need to prove closed(cball(x,e)) before deducing this as a corollary.     *)
(* ------------------------------------------------------------------------- *)

let LIM_NORM_UBOUND = prove
 (`!net:(A)net f (l:real^N) b.
      ~(trivial_limit net) /\
      (f --> l) net /\
      eventually (\x. norm(f x) <= b) net
      ==> norm(l) <= b`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISJ_CASES_TAC(REAL_ARITH `norm(l:real^N) <= b \/ b < norm l`) THEN
  ASM_REWRITE_TAC[tendsto] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `norm(l:real^N) - b`) MP_TAC) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT; IMP_IMP; GSYM EVENTUALLY_AND] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
  ASM_REWRITE_TAC[] THEN UNDISCH_TAC `b < norm(l:real^N)` THEN
  CONV_TAC NORM_ARITH);;

let LIM_NORM_LBOUND = prove
 (`!net:(A)net f (l:real^N) b.
      ~(trivial_limit net) /\ (f --> l) net /\
      eventually (\x. b <= norm(f x)) net
      ==> b <= norm(l)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISJ_CASES_TAC(REAL_ARITH `norm(l:real^N) < b \/ b <= norm l`) THEN
  ASM_REWRITE_TAC[tendsto] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `b - norm(l:real^N)`) MP_TAC) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT; IMP_IMP; GSYM EVENTUALLY_AND] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
  ASM_REWRITE_TAC[] THEN UNDISCH_TAC `norm(l:real^N) < b` THEN
  CONV_TAC NORM_ARITH);;

(* ------------------------------------------------------------------------- *)
(* Uniqueness of the limit, when nontrivial.                                 *)
(* ------------------------------------------------------------------------- *)

let LIM_UNIQUE = prove
 (`!net:(A)net f l:real^N l'.
      ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[LIMIT_METRIC_UNIQUE]);;

let TENDSTO_LIM = prove
 (`!net f l. ~(trivial_limit net) /\ (f --> l) net ==> lim net f = l`,
  REWRITE_TAC[lim] THEN MESON_TAC[LIM_UNIQUE]);;

let LIM_CONST_EQ = prove
 (`!net:(A net) c d:real^N.
        ((\x. c) --> d) net <=> trivial_limit net \/ c = d`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `trivial_limit (net:A net)` THEN
  ASM_SIMP_TAC[LIM_TRIVIAL] THEN
  EQ_TAC THEN SIMP_TAC[LIM_CONST] THEN DISCH_TAC THEN
  MATCH_MP_TAC(SPEC `net:A net` LIM_UNIQUE) THEN
  EXISTS_TAC `(\x. c):A->real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);;

(* ------------------------------------------------------------------------- *)
(* These are special for limits out of the same vector space.                *)
(* ------------------------------------------------------------------------- *)

let LIM_WITHIN_ID = prove
 (`!a s. ((\x. x) --> a) (at a within s)`,
  REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]);;

let LIM_AT_ID = prove
 (`!a. ((\x. x) --> a) (at a)`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]);;

let LIM_AT_ZERO = prove
 (`!f:real^M->real^N l a.
        (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(vec 0))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EVENTUALLY_AT_ZERO] THEN
  REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Some unwieldy but occasionally useful theorems about uniform limits.      *)
(* ------------------------------------------------------------------------- *)

let UNIFORM_LIM_ADD = prove
 (`!net:(A)net P f g l m.
        (!e. &0 < e
             ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\
        (!e. &0 < e
             ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net)
        ==> !e. &0 < e
                ==> eventually
                     (\x. !n. P n
                              ==> norm((f n x + g n x) - (l n + m n)) < e)
                     net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN
  ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN
  CONV_TAC NORM_ARITH);;

let UNIFORM_LIM_SUB = prove
 (`!net:(A)net P f g l m.
        (!e. &0 < e
             ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\
        (!e. &0 < e
             ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net)
        ==> !e. &0 < e
                ==> eventually
                     (\x. !n. P n
                              ==> norm((f n x - g n x) - (l n - m n)) < e)
                     net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN
  ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN
  CONV_TAC NORM_ARITH);;

(* ------------------------------------------------------------------------- *)
(* Limit under bilinear function, uniform version first.                     *)
(* ------------------------------------------------------------------------- *)

let UNIFORM_LIM_BILINEAR = prove
 (`!net:(A)net P (h:real^M->real^N->real^P) f g l m b1 b2.
        bilinear h /\
        eventually (\x. !n. P n ==> norm(l n) <= b1) net /\
        eventually (\x. !n. P n ==> norm(m n) <= b2) net /\
        (!e. &0 < e
             ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\
        (!e. &0 < e
             ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net)
        ==> !e. &0 < e
                ==> eventually
                     (\x. !n. P n
                              ==> norm(h (f n x) (g n x) - h (l n) (m n)) < e)
                     net`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o  MATCH_MP
   BILINEAR_BOUNDED_POS) THEN
  REWRITE_TAC[AND_FORALL_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   `min (abs b2 + &1) (e / &2 / (B * (abs b1 + abs b2 + &2)))`) THEN
  ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_LT_MIN;
               REAL_ARITH `&0 < abs x + &1`;
               REAL_ARITH `&0 < abs x + abs y + &2`] THEN
  REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  X_GEN_TAC `x:A` THEN REWRITE_TAC[AND_FORALL_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN
  ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH
    `h a b - h c d :real^N = (h a b - h a d) + (h a d - h c d)`] THEN
  ASM_SIMP_TAC[GSYM BILINEAR_LSUB; GSYM BILINEAR_RSUB] THEN
  MATCH_MP_TAC NORM_TRIANGLE_LT THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
   (MESON[REAL_LE_ADD2; REAL_LET_TRANS]
     `(!x y. norm(h x y:real^P) <= B * norm x * norm y)
       ==> B * norm a * norm b + B * norm c * norm d < e
           ==> norm(h a b) + norm(h c d) < e`)) THEN
  MATCH_MP_TAC(REAL_ARITH
   `x * B < e / &2 /\ y * B < e / &2 ==> B * x + B * y < e`) THEN
  CONJ_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THENL
   [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `e / &2 / (B * (abs b1 + abs b2 + &2)) *
             (abs b1 + abs b2 + &1)` THEN
  (CONJ_TAC THENL
    [MATCH_MP_TAC REAL_LE_MUL2 THEN
     ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN
     ASM_SIMP_TAC[REAL_ARITH `a <= b2 ==> a <= abs b1 + abs b2 + &1`] THEN
     ASM_MESON_TAC[NORM_ARITH
       `norm(f - l:real^P) < abs b2 + &1 /\ norm(l) <= b1
        ==> norm(f) <= abs b1 + abs b2 + &1`];
     ONCE_REWRITE_TAC[real_div] THEN
     ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_HALF; GSYM REAL_MUL_ASSOC;
                  REAL_INV_MUL] THEN
     REWRITE_TAC[REAL_ARITH `B * inv x * y < B <=> B * y / x < B * &1`] THEN
     ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ;
                  REAL_ARITH `&0 < abs x + abs y + &2`] THEN
     REAL_ARITH_TAC]));;

let LIM_BILINEAR = prove
 (`!net:(A)net (h:real^M->real^N->real^P) f g l m.
        (f --> l) net /\ (g --> m) net /\ bilinear h
        ==> ((\x. h (f x) (g x)) --> (h l m)) net`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`net:(A)net`; `\x:one. T`; `h:real^M->real^N->real^P`;
    `\n:one. (f:A->real^M)`; `\n:one. (g:A->real^N)`;
    `\n:one. (l:real^M)`; `\n:one. (m:real^N)`;
    `norm(l:real^M)`; `norm(m:real^N)`]
   UNIFORM_LIM_BILINEAR) THEN
  ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN
  ASM_REWRITE_TAC[GSYM dist; GSYM tendsto]);;

let BILINEAR_EPSILON_DELTA = prove
 (`!bop:real^M->real^N->real^P a b e.
        bilinear bop /\ &0 < e
        ==> ?d. &0 < d /\
                !x y. norm(x - a) < d /\ norm(y - b) < d
                      ==> norm(bop x y - bop a b) < e`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`at (pastecart (a:real^M) (b:real^N))`;
    `bop:real^M->real^N->real^P`;
    `fstcart:real^(M,N)finite_sum->real^M`;
    `sndcart:real^(M,N)finite_sum->real^N`;
    `fstcart(pastecart (a:real^M) (b:real^N))`;
    `sndcart(pastecart (a:real^M) (b:real^N))`]
    LIM_BILINEAR) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [CONJ_TAC THEN
    GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
    MATCH_MP_TAC LIM_LINEAR THEN
    REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LIM_AT_ID];
    REWRITE_TAC[LIM_SELF_AT] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
    ASM_SIMP_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF; GSYM dist] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    W(MP_TAC o PART_MATCH lhand DIST_PASTECART_LE o lhand o snd) THEN
    ASM_REAL_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* Transformation of limit.                                                  *)
(* ------------------------------------------------------------------------- *)

let LIM_TRANSFORM = prove
 (`!net f g l.
     ((\x. f x - g x) --> vec 0) net /\ (f --> l) net ==> (g --> l) net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
  VECTOR_ARITH_TAC);;

let LIM_TRANSFORM_EVENTUALLY = prove
 (`!net f g l.
        eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP LIM_EVENTUALLY) MP_TAC) THEN
  MESON_TAC[LIM_TRANSFORM]);;

let LIM_TRANSFORM_WITHIN = prove
 (`!f g x s d.
        &0 < d /\
        (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\
        (f --> l) (at x within s)
        ==> (g --> l) (at x within s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  DISCH_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN
  REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `d:real` THEN
  ASM_SIMP_TAC[VECTOR_SUB_REFL; DIST_REFL]);;

let LIM_TRANSFORM_AT = prove
 (`!f g x d.
        &0 < d /\
        (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\
        (f --> l) (at x)
        ==> (g --> l) (at x)`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]);;

let LIM_TRANSFORM_EQ = prove
 (`!net f:A->real^N g l.
     ((\x. f x - g x) --> vec 0) net ==> ((f --> l) net <=> (g --> l) net)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL
   [EXISTS_TAC `f:A->real^N` THEN ASM_REWRITE_TAC[];
    EXISTS_TAC `g:A->real^N` THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN
    ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]]);;

let LIM_TRANSFORM_WITHIN_SET = prove
 (`!f l a s t.
        eventually (\x. x IN s <=> x IN t) (at a)
        ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; LIM_WITHIN] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  ASM_MESON_TAC[]);;

let LIM_TRANSFORM_WITHIN_SET_IMP = prove
 (`!f l a s t.
        eventually (\x. x IN t ==> x IN s) (at a) /\ (f --> l) (at a within s)
        ==> (f --> l) (at a within t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; EVENTUALLY_AT; LIM_WITHIN] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Common case assuming being away from some crucial point like 0.           *)
(* ------------------------------------------------------------------------- *)

let LIM_TRANSFORM_AWAY_WITHIN = prove
 (`!f:real^M->real^N g a b s.
        ~(a = b) /\
        (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\
        (f --> l) (at a within s)
        ==> (g --> l) (at a within s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `dist(a:real^M,b)`] THEN
  ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `y:real^M` THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]);;

let LIM_TRANSFORM_AWAY_AT = prove
 (`!f:real^M->real^N g a b.
        ~(a = b) /\
        (!x. ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\
        (f --> l) (at a)
        ==> (g --> l) (at a)`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]);;

(* ------------------------------------------------------------------------- *)
(* Alternatively, within an open set.                                        *)
(* ------------------------------------------------------------------------- *)

let LIM_TRANSFORM_WITHIN_OPEN = prove
 (`!f g:real^M->real^N s a l.
        open s /\ a IN s /\
        (!x. x IN s /\ ~(x = a) ==> f x = g x) /\
        (f --> l) (at a)
        ==> (g --> l) (at a)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN
  EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL] THEN
  ASM_MESON_TAC[DIST_NZ; DIST_SYM]);;

let LIM_TRANSFORM_WITHIN_OPEN_IN = prove
 (`!f g:real^M->real^N s t a l.
        open_in (subtopology euclidean t) s /\ a IN s /\
        (!x. x IN s /\ ~(x = a) ==> f x = g x) /\
        (f --> l) (at a within t)
        ==> (g --> l) (at a within t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
  EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN
  ASM_MESON_TAC[DIST_NZ; DIST_SYM]);;

(* ------------------------------------------------------------------------- *)
(* Limit of linear functions is itself linear.                               *)
(* ------------------------------------------------------------------------- *)

let LINEAR_LIMIT = prove
 (`!net:A net f g:real^M->real^N.
        ~trivial_limit net /\
        eventually (\i. linear(f i)) net /\
        (!x. ((\i. f i x) --> g x) net)
        ==> linear g`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[linear] THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN
    MATCH_MP_TAC(ISPEC `net:A net` LIM_UNIQUE) THEN
    EXISTS_TAC `\i. (f:A->real^M->real^N) i (x + y)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
    EXISTS_TAC `\i. (f:A->real^M->real^N) i x + f i y` THEN
    ASM_SIMP_TAC[LIM_ADD];
    MAP_EVERY X_GEN_TAC [`c:real`; `x:real^M`] THEN
    MATCH_MP_TAC(ISPEC `net:A net` LIM_UNIQUE) THEN
    EXISTS_TAC `\i. (f:A->real^M->real^N) i (c % x)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
    EXISTS_TAC `\i. c % (f:A->real^M->real^N) i x` THEN
    ASM_SIMP_TAC[LIM_CMUL]] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
     EVENTUALLY_MONO)) THEN
  SIMP_TAC[linear]);;

let LINEAR_SEQUENTIAL_LIMIT = prove
 (`!f g:real^M->real^N.
        eventually (\n. linear(f n)) sequentially /\
        (!x. ((\n. f n x) --> g x) sequentially)
        ==> linear g`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(ISPEC `sequentially` LINEAR_LIMIT) THEN
  ASM_MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]);;

(* ------------------------------------------------------------------------- *)
(* Another quite common idiom of an explicit conditional in a sequence.      *)
(* ------------------------------------------------------------------------- *)

let LIM_CASES_FINITE_SEQUENTIALLY = prove
 (`!f g l. FINITE {n | P n}
           ==> (((\n. if P n then f n else g n) --> l) sequentially <=>
                (g --> l) sequentially)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
  FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
  REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `N:num` THEN DISCH_TAC THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN
  EXISTS_TAC `N + 1` THEN
  ASM_MESON_TAC[ARITH_RULE `~(x <= n /\ n + 1 <= x)`]);;

let LIM_CASES_COFINITE_SEQUENTIALLY = prove
 (`!f g l. FINITE {n | ~P n}
           ==> (((\n. if P n then f n else g n) --> l) sequentially <=>
                (f --> l) sequentially)`,
  ONCE_REWRITE_TAC[GSYM COND_SWAP] THEN
  REWRITE_TAC[LIM_CASES_FINITE_SEQUENTIALLY]);;

let LIM_CASES_SEQUENTIALLY = prove
 (`!f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=>
              (f --> l) sequentially) /\
             (((\n. if m < n then f n else g n) --> l) sequentially <=>
              (f --> l) sequentially) /\
             (((\n. if n <= m then f n else g n) --> l) sequentially <=>
              (g --> l) sequentially) /\
             (((\n. if n < m then f n else g n) --> l) sequentially <=>
              (g --> l) sequentially)`,
  SIMP_TAC[LIM_CASES_FINITE_SEQUENTIALLY; LIM_CASES_COFINITE_SEQUENTIALLY;
           NOT_LE; NOT_LT; FINITE_NUMSEG_LT; FINITE_NUMSEG_LE]);;

(* ------------------------------------------------------------------------- *)
(* A congruence rule allowing us to transform limits assuming not at point.  *)
(* ------------------------------------------------------------------------- *)

let LIM_CONG_WITHIN = prove
 (`(!x. x IN s /\ ~(x = a) ==> f x = g x)
   ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))`,
  REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);;

let LIM_CONG_AT = prove
 (`(!x. ~(x = a) ==> f x = g x)
   ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))`,
  REWRITE_TAC[LIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);;

extend_basic_congs [LIM_CONG_WITHIN; LIM_CONG_AT];;

(* ------------------------------------------------------------------------- *)
(* Useful lemmas on closure and set of possible sequential limits.           *)
(* ------------------------------------------------------------------------- *)

let CLOSURE_SEQUENTIAL = prove
 (`!s l:real^N.
     l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially`,
  REWRITE_TAC[closure; IN_UNION; LIMPT_SEQUENTIAL; IN_ELIM_THM; IN_DELETE] THEN
  REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
    `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN
  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
  EXISTS_TAC `\n:num. l:real^N` THEN
  ASM_REWRITE_TAC[LIM_CONST]);;

let CLOSED_CONTAINS_SEQUENTIAL_LIMIT = prove
 (`!s x l:real^N.
        closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s`,
  MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED]);;

let CLOSED_SEQUENTIAL_LIMITS = prove
 (`!s. closed s <=>
       !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s`,
  MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED;
            CLOSED_LIMPT; LIMPT_SEQUENTIAL; IN_DELETE]);;

let CLOSED_IN_SEQUENTIAL_LIMITS = prove
 (`!u s:real^N->bool.
        closed_in (subtopology euclidean u) s <=>
        s SUBSET u /\
        !x l. (!n. x n IN s) /\ l IN u /\ (x --> l) sequentially
              ==> l IN s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN
  REWRITE_TAC[SUBSET; IN_INTER; CLOSURE_SEQUENTIAL] THEN SET_TAC[]);;

let CLOSED_APPROACHABLE = prove
 (`!x s. closed s
         ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)`,
  MESON_TAC[CLOSURE_CLOSED; CLOSURE_APPROACHABLE]);;

let IN_CLOSURE_DELETE = prove
 (`!s x:real^N. x IN closure(s DELETE x) <=> x limit_point_of s`,
  SIMP_TAC[CLOSURE_APPROACHABLE; LIMPT_APPROACHABLE; IN_DELETE; CONJ_ASSOC]);;

let DENSE_LIMIT_POINTS = prove
 (`!s. {x | x limit_point_of s} = (:real^N) <=> closure s = (:real^N)`,
  GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[closure] THEN SET_TAC[]; DISCH_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP DENSE_IMP_PERFECT) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[closure]) THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Some other lemmas about sequences.                                        *)
(* ------------------------------------------------------------------------- *)

let SEQ_OFFSET = prove
 (`!f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially`,
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  MESON_TAC[ARITH_RULE `N <= n ==> N <= n + k:num`]);;

let SEQ_OFFSET_NEG = prove
 (`!f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially`,
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k:num`]);;

let SEQ_OFFSET_REV = prove
 (`!f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially`,
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k /\ (n - k) + k = n:num`]);;

let SEQ_OFFSET_EQ = prove
 (`!k f l:real^N.
        ((\i. f (i + k)) --> l) sequentially <=> (f --> l) sequentially`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SEQ_OFFSET_REV; SEQ_OFFSET]);;

let CONVERGENT_OFFSET = prove
 (`!f:num->real^N k.
     (?l. (f --> l) sequentially)
     ==> (?l. ((\i. f(i + k)) --> l) sequentially)`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN
  REWRITE_TAC[SEQ_OFFSET]);;

let CONVERGENT_OFFSET_EQ = prove
 (`!f:num->real^N k.
        (?l. ((\i. f(i + k)) --> l) sequentially) <=>
        (?l. (f --> l) sequentially)`,
  REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  REWRITE_TAC[SEQ_OFFSET_EQ]);;

let CONVERGENT_OFFSET_REV = prove
 (`!f:num->real^N k.
        (?l. ((\i. f(i + k)) --> l) sequentially)
        ==> (?l. (f --> l) sequentially)`,
  REWRITE_TAC[CONVERGENT_OFFSET_EQ]);;

let SEQ_HARMONIC_OFFSET = prove
 (`!a. ((\n. lift(inv(&n + a))) --> vec 0) sequentially`,
  GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o
    GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
  X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC
   (SPEC `--a:real` REAL_ARCH_SIMPLE) THEN
  EXISTS_TAC `M + N:num` THEN REWRITE_TAC[DIST_0; NORM_LIFT] THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN
  TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[REAL_ABS_INV] THEN
  MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD]) THEN
  ASM_REAL_ARITH_TAC);;

let SEQ_HARMONIC = prove
 (`((\n. lift(inv(&n))) --> vec 0) sequentially`,
  MP_TAC(SPEC `&0` SEQ_HARMONIC_OFFSET) THEN REWRITE_TAC[REAL_ADD_RID]);;

let SEQ_HARMONIC_RATIO = prove
 (`!a b. ((\n. lift((&n + a) / (&n + b))) --> vec 1) sequentially`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN
  MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
  EXISTS_TAC `\n. vec 1 + (a - b) % lift(inv(&n + b))` THEN
  SIMP_TAC[LIM_ADD; LIM_CONST; SEQ_HARMONIC_OFFSET; LIM_NULL_CMUL] THEN
  MP_TAC(ISPEC `abs b + &1` REAL_ARCH_SIMPLE) THEN
  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN
  REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
  REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD);;

(* ------------------------------------------------------------------------- *)
(* More properties of closed balls.                                          *)
(* ------------------------------------------------------------------------- *)

let CLOSED_CBALL = prove
 (`!x:real^N e. closed(cball(x,e))`,
  REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_CBALL; dist] THEN
  GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:num->real^N` THEN
  X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
  MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
  EXISTS_TAC `\n. x - (s:num->real^N) n` THEN
  REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN
  ASM_SIMP_TAC[LIM_SUB; LIM_CONST; SEQUENTIALLY] THEN MESON_TAC[GE_REFL]);;

let CLOSURE_CBALL = prove
 (`!a:real^N r. closure(cball(a,r)) = cball(a,r)`,
  REWRITE_TAC[CLOSURE_EQ; CLOSED_CBALL]);;

let IN_INTERIOR_CBALL = prove
 (`!x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s`,
  REWRITE_TAC[interior; IN_ELIM_THM] THEN
  MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET_TRANS;
            BALL_SUBSET_CBALL; CENTRE_IN_BALL; OPEN_BALL]);;

let LIMPT_BALL = prove
 (`!x:real^N y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < e` THENL
   [ALL_TAC; ASM_MESON_TAC[LIMPT_EMPTY; REAL_NOT_LT; BALL_EQ_EMPTY]] THEN
  ASM_REWRITE_TAC[] THEN EQ_TAC THENL
   [MESON_TAC[CLOSED_CBALL; CLOSED_LIMPT; LIMPT_SUBSET; BALL_SUBSET_CBALL];
    REWRITE_TAC[IN_CBALL; LIMPT_APPROACHABLE; IN_BALL]] THEN
  DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN
  ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[DIST_NZ] THENL
   [MP_TAC(SPECL [`d:real`; `e:real`] REAL_DOWN2) THEN
    ASM_REWRITE_TAC[] THEN
    GEN_MESON_TAC 0 40 1 [VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE];
    ALL_TAC] THEN
  MP_TAC(SPECL [`norm(y:real^N - x)`; `d:real`] REAL_DOWN2) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ; dist]) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(y:real^N) - (k / dist(y,x)) % (y - x)` THEN
  REWRITE_TAC[dist; VECTOR_ARITH `(y - c % z) - y = --c % z`] THEN
  REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NEG] THEN
  ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN
  REWRITE_TAC[VECTOR_ARITH `x - (y - k % (y - x)) = (&1 - k) % (x - y)`] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> &0 < abs k`; NORM_MUL] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 < k /\ k < d ==> abs k < d`] THEN
  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(x:real^N - y)` THEN
  ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
  MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[NORM_SUB]] THEN
  MATCH_MP_TAC(REAL_ARITH `&0 < k /\ k < &1 ==> abs(&1 - k) < &1`) THEN
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO;
               REAL_MUL_LID]);;

let CLOSURE_BALL = prove
 (`!x:real^N e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))`,
  SIMP_TAC[EXTENSION; closure; IN_ELIM_THM; IN_UNION; LIMPT_BALL] THEN
  REWRITE_TAC[IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);;

let INTERIOR_BALL = prove
 (`!a r. interior(ball(a,r)) = ball(a,r)`,
  SIMP_TAC[INTERIOR_OPEN; OPEN_BALL]);;

let INTERIOR_CBALL = prove
 (`!x:real^N e. interior(cball(x,e)) = ball(x,e)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL
   [ALL_TAC;
    SUBGOAL_THEN `cball(x:real^N,e) = {} /\ ball(x:real^N,e) = {}`
     (fun th -> REWRITE_TAC[th; INTERIOR_EMPTY]) THEN
    REWRITE_TAC[IN_BALL; IN_CBALL; EXTENSION; NOT_IN_EMPTY] THEN
    CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN
    MP_TAC(ISPECL [`x:real^N`; `y:real^N`] DIST_POS_LE) THEN
    POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN
  MATCH_MP_TAC INTERIOR_UNIQUE THEN
  REWRITE_TAC[BALL_SUBSET_CBALL; OPEN_BALL] THEN
  X_GEN_TAC `t:real^N->bool` THEN
  SIMP_TAC[SUBSET; IN_CBALL; IN_BALL; REAL_LT_LE] THEN STRIP_TAC THEN
  X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [open_def]) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_CASES_TAC `z:real^N = x` THENL
   [FIRST_X_ASSUM SUBST_ALL_TAC THEN
    FIRST_X_ASSUM(X_CHOOSE_TAC `k:real` o MATCH_MP REAL_DOWN) THEN
    SUBGOAL_THEN `?w:real^N. dist(w,x) = k` STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE];
      ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_SYM]];
    RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN
    DISCH_THEN(MP_TAC o SPEC `z + ((d / &2) / dist(z,x)) % (z - x:real^N)`) THEN
    REWRITE_TAC[dist; VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV;
                REAL_ABS_NORM; REAL_ABS_NUM] THEN
    ASM_SIMP_TAC[REAL_DIV_RMUL; GSYM dist; REAL_LT_IMP_NZ] THEN
    ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
    ASM_REWRITE_TAC[REAL_ARITH `abs d < d * &2 <=> &0 < d`] THEN
    DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN
    REWRITE_TAC[VECTOR_ARITH `x - (z + k % (z - x)) = (&1 + k) % (x - z)`] THEN
    REWRITE_TAC[REAL_NOT_LE; NORM_MUL] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
    ONCE_REWRITE_TAC[NORM_SUB] THEN
    ASM_SIMP_TAC[REAL_LT_RMUL_EQ; GSYM dist] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN
    ONCE_REWRITE_TAC[DIST_SYM] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]);;

let FRONTIER_BALL = prove
 (`!a e. &0 < e ==> frontier(ball(a,e)) = sphere(a,e)`,
  SIMP_TAC[frontier; sphere; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL;
           REAL_LT_IMP_LE] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN
  REAL_ARITH_TAC);;

let FRONTIER_CBALL = prove
 (`!a e. frontier(cball(a,e)) = sphere(a,e)`,
  SIMP_TAC[frontier; sphere; INTERIOR_CBALL; CLOSED_CBALL; CLOSURE_CLOSED;
           REAL_LT_IMP_LE] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN
  REAL_ARITH_TAC);;

let INTERIOR_SPHERE = prove
 (`!a:real^N r. interior(sphere(a,r)) = {}`,
  SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_FRONTIER_EMPTY; CLOSED_CBALL]);;

let CBALL_EQ_EMPTY = prove
 (`!x e. (cball(x,e) = {}) <=> e < &0`,
  REWRITE_TAC[EXTENSION; IN_CBALL; NOT_IN_EMPTY; REAL_NOT_LE] THEN
  MESON_TAC[DIST_POS_LE; DIST_REFL; REAL_LTE_TRANS]);;

let CBALL_EMPTY = prove
 (`!x e. e < &0 ==> cball(x,e) = {}`,
  REWRITE_TAC[CBALL_EQ_EMPTY]);;

let CBALL_EQ_SING = prove
 (`!x:real^N e. (cball(x,e) = {x}) <=> e = &0`,
  REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING] THEN
  EQ_TAC THENL [ALL_TAC; MESON_TAC[DIST_LE_0]] THEN
  DISCH_THEN(fun th -> MP_TAC(SPEC `x + (e / &2) % basis 1:real^N` th) THEN
                       MP_TAC(SPEC `x:real^N` th)) THEN
  REWRITE_TAC[dist; VECTOR_ARITH `x - (x + e):real^N = --e`;
              VECTOR_ARITH `x + e = x <=> e:real^N = vec 0`] THEN
  REWRITE_TAC[NORM_NEG; NORM_MUL; VECTOR_MUL_EQ_0; NORM_0; VECTOR_SUB_REFL] THEN
  SIMP_TAC[NORM_BASIS; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN
  REAL_ARITH_TAC);;

let CBALL_SING = prove
 (`!x e. e = &0 ==> cball(x,e) = {x}`,
  REWRITE_TAC[CBALL_EQ_SING]);;

let SPHERE_SING = prove
 (`!x e. e = &0 ==> sphere(x,e) = {x}`,
  SIMP_TAC[sphere; DIST_EQ_0; SING_GSPEC]);;

let SPHERE_EQ_SING = prove
 (`!a:real^N r x. sphere(a,r) = {x} <=> x = a /\ r = &0`,
  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPHERE_SING] THEN
  ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_INSERT_EMPTY] THEN
  ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING] THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE
   `!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})`) THEN
  EXISTS_TAC `a - (x - a):real^N` THEN REWRITE_TAC[IN_SPHERE] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH);;

let HAS_SIZE_SPHERE_1 = prove
 (`!a:real^N r. sphere(a,r) HAS_SIZE 1 <=> r = &0`,
  REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
  REWRITE_TAC[SPHERE_EQ_SING] THEN MESON_TAC[]);;

let IMAGE_AFFINITY_CBALL = prove
 (`!m c a:real^N r.
        IMAGE (\x. m % x + c) (cball(a,r)) =
        if &0 <= r \/ ~(m = &0) then cball(m % a + c,abs m * r) else {}`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
    REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; CBALL_EQ_EMPTY; GSYM REAL_NOT_LE] THEN
    MATCH_MP_TAC(SET_RULE `~(s = {}) /\ t = {a} ==> IMAGE (\x. a) s = t`) THEN
    ASM_REWRITE_TAC[CBALL_TRIVIAL; CBALL_EQ_EMPTY; REAL_NOT_LT];
    MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
    REWRITE_TAC[IN_CBALL; DIST_MUL; NORM_ARITH
     `dist(x + a:real^N,y + a) = dist(x,y)`] THEN
    ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_ABS_NZ] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN
    EXISTS_TAC `inv(m) % (x - c):real^N` THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN VECTOR_ARITH_TAC]);;

let IMAGE_AFFINITY_BALL = prove
 (`!m c a:real^N r.
        IMAGE (\x. m % x + c) (ball(a,r)) =
        if ~(m = &0) then ball(m % a + c,abs m * r)
        else if r <= &0 then {} else {c}`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
    REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; BALL_EQ_EMPTY; GSYM REAL_NOT_LT] THEN
    MATCH_MP_TAC(SET_RULE `~(s = {}) ==> IMAGE (\x. a) s = {a}`) THEN
    ASM_REWRITE_TAC[BALL_EQ_EMPTY];
    MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
    REWRITE_TAC[IN_BALL; DIST_MUL; NORM_ARITH
     `dist(x + a:real^N,y + a) = dist(x,y)`] THEN
    ASM_SIMP_TAC[REAL_LT_LMUL_EQ; GSYM REAL_ABS_NZ] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN
    EXISTS_TAC `inv(m) % (x - c):real^N` THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN VECTOR_ARITH_TAC]);;

let IMAGE_AFFINITY_SPHERE = prove
 (`!m c a:real^N r.
        IMAGE (\x. m % x + c) (sphere(a,r)) =
        if &0 <= r \/ ~(m = &0) then sphere(m % a + c,abs m * r) else {}`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
    REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; SPHERE_EQ_EMPTY; GSYM REAL_NOT_LE] THEN
    MATCH_MP_TAC(SET_RULE `~(s = {}) /\ t = {a} ==> IMAGE (\x. a) s = t`) THEN
    ASM_SIMP_TAC[SPHERE_SING; SPHERE_EQ_EMPTY; REAL_NOT_LT];
    MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
    REWRITE_TAC[IN_SPHERE; DIST_MUL; NORM_ARITH
     `dist(x + a:real^N,y + a) = dist(x,y)`] THEN
    ASM_SIMP_TAC[REAL_EQ_MUL_LCANCEL; REAL_ABS_ZERO; GSYM REAL_ABS_NZ] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN
    EXISTS_TAC `inv(m) % (x - c):real^N` THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN VECTOR_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* For points in the interior, localization of limits makes no difference.   *)
(* ------------------------------------------------------------------------- *)

let EVENTUALLY_WITHIN_INTERIOR_INTER = prove
 (`!p s t x.
        x IN interior s
        ==> (eventually p (at x within s INTER t) <=>
             eventually p (at x within t))`,
  REWRITE_TAC[EVENTUALLY_WITHIN; IN_INTER; IN_INTERIOR] THEN
  REPEAT GEN_TAC THEN SIMP_TAC[SUBSET; IN_BALL; LEFT_IMP_FORALL_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  ASM_MESON_TAC[DIST_SYM]);;

let LIM_WITHIN_INTERIOR_INTER = prove
 (`!f l s x.
        x IN interior s
        ==> ((f --> l) (at x within s INTER t) <=> (f --> l) (at x within t))`,
  SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR_INTER]);;

let LIM_WITHIN_INTERIOR = prove
 (`!f l s x.
        x IN interior s
        ==> ((f --> l) (at x within s) <=> (f --> l) (at x))`,
  SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR]);;

(* ------------------------------------------------------------------------- *)
(* A non-singleton connected set is perfect (i.e. has no isolated points).   *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_IMP_PERFECT = prove
 (`!s x:real^N.
        connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`euclidean:(real^N)topology`; `s:real^N->bool`]
        CONNECTED_IN_IMP_PERFECT_GEN) THEN
  ASM_REWRITE_TAC[CONNECTED_IN_EUCLIDEAN; T1_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[LIMIT_POINT_IN_DERIVED_SET] THEN ASM SET_TAC[]);;

let CONNECTED_IMP_PERFECT_CLOSED = prove
 (`!s x. connected s /\ closed s /\ ~(?a. s = {a})
         ==> (x limit_point_of s <=> x IN s)`,
  MESON_TAC[CONNECTED_IMP_PERFECT; CLOSED_LIMPT]);;

let CONNECTED_LIMIT_POINTS_EQ_CLOSURE = prove
 (`!s:real^N->bool.
        connected s /\ ~(?a. s = {a})
        ==> {x | x limit_point_of s} = closure s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[closure] THEN
  REWRITE_TAC[SET_RULE `l = s UNION l <=> s SUBSET l`] THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
  ASM_MESON_TAC[CONNECTED_IMP_PERFECT]);;

let CONNECTED_LIMIT_POINTS = prove
 (`!s:real^N->bool. connected s ==> connected {x | x limit_point_of s}`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a:real^N. s = {a}` THENL
   [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN
    SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING; EMPTY_GSPEC; CONNECTED_EMPTY];
    ASM_MESON_TAC[CONNECTED_LIMIT_POINTS_EQ_CLOSURE; CONNECTED_CLOSURE]]);;

(* ------------------------------------------------------------------------- *)
(* Boundedness.                                                              *)
(* ------------------------------------------------------------------------- *)

let bounded = new_definition
  `bounded s <=> ?a. !x:real^N. x IN s ==> norm(x) <= a`;;

let MBOUNDED_EUCLIDEAN = prove
 (`!s:real^N->bool. mbounded euclidean_metric s <=> bounded s`,
  GEN_TAC THEN REWRITE_TAC[mbounded; bounded; MCBALL_EUCLIDEAN] THEN
  EQ_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; LEFT_IMP_EXISTS_THM] THENL
   [MAP_EVERY X_GEN_TAC [`c:real^N`; `b:real`] THEN DISCH_TAC THEN
    EXISTS_TAC `norm(c:real^N) + b`;
    X_GEN_TAC `b:real` THEN DISCH_TAC THEN
    MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `b:real`]] THEN
  POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);;

let BOUNDED_EMPTY = prove
 (`bounded {}`,
  REWRITE_TAC[bounded; NOT_IN_EMPTY]);;

let BOUNDED_SUBSET = prove
 (`!s t. bounded t /\ s SUBSET t ==> bounded s`,
  MESON_TAC[bounded; SUBSET]);;

let BOUNDED_INTERIOR = prove
 (`!s:real^N->bool. bounded s ==> bounded(interior s)`,
  MESON_TAC[BOUNDED_SUBSET; INTERIOR_SUBSET]);;

let BOUNDED_CLOSURE = prove
 (`!s:real^N->bool. bounded s ==> bounded(closure s)`,
  REWRITE_TAC[bounded; CLOSURE_SEQUENTIAL] THEN
  GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
  DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
  DISCH_THEN(X_CHOOSE_TAC `x:num->real^N`) THEN
  MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
  EXISTS_TAC `x:num->real^N` THEN
  ASM_SIMP_TAC[EVENTUALLY_TRUE; TRIVIAL_LIMIT_SEQUENTIALLY]);;

let BOUNDED_CLOSURE_EQ = prove
 (`!s:real^N->bool. bounded(closure s) <=> bounded s`,
  GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN
  MESON_TAC[BOUNDED_SUBSET; CLOSURE_SUBSET]);;

let BOUNDED_CBALL = prove
 (`!x:real^N e. bounded(cball(x,e))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[bounded] THEN
  EXISTS_TAC `norm(x:real^N) + e` THEN REWRITE_TAC[IN_CBALL; dist] THEN
  NORM_ARITH_TAC);;

let BOUNDED_BALL = prove
 (`!x e. bounded(ball(x,e))`,
  MESON_TAC[BALL_SUBSET_CBALL; BOUNDED_CBALL; BOUNDED_SUBSET]);;

let FINITE_IMP_BOUNDED = prove
 (`!s:real^N->bool. FINITE s ==> bounded s`,
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[BOUNDED_EMPTY] THEN
  REWRITE_TAC[bounded; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `norm(x:real^N) + abs B` THEN REPEAT STRIP_TAC THEN
  ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH
   `(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b`]);;

let BOUNDED_NORM_IMAGE = prove
 (`!s:real^N->bool.
        bounded s <=> bounded(IMAGE (lift o norm) s)`,
  REWRITE_TAC[bounded; FORALL_IN_IMAGE; o_THM] THEN
  REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM]);;

let BOUNDED_UNION = prove
 (`!s t. bounded (s UNION t) <=> bounded s /\ bounded t`,
  REWRITE_TAC[bounded; IN_UNION] THEN MESON_TAC[REAL_LE_MAX]);;

let BOUNDED_UNIONS = prove
 (`!f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(UNIONS f)`,
  REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_0; BOUNDED_EMPTY; IN_INSERT; UNIONS_INSERT] THEN
  MESON_TAC[BOUNDED_UNION]);;

let BOUNDED_POS = prove
 (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) <= b`,
  REWRITE_TAC[bounded] THEN
  MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);;

let BOUNDED_POS_LT = prove
 (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) < b`,
  REWRITE_TAC[bounded] THEN
  MESON_TAC[REAL_LT_IMP_LE;
            REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);;

let BOUNDED_PAIRS = prove
 (`!s:real^N->bool.
        bounded s <=> ?B. !x y. x IN s /\ y IN s ==> dist(x,y) <= B`,
  GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_IN_EMPTY] THEN
  FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o
    REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[bounded] THEN EQ_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL
   [EXISTS_TAC `&2 * B` THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
    STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
      MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
    ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH;
    EXISTS_TAC `B + norm(a:real^N)` THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `x:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH]);;

let BOUNDED_PAIRS_POS = prove
 (`!s:real^N->bool.
        bounded s <=> ?B. &0 < B /\ !x y. x IN s /\ y IN s ==> dist(x,y) <= B`,
  REWRITE_TAC[BOUNDED_PAIRS] THEN
  MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);;

let BOUNDED_INTER = prove
 (`!s t. bounded s \/ bounded t ==> bounded (s INTER t)`,
  MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);;

let BOUNDED_DIFF = prove
 (`!s t. bounded s ==> bounded (s DIFF t)`,
  MESON_TAC[BOUNDED_SUBSET; SUBSET_DIFF]);;

let BOUNDED_INSERT = prove
 (`!x s. bounded(x INSERT s) <=> bounded s`,
  ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN
  SIMP_TAC[BOUNDED_UNION; FINITE_IMP_BOUNDED; FINITE_RULES]);;

let BOUNDED_SING = prove
 (`!a. bounded {a}`,
  REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY]);;

let BOUNDED_DELETE = prove
 (`!x:real^N s. bounded(s DELETE x) <=> bounded s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
  ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN
  TRANS_TAC EQ_TRANS `bounded((x:real^N) INSERT (s DELETE x))` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[BOUNDED_INSERT]; AP_TERM_TAC THEN ASM SET_TAC[]]);;

let BOUNDED_INTERS = prove
 (`!f:(real^N->bool)->bool.
        (?s:real^N->bool. s IN f /\ bounded s) ==> bounded(INTERS f)`,
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN
  DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
  ASM SET_TAC[]);;

let NOT_BOUNDED_UNIV = prove
 (`~(bounded (:real^N))`,
  REWRITE_TAC[BOUNDED_POS; NOT_FORALL_THM; NOT_EXISTS_THM; IN_UNIV;
              DE_MORGAN_THM; REAL_NOT_LE] THEN
  X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(SPEC `B + &1` VECTOR_CHOOSE_SIZE) THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> &0 <= B + &1`] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC);;

let NOT_OPEN_SING = prove
 (`!a:real^N. ~(open {a})`,
  GEN_TAC THEN MP_TAC(ISPEC `{a:real^N}` CLOPEN) THEN
  REWRITE_TAC[NOT_INSERT_EMPTY; CLOSED_SING] THEN
  DISCH_THEN SUBST1_TAC THEN
  DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^N->bool)->bool`) THEN
  REWRITE_TAC[BOUNDED_SING; NOT_BOUNDED_UNIV]);;

let COBOUNDED_IMP_UNBOUNDED = prove
 (`!s. bounded((:real^N) DIFF s) ==> ~bounded s`,
  GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
  REWRITE_TAC[GSYM BOUNDED_UNION; SET_RULE `UNIV DIFF s UNION s = UNIV`] THEN
  REWRITE_TAC[NOT_BOUNDED_UNIV]);;

let BOUNDED_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s. bounded s /\ linear f ==> bounded(IMAGE f s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) MP_TAC) THEN
  DISCH_THEN(X_CHOOSE_TAC `B2:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN
  EXISTS_TAC `B2 * B1` THEN ASM_SIMP_TAC[REAL_LT_MUL; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm(x:real^M)` THEN
  ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);;

let BOUNDED_LINEAR_IMAGE_EQ = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
         ==> (bounded (IMAGE f s) <=> bounded s)`,
  MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE BOUNDED_LINEAR_IMAGE));;

add_linear_invariants [BOUNDED_LINEAR_IMAGE_EQ];;

let BOUNDED_SCALING = prove
 (`!c s. bounded s ==> bounded (IMAGE (\x. c % x) s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
  ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID]);;

let BOUNDED_NEGATIONS = prove
 (`!s. bounded s ==> bounded (IMAGE (--) s)`,
  GEN_TAC THEN
  DISCH_THEN(MP_TAC o SPEC `-- &1` o MATCH_MP BOUNDED_SCALING) THEN
  REWRITE_TAC[bounded; IN_IMAGE; VECTOR_MUL_LNEG; VECTOR_MUL_LID]);;

let BOUNDED_TRANSLATION = prove
 (`!a:real^N s. bounded s ==> bounded (IMAGE (\x. a + x) s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN
  EXISTS_TAC `B + norm(a:real^N)` THEN POP_ASSUM MP_TAC THEN
  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[] THEN NORM_ARITH_TAC);;

let BOUNDED_TRANSLATION_EQ = prove
 (`!a s. bounded (IMAGE (\x:real^N. a + x) s) <=> bounded s`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN
  DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP BOUNDED_TRANSLATION) THEN
  REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
              VECTOR_ARITH `--a + a + x:real^N = x`]);;

add_translation_invariants [BOUNDED_TRANSLATION_EQ];;

let BOUNDED_SCALING_EQ = prove
 (`!s:real^N->bool c. bounded (IMAGE (\x. c % x) s) <=> c = &0 \/ bounded s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN
    MESON_TAC[BOUNDED_SING; BOUNDED_EMPTY];
    EQ_TAC THEN REWRITE_TAC[BOUNDED_SCALING] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP BOUNDED_SCALING) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);;

let BOUNDED_AFFINITY_EQ = prove
 (`!s m c:real^N.
        bounded (IMAGE (\x. m % x + c) s) <=> m = &0 \/ bounded s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; BOUNDED_TRANSLATION_EQ;
              BOUNDED_SCALING_EQ; IMAGE_o]);;

let BOUNDED_AFFINITY = prove
 (`!s m c:real^N. bounded s ==> bounded (IMAGE (\x. m % x + c) s)`,
  SIMP_TAC[BOUNDED_AFFINITY_EQ]);;

let BOUNDED_DIFFS = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN
  EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN
  CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
   `norm x <= a /\ norm y <= b ==> norm(x - y) <= a + b`) THEN
  ASM_SIMP_TAC[]);;

let BOUNDED_SUMS = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN
  EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN
  CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
   `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN
  ASM_SIMP_TAC[]);;

let BOUNDED_SUMS_IMAGE = prove
 (`!f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t}
           ==> bounded {f x + g x | x IN t}`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
  SET_TAC[]);;

let BOUNDED_SUMS_IMAGES = prove
 (`!f:A->B->real^N t s.
        FINITE s /\
        (!a. a IN s ==> bounded {f x a | x IN t})
        ==> bounded { vsum s (f x) | x IN t}`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL
   [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC `{vec 0:real^N}` THEN
    SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_RULES] THEN SET_TAC[];
    ALL_TAC] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGE THEN
  ASM_SIMP_TAC[IN_INSERT]);;

let BOUNDED_SUBSET_BALL = prove
 (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `&2 * B + norm(x:real^N)` THEN
  ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH
    `&0 < B /\ &0 <= x ==> &0 < &2 * B + x`] 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[IN_BALL] THEN
  UNDISCH_TAC `&0 < B` THEN NORM_ARITH_TAC);;

let BOUNDED_SUBSET_CBALL = prove
 (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)`,
  MESON_TAC[BOUNDED_SUBSET_BALL; SUBSET_TRANS; BALL_SUBSET_CBALL]);;

let UNBOUNDED_INTER_COBOUNDED = prove
 (`!s t. ~bounded s /\ bounded((:real^N) DIFF t) ==> ~(s INTER t = {})`,
  REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (:real^N) DIFF t`] THEN
  MESON_TAC[BOUNDED_SUBSET]);;

let COBOUNDED_INTER_UNBOUNDED = prove
 (`!s t. bounded((:real^N) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})`,
  REWRITE_TAC[SET_RULE `s INTER t = {} <=> t SUBSET (:real^N) DIFF s`] THEN
  MESON_TAC[BOUNDED_SUBSET]);;

let SUBSPACE_BOUNDED_EQ_TRIVIAL = prove
 (`!s:real^N->bool. subspace s ==> (bounded s <=> s = {vec 0})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SING] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN
  ASM_SIMP_TAC[SUBSPACE_0] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN
  DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm v % v:real^N`) THEN
  ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
  ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC);;

let BOUNDED_COMPONENTWISE = prove
 (`!s:real^N->bool.
        bounded s <=> !i. 1 <= i /\ i <= dimindex(:N)
                          ==> bounded (IMAGE (\x. lift(x$i)) s)`,
  GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; NORM_LIFT] THEN
  EQ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real` THEN
  DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) b` THEN CONJ_TAC THENL
   [MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC `sum(1..dimindex(:N)) (\i. &0)` THEN
    SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POS] THEN
    MATCH_MP_TAC SUM_LT_ALL THEN
    ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY] THEN
    REWRITE_TAC[NOT_LT; DIMINDEX_GE_1];
    REPEAT STRIP_TAC THEN
    W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG]]);;

let BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC = prove
 (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval(--a,a)`,
  REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `B:real`] THEN STRIP_TAC THEN
  EXISTS_TAC `(lambda i. B + &1):real^N` THEN
  REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_BOUNDS_LT; VECTOR_NEG_COMPONENT] THEN
  ASM_MESON_TAC[COMPONENT_LE_NORM;
                REAL_ARITH `x <= y ==> a <= x ==> a < y + &1`]);;

let BOUNDED_SUBSET_OPEN_INTERVAL = prove
 (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval(a,b)`,
  MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]);;

let BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC = prove
 (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval[--a,a]`,
  GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  SIMP_TAC[IN_BALL; IN_INTERVAL; SUBSET; REAL_LT_IMP_LE]);;

let BOUNDED_SUBSET_CLOSED_INTERVAL = prove
 (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval[a,b]`,
  MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]);;

(* ------------------------------------------------------------------------- *)
(* Some theorems on sups and infs using the notion "bounded".                *)
(* ------------------------------------------------------------------------- *)

let BOUNDED_LIFT = prove
 (`!s. bounded(IMAGE lift s) <=>  ?a. !x. x IN s ==> abs(x) <= a`,
  REWRITE_TAC[bounded; FORALL_LIFT; NORM_LIFT; LIFT_IN_IMAGE_LIFT]);;

let BOUNDED_HAS_SUP = prove
 (`!s. bounded(IMAGE lift s) /\ ~(s = {})
       ==> (!x. x IN s ==> x <= sup s) /\
           (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)`,
  REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN
  MESON_TAC[SUP; REAL_ARITH `abs(x) <= a ==> x <= a`]);;

let SUP_INSERT = prove
 (`!x s. bounded (IMAGE lift s)
         ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL
   [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN
  REWRITE_TAC[REAL_LE_MAX; REAL_LT_MAX; IN_INSERT] THEN
  MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN
  REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);;

let BOUNDED_HAS_INF = prove
 (`!s. bounded(IMAGE lift s) /\ ~(s = {})
       ==> (!x. x IN s ==> inf s <= x) /\
           (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)`,
  REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN
  MESON_TAC[INF; REAL_ARITH `abs(x) <= a ==> --a <= x`]);;

let INF_INSERT = prove
 (`!x s. bounded (IMAGE lift s)
         ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL
   [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN
  REWRITE_TAC[REAL_MIN_LE; REAL_MIN_LT; IN_INSERT] THEN
  MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN
  REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);;

(* ------------------------------------------------------------------------- *)
(* Subset and overlapping relations on balls.                                *)
(* ------------------------------------------------------------------------- *)

let SUBSET_BALLS = prove
 (`(!a a':real^N r r'.
      ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\
   (!a a':real^N r r'.
      ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\
   (!a a':real^N r r'.
      cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\
   (!a a':real^N r r'.
      cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)`,
  let lemma = prove
   (`(!a':real^N r r'.
       cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\
     (!a':real^N r r'.
       cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)`,
    CONJ_TAC THEN
    (GEOM_ORIGIN_TAC `a':real^N` THEN
    REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN
    EQ_TAC THENL [REWRITE_TAC[DIST_0]; NORM_ARITH_TAC] THEN
    DISJ_CASES_TAC(REAL_ARITH `r < &0 \/ &0 <= r`) THEN
    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN
    ASM_CASES_TAC `a:real^N = vec 0` THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `r % basis 1:real^N`) THEN
      ASM_SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL];
      FIRST_X_ASSUM(MP_TAC o SPEC `(&1 + r / norm(a)) % a:real^N`) THEN
      SIMP_TAC[dist; VECTOR_ARITH `a - (&1 + x) % a:real^N = --(x % a)`] THEN
      ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_NEG; REAL_POS;
                   REAL_LE_DIV; NORM_POS_LE; REAL_ADD_RDISTRIB; REAL_DIV_RMUL;
               NORM_EQ_0; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`]] THEN
    UNDISCH_TAC `&0 <= r` THEN NORM_ARITH_TAC))
  and tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN
            ASM_SIMP_TAC[CLOSED_CBALL; CLOSURE_CLOSED; CLOSURE_BALL] in
  REWRITE_TAC[AND_FORALL_THM] THEN GEOM_ORIGIN_TAC `a':real^N` THEN
  REPEAT STRIP_TAC THEN
  (EQ_TAC THENL
    [ALL_TAC; REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THEN
  MATCH_MP_TAC(SET_RULE
   `(s = {} <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p)
    ==> s SUBSET t ==> p \/ q`) THEN
  REWRITE_TAC[BALL_EQ_EMPTY; CBALL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL
   [tac; tac; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;

let INTER_BALLS_EQ_EMPTY = prove
 (`(!a b:real^N r s. ball(a,r) INTER ball(b,s) = {} <=>
                     r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\
   (!a b:real^N r s. ball(a,r) INTER cball(b,s) = {} <=>
                     r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\
   (!a b:real^N r s. cball(a,r) INTER ball(b,s) = {} <=>
                     r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\
   (!a b:real^N r s. cball(a,r) INTER cball(b,s) = {} <=>
                     r < &0 \/ s < &0 \/ r + s < dist(a,b))`,
  REPEAT STRIP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
  GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_CBALL; IN_BALL] THEN
  (EQ_TAC THENL
    [ALL_TAC;
     SPEC_TAC(`b % basis 1:real^N`,`v:real^N`) THEN CONV_TAC NORM_ARITH]) THEN
  DISCH_THEN(MP_TAC o GEN `c:real` o SPEC `c % basis 1:real^N`) THEN
  SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1; dist; NORM_NEG;
           VECTOR_SUB_LZERO; GSYM VECTOR_SUB_RDISTRIB; REAL_MUL_RID] THEN
  ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN
  DISCH_THEN(fun th ->
    MP_TAC(SPEC `min b r:real` th) THEN
    MP_TAC(SPEC `max (&0) (b - s:real)` th) THEN
    MP_TAC(SPEC `(r + (b - s)) / &2` th)) THEN
  ASM_REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Compactness (the definition is the one based on convegent subsequences).  *)
(* ------------------------------------------------------------------------- *)

let compact = new_definition
  `compact s <=>
        !f:num->real^N.
            (!n. f(n) IN s)
            ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\
                      ((f o r) --> l) sequentially`;;

let COMPACT_IN_EUCLIDEAN = prove
 (`!s:real^N->bool. compact_in euclidean s <=> compact s`,
  REWRITE_TAC[compact; GSYM LIMIT_EUCLIDEAN] THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; COMPACT_IN_SEQUENTIALLY] THEN
  REWRITE_TAC[compact; EUCLIDEAN_METRIC; SUBSET_UNIV]);;

let COMPACT_SPACE_EUCLIDEAN_SUBTOPOLOGY = prove
 (`!s:real^N->bool. compact_space (subtopology euclidean s) <=> compact s`,
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN; COMPACT_IN_SUBSPACE] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let COMPACT_IMP_CLOSED = prove
 (`!s. compact s ==> closed s`,
  GEN_TAC THEN REWRITE_TAC[CLOSED_IN; GSYM COMPACT_IN_EUCLIDEAN] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] COMPACT_IN_IMP_CLOSED_IN) THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[HAUSDORFF_SPACE_MTOPOLOGY]);;

let COMPACT_IMP_BOUNDED = prove
 (`!s. compact s ==> bounded s`,
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN; GSYM MBOUNDED_EUCLIDEAN] THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC; COMPACT_IN_IMP_MBOUNDED]);;

let COMPACT_INTERVAL = prove
 (`!a b:real^N. compact(interval[a,b])`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN] THEN
  SUBGOAL_THEN
    `interval[a:real^N,b] = IMAGE (\x. lambda i. x i)
     (cartesian_product (1..dimindex(:N)) (\i. real_interval[a$i,b$i]))`
  SUBST1_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `!g. (!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> g y IN s /\ f(g y) = y)
          ==> t = IMAGE f s`) THEN
    EXISTS_TAC `\(x:real^N) i. if i IN 1..dimindex(:N) then x$i else ARB` THEN
    REWRITE_TAC[cartesian_product; IN_ELIM_THM; EXTENSIONAL] THEN
    SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; IN_REAL_INTERVAL; IN_NUMSEG; CART_EQ];
    MATCH_MP_TAC IMAGE_COMPACT_IN THEN
    EXISTS_TAC `product_topology (1..dimindex(:N)) (\i. euclideanreal)` THEN
    SIMP_TAC[COMPACT_IN_CARTESIAN_PRODUCT; CONTINUOUS_MAP_PRODUCT_PROJECTION;
             IN_NUMSEG; CONTINUOUS_MAP_COMPONENTWISE_REAL; LAMBDA_BETA;
             COMPACT_IN_EUCLIDEANREAL_INTERVAL; TOPSPACE_EUCLIDEAN;
             SUBSET_UNIV; TOPSPACE_PRODUCT_TOPOLOGY]]);;

let BOUNDED_CLOSED_IMP_COMPACT = prove
 (`!s:real^N->bool. bounded s /\ closed s ==> compact s`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
  MATCH_MP_TAC CLOSED_COMPACT_IN THEN EXISTS_TAC `interval[a:real^N,b]` THEN
  ASM_REWRITE_TAC[CLOSED_IN_EUCLIDEAN; COMPACT_IN_EUCLIDEAN] THEN
  REWRITE_TAC[COMPACT_INTERVAL]);;

let COMPACT_EQ_BOUNDED_CLOSED = prove
 (`!s:real^N->bool. compact s <=> bounded s /\ closed s`,
  MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT; COMPACT_IMP_CLOSED;
            COMPACT_IMP_BOUNDED]);;

let NOT_COMPACT_UNIV = prove
 (`~compact (:real^N)`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; NOT_BOUNDED_UNIV]);;

let COMPACT_CLOSURE = prove
 (`!s. compact(closure s) <=> bounded s`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE_EQ]);;

let CLOSED_IN_COMPACT = prove
 (`!s t:real^N->bool.
        compact s /\ closed_in (subtopology euclidean s) t
        ==> compact t`,
  SIMP_TAC[IMP_CONJ; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_EQ] THEN
  MESON_TAC[BOUNDED_SUBSET]);;

let CLOSED_IN_COMPACT_EQ = prove
 (`!s t. compact s
         ==> (closed_in (subtopology euclidean s) t <=>
              compact t /\ t SUBSET s)`,
  MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);;

let COMPACT_EQ_HEINE_BOREL = prove
 (`!s:real^N->bool.
        compact s <=>
           !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f)
               ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`,
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN; compact_in] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; OPEN_IN; SUBSET_UNIV] THEN
  MESON_TAC[]);;

let COMPACT_IMP_HEINE_BOREL = prove
 (`!s. compact (s:real^N->bool)
       ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f)
               ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`,
  SIMP_TAC[GSYM COMPACT_EQ_HEINE_BOREL]);;

let COMPACT_EQ_BOLZANO_WEIERSTRASS = prove
 (`!s:real^N->bool.
        compact s <=>
           !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`,
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN] THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[COMPACT_IN_EQ_BOLZANO_WEIERSTRASS] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; SUBSET_UNIV] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[GSYM LIMIT_POINT_IN_DERIVED_SET] THEN MESON_TAC[]);;

let BOLZANO_WEIERSTRASS_IMP_CLOSED = prove
 (`!s:real^N->bool.
        (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t)
        ==> closed s`,
  REWRITE_TAC[GSYM COMPACT_EQ_BOLZANO_WEIERSTRASS; COMPACT_IMP_CLOSED]);;

let COMPACT_IMP_TOTALLY_BOUNDED = prove
 (`!s:real^N->bool.
        compact s
        ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\
                               s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`,
  GEN_TAC THEN
  SIMP_TAC[GSYM COMPACT_IN_EUCLIDEAN; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IN_IMP_TOTALLY_BOUNDED_IN) THEN
  REWRITE_TAC[totally_bounded_in; MBALL_EUCLIDEAN; SIMPLE_IMAGE]);;

let HEINE_BOREL_LEMMA = prove
 (`!s:real^N->bool.
      compact s
      ==> !t. s SUBSET (UNIONS t) /\ (!b. b IN t ==> open b)
              ==> ?e. &0 < e /\
                      !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`euclidean_metric:(real^N)metric`;
                 `s:real^N->bool`; `t:(real^N->bool)->bool`]
        LEBESGUE_NUMBER) THEN
  ASM_REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; COMPACT_IN_EUCLIDEAN] THEN
  ASM_REWRITE_TAC[GSYM OPEN_IN; MBALL_EUCLIDEAN]);;

let HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS = prove
 (`!s:real^N->bool.
        (!f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f)
             ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f'))
        ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`,
  REWRITE_TAC[GSYM COMPACT_EQ_BOLZANO_WEIERSTRASS; GSYM
              COMPACT_EQ_HEINE_BOREL]);;

let BOLZANO_WEIERSTRASS_IMP_BOUNDED = prove
 (`!s:real^N->bool.
        (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t)
        ==> bounded s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
  EXISTS_TAC `closure s:real^N->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
  MP_TAC(ISPECL [`euclidean_metric:(real^N)metric`; `s:real^N->bool`]
        COMPACT_CLOSURE_OF_EQ_BOLZANO_WEIERSTRASS) THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; SUBSET_UNIV; GSYM MEMBER_NOT_EMPTY] THEN
  REWRITE_TAC[GSYM LIMIT_POINT_IN_DERIVED_SET; MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  ASM_REWRITE_TAC[EUCLIDEAN_CLOSURE_OF; COMPACT_IN_EUCLIDEAN] THEN
  REWRITE_TAC[COMPACT_IMP_BOUNDED]);;

let COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY = prove
 (`!s:real^N->bool.
        compact s <=>
        !f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\
            s SUBSET UNIONS f
            ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET UNIONS f'`,
  GEN_TAC THEN REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN] THEN
  ONCE_REWRITE_TAC[GSYM COMPACT_IN_ABSOLUTE] THEN
  REWRITE_TAC[compact_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL] THEN
  MESON_TAC[]);;

let COMPACT_EQ_HEINE_BOREL_GEN = prove
 (`!c:real^N->bool.
        compact c <=>
        !f s. (!t. t IN f ==> open_in (subtopology euclidean s) t) /\
              c SUBSET UNIONS f
              ==> ?f'. f' SUBSET f /\ FINITE f' /\ c SUBSET UNIONS f'`,
  GEN_TAC THEN REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN] THEN
  ONCE_REWRITE_TAC[GSYM COMPACT_IN_ABSOLUTE] THEN
  EQ_TAC THEN REPEAT STRIP_TAC THENL
   [SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL
     [TRANS_TAC SUBSET_TRANS `UNIONS f:real^N->bool` THEN
      ASM_REWRITE_TAC[UNIONS_SUBSET] THEN
      ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
      MP_TAC(ISPECL[`subtopology euclidean (s:real^N->bool)`; `c:real^N->bool`]
        compact_in) THEN
      ONCE_REWRITE_TAC[GSYM COMPACT_IN_ABSOLUTE] THEN
      REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN
      ASM_SIMP_TAC[SET_RULE `c SUBSET s ==> s INTER c = c`] THEN
      ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      ASM_MESON_TAC[]];
    REWRITE_TAC[compact_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL] THEN
    ASM_MESON_TAC[]]);;

let BOUNDED_EQ_BOLZANO_WEIERSTRASS = prove
 (`!s:real^N->bool.
        bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t`,
  GEN_TAC THEN
  MP_TAC(ISPECL [`euclidean_metric:(real^N)metric`; `s:real^N->bool`]
        COMPACT_CLOSURE_OF_EQ_BOLZANO_WEIERSTRASS) THEN
  REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; COMPACT_IN_EUCLIDEAN; SUBSET_UNIV;
              EUCLIDEAN_CLOSURE_OF; EUCLIDEAN_METRIC; INTER_UNIV] THEN
  REWRITE_TAC[COMPACT_CLOSURE; GSYM MEMBER_NOT_EMPTY;
              LIMIT_POINT_IN_DERIVED_SET] THEN
  MESON_TAC[]);;

let BOLZANO_WEIERSTRASS = prove
 (`!s:real^N->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s`,
  MESON_TAC[BOUNDED_EQ_BOLZANO_WEIERSTRASS; SUBSET_REFL]);;

let BOUNDED_EQ_TOTALLY_BOUNDED = prove
 (`!s:real^N->bool.
        bounded s <=>
        !e. &0 < e
            ==> ?k. FINITE k /\ k SUBSET s /\
                    s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`,
  GEN_TAC THEN REWRITE_TAC[GSYM MBALL_EUCLIDEAN; GSYM SIMPLE_IMAGE] THEN
  REWRITE_TAC[GSYM totally_bounded_in] THEN EQ_TAC THENL
   [DISCH_TAC THEN MATCH_MP_TAC COMPACT_CLOSURE_OF_IMP_TOTALLY_BOUNDED_IN THEN
    REWRITE_TAC[SUBSET_UNIV; MTOPOLOGY_EUCLIDEAN_METRIC; EUCLIDEAN_METRIC] THEN
    REWRITE_TAC[EUCLIDEAN_CLOSURE_OF; COMPACT_IN_EUCLIDEAN] THEN
    ASM_REWRITE_TAC[COMPACT_CLOSURE];
    REWRITE_TAC[GSYM MBOUNDED_EUCLIDEAN; TOTALLY_BOUNDED_IN_IMP_MBOUNDED]]);;

(* ------------------------------------------------------------------------- *)
(* Convergence of bounded monotone sequences.                                *)
(* ------------------------------------------------------------------------- *)

let CONVERGENT_BOUNDED_MONOTONE_1 = prove
 (`!s. bounded(IMAGE s (:num)) /\
       ((!n. drop(s n) <= drop(s(SUC n))) \/ (!n. drop(s(SUC n)) <= drop(s n)))
       ==> ?l. (s --> l) sequentially`,
  GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN
  MP_TAC(ISPECL [`drop o (s:num->real^1)`; `b:real`]
     CONVERGENT_BOUNDED_MONOTONE) THEN
  ASM_REWRITE_TAC[o_DEF; GSYM NORM_1; LIM_SEQUENTIALLY] THEN
  REWRITE_TAC[DIST_REAL; GSYM drop; GSYM EXISTS_DROP] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  FIRST_X_ASSUM DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN
  MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
  ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;

let CONVERGENT_BOUNDED_INCREASING_1 = prove
 (`!s b. (!n. drop(s n) <= drop(s(SUC n))) /\ (!n. drop(s n) <= b)
         ==> ?l. (s --> l) sequentially`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE_1 THEN
  ASM_REWRITE_TAC[bounded] THEN
  EXISTS_TAC `max (abs b) (norm((s:num->real^1) 0))` THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; NORM_1] THEN X_GEN_TAC `n:num` THEN
  MATCH_MP_TAC(REAL_ARITH
   `a <= x /\ x <= b ==> abs x <= max (abs b) (abs a)`) THEN
  ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN
  INDUCT_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);;

let CONVERGENT_BOUNDED_DECREASING_1 = prove
 (`!s b. (!n. drop(s(SUC n)) <= drop(s n)) /\ (!n. b <= drop(s n))
         ==> ?l. (s --> l) sequentially`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE_1 THEN
  ASM_REWRITE_TAC[bounded] THEN
  EXISTS_TAC `max (abs b) (norm((s:num->real^1) 0))` THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; NORM_1] THEN X_GEN_TAC `n:num` THEN
  MATCH_MP_TAC(REAL_ARITH
   `b <= x /\ x <= a ==> abs x <= max (abs b) (abs a)`) THEN
  ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN
  INDUCT_TAC THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);;

(* ------------------------------------------------------------------------- *)
(* Completeness.                                                             *)
(* ------------------------------------------------------------------------- *)

let cauchy = new_definition
  `cauchy (s:num->real^N) <=>
     !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e`;;

let CAUCHY_IN_EUCLIDEAN = prove
 (`!s:num->real^N. cauchy_in euclidean_metric s <=> cauchy s`,
  REWRITE_TAC[cauchy; cauchy_in; EUCLIDEAN_METRIC; IN_UNIV; GE]);;

let complete = new_definition
  `complete s <=>
     !f:num->real^N. (!n. f n IN s) /\ cauchy f
                      ==> ?l. l IN s /\ (f --> l) sequentially`;;

let CAUCHY = prove
 (`!s:num->real^N.
      cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL
   [MESON_TAC[LE_REFL]; DISCH_TAC] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  MESON_TAC[DIST_TRIANGLE_HALF_L]);;

let CAUCHY_SUBSEQUENCE = prove
 (`!x:num->real^N r:num->num.
        (!m n. m < n ==> r m < r n) /\ cauchy x ==> cauchy (x o r)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  DISCH_THEN(MP_TAC o MATCH_MP MONOTONE_BIGGER) THEN
  REWRITE_TAC[cauchy; o_DEF; GE] THEN MESON_TAC[LE_TRANS]);;

let CAUCHY_OFFSET = prove
 (`!k x:num->real^N. cauchy (\i. x(i + k)) <=> cauchy x`,
  REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL
   [ALL_TAC; MESON_TAC[LE_ADD; LE_TRANS]] THEN
  MESON_TAC[ARITH_RULE
   `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`]);;

let CONVERGENT_IMP_CAUCHY = prove
 (`!s l. (s --> l) sequentially ==> cauchy s`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; GSYM CAUCHY_IN_EUCLIDEAN] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONVERGENT_IMP_CAUCHY_IN) THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; IN_UNIV]);;

let CAUCHY_IMP_BOUNDED = prove
 (`!s:num->real^N. cauchy s ==> bounded {y | ?n. y = s n}`,
  GEN_TAC THEN REWRITE_TAC[GSYM CAUCHY_IN_EUCLIDEAN] THEN
  DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IN_IMP_MBOUNDED) THEN
  REWRITE_TAC[MBOUNDED_EUCLIDEAN] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_TERM_TAC THEN SET_TAC[]);;

let CAUCHY_CONVERGENT_SUBSEQUENCE = prove
 (`!x:num->real^N r.
        cauchy x /\ (!m n. m < n ==> r m < r n) /\ ((x o r) --> l) sequentially
        ==> (x --> l) sequentially`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_ADD)) THEN
  DISCH_THEN(MP_TAC o SPEC `\n. (x:num->real^N)(n) - x(r n)`) THEN
  DISCH_THEN(MP_TAC o SPEC `vec 0: real^N`) THEN ASM_REWRITE_TAC[o_THM] THEN
  REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_ADD2; ETA_AX] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cauchy]) THEN
  REWRITE_TAC[GE; LIM_SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP MONOTONE_BIGGER) THEN
  ASM_MESON_TAC[LE_TRANS]);;

let COMPACT_IMP_COMPLETE = prove
 (`!s:real^N->bool. compact s ==> complete s`,
  GEN_TAC THEN REWRITE_TAC[complete; compact] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:num->real^N` THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CAUCHY_CONVERGENT_SUBSEQUENCE THEN
  ASM_MESON_TAC[]);;

let COMPLETE_UNIV = prove
 (`complete(:real^N)`,
  REWRITE_TAC[complete; IN_UNIV] THEN X_GEN_TAC `x:num->real^N` THEN
  DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN
  DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN
  MP_TAC(ISPEC `closure {y:real^N | ?n:num. y = x n}`
               COMPACT_IMP_COMPLETE) THEN
  ASM_SIMP_TAC[BOUNDED_CLOSED_IMP_COMPACT; CLOSED_CLOSURE; complete] THEN
  DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN
  ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
  ASM_REWRITE_TAC[closure; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]);;

let COMPLETE_EQ_CLOSED = prove
 (`!s:real^N->bool. complete s <=> closed s`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[complete; CLOSED_LIMPT; LIMPT_SEQUENTIAL] THEN
    REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
    MESON_TAC[CONVERGENT_IMP_CAUCHY; IN_DELETE; LIM_UNIQUE;
              TRIVIAL_LIMIT_SEQUENTIALLY];
    REWRITE_TAC[complete; CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN
    X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN
    MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN
    DISCH_THEN(MP_TAC o SPEC `f:num->real^N`) THEN
    ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]);;

let CONVERGENT_EQ_CAUCHY = prove
 (`!s. (?l. (s --> l) sequentially) <=> cauchy s`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONVERGENT_IMP_CAUCHY];
    REWRITE_TAC[REWRITE_RULE[complete; IN_UNIV] COMPLETE_UNIV]]);;

let CONVERGENT_IMP_BOUNDED = prove
 (`!s l. (s --> l) sequentially ==> bounded (IMAGE s (:num))`,
  REWRITE_TAC[LEFT_FORALL_IMP_THM; CONVERGENT_EQ_CAUCHY] THEN
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN
  REWRITE_TAC[IMAGE; IN_UNIV]);;

let CONVERGENT_BOUNDED_MONOTONE_EQ = prove
 (`!s. (!n. drop(s n) <= drop(s(SUC n))) \/ (!n. drop(s(SUC n)) <= drop(s n))
       ==> ((?l. (s --> l) sequentially) <=> bounded (IMAGE s (:num)))`,
  MESON_TAC[CONVERGENT_BOUNDED_MONOTONE_1; CONVERGENT_IMP_BOUNDED]);;

let MCOMPLETE_EUCLIDEAN = prove
 (`mcomplete(euclidean_metric:(real^N)metric)`,
  REWRITE_TAC[mcomplete; MTOPOLOGY_EUCLIDEAN_METRIC;
    CAUCHY_IN_EUCLIDEAN; LIMIT_EUCLIDEAN; CONVERGENT_EQ_CAUCHY]);;

let COMPLETELY_METRIZABLE_SPACE_EUCLIDEAN = prove
 (`completely_metrizable_space euclidean`,
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  MATCH_MP_TAC COMPLETELY_METRIZABLE_SPACE_MTOPOLOGY THEN
  REWRITE_TAC[MCOMPLETE_EUCLIDEAN]);;

(* ------------------------------------------------------------------------- *)
(* Cauchy-type criteria for limits at a point.                               *)
(* ------------------------------------------------------------------------- *)

let CONVERGENT_EQ_ZERO_OSCILLATION = prove
 (`!f:real^M->real^N a s.
        (?l. (f --> l) (at a within s)) <=>
        !e. &0 < e
            ==> ?u. open u /\ a IN u /\
                    !x y. x IN (s INTER u) DELETE a /\
                          y IN (s INTER u) DELETE a
                          ==> dist(f x,f y) < e`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; at; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  SIMP_TAC[CONVERGENT_EQ_ZERO_OSCILLATION_GEN; MCOMPLETE_EUCLIDEAN; IN_UNIV;
           EUCLIDEAN_METRIC; SUBSET_UNIV; TOPSPACE_MTOPOLOGY] THEN
  REWRITE_TAC[MTOPOLOGY_EUCLIDEAN_METRIC; GSYM OPEN_IN; UNIV_NOT_EMPTY]);;

let CONVERGENT_EQ_CAUCHY_WITHIN = prove
 (`!f:real^M->real^N s a.
        (?l. (f --> l) (at a within s)) <=>
        (!e. &0 < e
             ==> ?d. &0 < d /\
                     !x x'. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d /\
                            x' IN s /\ &0 < dist(x',a) /\ dist(x',a) < d
                            ==> dist(f x,f x') < e)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONVERGENT_EQ_ZERO_OSCILLATION] THEN
  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
    DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
    REWRITE_TAC[SUBSET; IN_BALL] THEN REPEAT STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[IN_INTER; IN_DELETE; DIST_NZ];
    X_GEN_TAC `d:real` THEN STRIP_TAC THEN
    EXISTS_TAC `ball(a:real^M,d)` THEN
    ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; IN_INTER; IN_DELETE] THEN
    ASM_REWRITE_TAC[IN_BALL; DIST_NZ]] THEN
  ASM_MESON_TAC[DIST_SYM]);;

let CONVERGENT_EQ_CAUCHY_AT = prove
 (`!f:real^M->real^N a.
        (?l. (f --> l) (at a)) <=>
        (!e. &0 < e
             ==> ?d. &0 < d /\
                     !x x'. &0 < dist(x,a) /\ dist(x,a) < d /\
                            &0 < dist(x',a) /\ dist(x',a) < d
                            ==> dist(f x,f x') < e)`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; `a:real^M`]
        CONVERGENT_EQ_CAUCHY_WITHIN) THEN
  REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Compactness properties (some orphaned lemmas no longer used here).        *)
(* ------------------------------------------------------------------------- *)

let SEQUENCE_INFINITE_LEMMA = prove
 (`!f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially
         ==> INFINITE {y:real^N | ?n. y = f n}`,
  REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC
   `IMAGE (\y:real^N. dist(y,l)) {y | ?n:num. y = f n}` INF_FINITE) THEN
  ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE; FINITE_IMAGE; IN_ELIM_THM] THEN
  ASM_MESON_TAC[LIM_SEQUENTIALLY; LE_REFL; REAL_NOT_LE; DIST_POS_LT]);;

let LIMPT_OF_SEQUENCE_SUBSEQUENCE = prove
 (`!f:num->real^N l.
        l limit_point_of (IMAGE f (:num))
        ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN
  DISCH_THEN(MP_TAC o GEN `n:num` o SPEC
   `inf((inv(&n + &1)) INSERT
    IMAGE (\k. dist((f:num->real^N) k,l))
          {k | k IN 0..n /\ ~(f k = l)})`) THEN
  SIMP_TAC[REAL_LT_INF_FINITE; FINITE_INSERT; NOT_INSERT_EMPTY;
           FINITE_RESTRICT; FINITE_NUMSEG; FINITE_IMAGE] THEN
  REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN
  REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
  SIMP_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; GSYM DIST_NZ; SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `nn:num->num` STRIP_ASSUME_TAC) THEN
  (MP_TAC o prove_recursive_functions_exist num_RECURSION)
   `r 0 = nn 0 /\ (!n. r (SUC n) = nn(r n))` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
  STRIP_TAC THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[LT_TRANS] THEN
    X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`(r:num->num) n`; `(nn:num->num)(r(n:num))`]) THEN
    ASM_REWRITE_TAC[IN_NUMSEG; LE_0; REAL_LT_REFL] THEN ARITH_TAC;
    DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
  MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LE] THEN
  X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN
  ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
  EXISTS_TAC `inv(&((r:num->num) n) + &1)` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
  ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN
  MATCH_MP_TAC(ARITH_RULE `N <= SUC n /\ n <= r n ==> N <= r n + 1`) THEN
  ASM_REWRITE_TAC[]);;

let SEQUENCE_UNIQUE_LIMPT = prove
 (`!f l l':real^N.
        (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n}
        ==> l' = l`,
  REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f (:num)`] THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
  EXISTS_TAC `(f:num->real^N) o (r:num->num)` THEN
  ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUBSEQUENCE]);;

let COMPACT_SEQUENCE_WITH_LIMIT_GEN = prove
 (`!f l:real^N s.
        (f --> l) sequentially /\ s SUBSET IMAGE f (:num)
        ==> compact (l INSERT s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN] THEN
  MATCH_MP_TAC COMPACT_IN_SEQUENCE_WITH_LIMIT THEN
  EXISTS_TAC `f:num->real^N` THEN
  ASM_REWRITE_TAC[LIMIT_EUCLIDEAN; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let COMPACT_SEQUENCE_WITH_LIMIT = prove
 (`!f l:real^N.
        (f --> l) sequentially ==> compact (l INSERT IMAGE f (:num))`,
  MESON_TAC[COMPACT_SEQUENCE_WITH_LIMIT_GEN; SUBSET_REFL]);;

let BOLZANO_WEIERSTRASS_CONTRAPOS = prove
 (`!s t:real^N->bool.
        compact s /\ t SUBSET s /\
        (!x. x IN s ==> ~(x limit_point_of t))
        ==> FINITE t`,
  REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; INFINITE] THEN MESON_TAC[]);;

let DISCRETE_BOUNDED_IMP_FINITE = prove
 (`!s:real^N->bool e.
        &0 < e /\
        (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) /\
        bounded s
        ==> FINITE s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `compact(s:real^N->bool)` MP_TAC THENL
   [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
    ASM_MESON_TAC[DISCRETE_IMP_CLOSED];
    DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN
  DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. ball(x,e)) s`) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; UNIONS_IMAGE; IN_ELIM_THM] THEN
  ANTS_TAC THENL
   [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL];
    ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
  ASM_REWRITE_TAC[IN_ELIM_THM; IN_BALL; dist] THEN ASM_MESON_TAC[SUBSET]);;

let FINITE_EQ_BOUNDED_DISCRETE = prove
 (`!s:real^N->bool.
        FINITE s <=>
        bounded s /\
        ?r. &0 < r /\ !x y. x IN s /\ y IN s /\ norm (y - x) < r ==> x = y`,
  GEN_TAC THEN EQ_TAC THENL
   [SIMP_TAC[FINITE_IMP_BOUNDED]; MESON_TAC[DISCRETE_BOUNDED_IMP_FINITE]] THEN
  DISCH_TAC THEN
  ASM_CASES_TAC `{(x:real^N,y) | x IN s /\ y IN s DELETE x} = {}` THENL
   [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
    REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN SET_TAC[];
    ALL_TAC] THEN
  EXISTS_TAC `inf (IMAGE dist {(x:real^N,y) | x IN s /\ y IN s DELETE x})` THEN
  ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_DELETE; REAL_LT_INF_FINITE;
    FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
  SIMP_TAC[IN_DELETE; DIST_POS_LT; dist] THEN MESON_TAC[REAL_LT_REFL]);;

let DISCRETE_EQ_FINITE_BOUNDED = prove
 (`!s:real^N->bool.
        bounded s ==> ({x | x limit_point_of s} = {} <=> FINITE s)`,
  GEN_TAC THEN REWRITE_TAC[BOUNDED_EQ_BOLZANO_WEIERSTRASS] THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
  MESON_TAC[LIMIT_POINT_FINITE; INFINITE; SUBSET_REFL]);;

let DISCRETE_EQ_FINITE_BOUNDED_CLOSED = prove
 (`!s t:real^N->bool.
        closed s /\ bounded t /\ t SUBSET s
        ==> ({x | x IN s /\ x limit_point_of t} = {} <=> FINITE t)`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM DISCRETE_EQ_FINITE_BOUNDED] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
   `(!x. P x ==> x IN s) ==> {x | x IN s /\ P x} = {x | P x}`) THEN
  ASM_MESON_TAC[CLOSED_LIMPT; LIMPT_SUBSET]);;

let DISCRETE_EQ_FINITE_COMPACT = prove
 (`!s t:real^N->bool.
        compact s /\ t SUBSET s
        ==> ({x | x IN s /\ x limit_point_of t} = {} <=> FINITE t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DISCRETE_EQ_FINITE_BOUNDED_CLOSED THEN
  ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);;

let COMPACT_EMPTY = prove
 (`compact {}`,
  REWRITE_TAC[compact; NOT_IN_EMPTY]);;

let COMPACT_UNION = prove
 (`!s t. compact s /\ compact t ==> compact (s UNION t)`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_UNION; CLOSED_UNION]);;

let COMPACT_INTER = prove
 (`!s t. compact s /\ compact t ==> compact (s INTER t)`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; CLOSED_INTER]);;

let COMPACT_INTER_CLOSED = prove
 (`!s t. compact s /\ closed t ==> compact (s INTER t)`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER] THEN
  MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);;

let CLOSED_INTER_COMPACT = prove
 (`!s t. closed s /\ compact t ==> compact (s INTER t)`,
  MESON_TAC[COMPACT_INTER_CLOSED; INTER_COMM]);;

let COMPACT_INTERS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> compact s) /\ ~(f = {})
        ==> compact(INTERS f)`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTERS] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_INTERS THEN ASM SET_TAC[]);;

let FINITE_IMP_CLOSED = prove
 (`!s. FINITE s ==> closed s`,
  MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED; INFINITE; FINITE_SUBSET]);;

let FINITE_IMP_CLOSED_IN = prove
 (`!s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s`,
  SIMP_TAC[CLOSED_SUBSET_EQ; FINITE_IMP_CLOSED]);;

let FINITE_IMP_COMPACT = prove
 (`!s. FINITE s ==> compact s`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; FINITE_IMP_CLOSED; FINITE_IMP_BOUNDED]);;

let COMPACT_SING = prove
 (`!a. compact {a}`,
  SIMP_TAC[FINITE_IMP_COMPACT; FINITE_RULES]);;

let COMPACT_INSERT = prove
 (`!a s. compact s ==> compact(a INSERT s)`,
  ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
  SIMP_TAC[COMPACT_UNION; COMPACT_SING]);;

let CLOSURE_SING = prove
 (`!x:real^N. closure {x} = {x}`,
  SIMP_TAC[CLOSURE_CLOSED; CLOSED_SING]);;

let CLOSURE_INSERT = prove
 (`!s a:real^N. closure(a INSERT s) = a INSERT closure s`,
  ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
  REWRITE_TAC[CLOSURE_UNION; CLOSURE_SING]);;

let CLOSURE_DELETE = prove
 (`!s a:real^N.
        closure(s DELETE a) =
        if a limit_point_of s then closure s else closure s DELETE a`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[closure; EXTENSION; IN_UNION; IN_DELETE; IN_ELIM_THM] THEN
  REWRITE_TAC[LIMPT_DELETE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  ASM SET_TAC[]);;

let CLOSED_INSERT = prove
 (`!a s. closed s ==> closed(a INSERT s)`,
  ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
  SIMP_TAC[CLOSED_UNION; CLOSED_SING]);;

let CONNECTED_2 = prove
 (`!a b:real^N. connected {a,b} <=> a = b`,
  REPEAT GEN_TAC THEN SIMP_TAC[CONNECTED_INSERT; CONNECTED_SING] THEN
  REWRITE_TAC[CLOSURE_SING] THEN SET_TAC[]);;

let COMPACT_CBALL = prove
 (`!x e. compact(cball(x,e))`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_CBALL; CLOSED_CBALL]);;

let COMPACT_FRONTIER_BOUNDED = prove
 (`!s. bounded s ==> compact(frontier s)`,
  SIMP_TAC[frontier; COMPACT_EQ_BOUNDED_CLOSED;
           CLOSED_DIFF; OPEN_INTERIOR; CLOSED_CLOSURE] THEN
  MESON_TAC[SUBSET_DIFF; BOUNDED_SUBSET; BOUNDED_CLOSURE]);;

let COMPACT_FRONTIER = prove
 (`!s. compact s ==> compact (frontier s)`,
  MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_FRONTIER_BOUNDED]);;

let BOUNDED_FRONTIER = prove
 (`!s:real^N->bool. bounded s ==> bounded(frontier s)`,
  MESON_TAC[COMPACT_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);;

let FRONTIER_SUBSET_COMPACT = prove
 (`!s. compact s ==> frontier s SUBSET s`,
  MESON_TAC[FRONTIER_SUBSET_CLOSED; COMPACT_EQ_BOUNDED_CLOSED]);;

let OPEN_DELETE = prove
 (`!s x. open s ==> open(s DELETE x)`,
  let lemma = prove(`s DELETE x = s DIFF {x}`,SET_TAC[]) in
  SIMP_TAC[lemma; OPEN_DIFF; CLOSED_SING]);;

let OPEN_IN_DELETE = prove
 (`!u s a:real^N.
        open_in (subtopology euclidean u) s
        ==> open_in (subtopology euclidean u) (s DELETE a)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL
   [ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
    MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[];
    ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]]);;

let CLOSED_INTERS_COMPACT = prove
 (`!s:real^N->bool.
        closed s <=> !e. compact(cball(vec 0,e) INTER s)`,
  GEN_TAC THEN EQ_TAC THENL
   [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_CBALL;
             BOUNDED_INTER; BOUNDED_CBALL];
    ALL_TAC] THEN
  STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `norm(x:real^N) + &1`) THEN
  DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
  REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
  REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &2)`) THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
  X_GEN_TAC `y:real^N` THEN SIMP_TAC[IN_INTER; IN_CBALL] THEN NORM_ARITH_TAC);;

let COMPACT_UNIONS = prove
 (`!s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(UNIONS s)`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_UNIONS; BOUNDED_UNIONS]);;

let COMPACT_DIFF = prove
 (`!s t. compact s /\ open t ==> compact(s DIFF t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
  SIMP_TAC[COMPACT_INTER_CLOSED; GSYM OPEN_CLOSED]);;

let COMPACT_SPHERE = prove
 (`!a:real^N r. compact(sphere(a,r))`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN
  REWRITE_TAC[COMPACT_CBALL]);;

let BOUNDED_SPHERE = prove
 (`!a:real^N r. bounded(sphere(a,r))`,
  SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_BOUNDED]);;

let CLOSED_SPHERE = prove
 (`!a r. closed(sphere(a,r))`,
  SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED]);;

let CLOSURE_SPHERE = prove
 (`!a:real^N r. closure(sphere(a,r)) = sphere(a,r)`,
  REWRITE_TAC[CLOSURE_EQ; CLOSED_SPHERE]);;

let FRONTIER_SPHERE = prove
 (`!a:real^N r. frontier(sphere(a,r)) = sphere(a,r)`,
  REWRITE_TAC[frontier; CLOSURE_SPHERE; INTERIOR_SPHERE; DIFF_EMPTY]);;

let FRONTIER_SING = prove
 (`!a:real^N. frontier {a} = {a}`,
  REWRITE_TAC[frontier; CLOSURE_SING; INTERIOR_SING; DIFF_EMPTY]);;

let COMPACT_OPEN = prove
 (`!s:real^N->bool. compact s /\ open s <=> s = {}`,
  MESON_TAC[COMPACT_EMPTY; OPEN_EMPTY; COMPACT_IMP_CLOSED; CLOPEN;
            COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Finite intersection property. I could make it an equivalence in fact.     *)
(* ------------------------------------------------------------------------- *)

let COMPACT_IMP_FIP = prove
 (`!s:real^N->bool f.
        compact s /\
        (!t. t IN f ==> closed t) /\
        (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {}))
        ==> ~(s INTER (INTERS f) = {})`,
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN; COMPACT_IN_FIP] THEN
  REWRITE_TAC[CLOSED_IN_EUCLIDEAN] THEN MESON_TAC[]);;

let CLOSED_IMP_FIP = prove
 (`!s:real^N->bool f.
        closed s /\
        (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\
        (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {}))
        ==> ~(s INTER (INTERS f) = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
   `~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})`) THEN
  MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[CLOSED_INTER_COMPACT; COMPACT_EQ_BOUNDED_CLOSED];
    REWRITE_TAC[INTER_ASSOC] THEN ONCE_REWRITE_TAC[GSYM INTERS_INSERT]] THEN
  GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC[FINITE_INSERT; INSERT_SUBSET]);;

let CLOSED_IMP_FIP_COMPACT = prove
 (`!s:real^N->bool f.
        closed s /\ (!t. t IN f ==> compact t) /\
        (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {}))
        ==> ~(s INTER (INTERS f) = {})`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
  ASM_SIMP_TAC[SUBSET_EMPTY; INTERS_0; INTER_UNIV] THENL
   [MESON_TAC[FINITE_EMPTY]; ALL_TAC] THEN
  STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN
  ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; MEMBER_NOT_EMPTY]);;

let CLOSED_FIP = prove
 (`!f. (!t:real^N->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\
       (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {}))
       ==> ~(INTERS f = {})`,
  GEN_TAC THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN
  MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);;

let COMPACT_FIP = prove
 (`!f. (!t:real^N->bool. t IN f ==> compact t) /\
       (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {}))
       ==> ~(INTERS f = {})`,
  GEN_TAC THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN
  MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN
  ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Bounded closed nest property (proof does not use Heine-Borel).            *)
(* ------------------------------------------------------------------------- *)

let BOUNDED_CLOSED_NEST = prove
 (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
       (!m n. m <= n ==> s(n) SUBSET s(m)) /\
       bounded(s 0)
       ==> ?a:real^N. !n:num. a IN s(n)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPEC
   `submetric euclidean_metric ((s:num->real^N->bool) 0)`
   COMPACT_SPACE_NEST) THEN
  ASM_REWRITE_TAC[COMPACT_SPACE_EUCLIDEAN_SUBTOPOLOGY; MTOPOLOGY_SUBMETRIC;
                  MTOPOLOGY_EUCLIDEAN_METRIC; COMPACT_EQ_BOUNDED_CLOSED] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  ASM_SIMP_TAC[CLOSED_SUBSET; LE_0] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Decreasing case does not even need compactness, just completeness.        *)
(* ------------------------------------------------------------------------- *)

let DECREASING_CLOSED_NEST = prove
 (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
       (!m n. m <= n ==> s(n) SUBSET s(m)) /\
       (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e)
       ==> ?a:real^N. !n:num. a IN s(n)`,
  GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2
     (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `?l:real^N. (a --> l) sequentially` MP_TAC THENL
   [ASM_MESON_TAC[cauchy; GE; SUBSET; LE_TRANS; LE_REFL;
                  complete; COMPLETE_UNIV; IN_UNIV];
    ASM_MESON_TAC[LIM_SEQUENTIALLY; CLOSED_APPROACHABLE;
                  SUBSET; LE_REFL; LE_TRANS; LE_CASES]]);;

(* ------------------------------------------------------------------------- *)
(* Strengthen it to the intersection actually being a singleton.             *)
(* ------------------------------------------------------------------------- *)

let DECREASING_CLOSED_NEST_SING = prove
 (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
       (!m n. m <= n ==> s(n) SUBSET s(m)) /\
       (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e)
       ==> ?a:real^N. INTERS {t | ?n:num. t = s n} = {a}`,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
  DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERS; IN_SING; IN_ELIM_THM] THEN
  ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL; SUBSET; LE_CASES]);;

(* ------------------------------------------------------------------------- *)
(* A version for a more general chain, not indexed by N.                     *)
(* ------------------------------------------------------------------------- *)

let BOUNDED_CLOSED_CHAIN = prove
 (`!f b:real^N->bool.
        (!s. s IN f ==> closed s /\ ~(s = {})) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\
         b IN f /\ bounded b
         ==> ~(INTERS f = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN `~(b INTER (INTERS f):real^N->bool = {})` MP_TAC THENL
   [ALL_TAC; SET_TAC[]] THEN
  MATCH_MP_TAC COMPACT_IMP_FIP THEN
  ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
  X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN
  SUBGOAL_THEN `?s:real^N->bool. s IN f /\ !t. t IN u ==> s SUBSET t`
  MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  UNDISCH_TAC `(u:(real^N->bool)->bool) SUBSET f` THEN
  UNDISCH_TAC `FINITE(u:(real^N->bool)->bool)` THEN
  SPEC_TAC(`u:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:(real^N->bool)->bool`] THEN
  REWRITE_TAC[INSERT_SUBSET] THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Analogous things directly for compactness.                                *)
(* ------------------------------------------------------------------------- *)

let COMPACT_CHAIN = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> compact s /\ ~(s = {})) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ~(INTERS f = {})`,
  GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN
  ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
   [ASM_REWRITE_TAC[INTERS_0] THEN SET_TAC[];
    MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM SET_TAC[]]);;

let COMPACT_NEST = prove
 (`!s. (!n. compact(s n) /\ ~(s n = {})) /\
       (!m n. m <= n ==> s n SUBSET s m)
       ==> ~(INTERS {s n | n IN (:num)} = {})`,
  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Relating convergent subsequences to escaping from a compact set.          *)
(* ------------------------------------------------------------------------- *)

let SEQUENCE_ESCAPES = prove
 (`!s x:num->real^N.
      (!n. x n IN s)
      ==> ((!k. k SUBSET s /\ compact k ==> FINITE {n | x n IN k}) <=>
           ~(?y r. y IN s /\
                  (!m n. m < n ==> r m < r n) /\
                  (x o r --> y) sequentially))`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[TAUT `(p <=> ~q) <=> (~p <=> q)`] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN EQ_TAC THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INFINITE]) THEN
    DISCH_THEN(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN
    DISCH_THEN(MP_TAC o SPEC `(x:num->real^N) o (r:num->num)`) THEN
    REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(r:num->num) o (q:num->num)` THEN
    ASM_SIMP_TAC[o_ASSOC; o_THM] THEN ASM SET_TAC[];
    MAP_EVERY X_GEN_TAC [`y:real^N`; `r:num->num`] THEN STRIP_TAC THEN
    EXISTS_TAC `y INSERT (IMAGE ((x:num->real^N) o r) (:num))` THEN
    ASM_SIMP_TAC[COMPACT_SEQUENCE_WITH_LIMIT; INSERT_SUBSET; IMAGE_o] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
    DISCH_THEN(MP_TAC o SPEC `IMAGE (r:num->num) (:num)`) THEN
    REWRITE_TAC[num_FINITE; NOT_IMP; FORALL_IN_IMAGE; IN_UNIV] THEN
    CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n + 1`)) THEN
    MATCH_MP_TAC(ARITH_RULE `n + 1 <= x ==> x <= n ==> F`) THEN
    ASM_MESON_TAC[MONOTONE_BIGGER]]);;

let SEQUENCE_ESCAPES_ALT = prove
 (`!s x:num->real^N.
      (!n. x n IN s)
      ==> ((!k. k SUBSET s /\ compact k
                ==> eventually (\n. ~(x n IN k)) sequentially) <=>
           ~(?y r. y IN s /\
                  (!m n. m < n ==> r m < r n) /\
                  (x o r --> y) sequentially))`,
  REWRITE_TAC[EVENTUALLY_IN_SEQUENTIALLY; SEQUENCE_ESCAPES]);;

let CONVERGENT_SUBSEQUENCE = prove
 (`!s x:num->real^N.
      (!n. x n IN s)
      ==> ((?y r. y IN s /\
                  (!m n. m < n ==> r m < r n) /\
                  (x o r --> y) sequentially) <=>
           (?k. k SUBSET s /\ compact k /\ INFINITE {n | x(n) IN k}))`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
    AP_TERM `~` o MATCH_MP SEQUENCE_ESCAPES) THEN
  REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  REWRITE_TAC[NOT_FORALL_THM; INFINITE] THEN
  MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Cauchy-type criteria for *uniform* convergence.                           *)
(* ------------------------------------------------------------------------- *)

let UNIFORMLY_CONVERGENT_EQ_CAUCHY = prove
 (`!P s:num->A->real^N.
         (?l. !e. &0 < e
                  ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=>
         (!e. &0 < e
              ==> ?N. !m n x. N <= m /\ N <= n /\ P x
                              ==> dist(s m x,s n x) < e)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_TAC `l:A->real^N`) THEN X_GEN_TAC `e:real` THEN
    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L];
    ALL_TAC] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN `!x:A. P x ==> cauchy (\n. s n x :real^N)` MP_TAC THENL
   [REWRITE_TAC[cauchy; GE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `l:A->real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `N:num` THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `N + M:num`; `x:A`]) THEN
  ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN
  ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);;

let UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT = prove
 (`!P s:num->A->real^N.
         (?l. !e. &0 < e
                  ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=>
         (!e. &0 < e
              ==> ?N. !m n x. N <= m /\ N <= n /\ m < n /\ P x
                              ==> dist(s m x,s n x) < e)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
  EQ_TAC THEN DISCH_TAC 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 X_GEN_TAC `N:num` THEN DISCH_TAC THEN
  ASM_SIMP_TAC[] THEN MATCH_MP_TAC WLOG_LT THEN
  ASM_SIMP_TAC[DIST_REFL] THEN MESON_TAC[DIST_SYM]);;

let UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT = prove
 (`!P (s:num->A->real^N) l.
    (!e. &0 < e
         ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\
    (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e)
    ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `l':A->real^N`) ASSUME_TAC) THEN
  SUBGOAL_THEN `!x. P x ==> (l:A->real^N) x = l' x` MP_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[]] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
  EXISTS_TAC `\n. (s:num->A->real^N) n x` THEN
  REWRITE_TAC[LIM_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
  ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Define continuity over a net to take in restrictions of the set.          *)
(* ------------------------------------------------------------------------- *)

parse_as_infix ("continuous",(12,"right"));;

let continuous = new_definition
  `f continuous net <=> (f --> f(netlimit net)) net`;;

let CONTINUOUS_TRIVIAL_LIMIT = prove
 (`!f net. trivial_limit net ==> f continuous net`,
  SIMP_TAC[continuous; LIM_TRIVIAL]);;

let CONTINUOUS_WITHIN = prove
 (`!f x:real^M. f continuous (at x within s) <=> (f --> f(x)) (at x within s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN

  ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THEN
  ASM_SIMP_TAC[LIM_TRIVIAL; NETLIMIT_WITHIN]);;

let LIM_CONTINUOUS_SELF_WITHIN = prove
 (`!f:real^M->real^N s x y.
        f continuous (at x within s) /\ f x = y ==> (f --> y) (at x within s)`,
  REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[]);;

let CONTINUOUS_AT = prove
 (`!f (x:real^N). f continuous (at x) <=> (f --> f(x)) (at x)`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[CONTINUOUS_WITHIN; IN_UNIV]);;

let LIM_CONTINUOUS_SELF_AT = prove
 (`!f:real^M->real^N x y.
        f continuous (at x) /\ f x = y ==> (f --> y) (at x)`,
  REWRITE_TAC[CONTINUOUS_AT] THEN MESON_TAC[]);;

let CONTINUOUS_AT_WITHIN = prove
 (`!f:real^M->real^N x s.
        f continuous (at x) ==> f continuous (at x within s)`,
  SIMP_TAC[LIM_AT_WITHIN; CONTINUOUS_AT; CONTINUOUS_WITHIN]);;

let CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL = prove
 (`!a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)`,
  ASM_SIMP_TAC[CONTINUOUS_TRIVIAL_LIMIT; LIM_WITHIN_CLOSED_TRIVIAL]);;

let CONTINUOUS_TRANSFORM_WITHIN = prove
 (`!f g:real^M->real^N s x d.
        &0 < d /\ x IN s /\
        (!x'. x' IN s /\ dist(x',x) < d ==> f(x') = g(x')) /\
        f continuous (at x within s)
        ==> g continuous (at x within s)`,
  REWRITE_TAC[CONTINUOUS_WITHIN] THEN
  MESON_TAC[LIM_TRANSFORM_WITHIN; DIST_REFL]);;

let CONTINUOUS_TRANSFORM_AT = prove
 (`!f g:real^M->real^N x d.
        &0 < d /\ (!x'. dist(x',x) < d ==> f(x') = g(x')) /\
        f continuous (at x)
        ==> g continuous (at x)`,
  REWRITE_TAC[CONTINUOUS_AT] THEN
  MESON_TAC[LIM_TRANSFORM_AT; DIST_REFL]);;

let CONTINUOUS_TRANSFORM_WITHIN_OPEN = prove
 (`!f g:real^M->real^N s a.
        open s /\ a IN s /\
        (!x. x IN s ==> f x = g x) /\
        f continuous at a
        ==> g continuous at a`,
  MESON_TAC[CONTINUOUS_AT; LIM_TRANSFORM_WITHIN_OPEN]);;

let CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN = prove
 (`!f g:real^M->real^N s t a.
        open_in (subtopology euclidean t) s /\ a IN s /\
        (!x. x IN s ==> f x = g x) /\
        f continuous (at a within t)
        ==> g continuous (at a within t)`,
  MESON_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_OPEN_IN]);;

let CONTINUOUS_TRANSFORM_WITHIN_SET_IMP = prove
 (`!f a s t. eventually (\x. x IN t ==> x IN s) (at a) /\
             f continuous (at a within s)
             ==> f continuous (at a within t)`,
  REWRITE_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_SET_IMP]);;

(* ------------------------------------------------------------------------- *)
(* Derive the epsilon-delta forms, which we often use as "definitions"       *)
(* ------------------------------------------------------------------------- *)

let continuous_within = prove
 (`f continuous (at x within s) <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`,
  REWRITE_TAC[CONTINUOUS_WITHIN; LIM_WITHIN] THEN
  REWRITE_TAC[GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]);;

let continuous_at = prove
 (`f continuous (at x) <=>
        !e. &0 < e ==> ?d. &0 < d /\
                           !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[continuous_within; IN_UNIV]);;

let CONTINUOUS_WITHIN_COMPARISON = prove
 (`!f:real^M->real^N g:real^M->real^P s a.
        g continuous (at a within s) /\
        (!x. x IN s ==> dist(f a,f x) <= dist(g a,g x))
        ==> f continuous (at a within s)`,
  ONCE_REWRITE_TAC[DIST_SYM] THEN
  REWRITE_TAC[continuous_within] THEN MESON_TAC[REAL_LET_TRANS]);;

let CONTINUOUS_EQ_CAUCHY_WITHIN = prove
 (`!f:real^M->real^N s a.
        f continuous (at a within s) <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !x x'. x IN a INSERT s /\ dist(x,a) < d /\
                           x' IN a INSERT s /\ dist(x',a) < d
                           ==> dist(f x,f x') < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; IN_INSERT] THEN
  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[DIST_REFL]] THEN
  FIRST_X_ASSUM(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 MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL] THEN
  ASM_SIMP_TAC[NORM_ARITH `dist(x:real^N,a) < e / &2 ==> dist(a,x) < e`] THEN
  ASM_SIMP_TAC[NORM_ARITH `dist(x:real^N,a) < e / &2 ==> dist(x,a) < e`] THEN
  ASM_MESON_TAC[NORM_ARITH
   `dist(x:real^N,a) < e / &2 /\ dist(y,a) < e / &2 ==> dist(x,y) < e`]);;

let CONTINUOUS_EQ_CAUCHY_AT = prove
 (`!f:real^M->real^N a.
        f continuous (at a) <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !x x'. dist(x,a) < d /\ dist(x',a) < d
                           ==> dist(f x,f x') < e`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[CONTINUOUS_EQ_CAUCHY_WITHIN; IN_INSERT; IN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Versions in terms of open balls.                                          *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_WITHIN_BALL = prove
 (`!f s x. f continuous (at x within s) <=>
                !e. &0 < e
                    ==> ?d. &0 < d /\
                            IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)`,
  SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_within; IN_INTER] THEN
  MESON_TAC[DIST_SYM]);;

let CONTINUOUS_AT_BALL = prove
 (`!f x. f continuous (at x) <=>
                !e. &0 < e
                    ==> ?d. &0 < d /\
                            IMAGE f (ball(x,d)) SUBSET ball(f x,e)`,
  SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_at] THEN
  MESON_TAC[DIST_SYM]);;

(* ------------------------------------------------------------------------- *)
(* For setwise continuity, just start from the epsilon-delta definitions.    *)
(* ------------------------------------------------------------------------- *)

parse_as_infix ("continuous_on",(12,"right"));;
parse_as_infix ("uniformly_continuous_on",(12,"right"));;

let continuous_on = new_definition
  `f continuous_on s <=>
        !x. x IN s ==> !e. &0 < e
                           ==> ?d. &0 < d /\
                                   !x'. x' IN s /\ dist(x',x) < d
                                        ==> dist(f(x'),f(x)) < e`;;

let uniformly_continuous_on = new_definition
  `f uniformly_continuous_on s <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !x x'. x IN s /\ x' IN s /\ dist(x',x) < d
                           ==> dist(f(x'),f(x)) < e`;;

let CONTINUOUS_MAP_EUCLIDEAN = prove
 (`!f:real^N->real^M s.
     continuous_map (subtopology euclidean s,euclidean) f <=>
     f continuous_on s`,
  REWRITE_TAC[GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC;
              GSYM  MTOPOLOGY_EUCLIDEAN_METRIC;
              GSYM MTOPOLOGY_SUBMETRIC] THEN
  REWRITE_TAC[METRIC_CONTINUOUS_MAP; continuous_on] THEN
  REWRITE_TAC[SUBMETRIC; EUCLIDEAN_METRIC; IN_UNIV; IN_INTER] THEN
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN
  MESON_TAC[]);;

let CONTINUOUS_MAP_EUCLIDEAN_EUCLIDEAN = prove
 (`!(f:real^M->real^N).
        continuous_map (euclidean,euclidean) f <=> f continuous_on (:real^M)`,
  MESON_TAC[SUBTOPOLOGY_UNIV; CONTINUOUS_MAP_EUCLIDEAN; SUBSET_UNIV]);;

let CONTINUOUS_MAP_EUCLIDEAN2 = prove
 (`!(f:real^M->real^N) s t.
        continuous_map (subtopology euclidean s,subtopology euclidean t) f <=>
        f continuous_on s /\ IMAGE f s SUBSET t`,
  REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY; CONTINUOUS_MAP_EUCLIDEAN] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let UNIFORMLY_CONTINUOUS_MAP_EUCLIDEAN = prove
 (`!f:real^N->real^M s.
     uniformly_continuous_map
      (submetric euclidean_metric s,euclidean_metric) f <=>
     f uniformly_continuous_on s`,
  REWRITE_TAC[uniformly_continuous_map; uniformly_continuous_on] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; SUBMETRIC; INTER_UNIV; SUBSET_UNIV]);;

let UNIFORMLY_CONTINUOUS_MAP_LIFT = prove
 (`uniformly_continuous_map (real_euclidean_metric,euclidean_metric) lift`,
  REWRITE_TAC[uniformly_continuous_map; REAL_EUCLIDEAN_METRIC;
              EUCLIDEAN_METRIC; IN_UNIV; SUBSET_UNIV; DIST_LIFT] THEN
  MESON_TAC[REAL_ABS_SUB]);;

let UNIFORMLY_CONTINUOUS_MAP_DROP = prove
 (`uniformly_continuous_map (euclidean_metric,real_euclidean_metric) drop`,
  REWRITE_TAC[uniformly_continuous_map; REAL_EUCLIDEAN_METRIC;
              EUCLIDEAN_METRIC; IN_UNIV; SUBSET_UNIV] THEN
  REWRITE_TAC[GSYM DROP_SUB; GSYM NORM_1; dist] THEN
  MESON_TAC[NORM_SUB]);;

let UNIFORMLY_CONTINUOUS_MAP_EQ_LIFT = prove
 (`!m f:A->real.
        uniformly_continuous_map(m,real_euclidean_metric) f <=>
        uniformly_continuous_map(m,euclidean_metric) (lift o f)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [MESON_TAC[UNIFORMLY_CONTINUOUS_MAP_COMPOSE; UNIFORMLY_CONTINUOUS_MAP_LIFT];
    DISCH_TAC] THEN
  SUBGOAL_THEN `f:A->real = drop o lift o f` SUBST1_TAC THENL
   [REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX];
    ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_MAP_COMPOSE;
                  UNIFORMLY_CONTINUOUS_MAP_DROP]]);;

let UNIFORMLY_CONTINUOUS_MAP_EQ_DROP = prove
 (`!m f:A->real^1.
        uniformly_continuous_map(m,euclidean_metric) f <=>
        uniformly_continuous_map(m,real_euclidean_metric) (drop o f)`,
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_MAP_EQ_LIFT; o_DEF; LIFT_DROP; ETA_AX]);;

let UNIFORMLY_CONTINUOUS_MAP_LIFT_EQ = prove
 (`!m f:real^1->A.
        uniformly_continuous_map(euclidean_metric,m) f <=>
        uniformly_continuous_map(real_euclidean_metric,m) (f o lift)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [MESON_TAC[UNIFORMLY_CONTINUOUS_MAP_COMPOSE; UNIFORMLY_CONTINUOUS_MAP_LIFT];
    DISCH_TAC] THEN
  SUBGOAL_THEN `f:real^1->A = (f o lift) o drop` SUBST1_TAC THENL
   [REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX];
    ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_MAP_COMPOSE;
                  UNIFORMLY_CONTINUOUS_MAP_DROP]]);;

let UNIFORMLY_CONTINUOUS_MAP_DROP_EQ = prove
 (`!m f:real->A.
        uniformly_continuous_map(real_euclidean_metric,m) f <=>
        uniformly_continuous_map(euclidean_metric,m) (f o drop)`,
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_MAP_LIFT_EQ; o_DEF; LIFT_DROP; ETA_AX]);;

(* ------------------------------------------------------------------------- *)
(* Some simple consequential lemmas.                                         *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_COMPARISON = prove
 (`!f:real^M->real^N g:real^M->real^P s.
        g continuous_on s /\
        (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(g x,g y))
        ==> f continuous_on s`,
  REWRITE_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);;

let UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS = prove
 (`!f s. f uniformly_continuous_on s ==> f continuous_on s`,
  REWRITE_TAC[uniformly_continuous_on; continuous_on] THEN MESON_TAC[]);;

let CONTINUOUS_AT_IMP_CONTINUOUS_ON = prove
 (`!f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s`,
  REWRITE_TAC[continuous_at; continuous_on] THEN MESON_TAC[]);;

let CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove
 (`!f s. f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)`,
  REWRITE_TAC[continuous_on; continuous_within]);;

let CONTINUOUS_ON = prove
 (`!f (s:real^N->bool).
        f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN]);;

let CONTINUOUS_ON_EQ_CONTINUOUS_AT = prove
 (`!f:real^M->real^N s.
      open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))`,
  SIMP_TAC[CONTINUOUS_ON; CONTINUOUS_AT; LIM_WITHIN_OPEN]);;

let CONTINUOUS_WITHIN_OPEN_IN = prove
 (`!f:real^M->real^N a s t.
        a IN t /\ open_in (subtopology euclidean s) t
        ==> (f continuous (at a within t) <=> f continuous (at a within s))`,
  REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_OPEN_IN]);;

let CONTINUOUS_WITHIN_SUBSET = prove
 (`!f s t x. f continuous (at x within s) /\ t SUBSET s
             ==> f continuous (at x within t)`,
   REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]);;

let CONTINUOUS_ON_SUBSET = prove
 (`!f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t`,
  REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);;

let UNIFORMLY_CONTINUOUS_ON_SUBSET = prove
 (`!f s t. f uniformly_continuous_on s /\ t SUBSET s
           ==> f uniformly_continuous_on t`,
  REWRITE_TAC[uniformly_continuous_on] THEN
  MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);;

let CONTINUOUS_ON_INTERIOR = prove
 (`!f:real^M->real^N s x.
        f continuous_on s /\ x IN interior(s) ==> f continuous at x`,
  REWRITE_TAC[interior; IN_ELIM_THM] THEN
  MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; CONTINUOUS_ON_SUBSET]);;

let CONTINUOUS_ON_EQ = prove
 (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f continuous_on s
           ==> g continuous_on s`,
  SIMP_TAC[continuous_on; IMP_CONJ]);;

let UNIFORMLY_CONTINUOUS_ON_EQ = prove
 (`!f g s.
        (!x. x IN s ==> f x = g x) /\ f uniformly_continuous_on s
        ==> g uniformly_continuous_on s`,
  SIMP_TAC[uniformly_continuous_on; IMP_CONJ]);;

let CONTINUOUS_ON_RESTRICT = prove
 (`!P f g:real^M->real^N s.
        (!x. x IN s ==> P x)
        ==> ((\x. if P x then f x else g x) continuous_on s <=>
             f continuous_on s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
  ASM_MESON_TAC[]);;

let UNIFORMLY_CONTINUOUS_ON_RESTRICT = prove
 (`!P f g:real^M->real^N s.
        (!x. x IN s ==> P x)
        ==> ((\x. if P x then f x else g x) uniformly_continuous_on s <=>
             f uniformly_continuous_on s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_EQ) THEN
  ASM_MESON_TAC[]);;

let CONTINUOUS_ON_SING = prove
 (`!f:real^M->real^N a. f continuous_on {a}`,
  SIMP_TAC[continuous_on; IN_SING; FORALL_UNWIND_THM2; DIST_REFL] THEN
  MESON_TAC[]);;

let CONTINUOUS_ON_EMPTY = prove
 (`!f:real^M->real^N. f continuous_on {}`,
  MESON_TAC[CONTINUOUS_ON_SING; EMPTY_SUBSET; CONTINUOUS_ON_SUBSET]);;

let CONTINUOUS_ON_NO_LIMPT = prove
 (`!f:real^M->real^N s.
     ~(?x. x limit_point_of s) ==> f continuous_on s`,
  REWRITE_TAC[continuous_on; LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]);;

let CONTINUOUS_ON_FINITE = prove
 (`!f:real^M->real^N s. FINITE s ==> f continuous_on s`,
  MESON_TAC[CONTINUOUS_ON_NO_LIMPT; LIMIT_POINT_FINITE]);;

let CONTRACTION_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N.
        (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y))
        ==> f continuous_on s`,
  SIMP_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);;

let ISOMETRY_ON_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N.
        (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y))
        ==> f continuous_on s`,
  SIMP_TAC[CONTRACTION_IMP_CONTINUOUS_ON; REAL_LE_REFL]);;

(* ------------------------------------------------------------------------- *)
(* Characterization of limits and continuity in terms of sequences.          *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_WITHIN_SEQUENTIALLY = prove
 (`!f s a:real^N.
        f continuous (at a within s) <=>
                !x. (!n. x(n) IN s) /\ (x --> a) sequentially
                     ==> ((f o x) --> f(a)) sequentially`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL
   [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN
  SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH;
       REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN
  X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
  STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN
  CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
  X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN
  DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
  EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN
  ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`;
               REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]);;

let CONTINUOUS_AT_SEQUENTIALLY = prove
 (`!f a:real^N.
        f continuous (at a) <=>
              !x. (x --> a) sequentially
                  ==> ((f o x) --> f(a)) sequentially`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_UNIV]);;

let CONTINUOUS_ON_SEQUENTIALLY = prove
 (`!f s:real^N->bool.
        f continuous_on s <=>
              !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially
                    ==> ((f o x) --> f(a)) sequentially`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
              CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);;

let UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY,
    UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT = (CONJ_PAIR o prove)
 (`(!f:real^M->real^N s.
        f uniformly_continuous_on s <=>
        !x y. (!n. x n IN s) /\ (!n. y n IN s) /\
              ((\n. x n - y n) --> vec 0) sequentially
              ==> ((\n. f(x(n)) - f(y(n))) --> vec 0) sequentially) /\
   (!f:real^M->real^N s.
        f uniformly_continuous_on s <=>
        !e x y. &0 < e /\
                (!n. x n IN s) /\ (!n. y n IN s) /\
                ((\n. x n - y n) --> vec 0) sequentially
                ==> ?n. dist(f(x n),f(y n)) < e)`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(p ==> q) /\ (q ==> r) /\ (r ==> p)
    ==> (p <=> q) /\ (p <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [REWRITE_TAC[uniformly_continuous_on; LIM_SEQUENTIALLY; dist] THEN
    REWRITE_TAC[VECTOR_SUB_RZERO] THEN MESON_TAC[];
    DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`e:real`; `x:num->real^M`; `y:num->real^M`] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`x:num->real^M`; `y:num->real^M`]) THEN
    ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
    DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
    ASM_REWRITE_TAC[NORM_ARITH `dist(x - y:real^N,vec 0) = dist(x,y)`] THEN
    MESON_TAC[LE_REFL];
    REWRITE_TAC[uniformly_continuous_on] THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
    ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> ~r ==> ~p`] THEN
    DISCH_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN
    REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; SKOLEM_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^M` THEN
    REWRITE_TAC[AND_FORALL_THM; REAL_NOT_LT] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
    ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN
    MATCH_MP_TAC FORALL_POS_MONO_1 THEN
    CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
    X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN
    X_GEN_TAC `m:num` THEN DISCH_TAC THEN
    REWRITE_TAC[NORM_ARITH `dist(x - y:real^N,vec 0) = dist(y,x)`] THEN
    TRANS_TAC REAL_LTE_TRANS `inv(&m + &1)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
    REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
    ASM_ARITH_TAC]);;

let LIM_WITHIN_SEQUENTIALLY = prove
 (`!f:real^M->real^N s a l.
        (f --> l) (at a within s) <=>
        !x. (!n. x(n) IN s DELETE a) /\
            (x --> a) sequentially
            ==> ((f o x) --> l) sequentially`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; at] THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  GEN_REWRITE_TAC LAND_CONV [LIMIT_ATPOINTOF_SEQUENTIALLY_WITHIN] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; IN_UNIV; INTER_UNIV]);;

let LIM_WITHIN_SEQUENTIALLY_INJ = prove
 (`!f:real^M->real^N s a l.
        (f --> l) (at a within s) <=>
        !x. (!n. x(n) IN s DELETE a) /\
            (!m n. x m = x n <=> m = n) /\
            (x --> a) sequentially
            ==> ((f o x) --> l) sequentially`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; at] THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  GEN_REWRITE_TAC LAND_CONV [LIMIT_ATPOINTOF_SEQUENTIALLY_WITHIN_INJ] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; IN_UNIV; INTER_UNIV]);;

let LIM_WITHIN_SEQUENTIALLY_DECREASING = prove
 (`!f:real^M->real^N s a l.
        (f --> l) (at a within s) <=>
        !x. (!n. x(n) IN s DELETE a) /\
            (!m n. m < n ==> dist(x n,a) < dist(x m,a)) /\
            (x --> a) sequentially
            ==> ((f o x) --> l) sequentially`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; at] THEN
  REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN GEN_REWRITE_TAC LAND_CONV
   [LIMIT_ATPOINTOF_SEQUENTIALLY_WITHIN_DECREASING] THEN
  REWRITE_TAC[EUCLIDEAN_METRIC; IN_UNIV; INTER_UNIV] THEN
  EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[REAL_LT_REFL]);;

let LIM_AT_SEQUENTIALLY = prove
 (`!f:real^M->real^N a l.
        (f --> l) (at a) <=>
        !x. (!n. ~(x(n) = a)) /\ (x --> a) sequentially
            ==> ((f o x) --> l) sequentially`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[LIM_WITHIN_SEQUENTIALLY; IN_UNIV; IN_DELETE]);;

let CONTINUOUS_WITHIN_SEQUENTIALLY_INJ,
    CONTINUOUS_WITHIN_SEQUENTIALLY_ALT = (CONJ_PAIR o prove)
 (`(!f:real^M->real^N s a.
        f continuous at a within s <=>
        !x. (!n. x n IN s DELETE a) /\
            (!m n. x m = x n <=> m = n) /\
            (x --> a) sequentially
            ==> (f o x --> f a) sequentially) /\
   (!f:real^M->real^N s a.
        (f continuous at a within s) <=>
        !e x. &0 < e /\
              (!n. x n IN s DELETE a) /\
              (x --> a) sequentially /\
              (!m n. x m = x n <=> m = n)
              ==> ?n. dist(f(x n),f a) < e)`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(p ==> q) /\ (q ==> r) /\ (~p ==> ~r)
    ==> (p <=> q) /\ (p <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_DELETE];
    ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:num->real^M` THEN
    DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
    ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
    DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_DEF] THEN
    MESON_TAC[LE_REFL];
    ALL_TAC] THEN
  REWRITE_TAC[continuous_within; IN_DELETE] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM;
              REAL_NOT_LT; TAUT `~(p /\ q) <=> p ==> ~q`] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
   `?x. (!n. x n IN s /\ ~(x n = a) /\ dist(x n,a) < inv(&n + &1) /\
             e <= dist((f:real^M->real^N) (x n),f a)) /\
        (!n. dist(x(SUC n),a) < dist(x n,a))`
  MP_TAC THENL
   [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01];
      MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC
       `min (inv(&(SUC n) + &1)) (dist(x:real^M,a))`)] THEN
    ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; GSYM DIST_NZ;
                    REAL_ARITH `&0 < &n + &1`] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN
      CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
      SUBGOAL_THEN `!m n. m <= n ==> dist((x:num->real^M) n,a) <= dist(x m,a)`
       (fun th -> ASM_MESON_TAC[REAL_LET_TRANS; th]) THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REAL_ARITH_TAC;
      MATCH_MP_TAC WLOG_LT THEN
      SUBGOAL_THEN `!m n. m < n ==> dist((x:num->real^M) n,a) < dist(x m,a)`
       (fun th -> MESON_TAC[th; REAL_LT_REFL]) THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN
      ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]);;

let CONTINUOUS_AT_SEQUENTIALLY_ALT = prove
 (`!f:real^M->real^N a.
        (f continuous at a) <=>
        !e x. &0 < e /\
              (!n. ~(x n = a)) /\
              (x --> a) sequentially /\
              (!m n. x m = x n <=> m = n)
              ==> ?n. dist(f(x n),f a) < e`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_ALT; IN_DELETE; IN_UNIV]);;

let CONTINUOUS_AT_SEQUENTIALLY_INJ = prove
 (`!f:real^M->real^N a.
        f continuous at a <=>
        !x. (!n. ~(x n = a)) /\
            (!m n. x m = x n <=> m = n) /\
            (x --> a) sequentially
            ==> (f o x --> f a) sequentially`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_INJ; IN_DELETE; IN_UNIV]);;

let LIM_CONTINUOUS = prove
 (`!net f:A->real^N l.
        f continuous net /\ f(netlimit net) = l ==> (f --> l) net`,
  MESON_TAC[continuous]);;

let LIM_CONTINUOUS_FUNCTION = prove
 (`!f net g l.
        f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net`,
  REWRITE_TAC[tendsto; continuous_at; eventually] THEN MESON_TAC[]);;

let LIM_CONTINUOUS_FUNCTION_WITHIN = prove
 (`!net f:real^M->real^N g:A->real^M l s.
       f continuous (at l within s) /\
       (g --> l) net /\ eventually (\a. g a IN s) net
       ==> ((\x. f (g x)) --> f l) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; continuous_within] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
   `(!x. P x ==> Q x) /\ R ==> !x. P x ==> Q x /\ R`)) THEN
  REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
  REWRITE_TAC[eventually] THEN ASM_MESON_TAC[]);;

let LIMIT_POINT_OF_IMAGE_GEN = prove
 (`!f:real^M->real^N s u x.
      x limit_point_of s /\
      f continuous (at x within s) /\ open u /\ x IN u /\
      FINITE {z | z IN s INTER u /\ f z =  f x}
      ==> (f x) limit_point_of (IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_SEQUENTIAL_INJ]) THEN
  REWRITE_TAC[IN_DELETE; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `p:num->real^M` THEN STRIP_TAC THEN
  MP_TAC(SPEC `{n:num | p n IN u /\ ~((f:real^M->real^N)(p n) = f x)}`
    INFINITE_ENUMERATE_WEAK) THEN
  REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
   [REWRITE_TAC[SET_RULE
     `{x | P x /\ ~Q x} = {x | P x} DIFF {x | P x /\ Q x}`] THEN
    MATCH_MP_TAC INFINITE_DIFF_FINITE THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE `{x | P x} = UNIV DIFF {x | ~P x}`] THEN
      MATCH_MP_TAC INFINITE_DIFF_FINITE THEN REWRITE_TAC[num_INFINITE] THEN
      FIRST_ASSUM(MP_TAC o SPEC `u:real^M->bool` o
        REWRITE_RULE[TENDSTO_ALT]) THEN
      ASM_REWRITE_TAC[EVENTUALLY_IN_SEQUENTIALLY];
      SUBGOAL_THEN
       `{n:num | p n IN u /\ (f:real^M->real^N)(p n) = f x} =
        {n | p n IN {z | z IN s INTER u /\ f z = f x}}`
      SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC FINITE_FINITE_PREIMAGE THEN ASM_REWRITE_TAC[] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_SING]
       `(?a. s SUBSET {a}) ==> FINITE s`) THEN
      ASM SET_TAC[]];
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
    REWRITE_TAC[LIMPT_SEQUENTIAL] THEN
    EXISTS_TAC `(f:real^M->real^N) o p o (r:num->num)` THEN
    REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_ASSUM(MATCH_MP_TAC o
      REWRITE_RULE[CONTINUOUS_WITHIN_SEQUENTIALLY]) THEN
    ASM_SIMP_TAC[LIM_SUBSEQUENCE; o_THM]]);;

let LIMIT_POINT_OF_IMAGE = prove
 (`!f:real^M->real^N s x.
      x limit_point_of s /\
      f continuous (at x within s) /\
      (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
      ==> (f x) limit_point_of (IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIMIT_POINT_OF_IMAGE_GEN THEN
  EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV] THEN
  MATCH_MP_TAC(MESON[FINITE_SUBSET; FINITE_SING]
   `(?a. s SUBSET {a}) ==> FINITE s`) THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* A continuous function distributes over nested compact intersection.       *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_IMAGE_NESTED_INTERS = prove
 (`!f:real^M->real^N s.
        f continuous_on s 0 /\
        (!n. compact(s n)) /\
        (!n. s(SUC n) SUBSET s n)
        ==> IMAGE f (INTERS {s n | n IN (:num)}) =
            INTERS {IMAGE f (s n) | n IN (:num)}`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^N` THEN
  REWRITE_TAC[INTERS_GSPEC; IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
  EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM]] THEN
  DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` (STRIP_ASSUME_TAC o GSYM)) THEN
  SUBGOAL_THEN `compact(s 0:real^M->bool)` MP_TAC THENL
   [ASM_REWRITE_TAC[]; REWRITE_TAC[compact]] THEN
  DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN
  SUBGOAL_THEN
   `!m n. m <= n ==> (s:num->real^M->bool) n SUBSET s m`
  ASSUME_TAC THENL
   [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `!n. (x:num->real^M) n IN s 0` ASSUME_TAC THENL
   [ASM_MESON_TAC[LE_0; SUBSET]; ALL_TAC] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `z:real^M` THEN
  DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL
   [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
    EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN
    REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
     [ASM_REWRITE_TAC[o_DEF; LIM_CONST]; ALL_TAC] THEN
    FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_SEQUENTIALLY]) THEN
    ASM_REWRITE_TAC[o_THM];
    X_GEN_TAC `n:num` THEN
    SUBGOAL_THEN `closed((s:num->real^M->bool) n)` MP_TAC THENL
     [ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
      REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS]] THEN
    DISCH_THEN MATCH_MP_TAC THEN
    EXISTS_TAC `(x:num->real^M) o (r:num->num) o (\i. n + i)` THEN
    ASM_SIMP_TAC[o_ASSOC; LIM_SUBSEQUENCE; LT_ADD_LCANCEL] THEN
    X_GEN_TAC `m:num` THEN REWRITE_TAC[o_THM] THEN
    MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN
    EXISTS_TAC `(s:num->real^M->bool)(r(n + m:num))` THEN
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC(ARITH_RULE `n + m:num <= r(n + m) ==> n <= r(n + m)`) THEN
    ASM_MESON_TAC[MONOTONE_BIGGER]]);;

let CONTINUOUS_IMAGE_NESTED_INTERS_GEN = prove
 (`!f:real^M->real^N s m.
        f continuous_on s m /\
        (!n. m <= n ==> compact(s n)) /\
        (!n. m <= n ==> s(SUC n) SUBSET s n)
        ==> IMAGE f (INTERS {s n | m <= n}) =
            INTERS {IMAGE f (s n) | m <= n}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `(s:num->real^M->bool) o (\i. m + i)`]
        CONTINUOUS_IMAGE_NESTED_INTERS) THEN
  ASM_SIMP_TAC[o_THM; ADD_CLAUSES; LE_ADD] THEN
  SUBGOAL_THEN
   `!n. m <= n <=> n IN IMAGE (\i. m + i) (:num)`
   (fun th -> REWRITE_TAC[th])
  THENL
   [REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[LE_ADD; LE_EXISTS];
    REWRITE_TAC[INTERS_GSPEC; FORALL_IN_IMAGE]]);;

(* ------------------------------------------------------------------------- *)
(* Combination results for pointwise continuity.                             *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_CONST = prove
 (`!net c. (\x. c) continuous net`,
  REWRITE_TAC[continuous; LIM_CONST]);;

let CONTINUOUS_CMUL = prove
 (`!f c net. f continuous net ==> (\x. c % f(x)) continuous net`,
  REWRITE_TAC[continuous; LIM_CMUL]);;

let CONTINUOUS_NEG = prove
 (`!f net. f continuous net ==> (\x. --(f x)) continuous net`,
  REWRITE_TAC[continuous; LIM_NEG]);;

let CONTINUOUS_ADD = prove
 (`!f g net. f continuous net /\ g continuous net
           ==> (\x. f(x) + g(x)) continuous net`,
  REWRITE_TAC[continuous; LIM_ADD]);;

let CONTINUOUS_SUB = prove
 (`!f g net. f continuous net /\ g continuous net
           ==> (\x. f(x) - g(x)) continuous net`,
  REWRITE_TAC[continuous; LIM_SUB]);;

let CONTINUOUS_ABS = prove
 (`!(f:A->real^N) net.
        f continuous net
        ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous net`,
  REWRITE_TAC[continuous; LIM_ABS]);;

let CONTINUOUS_LIFT_ABS_COMPONENT = prove
 (`!net f:A->real^N k.
     f continuous net ==> (\x. lift(abs(f x$k))) continuous net`,
  REWRITE_TAC[continuous; LIM_LIFT_ABS_COMPONENT]);;

let CONTINUOUS_LIFT_ABS = prove
 (`!net:(A)net f.
    (\x. lift(f x)) continuous net ==> (\x. lift(abs(f x))) continuous net`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ABS) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN
  REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);;

let CONTINUOUS_MAX = prove
 (`!(f:A->real^N) (g:A->real^N) net.
        f continuous net /\ g continuous net
        ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous net`,
  REWRITE_TAC[continuous; LIM_MAX]);;

let CONTINUOUS_MIN = prove
 (`!(f:A->real^N) (g:A->real^N) net.
        f continuous net /\ g continuous net
        ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous net`,
  REWRITE_TAC[continuous; LIM_MIN]);;

let CONTINUOUS_MAX_1 = prove
 (`!net:(A)net f g.
        (\x. lift(f x)) continuous net /\ (\x. lift(g x)) continuous net
        ==> (\x. lift(max (f x) (g x))) continuous net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_MAX) THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
  REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);;

let CONTINUOUS_MIN_1 = prove
 (`!net:(A)net f g.
        (\x. lift(f x)) continuous net /\ (\x. lift(g x)) continuous net
        ==> (\x. lift(min (f x) (g x))) continuous net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_MIN) THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
  REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);;

let CONTINUOUS_VSUM = prove
 (`!net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net)
             ==> (\x. vsum s (\a. f a x)) continuous net`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES;
           CONTINUOUS_CONST; CONTINUOUS_ADD; ETA_AX]);;

let CONTINUOUS_COMPONENTWISE_LIFT = prove
 (`!net f:A->real^N.
        f continuous net <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> (\x. lift((f x)$i)) continuous net`,
  REWRITE_TAC[continuous; GSYM LIM_COMPONENTWISE_LIFT]);;

(* ------------------------------------------------------------------------- *)
(* Same thing for setwise continuity.                                        *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_CONST = prove
 (`!s c. (\x. c) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CONST]);;

let CONTINUOUS_ON_CMUL = prove
 (`!f c s. f continuous_on s ==> (\x. c % f(x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CMUL]);;

let CONTINUOUS_ON_NEG = prove
 (`!f s. f continuous_on s
         ==> (\x. --(f x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_NEG]);;

let CONTINUOUS_ON_ADD = prove
 (`!f g s. f continuous_on s /\ g continuous_on s
           ==> (\x. f(x) + g(x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ADD]);;

let CONTINUOUS_ON_SUB = prove
 (`!f g s. f continuous_on s /\ g continuous_on s
           ==> (\x. f(x) - g(x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SUB]);;

let CONTINUOUS_ON_LIFT_ABS_COMPONENT = prove
 (`!f:real^M->real^N s.
     f continuous_on s ==> (\x. lift(abs(f x$k))) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
           CONTINUOUS_LIFT_ABS_COMPONENT]);;

let CONTINUOUS_ON_LIFT_ABS = prove
 (`!f s:real^N->bool.
     (\x. lift(f x)) continuous_on s ==> (\x. lift(abs(f x))) continuous_on s`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_ABS THEN
  ASM_SIMP_TAC[]);;

let CONTINUOUS_ON_ABS = prove
 (`!f:real^M->real^N s.
        f continuous_on s
        ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ABS]);;

let CONTINUOUS_ON_MAX = prove
 (`!f:real^M->real^N g:real^M->real^N s.
        f continuous_on s /\ g continuous_on s
        ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N)
            continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MAX]);;

let CONTINUOUS_ON_MIN = prove
 (`!f:real^M->real^N g:real^M->real^N s.
        f continuous_on s /\ g continuous_on s
        ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N)
            continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MIN]);;

let CONTINUOUS_ON_MAX_1 = prove
 (`!f:real^N->real g s.
        (\x. lift(f x)) continuous_on s /\ (\x. lift(g x)) continuous_on s
        ==> (\x. lift(max (f x) (g x))) continuous_on s`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
  REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);;

let CONTINUOUS_ON_MIN_1 = prove
 (`!f:real^N->real g s.
        (\x. lift(f x)) continuous_on s /\ (\x. lift(g x)) continuous_on s
        ==> (\x. lift(min (f x) (g x))) continuous_on s`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
  REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);;

let CONTINUOUS_ON_VSUM = prove
 (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t)
             ==> (\x. vsum s (\a. f a x)) continuous_on t`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_VSUM]);;

let CONTINUOUS_ON_COMPONENTWISE_LIFT = prove
 (`!f:real^M->real^N s.
        f continuous_on s <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> (\x. lift((f x)$i)) continuous_on s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [CONTINUOUS_COMPONENTWISE_LIFT] THEN
  MESON_TAC[]);;

let CONTINUOUS_ON_REFLECT = prove
 (`!f:real^M->real^N s.
        (\x. f(--x)) continuous_on (IMAGE (--) s) <=>
        f continuous_on s`,
  REWRITE_TAC[continuous_on; FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMP_CONJ] THEN
  REWRITE_TAC[VECTOR_NEG_NEG; NORM_ARITH `dist(--x:real^N,--y) = dist(x,y)`]);;

(* ------------------------------------------------------------------------- *)
(* Same thing for uniform continuity, using sequential formulations.         *)
(* ------------------------------------------------------------------------- *)

let UNIFORMLY_CONTINUOUS_ON_CONST = prove
 (`!s c. (\x. c) uniformly_continuous_on s`,
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF;
              VECTOR_SUB_REFL; LIM_CONST]);;

let LINEAR_UNIFORMLY_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s. linear f ==> f uniformly_continuous_on s`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[uniformly_continuous_on; dist; GSYM LINEAR_SUB] THEN
  FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
        MATCH_MP LINEAR_BOUNDED_POS) THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN
  ASM_SIMP_TAC[REAL_LT_DIV] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `B * norm(y - x:real^M)` THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[REAL_LT_RDIV_EQ; REAL_MUL_SYM]);;

let UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove
 (`!f g s. f uniformly_continuous_on s /\
           g uniformly_continuous_on (IMAGE f s)
           ==> (g o f) uniformly_continuous_on s`,
  let lemma = prove
   (`(!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=>
     (!x. P x /\ Q (f x) ==> R (f x))`,
    MESON_TAC[]) in
  REPEAT GEN_TAC THEN
  REWRITE_TAC[uniformly_continuous_on; o_THM; IN_IMAGE] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  MATCH_MP_TAC MONO_FORALL THEN
  X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[]);;

let BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove
 (`!f:real^M->real^N g (h:real^N->real^P->real^Q) s.
           f uniformly_continuous_on s /\ g uniformly_continuous_on s /\
           bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s)
           ==> (\x. h (f x) (g x)) uniformly_continuous_on s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `!a b c d. (h:real^N->real^P->real^Q) a b - h c d =
              h (a - c) b + h c (b - d)`
   (fun th -> ONCE_REWRITE_TAC[th])
  THENL
   [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN
    FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN
    VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
    MATCH_MP BILINEAR_BOUNDED_POS) THEN
  UNDISCH_TAC `bounded(IMAGE (g:real^M->real^P) s)` THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
  REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN
  UNDISCH_TAC `(g:real^M->real^P) uniformly_continuous_on s` THEN
  UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on s` THEN
  REWRITE_TAC[uniformly_continuous_on] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B2`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN
  DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B1`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN
  DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`])) THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
   `B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(NORM_ARITH
     `norm(x) <= a /\ norm(y) <= b ==> norm(x + y:real^N) <= a + b`) THEN
    CONJ_TAC THEN
    FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN
    ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE];
    ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN
    ASM_REAL_ARITH_TAC]);;

let UNIFORMLY_CONTINUOUS_ON_MUL = prove
 (`!f g:real^M->real^N s.
        (lift o f) uniformly_continuous_on s /\ g uniformly_continuous_on s /\
        bounded(IMAGE (lift o f) s) /\ bounded(IMAGE g s)
        ==>  (\x. f x % g x) uniformly_continuous_on s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`lift o (f:real^M->real)`; `g:real^M->real^N`;
    `\c (v:real^N). drop c % v`; `s:real^M->bool`]
        BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN
  ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
  REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;

let UNIFORMLY_CONTINUOUS_ON_CMUL = prove
 (`!f c s. f uniformly_continuous_on s
           ==> (\x. c % f(x)) uniformly_continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN
  ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_RZERO]);;

let UNIFORMLY_CONTINUOUS_ON_VMUL = prove
 (`!s:real^M->bool c v:real^N.
      (lift o c) uniformly_continuous_on s
      ==> (\x. c x % v) uniformly_continuous_on s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o ISPEC `\x. (drop x % v:real^N)` o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN
  REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
  MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN
  MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);;

let UNIFORMLY_CONTINUOUS_ON_NEG = prove
 (`!f s. f uniformly_continuous_on s
         ==> (\x. --(f x)) uniformly_continuous_on s`,
  ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]);;

let UNIFORMLY_CONTINUOUS_ON_ADD = prove
 (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s
           ==> (\x. f(x) + g(x)) uniformly_continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN
  REWRITE_TAC[AND_FORALL_THM] THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
  MATCH_MP_TAC EQ_IMP THEN
  REWRITE_TAC[VECTOR_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;

let UNIFORMLY_CONTINUOUS_ON_SUB = prove
 (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s
           ==> (\x. f(x) - g(x)) uniformly_continuous_on s`,
  REWRITE_TAC[VECTOR_SUB] THEN
  SIMP_TAC[UNIFORMLY_CONTINUOUS_ON_NEG; UNIFORMLY_CONTINUOUS_ON_ADD]);;

let UNIFORMLY_CONTINUOUS_ON_VSUM = prove
 (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t)
             ==> (\x. vsum s (\a. f a x)) uniformly_continuous_on t`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES;
       UNIFORMLY_CONTINUOUS_ON_CONST; UNIFORMLY_CONTINUOUS_ON_ADD; ETA_AX]);;

let UNIFORMLY_CONTINUOUS_ON_SQRT = prove
 (`!f:real^N->real s.
        (lift o f) uniformly_continuous_on s
        ==> (\x. lift(sqrt(f x))) uniformly_continuous_on s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[GSYM UNIFORMLY_CONTINUOUS_MAP_EUCLIDEAN] THEN
  REWRITE_TAC[GSYM o_DEF; GSYM UNIFORMLY_CONTINUOUS_MAP_EQ_LIFT] THEN
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_MAP_SQRT; o_DEF]);;

(* ------------------------------------------------------------------------- *)
(* Identity function is continuous in every sense.                           *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_WITHIN_ID = prove
 (`!a s. (\x. x) continuous (at a within s)`,
  REWRITE_TAC[continuous_within] THEN MESON_TAC[]);;

let CONTINUOUS_AT_ID = prove
 (`!a. (\x. x) continuous (at a)`,
  REWRITE_TAC[continuous_at] THEN MESON_TAC[]);;

let CONTINUOUS_ON_ID = prove
 (`!s. (\x. x) continuous_on s`,
  REWRITE_TAC[continuous_on] THEN MESON_TAC[]);;

let UNIFORMLY_CONTINUOUS_ON_ID = prove
 (`!s. (\x. x) uniformly_continuous_on s`,
  REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Continuity of all kinds is preserved under composition.                   *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_WITHIN_COMPOSE = prove
 (`!f g x s. f continuous (at x within s) /\
             g continuous (at (f x) within IMAGE f s)
             ==> (g o f) continuous (at x within s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; o_THM; IN_IMAGE] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  ASM_MESON_TAC[]);;

let CONTINUOUS_AT_COMPOSE = prove
 (`!f g x. f continuous (at x) /\ g continuous (at (f x))
           ==> (g o f) continuous (at x)`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  MESON_TAC[CONTINUOUS_WITHIN_COMPOSE; IN_IMAGE; CONTINUOUS_WITHIN_SUBSET;
            SUBSET_UNIV; IN_UNIV]);;

let CONTINUOUS_ON_COMPOSE = prove
 (`!f g s. f continuous_on s /\ g continuous_on (IMAGE f s)
           ==> (g o f) continuous_on s`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  MESON_TAC[IN_IMAGE; CONTINUOUS_WITHIN_COMPOSE]);;

(* ------------------------------------------------------------------------- *)
(* Continuity in terms of open preimages.                                    *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_WITHIN_OPEN = prove
 (`!f:real^M->real^N x u.
     f continuous (at x within u) <=>
        !t. open t /\ f(x) IN t
            ==> ?s. open s /\ x IN s /\
                    !x'. x' IN s /\ x' IN u ==> f(x') IN t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    GEN_REWRITE_TAC LAND_CONV [open_def] THEN
    DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
    ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; DIST_SYM];
    DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN
    ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
    MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);;

let CONTINUOUS_AT_OPEN = prove
 (`!f:real^M->real^N x.
     f continuous (at x) <=>
        !t. open t /\ f(x) IN t
            ==> ?s. open s /\ x IN s /\
                    !x'. x' IN s ==> f(x') IN t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    GEN_REWRITE_TAC LAND_CONV [open_def] THEN
    DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
    ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL];
    DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN
    ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
    MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);;

let CONTINUOUS_ON_OPEN_GEN = prove
 (`!f:real^M->real^N s t.
    IMAGE f s SUBSET t
    ==> (f continuous_on s <=>
         !u. open_in (subtopology euclidean t) u
             ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL
   [REWRITE_TAC[open_in; SUBSET; IN_ELIM_THM] THEN
    DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
    CONJ_TAC THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN
    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM SET_TAC[];
    DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN
    DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o
      SPEC `ball((f:real^M->real^N) x,e) INTER t`) THEN
    ANTS_TAC THENL
     [ASM_MESON_TAC[OPEN_IN_OPEN; INTER_COMM; OPEN_BALL]; ALL_TAC] THEN
    REWRITE_TAC[open_in; SUBSET; IN_INTER; IN_ELIM_THM; IN_BALL; IN_IMAGE] THEN
    REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
    ASM_MESON_TAC[DIST_REFL; DIST_SYM]]);;

let CONTINUOUS_ON_OPEN = prove
 (`!f:real^M->real^N s.
      f continuous_on s <=>
        !t. open_in (subtopology euclidean (IMAGE f s)) t
            ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN
  REWRITE_TAC[SUBSET_REFL]);;

let CONTINUOUS_OPEN_IN_PREIMAGE_GEN = prove
 (`!f:real^M->real^N s t u.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        open_in (subtopology euclidean t) u
        ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`,
  MESON_TAC[CONTINUOUS_ON_OPEN_GEN]);;

let CONTINUOUS_ON_IMP_OPEN_IN = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\
        open_in (subtopology euclidean (IMAGE f s)) t
        ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
  MESON_TAC[CONTINUOUS_ON_OPEN]);;

let CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET = prove
 (`!f:real^M->real^N s t u v.
        f continuous_on s /\
        IMAGE f s SUBSET t /\
        open_in (subtopology euclidean s) u /\
        open_in (subtopology euclidean t) v
        ==> open_in (subtopology euclidean s) {x | x IN u /\ f x IN v}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Similarly in terms of closed sets.                                        *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_CLOSED_GEN = prove
 (`!f:real^M->real^N s t.
    IMAGE f s SUBSET t
    ==> (f continuous_on s <=>
         !u. closed_in (subtopology euclidean t) u
             ==> closed_in (subtopology euclidean s)
                           {x | x IN s /\ f x IN u})`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
    ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
  EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THENL
   [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);;

let CONTINUOUS_ON_CLOSED = prove
 (`!f:real^M->real^N s.
      f continuous_on s <=>
        !t. closed_in (subtopology euclidean (IMAGE f s)) t
            ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN
  REWRITE_TAC[SUBSET_REFL]);;

let CONTINUOUS_CLOSED_IN_PREIMAGE_GEN = prove
 (`!f:real^M->real^N s t u.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        closed_in (subtopology euclidean t) u
        ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`,
  MESON_TAC[CONTINUOUS_ON_CLOSED_GEN]);;

let CONTINUOUS_ON_IMP_CLOSED_IN = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\
        closed_in (subtopology euclidean (IMAGE f s)) t
        ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
  MESON_TAC[CONTINUOUS_ON_CLOSED]);;

let CONTINUOUS_CLOSED_IN_PREIMAGE_SUBSET = prove
 (`!f:real^M->real^N s t u v.
        f continuous_on s /\
        IMAGE f s SUBSET t /\
        closed_in (subtopology euclidean s) u /\
        closed_in (subtopology euclidean t) v
        ==> closed_in (subtopology euclidean s) {x | x IN u /\ f x IN v}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Half-global and completely global cases.                                  *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_OPEN_IN_PREIMAGE = prove
 (`!f s t.
         f continuous_on s /\ open t
         ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
   `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
  ASM_REWRITE_TAC[]);;

let CONTINUOUS_CLOSED_IN_PREIMAGE = prove
 (`!f s t.
         f continuous_on s /\ closed t
         ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
   `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN
  ASM_REWRITE_TAC[]);;

let CONTINUOUS_OPEN_PREIMAGE = prove
 (`!f:real^M->real^N s t.
     f continuous_on s /\ open s /\ open t
     ==> open {x | x IN s /\ f(x) IN t}`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
  REWRITE_TAC [OPEN_IN_OPEN] THEN
  DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN
  ANTS_TAC THENL
   [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC [];
    STRIP_TAC THEN
    SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} =
                 s INTER t'` SUBST1_TAC THENL
    [ASM SET_TAC []; ASM_MESON_TAC [OPEN_INTER]]]);;

let CONTINUOUS_CLOSED_PREIMAGE = prove
 (`!f:real^M->real^N s t.
     f continuous_on s /\ closed s /\ closed t
     ==> closed {x | x IN s /\ f(x) IN t}`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_CLOSED]) THEN
  REWRITE_TAC [CLOSED_IN_CLOSED] THEN
  DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN
  ANTS_TAC THENL
   [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC [];
    STRIP_TAC THEN
    SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} =
                 s INTER t'` SUBST1_TAC THENL
    [ASM SET_TAC []; ASM_MESON_TAC [CLOSED_INTER]]]);;

let CONTINUOUS_OPEN_PREIMAGE_UNIV = prove
 (`!f:real^M->real^N s.
        (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`]
    CONTINUOUS_OPEN_PREIMAGE) THEN
  ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);;

let CONTINUOUS_CLOSED_PREIMAGE_UNIV = prove
 (`!f:real^M->real^N s.
        (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`]
    CONTINUOUS_CLOSED_PREIMAGE) THEN
  ASM_SIMP_TAC[CLOSED_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);;

let CONTINUOUS_OPEN_IN_PREIMAGE_EQ = prove
 (`!f:real^M->real^N s.
    f continuous_on s <=>
    !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_OPEN_IN_PREIMAGE] THEN
  REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN
  X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;

let CONTINUOUS_CLOSED_IN_PREIMAGE_EQ = prove
 (`!f:real^M->real^N s.
    f continuous_on s <=>
    !t. closed t
        ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE] THEN
  REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN
  X_GEN_TAC `t:real^N->bool` THEN
  GEN_REWRITE_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;

let RESTRICTION_CONTINUOUS_ON = prove
 (`!s t f:real^M->real^N.
     s SUBSET t ==> (RESTRICTION t f continuous_on s <=> f continuous_on s)`,
  INTRO_TAC "!s t f; sub" THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
  SUBGOAL_THEN
    `!u. {x:real^M | x IN s /\ RESTRICTION t f x:real^N IN u} =
         {x | x IN s /\ f x IN u}`
    (fun th -> REWRITE_TAC[th]) THEN
  REWRITE_TAC[RESTRICTION] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Linear functions are (uniformly) continuous on any set.                   *)
(* ------------------------------------------------------------------------- *)

let LINEAR_LIM_0 = prove
 (`!f. linear f ==> (f --> vec 0) (at (vec 0))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B` THEN
  ASM_SIMP_TAC[REAL_LT_DIV] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN
  ASM_MESON_TAC[REAL_MUL_SYM; REAL_LET_TRANS; REAL_LT_RDIV_EQ]);;

let LINEAR_CONTINUOUS_AT = prove
 (`!f:real^M->real^N a. linear f ==> f continuous (at a)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `\x. (f:real^M->real^N) (a + x) - f(a)` LINEAR_LIM_0) THEN
  ANTS_TAC THENL
   [POP_ASSUM MP_TAC THEN SIMP_TAC[linear] THEN
    REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[GSYM LIM_NULL; CONTINUOUS_AT] THEN
  GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC[]);;

let LINEAR_CONTINUOUS_WITHIN = prove
 (`!f:real^M->real^N s x. linear f ==> f continuous (at x within s)`,
  SIMP_TAC[CONTINUOUS_AT_WITHIN; LINEAR_CONTINUOUS_AT]);;

let LINEAR_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s. linear f ==> f continuous_on s`,
  MESON_TAC[LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);;

let LINEAR_CONTINUOUS_COMPOSE = prove
 (`!net f:A->real^N g:real^N->real^P.
        f continuous net /\ linear g ==> (\x. g(f x)) continuous net`,
  REWRITE_TAC[continuous; LIM_LINEAR]);;

let LINEAR_CONTINUOUS_ON_COMPOSE = prove
 (`!f:real^M->real^N g:real^N->real^P s.
        f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
           LINEAR_CONTINUOUS_COMPOSE]);;

let CONTINUOUS_LIFT_COMPONENT_COMPOSE = prove
 (`!net f:A->real^N i.
    f continuous net ==> (\x. lift(f x$i)) continuous net`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `linear(\x:real^N. lift (x$i))` MP_TAC THENL
   [REWRITE_TAC[LINEAR_LIFT_COMPONENT]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
  REWRITE_TAC[LINEAR_CONTINUOUS_COMPOSE]);;

let CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE = prove
 (`!f:real^M->real^N s.
        f continuous_on s
        ==> (\x. lift (f x$i)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
           CONTINUOUS_LIFT_COMPONENT_COMPOSE]);;

(* ------------------------------------------------------------------------- *)
(* Also bilinear functions, in composition form.                             *)
(* ------------------------------------------------------------------------- *)

let BILINEAR_CONTINUOUS_COMPOSE = prove
 (`!net f:A->real^M g:A->real^N h:real^M->real^N->real^P.
        f continuous net /\ g continuous net /\ bilinear h
        ==> (\x. h (f x) (g x)) continuous net`,
  REWRITE_TAC[continuous; LIM_BILINEAR]);;

let BILINEAR_CONTINUOUS_ON_COMPOSE = prove
 (`!f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h
             ==> (\x. h (f x) (g x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
           BILINEAR_CONTINUOUS_COMPOSE]);;

let BILINEAR_CONTINUOUS_ON = prove
 (`!bop:real^M->real^N->real^P.
        bilinear bop ==> (\z. bop (fstcart z) (sndcart z)) continuous_on UNIV`,
  SIMP_TAC[BILINEAR_CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON;
           LINEAR_FSTCART; LINEAR_SNDCART]);;

let BILINEAR_DOT = prove
 (`bilinear (\x y:real^N. lift(x dot y))`,
  REWRITE_TAC[bilinear; linear; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN
  REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);;

let CONTINUOUS_LIFT_DOT2 = prove
 (`!net f g:A->real^N.
        f continuous net /\ g continuous net
        ==> (\x. lift(f x dot g x)) continuous net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
  BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);;

let CONTINUOUS_ON_LIFT_DOT2 = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ g continuous_on s
        ==> (\x. lift(f x dot g x)) continuous_on s`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
  BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Preservation of compactness and connectedness under continuous function.  *)
(* ------------------------------------------------------------------------- *)

let COMPACT_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ compact s ==> compact(IMAGE f s)`,
  REWRITE_TAC[GSYM COMPACT_IN_EUCLIDEAN; GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  MESON_TAC[IMAGE_COMPACT_IN; COMPACT_IN_ABSOLUTE]);;

let COMPACT_TRANSLATION = prove
 (`!s a:real^N. compact s ==> compact (IMAGE (\x. a + x) s)`,
  SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_ADD;
           CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;

let COMPACT_TRANSLATION_EQ = prove
 (`!a s. compact (IMAGE (\x:real^N. a + x) s) <=> compact s`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN
  DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP COMPACT_TRANSLATION) THEN
  REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
              VECTOR_ARITH `--a + a + x:real^N = x`]);;

add_translation_invariants [COMPACT_TRANSLATION_EQ];;

let COMPACT_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s. compact s /\ linear f ==> compact(IMAGE f s)`,
  SIMP_TAC[LINEAR_CONTINUOUS_ON; COMPACT_CONTINUOUS_IMAGE]);;

let COMPACT_LINEAR_IMAGE_EQ = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
         ==> (compact (IMAGE f s) <=> compact s)`,
  MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COMPACT_LINEAR_IMAGE));;

add_linear_invariants [COMPACT_LINEAR_IMAGE_EQ];;

let CONNECTED_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ connected s ==> connected(IMAGE f s)`,
  REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN; GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  MESON_TAC[CONNECTED_IN_CONTINUOUS_MAP_IMAGE; CONNECTED_IN_ABSOLUTE]);;

let CONNECTED_TRANSLATION = prove
 (`!a s. connected s ==> connected (IMAGE (\x:real^N. a + x) s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;

let CONNECTED_TRANSLATION_EQ = prove
 (`!a s. connected (IMAGE (\x:real^N. a + x) s) <=> connected s`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN
  DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP CONNECTED_TRANSLATION) THEN
  REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
              VECTOR_ARITH `--a + a + x:real^N = x`]);;

add_translation_invariants [CONNECTED_TRANSLATION_EQ];;

let CONNECTED_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s. connected s /\ linear f ==> connected(IMAGE f s)`,
  SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CONTINUOUS_IMAGE]);;

let CONNECTED_LINEAR_IMAGE_EQ = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
         ==> (connected (IMAGE f s) <=> connected s)`,
  MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONNECTED_LINEAR_IMAGE));;

add_linear_invariants [CONNECTED_LINEAR_IMAGE_EQ];;

(* ------------------------------------------------------------------------- *)
(* Preservation properties for pasted sets (Cartesian products).             *)
(* ------------------------------------------------------------------------- *)

let BOUNDED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        bounded (s PCROSS t) <=>
        s = {} \/ t = {} \/ bounded s /\ bounded t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; BOUNDED_EMPTY] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[bounded; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
  ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS; NORM_PASTECART_LE;
                REAL_LE_ADD2]);;

let BOUNDED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
     bounded s /\ bounded t ==> bounded (s PCROSS t)`,
  SIMP_TAC[BOUNDED_PCROSS_EQ]);;

let CLOSED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        closed (s PCROSS t) <=>
        s = {} \/ t = {} \/ closed s /\ closed t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN MAP_EVERY ASM_CASES_TAC
   [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[NOT_IN_EMPTY; CLOSED_EMPTY; SET_RULE
   `{f x y |x,y| F} = {}`] THEN
  REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; LIM_SEQUENTIALLY] THEN
  REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
  REWRITE_TAC[IN_ELIM_THM; SKOLEM_THM; FORALL_AND_THM] THEN
  ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN
  REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
  SIMP_TAC[TAUT `((p /\ q) /\ r) /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN
  ONCE_REWRITE_TAC[MESON[]
   `(!a b c d e. P a b c d e) <=> (!d e b c a. P a b c d e)`] THEN
  REWRITE_TAC[FORALL_UNWIND_THM2] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL
   [GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
     [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; FORALL_AND_THM] THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM]] THEN
    MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(MESON[]
     `(?x. P x (\n. x)) ==> (?s x. P x s)`) THEN
    ASM_MESON_TAC[DIST_PASTECART_CANCEL];
    ONCE_REWRITE_TAC[MESON[]
     `(!x l. P x l) /\ (!y m. Q y m) <=> (!x y l m. P x l /\ Q y m)`] THEN
    REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
    REWRITE_TAC[dist; PASTECART_SUB] THEN
    ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]]);;

let CLOSED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
     closed s /\ closed t ==> closed (s PCROSS t)`,
  SIMP_TAC[CLOSED_PCROSS_EQ]);;

let COMPACT_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        compact (s PCROSS t) <=>
        s = {} \/ t = {} \/ compact s /\ compact t`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_PCROSS_EQ;
              BOUNDED_PCROSS_EQ] THEN
  MESON_TAC[]);;

let COMPACT_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
     compact s /\ compact t ==> compact (s PCROSS t)`,
  SIMP_TAC[COMPACT_PCROSS_EQ]);;

let OPEN_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        open (s PCROSS t) <=>
        s = {} \/ t = {} \/ open s /\ open t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; OPEN_EMPTY] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
  EQ_TAC THENL
   [REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
    ASM_MESON_TAC[DIST_PASTECART_CANCEL];
    REWRITE_TAC[OPEN_CLOSED] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `UNIV DIFF {pastecart x y | x IN s /\ y IN t} =
      {pastecart x y | x IN ((:real^M) DIFF s) /\ y IN (:real^N)} UNION
      {pastecart x y | x IN (:real^M) /\ y IN ((:real^N) DIFF t)}`
    SUBST1_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; FORALL_PASTECART; IN_UNIV] THEN
      REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART;
                  SNDCART_PASTECART] THEN MESON_TAC[];
      SIMP_TAC[GSYM PCROSS] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN
      MATCH_MP_TAC CLOSED_PCROSS THEN ASM_REWRITE_TAC[CLOSED_UNIV]]]);;

let OPEN_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        open s /\ open t ==> open (s PCROSS t)`,
  SIMP_TAC[OPEN_PCROSS_EQ]);;

let OPEN_IN_PCROSS = prove
 (`!s s':real^M->bool t t':real^N->bool.
        open_in (subtopology euclidean s) s' /\
        open_in (subtopology euclidean t) t'
        ==> open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN
  ASM_SIMP_TAC[OPEN_PCROSS; EXTENSION; FORALL_PASTECART] THEN
  REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);;

let PASTECART_IN_INTERIOR_SUBTOPOLOGY = prove
 (`!s t u x:real^M y:real^N.
     pastecart x y IN u /\ open_in (subtopology euclidean (s PCROSS t)) u
     ==> ?v w. open_in (subtopology euclidean s) v /\ x IN v /\
               open_in (subtopology euclidean t) w /\ y IN w /\
               (v PCROSS w) SUBSET u`,
  REWRITE_TAC[open_in; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^N`]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `ball(x:real^M,e / &2) INTER s` THEN
  EXISTS_TAC `ball(y:real^N,e / &2) INTER t` THEN
  SUBGOAL_THEN `(x:real^M) IN s /\ (y:real^N) IN t` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[SUBSET; PASTECART_IN_PCROSS]; ALL_TAC] THEN
  ASM_SIMP_TAC[INTER_SUBSET; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN
  REWRITE_TAC[IN_BALL] THEN REPEAT(CONJ_TAC THENL
   [MESON_TAC[REAL_SUB_LT; NORM_ARITH
     `dist(x,y) < e /\ dist(z,y) < e - dist(x,y)
      ==> dist(x:real^N,z) < e`];
    ALL_TAC]) THEN
  REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  REWRITE_TAC[IN_BALL; IN_INTER] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN
  W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN
  REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN
  ASM_REAL_ARITH_TAC);;

let PASTECART_IN_INTERIOR = prove
 (`!u x:real^M y:real^N.
     pastecart x y IN u /\ open u
     ==> ?v w. open v /\ x IN v /\ open w /\ y IN w /\ (v PCROSS w) SUBSET u`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[GSYM UNIV_PCROSS_UNIV; PASTECART_IN_INTERIOR_SUBTOPOLOGY]);;

let OPEN_IN_PCROSS_EQ = prove
 (`!s s':real^M->bool t t':real^N->bool.
        open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=>
        s' = {} \/ t' = {} \/
        open_in (subtopology euclidean s) s' /\
        open_in (subtopology euclidean t) t'`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s':real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN
  ASM_CASES_TAC `t':real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[OPEN_IN_PCROSS] THEN REPEAT STRIP_TAC THENL
   [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    UNDISCH_TAC `~(t':real^N->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `y:real^N`);
    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    UNDISCH_TAC `~(s':real^M->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `x:real^M`)] THEN
   MP_TAC(ISPECL
     [`s:real^M->bool`; `t:real^N->bool`;
      `(s':real^M->bool) PCROSS (t':real^N->bool)`;
      `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
  ASM_REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  MESON_TAC[]);;

let INTERIOR_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        interior (s PCROSS t) = (interior s) PCROSS (interior t)`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
    MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`;
         `interior((s:real^M->bool) PCROSS (t:real^N->bool))`;
         `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
    REWRITE_TAC[UNIV_PCROSS_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
    ASM_REWRITE_TAC[OPEN_INTERIOR] THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; SUBSET_TRANS]
      `s SUBSET interior t ==> s SUBSET t`)) THEN
    REWRITE_TAC[SUBSET_PCROSS] THEN
    ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_MAXIMAL; SUBSET];
    MATCH_MP_TAC INTERIOR_MAXIMAL THEN
    SIMP_TAC[OPEN_PCROSS; OPEN_INTERIOR; PCROSS_MONO; INTERIOR_SUBSET]]);;

let LIPSCHITZ_CONTINUOUS_MAP_PASTING = prove
 (`lipschitz_continuous_map
      (prod_metric euclidean_metric euclidean_metric,euclidean_metric)
      (\(x:real^M,y:real^N). pastecart x y)`,
  REWRITE_TAC[lipschitz_continuous_map; PROD_METRIC; EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[CROSS_UNIV; IN_UNIV; SUBSET_UNIV; FORALL_PAIR_THM] THEN
  EXISTS_TAC `&1:real` THEN
  SIMP_TAC[dist; PASTECART_SUB; REAL_MUL_LID; NORM_PASTECART; REAL_LE_REFL]);;

let LIPSCHITZ_CONTINUOUS_MAP_CART_PROJECTIONS = prove
 (`lipschitz_continuous_map (euclidean_metric,euclidean_metric)
                            (fstcart:real^(M,N)finite_sum->real^M) /\
   lipschitz_continuous_map(euclidean_metric,euclidean_metric)
                            (sndcart:real^(M,N)finite_sum->real^N)`,
  REWRITE_TAC[lipschitz_continuous_map; EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[IN_UNIV; SUBSET_UNIV; REAL_MUL_LID] THEN
  CONJ_TAC THEN EXISTS_TAC `&1` THEN
  REWRITE_TAC[REAL_MUL_LID; DIST_FSTCART; DIST_SNDCART]);;

let LIPSCHITZ_CONTINUOUS_MAP_PASTEWISE = prove
 (`!m (f:A->real^(M,N)finite_sum).
        lipschitz_continuous_map(m,euclidean_metric) f <=>
        lipschitz_continuous_map(m,euclidean_metric) (fstcart o f) /\
        lipschitz_continuous_map(m,euclidean_metric) (sndcart o f)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN CONJ_TAC THEN
    MATCH_MP_TAC LIPSCHITZ_CONTINUOUS_MAP_COMPOSE THEN
    ASM_MESON_TAC[LIPSCHITZ_CONTINUOUS_MAP_CART_PROJECTIONS];
    REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `(f:A->real^(M,N)finite_sum) =
      (\(x,y). pastecart x y) o (\a. fstcart(f a),sndcart(f a))`
    SUBST1_TAC THENL
     [REWRITE_TAC[FUN_EQ_THM; o_DEF; PASTECART_FST_SND];
      MATCH_MP_TAC LIPSCHITZ_CONTINUOUS_MAP_COMPOSE THEN EXISTS_TAC
       `prod_metric euclidean_metric euclidean_metric
        :(real^M#real^N)metric` THEN
      REWRITE_TAC[LIPSCHITZ_CONTINUOUS_MAP_PASTING] THEN
      ASM_REWRITE_TAC[LIPSCHITZ_CONTINUOUS_MAP_PAIRWISE; o_DEF]]]);;

let LIPSCHITZ_CONTINUOUS_MAP_PASTED = prove
 (`!m (f:A->real^M) (g:A->real^N).
        lipschitz_continuous_map (m,euclidean_metric)
                                 (\x. pastecart (f x) (g x)) <=>
        lipschitz_continuous_map(m,euclidean_metric) f /\
        lipschitz_continuous_map(m,euclidean_metric) g`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[LIPSCHITZ_CONTINUOUS_MAP_PASTEWISE; o_DEF] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;

let UNIFORMLY_CONTINUOUS_MAP_PASTEWISE = prove
 (`!m (f:A->real^(M,N)finite_sum).
        uniformly_continuous_map(m,euclidean_metric) f <=>
        uniformly_continuous_map(m,euclidean_metric) (fstcart o f) /\
        uniformly_continuous_map(m,euclidean_metric) (sndcart o f)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN CONJ_TAC THEN
    MATCH_MP_TAC UNIFORMLY_CONTINUOUS_MAP_COMPOSE THEN
    ASM_MESON_TAC[LIPSCHITZ_CONTINUOUS_MAP_CART_PROJECTIONS;
                  LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_MAP];
    REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `(f:A->real^(M,N)finite_sum) =
      (\(x,y). pastecart x y) o (\a. fstcart(f a),sndcart(f a))`
    SUBST1_TAC THENL
     [REWRITE_TAC[FUN_EQ_THM; o_DEF; PASTECART_FST_SND];
      MATCH_MP_TAC UNIFORMLY_CONTINUOUS_MAP_COMPOSE THEN EXISTS_TAC
       `prod_metric euclidean_metric euclidean_metric
        :(real^M#real^N)metric` THEN
      SIMP_TAC[LIPSCHITZ_CONTINUOUS_MAP_PASTING;
               LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_MAP] THEN
      ASM_REWRITE_TAC[UNIFORMLY_CONTINUOUS_MAP_PAIRWISE; o_DEF]]]);;

let UNIFORMLY_CONTINUOUS_MAP_PASTED = prove
 (`!m (f:A->real^M) (g:A->real^N).
        uniformly_continuous_map (m,euclidean_metric)
                                 (\x. pastecart (f x) (g x)) <=>
        uniformly_continuous_map(m,euclidean_metric) f /\
        uniformly_continuous_map(m,euclidean_metric) g`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_MAP_PASTEWISE; o_DEF] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;

let CAUCHY_CONTINUOUS_MAP_PASTEWISE = prove
 (`!m (f:A->real^(M,N)finite_sum).
        cauchy_continuous_map(m,euclidean_metric) f <=>
        cauchy_continuous_map(m,euclidean_metric) (fstcart o f) /\
        cauchy_continuous_map(m,euclidean_metric) (sndcart o f)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN CONJ_TAC THEN
    MATCH_MP_TAC CAUCHY_CONTINUOUS_MAP_COMPOSE THEN
    ASM_MESON_TAC[LIPSCHITZ_CONTINUOUS_MAP_CART_PROJECTIONS;
                  LIPSCHITZ_IMP_CAUCHY_CONTINUOUS_MAP];
    REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `(f:A->real^(M,N)finite_sum) =
      (\(x,y). pastecart x y) o (\a. fstcart(f a),sndcart(f a))`
    SUBST1_TAC THENL
     [REWRITE_TAC[FUN_EQ_THM; o_DEF; PASTECART_FST_SND];
      MATCH_MP_TAC CAUCHY_CONTINUOUS_MAP_COMPOSE THEN EXISTS_TAC
       `prod_metric euclidean_metric euclidean_metric
        :(real^M#real^N)metric` THEN
      SIMP_TAC[LIPSCHITZ_CONTINUOUS_MAP_PASTING;
               LIPSCHITZ_IMP_CAUCHY_CONTINUOUS_MAP] THEN
      ASM_REWRITE_TAC[CAUCHY_CONTINUOUS_MAP_PAIRWISE; o_DEF]]]);;

let CAUCHY_CONTINUOUS_MAP_PASTED = prove
 (`!m (f:A->real^M) (g:A->real^N).
        cauchy_continuous_map (m,euclidean_metric)
                                 (\x. pastecart (f x) (g x)) <=>
        cauchy_continuous_map(m,euclidean_metric) f /\
        cauchy_continuous_map(m,euclidean_metric) g`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[CAUCHY_CONTINUOUS_MAP_PASTEWISE; o_DEF] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;

let CONTINUOUS_MAP_PASTEWISE = prove
 (`!top (f:A->real^(M,N)finite_sum).
        continuous_map(top,euclidean) f <=>
        continuous_map(top,euclidean) (fstcart o f) /\
        continuous_map(top,euclidean) (sndcart o f)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN CONJ_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_MAP_COMPOSE)) THEN
    REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
    MATCH_MP_TAC LIPSCHITZ_CONTINUOUS_IMP_CONTINUOUS_MAP THEN
    REWRITE_TAC[LIPSCHITZ_CONTINUOUS_MAP_CART_PROJECTIONS];
    REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `(f:A->real^(M,N)finite_sum) =
      (\(x,y). pastecart x y) o (\a. fstcart(f a),sndcart(f a))`
    SUBST1_TAC THENL
     [REWRITE_TAC[FUN_EQ_THM; o_DEF; PASTECART_FST_SND];
      MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN EXISTS_TAC
       `prod_topology euclidean euclidean :(real^M#real^N)topology` THEN
      ASM_REWRITE_TAC[CONTINUOUS_MAP_PAIRED] THEN
      REWRITE_TAC[GSYM MTOPOLOGY_EUCLIDEAN_METRIC;
                  GSYM MTOPOLOGY_PROD_METRIC] THEN
      MATCH_MP_TAC LIPSCHITZ_CONTINUOUS_IMP_CONTINUOUS_MAP THEN
      REWRITE_TAC[LIPSCHITZ_CONTINUOUS_MAP_PASTING]]]);;

let CONTINUOUS_MAP_PASTED = prove
 (`!top (f:A->real^M) (g:A->real^N).
        continuous_map (top,euclidean) (\x. pastecart (f x) (g x)) <=>
        continuous_map(top,euclidean) f /\
        continuous_map(top,euclidean) g`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[CONTINUOUS_MAP_PASTEWISE; o_DEF] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;

(* ------------------------------------------------------------------------- *)
(* Quotient maps are occasionally useful.                                    *)
(* ------------------------------------------------------------------------- *)

let QUASICOMPACT_OPEN_CLOSED = prove
 (`!f:real^M->real^N s t.
    IMAGE f s SUBSET t
    ==> ((!u. u SUBSET t
              ==> (open_in (subtopology euclidean s)
                           {x | x IN s /\ f x IN u}
                   ==> open_in (subtopology euclidean t) u)) <=>
         (!u. u SUBSET t
              ==> (closed_in (subtopology euclidean s)
                             {x | x IN s /\ f x IN u}
                   ==> closed_in (subtopology euclidean t) u)))`,
  SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `u:real^N->bool` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
  ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN
  (ANTS_TAC THENL [SET_TAC[]; REPEAT STRIP_TAC]) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
   `open_in top x ==> x = y ==> open_in top y`)) THEN
  ASM SET_TAC[]);;

let QUOTIENT_MAP_IMP_CONTINUOUS_OPEN = prove
 (`!f:real^M->real^N s t.
     IMAGE f s SUBSET t /\
     (!u. u SUBSET t
          ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
               open_in (subtopology euclidean t) u))
     ==> f continuous_on s`,
  MESON_TAC[OPEN_IN_IMP_SUBSET; CONTINUOUS_ON_OPEN_GEN]);;

let QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED = prove
 (`!f:real^M->real^N s t.
     IMAGE f s SUBSET t /\
     (!u. u SUBSET t
          ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
               closed_in (subtopology euclidean t) u))
     ==> f continuous_on s`,
  MESON_TAC[CLOSED_IN_IMP_SUBSET; CONTINUOUS_ON_CLOSED_GEN]);;

let OPEN_MAP_IMP_QUOTIENT_MAP = prove
 (`!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 IMAGE f s
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
                 open_in (subtopology euclidean (IMAGE f s)) t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN
     `t = IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN t}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
    ASM_SIMP_TAC[]]);;

let CLOSED_MAP_IMP_QUOTIENT_MAP = prove
 (`!f:real^M->real^N s.
    f continuous_on s /\
    (!t. closed_in (subtopology euclidean s) t
         ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t))
    ==> !t. t SUBSET IMAGE f s
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
                 open_in (subtopology euclidean (IMAGE f s)) t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC
     `s DIFF {x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN
    ANTS_TAC THENL
     [MATCH_MP_TAC CLOSED_IN_DIFF THEN
      ASM_SIMP_TAC[CLOSED_IN_SUBTOPOLOGY_REFL;
                   TOPSPACE_EUCLIDEAN; SUBSET_UNIV];
      REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN
      AP_TERM_TAC THEN ASM SET_TAC[]];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
    ASM_SIMP_TAC[]]);;

let CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET s /\
        (!y. y IN t ==> f(g y) = y)
        ==> (!u. u SUBSET t
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                 open_in (subtopology euclidean t) u))`,
  REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(IMAGE (g:real^N->real^M) t)
       INTER
       {x | x IN s /\ (f:real^M->real^N) x IN u}`) THEN
    ANTS_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
      REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
      ASM SET_TAC[];
      MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]];
    DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = t`
     (fun th -> ASM_REWRITE_TAC[th]) THEN
    ASM SET_TAC[]]);;

let CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ g continuous_on (IMAGE f s) /\
        (!x. x IN s ==> g(f x) = x)
        ==> (!u. u SUBSET (IMAGE f s)
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                 open_in (subtopology euclidean (IMAGE f s)) u))`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
  EXISTS_TAC `g:real^N->real^M` THEN
  ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let QUOTIENT_MAP_OPEN_CLOSED = prove
 (`!f:real^M->real^N s t.
    IMAGE f s SUBSET t
    ==> ((!u. u SUBSET t
              ==> (open_in (subtopology euclidean s)
                           {x | x IN s /\ f x IN u} <=>
                   open_in (subtopology euclidean t) u)) <=>
         (!u. u SUBSET t
              ==> (closed_in (subtopology euclidean s)
                             {x | x IN s /\ f x IN u} <=>
                   closed_in (subtopology euclidean t) u)))`,
  SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `u:real^N->bool` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
  ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN
  (ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN
  REWRITE_TAC[SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM SET_TAC[]);;

let CONTINUOUS_ON_COMPOSE_QUOTIENT = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
      IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
      (!v. v SUBSET t
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
                open_in (subtopology euclidean t) v)) /\
      (g o f) continuous_on s
      ==> g continuous_on t`,
  REPEAT GEN_TAC THEN
  REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
  SUBGOAL_THEN
   `IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) s SUBSET u`
   (fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th])
  THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_TAC] THEN
  X_GEN_TAC `v:real^P->bool` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN
  ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN v}`) THEN
  ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
   `open_in top s ==> s = t ==> open_in top t`)) THEN
  ASM SET_TAC[]);;

let LIFT_TO_QUOTIENT_SPACE = prove
 (`!f:real^M->real^N h:real^M->real^P s t u.
        IMAGE f s = t /\
        (!v. v SUBSET t
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
                open_in (subtopology euclidean t) v)) /\
        h continuous_on s /\ IMAGE h s = u /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> h x = h y)
        ==> ?g. g continuous_on t /\ IMAGE g t = u /\
                !x. x IN s ==> h(x) = g(f x)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[FUNCTION_FACTORS_LEFT_GEN] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^P` THEN
  DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC
   [`f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`] THEN
  ASM_SIMP_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
    CONTINUOUS_ON_EQ)) THEN
  ASM_REWRITE_TAC[o_THM]);;

let QUOTIENT_MAP_COMPOSE_EXPLICIT = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        IMAGE f s SUBSET t /\
        (!v. v SUBSET t
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
                open_in (subtopology euclidean t) v)) /\
        (!v. v SUBSET u
           ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=>
                open_in (subtopology euclidean u) v))
        ==> !v. v SUBSET u
                ==> (open_in (subtopology euclidean s)
                             {x | x IN s /\ (g o f) x IN v} <=>
                     open_in (subtopology euclidean u) v)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} =
    {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}`
  SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_RESTRICT]]);;

let QUOTIENT_MAP_FROM_COMPOSITION_EXPLICIT = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET u /\
        (!v. v SUBSET u
             ==> (open_in (subtopology euclidean s)
                          {x | x IN s /\ (g o f) x IN v} <=>
                  open_in (subtopology euclidean u) v))
        ==> !v. v SUBSET u
                ==> (open_in (subtopology euclidean t)
                              {x | x IN t /\ g x IN v} <=>
                     open_in (subtopology euclidean u) v)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN
    ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
    SUBGOAL_THEN
     `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} =
      {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[]]);;

let QUOTIENT_MAP_FROM_SUBSET = prove
 (`!f:real^M->real^N s t u.
        f continuous_on t /\ IMAGE f t SUBSET u /\
        s SUBSET t /\ IMAGE f s = u /\
        (!v. v SUBSET u
             ==> (open_in (subtopology euclidean s)
                          {x | x IN s /\ f x IN v} <=>
                  open_in (subtopology euclidean u) v))
        ==> !v. v SUBSET u
                ==> (open_in (subtopology euclidean t)
                             {x | x IN t /\ f x IN v} <=>
                     open_in (subtopology euclidean u) v)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION_EXPLICIT THEN
  MAP_EVERY EXISTS_TAC [`\x:real^M. x`; `s:real^M->bool`] THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; o_THM]);;

let QUOTIENT_MAP_RESTRICT = prove
 (`!f:real^M->real^N s t c.
     IMAGE f s SUBSET t /\
     (!u. u SUBSET t
        ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
             open_in (subtopology euclidean t) u)) /\
     (open_in (subtopology euclidean t) c \/
      closed_in (subtopology euclidean t) c)
     ==> !u. u SUBSET c
             ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c})
                          {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=>
                  open_in (subtopology euclidean c) u)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC (MATCH_MP
   (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^M->real^N) {x | x IN s /\ f x IN c} SUBSET c`
  ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN
  FIRST_X_ASSUM DISJ_CASES_TAC THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET);
    ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN
  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
  (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  (MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
    [MATCH_MP_TAC(MESON[] `t = s /\ (P s <=> Q s) ==> (P s <=> Q t)`) THEN
     CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]];
     ALL_TAC]) THEN
  (EQ_TAC THENL
    [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE
     MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS);
     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE
     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN
  (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE
   MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC[]) THEN
  ASM SET_TAC[]);;

let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN = prove
 (`!f:real^M->real^N s t c.
      IMAGE f s = t /\
      (!u. u SUBSET t
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                open_in (subtopology euclidean t) u)) /\
      (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
      (open_in (subtopology euclidean t) c \/
       closed_in (subtopology euclidean t) c) /\
      connected c
      ==> connected {x | x IN s /\ f x IN c}`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL
   [`subtopology euclidean (s:real^M->bool)`;
    `subtopology euclidean (t:real^N->bool)`;
    `f:real^M->real^N`; `c:real^N->bool`]
    CONNECTED_IN_MONOTONE_QUOTIENT_MAP_PREIMAGE) THEN
  ASM_REWRITE_TAC[monotone_map; quotient_map; CONNECTED_IN_SUBTOPOLOGY;
                  CONNECTED_IN_EUCLIDEAN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
                  SUBSET_RESTRICT; SUBSET_REFL] THEN
  ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]);;

let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE = prove
 (`!f:real^M->real^N s t.
      f continuous_on s /\ IMAGE f s = t /\
      (!u. u SUBSET t
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                open_in (subtopology euclidean t) u)) /\
      (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
      connected t
      ==> connected s`,
  MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC(SPEC `t:real^N->bool` th)) THEN
  ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* More properties of open and closed maps.                                  *)
(* ------------------------------------------------------------------------- *)

let CLOSED_MAP_CLOSURES = prove
 (`!f:real^M->real^N.
        (!s. closed s ==> closed(IMAGE f s)) <=>
        (!s. closure(IMAGE f s) SUBSET IMAGE f (closure s))`,
  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC CLOSURE_MINIMAL THEN
    ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; IMAGE_SUBSET];
    REWRITE_TAC[GSYM CLOSURE_SUBSET_EQ] THEN ASM_MESON_TAC[CLOSURE_CLOSED]]);;

let OPEN_MAP_INTERIORS = prove
 (`!f:real^M->real^N.
        (!s. open s ==> open(IMAGE f s)) <=>
        (!s. IMAGE f (interior s) SUBSET interior(IMAGE f s))`,
  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC INTERIOR_MAXIMAL THEN
    ASM_SIMP_TAC[OPEN_INTERIOR; INTERIOR_SUBSET; IMAGE_SUBSET];
    REWRITE_TAC[GSYM SUBSET_INTERIOR_EQ] THEN ASM_MESON_TAC[INTERIOR_OPEN]]);;

let OPEN_MAP_RESTRICT = prove
 (`!f:real^M->real^N s t t'.
        (!u. open_in (subtopology euclidean s) u
             ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
        t' SUBSET t
        ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u
                ==> open_in (subtopology euclidean t') (IMAGE f u)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
  REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);;

let CLOSED_MAP_RESTRICT = prove
 (`!f:real^M->real^N s t t'.
        (!u. closed_in (subtopology euclidean s) u
             ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\
        t' SUBSET t
        ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u
                ==> closed_in (subtopology euclidean t') (IMAGE f u)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
  REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);;

let QUOTIENT_MAP_OPEN_MAP_EQ = prove
 (`!f:real^M->real^N s t.
       IMAGE f s SUBSET t /\
       (!u. u SUBSET t
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                 open_in (subtopology euclidean t) u))
       ==> ((!k. open_in (subtopology euclidean s) k
                 ==> open_in (subtopology euclidean t) (IMAGE f k)) <=>
            (!k. open_in (subtopology euclidean s) k
                 ==> open_in (subtopology euclidean s)
                               {x | x IN s /\ f x IN IMAGE f k}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN
  ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;

let QUOTIENT_MAP_CLOSED_MAP_EQ = prove
 (`!f:real^M->real^N s t.
       IMAGE f s SUBSET t /\
       (!u. u SUBSET t
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                 open_in (subtopology euclidean t) u))
       ==> ((!k. closed_in (subtopology euclidean s) k
                 ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
            (!k. closed_in (subtopology euclidean s) k
                 ==> closed_in (subtopology euclidean s)
                               {x | x IN s /\ f x IN IMAGE f k}))`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN
  ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;

let CLOSED_MAP_IMP_OPEN_MAP = prove
 (`!f:real^M->real^N s t.
        IMAGE f s = t /\
        (!u. closed_in (subtopology euclidean s) u
                ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\
        (!u. open_in (subtopology euclidean s) u
             ==> open_in (subtopology euclidean s)
                         {x | x IN s /\ f x IN IMAGE f u})
        ==> (!u. open_in (subtopology euclidean s) u
                 ==> open_in (subtopology euclidean t) (IMAGE f u))`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
    `IMAGE (f:real^M->real^N) u =
     t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[];
    MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    ASM_SIMP_TAC[CLOSED_IN_REFL]]);;

let OPEN_MAP_IMP_CLOSED_MAP = prove
 (`!f:real^M->real^N s t.
        IMAGE f s = t /\
        (!u. open_in (subtopology euclidean s) u
                ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
        (!u. closed_in (subtopology euclidean s) u
             ==> closed_in (subtopology euclidean s)
                         {x | x IN s /\ f x IN IMAGE f u})
        ==> (!u. closed_in (subtopology euclidean s) u
                 ==> closed_in (subtopology euclidean t) (IMAGE f u))`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
    `IMAGE (f:real^M->real^N) u =
     t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[];
    MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
    ASM_SIMP_TAC[OPEN_IN_REFL]]);;

let OPEN_MAP_IFF_CLOSED_MAP_BIJECTIVE = prove
 (`!f:real^M->real^N s t.
        IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> ((!u. open_in (subtopology euclidean s) u
                  ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
             (!c. closed_in (subtopology euclidean s) c
                  ==> closed_in (subtopology euclidean t) (IMAGE f c)))`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `c:real^M->bool` THEN
  ONCE_REWRITE_TAC[closed_in; OPEN_IN_CLOSED_IN_EQ] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN STRIP_TAC THEN
  (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF c:real^M->bool`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  ASM SET_TAC[]);;

let OPEN_MAP_FROM_COMPOSITION_SURJECTIVE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\
        (!k. open_in (subtopology euclidean s) k
             ==> open_in (subtopology euclidean u) (IMAGE (g o f) k))
        ==> (!k. open_in (subtopology euclidean t) k
                 ==> open_in (subtopology euclidean u) (IMAGE g k))`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N))
                      {x | x IN s /\ f(x) IN k}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);;

let CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\
        (!k. closed_in (subtopology euclidean s) k
             ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k))
        ==> (!k. closed_in (subtopology euclidean t) k
                 ==> closed_in (subtopology euclidean u) (IMAGE g k))`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N))
                      {x | x IN s /\ f(x) IN k}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);;

let OPEN_MAP_FROM_COMPOSITION_INJECTIVE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
        g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\
        (!k. open_in (subtopology euclidean s) k
             ==> open_in (subtopology euclidean u) (IMAGE (g o f) k))
        ==> (!k. open_in (subtopology euclidean s) k
                 ==> open_in (subtopology euclidean t) (IMAGE f k))`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `IMAGE f k = {x | x IN t /\
                    g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);;

let CLOSED_MAP_FROM_COMPOSITION_INJECTIVE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
        g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\
        (!k. closed_in (subtopology euclidean s) k
             ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k))
        ==> (!k. closed_in (subtopology euclidean s) k
                 ==> closed_in (subtopology euclidean t) (IMAGE f k))`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `IMAGE f k = {x | x IN t /\
                    g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);;

let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE = prove
 (`!f:real^M->real^N s t u w.
        (!k. open_in (subtopology euclidean s) k
             ==> open_in (subtopology euclidean t) (IMAGE f k)) /\
        closed_in (subtopology euclidean s) u /\
        w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
        ==> ?v. closed_in (subtopology euclidean t) v /\
                w SUBSET v /\
                {x | x IN s /\ f(x) IN v} SUBSET u`,
  REWRITE_TAC[GSYM open_map; OPEN_MAP_PREIMAGE_NEIGHBOURHOOD] THEN
  SIMP_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ = prove
 (`!f:real^M->real^N s t.
       IMAGE f s SUBSET t
       ==> ((!k. open_in (subtopology euclidean s) k
                 ==> open_in (subtopology euclidean t) (IMAGE f k)) <=>
            (!u w. closed_in (subtopology euclidean s) u /\
                   w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
                   ==> ?v. closed_in (subtopology euclidean t) v /\
                           w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`,
  REWRITE_TAC[GSYM open_map; OPEN_MAP_PREIMAGE_NEIGHBOURHOOD] THEN
  SIMP_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE = prove
 (`!f:real^M->real^N s t u w.
        (!k. closed_in (subtopology euclidean s) k
             ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
        open_in (subtopology euclidean s) u /\
        w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
        ==> ?v. open_in (subtopology euclidean t) v /\
                w SUBSET v /\
                {x | x IN s /\ f(x) IN v} SUBSET u`,
  REWRITE_TAC[GSYM closed_map; CLOSED_MAP_PREIMAGE_NEIGHBOURHOOD] THEN
  SIMP_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ = prove
 (`!f:real^M->real^N s t.
       IMAGE f s SUBSET t
       ==> ((!k. closed_in (subtopology euclidean s) k
                 ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
            (!u w. open_in (subtopology euclidean s) u /\
                   w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
                   ==> ?v. open_in (subtopology euclidean t) v /\
                           w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`,
  REWRITE_TAC[GSYM closed_map; CLOSED_MAP_PREIMAGE_NEIGHBOURHOOD] THEN
  SIMP_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT = prove
 (`!f:real^M->real^N s t.
       IMAGE f s SUBSET t
       ==> ((!k. closed_in (subtopology euclidean s) k
                 ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
            (!u y. open_in (subtopology euclidean s) u /\
                   y IN t /\ {x | x IN s /\ f(x) = y} SUBSET u
                   ==> ?v. open_in (subtopology euclidean t) v /\
                           y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`,
  REWRITE_TAC[GSYM closed_map; CLOSED_MAP_FIBRE_NEIGHBOURHOOD] THEN
  SIMP_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONNECTED_OPEN_MONOTONE_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!c. open_in (subtopology euclidean s) c
             ==> open_in (subtopology euclidean t) (IMAGE f c)) /\
        (!y. y IN t ==> connected {x | x IN s /\ f x = y})
        ==> !c. connected c /\ c SUBSET t
                ==> connected {x | x IN s /\ f x IN c}`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`subtopology euclidean (s:real^M->bool)`;
    `subtopology euclidean (t:real^N->bool)`; `f:real^M->real^N`]
   MONOTONE_OPEN_MAP) THEN
  ASM_REWRITE_TAC[open_map; monotone_map; CONTINUOUS_MAP_EUCLIDEAN2;
    CONNECTED_IN_SUBTOPOLOGY; CONNECTED_IN_EUCLIDEAN;
    TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL; SUBSET_RESTRICT]);;

let CONNECTED_CLOSED_MONOTONE_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
        (!y. y IN t ==> connected {x | x IN s /\ f x = y})
        ==> !c. connected c /\ c SUBSET t
                ==> connected {x | x IN s /\ f x IN c}`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`subtopology euclidean (s:real^M->bool)`;
    `subtopology euclidean (t:real^N->bool)`; `f:real^M->real^N`]
   MONOTONE_CLOSED_MAP) THEN
  ASM_REWRITE_TAC[closed_map; monotone_map; CONTINUOUS_MAP_EUCLIDEAN2;
    CONNECTED_IN_SUBTOPOLOGY; CONNECTED_IN_EUCLIDEAN;
    TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL; SUBSET_RESTRICT]);;

(* ------------------------------------------------------------------------- *)
(* Proper maps, including projections out of compact sets.                   *)
(* ------------------------------------------------------------------------- *)

let PROPER_MAP_INTO_EUCLIDEAN = prove
 (`!top (f:A->real^N) s.
        continuous_map(top,subtopology euclidean s) f \/ kc_space top
        ==> (proper_map(top,subtopology euclidean s) f <=>
             IMAGE f (topspace top) SUBSET s /\
             !k. k SUBSET s /\ compact k
                 ==> compact_in top {x | x IN topspace top /\ f x IN k})`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
     PROPER_EQ_COMPACT_MAP o lhand o snd) THEN
  ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; COMPACT_IN_SUBTOPOLOGY;
                  COMPACT_IN_EUCLIDEAN] THEN
  ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[CONJ_ACI]] THEN
  SIMP_TAC[METRIZABLE_IMP_K_SPACE; METRIZABLE_IMP_KC_SPACE;
           METRIZABLE_SPACE_SUBTOPOLOGY; METRIZABLE_SPACE_EUCLIDEAN]);;

let PROPER_MAP_EUCLIDEAN = prove
 (`!(f:real^M->real^N) s t.
        proper_map(subtopology euclidean s,subtopology euclidean t) f <=>
        IMAGE f s SUBSET t /\
        !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`,
  SIMP_TAC[PROPER_MAP_INTO_EUCLIDEAN; KC_SPACE_SUBTOPOLOGY;
           KC_SPACE_EUCLIDEAN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[COMPACT_IN_SUBTOPOLOGY; COMPACT_IN_EUCLIDEAN; SUBSET_RESTRICT]);;

let PROPER_MAP = prove
 (`!f:real^M->real^N s t.
    IMAGE f s SUBSET t
    ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=>
         (!k. closed_in (subtopology euclidean s) k
              ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
         (!a. a IN t ==> compact {x | x IN s /\ f x = a}))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
        PROPER_MAP_EUCLIDEAN) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  REWRITE_TAC[proper_map; closed_map] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; COMPACT_IN_SUBTOPOLOGY] THEN
  REWRITE_TAC[SUBSET_RESTRICT; COMPACT_IN_EUCLIDEAN]);;

let PROPER_MAP_EQ = prove
 (`!f:real^M->real^N s t.
        IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=>
        (!k. closed_in (subtopology euclidean s) k
             ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
        (!a. a IN t ==> compact {x | x IN s /\ f x = a})`,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(p ==> (q <=> r /\ s)) /\ (r ==> p) ==> (p /\ q <=> r /\ s)`) THEN
  REWRITE_TAC[PROPER_MAP] THEN
  MESON_TAC[CLOSED_IN_REFL; CLOSED_IN_IMP_SUBSET]);;

let PROPER_MAP_FROM_COMPACT = prove
 (`!f:real^M->real^N s k t.
        f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\
        closed_in (subtopology euclidean t) k
        ==> compact {x | x IN s /\ f x IN k}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN
  ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]);;

let PROPER_MAP_FROM_COMPACT_ALT = prove
 (`!f:real^M->real^N s t.
         compact s /\ f continuous_on s /\ IMAGE f s SUBSET t
         ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]);;

let PROPER_MAP_EUCLIDEAN_COMPOSE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k})
        ==> !k. k SUBSET u /\ compact k
                ==> compact {x | x IN s /\ (g o f) x IN k}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN k}`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN
  AP_TERM_TAC THEN ASM SET_TAC[]);;

let PROPER_MAP_EUCLIDEAN_FROM_COMPOSITION_LEFT = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s = t /\
        g continuous_on t /\ IMAGE g t SUBSET u /\
        (!k. k SUBSET u /\ compact k
             ==> compact {x | x IN s /\ (g o f) x IN k})
        ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}`,
  REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP
   (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN
  ANTS_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;

let PROPER_MAP_EUCLIDEAN_FROM_COMPOSITION_RIGHT = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET u /\
        (!k. k SUBSET u /\ compact k
             ==> compact {x | x IN s /\ (g o f) x IN k})
        ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`,
  let lemma = prove
   (`!s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t`,
    MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET;
              CLOSED_IN_CLOSED_EQ]) in
  REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^P) k`) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    MATCH_MP_TAC lemma THEN
    MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
    EXISTS_TAC `s:real^M->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);;

let PROPER_MAP_FSTCART = prove
 (`!s:real^M->bool t:real^N->bool k.
        compact t /\ k SUBSET s /\ compact k
        ==> compact {z | z IN s PCROSS t /\ fstcart z IN k}`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `{z | z IN s PCROSS t /\ fstcart z IN k} =
    (k:real^M->bool) PCROSS (t:real^N->bool)`
   (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN
  REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM;
              PASTECART_IN_PCROSS; FSTCART_PASTECART] THEN
  ASM SET_TAC[]);;

let CLOSED_MAP_FSTCART = prove
 (`!s:real^M->bool t:real^N->bool c.
        compact t /\ closed_in (subtopology euclidean (s PCROSS t)) c
        ==> closed_in (subtopology euclidean s) (IMAGE fstcart c)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
                 `(s:real^M->bool) PCROSS (t:real^N->bool)`;
                 `s:real^M->bool`]
        PROPER_MAP) THEN
  ASM_SIMP_TAC[PROPER_MAP_FSTCART; IMAGE_FSTCART_PCROSS] THEN
  ASM SET_TAC[]);;

let PROPER_MAP_SNDCART = prove
 (`!s:real^M->bool t:real^N->bool k.
        compact s /\ k SUBSET t /\ compact k
        ==> compact {z | z IN s PCROSS t /\ sndcart z IN k}`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `{z | z IN s PCROSS t /\ sndcart z IN k} =
    (s:real^M->bool) PCROSS (k:real^N->bool)`
   (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN
  REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM;
              PASTECART_IN_PCROSS; SNDCART_PASTECART] THEN
  ASM SET_TAC[]);;

let CLOSED_MAP_SNDCART = prove
 (`!s:real^M->bool t:real^N->bool c.
        compact s /\ closed_in (subtopology euclidean (s PCROSS t)) c
        ==> closed_in (subtopology euclidean t) (IMAGE sndcart c)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
                 `(s:real^M->bool) PCROSS (t:real^N->bool)`;
                 `t:real^N->bool`]
        PROPER_MAP) THEN
  ASM_SIMP_TAC[PROPER_MAP_SNDCART; IMAGE_SNDCART_PCROSS] THEN
  ASM SET_TAC[]);;

let CLOSED_IN_COMPACT_PROJECTION = prove
 (`!s:real^M->bool t:real^N->bool u.
    compact s /\ closed_in (subtopology euclidean (s PCROSS t)) u
    ==> closed_in (subtopology euclidean t)
                  {y | ?x. x IN s /\ pastecart x y IN u}`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_MAP_SNDCART) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET o CONJUNCT2) THEN
  REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART;
              PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN
  SET_TAC[]);;

let CLOSED_COMPACT_PROJECTION = prove
 (`!s:real^M->bool t:real^(M,N)finite_sum->bool.
      compact s /\ closed t ==> closed {y | ?x. x IN s /\ pastecart x y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{y | ?x:real^M. x IN s /\ pastecart x y IN t} =
    {y | ?x. x IN s /\ pastecart x y IN ((s PCROSS (:real^N)) INTER t)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_INTER] THEN SET_TAC[];
    MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
    EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[CLOSED_UNIV] THEN
    MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN
    ASM_SIMP_TAC[CLOSED_INTER; CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED;
                 INTER_SUBSET]]);;

let TUBE_LEMMA = prove
 (`!s:real^M->bool t:real^N->bool u a.
        compact s /\ ~(s = {}) /\ {pastecart x a | x IN s} SUBSET u /\
        open_in(subtopology euclidean (s PCROSS t)) u
        ==> ?v. open_in (subtopology euclidean t) v /\ a IN v /\
                (s PCROSS v) SUBSET u`,
  REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
  REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; PCROSS]
        CLOSED_IN_COMPACT_PROJECTION)) THEN
  ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
   `(closed_in top t ==> s DIFF (s DIFF t) = t) /\
    s DIFF t SUBSET s /\ P(s DIFF t)
    ==> closed_in top t
        ==> ?v. v SUBSET s /\ closed_in top (s DIFF v) /\ P v`) THEN
  REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = t <=> t SUBSET s`] THEN
  REWRITE_TAC[SUBSET_DIFF] THEN
  SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
  CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN
  REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_PASTECART] THEN
  REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);;

let TUBE_LEMMA_GEN = prove
 (`!s t t' u:real^(M,N)finite_sum->bool.
        compact s /\ ~(s = {}) /\ t SUBSET t' /\
        s PCROSS t SUBSET u /\
        open_in (subtopology euclidean (s PCROSS t')) u
        ==> ?v. open_in (subtopology euclidean t') v /\
                t SUBSET v /\
                s PCROSS v SUBSET u`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!a. a IN t ==> ?v. open_in (subtopology euclidean t') v /\ a IN v /\
                       (s:real^M->bool) PCROSS (v:real^N->bool) SUBSET u`
  MP_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC TUBE_LEMMA THEN
    ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
    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 `vv:real^N->real^N->bool` THEN DISCH_TAC THEN
    EXISTS_TAC `UNIONS (IMAGE (vv:real^N->real^N->bool) t)` THEN
    ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE] THEN
    REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; FORALL_IN_PCROSS] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real^N`)) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN
    ASM_REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Sequential characterizations of proper-ness.                              *)
(* ------------------------------------------------------------------------- *)

let PROPER_MAP_SEQUENTIALLY_IMP = prove
 (`!f:real^M->real^N s t x y.
        IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        (!n. x(n) IN s) /\ y IN t /\ ((f o x) --> y) sequentially
        ==> ?z r. z IN s /\ (!m n. m < n ==> r m < r n) /\
                  ((x o r) --> z) sequentially`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
      `y INSERT IMAGE ((f:real^M->real^N) o x) (:num)`) THEN
    ASM_SIMP_TAC[COMPACT_SEQUENCE_WITH_LIMIT; INSERT_SUBSET] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[compact]] THEN
    DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; IN_INSERT; IMAGE_o] THEN ASM SET_TAC[]);;

let PROPER_MAP_SEQUENTIALLY_REV = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\
        (!x y. (!n. x(n) IN s) /\ y IN t /\ ((f o x) --> y) sequentially
               ==> ?z r. z IN s /\ (!m n. m < n ==> r m < r n) /\
                         ((x o r) --> z) sequentially)
        ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[compact; IN_ELIM_THM; AND_FORALL_THM] THEN
  X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN
  DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) o (x:num->real^M)`) THEN
  ASM_REWRITE_TAC[o_THM; LEFT_IMP_EXISTS_THM; GSYM o_ASSOC] THEN
  MAP_EVERY X_GEN_TAC [`y:real^N`; `r:num->num`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL
   [`(x:num->real^M) o (r:num->num)`; `y:real^N`]) THEN
  ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN
  REWRITE_TAC[GSYM o_ASSOC; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `q:num->num` THEN STRIP_TAC THEN
  EXISTS_TAC `(r:num->num) o (q:num->num)` THEN
  ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CLOSED_CONTAINS_SEQUENTIAL_LIMIT THEN
  EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M) o r o (q:num->num)` THEN
  ASM_SIMP_TAC[o_THM; COMPACT_IMP_CLOSED] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_SEQUENTIALLY]) THEN
  ASM_REWRITE_TAC[o_THM]);;

let PROPER_MAP_SEQUENTIALLY = prove
 (`!f:real^M->real^N s t.
    f continuous_on s /\ IMAGE f s SUBSET t
    ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=>
         !x y. (!n. x(n) IN s) /\ y IN t /\ ((f o x) --> y) sequentially
               ==> ?z r. z IN s /\
                         (!m n. m < n ==> r m < r n) /\
                         ((x o r) --> z) sequentially)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC PROPER_MAP_SEQUENTIALLY_IMP THEN ASM_MESON_TAC[];
    DISCH_TAC THEN MATCH_MP_TAC PROPER_MAP_SEQUENTIALLY_REV THEN
    ASM_REWRITE_TAC[]]);;

let PROPER_MAP_ESCAPES_IMP = prove
 (`!f:real^M->real^N s t x.
        IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        (!n:num. x n IN s) /\
        (!c. c SUBSET s /\ compact c ==> FINITE {n | x n IN c})
        ==> (!k. k SUBSET t /\ compact k ==> FINITE {n | f(x n) IN k})`,
  REPEAT GEN_TAC THEN
  REPEAT (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  SUBGOAL_THEN
   `!x. (!n. x n IN s) ==> (!n:num. (f:real^M->real^N) (x n) IN t)`
  MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SEQUENCE_ESCAPES]] THEN
  DISCH_THEN(K ALL_TAC) THEN
  REWRITE_TAC[CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC; o_DEF] THEN
  MAP_EVERY X_GEN_TAC [`y:real^N`; `r:num->num`] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`;
                 `(x:num->real^M) o (r:num->num)`; `y:real^N`]
        PROPER_MAP_SEQUENTIALLY_IMP) THEN
  ASM_REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `z:real^M` THEN
  DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(r:num->num) o (q:num->num)` THEN
  ASM_SIMP_TAC[o_DEF]);;

let PROPER_MAP_ESCAPES = prove
 (`!f:real^M->real^N s t.
    f continuous_on s /\ IMAGE f s SUBSET t
    ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=>
         !x. (!n:num. x n IN s) /\
             (!c. c SUBSET s /\ compact c ==> FINITE {n | x n IN c})
             ==> (!k. k SUBSET t /\ compact k ==> FINITE {n | f(x n) IN k}))`,
  REPEAT STRIP_TAC THEN
  SIMP_TAC[IMP_CONJ; SEQUENCE_ESCAPES] THEN
  ASM_SIMP_TAC[PROPER_MAP_SEQUENTIALLY; IMP_IMP] THEN
  SUBGOAL_THEN
   `!x. (!n. x n IN s) ==> (!n:num. (f:real^M->real^N) (x n) IN t)`
  MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SEQUENCE_ESCAPES]] THEN
  DISCH_THEN(K ALL_TAC) THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
  REWRITE_TAC[CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC; o_DEF] THEN
  EQ_TAC THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:num->real^M`; `y:real^N`] THENL
   [X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`(x:num->real^M) o (r:num->num)`; `y:real^N`]) THEN
    ASM_REWRITE_TAC[o_DEF] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^M` THEN
    DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(r:num->num) o (q:num->num)` THEN ASM_SIMP_TAC[o_THM];
    STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    MAP_EVERY EXISTS_TAC [`y:real^N`; `\n:num. n`] THEN
    ASM_REWRITE_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Pasting functions together on open sets.                                  *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_UNION_LOCAL_OPEN = prove
 (`!f:real^M->real^N s.
        open_in (subtopology euclidean (s UNION t)) s /\
        open_in (subtopology euclidean (s UNION t)) t /\
        f continuous_on s /\ f continuous_on t
        ==> f continuous_on (s UNION t)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`subtopology euclidean (s UNION t:real^M->bool)`;
    `euclidean:(real^N)topology`;
    `\i:(real^M->bool). (f:real^M->real^N)`; `f:real^M->real^N`;
    `\i:(real^M->bool). i`; `{s:real^M->bool,t}`]
    PASTING_LEMMA) THEN
  REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN
  REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN; SUBTOPOLOGY_SUBTOPOLOGY] THEN
  ASM_REWRITE_TAC[IN_UNION; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  ASM_REWRITE_TAC[SET_RULE `(s UNION t) INTER t = t`] THEN
  ASM_REWRITE_TAC[SET_RULE `(s UNION t) INTER s = s`]);;

let CONTINUOUS_ON_UNION_OPEN = prove
 (`!f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t
           ==> f continuous_on (s UNION t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN
  ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);;

let CONTINUOUS_ON_CASES_LOCAL_OPEN = prove
 (`!P f g:real^M->real^N s t.
        open_in (subtopology euclidean (s UNION t)) s /\
        open_in (subtopology euclidean (s UNION t)) t /\
        f continuous_on s /\ g continuous_on t /\
        (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
        ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
   [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;

let CONTINUOUS_ON_CASES_OPEN = prove
 (`!P f g s t.
           open s /\
           open t /\
           f continuous_on s /\
           g continuous_on t /\
           (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
           ==> (\x. if P x then f x else g x) continuous_on s UNION t`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN
  ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Closure of halflines, halfspaces and hyperplanes.                         *)
(* ------------------------------------------------------------------------- *)

let LIM_LIFT_DOT = prove
 (`!f:real^M->real^N a.
        (f --> l) net ==> ((lift o (\y. a dot f(y))) --> lift(a dot l)) net`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a = vec 0:real^N` THENL
   [ASM_REWRITE_TAC[DOT_LZERO; LIFT_NUM; o_DEF; LIM_CONST]; ALL_TAC] THEN
  REWRITE_TAC[tendsto] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / norm(a:real^N)`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_RDIV_EQ] THEN
  REWRITE_TAC[dist; o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; NORM_LIFT] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  ONCE_REWRITE_TAC[DOT_SYM] THEN
  MESON_TAC[NORM_CAUCHY_SCHWARZ_ABS; REAL_MUL_SYM; REAL_LET_TRANS]);;

let CONTINUOUS_AT_LIFT_DOT = prove
 (`!a:real^N x. (lift o (\y. a dot y)) continuous at x`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_AT; o_THM] THEN
  MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN MESON_TAC[]);;

let CONTINUOUS_ON_LIFT_DOT = prove
 (`!s. (lift o (\y. a dot y)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_DOT]);;

let CLOSED_INTERVAL_LEFT = prove
 (`!b:real^N.
     closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i <= b$i}`,
  REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[dist; REAL_NOT_LT] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN
  ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
  ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
  ASM_SIMP_TAC[REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);;

let CLOSED_INTERVAL_RIGHT = prove
 (`!a:real^N.
     closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i}`,
  REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[dist; REAL_NOT_LT] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN
  ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
  ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
  ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`]);;

let CLOSED_HALFSPACE_LE = prove
 (`!a:real^N b. closed {x | a dot x <= b}`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPEC `(:real^N)` CONTINUOUS_ON_LIFT_DOT) THEN
  REWRITE_TAC[CONTINUOUS_ON_CLOSED; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN
  DISCH_THEN(MP_TAC o SPEC
   `IMAGE lift {r | ?x:real^N. (a dot x = r) /\ r <= b}`) THEN
  ANTS_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
    REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN
    REWRITE_TAC[o_DEF] THEN MESON_TAC[LIFT_DROP]] THEN
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN
  EXISTS_TAC `{x | !i. 1 <= i /\ i <= dimindex(:1)
                       ==> (x:real^1)$i <= (lift b)$i}` THEN
  REWRITE_TAC[CLOSED_INTERVAL_LEFT] THEN
  SIMP_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_INTER;
    VEC_COMPONENT; DIMINDEX_1; LAMBDA_BETA; o_THM] THEN
  SIMP_TAC[ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN
  REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
  MESON_TAC[LIFT_DROP]);;

let CLOSED_HALFSPACE_GE = prove
 (`!a:real^N b. closed {x | a dot x >= b}`,
  REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN
  REWRITE_TAC[GSYM DOT_LNEG; CLOSED_HALFSPACE_LE]);;

let CLOSED_HYPERPLANE = prove
 (`!a b. closed {x | a dot x = b}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
  REWRITE_TAC[REAL_ARITH `b <= a dot x <=> a dot x >= b`] THEN
  REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
  SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_LE; CLOSED_HALFSPACE_GE]);;

let CLOSURE_HYPERPLANE = prove
 (`!a b. closure {x | a dot x = b} = {x | a dot x = b}`,
  SIMP_TAC[CLOSURE_CLOSED; CLOSED_HYPERPLANE]);;

let CLOSED_STANDARD_HYPERPLANE = prove
 (`!k a. closed {x:real^N | x$k = a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HYPERPLANE) THEN
  ASM_SIMP_TAC[DOT_BASIS]);;

let CLOSED_HALFSPACE_COMPONENT_LE = prove
 (`!a k. closed {x:real^N | x$k <= a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_LE) THEN
  ASM_SIMP_TAC[DOT_BASIS]);;

let CLOSED_HALFSPACE_COMPONENT_GE = prove
 (`!a k. closed {x:real^N | x$k >= a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_GE) THEN
  ASM_SIMP_TAC[DOT_BASIS]);;

(* ------------------------------------------------------------------------- *)
(* Openness of halfspaces.                                                   *)
(* ------------------------------------------------------------------------- *)

let OPEN_HALFSPACE_LT = prove
 (`!a b. open {x | a dot x < b}`,
  REWRITE_TAC[GSYM REAL_NOT_LE] THEN
  REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN
  REWRITE_TAC[GSYM closed; GSYM real_ge; CLOSED_HALFSPACE_GE]);;

let OPEN_HALFSPACE_COMPONENT_LT = prove
 (`!a k. open {x:real^N | x$k < a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_LT) THEN
  ASM_SIMP_TAC[DOT_BASIS]);;

let OPEN_HALFSPACE_GT = prove
 (`!a b. open {x | a dot x > b}`,
  REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN
  REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN
  REWRITE_TAC[GSYM closed; CLOSED_HALFSPACE_LE]);;

let OPEN_HALFSPACE_COMPONENT_GT = prove
 (`!a k. open {x:real^N | x$k > a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_GT) THEN
  ASM_SIMP_TAC[DOT_BASIS]);;

let OPEN_POSITIVE_MULTIPLES = prove
 (`!s:real^N->bool. open s ==> open {c % x | &0 < c /\ x IN s}`,
  REWRITE_TAC[open_def; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
  X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `inv(c) % y:real^N`) THEN ANTS_TAC THENL
   [SUBGOAL_THEN `x:real^N = inv c % c % x` SUBST1_TAC THENL
     [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID;
                   REAL_LT_IMP_NZ];
      ASM_SIMP_TAC[DIST_MUL; real_abs; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN
      ONCE_REWRITE_TAC[REAL_ARITH `inv c * x:real = x / c`] THEN
      ASM_MESON_TAC[REAL_LT_LDIV_EQ; REAL_MUL_SYM]];
    DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `c:real` THEN EXISTS_TAC `inv(c) % y:real^N` THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN
    VECTOR_ARITH_TAC]);;

let OPEN_INTERVAL_LEFT = prove
 (`!b:real^N. open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i < b$i}`,
  GEN_TAC THEN
  SUBGOAL_THEN
   `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i < b$i} =
    INTERS{{x | x$i < (b:real^N)$i} | i IN 1..dimindex(:N)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[INTERS_GSPEC; IN_NUMSEG] THEN SET_TAC[];
    MATCH_MP_TAC OPEN_INTERS THEN
    SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; OPEN_HALFSPACE_COMPONENT_LT]]);;

let OPEN_INTERVAL_RIGHT = prove
 (`!a:real^N. open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i}`,
  GEN_TAC THEN
  SUBGOAL_THEN
   `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i} =
    INTERS{{x | (a:real^N)$i < x$i} | i IN 1..dimindex(:N)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[INTERS_GSPEC; IN_NUMSEG] THEN SET_TAC[];
    MATCH_MP_TAC OPEN_INTERS THEN
    SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT]]);;

let OPEN_POSITIVE_ORTHANT = prove
 (`open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 < x$i}`,
  MP_TAC(ISPEC `vec 0:real^N` OPEN_INTERVAL_RIGHT) THEN
  REWRITE_TAC[VEC_COMPONENT]);;

(* ------------------------------------------------------------------------- *)
(* Closures and interiors of halfspaces.                                     *)
(* ------------------------------------------------------------------------- *)

let INTERIOR_HALFSPACE_LE = prove
 (`!a:real^N b.
        ~(a = vec 0) ==> interior {x | a dot x <= b} = {x | a dot x < b}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN
  SIMP_TAC[OPEN_HALFSPACE_LT; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN
  X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[SUBSET; IN_CBALL] THEN
  DISCH_THEN(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN
  REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN
  ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL;
               NORM_EQ_0; REAL_ARITH `&0 < x ==> abs x <= x`] THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC  `x + e / norm(a) % a:real^N`) THEN
  ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
  MATCH_MP_TAC(REAL_ARITH `&0 < e ==> ~(b + e <= b)`) THEN
  ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]);;

let INTERIOR_HALFSPACE_GE = prove
 (`!a:real^N b.
        ~(a = vec 0) ==> interior {x | a dot x >= b} = {x | a dot x > b}`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`;
                   REAL_ARITH `a > b <=> --a < --b`] THEN
  ASM_SIMP_TAC[GSYM DOT_LNEG; INTERIOR_HALFSPACE_LE; VECTOR_NEG_EQ_0]);;

let INTERIOR_HALFSPACE_COMPONENT_LE = prove
 (`!a k. interior {x:real^N | x$k <= a} = {x | x$k < a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_LE) THEN
  ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;

let INTERIOR_HALFSPACE_COMPONENT_GE = prove
 (`!a k. interior {x:real^N | x$k >= a} = {x | x$k > a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_GE) THEN
  ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;

let CLOSURE_HALFSPACE_LT = prove
 (`!a:real^N b.
        ~(a = vec 0) ==> closure {x | a dot x < b} = {x | a dot x <= b}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN
  REWRITE_TAC[SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN
  ASM_SIMP_TAC[REAL_ARITH `~(x < b) <=> x >= b`; INTERIOR_HALFSPACE_GE] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let CLOSURE_HALFSPACE_GT = prove
 (`!a:real^N b.
        ~(a = vec 0) ==> closure {x | a dot x > b} = {x | a dot x >= b}`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`;
                   REAL_ARITH `a > b <=> --a < --b`] THEN
  ASM_SIMP_TAC[GSYM DOT_LNEG; CLOSURE_HALFSPACE_LT; VECTOR_NEG_EQ_0]);;

let CLOSURE_HALFSPACE_COMPONENT_LT = prove
 (`!a k. closure {x:real^N | x$k < a} = {x | x$k <= a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_LT) THEN
  ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;

let CLOSURE_HALFSPACE_COMPONENT_GT = prove
 (`!a k. closure {x:real^N | x$k > a} = {x | x$k >= a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_GT) THEN
  ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;

let INTERIOR_HYPERPLANE = prove
 (`!a b. ~(a = vec 0) ==> interior {x | a dot x = b} = {}`,
  REWRITE_TAC[REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN
  REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN
  REWRITE_TAC[INTERIOR_INTER] THEN
  ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN
  REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN
  REAL_ARITH_TAC);;

let FRONTIER_HALFSPACE_LE = prove
 (`!a:real^N b. ~(a = vec 0 /\ b = &0)
                ==> frontier {x | a dot x <= b} = {x | a dot x = b}`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
  ASM_SIMP_TAC[DOT_LZERO] THENL
   [ASM_CASES_TAC `&0 <= b` THEN
    ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY];
    ASM_SIMP_TAC[frontier; INTERIOR_HALFSPACE_LE; CLOSURE_CLOSED;
                 CLOSED_HALFSPACE_LE] THEN
    REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);;

let FRONTIER_HALFSPACE_GE = prove
 (`!a:real^N b. ~(a = vec 0 /\ b = &0)
                ==> frontier {x | a dot x >= b} = {x | a dot x = b}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LE) THEN
  ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN
  REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);;

let FRONTIER_HALFSPACE_LT = prove
 (`!a:real^N b. ~(a = vec 0 /\ b = &0)
                ==> frontier {x | a dot x < b} = {x | a dot x = b}`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
  ASM_SIMP_TAC[DOT_LZERO] THENL
   [ASM_CASES_TAC `&0 < b` THEN
    ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY];
    ASM_SIMP_TAC[frontier; CLOSURE_HALFSPACE_LT; INTERIOR_OPEN;
                 OPEN_HALFSPACE_LT] THEN
    REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);;

let FRONTIER_HALFSPACE_GT = prove
 (`!a:real^N b. ~(a = vec 0 /\ b = &0)
                ==> frontier {x | a dot x > b} = {x | a dot x = b}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LT) THEN
  ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN
  REWRITE_TAC[REAL_LT_NEG2; REAL_EQ_NEG2; real_gt]);;

let FRONTIER_HALFSPACE_COMPONENT_LE = prove
 (`!a k. frontier {x:real^N | x$k <= a} = {x | x$k = a}`,
  SIMP_TAC[frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_COMPONENT_LE;
           INTERIOR_HALFSPACE_COMPONENT_LE] THEN
  REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let FRONTIER_HALFSPACE_COMPONENT_GE = prove
 (`!a k. frontier {x:real^N | x$k >= a} = {x | x$k = a}`,
  SIMP_TAC[frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_COMPONENT_GE;
           INTERIOR_HALFSPACE_COMPONENT_GE] THEN
  REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let FRONTIER_HALFSPACE_COMPONENT_LT = prove
 (`!a k. frontier {x:real^N | x$k < a} = {x | x$k = a}`,
  SIMP_TAC[frontier; INTERIOR_OPEN; OPEN_HALFSPACE_COMPONENT_LT;
           CLOSURE_HALFSPACE_COMPONENT_LT] THEN
  REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let FRONTIER_HALFSPACE_COMPONENT_GT = prove
 (`!a k. frontier {x:real^N | x$k > a} = {x | x$k = a}`,
  SIMP_TAC[frontier; INTERIOR_OPEN; OPEN_HALFSPACE_COMPONENT_GT;
           CLOSURE_HALFSPACE_COMPONENT_GT] THEN
  REWRITE_TAC[IN_DIFF; EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC);;

let INTERIOR_STANDARD_HYPERPLANE = prove
 (`!k a. interior {x:real^N | x$k = a} = {}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
  CHOOSE_TAC THENL
   [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HYPERPLANE) THEN
  ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;

let EMPTY_INTERIOR_LOWDIM = prove
 (`!s:real^N->bool. dim(s) < dimindex(:N) ==> interior s = {}`,
  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC(SET_RULE
   `!t u. s SUBSET t /\ t SUBSET u /\ u = {} ==> s = {}`) THEN
  MAP_EVERY EXISTS_TAC
   [`interior(span(s):real^N->bool)`;
    `interior({x:real^N | a dot x = &0})`] THEN
  ASM_SIMP_TAC[SUBSET_INTERIOR; SPAN_INC; INTERIOR_HYPERPLANE]);;

let DIM_NONEMPTY_INTERIOR = prove
 (`!s:real^N->bool. ~(interior s = {}) ==> dim s = dimindex(:N)`,
  MESON_TAC[EMPTY_INTERIOR_LOWDIM; NOT_LE; LE_ANTISYM; DIM_SUBSET_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Unboundedness of halfspaces.                                              *)
(* ------------------------------------------------------------------------- *)

let UNBOUNDED_HALFSPACE_COMPONENT_LE = prove
 (`!a k. ~bounded {x:real^N | x$k <= a}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !z:real^N. z$k = z$i`
  CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
  ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
  EXISTS_TAC `--(&1 + max (abs B) (abs a)) % basis i:real^N` THEN
  ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; BASIS_COMPONENT;
               VECTOR_MUL_COMPONENT] THEN
  REAL_ARITH_TAC);;

let UNBOUNDED_HALFSPACE_COMPONENT_GE = prove
 (`!a k. ~bounded {x:real^N | x$k >= a}`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN
  MP_TAC(SPECL [`--a:real`; `k:num`] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN
  REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL
   [MESON_TAC[VECTOR_NEG_NEG];
    REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC]);;

let UNBOUNDED_HALFSPACE_COMPONENT_LT = prove
 (`!a k. ~bounded {x:real^N | x$k < a}`,
  ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
  REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT;
              UNBOUNDED_HALFSPACE_COMPONENT_LE]);;

let UNBOUNDED_HALFSPACE_COMPONENT_GT = prove
 (`!a k. ~bounded {x:real^N | x$k > a}`,
  ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
  REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT;
              UNBOUNDED_HALFSPACE_COMPONENT_GE]);;

let BOUNDED_HALFSPACE_LE = prove
 (`!a:real^N b. bounded {x | a dot x <= b} <=> a = vec 0 /\ b < &0`,
  GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN
  SIMP_TAC[DOT_LMUL; DOT_BASIS; VECTOR_MUL_EQ_0; DIMINDEX_GE_1; LE_REFL;
           BASIS_NONZERO] THEN
  X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THEN
  DISCH_TAC THEN X_GEN_TAC `b:real` THENL
   [REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO; GSYM REAL_NOT_LE] THEN
    ASM_CASES_TAC `&0 <= b` THEN
    ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV;
                    SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC];
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE;
                 UNBOUNDED_HALFSPACE_COMPONENT_LE]]);;

let BOUNDED_HALFSPACE_GE = prove
 (`!a:real^N b. bounded {x | a dot x >= b} <=> a = vec 0 /\ &0 < b`,
  REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN
  REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LE] THEN
  REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b < &0 <=> &0 < b`]);;

let BOUNDED_HALFSPACE_LT = prove
 (`!a:real^N b. bounded {x | a dot x < b} <=> a = vec 0 /\ b <= &0`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
  ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `b <= &0` THEN
    ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV;
                    SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC];
    ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
    ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; BOUNDED_HALFSPACE_LE]]);;

let BOUNDED_HALFSPACE_GT = prove
 (`!a:real^N b. bounded {x | a dot x > b} <=> a = vec 0 /\ &0 <= b`,
  REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`] THEN
  REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LT] THEN
  REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b <= &0 <=> &0 <= b`]);;

(* ------------------------------------------------------------------------- *)
(* Equality of continuous functions on closure and related results.          *)
(* ------------------------------------------------------------------------- *)

let FORALL_IN_INTERMEDIATE_CLOSURE = prove
 (`!f:real^M->real^N s s' t.
        closed t /\ f continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\
        (!x. x IN s ==> f x IN t)
        ==> !x. x IN s' ==> f x IN t`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^M->bool`; `x:real^M`] CLOSURE_SEQUENTIAL) THEN
  DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:num->real^M` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM CLOSURE_EQ]) THEN
  REWRITE_TAC[CLOSURE_SEQUENTIAL] THEN
  EXISTS_TAC `(f:real^M->real^N) o (a:num->real^M)` THEN
  ASM_SIMP_TAC[o_THM] THEN
  FIRST_ASSUM(MATCH_MP_TAC o
    GEN_REWRITE_RULE I [CONTINUOUS_ON_SEQUENTIALLY]) THEN
  ASM SET_TAC[]);;

let FORALL_IN_INTERMEDIATE_CLOSURE_EQ = prove
 (`!f s s' t.
         closed t /\ f continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s
         ==> ((!x. x IN s' ==> f x IN t) <=>
              (!x. x IN s ==> f x IN t))`,
  MESON_TAC[FORALL_IN_INTERMEDIATE_CLOSURE; SUBSET]);;

let CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE = prove
 (`!f:real^M->real s s' a.
        (lift o f) continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\
        (!x. x IN s ==> f(x) <= a)
        ==> !x. x IN s' ==> f(x) <= a`,
  let lemma = prove
   (`x IN s ==> f x <= a <=> x IN s ==> (lift o f) x IN {y | y$1 <= a}`,
    REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; LIFT_DROP]) in
  REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s:real^M->bool` THEN
  ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_LE]);;

let CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE = prove
 (`!f:real^M->real s s' a.
       (lift o f) continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\
        (!x. x IN s ==> a <= f(x))
        ==> !x. x IN s' ==> a <= f(x)`,
  let lemma = prove
   (`x IN s ==> a <= f x <=> x IN s ==> (lift o f) x IN {y | y$1 >= a}`,
    REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; real_ge; LIFT_DROP]) in
  REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s:real^M->bool` THEN
  ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_GE]);;

let CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE = prove
 (`!f:real^M->real^N s s' a.
        f continuous_on s' /\ s SUBSET s' /\ s' SUBSET closure s /\
        (!x. x IN s ==> f(x) = a)
        ==> !x. x IN s' ==> f(x) = a`,
  REWRITE_TAC[SET_RULE
   `x IN s ==> f x = a <=> x IN s ==> f x IN {a}`] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CLOSED_SING]);;

let CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE = prove
 (`!g h:real^M->real^N s s'.
        g continuous_on s' /\ h continuous_on s' /\
        s SUBSET s' /\ s' SUBSET closure s /\
        (!x. x IN s ==> g x = h x)
        ==> !x. x IN s' ==> g x = h x`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[CONTINUOUS_ON_SUB]);;

let FORALL_IN_CLOSURE = prove
 (`!f:real^M->real^N s t.
        closed t /\ f continuous_on (closure s) /\
        (!x. x IN s ==> f x IN t)
        ==> (!x. x IN closure s ==> f x IN t)`,
  MESON_TAC[FORALL_IN_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);;

let FORALL_IN_CLOSURE_EQ = prove
 (`!f s t.
         closed t /\ f continuous_on closure s
         ==> ((!x. x IN closure s ==> f x IN t) <=>
              (!x. x IN s ==> f x IN t))`,
  MESON_TAC[FORALL_IN_CLOSURE; CLOSURE_SUBSET; SUBSET]);;

let SUP_CLOSURE = prove
 (`!s. sup(IMAGE drop (closure s)) = sup(IMAGE drop s)`,
  GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN
  REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN
  MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
  REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_LE]);;

let INF_CLOSURE = prove
 (`!s. inf(IMAGE drop (closure s)) = inf(IMAGE drop s)`,
  GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN
  REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `b <= drop x <=> x IN {x | b <= drop x}`] THEN
  MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
  REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_GE;
              GSYM real_ge]);;

let CONTINUOUS_LE_ON_CLOSURE = prove
 (`!f:real^M->real s a.
        (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a)
        ==> !x. x IN closure(s) ==> f(x) <= a`,
  MESON_TAC[CONTINUOUS_LE_ON_INTERMEDIATE_CLOSURE;
            CLOSURE_SUBSET; SUBSET_REFL]);;

let CONTINUOUS_GE_ON_CLOSURE = prove
 (`!f:real^M->real s a.
        (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x))
        ==> !x. x IN closure(s) ==> a <= f(x)`,
  MESON_TAC[CONTINUOUS_GE_ON_INTERMEDIATE_CLOSURE;
            CLOSURE_SUBSET; SUBSET_REFL]);;

let CONTINUOUS_CONSTANT_ON_CLOSURE = prove
 (`!f:real^M->real^N s a.
        f continuous_on closure(s) /\ (!x. x IN s ==> f(x) = a)
        ==> !x. x IN closure(s) ==> f(x) = a`,
  MESON_TAC[CONTINUOUS_CONSTANT_ON_INTERMEDIATE_CLOSURE;
            CLOSURE_SUBSET; SUBSET_REFL]);;

let CONTINUOUS_AGREE_ON_CLOSURE = prove
 (`!g h:real^M->real^N.
        g continuous_on closure s /\ h continuous_on closure s /\
        (!x. x IN s ==> g x = h x)
        ==> !x. x IN closure s ==> g x = h x`,
  MESON_TAC[CONTINUOUS_AGREE_ON_INTERMEDIATE_CLOSURE;
            CLOSURE_SUBSET; SUBSET_REFL]);;

let CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT = prove
 (`!f:real^M->real^N s a.
        f continuous_on s
        ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x = a}`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
  ASM_REWRITE_TAC[CLOSED_SING]);;

let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove
 (`!f:real^M->real^N s.
      f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN
  ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
  ASM_REWRITE_TAC[CLOSED_SING] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Theorems relating continuity and uniform continuity to closures.          *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_INTERMEDIATE_CLOSURE = prove
 (`!f:real^M->real^N s t.
        t SUBSET closure s /\
        (!x. x IN t ==> (f --> f x) (at x within s))
        ==> f continuous_on t`,
  MP_TAC(ISPECL [`euclidean:(real^M)topology`; `euclidean:(real^N)topology`]
    CONTINUOUS_MAP_ON_INTERMEDIATE_CLOSURE_OF) THEN
  REWRITE_TAC[REGULAR_SPACE_EUCLIDEAN; EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN; LIMIT_EUCLIDEAN; at]);;

let CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ = prove
 (`!f:real^M->real^N s t.
        s SUBSET t /\ t SUBSET closure s
        ==> (f continuous_on t <=>
             !x. x IN t ==> (f --> f x) (at x within s))`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[CONTINUOUS_ON] THEN ASM_MESON_TAC[LIM_WITHIN_SUBSET];
    ASM_MESON_TAC[CONTINUOUS_ON_INTERMEDIATE_CLOSURE]]);;

let CONTINUOUS_ON_CLOSURE = prove
 (`!f:real^M->real^N s.
        f continuous_on closure s <=>
        !x e. x IN closure s /\ &0 < e
              ==> ?d. &0 < d /\
                      !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
  REWRITE_TAC[IMP_IMP; GSYM LIM_SELF_WITHIN] THEN
  MATCH_MP_TAC CONTINUOUS_ON_INTERMEDIATE_CLOSURE_EQ THEN
  REWRITE_TAC[CLOSURE_SUBSET; SUBSET_REFL]);;

let CONTINUOUS_ON_CLOSURE_SEQUENTIALLY = prove
 (`!f:real^M->real^N s.
        f continuous_on closure s <=>
        !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially
              ==> ((f o x) --> f a) sequentially`,
  REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REWRITE_TAC[IMP_IMP; GSYM continuous_within] THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);;

let CONTINUOUS_ON_INTERMEDIATE_CLOSURE_POINTWISE = prove
 (`!f:real^M->real^N s t.
        s SUBSET t /\ t SUBSET closure s /\
        (!x. x IN t ==> f continuous_on (x INSERT s))
        ==> f continuous_on t`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; CONTINUOUS_ON]) THEN
  ASM_MESON_TAC[LIM_WITHIN_SUBSET; SET_RULE `s SUBSET x INSERT s`]);;

let FUNCTION_EXTENSION_POINTWISE = prove
 (`!f:real^M->real^N s t u.
        s SUBSET t /\ t SUBSET closure s /\
        (!x. x IN t ==> ?g. g continuous_on (x INSERT s) /\
                            IMAGE g (x INSERT s) SUBSET u /\
                            (!x. x IN s ==> g x = f x))
        ==> ?g. g continuous_on t /\
                IMAGE g t SUBSET u /\
                (!x. x IN s ==> g x = f x)`,
  REPEAT GEN_TAC THEN MP_TAC(ISPECL
   [`euclidean:(real^M)topology`; `subtopology euclidean (u:real^N->bool)`]
   CONTINUOUS_MAP_EXTENSION_POINTWISE) THEN
  SIMP_TAC[REGULAR_SPACE_EUCLIDEAN; REGULAR_SPACE_SUBTOPOLOGY] THEN
  SIMP_TAC[CONTINUOUS_MAP_EUCLIDEAN2; EUCLIDEAN_CLOSURE_OF; CONJ_ASSOC]);;

let FUNCTION_EXTENSION_POINTWISE_ALT = prove
 (`!f:real^M->real^N s t u.
        s SUBSET t /\ t SUBSET closure s /\ closed u /\
        f continuous_on s /\ IMAGE f s SUBSET u /\
        (!x. x IN t DIFF s ==> ?l. (f --> l) (at x within s))
        ==> ?g. g continuous_on t /\
                IMAGE g t SUBSET u /\
                (!x. x IN s ==> g x = f x)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THENL
   [ASM_CASES_TAC `s:real^M->bool = {}` THEN
    ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; CLOSURE_EMPTY] THEN
    REWRITE_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY];
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN STRIP_TAC] THEN
  MP_TAC(ISPECL
   [`euclidean:(real^M)topology`; `subtopology euclidean (u:real^N->bool)`]
   CONTINUOUS_MAP_EXTENSION_POINTWISE_ALT) THEN
  SIMP_TAC[REGULAR_SPACE_EUCLIDEAN; REGULAR_SPACE_SUBTOPOLOGY] THEN
  REWRITE_TAC[LIMIT_EUCLIDEAN; GSYM at; LIMIT_SUBTOPOLOGY] THEN
  REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2; EUCLIDEAN_CLOSURE_OF; CONJ_ASSOC] THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
  ASM_REWRITE_TAC[EVENTUALLY_WITHIN_IMP; EVENTUALLY_TRUE] THEN
  ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL
   [ASM_MESON_TAC[LIM_TRIVIAL]; MATCH_MP_TAC MONO_EXISTS] THEN
  GEN_TAC THEN SIMP_TAC[] THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC]
        LIM_IN_CLOSED_SET)) THEN
  ASM_SIMP_TAC[EVENTUALLY_WITHIN_IMP; EVENTUALLY_TRUE]);;

let UNIFORMLY_CONTINUOUS_ON_CLOSURE = prove
 (`!f:real^M->real^N s.
        f uniformly_continuous_on s /\ f continuous_on closure s
        ==> f uniformly_continuous_on closure s`,
  REWRITE_TAC[GSYM UNIFORMLY_CONTINUOUS_MAP_EUCLIDEAN] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC UNIFORMLY_CONTINUOUS_MAP_ON_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s:real^M->bool` THEN
  ASM_REWRITE_TAC[UNIFORMLY_CONTINUOUS_MAP_EUCLIDEAN; SUBSET_REFL;
                  EUCLIDEAN_CLOSURE_OF; SUBSET_REFL; CLOSURE_SUBSET;
                  MTOPOLOGY_SUBMETRIC; MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN]);;

(* ------------------------------------------------------------------------- *)
(* Continuity properties for square roots. We get other forms of this        *)
(* later (transcendentals.ml and realanalysis.ml) but it's nice to have      *)
(* them around earlier.                                                      *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_LIFT_SQRT = prove
 (`!s. (lift o sqrt o drop) continuous_on s`,
  GEN_TAC THEN REWRITE_TAC[GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  MATCH_MP_TAC CONTINUOUS_MAP_FROM_SUBTOPOLOGY THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_EQ_LIFT;
              GSYM CONTINUOUS_MAP_DROP_EQ] THEN
  REWRITE_TAC[CONTINUOUS_MAP_SQUARE_ROOT]);;

let CONTINUOUS_AT_SQRT = prove
 (`!a. (lift o sqrt o drop) continuous (at a)`,
  GEN_TAC THEN MP_TAC(SPEC `(:real^1)` CONTINUOUS_ON_LIFT_SQRT) THEN
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]);;

let CONTINUOUS_WITHIN_LIFT_SQRT = prove
 (`!a s. (lift o sqrt o drop) continuous (at a within s)`,
  SIMP_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_SQRT]);;

let CONTINUOUS_WITHIN_SQRT_COMPOSE = prove
 (`!f s a:real^N.
        (\x. lift(f x)) continuous (at a within s)
        ==> (\x. lift(sqrt(f x))) continuous (at a within s)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)`
  SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_LIFT_SQRT] THEN
  ASM_REWRITE_TAC[o_DEF]);;

let CONTINUOUS_AT_SQRT_COMPOSE = prove
 (`!f a:real^N.
        (\x. lift(f x)) continuous (at a)
        ==> (\x. lift(sqrt(f x))) continuous (at a)`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`f:real^N->real`; `(:real^N)`; `a:real^N`]
        CONTINUOUS_WITHIN_SQRT_COMPOSE) THEN
  REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);;

let CONTINUOUS_ON_LIFT_SQRT_COMPOSE = prove
 (`!f:real^N->real s.
        (lift o f) continuous_on s
        ==> (\x. lift(sqrt(f x))) continuous_on s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)`
  SUBST1_TAC THENL
   [REWRITE_TAC[o_DEF; LIFT_DROP];
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
    ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SQRT]]);;

(* ------------------------------------------------------------------------- *)
(* Cauchy continuity, and the extension of functions to closures.            *)
(* ------------------------------------------------------------------------- *)

let UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS = prove
 (`!f:real^M->real^N s.
        f uniformly_continuous_on s
        ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; cauchy; o_DEF] THEN
  MESON_TAC[]);;

let CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ closed s
        ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`,
  REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; CONTINUOUS_ON_SEQUENTIALLY] THEN
  REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]);;

let CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove
 (`!f:real^M->real^N s.
        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
        ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`,
  MP_TAC(ISPECL
   [`euclidean_metric:(real^M)metric`; `euclidean_metric:(real^N)metric`]
        CAUCHY_CONTINUOUS_MAP_EXTENDS_TO_CONTINUOUS_CLOSURE_OF) THEN
  REWRITE_TAC[MCOMPLETE_EUCLIDEAN; cauchy_continuous_map; CAUCHY_IN_SUBMETRIC;
              CAUCHY_IN_EUCLIDEAN; MTOPOLOGY_EUCLIDEAN_METRIC;
              EUCLIDEAN_CLOSURE_OF; CONTINUOUS_MAP_EUCLIDEAN] THEN
  MESON_TAC[]);;

let UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove
 (`!f:real^M->real^N s.
   f uniformly_continuous_on s
   ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> g x = f x) /\
           !h. h continuous_on closure s /\ (!x. x IN s ==> h x = f x)
               ==> !x. x IN closure s ==> h x = g x`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o
   MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE; UNIFORMLY_CONTINUOUS_ON_EQ];
    ASM_MESON_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]);;

let CAUCHY_CONTINUOUS_IMP_CONTINUOUS = prove
 (`!f:real^M->real^N s.
        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CLOSURE_SUBSET; CONTINUOUS_ON_EQ]);;

let BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s.
        f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM
   (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN
  EXISTS_TAC `IMAGE (g:real^M->real^N) (closure s)` THEN CONJ_TAC THENL
   [ASM_MESON_TAC[COMPACT_CLOSURE; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS;
                  COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE];
    MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);;

let LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s.
        (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y))
        ==> f uniformly_continuous_on s`,
  ONCE_REWRITE_TAC[LIPSCHITZ_ON_POS] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[uniformly_continuous_on; dist] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `x:real^M`]) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);;

let BOUNDED_LIPSCHITZ_IMAGE = prove
 (`!f:real^M->real^N s.
        (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)) /\
        bounded s
        ==> bounded (IMAGE f s)`,
  MESON_TAC[BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE;
            LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON]);;

let LIPSCHITZ_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s.
        (?B. !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y))
        ==> f continuous_on s`,
  SIMP_TAC[LIPSCHITZ_IMP_UNIFORMLY_CONTINUOUS_ON;
           UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS]);;

let LIPSCHITZ_LIM = prove
 (`!f:num->real^M->real^N g s b.
      (!n x y. x IN s /\ y IN s ==> norm(f n x - f n y) <= b * norm(x - y)) /\
      (!x. x IN s ==> ((\n. f n x) --> g x) sequentially)
      ==> !x y. x IN s /\ y IN s ==> norm(g x - g y) <= b * norm(x - y)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `x:real^M = y` THEN
  ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LE_REFL; REAL_MUL_RZERO] THEN
  ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
  GEN_REWRITE_TAC I [REAL_LE_TRANS_LTE] THEN
  X_GEN_TAC `c:real` THEN DISCH_TAC THEN
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
  FIRST_X_ASSUM(fun th ->
    MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN
  ASM_REWRITE_TAC[tendsto; IMP_IMP; AND_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `(c - b) / &2 * norm(x - y:real^M)`) THEN
  ASM_SIMP_TAC[REAL_SUB_LT; REAL_HALF; REAL_LT_MUL; NORM_POS_LT;
               VECTOR_SUB_EQ; GSYM EVENTUALLY_AND] THEN
  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[LE_REFL] THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^M`; `y:real^M`]) THEN
  ASM_REWRITE_TAC[IMP_IMP] THEN
  MATCH_MP_TAC(NORM_ARITH
   `a + &2 * b <= c
    ==> norm(fx - fy:real^N) <= a /\ dist(fx,gx) < b /\ dist(fy,gy) < b
        ==> norm(gx - gy) <= c`) THEN
  REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
  MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
  ASM_REAL_ARITH_TAC);;

let LIPSCHITZ_ON_SUP = prove
 (`!P:(real^N->real^1)->bool B s.
        &0 <= B /\
        (!f. P f
             ==> !x y. x IN s /\ y IN s
                       ==> norm(f x - f y) <= B * norm(x - y)) /\
        (!x. x IN s ==> ?C. !f. P f ==> drop(f x) <= C)
        ==> !x y. x IN s /\ y IN s
                  ==> norm(lift(sup {drop(f x) | P f}) -
                           lift(sup {drop(f y) | P f}))
                      <= B * norm(x - y)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `!f:real^N->real^1. ~(P f)` THENL
   [ASM_REWRITE_TAC[SET_RULE `{f x | x | F} = {}`; VECTOR_SUB_REFL] THEN
    ASM_SIMP_TAC[NORM_0; REAL_LE_MUL; NORM_POS_LE];
    ALL_TAC] THEN
  MP_TAC(SPEC `{drop(f(y:real^N)) | P f}` SUP) THEN
  MP_TAC(SPEC `{drop(f(x:real^N)) | P f}` SUP) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  ABBREV_TAC `fy = sup {drop(f(y:real^N)) | P f}` THEN
  ABBREV_TAC `fx = sup {drop(f(x:real^N)) | P f}` THEN
  REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN
  REWRITE_TAC[NORM_1; DROP_SUB; LIFT_DROP; REAL_ARITH
   `abs(x - y) <= b <=> x <= y + b /\ y <= x + b`] THEN
  CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  X_GEN_TAC `f:real^N->real^1` THEN DISCH_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->real^1`)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
    (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
  ASM_REWRITE_TAC[NORM_1; DROP_SUB] THEN REAL_ARITH_TAC);;

let LIPSCHITZ_ON_INF = prove
 (`!P:(real^N->real^1)->bool B s.
        &0 <= B /\
        (!f. P f
             ==> !x y. x IN s /\ y IN s
                       ==> norm(f x - f y) <= B * norm(x - y)) /\
        (!x. x IN s ==> ?C. !f. P f ==> C <= drop(f x))
        ==> !x y. x IN s /\ y IN s
                  ==> norm(lift(inf {drop(f x) | P f}) -
                           lift(inf {drop(f y) | P f}))
                      <= B * norm(x - y)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `!f:real^N->real^1. ~(P f)` THENL
   [ASM_REWRITE_TAC[SET_RULE `{f x | x | F} = {}`; VECTOR_SUB_REFL] THEN
    ASM_SIMP_TAC[NORM_0; REAL_LE_MUL; NORM_POS_LE];
    ALL_TAC] THEN
  MP_TAC(SPEC `{drop(f(y:real^N)) | P f}` INF) THEN
  MP_TAC(SPEC `{drop(f(x:real^N)) | P f}` INF) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  ABBREV_TAC `fy = inf {drop(f(y:real^N)) | P f}` THEN
  ABBREV_TAC `fx = inf {drop(f(x:real^N)) | P f}` THEN
  REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN
  REWRITE_TAC[NORM_1; DROP_SUB; LIFT_DROP; REAL_ARITH
   `abs(x - y) <= b <=> x - b <= y /\ y - b <= x`] THEN
  CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  X_GEN_TAC `f:real^N->real^1` THEN DISCH_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->real^1`)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[REAL_LE_SUB_RADD] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
    (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
  ASM_REWRITE_TAC[NORM_1; DROP_SUB] THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Occasionally useful invariance properties.                                *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_AT_COMPOSE_EQ = prove
 (`!f:real^M->real^N g:real^M->real^M h:real^M->real^M.
        g continuous at x /\ h continuous at (g x) /\
        (!y. g(h y) = y) /\ h(g x) = x
        ==> (f continuous at (g x) <=> (\x. f(g x)) continuous at x)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN
   `((f:real^M->real^N) o (g:real^M->real^M) o (h:real^M->real^M))
     continuous at (g(x:real^M))`
  MP_TAC THENL
   [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
    ASM_REWRITE_TAC[o_DEF];

    ASM_REWRITE_TAC[o_DEF; ETA_AX]]);;

let CONTINUOUS_AT_TRANSLATION = prove
 (`!a z f:real^M->real^N.
      f continuous at (a + z) <=> (\x. f(a + x)) continuous at z`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN
  EXISTS_TAC `\x:real^M. x - a` THEN
  SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_SUB;
           CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN
  VECTOR_ARITH_TAC);;

add_translation_invariants [CONTINUOUS_AT_TRANSLATION];;

let CONTINUOUS_AT_LINEAR_IMAGE = prove
 (`!h:real^M->real^M z f:real^M->real^N.
        linear h /\ (!x. norm(h x) = norm x)
        ==> (f continuous at (h z) <=> (\x. f(h x)) continuous at z)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I
   [GSYM ORTHOGONAL_TRANSFORMATION]) THEN
  FIRST_ASSUM(X_CHOOSE_TAC `g:real^M->real^M` o MATCH_MP
    ORTHOGONAL_TRANSFORMATION_INVERSE) THEN
  MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN
  EXISTS_TAC `g:real^M->real^M` THEN
  RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_TRANSFORMATION]) THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);;

add_linear_invariants [CONTINUOUS_AT_LINEAR_IMAGE];;

(* ------------------------------------------------------------------------- *)
(* Interior of an injective image.                                           *)
(* ------------------------------------------------------------------------- *)

let INTERIOR_IMAGE_SUBSET = prove
 (`!f:real^M->real^N s.
       (!x. f continuous at x) /\ (!x y. f x = f y ==> x = y)
       ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
  REWRITE_TAC[interior; IN_ELIM_THM] THEN
  X_GEN_TAC `y:real^N` THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
  SUBGOAL_THEN `y IN IMAGE (f:real^M->real^N) s` MP_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[IN_IMAGE] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
  EXISTS_TAC `{x | (f:real^M->real^N)(x) IN t}` THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[];
    ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Making a continuous function avoid some value in a neighbourhood.         *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_WITHIN_AVOID = prove
 (`!f:real^M->real^N x s a.
        f continuous (at x within s) /\ x IN s /\  ~(f x = a)
        ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN
  DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x - a)`) THEN
  ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN
  MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN
  GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC);;

let CONTINUOUS_AT_AVOID = prove
 (`!f:real^M->real^N x a.
        f continuous (at x) /\ ~(f x = a)
        ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`,
  MP_TAC CONTINUOUS_WITHIN_AVOID THEN
  REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC `(:real^M)`) THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);;

let CONTINUOUS_ON_AVOID = prove
 (`!f:real^M->real^N x s a.
        f continuous_on s /\ x IN s /\ ~(f x = a)
        ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN
  ASM_SIMP_TAC[]);;

let CONTINUOUS_ON_OPEN_AVOID = prove
 (`!f:real^M->real^N x s a.
        f continuous_on s /\ open s /\ x IN s /\ ~(f x = a)
        ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `open(s:real^M->bool)` THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN
  ASM_SIMP_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Proving a function is constant by proving open-ness of level set.         *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_LEVELSET_OPEN_IN_CASES = prove
 (`!f:real^M->real^N s a.
        connected s /\
        f continuous_on s /\
        open_in (subtopology euclidean s) {x | x IN s /\ f x = a}
        ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> f x = a)`,
  REWRITE_TAC[SET_RULE `(!x. x IN s ==> ~(f x = a)) <=>
                        {x | x IN s /\ f x = a} = {}`;
              SET_RULE `(!x. x IN s ==> f x = a) <=>
                        {x | x IN s /\ f x = a} = s`] THEN
  REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]);;

let CONTINUOUS_LEVELSET_OPEN_IN = prove
 (`!f:real^M->real^N s a.
        connected s /\
        f continuous_on s /\
        open_in (subtopology euclidean s) {x | x IN s /\ f x = a} /\
        (?x. x IN s /\ f x = a)
        ==> (!x. x IN s ==> f x = a)`,
  MESON_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]);;

let CONTINUOUS_LEVELSET_OPEN = prove
 (`!f:real^M->real^N s a.
        connected s /\
        f continuous_on s /\
        open {x | x IN s /\ f x = a} /\
        (?x. x IN s /\ f x = a)
        ==> (!x. x IN s ==> f x = a)`,
  REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN
  ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
  EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x = a}` THEN
  ASM_REWRITE_TAC[] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Some arithmetical combinations (more to prove).                           *)
(* ------------------------------------------------------------------------- *)

let OPEN_SCALING = prove
 (`!s:real^N->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c % x) s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
  STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `e * abs(c)` THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ] THEN
  X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
  EXISTS_TAC `inv(c) % y:real^N` THEN
  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  SUBGOAL_THEN `x = inv(c) % c % x:real^N` SUBST1_TAC THENL
   [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID];
    REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN
    ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN
    ASM_REWRITE_TAC[GSYM dist]]);;

let OPEN_SCALING_EQ = prove
 (`!s:real^N->bool c.
        open(IMAGE (\x. c % x) s) <=> (c = &0 ==> s = {}) /\ open s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[OPEN_EMPTY; NOT_OPEN_SING];
    EQ_TAC THEN ASM_SIMP_TAC[OPEN_SCALING] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP
      (REWRITE_RULE[IMP_CONJ_ALT] OPEN_SCALING)) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; REAL_INV_EQ_0; IMAGE_ID]]);;

let OPEN_NEGATIONS = prove
 (`!s:real^N->bool. open s ==> open (IMAGE (--) s)`,
  SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x`
   (fun th -> SIMP_TAC[th; OPEN_SCALING; REAL_ARITH `~(--(&1) = &0)`]) THEN
  REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;

let OPEN_TRANSLATION = prove
 (`!s a:real^N. open s ==> open(IMAGE (\x. a + x) s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`\x:real^N. x - a`; `s:real^N->bool`]
         CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN
  ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN
  ASM_MESON_TAC[VECTOR_ARITH `(a + x) - a = x:real^N`;
                VECTOR_ARITH `a + (x - a) = x:real^N`]);;

let OPEN_TRANSLATION_EQ = prove
 (`!a s. open (IMAGE (\x:real^N. a + x) s) <=> open s`,
  REWRITE_TAC[open_def] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [OPEN_TRANSLATION_EQ];;

let OPEN_AFFINITY_EQ = prove
 (`!s m c:real^N.
        open(IMAGE (\x. m % x + c) s) <=> (m = &0 ==> s = {}) /\ open s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; OPEN_TRANSLATION_EQ;
              OPEN_SCALING_EQ; IMAGE_o]);;

let OPEN_AFFINITY = prove
 (`!s m c:real^N.
        open s /\ (m = &0 ==> s = {}) ==> open(IMAGE (\x. m % x + c) s)`,
  SIMP_TAC[OPEN_AFFINITY_EQ]);;

let INTERIOR_TRANSLATION = prove
 (`!a:real^N s.
    interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)`,
  REWRITE_TAC[interior] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [INTERIOR_TRANSLATION];;

let OPEN_SUMS = prove
 (`!s t:real^N->bool.
        open s \/ open t ==> open {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`);
    FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN
  ASM_REWRITE_TAC[] 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 REWRITE_TAC[IN_ELIM_THM] THEN
  ASM_MESON_TAC[VECTOR_ADD_SYM; VECTOR_ARITH `(z - y) + y:real^N = z`;
                NORM_ARITH `dist(z:real^N,x + y) < e ==> dist(z - y,x) < e`]);;

(* ------------------------------------------------------------------------- *)
(* Upper and lower hemicontinuous functions, relation in the case of         *)
(* preimage map to open and closed maps, and fact that upper and lower       *)
(* hemicontinuity together imply continuity in the sense of the Hausdorff    *)
(* metric (at points where the function gives a bounded and nonempty set).   *)
(* ------------------------------------------------------------------------- *)

let UPPER_HEMICONTINUOUS = prove
 (`!f:real^M->real^N->bool t s.
        (!x. x IN s ==> f(x) SUBSET t)
        ==> ((!u. open_in (subtopology euclidean t) u
                  ==> open_in (subtopology euclidean s)
                              {x | x IN s /\ f(x) SUBSET u}) <=>
             (!u. closed_in (subtopology euclidean t) u
                  ==> closed_in (subtopology euclidean s)
                                {x | x IN s /\ ~(f(x) INTER u = {})}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
  MATCH_MP_TAC MONO_IMP THEN
  SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL
   [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]; REWRITE_TAC[closed_in]] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);;

let LOWER_HEMICONTINUOUS = prove
 (`!f:real^M->real^N->bool t s.
        (!x. x IN s ==> f(x) SUBSET t)
        ==> ((!u. closed_in (subtopology euclidean t) u
                  ==> closed_in (subtopology euclidean s)
                                {x | x IN s /\ f(x) SUBSET u}) <=>
             (!u. open_in (subtopology euclidean t) u
                  ==> open_in (subtopology euclidean s)
                              {x | x IN s /\ ~(f(x) INTER u = {})}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
  MATCH_MP_TAC MONO_IMP THEN
  SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL
   [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);;

let OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        IMAGE f s SUBSET t
        ==> ((!u. open_in (subtopology euclidean s) u
                  ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
             (!u. closed_in (subtopology euclidean s) u
                      ==> closed_in (subtopology euclidean t)
                                    {y | y IN t /\
                                         {x | x IN s /\ f x = y} SUBSET u}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
    ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
    REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[];
    X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
    ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;

let CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        IMAGE f s SUBSET t
        ==> ((!u. closed_in (subtopology euclidean s) u
                  ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=>
             (!u. open_in (subtopology euclidean s) u
                  ==> open_in (subtopology euclidean t)
                              {y | y IN t /\
                                   {x | x IN s /\ f x = y} SUBSET u}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
    ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
    REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[];
    X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
    ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;

let UPPER_LOWER_HEMICONTINUOUS_EXPLICIT = prove
 (`!f:real^M->real^N->bool t s.
      (!x. x IN s ==> f(x) SUBSET t) /\
      (!u. open_in (subtopology euclidean t) u
           ==> open_in (subtopology euclidean s)
                       {x | x IN s /\ f(x) SUBSET u}) /\
      (!u. closed_in (subtopology euclidean t) u
           ==> closed_in (subtopology euclidean s)
                         {x | x IN s /\ f(x) SUBSET u})
      ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {})
                ==> ?d. &0 < d /\
                        !x'. x' IN s /\ dist(x,x') < d
                             ==> (!y. y IN f x
                                      ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\
                                 (!y'. y' IN f x'
                                       ==> ?y. y IN f x /\ dist(y',y) < e)`,
  REPEAT STRIP_TAC THEN
  UNDISCH_TAC
   `!u. open_in (subtopology euclidean t) u
        ==> open_in (subtopology euclidean s)
                    {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN
  DISCH_THEN(MP_TAC o SPEC
   `t INTER
    {a + b | a IN (f:real^M->real^N->bool) x /\ b IN ball(vec 0,e)}`) THEN
  SIMP_TAC[OPEN_SUMS; OPEN_BALL; OPEN_IN_OPEN_INTER] THEN
  REWRITE_TAC[open_in; SUBSET_RESTRICT] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
  ASM_SIMP_TAC[IN_ELIM_THM; SUBSET_INTER] THEN ANTS_TAC THENL
   [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    ASM_MESON_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID];
    DISCH_THEN(X_CHOOSE_THEN `d1:real`
     (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1")))] THEN
  UNDISCH_TAC
   `!u. closed_in (subtopology euclidean t) u
        ==> closed_in (subtopology euclidean s)
                    {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN
  ASM_SIMP_TAC[LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o
    GEN `a:real^N` o SPEC `t INTER ball(a:real^N,e / &2)`) THEN
  SIMP_TAC[OPEN_BALL; OPEN_IN_OPEN_INTER] THEN

  MP_TAC(SPEC `closure((f:real^M->real^N->bool) x)`
    COMPACT_EQ_HEINE_BOREL) THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC
   `{ball(a:real^N,e / &2) | a IN (f:real^M->real^N->bool) x}`) THEN
  REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_BALL] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL
   [REWRITE_TAC[CLOSURE_APPROACHABLE; SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC[REAL_HALF];
    ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
  DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP
   (MESON[CLOSURE_SUBSET; SUBSET_TRANS]
        `closure s SUBSET t ==> s SUBSET t`)) THEN
  SUBGOAL_THEN
   `open_in (subtopology euclidean s)
      (INTERS {{x | x IN s /\
          ~((f:real^M->real^N->bool) x INTER t INTER ball(a,e / &2) = {})} |
     a IN c})`
  MP_TAC THENL
   [MATCH_MP_TAC OPEN_IN_INTERS THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[open_in] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ANTS_TAC THENL
   [REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN
    X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC `a:real^N` THEN
    ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN
    ASM SET_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `d2:real`
     (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))] THEN
  EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
   [ALL_TAC;
    REMOVE_THEN "1" (MP_TAC o SPEC `x':real^M`) THEN
    ASM_REWRITE_TAC[] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL] THEN
    REWRITE_TAC[VECTOR_ARITH `x:real^N = a + b <=> x - a = b`;
                DIST_0; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
    REWRITE_TAC[dist]] THEN
  REMOVE_THEN "2" (MP_TAC o SPEC `x':real^M`) THEN
  ASM_REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
  DISCH_THEN(LABEL_TAC "3") THEN
  X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  UNDISCH_TAC `(f:real^M->real^N->bool) x SUBSET
               UNIONS (IMAGE (\a. ball (a,e / &2)) c)` THEN
  REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
  ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  REMOVE_THEN "3" (MP_TAC o SPEC `a:real^N`) THEN
  ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_BALL] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);;

(* ------------------------------------------------------------------------- *)
(* Connected components, considered as a "connectedness" relation or a set.  *)
(* ------------------------------------------------------------------------- *)

let connected_component = new_definition
 `connected_component s x y <=>
        ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t`;;

let CONNECTED_COMPONENT_OF_EUCLIDEAN = prove
 (`!s x:real^N.
     connected_component_of (subtopology euclidean s) x =
     connected_component s x`,
  REWRITE_TAC[FUN_EQ_THM; connected_component_of; connected_component] THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY; CONNECTED_IN_EUCLIDEAN] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC]);;

let CONNECTED_COMPONENT_IN = prove
 (`!s x y. connected_component s x y ==> x IN s /\ y IN s`,
  REWRITE_TAC[connected_component] THEN SET_TAC[]);;

let CONNECTED_COMPONENT_REFL = prove
 (`!s x:real^N. x IN s ==> connected_component s x x`,
  REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN
  EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[CONNECTED_SING] THEN
  ASM SET_TAC[]);;

let CONNECTED_COMPONENT_REFL_EQ = prove
 (`!s x:real^N. connected_component s x x <=> x IN s`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN
  REWRITE_TAC[connected_component] THEN SET_TAC[]);;

let CONNECTED_COMPONENT_SYM = prove
 (`!s x y:real^N. connected_component s x y ==> connected_component s y x`,
  REWRITE_TAC[connected_component] THEN MESON_TAC[]);;

let CONNECTED_COMPONENT_TRANS = prove
 (`!s x y:real^N.
    connected_component s x y /\ connected_component s y z
    ==> connected_component s x z`,
  REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `t:real^N->bool`)
                             (X_CHOOSE_TAC `u:real^N->bool`)) THEN
  EXISTS_TAC `t UNION u:real^N->bool` THEN
  ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN
  MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);;

let CONNECTED_COMPONENT_OF_SUBSET = prove
 (`!s t x. s SUBSET t /\ connected_component s x y
           ==> connected_component t x y`,
  REWRITE_TAC[connected_component] THEN SET_TAC[]);;

let CONNECTED_COMPONENT_SET = prove
 (`!s x. connected_component s x =
            { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}`,
  REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN
  REWRITE_TAC[IN; connected_component] THEN MESON_TAC[]);;

let CONNECTED_COMPONENT_UNIONS = prove
 (`!s x. connected_component s x =
                UNIONS {t | connected t /\ x IN t /\ t SUBSET s}`,
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;

let CONNECTED_COMPONENT_SUBSET = prove
 (`!s x. (connected_component s x) SUBSET s`,
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;

let CONNECTED_CONNECTED_COMPONENT_SET = prove
 (`!s. connected s <=> !x:real^N. x IN s ==> connected_component s x = s`,
  GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN EQ_TAC THENL
   [SET_TAC[]; ALL_TAC] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
  ASM SET_TAC[]);;

let CONNECTED_COMPONENT_UNIV = prove
 (`!x. connected_component(:real^N) x = (:real^N)`,
  MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; CONNECTED_UNIV; IN_UNIV]);;

let CONNECTED_COMPONENT_EQ_UNIV = prove
 (`!s x. connected_component s x = (:real^N) <=> s = (:real^N)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONNECTED_COMPONENT_UNIV] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s = UNIV ==> t = UNIV`) THEN
  REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);;

let CONNECTED_COMPONENT_EQ_SELF = prove
 (`!s x. connected s /\ x IN s ==> connected_component s x = s`,
  MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]);;

let CONNECTED_IFF_CONNECTED_COMPONENT = prove
 (`!s. connected s <=>
          !x y. x IN s /\ y IN s ==> connected_component s x y`,
  REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN
  REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN; CONNECTED_COMPONENT_IN]);;

let CONNECTED_IMP_CONNECTED_COMPONENT = prove
 (`!s a b:real^N.
     connected s /\ a IN s /\ b IN s ==> connected_component s a b`,
  MESON_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);;

let CONNECTED_COMPONENT_MAXIMAL = prove
 (`!s t x:real^N.
        x IN t /\ connected t /\ t SUBSET s
        ==> t SUBSET (connected_component s x)`,
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;

let CONNECTED_COMPONENT_MONO = prove
 (`!s t x. s SUBSET t
           ==> (connected_component s x) SUBSET (connected_component t x)`,
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;

let CONNECTED_CONNECTED_COMPONENT = prove
 (`!s x. connected(connected_component s x)`,
  REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN SET_TAC[]);;

let CONNECTED_COMPONENT_EQ_EMPTY = prove
 (`!s x:real^N. connected_component s x = {} <=> ~(x IN s)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
    REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
    REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]);;

let CONNECTED_COMPONENT_EMPTY = prove
 (`!x. connected_component {} x = {}`,
  REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);;

let CONNECTED_COMPONENT_EQ = prove
 (`!s x y. y IN connected_component s x
           ==> (connected_component s y = connected_component s x)`,
  REWRITE_TAC[EXTENSION; IN] THEN
  MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);;

let CLOSED_CONNECTED_COMPONENT = prove
 (`!s x:real^N. closed s ==> closed(connected_component s x)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `(x:real^N) IN s` THENL
   [ALL_TAC; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CLOSED_EMPTY]] THEN
  REWRITE_TAC[GSYM CLOSURE_EQ] THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
  SIMP_TAC[CONNECTED_CLOSURE; CONNECTED_CONNECTED_COMPONENT] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
    ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
    MATCH_MP_TAC CLOSURE_MINIMAL THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;

let CONNECTED_COMPONENT_DISJOINT = prove
 (`!s a b. DISJOINT (connected_component s a) (connected_component s b) <=>
             ~(a IN connected_component s b)`,
  REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
  REWRITE_TAC[IN] THEN
  MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);;

let CONNECTED_COMPONENT_NONOVERLAP = prove
 (`!s a b:real^N.
        (connected_component s a) INTER (connected_component s b) = {} <=>
        ~(a IN s) \/ ~(b IN s) \/
        ~(connected_component s a = connected_component s b)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
  ASM_REWRITE_TAC[INTER_EMPTY] THEN
  ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
  ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC
   `connected_component s (a:real^N) = connected_component s b` THEN
  ASM_REWRITE_TAC[INTER_IDEMPOT; CONNECTED_COMPONENT_EQ_EMPTY] THEN
  FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DISJOINT]) THEN
  REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]);;

let CONNECTED_COMPONENT_OVERLAP = prove
 (`!s a b:real^N.
        ~((connected_component s a) INTER (connected_component s b) = {}) <=>
        a IN s /\ b IN s /\
        connected_component s a = connected_component s b`,
  REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP; DE_MORGAN_THM]);;

let CONNECTED_COMPONENT_SYM_EQ = prove
 (`!s x y. connected_component s x y <=> connected_component s y x`,
  MESON_TAC[CONNECTED_COMPONENT_SYM]);;

let CONNECTED_COMPONENT_EQ_EQ = prove
 (`!s x y:real^N.
        connected_component s x = connected_component s y <=>
           ~(x IN s) /\ ~(y IN s) \/
           x IN s /\ y IN s /\ connected_component s x y`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL
   [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL
     [REWRITE_TAC[FUN_EQ_THM] THEN
      ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_REFL;
                    CONNECTED_COMPONENT_SYM];
      ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]];
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
    ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
    ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]);;

let CONNECTED_EQ_CONNECTED_COMPONENT_EQ = prove
 (`!s. connected s <=>
       !x y. x IN s /\ y IN s
             ==> connected_component s x = connected_component s y`,
  SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);;

let CONNECTED_COMPONENT_IDEMP = prove
 (`!s x:real^N. connected_component (connected_component s x) x =
                connected_component s x`,
  REWRITE_TAC[FUN_EQ_THM; connected_component] THEN
  REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL; SUBSET_TRANS;
                CONNECTED_COMPONENT_SUBSET]);;

let CONNECTED_COMPONENT_UNIQUE = prove
 (`!s c x:real^N.
        x IN c /\ c SUBSET s /\ connected c /\
        (!c'. x IN c' /\ c' SUBSET s /\ connected c'
              ==> c' SUBSET c)
        ==> connected_component s x = c`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
    REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM SET_TAC[];
    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);;

let JOINABLE_CONNECTED_COMPONENT_EQ = prove
 (`!s t x y:real^N.
        connected t /\ t SUBSET s /\
        ~(connected_component s x INTER t = {}) /\
        ~(connected_component s y INTER t = {})
        ==> connected_component s x = connected_component s y`,
  REPEAT GEN_TAC THEN
  REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)) THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
  REWRITE_TAC[IN] THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
  EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
  EXISTS_TAC `w:real^N` THEN CONJ_TAC THENL
   [REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
    ASM_MESON_TAC[IN; CONNECTED_COMPONENT_SYM]]);;

let CONNECTED_COMPONENT_TRANSLATION = prove
 (`!a s x. connected_component (IMAGE (\x. a + x) s) (a + x) =
                IMAGE (\x. a + x) (connected_component s x)`,
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [CONNECTED_COMPONENT_TRANSLATION];;

let CONNECTED_COMPONENT_LINEAR_IMAGE = prove
 (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
           ==> connected_component (IMAGE f s) (f x) =
               IMAGE f (connected_component s x)`,
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN
  GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [CONNECTED_COMPONENT_LINEAR_IMAGE];;

let UNIONS_CONNECTED_COMPONENT = prove
 (`!s:real^N->bool. UNIONS {connected_component s x |x| x IN s} = s`,
  GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; CONNECTED_COMPONENT_SUBSET] THEN
  REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]);;

let COMPLEMENT_CONNECTED_COMPONENT_UNIONS = prove
 (`!s x:real^N.
     s DIFF connected_component s x =
     UNIONS({connected_component s y | y | y IN s} DELETE
            (connected_component s x))`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
    [GSYM UNIONS_CONNECTED_COMPONENT] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x. x IN s DELETE a ==> DISJOINT a x)
     ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN
  REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
  SIMP_TAC[CONNECTED_COMPONENT_DISJOINT; CONNECTED_COMPONENT_EQ_EQ] THEN
  MESON_TAC[IN; SUBSET; CONNECTED_COMPONENT_SUBSET]);;

let CLOSED_IN_CONNECTED_COMPONENT = prove
 (`!s x:real^N. closed_in (subtopology euclidean s) (connected_component s x)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
  ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN
  EXISTS_TAC `closure(connected_component s x):real^N->bool` THEN
  REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  REWRITE_TAC[SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET] THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN
  CONJ_TAC THENL
   [ASM_REWRITE_TAC[IN_INTER] THEN
    MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
    ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
    MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
    EXISTS_TAC `connected_component s (x:real^N)` THEN
    REWRITE_TAC[INTER_SUBSET; CONNECTED_CONNECTED_COMPONENT;
                SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET]]);;

let OPEN_IN_CONNECTED_COMPONENT = prove
 (`!s x:real^N.
        FINITE {connected_component s x |x| x IN s}
        ==> open_in (subtopology euclidean s) (connected_component s x)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `connected_component s (x:real^N) =
        s DIFF (UNIONS {connected_component s y |y| y IN s} DIFF
                connected_component s x)`
  SUBST1_TAC THENL
   [REWRITE_TAC[UNIONS_CONNECTED_COMPONENT] THEN
    MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s DIFF (s DIFF t)`) THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
    MATCH_MP_TAC OPEN_IN_DIFF THEN
    REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
    REWRITE_TAC[UNIONS_DIFF] THEN
    MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `connected_component s y DIFF connected_component s x =
      connected_component s y \/
      connected_component s (y:real^N) DIFF connected_component s x = {}`
     (DISJ_CASES_THEN SUBST1_TAC)
    THENL
     [MATCH_MP_TAC(SET_RULE
       `(~(s INTER t = {}) ==> s = t) ==> s DIFF t = s \/ s DIFF t = {}`) THEN
      SIMP_TAC[CONNECTED_COMPONENT_OVERLAP];
      REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT];
      REWRITE_TAC[CLOSED_IN_EMPTY]]]);;

let CONNECTED_COMPONENT_EQUIVALENCE_RELATION = prove
 (`!R s:real^N->bool.
        (!x y. R x y ==> R y x) /\
        (!x y z. R x y /\ R y z ==> R x z) /\
        (!a. a IN s
             ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
                     !x. x IN t ==> R a x)
        ==> !a b. connected_component s a b ==> R a b`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`R:real^N->real^N->bool`; `connected_component s (a:real^N)`]
    CONNECTED_EQUIVALENCE_RELATION) THEN
  ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL
   [X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ANTS_TAC THENL
     [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `t INTER connected_component s (a:real^N)` THEN
    ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`]
        CONNECTED_COMPONENT_SUBSET) THEN
    SET_TAC[];
    DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]);;

let CONNECTED_COMPONENT_INTERMEDIATE_SUBSET = prove
 (`!t u a:real^N.
        connected_component u a SUBSET t /\ t SUBSET u
        ==> connected_component t a = connected_component u a`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
    ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM SET_TAC[];
    ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; SUBSET]]);;

let CONNECTED_UNIONS_STRONG = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> connected s) /\
        ~(UNIONS f INTER INTERS {closure s | s IN f} = {})
        ==> connected(UNIONS f)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[IN_INTER; IN_UNIONS; INTERS_GSPEC; IN_ELIM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2
   (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) ASSUME_TAC)) THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  SUBGOAL_THEN `(z:real^N) IN UNIONS f` ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `!x:real^N. x IN UNIONS f ==> connected_component (UNIONS f) z x`
   (fun th -> ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS;
                            CONNECTED_COMPONENT_SYM; th]) THEN
  REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM; connected_component] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
  EXISTS_TAC `u UNION c:real^N->bool` THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC CONNECTED_UNION_STRONG THEN ASM SET_TAC[]);;

let NOT_CONNECTED_COMPONENT_SEPARATED_UNION = prove
 (`!s t x y:real^N.
        s INTER closure t = {} /\ t INTER closure s = {} /\ x IN s /\ y IN t
        ==> ~connected_component (s UNION t) x y`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[connected_component] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_SEPARATION_ALT]) THEN
  REWRITE_TAC[] THEN
  MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
  ASM SET_TAC[]);;

let CONNECTED_COMPONENT_SEPARATED_UNION = prove
 (`!s t x:real^N.
        s INTER closure t = {} /\ t INTER closure s = {}
        ==> connected_component (s UNION t) x =
            if x IN s then connected_component s x
            else if x IN t then connected_component t x
            else {}`,
  REPEAT STRIP_TAC THEN
  REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; IN_UNION] THEN
  SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; CONNECTED_COMPONENT_MONO; SUBSET_UNION] THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
  REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNION] THEN
  MATCH_MP_TAC(SET_RULE
   `connected_component s x SUBSET s /\
    (!y. ~(y IN t) ==> y IN s ==> ~(connected_component s x y))
    ==> connected_component s x SUBSET t`) THEN
  SIMP_TAC[CONNECTED_COMPONENT_SUBSET; IN_UNION] THEN
  ASM_SIMP_TAC[NOT_CONNECTED_COMPONENT_SEPARATED_UNION] THEN
  ONCE_REWRITE_TAC[UNION_COMM] THEN
  ASM_SIMP_TAC[NOT_CONNECTED_COMPONENT_SEPARATED_UNION]);;

let CONNECTED_CONNECTED_DIFF = prove
 (`!s t:real^N->bool.
        connected s /\ s SUBSET closure(s DIFF t) /\
        (!x. x IN s
             ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\
                     connected(u DIFF t))
        ==> connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF] THEN
  REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN
  MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`; `u:real^N->bool`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
    ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
    ASM_REWRITE_TAC[CLOSURE_NONEMPTY_OPEN_INTER] THEN
    DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM SET_TAC[];
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^N->bool` THEN
    ONCE_REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ASM_REWRITE_TAC[IN_DIFF] THEN
    REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
    MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN MATCH_MP_TAC(SET_RULE
     `P SUBSET Q ==> P x ==> Q x`) THEN REWRITE_TAC[ETA_AX] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]]);;

let CONNECTED_COMPONENT_FINITE = prove
 (`!s x:real^N.
        FINITE s ==> connected_component s x = if x IN s then {x} else {}`,
  REWRITE_TAC[GSYM CONNECTED_COMPONENT_OF_EUCLIDEAN] THEN
  SIMP_TAC[SUBTOPOLOGY_EUCLIDEAN_EQ_DISCRETE_TOPOLOGY_FINITE] THEN
  REWRITE_TAC[CONNECTED_COMPONENT_OF_DISCRETE_TOPOLOGY]);;

(* ------------------------------------------------------------------------- *)
(* The set of connected components of a set.                                 *)
(* ------------------------------------------------------------------------- *)

let components = new_definition
  `components s = {connected_component s x | x | x:real^N IN s}`;;

let EUCLIDEAN_CONNECTED_COMPONENTS_OF = prove
 (`!s:real^N->bool.
        connected_components_of (subtopology euclidean s) = components s`,
  REWRITE_TAC[connected_components_of; components] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
              CONNECTED_COMPONENT_OF_EUCLIDEAN]);;

let PAIRWISE_SEPARATED_COMPONENTS = prove
 (`!s:real^N->bool. pairwise (separated_in euclidean) (components s)`,
  GEN_TAC THEN
  MP_TAC(ISPEC `subtopology euclidean (s:real^N->bool)`
        PAIRWISE_SEPARATED_CONNECTED_COMPONENTS_OF) THEN
  REWRITE_TAC[EUCLIDEAN_CONNECTED_COMPONENTS_OF] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] PAIRWISE_IMP) THEN
  SIMP_TAC[SEPARATED_IN_SUBTOPOLOGY]);;

let COMPONENTS_TRANSLATION = prove
 (`!a s. components(IMAGE (\x. a + x) s) =
   IMAGE (IMAGE (\x. a + x)) (components s)`,
  REWRITE_TAC[components] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);;

add_translation_invariants [COMPONENTS_TRANSLATION];;

let COMPONENTS_LINEAR_IMAGE = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
           ==> components(IMAGE f s) = IMAGE (IMAGE f) (components s)`,
  REWRITE_TAC[components] THEN GEOM_TRANSFORM_TAC[] THEN SET_TAC[]);;

add_linear_invariants [COMPONENTS_LINEAR_IMAGE];;

let IN_COMPONENTS = prove
 (`!u:real^N->bool s. s IN components u
    <=> ?x. x IN u /\ s = connected_component u x`,
  REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC
  THENL [SET_TAC[];STRIP_TAC THEN ASM_SIMP_TAC[] THEN
  UNDISCH_TAC `x:real^N IN u` THEN SET_TAC[]]);;

let CONNECTED_COMPONENTS = prove
 (`!s a b:real^N.
        connected_component s a b <=>
        ?c. c IN components s /\ a IN c /\ b IN c`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPEC `s:real^N->bool` CONNECTED_COMPONENT_SUBSET) THEN
  REWRITE_TAC[components; EXISTS_IN_GSPEC; SUBSET] THEN REWRITE_TAC[IN] THEN
  MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]);;

let UNIONS_COMPONENTS = prove
 (`!u:real^N->bool. u = UNIONS (components u)`,
  REWRITE_TAC[EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC
  THENL[DISCH_TAC THEN REWRITE_TAC[IN_UNIONS] THEN
  EXISTS_TAC `connected_component (u:real^N->bool) x` THEN CONJ_TAC THENL
  [REWRITE_TAC[components] THEN SET_TAC[ASSUME `x:real^N IN u`];
  REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SUBGOAL_THEN
  `?s:real^N->bool. connected s /\ s SUBSET u /\ x IN s` MP_TAC
  THENL[EXISTS_TAC `{x:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN
  POP_ASSUM MP_TAC THEN SET_TAC[]; SET_TAC[]]];
  REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN
  MATCH_MP_TAC (SET_RULE `!x:real^N s u. x IN s /\ s SUBSET u ==> x IN u`) THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_ASSUME_TAC
  (MESON[IN_COMPONENTS;ASSUME `t:real^N->bool IN components u`]
  `?y. t:real^N->bool = connected_component u y`) THEN
   ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;

let PAIRWISE_DISJOINT_COMPONENTS = prove
 (`!u:real^N->bool. pairwise DISJOINT (components u)`,
  GEN_TAC THEN REWRITE_TAC[pairwise;DISJOINT] THEN
  MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN
  ASSERT_TAC `(?a. s:real^N->bool = connected_component u a) /\
  ?b. t:real^N->bool = connected_component u b`
  THENL [ASM_MESON_TAC[IN_COMPONENTS];
  ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]);;

let IN_COMPONENTS_NONEMPTY = prove
 (`!s c. c IN components s ==> ~(c = {})`,
  REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;

let IN_COMPONENTS_SUBSET = prove
 (`!s c. c IN components s ==> c SUBSET s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);;

let IN_COMPONENTS_CONNECTED = prove
 (`!s c. c IN components s ==> connected c`,
  REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);;

let CONNECTED_COMPONENT_IN_COMPONENTS = prove
 (`!s x:real^N. connected_component s x IN components s <=> x IN s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
  ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[components; IN_ELIM_THM] THEN ASM_MESON_TAC[];
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
    ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]]);;

let IN_COMPONENTS_MAXIMAL = prove
 (`!s c:real^N->bool.
        c IN components s <=>
        ~(c = {}) /\ c SUBSET s /\ connected c /\
        !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c'
             ==> c' = c`,
  REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_SUBSET;
                    CONNECTED_CONNECTED_COMPONENT] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN; SUBSET];
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
    DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN
    REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]]);;

let JOINABLE_COMPONENTS_EQ = prove
 (`!s t c1 c2.
        connected t /\ t SUBSET s /\
        c1 IN components s /\ c2 IN components s /\
        ~(c1 INTER t = {}) /\ ~(c2 INTER t = {})
        ==> c1 = c2`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN
  MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]);;

let CLOSED_IN_COMPONENT = prove
 (`!s c:real^N->bool.
        c IN components s ==> closed_in (subtopology euclidean s) c`,
  REWRITE_TAC[components; FORALL_IN_GSPEC; CLOSED_IN_CONNECTED_COMPONENT]);;

let CLOSED_COMPONENTS = prove
 (`!s c. closed s /\ c IN components s ==> closed c`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN
  SIMP_TAC[CLOSED_CONNECTED_COMPONENT]);;

let COMPACT_CONNECTED_COMPONENT = prove
 (`!s a:real^N. compact s ==> compact(connected_component s a)`,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_COMPACT) THEN
  REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT]);;

let COMPACT_COMPONENTS = prove
 (`!s c:real^N->bool. compact s /\ c IN components s ==> compact c`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
  MESON_TAC[CLOSED_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET]);;

let CONTINUOUS_ON_COMPONENTS_GEN = prove
 (`!f:real^M->real^N s.
        (!c. c IN components s
             ==> open_in (subtopology euclidean s) c /\ f continuous_on c)
        ==> f continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
  DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x IN t} =
    UNIONS {{x | x IN c /\ f x IN t} | c IN components s}`
  SUBST1_TAC THENL
   [CONV_TAC(LAND_CONV(SUBS_CONV
     [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN
    REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[];
    MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
    ASM_MESON_TAC[OPEN_IN_TRANS]]);;

let CONTINUOUS_ON_COMPONENTS_FINITE = prove
 (`!f:real^M->real^N s.
        FINITE(components s) /\
        (!c. c IN components s ==> f continuous_on c)
        ==> f continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
  DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x IN t} =
    UNIONS {{x | x IN c /\ f x IN t} | c IN components s}`
  SUBST1_TAC THENL
   [CONV_TAC(LAND_CONV(SUBS_CONV
     [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN
    REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[];
    MATCH_MP_TAC CLOSED_IN_UNIONS THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
    ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_COMPONENT]]);;

let COMPONENTS_NONOVERLAP = prove
 (`!s c c'. c IN components s /\ c' IN components s
            ==> (c INTER c' = {} <=> ~(c = c'))`,
  REWRITE_TAC[components; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[CONNECTED_COMPONENT_NONOVERLAP]);;

let COMPONENTS_EQ = prove
 (`!s c c'. c IN components s /\ c' IN components s
            ==> (c = c' <=> ~(c INTER c' = {}))`,
  MESON_TAC[COMPONENTS_NONOVERLAP]);;

let COMPONENTS_EQ_EMPTY = prove
 (`!s. components s = {} <=> s = {}`,
  GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN
  REWRITE_TAC[components; connected_component; IN_ELIM_THM] THEN
  SET_TAC[]);;

let COMPONENTS_EMPTY = prove
 (`components {} = {}`,
  REWRITE_TAC[COMPONENTS_EQ_EMPTY]);;

let CONNECTED_EQ_CONNECTED_COMPONENTS_EQ = prove
 (`!s. connected s <=>
       !c c'. c IN components s /\ c' IN components s ==> c = c'`,
  REWRITE_TAC[components; IN_ELIM_THM] THEN
  MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]);;

let COMPONENTS_EQ_SING,COMPONENTS_EQ_SING_EXISTS = (CONJ_PAIR o prove)
 (`(!s:real^N->bool. components s = {s} <=> connected s /\ ~(s = {})) /\
   (!s:real^N->bool. (?a. components s = {a}) <=> connected s /\ ~(s = {}))`,
  REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN
  MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p)
                     ==> (p <=> r) /\ (q <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[];
    STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN
    ASM_MESON_TAC[IN_SING; COMPONENTS_EQ_EMPTY; NOT_INSERT_EMPTY];
    STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN
    REWRITE_TAC[IN_SING] THEN
    REWRITE_TAC[components; IN_ELIM_THM] THEN
    ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; MEMBER_NOT_EMPTY]]);;

let CONNECTED_EQ_COMPONENTS_SING = prove
 (`!s:real^N->bool. connected s <=> s = {} \/ components s = {s}`,
  MESON_TAC[COMPONENTS_EQ_SING; CONNECTED_EMPTY]);;

let CONNECTED_EQ_COMPONENTS_SING_EXISTS = prove
 (`!s:real^N->bool. connected s <=> s = {} \/ (?a. components s = {a})`,
  MESON_TAC[COMPONENTS_EQ_SING_EXISTS; CONNECTED_EMPTY]);;

let CONNECTED_EQ_CARD_COMPONENTS = prove
 (`!s:real^N->bool.
      connected s <=> FINITE(components s) /\ CARD(components s) <= 1`,
  GEN_TAC THEN REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SING_EXISTS] THEN
  REWRITE_TAC[ARITH_RULE `n <= 1 <=> n = 0 \/ n = 1`] THEN
  REWRITE_TAC[IMP_IMP; LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN
  CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
  REWRITE_TAC[COMPONENTS_EQ_EMPTY]);;

let COMPONENTS_UNIV = prove
 (`components(:real^N) = {(:real^N)}`,
  REWRITE_TAC[COMPONENTS_EQ_SING; CONNECTED_UNIV; UNIV_NOT_EMPTY]);;

let CONNECTED_EQ_COMPONENTS_SUBSET_SING = prove
 (`!s:real^N->bool. connected s <=> components s SUBSET {s}`,
  GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN
  REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN
  ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING]);;

let CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS = prove
 (`!s:real^N->bool. connected s <=> ?a. components s SUBSET {a}`,
  GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN
  REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN
  ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING_EXISTS]);;

let IN_COMPONENTS_SELF = prove
 (`!s:real^N->bool. s IN components s <=> connected s /\ ~(s = {})`,
  GEN_TAC THEN EQ_TAC THENL
   [MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED];
    SIMP_TAC[GSYM COMPONENTS_EQ_SING; IN_SING]]);;

let COMPONENTS_MAXIMAL = prove
 (`!s t c:real^N->bool.
     c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {})
     ==> t SUBSET c`,
  REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC] THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]);;

let IN_COMPONENTS_MAXIMAL_ALT = prove
 (`!s c:real^N->bool.
        c IN components s <=>
        ~(c = {}) /\ c SUBSET s /\ connected c /\
        (!c'. ~(c INTER c' = {}) /\ c' SUBSET s /\ connected c'
              ==> c' SUBSET c)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC COMPONENTS_MAXIMAL THEN ASM_MESON_TAC[];
    STRIP_TAC THEN ASM_REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]);;

let COMPONENTS_UNIQUE = prove
 (`!s:real^N->bool k.
        UNIONS k = s /\
        (!c. c IN k
             ==> connected c /\ ~(c = {}) /\
                 !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)
        ==> components s = k`,
  REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
  X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS] THEN
  EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_THEN `x:real^N`
     (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
    FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN
    REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
    SUBGOAL_THEN `connected_component s (x:real^N) = c`
     (fun th -> ASM_REWRITE_TAC[th]) THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN
    REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONNECTED_UNION; ASM SET_TAC[]] THEN
    ASM SET_TAC[];
    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
    CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;

let COMPONENTS_UNIQUE_EQ = prove
 (`!s:real^N->bool k.
        components s = k <=>
        UNIONS k = s /\
        (!c. c IN k
             ==> connected c /\ ~(c = {}) /\
                 !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_THEN(SUBST1_TAC o SYM); REWRITE_TAC[COMPONENTS_UNIQUE]] THEN
  REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN
  X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
    ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
    RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN
    ASM_MESON_TAC[SUBSET_EMPTY]]);;

let COMPONENTS_UNIQUE_2 = prove
 (`!s c1 c2:real^N->bool.
        connected c1 /\ connected c2 /\ c1 UNION c2 = s /\ ~connected s
        ==> components s = {c1,c2}`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `c1:real^N->bool = {}` THENL
   [ASM_MESON_TAC[UNION_EMPTY]; ALL_TAC] THEN
  ASM_CASES_TAC `c2:real^N->bool = {}` THENL
   [ASM_MESON_TAC[UNION_EMPTY]; ALL_TAC] THEN
  STRIP_TAC THEN MATCH_MP_TAC COMPONENTS_UNIQUE THEN
  ASM_REWRITE_TAC[UNIONS_2; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
  CONJ_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THENL
   [MP_TAC(ISPECL [`c:real^N->bool`; `c2:real^N->bool`]
        CONNECTED_UNION) THEN
    SUBGOAL_THEN `c UNION c2:real^N->bool = s` SUBST1_TAC THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    MP_TAC(ISPECL [`c1:real^N->bool`; `c:real^N->bool`]
        CONNECTED_UNION) THEN
    SUBGOAL_THEN `c1 UNION c:real^N->bool = s` SUBST1_TAC THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;

let EXISTS_COMPONENT_SUPERSET = prove
 (`!s t:real^N->bool.
        t SUBSET s /\ ~(s = {}) /\ connected t
        ==> ?c. c IN components s /\ t SUBSET c`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN
    ASM_MESON_TAC[COMPONENTS_EQ_EMPTY; MEMBER_NOT_EMPTY];
    FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o
      GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    EXISTS_TAC `connected_component s (a:real^N)` THEN
    REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL
     [ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]);;

let COMPONENTS_INTERMEDIATE_SUBSET = prove
 (`!s t u:real^N->bool.
        s IN components u /\ s SUBSET t /\ t SUBSET u
        ==> s IN components t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN
  MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; SUBSET;
            CONNECTED_COMPONENT_REFL; IN; CONNECTED_COMPONENT_SUBSET]);;

let FINITE_COMPONENTS_FINITE = prove
 (`!s:real^N->bool. FINITE s ==> FINITE(components s)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[GSYM EUCLIDEAN_CONNECTED_COMPONENTS_OF] THEN
  MATCH_MP_TAC FINITE_CONNECTED_COMPONENTS_OF_FINITE THEN
  ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let COMPONENTS_FINITE = prove
 (`!s:real^N->bool. FINITE s ==> components s = {{x} | x IN s}`,
  REWRITE_TAC[GSYM EUCLIDEAN_CONNECTED_COMPONENTS_OF] THEN
  SIMP_TAC[SUBTOPOLOGY_EUCLIDEAN_EQ_DISCRETE_TOPOLOGY_FINITE] THEN
  REWRITE_TAC[CONNECTED_COMPONENTS_OF_DISCRETE_TOPOLOGY]);;

let COMPONENTS_INTER_COMPONENTS = prove
 (`!s t c d:real^N->bool.
        c IN components s /\ d IN components (t INTER c)
        ==> d IN components(t INTER s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[IN_COMPONENTS_MAXIMAL_ALT; SUBSET_INTER] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let IN_COMPONENTS_UNIONS_COMPLEMENT = prove
 (`!s c:real^N->bool.
        c IN components s
        ==> s DIFF c = UNIONS(components s DELETE c)`,
  REWRITE_TAC[components; FORALL_IN_GSPEC;
              COMPLEMENT_CONNECTED_COMPONENT_UNIONS]);;

let CONNECTED_SUBSET_CLOPEN = prove
 (`!u s c:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) s /\
        connected c /\ c SUBSET u /\ ~(c INTER s = {})
        ==> c SUBSET s`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN
  REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o
    SPECL [`c INTER s:real^N->bool`; `c DIFF s:real^N->bool`]) THEN
  ASM_REWRITE_TAC[CONJ_ASSOC; SET_RULE `c DIFF s = {} <=> c SUBSET s`] THEN
  MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN
  REPLICATE_TAC 2 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
  CONJ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]);
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN])] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[OPEN_IN_OPEN; CLOSED_IN_CLOSED] THENL
   [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `(:real^N) DIFF t`] THEN
  ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);;

let CLOPEN_UNIONS_COMPONENTS = prove
 (`!u s:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) s
        ==> ?k. k SUBSET components u /\ s = UNIONS k`,
  REPEAT STRIP_TAC THEN
  EXISTS_TAC `{c:real^N->bool | c IN components u /\ ~(c INTER s = {})}` THEN
  REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  CONJ_TAC THENL
   [MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[];
    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN
    EXISTS_TAC `u:real^N->bool` THEN
    ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]]);;

let CLOPEN_IN_COMPONENTS = prove
 (`!u s:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) s /\
        connected s /\ ~(s = {})
        ==> s IN components u`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_UNIONS_COMPONENTS) THEN
  DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `k:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[UNIONS_0] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN
  ASM_CASES_TAC `k = {c:real^N->bool}` THENL
   [ASM_MESON_TAC[UNIONS_1; GSYM SING_SUBSET]; ALL_TAC] THEN
  MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN
  SUBGOAL_THEN `?c':real^N->bool. c' IN k /\ ~(c = c')` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[SET_RULE
     `a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)`];
    REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN
    DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `c':real^N->bool`]) THEN
    ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN
    MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN
    EXISTS_TAC `u:real^N->bool` THEN
    MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN ASM SET_TAC[]]);;

let CONNECTED_UNIONS_PAIRWISE = prove
 (`!f. (!s:real^N->bool. s IN f ==> connected s) /\
       pairwise (\s t. ~(s = {}) /\ ~(t = {}) ==> ~(s INTER t = {})) f
       ==> connected(UNIONS f)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS] THEN
  REWRITE_TAC[SET_RULE
   `(?c. s SUBSET {c}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN
  MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c2:real^N->bool`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`UNIONS f:real^N->bool`; `c1:real^N->bool`; `c2:real^N->bool`]
    COMPONENTS_EQ) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
  SUBGOAL_THEN
   `?a1:real^N a2:real^N. a1 IN c1 /\ a1 IN UNIONS f /\
                          a2 IN c2 /\ a2 IN UNIONS f`
  MP_TAC THENL
   [REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
    REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THEN
    ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_SUBSET;
                  MEMBER_NOT_EMPTY; SUBSET];
    REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM; IMP_CONJ]] THEN
  MAP_EVERY X_GEN_TAC [`a1:real^N`; `a2:real^N`] THEN DISCH_TAC THEN
  X_GEN_TAC `s1:real^N->bool` THEN REPEAT DISCH_TAC THEN
  X_GEN_TAC `s2:real^N->bool` THEN REPEAT DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
  DISCH_THEN(MP_TAC o SPECL [`s1:real^N->bool`; `s2:real^N->bool`]) THEN
  SUBGOAL_THEN
   `(s1:real^N->bool) SUBSET c1 /\ (s2:real^N->bool) SUBSET c2`
  MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  CONJ_TAC THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
  EXISTS_TAC `UNIONS f:real^N->bool` THEN ASM SET_TAC[]);;

let COMPONENTS_SEPARATED_UNION = prove
 (`!s t:real^N->bool.
        s INTER closure t = {} /\ t INTER closure s = {}
        ==> components(s UNION t) = components(s) UNION components(t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[components] THEN
  REWRITE_TAC[SIMPLE_IMAGE; IMAGE_UNION] THEN BINOP_TAC THEN
  MATCH_MP_TAC IMAGE_EQ THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[GSYM SUBSET_ANTISYM] THENL
   [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM]] THEN
  ASM_SIMP_TAC[CONNECTED_COMPONENT_SEPARATED_UNION]);;

let COMPONENTS_COMPLEMENT_FRONTIER = prove
 (`!s. components((:real^N) DIFF frontier s) =
       components(interior s) UNION components ((:real^N) DIFF closure s)`,
  GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES; SET_RULE
   `UNIV DIFF s INTER t = (UNIV DIFF s) UNION (UNIV DIFF t)`] THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
    COMPONENTS_SEPARATED_UNION o lhand o snd) THEN
  SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; GSYM INTERIOR_COMPLEMENT;
           OPEN_INTERIOR; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
  REWRITE_TAC[UNION_COMM; INTER_COMM] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
  MP_TAC(ISPEC `(:real^N) DIFF s` INTERIOR_SUBSET) THEN
  SET_TAC[]);;

let CARD_LE_COMPONENTS_UNION = prove
 (`!s t:real^N->bool.
        components(s UNION t) <=_c components(s) +_c components(t)`,
  REPEAT GEN_TAC THEN
  TRANS_TAC CARD_LE_TRANS `components(s:real^N->bool) UNION components t` THEN
  REWRITE_TAC[UNION_LE_ADD_C] THEN
  MATCH_MP_TAC(ISPEC `\s t. ~(s INTER t = {})` CARD_LE_RELATIONAL_FULL) THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [REWRITE_TAC[EXISTS_IN_UNION; components; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FORALL_IN_UNION; EXISTS_IN_GSPEC] THEN
    CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL
     [DISJ1_TAC; DISJ2_TAC] THEN
    EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNION];
    MAP_EVERY X_GEN_TAC
     [`c:real^N->bool`; `d:real^N->bool`; `e:real^N->bool`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL
     [`s UNION t:real^N->bool`; `d:real^N->bool`; `e:real^N->bool`]
     COMPONENTS_EQ) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `~(c INTER d = {}) ==> c SUBSET e ==> ~(d INTER e = {})`)) THEN
    MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
    EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
    DISCH_THEN(DISJ_CASES_THEN (fun th ->
     ASSUME_TAC(MATCH_MP IN_COMPONENTS_CONNECTED th) THEN
     MP_TAC(MATCH_MP IN_COMPONENTS_SUBSET th))) THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;

let FINITE_COMPONENTS_UNION = prove
 (`!s t:real^N->bool.
        FINITE(components s) /\ FINITE(components t)
        ==> FINITE(components(s UNION t))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_ADD_FINITE_EQ] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) THEN
  REWRITE_TAC[CARD_LE_COMPONENTS_UNION]);;

let COUNTABLE_COMPONENTS_UNION = prove
 (`!s t:real^N->bool.
        COUNTABLE(components s) /\ COUNTABLE(components t)
        ==> COUNTABLE(components(s UNION t))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM COUNTABLE_CARD_ADD_EQ] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_COUNTABLE) THEN
  REWRITE_TAC[CARD_LE_COMPONENTS_UNION]);;

let MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER_ELEMENTWISE = prove
 (`!s c1 c2 a b t.
        c1 IN components((:real^N) DIFF s) /\
        c2 IN components((:real^N) DIFF s) /\
        a IN c1 /\ b IN c2 /\ frontier c1 = s /\ frontier c2 = s /\
        t PSUBSET s
        ==> connected_component ((:real^N) DIFF t) a b`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `c:real^N`
        STRIP_ASSUME_TAC)) THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `((c:real^N) INSERT c1) UNION (c INSERT c2)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL
     [EXISTS_TAC `c1:real^N->bool`; EXISTS_TAC `c2:real^N->bool`] THEN
    (CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC]) THEN
    REWRITE_TAC[INSERT_SUBSET; CLOSURE_SUBSET] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[];
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
    ASM SET_TAC[]]);;

let MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER = prove
 (`!s t. t PSUBSET s /\ ~(s = (:real^N)) /\
         (!c. c IN components((:real^N) DIFF s) ==> frontier c = s)
         ==> connected((:real^N) DIFF t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  REWRITE_TAC[IN_DIFF; IN_UNIV] THEN MATCH_MP_TAC(MESON[]
   `!Q. (!x y z. R x y /\ R y z ==> R x z) /\ (!x y. R x y ==> R y x) /\
        (?y. P y /\ Q y) /\
        (?y. P y /\ ~Q y) /\
        (!x y. P x /\ P y /\ Q x /\ ~Q y ==> R x y)
        ==> (!x y. P x /\ P y ==> R x y)`) THEN
  EXISTS_TAC `\x:real^N. x IN s` THEN
  REWRITE_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS] THEN
  REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `a INSERT connected_component ((:real^N) DIFF s) b` THEN
  REWRITE_TAC[IN_INSERT] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
    EXISTS_TAC `connected_component ((:real^N) DIFF s) b` THEN
    REWRITE_TAC[INSERT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
    CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[CLOSURE_SUBSET]] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC
     `connected_component ((:real^N) DIFF s) b`) THEN
    REWRITE_TAC[frontier] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REWRITE_TAC[components; IN_ELIM_THM; IN_UNIV; IN_DIFF] THEN
    ASM_MESON_TAC[];
    ASM_REWRITE_TAC[INSERT_SUBSET; IN_UNIV; IN_DIFF] THEN
    MP_TAC(ISPECL [`(:real^N) DIFF s`; `b:real^N`]
      CONNECTED_COMPONENT_SUBSET) THEN ASM SET_TAC[];
    DISJ2_TAC THEN REWRITE_TAC[IN] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Continuity implies uniform continuity on a compact domain.                *)
(* ------------------------------------------------------------------------- *)

let COMPACT_UNIFORMLY_EQUICONTINUOUS = prove
 (`!(fs:(real^M->real^N)->bool) s.
     (!x e. x IN s /\ &0 < e
            ==> ?d. &0 < d /\
                    (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d
                            ==> dist (f x',f x) < e)) /\
     compact s
     ==> !e. &0 < e
             ==> ?d. &0 < d /\
                     !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d
                              ==> dist(f x',f x) < e`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `d:real^M->real->real` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN
  DISCH_THEN(MP_TAC o SPEC
    `{ ball(x:real^M,d x (e / &2)) | x IN s}`) THEN
  SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[CENTRE_IN_BALL; REAL_HALF]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `u:real^M`; `v:real^M`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^M` th) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(fun th ->
    MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN
  ASM_REWRITE_TAC[DIST_REFL] THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (CONJUNCTS_THEN2 ASSUME_TAC
    SUBST_ALL_TAC)) THEN
  ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN
  ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `e / &2`]) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o CONJUNCT2) THEN
  DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN
                        MP_TAC(SPEC `v:real^M` th)) THEN
  ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);;

let COMPACT_UNIFORMLY_CONTINUOUS = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ compact s ==> f uniformly_continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; uniformly_continuous_on] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`{f:real^M->real^N}`; `s:real^M->bool`]
        COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; IN_SING; FORALL_UNWIND_THM2] THEN
  ASM_MESON_TAC[]);;

let CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED = prove
 (`!f:real^M->real^N s.
        closed s
        ==> (f continuous_on s <=>
             !x. cauchy x /\ (!n. x n IN s) ==> cauchy(f o x))`,
  MESON_TAC[CAUCHY_CONTINUOUS_IMP_CONTINUOUS;
            CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS]);;

let UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED = prove
 (`!f:real^M->real^N s.
        bounded s
        ==> (f uniformly_continuous_on s <=>
             !x. cauchy x /\ (!n. x n IN s) ==> cauchy(f o x))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS] THEN
  DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC UNIFORMLY_CONTINUOUS_ON_EQ THEN
  EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC UNIFORMLY_CONTINUOUS_ON_SUBSET THEN
  EXISTS_TAC `closure s:real^M->bool` THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
  MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE]);;

let CAUCHY_CONTINUOUS_EXTENDS_TO_CAUCHY_CONTINUOUS_CLOSURE = prove
 (`!f:real^M->real^N s.
        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
        ==> ?g. (!x. cauchy x /\ (!n. (x n) IN closure s) ==> cauchy(g o x)) /\
                (!x. x IN s ==> g x = f x)`,
  SIMP_TAC[GSYM CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED; CLOSED_CLOSURE] THEN
  REWRITE_TAC[CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE]);;

let CAUCHY_CONTINUOUS_EQ_EXTENDS_TO_CLOSURE = prove
 (`!f:real^M->real^N s.
        (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) <=>
        ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  REWRITE_TAC[CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE] THEN
  SIMP_TAC[CONTINUOUS_EQ_CAUCHY_CONTINUOUS_CLOSED; CLOSED_CLOSURE] THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_SIMP_TAC[o_DEF] THEN
  REWRITE_TAC[GSYM o_DEF] THEN ASM_SIMP_TAC[CLOSURE_INC]);;

let UNIFORMLY_CONTINUOUS_ON_UNION = prove
 (`!f:real^M->real^N s t.
        bounded s /\ bounded t /\
        f uniformly_continuous_on t /\
        f continuous_on (closure s UNION t)
        ==> f uniformly_continuous_on (s UNION t)`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED;
               BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
  X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN
  ASM_CASES_TAC `eventually (\n. (x:num->real^M) n IN t) sequentially` THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVENTUALLY_SEQUENTIALLY]) THEN
    DISCH_THEN(X_CHOOSE_THEN `k:num`
      (MP_TAC o GEN `n:num` o SPEC `n + k:num`)) THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD] THEN
    DISCH_TAC THEN
    UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on t` THEN
    ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_EQ_CAUCHY_CONTINUOUS_BOUNDED] THEN
    DISCH_THEN(MP_TAC o SPEC `\n. (x:num->real^M)(n + k)`) THEN
    UNDISCH_TAC `cauchy(x:num->real^M)` THEN ASM_REWRITE_TAC[o_DEF] THEN
    MATCH_MP_TAC(TAUT
     `(q <=> p) /\ (r <=> s) ==> p ==> (q ==> r) ==> s`) THEN
    CONJ_TAC THENL
     [MP_TAC(SPEC `k:num` (INST_TYPE [`:M`,`:N`] CAUCHY_OFFSET));
      MP_TAC(SPEC `k:num` CAUCHY_OFFSET)] THEN
    SIMP_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPEC `{n | (x:num->real^M) n IN s}` INFINITE_ENUMERATE_WEAK) THEN
  REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
   [REWRITE_TAC[INFINITE] THEN DISCH_THEN(MP_TAC o
      ISPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
      [EVENTUALLY_SEQUENTIALLY]) THEN
    REWRITE_TAC[CONTRAPOS_THM; IN_ELIM_THM] THEN
    DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN
    ASM_MESON_TAC[IN_UNION; ARITH_RULE `~(n <= N /\ N + 1 <= n)`];
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC)] THEN
  SUBGOAL_THEN
   `?l. l IN closure s /\ ((\n. (x:num->real^M)(r n)) --> l) sequentially`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPEC `closure s:real^M->bool` complete) THEN
    REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_CLOSURE] THEN
    DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[CLOSURE_INC] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CAUCHY_SUBSEQUENCE THEN ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `((x:num->real^M) --> l) sequentially` ASSUME_TAC THENL
   [MATCH_MP_TAC  CAUCHY_CONVERGENT_SUBSEQUENCE THEN
    EXISTS_TAC `r:num->num` THEN ASM_REWRITE_TAC[o_DEF];
    ALL_TAC] THEN
  MATCH_MP_TAC CONVERGENT_IMP_CAUCHY THEN
  EXISTS_TAC `(f:real^M->real^N) l` THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_SEQUENTIALLY]) THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[IN_UNION; CLOSURE_INC]);;

(* ------------------------------------------------------------------------- *)
(* A uniformly convergent limit of continuous functions is continuous.       *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_UNIFORM_LIMIT = prove
 (`!net f:A->real^M->real^N g s.
        ~(trivial_limit net) /\
        eventually (\n. (f n) continuous_on s) net /\
        (!e. &0 < e
             ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) net)
        ==> g continuous_on s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`net:A net`; `subtopology euclidean (s:real^M->bool)`;
                 `euclidean_metric:(real^N)metric`; `f:A->real^M->real^N`;
                 `g:real^M->real^N`] CONTINUOUS_MAP_UNIFORM_LIMIT) THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN; MTOPOLOGY_EUCLIDEAN_METRIC; dist;
                  EUCLIDEAN_METRIC; IN_UNIV; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let CONTINUOUS_UNIFORMLY_CAUCHY_LIMIT = prove
 (`!f:num->real^M->real^N s.
        eventually (\n. f n continuous_on s) sequentially /\
        (!e. &0 < e
            ==> ?N. !m n x. N <= m /\ N <= n /\ x IN s
                            ==> dist (f m x,f n x) < e)
        ==> ?g. g continuous_on s /\
                (!x. x IN s ==> ((\n. f n x) --> g x) sequentially)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
  DISCH_TAC THEN CONJ_TAC THENL
   [MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN
    EXISTS_TAC `f:num->real^M->real^N` THEN
    ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN
    ASM_MESON_TAC[dist];
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN ASM_MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Topological stuff lifted from and dropped to R                            *)
(* ------------------------------------------------------------------------- *)

let OPEN_LIFT = prove
 (`!s. open(IMAGE lift s) <=>
        !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`,
  REWRITE_TAC[open_def; FORALL_LIFT; LIFT_IN_IMAGE_LIFT; DIST_LIFT]);;

let LIMPT_APPROACHABLE_LIFT = prove
 (`!x s. (lift x) limit_point_of (IMAGE lift s) <=>
         !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e`,
  REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT;
              LIFT_EQ; DIST_LIFT]);;

let CLOSED_LIFT = prove
 (`!s. closed (IMAGE lift s) <=>
        !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e)
            ==> x IN s`,
  GEN_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN
  ONCE_REWRITE_TAC[FORALL_LIFT] THEN
  REWRITE_TAC[LIMPT_APPROACHABLE_LIFT; LIFT_EQ; DIST_LIFT;
              EXISTS_LIFT; LIFT_IN_IMAGE_LIFT]);;

let CONTINUOUS_AT_LIFT_RANGE = prove
 (`!f x. (lift o f) continuous (at x) <=>
                !e. &0 < e
                    ==> ?d. &0 < d /\
                            (!x'. norm(x' - x) < d
                                  ==> abs(f x' - f x) < e)`,
  REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);;

let CONTINUOUS_ON_LIFT_RANGE = prove
 (`!f s. (lift o f) continuous_on s <=>
         !x. x IN s
             ==> !e. &0 < e
                     ==> ?d. &0 < d /\
                             (!x'. x' IN s /\ norm(x' - x) < d
                                   ==> abs(f x' - f x) < e)`,
  REWRITE_TAC[continuous_on; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);;

let CONTINUOUS_LIFT_NORM_COMPOSE = prove
 (`!net f:A->real^N.
        f continuous net
        ==> (\x. lift(norm(f x))) continuous net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous; tendsto] THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN
  NORM_ARITH_TAC);;

let CONTINUOUS_ON_LIFT_NORM_COMPOSE = prove
 (`!f:real^M->real^N s.
        f continuous_on s
        ==> (\x. lift(norm(f x))) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_NORM_COMPOSE]);;

let CONTINUOUS_AT_LIFT_NORM = prove
 (`!x. (lift o norm) continuous (at x)`,
  REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE; NORM_LIFT] THEN
  MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);;

let CONTINUOUS_ON_LIFT_NORM = prove
 (`!s. (lift o norm) continuous_on s`,
  REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE; NORM_LIFT] THEN
  MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);;

let PROPER_MAP_NORM_SIMPLE = prove
 (`!k. compact k ==> compact {x:real^N | lift(norm x) IN k}`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
    REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
    MESON_TAC[NORM_LIFT; REAL_ABS_NORM];
    MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
    ASM_REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]);;

let PROPER_MAP_NORM = prove
 (`!s t. closed s
         ==> !k. k SUBSET t /\ compact k
                 ==> compact {x:real^N | x IN s /\ lift(norm x) IN k}`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
  MATCH_MP_TAC CLOSED_INTER_COMPACT THEN
  ASM_SIMP_TAC[PROPER_MAP_NORM_SIMPLE]);;

let CLOSED_MAP_NORM = prove
 (`!s:real^N->bool. closed s ==> closed (IMAGE (lift o norm) s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] PROPER_MAP_NORM) THEN
  REWRITE_TAC[CLOSED_UNIV] THEN
  SIMP_TAC[PROPER_MAP; SUBSET_UNIV] THEN
  ASM_SIMP_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV; o_DEF]);;

let CONTINUOUS_AT_LIFT_COMPONENT = prove
 (`!i a. 1 <= i /\ i <= dimindex(:N)
         ==> (\x:real^N. lift(x$i)) continuous (at a)`,
  SIMP_TAC[continuous_at; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN
  MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);;

let CONTINUOUS_ON_LIFT_COMPONENT = prove
 (`!i s. 1 <= i /\ i <= dimindex(:N)
         ==> (\x:real^N. lift(x$i)) continuous_on s`,
  SIMP_TAC[continuous_on; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN
  MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);;

let CONTINUOUS_AT_LIFT_INFNORM = prove
 (`!x:real^N. (lift o infnorm) continuous (at x)`,
  REWRITE_TAC[CONTINUOUS_AT; LIM_AT; o_THM; DIST_LIFT] THEN
  MESON_TAC[REAL_LET_TRANS; dist; REAL_ABS_SUB_INFNORM; INFNORM_LE_NORM]);;

let CONTINUOUS_AT_LIFT_DIST = prove
 (`!a:real^N x. (lift o (\x. dist(a,x))) continuous (at x)`,
  REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN
  MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`;
            REAL_LET_TRANS]);;

let CONTINUOUS_ON_LIFT_DIST = prove
 (`!a s. (lift o (\x. dist(a,x))) continuous_on s`,
  REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN
  MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`;
            REAL_LET_TRANS]);;

(* ------------------------------------------------------------------------- *)
(* Hence some handy theorems on distance, diameter etc. of/from a set.       *)
(* ------------------------------------------------------------------------- *)

let COMPACT_ATTAINS_SUP = prove
 (`!s. compact (IMAGE lift s) /\ ~(s = {})
       ==> ?x. x IN s /\ !y. y IN s ==> y <= x`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN
  MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN EXISTS_TAC `sup s` THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s <= s - e <=> ~(&0 < e)`;
                REAL_ARITH `x <= s /\ ~(x <= s - e) ==> abs(x - s) < e`]);;

let COMPACT_ATTAINS_INF = prove
 (`!s. compact (IMAGE lift s) /\ ~(s = {})
       ==> ?x. x IN s /\ !y. y IN s ==> x <= y`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN
  MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN EXISTS_TAC `inf s` THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s + e <= s <=> ~(&0 < e)`;
                REAL_ARITH `s <= x /\ ~(s + e <= x) ==> abs(x - s) < e`]);;

let CONTINUOUS_ATTAINS_SUP = prove
 (`!f:real^N->real s.
        compact s /\ ~(s = {}) /\ (lift o f) continuous_on s
        ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_SUP) THEN
  ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN
  MESON_TAC[IN_IMAGE]);;

let CONTINUOUS_ATTAINS_INF = prove
 (`!f:real^N->real s.
        compact s /\ ~(s = {}) /\ (lift o f) continuous_on s
        ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_INF) THEN
  ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN
  MESON_TAC[IN_IMAGE]);;

let DISTANCE_ATTAINS_SUP = prove
 (`!s a. compact s /\ ~(s = {})
         ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN REWRITE_TAC[dist] THEN
  ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG;
                VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]);;

(* ------------------------------------------------------------------------- *)
(* For *minimal* distance, we only need closure, not compactness.            *)
(* ------------------------------------------------------------------------- *)

let DISTANCE_ATTAINS_INF = prove
 (`!s a:real^N.
        closed s /\ ~(s = {})
        ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
  DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN
  MP_TAC(ISPECL [`\x:real^N. dist(a,x)`; `cball(a:real^N,dist(b,a)) INTER s`]
                CONTINUOUS_ATTAINS_INF) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; BOUNDED_INTER;
                 BOUNDED_CBALL; CLOSED_CBALL; GSYM MEMBER_NOT_EMPTY] THEN
    REWRITE_TAC[dist; CONTINUOUS_ON_LIFT_RANGE; IN_INTER; IN_CBALL] THEN
    ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; REAL_LE_REFL;
            NORM_SUB; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`];
    MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN
    ASM_MESON_TAC[DIST_SYM; REAL_LE_TOTAL; REAL_LE_TRANS]]);;

(* ------------------------------------------------------------------------- *)
(* We can now extend limit compositions to consider the scalar multiplier.   *)
(* ------------------------------------------------------------------------- *)

let LIM_MUL = prove
 (`!net:(A)net f l:real^N c d.
        ((lift o c) --> lift d) net /\ (f --> l) net
        ==> ((\x. c(x) % f(x)) --> (d % l)) net`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`net:(A)net`; `\x (y:real^N). drop x % y`;
  `lift o (c:A->real)`; `f:A->real^N`; `lift d`; `l:real^N`] LIM_BILINEAR) THEN
  ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
  REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN
  REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;

let LIM_LIFT_POW = prove
 (`!net:(A)net f l n.
        ((\a. lift(f a)) --> lift l) net
        ==> ((\a. lift(f(a) pow n)) --> lift(l pow n)) net`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  INDUCT_TAC THEN REWRITE_TAC[real_pow; LIM_CONST; LIFT_CMUL] THEN
  MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[o_DEF]);;

let LIM_LIFT_PRODUCT = prove
 (`!net:(A)net f g (t:B->bool).
        FINITE t /\
        (!i. i IN t ==> ((\x. lift(f x i)) --> lift(g i)) net)
        ==> ((\x. lift(product t (f x))) --> lift(product t g)) net`,
  REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN
  REWRITE_TAC[LIM_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN
  ASM_SIMP_TAC[o_DEF]);;

let LIM_VMUL = prove
 (`!net:(A)net c d v:real^N.
        ((lift o c) --> lift d) net ==> ((\x. c(x) % v) --> d % v) net`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]);;

let CONTINUOUS_VMUL = prove
 (`!net c v. (lift o c) continuous net ==> (\x. c(x) % v) continuous net`,
  REWRITE_TAC[continuous; LIM_VMUL; o_THM]);;

let CONTINUOUS_MUL = prove
 (`!net f c. (lift o c) continuous net /\ f continuous net
             ==> (\x. c(x) % f(x)) continuous net`,
  REWRITE_TAC[continuous; LIM_MUL; o_THM]);;

let CONTINUOUS_ON_VMUL = prove
 (`!s c v. (lift o c) continuous_on s ==> (\x. c(x) % v) continuous_on s`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  SIMP_TAC[CONTINUOUS_VMUL]);;

let CONTINUOUS_ON_MUL = prove
 (`!s c f. (lift o c) continuous_on s /\ f continuous_on s
           ==> (\x. c(x) % f(x)) continuous_on s`,
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  SIMP_TAC[CONTINUOUS_MUL]);;

let CONTINUOUS_LIFT_POW = prove
 (`!net f:A->real n.
        (\x. lift(f x)) continuous net
        ==> (\x. lift(f x pow n)) continuous net`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
  INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_CONST] THEN
  MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[o_DEF]);;

let CONTINUOUS_ON_LIFT_POW = prove
 (`!f:real^N->real s n.
        (\x. lift(f x)) continuous_on s
        ==> (\x. lift(f x pow n)) continuous_on s`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN
  DISCH_TAC THEN INDUCT_TAC THEN
  ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_ON_CONST] THEN
  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF]);;

let CONTINUOUS_LIFT_PRODUCT = prove
 (`!net:(A)net f (t:B->bool).
        FINITE t /\
        (!i. i IN t ==> (\x. lift(f x i)) continuous net)
        ==> (\x. lift(product t (f x))) continuous net`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN
  REWRITE_TAC[CONTINUOUS_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
  ASM_SIMP_TAC[o_DEF]);;

let CONTINUOUS_ON_LIFT_PRODUCT = prove
 (`!f:real^N->A->real s t.
        FINITE t /\
        (!i. i IN t ==> (\x. lift(f x i)) continuous_on s)
        ==> (\x. lift(product t (f x))) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_PRODUCT]);;

(* ------------------------------------------------------------------------- *)
(* Continuity of inverse.                                                    *)
(* ------------------------------------------------------------------------- *)

let LIM_INV = prove
 (`!net:(A)net f l.
        ((lift o f) --> lift l) net /\ ~(l = &0)
        ==> ((lift o inv o f) --> lift(inv l)) net`,
  REWRITE_TAC[GSYM LIMIT_EUCLIDEAN; LIMIT_REAL_INV; LIMIT_EQ_DROP;
              LIFT_DROP; ETA_AX; o_DEF]);;

let CONTINUOUS_INV = prove
 (`!net f. (lift o f) continuous net /\ ~(f(netlimit net) = &0)
           ==> (lift o inv o f) continuous net`,
  REWRITE_TAC[continuous; LIM_INV; o_THM]);;

let CONTINUOUS_AT_WITHIN_INV = prove
 (`!f s a:real^N.
        (lift o f) continuous (at a within s) /\ ~(f a = &0)
        ==> (lift o inv o f) continuous (at a within s)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `trivial_limit (at (a:real^N) within s)` THEN
  ASM_SIMP_TAC[CONTINUOUS_TRIVIAL_LIMIT] THEN
  ASM_SIMP_TAC[NETLIMIT_WITHIN; CONTINUOUS_INV]);;

let CONTINUOUS_AT_INV = prove
 (`!f a. (lift o f) continuous at a /\ ~(f a = &0)
         ==> (lift o inv o f) continuous at a`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]);;

let CONTINUOUS_ON_INV = prove
 (`!f s. (lift o f) continuous_on s /\ (!x. x IN s ==> ~(f x = &0))
         ==> (lift o inv o f) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN_INV]);;

(* ------------------------------------------------------------------------- *)
(* More preservation properties for pasted sets (Cartesian products).        *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_MAP_PASTECART = prove
 (`continuous_map
     (prod_topology (euclidean:(real^M)topology) (euclidean:(real^N)topology),
      euclidean)
     (\(x,y). pastecart x y)`,
  REWRITE_TAC[GSYM MTOPOLOGY_PROD_METRIC; GSYM MTOPOLOGY_EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[METRIC_CONTINUOUS_MAP; PROD_METRIC; EUCLIDEAN_METRIC] THEN
  REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS; IN_UNIV] THEN
  REWRITE_TAC[dist; NORM_PASTECART; PASTECART_SUB] THEN MESON_TAC[]);;

let LIM_PASTECART = prove
 (`!net f:A->real^M g:A->real^N.
        (f --> a) net /\ (g --> b) net
        ==> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN
  ASM_REWRITE_TAC[REAL_HALF; IMP_IMP; GSYM EVENTUALLY_AND] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  REWRITE_TAC[] THEN MESON_TAC[DIST_PASTECART_LE;
   REAL_ARITH `x <= a + b /\ a < e / &2 /\ b < e / &2 ==> x < e`]);;

let LIM_PASTECART_EQ = prove
 (`!net f:A->real^M g:A->real^N.
        ((\x. pastecart (f x) (g x)) --> pastecart a b) net <=>
        (f --> a) net /\ (g --> b) net`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LIM_PASTECART] THEN
  REPEAT STRIP_TAC THENL
   [FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN
    REWRITE_TAC[LINEAR_FSTCART; FSTCART_PASTECART; ETA_AX];
    FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN
    REWRITE_TAC[LINEAR_SNDCART; SNDCART_PASTECART; ETA_AX]]);;

let CONTINUOUS_PASTECART = prove
 (`!net f:A->real^M g:A->real^N.
        f continuous net /\ g continuous net
        ==> (\x. pastecart (f x) (g x)) continuous net`,
  REWRITE_TAC[continuous; LIM_PASTECART]);;

let CONTINUOUS_ON_PASTECART = prove
 (`!f:real^M->real^N g:real^M->real^P s.
        f continuous_on s /\ g continuous_on s
        ==> (\x. pastecart (f x) (g x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON; LIM_PASTECART]);;

let CONTINUOUS_FSTCART = prove
 (`!net f:A->real^(M,N)finite_sum.
      f continuous net ==> (\x. fstcart(f x)) continuous net`,
  SIMP_TAC[LINEAR_CONTINUOUS_COMPOSE; LINEAR_FSTCART]);;

let CONTINUOUS_SNDCART = prove
 (`!net f:A->real^(M,N)finite_sum.
      f continuous net ==> (\x. sndcart(f x)) continuous net`,
  SIMP_TAC[LINEAR_CONTINUOUS_COMPOSE; LINEAR_SNDCART]);;

let CONTINUOUS_ON_FSTCART = prove
 (`!f:real^M->real^(N,P)finite_sum.
        f continuous_on s ==> (\x. fstcart(f x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_FSTCART]);;

let CONTINUOUS_ON_SNDCART = prove
 (`!f:real^M->real^(N,P)finite_sum.
        f continuous_on s ==> (\x. sndcart(f x)) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SNDCART]);;

let CONNECTED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        connected s /\ connected t
        ==> connected (s PCROSS t)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[PCROSS; CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
  MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2
   (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`])
   (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; connected_component] THEN
  X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN
  X_GEN_TAC `c1:real^M->bool` THEN STRIP_TAC THEN
  EXISTS_TAC
   `IMAGE (\x:real^M. pastecart x y1) c1 UNION
    IMAGE (\y:real^N. pastecart x2 y) c2` THEN
  REWRITE_TAC[IN_UNION] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_UNION THEN
    ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_PASTECART;
                 CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN
    EXISTS_TAC `x2:real^M` THEN ASM SET_TAC[];
    REWRITE_TAC[SUBSET; IN_UNION; FORALL_AND_THM; FORALL_IN_IMAGE;
                TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
    ASM SET_TAC[];
    ASM SET_TAC[];
    ASM SET_TAC[]]);;

let CONNECTED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        connected (s PCROSS t) <=>
        s = {} \/ t = {} \/ connected s /\ connected t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  REWRITE_TAC[PCROSS_EMPTY; CONNECTED_EMPTY] THEN
  EQ_TAC THEN SIMP_TAC[CONNECTED_PCROSS] THEN
  REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THENL
   [SUBGOAL_THEN `connected (IMAGE fstcart
                     {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})`
    MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC];
    SUBGOAL_THEN `connected (IMAGE sndcart
                     {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})`
    MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; IN_ELIM_PASTECART_THM;
              FSTCART_PASTECART; SNDCART_PASTECART] THEN
  ASM SET_TAC[]);;

let CONNECTED_COMPONENT_PCROSS = prove
 (`!s t a:real^M b:real^N.
        connected_component (s PCROSS t) (pastecart a b) =
        connected_component s a PCROSS connected_component t b`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^M) IN s /\ (b:real^N) IN t` THENL
   [MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
    REWRITE_TAC[PASTECART_IN_PCROSS; SUBSET_PCROSS; CONNECTED_PCROSS_EQ] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    X_GEN_TAC `c:real^(M,N)finite_sum->bool` THEN
    REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
    STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN
    REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
     [EXISTS_TAC `IMAGE fstcart (c:real^(M,N)finite_sum->bool)`;
      EXISTS_TAC `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
    REWRITE_TAC[FORALL_PASTECART; EXISTS_PASTECART; IN_IMAGE] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN
    MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
    MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN
    REWRITE_TAC[PCROSS_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY] THEN
    REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[]]);;

let COMPONENTS_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
    components(s PCROSS t) =
    {c PCROSS d | c IN components s /\ d IN components t}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN
  REWRITE_TAC[SIMPLE_IMAGE] THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ABS_CONV o RAND_CONV)
   [GSYM PASTECART_FST_SND] THEN
  REWRITE_TAC[CONNECTED_COMPONENT_PCROSS] THEN
  REWRITE_TAC[SET_RULE
   `{f x y | x IN IMAGE g s /\ y IN IMAGE h t} =
    {f (g x) (h y) | x IN s /\ y IN t}`] THEN
  REWRITE_TAC[PCROSS; GSYM SIMPLE_IMAGE; SET_RULE
   `{f z | z IN {g x y | P x y}} = {f(g x y) | P x y}`] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);;

let CLOSURE_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        closure (s PCROSS t) = (closure s) PCROSS (closure t)`,
  REWRITE_TAC[EXTENSION; PCROSS; FORALL_PASTECART] THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[CLOSURE_APPROACHABLE; EXISTS_PASTECART; FORALL_PASTECART] THEN
  REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
  REWRITE_TAC[dist; PASTECART_SUB] THEN EQ_TAC THENL
   [MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; DISCH_TAC] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN
  ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH
    `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);;

let LIMPT_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool x y.
        x limit_point_of s /\ y limit_point_of t
        ==> (pastecart x y) limit_point_of (s PCROSS t)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[PCROSS; LIMPT_APPROACHABLE; EXISTS_PASTECART] THEN
  REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ; dist; PASTECART_SUB] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN
  ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH
    `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);;

let CLOSED_IN_PCROSS = prove
 (`!s:real^M->bool s' t:real^N->bool t'.
        closed_in (subtopology euclidean s) s' /\
        closed_in (subtopology euclidean t) t'
        ==> closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN
  ASM_SIMP_TAC[CLOSED_PCROSS; EXTENSION; FORALL_PASTECART] THEN
  REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);;

let CLOSED_IN_PCROSS_EQ = prove
 (`!s s':real^M->bool t t':real^N->bool.
        closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=>
        s' = {} \/ t' = {} \/
        closed_in (subtopology euclidean s) s' /\
        closed_in (subtopology euclidean t) t'`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s':real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN
  ASM_CASES_TAC `t':real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[CLOSED_IN_PCROSS] THEN
  ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_PCROSS; INTER_PCROSS;
                  PCROSS_EQ; PCROSS_EQ_EMPTY]);;

let FRONTIER_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        frontier(s PCROSS t) = frontier s PCROSS closure t UNION
                               closure s PCROSS frontier t`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[frontier; CLOSURE_PCROSS; INTERIOR_PCROSS; PCROSS_DIFF] THEN
  REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; IN_UNION;
              PASTECART_IN_PCROSS] THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Hence some useful properties follow quite easily.                         *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_SCALING = prove
 (`!s:real^N->bool c. connected s ==> connected (IMAGE (\x. c % x) s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;

let CONNECTED_NEGATIONS = prove
 (`!s:real^N->bool. connected s ==> connected (IMAGE (--) s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;

let CONNECTED_SCALING_EQ = prove
 (`!s:real^N->bool c.
        connected (IMAGE (\x. c % x) s) <=> c = &0 \/ connected s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN
    MESON_TAC[CONNECTED_SING; CONNECTED_EMPTY];
    EQ_TAC THEN REWRITE_TAC[CONNECTED_SCALING] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP CONNECTED_SCALING) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);;

let CONNECTED_AFFINITY_EQ = prove
 (`!s m c:real^N.
        connected (IMAGE (\x. m % x + c) s) <=> m = &0 \/ connected s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; CONNECTED_TRANSLATION_EQ;
              CONNECTED_SCALING_EQ; IMAGE_o]);;

let CONNECTED_AFFINITY = prove
 (`!s m c:real^N. connected s ==> connected (IMAGE (\x. m % x + c) s)`,
  SIMP_TAC[CONNECTED_AFFINITY_EQ]);;

let CONNECTED_SUMS = prove
 (`!s t:real^N->bool.
        connected s /\ connected t ==> connected {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_PCROSS) THEN
  DISCH_THEN(MP_TAC o ISPEC
   `\z. (fstcart z + sndcart z:real^N)` o
    MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
           LINEAR_SNDCART; PCROSS] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN
  REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
  MESON_TAC[]);;

let COMPACT_SCALING = prove
 (`!s:real^N->bool c. compact s ==> compact (IMAGE (\x. c % x) s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;

let COMPACT_SCALING_EQ = prove
 (`!s:real^N->bool c. compact (IMAGE (\x. c % x) s) <=> c = &0 \/ compact s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN
    MESON_TAC[COMPACT_SING; COMPACT_EMPTY];
    EQ_TAC THEN REWRITE_TAC[COMPACT_SCALING] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP COMPACT_SCALING) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);;

let COMPACT_NEGATIONS = prove
 (`!s:real^N->bool. compact s ==> compact (IMAGE (--) s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;

let COMPACT_SUMS = prove
 (`!s:real^N->bool t.
        compact s /\ compact t ==> compact {x + y | x IN s /\ y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `{x + y | x IN s /\ y IN t} =
                IMAGE (\z. fstcart z + sndcart z :real^N) (s PCROSS t)`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; PCROSS] THEN
    GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_FST_SND];
    ALL_TAC] THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
  ASM_SIMP_TAC[COMPACT_PCROSS] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD;
              SNDCART_CMUL] THEN
  CONJ_TAC THEN VECTOR_ARITH_TAC);;

let COMPACT_DIFFERENCES = prove
 (`!s:real^N->bool t.
        compact s /\ compact t ==> compact {x - y | x IN s /\ y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} =
                {x + y | x IN s /\ y IN (IMAGE (--) t)}`
    (fun th -> ASM_SIMP_TAC[th; COMPACT_SUMS; COMPACT_NEGATIONS]) THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN
  SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN
  MESON_TAC[VECTOR_NEG_NEG]);;

let COMPACT_AFFINITY_EQ = prove
 (`!s m c:real^N.
        compact (IMAGE (\x. m % x + c) s) <=> m = &0 \/ compact s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; COMPACT_TRANSLATION_EQ;
              COMPACT_SCALING_EQ; IMAGE_o]);;

let COMPACT_AFFINITY = prove
 (`!s m c:real^N. compact s ==> compact (IMAGE (\x. m % x + c) s)`,
  SIMP_TAC[COMPACT_AFFINITY_EQ]);;

(* ------------------------------------------------------------------------- *)
(* Hence we get the following.                                               *)
(* ------------------------------------------------------------------------- *)

let COMPACT_SUP_MAXDISTANCE = prove
 (`!s:real^N->bool.
        compact s /\ ~(s = {})
        ==> ?x y. x IN s /\ y IN s /\
                  !u v. u IN s /\ v IN s ==> norm(u - v) <= norm(x - y)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN s}`; `vec 0:real^N`]
                DISTANCE_ATTAINS_SUP) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[COMPACT_DIFFERENCES] THEN
    REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
    ASM_MESON_TAC[MEMBER_NOT_EMPTY];
    REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO;
                NORM_NEG] THEN
    MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* We can state this in terms of diameter of a set.                          *)
(* ------------------------------------------------------------------------- *)

let diameter = new_definition
  `diameter s =
        if s = {} then &0
        else sup {norm(x - y) | x IN s /\ y IN s}`;;

let DIAMETER_BOUNDED = prove
 (`!s. bounded s
       ==> (!x:real^N y. x IN s /\ y IN s ==> norm(x - y) <= diameter s) /\
           (!d. &0 <= d /\ d < diameter s
                ==> ?x y. x IN s /\ y IN s /\ norm(x - y) > d)`,
  GEN_TAC THEN DISCH_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[diameter; NOT_IN_EMPTY; REAL_LET_ANTISYM] THEN
  MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN
  ABBREV_TAC `b = sup {norm(x - y:real^N) | x IN s /\ y IN s}` THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
  REWRITE_TAC[NOT_IN_EMPTY; real_gt] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC];
    MESON_TAC[REAL_NOT_LE]] THEN
  SIMP_TAC[VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
  MESON_TAC[REAL_ARITH `x <= y + z /\ y <= b /\ z<= b ==> x <= b + b`;
            NORM_TRIANGLE; NORM_NEG]);;

let DIAMETER_BOUNDED_BOUND = prove
 (`!s x y. bounded s /\ x IN s /\ y IN s ==> norm(x - y) <= diameter s`,
  MESON_TAC[DIAMETER_BOUNDED]);;

let DIAMETER_COMPACT_ATTAINED = prove
 (`!s:real^N->bool.
        compact s /\ ~(s = {})
        ==> ?x y. x IN s /\ y IN s /\ (norm(x - y) = diameter s)`,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_SUP_MAXDISTANCE) THEN
  REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(SPEC `s:real^N->bool` DIAMETER_BOUNDED) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[COMPACT_EQ_BOUNDED_CLOSED]) THEN
  ASM_REWRITE_TAC[real_gt] THEN STRIP_TAC THEN
  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
  ASM_MESON_TAC[NORM_POS_LE; REAL_NOT_LT]);;

let DIAMETER_TRANSLATION = prove
 (`!a s. diameter (IMAGE (\x. a + x) s) = diameter s`,
  REWRITE_TAC[diameter] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [DIAMETER_TRANSLATION];;

let DIAMETER_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x. norm(f x) = norm x)
        ==> diameter(IMAGE f s) = diameter s`,
  REWRITE_TAC[diameter] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[diameter; IMAGE_EQ_EMPTY] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN
  ASM_MESON_TAC[LINEAR_SUB]);;

add_linear_invariants [DIAMETER_LINEAR_IMAGE];;

let DIAMETER_EMPTY = prove
 (`diameter {} = &0`,
  REWRITE_TAC[diameter]);;

let DIAMETER_SING = prove
 (`!a. diameter {a} = &0`,
  REWRITE_TAC[diameter; NOT_INSERT_EMPTY; IN_SING] THEN
  REWRITE_TAC[SET_RULE `{f x y | x = a /\ y = a} = {f a a }`] THEN
  REWRITE_TAC[SUP_SING; VECTOR_SUB_REFL; NORM_0]);;

let DIAMETER_POS_LE = prove
 (`!s:real^N->bool. bounded s ==> &0 <= diameter s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
  MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
    EXISTS_TAC `&2 * B` THEN
    ASM_SIMP_TAC[NORM_ARITH
      `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
    DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a:real^N`] o CONJUNCT1) THEN
    ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]]);;

let DIAMETER_SUBSET = prove
 (`!s t:real^N->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_SIMP_TAC[DIAMETER_EMPTY; DIAMETER_POS_LE] THEN
  ASM_REWRITE_TAC[diameter] THEN
  COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN
  REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
  EXISTS_TAC `&2 * B` THEN
  ASM_SIMP_TAC[NORM_ARITH
    `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]);;

let DIAMETER_CLOSURE = prove
 (`!s:real^N->bool. diameter(closure s) = diameter s`,
  GEN_TAC THEN ASM_CASES_TAC `bounded(s:real^N->bool)` THENL
   [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN
    ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_CLOSURE; CLOSURE_SUBSET] THEN
    REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
    DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_BOUNDED) THEN
    ABBREV_TAC `d = diameter(closure s) - diameter(s:real^N->bool)` THEN
    ASM_SIMP_TAC[BOUNDED_CLOSURE] THEN DISCH_THEN(MP_TAC o
      SPEC `diameter(closure(s:real^N->bool)) - d / &2` o CONJUNCT2) THEN
    REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; NOT_EXISTS_THM] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN
    REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
    MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
    REWRITE_TAC[CLOSURE_APPROACHABLE; CONJ_ASSOC; AND_FORALL_THM] THEN
    DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `d / &4`) ASSUME_TAC) THEN
    ASM_REWRITE_TAC[REAL_ARITH `&0 < d / &4 <=> &0 < d`] THEN
    DISCH_THEN(CONJUNCTS_THEN2
     (X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
     (X_CHOOSE_THEN `v:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN
    DISCH_THEN(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o CONJUNCT1) THEN
    ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
    REWRITE_TAC[diameter; CLOSURE_EQ_EMPTY] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUP_EQ THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    MATCH_MP_TAC(MESON[]
     `(!a b. P a ==> ~(Q b a)) /\ (!a b. P a ==> ~(R b a))
      ==> (?x. P x) ==> !b. (!x. Q b x) <=> (!x. R b x)`) THEN
    SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
    REWRITE_TAC[RIGHT_FORALL_IMP_THM; GSYM NOT_EXISTS_THM] THEN
    ONCE_REWRITE_TAC[NORM_ARITH `norm(a - y:real^N) = norm(--a + y)`] THEN
    ONCE_REWRITE_TAC[SET_RULE
     `(!x. x IN s ==> norm(a + x:real^N) <= b) <=>
      (!x. x IN IMAGE (\x. a + x) s ==> norm(x) <= b)`] THEN
    ASM_REWRITE_TAC[GSYM bounded; BOUNDED_TRANSLATION_EQ;
                    BOUNDED_CLOSURE_EQ]]);;

let DIAMETER_SUBSET_CBALL_NONEMPTY = prove
 (`!s:real^N->bool.
       bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)`,
   REPEAT STRIP_TAC THEN
   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
   DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN
   DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN
   ASM_MESON_TAC[DIAMETER_BOUNDED]);;

let DIAMETER_SUBSET_CBALL = prove
 (`!s:real^N->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY; EMPTY_SUBSET]);;

let DIAMETER_EQ_0 = prove
 (`!s:real^N->bool.
        bounded s ==> (diameter s = &0 <=> s = {} \/ ?a. s = {a})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[DIAMETER_EMPTY; DIAMETER_SING] THEN
  REWRITE_TAC[SET_RULE
   `s = {} \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`]
        DIAMETER_BOUNDED_BOUND) THEN
  ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;

let DIAMETER_LE = prove
 (`!s:real^N->bool.
        (~(s = {}) \/ &0 <= d) /\
        (!x y. x IN s /\ y IN s ==> norm(x - y) <= d) ==> diameter s <= d`,
  GEN_TAC THEN REWRITE_TAC[diameter] THEN
  COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_GSPEC]]);;

let BOUNDED_AND_DIAMETER_LE = prove
 (`!s:real^N->bool r.
        bounded s /\ diameter s <= r <=>
        &0 <= r /\ !x y. x IN s /\ y IN s ==> dist(x,y) <= r`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= r` THENL
   [ASM_REWRITE_TAC[]; ASM_MESON_TAC[DIAMETER_POS_LE; REAL_LE_TRANS]] THEN
  EQ_TAC THENL
   [MESON_TAC[DIAMETER_BOUNDED_BOUND; dist; REAL_LE_TRANS]; ALL_TAC] THEN
  REPEAT STRIP_TAC THENL
   [ALL_TAC; MATCH_MP_TAC DIAMETER_LE THEN ASM_REWRITE_TAC[GSYM dist]] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[BOUNDED_EMPTY] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(a:real^N,r)` THEN
  ASM_SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL; dist]);;

let DIST_LE_DIAMETER = prove
 (`!s a b:real^N. bounded s /\ a IN s /\ b IN s ==> dist(a,b) <= diameter s`,
  MESON_TAC[BOUNDED_AND_DIAMETER_LE; REAL_LE_REFL]);;

let DIAMETER_CBALL = prove
 (`!a:real^N r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THENL
   [ASM_MESON_TAC[CBALL_EQ_EMPTY; DIAMETER_EMPTY]; ALL_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
   [MATCH_MP_TAC DIAMETER_LE THEN
    ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LE_MUL; REAL_POS; REAL_NOT_LT] THEN
    REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC;
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `norm((a + r % basis 1) - (a - r % basis 1):real^N)` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[VECTOR_ARITH `(a + r % b) - (a - r % b:real^N) =
                                (&2 * r) % b`] THEN
      SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
      ASM_REAL_ARITH_TAC;
      MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
      REWRITE_TAC[BOUNDED_CBALL; IN_CBALL] THEN
      REWRITE_TAC[NORM_ARITH
       `dist(a:real^N,a + b) = norm b /\ dist(a,a - b) = norm b`] THEN
      SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
      ASM_REAL_ARITH_TAC]]);;

let DIAMETER_BALL = prove
 (`!a:real^N r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THENL
   [ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; DIAMETER_EMPTY]; ALL_TAC] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; DIAMETER_EMPTY; REAL_MUL_RZERO] THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC `diameter(cball(a:real^N,r))` THEN CONJ_TAC THENL
   [SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    ASM_SIMP_TAC[GSYM CLOSURE_BALL; DIAMETER_CLOSURE; BOUNDED_BALL];
    ASM_SIMP_TAC[DIAMETER_CBALL]]);;

let DIAMETER_SCALING = prove
 (`!a s:real^N->bool.
        bounded s ==> diameter(IMAGE (\x. a % x) s) = abs a * diameter s`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[DIAMETER_EMPTY; IMAGE_CLAUSES; REAL_MUL_RZERO] THEN
  ASM_CASES_TAC `a = &0` THEN
  ASM_SIMP_TAC[VECTOR_MUL_LZERO; SET_RULE
     `~(s = {}) ==> IMAGE (\x. a) s = {a}`] THEN
  REWRITE_TAC[DIAMETER_SING; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
  ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
  CONJ_TAC THEN MATCH_MP_TAC DIAMETER_LE THEN
  ASM_SIMP_TAC[DIAMETER_POS_LE; REAL_LE_MUL; REAL_ABS_POS] THEN
  REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THENL
   [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
    REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
    ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_ABS_NZ] THEN
    ASM_MESON_TAC[DIAMETER_BOUNDED_BOUND];
    ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    REWRITE_TAC[GSYM NORM_MUL; VECTOR_SUB_LDISTRIB] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
    ASM_SIMP_TAC[BOUNDED_SCALING] THEN ASM SET_TAC[]]);;

let DIAMETER_AFFINITY = prove
 (`!s m c:real^N.
        bounded s
        ==> diameter(IMAGE (\x. m % x + c) s) = abs m * diameter s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; IMAGE_o; DIAMETER_TRANSLATION] THEN
  REWRITE_TAC[DIAMETER_SCALING]);;

let DIAMETER_SUMS = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t
        ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`;
               DIAMETER_EMPTY; REAL_ADD_LID; DIAMETER_POS_LE] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`;
               DIAMETER_EMPTY; REAL_ADD_RID; DIAMETER_POS_LE] THEN
  MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH
   `norm(x - x') <= s /\ norm(y - y') <= t
    ==> norm((x + y) - (x' + y'):real^N) <= s + t`) THEN
  ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND]);;

let DIAMETER_LE_SUMS_RIGHT = prove
 (`!s t:real^N->bool.
        ~(t = {}) /\ bounded s /\ bounded t
        ==> diameter s <= diameter {x + y | x IN s /\ y IN t}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIAMETER_LE THEN
  ASM_SIMP_TAC[DIAMETER_POS_LE; BOUNDED_SUMS] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
  SUBST1_TAC(VECTOR_ARITH `x - y:real^N = (x + z) - (y + z)`) THEN
  MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
  ASM_SIMP_TAC[BOUNDED_SUMS] THEN ASM SET_TAC[]);;

let DIAMETER_LE_SUMS_LEFT = prove
 (`!s t:real^N->bool.
        ~(s = {}) /\ bounded s /\ bounded t
        ==> diameter t <= diameter {x + y | x IN s /\ y IN t}`,
  ONCE_REWRITE_TAC[SUMS_SYM] THEN SIMP_TAC[DIAMETER_LE_SUMS_RIGHT]);;

let DIAMETER_UNION_LE = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t /\ ~(s INTER t = {})
        ==> diameter(s UNION t) <= diameter s + diameter t`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIAMETER_LE THEN
  ASM_SIMP_TAC[REAL_LE_ADD; DIAMETER_POS_LE; IN_UNION] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL
   [MATCH_MP_TAC(REAL_ARITH `x <= a /\ &0 <= b ==> x <= a + b`) THEN
    ASM_SIMP_TAC[DIAMETER_POS_LE];
    MATCH_MP_TAC(NORM_ARITH
     `norm(x - z:real^N) <= s /\ norm(y - z) <= t
      ==> norm(x - y) <= s + t`) THEN CONJ_TAC;
    MATCH_MP_TAC(NORM_ARITH
     `norm(x - z:real^N) <= t /\ norm(y - z) <= s
      ==> norm(x - y) <= s + t`) THEN CONJ_TAC;
    MATCH_MP_TAC(REAL_ARITH `x <= b /\ &0 <= a ==> x <= a + b`) THEN
    ASM_SIMP_TAC[DIAMETER_POS_LE]] THEN
  MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM_REWRITE_TAC[]);;

let LEBESGUE_COVERING_LEMMA = prove
 (`!s:real^N->bool c.
        compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open b)
        ==> ?d. &0 < d /\
                !t. t SUBSET s /\ diameter t <= d
                    ==> ?b. b IN c /\ t SUBSET b`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN
  DISCH_THEN(MP_TAC o SPEC `c:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[] THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN
  STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPEC `t:real^N->bool` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN
  ANTS_TAC THENL
   [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
  X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC SUBSET_TRANS THEN
  EXISTS_TAC `cball(x:real^N,diameter(t:real^N->bool))` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN
  EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN
  MAP_EVERY UNDISCH_TAC [`&0 < e`; `diameter(t:real^N->bool) <= e / &2`] THEN
  NORM_ARITH_TAC);;

let LEBESGUE_COVERING_LEMMA_GEN = prove
 (`!u s c:(real^N->bool)->bool.
         compact s /\
         ~(c = {}) /\
         s SUBSET UNIONS c /\
         (!b. b IN c ==> open_in (subtopology euclidean u) b)
         ==> ?d. &0 < d /\
                 !t. t SUBSET s /\ diameter t <= d
                     ==> ?b. b IN c /\ t SUBSET b`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV)
   [OPEN_IN_OPEN]) 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 `t:(real^N->bool)->(real^N->bool)` THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  MP_TAC(ISPECL[`s:real^N->bool`; `IMAGE (t:(real^N->bool)->(real^N->bool)) c`]
        LEBESGUE_COVERING_LEMMA) THEN
  ASM_SIMP_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
  REWRITE_TAC[UNIONS_IMAGE] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
  GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_FORALL THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Related results with closure as the conclusion.                           *)
(* ------------------------------------------------------------------------- *)

let CLOSED_SCALING = prove
 (`!s:real^N->bool c. closed s ==> closed (IMAGE (\x. c % x) s)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s :real^N->bool = {}` THEN
  ASM_REWRITE_TAC[CLOSED_EMPTY; IMAGE_CLAUSES] THEN
  ASM_CASES_TAC `c = &0` THENL
   [SUBGOAL_THEN `IMAGE (\x:real^N. c % x) s = {(vec 0)}`
     (fun th -> REWRITE_TAC[th; CLOSED_SING]) THEN
    ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING; VECTOR_MUL_LZERO] THEN
    ASM_MESON_TAC[MEMBER_NOT_EMPTY];
    ALL_TAC] THEN
  REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_IMAGE; SKOLEM_THM] THEN
  STRIP_TAC THEN X_GEN_TAC `x:num->real^N` THEN X_GEN_TAC `l:real^N` THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` MP_TAC) THEN
  REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
  EXISTS_TAC `inv(c) % l :real^N` THEN
  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. inv(c) % x n:real^N` THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID];
    MATCH_MP_TAC LIM_CMUL THEN
    FIRST_ASSUM(fun th -> REWRITE_TAC[SYM(SPEC_ALL th)]) THEN
    ASM_REWRITE_TAC[ETA_AX]]);;

let CLOSED_NEGATIONS = prove
 (`!s:real^N->bool. closed s ==> closed (IMAGE (--) s)`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x:real^N. --(&1) % x) s`
  SUBST1_TAC THEN SIMP_TAC[CLOSED_SCALING] THEN
  REWRITE_TAC[VECTOR_ARITH `--(&1) % x = --x`] THEN REWRITE_TAC[ETA_AX]);;

let COMPACT_CLOSED_SUMS = prove
 (`!s:real^N->bool t.
        compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[compact; IN_ELIM_THM; CLOSED_SEQUENTIAL_LIMITS] THEN
  STRIP_TAC THEN X_GEN_TAC `f:num->real^N` THEN X_GEN_TAC `l:real^N` THEN
  REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` MP_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o check(is_imp o concl) o SPEC `a:num->real^N`) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `la:real^N` (X_CHOOSE_THEN `sub:num->num`
        STRIP_ASSUME_TAC)) THEN
  MAP_EVERY EXISTS_TAC [`la:real^N`; `l - la:real^N`] THEN
  ASM_REWRITE_TAC[VECTOR_ARITH `a + (b - a) = b:real^N`] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  EXISTS_TAC `\n. (f o (sub:num->num)) n - (a o sub) n:real^N` THEN
  CONJ_TAC THENL [ASM_REWRITE_TAC[VECTOR_ADD_SUB; o_THM]; ALL_TAC] THEN
  MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; ETA_AX]);;

let CLOSED_COMPACT_SUMS = prove
 (`!s:real^N->bool t.
        closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN `{x + y:real^N | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}`
  SUBST1_TAC THEN  SIMP_TAC[COMPACT_CLOSED_SUMS] THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);;

let CLOSURE_SUMS = prove
 (`!s t:real^N->bool.
        bounded s \/ bounded t
        ==> closure {x + y | x IN s /\ y IN t} =
            {x + y | x IN closure s /\ y IN closure t}`,
  REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
  REWRITE_TAC[FORALL_AND_THM] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN
  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN
  SIMP_TAC[] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; CLOSURE_SEQUENTIAL] THEN
  X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL
   [REWRITE_TAC[IN_ELIM_THM; IN_DELETE; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN
    REWRITE_TAC[FORALL_AND_THM] THEN
    ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
    ONCE_REWRITE_TAC[MESON[] `(?f x y. P f x y) <=> (?x y f. P f x y)`] THEN
    ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN
    REWRITE_TAC[ETA_AX; UNWIND_THM2] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPEC `closure s:real^N->bool` compact) THEN
    ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
    DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN
    ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N`; `r:num->num`] THEN STRIP_TAC THEN
    EXISTS_TAC `z - u:real^N` THEN
    EXISTS_TAC `(a:num->real^N) o (r:num->num)` THEN EXISTS_TAC `u:real^N` THEN
    ASM_REWRITE_TAC[o_THM] THEN
    CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
    EXISTS_TAC `(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n)
                :num->real^N` THEN
    CONJ_TAC THENL
     [ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(a + b) - a:real^N = b`];
      MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN
      MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]];
    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM;
                RIGHT_AND_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC
     [`x:real^N`; `y:real^N`; `a:num->real^N`; `b:num->real^N`] THEN
    STRIP_TAC THEN EXISTS_TAC `(\n. a n + b n):num->real^N` THEN
    ASM_SIMP_TAC[LIM_ADD] THEN ASM_MESON_TAC[]]);;

let COMPACT_CLOSED_DIFFERENCES = prove
 (`!s:real^N->bool t.
        compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} =
                {x + y | x IN s /\ y IN (IMAGE (--) t)}`
    (fun th -> ASM_SIMP_TAC[th; COMPACT_CLOSED_SUMS; CLOSED_NEGATIONS]) THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN
  SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN
  MESON_TAC[VECTOR_NEG_NEG]);;

let CLOSED_COMPACT_DIFFERENCES = prove
 (`!s:real^N->bool t.
        closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} =
                {x + y | x IN s /\ y IN (IMAGE (--) t)}`
    (fun th -> ASM_SIMP_TAC[th; CLOSED_COMPACT_SUMS; COMPACT_NEGATIONS]) THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN
  SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN
  MESON_TAC[VECTOR_NEG_NEG]);;

let CLOSED_TRANSLATION_EQ = prove
 (`!a s. closed (IMAGE (\x:real^N. a + x) s) <=> closed s`,
  REWRITE_TAC[closed] THEN GEOM_TRANSLATE_TAC[]);;

let CLOSED_TRANSLATION = prove
 (`!s a:real^N. closed s ==> closed (IMAGE (\x. a + x) s)`,
  REWRITE_TAC[CLOSED_TRANSLATION_EQ]);;

add_translation_invariants [CLOSED_TRANSLATION_EQ];;

let COMPLETE_TRANSLATION_EQ = prove
 (`!a s. complete(IMAGE (\x:real^N. a + x) s) <=> complete s`,
  REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_TRANSLATION_EQ]);;

add_translation_invariants [COMPLETE_TRANSLATION_EQ];;

let CLOSED_SCALING_EQ = prove
 (`!s:real^N->bool c. closed (IMAGE (\x. c % x) s) <=> c = &0 \/ closed s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN
    MESON_TAC[CLOSED_SING; CLOSED_EMPTY];
    EQ_TAC THEN REWRITE_TAC[CLOSED_SCALING] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP CLOSED_SCALING) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);;

let CLOSED_AFFINITY_EQ = prove
 (`!s m c:real^N.
        closed (IMAGE (\x. m % x + c) s) <=> m = &0 \/ closed s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; CLOSED_TRANSLATION_EQ;
              CLOSED_SCALING_EQ; IMAGE_o]);;

let CLOSED_AFFINITY = prove
 (`!s m c:real^N. closed s ==> closed (IMAGE (\x. m % x + c) s)`,
  SIMP_TAC[CLOSED_AFFINITY_EQ]);;

let TRANSLATION_DIFF = prove
 (`!s t:real^N->bool.
        IMAGE (\x. a + x) (s DIFF t) =
        (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)`,
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_IMAGE] THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = a + y <=> y = x - a`] THEN
  REWRITE_TAC[UNWIND_THM2]);;

let CLOSURE_TRANSLATION = prove
 (`!a s. closure(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (closure s)`,
  REWRITE_TAC[CLOSURE_INTERIOR] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [CLOSURE_TRANSLATION];;

let FRONTIER_TRANSLATION = prove
 (`!a s. frontier(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (frontier s)`,
  REWRITE_TAC[frontier] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [FRONTIER_TRANSLATION];;

let DIAMETER_LT_SUMS_RIGHT = prove
 (`!s t:real^N->bool.
        ~(s = {}) /\ ~(?a. t SUBSET {a}) /\ bounded s /\ bounded t
        ==> diameter s < diameter {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[GSYM DIAMETER_CLOSURE] THEN SIMP_TAC[CLOSURE_SUMS] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP
   (SET_RULE `~(s = {}) /\ ~(?a. t SUBSET {a})
              ==> s SUBSET closure s /\ t SUBSET closure t
                  ==> ~(closure s = {}) /\ ~(?a. closure t SUBSET {a})`)) THEN
  REWRITE_TAC[CLOSURE_SUBSET; IMP_IMP; GSYM CONJ_ASSOC] THEN
  MAP_EVERY SPEC_TAC
   [`closure t:real^N->bool`,`t:real^N->bool`;
    `closure s:real^N->bool`,`s:real^N->bool`] THEN
  REWRITE_TAC[GSYM REAL_NOT_LE] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `?a b:real^N. a IN t /\ b IN t /\ ~(a = b)`
  STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPEC `{x + y:real^N | x IN s /\ y IN t}`
        DIAMETER_BOUNDED_BOUND) THEN
  ASM_SIMP_TAC[BOUNDED_SUMS; COMPACT_IMP_BOUNDED; IMP_CONJ;
               RIGHT_FORALL_IMP_THM] THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
  MP_TAC(ISPEC `s:real^N->bool` DIAMETER_COMPACT_ATTAINED) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  DISCH_THEN(fun th ->
    MP_TAC(ISPECL [`x:real^N`; `a:real^N`; `y:real^N`; `b:real^N`] th) THEN
    MP_TAC(ISPECL [`x:real^N`; `b:real^N`; `y:real^N`; `a:real^N`] th)) THEN
  ASM_REWRITE_TAC[VECTOR_ARITH
    `(x + a) - (y + b):real^N = (x - y) + (a - b)`] THEN
  MP_TAC(ISPECL [`x - y:real^N`; `b - a:real^N`] NORM_INCREASES_ONLINE) THEN
  ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH
   `(x - y) - (b - a):real^N = (x - y) + (a - b)`] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT]) THEN
  SPEC_TAC(`diameter {x + y:real^N | x IN s /\ y IN t}`,`d:real`) THEN
  ASM_REAL_ARITH_TAC);;

let DIAMETER_LT_SUMS_LEFT = prove
 (`!s t:real^N->bool.
        ~(?a. s SUBSET {a}) /\ ~(t = {}) /\ bounded s /\ bounded t
        ==> diameter t < diameter {x + y | x IN s /\ y IN t}`,
  ONCE_REWRITE_TAC[SUMS_SYM] THEN SIMP_TAC[DIAMETER_LT_SUMS_RIGHT]);;

(* ------------------------------------------------------------------------- *)
(* It is always possible to shrink a ball containing a compact set.          *)
(* ------------------------------------------------------------------------- *)

let COMPACT_SHRINK_ENCLOSING_BALL = prove
 (`!s x:real^N r. &0 < r /\ compact s /\ s SUBSET ball(x,r)
                  ==> ?r'. &0 < r' /\ r' < r /\ s SUBSET ball(x,r')`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
  [POP_ASSUM SUBST1_TAC THEN INTRO_TAC "r _ _" THEN EXISTS_TAC `r / &2` THEN
   REWRITE_TAC[EMPTY_SUBSET] THEN ASM_REAL_ARITH_TAC;
   ALL_TAC] THEN
  REWRITE_TAC[SUBSET; IN_BALL] THEN REPEAT STRIP_TAC THEN
  MP_TAC (ISPECL[`s:real^N->bool`;`x:real^N`] DISTANCE_ATTAINS_SUP) THEN
  ASM_REWRITE_TAC[] THEN INTRO_TAC "@y. y le" THEN
  EXISTS_TAC `(dist (x:real^N,y) + r) / &2` THEN
  CLAIM_TAC "rlt" `dist(x:real^N,y) < r` THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN
  ASM_SIMP_TAC[REAL_ARITH `a <= b /\ b < c ==> a < (b + c) / &2`] THEN
  ASM_NORM_ARITH_TAC);;

let COMPACT_SHRINK_ENCLOSING_BALL_INFTY = prove
 (`!s b. compact s /\ (!x:real^N. x IN s ==> b * norm x < &1)
         ==> ?r. &0 < r /\ b * r < &1 /\ !x. x IN s ==> norm x < r`,
  INTRO_TAC "!s b; cpt sub" THEN ASM_CASES_TAC `&0 < b` THENL
  [MP_TAC (ISPECL [`s:real^N->bool`;`vec 0:real^N`; `inv b`]
                  COMPACT_SHRINK_ENCLOSING_BALL) THEN
   ASM_REWRITE_TAC[REAL_LT_INV_EQ; SUBSET; IN_BALL_0] THEN
   ANTS_TAC THENL
   [GEN_TAC THEN DISCH_TAC THEN
    MATCH_MP_TAC (SPEC `b:real` REAL_LT_LCANCEL_IMP) THEN
    ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_RINV];
    ALL_TAC] THEN
   INTRO_TAC "@r. rpos rlt sub" THEN EXISTS_TAC `r:real` THEN
   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (SPEC `inv b` REAL_LT_LCANCEL_IMP) THEN
   ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_MUL_RID] THEN
   ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> inv b * b * r = r`];
   POP_ASSUM (LABEL_TAC "bneg" o REWRITE_RULE[REAL_NOT_LT])] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
  [POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `&1` THEN
   REWRITE_TAC[REAL_LT_01; NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC;
   ALL_TAC] THEN
  MP_TAC (ISPECL [`s:real^N->bool`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN
  ASM_REWRITE_TAC[DIST_0] THEN INTRO_TAC "@x. x le" THEN
  EXISTS_TAC `norm (x:real^N) + &1` THEN
  CONJ_TAC THENL [ASM_NORM_ARITH_TAC; ALL_TAC] THEN
  ASM_SIMP_TAC[REAL_ARITH `x <= y ==> x < y + &1`] THEN
  TRANS_TAC REAL_LET_TRANS `&0` THEN
  REWRITE_TAC[REAL_LT_01; GSYM REAL_NOT_LT; REAL_MUL_POS_LT] THEN
  ASM_NORM_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Separation between points and sets.                                       *)
(* ------------------------------------------------------------------------- *)

let SEPARATE_POINT_CLOSED = prove
 (`!s a:real^N.
        closed s /\ ~(a IN s)
        ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] DISTANCE_ATTAINS_INF) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
  STRIP_TAC THEN EXISTS_TAC `dist(a:real^N,b)` THEN
  ASM_MESON_TAC[DIST_POS_LT]);;

let SEPARATE_COMPACT_CLOSED = prove
 (`!s t:real^N->bool.
        compact s /\ closed t /\ s INTER t = {}
        ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`]
                SEPARATE_POINT_CLOSED) THEN
  ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; IN_ELIM_THM] THEN
  REWRITE_TAC[VECTOR_ARITH `vec 0 = x - y <=> x = y`] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN
  MESON_TAC[NORM_ARITH `dist(vec 0,x - y) = dist(x,y)`]);;

let SEPARATE_CLOSED_COMPACT = prove
 (`!s t:real^N->bool.
        closed s /\ compact t /\ s INTER t = {}
        ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`,
  ONCE_REWRITE_TAC[DIST_SYM; INTER_COMM] THEN
  MESON_TAC[SEPARATE_COMPACT_CLOSED]);;

(* ------------------------------------------------------------------------- *)
(* Representing sets as the union of a chain of compact sets.                *)
(* ------------------------------------------------------------------------- *)

let CLOSED_UNION_COMPACT_SUBSETS = prove
 (`!s. closed s
       ==> ?f:num->real^N->bool.
                (!n. compact(f n)) /\
                (!n. (f n) SUBSET s) /\
                (!n. (f n) SUBSET f(n + 1)) /\
                UNIONS {f n | n IN (:num)} = s /\
                (!k. compact k /\ k SUBSET s
                     ==> ?N. !n. n >= N ==> k SUBSET (f n))`,
  REPEAT STRIP_TAC THEN
  EXISTS_TAC `\n. s INTER cball(vec 0:real^N,&n)` THEN
  ASM_SIMP_TAC[INTER_SUBSET; COMPACT_CBALL; CLOSED_INTER_COMPACT] THEN
  REPEAT CONJ_TAC THENL
   [GEN_TAC THEN MATCH_MP_TAC(SET_RULE
     `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN
    REWRITE_TAC[SUBSET_BALLS; DIST_REFL; GSYM REAL_OF_NUM_ADD] THEN
    REAL_ARITH_TAC;
    REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_INTER] THEN
    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL_0] THEN
    MESON_TAC[REAL_ARCH_SIMPLE];
    X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER] THEN
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN
     (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN

    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        SUBSET_TRANS)) THEN
    REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]);;

let OPEN_UNION_COMPACT_SUBSETS = prove
 (`!s. open s
       ==> ?f:num->real^N->bool.
                (!n. compact(f n)) /\
                (!n. (f n) SUBSET s) /\
                (!n. (f n) SUBSET interior(f(n + 1))) /\
                UNIONS {f n | n IN (:num)} = s /\
                (!k. compact k /\ k SUBSET s
                     ==> ?N. !n. n >= N ==> k SUBSET (f n))`,
  GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [DISCH_TAC THEN EXISTS_TAC `(\n. {}):num->real^N->bool` THEN
    ASM_SIMP_TAC[EMPTY_SUBSET; SUBSET_EMPTY; COMPACT_EMPTY] THEN
    REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC] THEN
  MATCH_MP_TAC(MESON[]
   `(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\
    (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f))
    ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f`) THEN
  CONJ_TAC THENL
   [X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN
    DISCH_THEN(MP_TAC o SPEC `{interior(f n):real^N->bool | n IN (:num)}`) THEN
    REWRITE_TAC[FORALL_IN_GSPEC; OPEN_INTERIOR] THEN ANTS_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        SUBSET_TRANS)) THEN
      REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[];
      ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
      REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN
      REWRITE_TAC[SUBSET_UNIV] THEN
      DISCH_THEN(X_CHOOSE_THEN `i:num->bool` STRIP_ASSUME_TAC) THEN
      FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o
        MATCH_MP UPPER_BOUND_FINITE_SET) THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
      REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        SUBSET_TRANS)) THEN
      REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
      EXISTS_TAC `(f:num->real^N->bool) m` THEN
      REWRITE_TAC[INTERIOR_SUBSET] THEN
      SUBGOAL_THEN `!m n. m <= n ==> (f:num->real^N->bool) m SUBSET f n`
       (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_MESON_TAC[SUBSET; ADD1; INTERIOR_SUBSET]];
    EXISTS_TAC
     `\n. cball(a,&n) DIFF
         {x + e | x IN (:real^N) DIFF s /\ e IN ball(vec 0,inv(&n + &1))}` THEN
    REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [X_GEN_TAC `n:num` THEN MATCH_MP_TAC COMPACT_DIFF THEN
      SIMP_TAC[COMPACT_CBALL; OPEN_SUMS; OPEN_BALL];
      GEN_TAC THEN MATCH_MP_TAC(SET_RULE
       `(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s`) THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
      ASM_REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN
      REAL_ARITH_TAC;
      GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE
       `s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')`) THEN
      CONJ_TAC THENL
       [REWRITE_TAC[INTERIOR_CBALL; SUBSET; IN_BALL; IN_CBALL] THEN
        REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
        MATCH_MP_TAC SUBSET_TRANS THEN
        EXISTS_TAC `{x + e | x IN (:real^N) DIFF s /\
                             e IN cball(vec 0,inv(&n + &2))}` THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC CLOSURE_MINIMAL THEN
          ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL;
                       GSYM OPEN_CLOSED] THEN
          MATCH_MP_TAC(SET_RULE
           `t SUBSET t'
            ==> {f x y | x IN s /\ y IN t} SUBSET
                {f x y | x IN s /\ y IN t'}`) THEN
          REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN
          REAL_ARITH_TAC;
          MATCH_MP_TAC(SET_RULE
           `t SUBSET t'
            ==> {f x y | x IN s /\ y IN t} SUBSET
                {f x y | x IN s /\ y IN t'}`) THEN
          REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN
          GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
           `a < b ==> x <= a ==> x < b`) THEN
          MATCH_MP_TAC REAL_LT_INV2 THEN REAL_ARITH_TAC]];
      DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
      ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
      REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN
      REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_BALL_0] THEN
      REWRITE_TAC[VECTOR_ARITH `x:real^N = y + e <=> e = x - y`] THEN
      REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`; UNWIND_THM2] THEN
      REWRITE_TAC[MESON[] `~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x`] 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[SUBSET; IN_BALL; dist] THEN
      DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
      FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
      DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPEC `norm(x - a:real^N)` REAL_ARCH_SIMPLE) THEN
      DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN
      CONJ_TAC THENL
       [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
        UNDISCH_TAC `norm(x - a:real^N) <= &N2` THEN
        REWRITE_TAC[dist; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
        REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        SUBGOAL_THEN `inv(&(N1 + N2) + &1) <= inv(&N1)` MP_TAC THENL
         [MATCH_MP_TAC REAL_LE_INV2 THEN
          ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN
          REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
          ASM_REAL_ARITH_TAC]]]]);;

(* ------------------------------------------------------------------------- *)
(* Closed-graph characterization of continuity.                              *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_CLOSED_GRAPH_GEN = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s SUBSET t
        ==> closed_in (subtopology euclidean (s PCROSS t))
                      {pastecart x (f x) | x IN s}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{pastecart (x:real^M) (f x:real^N) | x IN s} =
    {z | z IN s PCROSS t /\ f(fstcart z) - sndcart z IN {vec 0}}`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_SING;
                PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
                PASTECART_INJ; VECTOR_SUB_EQ] THEN
    ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
    REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    SIMP_TAC[GSYM o_DEF; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN
    ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]]);;

let CONTINUOUS_CLOSED_GRAPH_EQ = prove
 (`!f:real^M->real^N s t.
        compact t /\ IMAGE f s SUBSET t
        ==> (f continuous_on s <=>
             closed_in (subtopology euclidean (s PCROSS t))
                       {pastecart x (f x) | x IN s})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  ASM_SIMP_TAC[CONTINUOUS_CLOSED_GRAPH_GEN] THEN DISCH_TAC THEN
  FIRST_ASSUM(fun th ->
   REWRITE_TAC[MATCH_MP CONTINUOUS_ON_CLOSED_GEN th]) THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x IN c} =
    IMAGE fstcart ({pastecart x (f x) | x IN s} INTER
                   (s PCROSS c))`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART;
                FSTCART_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM;
                PASTECART_IN_PCROSS; PASTECART_INJ] THEN
    ASM SET_TAC[];
    MATCH_MP_TAC CLOSED_MAP_FSTCART THEN EXISTS_TAC `t:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN
    ASM_REWRITE_TAC[] THEN  MATCH_MP_TAC CLOSED_IN_PCROSS THEN
    ASM_REWRITE_TAC[CLOSED_IN_REFL]]);;

let CONTINUOUS_CLOSED_GRAPH = prove
 (`!f:real^M->real^N s.
        closed s /\ f continuous_on s ==> closed {pastecart x (f x) | x IN s}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
  EXISTS_TAC `(s:real^M->bool) PCROSS (:real^N)` THEN
  ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_UNIV] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_GRAPH_GEN THEN
  ASM_REWRITE_TAC[SUBSET_UNIV]);;

let CONTINUOUS_FROM_CLOSED_GRAPH = prove
 (`!f:real^M->real^N s t.
        compact t /\ IMAGE f s SUBSET t /\
        closed {pastecart x (f x) | x IN s}
        ==> f continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONTINUOUS_CLOSED_GRAPH_EQ) THEN
  MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* More topological properties of intervals.                                 *)
(* ------------------------------------------------------------------------- *)

let OPEN_INTERVAL_LEMMA = prove
 (`!a b x. a < x /\ x < b
           ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b`,
  REPEAT STRIP_TAC THEN
  EXISTS_TAC `min (x - a) (b - x)` THEN REWRITE_TAC[REAL_LT_MIN] THEN
  ASM_REAL_ARITH_TAC);;

let OPEN_INTERVAL = prove
 (`!a:real^N b. open(interval (a,b))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[open_def; interval; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N)
                    ==> ?d. &0 < d /\
                            !x'. abs(x' - (x:real^N)$i) < d
                                 ==> (a:real^N)$i < x' /\ x' < (b:real^N)$i`
  MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTERVAL_LEMMA]; ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:num->real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `inf (IMAGE d (1..dimindex(:N)))` THEN
  SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG;
           IMAGE_EQ_EMPTY; NOT_INSERT_EMPTY; NUMSEG_EMPTY;
           ARITH_RULE `n < 1 <=> (n = 0)`; DIMINDEX_NONZERO] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; dist] THEN
  ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; VECTOR_SUB_COMPONENT]);;

let CLOSED_INTERVAL = prove
 (`!a:real^N b. closed(interval [a,b])`,
  REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_INTERVAL] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`);
    FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`)] THEN
  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[dist; REAL_NOT_LT] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN
  ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
  ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
  ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`;
               REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);;

let INTERIOR_CLOSED_INTERVAL = prove
 (`!a:real^N b. interior(interval [a,b]) = interval (a,b)`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC INTERIOR_MAXIMAL THEN
    REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL]] THEN
  REWRITE_TAC[interior; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN
  DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
  X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  ASM_SIMP_TAC[REAL_LT_LE] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
   [(let t = `x - (e / &2) % basis i :real^N` in
     DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t));
    (let t = `x + (e / &2) % basis i :real^N` in
     DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t))] THEN
  REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_ARITH `x - y - x = --y:real^N`] THEN
  ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; NORM_NEG; REAL_MUL_RID;
               REAL_ARITH `&0 < e ==> abs(e / &2) < e`] THEN
  MATCH_MP_TAC(TAUT `~b ==> (a ==> b) ==> ~a`) THEN
  REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `i:num` THEN
  ASM_SIMP_TAC[DE_MORGAN_THM; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THENL
   [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `a <= a - b <=> ~(&0 < b)`];
    DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `a + b <= a <=> ~(&0 < b)`]] THEN
  ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; basis; LAMBDA_BETA; REAL_MUL_RID] THEN
  ASM_REWRITE_TAC[REAL_HALF]);;

let INTERIOR_INTERVAL = prove
 (`(!a b. interior(interval[a,b]) = interval(a,b)) /\
   (!a b. interior(interval(a,b)) = interval(a,b))`,
  SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);;

let BOUNDED_CLOSED_INTERVAL = prove
 (`!a b:real^N. bounded (interval [a,b])`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; interval] THEN
  EXISTS_TAC `sum(1..dimindex(:N))
                 (\i. abs((a:real^N)$i) + abs((b:real^N)$i))` THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x:real^N)$i))` THEN
  REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE THEN
  ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ARITH
   `a <= x /\ x <= b ==> abs(x) <= abs(a) + abs(b)`]);;

let BOUNDED_INTERVAL = prove
 (`(!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))`,
  MESON_TAC[BOUNDED_CLOSED_INTERVAL; BOUNDED_SUBSET;
            INTERVAL_OPEN_SUBSET_CLOSED]);;

let NOT_INTERVAL_UNIV = prove
 (`(!a b. ~(interval[a,b] = (:real^N))) /\
   (!a b. ~(interval(a,b) = (:real^N)))`,
  MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);;

let OPEN_INTERVAL_MIDPOINT = prove
 (`!a b:real^N.
        ~(interval(a,b) = {}) ==> (inv(&2) % (a + b)) IN interval(a,b)`,
  REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL] THEN
  SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN
  REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);;

let OPEN_CLOSED_INTERVAL_CONVEX = prove
 (`!a b x y:real^N e.
        x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1
        ==> (e % x + (&1 - e) % y) IN interval(a,b)`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
   `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN
  STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN
  SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
  MATCH_MP_TAC MONO_FORALL THEN
  GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
  SUBST1_TAC(REAL_ARITH `(a:real^N)$i = e * a$i + (&1 - e) * a$i`) THEN
  SUBST1_TAC(REAL_ARITH `(b:real^N)$i = e * b$i + (&1 - e) * b$i`) THEN
  CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN
  ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL; REAL_SUB_LE]);;

let CLOSURE_OPEN_INTERVAL = prove
 (`!a b:real^N.
     ~(interval(a,b) = {}) ==> closure(interval(a,b)) = interval[a,b]`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [MATCH_MP_TAC CLOSURE_MINIMAL THEN
    REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CLOSED_INTERVAL];
    ALL_TAC] THEN
  REWRITE_TAC[SUBSET; closure; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN
  DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN
  REWRITE_TAC[IN_ELIM_THM; LIMPT_SEQUENTIAL] THEN
  ABBREV_TAC `(c:real^N) = inv(&2) % (a + b)` THEN
  EXISTS_TAC `\n. (x:real^N) + inv(&n + &1) % (c - x)` THEN CONJ_TAC THENL
   [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DELETE] THEN
    REWRITE_TAC[VECTOR_ARITH `x + a = x <=> a = vec 0`] THEN
    REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0] THEN
    REWRITE_TAC[VECTOR_SUB_EQ; REAL_ARITH `~(&n + &1 = &0)`] THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN
    REWRITE_TAC[VECTOR_ARITH `x + a % (y - x) = a % y + (&1 - a) % x`] THEN
    MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN
    CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]; ALL_TAC] THEN
    ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = x + &0 % (c - x)`] THEN
  MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN
  MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_CONST] THEN
  REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; DIST_LIFT; REAL_SUB_RZERO] THEN
  X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
  STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
  REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `N:num <= n` THEN
  UNDISCH_TAC `~(N = 0)` THEN
  REWRITE_TAC[GSYM LT_NZ; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT] THEN
  REAL_ARITH_TAC);;

let CLOSURE_INTERVAL = prove
 (`(!a b. closure(interval[a,b]) = interval[a,b]) /\
   (!a b. closure(interval(a,b)) =
          if interval(a,b) = {} then {} else interval[a,b])`,
  SIMP_TAC[CLOSURE_CLOSED; CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN
  COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; CLOSURE_EMPTY]);;

let FRONTIER_CLOSED_INTERVAL = prove
 (`!a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)`,
  SIMP_TAC[frontier; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED;
           CLOSED_INTERVAL]);;

let FRONTIER_OPEN_INTERVAL = prove
 (`!a b. frontier(interval(a,b)) =
                if interval(a,b) = {} then {}
                else interval[a,b] DIFF interval(a,b)`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN
  ASM_SIMP_TAC[frontier; CLOSURE_OPEN_INTERVAL; INTERIOR_OPEN;
               OPEN_INTERVAL]);;

let INTER_INTERVAL_MIXED_EQ_EMPTY = prove
 (`!a b c d:real^N.
        ~(interval(c,d) = {})
        ==> (interval(a,b) INTER interval[c,d] = {} <=>
             interval(a,b) INTER interval(c,d) = {})`,
  SIMP_TAC[GSYM CLOSURE_OPEN_INTERVAL; OPEN_INTER_CLOSURE_EQ_EMPTY;
           OPEN_INTERVAL]);;

let INTERVAL_TRANSLATION = prove
 (`(!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\
   (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))`,
  REWRITE_TAC[interval] THEN CONJ_TAC THEN GEOM_TRANSLATE_TAC[] THEN
  REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);;

add_translation_invariants
 [CONJUNCT1 INTERVAL_TRANSLATION; CONJUNCT2 INTERVAL_TRANSLATION];;

let EMPTY_AS_INTERVAL = prove
 (`{} = interval[vec 1,vec 0]`,
  SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTERVAL; VEC_COMPONENT] THEN
  GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN
  REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);;

let UNIT_INTERVAL_NONEMPTY = prove
 (`~(interval[vec 0:real^N,vec 1] = {}) /\
   ~(interval(vec 0:real^N,vec 1) = {})`,
  SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01; REAL_POS]);;

let IMAGE_STRETCH_INTERVAL = prove
 (`!a b:real^N m.
    IMAGE (\x. lambda k. m(k) * x$k) (interval[a,b]) =
        if interval[a,b] = {} then {}
        else interval[(lambda k. min (m(k) * a$k) (m(k) * b$k)):real^N,
                      (lambda k. max (m(k) * a$k) (m(k) * b$k))]`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES] THEN
  ASM_SIMP_TAC[EXTENSION; IN_IMAGE; CART_EQ; IN_INTERVAL; AND_FORALL_THM;
               TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`;
                LAMBDA_BETA; GSYM LAMBDA_SKOLEM] THEN
  X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(MESON[]
   `(!x. p x ==> (q x <=> r x))
    ==> ((!x. p x ==> q x) <=> (!x. p x ==> r x))`) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN
  MATCH_MP_TAC MONO_FORALL THEN
  X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN
  ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(m:num->real) k = &0` THENL
   [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MAX_ACI; REAL_MIN_ACI] THEN
    ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_REFL];
    ALL_TAC] THEN
  ASM_SIMP_TAC[REAL_FIELD `~(m = &0) ==> (x = m * y <=> y = x / m)`] THEN
  REWRITE_TAC[UNWIND_THM2] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP
   (REAL_ARITH `~(z = &0) ==> &0 < z \/ &0 < --z`))
  THENL
   [ALL_TAC;
    ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    REWRITE_TAC[REAL_ARITH `--(max a b) = min (--a) (--b)`;
                REAL_ARITH `--(min a b) = max (--a) (--b)`; real_div;
                GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN
    REWRITE_TAC[GSYM real_div]] THEN
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN
  ASM_SIMP_TAC[real_min; real_max; REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ] THEN
  REAL_ARITH_TAC);;

let INTERVAL_IMAGE_STRETCH_INTERVAL = prove
 (`!a b:real^N m. ?u v:real^N.
     IMAGE (\x. lambda k. m k * x$k) (interval[a,b]) = interval[u,v]`,
  REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);;

let CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL = prove
 (`!a b:real^N.
        ~(interval[a,b] = {})
        ==> interval[a,b] = IMAGE (\x:real^N. a + x)
                                  (IMAGE (\x. (lambda i. (b$i - a$i) * x$i))
                                         (interval[vec 0:real^N,vec 1]))`,
  REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[IMAGE_STRETCH_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
  REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN
  REWRITE_TAC[EXTENSION; IN_INTERVAL] THEN
  SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN
  GEN_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN
  MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((!x. P x) <=> (!x. Q x))`) THEN
  POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
  ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
  REAL_ARITH_TAC);;

let SUMS_INTERVALS = prove
 (`(!a b c d:real^N.
        ~(interval[a,b] = {}) /\ ~(interval[c,d] = {})
        ==> {x + y | x IN interval[a,b] /\ y IN interval[c,d]} =
            interval[a+c,b+d]) /\
   (!a b c d:real^N.
        ~(interval(a,b) = {}) /\ ~(interval(c,d) = {})
        ==> {x + y | x IN interval(a,b) /\ y IN interval(c,d)} =
            interval(a+c,b+d))`,
  CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
  STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN
  REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN
  REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN
  REWRITE_TAC[UNWIND_THM2; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
  (X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC);
    DISCH_TAC THEN
    REWRITE_TAC[AND_FORALL_THM; GSYM LAMBDA_SKOLEM;
                TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
    REWRITE_TAC[REAL_ARITH
     `((a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=>
       max a (x - d) <= y /\ y <= min b (x - c)) /\
      ((a < y /\ y < b) /\ c < x - y /\ x - y < d <=>
       max a (x - d) < y /\ y < min b (x - c))`] THEN
    REWRITE_TAC[GSYM REAL_LE_BETWEEN; GSYM REAL_LT_BETWEEN]] THEN
  X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
  ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));;

let PCROSS_INTERVAL = prove
 (`!a b:real^M c d:real^N.
        interval[a,b] PCROSS interval[c,d] =
        interval[pastecart a c,pastecart b d]`,
  REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
  REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
  SIMP_TAC[IN_INTERVAL; pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THEN STRIP_TAC THENL
   [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
      FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB] THENL
       [ASM_ARITH_TAC;
        DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);;

let OPEN_CONTAINS_INTERVAL,OPEN_CONTAINS_OPEN_INTERVAL = (CONJ_PAIR o prove)
 (`(!s:real^N->bool.
        open s <=>
        !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\
   (!s:real^N->bool.
        open s <=>
        !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)`,
  REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED];
    DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
    MP_TAC(ISPEC `interval(a:real^N,b)` OPEN_CONTAINS_BALL) THEN
    REWRITE_TAC[OPEN_INTERVAL] THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED];
    DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o
      GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `x - e / &(dimindex(:N)) % vec 1:real^N` THEN
    EXISTS_TAC `x + e / &(dimindex(:N)) % vec 1:real^N` THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s`)) THEN
    SIMP_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; IN_CBALL;
             VEC_COMPONENT; VECTOR_ADD_COMPONENT; SUBSET; REAL_MUL_RID] THEN
    REWRITE_TAC[REAL_ARITH `x - e < x /\ x < x + e <=> &0 < e`;
                REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(x - y) <= e`] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
    X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
    DISCH_TAC THEN REWRITE_TAC[dist] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN
    REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
    ASM_SIMP_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN
    REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);;

let DIAMETER_INTERVAL = prove
 (`(!a b:real^N.
        diameter(interval[a,b]) =
        if interval[a,b] = {} then &0 else norm(b - a)) /\
   (!a b:real^N.
        diameter(interval(a,b)) =
        if interval(a,b) = {} then &0 else norm(b - a))`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
   [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_EMPTY; DIAMETER_EMPTY];
    ASM_REWRITE_TAC[]] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
    ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND;
                 ENDS_IN_INTERVAL; BOUNDED_INTERVAL] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     `diameter(cball(inv(&2) % (a + b):real^N,norm(b - a) / &2))` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN
      REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN
      GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN
      REWRITE_TAC[GSYM NORM_MUL; REAL_ARITH `x / &2 = abs(inv(&2)) * x`] THEN
      MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
      X_GEN_TAC `i:num` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
      ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
                      VECTOR_MUL_COMPONENT] THEN
      REAL_ARITH_TAC;
      REWRITE_TAC[DIAMETER_CBALL] THEN NORM_ARITH_TAC];
    DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN
    SUBGOAL_THEN `interval[a:real^N,b] = closure(interval(a,b))`
    SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN
    ASM_MESON_TAC[DIAMETER_CLOSURE; BOUNDED_INTERVAL]]);;

let IMAGE_TWIZZLE_INTERVAL = prove
 (`!p a b. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N)
           ==> IMAGE ((\x. lambda i. x$(p i)):real^M->real^N) (interval[a,b]) =
               interval[(lambda i. a$(p i)),(lambda i. b$(p i))]`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
  SIMP_TAC[IN_INTERVAL; CART_EQ; LAMBDA_BETA] THEN CONJ_TAC THENL
   [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    EXISTS_TAC `(lambda i. (y:real^N)$(inverse p i)):real^M` THEN
    IMP_REWRITE_TAC[LAMBDA_BETA] THEN
    ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN
    ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_IN_IMAGE];
    REWRITE_TAC[GSYM IN_NUMSEG] THEN
    ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]);;

let EQ_INTERVAL = prove
 (`(!a b c d:real^N.
        interval[a,b] = interval[c,d] <=>
        interval[a,b] = {} /\ interval[c,d] = {} \/ a = c /\ b = d) /\
   (!a b c d:real^N.
        interval[a,b] = interval(c,d) <=>
        interval[a,b] = {} /\ interval(c,d) = {}) /\
   (!a b c d:real^N.
        interval(a,b) = interval[c,d] <=>
        interval(a,b) = {} /\ interval[c,d] = {}) /\
   (!a b c d:real^N.
        interval(a,b) = interval(c,d) <=>
        interval(a,b) = {} /\ interval(c,d) = {} \/ a = c /\ b = d)`,
  REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN
  (EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[]]) THEN
  MATCH_MP_TAC(MESON[]
   `(p = {} /\ q = {} ==> r) /\ (~(p = {}) /\ ~(q = {}) ==> p = q ==> r)
    ==> p = q ==> r`) THEN
  SIMP_TAC[] THENL
   [REWRITE_TAC[INTERVAL_NE_EMPTY; CART_EQ] THEN
    REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
    SIMP_TAC[SUBSET_INTERVAL; GSYM REAL_LE_ANTISYM];
    STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN]
     `closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(s = t)`) THEN
    ASM_REWRITE_TAC[CLOSED_INTERVAL; OPEN_INTERVAL; NOT_INTERVAL_UNIV];
    STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN]
     `closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(t = s)`) THEN
    ASM_REWRITE_TAC[CLOSED_INTERVAL; OPEN_INTERVAL; NOT_INTERVAL_UNIV];
    REWRITE_TAC[INTERVAL_NE_EMPTY; CART_EQ] THEN
    REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
    SIMP_TAC[SUBSET_INTERVAL; GSYM REAL_LE_ANTISYM]]);;

let CLOSED_INTERVAL_EQ = prove
 (`(!a b:real^N. closed(interval[a,b])) /\
   (!a b:real^N. closed(interval(a,b)) <=> interval(a,b) = {})`,
  REWRITE_TAC[CLOSED_INTERVAL] THEN
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[CLOSED_EMPTY] THEN
  MP_TAC(ISPEC `interval(a:real^N,b)` CLOPEN) THEN
  ASM_REWRITE_TAC[OPEN_INTERVAL] THEN
  MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);;

let OPEN_INTERVAL_EQ = prove
 (`(!a b:real^N. open(interval[a,b]) <=> interval[a,b] = {}) /\
   (!a b:real^N. open(interval(a,b)))`,
  REWRITE_TAC[OPEN_INTERVAL] THEN
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[CLOSED_EMPTY] THEN
  MP_TAC(ISPEC `interval[a:real^N,b]` CLOPEN) THEN
  ASM_REWRITE_TAC[CLOSED_INTERVAL] THEN
  MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);;

let COMPACT_INTERVAL_EQ = prove
 (`(!a b:real^N. compact(interval[a,b])) /\
   (!a b:real^N. compact(interval(a,b)) <=> interval(a,b) = {})`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL] THEN
  REWRITE_TAC[CLOSED_INTERVAL_EQ]);;

let CLOSED_INTERVAL_DROPOUT = prove
 (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\
           1 <= k /\ k <= dimindex(:N) /\
           a$k <= b$k
           ==> interval[dropout k a,dropout k b] =
               IMAGE (dropout k:real^N->real^M) (interval[a,b])`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[EXTENSION; IN_IMAGE_DROPOUT; IN_INTERVAL] THEN
  X_GEN_TAC `x:real^M` THEN
  SIMP_TAC[pushin; dropout; LAMBDA_BETA] THEN EQ_TAC THENL
   [DISCH_TAC THEN EXISTS_TAC `(a:real^N)$k` THEN X_GEN_TAC `i:num` THEN
    STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
      COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
      COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN
      ANTS_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]];
    DISCH_THEN(X_CHOOSE_TAC `t:real`) THEN X_GEN_TAC `i:num` THEN
    STRIP_TAC THEN COND_CASES_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
      FIRST_X_ASSUM(MP_TAC o SPEC `i + 1`) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN
      COND_CASES_TAC THEN REWRITE_TAC[ADD_SUB] THEN ASM_ARITH_TAC]]);;

let IMAGE_DROPOUT_CLOSED_INTERVAL = prove
 (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\
           1 <= k /\ k <= dimindex(:N)
           ==> IMAGE (dropout k:real^N->real^M) (interval[a,b]) =
                  if a$k <= b$k then interval[dropout k a,dropout k b]
                  else {}`,
  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC[CLOSED_INTERVAL_DROPOUT; IMAGE_EQ_EMPTY] THEN
  REWRITE_TAC[INTERVAL_EQ_EMPTY; GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[]);;

let EQ_BALLS = prove
 (`(!a a':real^N r r'.
      ball(a,r) = ball(a',r') <=> a = a' /\ r = r' \/ r <= &0 /\ r' <= &0) /\
   (!a a':real^N r r'.
      ball(a,r) = cball(a',r') <=> r <= &0 /\ r' < &0) /\
   (!a a':real^N r r'.
      cball(a,r) = ball(a',r') <=> r < &0 /\ r' <= &0) /\
   (!a a':real^N r r'.
      cball(a,r) = cball(a',r') <=> a = a' /\ r = r' \/ r < &0 /\ r' < &0)`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT STRIP_TAC THEN
  (EQ_TAC THENL
    [ALL_TAC; REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC])
  THENL
   [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN NORM_ARITH_TAC;
    ONCE_REWRITE_TAC[EQ_SYM_EQ];
    ALL_TAC;
    REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN NORM_ARITH_TAC] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (MESON[CLOPEN; BOUNDED_BALL; NOT_BOUNDED_UNIV]
    `s = t ==> closed s /\ open t /\ bounded t ==> s = {} /\ t = {}`)) THEN
  REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BOUNDED_BALL;
              BALL_EQ_EMPTY; CBALL_EQ_EMPTY] THEN
  REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Some special cases for intervals in R^1.                                  *)
(* ------------------------------------------------------------------------- *)

let IN_INTERVAL_1 = prove
 (`!a b x:real^1.
        (x IN interval[a,b] <=> drop a <= drop x /\ drop x <= drop b) /\
        (x IN interval(a,b) <=> drop a < drop x /\ drop x < drop b)`,
  REWRITE_TAC[IN_INTERVAL; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN
  MESON_TAC[]);;

let REAL_INTERVAL_INTERVAL = prove
 (`real_interval[a,b] = IMAGE drop (interval[lift a,lift b]) /\
   real_interval(a,b) = IMAGE drop (interval(lift a,lift b))`,
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN
  REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; UNWIND_THM1]);;

let INTERVAL_REAL_INTERVAL = prove
 (`interval[a,b] = IMAGE lift (real_interval[drop a,drop b]) /\
   interval(a,b) = IMAGE lift (real_interval(drop a,drop b))`,
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN
  REWRITE_TAC[EXISTS_DROP; LIFT_DROP; UNWIND_THM1]);;

let DROP_IN_REAL_INTERVAL = prove
 (`(!a b x. drop x IN real_interval[a,b] <=> x IN interval[lift a,lift b]) /\
   (!a b x. drop x IN real_interval(a,b) <=> x IN interval(lift a,lift b))`,
  REWRITE_TAC[REAL_INTERVAL_INTERVAL; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;

let LIFT_IN_INTERVAL = prove
 (`(!a b x. lift x IN interval[a,b] <=> x IN real_interval[drop a,drop b]) /\
   (!a b x. lift x IN interval(a,b) <=> x IN real_interval(drop a,drop b))`,
  REWRITE_TAC[FORALL_DROP; DROP_IN_REAL_INTERVAL; LIFT_DROP]);;

let IMAGE_LIFT_REAL_INTERVAL = prove
 (`IMAGE lift (real_interval[a,b]) = interval[lift a,lift b] /\
   IMAGE lift (real_interval(a,b)) = interval(lift a,lift b)`,
  REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN
  SET_TAC[]);;

let IMAGE_DROP_INTERVAL = prove
 (`IMAGE drop (interval[a,b]) = real_interval[drop a,drop b] /\
   IMAGE drop (interval(a,b)) = real_interval(drop a,drop b)`,
  REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN
  SET_TAC[]);;

let INTERVAL_CASES_1 = prove
 (`!x:real^1. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)`,
  REWRITE_TAC[CART_EQ; IN_INTERVAL; FORALL_DIMINDEX_1] THEN REAL_ARITH_TAC);;

let INTERVAL_EQ_EMPTY_1 = prove
 (`!a b:real^1.
        (interval[a,b] = {} <=> drop b < drop a) /\
        (interval(a,b) = {} <=> drop b <= drop a)`,
  REWRITE_TAC[INTERVAL_EQ_EMPTY; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN
  MESON_TAC[]);;

let INTERVAL_NE_EMPTY_1 = prove
 (`(!a b:real^1. ~(interval[a,b] = {}) <=> drop a <= drop b) /\
   (!a b:real^1. ~(interval(a,b) = {}) <=> drop a < drop b)`,
  REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REAL_ARITH_TAC);;

let UNION_INTERVAL_1 = prove
 (`!a b c:real^1.
    c IN interval[a,b] ==> interval[a,c] UNION interval[c,b] = interval[a,b]`,
  REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN REAL_ARITH_TAC);;

let SUBSET_INTERVAL_1 = prove
 (`!a b c d.
        (interval[a,b] SUBSET interval[c,d] <=>
                drop b < drop a \/
                drop c <= drop a /\ drop a <= drop b /\ drop b <= drop d) /\
        (interval[a,b] SUBSET interval(c,d) <=>
                drop b < drop a \/
                drop c < drop a /\ drop a <= drop b /\ drop b < drop d) /\
        (interval(a,b) SUBSET interval[c,d] <=>
                drop b <= drop a \/
                drop c <= drop a /\ drop a < drop b /\ drop b <= drop d) /\
        (interval(a,b) SUBSET interval(c,d) <=>
                drop b <= drop a \/
                drop c <= drop a /\ drop a < drop b /\ drop b <= drop d)`,
  REWRITE_TAC[SUBSET_INTERVAL; FORALL_1; DIMINDEX_1; drop] THEN
  REAL_ARITH_TAC);;

let EQ_INTERVAL_1 = prove
 (`!a b c d:real^1.
       (interval[a,b] = interval[c,d] <=>
          drop b < drop a /\ drop d < drop c \/
          drop a = drop c /\ drop b = drop d)`,
  REWRITE_TAC[SET_RULE `s = t <=> s SUBSET t /\ t SUBSET s`] THEN
  REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC);;

let DISJOINT_INTERVAL_1 = prove
 (`!a b c d:real^1.
        (interval[a,b] INTER interval[c,d] = {} <=>
          drop b < drop a \/ drop d < drop c \/
          drop b < drop c \/ drop d < drop a) /\
        (interval[a,b] INTER interval(c,d) = {} <=>
          drop b < drop a \/ drop d <= drop c \/
          drop b <= drop c \/ drop d <= drop a) /\
        (interval(a,b) INTER interval[c,d] = {} <=>
          drop b <= drop a \/ drop d < drop c \/
          drop b <= drop c \/ drop d <= drop a) /\
        (interval(a,b) INTER interval(c,d) = {} <=>
          drop b <= drop a \/ drop d <= drop c \/
          drop b <= drop c \/ drop d <= drop a)`,
  REWRITE_TAC[DISJOINT_INTERVAL; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM;
              UNWIND_THM1; drop]);;

let OPEN_CLOSED_INTERVAL_1 = prove
 (`!a b:real^1. interval(a,b) = interval[a,b] DIFF {a,b}`,
  REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
  REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);;

let CLOSED_OPEN_INTERVAL_1 = prove
 (`!a b:real^1. drop a <= drop b ==> interval[a,b] = interval(a,b) UNION {a,b}`,
  REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN
  REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);;

let BALL_1 = prove
 (`!x:real^1 r. cball(x,r) = interval[x - lift r,x + lift r] /\
                ball(x,r) = interval(x - lift r,x + lift r)`,
  REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL; IN_INTERVAL_1] THEN
  REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_ADD] THEN
  REAL_ARITH_TAC);;

let SPHERE_1 = prove
 (`!a:real^1 r. sphere(a,r) = if r < &0 then {} else {a - lift r,a + lift r}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN
  REWRITE_TAC[DIST_REAL; GSYM drop; FORALL_DROP] THEN
  REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN
  REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN
  ASM_REAL_ARITH_TAC);;

let FINITE_SPHERE_1 = prove
 (`!a:real^1 r. FINITE(sphere(a,r))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE_1] THEN
  MESON_TAC[FINITE_INSERT; FINITE_EMPTY]);;

let FINITE_INTERVAL_1 = prove
 (`(!a b. FINITE(interval[a,b]) <=> drop b <= drop a) /\
   (!a b. FINITE(interval(a,b)) <=> drop b <= drop a)`,
  REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN
  REWRITE_TAC[SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN
  REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN
  SUBGOAL_THEN `interval[a,b] = IMAGE lift {x | drop a <= x /\ x <= drop b}`
  SUBST1_TAC THENL
   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
    CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN
    REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP];
    SIMP_TAC[FINITE_IMAGE_INJ_EQ; LIFT_EQ; FINITE_REAL_INTERVAL]]);;

let BALL_INTERVAL = prove
 (`!x:real^1 e. ball(x,e) = interval(x - lift e,x + lift e)`,
  REWRITE_TAC[EXTENSION; IN_BALL; IN_INTERVAL_1; DIST_REAL] THEN
  REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);;

let CBALL_INTERVAL = prove
 (`!x:real^1 e. cball(x,e) = interval[x - lift e,x + lift e]`,
  REWRITE_TAC[EXTENSION; IN_CBALL; IN_INTERVAL_1; DIST_REAL] THEN
  REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);;

let BALL_INTERVAL_0 = prove
 (`!e. ball(vec 0:real^1,e) = interval(--lift e,lift e)`,
  GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN
  BINOP_TAC THEN VECTOR_ARITH_TAC);;

let CBALL_INTERVAL_0 = prove
 (`!e. cball(vec 0:real^1,e) = interval[--lift e,lift e]`,
  GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);;

let INTER_INTERVAL_1 = prove
 (`!a b c d:real^1.
        interval[a,b] INTER interval[c,d] =
        interval[lift(max (drop a) (drop c)),lift(min (drop b) (drop d))]`,
  REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; real_max; real_min] THEN
  REPEAT GEN_TAC THEN
  REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN
  ASM_REAL_ARITH_TAC);;

let CLOSED_DIFF_OPEN_INTERVAL_1 = prove
 (`!a b:real^1.
        interval[a,b] DIFF interval(a,b) =
        if interval[a,b] = {} then {} else {a,b}`,
  REWRITE_TAC[EXTENSION; IN_DIFF; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1] THEN
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN
  REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);;

let INTERVAL_1 = prove
 (`(!a b:real^1. interval[a,b] =
                 if drop a <= drop b then cball(midpoint(a,b),dist(a,b) / &2)
                 else {}) /\
   (!a b:real^1. interval(a,b) =
                 if drop a < drop b then ball(midpoint(a,b),dist(a,b) / &2)
                 else {})`,
  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE; REAL_NOT_LT]) THEN
  ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN
  REWRITE_TAC[BALL_1; DIST_REAL] THEN
  ASM_SIMP_TAC[GSYM drop; REAL_SUB_LE; REAL_LT_IMP_LE;
               REAL_ARITH `a <= b ==> abs(a - b) = b - a`] THEN
  REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`; LIFT_CMUL] THEN
  REWRITE_TAC[LIFT_SUB; LIFT_DROP; midpoint] THEN
  AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ; CONS_11] THEN VECTOR_ARITH_TAC);;

let SEGMENT_1 = prove
 (`(!a b. segment[a,b] =
          if drop a <= drop b then interval[a,b] else interval[b,a]) /\
   (!a b. segment(a,b) =
          if drop a <= drop b then interval(a,b) else interval(b,a))`,
  CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN
  COND_CASES_TAC THEN
  REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY;
              EXTENSION; GSYM BETWEEN_IN_SEGMENT; between; IN_INTERVAL_1] THEN
  REWRITE_TAC[GSYM DROP_EQ; DIST_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC);;

let OPEN_SEGMENT_1 = prove
 (`!a b:real^1. open(segment(a,b))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1] THEN
  COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]);;

let INTERVAL_SUBSET_SEGMENT_1 = prove
 (`(!a b:real^1. interval[a,b] SUBSET segment[a,b]) /\
   (!a b:real^1. interval(a,b) SUBSET segment(a,b))`,
  REWRITE_TAC[SEGMENT_1] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[SUBSET_REFL] THEN
  MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET t`) THEN
  REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC);;

let SEGMENT_SCALAR_MULTIPLE = prove
 (`(!a b v. segment[a % v,b % v] =
            {x % v:real^N | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\
   (!a b v. ~(v = vec 0)
            ==> segment(a % v,b % v) =
                {x % v:real^N | a < x /\ x < b \/ b < x /\ x < a})`,
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL
   [REPEAT GEN_TAC THEN
    MP_TAC(SPECL [`a % basis 1:real^1`; `b % basis 1:real^1`]
     (CONJUNCT1 SEGMENT_1)) THEN
    REWRITE_TAC[segment; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN
    REWRITE_TAC[SET_RULE `{f x % b | p x} = IMAGE (\a. a % b) {f x | p x}`] THEN
    DISCH_TAC THEN AP_TERM_TAC THEN
    FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE drop`) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_CMUL] THEN
    SIMP_TAC[drop; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
    REWRITE_TAC[REAL_MUL_RID; IMAGE_ID] THEN DISCH_THEN SUBST1_TAC THEN
    MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
    CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN
    REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN GEN_TAC THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN
    SIMP_TAC[drop; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1;
             LE_REFL; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC;
    ASM_REWRITE_TAC[open_segment] THEN
    ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; SET_RULE
     `(!x y. x % v = y % v <=> x = y)
      ==> {x % v | P x} DIFF {a % v,b % v} =
          {x % v | P x /\ ~(x = a) /\ ~(x = b)}`] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN
    REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]);;

let FINITE_INTER_COLLINEAR_OPEN_SEGMENTS = prove
 (`!a b c d:real^N.
        collinear{a,b,c}
        ==> (FINITE(segment(a,b) INTER segment(c,d)) <=>
             segment(a,b) INTER segment(c,d) = {})`,
  REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = b - a` THEN POP_ASSUM MP_TAC THEN
  GEOM_NORMALIZE_TAC `m:real^N` THEN
  SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; INTER_EMPTY; FINITE_EMPTY] THEN
  X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
  DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN
  GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
  X_GEN_TAC `b:real` THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
  ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN
  POP_ASSUM(K ALL_TAC) THEN
  ASM_CASES_TAC `collinear{vec 0:real^N,&1 % basis 1,y}` THENL
   [POP_ASSUM MP_TAC THEN
    SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN
    MATCH_MP_TAC(TAUT
     `~a /\ (b ==> c ==> d) ==> a \/ b ==> a \/ c ==> d`) THEN
    CONJ_TAC THENL
     [SIMP_TAC[VECTOR_MUL_LID; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL];
      REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN
    X_GEN_TAC `a:real` THEN DISCH_THEN SUBST_ALL_TAC THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN
    SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN
    SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
     VECTOR_MUL_RCANCEL; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; SET_RULE
     `(!x y. x % v = y % v <=> x = y)
      ==> {x % v | P x} INTER {x % v | Q x} =
          IMAGE (\x. x % v) {x | P x /\ Q x}`] THEN
    REWRITE_TAC[REAL_ARITH `(&0 < x /\ x < &1 \/ &1 < x /\ x < &0) /\
                            (b < x /\ x < a \/ a < x /\ x < b) <=>
                       max (&0) (min a b) < x /\ x < min (&1) (max a b)`] THEN
    SIMP_TAC[FINITE_REAL_INTERVAL; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN
    SIMP_TAC[GSYM REAL_LT_BETWEEN; GSYM NOT_EXISTS_THM] THEN REAL_ARITH_TAC;
    DISCH_TAC THEN ASM_CASES_TAC
     `segment(vec 0:real^N,&1 % basis 1) INTER segment (x,y) = {}` THEN
    ASM_REWRITE_TAC[FINITE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    REWRITE_TAC[open_segment; IN_DIFF; NOT_IN_EMPTY;
                DE_MORGAN_THM; IN_INTER; IN_INSERT] THEN
    DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN
    UNDISCH_TAC `~collinear{vec 0:real^N,&1 % basis 1, y}` THEN
    RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_LID]) THEN
    REWRITE_TAC[VECTOR_MUL_LID] THEN
    MATCH_MP_TAC COLLINEAR_SUBSET THEN
    EXISTS_TAC `{p,x:real^N, y, vec 0, basis 1}` THEN
    CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
    MP_TAC(ISPECL [`{y:real^N,vec 0,basis 1}`; `p:real^N`; `x:real^N`]
        COLLINEAR_TRIPLES) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE `{p,x,y} = {x,p,y}`] THEN
      MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN
      ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT];
      ALL_TAC] THEN
    ASM_SIMP_TAC[GSYM COLLINEAR_4_3] THEN
    ONCE_REWRITE_TAC[SET_RULE `{p,x,z,w} = {w,z,p,x}`] THEN
    SIMP_TAC[COLLINEAR_4_3; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o
        GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN
    REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);;

let BOUNDED_SEPARATION_1D = prove
 (`!s:real^N->bool.
        dimindex(:N) = 1 /\ bounded s
        ==> (connected((:real^N) DIFF s) <=> s = {})`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[DIFF_EMPTY; CONNECTED_UNIV] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[connected] THEN
  MAP_EVERY EXISTS_TAC
   [`{x:real^N | x$1 < (a:real^N)$1}`;
    `{x:real^N | x$1 > (a:real^N)$1}`] THEN
  REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT; OPEN_HALFSPACE_COMPONENT_LT] THEN
  REWRITE_TAC[SUBSET; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY;
              IN_UNION; IN_DIFF; IN_UNIV] THEN
  REWRITE_TAC[CONJ_ASSOC; REAL_ARITH `x < a /\ x > a <=> F`] THEN
  REWRITE_TAC[REAL_ARITH `x < a \/ x > a <=> ~(x = a)`; real_gt] THEN
  REWRITE_TAC[CONTRAPOS_THM; NOT_FORALL_THM] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
   [X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN `b:real^N = a` (fun th -> ASM_REWRITE_TAC[th]) THEN
    ASM_REWRITE_TAC[CART_EQ; DIMINDEX_1; FORALL_1];
    FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
    ASM_REWRITE_TAC[SUBSET; IN_INTERVAL; DIMINDEX_1; FORALL_1] THEN
    DISCH_TAC THEN CONJ_TAC THENL
     [EXISTS_TAC `u - basis 1:real^N`; EXISTS_TAC `v + basis 1:real^N`] THEN
    FIRST_ASSUM(MP_TAC o SPEC `a:real^N`) THEN
    (ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC]) THEN
    (CONJ_TAC THENL
      [ALL_TAC;
       FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV
        [GSYM CONTRAPOS_THM])] THEN
      REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
      SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
      ASM_REAL_ARITH_TAC)]);;

(* ------------------------------------------------------------------------- *)
(* Intervals in general, including infinite and mixtures of open and closed. *)
(* ------------------------------------------------------------------------- *)

let is_interval = new_definition
  `is_interval(s:real^N->bool) <=>
        !a b x. a IN s /\ b IN s /\
                (!i. 1 <= i /\ i <= dimindex(:N)
                     ==> (a$i <= x$i /\ x$i <= b$i) \/
                         (b$i <= x$i /\ x$i <= a$i))
                ==> x IN s`;;

let IS_INTERVAL_INTERVAL = prove
 (`!a:real^N b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])`,
  REWRITE_TAC[is_interval; IN_INTERVAL] THEN
  MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]);;

let IS_INTERVAL_EMPTY = prove
 (`is_interval {}`,
  REWRITE_TAC[is_interval; NOT_IN_EMPTY]);;

let IS_INTERVAL_UNIV = prove
 (`is_interval(UNIV:real^N->bool)`,
  REWRITE_TAC[is_interval; IN_UNIV]);;

let IS_INTERVAL_TRANSLATION_EQ = prove
 (`!a:real^N s. is_interval(IMAGE (\x. a + x) s) <=> is_interval s`,
  REWRITE_TAC[is_interval] THEN GEOM_TRANSLATE_TAC[] THEN
  REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);;

add_translation_invariants [IS_INTERVAL_TRANSLATION_EQ];;

let IS_INTERVAL_TRANSLATION = prove
 (`!s a:real^N. is_interval s ==> is_interval(IMAGE (\x. a + x) s)`,
  REWRITE_TAC[IS_INTERVAL_TRANSLATION_EQ]);;

let IS_INTERVAL_POINTWISE = prove
 (`!s:real^N->bool x.
        is_interval s /\
        (!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. a IN s /\ a$i = x$i)
        ==> x IN s`,
  REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
    `!n. ?y:real^N. (!i. 1 <= i /\ i <= n ==> y$i = (x:real^N)$i) /\ y IN s`
  MP_TAC THENL
   [INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THENL
     [ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN
    FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN
    ASM_CASES_TAC `SUC n <= dimindex(:N)` THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN
      ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC
       `(lambda i. if i <= n then (y:real^N)$i else (z:real^N)$i):real^N` THEN
      CONJ_TAC THENL
       [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
        SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL
         [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN
        COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
        SUBGOAL_THEN `i = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN
        ASM_ARITH_TAC;
        FIRST_X_ASSUM(ASSUME_TAC o CONJUNCT2) THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN
        MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN
        ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC];
      EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN `y:real^N = x` (fun th -> REWRITE_TAC[th]) THEN
      REWRITE_TAC[CART_EQ] THEN
      ASM_MESON_TAC[ARITH_RULE `i <= N /\ ~(SUC n <= N) ==> i <= n`]];
    DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN
    REWRITE_TAC[GSYM CART_EQ] THEN MESON_TAC[]]);;

let IS_INTERVAL_COMPACT = prove
 (`!s:real^N->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]`,
  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; COMPACT_INTERVAL] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [ASM_MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN
  EXISTS_TAC `(lambda i. inf { (x:real^N)$i | x IN s}):real^N` THEN
  EXISTS_TAC `(lambda i. sup { (x:real^N)$i | x IN s}):real^N` THEN
  SIMP_TAC[EXTENSION; IN_INTERVAL; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN
  EQ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` INF) THEN
    MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` SUP) THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
    REWRITE_TAC[bounded] THEN
    ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; MEMBER_NOT_EMPTY;
                  REAL_ARITH `abs(x) <= B ==> --B <= x /\ x <= B`];
    DISCH_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `?a b:real^N. a IN s /\ b IN s /\ a$i <= (x:real^N)$i /\ x$i <= b$i`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`]
        CONTINUOUS_ATTAINS_INF) THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
      MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`]
        CONTINUOUS_ATTAINS_SUP) THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
       [EXISTS_TAC `inf {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN
        MATCH_MP_TAC REAL_LE_INF THEN ASM SET_TAC[];
        EXISTS_TAC `sup {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN
        MATCH_MP_TAC REAL_SUP_LE THEN ASM SET_TAC[]];
      EXISTS_TAC
       `(lambda j. if j = i then (x:real^N)$i else (a:real^N)$j):real^N` THEN
      ASM_SIMP_TAC[LAMBDA_BETA] THEN
      FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN
      MAP_EVERY EXISTS_TAC
       [`a:real^N`;
        `(lambda j. if j = i then (b:real^N)$i else (a:real^N)$j):real^N`] THEN
      ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN
        MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
        ASM_SIMP_TAC[LAMBDA_BETA];
        ALL_TAC] THEN
      GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      ASM_REAL_ARITH_TAC]]);;

let IS_INTERVAL_1 = prove
 (`!s:real^1->bool.
        is_interval s <=>
          !a b x. a IN s /\ b IN s /\ drop a <= drop x /\ drop x <= drop b
                  ==> x IN s`,
  REWRITE_TAC[is_interval; DIMINDEX_1; FORALL_1; GSYM drop] THEN
  REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MESON_TAC[]);;

let IS_INTERVAL_1_CASES = prove
 (`!s:real^1->bool.
        is_interval s <=>
        s = {} \/
        s = (:real^1) \/
        (?a. s = {x | a < drop x}) \/
        (?a. s = {x | a <= drop x}) \/
        (?b. s = {x | drop x <= b}) \/
        (?b. s = {x | drop x < b}) \/
        (?a b. s = {x | a < drop x /\ drop x < b}) \/
        (?a b. s = {x | a < drop x /\ drop x <= b}) \/
        (?a b. s = {x | a <= drop x /\ drop x < b}) \/
        (?a b. s = {x | a <= drop x /\ drop x <= b})`,
  GEN_TAC THEN REWRITE_TAC[IS_INTERVAL_1] THEN EQ_TAC THENL
   [DISCH_TAC;
    STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN
    REAL_ARITH_TAC] THEN
  ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPEC `IMAGE drop s` SUP) THEN
  MP_TAC(ISPEC `IMAGE drop s` INF) THEN
  ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
  ASM_CASES_TAC `?a. !x. x IN s ==> a <= drop x` THEN
  ASM_CASES_TAC `?b. !x. x IN s ==> drop x <= b` THEN
  ASM_REWRITE_TAC[] THENL
   [STRIP_TAC THEN STRIP_TAC THEN
    MAP_EVERY ASM_CASES_TAC
     [`inf(IMAGE drop s) IN IMAGE drop s`; `sup(IMAGE drop s) IN IMAGE drop s`]
    THENL
     [REPLICATE_TAC 8 DISJ2_TAC;
      REPLICATE_TAC 7 DISJ2_TAC THEN DISJ1_TAC;
      REPLICATE_TAC 6 DISJ2_TAC THEN DISJ1_TAC;
      REPLICATE_TAC 5 DISJ2_TAC THEN DISJ1_TAC] THEN
    MAP_EVERY EXISTS_TAC [`inf(IMAGE drop s)`; `sup(IMAGE drop s)`];
    STRIP_TAC THEN ASM_CASES_TAC `inf(IMAGE drop s) IN IMAGE drop s` THENL
     [REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC;
      DISJ2_TAC THEN DISJ1_TAC] THEN
    EXISTS_TAC `inf(IMAGE drop s)`;
    STRIP_TAC THEN ASM_CASES_TAC `sup(IMAGE drop s) IN IMAGE drop s` THENL
     [REPLICATE_TAC 3 DISJ2_TAC THEN DISJ1_TAC;
      REPLICATE_TAC 4 DISJ2_TAC THEN DISJ1_TAC] THEN
    EXISTS_TAC `sup(IMAGE drop s)`;
    DISJ1_TAC] THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN
  REWRITE_TAC[GSYM REAL_NOT_LE] THEN
  ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM]);;

let IS_INTERVAL_1_CLAUSES = prove
 (`is_interval({}:real^1->bool) /\
   is_interval (:real^1) /\
   (!a. is_interval {x | a < drop x}) /\
   (!a. is_interval {x | a <= drop x}) /\
   (!b. is_interval {x | drop x < b}) /\
   (!b. is_interval {x | drop x <= b}) /\
   (!a b. is_interval {x | a < drop x /\ drop x < b}) /\
   (!a b. is_interval {x | a < drop x /\ drop x <= b}) /\
   (!a b. is_interval {x | a <= drop x /\ drop x < b}) /\
   (!a b. is_interval {x | a <= drop x /\ drop x <= b})`,
  REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN
  REAL_ARITH_TAC);;

let IS_REALINTERVAL_IS_INTERVAL = prove
 (`!s. is_realinterval s <=> is_interval(IMAGE lift s)`,
  REWRITE_TAC[IS_INTERVAL_1; is_realinterval] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[LIFT_DROP; IN_IMAGE; EXISTS_DROP; UNWIND_THM1] THEN
  REWRITE_TAC[GSYM FORALL_DROP]);;

let IS_INTERVAL_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        is_interval s /\ is_interval t ==> is_interval(s PCROSS t)`,
  REWRITE_TAC[is_interval; DIMINDEX_FINITE_SUM] THEN
  REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(MESON[]
   `(!a b a' b' x x'. P a b x /\ Q a' b' x' ==> R a b x a' b' x')
    ==> (!a b x. P a b x) /\ (!a' b' x'. Q a' b' x')
        ==> (!a a' b b' x x'. R a b x a' b' x')`) THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
    ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM;
                 ARITH_RULE `x:num <= m ==> x <= m + n`];
    FIRST_X_ASSUM(MP_TAC o SPEC `dimindex(:M) + i`) THEN
    ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM;
                 ARITH_RULE `x:num <= n ==> m + x <= m + n`;
                 ARITH_RULE `1 <= x ==> 1 <= m + x`] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN ASM_ARITH_TAC]);;

let IS_INTERVAL_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        is_interval(s PCROSS t) <=>
        s = {} \/ t = {} \/ is_interval s /\ is_interval t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_PCROSS] THEN
  REWRITE_TAC[is_interval] THEN
  REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  STRIP_TAC THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN
    STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`a:real^M`; `y:real^N`; `b:real^M`;
      `y:real^N`; `x:real^M`; `y:real^N`]);
    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
    STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `w:real^M`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`w:real^M`; `a:real^N`; `w:real^M`;
      `b:real^N`; `w:real^M`; `x:real^N`])] THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
  SIMP_TAC[pastecart; LAMBDA_BETA] THEN
  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
  ASM_MESON_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE
      `1 <= i /\ i <= m + n /\ ~(i <= m) ==> 1 <= i - m /\ i - m <= n`]);;

let IS_INTERVAL_INTER = prove
 (`!s t:real^N->bool.
        is_interval s /\ is_interval t ==> is_interval(s INTER t)`,
  REWRITE_TAC[is_interval; IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[]);;

let INTERVAL_SUBSET_IS_INTERVAL = prove
 (`!s a b:real^N.
     is_interval s
     ==> (interval[a,b] SUBSET s <=> interval[a,b] = {} \/ a IN s /\ b IN s)`,
  REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN
  ASM_REWRITE_TAC[EMPTY_SUBSET] THEN
  EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC] THEN
  REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[]);;

let INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD = prove
 (`!s x:real^N.
        is_interval s /\ x IN s
        ==> ?a b d. &0 < d /\ x IN interval[a,b] /\
                    interval[a,b] SUBSET s /\
                    ball(x,d) INTER s SUBSET interval[a,b]`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN
  SUBGOAL_THEN
   `!i. 1 <= i /\ i <= dimindex(:N)
        ==> ?a. (?y. y IN s /\ y$i = a) /\
                (a < x$i \/ a = (x:real^N)$i /\
                            !y:real^N. y IN s ==> a <= y$i)`
  MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!i. 1 <= i /\ i <= dimindex(:N)
        ==> ?b. (?y. y IN s /\ y$i = b) /\
                (x$i < b \/ b = (x:real^N)$i /\
                            !y:real^N. y IN s ==> y$i <= b)`
  MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
  EXISTS_TAC `min (inf (IMAGE (\i. if a$i < x$i
                                   then (x:real^N)$i - (a:real^N)$i else &1)
                              (1..dimindex(:N))))
                  (inf (IMAGE (\i. if x$i < b$i
                                   then (b:real^N)$i - x$i else &1)
                              (1..dimindex(:N))))` THEN
  REWRITE_TAC[REAL_LT_MIN; SUBSET; IN_BALL; IN_INTER] THEN
  SIMP_TAC[REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE;
           FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL] THEN REPEAT CONJ_TAC THENL
   [MESON_TAC[REAL_SUB_LT; REAL_LT_01];
    MESON_TAC[REAL_SUB_LT; REAL_LT_01];
    ASM_MESON_TAC[REAL_LE_LT];
    DISJ2_TAC THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN
    ASM_MESON_TAC[];
    X_GEN_TAC `y:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
    X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
    ASM_REWRITE_TAC[IN_NUMSEG] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
    (COND_CASES_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]]) THEN
    DISCH_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`]
      COMPONENT_LE_NORM) THEN
    ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);;

let IS_INTERVAL_SUMS = prove
 (`!s t:real^N->bool.
        is_interval s /\ is_interval t
        ==> is_interval {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
  MAP_EVERY X_GEN_TAC
   [`a:real^N`; `a':real^N`; `b:real^N`; `b':real^N`; `y:real^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (MP_TAC o SPECL [`a:real^N`; `b:real^N`]) MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (MP_TAC o SPECL [`a':real^N`; `b':real^N`]) STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[IMP_IMP; IN_ELIM_THM] THEN  ONCE_REWRITE_TAC[CONJ_SYM] THEN
  ONCE_REWRITE_TAC[VECTOR_ARITH `z:real^N = x + y <=> y = z - x`] THEN
  REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[]
   `(?x. P x /\ Q(f x))
    ==> (!x. P x ==> x IN s) /\ (!x. Q x ==> x IN t)
        ==> ?x. x IN s /\ f x IN t`) THEN
  REWRITE_TAC[VECTOR_SUB_COMPONENT; AND_FORALL_THM;
              TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
  REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN
  X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
  ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN
  REWRITE_TAC[REAL_ARITH
   `c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c`] THEN
  REWRITE_TAC[REAL_ARITH
  `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`] THEN
  ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN
  REWRITE_TAC[GSYM REAL_LE_MIN; GSYM REAL_MAX_LE] THEN
  REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN REAL_ARITH_TAC);;

let IS_INTERVAL_SING = prove
 (`!a:real^N. is_interval {a}`,
  SIMP_TAC[is_interval; IN_SING; IMP_CONJ; CART_EQ; REAL_LE_ANTISYM]);;

let INTERVAL_EQ_SING = prove
 (`(!a b x:real^N. interval[a,b] = {x} <=> a = x /\ b = x) /\
   (!a b x:real^N. ~(interval(a,b) = {x}))`,
  REWRITE_TAC[GSYM(CONJUNCT1 INTERVAL_SING); EQ_INTERVAL] THEN
  REWRITE_TAC[INTERVAL_SING; NOT_INSERT_EMPTY]);;

let IS_INTERVAL_SCALING = prove
 (`!s:real^N->bool c. is_interval s ==> is_interval(IMAGE (\x. c % x) s)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
    SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/
                  IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}`
    STRIP_ASSUME_TAC THENL
     [SET_TAC[];
      ASM_REWRITE_TAC[IS_INTERVAL_EMPTY];
      ASM_REWRITE_TAC[IS_INTERVAL_SING]];
    REWRITE_TAC[is_interval; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN
    GEN_REWRITE_TAC (BINOP_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN
    REWRITE_TAC[IMP_IMP; VECTOR_MUL_COMPONENT] THEN
    MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t)
     [`a:real^N`; `b:real^N`] THEN
    DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
                         MP_TAC(SPEC `inv(c) % x:real^N` th)) THEN
    ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_IMAGE] THEN ANTS_TAC THENL
     [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
      FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
       `~(c = &0) ==> &0 < c \/ &0 < --c`)) THEN
      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN
      ASM_SIMP_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_LE_RDIV_EQ; GSYM
                   REAL_LE_LDIV_EQ] THEN
      REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC;
      DISCH_TAC THEN EXISTS_TAC `inv c % x:real^N` THEN
      ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]);;

let IS_INTERVAL_SCALING_EQ = prove
 (`!s:real^N->bool c.
        is_interval(IMAGE (\x. c % x) s) <=> c = &0 \/ is_interval s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
    SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/
                  IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}`
    STRIP_ASSUME_TAC THENL
     [SET_TAC[];
      ASM_REWRITE_TAC[IS_INTERVAL_EMPTY];
      ASM_REWRITE_TAC[IS_INTERVAL_SING]];
    ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN
    DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP IS_INTERVAL_SCALING) THEN
    ASM_SIMP_TAC[GSYM IMAGE_o; VECTOR_MUL_ASSOC; o_DEF; REAL_MUL_LINV;
                 VECTOR_MUL_LID; IMAGE_ID]]);;

let IS_INTERVAL_REFLECT = prove
 (`!s:real^N->bool. is_interval(IMAGE (--) s) <=> is_interval s`,
  GEN_TAC THEN TRANS_TAC EQ_TRANS
   `is_interval(IMAGE (\x:real^N. --(&1) % x) s)` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_MUL_LID] THEN REWRITE_TAC[ETA_AX];
    REWRITE_TAC[IS_INTERVAL_SCALING_EQ] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);;

let lemma = prove
 (`!c. &0 < c
       ==> !s:real^N->bool. is_interval(IMAGE (\x. c % x) s) <=>
                            is_interval s`,
  SIMP_TAC[IS_INTERVAL_SCALING_EQ; REAL_LT_IMP_NZ]) in
add_scaling_theorems [lemma];;

let CARD_FRONTIER_INTERVAL_1 = prove
 (`!s:real^1->bool.
        is_interval s ==> FINITE(frontier s) /\ CARD(frontier s) <= 2`,
  let lemma = prove
   (`~(?a b c. drop a < drop b /\ drop b < drop c /\
               a IN s /\ b IN s /\ c IN s)
     ==> FINITE s /\ CARD(s) <= 2`,
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN
    REWRITE_TAC[ARITH_RULE `~(n <= 2) <=> 3 <= n`] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN
    REWRITE_TAC[HAS_SIZE_CONV `t HAS_SIZE 3`] THEN
    REWRITE_TAC[CONJ_ASSOC; MESON[]
     `(?t. P t /\ ?x y z. Q x y z /\ t = f x y z) <=>
      (?x y z. Q x y z /\ P(f x y z))`] THEN
    SIMP_TAC[LEFT_IMP_EXISTS_THM; GSYM CONJ_ASSOC; FORALL_LIFT; LIFT_EQ] THEN
    REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
    MATCH_MP_TAC(MESON[REAL_LE_TOTAL]
     `(!m n p:real. P m n p ==> P n p m /\ P n m p) /\
      (!m n p. m <= n /\ n <= p ==> P m n p)
      ==> !m n p. P m n p`) THEN
    CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[FORALL_DROP; DROP_EQ; LIFT_DROP] THEN
    REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN MESON_TAC[]) in
  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN
  REWRITE_TAC[NOT_EXISTS_THM; FRONTIER_CLOSURES; IN_INTER] THEN
  MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`] THEN STRIP_TAC THEN
  MAP_EVERY UNDISCH_TAC
   [`b IN closure ((:real^1) DIFF s)`;
    `(a:real^1) IN closure s`; `(c:real^1) IN closure s`] THEN
  SIMP_TAC[CLOSURE_APPROACHABLE; IN_DIFF; IN_UNIV; DIST_REAL; GSYM drop] THEN
  DISCH_THEN(MP_TAC o SPEC `(drop c - drop b) / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^1` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC `(drop b - drop a) / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC
    `min ((drop b - drop a) / &2) ((drop c - drop b) / &2)`) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT; REAL_LT_MIN] THEN
  DISCH_THEN(X_CHOOSE_THEN `w:real^1` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN
  DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`; `w:real^1`]) THEN
  ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;

let UNION_INTERVAL_SUBSET_INTERVAL = prove
 (`!s a b c d:real^N.
        is_interval s /\
        interval[a,b] SUBSET s /\ interval[c,d] SUBSET s
        ==> ?u v. interval[a,b] UNION interval[c,d] SUBSET interval[u,v] /\
                  interval[u,v] SUBSET s`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
   [ASM_REWRITE_TAC[UNION_EMPTY] THEN MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
  ASM_CASES_TAC `interval[c:real^N,d] = {}` THENL
   [ASM_REWRITE_TAC[UNION_EMPTY] THEN MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
  REWRITE_TAC[is_interval; GSYM UNION_SUBSET] THEN REPEAT STRIP_TAC THEN
  EXISTS_TAC `(lambda i. min ((a:real^N)$i) ((c:real^N)$i)):real^N` THEN
  EXISTS_TAC `(lambda i. max ((b:real^N)$i) ((d:real^N)$i)):real^N` THEN
  SIMP_TAC[UNION_SUBSET; SUBSET_INTERVAL; LAMBDA_BETA] THEN
  REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN
  SIMP_TAC[SUBSET; IN_INTERVAL; LAMBDA_BETA] THEN
  REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
  EXISTS_TAC `(lambda i. min ((a:real^N)$i) ((c:real^N)$i)):real^N` THEN
  EXISTS_TAC `(lambda i. max ((b:real^N)$i) ((d:real^N)$i)):real^N` THEN
  ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THENL
   [MAP_EVERY EXISTS_TAC [`a:real^N`; `c:real^N`];
    MAP_EVERY EXISTS_TAC [`b:real^N`; `d:real^N`]] THEN
  SIMP_TAC[LAMBDA_BETA; CONJ_ASSOC] THEN
  (CONJ_TAC THENL [CONJ_TAC; REAL_ARITH_TAC]) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[IN_UNION; ENDS_IN_INTERVAL]);;

(* ------------------------------------------------------------------------- *)
(* Limit component bounds.                                                   *)
(* ------------------------------------------------------------------------- *)

let LIM_COMPONENT_UBOUND = prove
 (`!net:(A)net f (l:real^N) b k.
        ~(trivial_limit net) /\ (f --> l) net /\
        eventually (\x. (f x)$k <= b) net /\
        1 <= k /\ k <= dimindex(:N)
        ==> l$k <= b`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`net:(A)net`; `f:A->real^N`; `{y:real^N | basis k dot y <= b}`; `l:real^N`]
   LIM_IN_CLOSED_SET) THEN
  ASM_SIMP_TAC[CLOSED_HALFSPACE_LE; IN_ELIM_THM; DOT_BASIS]);;

let LIM_COMPONENT_LBOUND = prove
 (`!net:(A)net f (l:real^N) b k.
        ~(trivial_limit net) /\ (f --> l) net /\
        eventually (\x. b <= (f x)$k) net /\
        1 <= k /\ k <= dimindex(:N)
        ==> b <= l$k`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`net:(A)net`; `f:A->real^N`; `{y:real^N | b <= basis k dot y}`; `l:real^N`]
   LIM_IN_CLOSED_SET) THEN
  ASM_SIMP_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_GE;
               IN_ELIM_THM; DOT_BASIS]);;

let LIM_COMPONENT_EQ = prove
 (`!net f:A->real^N i l b.
        (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) /\
        ~(trivial_limit net) /\ eventually (\x. f(x)$i = b) net
        ==> l$i = b`,
  REWRITE_TAC[GSYM REAL_LE_ANTISYM; EVENTUALLY_AND] THEN
  MESON_TAC[LIM_COMPONENT_UBOUND; LIM_COMPONENT_LBOUND]);;

let LIM_COMPONENT_LE = prove
 (`!net:(A)net f:A->real^N g:A->real^N k l m.
         ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\
        eventually (\x. (f x)$k <= (g x)$k) net /\
        1 <= k /\ k <= dimindex(:N)
        ==> l$k <= m$k`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
  REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; LIM_COMPONENT_LBOUND] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN POP_ASSUM MP_TAC THEN
  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; LIM_COMPONENT_LBOUND]);;

let LIM_DROP_LE = prove
 (`!net:(A)net f g l m.
         ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\
        eventually (\x. drop(f x) <= drop(g x)) net
        ==> drop l <= drop m`,
  REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(ISPEC `net:(A)net` LIM_COMPONENT_LE) THEN
  MAP_EVERY EXISTS_TAC [`f:A->real^1`; `g:A->real^1`] THEN
  ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);;

let LIM_DROP_UBOUND = prove
 (`!net f:A->real^1 l b.
        (f --> l) net /\
        ~(trivial_limit net) /\ eventually (\x. drop(f x) <= b) net
        ==> drop l <= b`,
  SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN
  REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);;

let LIM_DROP_LBOUND = prove
 (`!net f:A->real^1 l b.
        (f --> l) net /\
        ~(trivial_limit net) /\ eventually (\x. b <= drop(f x)) net
        ==> b <= drop l`,
  SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN
  REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);;

let LIMIT_PAIR_DROP_LE = prove
 (`!net1:(A)net net2:(B)net f g l m.
        ~(trivial_limit net1) /\ ~(trivial_limit net2) /\
        (f --> l) net1 /\ (g --> m) net2 /\
        eventually (\x. eventually (\y. drop(f x) <= drop(g y)) net2) net1
        ==> drop l <= drop m`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT
   `p /\ q /\ r /\ s /\ t ==> u <=>
    (p /\ q /\ s) ==> ~u ==> r /\ t ==> F`] THEN
  STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN
  REWRITE_TAC[tendsto] THEN DISCH_THEN(CONJUNCTS_THEN2
   (MP_TAC o SPEC `(drop l - drop m) / &2`) MP_TAC) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN
  REWRITE_TAC[TAUT `p ==> ~q <=> p /\ q ==> F`; GSYM EVENTUALLY_AND] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
  X_GEN_TAC `a:A` THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(drop l - drop m) / &2` o
    REWRITE_RULE[tendsto]) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN
  REWRITE_TAC[TAUT `p ==> ~q <=> p /\ q ==> F`; GSYM EVENTUALLY_AND] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN
  REWRITE_TAC[DIST_1] THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Also extending closed bounds to closures.                                 *)
(* ------------------------------------------------------------------------- *)

let IMAGE_CLOSURE_SUBSET = prove
 (`!f (s:real^N->bool) (t:real^M->bool).
      f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t
      ==> IMAGE f (closure s) SUBSET t`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `closure s SUBSET {x | (f:real^N->real^M) x IN t}` MP_TAC
  THENL [MATCH_MP_TAC SUBSET_TRANS; SET_TAC []]  THEN
  EXISTS_TAC `{x | x IN closure s /\ (f:real^N->real^M) x IN t}` THEN
  CONJ_TAC THENL
  [MATCH_MP_TAC CLOSURE_MINIMAL; SET_TAC[]] THEN
  ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CLOSURE] THEN
  MP_TAC (ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);;

let CLOSURE_IMAGE_CLOSURE = prove
 (`!f:real^M->real^N s.
        f continuous_on closure s
        ==> closure(IMAGE f (closure s)) = closure(IMAGE f s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  SIMP_TAC[SUBSET_CLOSURE; IMAGE_SUBSET; CLOSURE_SUBSET] THEN
  SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_CLOSURE] THEN
  MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN
  ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET]);;

let CLOSURE_IMAGE_BOUNDED = prove
 (`!f:real^M->real^N s.
        f continuous_on closure s /\ bounded s
        ==> closure(IMAGE f s) = IMAGE f (closure s)`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC EQ_TRANS `closure(IMAGE (f:real^M->real^N) (closure s))` THEN
  CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE]; ALL_TAC] THEN
  MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE]);;

let CONTINUOUS_ON_CLOSURE_NORM_LE = prove
 (`!f:real^N->real^M s x b.
      f continuous_on (closure s) /\
      (!y. y IN s ==> norm(f y) <= b) /\
      x IN (closure s)
      ==> norm(f x) <= b`,
  REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET cball(vec 0,b)`
    MP_TAC THENL
  [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN
  ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM SET_TAC []);;

let CONTINUOUS_ON_CLOSURE_COMPONENT_LE = prove
 (`!f:real^N->real^M s x b k.
      f continuous_on (closure s) /\
      (!y. y IN s ==> (f y)$k <= b) /\
      x IN (closure s)
      ==> (f x)$k <= b`,
  REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k <= b}`
  MP_TAC THENL
   [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN
  ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM SET_TAC[]);;

let CONTINUOUS_ON_CLOSURE_COMPONENT_GE = prove
 (`!f:real^N->real^M s x b k.
      f continuous_on (closure s) /\
      (!y. y IN s ==> b <= (f y)$k) /\
      x IN (closure s)
      ==> b <= (f x)$k`,
  REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k >= b}`
  MP_TAC THENL
   [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC [real_ge]] THEN
  ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM SET_TAC[real_ge]);;

let CONTINUOUS_MAP_CLOSURES_GEN = prove
 (`!f:real^M->real^N s.
        f continuous_on s <=>
        !t. t SUBSET s
            ==> IMAGE f (s INTER closure t) SUBSET closure(IMAGE f t)`,
  REWRITE_TAC[SET_RULE
     `IMAGE f s SUBSET t <=> s SUBSET {x | x IN s /\ f x IN t}`]  THEN
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
   [MATCH_MP_TAC CLOSURE_MINIMAL_LOCAL THEN CONJ_TAC THENL
     [MATCH_MP_TAC CLOSED_IN_TRANS THEN
      EXISTS_TAC `s INTER closure t:real^M->bool` THEN
      SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE] THEN
      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET; CLOSED_CLOSURE];
      SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTER; CLOSURE_INC; FUN_IN_IMAGE] THEN
      ASM_REWRITE_TAC[GSYM SUBSET]];
    REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
    X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
    REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; GSYM SUBSET_ANTISYM_EQ] THEN
    REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET; SUBSET_RESTRICT] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC
     `{x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN
    REWRITE_TAC[SUBSET_RESTRICT] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
    SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
    SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN
    REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
    ASM SET_TAC[]]);;

let CONTINUOUS_MAP_CLOSURES = prove
 (`!f:real^M->real^N.
        f continuous_on UNIV <=>
        !s. IMAGE f (closure s) SUBSET closure(IMAGE f s)`,
  REWRITE_TAC[CONTINUOUS_MAP_CLOSURES_GEN; SUBSET_UNIV; INTER_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Relating images and frontiers.                                            *)
(* ------------------------------------------------------------------------- *)

let PROPER_MAP_ESCAPES_FROM_IMAGE = prove
 (`!f:real^M->real^N s t x r a b.
        IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k
             ==> compact {x | x IN s /\ f x IN k}) /\
        (!n. x n IN s) /\ ~(a IN s) /\ (x --> a) sequentially /\
        (!m n. m < n ==> r m < r n) /\ ((f o x o r) --> b) sequentially
        ==> ~(b IN IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`;
                 `x:num->real^M`] PROPER_MAP_ESCAPES_IMP) THEN
  ASM_SIMP_TAC[NOT_IMP; SEQUENCE_ESCAPES; NOT_EXISTS_THM] THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`a':real^M`; `r':num->num`] THEN STRIP_TAC THEN
    SUBGOAL_THEN `a':real^M = a` (fun th -> ASM_MESON_TAC[th]) THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
    EXISTS_TAC `(x:num->real^M) o (r':num->num)` THEN
    ASM_SIMP_TAC[LIM_SUBSEQUENCE; TRIVIAL_LIMIT_SEQUENTIALLY];
    W(MP_TAC o PART_MATCH (lhand o rand) SEQUENCE_ESCAPES o rand o snd) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
    REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
    MAP_EVERY EXISTS_TAC [`b:real^N`; `r:num->num`] THEN
    ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;

let FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN = prove
 (`!f:real^M->real^N s t.
        IMAGE f s SUBSET t /\
        f continuous_on closure s /\
        (!k. k SUBSET t /\ compact k
             ==> compact {x | x IN s /\ f x IN k})
        ==> IMAGE f (closure s DIFF s) SUBSET
            closure(IMAGE f s) DIFF IMAGE f s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(SET_RULE
   `IMAGE f c SUBSET c' /\ IMAGE f (c DIFF i) INTER i' = {}
    ==> IMAGE f (c DIFF i) SUBSET c' DIFF i'`) THEN
  CONJ_TAC THENL
   [FIRST_ASSUM(MP_TAC o SPEC `s:real^M->bool` o
      GEN_REWRITE_RULE I [CONTINUOUS_MAP_CLOSURES_GEN]) THEN
    REWRITE_TAC[CLOSURE_SUBSET; INTER_IDEMPOT];
    REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_DIFF] THEN X_GEN_TAC `a:real^M` THEN
    STRIP_TAC THEN MATCH_MP_TAC PROPER_MAP_ESCAPES_FROM_IMAGE THEN
    EXISTS_TAC `t:real^N->bool` THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_SEQUENTIAL]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^M` THEN
    STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`I:num->num`; `a:real^M`] THEN
    ASM_REWRITE_TAC[I_O_ID; I_THM] THEN
    ASM_MESON_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY]]);;

let FRONTIER_PROPER_MAP_IMAGE_SUBSET = prove
 (`!f:real^M->real^N s t.
        IMAGE f s SUBSET t /\
        open s /\
        f continuous_on closure s /\
        (!k. k SUBSET t /\ compact k
             ==> compact {x | x IN s /\ f x IN k})
        ==> IMAGE f (frontier s) SUBSET frontier(IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
        FRONTIER_PROPER_MAP_IMAGE_SUBSET_GEN) THEN
  ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN
  MP_TAC(ISPEC `IMAGE (f:real^M->real^N) s` INTERIOR_SUBSET) THEN SET_TAC[]);;

let FRONTIER_CLOPEN_MAP_IMAGE_SUBSET = prove
 (`!f:real^M->real^N s.
        closed(IMAGE f (closure s)) /\ open(IMAGE f (interior s))
        ==> frontier(IMAGE f s) SUBSET IMAGE f (frontier s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
  MATCH_MP_TAC(SET_RULE
   `IMAGE f i SUBSET i' /\ c' SUBSET IMAGE f c
    ==> c' DIFF i' SUBSET IMAGE f (c DIFF i)`) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC INTERIOR_MAXIMAL; MATCH_MP_TAC CLOSURE_MINIMAL] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
  REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);;

let FRONTIER_OPEN_MAP_IMAGE_SUBSET = prove
 (`!f:real^M->real^N s.
        bounded s /\ f continuous_on closure s /\ open(IMAGE f (interior s))
        ==> frontier(IMAGE f s) SUBSET IMAGE f (frontier s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_CLOPEN_MAP_IMAGE_SUBSET THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE]);;

let FRONTIER_PROPER_CLOPEN_MAP_IMAGE = prove
 (`!f:real^M->real^N s t.
        open s /\ IMAGE f s SUBSET t /\ f continuous_on closure s /\
        open(IMAGE f s) /\ closed(IMAGE f (closure s)) /\
        (!k. k SUBSET t /\ compact k
             ==> compact {x | x IN s /\ f x IN k})
        ==> IMAGE f (frontier s) = frontier(IMAGE f s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  ASM_SIMP_TAC[FRONTIER_CLOPEN_MAP_IMAGE_SUBSET; INTERIOR_OPEN] THEN
  MATCH_MP_TAC FRONTIER_PROPER_MAP_IMAGE_SUBSET THEN ASM_MESON_TAC[]);;

let FRONTIER_PROPER_OPEN_MAP_IMAGE = prove
 (`!f:real^M->real^N s t.
        bounded s /\ open s /\ open(IMAGE f s) /\
        f continuous_on closure s /\
        IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k
             ==> compact {x | x IN s /\ f x IN k})
        ==> IMAGE f (frontier s) = frontier(IMAGE f s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  ASM_SIMP_TAC[FRONTIER_OPEN_MAP_IMAGE_SUBSET; INTERIOR_OPEN] THEN
  MATCH_MP_TAC FRONTIER_PROPER_MAP_IMAGE_SUBSET THEN ASM_MESON_TAC[]);;

let FRONTIER_CLOPEN_MAP_IMAGE = prove
 (`!f:real^M->real^N s t.
        open s /\ open(IMAGE f s) /\ closed(IMAGE f (closure s)) /\
        f continuous_on closure s /\
        (!y. compact {x | x IN s /\ f x = y}) /\
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c))
        ==> IMAGE f (frontier s) = frontier(IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_PROPER_CLOPEN_MAP_IMAGE THEN
  ASM_REWRITE_TAC[PROPER_MAP_EQ] THEN ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Limits relative to a union.                                               *)
(* ------------------------------------------------------------------------- *)

let LIM_WITHIN_UNION = prove
 (`(f --> l) (at x within (s UNION t)) <=>
   (f --> l) (at x within s) /\ (f --> l) (at x within t)`,
  REWRITE_TAC[LIM_WITHIN; IN_UNION; AND_FORALL_THM] THEN
  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN
   (CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `k:real`)) THEN
  EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  ASM_MESON_TAC[]);;

let CONTINUOUS_ON_UNION = prove
 (`!f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t
           ==> f continuous_on (s UNION t)`,
  REWRITE_TAC[CONTINUOUS_ON; CLOSED_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN
  MESON_TAC[LIM_TRIVIAL; TRIVIAL_LIMIT_WITHIN]);;

let CONTINUOUS_ON_CASES = prove
 (`!P f g:real^M->real^N s t.
        closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\
        (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
        ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
   [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;

let CONTINUOUS_ON_UNION_LOCAL = prove
 (`!f:real^M->real^N s.
        closed_in (subtopology euclidean (s UNION t)) s /\
        closed_in (subtopology euclidean (s UNION t)) t /\
        f continuous_on s /\ f continuous_on t
        ==> f continuous_on (s UNION t)`,
  REWRITE_TAC[CONTINUOUS_ON; CLOSED_IN_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN
  MESON_TAC[LIM_TRIVIAL; TRIVIAL_LIMIT_WITHIN]);;

let CONTINUOUS_ON_CASES_LOCAL = prove
 (`!P f g:real^M->real^N s t.
        closed_in (subtopology euclidean (s UNION t)) s /\
        closed_in (subtopology euclidean (s UNION t)) t /\
        f continuous_on s /\ g continuous_on t /\
        (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
        ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
   [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;

let CONTINUOUS_ON_CASES_LE = prove
 (`!f g:real^M->real^N h s a.
        f continuous_on {t | t IN s /\ h t <= a} /\
        g continuous_on {t | t IN s /\ a <= h t} /\
        (lift o h) continuous_on s /\
        (!t. t IN s /\ h t = a ==> f t = g t)
        ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC
   `{t | t IN s /\ (h:real^M->real) t <= a} UNION
    {t | t IN s /\ a <= h t}` THEN
  CONJ_TAC THENL
   [ALL_TAC; SIMP_TAC[SUBSET; IN_UNION; IN_ELIM_THM; REAL_LE_TOTAL]] THEN
  MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[]] THEN
  CONJ_TAC THENL
   [SUBGOAL_THEN
     `{t | t IN s /\ (h:real^M->real) t <= a} =
      {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\
           (lift o h) t IN {x | x$1 <= a}}`
     (fun th -> GEN_REWRITE_TAC RAND_CONV [th])
    THENL
     [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION;
                  IN_UNION] THEN
      GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      ASM_REAL_ARITH_TAC;
      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
      ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; ETA_AX] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      SET_TAC[]];
    SUBGOAL_THEN
     `{t | t IN s /\ a <= (h:real^M->real) t} =
      {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\
           (lift o h) t IN {x | x$1 >= a}}`
     (fun th -> GEN_REWRITE_TAC RAND_CONV [th])
    THENL
     [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION;
                  IN_UNION] THEN
      GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      ASM_REAL_ARITH_TAC;
      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
      ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE; ETA_AX] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      SET_TAC[]]]);;

let CONTINUOUS_ON_CASES_1 = prove
 (`!f g:real^1->real^N s a.
        f continuous_on {t | t IN s /\ drop t <= a} /\
        g continuous_on {t | t IN s /\ a <= drop t} /\
        (lift a IN s ==> f(lift a) = g(lift a))
        ==> (\t. if drop t <= a then f(t) else g(t)) continuous_on s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
  ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN
  REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_MESON_TAC[]);;

let EXTENSION_FROM_CLOPEN = prove
 (`!f:real^M->real^N s t u.
        open_in (subtopology euclidean s) t /\
        closed_in (subtopology euclidean s) t /\
        f continuous_on t /\ IMAGE f t SUBSET u /\ (u = {} ==> s = {})
        ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\
                !x. x IN t ==> g x = f x`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; SUBSET_EMPTY;
               IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
  EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else a` THEN
  SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  SUBGOAL_THEN `s:real^M->bool = t UNION (s DIFF t)` SUBST1_TAC THENL
   [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN
  ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`] THEN
  REWRITE_TAC[CONTINUOUS_ON_CONST; IN_DIFF] THEN
  CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF; MESON_TAC[]] THEN
  ASM_REWRITE_TAC[CLOSED_IN_REFL]);;

let CONTINUOUS_ON_CLOPEN_INDICATOR = prove
 (`!s t:real^M->bool a b:real^N.
        (\x. if x IN t then a else b) continuous_on s <=>
        a = b \/
        open_in (subtopology euclidean s) (s INTER t) /\
        closed_in (subtopology euclidean s) (s INTER t)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[COND_ID; CONTINUOUS_ON_CONST] THEN
  EQ_TAC THENL
   [ DISCH_TAC THEN SUBGOAL_THEN
    `s INTER t = {x:real^M | x IN s /\ (if x IN t then a else b:real^N) IN {a}}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN;
      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN] THEN
    EXISTS_TAC `{a:real^N,b}` THEN ASM_REWRITE_TAC[] THEN
    (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    REWRITE_TAC[CLOSED_IN_SING; OPEN_IN_SING; IN_INSERT] THEN
    SIMP_TAC[LIMIT_POINT_FINITE; FINITE_RULES];
    STRIP_TAC THEN
    SUBST1_TAC(SET_RULE `s:real^M->bool = (s INTER t) UNION (s DIFF t)`) THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
    REWRITE_TAC[SET_RULE `(s INTER t) UNION (s DIFF t) = s`] THEN
    ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF s INTER t`] THEN
    ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);;

(* ------------------------------------------------------------------------- *)
(* Various formulations of limits for linear operators.                      *)
(* ------------------------------------------------------------------------- *)

let LIM_NULL_ONORM,LIM_NULL_ONORM_COMPONENTWISE = (CONJ_PAIR o prove)
 (`(!net f:A->real^M->real^N.
        (!a. linear(f a))
        ==> (((\a. lift(onorm(f a))) --> vec 0) net <=>
             !x. ((\a. f a x) --> vec 0) net)) /\
   (!net f:A->real^M->real^N.
        (!a. linear(f a))
        ==> (((\a. lift(onorm(f a))) --> vec 0) net <=>
             !i. 1 <= i /\ i <= dimindex(:M)
                 ==> ((\a. f a (basis i)) --> vec 0) net))`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
  DISCH_TAC THEN MATCH_MP_TAC(TAUT
   `(q ==> r) /\ (p ==> q) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN
  SIMP_TAC[] THEN CONJ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN
    MATCH_MP_TAC LIM_NULL_COMPARISON THEN
    EXISTS_TAC `\a. onorm((f:A->real^M->real^N) a) * norm(x:real^M)` THEN
    ASM_SIMP_TAC[ONORM; EVENTUALLY_TRUE; LIFT_CMUL] THEN
    MATCH_MP_TAC LIM_NULL_VMUL THEN ASM_REWRITE_TAC[];
    DISCH_TAC THEN
    MATCH_MP_TAC LIM_NULL_COMPARISON THEN
    EXISTS_TAC `\a. sum(1..dimindex(:M))
                       (\i. norm((f:A->real^M->real^N) a (basis i)))` THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL
     [ASM_SIMP_TAC[ONORM_LE_EQ; NORM_LIFT; real_abs; ONORM_POS_LE] THEN
      MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `a:A` THEN
      REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV)
       [GSYM BASIS_EXPANSION] THEN
      ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG; o_DEF] THEN
      MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN
      REWRITE_TAC[FINITE_NUMSEG; GSYM SUM_RMUL] THEN
      MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN
      STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL] THEN
      GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
      MATCH_MP_TAC REAL_LE_RMUL THEN
      REWRITE_TAC[NORM_POS_LE; COMPONENT_LE_NORM];
      REWRITE_TAC[LIFT_SUM] THEN MATCH_MP_TAC LIM_NULL_VSUM THEN
      ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; GSYM LIM_NULL_NORM; o_DEF]]]);;

let LIM_NULL_MATRIX_ONORM = prove
 (`!net A:A->real^M^N.
        ((\a. lift(onorm(\x. A a ** x))) --> vec 0) net <=>
        !x. ((\a. A a ** x) --> vec 0) net`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`net:A net`; `\a x:real^M. (A:A->real^M^N) a ** x`]
   LIM_NULL_ONORM) THEN
  REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;

let LIM_NULL_MATRIX_ONORM_COMPONENTWISE = prove
 (`!net A:A->real^M^N.
        ((\a. lift(onorm(\x. A a ** x))) --> vec 0) net <=>
        !i j. 1 <= i /\ i <= dimindex(:N) /\
              1 <= j /\ j <= dimindex(:M)
              ==> ((\a. lift(A a$i$j)) --> vec 0) net`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`net:A net`; `\a x:real^M. (A:A->real^M^N) a ** x`]
   LIM_NULL_ONORM_COMPONENTWISE) THEN
  REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
  DISCH_THEN SUBST1_TAC THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LIM_COMPONENTWISE_LIFT] THEN
  SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; LAMBDA_BETA] THEN
  REWRITE_TAC[VEC_COMPONENT; LIFT_NUM] THEN MESON_TAC[]);;

let LIM_NULL_ONORM = prove
 (`!net f:A->real^M->real^N g:real^M->real^N.
        (!a. linear(f a)) /\ linear g /\
        ((\a. lift(onorm(\x. f a x - g x))) --> vec 0) net
        ==> ((\a. lift(onorm(f a))) --> lift(onorm g)) net`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_NULL_COMPARISON) THEN
  MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `a:A` THEN
  REWRITE_TAC[NORM_1; DROP_SUB; LIFT_DROP] THEN MATCH_MP_TAC(REAL_ARITH
   `f <= g + d /\ g <= f + d ==> abs(f - g) <= d`) THEN
  GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ONORM_NEG] THEN
  GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [GSYM ONORM_NEG] THEN
  CONJ_TAC THEN
  W(MP_TAC o PART_MATCH (rand o rand) ONORM_TRIANGLE o rand o snd) THEN
  ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_COMPOSE_NEG; ETA_AX] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
  MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC VECTOR_ARITH);;

let LIM_MATRIX_COMPONENTWISE = prove
 (`!net A:A->real^M^N B.
        (!x. ((\a. A a ** x) --> B ** x) net) <=>
        !i j. 1 <= i /\ i <= dimindex(:N) /\
              1 <= j /\ j <= dimindex(:M)
              ==> ((\a. lift(A a$i$j)) --> lift(B$i$j)) net`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN
  REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN
  REWRITE_TAC[GSYM LIFT_SUB; GSYM MATRIX_SUB_COMPONENT] THEN
  REWRITE_TAC[GSYM LIM_NULL_MATRIX_ONORM] THEN
  REWRITE_TAC[LIM_NULL_MATRIX_ONORM_COMPONENTWISE]);;

let CONTINUOUS_MATRIX_COMPONENTWISE = prove
 (`!net (A:A->real^M^N).
        (!x. (\a. A a ** x) continuous net) <=>
        !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:M)
              ==> (\a. lift (A a$i$j)) continuous net`,
  REWRITE_TAC[continuous; LIM_MATRIX_COMPONENTWISE]);;

let CONTINUOUS_ON_MATRIX_COMPONENTWISE = prove
 (`!A:real^P->real^M^N s.
        (!x. (\a. A a ** x) continuous_on s) <=>
        !i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex (:M)
              ==> (\a. lift (A a$i$j)) continuous_on s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [CONTINUOUS_MATRIX_COMPONENTWISE] THEN
  MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Limits and continuity of matrices as flattened vectors.                   *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_MATRIX_VECTOR_MUL = prove
 (`!net A:A->real^N^M v:A->real^N.
        (vectorize o A) continuous net /\ v continuous net
        ==> (\x. (A x) ** (v x)) continuous net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
   BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_MATRIX_VECTOR_MUL)) THEN
  REWRITE_TAC[o_THM; MATRIFY_VECTORIZE]);;

let CONTINUOUS_ON_MATRIX_VECTOR_MUL = prove
 (`!A:real^P->real^N^M v:real^P->real^N s.
        (vectorize o A) continuous_on s /\ v continuous_on s
        ==> (\x. (A x) ** (v x)) continuous_on s`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
   BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_MATRIX_VECTOR_MUL)) THEN
  REWRITE_TAC[o_THM; MATRIFY_VECTORIZE]);;

let CONTINUOUS_MATRIX_MUL = prove
 (`!net A:A->real^N^M B:A->real^P^N.
        (vectorize o A) continuous net /\ (vectorize o B) continuous net
        ==> (\x. vectorize((A x) ** (B x))) continuous net`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
   BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_MATRIX_MUL)) THEN
  REWRITE_TAC[o_THM; MATRIFY_VECTORIZE]);;

let CONTINUOUS_ON_MATRIX_MUL = prove
 (`!A:real^Q->real^N^M B:real^Q->real^P^N s.
        (vectorize o A) continuous_on s /\ (vectorize o B) continuous_on s
        ==> (\x. vectorize((A x) ** (B x))) continuous_on s`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
   [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
   BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_MATRIX_MUL)) THEN
  REWRITE_TAC[o_THM; MATRIFY_VECTORIZE]);;

let LIM_VECTORIZE_COMPONENTWISE = prove
 (`!net (A:A->real^N^M) B.
        ((\a. vectorize(A a)) --> vectorize B) net <=>
        !i j. 1 <= i /\ i <= dimindex (:M) /\ 1 <= j /\ j <= dimindex (:N)
              ==> ((\a. lift (A a$i$j)) --> lift (B$i$j)) net`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [LIM_COMPONENTWISE_LIFT] THEN
  REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THENL
   [ONCE_REWRITE_TAC[GSYM MATRIFY_VECTORIZE] THEN
    SIMP_TAC[MATRIFY_COMPONENT] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[DIMINDEX_FINITE_PROD]] THEN
    TRANS_TAC LE_TRANS `((i - 1) + 1) * dimindex(:N)` THEN
    CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB]] THEN
    REWRITE_TAC[LE_MULT_RCANCEL] THEN ASM_ARITH_TAC;
    SIMP_TAC[VECTORIZE_COMPONENT; DIMINDEX_FINITE_PROD] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[LE_ADD] THEN CONJ_TAC THEN
    MATCH_MP_TAC(ARITH_RULE `a < b ==> 1 + a <= b`) THEN
    SIMP_TAC[DIVISION; LE_1; DIMINDEX_GE_1; RDIV_LT_EQ] THEN
    ASM_ARITH_TAC]);;

let CONTINUOUS_VECTORIZE_COMPONENTWISE = prove
 (`!net (A:A->real^N^M).
        (\a. vectorize(A a)) continuous net <=>
        !i j. 1 <= i /\ i <= dimindex (:M) /\ 1 <= j /\ j <= dimindex (:N)
              ==> (\a. lift (A a$i$j)) continuous net`,
  REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN
  GEN_REWRITE_TAC LAND_CONV [LIM_VECTORIZE_COMPONENTWISE] THEN
  REWRITE_TAC[]);;

let CONTINUOUS_ON_VECTORIZE_COMPONENTWISE = prove
 (`!(A:real^P->real^N^M) s.
        (\a. vectorize(A a)) continuous_on s <=>
        !i j. 1 <= i /\ i <= dimindex (:M) /\ 1 <= j /\ j <= dimindex (:N)
              ==> (\a. lift (A a$i$j)) continuous_on s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [CONTINUOUS_VECTORIZE_COMPONENTWISE] THEN
  MESON_TAC[]);;

let LINEAR_TRANSP = prove
 (`linear(vectorize o (transp:real^N^M->real^M^N) o matrify)`,
  REWRITE_TAC[linear; o_THM; MATRIFY_ADD; MATRIFY_CMUL] THEN
  REWRITE_TAC[TRANSP_MATRIX_ADD; TRANSP_MATRIX_CMUL] THEN
  REWRITE_TAC[VECTORIZE_ADD; VECTORIZE_CMUL]);;

let LIM_MATRIX_VECTORIZE = prove
 (`!net A:A->real^M^N B.
        (!x. ((\a. A a ** x) --> B ** x) net) <=>
        ((\a. vectorize (A a)) --> vectorize B) net`,
  REWRITE_TAC[LIM_MATRIX_COMPONENTWISE; LIM_VECTORIZE_COMPONENTWISE]);;

let CONTINUOUS_MATRIX_VECTORIZE = prove
 (`!net (A:A->real^N^M).
        (!x. (\a. A a ** x) continuous net) <=>
        (\a. vectorize(A a)) continuous net`,
  REWRITE_TAC[continuous; LIM_MATRIX_VECTORIZE]);;

let CONTINUOUS_ON_MATRIX_VECTORIZE = prove
 (`!A:real^P->real^N^M s.
        (!x. (\a. A a ** x) continuous_on s) <=>
        (\a. vectorize(A a)) continuous_on s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [CONTINUOUS_MATRIX_VECTORIZE] THEN
  MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Some more convenient intermediate-value theorem formulations.             *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_IVT_HYPERPLANE = prove
 (`!s x y:real^N a b.
        connected s /\
        x IN s /\ y IN s /\ a dot x <= b /\ b <= a dot y
        ==> ?z. z IN s /\ a dot z = b`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
  REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL
   [`{x:real^N | a dot x < b}`; `{x:real^N | a dot x > b}`]) THEN
  REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; SUBSET;
              IN_UNION; REAL_LT_LE; real_gt] THEN
  ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]);;

let CONNECTED_IVT_COMPONENT = prove
 (`!s x y:real^N a k.
        connected s /\ x IN s /\ y IN s /\
        1 <= k /\ k <= dimindex(:N) /\ x$k <= a /\ a <= y$k
        ==> ?z. z IN s /\ z$k = a`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`s:real^N->bool`; `x:real^N`; `y:real^N`; `(basis k):real^N`;
    `a:real`] CONNECTED_IVT_HYPERPLANE) THEN
  ASM_SIMP_TAC[DOT_BASIS]);;

(* ------------------------------------------------------------------------- *)
(* Rather trivial observation that we can map any connected set on segment.  *)
(* ------------------------------------------------------------------------- *)

let MAPPING_CONNECTED_ONTO_SEGMENT = prove
 (`!s:real^M->bool a b:real^N.
        connected s /\ ~(?a. s SUBSET {a})
        ==> ?f. f continuous_on s /\ IMAGE f s = segment[a,b]`,
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`)) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN EXISTS_TAC
   `\x:real^M. a + dist(u,x) / (dist(u,x) + dist(v,x)) % (b - a:real^N)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST];
    REWRITE_TAC[segment; VECTOR_ARITH
     `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN
    MATCH_MP_TAC(SET_RULE
     `IMAGE f s = {x | P x}
      ==> IMAGE (\x. a + f x % b) s = {a + u % b:real^N | P u}`) THEN
    REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
    ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ;
      NORM_ARITH `~(u:real^N = v) ==> &0 < dist(u,x) + dist(v,x)`] THEN
    CONJ_TAC THENL [CONV_TAC NORM_ARITH; REWRITE_TAC[IN_IMAGE]] THEN
    X_GEN_TAC `t:real` THEN STRIP_TAC THEN
    MP_TAC(ISPECL
     [`IMAGE (\x:real^M. lift(dist(u,x) / (dist(u,x) + dist(v,x)))) s`;
      `vec 0:real^1`; `vec 1:real^1`; `t:real`; `1`]
        CONNECTED_IVT_COMPONENT) THEN
    ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH_LE] THEN
    REWRITE_TAC[EXISTS_IN_IMAGE; GSYM drop; LIFT_DROP] THEN
    ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE]; MESON_TAC[]] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[];
      EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[DIST_REFL; real_div] THEN
      REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN REAL_ARITH_TAC;
      EXISTS_TAC `v:real^M` THEN ASM_REWRITE_TAC[DIST_REFL] THEN
      ASM_SIMP_TAC[REAL_DIV_REFL; DIST_EQ_0; REAL_ADD_RID] THEN
      REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]]] THEN
  REWRITE_TAC[real_div; LIFT_CMUL] THEN
  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
  REWRITE_TAC[CONTINUOUS_ON_LIFT_DIST] THEN
  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
  ASM_SIMP_TAC[LIFT_ADD; NORM_ARITH
   `~(u:real^N = v) ==> ~(dist(u,x) + dist(v,x) = &0)`] THEN
  MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
  REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);;

(* ------------------------------------------------------------------------- *)
(* Also more convenient formulations of monotone convergence.                *)
(* ------------------------------------------------------------------------- *)

let BOUNDED_INCREASING_CONVERGENT = prove
 (`!s:num->real^1.
        bounded {s n | n IN (:num)} /\ (!n. drop(s n) <= drop(s(SUC n)))
        ==> ?l. (s --> l) sequentially`,
  GEN_TAC THEN
  REWRITE_TAC[bounded; IN_ELIM_THM; NORM_1; LIM_SEQUENTIALLY; dist;
              DROP_SUB; IN_UNIV; GSYM EXISTS_DROP] THEN
  DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN
  REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
  ASM_REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL]);;

let BOUNDED_DECREASING_CONVERGENT = prove
 (`!s:num->real^1.
        bounded {s n | n IN (:num)} /\ (!n. drop(s(SUC n)) <= drop(s(n)))
        ==> ?l. (s --> l) sequentially`,
  GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  MP_TAC(ISPEC `\n. --((s:num->real^1) n)` BOUNDED_INCREASING_CONVERGENT) THEN
  ASM_SIMP_TAC[bounded; FORALL_IN_GSPEC; NORM_NEG; DROP_NEG; REAL_LE_NEG2] THEN
  GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN
  REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Since we'll use some cardinality reasoning, add invariance theorems.      *)
(* ------------------------------------------------------------------------- *)

let card_translation_invariants = (CONJUNCTS o prove)
 (`(!a (s:real^N->bool) (t:A->bool).
     IMAGE (\x. a + x) s =_c t <=> s =_c t) /\
   (!a (s:A->bool) (t:real^N->bool).
     s =_c IMAGE (\x. a + x) t <=> s =_c t) /\
   (!a (s:real^N->bool) (t:A->bool).
     IMAGE (\x. a + x) s <_c t <=> s <_c t) /\
   (!a (s:A->bool) (t:real^N->bool).
     s <_c IMAGE (\x. a + x) t <=> s <_c t) /\
   (!a (s:real^N->bool) (t:A->bool).
     IMAGE (\x. a + x) s <=_c t <=> s <=_c t) /\
   (!a (s:A->bool) (t:real^N->bool).
     s <=_c IMAGE (\x. a + x) t <=> s <=_c t) /\
   (!a (s:real^N->bool) (t:A->bool).
     IMAGE (\x. a + x) s >_c t <=> s >_c t) /\
   (!a (s:A->bool) (t:real^N->bool).
     s >_c IMAGE (\x. a + x) t <=> s >_c t) /\
   (!a (s:real^N->bool) (t:A->bool).
     IMAGE (\x. a + x) s >=_c t <=> s >=_c t) /\
   (!a (s:A->bool) (t:real^N->bool).
     s >=_c IMAGE (\x. a + x) t <=> s >=_c t)`,
  REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC CARD_EQ_CONG;
    MATCH_MP_TAC CARD_EQ_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LE_CONG;
    MATCH_MP_TAC CARD_LE_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LE_CONG;
    MATCH_MP_TAC CARD_LE_CONG] THEN
  REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN
  SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]) in
add_translation_invariants card_translation_invariants;;

let card_linear_invariants = (CONJUNCTS o prove)
 (`(!(f:real^M->real^N) s (t:A->bool).
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (IMAGE f s =_c t <=> s =_c t)) /\
   (!(f:real^M->real^N) (s:A->bool) t.
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (s =_c IMAGE f t <=> s =_c t)) /\
   (!(f:real^M->real^N) s (t:A->bool).
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (IMAGE f s <_c t <=> s <_c t)) /\
   (!(f:real^M->real^N) (s:A->bool) t.
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (s <_c IMAGE f t <=> s <_c t)) /\
   (!(f:real^M->real^N) s (t:A->bool).
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (IMAGE f s <=_c t <=> s <=_c t)) /\
   (!(f:real^M->real^N) (s:A->bool) t.
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (s <=_c IMAGE f t <=> s <=_c t)) /\
   (!(f:real^M->real^N) s (t:A->bool).
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (IMAGE f s >_c t <=> s >_c t)) /\
   (!(f:real^M->real^N) (s:A->bool) t.
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (s >_c IMAGE f t <=> s >_c t)) /\
   (!(f:real^M->real^N) s (t:A->bool).
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (IMAGE f s >=_c t <=> s >=_c t)) /\
   (!(f:real^M->real^N) (s:A->bool) t.
     linear f /\ (!x y. f x = f y ==> x = y)
     ==> (s >=_c IMAGE f t <=> s >=_c t))`,
  REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC CARD_EQ_CONG;
    MATCH_MP_TAC CARD_EQ_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LE_CONG;
    MATCH_MP_TAC CARD_LE_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LT_CONG;
    MATCH_MP_TAC CARD_LE_CONG;
    MATCH_MP_TAC CARD_LE_CONG] THEN
  REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN
  ASM_MESON_TAC[]) in
add_linear_invariants card_linear_invariants;;

(* ------------------------------------------------------------------------- *)
(* Basic homeomorphism definitions.                                          *)
(* ------------------------------------------------------------------------- *)

let homeomorphism = new_definition
  `homeomorphism (s,t) (f,g) <=>
     (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\
     (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t`;;

parse_as_infix("homeomorphic",(12,"right"));;

let homeomorphic = new_definition
  `s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)`;;

let HOMEOMORPHISM = prove
 (`!s:real^M->bool t:real^N->bool f g.
        homeomorphism (s,t) (f,g) <=>
         f continuous_on s /\ IMAGE f s SUBSET t /\
         g continuous_on t /\ IMAGE g t SUBSET s /\
         (!x. x IN s ==> g (f x) = x) /\
         (!y. y IN t ==> f (g y) = y)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
  EQ_TAC THEN SIMP_TAC[] THEN SET_TAC[]);;

let HOMEOMORPHIC_MAPS_EUCLIDEAN_SUBTOPOLOGY = prove
 (`!f:real^M->real^N g s t.
        homeomorphic_maps
          (subtopology euclidean s,subtopology euclidean t)
          (f,g) <=>
        homeomorphism (s,t) (f,g)`,
  REWRITE_TAC[homeomorphic_maps; homeomorphism] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  SET_TAC[]);;

let HOMEOMORPHIC_SPACE_EUCLIDEAN = prove
 (`!(s:real^M->bool) (t:real^N->bool).
     (subtopology euclidean s) homeomorphic_space (subtopology euclidean t) <=>
     s homeomorphic t`,
  REWRITE_TAC[homeomorphic; homeomorphic_space;
              HOMEOMORPHIC_MAPS_EUCLIDEAN_SUBTOPOLOGY]);;

let HOMEOMORPHISM_IMP_HOMEOMORPHIC = prove
 (`!f:real^M->real^N g s t. homeomorphism (s,t) (f,g) ==> s homeomorphic t`,
  REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);;

let HOMEOMORPHISM_OF_SUBSETS = prove
 (`!f g s t s' t'.
    homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ IMAGE f s' = t'
    ==> homeomorphism (s',t') (f,g)`,
  REWRITE_TAC[homeomorphism] THEN
  REPEAT STRIP_TAC THEN
  TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_OF_SUBSETS_ALT = prove
 (`!f:real^M->real^N g s t s' t'.
        homeomorphism (s,t) (f,g) /\
        s' SUBSET s /\
        t' SUBSET t /\
        (!x. x IN s ==> (f x IN t' <=> x IN s'))
        ==> homeomorphism (s',t') (f,g)`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
   (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
  FIRST_ASSUM(MP_TAC o el 1 o CONJUNCTS o REWRITE_RULE[homeomorphism]) THEN
  ASM SET_TAC[]);;

let HOMEOMORPHISM_ID = prove
 (`!s:real^N->bool. homeomorphism (s,s) ((\x. x),(\x. x))`,
  REWRITE_TAC[homeomorphism; IMAGE_ID; CONTINUOUS_ON_ID]);;

let HOMEOMORPHISM_I = prove
 (`!s:real^N->bool. homeomorphism (s,s) (I,I)`,
  REWRITE_TAC[I_DEF; HOMEOMORPHISM_ID]);;

let HOMEOMORPHIC_REFL = prove
 (`!s:real^N->bool. s homeomorphic s`,
  REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_I]);;

let HOMEOMORPHISM_SYM = prove
 (`!f:real^M->real^N g s t.
        homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)`,
  REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);;

let HOMEOMORPHIC_SYM = prove
 (`!s t. s homeomorphic t <=> t homeomorphic s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN
  GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
  REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);;

let HOMEOMORPHISM_COMPOSE = prove
 (`!f:real^M->real^N g h:real^N->real^P k s t u.
        homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k)
        ==> homeomorphism (s,u) (h o f,g o k)`,
  SIMP_TAC[homeomorphism; CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM] THEN
  SET_TAC[]);;

let HOMEOMORPHIC_TRANS = prove
 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u`,
  REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]);;

let HOMEOMORPHISM_EQ = prove
 (`!f:real^M->real^N g f' g' s t.
        homeomorphism (s,t) (f,g) /\
        (!x. x IN s ==> f' x = f x) /\
        (!y. y IN t ==> g' y = g y)
        ==> homeomorphism (s,t) (f',g')`,
  REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_ON_EQ];
    ASM SET_TAC[];
    ASM_MESON_TAC[CONTINUOUS_ON_EQ];
    ASM SET_TAC[]; ASM SET_TAC[]; ASM SET_TAC[]]);;

let LINEAR_IMP_HOMEOMORPHISM = prove
 (`!f:real^M->real^N g:real^N->real^M s t.
        linear f /\ linear g /\ g o f = I /\ IMAGE f s = t
        ==> homeomorphism (s,t) (f,g)`,
  REPEAT GEN_TAC THEN GEN_REWRITE_TAC
   (LAND_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [FUN_EQ_THM] THEN
  REWRITE_TAC[o_THM; I_THM] THEN STRIP_TAC THEN
  ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

let ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM = prove
 (`!f:real^N->real^N s t.
        orthogonal_transformation f /\ IMAGE f s = t
        ==> ?g. orthogonal_transformation g /\
                homeomorphism (s,t) (f,g)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_IMP_HOMEOMORPHISM]);;

let HOMEOMORPHIC_SELF_IMAGE = prove
 (`!f:real^M->real^N g s t u.
        homeomorphism (s,t) (f,g) /\ u SUBSET s
        ==> IMAGE f u homeomorphic u`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_IMP_CARD_EQ = prove
 (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s =_c t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism; eq_c] THEN
  MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);;

let HOMEOMORPHIC_FINITENESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (FINITE s <=> FINITE t)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
  DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_FINITE_CONG));;

let HOMEOMORPHISM_FINITENESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (FINITE(IMAGE f k) <=> FINITE k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_FINITENESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_INFINITENESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (INFINITE s <=> INFINITE t)`,
  REWRITE_TAC[INFINITE] THEN MESON_TAC[HOMEOMORPHIC_FINITENESS]);;

let HOMEOMORPHISM_INFINITENESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (INFINITE(IMAGE f k) <=> INFINITE k)`,
  REWRITE_TAC[INFINITE] THEN MESON_TAC[HOMEOMORPHISM_FINITENESS]);;

let HOMEOMORPHIC_COUNTABILITY = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (COUNTABLE s <=> COUNTABLE t)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
  DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_COUNTABLE_CONG));;

let HOMEOMORPHISM_COUNTABILITY = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (COUNTABLE(IMAGE f k) <=> COUNTABLE k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COUNTABILITY THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_EMPTY = prove
 (`(!s. (s:real^N->bool) homeomorphic ({}:real^M->bool) <=> s = {}) /\
   (!s. ({}:real^M->bool) homeomorphic (s:real^N->bool) <=> s = {})`,
  REWRITE_TAC[homeomorphic; homeomorphism; IMAGE_CLAUSES; IMAGE_EQ_EMPTY] THEN
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[continuous_on; NOT_IN_EMPTY]);;

let HOMEOMORPHIC_MINIMAL = prove
 (`!s t. s homeomorphic t <=>
            ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\
                  (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\
                  f continuous_on s /\ g continuous_on t`,
  REWRITE_TAC[homeomorphic; homeomorphism; EXTENSION; IN_IMAGE] THEN
  REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]);;

let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (IMAGE f s) homeomorphic s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_LEFT_INVERSE]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN
  EXISTS_TAC `f:real^M->real^N` THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; FORALL_IN_IMAGE; FUN_IN_IMAGE] THEN
  ASM_SIMP_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `e * B:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
  X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB] THEN
  DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN
  MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);;

let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove
 (`!f:real^M->real^N s t.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)`,
  REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o
    MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN
  EQ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]);
    POP_ASSUM MP_TAC] THEN
  REWRITE_TAC[IMP_IMP; HOMEOMORPHIC_TRANS]);;

let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove
 (`!f:real^M->real^N s t.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)`,
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);;

add_linear_invariants
  [HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
   HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;

let HOMEOMORPHIC_TRANSLATION_SELF = prove
 (`!a:real^N s. (IMAGE (\x. a + x) s) homeomorphic s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  EXISTS_TAC `\x:real^N. x - a` THEN
  EXISTS_TAC `\x:real^N. a + x` THEN
  SIMP_TAC[FORALL_IN_IMAGE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
           CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD; VECTOR_ADD_SUB] THEN
  REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);;

let HOMEOMORPHIC_TRANSLATION_LEFT_EQ = prove
 (`!a:real^N s t.
      (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t`,
  MESON_TAC[HOMEOMORPHIC_TRANSLATION_SELF;
            HOMEOMORPHIC_SYM; HOMEOMORPHIC_TRANS]);;

let HOMEOMORPHIC_TRANSLATION_RIGHT_EQ = prove
 (`!a:real^N s t.
      s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t`,
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]);;

add_translation_invariants
  [HOMEOMORPHIC_TRANSLATION_LEFT_EQ;
   HOMEOMORPHIC_TRANSLATION_RIGHT_EQ];;

let INVOLUTION_IMP_HOMEOMORPHISM_GEN = prove
 (`!f:real^N->real^N u s.
        f continuous_on u /\
        s UNION IMAGE f s SUBSET u /\
        (!x. x IN s ==> f(f x) = x)
        ==> homeomorphism(s,IMAGE f s) (f,f)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM; SUBSET_REFL] THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; CONJ_ASSOC] THEN CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
    EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[];
    ASM SET_TAC[]]);;

let INVOLUTION_IMP_HOMEOMORPHISM = prove
 (`!f:real^N->real^N s.
        f continuous_on s /\ IMAGE f s SUBSET s /\ (!x. x IN s ==> f(f x) = x)
        ==> homeomorphism(s,s) (f,f)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `s:real^N->bool`]
        INVOLUTION_IMP_HOMEOMORPHISM_GEN) THEN
  ASM_REWRITE_TAC[UNION_SUBSET; SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_IMP_QUOTIENT_MAP = prove
 (`!f:real^M->real^N g s t.
    homeomorphism (s,t) (f,g)
    ==> !u. u SUBSET t
            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
                 open_in (subtopology euclidean t) u)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
  STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
  EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_REFL]);;

let HOMEOMORPHIC_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool.
        s homeomorphic s' /\ t homeomorphic t'
        ==> (s PCROSS t) homeomorphic (s' PCROSS t')`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `f:real^M->real^P`
     (X_CHOOSE_THEN `f':real^P->real^M` STRIP_ASSUME_TAC))
   (X_CHOOSE_THEN `g:real^N->real^Q`
     (X_CHOOSE_THEN `g':real^Q->real^N` STRIP_ASSUME_TAC))) THEN
  MAP_EVERY EXISTS_TAC
   [`(\z. pastecart (f(fstcart z)) (g(sndcart z)))
     :real^(M,N)finite_sum->real^(P,Q)finite_sum`;
    `(\z. pastecart (f'(fstcart z)) (g'(sndcart z)))
     :real^(P,Q)finite_sum->real^(M,N)finite_sum`] THEN
  ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
               SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
  CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
  CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  SIMP_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
  SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);;

let HOMEOMORPHIC_PCROSS_SYM = prove
 (`!s:real^M->bool t:real^N->bool. (s PCROSS t) homeomorphic (t PCROSS s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN
  EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z))
              :real^(M,N)finite_sum->real^(N,M)finite_sum` THEN
  EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z))
              :real^(N,M)finite_sum->real^(M,N)finite_sum` THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
  SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
           LINEAR_FSTCART; LINEAR_SNDCART] THEN
  REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
    IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; PASTECART_IN_PCROSS] THEN
  MESON_TAC[]);;

let HOMEOMORPHIC_PCROSS_ASSOC = prove
 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        (s PCROSS (t PCROSS u)) homeomorphic ((s PCROSS t) PCROSS u)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
  MAP_EVERY EXISTS_TAC
   [`\z:real^(M,(N,P)finite_sum)finite_sum.
        pastecart (pastecart (fstcart z) (fstcart(sndcart z)))
                  (sndcart(sndcart z))`;
    `\z:real^((M,N)finite_sum,P)finite_sum.
        pastecart (fstcart(fstcart z))
                  (pastecart (sndcart(fstcart z)) (sndcart z))`] THEN
  REWRITE_TAC[FORALL_IN_PCROSS; SUBSET; FORALL_IN_IMAGE;
              RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
  SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN
  CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
  REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN
  TRY(GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC LINEAR_COMPOSE) THEN
  REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;

let HOMEOMORPHIC_SCALING_LEFT = prove
 (`!c. &0 < c
       ==> !s t. (IMAGE (\x. c % x) s) homeomorphic t <=> s homeomorphic t`,
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN
  ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);;

let HOMEOMORPHIC_SCALING_RIGHT = prove
 (`!c. &0 < c
       ==> !s t. s homeomorphic (IMAGE (\x. c % x) t) <=> s homeomorphic t`,
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN
  ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);;

let HOMEOMORPHIC_SUBSPACES = prove
 (`!s:real^M->bool t:real^N->bool.
        subspace s /\ subspace t /\ dim s = dim t ==> s homeomorphic t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
  DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN
  SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_FINITE = prove
 (`!s:real^M->bool t:real^N->bool.
        FINITE s /\ FINITE t ==> (s homeomorphic t <=> CARD s = CARD t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
    ASM_SIMP_TAC[CARD_EQ_CARD];
    STRIP_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
    MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`]
        CARD_EQ_BIJECTIONS) THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_FINITE] THEN ASM SET_TAC[]]);;

let HOMEOMORPHIC_FINITE_STRONG = prove
 (`!s:real^M->bool t:real^N->bool.
        FINITE s \/ FINITE t
        ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ CARD s = CARD t)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN
  SIMP_TAC[HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP
    HOMEOMORPHIC_IMP_CARD_EQ) THEN
  FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);;

let HOMEOMORPHIC_HAS_SIZE = prove
 (`!s:real^M->bool t:real^N->bool n.
        s homeomorphic t ==> (s HAS_SIZE n <=> t HAS_SIZE n)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_FINITENESS) THEN
  ASM_CASES_TAC `FINITE(t:real^N->bool)` THEN ASM_SIMP_TAC[HAS_SIZE] THEN
  DISCH_TAC THEN ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);;

let HOMEOMORPHISM_HAS_SIZE_EQ = prove
 (`!f:real^M->real^N g s t k n.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> ((IMAGE f k) HAS_SIZE n <=> k HAS_SIZE n)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_HAS_SIZE THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_SING = prove
 (`!a:real^M b:real^N. {a} homeomorphic {b}`,
  SIMP_TAC[HOMEOMORPHIC_FINITE; FINITE_SING; CARD_SING]);;

let HOMEOMORPHIC_PCROSS_SING = prove
 (`(!s:real^M->bool a:real^N. s homeomorphic (s PCROSS {a})) /\
   (!s:real^M->bool a:real^N. s homeomorphic ({a} PCROSS s))`,
  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL
   [MESON_TAC[HOMEOMORPHIC_PCROSS_SYM; HOMEOMORPHIC_TRANS]; ALL_TAC] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
  EXISTS_TAC `\x. (pastecart x a:real^(M,N)finite_sum)` THEN
  EXISTS_TAC `fstcart:real^(M,N)finite_sum->real^M` THEN
  SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  SIMP_TAC[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]);;

let LIFT_TO_QUOTIENT_SPACE_UNIQUE = prove
 (`!f:real^M->real^N g:real^M->real^P s t u.
        IMAGE f s = t /\
        IMAGE g s = u /\
        (!v. v SUBSET t
             ==> (open_in (subtopology euclidean s)
                  {x | x IN s /\ f x IN v} <=>
                  open_in (subtopology euclidean t) v)) /\
         (!v. v SUBSET u
             ==> (open_in (subtopology euclidean s)
                  {x | x IN s /\ g x IN v} <=>
                  open_in (subtopology euclidean u) v)) /\
        (!x y. x IN s /\ y IN s ==> (f x = f y <=> g x = g y))
        ==> t homeomorphic u`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `g:real^M->real^P`; `s:real^M->bool`;
    `t:real^N->bool`; `u:real^P->bool`] LIFT_TO_QUOTIENT_SPACE) THEN
  MP_TAC(ISPECL
   [`g:real^M->real^P`; `f:real^M->real^N`; `s:real^M->bool`;
    `u:real^P->bool`; `t:real^N->bool`] LIFT_TO_QUOTIENT_SPACE) THEN
  ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
        CONTINUOUS_ON_OPEN_GEN) THEN
  ASM_SIMP_TAC[SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN ANTS_TAC THENL
   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
    DISCH_THEN(X_CHOOSE_THEN `h:real^P->real^N` STRIP_ASSUME_TAC)] THEN
  MP_TAC(ISPECL [`g:real^M->real^P`; `s:real^M->bool`; `u:real^P->bool`]
        CONTINUOUS_ON_OPEN_GEN) THEN
  ASM_SIMP_TAC[SUBSET_REFL] THEN DISCH_THEN SUBST1_TAC THEN ANTS_TAC THENL
   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
    DISCH_THEN(X_CHOOSE_THEN `k:real^N->real^P` STRIP_ASSUME_TAC)] THEN
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MAP_EVERY EXISTS_TAC
   [`k:real^N->real^P`; `h:real^P->real^N`] THEN
  ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let HOMOEOMORPHISM_PASTE = prove
 (`!f:real^M->real^N g f' g' s t s' t'.
        homeomorphism (s,t) (f,g) /\ homeomorphism (s',t') (f',g') /\
        (open_in (subtopology euclidean (s UNION s')) s /\
         open_in (subtopology euclidean (s UNION s')) s' /\
         open_in (subtopology euclidean (t UNION t')) t /\
         open_in (subtopology euclidean (t UNION t')) t' \/
         closed_in (subtopology euclidean (s UNION s')) s /\
         closed_in (subtopology euclidean (s UNION s')) s' /\
         closed_in (subtopology euclidean (t UNION t')) t /\
         closed_in (subtopology euclidean (t UNION t')) t') /\
        (!x. x IN s INTER s' ==> f' x = f x) /\
        (!y. y IN t INTER t' ==> g' y = g y)
        ==> ?h k. homeomorphism (s UNION s',t UNION t') (h,k) /\
                  (!x. x IN s ==> h x = f x) /\ (!x. x IN s' ==> h x = f' x) /\
                  (!y. y IN t ==> k y = g y) /\ (!y. y IN t' ==> k y = g' y) /\
                  IMAGE h s = t /\ IMAGE h s' = t' /\
                  IMAGE k t = s /\ IMAGE k t' = s' /\
                  IMAGE h (s INTER s') = t INTER t' /\
                  IMAGE h (s DIFF s') = t DIFF t' /\
                  IMAGE h (s' DIFF s) = t' DIFF t /\
                  IMAGE k (t INTER t') = s INTER s' /\
                  IMAGE k (t DIFF t') = s DIFF s' /\
                  IMAGE k (t' DIFF t) = s' DIFF s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else f' x` THEN
  EXISTS_TAC `\x. if x IN t then (g:real^N->real^M) x else g' x` THEN
  REWRITE_TAC[IN_UNION] THEN
  MATCH_MP_TAC(TAUT
   `(p /\ q /\ s /\ t /\ v) /\ (r /\ u)
    ==> (p /\ q /\ r /\ s /\ t /\ u) /\ v`) THEN
  CONJ_TAC THENL [REPEAT CONJ_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
  CONJ_TAC THEN
   (FIRST_X_ASSUM DISJ_CASES_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN;
      MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[]));;

(* ------------------------------------------------------------------------- *)
(* Domain of a continuous function is homeomorphic to its graph.             *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHISM_GRAPH_EXPLICIT = prove
 (`!f:real^M->real^N s.
        homeomorphism (s,{pastecart x (f x) | x IN s})
                      ((\x. pastecart x (f x)),fstcart) <=>
        f continuous_on s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN EQ_TAC THEN
  STRIP_TAC THEN REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN `(f:real^M->real^N) = sndcart o (\x. pastecart x (f x))`
    SUBST1_TAC THENL [SIMP_TAC[o_DEF; SNDCART_PASTECART; ETA_AX]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
    REWRITE_TAC[FSTCART_PASTECART];
    SET_TAC[];
    ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID];
    REWRITE_TAC[FORALL_IN_GSPEC; FSTCART_PASTECART];
    REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_ELIM_THM; EXISTS_PASTECART; FORALL_PASTECART] THEN
    REWRITE_TAC[FSTCART_PASTECART; PASTECART_INJ] THEN MESON_TAC[];
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]]);;

let HOMEOMORPHISM_GRAPH = prove
 (`!f:real^M->real^N s.
        (?g. homeomorphism (s,{pastecart x (f x) | x IN s})
                           ((\x. pastecart x (f x)),g)) <=>
        f continuous_on s`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [ALL_TAC;
    REWRITE_TAC[GSYM HOMEOMORPHISM_GRAPH_EXPLICIT] THEN MESON_TAC[]] THEN
  REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
  EXISTS_TAC `sndcart o (\x. pastecart x ((f:real^M->real^N) x))` THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART;
               o_THM; SNDCART_PASTECART]);;

let HOMEOMORPHIC_GRAPH = prove
 (`!f:real^M->real^N s.
        f continuous_on s ==> {pastecart x (f x) | x IN s} homeomorphic s`,
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[GSYM HOMEOMORPHISM_GRAPH_EXPLICIT; homeomorphic] THEN
  MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Inverse function property for open/closed maps.                           *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_INVERSE_OPEN_MAP = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\
        (!u. open_in (subtopology euclidean s) u
             ==> open_in (subtopology euclidean t) (IMAGE f u))
        ==> g continuous_on t`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`]
        CONTINUOUS_ON_OPEN_GEN) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
  X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
  ASM SET_TAC[]);;

let CONTINUOUS_ON_INVERSE_CLOSED_MAP = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\
        (!u. closed_in (subtopology euclidean s) u
             ==> closed_in (subtopology euclidean t) (IMAGE f u))
        ==> g continuous_on t`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`]
        CONTINUOUS_ON_CLOSED_GEN) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
  X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]);;

let CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!x. x IN s ==> g(f x) = x) /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k})
        ==> g continuous_on t`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ASM_SIMP_TAC[PROPER_MAP; SUBSET_REFL] THEN STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);;

let HOMEOMORPHISM_INJECTIVE_OPEN_MAP = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        (!u. open_in (subtopology euclidean s) u
             ==> open_in (subtopology euclidean t) (IMAGE f u))
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN
  REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]);;

let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        (!u. closed_in (subtopology euclidean s) u
             ==> closed_in (subtopology euclidean t) (IMAGE f u))
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN
  REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);;

let HOMEOMORPHISM_IMP_OPEN_MAP = prove
 (`!f:real^M->real^N g s t u.
        homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u
        ==> open_in (subtopology euclidean t) (IMAGE f u)`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^M->real^N) u =
                 {y | y IN t /\ g(y) IN u}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
    ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]);;

let HOMEOMORPHISM_IMP_CLOSED_MAP = prove
 (`!f:real^M->real^N g s t u.
        homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u
        ==> closed_in (subtopology euclidean t) (IMAGE f u)`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^M->real^N) u =
                 {y | y IN t /\ g(y) IN u}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]);;

let HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> ((?g. homeomorphism (s,t) (f,g)) <=>
             !u. open_in (subtopology euclidean s) u
                 ==> open_in (subtopology euclidean t) (IMAGE f u))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[];
    MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
    ASM_REWRITE_TAC[]]);;

let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> ((?g. homeomorphism (s,t) (f,g)) <=>
             !u. closed_in (subtopology euclidean s) u
                 ==> closed_in (subtopology euclidean t) (IMAGE f u))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[];
    MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN
    ASM_REWRITE_TAC[]]);;

let INJECTIVE_MAP_OPEN_IFF_CLOSED = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> ((!u. open_in (subtopology euclidean s) u
                  ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
             (!u. closed_in (subtopology euclidean s) u
                  ==> closed_in (subtopology euclidean t) (IMAGE f u)))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC `?g:real^N->real^M. homeomorphism (s,t) (f,g)` THEN
  CONJ_TAC THENL
   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ;
    MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN
  ASM_REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Transformation theorems for open, interior etc. under homeomorphism.      *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHISM_OPEN_IN_EQ = prove
 (`!f:real^M->real^N g s t u v.
        homeomorphism (s,t) (f,g) /\ u SUBSET s /\ v SUBSET s
        ==> (open_in (subtopology euclidean (IMAGE f u)) (IMAGE f v) <=>
             open_in  (subtopology euclidean u) v)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN `v = IMAGE (g:real^N->real^M) (IMAGE f v)` SUBST1_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
      MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
       [`f:real^M->real^N`; `IMAGE (f:real^M->real^N) u`] THEN
      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM]];
     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
      [`g:real^N->real^M`; `u:real^M->bool`] THEN  ASM_REWRITE_TAC[]] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
    HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_OPENNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (open_in (subtopology euclidean t) (IMAGE f k) <=>
             open_in (subtopology euclidean s) k)`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "t" THEN
  MATCH_MP_TAC HOMEOMORPHISM_OPEN_IN_EQ THEN MAP_EVERY EXISTS_TAC
   [`g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`] THEN
  ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_CLOSED_IN_EQ = prove
 (`!f:real^M->real^N g s t u v.
        homeomorphism (s,t) (f,g) /\ u SUBSET s /\ v SUBSET s
        ==> (closed_in (subtopology euclidean (IMAGE f u)) (IMAGE f v) <=>
             closed_in  (subtopology euclidean u) v)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN `v = IMAGE (g:real^N->real^M) (IMAGE f v)` SUBST1_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
      MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC
       [`f:real^M->real^N`; `IMAGE (f:real^M->real^N) u`] THEN
      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM]];
     MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC
      [`g:real^N->real^M`; `u:real^M->bool`] THEN  ASM_REWRITE_TAC[]] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
    HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_CLOSEDNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (closed_in (subtopology euclidean t) (IMAGE f k) <=>
             closed_in (subtopology euclidean s) k)`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "t" THEN
  MATCH_MP_TAC HOMEOMORPHISM_CLOSED_IN_EQ THEN MAP_EVERY EXISTS_TAC
   [`g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`] THEN
  ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_DERIVED_SET_OF = prove
 (`!f:real^M->real^N g s t u.
           homeomorphism (s,t) (f,g) /\ u SUBSET s
           ==> IMAGE f ((subtopology euclidean s) derived_set_of u) =
               (subtopology euclidean t) derived_set_of (IMAGE f u)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC HOMEOMORPHIC_MAP_DERIVED_SET_OF THEN
  REWRITE_TAC[HOMEOMORPHIC_MAP_MAPS; HOMEOMORPHIC_MAPS_EUCLIDEAN_SUBTOPOLOGY;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  ASM_MESON_TAC[]);;

let HOMEOMORPHISM_CLOSURE_OF = prove
 (`!f:real^M->real^N g s t u.
           homeomorphism (s,t) (f,g) /\ u SUBSET s
           ==> IMAGE f ((subtopology euclidean s) closure_of u) =
               (subtopology euclidean t) closure_of (IMAGE f u)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CLOSURE_OF_ALT; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IMAGE_UNION] THEN
  BINOP_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[];
    MATCH_MP_TAC HOMEOMORPHISM_DERIVED_SET_OF THEN ASM_MESON_TAC[]]);;

let HOMEOMORPHISM_INTERIOR_OF = prove
 (`!f:real^M->real^N g s t u.
           homeomorphism (s,t) (f,g) /\ u SUBSET s
           ==> IMAGE f ((subtopology euclidean s) interior_of u) =
               (subtopology euclidean t) interior_of (IMAGE f u)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC HOMEOMORPHIC_MAP_INTERIOR_OF THEN
  REWRITE_TAC[HOMEOMORPHIC_MAP_MAPS; HOMEOMORPHIC_MAPS_EUCLIDEAN_SUBTOPOLOGY;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  ASM_MESON_TAC[]);;

let HOMEOMORPHISM_FRONTIER_OF = prove
 (`!f:real^M->real^N g s t u.
           homeomorphism (s,t) (f,g) /\ u SUBSET s
           ==> IMAGE f ((subtopology euclidean s) frontier_of u) =
               (subtopology euclidean t) frontier_of (IMAGE f u)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC HOMEOMORPHIC_MAP_FRONTIER_OF THEN
  REWRITE_TAC[HOMEOMORPHIC_MAP_MAPS; HOMEOMORPHIC_MAPS_EUCLIDEAN_SUBTOPOLOGY;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  ASM_MESON_TAC[]);;

let HOMEOMORPHISM_CLOSURE = prove
 (`!f:real^M->real^N g s t u.
        homeomorphism (s,t) (f,g) /\ u SUBSET s
        ==> t INTER closure (IMAGE f u) = IMAGE f (s INTER closure u)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_CLOSURE_OF) THEN
  REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
  ASM_SIMP_TAC[SET_RULE `u SUBSET s ==> s INTER u = u`] THEN
  DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_CONNECTED_COMPONENT = prove
 (`!f:real^M->real^N g s t x.
        homeomorphism (s,t) (f,g) /\ x IN s
        ==> connected_component (IMAGE f s) (f x) =
            IMAGE f (connected_component s x)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ];
    MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
    MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
    FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
    X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
    SUBGOAL_THEN `IMAGE (g:real^N->real^M) d SUBSET connected_component s x`
    MP_TAC THENL
     [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN
      MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      ASM SET_TAC[]]]);;

let HOMEOMORPHISM_COMPONENTS = prove
 (`!f:real^M->real^N g s t.
        homeomorphism (s,t) (f,g)
        ==> components t = IMAGE (IMAGE f) (components s)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[homeomorphism]) THEN
  EXPAND_TAC "t" THEN REWRITE_TAC[components] THEN
  REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
  REWRITE_TAC[SET_RULE `IMAGE f {g x | x IN s} = {f(g x) | x IN s}`] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN
  ASM_MESON_TAC[HOMEOMORPHISM_CONNECTED_COMPONENT]);;

let LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP = prove
 (`!f:real^M->real^N s t.
        (!x. x IN s
             ==> ?u v g. x IN u /\
                         open_in (subtopology euclidean s) u /\
                         open_in (subtopology euclidean t) v /\
                         homeomorphism (u,v) (f,g))
        ==> !u. open_in (subtopology euclidean s) u
                ==> open_in (subtopology euclidean t) (IMAGE f u)`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
  REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN
  DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC
   [`v:real^M->bool`; `w:real^N->bool`; `g:real^N->real^M`] THEN
  STRIP_TAC THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) (u INTER v)` THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  TRANS_TAC OPEN_IN_TRANS `w:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHISM_IMP_OPEN_MAP)) THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
  EXISTS_TAC `s:real^M->bool` THEN
  ASM_MESON_TAC[OPEN_IN_INTER; OPEN_IN_REFL; OPEN_IN_IMP_SUBSET]);;

let DERIVED_SET_OF_TRANSLATION = prove
 (`!a:real^N u s.
        (subtopology euclidean (IMAGE (\x. a + x) u)) derived_set_of
        (IMAGE (\x. a + x) s) =
        IMAGE (\x. a + x) (subtopology euclidean u derived_set_of s)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  ONCE_REWRITE_TAC[DERIVED_SET_OF_RESTRICT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  SIMP_TAC[GSYM IMAGE_INTER_INJ;
           VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
  MATCH_MP_TAC HOMEOMORPHISM_DERIVED_SET_OF THEN
  EXISTS_TAC `\x:real^N. --a + x` THEN
  REWRITE_TAC[INTER_SUBSET] THEN REWRITE_TAC[HOMEOMORPHISM] THEN
  SIMP_TAC[FORALL_IN_IMAGE; SUBSET] THEN
  REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^N = x`] THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  SET_TAC[]);;

add_translation_invariants [DERIVED_SET_OF_TRANSLATION];;

let CLOSURE_OF_TRANSLATION = prove
 (`!a:real^N u s.
        (subtopology euclidean (IMAGE (\x. a + x) u)) closure_of
        (IMAGE (\x. a + x) s) =
        IMAGE (\x. a + x) (subtopology euclidean u closure_of s)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  ONCE_REWRITE_TAC[CLOSURE_OF_RESTRICT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  SIMP_TAC[GSYM IMAGE_INTER_INJ;
           VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
  MATCH_MP_TAC HOMEOMORPHISM_CLOSURE_OF THEN
  EXISTS_TAC `\x:real^N. --a + x` THEN
  REWRITE_TAC[INTER_SUBSET] THEN REWRITE_TAC[HOMEOMORPHISM] THEN
  SIMP_TAC[FORALL_IN_IMAGE; SUBSET] THEN
  REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^N = x`] THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  SET_TAC[]);;

add_translation_invariants [CLOSURE_OF_TRANSLATION];;

let INTERIOR_OF_TRANSLATION = prove
 (`!a:real^N u s.
        (subtopology euclidean (IMAGE (\x. a + x) u)) interior_of
        (IMAGE (\x. a + x) s) =
        IMAGE (\x. a + x) (subtopology euclidean u interior_of s)`,
  REWRITE_TAC[INTERIOR_OF_CLOSURE_OF; CLOSURE_OF_TRANSLATION;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; GSYM TRANSLATION_DIFF]);;

add_translation_invariants [INTERIOR_OF_TRANSLATION];;

let FRONTIER_OF_TRANSLATION = prove
 (`!a:real^N u s.
        (subtopology euclidean (IMAGE (\x. a + x) u)) frontier_of
        (IMAGE (\x. a + x) s) =
        IMAGE (\x. a + x) (subtopology euclidean u frontier_of s)`,
  REWRITE_TAC[frontier_of; CLOSURE_OF_TRANSLATION; INTERIOR_OF_TRANSLATION;
              GSYM TRANSLATION_DIFF]);;

add_translation_invariants [FRONTIER_OF_TRANSLATION];;

let DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N u s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (subtopology euclidean (IMAGE f u)) derived_set_of (IMAGE f s) =
            IMAGE f (subtopology euclidean u derived_set_of s)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  ONCE_REWRITE_TAC[DERIVED_SET_OF_RESTRICT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN
  MATCH_MP_TAC HOMEOMORPHISM_DERIVED_SET_OF THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN
  STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

add_linear_invariants [DERIVED_SET_OF_INJECTIVE_LINEAR_IMAGE];;

let CLOSURE_OF_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N u s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (subtopology euclidean (IMAGE f u)) closure_of (IMAGE f s) =
            IMAGE f (subtopology euclidean u closure_of s)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  ONCE_REWRITE_TAC[CLOSURE_OF_RESTRICT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN
  MATCH_MP_TAC HOMEOMORPHISM_CLOSURE_OF THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN
  STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

add_linear_invariants [CLOSURE_OF_INJECTIVE_LINEAR_IMAGE];;

let FRONTIER_OF_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N u s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (subtopology euclidean (IMAGE f u)) frontier_of (IMAGE f s) =
            IMAGE f (subtopology euclidean u frontier_of s)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  ONCE_REWRITE_TAC[FRONTIER_OF_RESTRICT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN
  MATCH_MP_TAC HOMEOMORPHISM_FRONTIER_OF THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN
  STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

add_linear_invariants [FRONTIER_OF_INJECTIVE_LINEAR_IMAGE];;

let INTERIOR_OF_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N u s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (subtopology euclidean (IMAGE f u)) interior_of (IMAGE f s) =
            IMAGE f (subtopology euclidean u interior_of s)`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  ONCE_REWRITE_TAC[INTERIOR_OF_RESTRICT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP IMAGE_INTER_INJ th)]) THEN
  MATCH_MP_TAC HOMEOMORPHISM_INTERIOR_OF THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN STRIP_TAC THEN
  STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHISM] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

add_linear_invariants [INTERIOR_OF_INJECTIVE_LINEAR_IMAGE];;

(* ------------------------------------------------------------------------- *)
(* Relatively weak hypotheses if the domain of the function is compact.      *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_IMP_CLOSED_MAP_EXPLICIT = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\ compact s
        ==> !u. closed_in (subtopology euclidean s) u
                ==> closed_in (subtopology euclidean t) (IMAGE f u)`,
  SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN
  EXPAND_TAC "t" THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN
  MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS;
                BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]);;

let CONTINUOUS_IMP_QUOTIENT_MAP_EXPLICIT = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\ compact s
        ==> !u. u SUBSET t
                ==> (open_in (subtopology euclidean s)
                             {x | x IN s /\ f x IN u} <=>
                     open_in (subtopology euclidean t) u)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP_EXPLICIT THEN
  ASM_REWRITE_TAC[]);;

let CONTINUOUS_ON_INVERSE = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x))
        ==> g continuous_on (IMAGE f s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN
  SUBGOAL_THEN `IMAGE g (IMAGE (f:real^M->real^N) s) = s` SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
  X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN CONJ_TAC THENL
   [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN
    REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS;
                  BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET];
    REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN
    ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET]]);;

let HOMEOMORPHISM_COMPACT = prove
 (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\
           (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
           ==> ?g. homeomorphism(s,t) (f,g)`,
  REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[EXTENSION; homeomorphism] THEN
  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  ASM_MESON_TAC[CONTINUOUS_ON_INVERSE; IN_IMAGE]);;

let HOMEOMORPHIC_COMPACT = prove
 (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\
           (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
           ==> s homeomorphic t`,
  REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPACT]);;

(* ------------------------------------------------------------------------- *)
(* Lemmas about composition of homeomorphisms.                               *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s = t /\
        g continuous_on t /\ IMAGE g t SUBSET u /\
        (?h. homeomorphism (s,u) (g o f,h))
        ==> (?f'. homeomorphism (s,t) (f,f')) /\
            (?g'. homeomorphism (t,u) (g,g'))`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN
  MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN
    MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
    MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN
    ASM_REWRITE_TAC[homeomorphism; o_THM];
    REWRITE_TAC[homeomorphism; o_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `g':real^P->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(h:real^P->real^M) o (g:real^N->real^P)` THEN
    ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;

let HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET u /\
        (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\
        (?h. homeomorphism (s,u) (g o f,h))
        ==> (?f'. homeomorphism (s,t) (f,f')) /\
            (?g'. homeomorphism (t,u) (g,g'))`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN
    MAP_EVERY EXISTS_TAC [`g:real^N->real^P`; `u:real^P->bool`] THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
    MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN
    ASM_REWRITE_TAC[homeomorphism; o_THM];
    REWRITE_TAC[homeomorphism; o_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^M` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(f:real^M->real^N) o (h:real^P->real^M)` THEN
    ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;

(* ------------------------------------------------------------------------- *)
(* Preservation of topological properties.                                   *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_COMPACTNESS = prove
 (`!s t. s homeomorphic t ==> (compact s <=> compact t)`,
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);;

let HOMEOMORPHIC_CONNECTEDNESS = prove
 (`!s t. s homeomorphic t ==> (connected s <=> connected t)`,
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);;

let HOMEOMORPHISM_COMPACTNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (compact(IMAGE f k) <=> compact k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACTNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHISM_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (connected(IMAGE f k) <=> connected k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Results on translation, scaling etc.                                      *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_SCALING = prove
 (`!s:real^N->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x) s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  MAP_EVERY EXISTS_TAC [`\x:real^N. c % x`; `\x:real^N. inv(c) % x`] THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN
  SIMP_TAC[VECTOR_MUL_LID; IN_IMAGE; REAL_MUL_LID] THEN MESON_TAC[]);;

let HOMEOMORPHIC_TRANSLATION = prove
 (`!s a:real^N. s homeomorphic (IMAGE (\x. a + x) s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  MAP_EVERY EXISTS_TAC [`\x:real^N. a +  x`; `\x:real^N. --a + x`] THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  SIMP_TAC[VECTOR_ADD_ASSOC; VECTOR_ADD_LINV; VECTOR_ADD_RINV;
           FORALL_IN_IMAGE; VECTOR_ADD_LID] THEN
  REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);;

let HOMEOMORPHIC_AFFINITY = prove
 (`!s a:real^N c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x + a) s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[AFFINITY_SCALING_TRANSLATION] THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `IMAGE (\x:real^N. c % x) s` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_TRANSLATION; IMAGE_o; HOMEOMORPHIC_SCALING]);;

let [HOMEOMORPHIC_BALLS; HOMEOMORPHIC_CBALLS; HOMEOMORPHIC_SPHERES] =
  (CONJUNCTS o prove)
 (`(!a:real^N b:real^N d e.
      &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\
   (!a:real^N b:real^N d e.
      &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\
   (!a:real^N b:real^N d e.
      &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  EXISTS_TAC `\x:real^N. b + (e / d) % (x - a)` THEN
  EXISTS_TAC `\x:real^N. a + (d / e) % (x - b)` THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL;
    CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IN_BALL; IN_CBALL; IN_SPHERE] THEN
  REWRITE_TAC[dist; VECTOR_ARITH `a - (a + b) = --b:real^N`; NORM_NEG] THEN
  REWRITE_TAC[real_div; VECTOR_ARITH
   `a + d % ((b + e % (x - a)) - b) = (&1 - d * e) % a + (d * e) % x`] THEN
  ONCE_REWRITE_TAC[REAL_ARITH
    `(e * d') * (d * e') = (d * d') * (e * e')`] THEN
  ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_SUB_REFL] THEN
  REWRITE_TAC[NORM_MUL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN
  ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH
   `&0 < x ==> (abs x = x)`] THEN
  GEN_REWRITE_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV)
        [GSYM REAL_MUL_RID] THEN
  ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN
  ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID;
    GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_SUB] THEN
  ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_RID]);;

(* ------------------------------------------------------------------------- *)
(* Homeomorphism of one-point compactifications.                             *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS = prove
 (`!f:real^M->real^N g:real^N->real^M s t a b.
        compact s /\ compact t /\ a IN s /\ b IN t /\
        homeomorphism (s DELETE a,t DELETE b) (f,g)
        ==> ?f' g'. homeomorphism (s,t) (f',g') /\
                    f' a = b /\ g' b = a /\
                    (!x. x IN s DELETE a ==> f' x = f x) /\
                    (!y. y IN t DELETE b ==> g' y = g y)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
  ONCE_REWRITE_TAC[TAUT
    `p /\ q /\ r /\ s /\ t <=> p /\ (q /\ s) /\ r /\ t`] THEN
  MATCH_MP_TAC(MESON[]
   `(!f g. P f /\ R f g ==> Q f g) /\
    (?f. P f /\ ?g. R f g)
    ==> ?f g. R f g /\ P f /\ Q f g`) THEN
  CONJ_TAC THENL
   [REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `y:real^N` THEN
    DISCH_TAC THEN
    SUBGOAL_THEN `(f':real^M->real^N) (g(y:real^N)) = y` MP_TAC THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  EXISTS_TAC `\x. if x = a then b else (f:real^M->real^N) x` THEN
  SIMP_TAC[IN_DELETE] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  ASM_CASES_TAC `x:real^M = a` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`b:real^N`; `e:real`] CENTRE_IN_BALL) THEN
    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
    SUBGOAL_THEN
      `closed_in (subtopology euclidean s)
                 { x | x IN (s DELETE a) /\
                       (f:real^M->real^N)(x) IN t DIFF ball(b,e)}`
    MP_TAC THENL
     [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN
       `{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} =
        IMAGE (g:real^N->real^M) (t DIFF ball (b,e))`
      SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
      ASM_SIMP_TAC[COMPACT_DIFF; OPEN_BALL] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
      REWRITE_TAC[closed_in; open_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      DISCH_THEN(MP_TAC o SPEC `a:real^M` o last o CONJUNCTS) THEN
      ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF; IN_DELETE] THEN
      SIMP_TAC[IMP_CONJ; DE_MORGAN_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN
      ASM_REWRITE_TAC[DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM SET_TAC[]];
    UNDISCH_TAC `(f:real^M->real^N) continuous_on (s DELETE a)` THEN
    REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN
    REWRITE_TAC[continuous_within] THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
    ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `min d (dist(a:real^M,x))` THEN
    ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ] THEN
    ASM_MESON_TAC[REAL_LT_REFL]]);;

let HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS = prove
 (`!s:real^M->bool t:real^N->bool a b.
        compact s /\ compact t /\ a IN s /\ b IN t /\
        (s DELETE a) homeomorphic (t DELETE b)
        ==> s homeomorphic t`,
  REWRITE_TAC[homeomorphic] THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
    (REWRITE_RULE[CONJ_ASSOC] HOMEOMORPHISM_ONE_POINT_COMPACTIFICATIONS))) THEN
  ASM_MESON_TAC[]);;

let BOUNDED_IMAGE_IN_COMPACTIFICATION = prove
 (`!f:real^M->real^N g u s t c.
        homeomorphism (u,s DIFF t) (f,g) /\
        compact s /\ closed u /\ c SUBSET u
        ==> (bounded c <=> closure(IMAGE f c) INTER t = {})`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN
  SUBGOAL_THEN `closure(c:real^M->bool) SUBSET u` ASSUME_TAC THENL
   [ASM_SIMP_TAC[CLOSURE_MINIMAL]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o SPEC `closure c:real^M->bool` o
        MATCH_MP(REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_COMPACTNESS)) THEN
  ASM_SIMP_TAC[CLOSURE_MINIMAL] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN EQ_TAC THENL
   [DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
    REWRITE_TAC[GSYM CLOSURE_EQ] THEN MATCH_MP_TAC(SET_RULE
     `closure(IMAGE f c) SUBSET closure(IMAGE f (closure c)) /\
      IMAGE f (closure c) SUBSET s DIFF t
      ==> closure (IMAGE f (closure c)) = IMAGE f (closure c)
          ==> closure (IMAGE f c) INTER t = {}`) THEN
    SIMP_TAC[IMAGE_SUBSET; CLOSURE_SUBSET; SUBSET_CLOSURE] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[];
    FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool` o
        MATCH_MP(REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE)) THEN
    ASM_SIMP_TAC[CLOSURE_MINIMAL; SET_RULE `c SUBSET u ==> u INTER c = c`] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    ASM_SIMP_TAC[COMPACT_INTER_CLOSED; CLOSED_CLOSURE; SET_RULE
    `k INTER t = {} ==> (s DIFF t) INTER k = s INTER k`]]);;

(* ------------------------------------------------------------------------- *)
(* Homeomorphisms between open intervals in real^1 and then in real^N.       *)
(* Could prove similar things for closed intervals, but they drop out of     *)
(* later stuff in "convex.ml" even more easily.                              *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_OPEN_INTERVALS_1 = prove
 (`!a b c d.
        drop a < drop b /\ drop c < drop d
        ==> interval(a,b) homeomorphic interval(c,d)`,
  SUBGOAL_THEN
   `!a b. drop a < drop b
          ==> interval(vec 0:real^1,vec 1) homeomorphic interval(a,b)`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
    EXISTS_TAC `(\x. a + drop x % (b - a)):real^1->real^1` THEN
    EXISTS_TAC `(\x. inv(drop b - drop a) % (x - a)):real^1->real^1` THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN
    REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; DROP_SUB] THEN
    REWRITE_TAC[REAL_ARITH `inv b * a:real = a / b`] THEN
    ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT;
       REAL_LT_ADDR; REAL_EQ_LDIV_EQ; REAL_DIV_RMUL; REAL_LT_IMP_NZ;
       REAL_LT_MUL; REAL_MUL_LZERO; REAL_ADD_SUB; REAL_LT_RMUL_EQ;
       REAL_ARITH `a + x < b <=> x < &1 * (b - a)`] THEN
    REPEAT CONJ_TAC THENL
     [REAL_ARITH_TAC;
      MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
      REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID];
      MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]];
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `d:real^1`]) THEN
    ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
    GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN
    REWRITE_TAC[HOMEOMORPHIC_TRANS]]);;

let HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1 = prove
 (`!a b. drop a < drop b ==> interval(a,b) homeomorphic (:real^1)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(SPECL [`a:real^1`; `b:real^1`; `--vec 1:real^1`; `vec 1:real^1`]
        HOMEOMORPHIC_OPEN_INTERVALS_1) THEN
  ASM_REWRITE_TAC[DROP_VEC; DROP_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_UNIV] THEN
  EXISTS_TAC `\x:real^1. inv(&1 - norm x) % x` THEN
  EXISTS_TAC `\y. if &0 <= drop y then inv(&1 + drop y) % y
                  else inv(&1 - drop y) % y` THEN
  REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
   [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN
    REWRITE_TAC[DROP_NEG; DROP_VEC; DROP_CMUL; NORM_REAL; GSYM drop] THEN
    SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LE_MUL_EQ; REAL_ARITH
     `--a < x /\ x < a ==> &0 < a - abs x`] THEN
    SIMP_TAC[real_abs; VECTOR_MUL_ASSOC] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN
    REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD;
    X_GEN_TAC `y:real^1` THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; REAL_BOUNDS_LT] THEN
    REWRITE_TAC[DROP_CMUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
    REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN
    ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < abs(&1 + x)`;
                 REAL_ARITH `~(&0 <= x) ==> &0 < abs(&1 - x)`] THEN
    (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
    REWRITE_TAC[NORM_REAL; VECTOR_MUL_ASSOC] THEN
    REWRITE_TAC[GSYM drop; DROP_CMUL; REAL_ABS_MUL] THEN
    ASM_REWRITE_TAC[real_abs; REAL_LE_INV_EQ] THEN
    ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 <= &1 + x`;
                 REAL_ARITH `~(&0 <= x) ==> &0 <= &1 - x`] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN
    REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD;
    MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
    X_GEN_TAC `x:real^1` THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC] THEN
    DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
    REWRITE_TAC[CONTINUOUS_AT_ID] THEN
    ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
    REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_SUB; LIFT_DROP] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_SUB THEN
      SIMP_TAC[CONTINUOUS_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM];
      REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC];
    SUBGOAL_THEN `(:real^1) = {x | x$1 >= &0} UNION {x | x$1 <= &0}`
    SUBST1_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN
      REAL_ARITH_TAC;
      MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
      REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE;
                  IN_ELIM_THM] THEN
      REWRITE_TAC[GSYM drop; REAL_NOT_LE; real_ge; REAL_LET_ANTISYM] THEN
      SIMP_TAC[REAL_LE_ANTISYM; REAL_SUB_RZERO; REAL_ADD_RID] THEN
      CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
      X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN
      DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
      REWRITE_TAC[CONTINUOUS_AT_ID] THEN
      ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
      REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_ADD; LIFT_SUB; LIFT_DROP] THEN
      ASM_SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_SUB;
                   CONTINUOUS_CONST] THEN
      ASM_REAL_ARITH_TAC]]);;

let HOMEOMORPHIC_OPEN_INTERVALS = prove
 (`!a b:real^N c d:real^N.
        (interval(a,b) = {} <=> interval(c,d) = {})
        ==> interval(a,b) homeomorphic interval(c,d)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(c:real^N,d) = {}` THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN
  SUBGOAL_THEN
   `!i. 1 <= i /\ i <= dimindex(:N)
        ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic
            interval(lift((c:real^N)$i),lift((d:real^N)$i))`
  MP_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
    ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVALS_1; LIFT_DROP];
    ALL_TAC] THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] 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 [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN
  DISCH_TAC THEN
  EXISTS_TAC
   `(\x. lambda i.
       drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
  EXISTS_TAC
   `(\x. lambda i.
       drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
  ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP] THEN
  ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
  SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN
  MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL
   [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`;
    EXISTS_TAC `interval(lift((c:real^N)$i),lift((d:real^N)$i))`] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
  ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);;

let HOMEOMORPHIC_OPEN_INTERVAL_UNIV = prove
 (`!a b:real^N.
        ~(interval(a,b) = {})
        ==> interval(a,b) homeomorphic (:real^N)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!i. 1 <= i /\ i <= dimindex(:N)
        ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic
            (:real^1)`
  MP_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
    ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; LIFT_DROP];
    ALL_TAC] THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN
  GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN
  DISCH_TAC THEN
  EXISTS_TAC
   `(\x. lambda i.
       drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
  EXISTS_TAC
   `(\x. lambda i.
       drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
  ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP; IN_UNIV] THEN
  ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
  SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN
  MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL
   [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`;
    EXISTS_TAC `(:real^1)`] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; IN_UNIV] THEN
  ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);;

let HOMEOMORPHIC_BALL_UNIV = prove
 (`!a:real^N r. &0 < r ==> ball(a,r) homeomorphic (:real^N)`,
  REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `?y:real^N. r = norm(y)` (CHOOSE_THEN SUBST_ALL_TAC) THENL
   [ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_LT_IMP_LE]; POP_ASSUM MP_TAC] THEN
  REWRITE_TAC[NORM_POS_LT] THEN GEOM_NORMALIZE_TAC `y:real^N` THEN
  SIMP_TAC[] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  EXISTS_TAC `\z:real^N. inv(&1 - norm(z)) % z` THEN
  EXISTS_TAC `\z:real^N. inv(&1 + norm(z)) % z` THEN
  REWRITE_TAC[IN_BALL; IN_UNIV; DIST_0; VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0;
              VECTOR_ARITH `a % x:real^N = x <=> (a - &1) % x = vec 0`] THEN
  REPEAT CONJ_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ1_TAC THEN
    REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN
    REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN
    ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> abs(&1 - x) = &1 - x`] THEN
    POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD;
    X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN
    ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH
     `&0 <= y ==> inv(abs(&1 + y)) * z = z / (&1 + y)`] THEN
    ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_LDIV_EQ; REAL_ARITH
      `&0 <= y ==> &0 < &1 + y`] THEN
    CONJ_TAC THENL [REAL_ARITH_TAC; DISJ1_TAC] THEN
    REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN
    MP_TAC(ISPEC `y:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD;
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_INV THEN
    SIMP_TAC[IN_BALL_0; REAL_SUB_0; REAL_ARITH `x < &1 ==> ~(&1 = x)`] THEN
    REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
    REWRITE_TAC[CONTINUOUS_ON_ID];
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_INV THEN
    SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`] THEN
    REWRITE_TAC[o_DEF; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
    REWRITE_TAC[CONTINUOUS_ON_ID]]);;

(* ------------------------------------------------------------------------- *)
(* Cardinalities of various useful sets.                                     *)
(* ------------------------------------------------------------------------- *)

let CARD_EQ_EUCLIDEAN = prove
 (`(:real^N) =_c (:real)`,
  MATCH_MP_TAC CARD_EQ_CART THEN REWRITE_TAC[real_INFINITE]);;

let UNCOUNTABLE_EUCLIDEAN = prove
 (`~COUNTABLE(:real^N)`,
  MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
  REWRITE_TAC[CARD_EQ_EUCLIDEAN]);;

let CARD_EQ_INTERVAL = prove
 (`(!a b:real^N. ~(interval(a,b) = {}) ==> interval[a,b] =_c (:real)) /\
   (!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) =_c (:real))`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    REWRITE_TAC[CARD_EQ_EUCLIDEAN];
    TRANS_TAC CARD_LE_TRANS `interval(a:real^N,b)` THEN
    SIMP_TAC[CARD_LE_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED];
    TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    REWRITE_TAC[CARD_EQ_EUCLIDEAN];
    ALL_TAC] THEN
  TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
  SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE;
           CARD_EQ_EUCLIDEAN] THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
  MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);;

let UNCOUNTABLE_INTERVAL = prove
 (`(!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\
   (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))`,
  SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_INTERVAL]);;

let COUNTABLE_OPEN_INTERVAL = prove
 (`!a b. COUNTABLE(interval(a,b)) <=> interval(a,b) = {}`,
  MESON_TAC[COUNTABLE_EMPTY; UNCOUNTABLE_INTERVAL]);;

let CARD_EQ_OPEN = prove
 (`!s:real^N->bool. open s /\ ~(s = {}) ==> s =_c (:real)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    REWRITE_TAC[CARD_EQ_EUCLIDEAN];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN
    DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
    ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN
    ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
    TRANS_TAC CARD_LE_TRANS `interval[a:real^N,b]` THEN
    ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_INTERVAL]]);;

let UNCOUNTABLE_OPEN = prove
 (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)`,
  SIMP_TAC[CARD_EQ_OPEN; CARD_EQ_REAL_IMP_UNCOUNTABLE]);;

let CARD_EQ_BALL = prove
 (`!a:real^N r. &0 < r ==> ball(a,r) =_c (:real)`,
  SIMP_TAC[CARD_EQ_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT]);;

let CARD_EQ_CBALL = prove
 (`!a:real^N r. &0 < r ==> cball(a,r) =_c (:real)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    REWRITE_TAC[CARD_EQ_EUCLIDEAN];
    TRANS_TAC CARD_LE_TRANS `ball(a:real^N,r)` THEN
    SIMP_TAC[CARD_LE_SUBSET; BALL_SUBSET_CBALL] THEN
    MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_BALL]]);;

let FINITE_IMP_NOT_OPEN = prove
 (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ~(open s)`,
  MESON_TAC[UNCOUNTABLE_OPEN; FINITE_IMP_COUNTABLE]);;

let OPEN_IMP_INFINITE = prove
 (`!s. open s ==> s = {} \/ INFINITE s`,
  MESON_TAC[FINITE_IMP_NOT_OPEN; INFINITE]);;

let EMPTY_INTERIOR_FINITE = prove
 (`!s:real^N->bool. FINITE s ==> interior s = {}`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_INTERIOR) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN) THEN
  MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
  ASM_REWRITE_TAC[INTERIOR_SUBSET]);;

let FINITE_CBALL = prove
 (`!a:real^N r. FINITE(cball(a,r)) <=> r <= &0`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[CBALL_EMPTY; REAL_LT_IMP_LE; FINITE_EMPTY] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_REWRITE_TAC[CBALL_TRIVIAL; FINITE_SING; REAL_LE_REFL] THEN
  EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EMPTY_INTERIOR_FINITE) THEN
  REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);;

let FINITE_BALL = prove
 (`!a:real^N r. FINITE(ball(a,r)) <=> r <= &0`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `r <= &0` THEN
  ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; FINITE_EMPTY] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        FINITE_IMP_NOT_OPEN)) THEN
  REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);;

let CARD_EQ_CONNECTED = prove
 (`!s a b:real^N.
        connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
  GEOM_ORIGIN_TAC `b:real^N` THEN GEOM_NORMALIZE_TAC `a:real^N` THEN
  REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE];
    TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
     [MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
      SIMP_TAC[UNIT_INTERVAL_NONEMPTY; CARD_EQ_INTERVAL];
      REWRITE_TAC[LE_C] THEN EXISTS_TAC `\x:real^N. lift(a dot x)` THEN
      SIMP_TAC[FORALL_LIFT; LIFT_EQ; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
      X_GEN_TAC `t:real` THEN STRIP_TAC THEN
      MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN
      MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real^N`] THEN
      ASM_REWRITE_TAC[DOT_RZERO]]]);;

let UNCOUNTABLE_CONNECTED = prove
 (`!s a b:real^N.
        connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
  MATCH_MP_TAC CARD_EQ_CONNECTED THEN
  ASM_MESON_TAC[]);;

let CARD_LT_IMP_DISCONNECTED = prove
 (`!s x:real^N. s <_c (:real) /\ x IN s ==> connected_component s x = {x}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
   `s = {a} <=> a IN s /\ !a b. a IN s /\ b IN s /\ ~(a = b) ==> F`] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[IN] THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
  MP_TAC(ISPECL [`connected_component s (x:real^N)`; `a:real^N`; `b:real^N`]
        CARD_EQ_CONNECTED) THEN
  ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
  DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) <_c (:real)` THEN
  REWRITE_TAC[CARD_NOT_LT] THEN
  TRANS_TAC CARD_LE_TRANS `connected_component s (x:real^N)` THEN
  ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE] THEN
  MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);;

let COUNTABLE_IMP_DISCONNECTED = prove
 (`!s x:real^N. COUNTABLE s /\ x IN s ==> connected_component s x = {x}`,
  SIMP_TAC[CARD_LT_IMP_DISCONNECTED; COUNTABLE_IMP_CARD_LT_REAL]);;

let CONNECTED_CARD_EQ_IFF_NONTRIVIAL = prove
 (`!s:real^N->bool.
        connected s ==> (s =_c (:real) <=> ~(?a. s SUBSET {a}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [ALL_TAC; MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN
  REWRITE_TAC[FINITE_SING] THEN
  ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_IMP_COUNTABLE]);;

let CONNECTED_CARD_LT_IFF_TRIVIAL = prove
 (`!s:real^N->bool. connected s ==> (s <_c (:real) <=> ?a. s SUBSET {a})`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_CARD_EQ_IFF_NONTRIVIAL) THEN
  MATCH_MP_TAC(TAUT `(~p <=> q) ==> (p <=> ~r) ==> (q <=> r)`) THEN
  REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_NOT_LE; DE_MORGAN_THM] THEN
  MATCH_MP_TAC(TAUT `~p ==> (p \/ q <=> q)`) THEN REWRITE_TAC[CARD_NOT_LT] THEN
  TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
  REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
  REWRITE_TAC[CARD_EQ_EUCLIDEAN]);;

let SMALL_IMP_TOTALLY_DISCONNECTED = prove
 (`!s:real^N->bool. s <_c (:real) ==> components s = IMAGE (\x. {x}) s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[components; SIMPLE_IMAGE] THEN
  MATCH_MP_TAC IMAGE_EQ THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC(SET_RULE `s x /\ (?a. s SUBSET {a}) ==> s = {x}`) THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
  SIMP_TAC[GSYM CONNECTED_CARD_LT_IFF_TRIVIAL;
           CONNECTED_CONNECTED_COMPONENT] THEN
  TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);;

let FINITE_IMP_TOTALLY_DISCONNECTED = prove
 (`!s:real^N->bool. FINITE s ==> components s = IMAGE (\x. {x}) s`,
  SIMP_TAC[SMALL_IMP_TOTALLY_DISCONNECTED; FINITE_IMP_COUNTABLE;
           COUNTABLE_IMP_CARD_LT_REAL]);;

(* ------------------------------------------------------------------------- *)
(* "Iff" forms of constancy of function from connected set into a set that   *)
(* is smaller than R, or countable, or finite, or disconnected, or discrete. *)
(* ------------------------------------------------------------------------- *)

let [CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ;
     CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ;
     CONTINUOUS_FINITE_RANGE_CONSTANT_EQ] = (CONJUNCTS o prove)
  (`(!s. connected s <=>
         !f:real^M->real^N t.
            f continuous_on s /\ IMAGE f s SUBSET t /\
            (!y. y IN t ==> connected_component t y = {y})
            ==> ?a. !x. x IN s ==> f x = a) /\
    (!s. connected s <=>
         !f:real^M->real^N.
            f continuous_on s /\
            (!x. x IN s
                 ==> ?e. &0 < e /\
                         !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x))
            ==> ?a. !x. x IN s ==> f x = a) /\
    (!s. connected s <=>
         !f:real^M->real^N.
            f continuous_on s /\ FINITE(IMAGE f s)
            ==> ?a. !x. x IN s ==> f x = a)`,
  REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^M->bool` THEN
  MATCH_MP_TAC(TAUT
   `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s)
    ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN
  REPEAT CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
    ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
    FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^M` o
        GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    EXISTS_TAC `(f:real^M->real^N) x` THEN
    MATCH_MP_TAC(SET_RULE
     `IMAGE f s SUBSET {a} ==> !y. y IN s ==> f y = a`) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN ASM SET_TAC[];
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
    ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_REFL] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    MATCH_MP_TAC(SET_RULE
     `(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> f y = a) /\
      connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\
      connected_component (IMAGE f s) a a
      ==> connected_component (IMAGE f s) a = {a}`) THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_SIMP_TAC[FUN_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
    MP_TAC(ISPEC `connected_component (IMAGE (f:real^M->real^N) s) (f x)`
        CONNECTED_CLOSED) THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
     [`cball((f:real^M->real^N) x,e / &2)`;
      `(:real^N) DIFF ball((f:real^M->real^N) x,e)`] THEN
    REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; CLOSED_CBALL] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL
     [REWRITE_TAC[SUBSET; IN_CBALL; IN_UNION; IN_DIFF; IN_BALL; IN_UNIV] THEN
      MATCH_MP_TAC(MESON[SUBSET; CONNECTED_COMPONENT_SUBSET]
       `(!x. x IN s ==> P x)
        ==> (!x. x IN connected_component s y ==> P x)`) THEN
      REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN
      DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN
      ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH;
      MATCH_MP_TAC(SET_RULE
       `(!x. x IN s /\ x IN t ==> F) ==> s INTER t INTER u = {}`) THEN
      REWRITE_TAC[IN_BALL; IN_CBALL; IN_DIFF; IN_UNIV] THEN
      UNDISCH_TAC `&0 < e` THEN CONV_TAC NORM_ARITH;
      EXISTS_TAC `(f:real^M->real^N) x` THEN
      ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_HALF; REAL_LT_IMP_LE; IN_INTER] THEN
      REWRITE_TAC[IN] THEN
      ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL_EQ; FUN_IN_IMAGE];
      EXISTS_TAC `(f:real^M->real^N) y` THEN
      ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN
      ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist]];
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN
    DISCH_THEN(fun th -> STRIP_TAC THEN MATCH_MP_TAC th) THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    ASM_CASES_TAC `IMAGE (f:real^M->real^N) s DELETE (f x) = {}` THENL
     [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    EXISTS_TAC
     `inf{norm(z - f x) |z| z IN IMAGE (f:real^M->real^N) s DELETE (f x)}` THEN
    REWRITE_TAC[SIMPLE_IMAGE] THEN
    ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_DELETE;
                 FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
    REWRITE_TAC[IN_DELETE; NORM_POS_LT; VECTOR_SUB_EQ; IN_IMAGE] THEN
    MESON_TAC[REAL_LE_REFL];
    REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN
    STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC
     `(\x. if x IN t then vec 0 else basis 1):real^M->real^N`) THEN
    REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
     [EXPAND_TAC "s" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[];
      MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^N,basis 1}` THEN
      REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[];
      SUBGOAL_THEN `?a b:real^M. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)`
      STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN MP_TAC)] THEN
      DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^M` th) THEN
                           MP_TAC(SPEC `b:real^M` th)) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
      CONV_TAC(RAND_CONV SYM_CONV) THEN
      SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_LE_REFL]]]);;

let CONTINUOUS_DISCONNECTED_RANGE_CONSTANT = prove
 (`!f:real^M->real^N s.
        connected s /\
        f continuous_on s /\ IMAGE f s SUBSET t /\
        (!y. y IN t ==> connected_component t y = {y})
        ==> ?a. !x. x IN s ==> f x = a`,
  MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]);;

let CONTINUOUS_DISCRETE_RANGE_CONSTANT = prove
 (`!f:real^M->real^N s.
        connected s /\
        f continuous_on s /\
        (!x. x IN s
             ==> ?e. &0 < e /\
                     !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x))
        ==> ?a. !x. x IN s ==> f x = a`,
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
  REWRITE_TAC[IMP_IMP; GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]);;

let CONTINUOUS_FINITE_RANGE_CONSTANT = prove
 (`!f:real^M->real^N s.
        connected s /\
        f continuous_on s /\
        FINITE(IMAGE f s)
        ==> ?a. !x. x IN s ==> f x = a`,
  MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]);;

let CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ = prove
 (`!s. connected s <=>
         !f:real^M->real^N.
            f continuous_on s /\ COUNTABLE(IMAGE f s)
            ==> ?a. !x. x IN s ==> f x = a`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ];
    REWRITE_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
  ASM_SIMP_TAC[COUNTABLE_IMP_DISCONNECTED; SUBSET_REFL]);;

let CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ = prove
 (`!s. connected s <=>
         !f:real^M->real^N.
            f continuous_on s /\ (IMAGE f s) <_c (:real)
            ==> ?a. !x. x IN s ==> f x = a`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ];
    REWRITE_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
  ASM_SIMP_TAC[CARD_LT_IMP_DISCONNECTED; SUBSET_REFL]);;

let CONTINUOUS_COUNTABLE_RANGE_CONSTANT = prove
 (`!f:real^M->real^N s.
        connected s /\ f continuous_on s /\ COUNTABLE(IMAGE f s)
        ==> ?a. !x. x IN s ==> f x = a`,
  MESON_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]);;

let CONTINUOUS_CARD_LT_RANGE_CONSTANT = prove
 (`!f:real^M->real^N s.
        connected s /\ f continuous_on s /\ (IMAGE f s) <_c (:real)
        ==> ?a. !x. x IN s ==> f x = a`,
  MESON_TAC[CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ]);;

(* ------------------------------------------------------------------------- *)
(* Homeomorphism of hyperplanes.                                             *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_HYPERPLANES = prove
 (`!a:real^N b c:real^N d.
        ~(a = vec 0) /\ ~(c = vec 0)
        ==> {x | a dot x = b} homeomorphic {x | c dot x = d}`,
  let lemma = prove
   (`~(a = vec 0)
     ==> {x:real^N | a dot x = b} homeomorphic {x:real^N | x$1 = &0}`,
    REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. a dot c = b`
    STRIP_ASSUME_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
      REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN
      DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `b / (a:real^N)$k % basis k:real^N` THEN
      ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; REAL_DIV_RMUL];
      FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
      ABBREV_TAC `p = {x:real^N | x$1 = &0}` THEN
      GEOM_ORIGIN_TAC `c:real^N` THEN
      REWRITE_TAC[VECTOR_ADD_RID; DOT_RADD; DOT_RZERO; REAL_EQ_ADD_LCANCEL_0;
                  REAL_ADD_RID] THEN
      REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN
      GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN
      SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_ENTIRE] THEN
      SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
      EXPAND_TAC "p" THEN REWRITE_TAC[HOMEOMORPHIC_REFL]]) in
  REPEAT STRIP_TAC THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0}` THEN
  ASM_SIMP_TAC[lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  ASM_SIMP_TAC[lemma]);;

let HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE = prove
 (`!a:real^N b k c.
        ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N)
        ==> {x | a dot x = b} homeomorphic {x:real^N | x$k = c}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `{x:real^N | x$k = c} = {x | basis k dot x = c}` SUBST1_TAC
  THENL [ASM_SIMP_TAC[DOT_BASIS]; MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN
  ASM_SIMP_TAC[BASIS_NONZERO]);;

let HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE = prove
 (`!a:real^N b k c.
        ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N)
        ==> {x:real^N | x$k = c} homeomorphic {x | a dot x = b}`,
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]);;

let HOMEOMORPHIC_HYPERPLANE_UNIV = prove
 (`!a b. ~(a = vec 0) /\ dimindex(:N) = dimindex(:M) + 1
         ==> {x:real^N | a dot x = b} homeomorphic (:real^M)`,
  REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS
   `{x:real^N | basis(dimindex(:N)) dot x = &0}` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANES; BASIS_NONZERO;
               LE_REFL; DIMINDEX_GE_1] THEN
  REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
  EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN
  EXISTS_TAC `(\x. lambda i. if i <= dimindex(:M) then x$i else &0)
              :real^M->real^N` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
    SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
             VECTOR_MUL_COMPONENT];
    REWRITE_TAC[SUBSET_UNIV];
    MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
    SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
             VECTOR_MUL_COMPONENT] THEN
    REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    REAL_ARITH_TAC;
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
    ASM_SIMP_TAC[DOT_BASIS; LAMBDA_BETA; LE_REFL; ARITH_RULE `1 <= n + 1`;
                 ARITH_RULE `~(m + 1 <= m)`];
    ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; LE_REFL; CART_EQ;
                 ARITH_RULE `1 <= n + 1`] THEN
    GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN
    ASM_CASES_TAC `i = dimindex(:M) + 1` THEN ASM_REWRITE_TAC[COND_ID] THEN
    COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC;
    ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; IN_UNIV; LE_REFL;
                 ARITH_RULE `i <= n ==> i <= n + 1`]]);;

(* ------------------------------------------------------------------------- *)
(* "Isometry" (up to constant bounds) of injective linear map etc.           *)
(* ------------------------------------------------------------------------- *)

let CAUCHY_ISOMETRIC = prove
 (`!f s e x.
        &0 < e /\ subspace s /\
        linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\
        (!n. x(n) IN s) /\ cauchy(f o x)
        ==> cauchy x`,
  REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[CAUCHY; dist; o_THM] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN
  DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC th) THEN
  DISCH_THEN(MP_TAC o SPEC `d * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
  ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_MUL_SYM; REAL_LET_TRANS; SUBSPACE_SUB;
                REAL_LT_LDIV_EQ]);;

let COMPLETE_ISOMETRIC_IMAGE = prove
 (`!f:real^M->real^N s e.
        &0 < e /\ subspace s /\
        linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\
        complete s
        ==> complete(IMAGE f s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[complete; EXISTS_IN_IMAGE] THEN
  STRIP_TAC THEN X_GEN_TAC `g:num->real^N` THEN
  REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` MP_TAC) THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN
  REWRITE_TAC[GSYM o_DEF] THEN
  DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN
  ASM_MESON_TAC[CAUCHY_ISOMETRIC; LINEAR_CONTINUOUS_AT;
                CONTINUOUS_AT_SEQUENTIALLY]);;

let INJECTIVE_IMP_ISOMETRIC = prove
 (`!f:real^M->real^N s.
        closed s /\ subspace s /\
        linear f /\ (!x. x IN s /\ (f x = vec 0) ==> (x = vec 0))
        ==> ?e. &0 < e /\ !x. x IN s ==> norm(f x) >= e * norm(x)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s SUBSET {vec 0 :real^M}` THENL
   [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; real_ge] THEN
    ASM_MESON_TAC[SUBSET; IN_SING; NORM_0; LINEAR_0; REAL_LE_REFL];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`{(f:real^M->real^N) x | x IN s /\ norm(x) = norm(a:real^M)}`;
    `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
    MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
    SUBST1_TAC(SET_RULE
     `{f x | x IN s /\ norm(x) = norm(a:real^M)} =
      IMAGE (f:real^M->real^N) (s INTER {x | norm x = norm a})`) THEN
    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN
    MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN
     `{x:real^M | norm x = norm(a:real^M)} = frontier(cball(vec 0,norm a))`
    SUBST1_TAC THENL
     [ASM_SIMP_TAC[FRONTIER_CBALL; NORM_POS_LT; dist; VECTOR_SUB_LZERO;
                   NORM_NEG; sphere];
      ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL]];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^M` MP_TAC) THEN
  REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG] THEN
  STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN
  EXISTS_TAC `norm((f:real^M->real^N) b) / norm(b)` THEN CONJ_TAC THENL
   [ASM_MESON_TAC[REAL_LT_DIV; NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  ASM_CASES_TAC `x:real^M = vec 0` THENL
   [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN
    REWRITE_TAC[NORM_0; REAL_MUL_RZERO; real_ge; REAL_LE_REFL];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(norm(a:real^M) / norm(x)) % x:real^M`) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_MESON_TAC[subspace];
    ALL_TAC] THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN
  ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; real_ge] THEN
  ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT] THEN
  REWRITE_TAC[real_div; REAL_MUL_AC]);;

let CLOSED_INJECTIVE_IMAGE_SUBSPACE = prove
 (`!f s. subspace s /\
         linear f /\
         (!x. x IN s /\ f(x) = vec 0 ==> x = vec 0) /\
         closed s
         ==> closed(IMAGE f s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN
  MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN
  ASM_REWRITE_TAC[COMPLETE_EQ_CLOSED] THEN
  MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN
  ASM_REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Relating linear images to open/closed/interior/closure.                   *)
(* ------------------------------------------------------------------------- *)

let OPEN_SURJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N.
        linear f /\ (!y. ?x. f x = y)
        ==> !s. open s ==> open(IMAGE f s)`,
  GEN_TAC THEN STRIP_TAC THEN
  REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
  FIRST_ASSUM(MP_TAC o GEN `k:num` o SPEC `basis k:real^N`) THEN
  REWRITE_TAC[SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `bounded(IMAGE (b:num->real^M) (1..dimindex(:N)))` MP_TAC THENL
   [SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN
  REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_NUMSEG] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN
  X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `e / B / &(dimindex(:N))` THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN
  X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
  ABBREV_TAC `u = y - (f:real^M->real^N) x` THEN
  EXISTS_TAC `x + vsum(1..dimindex(:N)) (\i. (u:real^N)$i % b i):real^M` THEN
  ASM_SIMP_TAC[LINEAR_ADD; LINEAR_VSUM; FINITE_NUMSEG; o_DEF;
               LINEAR_CMUL; BASIS_EXPANSION] THEN
  CONJ_TAC THENL [EXPAND_TAC "u" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  REWRITE_TAC[NORM_ARITH `dist(x + y,x) = norm y`] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `(dist(y,(f:real^M->real^N) x) * &(dimindex(:N))) * B` THEN
  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN
  MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
  ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN
  GEN_REWRITE_TAC(RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
  MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
  X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; dist] THEN
  MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN
  ASM_SIMP_TAC[COMPONENT_LE_NORM]);;

let OPEN_BIJECTIVE_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
        ==> (open(IMAGE f s) <=> open s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC; ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN
  SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);;

add_linear_invariants [OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];;

let OPEN_INVERTIBLE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ invertible(matrix f) /\ open s
        ==> open(IMAGE f s)`,
  SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; MATRIX_INVERTIBLE] THEN
  REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN
  MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN ASM_MESON_TAC[]);;

let CLOSED_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> !s. closed s ==> closed(IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) (:real^M)` THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) (:real^M)`;
                   `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s)`]
        CONTINUOUS_CLOSED_IN_PREIMAGE) THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL
     [ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_I]; ALL_TAC] THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
    REWRITE_TAC[EXTENSION; o_THM; I_THM] THEN SET_TAC[];
    MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN
    ASM_REWRITE_TAC[IN_UNIV; SUBSPACE_UNIV; CLOSED_UNIV] THEN
    X_GEN_TAC `x:real^M` THEN
    DISCH_THEN(MP_TAC o AP_TERM `g:real^N->real^M`) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM]) THEN
    ASM_MESON_TAC[LINEAR_0]]);;

let CLOSED_INJECTIVE_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (closed(IMAGE f s) <=> closed s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC; ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN
  SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);;

add_linear_invariants [CLOSED_INJECTIVE_LINEAR_IMAGE_EQ];;

let CLOSURE_LINEAR_IMAGE_SUBSET = prove
 (`!f:real^M->real^N s.
        linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN
  ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; LINEAR_CONTINUOUS_ON]);;

let CLOSURE_INJECTIVE_LINEAR_IMAGE  = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> closure(IMAGE f s) = IMAGE f (closure s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN
  MATCH_MP_TAC CLOSURE_MINIMAL THEN
  SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
  ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE; CLOSED_CLOSURE]);;

add_linear_invariants [CLOSURE_INJECTIVE_LINEAR_IMAGE];;

let CLOSURE_BOUNDED_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ bounded s
        ==> closure(IMAGE f s) = IMAGE f (closure s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN
  MATCH_MP_TAC CLOSURE_MINIMAL THEN
  SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
  MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
  MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE]);;

let LINEAR_INTERIOR_IMAGE_SUBSET = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
       ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`,
  MESON_TAC[INTERIOR_IMAGE_SUBSET; LINEAR_CONTINUOUS_AT]);;

let LINEAR_IMAGE_SUBSET_INTERIOR = prove
 (`!f:real^M->real^N s.
        linear f /\ (!y. ?x. f x = y)
        ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN
  ASM_SIMP_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE; OPEN_INTERIOR;
               IMAGE_SUBSET; INTERIOR_SUBSET]);;

let INTERIOR_BIJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
        ==> interior(IMAGE f s) = IMAGE f (interior s)`,
  REWRITE_TAC[interior] THEN GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [INTERIOR_BIJECTIVE_LINEAR_IMAGE];;

let FRONTIER_BIJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
        ==> frontier(IMAGE f s) = IMAGE f (frontier s)`,
  REWRITE_TAC[frontier] THEN GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [FRONTIER_BIJECTIVE_LINEAR_IMAGE];;

(* ------------------------------------------------------------------------- *)
(* Corollaries, reformulations and special cases for M = N.                  *)
(* ------------------------------------------------------------------------- *)

let IN_INTERIOR_LINEAR_IMAGE = prove
 (`!f:real^M->real^N g s x.
        linear f /\ linear g /\ (f o g = I) /\ x IN interior s
        ==> (f x) IN interior (IMAGE f s)`,
  REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
    LINEAR_IMAGE_SUBSET_INTERIOR) THEN
  ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  ASM_MESON_TAC[]);;

let LINEAR_OPEN_MAPPING = prove
 (`!f:real^M->real^N g.
        linear f /\ linear g /\ (f o g = I)
        ==> !s. open s ==> open(IMAGE f s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_TAC THEN
  MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN
  ASM_MESON_TAC[]);;

let INTERIOR_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> interior(IMAGE f s) = IMAGE f (interior s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN
  ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);;

let INTERIOR_SURJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!y. ?x. f x = y)
        ==> interior(IMAGE f s) = IMAGE f (interior s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN
  ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);;

let CLOSURE_SURJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!y. ?x. f x = y)
        ==> closure(IMAGE f s) = IMAGE f (closure s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
  ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);;

let FRONTIER_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> frontier(IMAGE f s) = IMAGE f (frontier s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN
  ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);;

let FRONTIER_SURJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^N->real^N.
        linear f /\ (!y. ?x. f x = y)
        ==> frontier(IMAGE f s) = IMAGE f (frontier s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN
  ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);;

let COMPLETE_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> !s. complete s ==> complete(IMAGE f s)`,
  REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE]);;

let COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (complete(IMAGE f s) <=> complete s)`,
  REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]);;

add_linear_invariants [COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ];;

let LIMPT_INJECTIVE_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)`,
  REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
  DISCH_TAC THENL
   [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS);
    MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS)] THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `e * B:real`);
    FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`)] THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; dist; GSYM LINEAR_SUB] THEN
  MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
  REPEAT(MATCH_MP_TAC MONO_AND THEN
         CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
  ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN
  MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);;

add_linear_invariants [LIMPT_INJECTIVE_LINEAR_IMAGE_EQ];;

let LIMPT_TRANSLATION_EQ = prove
 (`!a s x. (a + x) limit_point_of (IMAGE (\y. a + y) s) <=> x limit_point_of s`,
  REWRITE_TAC[limit_point_of] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [LIMPT_TRANSLATION_EQ];;

let OPEN_OPEN_LEFT_PROJECTION = prove
 (`!s t:real^(M,N)finite_sum->bool.
        open s /\ open t ==> open {x | x IN s /\ ?y. pastecart x y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ ?y. (pastecart x y:real^(M,N)finite_sum) IN t} =
    s INTER IMAGE fstcart t`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN
    MESON_TAC[FSTCART_PASTECART; PASTECART_FST_SND];
    MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
      OPEN_SURJECTIVE_LINEAR_IMAGE) THEN
    ASM_REWRITE_TAC[LINEAR_FSTCART] THEN MESON_TAC[FSTCART_PASTECART]]);;

let OPEN_OPEN_RIGHT_PROJECTION = prove
 (`!s t:real^(M,N)finite_sum->bool.
        open s /\ open t ==> open {y | y IN s /\ ?x. pastecart x y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{y | y IN s /\ ?x. (pastecart x y:real^(M,N)finite_sum) IN t} =
    s INTER IMAGE sndcart t`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN
    MESON_TAC[SNDCART_PASTECART; PASTECART_FST_SND];
    MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
      OPEN_SURJECTIVE_LINEAR_IMAGE) THEN
    ASM_REWRITE_TAC[LINEAR_SNDCART] THEN MESON_TAC[SNDCART_PASTECART]]);;

let OPEN_MAP_FSTCART = prove
 (`!s:real^(M,N)finite_sum->bool.
        open s ==> open(IMAGE fstcart s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(:real^M)`; `s:real^(M,N)finite_sum->bool`]
        OPEN_OPEN_LEFT_PROJECTION) THEN
  ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN
  REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART] THEN MESON_TAC[]);;

let OPEN_MAP_SNDCART = prove
 (`!s:real^(M,N)finite_sum->bool.
        open s ==> open(IMAGE sndcart s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(:real^N)`; `s:real^(M,N)finite_sum->bool`]
        OPEN_OPEN_RIGHT_PROJECTION) THEN
  ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN
  REWRITE_TAC[EXISTS_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Even more special cases.                                                  *)
(* ------------------------------------------------------------------------- *)

let INTERIOR_SCALING = prove
 (`!s:real^N->bool c.
        interior (IMAGE (\x. c % x) s) =
        if c = &0 then {} else IMAGE (\x. c % x) (interior s)`,
  REPEAT GEN_TAC THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THENL
   [MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN
    EXISTS_TAC `interior {vec 0:real^N}` THEN CONJ_TAC THENL
     [MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]; REWRITE_TAC[INTERIOR_SING]];
    MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN
    ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; LINEAR_SCALING]]);;

let INTERIOR_AFFINITY = prove
 (`!s m c:real^N.
        interior(IMAGE (\x. m % x + c) s) =
        if m = &0 then {} else IMAGE (\x. m % x + c) (interior s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; IMAGE_o] THEN
  REWRITE_TAC[INTERIOR_TRANSLATION; INTERIOR_SCALING] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES]);;

let CLOSURE_SCALING = prove
 (`!s:real^N->bool c.
        closure(IMAGE (\x. c % x) s) = IMAGE (\x. c % x) (closure s)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[CLOSURE_EMPTY; IMAGE_CLAUSES] THEN
  ASM_CASES_TAC `c = &0` THEN
  ASM_SIMP_TAC[VECTOR_MUL_LZERO; CLOSURE_EQ_EMPTY; CLOSURE_SING;
               IMAGE_CONST] THEN
  MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
  ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; LINEAR_SCALING]);;

let CLOSURE_AFFINITY = prove
 (`!s m c:real^N.
        closure(IMAGE (\x. m % x + c) s) = IMAGE (\x. m % x + c) (closure s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; IMAGE_o] THEN
  REWRITE_TAC[CLOSURE_TRANSLATION; CLOSURE_SCALING] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES]);;

let FRONTIER_SCALING = prove
 (`!s:real^N->bool c.
        frontier (IMAGE (\x. c % x) s) =
        if c = &0 /\ s = (:real^N) then {vec 0}
        else IMAGE (\x. c % x) (frontier s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[frontier; CLOSURE_SCALING; INTERIOR_SCALING] THEN
  ASM_CASES_TAC `c = &0` THEN
  ASM_REWRITE_TAC[VECTOR_MUL_LZERO; IMAGE_CONST] THENL
   [REWRITE_TAC[CLOSURE_EQ_EMPTY; DIFF_EMPTY] THEN
    ASM_REWRITE_TAC[GSYM frontier; FRONTIER_EQ_EMPTY] THEN
    ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[COND_ID] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[CLOSURE_EMPTY; EMPTY_DIFF] THEN
    SET_TAC[];
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC IMAGE_DIFF_INJ THEN
    ASM_SIMP_TAC[VECTOR_MUL_LCANCEL]]);;

let FRONTIER_AFFINITY = prove
 (`!s m c:real^N.
        frontier (IMAGE (\x. m % x + c) s) =
        if m = &0 /\ s = (:real^N) then {c}
        else IMAGE (\x. m % x + c) (frontier s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; FRONTIER_TRANSLATION;
              FRONTIER_SCALING; IMAGE_o] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID]);;

let INTERIOR_NEGATIONS = prove
 (`!s. interior(IMAGE (--) s) = IMAGE (--) (interior s)`,
  GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN
  REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;

let SYMMETRIC_INTERIOR = prove
 (`!s:real^N->bool.
        (!x. x IN s ==> --x IN s)
        ==> !x. x IN interior s ==> (--x) IN interior s`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN
  REWRITE_TAC[GSYM INTERIOR_NEGATIONS] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);;

let CLOSURE_NEGATIONS = prove
 (`!s. closure(IMAGE (--) s) = IMAGE (--) (closure s)`,
  GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
  REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;

let SYMMETRIC_CLOSURE = prove
 (`!s:real^N->bool.
        (!x. x IN s ==> --x IN s)
        ==> !x. x IN closure s ==> (--x) IN closure s`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN
  REWRITE_TAC[GSYM CLOSURE_NEGATIONS] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);;

(* ------------------------------------------------------------------------- *)
(* Some properties of a canonical subspace.                                  *)
(* ------------------------------------------------------------------------- *)

let SUBSPACE_SUBSTANDARD = prove
 (`!d. subspace
         {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`,
  GEN_TAC THEN ASM_CASES_TAC `d <= dimindex(:N)` THENL
   [MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN
    SIMP_TAC[subspace; IN_ELIM_THM; REAL_MUL_RZERO; REAL_ADD_LID;
             VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT];
    ASM_SIMP_TAC[ARITH_RULE `~(d:num <= e) ==> (d < i /\ i <= e <=> F)`] THEN
    REWRITE_TAC[SET_RULE `{x | T} = UNIV`; SUBSPACE_UNIV]]);;

let CLOSED_SUBSTANDARD = prove
 (`!d. closed
        {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`,
  GEN_TAC THEN
  SUBGOAL_THEN
   `{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} =
    INTERS {{x | basis i dot x = &0} | d < i /\ i <= dimindex(:N)}`
  SUBST1_TAC THENL
   [ALL_TAC;
    SIMP_TAC[CLOSED_INTERS; CLOSED_HYPERPLANE; IN_ELIM_THM;
             LEFT_IMP_EXISTS_THM]] THEN
  GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN
  SIMP_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN
  MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN
  SIMP_TAC[DOT_BASIS] THEN MESON_TAC[]);;

let DIM_SUBSTANDARD = prove
 (`!d. d <= dimindex(:N)
       ==> (dim {x:real^N | !i. d < i /\ i <= dimindex(:N)
                                ==> x$i = &0} =
            d)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN
  EXISTS_TAC `IMAGE (basis:num->real^N) (1..d)` THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
    MESON_TAC[BASIS_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`; NOT_LT];
    ALL_TAC;
    MATCH_MP_TAC INDEPENDENT_MONO THEN
    EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
    REWRITE_TAC[INDEPENDENT_STDBASIS]THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
    ASM_MESON_TAC[LE_TRANS];
    MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN
    REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS; BASIS_INJ]] THEN
  POP_ASSUM MP_TAC THEN SPEC_TAC(`d:num`,`d:num`) THEN
  INDUCT_TAC THENL
   [REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`; SPAN_STDBASIS] THEN
    SUBGOAL_THEN `IMAGE basis (1 .. 0) :real^N->bool = {}` SUBST1_TAC THENL
     [REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; ARITH]; ALL_TAC] THEN
    DISCH_TAC THEN REWRITE_TAC[SPAN_EMPTY; SUBSET; IN_ELIM_THM; IN_SING] THEN
    SIMP_TAC[CART_EQ; VEC_COMPONENT];
    ALL_TAC] THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
  ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x - (x$(SUC d)) % basis(SUC d) :real^N`) THEN
  ANTS_TAC THENL
   [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `d < i ==> 1 <= i`)) THEN
    ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN
    ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN
    ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN
    ASM_MESON_TAC[ARITH_RULE `d < i /\ ~(i = SUC d) ==> SUC d < i`];
    ALL_TAC] THEN
  DISCH_TAC THEN
  SUBST1_TAC(VECTOR_ARITH
   `x = (x - (x$(SUC d)) % basis(SUC d)) +
        x$(SUC d) % basis(SUC d) :real^N`) THEN
  MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SPAN_MONO; SUBSET_IMAGE; SUBSET; SUBSET_NUMSEG; LE_REFL; LE];
    MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN
    REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN
    MESON_TAC[LE_REFL; ARITH_RULE `1 <= SUC d`]]);;

(* ------------------------------------------------------------------------- *)
(* Hence closure and completeness of all subspaces.                          *)
(* ------------------------------------------------------------------------- *)

let CLOSED_SUBSPACE = prove
 (`!s:real^N->bool. subspace s ==> closed s`,
  REPEAT STRIP_TAC THEN ABBREV_TAC `d = dim(s:real^N->bool)` THEN
  MP_TAC(MATCH_MP DIM_SUBSTANDARD
    (ISPEC `s:real^N->bool` DIM_SUBSET_UNIV)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  MP_TAC(ISPECL
   [`{x:real^N | !i. d < i /\ i <= dimindex(:N)
                                ==> x$i = &0}`;
    `s:real^N->bool`] SUBSPACE_ISOMORPHISM) THEN
  ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD] THEN
  DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC(ISPEC `f:real^N->real^N` CLOSED_INJECTIVE_IMAGE_SUBSPACE) THEN
  ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD; CLOSED_SUBSTANDARD] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  ASM_MESON_TAC[VEC_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`]);;

let COMPLETE_SUBSPACE = prove
 (`!s:real^N->bool. subspace s ==> complete s`,
  REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_SUBSPACE]);;

let CLOSED_SPAN = prove
 (`!s. closed(span s)`,
  SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]);;

let CLOSURE_SUBSET_SPAN = prove
 (`!s:real^N->bool. closure s SUBSET span s`,
  GEN_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
  REWRITE_TAC[CLOSED_SPAN; SPAN_INC]);;

let DIM_CLOSURE = prove
 (`!s:real^N->bool. dim(closure s) = dim s`,
  GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL
   [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN]; ALL_TAC] THEN
  MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
  MATCH_MP_TAC CLOSURE_MINIMAL THEN
  SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN; SPAN_INC]);;

let CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s.
      closed s /\ f continuous_on s /\
      (!e. bounded {x | x IN s /\ norm(f x) <= e})
      ==> closed(IMAGE f s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_INTERS_COMPACT] THEN
  REWRITE_TAC[SET_RULE
   `cball(vec 0,e) INTER IMAGE (f:real^M->real^N) s =
    IMAGE f (s INTER {x | x IN s /\ f x IN cball(vec 0,e)})`] THEN
  X_GEN_TAC `e:real` THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN SET_TAC[];
    MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
     [ASM_REWRITE_TAC[IN_CBALL_0];
      ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CBALL]]]);;

let CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE = prove
 (`!f:real^M->real^N s t.
        closed s /\ s SUBSET t /\ subspace t /\
        linear f /\
        (!x. x IN t /\ f(x) = vec 0 ==> x = vec 0)
        ==> closed(IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`]
    INJECTIVE_IMP_ISOMETRIC) THEN
  ASM_SIMP_TAC[CLOSED_SUBSPACE; real_ge] THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  X_GEN_TAC `e:real` THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
  EXISTS_TAC `cball(vec 0:real^M,e / B)` THEN
  REWRITE_TAC[BOUNDED_CBALL] THEN
  ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0; REAL_LE_RDIV_EQ] THEN
  ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);;

let BASIS_COORDINATES_LIPSCHITZ = prove
 (`!b:real^N->bool.
        independent b
        ==> ?B. &0 < B /\
                !c v. v IN b
                      ==> abs(c v) <= B * norm(vsum b (\v. c(v) % v))`,
  X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP INDEPENDENT_BOUND) THEN
  FIRST_ASSUM(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC o
        GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN
  ABBREV_TAC `n = CARD(k:real^N->bool)` THEN
  MP_TAC(ISPECL
   [`(\x. vsum(1..n) (\i. x$i % b i)):real^N->real^N`;
    `span(IMAGE basis (1..n)):real^N->bool`]
        INJECTIVE_IMP_ISOMETRIC) THEN
  REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]; ALL_TAC] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN
      REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC LINEAR_VMUL_COMPONENT THEN
      SIMP_TAC[LINEAR_ID] THEN ASM_ARITH_TAC;
      ALL_TAC] THEN
    X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN
    REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
    DISCH_THEN(X_CHOOSE_TAC `c:real^N->num`) THEN
    SUBGOAL_THEN
     `vsum(1..n) (\i. (x:real^N)$i % b i:real^N) = vsum k (\v. x$(c v) % v)`
    SUBST1_TAC THENL
     [MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN
      MAP_EVERY EXISTS_TAC [`b:num->real^N`; `c:real^N->num`] THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN
    DISCH_THEN(MP_TAC o SPEC `\v:real^N. (x:real^N)$(c v)` o CONJUNCT2) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[CART_EQ; FORALL_IN_IMAGE; VEC_COMPONENT] THEN
    ASM_MESON_TAC[IN_NUMSEG];
    ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `inv(B:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
  ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
  MAP_EVERY X_GEN_TAC [`c:real^N->real`; `j:num`] THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN
  W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rand o rand o snd) THEN
  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   `(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`) THEN
  SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA] THEN
  ANTS_TAC THENL [MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN
  MATCH_MP_TAC(REAL_ARITH `x = v /\ u <= y ==> x >= y ==> u <= v`) THEN
  CONJ_TAC THENL
   [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN
    SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL
     [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC)] THEN
    REWRITE_TAC[o_THM];
    GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
    ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN
    MP_TAC(ISPECL
     [`(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`;
      `j:num`] COMPONENT_LE_NORM) THEN
    SUBGOAL_THEN `1 <= j /\ j <= dimindex(:N)` MP_TAC THENL
     [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[]]]);;

let COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ = prove
 (`!s t:real^N->bool.
        subspace s /\ subspace t /\ s INTER t SUBSET {vec 0}
        ==> ?B. &0 < B /\
                !x y. x IN s /\ y IN t ==> norm(x) <= B * norm(x + y)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `t:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN
  MP_TAC(ISPEC `s:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPEC `b UNION c:real^N->bool` BASIS_COORDINATES_LIPSCHITZ) THEN
  ASM_SIMP_TAC[INDEPENDENT_UNION] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(sum (b:real^N->bool) norm + &1) * B` THEN
  ASM_SIMP_TAC[REAL_LT_MUL; REAL_ARITH `&0 <= x ==> &0 < x + &1`;
               SUM_POS_LE; NORM_POS_LE] THEN
  SUBGOAL_THEN `DISJOINT (b:real^N->bool) c` ASSUME_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `s INTER t SUBSET {z}
      ==> b SUBSET s /\ c SUBSET t /\ ~(z IN b) ==> DISJOINT b c`)) THEN
    ASM_MESON_TAC[SPAN_INC; INDEPENDENT_NONZERO];
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  MP_TAC(ISPEC `c:real^N->bool` SPAN_FINITE) THEN
  MP_TAC(ISPEC `b:real^N->bool` SPAN_FINITE) THEN
  ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN
  REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `a:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  X_GEN_TAC `a':real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   `\x. if x IN b then (a:real^N->real) x else a' x`) THEN
  ASM_SIMP_TAC[VSUM_UNION] THEN REWRITE_TAC[FORALL_IN_UNION] THEN
  DISCH_THEN(MP_TAC o CONJUNCT1) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `DISJOINT b c ==> !x. x IN c ==> ~(x IN b)`)) THEN
  SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN
  MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REAL_ARITH
   `&0 <= b * y /\ x <= s * b * y ==> x <= ((s + &1) * b) * y`) THEN
  ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE; GSYM SUM_RMUL] THEN
  MATCH_MP_TAC SUM_LE THEN
  ASM_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] NORM_MUL] THEN
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);;

let BASIS_COORDINATES_CONTINUOUS = prove
 (`!b:real^N->bool e.
        independent b /\ &0 < e
        ==> ?d. &0 < d /\
                !c. norm(vsum b (\v. c(v) % v)) < d
                    ==> !v. v IN b ==> abs(c v) < e`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
  X_GEN_TAC `c:real^N->real` THEN DISCH_TAC THEN
  X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `B * norm(vsum b (\v:real^N. c v % v))` THEN
  ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);;

let COMPLEMENTARY_SUM_HOMEOMORPHIC_PCROSS = prove
 (`!s t:real^N->bool.
        span s INTER span t SUBSET {vec 0}
        ==> {x + y | x IN s /\ y IN t} homeomorphic (s PCROSS t)`,
  REPEAT STRIP_TAC THEN
  ABBREV_TAC `add = \z:real^(N,N)finite_sum. fstcart z + sndcart z` THEN
  SUBGOAL_THEN
   `?g. homeomorphism (span s PCROSS span t,
                       {x + y:real^N | x IN span s /\ y IN span t})
                      (add,g)`
  STRIP_ASSUME_TAC THENL
   [ALL_TAC;
    ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
    EXISTS_TAC `add:real^(N,N)finite_sum->real^N` THEN
    EXISTS_TAC `g:real^N->real^(N,N)finite_sum` THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
    REWRITE_TAC[SUBSET_PCROSS; SPAN_INC] THEN EXPAND_TAC "add" THEN
    REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN
    MP_TAC(ISPEC `s:real^N->bool` SPAN_INC) THEN
    MP_TAC(ISPEC `t:real^N->bool` SPAN_INC) THEN SET_TAC[]] THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
           LINEAR_SNDCART] THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN
  CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM]] THEN
  REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN
  CONJ_TAC THENL
   [ASM_MESON_TAC[INDEPENDENT_SUBSPACES; SUBSPACE_SPAN]; ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhand o rand o rand) PROPER_MAP o snd) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN SET_TAC[];
    MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`)] THEN
  X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
    REWRITE_TAC[BOUNDED_POS] THEN
    DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`span t:real^N->bool`; `span s:real^N->bool`]
      COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ) THEN
    MP_TAC(ISPECL [`span s:real^N->bool`; `span t:real^N->bool`]
      COMPLEMENTARY_SUM_COMPONENTS_LIPSCHITZ) THEN
    ASM_REWRITE_TAC[SUBSPACE_SPAN] THEN
    DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `D:real` THEN STRIP_TAC THEN EXISTS_TAC `B * (C + D):real` THEN
    ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL] THEN
    REWRITE_TAC[FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
    W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
    TRANS_TAC REAL_LE_TRANS `(C + D) * norm(x + y:real^N)` THEN
    ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_ADD] THEN
    REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
    ASM_MESON_TAC[VECTOR_ADD_SYM];
    MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_PCROSS; CLOSED_SPAN] THEN
    SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
           LINEAR_SNDCART]]);;

(* ------------------------------------------------------------------------- *)
(* Affine transformations of intervals.                                      *)
(* ------------------------------------------------------------------------- *)

let AFFINITY_INVERSES = prove
 (`!m c. ~(m = &0)
         ==> (\x. m % x + c) o (\x. inv(m) % x + (--(inv(m) % c))) = I /\
             (\x. inv(m) % x + (--(inv(m) % c))) o (\x. m % x + c) = I`,
  REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
  REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_RNEG] THEN
  SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN
  REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;

let REAL_AFFINITY_LE = prove
 (`!m c x y. &0 < m ==> (m * x + c <= y <=> x <= inv(m) * y + --(c / m))`,
  REWRITE_TAC[REAL_ARITH `m * x + c <= y <=> x * m <= y - c`] THEN
  SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC);;

let REAL_LE_AFFINITY = prove
 (`!m c x y. &0 < m ==> (y <= m * x + c <=> inv(m) * y + --(c / m) <= x)`,
  REWRITE_TAC[REAL_ARITH `y <= m * x + c <=> y - c <= x * m`] THEN
  SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC);;

let REAL_AFFINITY_LT = prove
 (`!m c x y. &0 < m ==> (m * x + c < y <=> x < inv(m) * y + --(c / m))`,
  SIMP_TAC[REAL_LE_AFFINITY; GSYM REAL_NOT_LE]);;

let REAL_LT_AFFINITY = prove
 (`!m c x y. &0 < m ==> (y < m * x + c <=> inv(m) * y + --(c / m) < x)`,
  SIMP_TAC[REAL_AFFINITY_LE; GSYM REAL_NOT_LE]);;

let REAL_AFFINITY_EQ = prove
 (`!m c x y. ~(m = &0) ==> (m * x + c = y <=> x = inv(m) * y + --(c / m))`,
  CONV_TAC REAL_FIELD);;

let REAL_EQ_AFFINITY = prove
 (`!m c x y. ~(m = &0) ==> (y = m * x + c  <=> inv(m) * y + --(c / m) = x)`,
  CONV_TAC REAL_FIELD);;

let VECTOR_AFFINITY_EQ = prove
 (`!m c x y. ~(m = &0)
             ==> (m % x + c = y <=> x = inv(m) % y + --(inv(m) % c))`,
  SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
           real_div; VECTOR_NEG_COMPONENT; REAL_AFFINITY_EQ] THEN
  REWRITE_TAC[REAL_MUL_AC]);;

let VECTOR_EQ_AFFINITY = prove
 (`!m c x y. ~(m = &0)
             ==> (y = m % x + c <=> inv(m) % y + --(inv(m) % c) = x)`,
  SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
           real_div; VECTOR_NEG_COMPONENT; REAL_EQ_AFFINITY] THEN
  REWRITE_TAC[REAL_MUL_AC]);;

let IMAGE_AFFINITY_INTERVAL = prove
 (`!a b:real^N m c.
        IMAGE (\x. m % x + c) (interval[a,b]) =
            if interval[a,b] = {} then {}
            else if &0 <= m then interval[m % a + c,m % b + c]
            else interval[m % b + c,m % a + c]`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN
  ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; COND_ID] THEN
    REWRITE_TAC[INTERVAL_SING] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
   `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN
  ASM_SIMP_TAC[EXTENSION; IN_IMAGE; REAL_ARITH `&0 < --x ==> ~(&0 < x)`] THENL
   [ALL_TAC;
    ONCE_REWRITE_TAC[VECTOR_ARITH `x = m % y + c <=> c = (--m) % y + x`]] THEN
  ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; REAL_LT_IMP_NZ; UNWIND_THM1] THEN
  SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
           VECTOR_NEG_COMPONENT] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_INV_EQ]) THEN
  SIMP_TAC[REAL_AFFINITY_LE; REAL_LE_AFFINITY; real_div] THEN
  DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN
  REWRITE_TAC[REAL_MUL_LNEG; REAL_NEG_NEG] THEN
  ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> (inv m * x) * m = x`] THEN
  GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Some matrix identities are easier to deduce for invertible matrices. We   *)
(* can then extend by continuity, which is why this material needs to be     *)
(* here after basic topological notions have been defined.                   *)
(* ------------------------------------------------------------------------- *)

let LIM_LIFT_DET = prove
 (`!(A:A->real^N^N) (B:real^N^N) net.
        (!i j. 1 <= i /\ i <= dimindex(:N) /\
               1 <= j /\ j <= dimindex(:N)
               ==> ((\x. lift(A x$i$j)) --> lift(B$i$j)) net)
        ==> ((\x. lift(det(A x))) --> lift(det B)) net`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN
  SIMP_TAC[LIFT_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG; o_DEF] THEN
  MATCH_MP_TAC LIM_VSUM THEN
  SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; LIFT_CMUL; IN_ELIM_THM] THEN
  X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN
  MATCH_MP_TAC LIM_CMUL THEN
  MATCH_MP_TAC LIM_LIFT_PRODUCT THEN
  REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
  ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG]);;

let LIM_COFACTOR = prove
 (`!net A:A->real^N^N B.
        (!x. ((\a. A a ** x) --> B ** x) net)
        ==> !x. ((\a. cofactor(A a) ** x) --> cofactor B ** x) net`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
  SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT] THEN
  X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[dot; LIFT_SUM; o_DEF] THEN
  MATCH_MP_TAC LIM_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
  X_GEN_TAC `j:num` THEN STRIP_TAC THEN
  ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN
  REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_VMUL THEN
  REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_LIFT_DET THEN
  MAP_EVERY X_GEN_TAC [`k:num`; `l:num`] THEN STRIP_TAC THEN
  ASM_SIMP_TAC[LAMBDA_BETA] THEN
  ASM_CASES_TAC `k:num = i /\ l:num = j` THEN
  ASM_REWRITE_TAC[LIM_CONST] THEN
  ASM_CASES_TAC `k:num = i \/ l:num = j` THEN
  ASM_REWRITE_TAC[LIM_CONST] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `basis l:real^N`) THEN
  ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column] THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPONENT) THEN
  DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[LAMBDA_BETA]);;

let LIM_MATRIX_TRANSP = prove
 (`!net A:A->real^M^N B.
        (!x. ((\a. transp(A a) ** x) --> transp B ** x) net) <=>
        (!x. ((\a. A a ** x) --> B ** x) net)`,
  REWRITE_TAC[LIM_MATRIX_COMPONENTWISE; TRANSP_COMPONENT] THEN MESON_TAC[]);;

let LIM_MATRIX_INV = prove
 (`!net A:A->real^N^N B.
        (!x. ((\a. A a ** x) --> B ** x) net) /\ ~(det B = &0)
        ==> !x. ((\a. matrix_inv(A a) ** x) --> matrix_inv B ** x) net`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC
   `\a:A. (inv(det(A a:real^N^N)) %% transp(cofactor(A a))) ** (x:real^N)` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [MATCH_MP_TAC LIM_EVENTUALLY THEN
    MATCH_MP_TAC EVENTUALLY_MONO THEN
    EXISTS_TAC `\a:A. ~(det(A a:real^N^N) = &0)` THEN
    SIMP_TAC[MATRIX_INV_COFACTOR; VECTOR_SUB_REFL] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_MATRIX_COMPONENTWISE]) THEN
    DISCH_THEN(MP_TAC o MATCH_MP LIM_LIFT_DET) THEN
    REWRITE_TAC[tendsto] THEN
    DISCH_THEN(MP_TAC o SPEC `abs(det(B:real^N^N))`) THEN
    ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
    REWRITE_TAC[DIST_LIFT] THEN REAL_ARITH_TAC;
    ASM_SIMP_TAC[MATRIX_INV_COFACTOR; MATRIX_VECTOR_LMUL] THEN
    MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
     [MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INV) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_LIFT_DET THEN
      ASM_REWRITE_TAC[GSYM LIM_MATRIX_COMPONENTWISE];
      SPEC_TAC(`x:real^N`,`x:real^N`) THEN
      REWRITE_TAC[LIM_MATRIX_TRANSP] THEN
      MATCH_MP_TAC LIM_COFACTOR THEN ASM_REWRITE_TAC[]]]);;

let CONTINUOUS_LIFT_DET = prove
 (`!(A:A->real^N^N) net.
        (!i j. 1 <= i /\ i <= dimindex(:N) /\
               1 <= j /\ j <= dimindex(:N)
               ==> (\x. lift(A x$i$j)) continuous net)
        ==> (\x. lift(det(A x))) continuous net`,
  REWRITE_TAC[continuous; LIM_LIFT_DET]);;

let CONTINUOUS_ON_LIFT_DET = prove
 (`!A:real^M->real^N^N s.
        (!i j. 1 <= i /\ i <= dimindex(:N) /\
               1 <= j /\ j <= dimindex(:N)
               ==> (\x. lift(A x$i$j)) continuous_on s)
        ==> (\x. lift(det(A x))) continuous_on s`,
  SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_DET]);;

let CONTINUOUS_DET_VECTORIZE = prove
 (`!net A:A->real^N^N.
        (\a. vectorize(A a)) continuous net
        ==> (\a. lift(det(A a))) continuous net`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
  ASM_REWRITE_TAC[GSYM CONTINUOUS_VECTORIZE_COMPONENTWISE]);;

let CONTINUOUS_ON_DET_VECTORIZE = prove
 (`!A:real^M->real^N^N.
        (\a. vectorize(A a)) continuous_on s
        ==> (\a. lift(det(A a))) continuous_on s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN
  ASM_REWRITE_TAC[GSYM CONTINUOUS_ON_VECTORIZE_COMPONENTWISE]);;

let CONTINUOUS_DET_EXPLICIT = prove
 (`!A:real^N^N e.
        &0 < e
        ==> ?d. &0 < d /\
                !A':real^N^N.
                    (!i j. 1 <= i /\ i <= dimindex(:N) /\
                           1 <= j /\ j <= dimindex(:N)
                           ==> abs(A'$i$j - A$i$j) < d)
                    ==> abs(det A' - det A) < e`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN
  PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`;
                   NOT_FORALL_THM; NOT_IMP] THEN
  DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN
  REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
  REWRITE_TAC[SKOLEM_THM; REAL_NOT_LT; FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `L:num->real^N^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`L:num->real^N^N`; `A:real^N^N`; `sequentially`]
    LIM_LIFT_DET) THEN
  REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN
    MATCH_MP_TAC LIM_NULL_COMPARISON THEN
    EXISTS_TAC `\n. inv(&n + &1)` THEN
    ASM_SIMP_TAC[GSYM LIFT_SUB; NORM_LIFT; REAL_LT_IMP_LE] THEN
    REWRITE_TAC[EVENTUALLY_TRUE; SEQ_HARMONIC_OFFSET];
    REWRITE_TAC[LIM_SEQUENTIALLY; NOT_IMP; DIST_LIFT] THEN
    DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[LE_REFL; REAL_NOT_LT]]);;

let NEARBY_INVERTIBLE_MATRIX = prove
 (`!A:real^N^N.
     ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% mat 1)`,
  GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`dimindex(:N)`; `a:num->real`] REAL_POLYFUN_FINITE_ROOTS) THEN
  MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL
   [EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC;
    ALL_TAC] THEN
  DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP FINITE_IMAGE) THEN
  DISCH_THEN(MP_TAC o MATCH_MP LIMIT_POINT_FINITE) THEN
  DISCH_THEN(MP_TAC o SPEC `lift(&0)`) THEN
  REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
  REWRITE_TAC[DIST_LIFT; LIFT_EQ; REAL_SUB_RZERO; NOT_FORALL_THM; NOT_IMP] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
  DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN
                MP_TAC(SPEC `--x:real` th)) THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `--x:real`) THEN
  ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_ABS_NEG] THEN
  ONCE_REWRITE_TAC[GSYM INVERTIBLE_NEG] THEN
  REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN
  REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN
  ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN
  REWRITE_TAC[GSYM MATRIX_CMUL_ADD_LDISTRIB; GSYM MATRIX_CMUL_ASSOC] THEN
  REWRITE_TAC[MATRIX_CMUL_LID; MATRIX_ADD_SYM]);;

let NEARBY_INVERTIBLE_MATRIX_GEN = prove
 (`!A B:real^N^N.
        invertible B
        ==> ?e. &0 < e /\
                !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% B)`,
  REWRITE_TAC[INVERTIBLE_DET_NZ] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `matrix_inv(B:real^N^N) ** (A:real^N^N)`
        NEARBY_INVERTIBLE_MATRIX) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN
  ASM_REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN
  DISCH_THEN(MP_TAC o AP_TERM `( * ) (det(matrix_inv(B:real^N^N)))`) THEN
  REWRITE_TAC[GSYM DET_MUL; REAL_MUL_RZERO; MATRIX_ADD_LDISTRIB] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[MATRIX_MUL_RMUL] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
  ASM_SIMP_TAC[MATRIX_MUL_LINV]);;

let MATRIX_WLOG_INVERTIBLE = prove
 (`!P. (!A:real^N^N. invertible A ==> P A) /\
       (!A:real^N^N. ?d. &0 < d /\
                         closed {x | x IN cball(vec 0,d) /\
                                     P(A + drop x %% mat 1)})
       ==> !A:real^N^N. P A`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^1` o
    GEN_REWRITE_RULE I [CLOSED_LIMPT]) THEN
  ASM_SIMP_TAC[IN_ELIM_THM; DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN
  ANTS_TAC THENL [ALL_TAC; CONV_TAC TAUT] THEN
  MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `k:real` THEN
  DISCH_TAC THEN REWRITE_TAC[EXISTS_LIFT; IN_ELIM_THM] THEN
  REWRITE_TAC[GSYM LIFT_NUM; IN_CBALL_0; NORM_LIFT; DIST_LIFT] THEN
  REWRITE_TAC[REAL_SUB_RZERO; LIFT_EQ; LIFT_DROP] THEN
  EXISTS_TAC `min d ((min e k) / &2)` THEN
  CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
  CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);;

let SYLVESTER_DETERMINANT_IDENTITY = prove
 (`!A:real^N^M B:real^M^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`,
  let lemma1 = prove
   (`!A:real^N^N B:real^N^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`,
    ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
    MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN
      SUBGOAL_THEN `det((mat 1 + A ** B) ** A:real^N^N) =
                    det(A ** (mat 1 + B ** A))`
      MP_TAC THENL
       [REWRITE_TAC[MATRIX_ADD_RDISTRIB; MATRIX_ADD_LDISTRIB] THEN
        REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID; MATRIX_MUL_ASSOC];
        REWRITE_TAC[DET_MUL] THEN
        FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INVERTIBLE_DET_NZ]) THEN
        CONV_TAC REAL_RING];
      X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN
      REWRITE_TAC[REAL_LT_01; SET_RULE
       `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
      MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
      ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
      REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
      REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
      MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
      REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
      REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN
      CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
      MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
      ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN
      MATCH_MP_TAC CONTINUOUS_ADD THEN
      ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; CONTINUOUS_CONST] THEN
      SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_VSUM THEN
      REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN
      DISCH_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN
      REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN
      REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD] THEN
      MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
      REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN
      MATCH_MP_TAC CONTINUOUS_CMUL THEN
      REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID]]) in
  let lemma2 = prove
   (`!A:real^N^M B:real^M^N.
          dimindex(:M) <= dimindex(:N)
          ==> det(mat 1 + A ** B) = det(mat 1 + B ** A)`,
    REPEAT STRIP_TAC THEN
    MAP_EVERY ABBREV_TAC
     [`A':real^N^N =
          lambda i j. if i <= dimindex(:M) then (A:real^N^M)$i$j
                      else &0`;
      `B':real^N^N =
          lambda i j. if j <= dimindex(:M) then (B:real^M^N)$i$j
                      else &0`] THEN
    MP_TAC(ISPECL [`A':real^N^N`; `B':real^N^N`] lemma1) THEN
    SUBGOAL_THEN
     `(B':real^N^N) ** (A':real^N^N) = (B:real^M^N) ** (A:real^N^M)`
    SUBST1_TAC THENL
     [MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN
      SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC SUM_EQ_SUPERSET THEN
      ASM_SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; FINITE_NUMSEG; SUBSET_NUMSEG;
                   LE_REFL; TAUT `(p /\ q) /\ ~(p /\ r) <=> p /\ q /\ ~r`];
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
     `sum {p | p permutes 1..dimindex(:N) /\ !i. dimindex(:M) < i ==> p i = i}
          (\p. sign p * product (1..dimindex(:N))
                     (\i. (mat 1 + (A':real^N^N) ** (B':real^N^N))$i$p i))` THEN
    CONJ_TAC THENL
     [ALL_TAC;
      CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
      CONJ_TAC THENL [SET_TAC[]; SIMP_TAC[IN_ELIM_THM; IMP_CONJ]] THEN
      X_GEN_TAC `p:num->num` THEN REPEAT STRIP_TAC THEN
      REWRITE_TAC[REAL_ENTIRE; PRODUCT_EQ_0_NUMSEG] THEN DISJ2_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
      REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN
      FIRST_ASSUM(MP_TAC o SPEC `k:num` o CONJUNCT1 o
        GEN_REWRITE_RULE I [permutes]) THEN
      ASM_REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN
      DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
      ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN
      DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN
      ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; REAL_ADD_LID] THEN
      ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN
      MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN
      REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN
      ASM_SIMP_TAC[LAMBDA_BETA; GSYM NOT_LT]] THEN
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN
    EXISTS_TAC `\f:num->num. f` THEN REWRITE_TAC[IN_ELIM_THM] THEN
    CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THENL
     [REWRITE_TAC[MESON[] `(?!x. P x /\ x = y) <=> P y`] THEN CONJ_TAC THENL
       [MATCH_MP_TAC PERMUTES_SUBSET THEN
        EXISTS_TAC `1..dimindex(:M)` THEN
        ASM_REWRITE_TAC[SUBSET_NUMSEG; LE_REFL];
        X_GEN_TAC `k:num` THEN DISCH_TAC THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT1 o
          GEN_REWRITE_RULE I [permutes]) THEN
        ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; NOT_LE]];
      MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
       [MATCH_MP_TAC PERMUTES_SUPERSET THEN
        EXISTS_TAC `1..dimindex(:N)` THEN
        ASM_REWRITE_TAC[IN_DIFF; IN_NUMSEG] THEN ASM_MESON_TAC[NOT_LE];
        DISCH_TAC] THEN
      AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE
       `m:num <= n ==> n = m + (n - m)`)) THEN
      SIMP_TAC[PRODUCT_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN
      MATCH_MP_TAC(REAL_RING `x = y /\ z = &1 ==> x = y * z`) THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
        X_GEN_TAC `i:num` THEN STRIP_TAC THEN
        SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL
         [ASM_ARITH_TAC; ALL_TAC] THEN
        MP_TAC(ISPECL [`p:num->num`; `1..dimindex(:M)`] PERMUTES_IMAGE) THEN
        ASM_REWRITE_TAC[] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
        ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN
        DISCH_THEN(MP_TAC o SPEC `i:num`) THEN
        ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
        SUBGOAL_THEN `(p:num->num) i <= dimindex(:N)` ASSUME_TAC THENL
         [ASM_ARITH_TAC; ALL_TAC] THEN
        ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN
        AP_TERM_TAC THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN
        MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN
        MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN
        ASM_SIMP_TAC[LAMBDA_BETA];
        MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG THEN
        ASM_SIMP_TAC[ARITH_RULE `n + 1 <= i ==> n < i`] THEN
        ASM_SIMP_TAC[ARITH_RULE `m:num <= n ==> m + (n - m) = n`] THEN
        X_GEN_TAC `i:num` THEN STRIP_TAC THEN
        SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
        ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN
        ASM_SIMP_TAC[REAL_EQ_ADD_LCANCEL_0; matrix_mul; LAMBDA_BETA] THEN
        MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN
        REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN
        ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `m + 1 <= i ==> ~(i <= m)`]]]) in
  REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE
   `dimindex(:M) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:M)`)
  THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN
  MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[]);;

let COFACTOR_MATRIX_MUL = prove
 (`!A B:real^N^N. cofactor(A ** B) = cofactor(A) ** cofactor(B)`,
  MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL
   [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN
    CONJ_TAC THENL
     [ASM_SIMP_TAC[COFACTOR_MATRIX_INV; GSYM INVERTIBLE_DET_NZ;
                   INVERTIBLE_MATRIX_MUL] THEN
      REWRITE_TAC[DET_MUL; MATRIX_MUL_LMUL] THEN
      REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_CMUL_ASSOC;
                  GSYM MATRIX_TRANSP_MUL] THEN
      ASM_SIMP_TAC[MATRIX_INV_MUL];
      GEN_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]];
    X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN
    REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN
    MATCH_MP_TAC CLOSED_FORALL THEN GEN_TAC] THEN
  REWRITE_TAC[SET_RULE
   `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
  MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
  REWRITE_TAC[CART_EQ] THEN
  MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
  REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
  REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
  REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
  ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; cofactor; LIFT_SUM;
               FINITE_NUMSEG; o_DEF] THEN
  (MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL
    [ALL_TAC;
     MATCH_MP_TAC CONTINUOUS_VSUM THEN
     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
     REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
     REWRITE_TAC[o_DEF] THEN CONJ_TAC]) THEN
  MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
  ASM_SIMP_TAC[LAMBDA_BETA; CONTINUOUS_CONST] THEN
  REPEAT(W(fun (asl,w) ->
   let t = find_term is_cond w in
   ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN
  SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
  TRY(MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN
      REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC) THEN
  REWRITE_TAC[LIFT_CMUL] THEN
  TRY(MATCH_MP_TAC CONTINUOUS_MUL THEN
      REWRITE_TAC[o_DEF; CONTINUOUS_CONST]) THEN
  REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN
  MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
  REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL; o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_MUL THEN
  REWRITE_TAC[CONTINUOUS_CONST; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;

let DET_COFACTOR = prove
 (`!A:real^N^N. det(cofactor A) = det(A) pow (dimindex(:N) - 1)`,
  MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN
  X_GEN_TAC `A:real^N^N` THENL
   [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_FIELD
     `~(a = &0) ==> a * x = a * y ==> x = y`)) THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN
    REWRITE_TAC[GSYM DET_MUL; MATRIX_MUL_RIGHT_COFACTOR] THEN
    REWRITE_TAC[DET_CMUL; GSYM(CONJUNCT2 real_pow); DET_I; REAL_MUL_RID] THEN
    SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`];
    ALL_TAC] THEN
  EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
  REWRITE_TAC[SET_RULE
   `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
  MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
  ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
  REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
  REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
  REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
  MATCH_MP_TAC CONTINUOUS_SUB THEN
  CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_LIFT_POW] THEN
  MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
  MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
  ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD;
               LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST;
               CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID] THEN
  ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN
  MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
  ASM_SIMP_TAC[LAMBDA_BETA] THEN
  REPEAT(W(fun (asl,w) ->
   let t = find_term is_cond w in
   ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN
  ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD;
               LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST;
               CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;

let INVERTIBLE_COFACTOR = prove
 (`!A:real^N^N. invertible(cofactor A) <=> dimindex(:N) = 1 \/ invertible A`,
  SIMP_TAC[DET_COFACTOR; INVERTIBLE_DET_NZ; REAL_POW_EQ_0; DE_MORGAN_THM;
           DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`;
           DISJ_ACI]);;

let COFACTOR_COFACTOR = prove
 (`!A:real^N^N.
     2 <= dimindex(:N)
     ==> cofactor(cofactor A) = (det(A) pow (dimindex(:N) - 2)) %% A`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
  MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN
  X_GEN_TAC `A:real^N^N` THENL
   [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`]
        COFACTOR_MATRIX_MUL) THEN
    REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; COFACTOR_CMUL; COFACTOR_I] THEN
    REWRITE_TAC[COFACTOR_TRANSP] THEN
    DISCH_THEN(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; TRANSP_MATRIX_CMUL] THEN
    REWRITE_TAC[TRANSP_MAT] THEN
    DISCH_THEN(MP_TAC o AP_TERM `(\x. x ** A):real^N^N->real^N^N`) THEN
    REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LEFT_COFACTOR] THEN
    REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN
    REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN
    DISCH_THEN(MP_TAC o AP_TERM `\x:real^N^N. inv(det(A:real^N^N)) %% x`) THEN
    ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_LINV; MATRIX_CMUL_LID] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN
    ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN
    REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC;
    POP_ASSUM(K ALL_TAC)] THEN
  EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
  REWRITE_TAC[SET_RULE
   `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
  MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
  REWRITE_TAC[CART_EQ] THEN
  MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
  REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
  REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
  REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
  MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL
   [REPLICATE_TAC 2
     (ONCE_REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
      MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC THEN
      ASM_SIMP_TAC[LAMBDA_BETA] THEN
      REPEAT(W(fun (asl,w) ->
       let t = find_term is_cond w in
       ASM_CASES_TAC (lhand(rator t)) THEN
       ASM_REWRITE_TAC[CONTINUOUS_CONST])));
    REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_LIFT_POW THEN
      MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC;
      ALL_TAC]] THEN
  REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT] THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
  SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_CMUL;
           CONTINUOUS_AT_ID]);;

let RANK_COFACTOR_EQ_FULL = prove
 (`!A:real^N^N. rank(cofactor A) = dimindex(:N) <=>
                dimindex(:N) = 1 \/ rank A = dimindex(:N)`,
  REWRITE_TAC[RANK_EQ_FULL_DET; DET_COFACTOR; REAL_POW_EQ_0] THEN
  SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN
  CONV_TAC TAUT);;

let COFACTOR_EQ_0 = prove
 (`!A:real^N^N. cofactor A = mat 0 <=> rank(A) < dimindex(:N) - 1`,
  let lemma1 = prove
   (`!A:real^N^N. rank(A) < dimindex(:N) - 1 ==> cofactor A = mat 0`,
    GEN_TAC THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN
    SIMP_TAC[CART_EQ; cofactor; MAT_COMPONENT; LAMBDA_BETA; COND_ID] THEN
    X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
    REWRITE_TAC[DET_EQ_0_RANK] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (ARITH_RULE `r < n - 1 ==> s <= r + 1 ==> s < n`)) THEN
    REWRITE_TAC[RANK_ROW; rows] THEN MATCH_MP_TAC LE_TRANS THEN
    EXISTS_TAC
     `dim (basis n INSERT
           {row i ((lambda k l. if l = n then &0 else (A:real^N^N)$k$l)
                   :real^N^N)
            | i IN (1..dimindex(:N)) DELETE m})` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN
      MATCH_MP_TAC(SET_RULE
       `m IN s /\ (!i. i IN s DELETE m ==> f i = g i) /\ f m = a
        ==> {f i | i IN s} SUBSET a INSERT {g i | i IN s DELETE m}`) THEN
      ASM_SIMP_TAC[IN_NUMSEG; IN_DELETE; row; LAMBDA_BETA; basis; LAMBDA_ETA];
      REWRITE_TAC[DIM_INSERT] THEN MATCH_MP_TAC(ARITH_RULE
       `n <= k ==> (if p then n else n + 1) <= k + 1`) THEN
      MATCH_MP_TAC(MESON[DIM_LINEAR_IMAGE_LE; DIM_SUBSET; LE_TRANS]
       `(?f. linear f /\ t SUBSET IMAGE f s) ==> dim t <= dim s`) THEN
      EXISTS_TAC `(\x. lambda i. if i = n then &0 else x$i)
                  :real^N->real^N` THEN
      REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL
       [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
                  VECTOR_MUL_COMPONENT] THEN
        REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
        REAL_ARITH_TAC;
        X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DELETE] THEN
        STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
        ONCE_REWRITE_TAC[CONJ_SYM] THEN
        REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `i:num` THEN
        ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA]]])
  and lemma2 = prove
   (`!A:real^N^N.
          rank A < dimindex(:N)
          ==> ?n x. 1 <= n /\ n <= dimindex(:N) /\
                    rank A <
                    rank((lambda i. if i = n then x else row i A):real^N^N)`,
    REPEAT STRIP_TAC THEN SUBGOAL_THEN
     `?n. 1 <= n /\ n <= dimindex(:N) /\
          row n (A:real^N^N) IN
          span {row j A | j IN (1..dimindex(:N)) DELETE n}`
    MP_TAC THENL
     [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN
      ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_TRANSP] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
      REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
      SIMP_TAC[matrix_vector_mul; transp; VEC_COMPONENT; LAMBDA_BETA] THEN
      DISCH_TAC THEN
      SUBGOAL_THEN `row n A = vsum ((1..dimindex(:N)) DELETE n)
                       (\i. --((c:real^N)$i / c$n) % row i (A:real^N^N))`
      SUBST1_TAC THENL
       [ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; REAL_DIV_REFL] THEN
        REWRITE_TAC[VECTOR_ARITH `n = x - -- &1 % n <=> x:real^N = vec 0`] THEN
        SIMP_TAC[VSUM_COMPONENT; row; VECTOR_MUL_COMPONENT; LAMBDA_BETA;
          CART_EQ; REAL_ARITH `--(x / y) * z:real = --(inv y) * z * x`] THEN
        ASM_SIMP_TAC[SUM_LMUL; VEC_COMPONENT; REAL_MUL_RZERO];
        MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN
        X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN
        STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
        MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN `span {row j (A:real^N^N) | j IN (1..dimindex(:N)) DELETE n}
                    PSUBSET (:real^N)`
      MP_TAC THENL
       [REWRITE_TAC[PSUBSET; SUBSET_UNIV] THEN
        DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN
        REWRITE_TAC[DIM_UNIV] THEN
        MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n - 1 ==> ~(x = n)`) THEN
        REWRITE_TAC[DIMINDEX_GE_1; DIM_SPAN] THEN
        W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
        SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN
        W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN
        SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN
        ASM_SIMP_TAC[CARD_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN
        REWRITE_TAC[CARD_NUMSEG_1; LE_REFL];
        DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
         `s PSUBSET UNIV ==> ?x. ~(x IN s)`)) THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
        REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN
        SUBGOAL_THEN
         `!A:real^N^N. rows A = row n A INSERT
                                {row j A | j IN (1..dimindex (:N)) DELETE n}`
         (fun th -> REWRITE_TAC[th])
        THENL
         [REWRITE_TAC[rows; IN_DELETE; IN_NUMSEG] THEN ASM SET_TAC[];
          ASM_SIMP_TAC[DIM_INSERT]] THEN
        COND_CASES_TAC THENL
         [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
            `x IN span s ==> x = y /\ s = t ==> ~(y IN span t) ==> q`)) THEN
          ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA];
          MATCH_MP_TAC(ARITH_RULE `s = t ==> s < t + 1`) THEN
          AP_TERM_TAC THEN REWRITE_TAC[row]] THEN
        MATCH_MP_TAC(SET_RULE
         `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN
        ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA; CART_EQ]]]) in
  GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_TAC THEN
  MATCH_MP_TAC(ARITH_RULE
   `r <= n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN
  REPEAT CONJ_TAC THENL
   [MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC;
    REWRITE_TAC[RANK_EQ_FULL_DET] THEN
    MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN
    ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN
    REWRITE_TAC[MAT_EQ; ARITH_EQ];
    DISCH_TAC] THEN
  MP_TAC(ISPEC `A:real^N^N` lemma2) THEN
  ASM_REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `n - 1 < n <=> 1 <= n`] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `x:real^N`
    STRIP_ASSUME_TAC)) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
   `n - 1 < k ==> k <= MIN n n ==> k = n`)) THEN
  REWRITE_TAC[RANK_BOUND; RANK_EQ_FULL_DET] THEN
  MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `n:num`]
    DET_COFACTOR_EXPANSION)) THEN
  ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_0 THEN
  X_GEN_TAC `m:num` THEN SIMP_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN
  DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
  DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[CART_EQ] THEN
  DISCH_THEN(MP_TAC o SPEC `m:num`) THEN
  ASM_SIMP_TAC[MAT_COMPONENT; COND_ID] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN
  ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN
  ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row] THEN
  REPEAT STRIP_TAC THEN
  REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA]) THEN
  ASM_MESON_TAC[]);;

let RANK_COFACTOR_EQ_1 = prove
 (`!A:real^N^N. rank(cofactor A) = 1 <=>
                dimindex(:N) = 1 \/ rank A = dimindex(:N) - 1`,
  GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
   [ASM_MESON_TAC[RANK_COFACTOR_EQ_FULL]; ASM_REWRITE_TAC[]] THEN
  EQ_TAC THENL
   [ASM_CASES_TAC `cofactor A:real^N^N = mat 0` THEN
    ASM_REWRITE_TAC[RANK_0; ARITH_EQ] THEN DISCH_TAC THEN
    MATCH_MP_TAC(ARITH_RULE
     `~(r < n - 1) /\ ~(r = n) /\ r <= MIN n n ==> r = n - 1`) THEN
    ASM_REWRITE_TAC[RANK_BOUND; GSYM COFACTOR_EQ_0] THEN
    MP_TAC(ISPEC `A:real^N^N` RANK_COFACTOR_EQ_FULL) THEN ASM_REWRITE_TAC[];
    DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE
     `~(n = 0) /\ n <= 1 ==> n = 1`) THEN
    ASM_REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0; LT_REFL] THEN
    MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`]
      RANK_SYLVESTER) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; RANK_TRANSP] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `a = n - 1 ==> 1 <= n ==> a < n`)) THEN
    ASM_SIMP_TAC[GSYM DET_EQ_0_RANK; DIMINDEX_GE_1] THEN
    DISCH_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN
    ARITH_TAC]);;

let RANK_COFACTOR = prove
 (`!A:real^N^N.
        rank(cofactor A) = if rank(A) = dimindex(:N) then dimindex(:N)
                           else if rank(A) = dimindex(:N) - 1 then 1
                           else 0`,
  GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_FULL] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_1] THEN
  REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0] THEN
  MATCH_MP_TAC(ARITH_RULE
   `r <= MIN n n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN
  ASM_REWRITE_TAC[RANK_BOUND]);;

let SAME_EIGENVALUES_TRANSP = prove
 (`!A:real^N^N c.
     (?v. ~(v = vec 0) /\ transp(A) ** v = c % v) <=>
     (?v. ~(v = vec 0) /\ A ** v = c % v)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN
  REWRITE_TAC[TRANSP_MATRIX_SUB; TRANSP_MATRIX_CMUL; TRANSP_MAT]);;

let SAME_EIGENVALUES_SIMILAR = prove
 (`!S:real^N^N A c.
        invertible S
        ==> ((?v. ~(v = vec 0) /\ (matrix_inv S ** A ** S) ** v = c % v) <=>
             (?v. ~(v = vec 0) /\ A ** v = c % v))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN TRANS_TAC EQ_TRANS
   `det(matrix_inv S ** (A - c %% mat 1) ** (S:real^N^N))` THEN
  CONJ_TAC THENL [AP_TERM_TAC; ASM_SIMP_TAC[DET_SIMILAR]] THEN
  REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_SUB_RDISTRIB] THEN
  REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN
  ASM_SIMP_TAC[MATRIX_INV; MATRIX_MUL_LID]);;

let SAME_EIGENVALUES_MATRIX_MUL = prove
 (`!A B:real^N^N c.
     (?v. ~(v = vec 0) /\ (A ** B) ** v = c % v) <=>
     (?v. ~(v = vec 0) /\ (B ** A) ** v = c % v)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[EIGENVALUES_CHARACTERISTIC_ALT] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN ASM_CASES_TAC `c = &0` THEN
  ASM_REWRITE_TAC[MATRIX_CMUL_LZERO; MATRIX_SUB_RZERO;
                  DET_MUL; REAL_MUL_SYM] THEN
  SUBGOAL_THEN `A:real^N^N = --c %% (inv(--c) %% A)` SUBST1_TAC THENL
   [ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; MATRIX_CMUL_LID; REAL_MUL_RINV;
                 REAL_NEG_EQ_0];
    ONCE_REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL]] THEN
  REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1; MATRIX_CMUL_ASSOC] THEN
  REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID; GSYM MATRIX_CMUL_ADD_LDISTRIB] THEN
  REWRITE_TAC[DET_CMUL] THEN AP_TERM_TAC THEN
  ONCE_REWRITE_TAC[MATRIX_ADD_SYM] THEN
  REWRITE_TAC[SYLVESTER_DETERMINANT_IDENTITY]);;

let SAME_EIGENVECTORS_MATRIX_INV = prove
 (`!A:real^N^N c v.
        symmetric_matrix A
        ==> (matrix_inv A ** v = c % v <=> A ** v = inv(c) % v)`,
  SUBGOAL_THEN
   `!A:real^N^N c v.
      symmetric_matrix A ==> A ** v = c % v ==> matrix_inv A ** v = inv(c) % v`
  MP_TAC THENL
   [REWRITE_TAC[symmetric_matrix] THEN REPEAT STRIP_TAC;
    MESON_TAC[REAL_INV_INV; MATRIX_INV_INV; SYMMETRIC_MATRIX_INV]] THEN
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL
   [ASM_MESON_TAC[VECTOR_MUL_LZERO; REAL_INV_0; MATRIX_VECTOR_MUL_INV_EQ_0];
    ASM_REWRITE_TAC[]] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o LAND_CONV)
   [GSYM MATRIX_INV_MUL_INNER]) THEN
  ASM_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
  REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN
  GEN_REWRITE_TAC (funpow 3 LAND_CONV)
   [GSYM(REWRITE_RULE[symmetric_matrix] SYMMETRIC_MATRIX_INV_RMUL)] THEN
  ASM_REWRITE_TAC[MATRIX_TRANSP_MUL; GSYM MATRIX_VECTOR_MUL_ASSOC;
                  TRANSP_MATRIX_INV; MATRIX_VECTOR_MUL_RMUL] THEN
  DISCH_THEN(MP_TAC o AP_TERM `(%) (inv c * inv c):real^N->real^N`) THEN
  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV;
               REAL_FIELD `~(c = &0) ==> inv c * inv c * c * c = &1`] THEN
  REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_RID]);;

let NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP = prove
 (`!A:real^N^N.
        normal_matrix A
        ==> !c v. transp A ** v = c % v <=> A ** v = c % v`,
  REWRITE_TAC[normal_matrix] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
  ONCE_REWRITE_TAC[MESON[MATRIX_VECTOR_LMUL; MATRIX_VECTOR_MUL_LID]
   `c % v = (c %% mat 1:real^N^N) ** v`] THEN
  REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]  THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_MAT] THEN
  REWRITE_TAC[GSYM TRANSP_MATRIX_CMUL; GSYM TRANSP_MATRIX_SUB] THEN
  MATCH_MP_TAC NORMAL_MATRIX_KERNEL_TRANSP_EXPLICIT THEN
  REWRITE_TAC[normal_matrix] THEN
  REWRITE_TAC[TRANSP_MATRIX_SUB; TRANSP_MATRIX_CMUL; TRANSP_MAT] THEN
  REWRITE_TAC[MATRIX_SUB_LDISTRIB] THEN REWRITE_TAC[MATRIX_SUB_RDISTRIB] THEN
  ASM_REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN
  REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN
  REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_SUB; MATRIX_CMUL_ADD_LDISTRIB] THEN
  REWRITE_TAC[MATRIX_CMUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
  REWRITE_TAC[MATRIX_ADD_AC]);;

let NORMAL_MATRIX_SAME_EIGENVECTORS_TRANSP = prove
 (`!A:real^N^N.
        normal_matrix A
        ==> !v. ((?c. transp A ** v = c % v) <=> (?c. A ** v = c % v))`,
  MESON_TAC[NORMAL_MATRIX_SAME_EIGENPAIRS_TRANSP]);;

(* ------------------------------------------------------------------------- *)
(* Not in so many words, but combining this with intermediate value theorem  *)
(* implies the determinant is an open map.                                   *)
(* ------------------------------------------------------------------------- *)

let DET_OPEN_MAP = prove
 (`!A:real^N^N e.
        &0 < e
        ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < det A) /\
            (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > det A)`,
  let lemma1 = prove
   (`!A:real^N^N i e.
          1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 /\ &0 < e
          ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < &0) /\
              (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > &0)`,
    REPEAT GEN_TAC THEN STRIP_TAC THEN
    SUBGOAL_THEN `det(A:real^N^N) = &0` ASSUME_TAC THENL
     [ASM_MESON_TAC[DET_ZERO_ROW]; ALL_TAC] THEN
    MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[INVERTIBLE_DET_NZ]] THEN
    DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH
     `~(x = &0) ==> x < &0 \/ &0 < x`))
    THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN
    (CONJ_TAC THENL
       [EXISTS_TAC `A + min d e / &2 %% mat 1:real^N^N`;
        EXISTS_TAC `(lambda j. if j = i then
                         --(&1) % row i (A + min d e / &2 %% mat 1:real^N^N)
                         else row j (A + min d e / &2 %% mat 1:real^N^N))
                    :real^N^N`]) THEN
    ASM_SIMP_TAC[DET_ROW_MUL; MESON[]
     `(if j = i then f i else f j) = f j`] THEN
    REWRITE_TAC[row; LAMBDA_ETA] THEN
    ASM_REWRITE_TAC[real_gt; GSYM row] THEN
    TRY(CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN
    (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
     SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k`
     CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
     SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l`
     CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN
    ASM_SIMP_TAC[LAMBDA_BETA] THEN
    TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT;
                 VECTOR_MUL_COMPONENT] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
    DISCH_THEN(MP_TAC o SPEC `l:num`) THEN
    ASM_SIMP_TAC[row; LAMBDA_BETA; VEC_COMPONENT] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC)
  and lemma2 = prove
   (`!A:real^N^N x:real^N i.
          1 <= i /\ i <= dimindex(:N) /\ x$i = &1
          ==> det(lambda k. if k = i then transp A ** x else row k A) = det A`,
    REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC
     `det(lambda k. if k = i
                    then row i (A:real^N^N) + (transp A ** x - row i A)
                    else row k A)` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[VECTOR_ARITH `r + (x - r):real^N = x`]; ALL_TAC] THEN
    MATCH_MP_TAC DET_ROW_SPAN THEN
    SUBGOAL_THEN
     `transp(A:real^N^N) ** x - row i A =
      vsum ((1..dimindex(:N)) DELETE i) (\k. x$k % row k A)`
    SUBST1_TAC THENL
     [SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_SUB_COMPONENT; row; transp;
               LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN
      ASM_SIMP_TAC[SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG; REAL_MUL_LID] THEN
      REWRITE_TAC[REAL_MUL_AC];
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN
      REWRITE_TAC[FINITE_DELETE; IN_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN
      X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
      MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) in
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  ASM_CASES_TAC `cofactor(A:real^N^N) = mat 0` THENL
   [MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN
    ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN
    REWRITE_TAC[MAT_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN
     `?c i. 1 <= i /\ i <= dimindex(:N) /\ c$i = &1 /\
            transp(A:real^N^N) ** c = vec 0`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN
      ASM_REWRITE_TAC[DET_TRANSP] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
      ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
      REWRITE_TAC[VEC_COMPONENT; NOT_IMP; NOT_FORALL_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
      EXISTS_TAC `inv(c$i) % c:real^N` THEN
      ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV] THEN
      ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_RZERO];
      ALL_TAC] THEN
    MP_TAC(ISPECL
    [`(lambda k. if k = i then transp A ** c else row k (A:real^N^N)):real^N^N`;
     `i:num`; `min e (e / &(dimindex(:N)) /
                      (&1 + norm(&2 % basis i - c:real^N)))`] lemma1) THEN
    ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
                 NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN
    ANTS_TAC THENL
     [ASM_SIMP_TAC[row; CART_EQ; VEC_COMPONENT; LAMBDA_BETA];
      ALL_TAC] THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
    ABBREV_TAC `A':real^N^N =
                lambda k. if k = i then vec 0 else row k (A:real^N^N)` THEN
    DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(lambda k. if k = i then transp(B:real^N^N) **
                                         (&2 % basis i - c)
                           else row k B):real^N^N` THEN
    ASM_SIMP_TAC[lemma2; BASIS_COMPONENT; VECTOR_MUL_COMPONENT;
                 VECTOR_SUB_COMPONENT; REAL_ARITH `&2 * x - x = x`] THEN
    (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
     SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k`
     CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
     SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l`
     CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN
    EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
    (COND_CASES_TAC THENL
      [ALL_TAC;
       FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
       EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; row]] THEN
     SUBGOAL_THEN
      `(A:real^N^N)$k$l = (transp(A':real^N^N) ** (&2 % basis i - c:real^N))$l`
     SUBST1_TAC THENL
      [ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN
       EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
       REWRITE_TAC[COND_RAND; COND_RATOR] THEN
       SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
         VEC_COMPONENT; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LZERO] THEN
       ASM_SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_0; REAL_ADD_LID] THEN
       ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN
       UNDISCH_TAC `transp(A:real^N^N) ** (c:real^N) = vec 0` THEN
       ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT; matrix_vector_mul; LAMBDA_BETA;
                    row; transp] THEN
       DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN
       SIMP_TAC[REAL_MUL_RNEG; SUM_NEG] THEN REAL_ARITH_TAC;
       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM TRANSP_MATRIX_SUB;
                   GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]] THEN
      ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN
      W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
      MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
      ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY;
                   GSYM NOT_LE; DIMINDEX_GE_1] THEN
      X_GEN_TAC `r:num` THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN
      STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN
      TRANS_TAC REAL_LET_TRANS
       `abs((B - A':real^N^N)$r$l) * (&1 + norm(&2 % basis i - c:real^N))` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
        MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= &1 + b`) THEN
        ASM_SIMP_TAC[COMPONENT_LE_NORM];
        ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; GSYM REAL_LT_RDIV_EQ;
                     NORM_ARITH `&0 < &1 + norm(x:real^N)`]]);
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
    SIMP_TAC[CART_EQ; MAT_COMPONENT; COND_ID] THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt] THEN
    DISCH_THEN(X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC
     (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))) THEN
    FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
     `~(x = &0) ==> &0 < x \/ x < &0`))
    THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN
    (CONJ_TAC THENL
     [EXISTS_TAC `(lambda m n. if m = i /\ n = j
                               then (A:real^N^N)$i$j -
                                    e / (&1 + abs(cofactor A$i$j))
                               else A$m$n):real^N^N`;
      EXISTS_TAC `(lambda m n. if m = i /\ n = j
                               then (A:real^N^N)$i$j +
                                    e / (&1 + abs(cofactor A$i$j))
                               else A$m$n):real^N^N`]) THEN
     (CONJ_TAC THENL
       [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
        SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k`
        CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
        SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l`
        CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
        ASM_SIMP_TAC[LAMBDA_BETA] THEN
        COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN
        REWRITE_TAC[REAL_ARITH `abs(a - e - a) = abs e`;
                    REAL_ARITH `abs((a + e) - a) = abs e`] THEN
        REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_ABS] THEN
        ASM_SIMP_TAC[REAL_ARITH `abs(&1 + abs x) = &1 + abs x`;
                     REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
        MATCH_MP_TAC(REAL_ARITH
         `&0 < e /\ &0 < e * x ==> abs e < e * (&1 + x)`) THEN
        ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC;
        ALL_TAC]) THEN
    MP_TAC(GEN `A:real^N^N` (SPECL [`A:real^N^N`; `i:num`]
        DET_COFACTOR_EXPANSION)) THEN
    ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
    ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
    ASM_SIMP_TAC[GSYM SUM_SUB_NUMSEG; LAMBDA_BETA] THEN
    REWRITE_TAC[REAL_ARITH `p - A$i$j * cofactor A$i$j =
                            --(A$i$j * cofactor A$i$j - p)`] THEN
    REWRITE_TAC[SUM_NEG; REAL_ARITH
     `a * b - c * d:real = b * (a - c) + c * (b - d)`] THEN
    REWRITE_TAC[SUM_ADD_NUMSEG; REAL_NEG_ADD] THEN MATCH_MP_TAC(REAL_ARITH
     `b = &0 /\ &0 < a ==> &0 < a + b`) THEN
    (CONJ_TAC THENL
      [REWRITE_TAC[REAL_NEG_EQ_0] THEN
       MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN
       REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN
       REWRITE_TAC[REAL_SUB_0] THEN REWRITE_TAC[cofactor] THEN
       ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN
       ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[];
       ALL_TAC]) THEN
    REWRITE_TAC[GSYM SUM_NEG; GSYM REAL_MUL_RNEG] THEN
    MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[FINITE_NUMSEG] THEN
    MATCH_MP_TAC(MESON[REAL_LT_IMP_LE; REAL_LE_REFL]
     `(?i. P i /\ &0 < f i /\ (!j. P j /\ ~(j = i) ==> f j = &0))
      ==> (!j. P j ==> &0 <= f j) /\ (?j. P j /\ &0 < f j)`) THEN
    EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
    ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; IN_NUMSEG; REAL_NEG_0] THEN
    REWRITE_TAC[REAL_ARITH `a - (a + e):real = --e`;
                REAL_ARITH `a - (a - e):real = e`; REAL_NEG_NEG] THEN
    ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN
    REWRITE_TAC[REAL_ARITH `&0 < a * --b <=> &0 < --a * b`] THEN
    ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_NEG_GT0] THEN
    MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* Existence of eigenvectors. The proof is only in this file because it uses *)
(* a few simple results about continuous functions (at least                 *)
(* CONTINUOUS_ON_LIFT_DOT2, CONTINUOUS_ATTAINS_SUP and CLOSED_SUBSPACE).     *)
(* ------------------------------------------------------------------------- *)

let SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE = prove
 (`!f:real^N->real^N s.
        linear f /\ adjoint f = f /\
        subspace s /\ ~(s = {vec 0}) /\ (!x. x IN s ==> f x IN s)
        ==> ?v c. v IN s /\ norm(v) = &1 /\ f(v) = c % v`,
  let lemma = prove
   (`!a b. (!x. a * x <= b * x pow 2) ==> &0 <= b ==> a = &0`,
    REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
    ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THENL
     [FIRST_X_ASSUM(fun t -> MP_TAC(SPEC `&1` t) THEN
        MP_TAC(SPEC `-- &1` t)) THEN ASM_REAL_ARITH_TAC;
      DISCH_TAC THEN  FIRST_X_ASSUM(MP_TAC o SPEC `a / &2 / b`) THEN
      ASM_SIMP_TAC[REAL_FIELD
       `&0 < b ==> (b * (a / b) pow 2) = a pow 2 / b`] THEN
      REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div] THEN
      ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN
      REWRITE_TAC[REAL_LT_SQUARE; REAL_ARITH
        `(a * a) / &2 <= (a / &2) pow 2 <=> ~(&0 < a * a)`]]) in
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`\x:real^N. (f x) dot x`;
                 `s INTER sphere(vec 0:real^N,&1)`]
        CONTINUOUS_ATTAINS_SUP) THEN
  REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; o_DEF] THEN ANTS_TAC THENL
   [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; LINEAR_CONTINUOUS_ON;
                   CONTINUOUS_ON_ID] THEN
    ASM_SIMP_TAC[COMPACT_SPHERE; CLOSED_INTER_COMPACT; CLOSED_SUBSPACE] THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
      `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN
    ASM_SIMP_TAC[SUBSPACE_0; IN_SPHERE_0; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `inv(norm x) % x:real^N` THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_SUB_RZERO; NORM_MUL] THEN
    ASM_SIMP_TAC[SUBSPACE_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN
    REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN
    ABBREV_TAC `c = (f:real^N->real^N) v dot v` THEN
    EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]] THEN
  ABBREV_TAC `p = \x y:real^N. c * (x dot y) - (f x) dot y` THEN
  SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= p x x` (LABEL_TAC "POSDEF") THENL
   [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "p" THEN REWRITE_TAC[] THEN
    ASM_CASES_TAC `x:real^N = vec 0` THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; REAL_SUB_LE; REAL_LE_REFL] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `inv(norm x) % x:real^N`) THEN
    ASM_SIMP_TAC[SUBSPACE_MUL] THEN
    ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; REAL_ABS_INV; DOT_RMUL] THEN
    ASM_SIMP_TAC[REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; DOT_LMUL] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; DOT_POS_LT] THEN
    REWRITE_TAC[GSYM NORM_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN `!y:real^N. y IN s ==> !a. p v y * a <= p y y * a pow 2`
  MP_TAC THENL
   [REPEAT STRIP_TAC THEN
    REMOVE_THEN "POSDEF" (MP_TAC o SPEC `v - (&2 * a) % y:real^N`) THEN
    EXPAND_TAC "p" THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
    ASM_SIMP_TAC[LINEAR_SUB; LINEAR_CMUL] THEN
    REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN
    REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN
    SUBGOAL_THEN `f y dot (v:real^N) = f v dot y` SUBST1_TAC THENL
     [ASM_MESON_TAC[ADJOINT_CLAUSES; DOT_SYM]; ALL_TAC] THEN
    ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[NORM_POW_2] THEN
    MATCH_MP_TAC(REAL_ARITH
        `&4 * (z - y) = x ==> &0 <= x ==> y <= z`) THEN
    REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING;
    DISCH_THEN(MP_TAC o GEN `y:real^N` o DISCH `(y:real^N) IN s` o
      MATCH_MP lemma o C MP (ASSUME `(y:real^N) IN s`) o SPEC `y:real^N`) THEN
    ASM_SIMP_TAC[] THEN EXPAND_TAC "p" THEN
    REWRITE_TAC[GSYM DOT_LMUL; GSYM DOT_LSUB] THEN
    DISCH_THEN(MP_TAC o SPEC `c % v - f v:real^N`) THEN
    ASM_SIMP_TAC[SUBSPACE_MUL; SUBSPACE_SUB; DOT_EQ_0; VECTOR_SUB_EQ]]);;

let SELF_ADJOINT_HAS_EIGENVECTOR = prove
 (`!f:real^N->real^N.
        linear f /\ adjoint f = f ==> ?v c. norm(v) = &1 /\ f(v) = c % v`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`]
        SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN
  ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN
  MATCH_MP_TAC(SET_RULE `!a. ~(a IN s) ==> ~(UNIV = s)`) THEN
  EXISTS_TAC `vec 1:real^N` THEN
  REWRITE_TAC[IN_SING; VEC_EQ; ARITH_EQ]);;

let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE = prove
 (`!f:real^N->real^N s.
        linear f /\ adjoint f = f /\
        subspace s /\ (!x. x IN s ==> f x IN s)
        ==> ?b. b SUBSET s /\
                pairwise orthogonal b /\
                (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\
                independent b /\
                span b = s /\
                b HAS_SIZE dim s`,
  let lemma = prove
   (`!f:real^N->real^N s.
          linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s)
          ==> ?b. b SUBSET s /\ b HAS_SIZE dim s /\
                  pairwise orthogonal b /\
                  (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x)`,
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN
    GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN
    WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN
    ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL
     [EXISTS_TAC `{}:real^N->bool` THEN
      ASM_SIMP_TAC[HAS_SIZE_CLAUSES; NOT_IN_EMPTY;
                   PAIRWISE_EMPTY; EMPTY_SUBSET];
      ALL_TAC] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN
    DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE
     `~(s SUBSET {a}) ==> ~(s = {a})`)) THEN
    MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`]
      SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN
    ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N` MP_TAC) THEN
    ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | y IN s /\ orthogonal v y}`) THEN
    REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM] THEN
    MP_TAC(ISPECL [`span {v:real^N}`; `s:real^N->bool`]
          DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN
    ASM_REWRITE_TAC[SUBSPACE_SPAN; IN_SING; FORALL_UNWIND_THM2] THEN
    ANTS_TAC THENL
     [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM SET_TAC[];
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    ASM_REWRITE_TAC[DIM_SPAN; DIM_SING; ARITH_RULE `n < n + 1`] THEN
    ANTS_TAC THENL
     [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
      ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN
      REWRITE_TAC[orthogonal] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
      MATCH_MP_TAC EQ_TRANS THEN
      EXISTS_TAC `(f:real^N->real^N) v dot x` THEN CONJ_TAC THENL
       [ASM_MESON_TAC[ADJOINT_CLAUSES];
        ASM_MESON_TAC[DOT_LMUL; REAL_MUL_RZERO]];
      DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `(v:real^N) INSERT b` THEN
      ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN
      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      ASM_REWRITE_TAC[PAIRWISE_INSERT] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE; SUBSET; IN_ELIM_THM]) THEN
      CONJ_TAC THENL
       [ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN
        COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD1] THEN
        ASM_MESON_TAC[ORTHOGONAL_REFL];
        RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN
        ASM_MESON_TAC[ORTHOGONAL_SYM]]]) in
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] lemma) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `b:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
    ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`];
    DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
     [ASM_MESON_TAC[SPAN_SUBSET_SUBSPACE];
      MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
      RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
      ASM_REWRITE_TAC[LE_REFL]]]);;

let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS = prove
 (`!f:real^N->real^N.
        linear f /\ adjoint f = f
        ==> ?b. pairwise orthogonal b /\
                (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\
                independent b /\
                span b = (:real^N) /\
                b HAS_SIZE (dimindex(:N))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`]
        SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE) THEN
  ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV; SUBSET_UNIV]);;

let EIGENVALUE_LOWERBOUND_DOT = prove
 (`!A:real^N^N a.
        symmetric_matrix A /\
        (!c v. A ** v = c % v /\ ~(v = vec 0) ==> a <= c)
        ==> !x. a * norm(x) pow 2 <= x dot (A ** x)`,
  REWRITE_TAC[symmetric_matrix] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x`
    SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN
  ASM_REWRITE_TAC[ADJOINT_MATRIX; MATRIX_VECTOR_MUL_LINEAR] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPEC `b:real^N->bool` ORTHONORMAL_BASIS_EXPAND_DOT) THEN
  ASM_SIMP_TAC[NORM_POW_2; IN_UNIV] THEN
  DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
  REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN
  ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE] THEN X_GEN_TAC `v:real^N` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N`) THEN
  ONCE_REWRITE_TAC[GSYM DOT_MATRIX_TRANSP_LMUL] THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real`)) THEN
  ASM_REWRITE_TAC[DOT_LMUL; REAL_ARITH `x * c * x:real = c * x * x`] THEN
  MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_SQUARE] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N` THEN
  ASM_REWRITE_TAC[] THEN UNDISCH_TAC `norm(v:real^N) = &1` THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[NORM_0] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let EIGENVALUE_LOWERBOUND_DOT_EQ = prove
 (`!A:real^N^N a.
        symmetric_matrix A
        ==> ((!c v. A ** v = c % v /\ ~(v = vec 0) ==> a <= c) <=>
             (!x. a * norm(x) pow 2 <= x dot (A ** x)))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [MATCH_MP_TAC EIGENVALUE_LOWERBOUND_DOT THEN ASM_MESON_TAC[];
    MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN
    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[DOT_RMUL; GSYM NORM_POW_2] THEN
    ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_POW_2; NORM_EQ_0]]);;

(* ------------------------------------------------------------------------- *)
(* Diagonalization of symmetric matrix.                                      *)
(* ------------------------------------------------------------------------- *)

let SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT = prove
 (`!A:real^N^N.
      symmetric_matrix A
      ==> ?P d. orthogonal_matrix P /\
                transp P ** A ** P = (lambda i j. if i = j then d i else &0)`,
  let lemma1 = prove
   (`!A:real^N^N P:real^N^N d.
       A ** P = P ** (lambda i j. if i = j then d i else &0) <=>
       !i. 1 <= i /\ i <= dimindex(:N)
           ==> A ** column i P = d i % column i P`,
    SIMP_TAC[CART_EQ; matrix_mul; matrix_vector_mul; LAMBDA_BETA;
             column; VECTOR_MUL_COMPONENT] THEN
    REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN
    SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN
    EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN
    REWRITE_TAC[REAL_MUL_SYM]) in
  let lemma2 = prove
   (`!A:real^N^N P:real^N^N d.
          orthogonal_matrix P /\
          transp P ** A ** P = (lambda i j. if i = j then d i else &0) <=>
          orthogonal_matrix P /\
          !i. 1 <= i /\ i <= dimindex(:N)
              ==> A ** column i P = d i % column i P`,
    REPEAT GEN_TAC THEN REWRITE_TAC[GSYM lemma1; orthogonal_matrix] THEN
    ABBREV_TAC `D:real^N^N = lambda i j. if i = j then d i else &0` THEN
    MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]) in
  REWRITE_TAC[symmetric_matrix] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[lemma2] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  REWRITE_TAC[GSYM SKOLEM_THM] THEN
  MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x`
    SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN
  ASM_SIMP_TAC[MATRIX_SELF_ADJOINT; symmetric_matrix; MATRIX_VECTOR_MUL_LINEAR;
               MATRIX_OF_MATRIX_VECTOR_MUL] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN
  REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
  REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN
  ASM_REWRITE_TAC[IN_NUMSEG; TAUT
   `p /\ q /\ x = y ==> a = b <=> p /\ q /\ ~(a = b) ==> ~(x = y)`] THEN
  DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC[pairwise; IN_NUMSEG] THEN STRIP_TAC THEN
  EXISTS_TAC `transp(lambda i. f i):real^N^N` THEN
  SIMP_TAC[COLUMN_TRANSP; ORTHOGONAL_MATRIX_TRANSP] THEN
  SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; row] THEN
  SIMP_TAC[LAMBDA_ETA; LAMBDA_BETA; pairwise; IN_NUMSEG] THEN
  ASM_MESON_TAC[]);;

let SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE = prove
 (`!A:real^N^N.
     symmetric_matrix A
     ==> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`,
  GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN
  MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SIMP_TAC[diagonal_matrix; LAMBDA_BETA]);;

let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE = prove
 (`!A:real^N^N.
     symmetric_matrix A <=>
     ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`,
  GEN_TAC THEN EQ_TAC THEN
  REWRITE_TAC[SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE] THEN
  REWRITE_TAC[symmetric_matrix; orthogonal_matrix] THEN
  DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC `D:real^N^N = transp P ** (A:real^N^N) ** P` THEN
  SUBGOAL_THEN `A:real^N^N = P ** (D:real^N^N) ** transp P` SUBST1_TAC THENL
   [EXPAND_TAC "D" THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID];
    REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC] THEN
    ASM_MESON_TAC[TRANSP_DIAGONAL_MATRIX]]);;

let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT = prove
 (`!A:real^N^N.
        symmetric_matrix A <=>
        ?P D. orthogonal_matrix P /\ diagonal_matrix D /\
              A = transp P ** D ** P`,
  GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE] THEN
  REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  MATCH_MP_TAC(MESON[TRANSP_TRANSP; ORTHOGONAL_MATRIX_TRANSP]
   `(!P. orthogonal_matrix P ==> (A(transp P) <=> B P))
    ==> ((?P. orthogonal_matrix P /\ A P) <=>
         (?P. orthogonal_matrix P /\ B P))`) THEN
  X_GEN_TAC `P:real^N^N` THEN DISCH_TAC THEN
  REWRITE_TAC[TRANSP_TRANSP] THEN EQ_TAC THENL
   [DISCH_TAC THEN EXISTS_TAC `(P:real^N^N) ** (A:real^N^N) ** transp P`;
    STRIP_TAC] THEN
  ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
  ASM_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
  ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
  ASM_REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]);;

(* ------------------------------------------------------------------------- *)
(* Hence deduce more general results using diagonalization.                  *)
(* ------------------------------------------------------------------------- *)

let TRACE_MATRIX_INV_LMUL = prove
 (`!A:real^N^M. trace(matrix_inv A ** A) = &(rank A)`,
  GEN_TAC THEN ONCE_REWRITE_TAC[GSYM RANK_MATRIX_INV_LMUL] THEN
  SUBGOAL_THEN
   `(matrix_inv(A:real^N^M) ** A) ** (matrix_inv A ** A) = matrix_inv A ** A`
  MP_TAC THENL
   [REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV_MUL_INNER];
    MP_TAC(ISPEC `A:real^N^M` SYMMETRIC_MATRIX_INV_LMUL)] THEN
  SPEC_TAC(`matrix_inv(A:real^N^M) ** A`,`A:real^N^N`) THEN GEN_TAC THEN
  REWRITE_TAC[SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM SUBST1_TAC THEN
  ASM_SIMP_TAC[ORTHOGONAL_MATRIX_IMP_INVERTIBLE; RANK_SIMILAR;
    GSYM ORTHOGONAL_MATRIX_INV; TRACE_SIMILAR; INVERTIBLE_MATRIX_INV;
    GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LCANCEL] THEN
  ASM_SIMP_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_RCANCEL;
               ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN
  GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN
  ASM_SIMP_TAC[MATRIX_INV; ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN
  REWRITE_TAC[MATRIX_MUL_RID] THEN
  ASM_SIMP_TAC[MATRIX_MUL_DIAGONAL; RANK_DIAGONAL_MATRIX; trace] THEN
  SIMP_TAC[CART_EQ; LAMBDA_BETA; REAL_RING
   `x * x = x <=> x = &0 \/ x = &1`] THEN
  DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
  SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG; FINITE_RESTRICT] THEN
  REWRITE_TAC[SUM_RESTRICT_SET] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
  ASM_MESON_TAC[]);;

let TRACE_MATRIX_INV_RMUL = prove
 (`!A:real^N^M. trace(A ** matrix_inv A) = &(rank A)`,
  ONCE_REWRITE_TAC[GSYM TRACE_TRANSP] THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_MATRIX_INV] THEN
  REWRITE_TAC[TRACE_MATRIX_INV_LMUL; RANK_TRANSP]);;

let IDEMPOTENT_MATRIX_TRACE_EQ_RANK = prove
 (`!A:real^N^N. A ** A = A ==> trace A = &(rank A)`,
  REPEAT STRIP_TAC THEN
  GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM MATRIX_INV_MUL_INNER] THEN
  ONCE_REWRITE_TAC[TRACE_MUL_CYCLIC] THEN
  ASM_REWRITE_TAC[TRACE_MATRIX_INV_LMUL]);;

let POSITIVE_SEMIDEFINITE_EIGENVALUES = prove
 (`!A:real^N^N. positive_semidefinite A <=>
                symmetric_matrix A /\
                !c v. A ** v = c % v /\ ~(v = vec 0) ==> &0 <= c`,
  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[positive_semidefinite];
    FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N` o CONJUNCT2 o
      REWRITE_RULE[positive_semidefinite]) THEN
    ASM_SIMP_TAC[DOT_RMUL; REAL_LE_MUL_EQ; DOT_POS_LT];
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN SUBST_ALL_TAC THEN
    MATCH_MP_TAC POSITIVE_SEMIDEFINITE_SIMILAR THEN
    MATCH_MP_TAC POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    EXISTS_TAC `transp(P:real^N^N) ** basis i` THEN CONJ_TAC THENL
     [ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_VECTOR_MUL_ASSOC] THEN
      REWRITE_TAC[MATRIX_MUL_RID; GSYM MATRIX_VECTOR_MUL_RMUL] THEN
      REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN
      FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN
      ASM_SIMP_TAC[LAMBDA_BETA; vector_mul; matrix_vector_mul; basis;
                   CART_EQ] THEN
      ONCE_REWRITE_TAC[COND_RAND] THEN
      ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID];
      DISCH_THEN(MP_TAC o AP_TERM `(**) P :real^N->real^N`) THEN
      ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID] THEN
      ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; BASIS_NONZERO]]]);;

let POSITIVE_DEFINITE_EIGENVALUES = prove
 (`!A:real^N^N. positive_definite A <=>
                symmetric_matrix A /\
                !c v. A ** v = c % v /\ ~(v = vec 0) ==> &0 < c`,
  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[positive_definite];
    FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N` o CONJUNCT2 o
      REWRITE_RULE[positive_definite]) THEN
    ASM_SIMP_TAC[DOT_RMUL; REAL_LT_MUL_EQ; DOT_POS_LT];
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN SUBST_ALL_TAC THEN
    MATCH_MP_TAC POSITIVE_DEFINITE_SIMILAR THEN
    ASM_SIMP_TAC[ORTHOGONAL_MATRIX_IMP_INVERTIBLE] THEN
    MATCH_MP_TAC POSITIVE_DEFINITE_DIAGONAL_MATRIX THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    EXISTS_TAC `transp(P:real^N^N) ** basis i` THEN CONJ_TAC THENL
     [ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_VECTOR_MUL_ASSOC] THEN
      REWRITE_TAC[MATRIX_MUL_RID; GSYM MATRIX_VECTOR_MUL_RMUL] THEN
      REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN
      FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN
      ASM_SIMP_TAC[LAMBDA_BETA; vector_mul; matrix_vector_mul; basis;
                   CART_EQ] THEN
      ONCE_REWRITE_TAC[COND_RAND] THEN
      ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID];
      DISCH_THEN(MP_TAC o AP_TERM `(**) P :real^N->real^N`) THEN
      ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID] THEN
      ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; BASIS_NONZERO]]]);;

let POSITIVE_SEMIDEFINITE_COVARIANCE_EQ,
    POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT = (CONJ_PAIR o prove)
 (`(!A:real^N^N. positive_semidefinite A <=>
                 ?S:real^N^N. A = transp S ** S) /\
   (!A:real^N^N. positive_semidefinite A <=>
                 ?S:real^N^N. positive_semidefinite S /\ A = transp S ** S)`,
  REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(r ==> q) /\ (q ==> p) /\ (p ==> r)
    ==> (p <=> q) /\ (p <=> r)`) THEN
  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
   [DISCH_THEN(X_CHOOSE_THEN `S:real^N^N` SUBST1_TAC) THEN
    REWRITE_TAC[positive_semidefinite; symmetric_matrix;
                MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN
    REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
    ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
    REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP; DOT_POS_LE];
    ALL_TAC] THEN
  REWRITE_TAC[positive_semidefinite; symmetric_matrix] THEN
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
   [REWRITE_RULE[symmetric_matrix]
     SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN EXISTS_TAC
   `transp P ** ((lambda i j. sqrt((D:real^N^N)$i$j)):real^N^N) **
    (P:real^N^N)` THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; GSYM CONJ_ASSOC] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN
    SIMP_TAC[CART_EQ; transp; LAMBDA_BETA] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [diagonal_matrix]) THEN
    DISCH_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN X_GEN_TAC `j:num` THEN
    DISCH_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN
    AP_TERM_TAC THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!i j. 1 <= i /\ i <= dimindex(:N) /\
          1 <= j /\ j <= dimindex(:N)
          ==> &0 <= (D:real^N^N)$i$j`
  ASSUME_TAC THENL
   [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
    ASM_CASES_TAC `j:num = i` THENL
     [UNDISCH_TAC `!x:real^N. &0 <= x dot (A ** x)` THEN EXPAND_TAC "A" THEN
      REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
      ONCE_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
      ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
      REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP] THEN
      DISCH_THEN(MP_TAC o SPEC `transp(P:real^N^N) ** basis i`) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
      ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_VECTOR_MUL_ASSOC] THEN
      ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
      ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LID; MATRIX_MUL_RID] THEN
      ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; DOT_BASIS] THEN
      ASM_SIMP_TAC[column; LAMBDA_BETA];
      MATCH_MP_TAC REAL_EQ_IMP_LE THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [diagonal_matrix]) THEN
      ASM_MESON_TAC[]];
    CONJ_TAC THENL
     [REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
      ONCE_REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
      ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
      REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_TRANSP] THEN
      REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
      X_GEN_TAC `x:real^N` THEN
      SPEC_TAC(`(P:real^N^N) ** (x:real^N)`,`y:real^N`) THEN
      SIMP_TAC[matrix_vector_mul; dot; LAMBDA_BETA] THEN
      X_GEN_TAC `y:real^N` THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN
      X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
      MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [diagonal_matrix]) THEN
      DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN
      ASM_CASES_TAC `j:num = i` THEN
      ASM_SIMP_TAC[SQRT_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_REFL] THEN
      ONCE_REWRITE_TAC[REAL_ARITH `y * a * y:real = a * y * y`] THEN
      MATCH_MP_TAC REAL_LE_MUL THEN
      ASM_SIMP_TAC[REAL_LE_SQUARE; SQRT_POS_LE];
      EXPAND_TAC "A" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
      AP_TERM_TAC THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
      AP_THM_TAC THEN AP_TERM_TAC THEN
      GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
      ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN
      REWRITE_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN] THEN
      SIMP_TAC[CART_EQ; LAMBDA_BETA; column; dot] THEN
      FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN
      SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
      X_GEN_TAC `j:num` THEN STRIP_TAC THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[COND_RAND] THEN
      REWRITE_TAC[SQRT_0] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
      REWRITE_TAC[REAL_MUL_RZERO] THEN
      ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN
      ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_MUL_LZERO]]]);;

let POSITIVE_SEMIDEFINITE_SQRT_EQ = prove
 (`!A:real^N^N.
        positive_semidefinite A <=>
        ?S:real^N^N. positive_semidefinite S /\ A = S ** S`,
  GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT] THEN
  REWRITE_TAC[positive_semidefinite; symmetric_matrix] THEN MESON_TAC[]);;

let POSITIVE_SEMIDEFINITE_SQRT = prove
 (`!A:real^N^N. positive_semidefinite A ==> ?S:real^N^N. A = S ** S`,
  ONCE_REWRITE_TAC[POSITIVE_SEMIDEFINITE_SQRT_EQ] THEN MESON_TAC[]);;

let POSITIVE_DEFINITE_COVARIANCE_EQ = prove
 (`!A:real^N^N.
        positive_definite A <=>
        ?S:real^N^N. invertible S /\ transp S ** S = A`,
  REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE;
              POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN
  MESON_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP]);;

let POSITIVE_DEFINITE_COVARIANCE_EQ_ALT = prove
 (`!A:real^N^N.
        positive_definite A <=> ?S. positive_definite S /\ transp S ** S = A`,
  GEN_TAC THEN REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE] THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
   [POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT] THEN
  MESON_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP]);;

let DET_POSITIVE_SEMIDEFINITE = prove
 (`!A:real^N^N. positive_semidefinite A ==> &0 <= det A`,
  ONCE_REWRITE_TAC[POSITIVE_SEMIDEFINITE_SQRT_EQ] THEN
  SIMP_TAC[DET_MUL; DET_TRANSP; REAL_LE_SQUARE; LEFT_IMP_EXISTS_THM]);;

let DET_POSITIVE_DEFINITE = prove
 (`!A:real^N^N. positive_definite A ==> &0 < det A`,
  SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; REAL_LT_LE;
           DET_POSITIVE_SEMIDEFINITE; INVERTIBLE_DET_NZ]);;

let POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY = prove
 (`!A:real^N^N i j.
        positive_semidefinite A /\
        1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N)
        ==> A$i$j pow 2 <= A$i$i * A$j$j`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP POSITIVE_SEMIDEFINITE_SUBMATRIX_2) THEN
  DISCH_THEN(MP_TAC o MATCH_MP DET_POSITIVE_SEMIDEFINITE) THEN
  REWRITE_TAC[DET_2; VECTOR_2] THEN FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN
  REWRITE_TAC[positive_semidefinite; symmetric_matrix] THEN
  DISCH_THEN(MP_TAC o CONJUNCT1) THEN SIMP_TAC[CART_EQ] THEN
  DISCH_THEN(MP_TAC o SPEC`i:num`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN
  ASM_SIMP_TAC[transp; LAMBDA_BETA] THEN REAL_ARITH_TAC);;

let TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE = prove
 (`!A:real^N^N.
        positive_semidefinite A ==> trace(transp A ** A) <= trace(A) pow 2`,
  REPEAT STRIP_TAC THEN
  SIMP_TAC[trace; matrix_mul; LAMBDA_BETA; transp; REAL_POW_2] THEN
  REWRITE_TAC[GSYM SUM_RMUL] THEN
  MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `m:num` THEN
  STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
  MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN
  STRIP_TAC THEN REWRITE_TAC[GSYM REAL_POW_2] THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY]);;

let TRACE_SQUARE_POSITIVE_SEMIDEFINITE_LE = prove
 (`!A:real^N^N.
        positive_semidefinite A ==> trace(A ** A) <= trace(A) pow 2`,
  MESON_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC;
            TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE]);;

let TRACE_MUL_POSITIVE_SEMIDEFINITE_LE = prove
 (`!A B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B
        ==> trace(A ** B) <= trace(A) * trace(B)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`A:real^N^N`; `B:real^N^N`]
        TRACE_COVARIANCE_CAUCHY_SCHWARZ) THEN
  MATCH_MP_TAC(REAL_ARITH `x = y /\ w <= z ==> x <= w ==> y <= z`) THEN
  CONJ_TAC THENL
   [ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC]; ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_MUL2 THEN
  SIMP_TAC[SQRT_POS_LE; TRACE_COVARIANCE_POS_LE] THEN
  CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LSQRT THEN
  ASM_SIMP_TAC[TRACE_POSITIVE_SEMIDEFINITE] THEN
  ASM_SIMP_TAC[TRACE_COVARIANCE_POSITIVE_SEMIDEFINITE_LE]);;

let POSITIVE_SEMIDEFINITE_ZERO_ROW = prove
 (`!A:real^N^N i.
        positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) /\ A$i$i = &0
        ==> row i A = vec 0`,
  REPEAT STRIP_TAC THEN SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT] THEN
  X_GEN_TAC `j:num` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`A:real^N^N`; `i:num`; `j:num`]
   POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY) THEN
  ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LE_POW_2; REAL_ARITH
   `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN
  CONV_TAC REAL_RING);;

let POSITIVE_SEMIDEFINITE_ZERO_COLUMN = prove
 (`!A:real^N^N i.
        positive_semidefinite A /\ 1 <= i /\ i <= dimindex(:N) /\ A$i$i = &0
        ==> column i A = vec 0`,
  REPEAT STRIP_TAC THEN
  SIMP_TAC[CART_EQ; column; LAMBDA_BETA; VEC_COMPONENT] THEN
  X_GEN_TAC `j:num` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`A:real^N^N`; `j:num`; `i:num`]
   POSITIVE_SEMIDEFINITE_DIAGONAL_INEQUALITY) THEN
  ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_LE_POW_2; REAL_ARITH
   `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN
  CONV_TAC REAL_RING);;

let POSITIVE_SEMIDEFINITE_TRACE_EQ_0 = prove
 (`!A:real^N^N. positive_semidefinite A ==> (trace A = &0 <=> A = mat 0)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[TRACE_0] THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[MATRIX_EQUAL_ROWS] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [trace]) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        SUM_POS_EQ_0_NUMSEG)) THEN
  ASM_SIMP_TAC[DIAGONAL_POSITIVE_SEMIDEFINITE; ROW_0] THEN
  ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_ZERO_ROW]);;

let COVARIANCE_MATRIX_EQ_SQUARE = prove
 (`!A:real^N^N. transp A ** A = A ** A <=> symmetric_matrix A`,
  REWRITE_TAC[symmetric_matrix] THEN GEN_TAC THEN
  EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
  MP_TAC(ISPEC `transp A - A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE) THEN
  DISCH_THEN(MP_TAC o MATCH_MP POSITIVE_SEMIDEFINITE_TRACE_EQ_0) THEN
  REWRITE_TAC[COVARIANCE_MATRIX_EQ_0; MATRIX_SUB_EQ] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  ASM_REWRITE_TAC[TRANSP_MATRIX_SUB; TRANSP_TRANSP] THEN
  REWRITE_TAC[MATRIX_SUB_LDISTRIB] THEN
  ASM_REWRITE_TAC[MATRIX_SUB_RDISTRIB; MATRIX_SUB_REFL; MATRIX_SUB_RZERO] THEN
  REWRITE_TAC[TRACE_SUB; REAL_SUB_0] THEN
  ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRACE_TRANSP]);;

let TRACE_MUL_POSITIVE_SEMIDEFINITE,TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0 =
  (CONJ_PAIR o prove)
  (`(!A:real^N^N B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B
        ==> &0 <= trace(A ** B)) /\
    (!A:real^N^N B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B
        ==> (trace(A ** B) = &0 <=> A ** B = mat 0))`,
  let lemma = prove
   (`!A:real^N^N B:real^N^N.
          trace((transp A ** A) ** (transp B ** B)) =
          trace(transp(A ** transp B) ** (A ** transp B))`,
    REPEAT GEN_TAC THEN
     GEN_REWRITE_TAC LAND_CONV [GSYM TRACE_MUL_CYCLIC]  THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; GSYM MATRIX_MUL_ASSOC]) in
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
  REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN
  STRIP_TAC THEN
  SIMP_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`; TRACE_0] THEN
  ASM_REWRITE_TAC[lemma] THEN
  SIMP_TAC[POSITIVE_SEMIDEFINITE_TRACE_EQ_0; POSITIVE_SEMIDEFINITE_COVARIANCE;
           TRACE_POSITIVE_SEMIDEFINITE; COVARIANCE_MATRIX_EQ_0] THEN
  DISCH_TAC THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
  GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MATRIX_MUL_ASSOC] THEN
  ASM_REWRITE_TAC[MATRIX_MUL_LZERO; MATRIX_MUL_RZERO]);;

let TRACE_MUL_POSITIVE_SEMIDEFINITE_DEFINITE_EQ_0 = prove
 (`!A:real^N^N B:real^N^N.
        positive_semidefinite A /\ positive_definite B
        ==> (trace(A ** B) = &0 <=> A = mat 0)`,
  SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; MATRIX_ENTIRE;
           TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0]);;

let TRACE_MUL_POSITIVE_DEFINITE_SEMIDEFINITE_EQ_0 = prove
 (`!A:real^N^N B:real^N^N.
        positive_definite A /\ positive_semidefinite B
        ==> (trace(A ** B) = &0 <=> B = mat 0)`,
  SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; MATRIX_ENTIRE;
           TRACE_MUL_POSITIVE_SEMIDEFINITE_EQ_0]);;

let POSITIVE_SEMIDEFINITE_AND_ORTHOGONAL = prove
 (`!A:real^N^N.
        positive_semidefinite A /\ orthogonal_matrix A
        ==> A = mat 1`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o CONJUNCT1 o
   GEN_REWRITE_RULE I [positive_semidefinite]) THEN
  REWRITE_TAC[SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN
  SUBGOAL_THEN `D:real^N^N = mat 1`
   (fun th -> ASM_MESON_TAC[MATRIX_MUL_LID; orthogonal_matrix; th]) THEN
  SUBGOAL_THEN
   `positive_semidefinite(D:real^N^N) /\ orthogonal_matrix D`
  MP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o AP_TERM
     `\X:real^N^N. Q ** X ** transp(Q:real^N^N)`) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM orthogonal_matrix]) THEN
    ASM_MESON_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP;
                  POSITIVE_SEMIDEFINITE_SIMILAR; TRANSP_TRANSP];
    DISCH_THEN(CONJUNCTS_THEN2
     (MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
                  DIAGONAL_POSITIVE_SEMIDEFINITE))
     (MP_TAC o CONJUNCT1 o
       REWRITE_RULE[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED]))] THEN
  FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN
  SIMP_TAC[LAMBDA_BETA; NORM_EQ_SQUARE; row; dot; CART_EQ] THEN
  REWRITE_TAC[MESON[]
   `(if i = j then x else y:real) * (if i = j then a else b) =
    (if j = i then x * a else y * b)`] THEN
  SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_POS; FINITE_NUMSEG] THEN
  SIMP_TAC[mat; LAMBDA_BETA; IN_NUMSEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
  SUBGOAL_THEN `!x. x * x = &1 /\ &0 <= x ==> x = &1`
   (fun th -> MESON_TAC[th]) THEN
  REWRITE_TAC[REAL_RING `x * x = &1 <=> x = &1 \/ x = -- &1`] THEN
  REAL_ARITH_TAC);;

let POSITIVE_SEMIDEFINITE_INV = prove
 (`!A:real^N^N.
     positive_semidefinite(matrix_inv A) <=> positive_semidefinite A`,
  SUBGOAL_THEN
   `!A:real^N^N. positive_semidefinite A
                 ==> positive_semidefinite(matrix_inv A)`
  MP_TAC THENL [GEN_TAC; MESON_TAC[MATRIX_INV_INV]] THEN
  REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN
  DISCH_THEN(X_CHOOSE_THEN `S:real^N^N` SUBST1_TAC) THEN
  REWRITE_TAC[MATRIX_INV_COVARIANCE] THEN MESON_TAC[TRANSP_TRANSP]);;

let POSITIVE_DEFINITE_INV = prove
 (`!A:real^N^N.
     positive_definite(matrix_inv A) <=> positive_definite A`,
  REWRITE_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE;
              POSITIVE_SEMIDEFINITE_INV; INVERTIBLE_MATRIX_INV]);;

let POSITIVE_DEFINITE_COFACTOR = prove
 (`!A:real^N^N. positive_definite A ==> positive_definite(cofactor A)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP POSITIVE_DEFINITE_IMP_INVERTIBLE) THEN
  REWRITE_TAC[INVERTIBLE_DET_NZ] THEN
  DISCH_THEN(SUBST1_TAC o MATCH_MP COFACTOR_MATRIX_INV) THEN
  MATCH_MP_TAC POSITIVE_DEFINITE_CMUL THEN
  ASM_SIMP_TAC[POSITIVE_DEFINITE_TRANSP; POSITIVE_DEFINITE_INV] THEN
  ASM_SIMP_TAC[DET_POSITIVE_DEFINITE]);;

let POSITIVE_SEMIDEFINITE_COFACTOR = prove
 (`!A:real^N^N. positive_semidefinite A ==> positive_semidefinite(cofactor A)`,
  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[positive_semidefinite] THEN
  REWRITE_TAC[symmetric_matrix; GSYM COFACTOR_TRANSP] THEN
  ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC] THEN
  X_GEN_TAC `v:real^N` THEN ASM_CASES_TAC `v:real^N = vec 0` THEN
  ASM_REWRITE_TAC[DOT_LZERO; REAL_LE_REFL] THEN
  SUBGOAL_THEN
   `!x. x IN closure(interval(vec 0,vec 1))
        ==> lift(v dot (cofactor(A + drop x %% mat 1:real^N^N) ** v)) IN
            {t | &0 <= drop t}`
  MP_TAC THENL
   [MATCH_MP_TAC FORALL_IN_CLOSURE;
    REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN
    SIMP_TAC[CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
    DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN
    REWRITE_TAC[DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN
    REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]] THEN
  REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN
  SIMP_TAC[CLOSURE_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE];
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN
    REWRITE_TAC[cofactor; CONTINUOUS_ON_CONST] THEN
    ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
    X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT] THEN
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_CONST; LAMBDA_BETA] THEN
    ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
    X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN SIMP_TAC[LAMBDA_BETA] THEN
    MAP_EVERY X_GEN_TAC [`k:num`; `l:num`] THEN STRIP_TAC THEN
    ASM_CASES_TAC `k:num = i /\ l:num = j` THEN
    ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    ASM_CASES_TAC `k:num = i \/ l:num = j` THEN
    ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN
    MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_DROP; o_DEF; CONTINUOUS_ON_ID];
    REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
    X_GEN_TAC `x:real` THEN STRIP_TAC THEN MP_TAC
     (ISPECL [`A:real^N^N`; `x:real`] NEARBY_POSITIVE_DEFINITE_MATRIX) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP POSITIVE_DEFINITE_COFACTOR) THEN
    ASM_SIMP_TAC[positive_definite; REAL_LT_IMP_LE]]);;

let POSITIVE_DEFINITE_COFACTOR_EQ = prove
 (`!A:real^N^N.
        positive_definite A <=>
        positive_definite(cofactor A) /\ &0 < det A`,
  GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
   [ASM_SIMP_TAC[COFACTOR_1_GEN; DET_1_GEN; POSITIVE_DEFINITE_ID] THEN
    ASM_SIMP_TAC[POSITIVE_DEFINITE_1_GEN];
    EQ_TAC THEN
    SIMP_TAC[POSITIVE_DEFINITE_COFACTOR; DET_POSITIVE_DEFINITE] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP POSITIVE_DEFINITE_COFACTOR) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN
    SIMP_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN
    ASM_SIMP_TAC[COFACTOR_COFACTOR] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(det(A:real^N^N) pow (dimindex (:N) - 2))` o
        MATCH_MP(REWRITE_RULE[IMP_CONJ] POSITIVE_DEFINITE_CMUL)) THEN
    ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; MATRIX_CMUL_ASSOC;
                 REAL_MUL_LINV; REAL_LT_IMP_NZ; MATRIX_CMUL_LID]]);;

let POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE = prove
 (`!A:real^N^N. positive_semidefinite A <=>
                ?!S. positive_semidefinite S /\ A = transp S ** S`,
  GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC; MESON_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT]] THEN
  REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ_ALT]; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`S:real^N^N`; `U:real^N^N`] THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  ONCE_REWRITE_TAC[GSYM MATRIX_SUB_EQ] THEN
  ONCE_REWRITE_TAC[GSYM COVARIANCE_MATRIX_EQ_0] THEN
  REWRITE_TAC[MATRIX_SUB_LDISTRIB] THEN
  REWRITE_TAC[TRANSP_MATRIX_SUB; MATRIX_SUB_RDISTRIB] THEN
  ASM_REWRITE_TAC[MATRIX_SUB_EQ] THEN
  SUBGOAL_THEN `transp(U:real^N^N) ** (S:real^N^N) = A` ASSUME_TAC THENL
   [ALL_TAC;
    ASM_REWRITE_TAC[MATRIX_SUB_REFL] THEN CONV_TAC SYM_CONV THEN
    REWRITE_TAC[MATRIX_SUB_EQ] THEN
    GEN_REWRITE_TAC BINOP_CONV [GSYM TRANSP_TRANSP] THEN
    ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    ASM_REWRITE_TAC[TRANSP_TRANSP] THEN
    ASM_MESON_TAC[positive_semidefinite; symmetric_matrix]] THEN
  SUBGOAL_THEN `symmetric_matrix(S:real^N^N) /\ symmetric_matrix(U:real^N^N)`
  MP_TAC THENL [ASM_MESON_TAC[positive_semidefinite]; ALL_TAC] THEN
  REWRITE_TAC[IMP_CONJ; SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`O:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`P:real^N^N`; `C:real^N^N`] THEN STRIP_TAC THEN
  ABBREV_TAC `Q = (P:real^N^N) ** transp(O:real^N^N)` THEN
  SUBGOAL_THEN `(Q:real^N^N) ** (D ** D) = (C ** C) ** Q` MP_TAC THENL
   [UNDISCH_TAC `transp(S:real^N^N) ** S = A` THEN
    UNDISCH_TAC `transp(U:real^N^N) ** U = A` THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN
    REWRITE_TAC[MESON[MATRIX_MUL_ASSOC]
     `(A ** (Q:real^N^N)) ** (Q':real^N^N) ** C =
      (A:real^N^N) ** (Q ** Q') ** (C:real^N^N)`] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN DISCH_THEN(MP_TAC o
      AP_TERM `\X:real^N^N. (P:real^N^N) ** X ** transp(O:real^N^N)`) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN
    ASM_SIMP_TAC[TRANSP_DIAGONAL_MATRIX];
    TRANS_TAC (TAUT `!q. (p ==> q) /\ (q ==> r) ==> p ==> r`)
      `(Q:real^N^N) ** (D:real^N^N) = C ** (Q:real^N^N)` THEN
    CONJ_TAC THENL
     [REPEAT(FIRST_X_ASSUM
       (SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX])) THEN
      SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN
      REPLICATE_TAC 2
       (REWRITE_TAC[MESON[REAL_MUL_LZERO]
         `(if a = b then x else &0) * y = if b = a then x * y else &0`] THEN
       SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN
       REWRITE_TAC[MESON[REAL_MUL_RZERO]
         `u * (if p then x else &0) = if p then u * x else &0`] THEN
       SIMP_TAC[SUM_DELTA; IN_NUMSEG]) THEN
      MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
      DISCH_THEN(fun t -> STRIP_TAC THEN MP_TAC t THEN ASM_REWRITE_TAC[]) THEN
      MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN
      DISCH_THEN(fun t -> STRIP_TAC THEN MP_TAC t THEN ASM_REWRITE_TAC[]) THEN
      MATCH_MP_TAC(REAL_RING
       `(c + d = &0 ==> c = &0 /\ d = &0)
        ==> q * d * d = (c * c) * q ==> q * d = c * q`) THEN
      MATCH_MP_TAC(REAL_FIELD
       `&0 <= c /\ &0 <= d ==> c + d = &0 ==> c = &0 /\ d = &0`) THEN
      CONJ_TAC THEN
      MATCH_MP_TAC DIAGONAL_POSITIVE_SEMIDEFINITE THEN
      ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR_EQ;
                    ORTHOGONAL_MATRIX_IMP_INVERTIBLE];
      DISCH_TAC THEN ASM_REWRITE_TAC[TRANSP_TRANSP; MATRIX_TRANSP_MUL] THEN
      ASM_REWRITE_TAC[MESON[MATRIX_MUL_ASSOC]
       `(A ** (Q:real^N^N)) ** (Q':real^N^N) ** C =
        (A:real^N^N) ** (Q ** Q') ** (C:real^N^N)`] THEN
      UNDISCH_THEN `transp(U:real^N^N) ** U = A` (SUBST1_TAC o SYM) THEN
      ASM_REWRITE_TAC[TRANSP_TRANSP; MATRIX_TRANSP_MUL] THEN
      EXPAND_TAC "Q" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
      ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
      ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]]]);;

let POSITIVE_SEMIDEFINITE_SQRT_UNIQUE = prove
 (`!A:real^N^N. positive_semidefinite A <=>
                ?!S. positive_semidefinite S /\ A = S ** S`,
  GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE] THEN
  REWRITE_TAC[positive_semidefinite; symmetric_matrix] THEN MESON_TAC[]);;

let POSITIVE_SEMIDEFINITE_MUL_EQ = prove
 (`!A:real^N^N B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B
        ==> (positive_semidefinite(A ** B) <=> A ** B = B ** A)`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC EQ_TRANS `transp(A ** (B:real^N^N)) = A ** B` THEN CONJ_TAC THENL
   [ALL_TAC;
    ASM_MESON_TAC[MATRIX_TRANSP_MUL; symmetric_matrix;
                  positive_semidefinite]] THEN
  EQ_TAC THENL
   [MESON_TAC[positive_semidefinite; symmetric_matrix]; DISCH_TAC] THEN
  ASM_REWRITE_TAC[POSITIVE_SEMIDEFINITE_EIGENVALUES; symmetric_matrix] THEN
  MP_TAC(ISPEC `A:real^N^N` POSITIVE_SEMIDEFINITE_SQRT_EQ) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `S:real^N^N` THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `positive_semidefinite(S ** (B:real^N^N) ** S)` MP_TAC THENL
   [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR;
                  positive_semidefinite; symmetric_matrix];
    ASM_REWRITE_TAC[POSITIVE_SEMIDEFINITE_EIGENVALUES]] THEN
  REWRITE_TAC[MATRIX_MUL_ASSOC] THEN STRIP_TAC THEN
  REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
  ASM_MESON_TAC[SAME_EIGENVALUES_MATRIX_MUL]);;

let POSITIVE_SEMIDEFINITE_MUL = prove
 (`!A:real^N^N B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B /\ A ** B = B ** A
        ==> positive_semidefinite(A ** B)`,
  SIMP_TAC[POSITIVE_SEMIDEFINITE_MUL_EQ]);;

let POSITIVE_DEFINITE_MUL_EQ = prove
 (`!A:real^N^N B:real^N^N.
        positive_definite A /\ positive_definite B
        ==> (positive_definite(A ** B) <=> A ** B = B ** A)`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC EQ_TRANS `transp(A ** (B:real^N^N)) = A ** B` THEN CONJ_TAC THENL
   [ALL_TAC;
    ASM_MESON_TAC[MATRIX_TRANSP_MUL; symmetric_matrix;
                  positive_definite]] THEN
  EQ_TAC THENL [MESON_TAC[positive_definite; symmetric_matrix]; DISCH_TAC] THEN
  ASM_REWRITE_TAC[POSITIVE_DEFINITE_EIGENVALUES; symmetric_matrix] THEN
  MP_TAC(ISPEC `A:real^N^N` POSITIVE_SEMIDEFINITE_SQRT_EQ) THEN
  ASM_SIMP_TAC[POSITIVE_DEFINITE_IMP_POSITIVE_SEMIDEFINITE] THEN
  DISCH_THEN(X_CHOOSE_THEN `S:real^N^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `positive_definite(S ** (B:real^N^N) ** S)` MP_TAC THENL
   [ASM_MESON_TAC[POSITIVE_DEFINITE_SIMILAR; positive_definite;
        symmetric_matrix;
      POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE; INVERTIBLE_MATRIX_MUL];
    ASM_REWRITE_TAC[POSITIVE_DEFINITE_EIGENVALUES]] THEN
  REWRITE_TAC[MATRIX_MUL_ASSOC] THEN STRIP_TAC THEN
  REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
  ASM_MESON_TAC[SAME_EIGENVALUES_MATRIX_MUL]);;

let POSITIVE_DEFINITE_MUL = prove
 (`!A:real^N^N B:real^N^N.
        positive_definite A /\ positive_definite B /\ A ** B = B ** A
        ==> positive_definite(A ** B)`,
  SIMP_TAC[POSITIVE_DEFINITE_MUL_EQ]);;

let COMMUTING_WITH_SQUARE_ROOT_MATRIX = prove
 (`!A S B:real^N^N.
        positive_semidefinite S /\ S ** S = A /\ A ** B = B ** A
        ==> S ** B = B ** S`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `S:real^N^N` SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT) THEN
  DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL
   [ASM_MESON_TAC[positive_semidefinite]; ALL_TAC] THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  UNDISCH_TAC `(A:real^N^N) ** (B:real^N^N) = B ** A` THEN
  SUBGOAL_THEN
   `!C. (C:real^N^N) ** (B:real^N^N) = B ** C <=>
        (Q ** C ** transp(Q:real^N^N)) ** (Q ** B ** transp(Q:real^N^N)) =
        (Q ** B ** transp(Q:real^N^N)) ** (Q ** C ** transp(Q:real^N^N))`
   (fun th -> ONCE_REWRITE_TAC[th])
  THENL
   [GEN_TAC THEN EQ_TAC THENL
     [DISCH_THEN(MP_TAC o AP_TERM
        `\X:real^N^N. Q ** X ** transp(Q:real^N^N)`);
      DISCH_THEN(MP_TAC o AP_TERM
        `\X:real^N^N. transp(Q:real^N^N) ** X ** Q`)] THEN
    REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN
    REWRITE_TAC[MATRIX_MUL_ASSOC] THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID] THEN
    REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID];
    ALL_TAC] THEN
  SUBGOAL_THEN `(Q:real^N^N) ** (S:real^N^N) ** transp Q = D` ASSUME_TAC THENL
   [EXPAND_TAC "S" THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `(Q:real^N^N) ** (A:real^N^N) ** transp Q = (D:real^N^N) ** D`
  ASSUME_TAC THENL
   [EXPAND_TAC "A" THEN EXPAND_TAC "D" THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN REPEAT AP_TERM_TAC THEN
    EXPAND_TAC "S" THEN REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
    ASM_REWRITE_TAC[MATRIX_MUL_RID];
    ALL_TAC] THEN
  GEN_REWRITE_TAC BINOP_CONV [EQ_SYM_EQ] THEN
  ASM_SIMP_TAC[COMMUTING_WITH_DIAGONAL_MATRIX; DIAGONAL_MATRIX_MUL] THEN
  ASM_SIMP_TAC[DIAGONAL_MATRIX_MUL_COMPONENT] THEN
  REWRITE_TAC[REAL_RING `x * x:real = y * y <=> x = y \/ x = --y`] THEN
  SUBGOAL_THEN `positive_semidefinite(D:real^N^N)` ASSUME_TAC THENL
   [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR; TRANSP_TRANSP;
                  ORTHOGONAL_MATRIX_IMP_INVERTIBLE; INVERTIBLE_TRANSP];
    ASM_SIMP_TAC[DIAGONAL_POSITIVE_SEMIDEFINITE; REAL_ARITH
     `&0 <= x /\ &0 <= y ==> (x = y \/ x = --y <=> x = y)`]]);;

let POSITIVE_SEMIDEFINITE_MUL_EIGENVALUES = prove
 (`!A B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B
        ==> !c v. (A ** B) ** v = c % v /\ ~(v = vec 0) ==> &0 <= c`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ] THEN STRIP_TAC THEN
  REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
  ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
  ONCE_REWRITE_TAC[SAME_EIGENVALUES_MATRIX_MUL] THEN
  ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
  GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o BINDER_CONV o
    RAND_CONV o funpow 4 LAND_CONV) [GSYM TRANSP_TRANSP] THEN
  ONCE_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
  REWRITE_TAC[TRANSP_TRANSP; GSYM MATRIX_MUL_ASSOC] THEN
  ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MESON_TAC[POSITIVE_SEMIDEFINITE_EIGENVALUES;
            POSITIVE_SEMIDEFINITE_COVARIANCE]);;

let POSITIVE_SEMIDEFINITE_2_DET = prove
 (`!A:real^2^2. positive_semidefinite A <=>
                symmetric_matrix A /\
                &0 <= A$1$1 /\ &0 <= A$2$2 /\ &0 <= det A`,
  GEN_TAC THEN EQ_TAC THENL
   [SIMP_TAC[DIAGONAL_POSITIVE_SEMIDEFINITE; DIMINDEX_2; ARITH] THEN
    MESON_TAC[DET_POSITIVE_SEMIDEFINITE; positive_semidefinite];
    STRIP_TAC THEN ASM_REWRITE_TAC[positive_semidefinite]] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[symmetric_matrix]) THEN
  SIMP_TAC[matrix_vector_mul; DOT_2; FORALL_VECTOR_2; VECTOR_2; ARITH;
           LAMBDA_BETA; DIMINDEX_2; SUM_2] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DET_2]) THEN
  SUBGOAL_THEN `(A:real^2^2)$2$1 = A$1$2` SUBST1_TAC THENL
   [ASM_MESON_TAC[TRANSP_COMPONENT]; REWRITE_TAC[REAL_SUB_LE]] THEN
  ASM_CASES_TAC `(A:real^2^2)$2$2 = &0` THENL
   [DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
     `x <= a ==> &0 <= x /\ a = &0 ==> x = &0`)) THEN
    ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN
    GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `y * a * y:real = a * y * y`] THEN
    ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_SQUARE];
    DISCH_TAC] THEN
  REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
  EXISTS_TAC `(A:real^2^2)$2$2` THEN
  ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_LE] THEN
  REWRITE_TAC[REAL_ARITH
   `c * (x * (a * x + b * y) + y * (b * x + c * y)) =
    (b * x + c * y) pow 2 + (a * c - b pow 2) * x pow 2`] THEN
  MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_LE_POW_2] THEN
  MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN
  ASM_REAL_ARITH_TAC);;

let POSITIVE_SEMIDEFINITE_2 = prove
 (`!A:real^2^2. positive_semidefinite A <=>
                A$2$1 = A$1$2 /\
                &0 <= A$1$1 /\ &0 <= A$2$2 /\ A$1$2 pow 2 <= A$1$1 * A$2$2`,
  REPEAT GEN_TAC THEN REWRITE_TAC[POSITIVE_SEMIDEFINITE_2_DET; DET_2] THEN
  REWRITE_TAC[symmetric_matrix] THEN
  SIMP_TAC[CART_EQ; FORALL_2; TRANSP_COMPONENT; DIMINDEX_2] THEN
  ASM_CASES_TAC `(A:real^2^2)$2$1 = A$1$2` THEN
  ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;

let POSITIVE_DEFINITE_2_DET = prove
 (`!A:real^2^2. positive_definite A <=>
                symmetric_matrix A /\ &0 < A$1$1 /\ &0 < A$2$2 /\ &0 < det A`,
  GEN_TAC THEN EQ_TAC THENL
   [SIMP_TAC[DIAGONAL_POSITIVE_DEFINITE; DIMINDEX_2; ARITH] THEN
    MESON_TAC[DET_POSITIVE_DEFINITE; positive_definite];
    STRIP_TAC THEN ASM_SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE]] THEN
  ASM_REWRITE_TAC[POSITIVE_SEMIDEFINITE_2_DET; INVERTIBLE_DET_NZ] THEN
  ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_LT_IMP_LE]);;

let POSITIVE_DEFINITE_2 = prove
 (`!A:real^2^2. positive_definite A <=>
                A$2$1 = A$1$2 /\
                &0 < A$1$1 /\ &0 < A$2$2 /\ A$1$2 pow 2 < A$1$1 * A$2$2`,
  REPEAT GEN_TAC THEN REWRITE_TAC[POSITIVE_DEFINITE_2_DET; DET_2] THEN
  REWRITE_TAC[symmetric_matrix] THEN
  SIMP_TAC[CART_EQ; FORALL_2; TRANSP_COMPONENT; DIMINDEX_2] THEN
  ASM_CASES_TAC `(A:real^2^2)$2$1 = A$1$2` THEN
  ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;

let REAL_LE_NORM_MATRIX_MUL_DET = prove
 (`!A B:real^N^N.
        (!x. norm(A ** x) <= norm(B ** x)) ==> abs(det A) <= abs(det B)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `det(B:real^N^N) = &0` THENL
   [ASM_REWRITE_TAC[DET_0; REAL_ARITH `abs x <= abs(&0) <=> x = &0`] THEN
    REWRITE_TAC[GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[NORM_ARITH `norm(x:real^N) <= &0 <=> x = vec 0`; NORM_0];
    ALL_TAC] THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
  ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; GSYM REAL_ABS_DIV] THEN
  REWRITE_TAC[real_div; GSYM DET_MATRIX_INV; GSYM DET_MUL] THEN
  SUBGOAL_THEN
   `!x:real^N. norm(((A:real^N^N) ** matrix_inv B) ** x) <= norm(x)`
  MP_TAC THENL
   [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
    TRANS_TAC REAL_LE_TRANS
     `norm(B ** matrix_inv(B:real^N^N) ** (x:real^N))` THEN
    ASM_REWRITE_TAC[] THEN
    ASM_SIMP_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_MUL_RINV] THEN
    REWRITE_TAC[MATRIX_VECTOR_MUL_LID; REAL_LE_REFL];
    POP_ASSUM_LIST(K ALL_TAC) THEN
    SPEC_TAC(`(A:real^N^N) ** matrix_inv(B:real^N^N)`,`A:real^N^N`)] THEN
  REPEAT STRIP_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ABS_NUM] THEN
  REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN
  TRANS_TAC REAL_LE_TRANS `det(transp(A:real^N^N) ** A)` THEN CONJ_TAC THENL
   [REWRITE_TAC[DET_MUL; DET_TRANSP] THEN REAL_ARITH_TAC; ALL_TAC] THEN
  SUBGOAL_THEN
   `!x. norm(transp A ** (A:real^N^N) ** x) <= norm(x)`
  MP_TAC THENL
   [X_GEN_TAC `y:real^N` THEN
    TRANS_TAC REAL_LE_TRANS `norm((A:real^N^N) ** (y:real^N))` THEN
    ASM_REWRITE_TAC[] THEN
    SPEC_TAC(`(A:real^N^N) ** (y:real^N)`,`x:real^N`) THEN GEN_TAC THEN
    ASM_CASES_TAC `transp(A:real^N^N) ** x = vec 0` THEN
    ASM_REWRITE_TAC[NORM_0; NORM_POS_LE] THEN
    MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN
    EXISTS_TAC `norm(transp(A:real^N^N) ** x)` THEN
    ASM_REWRITE_TAC[NORM_POS_LT; NORM_POW_2; GSYM REAL_POW_2] THEN
    REWRITE_TAC[DOT_MATRIX_TRANSP_LMUL] THEN
    W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ o lhand o snd) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_POS_LE];
    REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; REAL_POW_ONE] THEN
    MP_TAC(ISPEC `A:real^N^N` POSITIVE_SEMIDEFINITE_COVARIANCE) THEN
    POP_ASSUM(K ALL_TAC) THEN
    SPEC_TAC(`transp(A:real^N^N) ** A`,`A:real^N^N`)] THEN
  GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP
    POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC_MATRIX) THEN
  REWRITE_TAC[SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN
  STRIP_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[DET_MUL] THEN
  ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (a * c) * b`] THEN
  ONCE_REWRITE_TAC[GSYM DET_MUL] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
  ASM_REWRITE_TAC[DET_I; REAL_MUL_LID] THEN
  MATCH_MP_TAC(REAL_ARITH `abs x <= &1 ==> x <= &1`) THEN
  ASM_SIMP_TAC[DET_DIAGONAL; GSYM PRODUCT_ABS; FINITE_NUMSEG] THEN
  MATCH_MP_TAC PRODUCT_LE_1 THEN REWRITE_TAC[FINITE_NUMSEG] THEN
  X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG; REAL_ABS_POS] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `transp(Q:real^N^N) ** basis k`) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM orthogonal_matrix]) THEN
  ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; NORM_BASIS;
               ORTHOGONAL_MATRIX_NORM; ORTHOGONAL_MATRIX_TRANSP] THEN
  REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
  ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN
  ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS] THEN
  MP_TAC(ISPECL [`column k (D:real^N^N)`; `k:num`] COMPONENT_LE_NORM) THEN
  ASM_SIMP_TAC[column; LAMBDA_BETA] THEN REAL_ARITH_TAC);;

let DET_LE_ONORM_POW = prove
 (`!A:real^N^N. abs(det A) <= onorm(\x. A ** x) pow (dimindex(:N))`,
  REPEAT GEN_TAC THEN TRANS_TAC REAL_LE_TRANS
   `abs(det(onorm(\x. (A:real^N^N) ** x) %% mat 1:real^N^N))` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC REAL_LE_NORM_MATRIX_MUL_DET THEN
    REWRITE_TAC[MATRIX_VECTOR_LMUL; NORM_MUL; MATRIX_VECTOR_MUL_LID] THEN
    MP_TAC(ISPEC `\x. (A:real^N^N) ** x` ONORM) THEN
    SIMP_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR; real_abs;
             ONORM_POS_LE];
    REWRITE_TAC[DET_CMUL; DET_I; REAL_MUL_RID; REAL_LE_REFL] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x <= x`) THEN
    SIMP_TAC[REAL_POW_LE; ONORM_POS_LE; MATRIX_VECTOR_MUL_LINEAR]]);;

let ONORM_INVERSE_DET_LE_ONORM_POW = prove
 (`!A:real^N^N.
        invertible A
        ==> onorm(\x. matrix_inv A ** x) * det A
            <= onorm(\x. A ** x) pow (dimindex(:N) - 1)`,
  SUBGOAL_THEN
   `!A:real^N^N.
        invertible A /\ transp A = A
        ==> onorm(\x. matrix_inv A ** x) * det A
            <= onorm(\x. A ** x) pow (dimindex(:N) - 1)`
  ASSUME_TAC THENL
   [ALL_TAC;
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `transp(A:real^N^N) ** A`) THEN
    ASM_REWRITE_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP] THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP] THEN
    ASM_SIMP_TAC[MATRIX_INV_MUL; INVERTIBLE_TRANSP; MATRIX_INV_TRANSP] THEN
    REWRITE_TAC[ONORM_COVARIANCE_ALT] THEN
    REWRITE_TAC[ONORM_COVARIANCE; DET_MUL; DET_TRANSP] THEN
    REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_POW_MUL; REAL_POW_POW] THEN
    ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN
    REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> abs x <= abs y ==> x <= y`) THEN
    MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC ONORM_POS_LE THEN
    REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]] THEN
  REWRITE_TAC[GSYM symmetric_matrix] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
   [SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT]) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`Q:real^N^N`; `D:real^N^N`] THEN
  STRIP_TAC THEN UNDISCH_TAC `invertible(A:real^N^N)` THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN
  REWRITE_TAC[INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP] THEN STRIP_TAC THEN
  TRANS_TAC REAL_LE_TRANS
   `onorm(\x. matrix_inv(D:real^N^N) ** x) * det(D)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THENL
     [ASM_SIMP_TAC[MATRIX_INV_MUL; INVERTIBLE_MATRIX_MUL; INVERTIBLE_TRANSP;
                   GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
      MP_TAC(ISPECL
       [`\x:real^N. matrix_inv(Q:real^N^N) ** x`;
        `\x:real^N. matrix_inv(D:real^N^N) **
                    matrix_inv(transp Q:real^N^N) ** x`]
       ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT) THEN
      ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION; o_DEF] THEN
      ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_INV_EQ] THEN DISCH_THEN SUBST1_TAC THEN
      MP_TAC(ISPECL
       [`\x:real^N. matrix_inv(D:real^N^N) ** x`;
        `\x:real^N. matrix_inv(transp Q:real^N^N) ** x`]
       ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT) THEN
      REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION] THEN
      ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_INV_EQ; ORTHOGONAL_MATRIX_TRANSP];
      REWRITE_TAC[DET_MUL] THEN
      ONCE_REWRITE_TAC[REAL_ARITH `q' * d * q:real = (q' * q) * d`] THEN
      ONCE_REWRITE_TAC[GSYM DET_MUL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
      ASM_REWRITE_TAC[DET_I; REAL_MUL_LID]];
    ALL_TAC] THEN
  TRANS_TAC REAL_LE_TRANS
   `onorm(\x. (D:real^N^N) ** x) pow (dimindex(:N) - 1)` THEN
  CONJ_TAC THENL
   [REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (free_in `Q:real^N^N` o concl)));
    MATCH_MP_TAC(REAL_ARITH `y:real = x ==> x <= y`) THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN
    REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
    MP_TAC(ISPECL
     [`\x:real^N. transp(Q:real^N^N) ** x`;
      `\x:real^N. (D:real^N^N) ** (Q:real^N^N) ** x`]
     ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_LEFT) THEN
    ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION; o_DEF] THEN
    ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP] THEN DISCH_THEN SUBST1_TAC THEN
    MP_TAC(ISPECL
     [`\x:real^N. (D:real^N^N) ** x`;
      `\x:real^N. (Q:real^N^N) ** x`]
     ONORM_COMPOSE_ORTHOGONAL_TRANSFORMATION_RIGHT) THEN
    REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION]] THEN
  ASM_SIMP_TAC[ONORM_DIAGONAL_MATRIX; DET_DIAGONAL; DIAGONAL_MATRIX_INV] THEN
  MP_TAC(ISPEC `D:real^N^N` INVERTIBLE_DIAGONAL_MATRIX) THEN
  ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `sup {abs((matrix_inv D:real^N^N)$i$i) | i IN 1..dimindex (:N)} =
    inv (inf {abs(D$i$i) | i IN 1..dimindex (:N)})`
  SUBST1_TAC THENL
   [ASM_SIMP_TAC[DIAGONAL_MATRIX_INV_EXPLICIT] THEN
    REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC REAL_SUP_LE THEN
      REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
      REWRITE_TAC[NUMSEG_EMPTY;  NOT_LT; DIMINDEX_GE_1] THEN
      SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN X_GEN_TAC `i:num` THEN
      STRIP_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN
      MATCH_MP_TAC REAL_LE_INV2 THEN
      SIMP_TAC[REAL_LT_INF_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY;
               NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN
      ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; GSYM REAL_ABS_NZ] THEN
      ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN
      MATCH_MP_TAC INF_LE_ELEMENT THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
      CONJ_TAC THENL [MESON_TAC[REAL_ABS_POS]; ALL_TAC] THEN
      REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[];
      MP_TAC(ISPEC `IMAGE (\i. abs((D:real^N^N)$i$i)) (1..dimindex(:N))`
        INF_FINITE) THEN
      SIMP_TAC[SIMPLE_IMAGE; REAL_LE_SUP_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY;
               NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN
      REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
      DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      REWRITE_TAC[IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `i:num` THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN
      REWRITE_TAC[REAL_ABS_INV; REAL_LE_REFL]];
    REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_LDIV_EQ o snd) THEN
    SIMP_TAC[SIMPLE_IMAGE; REAL_LT_INF_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY;
               NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN
    ASM_REWRITE_TAC[FORALL_IN_IMAGE; GSYM REAL_ABS_NZ] THEN
    DISCH_THEN SUBST1_TAC] THEN
  MP_TAC(ISPEC `IMAGE (\i. abs((D:real^N^N)$i$i)) (1..dimindex(:N))`
    INF_FINITE) THEN
  SIMP_TAC[SIMPLE_IMAGE; REAL_LE_SUP_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY;
           NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN
  REWRITE_TAC[FORALL_IN_IMAGE] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`\i. (D:real^N^N)$i$i`; `1..dimindex(:N)`; `n:num`]
        PRODUCT_DELETE) THEN
  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  MATCH_MP_TAC(REAL_ARITH `abs(x) <= a * b ==> x <= b * a`) THEN
  REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
  SIMP_TAC[GSYM PRODUCT_ABS; REAL_ABS_POS; FINITE_NUMSEG; FINITE_DELETE] THEN
  SUBGOAL_THEN `dimindex(:N) - 1 = CARD((1..dimindex(:N)) DELETE n)`
  SUBST1_TAC THENL
   [ASM_SIMP_TAC[CARD_DELETE; FINITE_NUMSEG; CARD_NUMSEG_1];
    SIMP_TAC[GSYM PRODUCT_CONST; FINITE_DELETE; FINITE_NUMSEG]] THEN
  MATCH_MP_TAC PRODUCT_LE THEN
  REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN
  X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POS] THEN
  SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY;
           NOT_LT; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN
  REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `i:num` THEN
  ASM_REWRITE_TAC[REAL_LE_REFL]);;

let ONORM_INVERSE_DET_LE_ONORM_POW_ALT = prove
 (`!f g:real^N->real^N.
        linear f /\ linear g /\ f o g = I
        ==> onorm f * det(matrix g) <= onorm g pow (dimindex(:N) - 1)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(g:real^N->real^N) o f = I` ASSUME_TAC THENL
   [ASM_MESON_TAC[LINEAR_INVERSE_LEFT]; ALL_TAC] THEN
  MP_TAC(ISPEC `matrix(g:real^N->real^N)`
      ONORM_INVERSE_DET_LE_ONORM_POW) THEN
  ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL; MATRIX_INVERTIBLE] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
  MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  AP_TERM_TAC THEN MP_TAC(ISPEC `f:real^N->real^N` MATRIX_VECTOR_MUL) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
  ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  CONV_TAC SYM_CONV THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
  ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]);;

let HADAMARD_INEQUALITY_PSD = prove
 (`!A:real^N^N.
    positive_semidefinite A ==> det A <= product(1..dimindex(:N)) (\i. A$i$i)`,
  SIMP_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE_EQ; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`B:real^N^N`; `A:real^N^N`] THEN
  DISCH_THEN SUBST1_TAC THEN
  MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN
  REWRITE_TAC[DET_MUL; DET_TRANSP; REAL_ABS_MUL] THEN
  TRANS_TAC REAL_LE_TRANS
   `product(1..dimindex(:N)) (\i. norm(column i (A:real^N^N))) pow 2` THEN
  REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_ABS_ABS] THEN
  SIMP_TAC[HADAMARD_INEQUALITY_COLUMN; REAL_ARITH `x <= y ==> x <= abs y`] THEN
  REWRITE_TAC[GSYM PRODUCT_MUL_NUMSEG; REAL_POW_2] THEN
  MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[GSYM REAL_POW_2] THEN
  MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN
  STRIP_TAC THEN ASM_SIMP_TAC[ROW_MATRIX_MUL; MATRIX_MUL_COMPONENT] THEN
  REWRITE_TAC[NORM_POW_2; dot; matrix_vector_mul; transp; column] THEN
  ASM_SIMP_TAC[LAMBDA_BETA]);;

let POSITIVE_DEFINITE_NEARBY = prove
 (`!A:real^N^N.
        positive_definite A
        ==> ?e. &0 < e /\
                !B. symmetric_matrix B /\ onorm(\x. (B - A) ** x) < e
                    ==> positive_definite B`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `{c | ?v. ~(v = vec 0) /\ (A:real^N^N) ** v = c % v}`
        INF_FINITE) THEN
  REWRITE_TAC[FINITE_EIGENVALUES] THEN ANTS_TAC THENL
   [MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x`
     SELF_ADJOINT_HAS_EIGENVECTOR) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[positive_definite; symmetric_matrix]) THEN
    ASM_REWRITE_TAC[ADJOINT_MATRIX; MATRIX_VECTOR_MUL_LINEAR] THEN
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    MATCH_MP_TAC MONO_AND THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    SIMP_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ];
    ABBREV_TAC
     `a = inf {c | ?v. ~(v = vec 0) /\ (A:real^N^N) ** v = c % v}` THEN
    FIRST_X_ASSUM(K ALL_TAC o SYM) THEN
    REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN STRIP_TAC] THEN
  EXISTS_TAC `a:real` THEN CONJ_TAC THENL
   [ASM_MESON_TAC[POSITIVE_DEFINITE_EIGENVALUES]; ALL_TAC] THEN
  X_GEN_TAC `B:real^N^N` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[positive_definite] THEN X_GEN_TAC `x:real^N` THEN
  DISCH_TAC THEN
  SUBGOAL_THEN `B:real^N^N = (B - A) + A` SUBST1_TAC THENL
   [REWRITE_TAC[MATRIX_SUB; GSYM MATRIX_ADD_ASSOC; MATRIX_ADD_LNEG] THEN
    REWRITE_TAC[MATRIX_ADD_RID];
    REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD]] THEN
  MATCH_MP_TAC(REAL_ARITH `!b. abs x < b /\ b <= y ==> &0 < x + y`) THEN
  EXISTS_TAC `a * norm(x:real^N) pow 2` THEN CONJ_TAC THENL
   [W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ_ABS o lhand o snd) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
    ONCE_REWRITE_TAC[REAL_ARITH `(a:real) * x pow 2 = x * a * x`] THEN
    ASM_SIMP_TAC[REAL_LT_LMUL_EQ; NORM_POS_LT] THEN TRANS_TAC REAL_LET_TRANS
     `onorm(\x. (B - A:real^N^N) ** x) * norm(x:real^N)` THEN
    SIMP_TAC[ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN
    ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT];
    MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM]
      EIGENVALUE_LOWERBOUND_DOT) THEN
    ASM_MESON_TAC[positive_definite]]);;

let (POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY,
     POSITIVE_DEFINITE_EQ_CONGRUENT_IDENTITY_ALT) = (CONJ_PAIR o prove)
 (`(!A:real^N^N.
        positive_definite A <=> ?B:real^N^N. transp B ** A ** B = mat 1) /\
   (!A:real^N^N.
        positive_definite A <=>
        ?B:real^N^N. invertible B /\ transp B ** A ** B = mat 1)`,
  REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(r ==> q) /\ (p ==> r) /\ (q ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[];
    ONCE_REWRITE_TAC[POSITIVE_DEFINITE_COVARIANCE_EQ] THEN
    DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `matrix_inv(B:real^N^N)` THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV; MATRIX_MUL_RID] THEN
    SIMP_TAC[TRANSP_MATRIX_INV; MATRIX_MUL_ASSOC; INVERTIBLE_MATRIX_INV] THEN
    ASM_SIMP_TAC[MATRIX_INV; INVERTIBLE_TRANSP; MATRIX_MUL_LID];
    DISCH_THEN(CHOOSE_THEN MP_TAC) THEN
    DISCH_THEN(MP_TAC o AP_TERM `positive_definite:real^N^N->bool`) THEN
    SIMP_TAC[POSITIVE_DEFINITE_SIMILAR_EQ; POSITIVE_DEFINITE_ID]]);;

let POSITIVE_DEFINITE_EVENTUALLY = prove
 (`!A:real^N^N.
        symmetric_matrix A
        ==> ?a. !x. a <= x ==> positive_definite(A + x %% mat 1)`,
  REWRITE_TAC[symmetric_matrix] THEN
  REPEAT STRIP_TAC THEN EXISTS_TAC `onorm(\x. (A:real^N^N) ** x) + &1` THEN
  X_GEN_TAC `a:real` THEN DISCH_TAC THEN
  ASM_SIMP_TAC[TRANSP_MATRIX_ADD; positive_definite; TRANSP_MATRIX_CMUL;
               TRANSP_MAT; MATRIX_VECTOR_MUL_ADD_RDISTRIB; DOT_RADD;
               symmetric_matrix;
               MATRIX_VECTOR_LMUL; DOT_RMUL; MATRIX_VECTOR_MUL_LID] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC(REAL_ARITH `abs(x) < y ==> &0 < x + y`) THEN
  W(MP_TAC o PART_MATCH lhand NORM_CAUCHY_SCHWARZ_ABS o lhand o snd) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
  TRANS_TAC REAL_LET_TRANS
   `norm(x:real^N) * onorm(\y. (A:real^N^N) ** y) * norm(x)` THEN
  SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE; ONORM; MATRIX_VECTOR_MUL_LINEAR] THEN
  SIMP_TAC[GSYM NORM_POW_2; REAL_ARITH `(a:real) * x pow 2 = x * a * x`] THEN
  ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_RMUL_EQ; NORM_POS_LT] THEN
  ASM_SIMP_TAC[REAL_ARITH `a + &1 <= x ==> a < x`]);;

let POSITIVE_SEMIDEFINITE_HADAMARD_PRODUCT,
    POSITIVE_DEFINITE_HADAMARD_PRODUCT = (CONJ_PAIR o prove)
 (`(!A:real^N^N B:real^N^N.
        positive_semidefinite A /\ positive_semidefinite B
        ==> positive_semidefinite((lambda i j. A$i$j * B$i$j):real^N^N)) /\
   (!A:real^N^N B:real^N^N.
        positive_definite A /\ positive_definite B
        ==> positive_definite((lambda i j. A$i$j * B$i$j):real^N^N))`,
  REPEAT STRIP_TAC THEN
 (SUBGOAL_THEN `transp(A:real^N^N) = A /\ transp(B:real^N^N) = B`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[positive_semidefinite; positive_definite; symmetric_matrix];
    REWRITE_TAC[positive_semidefinite; positive_definite;
                symmetric_matrix]] THEN
  CONJ_TAC THENL
   [SIMP_TAC[CART_EQ; TRANSP_COMPONENT; LAMBDA_BETA] THEN
    REPEAT STRIP_TAC THEN BINOP_TAC THEN
    ASM_MESON_TAC[TRANSP_COMPONENT];
    ALL_TAC] THEN
  X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN
  ABBREV_TAC
     `D:real^N^N = (lambda i j. if i = j then (x:real^N)$i else &0)` THEN
  SUBGOAL_THEN
   `(?A':real^N^N. transp A' = A' /\  A' ** A' = A) /\
    (?B':real^N^N. transp B' = B' /\  B' ** B' = B)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SQRT_EQ; positive_semidefinite;
                  symmetric_matrix; POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE];
    ALL_TAC])
  THENL [MATCH_MP_TAC REAL_LE_TRANS; MATCH_MP_TAC REAL_LTE_TRANS] THEN
  EXISTS_TAC
    `trace(transp(A' ** D ** B') **
           ((A':real^N^N) ** D ** (B':real^N^N)))` THEN
 (CONJ_TAC THENL
   [ASM_REWRITE_TAC[TRACE_COVARIANCE_POS_LT; TRACE_COVARIANCE_POS_LE];
    MATCH_MP_TAC REAL_EQ_IMP_LE THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
    EXPAND_TAC "D" THEN
    SIMP_TAC[trace; dot; MATRIX_MUL_COMPONENT; LAMBDA_BETA;
             TRANSP_COMPONENT; MATRIX_VECTOR_MUL_COMPONENT] THEN
    REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
    SIMP_TAC[SUM_DELTA] THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
    SIMP_TAC[SUM_DELTA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
    GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN
    REWRITE_TAC[] THEN
    MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    REWRITE_TAC[] THEN
    MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
    REWRITE_TAC[] THEN
    SUBGOAL_THEN `(B:real^N^N)$j$i = B$i$j`
     (fun th -> REWRITE_TAC[th; REAL_MUL_AC]) THEN
    ASM_MESON_TAC[TRANSP_COMPONENT]]) THEN
  SUBGOAL_THEN `invertible(A':real^N^N) /\ invertible(B':real^N^N)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[INVERTIBLE_MATRIX_MUL; POSITIVE_DEFINITE_IMP_INVERTIBLE];
    ASM_SIMP_TAC[MATRIX_ENTIRE]] THEN
  EXPAND_TAC "D" THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; MAT_COMPONENT] THEN
  REWRITE_TAC[MESON[]
   `(if p then a else z) = (if p then b else z) <=> p ==> a = b`] THEN
  ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
  UNDISCH_TAC `~(x:real^N = vec 0)` THEN
  SIMP_TAC[FORALL_UNWIND_THM1; CART_EQ; VEC_COMPONENT]);;

(* ------------------------------------------------------------------------- *)
(* Polar decomposition.                                                      *)
(* ------------------------------------------------------------------------- *)

let RIGHT_POLAR_DECOMPOSITION = prove
 (`!A:real^N^N.
        ?U:real^N^N P:real^N^N.
                orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `transp(A:real^N^N) ** A`
    SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT) THEN
  ASM_REWRITE_TAC[SYMMETRIC_MATRIX_COVARIANCE; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`P:real^N^N`; `D:real^N^N`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `!i j. 1 <= i /\ i <= dimindex(:N) /\
          1 <= j /\ j <= dimindex(:N)
          ==> ((A:real^N^N) ** (transp P ** (basis i:real^N))) dot
              (A ** (transp P ** basis j)) =
              (D:real^N^N)$i$j`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM
     `\M:real^N^N. (P:real^N^N) ** M ** transp P`) THEN
    REWRITE_TAC[] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID] THEN
    GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM TRANSP_TRANSP] THEN
    REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; MATRIX_MUL_ASSOC] THEN
    REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN
    SPEC_TAC(`(A:real^N^N) ** transp(P:real^N^N)`,`B:real^N^N`) THEN
    ASM_SIMP_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN; LAMBDA_BETA;
                 MATRIX_VECTOR_MUL_BASIS];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N)
          ==> &0 <= (D:real^N^N)$i$j`
  ASSUME_TAC THENL
   [REPEAT GEN_TAC THEN ASM_CASES_TAC `i:num = j` THEN
    ASM_MESON_TAC[DOT_POS_LE; diagonal_matrix; REAL_LE_REFL];
    ALL_TAC] THEN
  ABBREV_TAC
    `b = { inv(sqrt((D:real^N^N)$i$i)) %
           ((A:real^N^N) ** (transp P ** (basis i:real^N))) |i|
           i IN 1..dimindex(:N) /\ ~((D:real^N^N)$i$i = &0)}` THEN
  MP_TAC(ISPECL
   [`b:real^N->bool`; `(:real^N)`] ORTHONORMAL_EXTENSION) THEN
  REWRITE_TAC[UNION_UNIV; SPAN_UNIV] THEN MATCH_MP_TAC(TAUT
    `(p /\ q) /\ (q ==> s ==> r) ==> (p /\ q ==> s) ==> r`) THEN
  CONJ_TAC THENL
   [EXPAND_TAC "b" THEN
    REWRITE_TAC[pairwise; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THENL
     [REWRITE_TAC[ORTHOGONAL_MUL] THEN REPEAT DISJ2_TAC THEN
      ASM_SIMP_TAC[orthogonal] THEN
      FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[diagonal_matrix]) THEN
      ASM_MESON_TAC[];
      REWRITE_TAC[NORM_EQ_SQUARE; DOT_LMUL; DOT_RMUL; REAL_POS] THEN
      ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
      MATCH_MP_TAC(REAL_FIELD
       `s pow 2 = x /\ ~(x = &0) ==> inv s * inv s * x = &1`) THEN
      ASM_SIMP_TAC[SQRT_POW2]];
    DISCH_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`{i | i IN 1..dimindex(:N) /\ (D:real^N^N)$i$i = &0}`;
    `c:real^N->bool`] CARD_EQ_BIJECTION) THEN
  ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
  REWRITE_TAC[FINITE_UNION] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  ANTS_TAC THENL
   [MP_TAC(ISPECL [`(:real^N)`; `b UNION c:real^N->bool`]
        BASIS_CARD_EQ_DIM) THEN
    ASM_REWRITE_TAC[SUBSET_UNIV; FINITE_UNION; DIM_UNIV] THEN ANTS_TAC THENL
     [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
      ASM_REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N`)) THEN
      ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
      ONCE_REWRITE_TAC[UNION_COMM] THEN
      ASM_SIMP_TAC[CARD_UNION; GSYM DISJOINT] THEN
      MATCH_MP_TAC(ARITH_RULE `s + b:num = n ==> c + b = n ==> s = c`)] THEN
    SUBGOAL_THEN
     `CARD(b:real^N->bool) =
      CARD {i | i IN 1..dimindex(:N) /\ ~((D:real^N^N)$i$i = &0)}`
    SUBST1_TAC THENL
     [EXPAND_TAC "b" THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
      ASM_SIMP_TAC[IMAGE_ID; CARD_IMAGE_EQ_INJ; FINITE_RESTRICT;
                   FINITE_NUMSEG] THEN
      REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
      X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN
      STRIP_TAC THEN STRIP_TAC THEN
      X_GEN_TAC `j:num` THEN STRIP_TAC THEN STRIP_TAC THEN
      ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(MESON[ORTHOGONAL_REFL]
       `orthogonal x y /\ ~(x = vec 0) ==> ~(x:real^N = y)`) THEN
      CONJ_TAC THENL
       [REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM_SIMP_TAC[orthogonal] THEN
        ASM_MESON_TAC[diagonal_matrix];
        DISCH_TAC THEN
        UNDISCH_TAC `!x:real^N. x IN b ==> norm x = &1` THEN
        EXPAND_TAC "b" THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
        DISCH_THEN(MP_TAC o SPEC `i:num`) THEN
        ASM_REWRITE_TAC[IN_NUMSEG; NORM_0] THEN REAL_ARITH_TAC];
      GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN
      MATCH_MP_TAC CARD_UNION_EQ THEN
      REWRITE_TAC[FINITE_NUMSEG] THEN SET_TAC[]];
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN
    REWRITE_TAC[IN_NUMSEG; RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[TAUT
     `p ==> q ==> r ==> s <=> p /\ q /\ r ==> s`] THEN
    REWRITE_TAC[INJECTIVE_ON_ALT]] THEN
  DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC
   `U:real^N^N =
    lambda i. if (D:real^N^N)$i$i = &0 then f i
             else inv(sqrt(D$i$i)) % (A ** transp(P:real^N^N) ** basis i)` THEN
  MAP_EVERY EXISTS_TAC
   [`transp(U:real^N^N) ** P:real^N^N`;
    `transp(P:real^N^N) ** (lambda i j. sqrt((D:real^N^N)$j$i)) ** P`] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC ORTHOGONAL_MATRIX_MUL THEN
    ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP] THEN
    REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS] THEN
    EXPAND_TAC "U" THEN SIMP_TAC[LAMBDA_BETA; row; LAMBDA_ETA] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THENL
     [STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; REWRITE_TAC[NORM_MUL; REAL_ABS_INV]] THEN
      MATCH_MP_TAC(REAL_FIELD
       `~(x = &0) /\ y = x ==> inv x * y = &1`) THEN
      ASM_REWRITE_TAC[REAL_ABS_ZERO; SQRT_EQ_0] THEN
      ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN
      ASM_SIMP_TAC[NORM_EQ_SQUARE; SQRT_POW_2; SQRT_POS_LE];
      X_GEN_TAC `j:num` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
      MAP_EVERY ASM_CASES_TAC
       [`(D:real^N^N)$i$i = &0`; `(D:real^N^N)$j$j = &0`] THEN
      ASM_SIMP_TAC[IN_UNION] THEN
      REPEAT(CONJ_TAC THENL
        [EXPAND_TAC "b" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[];
         ALL_TAC])
      THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `DISJOINT b c ==> x IN b /\ y IN c ==> ~(x = y)`)) THEN
        EXPAND_TAC "b" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `DISJOINT b c ==> x IN b /\ y IN c ==> ~(y = x)`)) THEN
        EXPAND_TAC "b" THEN REWRITE_TAC[IN_NUMSEG] THEN ASM SET_TAC[];
        MATCH_MP_TAC(MESON[ORTHOGONAL_REFL]
         `orthogonal x y /\ ~(x = vec 0) ==> ~(x = y)`) THEN
        CONJ_TAC THENL
         [REWRITE_TAC[ORTHOGONAL_MUL] THEN REPEAT DISJ2_TAC THEN
          ASM_SIMP_TAC[orthogonal] THEN ASM_MESON_TAC[diagonal_matrix];
          ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; SQRT_EQ_0] THEN
          ASM_SIMP_TAC[GSYM DOT_EQ_0]]]];
    MATCH_MP_TAC POSITIVE_SEMIDEFINITE_SIMILAR THEN
    MATCH_MP_TAC POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX THEN
    ASM_SIMP_TAC[SQRT_POS_LE; LAMBDA_BETA] THEN
    FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN
    SIMP_TAC[diagonal_matrix; LAMBDA_BETA; SQRT_0];
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    GEN_REWRITE_TAC LAND_CONV [MATRIX_MUL_ASSOC] THEN
    GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN
    ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    TRANS_TAC EQ_TRANS `(A:real^N^N) ** transp P ** (P:real^N^N)` THEN
    CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[MATRIX_MUL_RID]] THEN
    REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
    GEN_REWRITE_TAC LAND_CONV [matrix_mul] THEN
    SIMP_TAC[CART_EQ; LAMBDA_BETA; transp] THEN
    X_GEN_TAC `m:num` THEN STRIP_TAC THEN
    X_GEN_TAC `n:num` THEN STRIP_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [DIAGONAL_MATRIX]) THEN
    ASM_SIMP_TAC[LAMBDA_BETA] THEN
    REWRITE_TAC[COND_RATOR; COND_RAND; SQRT_0; REAL_MUL_LZERO;
                REAL_MUL_RZERO] THEN
    CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
    ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN EXPAND_TAC "U" THEN
    ASM_SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC] THEN
    COND_CASES_TAC THEN
    ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; VECTOR_MUL_COMPONENT;
                 LAMBDA_BETA] THEN
    ASM_SIMP_TAC[transp; SQRT_POW2; REAL_FIELD
     `~(s = &0) /\ sqrt s pow 2 = s ==> (inv(sqrt s) * x) * sqrt s = x`] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`])) THEN
    ASM_REWRITE_TAC[DOT_EQ_0; REAL_LE_REFL; MATRIX_VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; column; transp; SQRT_0;
                 CART_EQ; LAMBDA_BETA; VEC_COMPONENT; REAL_MUL_RZERO]]);;

let LEFT_POLAR_DECOMPOSITION = prove
 (`!A:real^N^N.
        ?U:real^N^N P:real^N^N.
                orthogonal_matrix U /\ positive_semidefinite P /\ P ** U = A`,
  GEN_TAC THEN
  MP_TAC(ISPEC `transp(A:real^N^N)` RIGHT_POLAR_DECOMPOSITION) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN
  REWRITE_TAC[TRANSP_TRANSP] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  MAP_EVERY EXISTS_TAC [`transp U:real^N^N`; `transp P:real^N^N`] THEN
  ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP; POSITIVE_SEMIDEFINITE_TRANSP] THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL]);;

let RIGHT_POLAR_DECOMPOSITION_INVERTIBLE = prove
 (`!A:real^N^N.
        invertible A <=>
        ?U:real^N^N P:real^N^N.
                orthogonal_matrix U /\ positive_definite P /\ U ** P = A`,
  GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN
    MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    UNDISCH_TAC `invertible(A:real^N^N)` THEN
    ASM_SIMP_TAC[POSITIVE_DEFINITE_POSITIVE_SEMIDEFINITE;
                 INVERTIBLE_MATRIX_MUL];
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    ASM_SIMP_TAC[INVERTIBLE_MATRIX_MUL; ORTHOGONAL_MATRIX_IMP_INVERTIBLE;
                 POSITIVE_DEFINITE_IMP_INVERTIBLE]]);;

let LEFT_POLAR_DECOMPOSITION_INVERTIBLE = prove
 (`!A:real^N^N.
        invertible A <=>
        ?U:real^N^N P:real^N^N.
                orthogonal_matrix U /\ positive_definite P /\ P ** U = A`,
  GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INVERTIBLE_TRANSP] THEN
  REWRITE_TAC[RIGHT_POLAR_DECOMPOSITION_INVERTIBLE] THEN
  EQ_TAC THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN
  REWRITE_TAC[TRANSP_TRANSP] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  MAP_EVERY EXISTS_TAC [`transp U:real^N^N`; `transp P:real^N^N`] THEN
  ASM_REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP; POSITIVE_DEFINITE_TRANSP] THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL]);;

let NORMAL_RIGHT_POLAR_DECOMPOSITION = prove
 (`!A U P:real^N^N.
        orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A
        ==> (normal_matrix A <=> P ** U = U ** P)`,
  REWRITE_TAC[normal_matrix] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
   [UNDISCH_TAC `transp A ** A:real^N^N = A ** transp A` THEN
    EXPAND_TAC "A" THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN EXPAND_TAC "A" THEN
    REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN
    REWRITE_TAC[MATRIX_MUL_ASSOC] THEN DISCH_TAC THEN
    MP_TAC(ISPEC `transp P ** P:real^N^N`
      POSITIVE_SEMIDEFINITE_SQRT_UNIQUE) THEN
    REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE; EXISTS_UNIQUE_DEF] THEN
    DISCH_THEN(MP_TAC o SPECL
      [`P:real^N^N`; `(U:real^N^N) ** (P:real^N^N) ** transp U`] o
     CONJUNCT2) THEN
    ANTS_TAC THENL
     [ALL_TAC;
      DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [th]) THEN
      ASM_MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_RID]] THEN
    REPEAT CONJ_TAC THENL
     [FIRST_ASSUM ACCEPT_TAC;
      ASM_MESON_TAC[positive_semidefinite; symmetric_matrix];
      ASM_MESON_TAC[POSITIVE_SEMIDEFINITE_SIMILAR; TRANSP_TRANSP];
      ASM_REWRITE_TAC[] THEN EXPAND_TAC "A" THEN
      REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_TRANSP_MUL] THEN
      AP_TERM_TAC THEN AP_TERM_TAC THEN
      ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID] THEN
      ASM_MESON_TAC[positive_semidefinite; symmetric_matrix]];
    EXPAND_TAC "A" THEN FIRST_X_ASSUM(fun th ->
      GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th] THEN
      GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SYM th]) THEN
    REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[positive_semidefinite; orthogonal_matrix]) THEN
    ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV) [GSYM MATRIX_MUL_ASSOC] THEN
    ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN ASM_MESON_TAC[symmetric_matrix]]);;

let NORMAL_LEFT_POLAR_DECOMPOSITION = prove
 (`!A U P:real^N^N.
        orthogonal_matrix U /\ positive_semidefinite P /\ P ** U = A
        ==> (normal_matrix A <=> P ** U = U ** P)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`transp A:real^N^N`; `transp U:real^N^N`; `transp P:real^N^N`]
        NORMAL_RIGHT_POLAR_DECOMPOSITION) THEN
  ASM_SIMP_TAC[ORTHOGONAL_MATRIX_TRANSP; POSITIVE_SEMIDEFINITE_TRANSP] THEN
  REWRITE_TAC[normal_matrix] THEN
  ASM_REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; MESON[TRANSP_TRANSP]
   `transp(A:real^N^N) = transp B <=> A = B`] THEN
  MESON_TAC[]);;

let NORMAL_BIPOLAR_DECOMPOSITION = prove
 (`!A:real^N^N.
        normal_matrix A <=>
        ?U P. orthogonal_matrix U /\ positive_semidefinite P /\
              U ** P = A /\ P ** U = A`,
  GEN_TAC THEN EQ_TAC THENL
   [MESON_TAC[NORMAL_RIGHT_POLAR_DECOMPOSITION;
              RIGHT_POLAR_DECOMPOSITION];
    REWRITE_TAC[normal_matrix; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN
    REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN DISCH_TAC THEN
    DISCH_THEN(fun th ->
     GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    RULE_ASSUM_TAC(REWRITE_RULE
     [orthogonal_matrix; positive_semidefinite; symmetric_matrix]) THEN
    ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN
    ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]]);;

let LEFT_POLAR_DECOMPOSITION_UNIQUE = prove
 (`!A:real^N^N.
        ?!P. ?U. orthogonal_matrix U /\ positive_semidefinite P /\ P ** U = A`,
  GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` LEFT_POLAR_DECOMPOSITION) THEN
  REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN
  GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
  SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
  MAP_EVERY X_GEN_TAC [`S:real^N^N`; `P:real^N^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `U:real^N^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `V:real^N^N` STRIP_ASSUME_TAC)) THEN
  MP_TAC(ISPEC `transp(transp A) ** transp A:real^N^N`
        POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE) THEN
  REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE] THEN
  REWRITE_TAC[TRANSP_TRANSP; EXISTS_UNIQUE_DEF] THEN
  DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL
   [UNDISCH_THEN `(S:real^N^N) ** (U:real^N^N) = A` (SUBST1_TAC o SYM);
    UNDISCH_THEN `(P:real^N^N) ** (V:real^N^N) = A` (SUBST1_TAC o SYM)] THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
  ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; MATRIX_MUL_ASSOC] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
  ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]);;

let RIGHT_POLAR_DECOMPOSITION_UNIQUE = prove
 (`!A:real^N^N.
        ?!P. ?U. orthogonal_matrix U /\ positive_semidefinite P /\ U ** P = A`,
  GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN
  REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN
  GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
  SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
  MAP_EVERY X_GEN_TAC [`S:real^N^N`; `P:real^N^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `U:real^N^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `V:real^N^N` STRIP_ASSUME_TAC)) THEN
  MP_TAC(ISPEC `transp(A:real^N^N) ** A:real^N^N`
        POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE) THEN
  REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE] THEN
  REWRITE_TAC[TRANSP_TRANSP; EXISTS_UNIQUE_DEF] THEN
  DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL
   [UNDISCH_THEN `(U:real^N^N) ** (S:real^N^N) = A` (SUBST1_TAC o SYM);
    UNDISCH_THEN `(V:real^N^N) ** (P:real^N^N) = A` (SUBST1_TAC o SYM)] THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
  ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC; MATRIX_MUL_ASSOC] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
  ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]);;

let LEFT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE = prove
 (`!A:real^N^N U V P S.
        invertible A /\
        orthogonal_matrix U /\ positive_semidefinite P /\
        orthogonal_matrix V /\ positive_semidefinite S /\
        P ** U = A /\ S ** V = A
        ==> P = S /\ U = V`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN `P:real^N^N = S` SUBST_ALL_TAC THENL
   [ASM_MESON_TAC[LEFT_POLAR_DECOMPOSITION_UNIQUE]; REWRITE_TAC[]] THEN
  ASM_MESON_TAC[MATRIX_MUL_LCANCEL; INVERTIBLE_MATRIX_MUL]);;

let RIGHT_POLAR_DECOMPOSITION_INVERTIBLE_UNIQUE = prove
 (`!A:real^N^N U V P S.
        invertible A /\
        orthogonal_matrix U /\ positive_semidefinite P /\
        orthogonal_matrix V /\ positive_semidefinite S /\
        U ** P = A /\ V ** S = A
        ==> P = S /\ U = V`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN `P:real^N^N = S` SUBST_ALL_TAC THENL
   [ASM_MESON_TAC[RIGHT_POLAR_DECOMPOSITION_UNIQUE]; REWRITE_TAC[]] THEN
  ASM_MESON_TAC[MATRIX_MUL_RCANCEL; INVERTIBLE_MATRIX_MUL]);;

let COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL = prove
 (`!A B:real^N^N.
        transp A ** A = transp B ** B <=>
        ?U. orthogonal_matrix U /\ U ** A = B`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [MP_TAC(ISPEC `B:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN
    MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`U:real^N^N`; `P:real^N^N`] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`V:real^N^N`; `Q:real^N^N`] THEN STRIP_TAC THEN
    MAP_EVERY EXPAND_TAC ["A"; "B"] THEN REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
    GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV o LAND_CONV)
     [GSYM MATRIX_MUL_ASSOC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_matrix]) THEN
    ASM_REWRITE_TAC[MATRIX_MUL_RID] THEN DISCH_TAC THEN
    MP_TAC(ISPEC `transp(P:real^N^N) ** P`
      POSITIVE_SEMIDEFINITE_COVARIANCE_UNIQUE) THEN
    REWRITE_TAC[POSITIVE_SEMIDEFINITE_COVARIANCE; EXISTS_UNIQUE_DEF] THEN
    DISCH_THEN(MP_TAC o SPECL [`P:real^N^N`; `Q:real^N^N`] o CONJUNCT2) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
    EXISTS_TAC `(V:real^N^N) ** transp(U:real^N^N)` THEN
    ASM_MESON_TAC[orthogonal_matrix; ORTHOGONAL_MATRIX_MUL;
                  ORTHOGONAL_MATRIX_TRANSP; MATRIX_MUL_ASSOC; MATRIX_MUL_RID];
    REWRITE_TAC[orthogonal_matrix] THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    ASM_REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
    ASM_MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_RID]]);;

let COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL_ALT = prove
 (`!A B:real^N^N.
        A ** transp A = B ** transp B <=>
        ?U. orthogonal_matrix U /\ A ** U = B`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`transp A:real^N^N`; `transp B:real^N^N`]
        COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL) THEN
  REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_EQ] THEN
  DISCH_THEN SUBST1_TAC THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_EQ] THEN
  REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
  MESON_TAC[ORTHOGONAL_MATRIX_TRANSP; TRANSP_TRANSP]);;

let NORMAL_MATRIX_SIMILAR_TRANSP = prove
 (`!A:real^N^N.
        normal_matrix A <=>
        ?U. orthogonal_matrix U /\ U ** transp A = A`,
  REWRITE_TAC[GSYM COVARIANCE_UNIQUE_UP_TO_ORTHOGONAL] THEN
  REWRITE_TAC[normal_matrix] THEN MESON_TAC[TRANSP_TRANSP]);;

let NORMAL_MATRIX_SIMILAR_TRANSP_ALT = prove
 (`!A:real^N^N.
        normal_matrix A <=>
        ?U. orthogonal_matrix U /\ transp A ** U = A`,
  GEN_TAC THEN
  MP_TAC(ISPEC `transp A:real^N^N` NORMAL_MATRIX_SIMILAR_TRANSP) THEN
  REWRITE_TAC[normal_matrix; TRANSP_TRANSP] THEN
  MESON_TAC[ORTHOGONAL_MATRIX_TRANSP; MATRIX_TRANSP_MUL; TRANSP_TRANSP]);;

let MATRIX_DIAGONALIZABLE = prove
 (`!A:real^N^N.
        ?P D Q. orthogonal_matrix P /\
                diagonal_matrix D /\
                orthogonal_matrix Q /\
                (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= D$i$i) /\
                A = P ** D ** Q`,
  GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RIGHT_POLAR_DECOMPOSITION) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`U:real^N^N`; `S:real^N^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
  MP_TAC(ISPEC `S:real^N^N` SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE_ALT) THEN
  ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM;
               POSITIVE_SEMIDEFINITE_IMP_SYMMETRIC_MATRIX] THEN
  MAP_EVERY X_GEN_TAC [`V:real^N^N`; `D:real^N^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN MAP_EVERY EXISTS_TAC
   [`(U:real^N^N) ** transp(V:real^N^N)`; `D:real^N^N`; `V:real^N^N`] THEN
  ASM_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
  ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP] THEN
  UNDISCH_TAC `positive_semidefinite(transp(V:real^N^N) ** D ** V)` THEN
  ASM_SIMP_TAC[POSITIVE_SEMIDEFINITE_SIMILAR_EQ;
               ORTHOGONAL_MATRIX_IMP_INVERTIBLE;
               POSITIVE_SEMIDEFINITE_DIAGONAL_MATRIX_EQ]);;

(* ------------------------------------------------------------------------- *)
(* Infinite sums of vectors. Allow general starting point (and more).        *)
(* ------------------------------------------------------------------------- *)

parse_as_infix("sums",(12,"right"));;

let sums = new_definition
  `(f sums l) s = ((\n. vsum(s INTER (0..n)) f) --> l) sequentially`;;

let infsum = new_definition
 `infsum s f = @l. (f sums l) s`;;

let summable = new_definition
 `summable s f = ?l. (f sums l) s`;;

let SUMS_SUMMABLE = prove
 (`!f l s. (f sums l) s ==> summable s f`,
  REWRITE_TAC[summable] THEN MESON_TAC[]);;

let SUMS_INFSUM = prove
 (`!f s. (f sums (infsum s f)) s <=> summable s f`,
  REWRITE_TAC[infsum; summable] THEN MESON_TAC[]);;

let SUMS_LIM = prove
 (`!f:num->real^N s.
      (f sums lim sequentially (\n. vsum (s INTER (0..n)) f)) s
      <=> summable s f`,
  GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable];
  REWRITE_TAC[summable; sums] THEN STRIP_TAC THEN REWRITE_TAC[lim] THEN
  ASM_MESON_TAC[]]);;

let SERIES_FROM = prove
 (`!f l k. (f sums l) (from k) = ((\n. vsum(k..n) f) --> l) sequentially`,
  REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);;

let SERIES_UNIQUE = prove
 (`!f:num->real^N l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')`,
  REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_UNIQUE]);;

let INFSUM_UNIQUE = prove
 (`!f:num->real^N l s. (f sums l) s ==> infsum s f = l`,
  MESON_TAC[SERIES_UNIQUE; SUMS_INFSUM; summable]);;

let SERIES_TERMS_TOZERO = prove
 (`!f l n. (f sums l) (from n) ==> (f --> vec 0) sequentially`,
  REPEAT GEN_TAC THEN SIMP_TAC[sums; LIM_SEQUENTIALLY; FROM_INTER_NUMSEG] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
  EXISTS_TAC `N + n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(fun th ->
    MP_TAC(SPEC `m - 1` th) THEN MP_TAC(SPEC `m:num` th)) THEN
  SUBGOAL_THEN `0 < m /\ n <= m` (fun th -> SIMP_TAC[VSUM_CLAUSES_RIGHT; th])
  THENL [ASM_ARITH_TAC; ALL_TAC] THEN
  REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN
  REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;

let SERIES_FINITE = prove
 (`!f s. FINITE s ==> (f sums (vsum s f)) s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `n:num` THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN
  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN
  X_GEN_TAC `m:num` THEN DISCH_TAC THEN
  SUBGOAL_THEN `s INTER (0..m) = s`
   (fun th -> ASM_REWRITE_TAC[th; DIST_REFL]) THEN
  REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN
  ASM_MESON_TAC[LE_TRANS]);;

let SERIES_FINITE_EQ = prove
 (`!f:num->real^N s y.
        FINITE s ==> ((f sums y) s <=> vsum s f = y)`,
  MESON_TAC[SERIES_FINITE; SERIES_UNIQUE]);;

let SERIES_LINEAR = prove
 (`!f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s`,
  SIMP_TAC[sums; LIM_LINEAR; FINITE_INTER; FINITE_NUMSEG;
           GSYM(REWRITE_RULE[o_DEF] LINEAR_VSUM)]);;

let SERIES_0 = prove
 (`!s. ((\n. vec 0) sums (vec 0)) s`,
  REWRITE_TAC[sums; VSUM_0; LIM_CONST]);;

let SERIES_ADD = prove
 (`!x x0 y y0 s.
     (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s`,
  SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_ADD; LIM_ADD]);;

let SERIES_SUB = prove
 (`!x x0 y y0 s.
     (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s`,
  SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_SUB; LIM_SUB]);;

let SERIES_CMUL = prove
 (`!x x0 c s. (x sums x0) s ==> ((\n. c % x n) sums (c % x0)) s`,
  SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_LMUL; LIM_CMUL]);;

let SERIES_NEG = prove
 (`!x x0 s. (x sums x0) s ==> ((\n. --(x n)) sums (--x0)) s`,
  SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_NEG; LIM_NEG]);;

let SUMS_IFF = prove
 (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f sums l) k <=> (g sums l) k)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);;

let SUMS_EQ = prove
 (`!f g k. (!x. x IN k ==> f x = g x) /\ (f sums l) k ==> (g sums l) k`,
  MESON_TAC[SUMS_IFF]);;

let SUMS_0 = prove
 (`!f:num->real^N s. (!n. n IN s ==> f n = vec 0) ==> (f sums vec 0) s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN
  EXISTS_TAC `\n:num. vec 0:real^N` THEN ASM_SIMP_TAC[SERIES_0]);;

let SERIES_FINITE_SUPPORT = prove
 (`!f:num->real^N s k.
     FINITE (s INTER k) /\ (!x. x IN k /\ ~(x IN s) ==> f x = vec 0)
     ==> (f sums vsum (s INTER k) f) k`,
  REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
  REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
  STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
  SUBGOAL_THEN `vsum (k INTER (0..n)) (f:num->real^N) = vsum(s INTER k) f`
   (fun th -> ASM_REWRITE_TAC[DIST_REFL; th]) THEN
  MATCH_MP_TAC VSUM_SUPERSET THEN
  ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN
  ASM_MESON_TAC[IN_INTER; LE_TRANS]);;

let SERIES_COMPONENT = prove
 (`!f s l:real^N k. (f sums l) s /\ 1 <= k /\ k <= dimindex(:N)
                    ==> ((\i. lift(f(i)$k)) sums lift(l$k)) s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM o_DEF] THEN
  ASM_SIMP_TAC[GSYM LIFT_SUM; GSYM VSUM_COMPONENT;
               FINITE_INTER; FINITE_NUMSEG] THEN
  ASM_SIMP_TAC[o_DEF; LIM_COMPONENT]);;

let SERIES_DIFFS = prove
 (`!f:num->real^N k.
        (f --> vec 0) sequentially
        ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)`,
  REWRITE_TAC[sums; FROM_INTER_NUMSEG; VSUM_DIFFS] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
  EXISTS_TAC `\n. (f:num->real^N) k - f(n + 1)` THEN CONJ_TAC THENL
   [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN
    SIMP_TAC[];
    GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN
    MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN
    MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);;

let SERIES_TRIVIAL = prove
 (`!f. (f sums vec 0) {}`,
  REWRITE_TAC[sums; INTER_EMPTY; VSUM_CLAUSES; LIM_CONST]);;

let SERIES_RESTRICT = prove
 (`!f k l:real^N.
        ((\n. if n IN k then f(n) else vec 0) sums l) (:num) <=>
        (f sums l) k`,
  REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN
  MATCH_MP_TAC(MESON[] `vsum s f = vsum t f /\ vsum t f = vsum t g
                        ==> vsum s f = vsum t g`) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[];
    MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_INTER]]);;

let SERIES_VSUM = prove
 (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = vec 0) /\
             vsum s f = l ==> (f sums l) k`,
  REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN
  SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL
   [ASM SET_TAC []; ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]);;

let SUMS_REINDEX = prove
 (`!k a l:real^N n.
   ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VSUM_OFFSET] THEN
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`;
                ARITH_RULE `N + k:num <= n ==> N <= n + k`]);;

let SUMS_REINDEX_GEN = prove
 (`!k a l:real^N s.
     ((\x. a(x + k)) sums l) s <=> (a sums l) (IMAGE (\i. i + k) s)`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
  MP_TAC(ISPECL
   [`k:num`;
    `\i. if i IN IMAGE (\i. i + k) s then (a:num->real^N) i else vec 0`;
    `l:real^N`; `0`] SUMS_REINDEX) THEN
  REWRITE_TAC[FROM_0] THEN
  SIMP_TAC[EQ_ADD_RCANCEL; SET_RULE
   `(!x y:num. x + k = y + k <=> x = y)
         ==> ((x + k) IN IMAGE (\i. i + k) s <=> x IN s)`] THEN
  DISCH_THEN SUBST1_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM; IN_FROM; ADD_CLAUSES] THEN
  SUBGOAL_THEN `!x:num. x IN IMAGE (\i. i + k) s ==> k <= x` MP_TAC THENL
   [REWRITE_TAC[FORALL_IN_IMAGE] THEN ARITH_TAC; SET_TAC[]]);;

let SERIES_EVEN = prove
 (`!f l:real^N n.
    (f sums l) (from n) <=>
    ((\i. if EVEN i then f(i DIV 2) else vec 0) sums l) (from (2 * n))`,
  let lemma = prove
   (`vsum(2 * m..n) (\i. if EVEN i then f i else vec 0):real^N =
     vsum(m..n DIV 2) (\i. f(2 * i))`,
    TRANS_TAC EQ_TRANS
     `vsum (2 * m..2 * (n DIV 2) + 1)
           (\i. if EVEN i then f i else vec 0):real^N` THEN
    CONJ_TAC THENL
     [ALL_TAC;
      REWRITE_TAC[VSUM_PAIR] THEN
      REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN; VECTOR_ADD_RID]] THEN
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN
    REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET_NUMSEG] THEN
    CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN
    X_GEN_TAC `p:num` THEN DISCH_TAC THEN
    SUBGOAL_THEN `p = 2 * n DIV 2 + 1` SUBST1_TAC
    THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN]) in
  REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_FROM; lemma] THEN
  REWRITE_TAC[ARITH_RULE `(2 * i) DIV 2 = i`; ETA_AX] THEN
  REWRITE_TAC[tendsto] THEN AP_TERM_TAC THEN
  GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
  REWRITE_TAC[] THEN AP_TERM_TAC THEN
  ABBREV_TAC `P m <=> dist(vsum (n..m) f:real^N,l) < e` THEN
  POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
  EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
  EXISTS_TAC `2 * N` THEN ASM_SIMP_TAC[GSYM LE_RDIV_EQ; ARITH_EQ] THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `2 * n`) THEN
  REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n`] THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC);;

let SERIES_ODD = prove
 (`!f l:real^N n.
    (f sums l) (from n) <=>
    ((\i. if ODD i then f(i DIV 2) else vec 0) sums l) (from (2 * n + 1))`,
  REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SERIES_EVEN] THEN
  REWRITE_TAC[GSYM SUMS_REINDEX] THEN
  REWRITE_TAC[ODD_ADD; ARITH_ODD; NOT_ODD] THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN
  SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[ARITH_RULE `(2 * m + 1) DIV 2 = m`] THEN
  REWRITE_TAC[ARITH_RULE `(2 * m) DIV 2 = m`]);;

let SERIES_PASTECART = prove
 (`!f1:num->real^N f2:num->real^M l1 l2 s.
        ((\x. pastecart (f1 x) (f2 x)) sums (pastecart l1 l2)) s <=>
        (f1 sums l1) s /\ (f2 sums l2) s`,
  SIMP_TAC[sums; GSYM PASTECART_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN
  REWRITE_TAC[LIM_PASTECART_EQ]);;

(* ------------------------------------------------------------------------- *)
(* Similar combining theorems just for summability.                          *)
(* ------------------------------------------------------------------------- *)

let SUMMABLE_LINEAR = prove
 (`!f h s. summable s f /\ linear h ==> summable s (\n. h(f n))`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_LINEAR]);;

let SUMMABLE_0 = prove
 (`!s. summable s (\n. vec 0)`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]);;

let SUMMABLE_ADD = prove
 (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_ADD]);;

let SUMMABLE_SUB = prove
 (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUB]);;

let SUMMABLE_CMUL = prove
 (`!s x c. summable s x ==> summable s (\n. c % x n)`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_CMUL]);;

let SUMMABLE_NEG = prove
 (`!x s. summable s x ==> summable s (\n. --(x n))`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_NEG]);;

let SUMMABLE_IFF = prove
 (`!f g k. (!x. x IN k ==> f x = g x) ==> (summable k f <=> summable k g)`,
  REWRITE_TAC[summable] THEN MESON_TAC[SUMS_IFF]);;

let SUMMABLE_EQ = prove
 (`!f g k. (!x. x IN k ==> f x = g x) /\ summable k f ==> summable k g`,
  REWRITE_TAC[summable] THEN MESON_TAC[SUMS_EQ]);;

let SUMMABLE_FINITE = prove
 (`!k f:num->real^N. FINITE k ==> summable k f`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_FINITE]);;

let SUMMABLE_COMPONENT = prove
 (`!f:num->real^N s k.
        summable s f /\ 1 <= k /\ k <= dimindex(:N)
        ==> summable s (\i. lift(f(i)$k))`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^N` o REWRITE_RULE[summable]) THEN
  REWRITE_TAC[summable] THEN EXISTS_TAC `lift((l:real^N)$k)` THEN
  ASM_SIMP_TAC[SERIES_COMPONENT]);;

let SERIES_SUBSET = prove
 (`!x s t l.
        s SUBSET t /\
        ((\i. if i IN s then x i else vec 0) sums l) t
        ==> (x sums l) s`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMP THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
  ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);;

let SUMMABLE_SUBSET = prove
 (`!x s t.
        s SUBSET t /\
        summable t (\i. if i IN s then x i else vec 0)
        ==> summable s x`,
  REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUBSET]);;

let SUMMABLE_TRIVIAL = prove
 (`!f:num->real^N. summable {} f`,
  GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `vec 0:real^N` THEN
  REWRITE_TAC[SERIES_TRIVIAL]);;

let SUMMABLE_RESTRICT = prove
 (`!f:num->real^N k.
        summable (:num) (\n. if n IN k then f(n) else vec 0) <=>
        summable k f`,
  REWRITE_TAC[summable; SERIES_RESTRICT]);;

let SUMS_FINITE_DIFF = prove
 (`!f:num->real^N t s l.
        t SUBSET s /\ FINITE t /\ (f sums l) s
        ==> (f sums (l - vsum t f)) (s DIFF t)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_ASSUM(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN
  ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
  REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
  DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN
  FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN
  MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN
  ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;

let SUMS_FINITE_UNION = prove
 (`!f:num->real^N s t l.
        FINITE t /\ (f sums l) s
        ==> (f sums (l + vsum (t DIFF s) f)) (s UNION t)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN
  DISCH_THEN(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN
  ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
  REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
  DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN
  REWRITE_TAC[IN_DIFF; IN_UNION] THEN
  MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN
  ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;

let SUMS_OFFSET = prove
 (`!f l:real^N m n.
           (f sums l) (from m) /\ 0 < n /\ m <= n
           ==> (f sums l - vsum (m..n - 1) f) (from n)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC;
    MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
    SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);;

let SUMS_OFFSET_REV = prove
 (`!f:num->real^N l m n.
        (f sums l) (from m) /\ 0 < m /\ n <= m

        ==> (f sums (l + vsum(n..m-1) f)) (from n)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:num->real^N`; `from m`; `n..m-1`; `l:real^N`]
                SUMS_FINITE_UNION) THEN
  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN
  BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN
  ASM_ARITH_TAC);;

let SUMMABLE_REINDEX = prove
 (`!k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a`,
  REWRITE_TAC[summable; GSYM SUMS_REINDEX]);;

let SUMMABLE_EVEN = prove
 (`!f:num->real^N n.
        summable (from n) f <=>
        summable (from (2 * n)) (\i. if EVEN i then f(i DIV 2) else vec 0)`,
  REWRITE_TAC[summable; GSYM SERIES_EVEN]);;

let SUMMABLE_ODD = prove
 (`!f:num->real^N n.
        summable (from n) f <=>
        summable (from (2 * n + 1)) (\i. if ODD i then f(i DIV 2) else vec 0)`,
  REWRITE_TAC[summable; GSYM SERIES_ODD]);;

let SERIES_DROP_LE = prove
 (`!f g s a b.
        (f sums a) s /\ (g sums b) s /\
        (!x. x IN s ==> drop(f x) <= drop(g x))
        ==> drop a <= drop b`,
  REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN
  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
  EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^1)` THEN
  EXISTS_TAC `\n. vsum (s INTER (0..n)) (g:num->real^1)` THEN
  ASM_REWRITE_TAC[DROP_VSUM] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUM_LE THEN
  ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; o_THM; IN_INTER; IN_NUMSEG]);;

let SERIES_DROP_POS = prove
 (`!f s a.
        (f sums a) s /\ (!x. x IN s ==> &0 <= drop(f x))
        ==> &0 <= drop a`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(\n. vec 0):num->real^1`; `f:num->real^1`; `s:num->bool`;
                 `vec 0:real^1`; `a:real^1`] SERIES_DROP_LE) THEN
  ASM_SIMP_TAC[SUMS_0; DROP_VEC]);;

let SERIES_BOUND = prove
 (`!f:num->real^N g s a b.
        (f sums a) s /\ ((lift o g) sums (lift b)) s /\
        (!i. i IN s ==> norm(f i) <= g i)
        ==> norm(a) <= b`,
  REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
  EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^N)` THEN
  ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN
  X_GEN_TAC `m:num` THEN DISCH_TAC THEN
  TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..m)) g` THEN CONJ_TAC THEN
  ASM_SIMP_TAC[VSUM_NORM_LE; IN_INTER; FINITE_NUMSEG; FINITE_INTER] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN
  UNDISCH_TAC `((lift o g) sums lift b) s` THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN
  REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC `m + 1` o MATCH_MP
   (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN
  ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[ARITH_RULE `0 < m + 1`; o_DEF; ADD_SUB] THEN
  REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN
  REWRITE_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SERIES_DROP_POS)) THEN
  REWRITE_TAC[DROP_SUB; LIFT_DROP; ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER);
              REAL_SUB_LE] THEN
  DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_REFL] THEN
  ASM_MESON_TAC[NORM_ARITH `norm(x:real^N) <= y ==> &0 <= y`]);;

(* ------------------------------------------------------------------------- *)
(* Similar combining theorems for infsum.                                    *)
(* ------------------------------------------------------------------------- *)

let INFSUM_LINEAR = prove
 (`!f h s. summable s f /\ linear h
           ==> infsum s (\n. h(f n)) = h(infsum s f)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
  MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;

let INFSUM_0 = prove
 (`infsum s (\i. vec 0) = vec 0`,
  MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]);;

let INFSUM_ADD = prove
 (`!x y s. summable s x /\ summable s y
           ==> infsum s (\i. x i + y i) = infsum s x + infsum s y`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
  MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;

let INFSUM_SUB = prove
 (`!x y s. summable s x /\ summable s y
           ==> infsum s (\i. x i - y i) = infsum s x - infsum s y`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
  MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;

let INFSUM_CMUL = prove
 (`!s x c. summable s x ==> infsum s (\n. c % x n) = c % infsum s x`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
  MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;

let INFSUM_NEG = prove
 (`!s x. summable s x ==> infsum s (\n. --(x n)) = --(infsum s x)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
  MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;

let INFSUM_EQ = prove
 (`!f g k. summable k f /\ summable k g /\ (!x. x IN k ==> f x = g x)
           ==> infsum k f = infsum k g`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN
  AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ; SUMS_INFSUM]);;

let INFSUM_RESTRICT = prove
 (`!k a:num->real^N.
        infsum (:num) (\n. if n IN k then a n else vec 0) = infsum k a`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`a:num->real^N`; `k:num->bool`] SUMMABLE_RESTRICT) THEN
  ASM_CASES_TAC `summable k (a:num->real^N)` THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THENL
   [MATCH_MP_TAC INFSUM_UNIQUE THEN
    ASM_REWRITE_TAC[SERIES_RESTRICT; SUMS_INFSUM];
    RULE_ASSUM_TAC(REWRITE_RULE[summable; NOT_EXISTS_THM]) THEN
    ASM_REWRITE_TAC[infsum]]);;

let PARTIAL_SUMS_COMPONENT_LE_INFSUM = prove
 (`!f:num->real^N s k n.
        1 <= k /\ k <= dimindex(:N) /\
        (!i. i IN s ==> &0 <= (f i)$k) /\
        summable s f
        ==> (vsum (s INTER (0..n)) f)$k <= (infsum s f)$k`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
  REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   `vsum (s INTER (0..n)) (f:num->real^N)$k - (infsum s f)$k`) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N + n:num`)) THEN
  REWRITE_TAC[LE_ADD; REAL_NOT_LT; dist] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `abs((vsum (s INTER (0..N + n)) f - infsum s f:real^N)$k)` THEN
  ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN
  MATCH_MP_TAC(REAL_ARITH `s < a /\ a <= b ==> a - s <= abs(b - s)`) THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
  SIMP_TAC[NUMSEG_ADD_SPLIT; LE_0; UNION_OVER_INTER] THEN
  W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhand o rand o snd) THEN
  ANTS_TAC THENL
   [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; DISJOINT; EXTENSION] THEN
    REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC;
    DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[REAL_LE_ADDR; VECTOR_ADD_COMPONENT] THEN
    ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_POS_LE THEN
    ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);;

let PARTIAL_SUMS_DROP_LE_INFSUM = prove
 (`!f s n.
        (!i. i IN s ==> &0 <= drop(f i)) /\
        summable s f
        ==> drop(vsum (s INTER (0..n)) f) <= drop(infsum s f)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[drop] THEN
  MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN
  ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL; GSYM drop]);;

let INFSUM_EVEN = prove
 (`!f:num->real^N n.
        infsum (from n) f =
        infsum (from (2 * n)) (\i. if EVEN i then f(i DIV 2) else vec 0)`,
  REWRITE_TAC[infsum; GSYM SERIES_EVEN]);;

let INFSUM_ODD = prove
 (`!f:num->real^N n.
        infsum (from n) f =
        infsum (from (2 * n + 1)) (\i. if ODD i then f(i DIV 2) else vec 0)`,
  REWRITE_TAC[infsum; GSYM SERIES_ODD]);;

(* ------------------------------------------------------------------------- *)
(* Cauchy criterion for series.                                              *)
(* ------------------------------------------------------------------------- *)

let SEQUENCE_CAUCHY_WLOG = prove
 (`!P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=>
         (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)`,
  MESON_TAC[DIST_SYM; LE_CASES]);;

let VSUM_DIFF_LEMMA = prove
 (`!f:num->real^N k m n.
        m <= n
        ==> vsum(k INTER (0..n)) f - vsum(k INTER (0..m)) f =
            vsum(k INTER (m+1..n)) f`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:num->real^N`; `k INTER (0..n)`; `k INTER (0..m)`]
    VSUM_DIFF) THEN
  ANTS_TAC THENL
   [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC
     (SET_RULE `s SUBSET t ==> (u INTER s SUBSET u INTER t)`) THEN
    REWRITE_TAC[SUBSET; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
    DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN
    REWRITE_TAC[SET_RULE
     `(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)`] THEN
    AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_NUMSEG] THEN
    POP_ASSUM MP_TAC THEN ARITH_TAC]);;

let NORM_VSUM_TRIVIAL_LEMMA = prove
 (`!e. &0 < e ==> (P ==> norm(vsum(s INTER (m..n)) f) < e <=>
                   P ==> n < m \/ norm(vsum(s INTER (m..n)) f) < e)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `n:num < m` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [GSYM NUMSEG_EMPTY]) THEN
  ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0; INTER_EMPTY]);;

let SERIES_CAUCHY = prove
 (`!f s. (?l. (f sums l) s) =
         !e. &0 < e
             ==> ?N. !m n. m >= N
                           ==> norm(vsum(s INTER (m..n)) f) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[sums; CONVERGENT_EQ_CAUCHY; cauchy] THEN
  REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
  SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN
  REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
  REWRITE_TAC[NOT_LT; ARITH_RULE
   `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=>
    N + 1 <= m + 1 /\ m + 1 <= n`] THEN
  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL
   [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN
  SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL
   [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN
  ASM_ARITH_TAC);;

let SUMMABLE_CAUCHY = prove
 (`!f s. summable s f <=>
         !e. &0 < e
             ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`,
  REWRITE_TAC[summable; GSYM SERIES_CAUCHY]);;

let SUMMABLE_IFF_EVENTUALLY = prove
 (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n)
           ==> (summable k f <=> summable k g)`,
  REWRITE_TAC[summable; SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN
  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
  AP_TERM_TAC THEN EQ_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `N1:num`
   (fun th -> EXISTS_TAC `N0 + N1:num` THEN MP_TAC th)) THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
  (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER; IN_NUMSEG] THEN
  REPEAT STRIP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  ASM_ARITH_TAC);;

let SUMMABLE_EQ_EVENTUALLY = prove
 (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ summable k f
           ==> summable k g`,
  MESON_TAC[SUMMABLE_IFF_EVENTUALLY]);;

let SUMMABLE_IFF_COFINITE = prove
 (`!f s t. FINITE((s DIFF t) UNION (t DIFF s))
           ==> (summable s f <=> summable t f)`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN
  MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN
  FIRST_ASSUM(MP_TAC o ISPEC `\x:num.x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN
  DISCH_TAC THEN EXISTS_TAC `N + 1` THEN
  REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`] THEN ASM SET_TAC[]);;

let SUMMABLE_EQ_COFINITE = prove
 (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f
           ==> summable t f`,
  MESON_TAC[SUMMABLE_IFF_COFINITE]);;

let SUMMABLE_FROM_ELSEWHERE = prove
 (`!f m n. summable (from m) f ==> summable (from n) f`,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ_COFINITE) THEN
  MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN
  SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN
  ARITH_TAC);;

let SUMMABLE_FROM_ELSEWHERE_EQ = prove
 (`!n m f:num->real^N. summable (from m) f <=> summable (from n) f`,
  MESON_TAC[SUMMABLE_FROM_ELSEWHERE]);;

(* ------------------------------------------------------------------------- *)
(* Uniform vesion of Cauchy criterion.                                       *)
(* ------------------------------------------------------------------------- *)

let SERIES_CAUCHY_UNIFORM = prove
 (`!P f:A->num->real^N k.
        (?l. !e. &0 < e
                 ==> ?N. !n x. N <= n /\ P x
                               ==> dist(vsum(k INTER (0..n)) (f x),
                                        l x) < e) <=>
        (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x
                                    ==> norm(vsum(k INTER (m..n)) (f x)) < e)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[sums; UNIFORMLY_CONVERGENT_EQ_CAUCHY; cauchy] THEN
  ONCE_REWRITE_TAC[MESON[]
   `(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=>
    (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)`] THEN
  REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
  SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN
  REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
  REWRITE_TAC[NOT_LT; ARITH_RULE
   `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=>
    N + 1 <= m + 1 /\ m + 1 <= n`] THEN
  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL
   [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN
  SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL
   [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN
  ASM_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* So trivially, terms of a convergent series go to zero.                    *)
(* ------------------------------------------------------------------------- *)

let SERIES_GOESTOZERO = prove
 (`!s x. summable s x
         ==> !e. &0 < e
                 ==> eventually (\n. n IN s ==> norm(x n) < e) sequentially`,
  REPEAT GEN_TAC THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
  X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`]) THEN
  ASM_SIMP_TAC[NUMSEG_SING; GE; SET_RULE `n IN s ==> s INTER {n} = {n}`] THEN
  REWRITE_TAC[VSUM_SING]);;

let SUMMABLE_IMP_TOZERO = prove
 (`!f:num->real^N k.
       summable k f
       ==> ((\n. if n IN k then f(n) else vec 0) --> vec 0) sequentially`,
  REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN
  REWRITE_TAC[summable; LIM_SEQUENTIALLY; INTER_UNIV; sums] THEN
  DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN X_GEN_TAC `e:real` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `N:num` THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(fun th ->
    MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN
  ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> N <= n /\ N <= n - 1`] THEN
  ABBREV_TAC `m = n - 1` THEN
  SUBGOAL_THEN `n = SUC m` SUBST1_TAC THENL
   [ASM_ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN
  REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC NORM_ARITH);;

let SUMMABLE_IMP_BOUNDED = prove
 (`!f:num->real^N k. summable k f ==> bounded (IMAGE f k)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN
  DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
  REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN
  MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE; NORM_0]);;

let SUMMABLE_IMP_SUMS_BOUNDED = prove
 (`!f:num->real^N k.
       summable (from k) f ==> bounded { vsum(k..n) f | n IN (:num) }`,
  REWRITE_TAC[summable; sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
  REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);;

(* ------------------------------------------------------------------------- *)
(* Comparison test.                                                          *)
(* ------------------------------------------------------------------------- *)

let SERIES_COMPARISON = prove
 (`!f g s. (?l. ((lift o g) sums l) s) /\
           (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n)
           ==> ?l:real^N. (f sums l) s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
  EXISTS_TAC `N1 + N2:num` THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL
   [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN
    MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN
    MATCH_MP_TAC VSUM_NORM_LE THEN
    REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN
    ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num /\ m <= x ==> x >= N1`];
    ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num ==> m >= N2`]]);;

let SUMMABLE_COMPARISON = prove
 (`!f g s. summable s (lift o g) /\
           (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n)
           ==> summable s f`,
  REWRITE_TAC[summable; SERIES_COMPARISON]);;

let SERIES_LIFT_ABSCONV_IMP_CONV = prove
 (`!x:num->real^N k. summable k (\n. lift(norm(x n))) ==> summable k x`,
  REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SERIES_COMPARISON THEN
  EXISTS_TAC `\n:num. norm(x n:real^N)` THEN
  ASM_REWRITE_TAC[o_DEF; REAL_LE_REFL] THEN ASM_MESON_TAC[]);;

let SUMMABLE_SUBSET_ABSCONV = prove
 (`!x:num->real^N s t.
        summable s (\n. lift(norm(x n))) /\ t SUBSET s
        ==> summable t (\n. lift(norm(x n)))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN
  EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN
  EXISTS_TAC `\n:num. norm(x n:real^N)` THEN
  ASM_REWRITE_TAC[o_DEF; GSYM summable] THEN
  EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  REWRITE_TAC[REAL_LE_REFL; NORM_LIFT; REAL_ABS_NORM; NORM_0; NORM_POS_LE]);;

let SERIES_COMPARISON_BOUND = prove
 (`!f:num->real^N g s a.
        (g sums a) s /\ (!i. i IN s ==> norm(f i) <= drop(g i))
        ==> ?l. (f sums l) s /\ norm(l) <= drop a`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`]
        SUMMABLE_COMPARISON) THEN
  REWRITE_TAC[o_DEF; LIFT_DROP; GE; ETA_AX; summable] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
  X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[FROM_0; INTER_UNIV; sums]) THEN
  MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC
   [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] THEN
  ASM_REWRITE_TAC[sums; o_DEF; LIFT_DROP; ETA_AX]);;

(* ------------------------------------------------------------------------- *)
(* Uniform version of comparison test.                                       *)
(* ------------------------------------------------------------------------- *)

let SERIES_COMPARISON_UNIFORM = prove
 (`!f g P s. (?l. ((lift o g) sums l) s) /\
             (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= g n)
             ==> ?l:A->real^N.
                    !e. &0 < e
                        ==> ?N. !n x. N <= n /\ P x
                                      ==> dist(vsum(s INTER (0..n)) (f x),
                                               l x) < e`,
  REPEAT GEN_TAC THEN SIMP_TAC[GE; SERIES_CAUCHY; SERIES_CAUCHY_UNIFORM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
  EXISTS_TAC `N1 + N2:num` THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL
   [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN
    MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN
    MATCH_MP_TAC VSUM_NORM_LE THEN
    REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN
    ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`];
    ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);;

(* ------------------------------------------------------------------------- *)
(* Ratio test.                                                               *)
(* ------------------------------------------------------------------------- *)

let SERIES_RATIO = prove
 (`!c a s N.
      c < &1 /\
      (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n)))
      ==> ?l:real^N. (a sums l) s`,
  REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SERIES_COMPARISON THEN
  DISJ_CASES_TAC(REAL_ARITH `c <= &0 \/ &0 < c`) THENL
   [EXISTS_TAC `\n:num. &0` THEN REWRITE_TAC[o_DEF; LIFT_NUM] THEN
    CONJ_TAC THENL [MESON_TAC[SERIES_0]; ALL_TAC] THEN
    EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm(a(n - 1):real^N)` THEN
    CONJ_TAC THENL
     [ASM_MESON_TAC[ARITH_RULE `N + 1 <= n ==> SUC(n - 1) = n /\ N <= n - 1`];
      ALL_TAC] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= --c * x ==> c * x <= &0`) THEN
    MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN
    UNDISCH_TAC `c <= &0` THEN REAL_ARITH_TAC;
    ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`))] THEN
  EXISTS_TAC `\n. norm(a(N):real^N) * c pow (n - N)` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [ALL_TAC;
    EXISTS_TAC `N:num` THEN
    SIMP_TAC[GE; LE_EXISTS; IMP_CONJ; ADD_SUB2; LEFT_IMP_EXISTS_THM] THEN
    SUBGOAL_THEN `!d:num. norm(a(N + d):real^N) <= norm(a N) * c pow d`
     (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN
    REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_RID; REAL_LE_REFL] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `c * norm((a:num->real^N) (N + d))` THEN
    ASM_SIMP_TAC[LE_ADD] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]] THEN
  GEN_REWRITE_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC `e:real` THEN
  SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER; NORM_LIFT; FINITE_NUMSEG] THEN
  DISCH_TAC THEN SIMP_TAC[SUM_LMUL; FINITE_INTER; FINITE_NUMSEG] THEN
  ASM_CASES_TAC `(a:num->real^N) N = vec 0` THENL
   [ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_ABS_NUM]; ALL_TAC] THEN
  MP_TAC(SPECL [`c:real`; `((&1 - c) * e) / norm((a:num->real^N) N)`]
               REAL_ARCH_POW_INV) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_SUB_LT; NORM_POS_LT; GE] THEN
  DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `N + M:num` THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `abs(norm((a:num->real^N) N) *
                  sum(m..n) (\i. c pow (i - N)))` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
    REWRITE_TAC[REAL_ABS_POS] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN
    ASM_SIMP_TAC[SUM_POS_LE; FINITE_INTER_NUMSEG; REAL_POW_LE] THEN
    MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[REAL_POW_LE] THEN
    REWRITE_TAC[FINITE_INTER_NUMSEG; FINITE_NUMSEG] THEN
    REWRITE_TAC[IN_INTER; IN_DIFF] THEN MESON_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN
  DISJ_CASES_TAC(ARITH_RULE `n:num < m \/ m <= n`) THENL
   [ASM_SIMP_TAC[SUM_TRIV_NUMSEG; REAL_ABS_NUM; REAL_MUL_RZERO]; ALL_TAC] THEN
  SUBGOAL_THEN `m = 0 + m /\ n = (n - m) + m` (CONJUNCTS_THEN SUBST1_TAC) THENL
   [UNDISCH_TAC `m:num <= n` THEN ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[SUM_OFFSET] THEN UNDISCH_TAC `N + M:num <= m` THEN
  SIMP_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN
  REWRITE_TAC[ARITH_RULE `(i + (N + M) + d) - N:num = (M + d) + i`] THEN
  ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN
  ASM_SIMP_TAC[LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; REAL_ABS_MUL] THEN
  REWRITE_TAC[REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ABS_DIV; REAL_POW_LT; REAL_ARITH
   `&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c)`; REAL_LT_LDIV_EQ] THEN
  MATCH_MP_TAC(REAL_ARITH
   `&0 < x /\ x <= &1 /\ &1 <= e ==> abs(c pow 0 - x) < e`) THEN
  ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_1_LE; REAL_LT_IMP_LE] THEN
  ASM_SIMP_TAC[REAL_ARITH `c < &1 ==> x * abs(&1 - c) = (&1 - c) * x`] THEN
  REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_MUL_ASSOC] THEN
  REWRITE_TAC[REAL_ARITH
   `(((a * b) * c) * d) * e = (e * ((a * b) * c)) * d`] THEN
  ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_MUL_LID;
               REAL_ARITH `&0 < c ==> abs c = c`] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   `xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e`)) THEN
  MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
   [REWRITE_TAC[REAL_SUB_LE; GSYM REAL_POW_INV] THEN
    MATCH_MP_TAC REAL_POW_LE_1 THEN
    MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
    MATCH_MP_TAC REAL_LT_IMP_LE THEN
    ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT]]);;

let SUMMABLE_RATIO = prove
 (`!c a:num->real^N s N.
      c < &1 /\
      (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n)))
      ==> summable s a`,
  REWRITE_TAC[summable; SERIES_RATIO]);;

let SUMMABLE_REAL_GP = prove
 (`!x k. abs x < &1 ==> summable k (\n. lift(x pow n))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_RATIO THEN
  MAP_EVERY EXISTS_TAC [`abs x`; `0`] THEN
  ASM_REWRITE_TAC[NORM_LIFT; real_pow; REAL_ABS_MUL; REAL_LE_REFL]);;

(* ------------------------------------------------------------------------- *)
(* Ostensibly weaker versions of the boundedness of partial sums.            *)
(* ------------------------------------------------------------------------- *)

let BOUNDED_PARTIAL_SUMS = prove
 (`!f:num->real^N k.
        bounded { vsum(k..n) f | n IN (:num) }
        ==> bounded { vsum(m..n) f | m IN (:num) /\ n IN (:num) }`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `bounded { vsum(0..n) f:real^N | n IN (:num) }` MP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
    REWRITE_TAC[bounded] THEN
    REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN
    DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `sum { i:num | i < k} (\i. norm(f i:real^N)) + B` THEN
    X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num < k` THENL
     [MATCH_MP_TAC(REAL_ARITH
       `!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b`) THEN
      EXISTS_TAC `sum (0..i) (\i. norm(f i:real^N))` THEN
      ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG] THEN
      MATCH_MP_TAC SUM_SUBSET THEN
      REWRITE_TAC[FINITE_NUMSEG; FINITE_NUMSEG_LT; NORM_POS_LE] THEN
      REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN ASM_ARITH_TAC;
      ALL_TAC] THEN
    ASM_CASES_TAC `k = 0` THENL
     [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH
       `x <= B /\ &0 <= b ==> x <= b + B`) THEN
      ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG_LT; NORM_POS_LE];
      ALL_TAC] THEN
    MP_TAC(ISPECL [`f:num->real^N`; `0`; `k:num`; `i:num`]
      VSUM_COMBINE_L) THEN
    ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN
    MATCH_MP_TAC(NORM_ARITH
     `norm(x) <= a /\ norm(y) <= b ==> norm(x + y) <= a + b`) THEN
    ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG];
    ALL_TAC] THEN
  DISCH_THEN(fun th ->
    MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN
  REWRITE_TAC[IMP_IMP; GSYM BOUNDED_UNION] THEN
  MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`]
        BOUNDED_SUBSET) THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `m:num`; `n:num`] THEN
  DISCH_THEN SUBST1_TAC THEN
  ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  ASM_CASES_TAC `n:num < m` THENL
   [DISJ2_TAC THEN REPEAT(EXISTS_TAC `vsum(0..0) (f:num->real^N)`) THEN
    ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; VECTOR_SUB_REFL] THEN MESON_TAC[];
    ALL_TAC] THEN
  DISJ2_TAC THEN MAP_EVERY EXISTS_TAC
   [`vsum(0..n) (f:num->real^N)`; `vsum(0..(m-1)) (f:num->real^N)`] THEN
  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPECL [`f:num->real^N`; `0`; `m:num`; `n:num`]
      VSUM_COMBINE_L) THEN
  ANTS_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* General Dirichlet convergence test (could make this uniform on a set).    *)
(* ------------------------------------------------------------------------- *)

let SUMMABLE_BILINEAR_PARTIAL_PRE = prove
 (`!f g h:real^M->real^N->real^P l k.
        bilinear h /\
        ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\
        summable (from k) (\n. h (f(n + 1) - f(n)) (g(n)))
        ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_ASSUM(fun th ->
   REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE th]) THEN
  DISCH_THEN(X_CHOOSE_TAC `l':real^P`) THEN
  EXISTS_TAC `l - (h:real^M->real^N->real^P) (f k) (g(k - 1)) - l'` THEN
  REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN
  REPEAT(MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]));;

let SERIES_DIRICHLET_BILINEAR = prove
 (`!f g h:real^M->real^N->real^P k m p l.
        bilinear h /\
        bounded { vsum (m..n) f | n IN (:num)} /\
        summable (from p) (\n. lift(norm(g(n + 1) - g(n)))) /\
        ((\n. h (g(n + 1)) (vsum(1..n) f)) --> l) sequentially
        ==> summable (from k) (\n. h (g n) (f n))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN
  EXISTS_TAC `1` THEN
  FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
  SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN
  X_GEN_TAC `B:real` THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN
  DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC SUMMABLE_EQ THEN
  EXISTS_TAC `\n. (h:real^M->real^N->real^P)
                  (g n) (vsum (1..n) f - vsum (1..n-1) f)` THEN
  SIMP_TAC[IN_FROM; GSYM NUMSEG_RREC] THEN
  SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG;
           ARITH_RULE `1 <= n ==> ~(n <= n - 1)`] THEN
  CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RSUB] THEN
    VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `p:num` THEN
  MP_TAC(ISPECL [`g:num->real^M`; `\n. vsum(1..n) f:real^N`;
                 `h:real^M->real^N->real^P`; `l:real^P`; `p:num`]
         SUMMABLE_BILINEAR_PARTIAL_PRE) THEN
  REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
    `summable (from p) (lift o (\n. C * B * norm(g(n + 1) - g(n):real^M)))`
  MP_TAC THENL [ASM_SIMP_TAC[o_DEF; LIFT_CMUL; SUMMABLE_CMUL]; ALL_TAC] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN
  EXISTS_TAC `0` THEN REWRITE_TAC[IN_FROM; GE; LE_0] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
   `C * norm(g(n + 1) - g(n):real^M) * norm(vsum (1..n) f:real^N)` THEN
  ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
  GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
  ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);;

let SERIES_DIRICHLET = prove
 (`!f:num->real^N g N k m.
        bounded { vsum (m..n) f | n IN (:num)} /\
        (!n. N <= n ==> g(n + 1) <= g(n)) /\
        ((lift o g) --> vec 0) sequentially
        ==> summable (from k) (\n. g(n) % f(n))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:num->real^N`; `lift o (g:num->real)`;
                 `\x y:real^N. drop x % y`] SERIES_DIRICHLET_BILINEAR) THEN
  REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
  MAP_EVERY EXISTS_TAC [`m:num`; `N:num`; `vec 0:real^N`] THEN CONJ_TAC THENL
   [REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN
    REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
  FIRST_ASSUM(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN
  REWRITE_TAC[o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
   [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN
    EXISTS_TAC `\n. lift(g(n) - g(n + 1))` THEN REWRITE_TAC[] THEN
    CONJ_TAC THENL
     [ASM_MESON_TAC[REAL_ARITH `b <= a ==> abs(b - a) = a - b`];
      REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG; VSUM_DIFFS; LIFT_SUB] THEN
      REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN
      EXISTS_TAC `lift(g(N:num)) - vec 0` THEN
      MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]];
    MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN ASM_REWRITE_TAC[o_DEF] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
    SIMP_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Rearranging absolutely convergent series.                                 *)
(* ------------------------------------------------------------------------- *)

let SERIES_INJECTIVE_IMAGE_STRONG = prove
 (`!x:num->real^N s f.
        summable (IMAGE f s) (\n. lift(norm(x n))) /\
        (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n)
        ==> ((\n. vsum (IMAGE f s INTER (0..n)) x -
                  vsum (s INTER (0..n)) (x o f)) --> vec 0)
            sequentially`,
  let lemma = prove
   (`!f:A->real^N s t.
          FINITE s /\ FINITE t
          ==> vsum s f - vsum t f = vsum (s DIFF t) f - vsum (t DIFF s) f`,
    REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
    ASM_SIMP_TAC[VSUM_DIFF; INTER_SUBSET] THEN
    REWRITE_TAC[INTER_COMM] THEN VECTOR_ARITH_TAC) in
  REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUMMABLE_CAUCHY]) THEN
  SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN
  REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN
  SIMP_TAC[real_abs; SUM_POS_LE; NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[dist; GE; VECTOR_SUB_RZERO; REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
  DISCH_THEN(X_CHOOSE_TAC `g:num->num`) THEN
  MP_TAC(ISPECL [`g:num->num`; `0..N`] UPPER_BOUND_FINITE_SET) THEN
  REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN
  DISCH_THEN(X_CHOOSE_TAC `P:num`) THEN
  EXISTS_TAC `MAX N P` THEN X_GEN_TAC `n:num` THEN
  SIMP_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN DISCH_TAC THEN
  W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE o rand o
    rand o lhand o snd) THEN
  ANTS_TAC THENL
   [ASM_MESON_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER];
    DISCH_THEN(SUBST1_TAC o SYM)] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN
  SIMP_TAC[FINITE_INTER; FINITE_IMAGE; FINITE_NUMSEG] THEN
  DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(NORM_ARITH
   `norm a < e / &2 /\ norm b < e / &2 ==> norm(a - b:real^N) < e`) THEN
  CONJ_TAC THEN
  W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN
  SIMP_TAC[FINITE_DIFF; FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
  MATCH_MP_TAC REAL_LET_TRANS THENL
   [EXISTS_TAC
     `sum(IMAGE (f:num->num) s INTER (N..n)) (\i. norm(x i :real^N))` THEN
    ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
    SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN
    MATCH_MP_TAC(SET_RULE
     `(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t)
      ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET
          IMAGE f s INTER t`) THEN
    ASM_SIMP_TAC[IN_NUMSEG; LE_0; NOT_LE] THEN
    X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM NOT_LE] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV
     [GSYM CONTRAPOS_THM]) THEN
    ASM_SIMP_TAC[] THEN ASM_ARITH_TAC;
    MP_TAC(ISPECL [`f:num->num`; `0..n`] UPPER_BOUND_FINITE_SET) THEN
    REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN
    DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN
    EXISTS_TAC
     `sum(IMAGE (f:num->num) s INTER (N..p)) (\i. norm(x i :real^N))` THEN
    ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
    SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN
    MATCH_MP_TAC(SET_RULE
     `(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t)
      ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET
          (IMAGE f s INTER t)`) THEN
    ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN ASM_ARITH_TAC]);;

let SERIES_INJECTIVE_IMAGE = prove
 (`!x:num->real^N s f l.
        summable (IMAGE f s) (\n. lift(norm(x n))) /\
        (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n)
        ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN
  MATCH_MP_TAC LIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN
  ASM_REWRITE_TAC[]);;

let SERIES_REARRANGE_EQ = prove
 (`!x:num->real^N s p l.
        summable s (\n. lift(norm(x n))) /\ p permutes s
        ==> (((x o p) sums l) s <=> (x sums l) s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`x:num->real^N`; `s:num->bool`; `p:num->num`; `l:real^N`]
        SERIES_INJECTIVE_IMAGE) THEN
  ASM_SIMP_TAC[PERMUTES_IMAGE] THEN
  ASM_MESON_TAC[PERMUTES_INJECTIVE]);;

let SERIES_REARRANGE = prove
 (`!x:num->real^N s p l.
        summable s (\n. lift(norm(x n))) /\ p permutes s /\ (x sums l) s
        ==> ((x o p) sums l) s`,
  MESON_TAC[SERIES_REARRANGE_EQ]);;

let SUMMABLE_REARRANGE = prove
 (`!x s p.
        summable s (\n. lift(norm(x n))) /\ p permutes s
        ==> summable s (x o p)`,
  MESON_TAC[SERIES_LIFT_ABSCONV_IMP_CONV; summable; SERIES_REARRANGE]);;

(* ------------------------------------------------------------------------- *)
(* Some general theorems about series averages, convolutions etc.            *)
(* ------------------------------------------------------------------------- *)

let TOEPLITZ_BILINEAR_SERIES_NULL = prove
 (`!(bop:real^M->real^N->real^P) a x m b.
        bilinear bop /\
        (x --> vec 0) sequentially /\
        (!p. ((\n. a n p) --> vec 0) sequentially) /\
        (!n. sum (0..n) (\i. norm(a n i)) <= b)
        ==> ((\n. vsum(m..n) (\i. bop (a n i) (x i))) --> vec 0) sequentially`,
  ONCE_REWRITE_TAC[MESON[]
   `(!p a x m b. P p a x m b) <=> (!p b a m x. P p a x m b)`] THEN
  REPLICATE_TAC 3 GEN_TAC THEN
  MATCH_MP_TAC(MESON[] `(!m. P 0 ==> P m) /\ P 0 ==> !m. P m`) THEN
  CONJ_TAC THENL
   [X_GEN_TAC `m:num` THEN DISCH_TAC THEN X_GEN_TAC `x:num->real^N` THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC
     `\i. if i < m then vec 0 else (x:num->real^N) i`) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        LIM_TRANSFORM_EVENTUALLY)) THEN
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `m:num` THEN
      SIMP_TAC[GSYM NOT_LE];
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
      MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `i:num` THEN
      REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN
      REWRITE_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; IN_NUMSEG; LE_0; LE_REFL] THEN
      SIMP_TAC[GSYM NOT_LE; IMP_CONJ] THEN ASM_MESON_TAC[BILINEAR_RZERO]];
    REPEAT STRIP_TAC] THEN
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
    MATCH_MP BILINEAR_BOUNDED_POS) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC `e / B / (&2 * abs b + &1)`) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2 * abs b + &1`] THEN
  REWRITE_TAC[DIST_0; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `m:num` THEN DISCH_TAC THEN
  SUBGOAL_THEN
    `((\n. vsum(0..m) (\i. (bop:real^M->real^N->real^P) (a n i) (x i)))
      --> vec 0) sequentially`
  MP_TAC THENL
   [MATCH_MP_TAC LIM_NULL_VSUM THEN
    REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
    X_GEN_TAC `k:num` THEN STRIP_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `(x:num->real^N) k` o
        MATCH_MP BILINEAR_LZERO) THEN
    MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`]
        LIM_BILINEAR) THEN
    DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LIM_CONST];
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN
    DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; DIST_0; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `p:num` THEN DISCH_TAC THEN
  EXISTS_TAC `MAX m p` THEN X_GEN_TAC `n:num` THEN
  REWRITE_TAC[ARITH_RULE `MAX a b <= n <=> a <= n /\ b <= n`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `0 <= m + 1 /\ m <= n` MP_TAC THENL
   [ASM_ARITH_TAC;
    DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP VSUM_COMBINE_R th)])] THEN
  MATCH_MP_TAC(NORM_ARITH
   `norm(x:real^N) < e / &2 /\ norm(y) <= e / &2 ==> norm(x + y) < e`) THEN
  ASM_SIMP_TAC[] THEN
  MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
  TRANS_TAC REAL_LE_TRANS
    `sum(m + 1..n) (\i. norm((a:num->num->real^M) n i)) *
     e / (&2 * abs b + &1)` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN
    X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN
    FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
    REWRITE_TAC[GSYM REAL_MUL_ASSOC; real_div] THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
    MATCH_MP_TAC(REAL_ARITH `x < e / b / c ==> x <= e * inv c * inv b`) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    ONCE_REWRITE_TAC[REAL_ARITH
     `s * e / b <= e / &2 <=> e * (&2 * s) / b <= e * &1`] THEN
    ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_LDIV_EQ;
                 REAL_ARITH `&0 < &2 * abs b + &1`] THEN
    MATCH_MP_TAC(REAL_ARITH `x <= b ==> &2 * x <= &1 * (&2 * abs b + &1)`) THEN
    TRANS_TAC REAL_LE_TRANS
     `sum(0..n) (\i. norm((a:num->num->real^M) n i))` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
    REWRITE_TAC[SUBSET; NORM_POS_LE; IN_NUMSEG; FINITE_NUMSEG] THEN
    ARITH_TAC]);;

let TOEPLITZ_BILINEAR_SERIES = prove
 (`!(bop:real^M->real^N->real^P) a x m r l i b.
        bilinear bop /\
        (x --> l) sequentially /\
        (!p. ((\n. a n p) --> vec 0) sequentially) /\
        (((\n. vsum(r..n) (\i. a n i))) --> i) sequentially /\
        (!n. sum (0..n) (\i. norm(a n i)) <= b)
        ==> ((\n. vsum(m..n) (\i. bop (a n i) (x i))) --> bop i l)
             sequentially`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`bop:real^M->real^N->real^P`; `a:num->num->real^M`;
    `\n. (x:num->real^N) n - l`; `m:num`; `b:real`]
   TOEPLITZ_BILINEAR_SERIES_NULL) THEN
  ASM_REWRITE_TAC[GSYM LIM_NULL] THEN
  GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN
  ASM_SIMP_TAC[BILINEAR_RSUB; VSUM_SUB_NUMSEG] THEN
  REWRITE_TAC[VECTOR_ARITH `x - l - (x - b):real^N = --(l - b)`] THEN
  REWRITE_TAC[LIM_NULL_NEG; GSYM LIM_NULL] THEN
  ASM_SIMP_TAC[GSYM BILINEAR_LSUM; FINITE_NUMSEG] THEN
  MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`]
        LIM_BILINEAR) THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN
  UNDISCH_TAC
   `((\n. vsum(r..n) (\j. (a:num->num->real^M) n j)) --> i) sequentially` THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN
  REWRITE_TAC[] THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`r:num`; `m:num`] THEN
  MATCH_MP_TAC WLOG_LT THEN
  REWRITE_TAC[VECTOR_SUB_REFL; LIM_CONST] THEN CONJ_TAC THENL
   [REPEAT GEN_TAC THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM LIM_NULL_NEG] THEN
    REWRITE_TAC[VECTOR_NEG_SUB];
    MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
    MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
    EXISTS_TAC `\k. --(vsum(m..n-1) (\j. (a:num->num->real^M) k j))` THEN
    ASM_SIMP_TAC[LIM_NULL_VSUM; FINITE_NUMSEG; LIM_NULL_NEG] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN
    X_GEN_TAC `k:num` THEN DISCH_TAC THEN
    REWRITE_TAC[VECTOR_ARITH `--x:real^N = y - z <=> x + y = z`] THEN
    MATCH_MP_TAC  VSUM_COMBINE_L THEN ASM_ARITH_TAC]);;

let LIM_BILINEAR_CONVOLUTION = prove
 (`!(bop:real^M->real^N->real^P) x y m k a b.
     bilinear bop /\ (x --> a) sequentially /\ (y --> b) sequentially
     ==> ((\n. inv(&n + k) % vsum(m..n) (\i. bop (x i) (y(n - i))))
          --> bop a b) sequentially`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[tendsto] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o ISPECL [`a:real^M`; `b:real^N`; `e / &4`] o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] BILINEAR_EPSILON_DELTA)) THEN
  ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN
  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `eventually (\n. m + 1 <= n /\
                    norm(x n - a:real^M) < d /\
                    norm(y n - b:real^N) < d) sequentially`
  MP_TAC THENL
   [REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL
     [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[];
      RULE_ASSUM_TAC(REWRITE_RULE[tendsto; dist]) THEN ASM_SIMP_TAC[]];
    GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_SEQUENTIALLY] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `N:num` THEN DISCH_TAC THEN
  SUBGOAL_THEN `m + 1 <= N` ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN ARITH_TAC;
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP
     (ARITH_RULE `m + 1 <= n ==> 1 <= n`))] THEN
  MATCH_MP_TAC EVENTUALLY_MONO THEN EXISTS_TAC
   `\n. max (&(2 * N + 1)) (--k) <= &n /\
        (dist(inv (&n + k) % vsum(m..N-1) (\i. bop (x i) (y (n - i))),vec 0)
         < e / &4 /\
        dist(inv (&n + k) % vsum((n-N)+1..n)
              (\i. (bop:real^M->real^N->real^P) (x i) (y (n - i))),vec 0)
        < e / &4) /\
       dist(inv (&n + k) % vsum(N..n-N) (\i. bop (x i) (y (n - i))),bop a b)
       < e / &2` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_MAX_LE; REAL_OF_NUM_LE] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    MATCH_MP_TAC(NORM_ARITH
     `x + y + z:real^N = w
      ==> (dist(x,vec 0) < e / &4 /\ dist(z,vec 0) < e / &4) /\
          dist(y,a) < e / &2
          ==> dist(w,a) < e`) THEN
    REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN AP_TERM_TAC THEN
    W(MP_TAC o PART_MATCH (lhand o rand)
      VSUM_COMBINE_R o rand o lhand o snd) THEN
    ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
    MATCH_MP_TAC VSUM_COMBINE_L THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN ASM_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[EVENTUALLY_AND; ARCH_EVENTUALLY_LE] THEN CONJ_TAC THENL
   [CONJ_TAC THEN
    (SUBGOAL_THEN `&0 < e / &4` MP_TAC THENL
      [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
    SPEC_TAC(`e / &4`,`e:real`) THEN REWRITE_TAC[GSYM tendsto] THEN
    REWRITE_TAC[GSYM VSUM_LMUL] THENL
     [ALL_TAC;
      MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
      EXISTS_TAC
       `\n. vsum (0..N-1)
               (\i. inv (&n + k) %
              (bop:real^M->real^N->real^P) (x (n - i)) (y i))` THEN
      CONJ_TAC THENL
       [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN
        REPEAT STRIP_TAC THEN
        GEN_REWRITE_TAC RAND_CONV [VSUM_REFLECT] THEN
        COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
        ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> n - (n - N + 1) = N - 1`] THEN
        MATCH_MP_TAC VSUM_EQ_NUMSEG THEN REWRITE_TAC[] THEN
        REPEAT STRIP_TAC THEN REPEAT AP_TERM_TAC THEN ASM_ARITH_TAC;
        ALL_TAC]] THEN
    MATCH_MP_TAC LIM_NULL_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN
    X_GEN_TAC `n:num` THEN STRIP_TAC THEN
    MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN
    REWRITE_TAC[o_DEF; SEQ_HARMONIC_OFFSET] THEN
    UNDISCH_TAC `(y --> (b:real^N)) sequentially` THEN
    UNDISCH_TAC `(x --> (a:real^M)) sequentially` THEN
    DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
    REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN
    DISCH_THEN(X_CHOOSE_THEN `A:real` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
    REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN
    DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN
    DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `C * A * B:real` THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN
    X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN DISJ2_TAC THEN
    FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
    ASM_REWRITE_TAC[NORM_POS_LE];
    MATCH_MP_TAC EVENTUALLY_MONO THEN
    EXISTS_TAC
     `\n. max (&1 - k) (&2 * &N + &1) <= &n /\
          dist(inv(&n + (&1 - &2 * &N)) %
               vsum(N..n - N) (\i. bop (x i) (y (n - i))),bop a b) < e / &4 /\
          dist(lift((&n + k) / (&n + (&1 - &2 * &N))),vec 1) < &1 / &4 /\
          dist((&n + (&1 - &2 * &N)) / (&n + k) %
               (bop:real^M->real^N->real^P) a b,bop a b) < e / &8` THEN
    REWRITE_TAC[EVENTUALLY_AND; ARCH_EVENTUALLY_LE] THEN REPEAT CONJ_TAC THENL
     [X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
       `dist(ab',ab) < e / &8 ==> dist(s,ab') <= &3 * e / &8
        ==> dist(s:real^N,ab) < e / &2`)) THEN
      REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
      REWRITE_TAC[dist; GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_SUB_LDISTRIB] THEN
      ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ARITH
        `&1 - k <= n ==> abs(n + k) = n + k`] THEN
      GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
      ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_ARITH
        `&1 - k <= n ==> &0 < n + k`] THEN
      MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
      EXISTS_TAC `abs(inv(&n + &1 - &2 * &N))` THEN
      REWRITE_TAC[GSYM NORM_MUL; VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN
      REWRITE_TAC[REAL_ABS_INV; REAL_INV_EQ_0; GSYM REAL_ABS_NZ] THEN
      ASM_SIMP_TAC[REAL_MUL_LINV; GSYM dist; VECTOR_MUL_LID; REAL_ARITH
       `x + &1 <= n ==> ~(n + &1 - x = &0)`] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
        `x < e / &4 ==> e * &2 / &3 <= e * nk * nn
        ==> x <= nn * (&3 * inv(&8) * e) * nk`)) THEN
      ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[DIST_LIFT; GSYM LIFT_NUM]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
        `abs(x - &1) < &1 / &4 ==> y = x ==> &2 / &3 <= y`)) THEN
      REWRITE_TAC[real_div] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
      ASM_REAL_ARITH_TAC;
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2 * N + 1` THEN
      X_GEN_TAC `n:num` THEN DISCH_TAC THEN
      MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN
      EXISTS_TAC `abs(&n + &1 - &2 * &N)` THEN
      SIMP_TAC[dist; GSYM NORM_MUL; VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE
       [GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL]) THEN
      ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_MUL_RINV; VECTOR_MUL_LID; REAL_ARITH
       `x + &1 <= n ==> ~(n + &1 - x = &0)`] THEN
      SUBGOAL_THEN `&n + &1 - &2 * &N = &(((n - N) + 1) - N)`
      SUBST1_TAC THENL
       [MATCH_MP_TAC(REAL_ARITH `x + &1 = y + z ==> x + &1 - z = y`) THEN
        UNDISCH_TAC `&2 * &N + &1 <= &n` THEN
        REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN
        REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_LE] THEN ARITH_TAC;
        REWRITE_TAC[GSYM VSUM_CONST_NUMSEG; GSYM VSUM_SUB_NUMSEG]] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN
      REWRITE_TAC[FINITE_NUMSEG] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
      REWRITE_TAC[GSYM CARD_NUMSEG; REAL_ABS_NUM] THEN
      MATCH_MP_TAC SUM_BOUND_LT_ALL THEN
      REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN
      CONJ_TAC THENL
       [RULE_ASSUM_TAC(REWRITE_RULE
         [REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE]) THEN
        ASM_ARITH_TAC;
        X_GEN_TAC `i:num` THEN STRIP_TAC THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN
        FIRST_X_ASSUM(fun th ->
          MP_TAC(ISPEC `i:num` th) THEN
          MP_TAC(ISPEC `n - i:num` th)) THEN
        ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN
        ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]];
      MP_TAC(REAL_ARITH `&0 < &1 / &4`) THEN SPEC_TAC(`&1 / &4`,`e:real`) THEN
      REWRITE_TAC[GSYM tendsto; SEQ_HARMONIC_RATIO];
      SUBGOAL_THEN `&0 < e / &8` MP_TAC THENL
       [ASM_REAL_ARITH_TAC; SPEC_TAC(`e / &8`,`e:real`)] THEN
      REWRITE_TAC[GSYM tendsto] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN
      MATCH_MP_TAC LIM_VMUL THEN
      REWRITE_TAC[o_DEF; SEQ_HARMONIC_RATIO; LIFT_NUM]]]);;

let LIM_CESARO = prove
 (`!a l:real^N m k.
        (a --> l) sequentially
        ==> ((\n. inv(&n + k) % vsum(m..n) a) --> l) sequentially`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`\y:real^N x. drop x % y`; `a:num->real^N`; `(\n. vec 1):num->real^1`;
    `m:num`; `k:real`; `l:real^N`; `vec 1:real^1`]
   LIM_BILINEAR_CONVOLUTION) THEN
  ASM_REWRITE_TAC[BILINEAR_MUL_DROP; LIM_CONST; DROP_VEC; VECTOR_MUL_LID] THEN
  REWRITE_TAC[ETA_AX]);;

(* ------------------------------------------------------------------------- *)
(* Multiplication (in a general bilinear sense) of series.                   *)
(* ------------------------------------------------------------------------- *)

let SERIES_BILINEAR = prove
 (`!bop:real^M->real^N->real^P x y a b.
        bilinear bop /\ (x sums a) (from 0) /\ (y sums b) (from 0) /\
        (summable (from 0) (\n. lift(norm(x n))) \/
         summable (from 0) (\n. lift(norm(y n))))
        ==> ((\n. vsum(0..n) (\i. bop (x i) (y(n - i)))) sums bop a b)
            (from 0)`,
  let lemma = prove
   (`!bop:real^M->real^N->real^P x y a b.
          bilinear bop /\
          (x sums a) (from 0) /\ (y sums b) (from 0) /\
          summable (from 0) (\n. lift(norm(x n)))
          ==> ((\n. vsum(0..n) (\i. bop (x i) (y(n - i)))) sums bop a b)
              (from 0)`,
    REWRITE_TAC[SERIES_FROM] THEN REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[LIM_NULL] THEN
    ASM_SIMP_TAC[BILINEAR_VSUM_CONVOLUTION_1] THEN
    ONCE_REWRITE_TAC[VSUM_REFLECT] THEN REWRITE_TAC[CONJUNCT1 LT; SUB_0] THEN
    MP_TAC(ISPECL
     [`bop:real^M->real^N->real^P`;
      `\n i. (x:num->real^M) (n - i)`;
      `\m. vsum(0..m) y - b:real^N`;
      `0`]
     TOEPLITZ_BILINEAR_SERIES_NULL) THEN
    ASM_REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM] THEN
    ANTS_TAC THENL
     [ASM_REWRITE_TAC[GSYM LIM_NULL] THEN CONJ_TAC THENL
       [X_GEN_TAC `p:num` THEN MATCH_MP_TAC SEQ_OFFSET_REV THEN
        EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[ADD_SUB; ETA_AX] THEN
        MATCH_MP_TAC SERIES_TERMS_TOZERO THEN REWRITE_TAC[SERIES_FROM] THEN
        MAP_EVERY EXISTS_TAC [`a:real^M`; `0`] THEN ASM_REWRITE_TAC[];
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [summable]) THEN
        REWRITE_TAC[SERIES_FROM; LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `l:real^1` THEN DISCH_TAC THEN
        MP_TAC(ISPECL [`\n. vsum(0..n) (\i. lift(norm((x:num->real^M) i)))`;
                       `l:real^1`]
          CONVERGENT_IMP_BOUNDED) THEN
        ASM_REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN
        MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
        MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= b ==> y <= b`) THEN
        REWRITE_TAC[NORM_1; DROP_VSUM; o_DEF; LIFT_DROP] THEN
        GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUM_REFLECT] THEN
        REWRITE_TAC[CONJUNCT1 LT; SUB_0; REAL_ABS_REFL] THEN
        SIMP_TAC[SUM_POS_LE_NUMSEG; NORM_POS_LE]];
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN
      ASM_SIMP_TAC[BILINEAR_RSUB; VSUM_SUB_NUMSEG] THEN
      ONCE_REWRITE_TAC[VECTOR_ARITH
        `s - l - (s' - ab):real^N = (s - s') + --(l - ab)`] THEN
      MATCH_MP_TAC LIM_NULL_ADD THEN CONJ_TAC THENL
       [MATCH_MP_TAC LIM_EVENTUALLY THEN
        MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN
        GEN_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN
        SIMP_TAC[ARITH_RULE `i:num <= n ==> n - (n - i) = i`];
        ASM_SIMP_TAC[GSYM BILINEAR_LSUM; FINITE_NUMSEG;
                     GSYM BILINEAR_LSUB] THEN
        REWRITE_TAC[LIM_NULL_NEG] THEN
        FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `b:real^N` o
          MATCH_MP BILINEAR_LZERO) THEN
        MP_TAC(ISPECL [`sequentially`; `bop:real^M->real^N->real^P`]
          LIM_BILINEAR) THEN
        DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN
        ONCE_REWRITE_TAC[VSUM_REFLECT] THEN
        REWRITE_TAC[CONJUNCT1 LT; SUB_0; GSYM LIM_NULL] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          LIM_TRANSFORM_EVENTUALLY)) THEN
        REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN
        REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN
        GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN
        ASM_ARITH_TAC]]) in
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[lemma] THEN
  MP_TAC(ISPECL
   [`\x y. (bop:real^M->real^N->real^P) y x`;
    `y:num->real^N`; `x:num->real^M`; `b:real^N`; `a:real^M`] lemma) THEN
  ASM_REWRITE_TAC[BILINEAR_SWAP] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMS_EQ) THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
  GEN_REWRITE_TAC RAND_CONV [VSUM_REFLECT] THEN
  REWRITE_TAC[CONJUNCT1 LT; SUB_0] THEN MATCH_MP_TAC VSUM_EQ THEN
  SIMP_TAC[IN_NUMSEG; ARITH_RULE `i:num <= n ==> n - (n - i) = i`]);;

let SERIES_BILINEAR_UNIQUE = prove
 (`!bop:real^M->real^N->real^P x y a b c.
        bilinear bop /\
        (x sums a) (from 0) /\ (y sums b) (from 0) /\
        ((\n. vsum (0..n) (\i. bop (x i) (y(n - i)))) sums c) (from 0)
        ==> bop a b = c`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_FROM] THEN ONCE_REWRITE_TAC[TAUT
    `p /\ q /\ r /\ s ==> t <=> p ==> p /\ q /\ r ==> s ==> t`] THEN
  DISCH_TAC THEN DISCH_THEN(LABEL_TAC "*" o SPECL [`0`; `&0:real`] o
  MATCH_MP LIM_BILINEAR_CONVOLUTION) THEN
  DISCH_THEN(MP_TAC o SPECL [`0`; `&0:real`] o MATCH_MP LIM_CESARO) THEN
  REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[IMP_IMP; REAL_ADD_RID] THEN
  FIRST_ASSUM(fun th ->
    REWRITE_TAC[MATCH_MP BILINEAR_VSUM_CONVOLUTION_2 th]) THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] LIM_UNIQUE) THEN
  REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]);;

let SUMMABLE_BILINEAR_LEFT = prove
 (`!bop:real^M->real^N->real^P x y m n p.
        bilinear bop /\
        summable (from m) (\n. lift(norm(x n))) /\ summable (from n) y
        ==> summable (from p) (\n. vsum(0..n) (\i. bop (x i) (y(n - i))))`,
  ONCE_REWRITE_TAC[SPEC `0` SUMMABLE_FROM_ELSEWHERE_EQ] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP SERIES_LIFT_ABSCONV_IMP_CONV) THEN
  UNDISCH_TAC `summable (from 0) (y:num->real^N)` THEN
  REWRITE_TAC[summable; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
  EXISTS_TAC `(bop:real^M->real^N->real^P) a b` THEN
  MATCH_MP_TAC SERIES_BILINEAR THEN ASM_REWRITE_TAC[]);;

let SUMMABLE_BILINEAR_RIGHT = prove
 (`!bop:real^M->real^N->real^P x y m n p.
        bilinear bop /\
        summable (from m) x /\ summable (from n) (\n. lift(norm(y n)))
        ==> summable (from p) (\n. vsum(0..n) (\i. bop (x i) (y(n - i))))`,
  ONCE_REWRITE_TAC[SPEC `0` SUMMABLE_FROM_ELSEWHERE_EQ] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP SERIES_LIFT_ABSCONV_IMP_CONV) THEN
  UNDISCH_TAC `summable (from 0) (x:num->real^M)` THEN
  REWRITE_TAC[summable; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
  X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
  EXISTS_TAC `(bop:real^M->real^N->real^P) a b` THEN
  MATCH_MP_TAC SERIES_BILINEAR THEN ASM_REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Relate Cauchy sequences to summability or absolute convergence.           *)
(* ------------------------------------------------------------------------- *)

let CAUCHY_EQ_SUMMABLE = prove
 (`!x:num->real^N. cauchy x <=> summable (from 0) (\n. x(n + 1) - x n)`,
  REWRITE_TAC[cauchy; SUMMABLE_CAUCHY; FROM_0; INTER_UNIV] THEN
  GEN_TAC THEN REWRITE_TAC[VSUM_DIFFS_ALT] THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THENL
   [REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0; GSYM dist] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    MATCH_MP_TAC WLOG_LT THEN ASM_REWRITE_TAC[DIST_REFL] THEN
    CONJ_TAC THENL [MESON_TAC[DIST_SYM]; ALL_TAC] THEN
    X_GEN_TAC `m:num` THEN MATCH_MP_TAC num_INDUCTION THEN
    REWRITE_TAC[CONJUNCT1 LT] THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
    ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN
    REWRITE_TAC[ADD1] THEN CONV_TAC NORM_ARITH]);;

let CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE = prove
 (`!x:num->real^N.
        cauchy x
        ==> ?r. (!m n. m < n ==> r m < r n) /\
                summable (from 0) (\n. lift(dist(x(r(n + 1)),x(r n))))`,
  REWRITE_TAC[cauchy] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
  SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN
  SUBGOAL_THEN
   `?r:num->num.
        (!n. N n <= r n) /\ (!n. r(n) < r(SUC n))`
  MP_TAC THENL
   [MATCH_MP_TAC DEPENDENT_CHOICE THEN
    REWRITE_TAC[ARITH_RULE `a <= x /\ b < x <=> MAX a (SUC b) <= x`] THEN
    MESON_TAC[LE_REFL];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num`] THEN
  STRIP_TAC THEN CONJ_TAC THENL
   [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS];
    ALL_TAC] THEN
  MATCH_MP_TAC SUMMABLE_COMPARISON THEN
  EXISTS_TAC `\n. inv(&2 pow n)` THEN CONJ_TAC THENL
   [REWRITE_TAC[o_DEF; REAL_INV_POW] THEN MATCH_MP_TAC SUMMABLE_REAL_GP THEN
    CONV_TAC REAL_RAT_REDUCE_CONV;
    EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
    REWRITE_TAC[] THEN
    MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[NORM_LIFT; REAL_ABS_DIST] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN
    REWRITE_TAC[ADD1] THEN ARITH_TAC]);;

let ABSOLUTELY_SUMMABLE_IMP_CAUCHY = prove
 (`!x:num->real^N.
        summable (from 0) (\n. lift(dist(x(n + 1),x n))) ==> cauchy x`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CAUCHY_EQ_SUMMABLE] THEN
  MATCH_MP_TAC SERIES_LIFT_ABSCONV_IMP_CONV THEN
  ASM_REWRITE_TAC[GSYM dist]);;

let COMPLETE_ABSOLUTELY_SUMMABLE = prove
 (`!s:real^N->bool.
        complete s <=>
        !f. (!n. f n IN s) /\ summable (from 0) (\n. lift(dist(f(n + 1),f n)))
            ==> ?l. l IN s /\ (f --> l) sequentially`,
  GEN_TAC THEN REWRITE_TAC[complete] THEN EQ_TAC THENL
   [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_SUMMABLE_IMP_CAUCHY THEN
    ASM_REWRITE_TAC[];
    DISCH_TAC THEN X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o
      MATCH_MP CAUCHY_ABSOLUTELY_SUMMABLE_SUBSEQUENCE) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(f:num->real^N) o (r:num->num)`) THEN
    ASM_REWRITE_TAC[o_THM] THEN
    ASM_MESON_TAC[CAUCHY_CONVERGENT_SUBSEQUENCE]]);;

(* ------------------------------------------------------------------------- *)
(* Banach fixed point theorem (not really topological...)                    *)
(* ------------------------------------------------------------------------- *)

let BANACH_FIX = prove
 (`!f s c. complete s /\ ~(s = {}) /\
           &0 <= c /\ c < &1 /\
           (IMAGE f s) SUBSET s /\
           (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y))
           ==> ?!x:real^N. x IN s /\ (f x = x)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL
   [ALL_TAC;
    MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
    SUBGOAL_THEN `dist((f:real^N->real^N) x,f y) <= c * dist(x,y)` MP_TAC THENL
     [ASM_MESON_TAC[]; ALL_TAC] THEN
    ASM_REWRITE_TAC[REAL_ARITH `a <= c * a <=> &0 <= --a * (&1 - c)`] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; real_div] THEN
    REWRITE_TAC[REAL_MUL_LZERO; REAL_ARITH `&0 <= --x <=> ~(&0 < x)`] THEN
    MESON_TAC[DIST_POS_LT]] THEN
  STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION
    `(z 0 = @x:real^N. x IN s) /\ (!n. z(SUC n) = f(z n))`) THEN
  SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL
   [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_IMAGE];
    ALL_TAC] THEN
  UNDISCH_THEN `z 0 = @x:real^N. x IN s` (K ALL_TAC) THEN
  SUBGOAL_THEN `?x:real^N. x IN s /\ (z --> x) sequentially` MP_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    ABBREV_TAC `e = dist(f(a:real^N),a)` THEN
    SUBGOAL_THEN `~(&0 < e)` (fun th -> ASM_MESON_TAC[th; DIST_POS_LT]) THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
    DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
    SUBGOAL_THEN
     `dist(f(z N),a:real^N) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2`
     (fun th -> ASM_MESON_TAC[th; DIST_TRIANGLE_HALF_R; REAL_LT_REFL]) THEN
    CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N <= SUC N`]; ALL_TAC] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC `c * dist((z:num->real^N) N,a)` THEN ASM_SIMP_TAC[] THEN
    MATCH_MP_TAC(REAL_ARITH `x < y /\ c * x <= &1 * x ==> c * x < y`) THEN
    ASM_SIMP_TAC[LE_REFL; REAL_LE_RMUL; DIST_POS_LE; REAL_LT_IMP_LE]] THEN
  FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [complete]) THEN
  ASM_REWRITE_TAC[CAUCHY] THEN
  SUBGOAL_THEN `!n. dist(z(n):real^N,z(SUC n)) <= c pow n * dist(z(0),z(1))`
  ASSUME_TAC THENL
   [INDUCT_TAC THEN
    REWRITE_TAC[real_pow; ARITH; REAL_MUL_LID; REAL_LE_REFL] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `c * dist(z(n):real^N,z(SUC n))` THEN
    CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!m n:num. (&1 - c) * dist(z(m):real^N,z(m+n))
                <= c pow m * dist(z(0),z(1)) * (&1 - c pow n)`
  ASSUME_TAC THENL
   [GEN_TAC THEN INDUCT_TAC THENL
     [REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_RZERO] THEN
      MATCH_MP_TAC REAL_LE_MUL THEN
      ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_SUB_LE;
                   REAL_POW_1_LE; REAL_LT_IMP_LE];
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
    `(&1 - c) * (dist(z m:real^N,z(m + n)) + dist(z(m + n),z(m + SUC n)))` THEN
    ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE; DIST_TRIANGLE] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
      `c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y'`)) THEN
    REWRITE_TAC[REAL_ARITH
     `q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y)`] THEN
    REWRITE_TAC[ADD_CLAUSES; real_pow] THEN
    REWRITE_TAC[REAL_ARITH `a * b * (d - c * d) = (&1 - c) * a * d * b`] THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN
    ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE] THEN
    REWRITE_TAC[GSYM REAL_POW_ADD; REAL_MUL_ASSOC] THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  ASM_CASES_TAC `(z:num->real^N) 0 = z 1` THENL
   [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `0` THEN
    REWRITE_TAC[GE; LE_0] THEN X_GEN_TAC `n:num` THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `n:num`]) THEN
    REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    ASM_CASES_TAC `(z:num->real^N) 0 = z n` THEN
    ASM_REWRITE_TAC[DIST_REFL; REAL_NOT_LE] THEN
    ASM_SIMP_TAC[REAL_LT_MUL; DIST_POS_LT; REAL_SUB_LT];
    ALL_TAC] THEN
  MP_TAC(SPECL [`c:real`; `e * (&1 - c) / dist((z:num->real^N) 0,z 1)`]
   REAL_ARCH_POW_INV) THEN
  ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_SUB_LT; DIST_POS_LT] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
  REWRITE_TAC[real_div; GE; REAL_MUL_ASSOC] THEN
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM real_div; DIST_POS_LT] THEN
  ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_TAC THEN
  REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
  GEN_TAC THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
  ONCE_REWRITE_TAC[DIST_SYM] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH
    `d < e ==> x <= d ==> x < e`)) THEN
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `d:num`]) THEN
  MATCH_MP_TAC(REAL_ARITH
  `(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d`) THEN
  MATCH_MP_TAC REAL_LE_LMUL THEN
  ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_ARITH
   `&0 <= x ==> &1 - x <= &1`]);;

(* ------------------------------------------------------------------------- *)
(* Edelstein fixed point theorem.                                            *)
(* ------------------------------------------------------------------------- *)

let EDELSTEIN_FIX = prove
 (`!f s. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\
         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(f(x),f(y)) < dist(x,y))
         ==> ?!x:real^N. x IN s /\ f x = x`,
  MAP_EVERY X_GEN_TAC [`g:real^N->real^N`; `s:real^N->bool`] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]] THEN
  SUBGOAL_THEN
   `!x y. x IN s /\ y IN s ==> dist((g:real^N->real^N)(x),g(y)) <= dist(x,y)`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN
    ASM_SIMP_TAC[DIST_REFL; REAL_LE_LT];
    ALL_TAC] THEN
  ASM_CASES_TAC `?x:real^N. x IN s /\ ~(g x = x)` THENL
   [ALL_TAC; ASM SET_TAC[]] THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC `y = (g:real^N->real^N) x` THEN
  SUBGOAL_THEN `(y:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_PCROSS o W CONJ) THEN
  REWRITE_TAC[compact; PCROSS] THEN
  (STRIP_ASSUME_TAC o prove_general_recursive_function_exists)
    `?f:num->real^N->real^N.
        (!z. f 0 z = z) /\ (!z n. f (SUC n) z = g(f n z))` THEN
  SUBGOAL_THEN `!n z. z IN s ==> (f:num->real^N->real^N) n z IN s`
  STRIP_ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `!m n w z. m <= n /\ w IN s /\ z IN s
              ==> dist((f:num->real^N->real^N) n w,f n z) <= dist(f m w,f m z)`
  ASSUME_TAC THENL
   [REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
    ASM_SIMP_TAC[REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TRANS];
    ALL_TAC] THEN
  DISCH_THEN(MP_TAC o SPEC
   `\n:num. pastecart (f n (x:real^N)) (f n y:real^N)`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`l:real^(N,N)finite_sum`; `s:num->num`] THEN
  REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST_ALL_TAC) THEN
  SUBGOAL_THEN
   `(\x:real^(N,N)finite_sum. fstcart x) continuous_on UNIV /\
    (\x:real^(N,N)finite_sum. sndcart x) continuous_on UNIV`
  MP_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
    REWRITE_TAC[ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART];
    ALL_TAC] THEN
  REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV] THEN
  DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th))) THEN
  REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; IMP_IMP] THEN
  ONCE_REWRITE_TAC[CONJ_SYM] THEN
  DISCH_THEN(fun th -> CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B") th THEN
    MP_TAC(MATCH_MP LIM_SUB th)) THEN
  REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "AB") THEN
  SUBGOAL_THEN
   `!n. dist(a:real^N,b) <= dist((f:num->real^N->real^N) n x,f n y)`
  STRIP_ASSUME_TAC THENL
   [X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
    ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
    USE_THEN "AB" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN
    DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o MATCH_MP th)) THEN
    REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN
    DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN
    MATCH_MP_TAC(NORM_ARITH
     `dist(fx,fy) <= dist(x,y)
      ==> ~(dist(fx - fy,a - b) < dist(a,b) - dist(x,y))`) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num` o MATCH_MP MONOTONE_BIGGER) THEN
    ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL
   [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    ABBREV_TAC `e = dist(a,b) - dist((g:real^N->real^N) a,g b)` THEN
    SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
     [ASM_MESON_TAC[REAL_SUB_LT]; ALL_TAC] THEN
    SUBGOAL_THEN
     `?n. dist((f:num->real^N->real^N) n x,a) < e / &2 /\
          dist(f n y,b) < e / &2`
    STRIP_ASSUME_TAC THENL
     [MAP_EVERY (fun s -> USE_THEN s (MP_TAC o SPEC `e / &2` o
        REWRITE_RULE[LIM_SEQUENTIALLY])) ["A"; "B"] THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN
      DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN
      DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
      EXISTS_TAC `(s:num->num) (M + N)` THEN
      CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
      ALL_TAC] THEN
    SUBGOAL_THEN `dist(f (SUC n) x,(g:real^N->real^N) a) +
                  dist((f:num->real^N->real^N) (SUC n) y,g b) < e`
    MP_TAC THENL
     [ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN
      CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
       `dist(x,y) < e
        ==> dist(g x,g y) <= dist(x,y) ==> dist(g x,g y) < e`)) THEN
      ASM_SIMP_TAC[];
      ALL_TAC] THEN
    MP_TAC(SPEC `SUC n` (ASSUME
    `!n. dist (a:real^N,b) <=
         dist ((f:num->real^N->real^N) n x,f n y)`)) THEN
    EXPAND_TAC "e" THEN NORM_ARITH_TAC;
    ALL_TAC] THEN
  EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
  EXISTS_TAC `\n:num. (f:num->real^N->real^N) (SUC(s n)) x` THEN
  REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
   [ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN `(g:real^N->real^N) continuous_on s` MP_TAC THENL
     [REWRITE_TAC[continuous_on] THEN ASM_MESON_TAC[REAL_LET_TRANS];
      ALL_TAC] THEN
    REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; o_DEF] THEN
    DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[];
    SUBGOAL_THEN `!n. (f:num->real^N->real^N) (SUC n) x = f n y`
     (fun th -> ASM_SIMP_TAC[th]) THEN
    INDUCT_TAC THEN ASM_REWRITE_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Simple n-ary generalizations of Banach and Edelstein theorems.            *)
(* ------------------------------------------------------------------------- *)

let BANACH_FIX_ITER = prove
 (`!f s:real^N->bool c n.
           complete s /\
           ~(s = {}) /\
           &0 <= c /\
           c < &1 /\
           IMAGE f s SUBSET s /\
           (!x y. x IN s /\ y IN s
                  ==> dist (ITER n f x,ITER n f y) <= c * dist (x,y))
           ==> ?!x. x IN s /\ f x = x`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`ITER n f:real^N->real^N`; `s:real^N->bool`; `c:real`]
        BANACH_FIX) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
    ASM_REWRITE_TAC[ITER_POINTLESS; IMAGE_I; IMAGE_o] THEN
    ASM SET_TAC[];
    REWRITE_TAC[EXISTS_UNIQUE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC
     (fun t -> ASSUME_TAC t THEN MP_TAC(SPEC `(f:real^N->real^N) x` t))) THEN
    ANTS_TAC THENL
     [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      ASM_MESON_TAC[ITER_ALT; ITER];
      STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
    X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
    ASM_REWRITE_TAC[ITER]]);;

let EDELSTEIN_FIX_ITER = prove
 (`!f s n.
        compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\
        (!x y. x IN s /\ y IN s /\ ~(x = y)
               ==> dist(ITER n f x,ITER n f y) < dist(x,y))
        ==> ?!x:real^N. x IN s /\ f x = x`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`ITER n f:real^N->real^N`; `s:real^N->bool`]
        EDELSTEIN_FIX) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
    ASM_REWRITE_TAC[ITER_POINTLESS; IMAGE_I; IMAGE_o] THEN
    ASM SET_TAC[];
    REWRITE_TAC[EXISTS_UNIQUE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC
     (fun t -> ASSUME_TAC t THEN MP_TAC(SPEC `(f:real^N->real^N) x` t))) THEN
    ANTS_TAC THENL
     [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      ASM_MESON_TAC[ITER_ALT; ITER];
      STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
    X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
    ASM_REWRITE_TAC[ITER]]);;

(* ------------------------------------------------------------------------- *)
(* Dini's theorem.                                                           *)
(* ------------------------------------------------------------------------- *)

let DINI = prove
 (`!f:num->real^N->real^1 g s.
        compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\
        (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\
        (!n x. x IN s ==> drop(f n x) <= drop(f (n + 1) x))
        ==> !e. &0 < e
                ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e)
                               sequentially`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!x:real^N m n:num. x IN s /\ m <= n ==> drop(f m x) <= drop(f n x)`
  ASSUME_TAC THENL
   [GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[ADD1] THEN
    REAL_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN `!n:num x:real^N. x IN s ==> drop(f n x) <= drop(g x)`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN
    EXISTS_TAC `\m:num. (f:num->real^N->real^1) n x` THEN
    EXISTS_TAC `\m:num. (f:num->real^N->real^1) m x` THEN
    ASM_SIMP_TAC[LIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY; dist]) THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
   [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
  DISCH_THEN(MP_TAC o SPEC
   `IMAGE (\n. { x | x IN s /\ norm((f:num->real^N->real^1) n x - g x) < e})
          (:num)`) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; SUBSET_UNION; UNIONS_IMAGE] THEN
  REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY] THEN
  SIMP_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN
    X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
    ASM_SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_SUB; ETA_AX];

    DISCH_THEN(X_CHOOSE_THEN `k:num->bool` (CONJUNCTS_THEN2
     (MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET)
     (LABEL_TAC "*"))) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
    REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
    DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH
     `m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e`) THEN
    ASM_MESON_TAC[LE_TRANS]]);;

(* ------------------------------------------------------------------------- *)
(* Closest point of a (closed) set to a point.                               *)
(* ------------------------------------------------------------------------- *)

let closest_point = new_definition
 `closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`;;

let CLOSEST_POINT_EXISTS = prove
 (`!s a. closed s /\ ~(s = {})
         ==> (closest_point s a) IN s /\
             !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)`,
  REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN
  REWRITE_TAC[DISTANCE_ATTAINS_INF]);;

let CLOSEST_POINT_IN_SET = prove
 (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s`,
  MESON_TAC[CLOSEST_POINT_EXISTS]);;

let CLOSEST_POINT_LE = prove
 (`!s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)`,
  MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);;

let CLOSEST_POINT_SELF = prove
 (`!s x:real^N. x IN s ==> closest_point s x = x`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN
  MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL
   [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_SIMP_TAC[DIST_LE_0; DIST_REFL];
    STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_POS_LE]]);;

let CLOSEST_POINT_REFL = prove
 (`!s x:real^N. closed s /\ ~(s = {}) ==> (closest_point s x = x <=> x IN s)`,
  MESON_TAC[CLOSEST_POINT_IN_SET; CLOSEST_POINT_SELF]);;

let DIST_CLOSEST_POINT_LIPSCHITZ = prove
 (`!s x y:real^N.
        closed s /\ ~(s = {})
        ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y))
            <= dist(x,y)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN
  DISCH_THEN(fun th ->
    CONJUNCTS_THEN2 ASSUME_TAC
     (MP_TAC o SPEC `closest_point s (y:real^N)`) (SPEC `x:real^N` th) THEN
    CONJUNCTS_THEN2 ASSUME_TAC
     (MP_TAC o SPEC `closest_point s (x:real^N)`) (SPEC `y:real^N` th)) THEN
  ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;

let CONTINUOUS_AT_DIST_CLOSEST_POINT = prove
 (`!s x:real^N.
        closed s /\ ~(s = {})
        ==> (\x. lift(dist(x,closest_point s x))) continuous (at x)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN
  ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);;

let CONTINUOUS_ON_DIST_CLOSEST_POINT = prove
 (`!s t. closed s /\ ~(s = {})
         ==> (\x. lift(dist(x,closest_point s x))) continuous_on t`,
  MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON;
            CONTINUOUS_AT_DIST_CLOSEST_POINT]);;

let UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT = prove
 (`!s t:real^N->bool.
        closed s /\ ~(s = {})
        ==> (\x. lift(dist(x,closest_point s x))) uniformly_continuous_on t`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN
  ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);;

let SEGMENT_TO_CLOSEST_POINT = prove
 (`!s a:real^N.
        closed s /\ ~(s = {})
        ==> segment(a,closest_point s a) INTER s = {}`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN
  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN
  MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN
  ASM_MESON_TAC[CLOSEST_POINT_EXISTS; REAL_NOT_LT; DIST_SYM]);;

let SEGMENT_TO_POINT_EXISTS = prove
 (`!s a:real^N.
        closed s /\ ~(s = {}) ==> ?b. b IN s /\ segment(a,b) INTER s = {}`,
  MESON_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]);;

let CLOSEST_POINT_IN_INTERIOR = prove
 (`!s x:real^N.
        closed s /\ ~(s = {})
        ==> ((closest_point s x) IN interior s <=> x IN interior s)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
  ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN
  MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `closest_point s (x:real^N) IN s` ASSUME_TAC THENL
   [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN
  SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`;
   `closest_point s x -
    (min (&1) (e / norm(closest_point s x - x))) %
    (closest_point s x - x):real^N`]
    CLOSEST_POINT_LE) THEN
  ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH
   `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN
  CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN
    REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN
    ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE];
    REWRITE_TAC[NORM_MUL; REAL_ARITH
     `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN
    MATCH_MP_TAC REAL_LT_MUL THEN
    ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN
    MATCH_MP_TAC(REAL_ARITH
     `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN
    REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);;

let CLOSEST_POINT_IN_FRONTIER = prove
 (`!s x:real^N.
        closed s /\ ~(s = {}) /\ ~(x IN interior s)
        ==> (closest_point s x) IN frontier s`,
  SIMP_TAC[frontier; IN_DIFF; CLOSEST_POINT_IN_INTERIOR] THEN
  SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSURE_CLOSED]);;

let CLOSEST_POINT_FRONTIER = prove
 (`!s x:real^N.
        ~(x IN interior s)
        ==> closest_point (frontier s) x = closest_point (closure s) x`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[FRONTIER_EMPTY; CLOSURE_EMPTY] THEN
  ASM_CASES_TAC `s = (:real^N)` THEN
  ASM_REWRITE_TAC[INTERIOR_UNIV; IN_UNIV] THEN DISCH_TAC THEN
  REWRITE_TAC[closest_point] THEN AP_TERM_TAC THEN
  GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:real^N` THEN
  REWRITE_TAC[] THEN EQ_TAC THEN STRIP_TAC THENL
   [CONJ_TAC THENL [ASM_MESON_TAC[frontier; IN_DIFF]; ALL_TAC] THEN
    X_GEN_TAC `z:real^N` THEN ASM_CASES_TAC `(z:real^N) IN interior s` THENL
     [DISCH_THEN(K ALL_TAC); ASM_MESON_TAC[frontier; IN_DIFF]] THEN
    ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`segment[x:real^N,z]`; `interior s:real^N->bool`]
        CONNECTED_INTER_FRONTIER) THEN
    PURE_REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; NOT_IMP] THEN
    REWRITE_TAC[IN_INTER; IN_DIFF; NOT_IMP] THEN REPEAT CONJ_TAC THENL
     [EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT];
      EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT];
      DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N`) THEN
      REWRITE_TAC[NOT_IMP] THEN
      FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
        FRONTIER_INTERIOR_SUBSET)) THEN
      CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; frontier; IN_DIFF]; ALL_TAC] THEN
      REWRITE_TAC[REAL_NOT_LE] THEN
      TRANS_TAC REAL_LET_TRANS `dist(x:real^N,z)` THEN
      ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM]];
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[frontier; IN_DIFF]] THEN
    ASM_REWRITE_TAC[frontier; IN_DIFF] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`segment[x:real^N,y]`; `interior s:real^N->bool`]
        CONNECTED_INTER_FRONTIER) THEN
    PURE_REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; NOT_IMP] THEN
    REWRITE_TAC[IN_INTER; IN_DIFF; NOT_IMP] THEN REPEAT CONJ_TAC THENL
     [EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT];
      EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT];
      DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN
      REWRITE_TAC[NOT_IMP] THEN
      FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
        FRONTIER_INTERIOR_SUBSET)) THEN
      CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; frontier; IN_DIFF]; ALL_TAC] THEN
      ASM_CASES_TAC `z:real^N = x` THEN
      ASM_REWRITE_TAC[REAL_NOT_LE; DIST_REFL; GSYM DIST_NZ] THENL
       [ASM_MESON_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `z IN segment(x:real^N,y)` MP_TAC THENL
       [ALL_TAC; ASM_MESON_TAC[DIST_IN_OPEN_SEGMENT; DIST_SYM]] THEN
      ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
      ASM_MESON_TAC[frontier; IN_DIFF]]]);;

(* ------------------------------------------------------------------------- *)
(* More general infimum of distance between two sets.                        *)
(* ------------------------------------------------------------------------- *)

let setdist = new_definition
 `setdist(s,t) =
        if s = {} \/ t = {} then &0
        else inf {dist(x,y) | x IN s /\ y IN t}`;;

let SETDIST_EMPTY = prove
 (`(!t. setdist({},t) = &0) /\ (!s. setdist(s,{}) = &0)`,
  REWRITE_TAC[setdist]);;

let SETDIST_POS_LE = prove
 (`!s t. &0 <= setdist(s,t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN
  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
  MATCH_MP_TAC REAL_LE_INF THEN
  REWRITE_TAC[FORALL_IN_GSPEC; DIST_POS_LE] THEN ASM SET_TAC[]);;

let SETDIST_POS_LT = prove
 (`!s t:real^N->bool. &0 < setdist(s,t) <=> ~(setdist(s,t) = &0)`,
  REWRITE_TAC[REAL_LT_LE; SETDIST_POS_LE] THEN REAL_ARITH_TAC);;

let SETDIST_SUBSETS_EQ = prove
 (`!s t s' t':real^N->bool.
     s' SUBSET s /\ t' SUBSET t /\
     (!x y. x IN s /\ y IN t
            ==> ?x' y'. x' IN s' /\ y' IN t' /\ dist(x',y') <= dist(x,y))
     ==> setdist(s',t') = setdist(s,t)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [ASM_CASES_TAC `s':real^N->bool = {}` THEN
    ASM_REWRITE_TAC[SETDIST_EMPTY] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [ASM_CASES_TAC `t':real^N->bool = {}` THEN
    ASM_REWRITE_TAC[SETDIST_EMPTY] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `s':real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
  ASM_CASES_TAC `t':real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
  ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC INF_EQ THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);;

let REAL_LE_SETDIST = prove
  (`!s t:real^N->bool d.
        ~(s = {}) /\ ~(t = {}) /\
        (!x y. x IN s /\ y IN t ==> d <= dist(x,y))
        ==> d <= setdist(s,t)`,
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[setdist] THEN
  MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN
  ASM_MESON_TAC[]);;

let SETDIST_LE_DIST = prove
 (`!s t x y:real^N. x IN s /\ y IN t ==> setdist(s,t) <= dist(x,y)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN
  COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN
  ASM_MESON_TAC[]);;

let REAL_LE_SETDIST_EQ = prove
 (`!d s t:real^N->bool.
        d <= setdist(s,t) <=>
        (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) /\
        (s = {} \/ t = {} ==> d <= &0)`,
  REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC
   [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; NOT_IN_EMPTY] THEN
  ASM_MESON_TAC[REAL_LE_SETDIST; SETDIST_LE_DIST; REAL_LE_TRANS]);;

let REAL_SETDIST_LT_EXISTS = prove
 (`!s t:real^N->bool b.
        ~(s = {}) /\ ~(t = {}) /\ setdist(s,t) < b
        ==> ?x y. x IN s /\ y IN t /\ dist(x,y) < b`,
  REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SETDIST_EQ] THEN MESON_TAC[]);;

let SETDIST_REFL = prove
 (`!s:real^N->bool. setdist(s,s) = &0`,
  GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [ASM_REWRITE_TAC[setdist; REAL_LE_REFL]; ALL_TAC] THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; MEMBER_NOT_EMPTY; DIST_REFL]);;

let SETDIST_SYM = prove
 (`!s t. setdist(s,t) = setdist(t,s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[setdist; DISJ_SYM] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
  MESON_TAC[DIST_SYM]);;

let SETDIST_TRIANGLE = prove
 (`!s a t:real^N->bool.
        setdist(s,t) <= setdist(s,{a}) + setdist({a},t)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_LID; SETDIST_POS_LE] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_RID; SETDIST_POS_LE] THEN
  ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN
  MATCH_MP_TAC REAL_LE_SETDIST THEN
  ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ;
                  RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN
  MATCH_MP_TAC REAL_LE_SETDIST THEN
  ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ;
                  RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
  X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
  REWRITE_TAC[REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `dist(x:real^N,y)` THEN
  ASM_SIMP_TAC[SETDIST_LE_DIST] THEN CONV_TAC NORM_ARITH);;

let SETDIST_SINGS = prove
 (`!x y. setdist({x},{y}) = dist(x,y)`,
  REWRITE_TAC[setdist; NOT_INSERT_EMPTY] THEN
  REWRITE_TAC[SET_RULE `{f x y | x IN {a} /\ y IN {b}} = {f a b}`] THEN
  SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);;

let SETDIST_SCALING = prove
 (`!a s t:real^N->bool.
        setdist(IMAGE (\x. a % x) s,IMAGE (\x. a % x) t) =
        abs a * setdist(s,t)`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[REAL_MUL_RZERO; SETDIST_EMPTY; IMAGE_CLAUSES] THEN
  ASM_CASES_TAC `a = &0` THENL
   [ASM_SIMP_TAC[VECTOR_MUL_LZERO; SETDIST_REFL; SET_RULE
     `~(s = {}) ==> IMAGE (\x. a) s = {a}`] THEN REAL_ARITH_TAC;
    ASM_REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN MATCH_MP_TAC INF_UNIQUE THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; DIST_MUL] THEN
    X_GEN_TAC `c:real` THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ] THEN
    CONV_TAC SYM_CONV THEN
    W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_INF_EQ o lhand o snd) THEN
    REWRITE_TAC[FORALL_IN_GSPEC; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
    DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MESON_TAC[DIST_POS_LE]]);;

let SETDIST_UNIFORMLY_CONTINUOUS_ON,SETDIST_UNIFORMLY_CONTINUOUS_ON_ALT =
 (CONJ_PAIR o prove)
 (`(!f:real^M->real^N s.
        f uniformly_continuous_on s <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !t t'. t SUBSET s /\ t' SUBSET s /\ setdist(t',t) < d
                           ==> setdist(IMAGE f t',IMAGE f t) < e) /\
   (!f:real^M->real^N s.
        f uniformly_continuous_on s <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !t t'. t SUBSET s /\ t' SUBSET s /\
                           bounded t /\ bounded t' /\
                           setdist(t',t) < d
                           ==> setdist(IMAGE f t',IMAGE f t) < e)`,
  CONJ_TAC THEN
  (REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN EQ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `t':real^M->bool`] THEN
    STRIP_TAC THEN
    MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
    ASM_CASES_TAC `t:real^M->bool = {}` THEN
    ASM_SIMP_TAC[SETDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN
    ASM_CASES_TAC `t':real^M->bool = {}` THEN
    ASM_SIMP_TAC[SETDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN
    MP_TAC(ISPECL [`t':real^M->bool`; `t:real^M->bool`; `d / &2`]
        REAL_SETDIST_LT_EXISTS) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`y:real^M`; `x:real^M`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
    ASM_SIMP_TAC[REAL_ARITH `x < d / &2 /\ &0 < d ==> x < d`] THEN
    MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e / &2 ==> x <= e / &2`) THEN
    MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SIMP_TAC[IN_SING; FUN_IN_IMAGE];
    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
    REWRITE_TAC[GSYM SETDIST_SINGS] THEN REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[SET_RULE `{f x} = IMAGE f {x}`] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[SING_SUBSET; BOUNDED_SING]]));;

let th = prove
 (`!c. &0 < c
       ==> !s t. setdist(IMAGE (\x. c % x) s,IMAGE (\x. c % x) t) =
                 c * setdist(s,t)`,
  SIMP_TAC[SETDIST_SCALING; REAL_ARITH `&0 < c ==> abs c = c`]) in
add_scaling_theorems [th];;

let SETDIST_SING_TRIANGLE = prove
 (`!s x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN
  REWRITE_TAC[REAL_ARITH
   `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN
  MESON_TAC[SETDIST_TRIANGLE; SETDIST_SYM]);;

let CONTINUOUS_AT_LIFT_SETDIST = prove
 (`!s x:real^N. (\y. lift(setdist({y},s))) continuous (at x)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN
  ASM_MESON_TAC[SETDIST_SING_TRIANGLE; REAL_LET_TRANS]);;

let CONTINUOUS_ON_LIFT_SETDIST = prove
 (`!s t:real^N->bool. (\y. lift(setdist({y},s))) continuous_on t`,
  MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON;
            CONTINUOUS_AT_LIFT_SETDIST]);;

let UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST = prove
 (`!s t:real^N->bool.
         (\y. lift(setdist({y},s))) uniformly_continuous_on t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN
  ASM_MESON_TAC[SETDIST_SING_TRIANGLE; REAL_LET_TRANS]);;

let SETDIST_DIFFERENCES = prove
 (`!s t. setdist(s,t) = setdist({vec 0},{x - y:real^N | x IN s /\ y IN t})`,
  REPEAT GEN_TAC THEN REWRITE_TAC[setdist; NOT_INSERT_EMPTY;
     SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2; DIST_0] THEN
  REWRITE_TAC[dist] THEN MESON_TAC[]);;

let SETDIST_SUBSET_RIGHT = prove
 (`!s t u:real^N->bool.
    ~(t = {}) /\ t SUBSET u ==> setdist(s,u) <= setdist(s,t)`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; SETDIST_POS_LE; REAL_LE_REFL] THEN
  ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
  ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN
  REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  MESON_TAC[DIST_POS_LE]);;

let SETDIST_SUBSET_LEFT = prove
 (`!s t u:real^N->bool.
    ~(s = {}) /\ s SUBSET t ==> setdist(t,u) <= setdist(s,u)`,
  MESON_TAC[SETDIST_SUBSET_RIGHT; SETDIST_SYM]);;

let SETDIST_CLOSURE = prove
 (`(!s t:real^N->bool. setdist(closure s,t) = setdist(s,t)) /\
   (!s t:real^N->bool. setdist(s,closure t) = setdist(s,t))`,
  GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN
  REWRITE_TAC[] THEN
  REWRITE_TAC[MESON[REAL_LE_ANTISYM]
   `x:real = y <=> !d. d <= x <=> d <= y`] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; CLOSURE_EMPTY; NOT_IN_EMPTY] THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET c /\
    (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y))
   ==> ((!x y. x IN c /\ Q y ==> P x y) <=>
        (!x y. x IN s /\ Q y ==> P x y))`) THEN
  REWRITE_TAC[CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN
  ASM_REWRITE_TAC[o_DEF; dist] THEN
  MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
  SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;

let SETDIST_FRONTIER = prove
 (`(!s t:real^N->bool.
        DISJOINT s t ==> setdist(frontier s,t) = setdist(s,t)) /\
   (!s t:real^N->bool.
        DISJOINT s t ==> setdist(s,frontier t) = setdist(s,t))`,
  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN
  CONJ_TAC THENL [MESON_TAC[SETDIST_SYM; DISJOINT_SYM]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1 SETDIST_CLOSURE)] THEN
  MATCH_MP_TAC SETDIST_SUBSETS_EQ THEN
  REWRITE_TAC[frontier; IN_DIFF; SUBSET_DIFF; SUBSET_REFL] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  ASM_CASES_TAC  `(x:real^N) IN interior s` THENL
   [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `y:real^N` THEN
  ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPECL [`segment[x:real^N,y]`; `s:real^N->bool`]
        CONNECTED_INTER_FRONTIER) THEN
  REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [EXISTS_TAC `x:real^N`; EXISTS_TAC `y:real^N`] THEN
    ASM_REWRITE_TAC[IN_INTER; IN_DIFF; ENDS_IN_SEGMENT] THEN
    MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
    SIMP_TAC[IN_INTER; frontier; IN_DIFF] THEN
    MESON_TAC[DIST_IN_CLOSED_SEGMENT]]);;

let SETDIST_COMPACT_CLOSED = prove
 (`!s t:real^N->bool.
        compact s /\ closed t /\ ~(s = {}) /\ ~(t = {})
        ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
  MATCH_MP_TAC(MESON[]
   `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y)
    ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN
  SIMP_TAC[SETDIST_LE_DIST] THEN
  ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
  MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`]
        DISTANCE_ATTAINS_INF) THEN
  ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC;
               DIST_0; GSYM CONJ_ASSOC] THEN
  REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;

let SETDIST_CLOSED_COMPACT = prove
 (`!s t:real^N->bool.
        closed s /\ compact t /\ ~(s = {}) /\ ~(t = {})
        ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
  MATCH_MP_TAC(MESON[]
   `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y)
    ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN
  SIMP_TAC[SETDIST_LE_DIST] THEN
  ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
  MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`]
        DISTANCE_ATTAINS_INF) THEN
  ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC;
               DIST_0; GSYM CONJ_ASSOC] THEN
  REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;

let SETDIST_EQ_0_COMPACT_CLOSED = prove
 (`!s t:real^N->bool.
        compact s /\ closed t
        ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL
   [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
      SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0];
    REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN
    REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
    MESON_TAC[SETDIST_LE_DIST; DIST_EQ_0]]);;

let SETDIST_EQ_0_CLOSED_COMPACT = prove
 (`!s t:real^N->bool.
        closed s /\ compact t
        ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`,
  ONCE_REWRITE_TAC[SETDIST_SYM] THEN
  SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]);;

let SETDIST_EQ_0_BOUNDED = prove
 (`!s t:real^N->bool.
        (bounded s \/ bounded t)
        ==> (setdist(s,t) = &0 <=>
             s = {} \/ t = {} \/ ~(closure(s) INTER closure(t) = {}))`,
  REPEAT GEN_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE]
   `setdist(s,t) = setdist(closure s,closure t)`] THEN
  ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; SETDIST_EQ_0_CLOSED_COMPACT;
               COMPACT_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY]);;

let SETDIST_TRANSLATION = prove
 (`!a:real^N s t.
        setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN
  AP_TERM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[SET_RULE
   `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} =
    {f (g x) (g y) | x IN s /\ y IN t}`] THEN
  REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);;

add_translation_invariants [SETDIST_TRANSLATION];;

let SETDIST_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s t.
        linear f /\ (!x. norm(f x) = norm x)
        ==> setdist(IMAGE f s,IMAGE f t) = setdist(s,t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN
  REWRITE_TAC[SET_RULE
   `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} =
    {f (g x) (g y) | x IN s /\ y IN t}`] THEN
  FIRST_X_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN
  ASM_REWRITE_TAC[]);;

add_linear_invariants [SETDIST_LINEAR_IMAGE];;

let SETDIST_UNIQUE = prove
 (`!s t a b:real^N d.
        a IN s /\ b IN t /\ dist(a,b) = d /\
        (!x y. x IN s /\ y IN t ==> dist(a,b) <= dist(x,y))
        ==> setdist(s,t) = d`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SETDIST_LE_DIST];
    MATCH_MP_TAC REAL_LE_SETDIST THEN ASM SET_TAC[]]);;

let SETDIST_UNIV = prove
 (`(!s. setdist(s,(:real^N)) = &0) /\
   (!t. setdist((:real^N),t) = &0)`,
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN
  REWRITE_TAC[] THEN X_GEN_TAC `s:real^N->bool` THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN
  MATCH_MP_TAC SETDIST_UNIQUE THEN
  REWRITE_TAC[IN_UNIV; DIST_EQ_0; RIGHT_EXISTS_AND_THM] THEN
  ASM_REWRITE_TAC[UNWIND_THM1; DIST_REFL; DIST_POS_LE; MEMBER_NOT_EMPTY]);;

let SETDIST_ZERO = prove
 (`!s t:real^N->bool. ~(DISJOINT s t) ==> setdist(s,t) = &0`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN
  MATCH_MP_TAC(MESON[] `(?a. P a a) ==> ?a b. P a b`) THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ p /\ q /\ s`] THEN
  REWRITE_TAC[DIST_EQ_0; UNWIND_THM2; DIST_REFL; DIST_POS_LE] THEN
  ASM SET_TAC[]);;

let SETDIST_ZERO_STRONG = prove
 (`!s t:real^N->bool.
      ~(DISJOINT (closure s) (closure t)) ==> setdist(s,t) = &0`,
  MESON_TAC[SETDIST_CLOSURE; SETDIST_ZERO]);;

let SETDIST_FRONTIERS = prove
 (`!s t:real^N->bool.
        setdist(s,t) =
        if DISJOINT s t then setdist(frontier s,frontier t) else &0`,
  REPEAT STRIP_TAC THEN
  COND_CASES_TAC THEN ASM_SIMP_TAC[SETDIST_ZERO] THEN
  ASM_SIMP_TAC[GSYM SETDIST_FRONTIER] THEN
  ASM_CASES_TAC `DISJOINT s (frontier t:real^N->bool)` THENL
   [ASM_MESON_TAC[SETDIST_FRONTIER]; ALL_TAC] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1 SETDIST_CLOSURE)] THEN
  CONV_TAC SYM_CONV THEN MATCH_MP_TAC SETDIST_SUBSETS_EQ THEN
  REWRITE_TAC[frontier; SUBSET_DIFF; SUBSET_REFL; IN_DIFF] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `y:real^N` THEN
  ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `(x:real^N) IN interior s` THENL
   [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN
  MP_TAC(ISPECL [`segment[x:real^N,y]`; `interior s:real^N->bool`]
        CONNECTED_INTER_FRONTIER) THEN
  REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [EXISTS_TAC `x:real^N`; EXISTS_TAC `y:real^N`] THEN
    ASM_REWRITE_TAC[IN_INTER; IN_DIFF; ENDS_IN_SEGMENT] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `y IN u ==> u INTER v = {} ==> ~(y IN v)`)) THEN
    REWRITE_TAC[INTERIOR_CLOSURE; SET_RULE
     `s INTER (UNIV DIFF t) = {} <=> s SUBSET t`] THEN
    MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
    SIMP_TAC[IN_INTER; GSYM frontier; GSYM IN_DIFF] THEN
    MESON_TAC[FRONTIER_INTERIOR_SUBSET; SUBSET; DIST_IN_CLOSED_SEGMENT]]);;

let SETDIST_SING_FRONTIER = prove
 (`!s x:real^N. ~(x IN s) ==> setdist({x},frontier s) = setdist({x},s)`,
  MESON_TAC[SET_RULE `DISJOINT {x} s <=> ~(x IN s)`; SETDIST_FRONTIER]);;

let SETDIST_CLOSEST_POINT = prove
 (`!a:real^N s.
      closed s /\ ~(s = {}) ==> setdist({a},s) = dist(a,closest_point s a)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN
  REWRITE_TAC[RIGHT_EXISTS_AND_THM; IN_SING; UNWIND_THM2] THEN
  EXISTS_TAC `closest_point s (a:real^N)` THEN
  ASM_MESON_TAC[CLOSEST_POINT_EXISTS; DIST_SYM]);;

let SETDIST_EQ_0_SING = prove
 (`(!s x:real^N. setdist({x},s) = &0 <=> s = {} \/ x IN closure s) /\
   (!s x:real^N. setdist(s,{x}) = &0 <=> s = {} \/ x IN closure s)`,
  SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_SING; CLOSURE_SING] THEN SET_TAC[]);;

let SETDIST_EQ_0_CLOSED = prove
 (`!s x. closed s ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`,
  SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_SING] THEN SET_TAC[]);;

let SETDIST_EQ_0_CLOSED_IN = prove
 (`!u s x. closed_in (subtopology euclidean u) s /\ x IN u
           ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`,
  REWRITE_TAC[SETDIST_EQ_0_SING; CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]);;

let SETDIST_SING_IN_SET = prove
 (`!x s. x IN s ==> setdist({x},s) = &0`,
  SIMP_TAC[SETDIST_EQ_0_SING; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);;

let SETDIST_SING_FRONTIER_CASES = prove
 (`!s x:real^N.
        setdist({x},s) = if x IN s then &0 else setdist({x},frontier s)`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC[SETDIST_SING_IN_SET; SETDIST_SING_FRONTIER]);;

let SETDIST_LE_SING = prove
 (`!s t x:real^N. x IN s ==> setdist(s,t) <= setdist({x},t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_LEFT THEN ASM SET_TAC[]);;

let SETDIST_BALLS = prove
 (`(!a b:real^N r s.
        setdist(ball(a,r),ball(b,s)) =
        if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
   (!a b:real^N r s.
        setdist(ball(a,r),cball(b,s)) =
        if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
   (!a b:real^N r s.
        setdist(cball(a,r),ball(b,s)) =
        if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
   (!a b:real^N r s.
        setdist(cball(a,r),cball(b,s)) =
        if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))`,
  REWRITE_TAC[MESON[]
   `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN
  SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
  SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; SETDIST_EMPTY; DE_MORGAN_THM] THEN
  ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE]
   `setdist(s,t) = setdist(closure s,closure t)`] THEN
  SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN
  REWRITE_TAC[SETDIST_CLOSURE] THEN
  MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN
  CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT GEN_TAC] THEN
  REWRITE_TAC[real_max; REAL_SUB_LE] THEN COND_CASES_TAC THEN
  SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_CBALL; CLOSED_CBALL; CLOSURE_CLOSED;
           CBALL_EQ_EMPTY; INTER_BALLS_EQ_EMPTY]
  THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
  ASM_CASES_TAC `b:real^N = a` THENL
   [FIRST_X_ASSUM SUBST_ALL_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN
    ASM_CASES_TAC `r = &0 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
    ASM_SIMP_TAC[CBALL_SING; SETDIST_SINGS] THEN REAL_ARITH_TAC;
    STRIP_TAC] THEN
  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC REAL_LE_SETDIST THEN
    ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; IN_CBALL] THEN
    CONV_TAC NORM_ARITH] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `dist(a + r / dist(a,b) % (b - a):real^N,
                   b - s / dist(a,b) % (b - a))` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SETDIST_LE_DIST THEN
    REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a + x) = norm x`;
                NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN
    ONCE_REWRITE_TAC[DIST_SYM] THEN
    REWRITE_TAC[dist; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN
    ASM_REAL_ARITH_TAC;
    REWRITE_TAC[dist; VECTOR_ARITH
     `(a + d % (b - a)) - (b - e % (b - a)):real^N =
      (&1 - d - e) % (a - b)`] THEN
    REWRITE_TAC[NORM_MUL; REAL_ARITH
      `&1 - r / y - s / y = &1 - (r + s) / y`] THEN
    ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
    REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[VECTOR_SUB_EQ; NORM_EQ_0; REAL_FIELD
     `~(n = &0) ==> (&1 - x / n) * n = n - x`] THEN
    REWRITE_TAC[GSYM dist] THEN ASM_REAL_ARITH_TAC]);;

let OPEN_TRANSLATION_SUBSET_PREIMAGE = prove
 (`!s t:real^N->bool.
        compact s /\ open t ==> open {a | IMAGE (\x. a + x) s SUBSET t}`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[IMAGE_CLAUSES; EMPTY_SUBSET; UNIV_GSPEC; OPEN_UNIV] THEN
  ASM_CASES_TAC `t = (:real^N)` THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC; OPEN_UNIV] THEN
  REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
  X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
  EXISTS_TAC `setdist(IMAGE (\x. a + x) s,(:real^N) DIFF t)` THEN
  REWRITE_TAC[SETDIST_POS_LT; SUBSET; IN_BALL; IN_ELIM_THM;
              FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_TRANSLATION_EQ;
               GSYM OPEN_CLOSED] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[REAL_NOT_LT]
   `x < y ==> (~p ==> y <= x) ==> p`)) THEN
  DISCH_TAC THEN
  SUBST1_TAC(NORM_ARITH `dist(a:real^N,b) = dist(a + c,b + c)`) THEN
  MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* A nice characterization of uniform continuity via setdist.                *)
(* ------------------------------------------------------------------------- *)

let UNIFORMLY_CONTINUOUS_ON_SETDIST = prove
 (`!f:real^M->real^N s t t'.
        f uniformly_continuous_on s /\
        t SUBSET s /\ t' SUBSET s /\ setdist(t,t') = &0
        ==> setdist(IMAGE f t,IMAGE f t') = &0`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `t:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[IMAGE_CLAUSES; SETDIST_EMPTY] THEN
  ASM_CASES_TAC `t':real^M->bool = {}` THEN
  ASM_REWRITE_TAC[IMAGE_CLAUSES; SETDIST_EMPTY] THEN
  GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN
  PURE_REWRITE_TAC[GSYM SETDIST_POS_LT] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [uniformly_continuous_on]) THEN
  DISCH_THEN(MP_TAC o SPEC
   `setdist(IMAGE (f:real^M->real^N) t,IMAGE f t')`) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`t:real^M->bool`; `t':real^M->bool`; `d:real`]
        REAL_SETDIST_LT_EXISTS) THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `x:real^M`]) THEN
  ASM_REWRITE_TAC[REAL_NOT_LT; NOT_IMP] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC SETDIST_LE_DIST THEN
  ASM_SIMP_TAC[FUN_IN_IMAGE]);;

let UNIFORMLY_CONTINUOUS_ON_SETDIST_EQ = prove
 (`!f:real^M->real^N s.
        f uniformly_continuous_on s <=>
        !t t'. t SUBSET s /\ t' SUBSET s /\ setdist(t,t') = &0
              ==> setdist(IMAGE f t,IMAGE f t') = &0`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [MESON_TAC[UNIFORMLY_CONTINUOUS_ON_SETDIST]; DISCH_TAC] THEN
  REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY_ALT] THEN
  X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(MESON[]
   `!P. (!x y. R x y ==> R y x) /\
        (!x y. P x ==> R x y) /\ (!x y. ~P x /\ ~P y ==> R x y)
        ==> !x y. R x y`) THEN
  EXISTS_TAC
   `\x. ?B. INFINITE {n:num | norm((f:real^M->real^N) (x n)) <= B}` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [REPEAT GEN_TAC THEN DISCH_TAC THEN
    ONCE_REWRITE_TAC[GSYM LIM_NULL_NEG] THEN
    ONCE_REWRITE_TAC[DIST_SYM] THEN
    ASM_SIMP_TAC[VECTOR_NEG_SUB];
    ALL_TAC] THEN
  CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num->real^M`; `y:num->real^M`] THEN
  REWRITE_TAC[NOT_EXISTS_THM; INFINITE; AND_FORALL_THM] THEN
  REWRITE_TAC[GSYM INFINITE; GSYM FINITE_UNION] THEN DISCH_TAC THEN
  STRIP_TAC THEN
  REWRITE_TAC[GSYM REAL_NOT_LE; GSYM NOT_FORALL_THM] THEN DISCH_TAC THENL
   [SUBGOAL_THEN
     `?l r. (!m n. m < n ==> r m < r n) /\
            ((\n. (f:real^M->real^N) (x((r:num->num) n))) --> l) sequentially`
    (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
     [FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` (MP_TAC o MATCH_MP
        INFINITE_ENUMERATE)) THEN
      DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
       `IMAGE r UNIV = {x | P x} ==> !n. P(r n)`)) THEN
      MP_TAC(ISPEC `cball(vec 0:real^N,B)` compact) THEN
      REWRITE_TAC[COMPACT_CBALL; IN_CBALL_0] THEN
      DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) o x o (r:num->num)`) THEN
      ASM_REWRITE_TAC[o_DEF] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN
      DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `(r:num->num) o (q:num->num)` THEN
      ASM_SIMP_TAC[o_DEF];
      REWRITE_TAC[LIM_SEQUENTIALLY] THEN
      DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN
      ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN
      DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`IMAGE ((x:num->real^M) o r) {n:num | N <= n}`;
        `IMAGE ((y:num->real^M) o r) {n:num | N <= n}`]) THEN
      ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM IMAGE_o; o_DEF] THEN
      REWRITE_TAC[NOT_IMP; GSYM SETDIST_POS_LT] THEN CONJ_TAC THENL
       [REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN
        GEN_REWRITE_TAC I [REAL_LE_TRANS_LT] THEN X_GEN_TAC `b:real` THEN
        DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
        DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_REWRITE_TAC[] THEN
        DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC
         `(r:num->num) (MAX N n)`)) THEN
        REWRITE_TAC[LE_REFL; dist; VECTOR_SUB_RZERO] THEN ANTS_TAC THENL
         [TRANS_TAC LE_TRANS `MAX N n` THEN CONJ_TAC THENL
           [ARITH_TAC; ASM_MESON_TAC[MONOTONE_BIGGER]];
          MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS)] THEN
        REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
        GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
        REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THEN
        REPLICATE_TAC 2 (MATCH_MP_TAC FUN_IN_IMAGE) THEN
        REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC;
        TRANS_TAC REAL_LTE_TRANS `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
        MATCH_MP_TAC REAL_LE_SETDIST THEN
        REWRITE_TAC[IMAGE_EQ_EMPTY; CONJ_ASSOC] THEN
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
        CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN
        REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
        REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
        X_GEN_TAC `n:num` THEN DISCH_TAC THEN
        MATCH_MP_TAC(NORM_ARITH
         `!xn l. dist(xm,l) < e / &4 /\ dist(xn,l) < e / &4 /\
                 e <= dist(xn,yn)
                 ==> e / &2 <= dist(xm:real^N,yn)`) THEN
        EXISTS_TAC `(f:real^M->real^N)(x((r:num->num) n))` THEN
        EXISTS_TAC `l:real^N` THEN ASM_SIMP_TAC[]]];
      MP_TAC(ISPEC `\(r:num->num) n.
                @m. !k. k < n
                        ==> (r:num->num) k < m /\
                            e <= dist(f(y(r k)),f(x m)) /\
                            e <= dist((f:real^M->real^N)(x(r k)),f(y m))`
        (MATCH_MP WF_REC WF_num)) THEN
      REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `r:num->num` (LABEL_TAC "*")) THEN
      SUBGOAL_THEN
        `!n k. k < n
               ==> (r:num->num) k < r n /\
                   e <= dist(f(y(r k)),f(x (r n))) /\
                   e <= dist((f:real^M->real^N)(x(r k)),f(y (r n)))`
      ASSUME_TAC THENL
       [X_GEN_TAC `n:num` THEN
        REMOVE_THEN "*" (SUBST1_TAC o SPEC `n:num`) THEN
        CONV_TAC SELECT_CONV THEN
        SUBGOAL_THEN
         `bounded
           (IMAGE ((f:real^M->real^N) o x o (r:num->num)) {k | k < n} UNION
            IMAGE ((f:real^M->real^N) o y o (r:num->num)) {k | k < n})`
        MP_TAC THENL
         [MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_UNION] THEN
          SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT];
          REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE] THEN
          REWRITE_TAC[FORALL_IN_GSPEC; o_THM; LEFT_IMP_EXISTS_THM]] THEN
        X_GEN_TAC `B:real` THEN STRIP_TAC THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `B + e:real`) THEN
        SUBGOAL_THEN `FINITE(IMAGE (r:num->num) {k | k < n})` MP_TAC THENL
         [SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; ALL_TAC] THEN
        DISCH_THEN(MP_TAC o ISPEC `\n:num. n` o
         MATCH_MP UPPER_BOUND_FINITE_SET) THEN
        REWRITE_TAC[FORALL_IN_IMAGE; LEFT_IMP_EXISTS_THM; FORALL_IN_GSPEC] THEN
        X_GEN_TAC `m:num` THEN DISCH_TAC THEN
        MP_TAC(SPECL [`0`; `m:num`] FINITE_NUMSEG) THEN
        REWRITE_TAC[IMP_IMP; GSYM FINITE_UNION] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (MESON[INFINITE; num_INFINITE]
         `FINITE s ==> ~(s = (:num))`)) THEN
        REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; NOT_FORALL_THM] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN
        REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; IN_ELIM_THM; LE_0] THEN
        REWRITE_TAC[REAL_NOT_LE; NOT_LE] THEN ASM_MESON_TAC[LET_TRANS;
         NORM_ARITH `norm x <= B /\ B + e < norm y ==> e <= dist(x:real^N,y)`];
        REMOVE_THEN "*" (K ALL_TAC) ] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`IMAGE ((x:num->real^M) o r) (:num)`;
        `IMAGE ((y:num->real^M) o r) (:num)`]) THEN
      ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM IMAGE_o; o_DEF] THEN
      REWRITE_TAC[NOT_IMP; GSYM SETDIST_POS_LT] THEN CONJ_TAC THENL
       [REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN
        GEN_REWRITE_TAC I [REAL_LE_TRANS_LT] THEN X_GEN_TAC `b:real` THEN
        DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
        DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_REWRITE_TAC[] THEN
        DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC
         `(r:num->num) (MAX N n)`)) THEN
        REWRITE_TAC[LE_REFL; dist; VECTOR_SUB_RZERO] THEN ANTS_TAC THENL
         [TRANS_TAC LE_TRANS `MAX N n` THEN CONJ_TAC THENL
           [ARITH_TAC; ASM_MESON_TAC[MONOTONE_BIGGER]];
          MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS)] THEN
        REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
        GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
        REWRITE_TAC[IMAGE_o] THEN SET_TAC[];
        TRANS_TAC REAL_LTE_TRANS `e:real` THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC REAL_LE_SETDIST THEN
        REWRITE_TAC[IMAGE_EQ_EMPTY; CONJ_ASSOC; UNIV_NOT_EMPTY] THEN
        REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
        REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN
        ASM_METIS_TAC[LT_CASES; DIST_SYM]]]);;

(* ------------------------------------------------------------------------- *)
(* Use set distance for an easy proof of separation properties etc.          *)
(* ------------------------------------------------------------------------- *)

let OPEN_IN_SEPARATED_UNION = prove
 (`!s t:real^N->bool.
        &0 < setdist(s,t)
        ==> open_in (subtopology euclidean (s UNION t)) s /\
            open_in (subtopology euclidean (s UNION t)) t`,
  MATCH_MP_TAC(MESON[]
   `(!s t. P s t ==> P t s) /\ (!s t. Q t s ==> R s t) /\
    (!s t. P s t ==> Q s t)
    ==> !s t. P s t ==> Q s t /\ R s t`) THEN
  CONJ_TAC THENL [REWRITE_TAC[SETDIST_SYM]; ALL_TAC] THEN
  CONJ_TAC THENL [REWRITE_TAC[UNION_COMM]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC
   `{x + y:real^N | x IN s /\ y IN ball(vec 0,setdist(s,t))}` THEN
  SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; SUBSET_UNION] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `vec 0:real^N` THEN
    ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; VECTOR_ADD_RID] THEN
    ASM SET_TAC[];
    MATCH_MP_TAC(SET_RULE `DISJOINT t u ==> (s UNION t) INTER u SUBSET s`) THEN
    REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN t ==> ~(x IN s)`] THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN
    MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`;
                   `x:real^N`; `x + y:real^N`] SETDIST_LE_DIST) THEN
    ASM_SIMP_TAC[NORM_ARITH `~(p <= dist(x:real^N,x + y)) <=> norm y < p`]]);;

let CLOSED_IN_SEPARATED_UNION = prove
 (`!s t:real^N->bool.
        &0 < setdist(s,t)
        ==> closed_in (subtopology euclidean (s UNION t)) s /\
            closed_in (subtopology euclidean (s UNION t)) t`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
  REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_UNION] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SEPARATED_UNION) THEN
  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN MATCH_MP_TAC EQ_IMP THEN
  AP_TERM_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SETDIST_POS_LT]) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]
        SETDIST_ZERO)) THEN
  SET_TAC[]);;

let COMPACT_IN_SEPARATED_UNION = prove
 (`!s t:real^N->bool.
        compact(s UNION t) /\ &0 < setdist(s,t) ==> compact s /\ compact t`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SEPARATED_UNION) THEN
  ASM_MESON_TAC[CLOSED_IN_COMPACT]);;

let CONNECTED_IMP_NONSEPARATED_UNION = prove
 (`!s t:real^N->bool. connected(s UNION t) ==> setdist(s,t) = &0`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[SETDIST_EMPTY] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]
        SETDIST_ZERO)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM SETDIST_POS_LT]) THEN
  REWRITE_TAC[CONNECTED_CLOSED_IN] THEN
  MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP CLOSED_IN_SEPARATED_UNION) THEN
  ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let SEPARATION_CLOSURES = prove
 (`!s t:real^N->bool.
        s INTER closure(t) = {} /\ t INTER closure(s) = {}
        ==> ?u v. DISJOINT u v /\ open u /\ open v /\
                  s SUBSET u /\ t SUBSET v`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> q /\ r /\ s /\ t /\ p`] THEN
  MATCH_MP_TAC METRIZABLE_SPACE_SEPARATION THEN
  REWRITE_TAC[METRIZABLE_SPACE_EUCLIDEAN; separated_in] THEN
  ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV; EUCLIDEAN_CLOSURE_OF]);;

let SEPARATION_NORMAL = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\ s INTER t = {}
        ==> ?u v. open u /\ open v /\
                  s SUBSET u /\ t SUBSET v /\ u INTER v = {}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN
  ONCE_REWRITE_TAC[TAUT
    `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN
  MATCH_MP_TAC SEPARATION_CLOSURES THEN
  ASM_SIMP_TAC[CLOSURE_CLOSED] THEN ASM SET_TAC[]);;

let SEPARATION_NORMAL_LOCAL_CLOSURES = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        DISJOINT s t
        ==> ?s' t'. open_in (subtopology euclidean u) s' /\
                    open_in (subtopology euclidean u) t' /\
                    s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' /\
                    DISJOINT (subtopology euclidean u closure_of s')
                             (subtopology euclidean u closure_of t')`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `normal_space(subtopology euclidean (u:real^N->bool))`
  MP_TAC THENL
   [SIMP_TAC[METRIZABLE_IMP_NORMAL_SPACE; METRIZABLE_SPACE_EUCLIDEAN;
             METRIZABLE_SPACE_SUBTOPOLOGY];
    REWRITE_TAC[NORMAL_SPACE_DISJOINT_CLOSURES]] THEN
  DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s':real^N->bool` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t':real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
   (SET_RULE `DISJOINT s t
              ==> s' SUBSET s /\ t' SUBSET t ==> DISJOINT s' t'`)) THEN
  ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; SUBSET_INTER; CLOSURE_SUBSET;
               EUCLIDEAN_CLOSURE_OF; ISPEC `euclidean` OPEN_IN_IMP_SUBSET;
               SET_RULE `s SUBSET u ==> u INTER s = s`]);;

let SEPARATION_NORMAL_LOCAL = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        s INTER t = {}
        ==> ?s' t'. open_in (subtopology euclidean u) s' /\
                    open_in (subtopology euclidean u) t' /\
                    s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN
  DISCH_THEN(MP_TAC o MATCH_MP SEPARATION_NORMAL_LOCAL_CLOSURES) THEN
  MESON_TAC[]);;

let SEPARATION_NORMAL_CLOSURES = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\ DISJOINT s t
        ==> ?s' t'. open s' /\ open t' /\
                    s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' /\
                    DISJOINT (closure s') (closure t')`,
  REWRITE_TAC[CLOSED_IN; OPEN_IN; GSYM EUCLIDEAN_CLOSURE_OF] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[SEPARATION_NORMAL_LOCAL_CLOSURES]);;

let SEPARATION_NORMAL_COMPACT = prove
 (`!s t:real^N->bool.
        compact s /\ closed t /\ s INTER t = {}
        ==> ?u v. open u /\ compact(closure u) /\ open v /\
                  s SUBSET u /\ t SUBSET v /\ u INTER v = {}`,
  REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
  REPEAT STRIP_TAC THEN FIRST_ASSUM
   (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t UNION ((:real^N) DIFF ball(vec 0,r))`]
        SEPARATION_NORMAL) THEN
  ASM_SIMP_TAC[CLOSED_UNION; GSYM OPEN_CLOSED; OPEN_BALL] 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
  CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE; ASM SET_TAC[]] THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN
  REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]);;

let SEPARATION_HAUSDORFF = prove
 (`!x:real^N y.
      ~(x = y)
      ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`,
  MATCH_ACCEPT_TAC(REWRITE_RULE
   [GSYM OPEN_IN; hausdorff_space; TOPSPACE_EUCLIDEAN; IN_UNIV; DISJOINT]
     HAUSDORFF_SPACE_EUCLIDEAN));;

let SEPARATION_T2 = prove
 (`!x:real^N y.
        ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\
                           (u INTER v = {})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SEPARATION_HAUSDORFF] THEN
  REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]);;

let SEPARATION_T1 = prove
 (`!x:real^N y.
        ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\
                           ~(x IN v) /\ y IN v`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ASM_SIMP_TAC[SEPARATION_T2; EXTENSION; NOT_IN_EMPTY; IN_INTER];
    ALL_TAC] THEN MESON_TAC[]);;

let SEPARATION_T0 = prove
 (`!x:real^N y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)`,
  MESON_TAC[SEPARATION_T1]);;

let CLOSED_IN_EQ_CONTINUOUS_LEVELSET = prove
 (`!u s a.
        closed_in (subtopology euclidean u) s <=>
        ?f:real^M->real^N. f continuous_on u /\ {x | x IN u /\ f x = a} = s`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
    ASM_CASES_TAC `t:real^M->bool = {}` THENL
     [EXISTS_TAC `(\x. a + basis 1):real^M->real^N` THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`] THEN
      ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    EXISTS_TAC `(\x. a + setdist({x},t) % basis 1):real^M->real^N` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
      REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_LIFT_SETDIST];
      REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`] THEN
      REWRITE_TAC[VECTOR_MUL_EQ_0; SETDIST_EQ_0_SING] THEN
      ASM_SIMP_TAC[CLOSURE_CLOSED; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN
      SET_TAC[]];
    EXPAND_TAC "s" THEN REWRITE_TAC[GSYM IN_SING] THEN
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
    ASM_REWRITE_TAC[CLOSED_SING]]);;

let CLOSED_EQ_CONTINUOUS_LEVELSET = prove
 (`!s a.
        closed s <=>
        ?f:real^M->real^N. f continuous_on (:real^M) /\ {x | f x = a} = s`,
  ONCE_REWRITE_TAC[SET_RULE `{x | P x} = {x | x IN UNIV /\ P x}`] THEN
  REWRITE_TAC[GSYM CLOSED_IN_EQ_CONTINUOUS_LEVELSET] THEN
  REWRITE_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV]);;

let CONNECTED = prove
 (`!s:real^N->bool.
      connected s <=>
      ~(?e1 e2. open e1 /\ open e2 /\ s SUBSET (e1 UNION e2) /\
                e1 INTER e2 = {} /\ ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`,
  GEN_TAC THEN EQ_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THENL
   [REWRITE_TAC[connected] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SET_TAC[];
    REWRITE_TAC[CONNECTED_SEPARATION; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c2:real^N->bool`] THEN
    STRIP_TAC THEN MP_TAC
     (ISPECL [`c1:real^N->bool`; `c2:real^N->bool`] SEPARATION_CLOSURES) THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Connectedness of the intersection of a chain.                             *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_CHAIN = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> compact s /\ connected s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> connected(INTERS f)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[INTERS_0; CONNECTED_UNIV] THEN
  ABBREV_TAC `c:real^N->bool = INTERS f` THEN
  SUBGOAL_THEN `compact(c:real^N->bool)` ASSUME_TAC THENL
   [EXPAND_TAC "c" THEN MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ASM_SIMP_TAC[CONNECTED_CLOSED_SET; COMPACT_IMP_CLOSED; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`a:real^N->bool`; `b:real^N->bool`] SEPARATION_NORMAL) THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `?k:real^N->bool. k IN f` STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `?n:real^N->bool. open n /\ k SUBSET n` MP_TAC THENL
   [ASM_MESON_TAC[BOUNDED_SUBSET_BALL; COMPACT_IMP_BOUNDED; OPEN_BALL];
    REWRITE_TAC[UNIONS_SUBSET] THEN STRIP_TAC] THEN
  MP_TAC(ISPEC `k:real^N->bool` COMPACT_IMP_HEINE_BOREL) THEN
  ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC
   `(u UNION v:real^N->bool) INSERT {n DIFF s | s IN f}`) THEN
  REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC[OPEN_UNION; OPEN_DIFF; COMPACT_IMP_CLOSED; NOT_IMP] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[UNIONS_INSERT] THEN REWRITE_TAC[SUBSET] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[IN_UNION] THEN
    ASM_CASES_TAC `(x:real^N) IN c` THENL [ASM SET_TAC[]; DISJ2_TAC] THEN
    REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN
    UNDISCH_TAC `~((x:real^N) IN c)` THEN
    SUBST1_TAC(SYM(ASSUME `INTERS f:real^N->bool = c`)) THEN
    REWRITE_TAC[IN_INTERS; NOT_FORALL_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
    ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[SUBSET_INSERT_DELETE] THEN
  SUBGOAL_THEN `FINITE(g DELETE (u UNION v:real^N->bool))` MP_TAC THENL
   [ASM_REWRITE_TAC[FINITE_DELETE];
    REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN
  REWRITE_TAC[FINITE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `?j:real^N->bool. j IN f /\
                     UNIONS(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)`
  STRIP_ASSUME_TAC THENL
   [ASM_CASES_TAC `f':(real^N->bool)->bool = {}` THEN
    ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; EMPTY_SUBSET] THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN
     `?j:real^N->bool. j IN f' /\
                       UNIONS(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)`
    MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
    SUBGOAL_THEN
     `!s t:real^N->bool. s IN f' /\ t IN f' ==> s SUBSET t \/ t SUBSET s`
    MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
    UNDISCH_TAC `~(f':(real^N->bool)->bool = {})` THEN
    UNDISCH_TAC `FINITE(f':(real^N->bool)->bool)` THEN
    SPEC_TAC(`f':(real^N->bool)->bool`,`f':(real^N->bool)->bool`) THEN
    MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[] THEN
    REWRITE_TAC[EXISTS_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_INSERT] THEN POP_ASSUM_LIST(K ALL_TAC) THEN
    MAP_EVERY X_GEN_TAC [`i:real^N->bool`; `f:(real^N->bool)->bool`] THEN
    ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
    ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; NOT_IN_EMPTY;
                    UNIONS_0; UNION_EMPTY; SUBSET_REFL] THEN
    DISCH_THEN(fun th -> REPEAT DISCH_TAC THEN MP_TAC th) THEN
    ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `j:real^N->bool` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `(n DIFF j) SUBSET (n DIFF i) \/
                  (n DIFF i:real^N->bool) SUBSET (n DIFF j)`
    STRIP_ASSUME_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `j:real^N->bool` o CONJUNCT2) THEN
      ASM SET_TAC[];
      DISJ1_TAC THEN ASM SET_TAC[];
      DISJ2_TAC THEN EXISTS_TAC `j:real^N->bool` THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN `(j INTER k:real^N->bool) SUBSET (u UNION v)` ASSUME_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `k SUBSET (u UNION v) UNION (n DIFF j)
      ==> (j INTER k) SUBSET (u UNION v)`) THEN
    MATCH_MP_TAC SUBSET_TRANS THEN
    EXISTS_TAC `UNIONS g :real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
     `UNIONS((u UNION v:real^N->bool) INSERT (g DELETE (u UNION v)))` THEN
    CONJ_TAC THENL [MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]; ALL_TAC] THEN
    ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[UNIONS_INSERT] THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `connected(j INTER k:real^N->bool)` MP_TAC THENL
   [ASM_MESON_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; INTER_COMM];
    REWRITE_TAC[connected] THEN
    MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;

let CONNECTED_CHAIN_GEN = prove
 (`!f:(real^N->bool)->bool.
       (!s. s IN f ==> closed s /\ connected s) /\
       (?s. s IN f /\ compact s) /\
       (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
       ==> connected(INTERS f)`,
  GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `INTERS f = INTERS(IMAGE (\t:real^N->bool. s INTER t) f)`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; INTERS_IMAGE] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONNECTED_CHAIN THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
    ASM_SIMP_TAC[COMPACT_INTER_CLOSED] THEN
    CONJ_TAC THENL [X_GEN_TAC `t:real^N->bool`; ASM SET_TAC[]] THEN
    DISCH_TAC THEN
    SUBGOAL_THEN `s INTER t:real^N->bool = s \/ s INTER t = t`
     (DISJ_CASES_THEN SUBST1_TAC) THEN
    ASM SET_TAC[]]);;

let CONNECTED_NEST = prove
 (`!s. (!n. compact(s n) /\ connected(s n)) /\
       (!m n. m <= n ==> s n SUBSET s m)
       ==> connected(INTERS {s n | n IN (:num)})`,
  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CHAIN THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);;

let CONNECTED_NEST_GEN = prove
 (`!s. (!n. closed(s n) /\ connected(s n)) /\ (?n. compact(s n)) /\
       (!m n. m <= n ==> s n SUBSET s m)
       ==> connected(INTERS {s n | n IN (:num)})`,
  GEN_TAC THEN
  DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN
  MATCH_MP_TAC CONNECTED_CHAIN_GEN THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM;
               EXISTS_IN_GSPEC] THEN
  MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Hausdorff distance between sets.                                          *)
(* ------------------------------------------------------------------------- *)

let hausdist = new_definition
 `hausdist(s:real^N->bool,t:real^N->bool) =
        let ds = {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} in
        if ~(ds = {}) /\ (?b. !d. d IN ds ==> d <= b) then sup ds
        else &0`;;

let HAUSDIST_POS_LE = prove
 (`!s t:real^N->bool. &0 <= hausdist(s,t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
  REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN
  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
  MATCH_MP_TAC REAL_LE_SUP THEN
  ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE] THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
  ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  MATCH_MP_TAC(SET_RULE
   `~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y`) THEN
  ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE]);;

let HAUSDIST_POS_LT = prove
 (`!s t:real^N->bool. &0 < hausdist(s,t) <=> ~(hausdist(s,t) = &0)`,
  REWRITE_TAC[REAL_LT_LE; HAUSDIST_POS_LE] THEN REAL_ARITH_TAC);;

let REAL_ABS_HAUSDIST = prove
 (`!s t:real^N->bool. abs(hausdist(s,t)) = hausdist(s,t)`,
  REWRITE_TAC[real_abs; HAUSDIST_POS_LE]);;

let HAUSDIST_REFL = prove
 (`!s:real^N->bool. hausdist(s,s) = &0`,
  GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE] THEN
  REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
  MATCH_MP_TAC REAL_SUP_LE THEN
  REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN
  ASM_SIMP_TAC[SETDIST_SING_IN_SET; REAL_LE_REFL]);;

let HAUSDIST_SYM = prove
 (`!s t:real^N->bool. hausdist(s,t) = hausdist(t,s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN
  REWRITE_TAC[]);;

let HAUSDIST_EMPTY = prove
 (`(!t:real^N->bool. hausdist ({},t) = &0) /\
   (!s:real^N->bool. hausdist (s,{}) = &0)`,
  REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_EMPTY] THEN
  REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`; UNION_EMPTY] THEN
  REWRITE_TAC[SET_RULE `{c |x| x IN s} = {} <=> s = {}`] THEN
  X_GEN_TAC `s:real^N->bool` THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
  ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> {c |x| x IN s} = {c}`] THEN
  REWRITE_TAC[SUP_SING; COND_ID]);;

let HAUSDIST_SINGS = prove
 (`!x y:real^N. hausdist({x},{y}) = dist(x,y)`,
  REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN
  REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`] THEN
  REWRITE_TAC[DIST_SYM; UNION_IDEMPOT; SUP_SING; NOT_INSERT_EMPTY] THEN
  REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN
  MESON_TAC[REAL_LE_REFL]);;

let HAUSDIST_SCALING = prove
 (`!a s t:real^N->bool.
        hausdist(IMAGE (\x. a % x) s,IMAGE (\x. a % x) t) =
        abs a * hausdist(s,t)`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[REAL_MUL_RZERO; HAUSDIST_EMPTY; IMAGE_CLAUSES] THEN
  ASM_CASES_TAC `a = &0` THENL
   [ASM_SIMP_TAC[VECTOR_MUL_LZERO; HAUSDIST_REFL; SET_RULE
     `~(s = {}) ==> IMAGE (\x. a) s = {a}`] THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[hausdist; SET_RULE
   `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
  REWRITE_TAC[SET_RULE `{a % x} = IMAGE (\x:real^N. a % x) {x}`] THEN
  REWRITE_TAC[SETDIST_SCALING; SET_RULE
   `{(c:real) * f x t | x IN s} UNION {c * f x s | x IN t} =
    IMAGE (\x. c * x) ({f x t | x IN s} UNION {f x s | x IN t})`] THEN
  ABBREV_TAC `ds = {setdist({y:real^N},t) | y IN s} UNION
                   {setdist ({y},s) | y IN t}` THEN
  CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN
  ASM_CASES_TAC `ds:real->bool = {}` THEN
  ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; REAL_MUL_RZERO; FORALL_IN_IMAGE] THEN
  GEN_REWRITE_TAC RAND_CONV [COND_RAND] THEN
  MATCH_MP_TAC(MESON[]
   `y = b /\ (p <=> q) /\ (p /\ q ==> x = a)
    ==> (if p then x else y) = (if q then a else b)`) THEN
  REWRITE_TAC[REAL_MUL_RZERO] THEN CONJ_TAC THENL
   [EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `b:real`) THENL
     [EXISTS_TAC `b / abs a`; EXISTS_TAC `abs a * b`] THEN
    ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN
    ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
    ASM_MESON_TAC[REAL_MUL_SYM];
    DISCH_TAC THEN MATCH_MP_TAC SUP_UNIQUE THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
    X_GEN_TAC `c:real` THEN CONV_TAC SYM_CONV THEN
    MATCH_MP_TAC REAL_SUP_LE_EQ THEN ASM_REWRITE_TAC[]]);;

let th = prove
 (`!c. &0 < c
       ==> !s t. hausdist(IMAGE (\x. c % x) s,IMAGE (\x. c % x) t) =
                 c * hausdist(s,t)`,
  SIMP_TAC[HAUSDIST_SCALING; REAL_ARITH `&0 < c ==> abs c = c`]) in
add_scaling_theorems [th];;

let HAUSDIST_EQ = prove
 (`!s t:real^M->bool s' t':real^N->bool.
        (!b. (!x. x IN s ==> setdist({x},t) <= b) /\
             (!y. y IN t ==> setdist({y},s) <= b) <=>
             (!x. x IN s' ==> setdist({x},t') <= b) /\
             (!y. y IN t' ==> setdist({y},s') <= b))
        ==> hausdist(s,t) = hausdist(s',t')`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
  MATCH_MP_TAC(MESON[]
   `(p <=> p') /\ s = s'
    ==> (if p then s else &0) = (if p' then s' else &0)`) THEN
  CONJ_TAC THENL
   [BINOP_TAC THENL
     [PURE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`];
      AP_TERM_TAC THEN ABS_TAC];
    MATCH_MP_TAC SUP_EQ] THEN
  PURE_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN
  ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN
  REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN
  DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN
  ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  DISCH_THEN(MP_TAC o SPEC `--(&1):real`) THEN
  SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> ~(x <= --(&1))`] THEN
  SET_TAC[]);;

let HAUSDIST_TRANSLATION = prove
 (`!a s t:real^N->bool.
        hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
  REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
  REWRITE_TAC[SET_RULE `{a + x:real^N} = IMAGE (\x. a + x) {x}`] THEN
  REWRITE_TAC[SETDIST_TRANSLATION]);;

add_translation_invariants [HAUSDIST_TRANSLATION];;

let HAUSDIST_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s t.
           linear f /\ (!x. norm(f x) = norm x)
           ==> hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t)`,
  REPEAT STRIP_TAC THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
  REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
  ONCE_REWRITE_TAC[SET_RULE `{(f:real^M->real^N) x} = IMAGE f {x}`] THEN
  ASM_SIMP_TAC[SETDIST_LINEAR_IMAGE]);;

add_linear_invariants [HAUSDIST_LINEAR_IMAGE];;

let HAUSDIST_CLOSURE = prove
 (`(!s t:real^N->bool. hausdist(closure s,t) = hausdist(s,t)) /\
   (!s t:real^N->bool. hausdist(s,closure t) = hausdist(s,t))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN
  GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN
  PURE_ONCE_REWRITE_TAC[SET_RULE
   `(!x. P x ==> Q x) <=> (!x. P x ==> x IN {x | Q x})`] THEN
  MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
  REWRITE_TAC[EMPTY_GSPEC; CONTINUOUS_ON_ID; CLOSED_EMPTY] THEN
  ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x <= b <=> drop(lift x) <= b`] THEN
  REWRITE_TAC[SET_RULE
    `{x | drop(lift(f x)) <= b} =
     {x | x IN UNIV /\ lift(f x) IN {x | drop x <= b}}`] THEN
  MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
  REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_LIFT_SETDIST] THEN
  REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]);;

let REAL_HAUSDIST_LE = prove
 (`!s t:real^N->bool b.
        ~(s = {}) /\ ~(t = {}) /\
        (!x. x IN s ==> setdist({x},t) <= b) /\
        (!y. y IN t ==> setdist({y},s) <= b)
        ==> hausdist(s,t) <= b`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN
  ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
  REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN
  COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
  MATCH_MP_TAC REAL_SUP_LE THEN
  ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
  ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]);;

let REAL_HAUSDIST_LE_SUMS = prove
 (`!s t:real^N->bool b.
        ~(s = {}) /\ ~(t = {}) /\
        s SUBSET {y + z | y IN t /\ z IN cball(vec 0,b)} /\
        t SUBSET {y + z | y IN s /\ z IN cball(vec 0,b)}
        ==> hausdist(s,t) <= b`,
  REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN
  REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`;
              ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
  REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC REAL_HAUSDIST_LE THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; REAL_LE_TRANS; IN_SING]);;

let REAL_LE_HAUSDIST  = prove
 (`!s t:real^N->bool a b c z.
        ~(s = {}) /\ ~(t = {}) /\
        (!x. x IN s ==> setdist({x},t) <= b) /\
        (!y. y IN t ==> setdist({y},s) <= c) /\
        (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s))
        ==> a <= hausdist(s,t)`,
  REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN
  ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
  REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL
   [MATCH_MP_TAC REAL_LE_SUP THEN
    ASM_SIMP_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
    REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
    REWRITE_TAC[NOT_FORALL_THM]] THEN
  EXISTS_TAC `max b c:real` THEN
  ASM_SIMP_TAC[REAL_LE_MAX] THEN ASM SET_TAC[]);;

let SETDIST_LE_HAUSDIST = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN
  MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN
  ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN
  CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[SETDIST_LE_SING; MEMBER_NOT_EMPTY]] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN
  DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN
  CONJ_TAC THEN EXISTS_TAC `b:real` THEN REPEAT STRIP_TAC THEN
  ASM_MESON_TAC[REAL_LE_TRANS; SETDIST_LE_DIST; MEMBER_NOT_EMPTY; IN_SING;
                DIST_SYM]);;

let SETDIST_SING_LE_HAUSDIST = prove
 (`!s t x:real^N.
        bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN
  ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_OR_THM; CONJ_ASSOC] THEN
  CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM dist] THEN GEN_TAC THENL
   [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN
  REPEAT STRIP_TAC THENL
   [UNDISCH_TAC `~(t:real^N->bool = {})`;
    UNDISCH_TAC `~(s:real^N->bool = {})`] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THENL
   [ALL_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN
  MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);;

let SETDIST_HAUSDIST_TRIANGLE = prove
 (`!s t u:real^N->bool.
        ~(t = {}) /\ bounded t /\ bounded u
        ==> setdist(s,u) <= setdist(s,t) + hausdist(t,u)`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN
  ASM_SIMP_TAC[SETDIST_EMPTY; REAL_LE_ADD; REAL_ADD_LID;
               SETDIST_POS_LE; HAUSDIST_POS_LE] THEN
  ONCE_REWRITE_TAC[REAL_ARITH `a <= b + c <=> a - c <= b`] THEN
  ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ; NOT_INSERT_EMPTY; IN_SING] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  REWRITE_TAC[REAL_LE_SUB_RADD] THEN
  TRANS_TAC REAL_LE_TRANS `setdist({x:real^N},u)` THEN
  ASM_SIMP_TAC[SETDIST_LE_SING] THEN
  MP_TAC(ISPECL [`u:real^N->bool`; `x:real^N`; `y:real^N`]
        SETDIST_SING_TRIANGLE) THEN
  MATCH_MP_TAC(REAL_ARITH
   `yu <= z ==> abs(xu - yu) <= d ==> xu <= d + z`) THEN
  MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]);;

let HAUSDIST_SETDIST_TRIANGLE = prove
 (`!s t u:real^N->bool.
        ~(t = {}) /\ bounded s /\ bounded t
        ==> setdist(s,u) <= hausdist(s,t) + setdist(t,u)`,
  ONCE_REWRITE_TAC[SETDIST_SYM; HAUSDIST_SYM] THEN
  ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
  SIMP_TAC[SETDIST_HAUSDIST_TRIANGLE]);;

let REAL_LT_HAUSDIST_POINT_EXISTS = prove
 (`!s t x:real^N d.
        bounded s /\ bounded t /\ ~(t = {}) /\ hausdist(s,t) < d /\ x IN s
        ==> ?y. y IN t /\ dist(x,y) < d`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`; `d:real`]
        REAL_SETDIST_LT_EXISTS) THEN
  REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN
  TRANS_TAC REAL_LET_TRANS `hausdist(s:real^N->bool,t)` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN
  ASM_REWRITE_TAC[]);;

let HAUSDIST_UNIFORMLY_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s.
        f uniformly_continuous_on s <=>
        !e. &0 < e
            ==> ?d. &0 < d /\
                    !t t'. t SUBSET s /\ t' SUBSET s /\
                           bounded t /\ bounded t' /\
                           hausdist(t',t) < d
                           ==> hausdist(IMAGE f t',IMAGE f t) < e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN EQ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `t':real^M->bool`] THEN
    STRIP_TAC THEN
    MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
    ASM_CASES_TAC `t:real^M->bool = {}` THEN
    ASM_SIMP_TAC[HAUSDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN
    ASM_CASES_TAC `t':real^M->bool = {}` THEN
    ASM_SIMP_TAC[HAUSDIST_EMPTY; IMAGE_CLAUSES; REAL_HALF; REAL_LT_IMP_LE] THEN
    MATCH_MP_TAC REAL_HAUSDIST_LE THEN
    ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
    CONJ_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THENL
     [MP_TAC(ISPECL [`t':real^M->bool`; `t:real^M->bool`; `x:real^M`; `d / &2`]
        REAL_LT_HAUSDIST_POINT_EXISTS);
      MP_TAC(ISPECL [`t:real^M->bool`; `t':real^M->bool`; `x:real^M`; `d / &2`]
        REAL_LT_HAUSDIST_POINT_EXISTS)] THEN
    ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `x:real^M`]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
    ASM_SIMP_TAC[REAL_ARITH `x < d / &2 /\ &0 < d ==> x < d`] THEN
    MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e / &2 ==> x <= e / &2`) THEN
    MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_SIMP_TAC[IN_SING; FUN_IN_IMAGE];
    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
    REWRITE_TAC[GSYM HAUSDIST_SINGS] THEN REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[SET_RULE `{f x} = IMAGE f {x}`] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[SING_SUBSET; BOUNDED_SING]]);;

let SUBSET_COMPACT_HAUSDIST_LIMIT = prove
 (`!f s t:real^N->bool.
        compact s /\ ~(s = {}) /\
        (!n. t SUBSET f n) /\ (!n. bounded(f n)) /\
        ((\n. lift(hausdist (f n,s))) --> vec 0) sequentially
        ==> t SUBSET s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN `setdist({x:real^N},s) = &0` MP_TAC THENL
   [GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`];
    ASM_SIMP_TAC[SETDIST_EQ_0_SING; CLOSURE_CLOSED; COMPACT_IMP_CLOSED]] THEN
  PURE_REWRITE_TAC[GSYM SETDIST_POS_LT] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC `setdist({x:real^N},s)`) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST; LE_REFL] THEN
  REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN
  ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[]);;

let UPPER_LOWER_HEMICONTINUOUS = prove
 (`!f:real^M->real^N->bool t s.
      (!x. x IN s ==> f(x) SUBSET t) /\
      (!u. open_in (subtopology euclidean t) u
           ==> open_in (subtopology euclidean s)
                       {x | x IN s /\ f(x) SUBSET u}) /\
      (!u. closed_in (subtopology euclidean t) u
           ==> closed_in (subtopology euclidean s)
                         {x | x IN s /\ f(x) SUBSET u})
      ==> !x e. x IN s /\ &0 < e /\ bounded(f x)
                ==> ?d. &0 < d /\
                        !x'. x' IN s /\ dist(x,x') < d
                             ==> hausdist(f x,f x') < e`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `(f:real^M->real^N->bool) x = {}` THENL
   [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`] o MATCH_MP
        UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o SPEC `t INTER ball(vec 0:real^N,r)` o
        CONJUNCT1 o CONJUNCT2) THEN
  SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[open_in] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN
  ASM_SIMP_TAC[SUBSET_INTER; IN_ELIM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
  X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x':real^M`)) THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN STRIP_TAC THEN
  ASM_CASES_TAC `(f:real^M->real^N->bool) x' = {}` THEN
  ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
  MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS;
                IN_SING; REAL_LT_IMP_LE]);;

let HAUSDIST_NONTRIVIAL = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
        ==> hausdist(s,t) =
            sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t})`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN
  ASM_SIMP_TAC[EMPTY_UNION; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN
  MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
  ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
                MEMBER_NOT_EMPTY; IN_SING]);;

let HAUSDIST_NONTRIVIAL_ALT = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
        ==> hausdist(s,t) = max (sup {setdist ({x},t) | x IN s})
                                (sup {setdist ({y},s) | y IN t})`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL] THEN
  MATCH_MP_TAC SUP_UNION THEN
  ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
  CONJ_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
  ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
                MEMBER_NOT_EMPTY; IN_SING]);;

let REAL_HAUSDIST_LE_EQ = prove
 (`!s t:real^N->bool b.
        ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t
        ==> (hausdist(s,t) <= b <=>
             (!x. x IN s ==> setdist({x},t) <= b) /\
             (!y. y IN t ==> setdist({y},s) <= b))`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL_ALT; REAL_MAX_LE] THEN
  BINOP_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x <= b) <=>
                             (!y. y IN {f x | x IN s} ==> y <= b)`] THEN
  MATCH_MP_TAC REAL_SUP_LE_EQ THEN
  ASM_REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
  ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
                MEMBER_NOT_EMPTY; IN_SING]);;

let HAUSDIST_UNION_LE = prove
 (`!s t u:real^N->bool.
        bounded s /\ bounded t /\ bounded u /\ ~(t = {}) /\ ~(u = {})
        ==> hausdist(s UNION t,s UNION u) <= hausdist(t,u)`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ; BOUNDED_UNION; EMPTY_UNION] THEN
  REWRITE_TAC[FORALL_IN_UNION] THEN
  SIMP_TAC[SETDIST_SING_IN_SET; IN_UNION; HAUSDIST_POS_LE] THEN
  ASM_SIMP_TAC[GSYM REAL_HAUSDIST_LE_EQ; BOUNDED_UNION; EMPTY_UNION] THEN
  CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL
   [TRANS_TAC REAL_LE_TRANS `setdist({x:real^N},u)`;
    TRANS_TAC REAL_LE_TRANS `setdist({x:real^N},t)`] THEN
  ASM_SIMP_TAC[SETDIST_SUBSET_RIGHT; SUBSET_UNION] THENL
   [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN
  MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN ASM_REWRITE_TAC[]);;

let HAUSDIST_INSERT_LE = prove
 (`!s t a:real^N.
        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
        ==> hausdist(a INSERT s,a INSERT t) <= hausdist(s,t)`,
  ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
  ASM_SIMP_TAC[HAUSDIST_UNION_LE; NOT_INSERT_EMPTY; BOUNDED_SING]);;

let HAUSDIST_COMPACT_EXISTS = prove
 (`!s t:real^N->bool.
        bounded s /\ compact t /\ ~(t = {})
        ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`]
        SETDIST_COMPACT_CLOSED) THEN
  ASM_SIMP_TAC[COMPACT_SING; COMPACT_IMP_CLOSED; NOT_INSERT_EMPTY] THEN
  REWRITE_TAC[IN_SING; UNWIND_THM2; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC REAL_LE_HAUSDIST THEN
  ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN
  CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
  ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
  REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
                MEMBER_NOT_EMPTY; IN_SING]);;

let HAUSDIST_TRIANGLE = prove
 (`!s t u:real^N->bool.
        bounded s /\ bounded t /\ bounded u /\ ~(t = {})
        ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`,
  ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN
  ONCE_REWRITE_TAC[GSYM(CONJUNCT2 HAUSDIST_CLOSURE)] THEN
  ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM CLOSURE_EQ_EMPTY] THEN
  REPEAT GEN_TAC THEN MAP_EVERY
   (fun t -> SPEC_TAC(mk_comb(`closure:(real^N->bool)->real^N->bool`,t),t))
   [`u:real^N->bool`; `t:real^N->bool`; `s:real^N->bool`] THEN
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_ADD_LID] THEN
  ASM_CASES_TAC `u:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_ADD_RID] THEN
  ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ; COMPACT_IMP_BOUNDED] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [HAUSDIST_SYM] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
   MAP_EVERY (fun t -> SPEC_TAC(t,t))
   [`u:real^N->bool`; `t:real^N->bool`; `s:real^N->bool`] THEN
  MATCH_MP_TAC(MESON[]
   `(!s t u. P s t u ==> P u t s) /\
    (!s t u. P s t u ==> Q s t u)
    ==> (!s t u. P s t u ==> Q s t u /\ Q u t s)`) THEN
  CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI]; REPEAT GEN_TAC THEN STRIP_TAC] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN `?y:real^N. y IN t /\ dist(x,y) <= hausdist(s,t)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN
  SUBGOAL_THEN `?z:real^N. z IN u /\ dist(y,z) <= hausdist(t,u)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
   `dist(y,z) <= b ==> dist(x,y) <= a /\ s <= dist(x,z) ==> s <= a + b`)) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
  ASM_REWRITE_TAC[IN_SING]);;

let HAUSDIST_COMPACT_SUMS = prove
 (`!s t:real^N->bool.
        bounded s /\ compact t /\ ~(t = {})
        ==> s SUBSET {y + z | y IN t /\ z IN cball(vec 0,hausdist(s,t))}`,
  REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN
  REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`;
              ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
  REWRITE_TAC[GSYM dist; HAUSDIST_COMPACT_EXISTS]);;

let HAUSDIST_SUMS_LE = prove
 (`!s t u v:real^N->bool.
        bounded s /\ bounded t /\ bounded u /\ bounded v
        ==> hausdist({x + y | x IN s /\ y IN t},{x + y | x IN u /\ y IN v})
            <= hausdist(s,u) + hausdist(t,v)`,
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[GSYM(CONJUNCT1 HAUSDIST_CLOSURE)] THEN
  ONCE_REWRITE_TAC[GSYM(CONJUNCT2 HAUSDIST_CLOSURE)] THEN
  SIMP_TAC[CLOSURE_SUMS] THEN
  ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE] THEN
  MAP_EVERY
  (fun t -> SPEC_TAC(mk_comb(`closure:(real^N->bool)->real^N->bool`,t),t))
  [`v:real^N->bool`; `u:real^N->bool`; `t:real^N->bool`; `s:real^N->bool`] THEN
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `{x + y:real^N | x IN s /\ y IN t} = {}` THEN
  ASM_SIMP_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_LE_ADD] THEN
  ASM_CASES_TAC `{x + y:real^N | x IN u /\ y IN v} = {}` THEN
  ASM_SIMP_TAC[HAUSDIST_EMPTY; HAUSDIST_POS_LE; REAL_LE_ADD] THEN
  MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
  CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
  STRIP_TAC THENL
   [MP_TAC(ISPECL [`t:real^N->bool`; `v:real^N->bool`]
      HAUSDIST_COMPACT_EXISTS) THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `u:real^N->bool`]
      HAUSDIST_COMPACT_EXISTS);
    MP_TAC(ISPECL [`v:real^N->bool`; `t:real^N->bool`]
      HAUSDIST_COMPACT_EXISTS) THEN
    MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`]
      HAUSDIST_COMPACT_EXISTS)] THEN
  ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
  (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `a:real^N`)]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
  (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(MP_TAC o SPEC `b:real^N`)]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THENL
   [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN
  TRANS_TAC REAL_LE_TRANS `dist(a + b:real^N,c + d)` THEN
  (CONJ_TAC THENL
    [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[];
     REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT])) THEN
     CONV_TAC NORM_ARITH]));;

let HAUSDIST_SUMS_LE_LCANCEL = prove
 (`!s t u:real^N->bool.
        bounded s /\ bounded t /\ bounded u
        ==> hausdist({x + y | x IN s /\ y IN t},{x + y | x IN s /\ y IN u})
            <= hausdist(t,u)`,
  REPEAT STRIP_TAC THEN
  W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_SUMS_LE o lhand o snd) THEN
  ASM_REWRITE_TAC[HAUSDIST_REFL; REAL_ADD_LID]);;

let HAUSDIST_SUMS_LE_RCANCEL = prove
 (`!s t u:real^N->bool.
        bounded s /\ bounded t /\ bounded u
        ==> hausdist({x + y | x IN s /\ y IN u},{x + y | x IN t /\ y IN u})
            <= hausdist(s,t)`,
  REPEAT STRIP_TAC THEN
  W(MP_TAC o PART_MATCH (lhand o rand) HAUSDIST_SUMS_LE o lhand o snd) THEN
  ASM_REWRITE_TAC[HAUSDIST_REFL; REAL_ADD_RID]);;

let HAUSDIST_EQ_0 = prove
 (`!s t:real^N->bool.
      bounded s /\ bounded t
      ==> (hausdist(s,t) = &0 <=> s = {} \/ t = {} \/ closure s = closure t)`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
  ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE; REAL_HAUSDIST_LE_EQ] THEN
  SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN
  ASM_REWRITE_TAC[SETDIST_EQ_0_SING; GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN
  SIMP_TAC[FORALL_IN_CLOSURE_EQ; CLOSED_CLOSURE; CONTINUOUS_ON_ID]);;

let HAUSDIST_COMPACT_NONTRIVIAL = prove
 (`!s t:real^N->bool.
        compact s /\ compact t /\ ~(s = {}) /\ ~(t = {})
        ==> hausdist(s,t) =
            inf {e | &0 <= e /\
                   s SUBSET {x + y | x IN t /\ norm y <= e} /\
                   t SUBSET {x + y | x IN s /\ norm y <= e}}`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC REAL_INF_UNIQUE THEN
  REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
  REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`;
              ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
  REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC REAL_HAUSDIST_LE THEN
    ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS;
                  IN_SING; REAL_LT_IMP_LE];
    REPEAT STRIP_TAC THEN EXISTS_TAC `hausdist(s:real^N->bool,t)` THEN
    ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN
    ASM_MESON_TAC[DIST_SYM; HAUSDIST_SYM;
                  HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]]);;

let HAUSDIST_BALLS = prove
 (`(!a b:real^N r s.
        hausdist(ball(a,r),ball(b,s)) =
        if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\
   (!a b:real^N r s.
        hausdist(ball(a,r),cball(b,s)) =
        if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\
   (!a b:real^N r s.
        hausdist(cball(a,r),ball(b,s)) =
        if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\
   (!a b:real^N r s.
        hausdist(cball(a,r),cball(b,s)) =
        if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))`,
  REWRITE_TAC[MESON[]
   `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN
  SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
  SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; HAUSDIST_EMPTY; DE_MORGAN_THM] THEN
  ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE]
   `hausdist(s,t) = hausdist(closure s,closure t)`] THEN
  SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN
  REWRITE_TAC[HAUSDIST_CLOSURE] THEN
  MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN
  CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC] THEN
  ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; BOUNDED_CBALL; CBALL_EQ_EMPTY;
               REAL_NOT_LT] THEN
  MATCH_MP_TAC SUP_UNIQUE THEN
  REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN
  REWRITE_TAC[MESON[CBALL_SING] `{a} = cball(a:real^N,&0)`] THEN
  ASM_REWRITE_TAC[SETDIST_BALLS; REAL_LT_REFL] THEN
  X_GEN_TAC `c:real` THEN REWRITE_TAC[IN_CBALL] THEN
  EQ_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN
  ASM_CASES_TAC `b:real^N = a` THENL
   [ASM_REWRITE_TAC[DIST_SYM; DIST_REFL; REAL_MAX_LE] THEN
    DISCH_THEN(CONJUNCTS_THEN2
     (MP_TAC o SPEC `a + r % basis 1:real^N`)
     (MP_TAC o SPEC `a + s % basis 1:real^N`)) THEN
    REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
    SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
    ASM_REAL_ARITH_TAC;
    DISCH_THEN(CONJUNCTS_THEN2
     (MP_TAC o SPEC `a - r / dist(a,b) % (b - a):real^N`)
     (MP_TAC o SPEC `b - s / dist(a,b) % (a - b):real^N`)) THEN
    REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN
    REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH
     `b - e % (a - b) - a:real^N = (&1 + e) % (b - a)`] THEN
    ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
    REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN
    REWRITE_TAC[NORM_SUB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN
    ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
    ASM_REAL_ARITH_TAC]);;

let HAUSDIST_ALT = prove
 (`!s t:real^N->bool.
        bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
        ==> hausdist(s,t) =
            sup {abs(setdist({x},s) - setdist({x},t)) | x IN (:real^N)}`,
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM(CONJUNCT2 SETDIST_CLOSURE);
    GSYM CLOSURE_EQ_EMPTY; MESON[HAUSDIST_CLOSURE]
    `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN
  SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN
  SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; COMPACT_IMP_BOUNDED] THEN
  MATCH_MP_TAC SUP_EQ THEN
  REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC; IN_UNIV] THEN
  REWRITE_TAC[REAL_ARITH `abs(y - x) <= b <=> x <= y + b /\ y <= x + b`] THEN
  GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN BINOP_TAC THEN
  (EQ_TAC THENL [ALL_TAC; MESON_TAC[SETDIST_SING_IN_SET; REAL_ADD_LID]]) THEN
  DISCH_TAC THEN X_GEN_TAC `z:real^N` THENL
   [MP_TAC(ISPECL[`{z:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT);
    MP_TAC(ISPECL[`{z:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN
  ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN
  REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL
   [MP_TAC(ISPECL[`{y:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT);
    MP_TAC(ISPECL[`{y:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN
  ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN
  REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
  DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  TRANS_TAC REAL_LE_TRANS `dist(z:real^N,x)` THEN
  ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN
  UNDISCH_TAC `dist(y:real^N,x) <= b` THEN CONV_TAC NORM_ARITH);;

let DIAMETERS_HAUSDIST_BOUND = prove
 (`!s t:real^N->bool.
        bounded s /\ ~(s = {}) /\ bounded t /\ ~(t = {})
        ==> abs(diameter s - diameter t) <= &2 * hausdist(s,t)`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIAMETER_CLOSURE] THEN
  MP_TAC(ISPECL [`vec 0:real^N`; `hausdist(s:real^N->bool,t)`]
    DIAMETER_CBALL) THEN
  ASM_SIMP_TAC[HAUSDIST_POS_LE; GSYM REAL_NOT_LE] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH
   `x <= y + e /\ y <= x + e ==> abs(x - y) <= e`) THEN
  CONJ_TAC THEN
  W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN
  ASM_SIMP_TAC[BOUNDED_CBALL; BOUNDED_CLOSURE] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
  MATCH_MP_TAC DIAMETER_SUBSET THEN
  ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL; BOUNDED_CLOSURE] THEN
  ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE]
   `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`]
  THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN
  MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN
  ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY]);;

let CONTINUOUS_DIAMETER = prove
 (`!s:real^N->bool e.
        bounded s /\ ~(s = {}) /\ &0 < e
        ==> ?d. &0 < d /\
                !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d
                    ==> abs(diameter s - diameter t) < e`,
  REPEAT STRIP_TAC THEN EXISTS_TAC `e / &2` THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN
  TRANS_TAC REAL_LET_TRANS `&2 * hausdist(s:real^N->bool,t)` THEN
  ASM_SIMP_TAC[DIAMETERS_HAUSDIST_BOUND] THEN ASM_REAL_ARITH_TAC);;

let CONNECTED_HAUSDIST_LIMIT = prove
 (`!s k:real^N->bool.
        (!n. bounded(s n) /\ connected(s n) /\ ~(s n = {})) /\
        compact k /\ ((\n. lift (hausdist(s n,k))) --> vec 0) sequentially
        ==> connected k`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN
  ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `compact(k1:real^N->bool) /\ compact(k2:real^N->bool)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET];
    ALL_TAC] THEN
  ABBREV_TAC `e = setdist(k1:real^N->bool,k2)` THEN
  SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
   [EXPAND_TAC "e" THEN REWRITE_TAC[SETDIST_POS_LT] THEN
    ASM_SIMP_TAC[SETDIST_EQ_0_CLOSED_COMPACT; COMPACT_IMP_CLOSED];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[LE_REFL; DIST_1; DROP_VEC; LIFT_DROP; REAL_SUB_RZERO] THEN
  REWRITE_TAC[real_abs; HAUSDIST_POS_LE] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC `n:num`) THEN
  REWRITE_TAC[connected] THEN
  MAP_EVERY EXISTS_TAC
   [`{x + y:real^N | x IN k1 /\ y IN ball(vec 0,e / &2)}`;
    `{x + y:real^N | x IN k2 /\ y IN ball(vec 0,e / &2)}`] THEN
  SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN CONJ_TAC THENL
   [ASM_REWRITE_TAC[SET_RULE
     `{f x y | x IN s /\ y IN t} UNION {f x y | x IN s' /\ y IN t} =
      {f x y | x IN s UNION s' /\  y IN t}`] THEN
    MP_TAC(ISPECL [`(s:num->real^N->bool) n`; `k:real^N->bool`]
     HAUSDIST_COMPACT_SUMS) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(SET_RULE
     `t SUBSET u
      ==> s SUBSET {f x y | x IN k /\ y IN t}
          ==> s SUBSET {f x y | x IN k /\ y IN u}`) THEN
    REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(SET_RULE
      `(!x y a b. (x IN s /\ y IN t) /\ a IN u /\ b IN u ==> ~(f x a = f y b))
       ==> {f x a | x IN s /\ a IN u} INTER {f x a | x IN t /\ a IN u}
           INTER v = {}`) THEN
    REPEAT GEN_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[IN_BALL_0] THEN MATCH_MP_TAC(NORM_ARITH
     `e <= dist(x:real^N,y)
      ==> norm a < e / &2 /\ norm b < e / &2 ==> ~(x + a = y + b)`) THEN
    ASM_MESON_TAC[SETDIST_LE_DIST];
    ALL_TAC] THEN
  CONJ_TAC THEN
  REWRITE_TAC[SET_RULE `~(s INTER t = {}) <=> ?x. x IN s /\ x IN t`] THEN
  REWRITE_TAC[EXISTS_IN_GSPEC; IN_BALL_0] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `~(k = {})
    ==> (!x. x IN k ==> ?y. R x y /\ P y)
        ==> ?x y. (x IN k /\ P y) /\ R x y`)) THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC(MESON[] `!x:real^N. (?y. P(y - x)) ==> ?y. P y`) THEN
  EXISTS_TAC `x:real^N` THEN REWRITE_TAC[VECTOR_SUB_ADD2] THEN
  REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
  MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN
  EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
  ASM SET_TAC[]);;

let HAUSDIST_COMPACT_INTERS_LIMIT = prove
 (`!s:num->(real^N->bool).
        (!n. compact(s n)) /\ (!n. s(SUC n) SUBSET s n)
        ==> ((\n. lift(hausdist(s n,INTERS {s i | i IN (:num)}))) --> vec 0)
            sequentially`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `!m n. m <= n ==> (s:num->real^N->bool) n SUBSET s m`
  ASSUME_TAC THENL
   [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `?n. (s:num->real^N->bool) n = {}` THENL
   [FIRST_X_ASSUM(X_CHOOSE_TAC `N:num`) THEN
    MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
    EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    SUBGOAL_THEN `(s:num->real^N->bool) n = {}` SUBST1_TAC THENL
     [ASM SET_TAC[]; REWRITE_TAC[HAUSDIST_EMPTY; LIFT_NUM]];
    RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN
  REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `?r:num->num.
        (!n. e <= hausdist(s(r n):real^N->bool,INTERS {s i | i IN (:num)})) /\
        (!n. r n < r (SUC n))`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
     [ALL_TAC; REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
    DISCH_THEN(MP_TAC o SPEC `n + 1`) THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `m:num` THEN REWRITE_TAC[DIST_0; NORM_LIFT] THEN
    SIMP_TAC[real_abs; HAUSDIST_POS_LE; REAL_NOT_LT] THEN ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!n:num. ?x:real^N.
        x IN s(r n) /\ e / &2 <= setdist({x},INTERS {s i | i IN (:num)})`
  MP_TAC THENL
   [GEN_TAC THEN
    MP_TAC(ISPECL [`(s:num->real^N->bool)(r(n:num))`;
                   `INTERS {s i | i IN (:num)}:real^N->bool`; `e / &2`]
       REAL_HAUSDIST_LE) THEN
    ASM_SIMP_TAC[COMPACT_NEST] THEN
    ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ e <= x ==> ~(x <= e / &2)`] THEN
    REWRITE_TAC[TAUT `~(p /\ q) <=> q ==> ~p`] THEN
    ANTS_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_TOTAL]] THEN
    SIMP_TAC[SETDIST_SING_IN_SET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
    ASM_REAL_ARITH_TAC;
    REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC)] THEN
  MP_TAC(ISPEC `s 0:real^N->bool` compact) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN ANTS_TAC THENL
   [ASM_MESON_TAC[SUBSET; LE_0]; REWRITE_TAC[NOT_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`y:real^N`; `k:num->num`] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN REWRITE_TAC[NOT_IMP] THEN
  CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[LE_REFL; REAL_NOT_LT; o_THM] THEN TRANS_TAC REAL_LE_TRANS
   `setdist({(x:num->real^N)(k(n:num))}, INTERS {s i | i IN (:num)})` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
  REWRITE_TAC[IN_SING; INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
  X_GEN_TAC `n:num` THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC `setdist({y},(s:num->real^N->bool) n)`) THEN
  ASM_SIMP_TAC[SETDIST_POS_LT; SETDIST_EQ_0_CLOSED; COMPACT_IMP_CLOSED] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `MAX N n`)) THEN
  REWRITE_TAC[o_THM; NOT_IMP; REAL_NOT_LT] THEN
  CONJ_TAC THENL [ARITH_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN
  MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_SING] THEN
  MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN
  EXISTS_TAC `(s:num->real^N->bool)((r:num->num)(k(MAX N n)))` THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  TRANS_TAC LE_TRANS `MAX N n` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN
  SPEC_TAC(`MAX N n`,`m:num`) THEN X_GEN_TAC `m:num` THEN
  TRANS_TAC LE_TRANS `(k:num->num) m` THEN ASM_SIMP_TAC[MONOTONE_BIGGER] THEN
  SPEC_TAC(`(k:num->num) m`,`p:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN
  MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Hausdorff metric inherits completeness, total boundedness, compactness.   *)
(* ------------------------------------------------------------------------- *)

let COMPLETE_HAUSDIST_UNIV = prove
 (`!f:num->(real^N->bool).
        (!n. bounded(f n) /\ ~(f n = {})) /\
        (!e. &0 < e
             ==> ?N. !m n. m >= N /\ n >= N ==> hausdist(f m,f n) < e)
        ==> ?s. compact s /\ ~(s = {}) /\
                ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`,
  SUBGOAL_THEN
   `!f:num->(real^N->bool).
        (!n. bounded(f n) /\ ~(f n = {})) /\
        (!m n. m <= n ==> hausdist(f m,f n) < inv(&2 pow m))
        ==> ?s. bounded s /\ ~(s = {}) /\
                ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`
  ASSUME_TAC THENL
   [ALL_TAC;
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(MESON[] `(?s. P(closure s)) ==> ?s. P s`) THEN
    REWRITE_TAC[COMPACT_CLOSURE; HAUSDIST_CLOSURE; CLOSURE_EQ_EMPTY] THEN
    FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
    SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN
    DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN
    SUBGOAL_THEN
     `?r:num->num.
          (!n. N n <= r n) /\ (!n. r(n) < r(SUC n))`
    STRIP_ASSUME_TAC THENL
     [MATCH_MP_TAC DEPENDENT_CHOICE THEN
      REWRITE_TAC[ARITH_RULE `a <= x /\ b < x <=> MAX a (SUC b) <= x`] THEN
      MESON_TAC[LE_REFL];
      FIRST_X_ASSUM(MP_TAC o SPEC
       `(f:num->(real^N->bool)) o (r:num->num)`) THEN
      ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL
       [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE] THEN
        SUBGOAL_THEN `!i j. i <= j ==> (r:num->num) i <= r j`
         (fun th -> ASM_MESON_TAC[LE_TRANS; th]) THEN
        MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
        ASM_SIMP_TAC[LT_IMP_LE] THEN ARITH_TAC;
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N->bool` THEN
        STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (ONCE_REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN
        MATCH_MP_TAC LIM_NULL_COMPARISON THEN
        EXISTS_TAC `\n. hausdist((f:num->(real^N->bool)) n,f(r n))` THEN
        REWRITE_TAC[] THEN CONJ_TAC THENL
         [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN
          REWRITE_TAC[GSYM dist; DIST_LIFT] THEN
          REWRITE_TAC[REAL_ARITH
            `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN
          CONJ_TAC THENL
           [GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [HAUSDIST_SYM];
            ALL_TAC] THEN
          MATCH_MP_TAC HAUSDIST_TRIANGLE THEN ASM_REWRITE_TAC[];
          REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN
          REWRITE_TAC[NORM_LIFT; REAL_ABS_HAUSDIST] THEN
          X_GEN_TAC `e:real` THEN DISCH_TAC THEN
          MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
          ASM_REWRITE_TAC[REAL_POW_INV] THEN
          CONV_TAC REAL_RAT_REDUCE_CONV THEN
          DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN
          EXISTS_TAC `(N:num->num) M` THEN
          X_GEN_TAC `n:num` THEN DISCH_TAC THEN
          TRANS_TAC REAL_LT_TRANS `inv(&2 pow M)` THEN
          ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
          MATCH_MP_TAC(ARITH_RULE
           `a:num <= n /\ n <= r ==> n >= a /\ r >= a`) THEN
          ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:num`,`n:num`) THEN
          MATCH_MP_TAC MONOTONE_BIGGER THEN
          MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN
          ASM_REWRITE_TAC[LT_TRANS]]]]] THEN
  REPEAT STRIP_TAC THEN ABBREV_TAC
   `s:real^N->bool =
    {l | ?x:num->real^N.
                (!n. x n IN f n) /\
                (!n. dist(x n,x(SUC n)) < inv(&2 pow n)) /\
                (x --> l) sequentially}` THEN
  EXISTS_TAC `s:real^N->bool` THEN
  SUBGOAL_THEN
   `!n. f n SUBSET {x + y:real^N | x IN s /\ y IN cball(vec 0,&2 / &2 pow n)}`
  ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `?x. x k:real^N = a /\
          (!n. x n IN f n) /\
          (!n. dist(x n,x (SUC n)) < inv(&2 pow n))`
    STRIP_ASSUME_TAC THENL
     [SUBGOAL_THEN
       `?y. y 0 = a /\
            (!n. y n IN f(k + n)) /\
            (!n. dist(y n:real^N,y(SUC n)) < inv(&2 pow (k + n)))`
      STRIP_ASSUME_TAC THENL
       [MATCH_MP_TAC DEPENDENT_CHOICE_FIXED THEN
        ASM_REWRITE_TAC[ADD_CLAUSES] THEN
        MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN DISCH_TAC THEN
        MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN
        EXISTS_TAC `(f:num->(real^N->bool)) (k + n)` THEN
        ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
        ALL_TAC] THEN
      SUBGOAL_THEN
       `?z. z 0 = a /\
            (!n. z n IN f(k - n)) /\
            (!n. dist(z n:real^N,z(SUC n)) < inv(&2 pow (k - SUC n)))`
      STRIP_ASSUME_TAC THENL
       [MATCH_MP_TAC DEPENDENT_CHOICE_FIXED THEN ASM_REWRITE_TAC[SUB_0] THEN
        MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN DISCH_TAC THEN
        ASM_CASES_TAC `k:num <= n` THENL
         [EXISTS_TAC `x:real^N` THEN
          ASM_REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
          ASM_MESON_TAC[ARITH_RULE `k <= n ==> k - SUC n = k - n`];
          MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN
          EXISTS_TAC `(f:num->(real^N->bool)) (k - n)` THEN
          ASM_REWRITE_TAC[] THEN
          ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN
          FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC];
        ALL_TAC] THEN
      EXISTS_TAC
       `\n. if k <= n then (y:num->real^N)(n - k) else z(k - n)` THEN
      ASM_REWRITE_TAC[LE_REFL; SUB_REFL] THEN
      CONJ_TAC THEN X_GEN_TAC `n:num` THENL
       [ASM_MESON_TAC[ARITH_RULE
         `(k:num <= n ==> k + (n - k) = n) /\
          (~(k <= n) ==> k - (k - n) = n)`];
        ALL_TAC] THEN
      ASM_CASES_TAC `SUC n = k` THEN ASM_REWRITE_TAC[LE_REFL] THENL
       [ASM_SIMP_TAC[ARITH_RULE `SUC n = k ==> ~(k <= n)`; SUB_REFL] THEN
        ASM_SIMP_TAC[ARITH_RULE `SUC n = k ==> k - n = SUC 0`] THEN
        SUBST1_TAC(SYM(ASSUME `(z:num->real^N) 0 = a`)) THEN
        ONCE_REWRITE_TAC[DIST_SYM] THEN
        FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE
         `SUC n = k ==> n = k - SUC 0`)) THEN
        ASM_REWRITE_TAC[];
        SUBGOAL_THEN `k <= SUC n <=> k <= n` SUBST1_TAC THENL
         [ASM_ARITH_TAC; ALL_TAC]] THEN
       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
        [ASM_SIMP_TAC[ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`] THEN
         ASM_MESON_TAC[ARITH_RULE `k:num <= n ==> k + n - k = n`];
         ASM_SIMP_TAC[ARITH_RULE `~(k <= n) ==> k - n = SUC(k - SUC n)`] THEN
         ONCE_REWRITE_TAC[DIST_SYM] THEN
         ASM_MESON_TAC[ARITH_RULE `~(k <= n) ==> k - SUC(k - SUC n) = n`]];
      ALL_TAC] THEN
    SUBGOAL_THEN `cauchy(x:num->real^N)` MP_TAC THENL
     [MATCH_MP_TAC ABSOLUTELY_SUMMABLE_IMP_CAUCHY THEN
      REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
      MATCH_MP_TAC SUMMABLE_COMPARISON THEN
      EXISTS_TAC `\n. inv(&2 pow n)` THEN
      ASM_SIMP_TAC[NORM_LIFT; REAL_ABS_DIST; REAL_LT_IMP_LE] THEN
      REWRITE_TAC[REAL_INV_POW; o_DEF] THEN
      MATCH_MP_TAC SUMMABLE_REAL_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV;
      REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN
    ONCE_REWRITE_TAC[CONJ_SYM] THEN
    REWRITE_TAC[VECTOR_ARITH `l:real^N = x + y <=> y = l - x`] THEN
    REWRITE_TAC[UNWIND_THM2] THEN ASM_REWRITE_TAC[IN_CBALL_0] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
    EXISTS_TAC `\n. a - (x:num->real^N) n` THEN
    ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY; LIM_CONST] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
    EXISTS_TAC `k + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
    SUBST1_TAC(SYM(ASSUME `(x:num->real^N) k = a`)) THEN
    TRANS_TAC REAL_LE_TRANS
      `norm(vsum (k..m - 1) (\i. (x:num->real^N)(i + 1) - x i))` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[VSUM_DIFFS_ALT] THEN FIRST_ASSUM(fun th ->
        REWRITE_TAC[MATCH_MP
         (ARITH_RULE `k + 1 <= m ==> m - 1 + 1 = m /\ k <= m - 1`) th]) THEN
      CONV_TAC NORM_ARITH;
      MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG]] THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
    TRANS_TAC REAL_LE_TRANS `sum (k..m-1) (\i. inv(&2 pow i))` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_LE_NUMSEG THEN
      ASM_SIMP_TAC[GSYM ADD1; REAL_LT_IMP_LE];
      ALL_TAC] THEN
    REWRITE_TAC[REAL_INV_POW; SUM_GP] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    MATCH_MP_TAC(REAL_ARITH
     `x <= inv y ==> x / (&1 / &2) <= &2 / y`) THEN
    REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE] THEN REWRITE_TAC[real_div] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 * y - &1 * x <= y`) THEN
    REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN
    REWRITE_TAC[REAL_POS];
    ALL_TAC] THEN
  MATCH_MP_TAC(TAUT `q /\ (q ==> p /\ r) ==> p /\ q /\ r`) THEN CONJ_TAC THENL
   [ASM SET_TAC[]; DISCH_TAC] THEN
  SUBGOAL_THEN
   `!n. s SUBSET {x + y:real^N | x IN f n /\ y IN cball(vec 0,&2 / &2 pow n)}`
  ASSUME_TAC THENL
   [X_GEN_TAC `n:num` THEN EXPAND_TAC "s" THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `l:real^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN
    ONCE_REWRITE_TAC[CONJ_SYM] THEN
    REWRITE_TAC[VECTOR_ARITH `l:real^N = x + y <=> y = l - x`] THEN
    REWRITE_TAC[UNWIND_THM2] THEN EXISTS_TAC `(x:num->real^N) n` THEN
    ASM_REWRITE_TAC[IN_CBALL_0] THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
    EXISTS_TAC `\m. (x:num->real^N) m - x n` THEN
    ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY; LIM_CONST] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
    EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
    TRANS_TAC REAL_LE_TRANS
      `norm(vsum (n..m - 1) (\i. (x:num->real^N)(i + 1) - x i))` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[VSUM_DIFFS_ALT] THEN FIRST_ASSUM(fun th ->
        REWRITE_TAC[MATCH_MP
         (ARITH_RULE `n + 1 <= m ==> m - 1 + 1 = m /\ n <= m - 1`) th]) THEN
      REWRITE_TAC[REAL_LE_REFL];
      MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG]] THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
    TRANS_TAC REAL_LE_TRANS `sum (n..m-1) (\i. inv(&2 pow i))` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_LE_NUMSEG THEN
      ASM_SIMP_TAC[GSYM ADD1; REAL_LT_IMP_LE];
      ALL_TAC] THEN
    REWRITE_TAC[REAL_INV_POW; SUM_GP] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    MATCH_MP_TAC(REAL_ARITH
     `x <= inv y ==> x / (&1 / &2) <= &2 / y`) THEN
    REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE] THEN REWRITE_TAC[real_div] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 * y - &1 * x <= y`) THEN
    REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN
    REWRITE_TAC[REAL_POS];
    ALL_TAC] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC `{x + y:real^N | x IN f n /\
                                y IN cball(vec 0,&2 / &2 pow n)}` THEN
    ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL];
    DISCH_TAC] THEN
  REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`inv(&2)`; `e / &2`] REAL_ARCH_POW_INV) THEN
  ASM_REWRITE_TAC[REAL_POW_INV; REAL_HALF] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
    `inv i < e / &2 ==> x <= &2 / i ==> x < e`)) THEN
  TRANS_TAC REAL_LE_TRANS `&2 / &2 pow m` THEN CONJ_TAC THENL
   [MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN ASM_REWRITE_TAC[];
    REWRITE_TAC[REAL_ARITH `&2 / x <= &2 / y <=> inv x <= inv y`] THEN
    MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN
    MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV]);;

let COMPLETE_HAUSDIST = prove
 (`!f:num->(real^N->bool) c.
        closed c /\
        (!n. bounded(f n) /\ ~(f n = {}) /\ f n SUBSET c) /\
        (!e. &0 < e
             ==> ?N. !m n. m >= N /\ n >= N ==> hausdist(f m,f n) < e)
        ==> ?s. compact s /\ ~(s = {}) /\ s SUBSET c /\
                ((\n. lift(hausdist(f n,s))) --> vec 0) sequentially`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `f:num->(real^N->bool)` COMPLETE_HAUSDIST_UNIV) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CLOSURE_CLOSED) THEN
  REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[LE_REFL; DIST_0; NORM_LIFT; REAL_ABS_HAUSDIST] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN
   `?y. y IN (f:num->(real^N->bool)) n /\ dist(y,x) < e`
  MP_TAC THENL [ONCE_REWRITE_TAC[DIST_SYM]; ASM SET_TAC[]] THEN
  MATCH_MP_TAC REAL_LT_HAUSDIST_POINT_EXISTS THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
  ASM_MESON_TAC[HAUSDIST_SYM]);;

let TOTALLY_BOUNDED_HAUSDIST = prove
 (`!s:real^N->bool e.
        bounded s /\ &0 < e
        ==> ?k. FINITE k /\
                (!u. u IN k ==> ~(u = {}) /\ u SUBSET s) /\
                (!t. t SUBSET s /\ ~(t = {})
                     ==> ?u. u IN k /\ hausdist(t,u) < e)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `closure s:real^N->bool` COMPACT_IMP_TOTALLY_BOUNDED) THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN
  ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC
   `{s INTER {x + y:real^N | x IN c /\ y IN ball(vec 0,e / &4)} | c SUBSET k}
    DELETE {}` THEN
  REWRITE_TAC[FORALL_IN_GSPEC; IN_DELETE; IMP_CONJ; INTER_SUBSET] THEN
  REWRITE_TAC[FINITE_DELETE; GSYM CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
  ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE; EXISTS_IN_IMAGE] THEN
  X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN
  REPEAT DISCH_TAC THEN
  EXISTS_TAC `{x:real^N | x IN k /\ ~(ball(x,e / &4) INTER t = {})}` THEN
  REWRITE_TAC[SUBSET_RESTRICT; IN_ELIM_THM] THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC[SET_RULE
     `~(s INTER t = {}) <=> ?x. x IN t /\ x IN s`] THEN
    REWRITE_TAC[EXISTS_IN_GSPEC] THEN
    SUBGOAL_THEN `?x:real^N. x IN t` STRIP_ASSUME_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE
     `closure s SUBSET u
      ==> !x. x IN t /\ t SUBSET s /\ s SUBSET closure s ==> x IN u`)) THEN
    ASM_REWRITE_TAC[CLOSURE_SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_BALL_0]] THEN
    SUBGOAL_THEN `(y:real^N) IN closure s` MP_TAC THENL
     [ASM SET_TAC[]; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN
    DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `z - y:real^N` THEN ASM_REWRITE_TAC[GSYM dist; VECTOR_SUB_ADD2];
    ALL_TAC] THEN
  MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
  ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[HAUSDIST_EMPTY; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
    `closure s SUBSET t ==> ~(closure s = {}) ==> ~(t = {})`)) THEN
  ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; EMPTY_UNIONS; FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_ARITH `&0 < e ==> ~(e / &4 <= &0)`] THEN
  REWRITE_TAC[NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN
  ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
   [ONCE_REWRITE_TAC[SET_RULE
     `~(s INTER t = {}) <=> ?x. x IN t /\ x IN s`] THEN
    REWRITE_TAC[EXISTS_IN_GSPEC] THEN
    SUBGOAL_THEN `?x:real^N. x IN t` STRIP_ASSUME_TAC THENL
     [ASM SET_TAC[]; ALL_TAC];
    REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
        MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
    REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_CBALL; GSYM CONJ_ASSOC] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC];
    REWRITE_TAC[SET_RULE
     `s INTER t SUBSET u <=> !x. x IN t ==> x IN s ==> x IN u`] THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL; DIST_0] THEN
    MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
     `~(s INTER t = {}) ==> ?x. x IN t /\ x IN s`)) THEN
    REWRITE_TAC[IN_CBALL_0; IN_BALL] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
    REWRITE_TAC[VECTOR_ARITH `x:real^N = z + w <=> x - z = w`] THEN
    REWRITE_TAC[UNWIND_THM1] THEN
    MAP_EVERY UNDISCH_TAC
     [`norm(y:real^N) < e / &4`; `dist(x:real^N,z) < e / &4`] THEN
    CONV_TAC NORM_ARITH] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE
   `closure s SUBSET u
    ==> !x. x IN t /\ t SUBSET s /\ s SUBSET closure s ==> x IN u`)) THEN
  ASM_REWRITE_TAC[CLOSURE_SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
  REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  EXISTS_TAC `x - y:real^N` THEN REWRITE_TAC[VECTOR_SUB_ADD2] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_BALL; DIST_0] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN
  ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
  EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_BALL]);;

let COMPACT_HAUSDIST = prove
 (`!f:num->(real^N->bool) c.
        compact c /\ (!n. ~(f n = {}) /\ f n SUBSET c)
        ==> ?r s. (!m n. m < n ==> r m < r n) /\
                  compact s /\ ~(s = {}) /\ s SUBSET c /\
                  ((\n. lift(hausdist(f(r n),s))) --> vec 0) sequentially`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?r. (!n. INFINITE {i | hausdist(f(r n),f i) < inv(&2 pow n)}) /\
        (!n. r n < r(SUC n) /\
             hausdist((f:num->(real^N->bool))(r n),f(r(SUC n)))
             < inv(&2 pow n))`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
     [MP_TAC(ISPECL [`c:real^N->bool`; `&1 / &2`]
        TOTALLY_BOUNDED_HAUSDIST) THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
      DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN
       `UNIONS
         {{i | hausdist((f:num->(real^N->bool)) i,u) < &1 / &2} | u IN k} =
        (:num)`
      MP_TAC THENL
       [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
        DISCH_THEN(MP_TAC o MATCH_MP (MESON[INFINITE; num_INFINITE]
         `s = (:num) ==> ~FINITE s`))] THEN
      REWRITE_TAC[FINITE_UNIONS] THEN
      ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
      REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM INFINITE] THEN
      DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        INFINITE_SUPERSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
      GEN_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
       `x < &1 / &2 ==> z <= x + y ==> y < &1 / &2 ==> z < &1`)) THEN
      GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [HAUSDIST_SYM] THEN
      MATCH_MP_TAC HAUSDIST_TRIANGLE THEN
      ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET];
      ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`c:real^N->bool`; `inv(&2 pow (n + 2))`]
        TOTALLY_BOUNDED_HAUSDIST) THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
    DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `INFINITE
        (UNIONS
          {{i | hausdist (f m,f i) < inv(&2 pow n) /\ m < i /\
                 hausdist((f:num->(real^N->bool)) i,u) < inv(&2 pow (n + 2))}
           | u IN k})`
    MP_TAC THENL
     [FIRST_ASSUM(MP_TAC o SPEC `0..m` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
       INFINITE_DIFF_FINITE)) THEN
      REWRITE_TAC[FINITE_NUMSEG] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INFINITE_SUPERSET) THEN
      REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN
      REWRITE_TAC[LE_0; NOT_LE] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    REWRITE_TAC[INFINITE; FINITE_UNIONS] THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM INFINITE] THEN
    FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [INFINITE]) THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      INFINITE_SUPERSET)) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    X_GEN_TAC `q:num` THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
     `x < n2 ==> inv(&2) * n1 = n2 /\ z <= x + y ==> y < n2 ==> z < n1`)) THEN
    REWRITE_TAC[GSYM REAL_INV_MUL; GSYM(CONJUNCT2 real_pow)] THEN
    REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN
    GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [HAUSDIST_SYM] THEN
    MATCH_MP_TAC HAUSDIST_TRIANGLE THEN
    ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET];
    ALL_TAC] THEN
  EXISTS_TAC `r:num->num` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS];
    MATCH_MP_TAC COMPLETE_HAUSDIST] THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
  ASM_REWRITE_TAC[REAL_POW_INV; GE] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN
  MATCH_MP_TAC WLOG_LT THEN ASM_REWRITE_TAC[HAUSDIST_REFL] THEN
  CONJ_TAC THENL [MESON_TAC[HAUSDIST_SYM]; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN
  TRANS_TAC REAL_LET_TRANS
    `sum(m..n-1) (\i. hausdist((f:num->real^N->bool)(r(i + 1)),f(r i)))` THEN
  CONJ_TAC THENL
   [FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o
        GEN_REWRITE_RULE I [LT_EXISTS]) THEN
    REWRITE_TAC[ARITH_RULE `(m + SUC d) - 1 = m + d`] THEN
    SPEC_TAC(`d:num`,`d:num`) THEN MATCH_MP_TAC num_INDUCTION THEN
    REWRITE_TAC[ADD_CLAUSES; SUM_CLAUSES_NUMSEG; NUMSEG_SING; SUM_SING] THEN
    CONJ_TAC THENL [MESON_TAC[ADD1; REAL_LE_REFL; HAUSDIST_SYM]; ALL_TAC] THEN
    X_GEN_TAC `d:num` THEN REWRITE_TAC[ARITH_RULE `m <= SUC(m + d)`] THEN
    MATCH_MP_TAC(REAL_ARITH `h' <= h + e ==> h <= d ==> h' <= d + e`) THEN
    REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN
    GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [HAUSDIST_SYM] THEN
    MATCH_MP_TAC HAUSDIST_TRIANGLE THEN
    ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED];
    ALL_TAC] THEN
  TRANS_TAC REAL_LET_TRANS `sum (m..n-1) (\i. inv(&2 pow i))` THEN
  CONJ_TAC THENL
   [ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN
    ASM_SIMP_TAC[GSYM ADD1; REAL_LT_IMP_LE];
    ALL_TAC] THEN
  REWRITE_TAC[REAL_INV_POW; SUM_GP] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   `inv i < e ==> x <= inv(&2) * inv i  ==> x / (&1 / &2) < e`)) THEN
  REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE] THEN REWRITE_TAC[real_div] THEN
  MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ y <= z ==> &1 * y - &1 * x <= z`) THEN
  SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN
  REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
  REWRITE_TAC[GSYM(CONJUNCT2 real_pow); REAL_LT_POW2] THEN
  MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN
  ASM_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Isometries are embeddings, and even surjective in the compact case.       *)
(* ------------------------------------------------------------------------- *)

let ISOMETRY_IMP_OPEN_MAP = prove
 (`!f:real^M->real^N s t u.
        IMAGE f s = t /\
        (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\
        open_in (subtopology euclidean s) u
        ==> open_in (subtopology euclidean t) (IMAGE f u)`,
  REWRITE_TAC[open_in; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ] THEN
  EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
  ASM_SIMP_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]);;

let ISOMETRY_IMP_EMBEDDING = prove
 (`!f:real^M->real^N s t.
        IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y))
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
  ASM_SIMP_TAC[ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; REPEAT STRIP_TAC] THEN
  MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);;

let ISOMETRY_IMP_HOMEOMORPHISM_COMPACT = prove
 (`!f s:real^N->bool.
        compact s /\ IMAGE f s SUBSET s /\
        (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y))
        ==> ?g. homeomorphism (s,s) (f,g)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s`
   (fun th -> ASM_MESON_TAC[th; ISOMETRY_IMP_EMBEDDING]) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN
  ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN `setdist({x},IMAGE (f:real^N->real^N) s) = &0` MP_TAC THENL
   [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN
    REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN
    (X_CHOOSE_THEN `z:num->real^N` STRIP_ASSUME_TAC o
     prove_recursive_functions_exist num_RECURSION)
     `z 0 = (x:real^N) /\ !n. z(SUC n) = f(z n)` THEN
    SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL
     [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN
    DISCH_THEN(MP_TAC o SPEC `z:num->real^N`) THEN
    ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN
    REWRITE_TAC[cauchy] THEN
    DISCH_THEN(MP_TAC o SPEC `setdist({x},IMAGE (f:real^N->real^N) s)`) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num`
     (MP_TAC o SPECL [`N:num`; `N + 1`])) THEN
    ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[REAL_NOT_LT; o_THM]] THEN
    SUBGOAL_THEN `(r:num->num) N < r (N + 1)` MP_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
      REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN
    TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z(SUC d))` THEN CONJ_TAC THENL
     [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC REAL_EQ_IMP_LE THEN
    SPEC_TAC(`(r:num->num) N`,`m:num`) THEN
    INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES];
    REWRITE_TAC[SETDIST_EQ_0_SING; IMAGE_EQ_EMPTY] THEN
    ASM_MESON_TAC[COMPACT_IMP_CLOSED; NOT_IN_EMPTY;
                  COMPACT_CONTINUOUS_IMAGE; CLOSURE_CLOSED]]);;

(* ------------------------------------------------------------------------- *)
(* Urysohn's lemma (for real^N, where the proof is easy using distances).    *)
(* ------------------------------------------------------------------------- *)

let URYSOHN_LOCAL_STRONG = prove
 (`!s t u a b.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        s INTER t = {} /\ ~(a = b)
        ==> ?f:real^N->real^M.
               f continuous_on u /\
               (!x. x IN u ==> f(x) IN segment[a,b]) /\
               (!x. x IN u ==> (f x = a <=> x IN s)) /\
               (!x. x IN u ==> (f x = b <=> x IN t))`,
  let lemma = prove
   (`!s t u a b.
          closed_in (subtopology euclidean u) s /\
          closed_in (subtopology euclidean u) t /\
          s INTER t = {} /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b)
          ==> ?f:real^N->real^M.
                 f continuous_on u /\
                 (!x. x IN u ==> f(x) IN segment[a,b]) /\
                 (!x. x IN u ==> (f x = a <=> x IN s)) /\
                 (!x. x IN u ==> (f x = b <=> x IN t))`,
    REPEAT STRIP_TAC THEN EXISTS_TAC
      `\x:real^N. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) %
                      (b - a:real^M)` THEN REWRITE_TAC[] THEN
    SUBGOAL_THEN
     `(!x:real^N. x IN u ==> (setdist({x},s) = &0 <=> x IN s)) /\
      (!x:real^N. x IN u ==> (setdist({x},t) = &0 <=> x IN t))`
    STRIP_ASSUME_TAC THENL
     [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL
       [MP_TAC(ISPEC `s:real^N->bool` CLOSED_IN_CLOSED);
        MP_TAC(ISPEC `t:real^N->bool` CLOSED_IN_CLOSED)] THEN
      DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool`
       (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
      ASM_MESON_TAC[CLOSURE_CLOSED; INTER_SUBSET; SUBSET_CLOSURE; SUBSET;
                    IN_INTER; CLOSURE_SUBSET];
      ALL_TAC] THEN
    SUBGOAL_THEN `!x:real^N. x IN u ==> &0 < setdist({x},s) + setdist({x},t)`
    ASSUME_TAC THENL
     [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
        `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN
      REWRITE_TAC[SETDIST_POS_LE] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN
      REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC) THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF] THEN
      REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN
      MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
      ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN
      REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
      REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST];
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      REWRITE_TAC[segment; IN_ELIM_THM] THEN
      REWRITE_TAC[VECTOR_MUL_EQ_0; LEFT_OR_DISTRIB; VECTOR_ARITH
       `a + x % (b - a):real^N = (&1 - u) % a + u % b <=>
        (x - u) % (b - a) = vec 0`;
       EXISTS_OR_THM] THEN
      DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
      REWRITE_TAC[REAL_SUB_0; UNWIND_THM1] THEN
      ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; SETDIST_POS_LE; REAL_LE_LDIV_EQ;
                   REAL_ARITH `a <= &1 * (a + b) <=> &0 <= b`];
      REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`];
      REWRITE_TAC[VECTOR_ARITH `a + x % (b - a):real^N = b <=>
                                (x - &1) % (b - a) = vec 0`]] THEN
    ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN
    ASM_SIMP_TAC[REAL_SUB_0; REAL_EQ_LDIV_EQ;
                 REAL_MUL_LZERO; REAL_MUL_LID] THEN
    REWRITE_TAC[REAL_ARITH `x:real = x + y <=> y = &0`] THEN
    ASM_REWRITE_TAC[]) in
  MATCH_MP_TAC(MESON[]
   `(!s t. P s t <=> P t s) /\
    (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\
    P {} {} /\ (!t. ~(t = {}) ==> P {} t)
    ==> !s t. P s t`) THEN
  REPEAT CONJ_TAC THENL
   [REPEAT GEN_TAC THEN
    GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN
    REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
    REWRITE_TAC[SEGMENT_SYM; INTER_COMM; CONJ_ACI; EQ_SYM_EQ];
    SIMP_TAC[lemma];
    REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. midpoint(a,b)):real^N->real^M` THEN
    ASM_SIMP_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_CONST; MIDPOINT_IN_SEGMENT] THEN
    REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
    UNDISCH_TAC `~(a:real^M = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN
    VECTOR_ARITH_TAC;
    REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = u` THENL
     [EXISTS_TAC `(\x. b):real^N->real^M` THEN
      ASM_REWRITE_TAC[NOT_IN_EMPTY; ENDS_IN_SEGMENT; IN_UNIV;
                      CONTINUOUS_ON_CONST];
      SUBGOAL_THEN `?c:real^N. c IN u /\ ~(c IN t)` STRIP_ASSUME_TAC THENL
       [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN
        REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[];
        ALL_TAC] THEN
      MP_TAC(ISPECL [`{c:real^N}`; `t:real^N->bool`; `u:real^N->bool`;
                     `midpoint(a,b):real^M`; `b:real^M`] lemma) THEN
      ASM_REWRITE_TAC[CLOSED_IN_SING; MIDPOINT_EQ_ENDPOINT] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IN_EMPTY] THEN
      X_GEN_TAC `f:real^N->real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
       [SUBGOAL_THEN
         `segment[midpoint(a,b):real^M,b] SUBSET segment[a,b]` MP_TAC
        THENL
         [REWRITE_TAC[SUBSET; IN_SEGMENT; midpoint] THEN GEN_TAC THEN
          DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
          EXISTS_TAC `(&1 + u) / &2` THEN ASM_REWRITE_TAC[] THEN
          REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
          VECTOR_ARITH_TAC;
          ASM SET_TAC[]];
        SUBGOAL_THEN `~(a IN segment[midpoint(a,b):real^M,b])` MP_TAC THENL
         [ALL_TAC; ASM_MESON_TAC[]] THEN
        DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN
        REWRITE_TAC[DIST_MIDPOINT] THEN
        UNDISCH_TAC `~(a:real^M = b)` THEN NORM_ARITH_TAC]]]);;

let URYSOHN_LOCAL = prove
 (`!s t u a b.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        s INTER t = {}
        ==> ?f:real^N->real^M.
               f continuous_on u /\
               (!x. x IN u ==> f(x) IN segment[a,b]) /\
               (!x. x IN s ==> f x = a) /\
               (!x. x IN t ==> f x = b)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL
   [EXISTS_TAC `(\x. b):real^N->real^M` THEN
    ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONTINUOUS_ON_CONST];
    MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`;
                   `a:real^M`; `b:real^M`] URYSOHN_LOCAL_STRONG) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]);;

let URYSOHN_STRONG = prove
 (`!s t a b.
        closed s /\ closed t /\ s INTER t = {} /\ ~(a = b)
        ==> ?f:real^N->real^M.
               f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\
               (!x. f x = a <=> x IN s) /\ (!x. f x = b <=> x IN t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN
  REWRITE_TAC[IN_UNIV]);;

let URYSOHN = prove
 (`!s t a b.
        closed s /\ closed t /\ s INTER t = {}
        ==> ?f:real^N->real^M.
               f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\
               (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN
   (MP_TAC o ISPECL [`a:real^M`; `b:real^M`] o MATCH_MP URYSOHN_LOCAL) THEN
  REWRITE_TAC[IN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Density of points with rational, or just dyadic rational, coordinates.    *)
(* ------------------------------------------------------------------------- *)

let CLOSURE_DYADIC_RATIONALS = prove
 (`closure { inv(&2 pow n) % x |n,x|
             !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) } = (:real^N)`,
  REWRITE_TAC[EXTENSION; CLOSURE_APPROACHABLE; IN_UNIV; EXISTS_IN_GSPEC] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN
  MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN
  ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
               REAL_POW_INV; REAL_LT_RDIV_EQ] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
  EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN
  ASM_SIMP_TAC[LAMBDA_BETA; FLOOR; dist; NORM_MUL] THEN
  MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS)
   (SPEC_ALL NORM_LE_L1)) THEN
  SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC `&(dimindex(:N)) * inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN
  GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
  MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
  X_GEN_TAC `k:num` THEN STRIP_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
  SIMP_TAC[REAL_ABS_MUL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH;
    REAL_FIELD `~(a = &0) ==> inv a * b - x = inv a * (b - a * x)`] THEN
  MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
  REWRITE_TAC[REAL_LE_REFL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NUM] THEN
  MP_TAC(SPEC `&2 pow n * (x:real^N)$k` FLOOR) THEN REAL_ARITH_TAC);;

let CLOSURE_RATIONAL_COORDINATES = prove
 (`closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } =
   (:real^N)`,
  MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN
  EXISTS_TAC
   `closure { inv(&2 pow n) % x:real^N |n,x|
              !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }` THEN

  CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSURE_DYADIC_RATIONALS]] THEN
  MATCH_MP_TAC SUBSET_CLOSURE THEN
  REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN
  ASM_SIMP_TAC[RATIONAL_CLOSED]);;

let CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET = prove
 (`!s:real^N->bool.
        open s
        ==> closure(s INTER
                    { inv(&2 pow n) % x | n,x |
                      !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) =
            closure s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN
  ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);;

let CLOSURE_RATIONALS_IN_OPEN_SET = prove
 (`!s:real^N->bool.
      open s
      ==> closure(s INTER
                  { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }) =
          closure s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN
  ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; SUBSET_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Various separability-type properties.                                     *)
(* ------------------------------------------------------------------------- *)

let UNIV_SECOND_COUNTABLE = prove
 (`?b. COUNTABLE b /\ (!c. c IN b ==> open c) /\
       !s:real^N->bool. open s ==> ?u. u SUBSET b /\ s = UNIONS u`,
  EXISTS_TAC
   `IMAGE (\(v:real^N,q). ball(v,q))
          ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS
           rational)` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_CROSS THEN
    REWRITE_TAC[COUNTABLE_RATIONAL] THEN MATCH_MP_TAC COUNTABLE_CART THEN
    REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | P x} = P`];
    REWRITE_TAC[FORALL_IN_IMAGE; CROSS; FORALL_IN_GSPEC; OPEN_BALL];
    REPEAT STRIP_TAC THEN
    ASM_CASES_TAC `s:real^N->bool = {}` THENL
     [EXISTS_TAC `{}:(real^N->bool)->bool` THEN
      ASM_REWRITE_TAC[UNIONS_0; EMPTY_SUBSET];
      ALL_TAC] THEN
    EXISTS_TAC `{c | c IN IMAGE (\(v:real^N,q). ball(v,q))
          ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS
           rational) /\ c SUBSET s}` THEN
    CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
    REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
    REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_IMAGE] THEN
    REWRITE_TAC[CROSS; EXISTS_PAIR_THM; EXISTS_IN_GSPEC] THEN
    REWRITE_TAC[IN_ELIM_PAIR_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_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[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN
    X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
    MP_TAC(REWRITE_RULE[EXTENSION; IN_UNIV] CLOSURE_RATIONAL_COORDINATES) THEN
    REWRITE_TAC[CLOSURE_APPROACHABLE] THEN
    DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `e / &4`]) THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
    SUBGOAL_THEN `?x. rational x /\ e / &3 < x /\ x < e / &2`
     (X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC)
    THENL
     [MP_TAC(ISPECL [`&5 / &12 * e`; `e / &12`] RATIONAL_APPROXIMATION) THEN
      ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
      SIMP_TAC[] THEN REAL_ARITH_TAC;
      EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
       [ASM_REWRITE_TAC[IN];
        REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
        ASM_REAL_ARITH_TAC]]]);;

let UNIV_SECOND_COUNTABLE_SEQUENCE = prove
 (`?b:num->real^N->bool.
        (!m n. b m = b n <=> m = n) /\
        (!n. open(b n)) /\
        (!s. open s ==> ?k. s = UNIONS {b n | n IN k})`,
  X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC
    UNIV_SECOND_COUNTABLE THEN
  MP_TAC(ISPEC `bb:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
  ANTS_TAC THENL
   [ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `INFINITE {ball(vec 0:real^N,inv(&n + &1)) | n IN (:num)}`
    MP_TAC THENL
     [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE
       [RIGHT_IMP_FORALL_THM; IMP_IMP] INFINITE_IMAGE_INJ) THEN
      REWRITE_TAC[num_INFINITE] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN
      CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
      MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
      REWRITE_TAC[EXTENSION] THEN
      DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) % basis 1:real^N`) THEN
      REWRITE_TAC[IN_BALL; DIST_0; NORM_MUL; REAL_ABS_INV] THEN
      SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
      REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_REFL] THEN
      MATCH_MP_TAC REAL_LT_INV2 THEN
      REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC;
      REWRITE_TAC[INFINITE; SIMPLE_IMAGE] THEN
      MATCH_MP_TAC FINITE_SUBSET THEN
      EXISTS_TAC `IMAGE UNIONS {u | u SUBSET bb} :(real^N->bool)->bool` THEN
      ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET] THEN
      GEN_REWRITE_TAC I [SUBSET] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
      X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
      ASM_MESON_TAC[OPEN_BALL]];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real^N->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN
    REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
    X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
    ASM_REWRITE_TAC[SUBSET_IMAGE; LEFT_AND_EXISTS_THM; SUBSET_UNIV] THEN
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLE_IMAGE]]);;

let SUBSET_SECOND_COUNTABLE = prove
 (`!s:real^N->bool.
       ?b. COUNTABLE b /\
           (!c. c IN b ==> ~(c = {}) /\ open_in(subtopology euclidean s) c) /\
           !t. open_in(subtopology euclidean s) t
               ==> ?u. u SUBSET b /\ t = UNIONS u`,
  GEN_TAC THEN
  SUBGOAL_THEN
   `?b. COUNTABLE b /\
           (!c:real^N->bool. c IN b ==> open_in(subtopology euclidean s) c) /\
           !t. open_in(subtopology euclidean s) t
               ==> ?u. u SUBSET b /\ t = UNIONS u`
  STRIP_ASSUME_TAC THENL
   [X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC
      UNIV_SECOND_COUNTABLE THEN
    EXISTS_TAC `{s INTER c :real^N->bool | c IN B}` THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN
    ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; OPEN_IN_OPEN_INTER] THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN
    X_GEN_TAC `t:real^N->bool` THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM SUBST_ALL_TAC THEN
    SUBGOAL_THEN `?b. b SUBSET B /\ u:real^N->bool = UNIONS b`
    STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM SUBST_ALL_TAC THEN
    EXISTS_TAC `b:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[INTER_UNIONS] THEN AP_TERM_TAC THEN SET_TAC[];
    EXISTS_TAC `b DELETE ({}:real^N->bool)` THEN
    ASM_SIMP_TAC[COUNTABLE_DELETE; IN_DELETE; SUBSET_DELETE] THEN
    X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `u DELETE ({}:real^N->bool)` THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    FIRST_X_ASSUM SUBST_ALL_TAC THEN
    REWRITE_TAC[EXTENSION; IN_UNIONS] THEN
    GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
    REWRITE_TAC[IN_DELETE] THEN SET_TAC[]]);;

let SEPARABLE = prove
 (`!s:real^N->bool.
        ?t. COUNTABLE t /\ t SUBSET s /\ s SUBSET closure t`,
  MP_TAC SUBSET_SECOND_COUNTABLE THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_AND_EXISTS_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:(real^N->bool)->bool`
   (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))) 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 `f:(real^N->bool)->real^N` THEN DISCH_TAC THEN
  EXISTS_TAC `IMAGE (f:(real^N->bool)->real^N) B` THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL
   [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
    X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN
    REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[];
    REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    UNDISCH_THEN
     `!t:real^N->bool.
        open_in (subtopology euclidean s) t
        ==> (?u. u SUBSET B /\ t = UNIONS u)`
     (MP_TAC o SPEC `s INTER ball(x:real^N,e)`) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `b:(real^N->bool)->bool` THEN
    ASM_CASES_TAC `b:(real^N->bool)->bool = {}` THENL
     [MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN
      ASM_REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; UNIONS_0] THEN
      ASM_MESON_TAC[CENTRE_IN_BALL];
      STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
      DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
      DISCH_THEN(MP_TAC o SPEC `(f:(real^N->bool)->real^N) c`) THEN
      ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
      MATCH_MP_TAC(TAUT `a /\ c ==> (a /\ b <=> c) ==> b`) THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN
      REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN
      ASM SET_TAC[]]]);;

let OPEN_SET_RATIONAL_COORDINATES = prove
 (`!s. open s /\ ~(s = {})
       ==> ?x:real^N. x IN s /\
                      !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `~(closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } INTER
    (s:real^N->bool) = {})`
  MP_TAC THENL
   [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; INTER_UNIV]; ALL_TAC] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CLOSURE_APPROACHABLE; IN_INTER;
              IN_ELIM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[open_def]) THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;

let OPEN_COUNTABLE_UNION_OPEN_INTERVALS,
    OPEN_COUNTABLE_UNION_CLOSED_INTERVALS = (CONJ_PAIR o prove)
 (`(!s:real^N->bool.
        open s
        ==> ?D. COUNTABLE D /\
                (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval(a,b)) /\
                UNIONS D = s) /\
   (!s:real^N->bool.
        open s
        ==> ?D. COUNTABLE D /\
                (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval[a,b]) /\
                UNIONS D = s)`,
  REPEAT STRIP_TAC THENL
   [EXISTS_TAC
     `{i | i IN IMAGE (\(a:real^N,b). interval(a,b))
            ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS
             {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\
           i SUBSET s}`;
    EXISTS_TAC
     `{i | i IN IMAGE (\(a:real^N,b). interval[a,b])
            ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS
             {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\
           i SUBSET s}`] THEN
  (SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_CROSS;
           COUNTABLE_RATIONAL_COORDINATES] THEN
   REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; IMP_CONJ; GSYM CONJ_ASSOC] THEN
   REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
   REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_ELIM_THM] THEN
   CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
   X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SET_TAC[]; DISCH_TAC] THEN
   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[open_def]) THEN
   ASM_REWRITE_TAC[] THEN
   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
   SUBGOAL_THEN
    `!i. 1 <= i /\ i <= dimindex(:N)
         ==> ?a b. rational a /\ rational b /\
                   a < (x:real^N)$i /\ (x:real^N)$i < b /\
                   abs(b - a) < e / &(dimindex(:N))`
   MP_TAC THENL
    [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE THEN
     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1];
     REWRITE_TAC[LAMBDA_SKOLEM]] THEN
   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN
   DISCH_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTERVAL; REAL_LT_IMP_LE] THEN
   X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
   REWRITE_TAC[dist] THEN MP_TAC(ISPEC `y - x:real^N` NORM_LE_L1) THEN
   MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN
   MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
   REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; CARD_NUMSEG_1] THEN
   REWRITE_TAC[DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
   X_GEN_TAC `k:num` THEN STRIP_TAC THEN
   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN
   ASM_REAL_ARITH_TAC));;

let LINDELOF = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> open s)
        ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?b. COUNTABLE b /\
        (!c:real^N->bool. c IN b ==> open c) /\
        (!s. open s ==> ?u. u SUBSET b /\ s = UNIONS u)`
  STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[UNIV_SECOND_COUNTABLE]; ALL_TAC] THEN
  ABBREV_TAC
   `d = {s:real^N->bool | s IN b /\ ?u. u IN f /\ s SUBSET u}` THEN
  SUBGOAL_THEN
   `COUNTABLE d /\ UNIONS f :real^N->bool = UNIONS d`
  STRIP_ASSUME_TAC THENL
   [EXPAND_TAC "d" THEN ASM_SIMP_TAC[COUNTABLE_RESTRICT] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!s:real^N->bool. ?u. s IN d ==> u IN f /\ s SUBSET u`
  MP_TAC THENL [EXPAND_TAC "d" THEN SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g:(real^N->bool)->(real^N->bool)` THEN STRIP_TAC THEN
  EXISTS_TAC `IMAGE (g:(real^N->bool)->(real^N->bool)) d` THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; UNIONS_IMAGE] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);;

let LINDELOF_OPEN_IN = prove
 (`!f u:real^N->bool.
        (!s. s IN f ==> open_in (subtopology euclidean u) s)
        ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] 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 `v:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN
  MP_TAC(ISPEC `IMAGE (v:(real^N->bool)->real^N->bool) f` LINDELOF) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
  `!f'. f' SUBSET f ==> UNIONS f' = (u:real^N->bool) INTER UNIONS (IMAGE v f')`
  MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]]);;

let COUNTABLE_DISJOINT_OPEN_IN_SUBSETS = prove
 (`!f:(real^N->bool)->bool u.
        (!s. s IN f ==> open_in (subtopology euclidean u) s) /\
        pairwise DISJOINT f
        ==> COUNTABLE f`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINDELOF_OPEN_IN) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN
  EXISTS_TAC `({}:real^N->bool) INSERT g` THEN
  ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
  REWRITE_TAC[SUBSET; IN_INSERT] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[EXTENSION; SUBSET] THEN
  REWRITE_TAC[IN_UNIONS; pairwise] THEN
  REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN
  REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[]);;

let COUNTABLE_DISJOINT_OPEN_SUBSETS = prove
 (`!f. (!s:real^N->bool. s IN f ==> open s) /\ pairwise DISJOINT f
       ==> COUNTABLE f`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `(:real^N)`]
        COUNTABLE_DISJOINT_OPEN_IN_SUBSETS) THEN
  ASM_SIMP_TAC[GSYM OPEN_IN; SUBTOPOLOGY_UNIV]);;

let COUNTABLE_DISJOINT_NONEMPTY_INTERIOR_SUBSETS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f /\ interior s = {} ==> s = {}) /\ pairwise DISJOINT f
        ==> COUNTABLE f`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `IMAGE interior (f:(real^N->bool)->bool)`
        COUNTABLE_DISJOINT_OPEN_SUBSETS) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; OPEN_INTERIOR] THEN ANTS_TAC THENL
   [REWRITE_TAC[PAIRWISE_IMAGE];
    MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COUNTABLE_IMAGE_INJ_EQ THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN
    REWRITE_TAC[GSYM pairwise]] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    PAIRWISE_IMP)) THEN
  MATCH_MP_TAC(MESON[]
   `(!s:real^N->bool. interior s SUBSET s) /\
    (!s t. interior s SUBSET s /\ interior t SUBSET t ==> P s t)
    ==> !s:real^N->bool t:real^N->bool. P s t`) THEN
  (CONJ_TAC THENL [REWRITE_TAC[INTERIOR_SUBSET]; ALL_TAC]) THEN
  REPEAT(FIRST_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN
         GEN_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM]) THEN
  SET_TAC[]);;

let COUNTABLE_COMPACT_OPEN_IN = prove
 (`!u:real^N->bool.
        COUNTABLE {c | compact c /\ open_in (subtopology euclidean u) c}`,
  GEN_TAC THEN MP_TAC(ISPEC `u:real^N->bool` SUBSET_SECOND_COUNTABLE) THEN
  DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC
   `IMAGE UNIONS {t:(real^N->bool)->bool | t SUBSET b /\ FINITE t}` THEN
  ASM_SIMP_TAC[COUNTABLE_FINITE_SUBSETS; COUNTABLE_IMAGE] THEN
  GEN_REWRITE_TAC I [SUBSET] THEN
  REWRITE_TAC[IN_IMAGE; IN_UNIONS; IN_ELIM_THM] THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME
   `open_in (subtopology euclidean u) (c:real^N->bool)`)) THEN
  DISCH_THEN(X_CHOOSE_THEN `t:(real^N->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `t:(real^N->bool)->bool` o
    GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
  ASM_REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL
   [X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N->bool`) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        OPEN_IN_SUBSET_TRANS)) THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;

let COUNTABLE_CLOPEN_IN = prove
 (`!u:real^N->bool.
        compact u
        ==> COUNTABLE {c | closed_in (subtopology euclidean u) c /\
                           open_in (subtopology euclidean u) c}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC
   `{c:real^N->bool | compact c /\ open_in (subtopology euclidean u) c}` THEN
  REWRITE_TAC[COUNTABLE_COMPACT_OPEN_IN; SUBSET; IN_ELIM_THM] THEN
  ASM_MESON_TAC[CLOSED_IN_COMPACT]);;

let CARD_EQ_OPEN_SETS = prove
 (`{s:real^N->bool | open s} =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC
      UNIV_SECOND_COUNTABLE THEN
    TRANS_TAC CARD_LE_TRANS `{s:(real^N->bool)->bool | s SUBSET b}` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[LE_C] THEN
      EXISTS_TAC `UNIONS:((real^N->bool)->bool)->real^N->bool` THEN
      REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[];
      TRANS_TAC CARD_LE_TRANS `{s | s SUBSET (:num)}` THEN CONJ_TAC THENL
       [MATCH_MP_TAC CARD_LE_POWERSET THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT];
        REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC] THEN
        MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM; CARD_EQ_REAL]]];
    REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN
    EXISTS_TAC `\x. ball(x % basis 1:real^N,&1)` THEN
    REWRITE_TAC[OPEN_BALL; GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[NORM_ARITH `dist(p:real^N,q) + &1 <= &1 <=> p = q`] THEN
    REWRITE_TAC[VECTOR_MUL_RCANCEL; EQ_SYM_EQ] THEN
    SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);;

let CARD_EQ_CLOSED_SETS = prove
 (`{s:real^N->bool | closed s} =_c (:real)`,
  SUBGOAL_THEN
   `{s:real^N->bool | closed s} =
    IMAGE (\s. (:real^N) DIFF s) {s | open s}`
  SUBST1_TAC THENL
   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
    REWRITE_TAC[IN_ELIM_THM; GSYM OPEN_CLOSED] THEN
    MESON_TAC[COMPL_COMPL];
    TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | open s}` THEN
    REWRITE_TAC[CARD_EQ_OPEN_SETS] THEN
    MATCH_MP_TAC CARD_EQ_IMAGE THEN SET_TAC[]]);;

let CARD_EQ_COMPACT_SETS = prove
 (`{s:real^N->bool | compact s} =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN
    SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_CLOSED_SETS] THEN
    MATCH_MP_TAC CARD_LE_SUBSET THEN
    SIMP_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_CLOSED];
    REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN
    EXISTS_TAC `\x. {x % basis 1:real^N}` THEN
    REWRITE_TAC[COMPACT_SING; SET_RULE `{x} = {y} <=> x = y`] THEN
    SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);;

let COUNTABLE_NON_CONDENSATION_POINTS = prove
 (`!s:real^N->bool. COUNTABLE(s DIFF {x | x condensation_point_of s})`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[condensation_point_of] THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN
  X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC
   UNIV_SECOND_COUNTABLE THEN
  EXISTS_TAC
   `s INTER UNIONS { u:real^N->bool | u IN b /\ COUNTABLE(s INTER u)}` THEN
  REWRITE_TAC[INTER_UNIONS; IN_ELIM_THM] THEN CONJ_TAC THENL
   [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[FORALL_IN_GSPEC] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT];
    SIMP_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_DIFF] THEN
    X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
    SUBGOAL_THEN `?u:real^N->bool. x IN u /\ u IN b /\ u SUBSET t` MP_TAC THENL
     [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC COUNTABLE_SUBSET THEN
    EXISTS_TAC `s INTER t:real^N->bool` THEN ASM SET_TAC[]]);;

let COUNTABLE_NON_LIMIT_POINTS = prove
 (`!s:real^N->bool. COUNTABLE(s DIFF {x | x limit_point_of s})`,
  GEN_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN
  EXISTS_TAC `s DIFF {x:real^N | x condensation_point_of s}` THEN
  REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x. Q x ==> P x) ==> s DIFF {x | P x} SUBSET s DIFF {x | Q x}`) THEN
  REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT]);;

let COUNTABLE_ISOLATED_SET = prove
 (`!s:real^N->bool.
        (!a. a IN s ==> ~(a limit_point_of s)) ==> COUNTABLE s`,
  GEN_TAC THEN DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE
   `(!x. x IN s ==> ~(P x)) ==> s = s DIFF {x | P x}`)) THEN
  REWRITE_TAC[COUNTABLE_NON_LIMIT_POINTS]);;

let CARD_EQ_CONDENSATION_POINTS_IN_SET = prove
 (`!s:real^N->bool.
     ~(COUNTABLE s) ==> {x | x IN s /\ x condensation_point_of s} =_c s`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC CARD_EQ_TRANS
   `(s DIFF {x | x condensation_point_of s}) +_c
    {x:real^N | x IN s /\ x condensation_point_of s}` THEN
  CONJ_TAC THENL
   [ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_ADD_ABSORB_LEFT THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [POP_ASSUM MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN
      DISCH_THEN(MP_TAC o CONJ (SPEC `s:real^N->bool`
       COUNTABLE_NON_CONDENSATION_POINTS) o MATCH_MP FINITE_IMP_COUNTABLE) THEN
      REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC EQ_IMP THEN
      AP_TERM_TAC THEN SET_TAC[];
      REWRITE_TAC[INFINITE_CARD_LE] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN
      REWRITE_TAC[GSYM COUNTABLE_ALT; COUNTABLE_NON_CONDENSATION_POINTS]];
    ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
    W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o rand o snd) THEN
    ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]]);;

let LIMPT_OF_CONDENSATION_POINTS,CONDENSATION_POINT_OF_CONDENSATION_POINTS =
  (CONJ_PAIR o prove)
 (`(!x:real^N s.
        x limit_point_of {y | y condensation_point_of s} <=>
        x condensation_point_of s) /\
   (!x:real^N s.
        x condensation_point_of {y | y condensation_point_of s} <=>
        x condensation_point_of s)`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
   `(r ==> q) /\ (q ==> p) /\ (p ==> r)
    ==> (q <=> p) /\ (r <=> p)`) THEN
  REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT] THEN CONJ_TAC THENL
   [REWRITE_TAC[LIMPT_APPROACHABLE; CONDENSATION_POINT_INFINITE_BALL] THEN
    REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; CONTRAPOS_THM] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
    SIMP_TAC[SUBSET; IN_INTER; IN_BALL] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
    ONCE_REWRITE_TAC[CONDENSATION_POINT_INFINITE_BALL] THEN DISCH_TAC THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP
     (MESON[CARD_EQ_CONDENSATION_POINTS_IN_SET; CARD_COUNTABLE_CONG]
        `~COUNTABLE s
         ==> ~COUNTABLE {x | x IN s /\ x condensation_point_of s}`)) THEN
    REWRITE_TAC[UNCOUNTABLE_REAL; CONTRAPOS_THM] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN
    REPEAT STRIP_TAC THENL
     [ASM_MESON_TAC[CONDENSATION_POINT_OF_SUBSET; INTER_SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN
    EXISTS_TAC `closure(s INTER ball(x:real^N,e / &2))` THEN CONJ_TAC THENL
     [REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN
      ASM_SIMP_TAC[CONDENSATION_POINT_IMP_LIMPT];
      TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN
      SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
      ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; SUBSET_BALLS; DIST_REFL] THEN
      ASM_REAL_ARITH_TAC]]);;

let CLOSED_CONDENSATION_POINTS = prove
 (`!s:real^N->bool. closed {x | x condensation_point_of s}`,
  SIMP_TAC[CLOSED_LIMPT; LIMPT_OF_CONDENSATION_POINTS; IN_ELIM_THM]);;

let CANTOR_BENDIXSON_GEN = prove
 (`!s:real^N->bool.
      ?t u.
        closed_in (subtopology euclidean s) t /\
        (!x. x IN t ==> x condensation_point_of t) /\
        COUNTABLE u /\ DISJOINT t u /\ s = t UNION u`,
  GEN_TAC THEN
  EXISTS_TAC `s INTER {x:real^N | x condensation_point_of s}` THEN
  EXISTS_TAC `s DIFF {x:real^N | x condensation_point_of s}` THEN
  SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CONDENSATION_POINTS] THEN
  REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS] THEN
  CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ONCE_REWRITE_TAC[condensation_point_of] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^N->bool` THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[CONTRAPOS_THM] THEN
  MP_TAC(ISPEC `s:real^N->bool` COUNTABLE_NON_CONDENSATION_POINTS) THEN
  REWRITE_TAC[IMP_IMP; GSYM COUNTABLE_UNION] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]);;

let CANTOR_BENDIXSON = prove
 (`!s:real^N->bool.
        closed s
        ==> ?t u. closed t /\ (!x. x IN t ==> x limit_point_of t) /\
                  COUNTABLE u /\ DISJOINT t u /\ s = t UNION u`,
  MESON_TAC[CLOSED_IN_CLOSED_TRANS; CANTOR_BENDIXSON_GEN;
                CONDENSATION_POINT_IMP_LIMPT]);;

(* ------------------------------------------------------------------------- *)
(* A discrete set is countable, and an uncountable set has a limit point.    *)
(* ------------------------------------------------------------------------- *)

let DISCRETE_IMP_COUNTABLE = prove
 (`!s:real^N->bool.
        (!x. x IN s ==> ?e. &0 < e /\
                            !y. y IN s /\ ~(y = x) ==> e <= norm(y - x))
        ==> COUNTABLE s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!x. x IN s
        ==> ?q. (!i. 1 <= i /\ i <= dimindex(:N) ==> rational(q$i)) /\
                !y:real^N. y IN s /\ ~(y = x) ==> norm(x - q) < norm(y - q)`
  MP_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(SET_RULE `x IN (:real^N)`) THEN
    REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN
    REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] 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 `q:real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
    POP_ASSUM(K ALL_TAC) THEN
    REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `q:real^N->real^N` THEN DISCH_TAC THEN
    MP_TAC(ISPECL
     [`s:real^N->bool`;
      `{ x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`;
      `(:num)`] CARD_LE_TRANS) THEN
    REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN MATCH_MP_TAC THEN
    SIMP_TAC[REWRITE_RULE[COUNTABLE; ge_c] COUNTABLE_RATIONAL_COORDINATES] THEN
    REWRITE_TAC[le_c] THEN EXISTS_TAC `q:real^N->real^N` THEN
    ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_ANTISYM]]);;

let UNCOUNTABLE_CONTAINS_LIMIT_POINT = prove
 (`!s. ~(COUNTABLE s) ==> ?x. x IN s /\ x limit_point_of s`,
  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
   (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DISCRETE_IMP_COUNTABLE)) THEN
  REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LT; dist] THEN
  MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Theorems about left and right limits on R^1                               *)
(* ------------------------------------------------------------------------- *)

let EVENTUALLY_WITHIN_RIGHT_ALT_GEN = prove
 (`!P s a. eventually P (at a within {x | x IN s /\ drop a <= drop x}) <=>
           eventually P (at a within {x | x IN s /\ drop a < drop x})`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_WITHIN_DELETE] THEN
  AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DELETE] THEN
  X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `(x:real^1) IN s` THEN
  ASM_REWRITE_TAC[IN_ELIM_THM; GSYM DROP_EQ] THEN REAL_ARITH_TAC);;

let EVENTUALLY_WITHIN_RIGHT_ALT = prove
 (`!P a. eventually P (at a within {x | drop a <= drop x}) <=>
         eventually P (at a within {x | drop a < drop x})`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`P:real^1->bool`; `(:real^1)`; `a:real^1`]
        EVENTUALLY_WITHIN_RIGHT_ALT_GEN) THEN
  REWRITE_TAC[IN_UNIV]);;

let RIGHT_LIMIT_WITHIN_ALT = prove
 (`!f l s a. (f --> l) (at a within {x | x IN s /\ drop a <= drop x}) <=>
             (f --> l) (at a within {x | x IN s /\ drop a < drop x})`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_RIGHT_ALT_GEN]);;

let RIGHT_LIMIT_ALT = prove
 (`!f l a. (f --> l) (at a within {x | drop a <= drop x}) <=>
           (f --> l) (at a within {x | drop a < drop x})`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_RIGHT_ALT]);;

let EVENTUALLY_WITHIN_LEFT_ALT_GEN = prove
 (`!P s a. eventually P (at a within {x | x IN s /\ drop x <= drop a}) <=>
           eventually P (at a within {x | x IN s /\ drop x < drop a})`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_WITHIN_DELETE] THEN
  AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DELETE] THEN
  X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `(x:real^1) IN s` THEN
  ASM_REWRITE_TAC[IN_ELIM_THM; GSYM DROP_EQ] THEN REAL_ARITH_TAC);;

let EVENTUALLY_WITHIN_LEFT_ALT = prove
 (`!P a. eventually P (at a within {x | drop x <= drop a}) <=>
         eventually P (at a within {x | drop x < drop a})`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`P:real^1->bool`; `(:real^1)`; `a:real^1`]
        EVENTUALLY_WITHIN_LEFT_ALT_GEN) THEN
  REWRITE_TAC[IN_UNIV]);;

let LEFT_LIMIT_WITHIN_ALT = prove
 (`!f l s a. (f --> l) (at a within {x | x IN s /\ drop x <= drop a}) <=>
             (f --> l) (at a within {x | x IN s /\ drop x < drop a})`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LEFT_ALT_GEN]);;

let LEFT_LIMIT_ALT = prove
 (`!f l a. (f --> l) (at a within {x | drop x <= drop a}) <=>
           (f --> l) (at a within {x | drop x < drop a})`,
  REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LEFT_ALT]);;

let TWO_SIDED_LIMIT_WITHIN = prove
 (`!f s a l:real^N.
        (f --> l) (at a within s) <=>
        (f --> l) (at a within s INTER {x | drop x <= drop a}) /\
        (f --> l) (at a within s INTER {x | drop a <= drop x})`,
  REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN
  REWRITE_TAC[AND_FORALL_THM; TAUT
   `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
  REWRITE_TAC[EVENTUALLY_WITHIN_INTER_IMP; GSYM EVENTUALLY_AND] THEN
  REWRITE_TAC[TAUT `(p ==> r) /\ (q ==> r) <=> p \/ q ==> r`] THEN
  REWRITE_TAC[IN_ELIM_THM; REAL_LE_TOTAL]);;

let TWO_SIDED_LIMIT_AT = prove
 (`!f a l:real^N.
        (f --> l) (at a) <=>
        (f --> l) (at a within {x | drop x <= drop a}) /\
        (f --> l) (at a within {x | drop a <= drop x})`,
  REPEAT GEN_TAC THEN
  SUBST1_TAC(SYM(ISPEC `a:real^1` WITHIN_UNIV)) THEN
  REWRITE_TAC[WITHIN_WITHIN; GSYM TWO_SIDED_LIMIT_WITHIN]);;

let NON_TRIVIAL_LIMIT_LEFT = prove
 (`!a. ~trivial_limit (at a within {x | drop x <= drop a})`,
  GEN_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE_LE] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `a - lift e` THEN
  REWRITE_TAC[IN_ELIM_THM; DIST_1; DROP_SUB; LIFT_DROP; GSYM DROP_EQ] THEN
  ASM_REAL_ARITH_TAC);;

let NON_TRIVIAL_LIMIT_RIGHT = prove
 (`!a. ~trivial_limit (at a within {x | drop a <= drop x})`,
  GEN_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE_LE] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `a + lift e` THEN
  REWRITE_TAC[IN_ELIM_THM; DIST_1; DROP_ADD; DROP_SUB;
              LIFT_DROP; GSYM DROP_EQ] THEN
  ASM_REAL_ARITH_TAC);;

let COUNTABLE_TRIVIAL_RIGHT_LIMITS = prove
 (`!s. COUNTABLE {x | x IN s /\
                      trivial_limit
                        (at x within {t | t IN s /\ drop x <= drop t})}`,
  GEN_TAC THEN ABBREV_TAC
   `C = {x | x IN s /\
             trivial_limit(at x within {t | t IN s /\ drop x <= drop t})}` THEN
  SUBGOAL_THEN
   `!a. a IN C ==> ?b. drop a < drop b /\ DISJOINT s (interval(a,b))`
  MP_TAC THENL
   [X_GEN_TAC `a:real^1` THEN EXPAND_TAC "C" THEN
    REWRITE_TAC[IN_ELIM_THM; TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `d:real` THEN REWRITE_TAC[NOT_EXISTS_THM; GSYM DROP_EQ] THEN
    REWRITE_TAC[GSYM CONJ_ASSOC; DIST_1; REAL_ARITH
     `a <= x /\ ~(x = a) /\ abs(x - a) < d <=> a < x /\ x < a + d`] THEN
    STRIP_TAC THEN EXISTS_TAC `a + lift d` THEN
    ASM_REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_INTERVAL_1] THEN
    REWRITE_TAC[DROP_ADD; LIFT_DROP; NOT_IN_EMPTY; REAL_LT_ADDR] THEN
    ASM_MESON_TAC[];
    REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `B:real^1->real^1` THEN DISCH_TAC THEN
  SUBGOAL_THEN `COUNTABLE (IMAGE (\a:real^1. interval(a,B a)) C)`
  MP_TAC THENL
   [MATCH_MP_TAC COUNTABLE_DISJOINT_OPEN_SUBSETS THEN
    REWRITE_TAC[FORALL_IN_IMAGE; OPEN_INTERVAL] THEN
    REWRITE_TAC[PAIRWISE_IMAGE; DISJOINT_INTERVAL_1; DISJOINT] THEN
    REWRITE_TAC[pairwise; EQ_INTERVAL] THEN ASM_SIMP_TAC[DROP_EQ; REAL_ARITH
     `a < a' /\ b < b' /\ ~(a = b)
      ==> (a' <= a \/ b' <= b \/ a' <= b \/ b' <= a <=>
           ~(a < b /\ b < a') /\ ~(b < a /\ a < b'))`] THEN
    REWRITE_TAC[GSYM IN_INTERVAL_1] THEN ASM SET_TAC[];
    MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COUNTABLE_IMAGE_INJ_EQ THEN
    ASM_SIMP_TAC[EQ_INTERVAL; IMP_CONJ; INTERVAL_EQ_EMPTY_1; GSYM
                 REAL_NOT_LT]]);;

let COUNTABLE_TRIVIAL_LEFT_LIMITS = prove
 (`!s. COUNTABLE {x | x IN s /\
                      trivial_limit
                        (at x within {t | t IN s /\ drop t <= drop x})}`,
  GEN_TAC THEN MP_TAC(ISPEC
   `IMAGE (--) (s:real^1->bool)` COUNTABLE_TRIVIAL_RIGHT_LIMITS) THEN
  REWRITE_TAC[GSYM EVENTUALLY_FALSE] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [GSYM EVENTUALLY_WITHIN_REFLECT] THEN
  DISCH_THEN(MP_TAC o ISPEC `(--):real^1->real^1` o
    MATCH_MP COUNTABLE_IMAGE) THEN
  REWRITE_TAC[EVENTUALLY_FALSE] THEN
  SIMP_TAC[VECTOR_NEG_NEG; SET_RULE
   `(!x. n(n x) = x)
    ==> IMAGE n {x | x IN IMAGE n s /\ P x} = {x | x IN s /\ P(n x)}`] THEN
  REWRITE_TAC[DROP_NEG; REAL_LE_NEG2]);;

let COUNTABLE_NONCONTINUOUS_RIGHT_LIMITS = prove
 (`!f:real^1->real^N s.
      COUNTABLE
       {x | x IN s /\
            (?l. (f --> l) (at x within {t | t IN s /\ drop x <= drop t})) /\
            ~(f continuous (at x within s))}`,
  REPEAT GEN_TAC THEN
  ABBREV_TAC
   `C = {x | x IN s /\
             trivial_limit(at x within {t | t IN s /\ drop x <= drop t})}` THEN
  SUBGOAL_THEN `COUNTABLE(C:real^1->bool)` ASSUME_TAC THENL
   [EXPAND_TAC "C" THEN REWRITE_TAC[COUNTABLE_TRIVIAL_RIGHT_LIMITS];
    ALL_TAC] THEN
  ABBREV_TAC
   `L = {x | x IN s /\
             ?l. ((f:real^1->real^N) --> l)
                 (at x within {t | t IN s /\ drop x <= drop t})}` THEN
  ABBREV_TAC
   `U = \n. {a | ?d. &0 < d /\
                     !x y. x IN s /\ y IN s /\
                           dist(a:real^1,x) < d /\ dist(a,y) < d
                           ==> dist(f x:real^N,f y) < inv(&n + &1)}` THEN
  SUBGOAL_THEN
   `{x | x IN s /\
         (?l:real^N. (f --> l)
                     (at x within {t | t IN s /\ drop x <= drop t})) /\
         ~(f continuous (at x within s))} =
    L DIFF INTERS {U n | n IN (:num)}`
  SUBST1_TAC THENL
   [MAP_EVERY EXPAND_TAC ["L"; "U"] THEN
    GEN_REWRITE_TAC I [EXTENSION] THEN
    REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_DIFF; IN_UNIV] THEN
    X_GEN_TAC `a:real^1` THEN
    ASM_CASES_TAC `(a:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN
    AP_TERM_TAC THEN AP_TERM_TAC THEN
    W(MP_TAC o PART_MATCH (rand o rand) FORALL_POS_MONO_1_EQ o rand o snd) THEN
    ANTS_TAC THENL
     [MESON_TAC[REAL_LT_TRANS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
    REWRITE_TAC[CONTINUOUS_EQ_CAUCHY_WITHIN] THEN
    REPEAT(AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC) THEN ABS_TAC THEN
    ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN
    REWRITE_TAC[DIST_SYM] THEN MESON_TAC[];
    REWRITE_TAC[DIFF_INTERS] THEN MATCH_MP_TAC COUNTABLE_UNIONS THEN
    REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
    SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; IN_UNIV]] THEN
  X_GEN_TAC `n:num` THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN
  EXISTS_TAC `(L DIFF (U:num->real^1->bool) n DIFF C) UNION C` THEN
  CONJ_TAC THENL [ASM_REWRITE_TAC[COUNTABLE_UNION]; SET_TAC[]] THEN
  SUBGOAL_THEN
   `!a. a IN L
        ==> ?b. drop a < drop b /\ s INTER interval(a,b) SUBSET U(n:num)`
  MP_TAC THENL
   [GEN_TAC THEN MAP_EVERY EXPAND_TAC ["L"; "U"] THEN
    REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[LIM_WITHIN; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l:real^N` THEN
    DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    REWRITE_TAC[IN_ELIM_THM; DIST_1; REAL_ARITH
     `a <= x /\ &0 < abs(x - a) /\ abs(x - a) < d <=>
      a < x /\ x < a + d`] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `a + lift d` THEN
    ASM_SIMP_TAC[SUBSET; IN_INTERVAL_1; IN_INTER; IN_ELIM_THM; DROP_ADD] THEN
    ASM_REWRITE_TAC[LIFT_DROP; REAL_LT_ADDR] THEN
    X_GEN_TAC `b:real^1` THEN STRIP_TAC THEN
    EXISTS_TAC `min (drop b - drop a) ((drop a + d) - drop b)` THEN
    ASM_REWRITE_TAC[REAL_LT_MIN] THEN
    CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
    MATCH_MP_TAC(NORM_ARITH
     `!l:real^N. dist(x,l) < e / &2 /\ dist(y,l) < e / &2
                 ==> dist(x,y) < e`) THEN
    EXISTS_TAC `l:real^N` THEN CONJ_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
    REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `B:real^1->real^1` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `COUNTABLE (IMAGE (\a:real^1. s INTER interval(a,B a))
                     (L DIFF U(n:num) DIFF C))`
  MP_TAC THENL
   [MATCH_MP_TAC COUNTABLE_DISJOINT_OPEN_IN_SUBSETS THEN
    EXISTS_TAC `s:real^1->bool` THEN
    SIMP_TAC[FORALL_IN_IMAGE; OPEN_IN_OPEN_INTER; OPEN_INTERVAL] THEN
    REWRITE_TAC[PAIRWISE_IMAGE] THEN REWRITE_TAC[pairwise; FORALL_LIFT] THEN
    MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL
     [REWRITE_TAC[DISJOINT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[LIFT_DROP; FORALL_DROP] THEN
    MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN DISCH_TAC THEN
    REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN DISCH_THEN(K ALL_TAC) THEN
    MATCH_MP_TAC(SET_RULE
     `t INTER u = {} ==> DISJOINT (s INTER t) (s INTER u)`) THEN
    ASM_REWRITE_TAC[DISJOINT_INTERVAL_1] THEN
    SUBGOAL_THEN `~(b IN interval(a:real^1,B a))` MP_TAC THENL
     [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC];
    MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC COUNTABLE_IMAGE_INJ_EQ THEN
    REWRITE_TAC[EQ_INTERVAL; INTERVAL_EQ_EMPTY_1; IN_DIFF; IMP_CONJ] 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] THEN
    MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN REPEAT DISCH_TAC THEN
    UNDISCH_TAC `~((a:real^1) IN C)` THEN EXPAND_TAC "C" THEN
    REWRITE_TAC[IN_ELIM_THM; TRIVIAL_LIMIT_WITHIN; LIMPT_APPROACHABLE] THEN
    ASM_CASES_TAC `(a:real^1) IN s` THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN
     (MP_TAC o SPEC `min (drop(B a) - drop a) (drop b - drop a)`) THEN
    ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; DIST_1; GSYM DROP_EQ] THEN
    DISCH_THEN(X_CHOOSE_THEN `x:real^1` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `x IN (s INTER interval(a:real^1,B a))` MP_TAC THENL
     [REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
      ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
      ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
      ASM_REAL_ARITH_TAC]]);;

let COUNTABLE_NONCONTINUOUS_LEFT_LIMITS = prove
 (`!f:real^1->real^N s.
      COUNTABLE {x | x IN s /\
                     (?l. (f --> l)
                          (at x within {t | t IN s /\ drop t <= drop x})) /\
                     ~(f continuous (at x within s))}`,
  let lemma = prove
   (`{x | P x} = {--x:real^N | P (--x)}`,
    REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_NEG_NEG]) in
  REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN
  ONCE_REWRITE_TAC[GSYM LIM_WITHIN_REFLECT; GSYM LIM_AT_REFLECT] THEN
  ONCE_REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
  MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[VECTOR_NEG_NEG] THEN
  MP_TAC(ISPECL [`\x. (f:real^1->real^N) (--x)`; `IMAGE (--) (s:real^1->bool)`]
    COUNTABLE_NONCONTINUOUS_RIGHT_LIMITS) THEN
  REWRITE_TAC[CONTINUOUS_WITHIN] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^1` THEN
  SIMP_TAC[IN_ELIM_THM; VECTOR_NEG_NEG; SET_RULE
   `(!x. n(n x) = x) ==> (x IN IMAGE n s <=> n x IN s)`] THEN
  AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
  REWRITE_TAC[EXISTS_REFL; VECTOR_ARITH `--x:real^N = y <=> x = --y`] THEN
  REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_NEG; DROP_NEG] THEN
  GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;

let COUNTABLE_NONCONTINUOUS_ONE_SIDED_LIMITS = prove
 (`!f:real^1->real^N s.
      COUNTABLE {x | x IN s /\
                     ((?l. (f --> l)
                           (at x within {t | t IN s /\ drop t <= drop x})) \/
                      (?l. (f --> l)
                           (at x within {t | t IN s /\ drop x <= drop t}))) /\
                     ~(f continuous (at x within s))}`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`]
     COUNTABLE_NONCONTINUOUS_RIGHT_LIMITS) THEN
  MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`]
     COUNTABLE_NONCONTINUOUS_LEFT_LIMITS) THEN
  REWRITE_TAC[GSYM COUNTABLE_UNION; IMP_IMP] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* A closed local homeomorphism is proper: it actually has finite preimages. *)
(* ------------------------------------------------------------------------- *)

let CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN = prove
 (`!f:real^M->real^N s t.
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
        (!w x. open_in (subtopology euclidean s) w /\ x IN w
               ==> ?u. open_in (subtopology euclidean s) u /\
                       {x} PSUBSET u /\ u SUBSET w /\
                       f continuous_on u /\
                       (!x'. x' IN u /\ ~(x' = x) ==> ~(f x' = f x)))
          ==> !y. FINITE {x | x IN s /\ f x = y}`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(fun th ->
    ASSUME_TAC th THEN MP_TAC(SPEC `s:real^M->bool` th)) THEN
  REWRITE_TAC[CLOSED_IN_REFL] THEN
  DISCH_THEN(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
  X_GEN_TAC `b:real^N` THEN
  REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `!z. z IN s /\ (f:real^M->real^N) z = b
        ==> ?r. &0 < r /\
                f continuous_on s INTER ball(z,r) /\
                !z'. z' IN s /\ z' IN cball(z,&2 * r) /\ ~(z' = z)
                     ==> ~(f z' = b)`
  (LABEL_TAC "*") THENL
   [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^M->bool`; `x:real^M`]) THEN
    ASM_SIMP_TAC[OPEN_IN_REFL; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `u:real^M->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
    REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^M`)) THEN
    ASM_REWRITE_TAC[SUBSET; IN_INTER] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `r / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL] THEN
    ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        COUNTABLE_AS_INJECTIVE_IMAGE)) THEN
  REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
   [MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN
    X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
    ASM_REWRITE_TAC[IN_CBALL; dist] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real` THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN
    ASM_CASES_TAC `y:real^M = x` THEN ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `(y:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `(f:real^M->real^N) y = b` THEN ASM_REWRITE_TAC[] THEN
    CONV_TAC NORM_ARITH;
    REWRITE_TAC[INJECTIVE_ALT] THEN
    DISCH_THEN(X_CHOOSE_THEN `a:num->real^M` STRIP_ASSUME_TAC)] THEN
  SUBGOAL_THEN `(!n:num. a n IN s) /\ (!n. (f:real^M->real^N) (a n) = b)`
  STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  REMOVE_THEN "*" (MP_TAC o GEN_REWRITE_RULE I [SET_RULE
    `(!x. P x ==> Q x) <=> (!x. x IN {z | P z} ==> Q x)`]) THEN
  ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; SKOLEM_THM; FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `r:num->real` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC `u:num->real^M->bool = \n. s INTER ball(a n,r n)` THEN
  SUBGOAL_THEN
   `!n. open_in (subtopology euclidean s) ((u:num->real^M->bool) n)`
  ASSUME_TAC THENL
   [EXPAND_TAC "u" THEN REWRITE_TAC[] THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL];
    ALL_TAC] THEN
  SUBGOAL_THEN `!n. (a:num->real^M) n IN u n` ASSUME_TAC THENL
   [EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!n:num. (f:real^M->real^N) continuous_on u n` ASSUME_TAC THENL
   [EXPAND_TAC "u" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `?x:num->real^M.
        (!n. x n IN u n /\ ~(f(x n) = b)) /\
        (!n. dist(f(x(SUC n)):real^N,b) < dist(f(x n),b) / &2)`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPECL
        [`(u:num->real^M->bool) 0`; `a 0:real^M`]) THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
      MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`{z | z IN u(SUC n) /\
              (f:real^M->real^N) z IN ball(b,dist(f x,b) / &2)}`;
        `(a:num->real^M) (SUC n)`]) THEN
      ASM_SIMP_TAC[IN_ELIM_THM; CENTRE_IN_BALL; REAL_HALF; GSYM DIST_NZ] THEN
    ANTS_TAC THENL
     [TRANS_TAC OPEN_IN_TRANS `u(SUC n):real^M->bool` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
      ASM_REWRITE_TAC[OPEN_BALL];
      REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL] THEN SET_TAC[]]];
    ALL_TAC] THEN
  SUBGOAL_THEN `!n. (x:num->real^M) n IN s` ASSUME_TAC THENL
   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN
  SUBGOAL_THEN
   `(((f:real^M->real^N) o (x:num->real^M)) --> b) sequentially`
  ASSUME_TAC THENL
   [REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`inv(&2)`; `e / dist((f:real^M->real^N)(x 0),b)`]
        REAL_ARCH_POW_INV) THEN
    ASM_SIMP_TAC[REAL_POW_INV; REAL_LT_DIV; DIST_POS_LT] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
    ASM_SIMP_TAC[REAL_LT_RDIV_EQ; DIST_POS_LT] THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
    DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
      REAL_LET_TRANS)) THEN
    SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_POW2; o_THM] THEN
    TRANS_TAC REAL_LE_TRANS
      `dist ((f:real^M->real^N) (x n),b) * &2 pow n` THEN
    ASM_SIMP_TAC[REAL_LE_LMUL; DIST_POS_LE; REAL_POW_MONO;
                 REAL_ARITH `&1 <= &2`] THEN
    SPEC_TAC(`n:num`,`m:num`) THEN INDUCT_TAC THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[REAL_LE_REFL; REAL_MUL_RID; real_pow] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
      REAL_LE_TRANS)) THEN
    ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_LE_RMUL_EQ; REAL_LT_POW2] THEN
    ASM_SIMP_TAC[REAL_ARITH `x < y / &2 ==> x * &2 <= y`];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN `x:real^M` o
    SPECL [`s:real^M->bool`; `x:real^M`]) THEN
  REWRITE_TAC[OPEN_IN_REFL] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^M) (:num)`) THEN
  REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
   [ALL_TAC;
    REWRITE_TAC[CLOSED_IN_SEQUENTIAL_LIMITS] THEN
    DISCH_THEN(MP_TAC o SPECL
     [`(f:real^M->real^N) o (x:num->real^M)`; `b:real^N`] o CONJUNCT2) THEN
    ASM_REWRITE_TAC[o_THM; NOT_IMP] THEN ASM SET_TAC[]] THEN
  REWRITE_TAC[CLOSED_IN_LIMPT] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  X_GEN_TAC `z: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 `(f:real^M->real^N) z = b` ASSUME_TAC THENL
   [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
    EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN
    ASM_SIMP_TAC[o_ASSOC; LIM_SUBSEQUENCE; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
    REWRITE_TAC[o_DEF] THEN
    MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION_WITHIN THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^M->bool` THEN REPEAT STRIP_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
       `{z} PSUBSET s ==> z IN s`))
    THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN];
      GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN
      ASM_REWRITE_TAC[];
      MATCH_MP_TAC LIM_EVENTUALLY_IN_OPEN_IN THEN
      MAP_EVERY EXISTS_TAC [`z:real^M`; `s:real^M->bool`] THEN
      ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN
      GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN
      ASM_REWRITE_TAC[]];
    SUBGOAL_THEN `?N. z = (a:num->real^M) N`
     (X_CHOOSE_THEN `N:num` SUBST_ALL_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN
      `eventually (\n. (x:num->real^M)(r n) IN u(N:num)) sequentially`
    MP_TAC THENL
     [MATCH_MP_TAC LIM_EVENTUALLY_IN_OPEN_IN THEN
      MAP_EVERY EXISTS_TAC [`(a:num->real^M) N`; `s:real^M->bool`] THEN
      ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN
      GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN
      ASM_REWRITE_TAC[];
      MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
      DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M + N + 1`)) THEN
      REWRITE_TAC[ARITH_RULE `M <= M + N + 1`] THEN
      SUBGOAL_THEN `(x:num->real^M)(r(M + N + 1)) IN u(r(M + N + 1))`
      MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC(SET_RULE `DISJOINT s t ==> x IN t ==> ~(x IN s)`) THEN
      SUBGOAL_THEN `~(r(M + N + 1) = N)` MP_TAC THENL
       [MATCH_MP_TAC(ARITH_RULE
         `M + N + 1 <= r(M + N + 1) ==> ~(r(M + N + 1) = N)`) THEN
        ASM_MESON_TAC[MONOTONE_BIGGER];
        ALL_TAC] THEN
      SPEC_TAC(`r(M + N + 1):num`,`N':num`) THEN GEN_TAC THEN
      DISCH_TAC THEN EXPAND_TAC "u" THEN
      MATCH_MP_TAC(SET_RULE
       `DISJOINT t u ==> DISJOINT (s INTER t) (s INTER u)`) THEN
      FIRST_X_ASSUM(fun th ->
        MP_TAC(SPECL [`N:num`; `(a:num->real^M) N'`] th) THEN
        MP_TAC(SPECL [`N':num`; `(a:num->real^M) N`] th)) THEN
      ASM_REWRITE_TAC[IN_BALL; IN_CBALL; DISJOINT; EXTENSION; IN_INTER;
                      NOT_IN_EMPTY] THEN
      CONV_TAC NORM_ARITH]]);;

let CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER = prove
 (`!f:real^M->real^N s t.
        (!x. connected_component s x = {x} ==> s = {x}) /\
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
        (!x. x IN s
             ==> ?u v g. x IN u /\
                         open_in (subtopology euclidean s) u /\
                         open_in (subtopology euclidean t) v /\
                         homeomorphism (u,v) (f,g))
        ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN `IMAGE (f:real^M->real^N) s SUBSET t` ASSUME_TAC THENL
   [ASM_MESON_TAC[CLOSED_IN_REFL; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
  ASM_SIMP_TAC[PROPER_MAP] THEN
  X_GEN_TAC `y:real^N` THEN DISCH_THEN(K ALL_TAC) THEN
  MATCH_MP_TAC FINITE_IMP_COMPACT THEN
  ASM_CASES_TAC `?a:real^M. s = {a}` THENL
   [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST1_TAC) THEN
    MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{a:real^M}` THEN
    REWRITE_TAC[SUBSET_RESTRICT; FINITE_SING];
    SUBGOAL_THEN `!x:real^M. x IN s ==> {x} PSUBSET connected_component s x`
    ASSUME_TAC THENL
     [REPEAT STRIP_TAC THEN REWRITE_TAC[SING_SUBSET; PSUBSET] THEN
      REWRITE_TAC[IN] THEN ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL] THEN
      ASM_MESON_TAC[];
      FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM])] THEN
    UNDISCH_THEN `!x:real^M. connected_component s x = {x} ==> s = {x}`
         (K ALL_TAC)] THEN
  SPEC_TAC(`y:real^N`,`y:real^N`) THEN
  MATCH_MP_TAC CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER_GEN THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `x:real^M`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `(x:real^M) IN s` ASSUME_TAC THENL
   [ASM_MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; HOMEOMORPHISM] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `g:real^N->real^M`] THEN
  STRIP_TAC THEN EXISTS_TAC `u INTER w:real^M->bool` THEN
  ASM_SIMP_TAC[OPEN_IN_INTER; INTER_SUBSET; CONJ_ASSOC] THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]] THEN
  MATCH_MP_TAC(SET_RULE `a IN s /\ ~(s SUBSET {a}) ==> {a} PSUBSET s`) THEN
  ASM_REWRITE_TAC[IN_INTER] THEN
  MATCH_MP_TAC(MESON[INFINITE; FINITE_SING; FINITE_SUBSET]
   `INFINITE s ==> ~(s SUBSET {x})`) THEN
  MATCH_MP_TAC INFINITE_OPEN_IN THEN EXISTS_TAC `s:real^M->bool` THEN
  ASM_SIMP_TAC[OPEN_IN_INTER] THEN
  EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[IN_INTER] THEN
  MATCH_MP_TAC LIMPT_SUBSET THEN
  EXISTS_TAC `connected_component s (x:real^M)` THEN
  REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN
  MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN
  REWRITE_TAC[IN; CONNECTED_CONNECTED_COMPONENT] THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* The Brouwer reduction theorem.                                            *)
(* ------------------------------------------------------------------------- *)

let BROUWER_REDUCTION_THEOREM_GEN = prove
 (`!P s:real^N->bool.
        (!f. (!n. closed(f n) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n))
              ==> P(INTERS {f n | n IN (:num)})) /\
        closed s /\ P s
        ==> ?t. t SUBSET s /\ closed t /\ P t /\
                (!u. u SUBSET s /\ closed u /\ P u ==> ~(u PSUBSET t))`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?b:num->real^N->bool.
        (!m n. b m = b n <=> m = n) /\
        (!n. open (b n)) /\
        (!s. open s ==> (?k. s = UNIONS {b n | n IN k}))`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[UNIV_SECOND_COUNTABLE_SEQUENCE]; ALL_TAC] THEN
  X_CHOOSE_THEN `a:num->real^N->bool` MP_TAC
   (prove_recursive_functions_exist num_RECURSION
   `a 0 = (s:real^N->bool) /\
    (!n. a(SUC n) =
         if ?u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {}
         then @u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {}
         else a(n))`) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "base") (LABEL_TAC "step")) THEN
  EXISTS_TAC `INTERS {a n :real^N->bool | n IN (:num)}` THEN
  SUBGOAL_THEN `!n. (a:num->real^N->bool)(SUC n) SUBSET a(n)` ASSUME_TAC THENL
   [GEN_TAC THEN ASM_REWRITE_TAC[] THEN
    COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN
    FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!n. (a:num->real^N->bool) n SUBSET s` ASSUME_TAC THENL
   [INDUCT_TAC THEN ASM_MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; ALL_TAC] THEN
  SUBGOAL_THEN `!n. closed((a:num->real^N->bool) n) /\ P(a n)` ASSUME_TAC THENL
   [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[];
    ALL_TAC] THEN
  REPEAT CONJ_TAC THENL
   [ASM SET_TAC[];
    MATCH_MP_TAC CLOSED_INTERS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
    X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
    REWRITE_TAC[PSUBSET_ALT] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[INTERS_GSPEC; EXISTS_IN_GSPEC; IN_UNIV] THEN
    DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `?n. x IN (b:num->real^N->bool)(n) /\ t INTER b n = {}`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPEC `(:real^N) DIFF t` OPEN_CONTAINS_BALL) THEN
      ASM_REWRITE_TAC[GSYM closed] THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
      ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
      REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> t INTER s = {}`] THEN
      X_GEN_TAC `e:real` THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `ball(x:real^N,e)`) THEN
      ASM_REWRITE_TAC[OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `k:num->bool` THEN DISCH_THEN SUBST1_TAC THEN
      REWRITE_TAC[IN_UNIONS; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
      SET_TAC[];
      REMOVE_THEN "step" (MP_TAC o SPEC `n:num`) THEN
      COND_CASES_TAC THENL
       [DISCH_THEN(ASSUME_TAC o SYM) THEN
        FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN
        ASM SET_TAC[];
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
        DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
        ASM SET_TAC[]]]]);;

let BROUWER_REDUCTION_THEOREM = prove
 (`!P s:real^N->bool.
        (!f. (!n. compact(f n) /\ ~(f n = {}) /\ P(f n)) /\
             (!n. f(SUC n) SUBSET f(n))
             ==> P(INTERS {f n | n IN (:num)})) /\
        compact s /\ ~(s = {}) /\ P s
        ==> ?t. t SUBSET s /\ compact t /\ ~(t = {}) /\ P t /\
                (!u. u SUBSET s /\ closed u /\ ~(u = {}) /\ P u
                     ==> ~(u PSUBSET t))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`\t:real^N->bool. ~(t = {}) /\ t SUBSET s /\ P t`;
                 `s:real^N->bool`]
        BROUWER_REDUCTION_THEOREM_GEN) THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_REFL] THEN ANTS_TAC THENL
   [GEN_TAC THEN STRIP_TAC THEN
    SUBGOAL_THEN `!n. compact((f:num->real^N->bool) n)` ASSUME_TAC THENL
     [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[] THEN SET_TAC[];
      ASM SET_TAC[];
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]];
    MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[] THEN
    ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]]);;

let MINIMAL_CONTINUUM = prove
 (`!t s:real^N->bool.
        t SUBSET s /\ compact s /\ connected s
        ==> ?u. t SUBSET u /\ u SUBSET s /\ compact u /\ connected u /\
                !v. v SUBSET u /\ t SUBSET v /\ compact v /\ connected v
                    ==> v = u`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [EXISTS_TAC `{}:real^N->bool` THEN
    ASM_MESON_TAC[COMPACT_EMPTY; CONNECTED_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`\u:real^N->bool. t SUBSET u /\ connected u`;
                 `s:real^N->bool`]
        BROUWER_REDUCTION_THEOREM) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_TAC THEN STRIP_TAC THEN
    CONJ_TAC THENL
     [REWRITE_TAC[SUBSET_INTERS] THEN ASM SET_TAC[];
      MATCH_MP_TAC CONNECTED_NEST THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_REWRITE_TAC[] THEN SET_TAC[]];
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[SET_RULE `(v SUBSET u /\ p ==> v = u) <=>
                          (v SUBSET u /\ p ==> ~(v PSUBSET u))`] THEN
    GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* The Arzela-Ascoli theorem.                                                *)
(* ------------------------------------------------------------------------- *)

let FUNCTION_CONVERGENT_SUBSEQUENCE = prove
 (`!f:num->real^M->real^N s M.
        COUNTABLE s /\ (!n x. x IN s ==> norm(f n x) <= M)
        ==> ?k. (!m n:num. m < n ==> k m < k n) /\
                !x. x IN s ==> ?l. ((\n. f (k n) x) --> l) sequentially`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THENL
   [EXISTS_TAC `\n:num. n` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY];
    ALL_TAC] THEN
  MP_TAC(ISPEC `s:real^M->bool` COUNTABLE_AS_IMAGE) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `X:num->real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN
  MP_TAC(ISPEC
    `\i r. ?l. ((\n. ((f:num->real^M->real^N) o (r:num->num)) n
                     ((X:num->real^M) i)) --> l) sequentially`
   SUBSEQUENCE_DIAGONALIZATION_LEMMA) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_UNIV] THEN
  ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_ACCEPT_TAC] THEN CONJ_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN
    MAP_EVERY X_GEN_TAC [`i:num`; `r:num->num`] THEN
    MP_TAC(ISPEC `cball(vec 0:real^N,M)` compact) THEN
    REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC
     `\n. (f:num->real^M->real^N) ((r:num->num) n) (X(i:num))`) THEN
    ASM_REWRITE_TAC[IN_CBALL_0; o_DEF] THEN MESON_TAC[];
    REPEAT GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY; GE] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
    ASM_MESON_TAC[LE_TRANS; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`]]);;

let ARZELA_ASCOLI = prove
 (`!f:num->real^M->real^N s M.
        compact s /\
        (!n x. x IN s ==> norm(f n x) <= M) /\
        (!x e. x IN s /\ &0 < e
               ==> ?d. &0 < d /\
                       !n y. y IN s /\ norm(x - y) < d
                             ==> norm(f n x - f n y) < e)
        ==> ?g. g continuous_on s /\
                ?r. (!m n:num. m < n ==> r m < r n) /\
                    !e. &0 < e
                        ==> ?N. !n x. n >= N /\ x IN s
                                      ==> norm(f(r n) x - g x) < e`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GE] THEN
  MATCH_MP_TAC(MESON[]
   `(!k g. V k g ==> N g) /\ (?k. M k /\ ?g. V k g)
    ==> ?g. N g /\ ?k. M k /\ V k g`) THEN
  CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`k:num->num`; `g:real^M->real^N`] THEN
    STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially`
      CONTINUOUS_UNIFORM_LIMIT) THEN
    EXISTS_TAC `(f:num->real^M->real^N) o (k:num->num)` THEN
    ASM_SIMP_TAC[EVENTUALLY_SEQUENTIALLY; o_THM; TRIVIAL_LIMIT_SEQUENTIALLY;
                 RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
    EXISTS_TAC `0` THEN REWRITE_TAC[continuous_on; dist] THEN
    ASM_MESON_TAC[NORM_SUB];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`IMAGE (f:num->real^M->real^N) (:num)`;
    `s:real^M->bool`]
   COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
  ANTS_TAC THENL
   [REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[];
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`)] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; dist] THEN
  DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[NORM_SUB]) THEN
  REWRITE_TAC[GSYM dist; UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
  X_CHOOSE_THEN `r:real^M->bool` STRIP_ASSUME_TAC
   (ISPEC `s:real^M->bool` SEPARABLE) THEN
  MP_TAC(ISPECL [`f:num->real^M->real^N`; `r:real^M->bool`; `M:real`]
        FUNCTION_CONVERGENT_SUBSEQUENCE) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num->num` THEN
  REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN
  DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^M. ball(x,d)) r`) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL] THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL
   [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure r:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN
    ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL];
    DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN
  REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
  GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
  ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] 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 `M:real^M->num` THEN DISCH_THEN(LABEL_TAC "*") THEN
  MP_TAC(ISPECL [`M:real^M->num`; `t:real^M->bool`]
    UPPER_BOUND_FINITE_SET) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
  DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^M`] THEN STRIP_TAC THEN
  UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^M. ball (x,d)) t)` THEN
  REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
  ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; dist] THEN
  X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
  MATCH_MP_TAC(NORM_ARITH
   `norm(f (k(m:num)) y - f (k m) x) < e / &3 /\
    norm(f (k n) y - f (k n) x) < e / &3 /\
    norm(f (k m) y - f (k n) y) < e / &3
    ==> norm(f (k m) x - f (k n) x :real^M) < e`) THEN
  ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
  ASM_REWRITE_TAC[dist; GE] THEN ASM_MESON_TAC[SUBSET; LE_TRANS]);;

let ARZELA_ASCOLI_LIPSCHITZ = prove
 (`!f:num->real^M->real^N s t b.
     compact s /\ bounded t /\
     (!n x. x IN s ==> ~(IMAGE (f n) s INTER t = {})) /\
     (!n x y. x IN s /\ y IN s ==> norm(f n x - f n y) <= b * norm(x - y))
     ==> ?g. (!x y. x IN s /\ y IN s ==> norm(g x - g y) <= b * norm(x - y)) /\
             ?r. (!m n. m < n ==> r m < r n) /\
                 !e. &0 < e
                     ==> ?N. !n:num x. n >= N /\ x IN s
                                       ==> norm(f (r n) x - g x) < e`,
  REPEAT STRIP_TAC THEN
  MP_TAC(MATCH_MP MONO_EXISTS (ISPECL
   [`f:num->real^M->real^N`; `s:real^M->bool`] ARZELA_ASCOLI)) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPECL [`s:real^M->bool`; `s:real^M->bool`] BOUNDED_DIFFS) THEN
      ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
      REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM; FORALL_IN_GSPEC] THEN
      X_GEN_TAC `C:real` THEN STRIP_TAC THEN
      EXISTS_TAC `B + abs b * C:real` THEN
      MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN DISCH_TAC THEN
      SUBGOAL_THEN `~(IMAGE ((f:num->real^M->real^N) n) s INTER t = {})`
      MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN
      REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
      DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^M`; `y:real^M`]) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
      `norm(y) <= b /\ a <= c
        ==> norm(x - y:real^M) <= a ==> norm(x) <= b + c`) THEN
      ASM_SIMP_TAC[] THEN
      TRANS_TAC REAL_LE_TRANS `abs b * norm(x - y:real^M)` THEN
      ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN
      MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
      REAL_ARITH_TAC;
      MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN STRIP_TAC THEN
      EXISTS_TAC `e / (abs b + &1)` THEN
      ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_ARITH `&0 < abs b + &1`] THEN
      ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
      MAP_EVERY X_GEN_TAC [`n:num`; `y:real^M`] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real^M`; `y:real^M`]) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
      GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
      MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
      REAL_ARITH_TAC];
    REWRITE_TAC[RIGHT_AND_EXISTS_THM; dist; GE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIPSCHITZ_LIM THEN
    EXISTS_TAC `(f:num->real^M->real^N) o (r:num->num)` THEN
    ASM_REWRITE_TAC[LIM_SEQUENTIALLY; dist; o_DEF] THEN ASM_MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Basics about "local" properties in general.                               *)
(* ------------------------------------------------------------------------- *)

let locally = new_definition
 `locally P (s:real^N->bool) <=>
        !w x. open_in (subtopology euclidean s) w /\ x IN w
              ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\
                        x IN u /\ u SUBSET v /\ v SUBSET w`;;

let NEIGHBOURHOOD_BASE_OF_EUCLIDEAN = prove
 (`!P s:real^N->bool.
        neighbourhood_base_of P (subtopology euclidean s) <=> locally P s`,
  REWRITE_TAC[NEIGHBOURHOOD_BASE_OF; locally]);;

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_LOCALLY;LOCALLY_ON_OPEN_SUBSETS; LOCALLY_ON_NBDS] =
  (CONJUNCTS o prove)
 (`(!P:(real^N->bool)->bool. locally (locally P) = locally P) /\
   (!P s:real^N->bool.
        locally P s <=>
        !a. a IN s
            ==> ?v. open_in (subtopology euclidean s) v /\
                    a IN v /\ locally P v) /\
   (!P s:real^N->bool.
        locally P s <=>
        !a. a IN s
            ==> ?u v. open_in (subtopology euclidean s) u /\
                    a IN u /\ u SUBSET v /\ v SUBSET s /\ locally P v)`,
  REWRITE_TAC[FUN_EQ_THM; AND_FORALL_THM] THEN
  MAP_EVERY X_GEN_TAC [`P:(real^N->bool)->bool`; `s:real^N->bool`] THEN
  MATCH_MP_TAC(TAUT
   `(p ==> q) /\ (q ==> s) /\ (s ==> r) /\ (r ==> p)
    ==> (q <=> p) /\ (p <=> r) /\ (p <=> s)`) THEN
  REPEAT CONJ_TAC THENL
   [DISCH_TAC THEN ONCE_REWRITE_TAC[locally] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN
    STRIP_TAC THEN REPEAT(EXISTS_TAC `v:real^N->bool`) THEN
    ASM_MESON_TAC[SUBSET_REFL; LOCALLY_OPEN_SUBSET];
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [locally] THEN
    DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
    REWRITE_TAC[OPEN_IN_REFL] THEN MESON_TAC[];
    DISCH_TAC THEN
    X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^N->bool` THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
    EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
    ASM_REWRITE_TAC[];
    REWRITE_TAC[locally] THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`u INTER v:real^N->bool`; `x:real^N`]) THEN
    ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
    ASM_MESON_TAC[OPEN_IN_SUBTOPOLOGY_INTER_SUBSET; OPEN_IN_INTER;
                  OPEN_IN_TRANS; OPEN_IN_REFL; OPEN_IN_IMP_SUBSET]]);;

let LOCALLY_AND_SUBSET = prove
 (`!s:real^N->bool. locally P s <=> locally (\t. t SUBSET s /\ P t) s`,
  GEN_TAC THEN REWRITE_TAC[locally] THEN
  MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]);;

let LOCALLY_AND_OPEN_IN = prove
 (`!P s:real^N->bool.
        locally (\u. open_in (subtopology euclidean s) u /\ P u) s <=>
        !v x. open_in (subtopology euclidean s) v /\ x IN v
              ==> ?u. open_in (subtopology euclidean s) u /\ P u /\
                      x IN u /\
                      u SUBSET v`,
  REWRITE_TAC[locally] THEN MESON_TAC[SUBSET]);;

let LOCALLY_AND_SMALL_LT,LOCALLY_AND_SMALL_LE = (CONJ_PAIR o prove)
 (`(!P:(real^N->bool)->bool e.
        &0 < e
        ==> locally P = locally (\s. P s /\ bounded s /\ diameter s < e)) /\
   (!P:(real^N->bool)->bool e.
        &0 < e
        ==> locally P = locally (\s. P s /\ bounded s /\ diameter s <= e))`,
  REWRITE_TAC[AND_FORALL_THM; FUN_EQ_THM; RIGHT_IMP_FORALL_THM] THEN
  MAP_EVERY X_GEN_TAC
    [`P:(real^N->bool)->bool`; `e:real`; `s:real^N->bool`] THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(TAUT
   `((q ==> r) /\ (r ==> p)) /\ (p ==> q)
    ==> (p <=> q) /\ (p <=> r)`) THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN
    SIMP_TAC[REAL_LT_IMP_LE];
    REWRITE_TAC[locally] THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`w INTER ball(a:real^N,e / &4)`; `a:real^N`]) THEN
    ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
    ASM_REWRITE_TAC[SUBSET_INTER; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
    ASM_REWRITE_TAC[] THEN
    TRANS_TAC REAL_LE_TRANS `diameter(ball(a:real^N,e / &4))` THEN
    ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN
    REWRITE_TAC[DIAMETER_BALL] THEN ASM_REAL_ARITH_TAC]);;

let LOCALLY_OPEN_BASIS = prove
 (`!P s:real^N->bool.
        locally (\u. open_in (subtopology euclidean s) u /\ P u) s <=>
        ?b. COUNTABLE b /\
            (!c. c IN b
                 ==> ~(c = {}) /\
                     open_in (subtopology euclidean s) c /\
                     P c) /\
            (!t. open_in (subtopology euclidean s) t
                 ==> ?u. u SUBSET b /\ t = UNIONS u)`,
  REWRITE_TAC[LOCALLY_AND_OPEN_IN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL
   [STRIP_TAC; ASM SET_TAC[]] THEN
  SUBGOAL_THEN
    `!n. ?c. COUNTABLE c /\
             UNIONS c = s /\
             !u. u IN c
                 ==> ~(u = {}) /\
                     open_in (subtopology euclidean s) u /\
                     P u /\
                     ?x. x IN s /\ x IN u /\
                         u SUBSET ball(x:real^N,inv(&n + &1))`
  MP_TAC THENL
   [X_GEN_TAC `n:num` THEN FIRST_ASSUM(MP_TAC o GEN `x:real^N` o
        SPECL [`s INTER ball(x:real^N,inv(&n + &1))`; `x:real^N`]) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
    REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `u:real^N->real^N->bool` THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]
        LINDELOF_OPEN_IN) THEN
    ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:(real^N->bool)->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `c SUBSET t ==> (!x. x IN t ==> P x) ==> !x. x IN c ==> P x`)) THEN
    REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_EMPTY; EMPTY_SUBSET] THEN
    ASM SET_TAC[];
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN
  X_GEN_TAC `c:num->(real^N->bool)->bool` THEN STRIP_TAC THEN
  EXISTS_TAC `UNIONS {c n | n IN (:num)}:(real^N->bool)->bool` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC COUNTABLE_UNIONS THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE;
                 FORALL_IN_IMAGE];
    REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM SET_TAC[];
    X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN
    EXISTS_TAC
     `{t:real^N->bool | t IN UNIONS {c n | n IN (:num)} /\ t SUBSET v}` THEN
    CONJ_TAC THENL [SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM] THEN
    CONJ_TAC THENL [GEN_REWRITE_TAC I [SUBSET]; SET_TAC[]] THEN
    X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
    REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `r:real` THEN STRIP_TAC THEN
    MP_TAC(ISPEC `r / &2` ARCH_EVENTUALLY_INV1) THEN
    ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
    REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN
    SUBGOAL_THEN `(a:real^N) IN UNIONS (c(n:num))` MP_TAC THENL
     [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `t:real^N->bool`]) THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
    TRANS_TAC SUBSET_TRANS `ball(a:real^N,r) INTER s` THEN
    ASM_REWRITE_TAC[SUBSET_INTER] THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]] THEN
    REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN `x IN ball(b:real^N,inv(&n + &1)) /\
                  a IN ball(b,inv(&n + &1))`
    MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_BALL]] THEN
    UNDISCH_TAC `inv (&n + &1) < r / &2` THEN CONV_TAC NORM_ARITH]);;

let LOCALLY_AND_OPEN_IN_IDEMPOT = prove
 (`!P s:real^N->bool.
        locally (\u. open_in (subtopology euclidean s) u /\
                     locally (\v. open_in (subtopology euclidean u) v /\
                                  P v) u) s <=>
        locally (\u. open_in (subtopology euclidean s) u /\ P u) s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_AND_OPEN_IN] THEN
  EQ_TAC THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
  STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real^N->bool` THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
    ASM_REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
    ASM_MESON_TAC[OPEN_IN_TRANS; SUBSET];
    EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`v INTER w:real^N->bool`; `y:real^N`]) THEN
    SUBGOAL_THEN `(v:real^N->bool) SUBSET w /\ w SUBSET s`
    STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN
    SUBGOAL_THEN `(y:real^N) IN w` ASSUME_TAC THENL
     [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER]] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_INTER; OPEN_IN_TRANS]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_INTER]]);;

let LOCALLY_IMP_COUNTABLE_UNION_OF = prove
 (`!P s:real^N->bool. locally P s ==> (COUNTABLE UNION_OF P) s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN DISCH_THEN
   (MP_TAC o GEN `x:real^N` o SPECL [`s:real^N->bool`; `x:real^N`]) THEN
  REWRITE_TAC[OPEN_IN_REFL; RIGHT_IMP_EXISTS_THM; SKOLEM_THM;
              LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
  DISCH_TAC THEN REWRITE_TAC[UNION_OF] THEN
  MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]
        LINDELOF_OPEN_IN) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `IMAGE (v:real^N->real^N->bool) t` THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);;

let LOCALLY_IMP_FINITE_UNION_OF = prove
 (`!P s:real^N->bool. compact s /\ locally P s ==> (FINITE UNION_OF P) s`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN
  DISCH_THEN
   (MP_TAC o GEN `x:real^N` o SPECL [`s:real^N->bool`; `x:real^N`]) THEN
  REWRITE_TAC[OPEN_IN_REFL; RIGHT_IMP_EXISTS_THM; SKOLEM_THM;
              LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
  DISCH_TAC THEN REWRITE_TAC[UNION_OF] THEN
  FIRST_ASSUM(MP_TAC o SPEC `IMAGE (u:real^N->real^N->bool) s` o
    GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `IMAGE (v:real^N->real^N->bool) t` THEN
  ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[]);;

let LOCALLY_DIFF_CLOSED = prove
 (`!P s t:real^N->bool.
        locally P s /\ closed_in (subtopology euclidean s) t
        ==> locally P (s DIFF t)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC OPEN_IN_DIFF THEN
  ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]);;

let LOCALLY_CLOSED_IN_EXPLICIT = prove
 (`!s v a:real^N.
        a IN v /\ open_in (subtopology euclidean s) v
        ==> ?u. a IN u /\
                open_in (subtopology euclidean s) u /\
                u SUBSET v /\
                (subtopology euclidean s) closure_of u SUBSET v`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real` THEN
  STRIP_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
  MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN DISCH_TAC THEN
  REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `b INTER s SUBSET v ==> c SUBSET b ==> s INTER c SUBSET v`)) THEN
  ASM_SIMP_TAC[GSYM CLOSURE_BALL; EUCLIDEAN_CLOSURE_OF] THEN
  MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]);;

let LOCALLY_CLOSED_IN = prove
 (`!s:real^N->bool. locally (closed_in (subtopology euclidean s)) s`,
  REWRITE_TAC[locally] THEN REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[CONJ_SYM] THEN
  DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_CLOSED_IN_EXPLICIT) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
  STRIP_TAC THEN
  EXISTS_TAC `(subtopology euclidean s) closure_of u:real^N->bool` THEN
  ASM_REWRITE_TAC[CLOSED_IN_CLOSURE_OF] THEN
  ASM_SIMP_TAC[CLOSURE_OF_SUBSET; OPEN_IN_SUBSET]);;

let LOCALLY_EMPTY = prove
 (`!P. locally P {}`,
  REWRITE_TAC[locally] THEN MESON_TAC[open_in; SUBSET; NOT_IN_EMPTY]);;

let LOCALLY_SING = prove
 (`!P a. locally P {a} <=> P {a}`,
  REWRITE_TAC[locally; open_in] THEN
  REWRITE_TAC[SET_RULE
   `(w SUBSET {a} /\ P) /\ x IN w <=> w = {a} /\ x = a /\ P`] THEN
  SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_SING] THEN
  REWRITE_TAC[SET_RULE
   `(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=>
    u = {a} /\ v = {a} /\ P /\ Q`] THEN
  REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; IN_SING] THEN
  REWRITE_TAC[FORALL_UNWIND_THM2; MESON[REAL_LT_01] `?x. &0 < x`]);;

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 LOCALLY_INTER_OPEN = prove
 (`!P s t u:real^N->bool.
        locally P s /\
        open_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) t
        ==> locally P (s INTER t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[locally; IN_INTER] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN
  DISCH_THEN(MP_TAC o SPECL [`t INTER v:real^N->bool`; `x:real^N`]) THEN
  ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER t:real^N->bool` THEN
      CONJ_TAC THENL
       [SUBGOAL_THEN `t INTER v:real^N->bool = (s INTER t) INTER v`
         (fun th -> ASM_SIMP_TAC[th; OPEN_IN_INTER; OPEN_IN_REFL]) THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
        ASM SET_TAC[];
        MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
        EXISTS_TAC `u:real^N->bool` THEN
        ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL] THEN
        ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]];
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      ASM SET_TAC[]];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] 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[]]);;

let LOCALLY_OPEN_INTER = prove
 (`!P s t u:real^N->bool.
        locally P t /\
        open_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) t
        ==> locally P (s INTER t)`,
  ONCE_REWRITE_TAC[INTER_COMM] THEN MESON_TAC[LOCALLY_INTER_OPEN]);;

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]);;

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_TRANSLATION = prove
 (`!P:(real^N->bool)->bool.
        (!a s. P (IMAGE (\x. a + x) s) <=> P s)
        ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)`,
  GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  MP_TAC(ISPECL
   [`P:(real^N->bool)->bool`; `P:(real^N->bool)->bool`;
    `\x:real^N. a + x`; `\x:real^N. --a + x`]
     HOMEOMORPHISM_LOCALLY) THEN
  REWRITE_TAC[homeomorphism] THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; GSYM IMAGE_o; o_DEF; IMAGE_ID;
              VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`] THEN
  MESON_TAC[]);;

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))`,
  GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  ASM_CASES_TAC `linear(f:real^M->real^N) /\ (!x y. f x = f y ==> x = y)` THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`Q:(real^M->bool)->bool`; `P:(real^N->bool)->bool`;
    `f:real^M->real^N`; `g:real^N->real^M`]
     HOMEOMORPHISM_LOCALLY) THEN
  ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN
  ASM_REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; FORALL_IN_IMAGE] THEN
  ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN MESON_TAC[]);;

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[]);;

let LOCALLY_FINE_COVERING_COMPACT = prove
 (`!P s:real^N->bool e.
        compact s /\ locally P s /\ &0 < e
        ==> ?f. FINITE f /\ UNIONS f = s /\
                !c. c IN f ==> P c /\ bounded c /\ diameter c <= e`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  FIRST_ASSUM(SUBST1_TAC o SPEC `P:(real^N->bool)->bool` o
    MATCH_MP LOCALLY_AND_SMALL_LE) THEN
  DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_IMP_FINITE_UNION_OF) THEN
  REWRITE_TAC[UNION_OF] THEN MESON_TAC[]);;

let LOCALLY_COUNTABLE = prove
 (`!s:real^N->bool. locally COUNTABLE s <=> COUNTABLE s`,
  GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL
   [DISCH_THEN(MP_TAC o GEN `x:real^N` o
      SPECL [`s:real^N->bool`; `x:real^N`]) THEN
    REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    REWRITE_TAC[OPEN_IN_REFL] THEN MAP_EVERY X_GEN_TAC
     [`u:real^N->real^N->bool`; `vu:real^N->real^N->bool`] THEN
    DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN
    EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) s)` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]
          LINDELOF_OPEN_IN) THEN
    ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC COUNTABLE_UNIONS THEN
    ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
    ASM_MESON_TAC[SUBSET; COUNTABLE_SUBSET];
    DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
    DISCH_TAC THEN REPEAT(EXISTS_TAC `w:real^N->bool`) THEN
    ASM_REWRITE_TAC[SUBSET_REFL] THEN
    ASM_MESON_TAC[COUNTABLE_SUBSET; OPEN_IN_IMP_SUBSET]]);;

let LOCALLY_CONSTANT = prove
 (`!f:real^N->A s.
        connected s
        ==> (locally (\u. ?c. !x. x IN u ==> f x = c) s <=>
             ?c. !x. x IN s ==> f x = c)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THENL
   [DISCH_TAC; MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]] THEN
  MATCH_MP_TAC LOCALLY_CONSTANT_IMP_CONSTANT THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `x:real^N`]) THEN
  ASM_REWRITE_TAC[OPEN_IN_REFL] THEN MESON_TAC[SUBSET]);;

let [LOCALLY_CONTINUOUS_ON; LOCALLY_CONTINUOUS_ON_ALT;
     LOCALLY_CONTINUOUS_ON_EXPLICIT] = (CONJUNCTS o prove)
 (`(!f:real^M->real^N s.
        locally (\u. f continuous_on u) s <=> f continuous_on s) /\
   (!f:real^M->real^N s.
        f continuous_on s <=>
        !x. x IN s ==> ?u v. open_in (subtopology euclidean s) u /\
                             x IN u /\ u SUBSET v /\ f continuous_on v) /\
   (!f:real^M->real^N s.
        f continuous_on s <=>
        !x. x IN s ==> ?u. open_in (subtopology euclidean s) u /\
                           x IN u /\ f continuous_on u)`,
  REWRITE_TAC[AND_FORALL_THM; locally] THEN REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(p ==> q) /\ (q ==> r) /\ (s ==> p) /\ (r ==> s)
    ==> (p <=> s) /\ (s <=> q) /\ (s <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[OPEN_IN_REFL];
    MESON_TAC[CONTINUOUS_ON_SUBSET];
    MESON_TAC[CONTINUOUS_ON_SUBSET; OPEN_IN_IMP_SUBSET; SUBSET_REFL];
    REWRITE_TAC[CONTINUOUS_ON] THEN
    MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[LIM_WITHIN_OPEN_IN]]);;

let LOCALLY_TO_COMPACTLY = prove
 (`!P s c:real^N->bool.
        (!t u. t SUBSET u /\ u SUBSET s /\ P u ==> P t) /\
        (!f. FINITE f /\ (!t. t IN f ==> P t /\ t SUBSET s)
             ==> P(UNIONS f)) /\
        locally P s /\ compact c /\ c SUBSET s
        ==> P c`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN
  DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
  ASM_REWRITE_TAC[OPEN_IN_REFL; RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
  DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
    GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_GEN]) THEN DISCH_THEN(MP_TAC o
    SPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  EXISTS_TAC `UNIONS (IMAGE (v:real^N->real^N->bool) k)` THEN
  REPEAT (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Local compactness.                                                        *)
(* ------------------------------------------------------------------------- *)

let LOCALLY_COMPACT_SPACE_SUBTOPOLOGY_EUCLIDEAN = prove
 (`!s:real^N->bool.
        locally_compact_space(subtopology euclidean s) <=>
        locally compact s`,
  GEN_TAC THEN
  REWRITE_TAC[GSYM NEIGHBOURHOOD_BASE_OF_EUCLIDEAN] THEN
  SIMP_TAC[LOCALLY_COMPACT_SPACE_NEIGHBOURHOOD_BASE;
           HAUSDORFF_SPACE_EUCLIDEAN; HAUSDORFF_SPACE_SUBTOPOLOGY] THEN
  REWRITE_TAC[COMPACT_IN_SUBTOPOLOGY; NEIGHBOURHOOD_BASE_OF] THEN
  REWRITE_TAC[COMPACT_IN_EUCLIDEAN] THEN
  MESON_TAC[SUBSET; OPEN_IN_IMP_SUBSET]);;

let LOCALLY_COMPACT = prove
 (`!s:real^N->bool.
        locally compact s <=>
        !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
                             open_in (subtopology euclidean s) u /\
                             compact v`,
  GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
     (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
    MESON_TAC[SUBSET_INTER];
    MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
    REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) 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
    EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
    EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
    ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
                 COMPACT_INTER; COMPACT_CBALL; IN_INTER] THEN
    MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
    ASM SET_TAC[]]);;

let LOCALLY_COMPACT_ALT = prove
 (`!s:real^N->bool.
        locally compact s <=>
        !x. x IN s
            ==> ?u. x IN u /\
                    open_in (subtopology euclidean s) u /\
                    compact(closure u) /\ closure u SUBSET s`,
  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN EQ_TAC THEN
  DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
  MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL;
            COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;

let LOCALLY_COMPACT_INTER_CBALL = prove
 (`!s:real^N->bool.
        locally compact s <=>
        !x. x IN s ==> ?e. &0 < e /\ closed(cball(x,e) INTER s)`,
  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT; OPEN_IN_CONTAINS_CBALL] THEN
  EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
  ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL
   [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN `cball(x:real^N,e) INTER s = cball (x,e) INTER v`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    ASM_SIMP_TAC[COMPACT_CBALL; COMPACT_INTER; COMPACT_IMP_CLOSED];
    X_GEN_TAC `e:real` THEN STRIP_TAC THEN
    EXISTS_TAC `ball(x:real^N,e) INTER s` THEN
    EXISTS_TAC `cball(x:real^N,e) INTER s` THEN
    REWRITE_TAC[GSYM OPEN_IN_CONTAINS_CBALL] THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET] THEN
    ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; BOUNDED_CBALL] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    MESON_TAC[SUBSET; IN_INTER; BALL_SUBSET_CBALL]]);;

let LOCALLY_COMPACT_INTER_CBALLS = prove
 (`!s:real^N->bool.
      locally compact s <=>
      !x. x IN s ==> ?e. &0 < e /\ !d. d <= e ==> closed(cball(x,d) INTER s)`,
  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL] THEN
  EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_REFL]] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
  ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `cball(x:real^N,d) INTER s = cball(x,d) INTER cball(x,e) INTER s`
  SUBST1_TAC THENL
   [REWRITE_TAC[GSYM INTER_ASSOC; GSYM CBALL_MIN_INTER] THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
    BINOP_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
    ASM_SIMP_TAC[CLOSED_INTER; CLOSED_CBALL]]);;

let LOCALLY_COMPACT_COMPACT = prove
 (`!s:real^N->bool.
        locally compact s <=>
        !k. k SUBSET s /\ compact k
            ==> ?u v. k SUBSET u /\
                      u SUBSET v /\
                      v SUBSET s /\
                      open_in (subtopology euclidean s) u /\
                      compact v`,
  GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_COMPACT] THEN EQ_TAC THEN
  REPEAT STRIP_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[SING_SUBSET; COMPACT_SING]] THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM] o
        check (is_forall o concl)) THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
   [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
  DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. k INTER u x) k`) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    ASM SET_TAC[];
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) t)` THEN
    EXISTS_TAC `UNIONS(IMAGE (v:real^N->real^N->bool) t)` THEN
    REPEAT CONJ_TAC THENL
     [ALL_TAC; ALL_TAC; ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS;
      MATCH_MP_TAC COMPACT_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE]] THEN
    ASM SET_TAC[]]);;

let LOCALLY_COMPACT_COMPACT_ALT = prove
 (`!s:real^N->bool.
        locally compact s <=>
        !k. k SUBSET s /\ compact k
            ==> ?u. k SUBSET u /\
                    open_in (subtopology euclidean s) u /\
                    compact(closure u) /\ closure u SUBSET s`,
  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN
  DISCH_TAC THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
  MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL;
            COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;

let LOCALLY_COMPACT_COMPACT_SUBOPEN = prove
 (`!s:real^N->bool.
        locally compact s <=>
        !k t. k SUBSET s /\ compact k /\ open t /\ k SUBSET t
              ==> ?u v. k SUBSET u /\ u SUBSET v /\ u SUBSET t /\ v SUBSET s /\
                        open_in (subtopology euclidean s) u /\
                        compact v`,
  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN
  EQ_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN
    ASM_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
     [`u INTER t:real^N->bool`; `closure(u INTER t:real^N->bool)`] THEN
    REWRITE_TAC[CLOSURE_SUBSET; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL
     [ASM SET_TAC[];
      TRANS_TAC SUBSET_TRANS `closure(u:real^N->bool)` THEN
      SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
      TRANS_TAC SUBSET_TRANS `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
      ASM_SIMP_TAC[OPEN_IN_INTER_OPEN];
      REWRITE_TAC[COMPACT_CLOSURE] THEN
      ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; SUBSET_TRANS;
                    COMPACT_IMP_BOUNDED]];
    FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `(:real^N)`]) THEN
    ASM_REWRITE_TAC[OPEN_UNIV; SUBSET_UNIV]]);;

let OPEN_IMP_LOCALLY_COMPACT = prove
 (`!s:real^N->bool. open s ==> locally compact s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM
   (MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
  ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  MAP_EVERY EXISTS_TAC [`ball(x:real^N,e)`; `cball(x:real^N,e)`] THEN
  ASM_REWRITE_TAC[BALL_SUBSET_CBALL; CENTRE_IN_BALL; COMPACT_CBALL] THEN
  MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN
  ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]);;

let CLOSED_IMP_LOCALLY_COMPACT = prove
 (`!s:real^N->bool. closed s ==> locally compact s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
   [`s INTER ball(x:real^N,&1)`; `s INTER cball(x:real^N,&1)`] THEN
  ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET; REAL_LT_01] THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
  ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
  MP_TAC(ISPECL [`x:real^N`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;

let IS_INTERVAL_LOCALLY_COMPACT_INTERVAL = prove
 (`!s:real^N->bool.
        is_interval s ==> locally (\k. ?a b. k = interval[a,b]) s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[locally] THEN
  REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`ww:real^N->bool`; `x:real^N`; `w:real^N->bool`] THEN
  ASM_CASES_TAC `s INTER w:real^N->bool = ww` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[IN_INTER] THEN
  STRIP_TAC THEN MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
   INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
  ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `e:real`] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN STRIP_TAC THEN
  EXISTS_TAC `s INTER ball(x:real^N,e) INTER interval(c,d)` THEN
  EXISTS_TAC `interval[a:real^N,b] INTER interval[c:real^N,d]` THEN
  EXISTS_TAC `ball(x:real^N,e) INTER interval(c,d)` THEN
  ASM_SIMP_TAC[OPEN_INTERVAL; OPEN_INTER; OPEN_BALL; IN_INTER] THEN
  ASM_REWRITE_TAC[CENTRE_IN_BALL; LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
   [REWRITE_TAC[INTER_INTERVAL] THEN MESON_TAC[];
    MP_TAC(ISPECL [`c:real^N`; `d:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
    ASM SET_TAC[]]);;

let IS_INTERVAL_IMP_LOCALLY_COMPACT = prove
 (`!s:real^N->bool. is_interval s ==> locally compact s`,
  GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP IS_INTERVAL_LOCALLY_COMPACT_INTERVAL) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN
  SIMP_TAC[LEFT_IMP_EXISTS_THM; COMPACT_INTERVAL]);;

let LOCALLY_COMPACT_UNIV = prove
 (`locally compact (:real^N)`,
  SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; OPEN_UNIV]);;

let LOCALLY_COMPACT_INTER = prove
 (`!s t:real^N->bool.
        locally compact s /\ locally compact t
        ==> locally compact (s INTER t)`,
  MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]);;

let LOCALLY_COMPACT_OPEN_IN = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean s) t /\ locally compact s
        ==> locally compact t`,
  REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; OPEN_IMP_LOCALLY_COMPACT]);;

let LOCALLY_COMPACT_CLOSED_IN = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean s) t /\ locally compact s
        ==> locally compact t`,
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; CLOSED_IMP_LOCALLY_COMPACT]);;

let LOCALLY_COMPACT_DELETE = prove
 (`!s a:real^N. locally compact s ==> locally compact (s DELETE a)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_COMPACT_OPEN_IN THEN
  EXISTS_TAC `s:real^N->bool` THEN
  ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL]);;

let SIGMA_COMPACT = prove
 (`!s:real^N->bool.
        locally compact s
        ==> ?f. COUNTABLE f /\ (!t. t IN f ==> compact t) /\ UNIONS f = s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_IMP_COUNTABLE_UNION_OF) THEN
  REWRITE_TAC[UNION_OF]);;

let HOMEOMORPHIC_LOCAL_COMPACTNESS = prove
 (`!s t:real^N->bool.
        s homeomorphic t ==> (locally compact s <=> locally compact t)`,
  MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
  REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]);;

let LOCALLY_COMPACT_TRANSLATION_EQ = prove
 (`!a:real^N s. locally compact (IMAGE (\x. a + x) s) <=>
                locally compact s`,
  MATCH_MP_TAC LOCALLY_TRANSLATION THEN
  REWRITE_TAC[COMPACT_TRANSLATION_EQ]);;

add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];;

let LOCALLY_COMPACT_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (locally compact (IMAGE f s) <=> locally compact s)`,
  MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
  REWRITE_TAC[COMPACT_LINEAR_IMAGE_EQ]);;

add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];;

let HOMEOMORPHISM_LOCAL_COMPACTNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (locally compact (IMAGE f k) <=> locally compact k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_LOCAL_COMPACTNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let LOCALLY_CLOSED = prove
 (`!s:real^N->bool. locally closed s <=> locally compact s`,
  GEN_TAC THEN EQ_TAC THENL
   [ALL_TAC; MESON_TAC[LOCALLY_MONO; COMPACT_IMP_CLOSED]] THEN
  REWRITE_TAC[locally] THEN DISCH_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
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  STRIP_TAC THEN
  EXISTS_TAC `u INTER ball(x:real^N,&1)` THEN
  EXISTS_TAC `v INTER cball(x:real^N,&1)` THEN
  ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL] THEN
  ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
  ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
  MP_TAC(ISPEC `x:real^N` BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;

let LOCALLY_COMPACT_CLOSED_UNION = prove
 (`!s t u:real^N->bool.
        locally compact s /\ locally compact t /\
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t
        ==> locally compact (s UNION t)`,
  SUBGOAL_THEN
   `!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)`
  MP_TAC THENL
   [ALL_TAC;
    REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_MESON_TAC[CLOSED_IN_SUBSET_TRANS; SUBSET_UNION; UNION_SUBSET;
                  CLOSED_IN_IMP_SUBSET]] THEN
  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]);;

let LOCALLY_COMPACT_OPEN_UNIONS = prove
 (`!f:(real^N->bool)->bool u.
        (!c. c IN f ==> locally compact c) /\
        (!c. c IN f ==> open_in (subtopology euclidean u) c)
        ==> locally compact (UNIONS f)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  REWRITE_TAC[LOCALLY_COMPACT_ALT; FORALL_IN_UNIONS] THEN
  MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `t:real^N->bool` o
    GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) [LOCALLY_COMPACT_ALT]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
  EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[UNIONS_SUBSET]] THEN
  ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]);;

let LOCALLY_COMPACT_OPEN_UNION = prove
 (`!s t:real^N->bool u.
        locally compact s /\ locally compact t /\
        open_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) t
        ==> locally compact (s UNION t)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{s:real^N->bool,t}`; `u:real^N->bool`]
    LOCALLY_COMPACT_OPEN_UNIONS) THEN
  ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_2]);;

let LOCALLY_COMPACT_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        locally compact s /\ locally compact t
        ==> locally compact (s PCROSS t)`,
  MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[COMPACT_PCROSS]);;

let LOCALLY_COMPACT_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        locally compact (s PCROSS t) <=>
        s = {} \/ t = {} \/ locally compact s /\ locally compact t`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; PCROSS_EMPTY; LOCALLY_EMPTY] THEN
  MATCH_MP_TAC(TAUT `(~p ==> s) /\ (~q ==> r) ==> p \/ q \/ r /\ s`) THEN
  CONJ_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `a:real^M`; X_GEN_TAC `b:real^N`] THEN
  DISCH_TAC THEN FIRST_ASSUM
   (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_COMPACT_INTER))
  THENL
   [DISCH_THEN(MP_TAC o SPEC `{a:real^M} PCROSS (:real^N)`);
    DISCH_THEN(MP_TAC o SPEC `(:real^M) PCROSS {b:real^N}`)] THEN
  ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; CLOSED_IMP_LOCALLY_COMPACT;
               CLOSED_UNIV; CLOSED_SING; INTER_PCROSS; INTER_UNIV;
               SET_RULE `a IN s ==> s INTER {a} = {a}`] THEN
  ASM_MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_LOCAL_COMPACTNESS]);;

let OPEN_IN_LOCALLY_COMPACT = prove
 (`!s t:real^N->bool.
        locally compact s
        ==> (open_in (subtopology euclidean s) t <=>
             t SUBSET s /\
             !k. compact k /\ k SUBSET s
                 ==> open_in (subtopology euclidean k) (k INTER t))`,
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT]) THEN
    DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
    ANTS_TAC THENL [ASM SET_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 EXISTS_TAC `t INTER u:real^N->bool` THEN
    ASM_REWRITE_TAC[IN_INTER; INTER_SUBSET] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `closure u:real^N->bool`) THEN
    ANTS_TAC THENL
     [SUBGOAL_THEN `(closure u:real^N->bool) SUBSET v` MP_TAC THENL
       [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
        REWRITE_TAC[COMPACT_CLOSURE] THEN
        ASM_MESON_TAC[SUBSET_TRANS; BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]];
      REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
      MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);;

let LOCALLY_COMPACT_PROPER_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\
        (!k. k SUBSET (IMAGE f s) /\ compact k
             ==> compact {x | x IN s /\ f x IN k})
        ==> (locally compact s <=> locally compact (IMAGE f s))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
                 `IMAGE (f:real^M->real^N) s`] PROPER_MAP) THEN
  ASM_REWRITE_TAC[SUBSET_REFL] THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC `y:real^N` THEN
    DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
    ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_ALT]) THEN
    DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN
    ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `?v. open_in (subtopology euclidean (IMAGE f s)) v /\
          y IN v /\
          {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET u`
    MP_TAC THENL
     [GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV)
       [GSYM SING_SUBSET] THEN
      MATCH_MP_TAC CLOSED_MAP_OPEN_SUPERSET_PREIMAGE THEN
      ASM_REWRITE_TAC[SING_SUBSET; IN_SING];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN `closure v SUBSET IMAGE (f:real^M->real^N) (closure u)`
      ASSUME_TAC THENL
       [TRANS_TAC SUBSET_TRANS `closure(IMAGE (f:real^M->real^N) u)` THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC SUBSET_CLOSURE THEN
          REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
          ASM SET_TAC[];
          MATCH_MP_TAC CLOSURE_MINIMAL THEN
          SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
          MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
          MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
          ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]];
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          BOUNDED_SUBSET)) THEN
        MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
        MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]];
    REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_ALT]) THEN
    DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
    ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `closure v:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN v}` THEN
    ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
      ASM_MESON_TAC[SUBSET_REFL];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `closure {x | x IN s /\ f x IN v} SUBSET
      {x | x IN s /\ (f:real^M->real^N) x IN closure v}`
    ASSUME_TAC THENL
     [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
      MP_TAC(ISPEC `v:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
      ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]]]);;

let LOCALLY_COMPACT_PROPER_IMAGE = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\
        (!k. k SUBSET (IMAGE f s) /\ compact k
             ==> compact {x | x IN s /\ f x IN k}) /\
        locally compact s
        ==> locally compact (IMAGE f s)`,
  MESON_TAC[LOCALLY_COMPACT_PROPER_IMAGE_EQ]);;

let LOCALLY_COMPACT_PROPER_CONTINUOUS_PREIMAGE = prove
 (`!f:real^M->real^N s t c.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        (!k. k SUBSET t /\ compact k
             ==> compact {x | x IN s /\ f x IN k}) /\
        locally compact c /\ c SUBSET t
        ==> locally compact {x | x IN s /\ f x IN c}`,
  REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
  STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN
  REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `k:real^N->bool`] THEN
  STRIP_TAC THEN MAP_EVERY EXISTS_TAC
   [`{x | x IN s /\ (f:real^M->real^N) x IN u}`;
    `{x | x IN s /\ (f:real^M->real^N) x IN k}`] THEN
  REPLICATE_TAC 3 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  CONJ_TAC THENL
   [SUBGOAL_THEN
     `{x | x IN s /\ (f:real^M->real^N) x IN u} =
      {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]);;

let MUMFORD_LEMMA = prove
 (`!f:real^M->real^N s t y.
        f continuous_on s /\ IMAGE f s SUBSET t /\ locally compact s /\
        y IN t /\ compact {x | x IN s /\ f x = y}
        ==> ?u v. open_in (subtopology euclidean s) u /\
                  open_in (subtopology euclidean t) v /\
                  {x | x IN s /\ f x = y} SUBSET u /\ y IN v /\
                  IMAGE f u SUBSET v /\
                  (!k. k SUBSET v /\ compact k
                       ==> compact {x | x IN u /\ f x IN k})`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}` o
   GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT]) THEN
  ASM_REWRITE_TAC[SUBSET_RESTRICT; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `(closure u:real^M->bool) SUBSET v` ASSUME_TAC THENL
   [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
    ALL_TAC] THEN
  SUBGOAL_THEN `compact(closure u:real^M->bool)` ASSUME_TAC THENL
   [ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
    ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED];
    ALL_TAC] THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `!b. open_in (subtopology euclidean t) b /\ y IN b
        ==> u INTER {x | x IN s /\ (f:real^M->real^N) x IN b} PSUBSET
            closure u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`
  MP_TAC THENL
   [REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET] THEN
    SIMP_TAC[CLOSURE_SUBSET;
             SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`] THEN
    MATCH_MP_TAC(MESON[] `!P. ~P s /\ P t ==> ~(s = t)`) THEN
    EXISTS_TAC
     `\a. !k. k SUBSET b /\ compact k
              ==> compact {x | x IN a /\ (f:real^M->real^N) x IN k}` THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
      REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL
       [`u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`;
        `b:real^N->bool`]) THEN
      ASM_REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN ANTS_TAC THENL
       [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM SET_TAC[];
        ASM SET_TAC[]];
      X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
      SUBGOAL_THEN
       `{x | x IN closure u INTER {x | x IN s /\ f x IN b} /\ f x IN k} =
        v INTER {x | x IN closure u /\ (f:real^M->real^N) x IN k}`
      SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_INTER_CLOSED] THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_CLOSURE] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]];
    DISCH_THEN(MP_TAC o GEN `n:num` o SPEC
     `t INTER ball(y:real^N,inv(&n + &1))`) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
    ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    SIMP_TAC[CLOSURE_SUBSET; SET_RULE
     `u SUBSET u'
      ==> (u INTER t PSUBSET u' INTER t <=>
           ?x. x IN u' /\ ~(x IN u) /\ x IN t)`] THEN
    REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `closure u:real^M->bool` compact) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN
    ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`l:real^M`; `r:num->num`] THEN STRIP_TAC THEN
    SUBGOAL_THEN `(f:real^M->real^N) l = y` ASSUME_TAC THENL
     [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
      EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN
      ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
       [SUBGOAL_THEN `(f:real^M->real^N) continuous_on closure u` MP_TAC THENL
         [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN
        REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN
        DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[o_THM];
        REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
        ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
        X_GEN_TAC `e:real` THEN DISCH_TAC THEN
        MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
        X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
        DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
        TRANS_TAC REAL_LT_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
        TRANS_TAC REAL_LT_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC REAL_LT_INV2 THEN
        ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `l:real^M`)) THEN
      REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN
      CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `e:real` THEN STRIP_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
      DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
      ASM_REWRITE_TAC[LE_REFL; o_THM] THEN ASM SET_TAC[]]]);;

let LOCALLY_EQ_COMPACTLY = prove
 (`!P s:real^N->bool.
        (!t u. t SUBSET u /\ u SUBSET s /\ P u ==> P t) /\
        (!f. FINITE f /\ (!t. t IN f ==> P t /\ t SUBSET s)
             ==> P(UNIONS f)) /\
        locally compact s
        ==> (locally P s <=> !c. compact c /\ c SUBSET s ==> P c)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_TO_COMPACTLY THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_AND_SUBSET]) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN ASM_MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* 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_OPEN_INTER_CLOSURE = prove
 (`!s:real^N->bool. locally compact s ==> ?t. open t /\ s = t INTER closure s`,
  REWRITE_TAC[GSYM LOCALLY_COMPACT_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
  (REWRITE_RULE[CONJ_ASSOC] LOCALLY_COMPACT_SUBSPACE_OPEN_IN_CLOSURE_OF))) THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV; HAUSDORFF_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN; EUCLIDEAN_CLOSURE_OF]);;

let LOCALLY_COMPACT_CLOSED_IN_OPEN = prove
 (`!s:real^N->bool.
    locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s`,
  GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM SUBST1_TAC THEN
  SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]);;

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[]]);;

let LOCALLY_COMPACT_CLOSED_INTER_OPEN = prove
 (`!s:real^N->bool.
        locally compact s <=> ?t u. closed t /\ open u /\ s = t INTER u`,
  MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT;
            LOCALLY_COMPACT_INTER; INTER_COMM; CLOSED_CLOSURE;
            LOCALLY_COMPACT_OPEN_INTER_CLOSURE]);;

let LOCALLY_COMPACT_CLOSED_DIFF = prove
 (`!s:real^N->bool.
        locally compact s <=> ?t u. closed t /\ closed u /\ t DIFF u = s`,
  GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_CLOSED_INTER_OPEN] THEN
  MATCH_MP_TAC(MESON[COMPL_COMPL]
    `(!t u. P t u <=> Q t (UNIV DIFF u))
     ==> ((?t u. P t u) <=> (?t u. Q t u))`) THEN
  REWRITE_TAC[GSYM OPEN_CLOSED; SET_RULE
    `t DIFF (UNIV DIFF s) = t INTER s`] THEN
  REWRITE_TAC[EQ_SYM_EQ]);;

let LOCALLY_COMPACT_CLOSURE_DIFF = prove
 (`!s:real^N->bool. locally compact s <=> closed(closure s DIFF s)`,
  GEN_TAC THEN EQ_TAC THENL
   [SIMP_TAC[LOCALLY_COMPACT_CLOSED_INTER_OPEN; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `u:real^N->bool`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN
     `closure(c INTER u) DIFF (c INTER u):real^N->bool =
      closure(c INTER u) INTER (c DIFF u)`
     (fun t -> ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSED_DIFF; CLOSED_INTER; t]) THEN
    MP_TAC(SET_RULE `c:real^N->bool = (c INTER u) UNION (c DIFF u)`) THEN
    DISCH_THEN(MP_TAC o AP_TERM `closure:(real^N->bool)->real^N->bool`) THEN
    ASM_SIMP_TAC[CLOSURE_UNION; CLOSURE_CLOSED; CLOSED_DIFF] THEN SET_TAC[];
    DISCH_TAC THEN
    SUBGOAL_THEN `s:real^N->bool = closure s DIFF (closure(s) DIFF s)`
    SUBST1_TAC THENL
     [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[];
      REWRITE_TAC[LOCALLY_COMPACT_CLOSED_DIFF] THEN
      ASM_MESON_TAC[CLOSED_CLOSURE]]]);;

(* ------------------------------------------------------------------------- *)
(* F_sigma and G_delta sets.                                                 *)
(* ------------------------------------------------------------------------- *)

let gdelta = new_definition
 `gdelta(s:real^N->bool) <=> (COUNTABLE INTERSECTION_OF open) s`;;

let fsigma = new_definition
 `fsigma (s:real^N->bool) <=> (COUNTABLE UNION_OF closed) s`;;

let FSIGMA_IN_EUCLIDEAN = prove
 (`fsigma_in euclidean = fsigma`,
  REWRITE_TAC[FUN_EQ_THM; fsigma_in; fsigma; CLOSED_IN_EUCLIDEAN]);;

let GDELTA_IN_EUCLIDEAN = prove
 (`gdelta_in euclidean = gdelta`,
  REWRITE_TAC[FUN_EQ_THM; gdelta_in; gdelta; OPEN_IN_EUCLIDEAN;
              TOPSPACE_EUCLIDEAN; RELATIVE_TO_UNIV]);;

let FSIGMA_UNIONS_COMPACT = prove
 (`!s:real^N->bool. fsigma s <=> (COUNTABLE UNION_OF compact) s`,
  GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN
  EQ_TAC THENL [ALL_TAC; MESON_TAC[COMPACT_IMP_CLOSED]] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `!c:real^N->bool. ?g.
        c IN u
        ==> COUNTABLE g /\ (!t. t IN g ==> compact t) /\ UNIONS g = c`
  MP_TAC THENL
   [ASM_MESON_TAC[SIGMA_COMPACT; CLOSED_IMP_LOCALLY_COMPACT]; ALL_TAC] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `f:(real^N->bool)->(real^N->bool)->bool` THEN
  STRIP_TAC THEN
  EXISTS_TAC`UNIONS {(f:(real^N->bool)->(real^N->bool)->bool) c | c IN u}` THEN
  REWRITE_TAC[SIMPLE_IMAGE] THEN CONJ_TAC THENL
   [MATCH_MP_TAC COUNTABLE_UNIONS THEN
    ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE];
    ASM SET_TAC[]]);;

let GDELTA_COMPLEMENT = prove
 (`!s. gdelta((:real^N) DIFF s) <=> fsigma s`,
  REWRITE_TAC[GSYM FSIGMA_IN_EUCLIDEAN; FSIGMA_IN_GDELTA_IN] THEN
  REWRITE_TAC[GDELTA_IN_EUCLIDEAN; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let FSIGMA_ASCENDING = prove
 (`!s:real^N->bool.
        fsigma s <=>
        ?c. (!n. compact(c n)) /\ (!n. c n SUBSET c(SUC n)) /\
            UNIONS {c n | n IN (:num)} = s`,
  REWRITE_TAC[FSIGMA_UNIONS_COMPACT] THEN
  SIMP_TAC[COUNTABLE_UNION_OF_ASCENDING; COMPACT_EMPTY; COMPACT_UNION]);;

let FSIGMA_COMPLEMENT = prove
 (`!s. fsigma((:real^N) DIFF s) <=> gdelta s`,
  ONCE_REWRITE_TAC[GSYM GDELTA_COMPLEMENT] THEN
  REWRITE_TAC[COMPL_COMPL]);;

let GDELTA_DESCENDING = prove
 (`!s:real^N->bool.
        gdelta s <=>
        ?u. (!n. open(u n)) /\ (!n. u(SUC n) SUBSET u n) /\
            INTERS {u n | n IN (:num)} = s`,
  REWRITE_TAC[GSYM GDELTA_IN_EUCLIDEAN; GDELTA_IN_DESCENDING] THEN
  REWRITE_TAC[GSYM OPEN_IN; ADD1]);;

let GDELTA_TRANSLATION = prove
 (`!a:real^N s. gdelta (IMAGE (\x. a + x) s) <=> gdelta s`,
  REWRITE_TAC[gdelta; INTERSECTION_OF] THEN GEOM_TRANSLATE_TAC[]);;

let FSIGMA_TRANSLATION = prove
 (`!a:real^N s. fsigma (IMAGE (\x. a + x) s) <=> fsigma s`,
  REWRITE_TAC[fsigma; UNION_OF] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [GDELTA_TRANSLATION; FSIGMA_TRANSLATION];;

let GDELTA_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (gdelta(IMAGE f s) <=> gdelta s)`,
  REWRITE_TAC[gdelta; INTERSECTION_OF] THEN GEOM_TRANSFORM_TAC[]);;

let FSIGMA_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (fsigma(IMAGE f s) <=> fsigma s)`,
  REWRITE_TAC[fsigma; UNION_OF] THEN GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [GDELTA_LINEAR_IMAGE; FSIGMA_LINEAR_IMAGE];;

let FSIGMA_LOCALLY_COMPACT = prove
 (`!s:real^N->bool. locally compact s ==> fsigma s`,
  MESON_TAC[fsigma; UNION_OF; SIGMA_COMPACT; COMPACT_IMP_CLOSED]);;

let OPEN_IMP_FSIGMA = prove
 (`!s:real^N->bool. open s ==> fsigma s`,
  MESON_TAC[OPEN_IMP_LOCALLY_COMPACT; FSIGMA_LOCALLY_COMPACT]);;

let CLOSED_IMP_FSIGMA = prove
 (`!s:real^N->bool. closed s ==> fsigma s`,
  MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; FSIGMA_LOCALLY_COMPACT]);;

let CLOSED_IMP_GDELTA = prove
 (`!s:real^N->bool. closed s ==> gdelta s`,
  REWRITE_TAC[closed; GSYM FSIGMA_COMPLEMENT; OPEN_IMP_FSIGMA]);;

let FSIGMA_SING = prove
 (`!x:real^N. fsigma {x}`,
  SIMP_TAC[CLOSED_IMP_FSIGMA; CLOSED_SING]);;

let GDELTA_SING = prove
 (`!x:real^N. gdelta {x}`,
  SIMP_TAC[CLOSED_IMP_GDELTA; CLOSED_SING]);;

let OPEN_IMP_GDELTA = prove
 (`!s:real^N->bool. open s ==> gdelta s`,
  REWRITE_TAC[GSYM OPEN_IN_EUCLIDEAN; GSYM GDELTA_IN_EUCLIDEAN] THEN
  REWRITE_TAC[OPEN_IMP_GDELTA_IN]);;

let GDELTA_EMPTY = prove
 (`gdelta {}`,
  SIMP_TAC[OPEN_IMP_GDELTA; OPEN_EMPTY]);;

let FSIGMA_EMPTY = prove
 (`fsigma {}`,
  SIMP_TAC[CLOSED_IMP_FSIGMA; CLOSED_EMPTY]);;

let GDELTA_UNIV = prove
 (`gdelta (:real^N)`,
  SIMP_TAC[OPEN_IMP_GDELTA; OPEN_UNIV]);;

let FSIGMA_UNIV = prove
 (`fsigma (:real^N)`,
  SIMP_TAC[CLOSED_IMP_FSIGMA; CLOSED_UNIV]);;

let GDELTA_INTERS = prove
 (`!g:(real^N->bool)->bool.
        COUNTABLE g /\ (!u. u IN g ==> gdelta u) ==> gdelta(INTERS g)`,
  GEN_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[INTERS_0; GDELTA_UNIV] THEN
  ASM_SIMP_TAC[GSYM GDELTA_IN_EUCLIDEAN; GDELTA_IN_INTERS]);;

let GDELTA_INTER = prove
 (`!s t:real^N->bool. gdelta s /\ gdelta t ==> gdelta(s INTER t)`,
  REWRITE_TAC[GSYM GDELTA_IN_EUCLIDEAN; GDELTA_IN_INTER]);;

let GDELTA_DIFF = prove
 (`!s t:real^N->bool. gdelta s /\ fsigma t ==> gdelta(s DIFF t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
  SIMP_TAC[GDELTA_INTER; GDELTA_COMPLEMENT]);;

let FSIGMA_UNIONS = prove
 (`!g:(real^N->bool)->bool.
        COUNTABLE g /\ (!u. u IN g ==> fsigma u) ==> fsigma(UNIONS g)`,
  REWRITE_TAC[GSYM FSIGMA_IN_EUCLIDEAN; FSIGMA_IN_UNIONS]);;

let COUNTABLE_IMP_FSIGMA = prove
 (`!s:real^N->bool. COUNTABLE s ==> fsigma s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `s = UNIONS {{x:real^N} | x IN s}` SUBST1_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; MATCH_MP_TAC FSIGMA_UNIONS] THEN
  ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[FSIGMA_SING]);;

let FSIGMA_UNION = prove
 (`!s t:real^N->bool. fsigma s /\ fsigma t ==> fsigma(s UNION t)`,
  REWRITE_TAC[GSYM FSIGMA_IN_EUCLIDEAN; FSIGMA_IN_UNION]);;

let GDELTA_UNION = prove
 (`!s t:real^N->bool. gdelta s /\ gdelta t ==> gdelta(s UNION t)`,
  REWRITE_TAC[GSYM GDELTA_IN_EUCLIDEAN; GDELTA_IN_UNION]);;

let FSIGMA_INTER = prove
 (`!s t:real^N->bool. fsigma s /\ fsigma t ==> fsigma(s INTER t)`,
  REWRITE_TAC[GSYM FSIGMA_IN_EUCLIDEAN; FSIGMA_IN_INTER]);;

let FSIGMA_DIFF = prove
 (`!s t:real^N->bool. fsigma s /\ gdelta t ==> fsigma(s DIFF t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
  SIMP_TAC[FSIGMA_INTER; FSIGMA_COMPLEMENT]);;

let GDELTA_UNIONS = prove
 (`!g:(real^N->bool)->bool.
        FINITE g /\ (!u. u IN g ==> gdelta u) ==> gdelta(UNIONS g)`,
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_0; GDELTA_EMPTY] THEN
  SIMP_TAC[UNIONS_INSERT; FORALL_IN_INSERT; GDELTA_UNION]);;

let FSIGMA_INTERS = prove
 (`!g:(real^N->bool)->bool.
        FINITE g /\ (!u. u IN g ==> fsigma u) ==> fsigma(INTERS g)`,
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[INTERS_0; FSIGMA_UNIV] THEN
  SIMP_TAC[INTERS_INSERT; FORALL_IN_INSERT; FSIGMA_INTER]);;

let OPEN_IN_FSIGMA = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean t) s /\ fsigma t ==> fsigma s`,
  REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_INTER THEN
  ASM_SIMP_TAC[OPEN_IMP_FSIGMA]);;

let CLOSED_IN_FSIGMA = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean t) s /\ fsigma t ==> fsigma s`,
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_INTER THEN
  ASM_SIMP_TAC[CLOSED_IMP_FSIGMA]);;

let OPEN_IN_GDELTA = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean t) s /\ gdelta t ==> gdelta s`,
  REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN
  ASM_SIMP_TAC[OPEN_IMP_GDELTA]);;

let CLOSED_IN_GDELTA = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean t) s /\ gdelta t ==> gdelta s`,
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN
  ASM_SIMP_TAC[CLOSED_IMP_GDELTA]);;

let GDELTA_LOCALLY_COMPACT = prove
 (`!s:real^N->bool. locally compact s ==> gdelta s`,
  GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP
    LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
  ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC GDELTA_INTER THEN
  ASM_SIMP_TAC[OPEN_IMP_GDELTA; CLOSED_IMP_GDELTA; CLOSED_CLOSURE]);;

let FSIGMA_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s. f continuous_on s /\ fsigma s ==> fsigma (IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FSIGMA_UNIONS_COMPACT]) THEN
  REWRITE_TAC[UNION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool`
    (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_REWRITE_TAC[IMAGE_UNIONS] THEN
  MATCH_MP_TAC FSIGMA_UNIONS THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN
  MATCH_MP_TAC CLOSED_IMP_FSIGMA THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
  ASM SET_TAC[]);;

let HOMEOMORPHIC_FSIGMANESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (fsigma s <=> fsigma t)`,
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MESON_TAC[FSIGMA_CONTINUOUS_IMAGE]);;

let HOMEOMORPHISM_FSIGMANESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (fsigma(IMAGE f k) <=> fsigma k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_FSIGMANESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let FSIGMA_FSIGMA_PROJECTION = prove
 (`!s:real^M->bool t:real^(M,N)finite_sum->bool.
      IMAGE fstcart t SUBSET s /\ fsigma t
      ==> fsigma {y | ?x. x IN s /\ pastecart x y IN t}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{y:real^N | ?x:real^M. x IN s /\ pastecart x y IN t} =
    IMAGE sndcart t`
  SUBST1_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART;
                EXISTS_PASTECART; FSTCART_PASTECART; PASTECART_IN_PCROSS;
                IN_ELIM_THM; SNDCART_PASTECART] THEN
    MESON_TAC[];
    MATCH_MP_TAC FSIGMA_CONTINUOUS_IMAGE THEN
    ASM_SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON]]);;

let CONTINUOUS_FSIGMA_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ fsigma s /\ fsigma t
        ==> fsigma {x | x IN s /\ f x IN t}`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fsigma]) THEN
  REWRITE_TAC[UNION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  SUBGOAL_THEN
   `!t. t IN g
        ==> closed_in (subtopology euclidean s)
                      {x | x IN s /\ (f:real^M->real^N) x IN t}`
  MP_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE];
    REWRITE_TAC[CLOSED_IN_CLOSED]] THEN
  GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `u:(real^N->bool)->(real^M->bool)` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ f x IN UNIONS g} =
    s INTER (UNIONS (IMAGE (u:(real^N->bool)->(real^M->bool)) g))`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC FSIGMA_INTER THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC FSIGMA_UNIONS THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; CLOSED_IMP_FSIGMA]);;

let CONTINUOUS_GDELTA_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ gdelta s /\ gdelta t
        ==> gdelta {x | x IN s /\ f x IN t}`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gdelta]) THEN
  REWRITE_TAC[INTERSECTION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[INTERS_0; IN_UNIV; SET_RULE `{x | x IN s} = s`] THEN
  SUBGOAL_THEN
   `!t. t IN g
        ==> open_in (subtopology euclidean s)
                    {x | x IN s /\ (f:real^M->real^N) x IN t}`
  MP_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_OPEN_IN_PREIMAGE];
    REWRITE_TAC[OPEN_IN_OPEN]] THEN
  GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `u:(real^N->bool)->(real^M->bool)` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ f x IN INTERS g} =
    s INTER (INTERS (IMAGE (u:(real^N->bool)->(real^M->bool)) g))`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC GDELTA_INTER THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC GDELTA_INTERS THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; OPEN_IMP_GDELTA]);;

let FSIGMA_PROPER_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k})
        ==> (!k. k SUBSET t /\ fsigma k ==> fsigma {x | x IN s /\ f x IN k})`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[FSIGMA_UNIONS_COMPACT; UNION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  EXISTS_TAC `IMAGE (\c. {x | x IN s /\ (f:real^M->real^N) x IN c}) g` THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; UNIONS_IMAGE] THEN
  CONJ_TAC THENL [REPEAT STRIP_TAC; ASM SET_TAC[]] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);;

let FSIGMA_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        fsigma s /\ fsigma t ==> fsigma(s PCROSS t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `f:(real^M->bool)->bool` (STRIP_ASSUME_TAC o GSYM))
   (X_CHOOSE_THEN `g:(real^N->bool)->bool` (STRIP_ASSUME_TAC o GSYM))) THEN
  EXISTS_TAC
   `{(s PCROSS t):real^(M,N)finite_sum->bool | s IN f /\ t IN g}` THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC; CLOSED_PCROSS] THEN
  ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT] THEN
  REWRITE_TAC[UNIONS_GSPEC; EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
              IN_ELIM_THM] THEN
  ASM SET_TAC[]);;

let FSIGMA_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        fsigma(s PCROSS t) <=> s = {} \/ t = {} \/ fsigma s /\ fsigma t`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[FSIGMA_PCROSS; PCROSS_EMPTY; FSIGMA_EMPTY] THEN
  MATCH_MP_TAC(TAUT `(~p /\ ~q ==> r) ==> p \/ q \/ r`) THEN STRIP_TAC THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL
     [`fstcart:real^(M,N)finite_sum->real^M`;
      `(s:real^M->bool) PCROSS (t:real^N->bool)`]
     FSIGMA_CONTINUOUS_IMAGE);
    MP_TAC(ISPECL
     [`sndcart:real^(M,N)finite_sum->real^N`;
      `(s:real^M->bool) PCROSS (t:real^N->bool)`]
     FSIGMA_CONTINUOUS_IMAGE)] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
  ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS]);;

let GDELTA_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        gdelta s /\ gdelta t ==> gdelta(s PCROSS t)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `s PCROSS t = (s PCROSS (:real^N)) INTER ((:real^M) PCROSS t)`
  SUBST1_TAC THENL [REWRITE_TAC[INTER_PCROSS; INTER_UNIV]; ALL_TAC] THEN
  MATCH_MP_TAC GDELTA_INTER THEN CONJ_TAC THENL
   [UNDISCH_TAC `gdelta(s:real^M->bool)`;
    UNDISCH_TAC `gdelta(t:real^N->bool)`] THEN
  REWRITE_TAC[gdelta; INTERSECTION_OF; LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `f:(real^M->bool)->bool` THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    EXISTS_TAC `IMAGE (\s:real^M->bool. s PCROSS (:real^N)) f`;
    X_GEN_TAC `f:(real^N->bool)->bool` THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    EXISTS_TAC `IMAGE (\s:real^N->bool. (:real^M) PCROSS s) f`] THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; OPEN_PCROSS; OPEN_UNIV] THEN
  REWRITE_TAC[INTERS_IMAGE; EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
              IN_ELIM_THM; IN_UNIV] THEN
  SET_TAC[]);;

let GDELTA_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        gdelta(s PCROSS t) <=> s = {} \/ t = {} \/ gdelta s /\ gdelta t`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[GDELTA_PCROSS; PCROSS_EMPTY; GDELTA_EMPTY] THEN
  MATCH_MP_TAC(TAUT `(~p /\ ~q ==> r) ==> p \/ q \/ r`) THEN
  REPEAT STRIP_TAC THENL
   [UNDISCH_TAC `~(t:real^N->bool = {})`;
    UNDISCH_TAC `~(s:real^M->bool = {})`] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `y:real^N`; X_GEN_TAC `x:real^M`] THEN
  DISCH_TAC THENL
   [SUBGOAL_THEN `s = {x | x IN (:real^M) /\
                           pastecart x (y:real^N) IN (s PCROSS t)}`
    SUBST1_TAC THENL
     [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC];
    SUBGOAL_THEN `t = {y | y IN (:real^N) /\
                           pastecart (x:real^M) y IN (s PCROSS t)}`
    SUBST1_TAC THENL
     [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC]] THEN
  MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN
  ASM_REWRITE_TAC[GDELTA_UNIV] THEN
  MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
  REWRITE_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;

let CARD_EQ_GDELTA_SETS = prove
 (`{s:real^N->bool | gdelta s} =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS
     `IMAGE INTERS
         {g | COUNTABLE g /\ g SUBSET {s:real^N->bool | open s}}` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_LE_SUBSET THEN
      REWRITE_TAC[SUBSET; IN_IMAGE; gdelta; INTERSECTION_OF; IN_ELIM_THM] THEN
      GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
      TRANS_TAC CARD_LE_TRANS
       `{g | COUNTABLE g /\ g SUBSET {s:real^N->bool | open s}}` THEN
      REWRITE_TAC[CARD_LE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
      ONCE_REWRITE_TAC[CONJ_SYM] THEN
      MATCH_MP_TAC CARD_EQ_COUNTABLE_SUBSETS_SUBREAL THEN
      SUBGOAL_THEN `{s:real^N->bool | open s} =_c (:real)` MP_TAC THENL
       [REWRITE_TAC[CARD_EQ_OPEN_SETS]; SIMP_TAC[CARD_EQ_IMP_LE]] THEN
      DISCH_THEN(SUBST1_TAC o MATCH_MP CARD_INFINITE_CONG) THEN
      REWRITE_TAC[real_INFINITE]];
    TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
      REWRITE_TAC[CARD_EQ_CLOSED_SETS];
      MATCH_MP_TAC CARD_LE_SUBSET THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM; CLOSED_IMP_GDELTA]]]);;

let CARD_EQ_FSIGMA_SETS = prove
 (`{s:real^N->bool | fsigma s} =_c (:real)`,
  TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | gdelta s}` THEN
  REWRITE_TAC[CARD_EQ_GDELTA_SETS] THEN REWRITE_TAC[EQ_C_BIJECTIONS] THEN
  REPEAT(EXISTS_TAC `\s. (:real^N) DIFF s`) THEN
  SIMP_TAC[IN_ELIM_THM; FSIGMA_COMPLEMENT; GDELTA_COMPLEMENT] THEN
  SET_TAC[]);;

let GDELTA_POINTS_OF_CONVERGENCE_WITHIN = prove
 (`!f:real^M->real^N s. gdelta {x | ?l. (f --> l) (at x within s)}`,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN
   `{a | ?l. ((f:real^M->real^N) --> l) (at a within s)} =
    INTERS {UNIONS {u | open u /\
                        ?b. !x y. x IN (s INTER u) DELETE b /\
                                  y IN (s INTER u) DELETE b
                                  ==> dist(f x,f y) < inv(&n + &1)} |
            n IN (:num)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[CONVERGENT_EQ_ZERO_OSCILLATION; EXTENSION] THEN
    REWRITE_TAC[IN_ELIM_THM; INTERS_GSPEC; UNIONS_GSPEC; IN_UNIV] THEN
    X_GEN_TAC `a:real^M` THEN EQ_TAC THEN DISCH_TAC THENL
     [X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `inv(&n + &1)`) THEN
      REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN MESON_TAC[];
      MATCH_MP_TAC FORALL_POS_MONO_1 THEN
      CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
      X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
      DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool`
        (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
      FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
      ASM_CASES_TAC `b:real^M = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
      EXISTS_TAC `u INTER ball(a:real^M,dist(b,a))` THEN
      ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL;
                   IN_DELETE; GSYM DIST_NZ] THEN
      REWRITE_TAC[IN_BALL] THEN
      REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[IN_INTER; IN_DELETE] THEN
      ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]];
    MATCH_MP_TAC GDELTA_INTERS THEN
    SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN
    MATCH_MP_TAC OPEN_IMP_GDELTA THEN MATCH_MP_TAC OPEN_UNIONS THEN
    SET_TAC[]]);;

let GDELTA_POINTS_OF_CONVERGENCE_AT = prove
 (`!f:real^M->real^N. gdelta {x | ?l. (f --> l) (at x)}`,
  ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
  REWRITE_TAC[GDELTA_POINTS_OF_CONVERGENCE_WITHIN]);;

let GDELTA_POINTS_OF_CONTINUITY_WITHIN = prove
 (`!f:real^M->real^N s.
        ?t. gdelta t /\
            {x | x IN s /\ f continuous (at x within s)} = s INTER t`,
  REPEAT GEN_TAC THEN
  EXISTS_TAC
   `INTERS {UNIONS {u | open u /\
                        !x y. x IN s INTER u /\ y IN s INTER u
                              ==> norm((f:real^M->real^N) x - f y)
                                  < inv(&n + &1)} |
            n IN (:num)}` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC GDELTA_INTERS THEN
    SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC OPEN_IMP_GDELTA THEN MATCH_MP_TAC OPEN_UNIONS THEN
    SIMP_TAC[IN_ELIM_THM];
    REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER] THEN
    REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; UNIONS_GSPEC; IN_UNIV] THEN
    X_GEN_TAC `x:real^M` THEN
    ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[continuous_within] THEN
    W(MP_TAC o PART_MATCH (rand o rand) FORALL_POS_MONO_1_EQ o rand o snd) THEN
    ANTS_TAC THENL
     [MESON_TAC[REAL_LT_TRANS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
    EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `ball(x:real^M,d)` THEN
      ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
      MAP_EVERY X_GEN_TAC [`y:real^M`; `z:real^M`] THEN
      REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
        MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `z:real^M` th)) THEN
      ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN
      CONV_TAC NORM_ARITH;
      FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; dist] THEN
      REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      REPEAT(FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) THEN
      ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist]]]);;

let GDELTA_POINTS_OF_CONTINUITY = prove
 (`!f:real^M->real^N. gdelta {x | f continuous at x}`,
  GEN_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`]
        GDELTA_POINTS_OF_CONTINUITY_WITHIN) THEN
  SIMP_TAC[WITHIN_UNIV; IN_UNIV; INTER_UNIV; LEFT_IMP_EXISTS_THM]);;

(* ------------------------------------------------------------------------- *)
(* Lavrentiev extension theorem.                                             *)
(* ------------------------------------------------------------------------- *)

let LAVRENTIEV = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\ gdelta t
        ==> ?u g. gdelta u /\ s SUBSET u /\ u SUBSET closure s /\
                  g continuous_on u /\ IMAGE g u SUBSET t /\
                  !x. x IN s ==> g x = f x`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`euclidean:(real^M)topology`; `s:real^M->bool`;
                 `subtopology euclidean (t:real^N->bool)`; `f:real^M->real^N`]
        LAVRENTIEV_EXTENSION) THEN
  ASM_SIMP_TAC[METRIZABLE_SPACE_EUCLIDEAN; CONTINUOUS_MAP_EUCLIDEAN2;
               COMPLETELY_METRIZABLE_SPACE_EUCLIDEAN; GSYM CONJ_ASSOC;
               COMPLETELY_METRIZABLE_SPACE_GDELTA_IN; TOPSPACE_EUCLIDEAN;
               SUBSET_UNIV; GDELTA_IN_EUCLIDEAN; EUCLIDEAN_CLOSURE_OF]);;

let LAVRENTIEV_HOMEOMORPHISM = prove
 (`!f:real^M->real^N f' s s'.
        homeomorphism (s,s') (f,f')
        ==> ?u u' g g'.
                gdelta u /\ s SUBSET u /\ u SUBSET closure s /\
                gdelta u' /\ s' SUBSET u' /\ u' SUBSET closure s' /\
                (!x. x IN s ==> g x = f x) /\ (!x. x IN s' ==> g' x = f' x) /\
                homeomorphism (u,u') (g,g')`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`]
        LAVRENTIEV) THEN
  ASM_REWRITE_TAC[GDELTA_UNIV; SUBSET_UNIV; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`f':real^N->real^M`; `s':real^N->bool`; `(:real^M)`]
        LAVRENTIEV) THEN
  ASM_REWRITE_TAC[GDELTA_UNIV; SUBSET_UNIV; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `g':real^N->real^M`] THEN
  STRIP_TAC THEN MAP_EVERY EXISTS_TAC
   [`{x | x IN v /\ (g:real^M->real^N) x IN v'}`;
    `{x | x IN v' /\ (g':real^N->real^M) x IN v}`;
    `g:real^M->real^N`; `g':real^N->real^M`] THEN
  REPLICATE_TAC 2
   (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_GDELTA_PREIMAGE]; ALL_TAC] THEN
    REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC])) THEN
  REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  ONCE_REWRITE_TAC[TAUT
   `p /\ q /\ r /\ p' /\ q' /\ r' <=>
    (r /\ r') /\ (p /\ p' ==> q /\ q') /\ (p /\ p')`] THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]] THEN
  CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
  REWRITE_TAC[GSYM IN_SING] THEN
  MATCH_MP_TAC FORALL_IN_INTERMEDIATE_CLOSURE THENL
   [EXISTS_TAC `s:real^M->bool`; EXISTS_TAC `s':real^N->bool`] THEN
  REWRITE_TAC[IN_SING; VECTOR_SUB_EQ; CLOSED_SING] THEN
  (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
  MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] 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[]);;

let LAVRENTIEV_HOMEOMORPHISM_SELF = prove
 (`!f:real^N->real^N f' s.
        homeomorphism (s,s) (f,f')
        ==> ?u g g'.
                gdelta u /\ s SUBSET u /\ u SUBSET closure s /\
                (!x. x IN s ==> g x = f x /\ g' x = f' x) /\
                homeomorphism (u,u) (g,g')`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` MP_TAC) THEN
  GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN
  GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^N->real^N` THEN
  STRIP_TAC THEN ASM_SIMP_TAC[] THEN
  STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION
   `h 0 = u /\
    (!n. h(SUC n) = h n INTER IMAGE g (h n) INTER
                    {x:real^N | x IN u /\ g x IN h n})`) THEN
  EXISTS_TAC `INTERS {h n:real^N->bool | n IN (:num)}` THEN
  SUBGOAL_THEN `!n. (h:num->real^N->bool) n SUBSET u` ASSUME_TAC THENL
   [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC GDELTA_INTERS THEN
    SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
    MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    MATCH_MP_TAC GDELTA_INTER THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC GDELTA_INTER THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN CONJ_TAC THENL
     [SUBGOAL_THEN
       `IMAGE (g:real^N->real^N) (h(n:num)) = {x | x IN v /\ g' x IN h n}`
      SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN
    ASM_REWRITE_TAC[];
    REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC; IN_UNIV] THEN
    MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[SUBSET_INTER] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    MATCH_MP_TAC(SET_RULE
     `!a. a IN s /\ f a SUBSET t ==> INTERS {f x | x IN s} SUBSET t`) THEN
    EXISTS_TAC `0` THEN ASM_REWRITE_TAC[IN_UNIV];
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHISM_OF_SUBSETS)) THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `!a. a IN s /\ f a SUBSET t ==> INTERS {f x | x IN s} SUBSET t`) THEN
      EXISTS_TAC `0` THEN ASM SET_TAC[];
      MATCH_MP_TAC(SET_RULE
       `!a. a IN s /\ f a SUBSET t ==> INTERS {f x | x IN s} SUBSET t`) THEN
      EXISTS_TAC `SUC 0` THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
      MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
       [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
        REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
        GEN_TAC THEN MATCH_MP_TAC(MESON[]
         `(!n. P(SUC n) ==> Q n) ==> (!n. P n) ==> (!n. Q n)`) THEN
        ASM SET_TAC[];
        REWRITE_TAC[SUBSET; IN_IMAGE; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
        X_GEN_TAC `x:real^N` THEN
        DISCH_THEN(fun th ->
          EXISTS_TAC `(g':real^N->real^N) x` THEN CONJ_TAC THEN MP_TAC th)
        THENL
         [DISCH_THEN(MP_TAC o SPEC `SUC 0`);
          MATCH_MP_TAC(MESON[]
          `(!n. P(SUC n) ==> Q n) ==> (!n. P n) ==> (!n. Q n)`)] THEN
        ASM_REWRITE_TAC[] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]]]);;

let HOMEOMORPHIC_GDELTANESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (gdelta s <=> gdelta t)`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool.
          s homeomorphic t ==> gdelta s ==> gdelta t`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
    MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `g':real^N->real^M`] THEN
    STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
    SUBGOAL_THEN `t = {x | x IN v /\ (g':real^N->real^M) x IN s}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_GDELTA_PREIMAGE THEN ASM_SIMP_TAC[]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC lemma THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let HOMEOMORPHISM_GDELTANESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (gdelta(IMAGE f k) <=> gdelta k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_GDELTANESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Effective countability of closed or open chains.                          *)
(* ------------------------------------------------------------------------- *)

let EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS = prove
 (`!f v:real^N->bool.
        (!s. s IN f ==> closed_in (subtopology euclidean v) s \/
                        open_in (subtopology euclidean v) s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ UNIONS f' = UNIONS f`,
  let lemma = prove
   (`!f v:real^N->bool.
          (!s. s IN f ==> closed_in (subtopology euclidean v) s) /\
          (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
          ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ UNIONS f' = UNIONS f`,
    REPEAT STRIP_TAC THEN
    ASM_CASES_TAC `?s:real^N->bool. s IN f /\ !s'. s' IN f ==> s' SUBSET s`
    THENL
     [FIRST_X_ASSUM(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `{s:real^N->bool}` THEN
      ASM_REWRITE_TAC[COUNTABLE_SING; SING_SUBSET; UNIONS_1] THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    MP_TAC(ISPEC `\(s:real^N->bool) t. s IN f /\ t IN f /\ s SUBSET t`
          TOSET_COFINAL_WOSET) THEN
    SUBGOAL_THEN
     `fld(\(s:real^N->bool) t. s IN f /\ t IN f /\ s SUBSET t) = f`
    ASSUME_TAC THENL
     [REWRITE_TAC[fld; IN_ELIM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN
    ASM_REWRITE_TAC[toset; poset] THEN ANTS_TAC THENL
     [ASM_MESON_TAC[IN; SUBSET_REFL; SUBSET_TRANS; SUBSET_ANTISYM];
      DISCH_THEN(X_CHOOSE_THEN `w:((real^N->bool)->(real^N->bool)->bool)`
          STRIP_ASSUME_TAC)] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP FLD_SUBSET) THEN ASM_REWRITE_TAC[] THEN
    ABBREV_TAC `f':(real^N->bool)->bool = fld w` THEN DISCH_TAC THEN
    EXISTS_TAC `f':(real^N->bool)->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MP_TAC(ISPEC `v:real^N->bool` SUBSET_SECOND_COUNTABLE) THEN
    DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CARD_LE_COUNTABLE)) THEN
    MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN
    EXISTS_TAC `\b c:real^N->bool.
                    DISJOINT b c /\
                    !c'. c' IN f' /\ c PSUBSET c' ==> ~(DISJOINT b c')` THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL
     [ALL_TAC;
      REPEAT STRIP_TAC THEN
      MATCH_MP_TAC(SET_RULE
       `(s SUBSET t \/ t SUBSET s) /\ ~(s PSUBSET t) /\ ~(t PSUBSET s)
        ==> s = t`) THEN
      ASM_MESON_TAC[SUBSET]] THEN
    X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `\c':real^N->bool. c' IN f' /\ c PSUBSET c'` o
      last o CONJUNCTS o GEN_REWRITE_RULE I [woset]) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `?c':real^N->bool. c' IN f /\ ~(c' SUBSET c)`
      STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `c PSUBSET (c':real^N->bool)` ASSUME_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `?c'':real^N->bool. c'' IN f' /\ c' SUBSET c''` MP_TAC THENL
       [ASM SET_TAC[]; REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN
      MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
      DISCH_THEN(X_CHOOSE_THEN `c':real^N->bool` STRIP_ASSUME_TAC)] THEN
    SUBGOAL_THEN `?p:real^N. p IN c' /\ ~(p IN c)` STRIP_ASSUME_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN `open_in (subtopology euclidean v) (v DIFF c:real^N->bool)`
    (ANTE_RES_THEN MP_TAC) THENL
     [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN ASM
      SET_TAC[];
      DISCH_THEN(X_CHOOSE_THEN `bb:(real^N->bool)->bool`
        STRIP_ASSUME_TAC)] THEN
    SUBGOAL_THEN `(p:real^N) IN v DIFF c` MP_TAC THENL
     [ASM_MESON_TAC[SUBSET; IN_DIFF; CLOSED_IN_IMP_SUBSET];
      ASM_REWRITE_TAC[IN_UNIONS]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
    STRIP_TAC THEN REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
    UNDISCH_THEN
     `!x y:real^N->bool. w x y ==> x IN f /\ y IN f /\ x SUBSET y`
     (MP_TAC o SPECL [`c':real^N->bool`; `d:real^N->bool`]) THEN
    ASM SET_TAC[]) in
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`{s:real^N->bool | s IN f /\ closed_in (subtopology euclidean v) s}`;
    `v:real^N->bool`] lemma) THEN
  MP_TAC(ISPECL
   [`{s:real^N->bool | s IN f /\ open_in (subtopology euclidean v) s}`;
    `v:real^N->bool`] LINDELOF_OPEN_IN) THEN
  ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `fo:(real^N->bool)->bool` THEN STRIP_TAC THEN
  X_GEN_TAC `fc:(real^N->bool)->bool` THEN STRIP_TAC THEN
  EXISTS_TAC `fo UNION fc:(real^N->bool)->bool` THEN
  ASM_REWRITE_TAC[COUNTABLE_UNION] THEN ASM SET_TAC[]);;

let COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN = prove
 (`!f v:real^N->bool.
        ~(f = {}) /\
        (!s. s IN f ==> closed_in (subtopology euclidean v) s \/
                        open_in (subtopology euclidean v) s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?u. (!n. u(n) IN f) /\ (!n. u(n) SUBSET u(SUC n)) /\
                UNIONS {u n | n IN (:num)} = UNIONS f`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `UNIONS f:real^N->bool = {}` THENL
   [EXISTS_TAC `(\n. {}):num->real^N->bool` THEN
    ASM_REWRITE_TAC[SUBSET_REFL; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EMPTY_UNIONS]) THEN
    ASM_MESON_TAC[MEMBER_NOT_EMPTY];
    MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `v:real^N->bool`]
        EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `f':(real^N->bool)->bool` COUNTABLE_ASCENDING_CHAIN) THEN
    ASM_REWRITE_TAC[] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[UNIONS_0; SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]);;

let EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS = prove
 (`!f v:real^N->bool.
        (!s. s IN f ==> closed_in (subtopology euclidean v) s \/
                        open_in (subtopology euclidean v) s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ INTERS f' = INTERS f`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `f SUBSET {v:real^N->bool}` THENL
   [EXISTS_TAC `f:(real^N->bool)->bool` THEN
    ASM_MESON_TAC[COUNTABLE_SUBSET; COUNTABLE_SING; SUBSET_REFL];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`IMAGE (\s:real^N->bool. v DIFF s) f`; `v:real^N->bool`]
   EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS) THEN
  ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_IMAGE_2] THEN ANTS_TAC THENL
   [ASM_MESON_TAC[SET_RULE `s SUBSET t ==> v DIFF t SUBSET v DIFF s`;
                  OPEN_IN_REFL; CLOSED_IN_REFL; CLOSED_IN_DIFF; OPEN_IN_DIFF];
    REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:(real^N->bool)->bool` THEN
    ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THENL
     [DISCH_THEN(MP_TAC o SYM o last o CONJUNCTS) THEN
      ASM_REWRITE_TAC[EMPTY_UNIONS; IMAGE_CLAUSES; UNIONS_0] THEN
      ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN
      DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
       `(!u. u IN f ==> v DIFF u = {})
        ==> (!u. u IN f ==> u SUBSET v)
            ==> !u. u IN f ==> u = v`)) THEN
      ANTS_TAC THENL
       [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET];
        ASM_REWRITE_TAC[GSYM IN_SING; GSYM SUBSET]];
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(SET_RULE
     `!v. s SUBSET v /\ t SUBSET v /\ v DIFF s = v DIFF t ==> s = t`) THEN
    EXISTS_TAC `v:real^N->bool` THEN
    ASM_REWRITE_TAC[DIFF_INTERS; SIMPLE_IMAGE] THEN
    CONJ_TAC THEN MATCH_MP_TAC INTERS_SUBSET THEN
    (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET; SUBSET]]]);;

let COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN = prove
 (`!f v:real^N->bool.
        ~(f = {}) /\
        (!s. s IN f ==> closed_in (subtopology euclidean v) s \/
                        open_in (subtopology euclidean v) s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?u. (!n. u(n) IN f) /\ (!n. u(SUC n) SUBSET u n) /\
                INTERS {u n | n IN (:num)} = INTERS f`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `INTERS f = (:real^N)` THENL
   [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERS_EQ_UNIV]) THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM IN_SING] THEN
    ASM_SIMP_TAC[GSYM SUBSET; SET_RULE
     `~(f = {}) ==> (f SUBSET {a} <=> f = {a})`] THEN
    DISCH_TAC THEN EXISTS_TAC `(\n. UNIV):num->real^N->bool` THEN
    REWRITE_TAC[IN_SING; SUBSET_REFL; INTERS_EQ_UNIV; FORALL_IN_GSPEC];
    MP_TAC(ISPECL [`f:(real^N->bool)->bool`; `v:real^N->bool`]
      EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `f':(real^N->bool)->bool` COUNTABLE_DESCENDING_CHAIN) THEN
    ANTS_TAC THENL
     [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      ASM_MESON_TAC[INTERS_0];
      MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]]);;

let EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> closed s \/ open s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ UNIONS f' = UNIONS f`,
  REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_UNIONS]);;

let COUNTABLE_ASCENDING_CLOPEN_CHAIN = prove
 (`!f:(real^N->bool)->bool.
        ~(f = {}) /\
        (!s. s IN f ==> closed s \/ open s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?u. (!n. u(n) IN f) /\ (!n. u(n) SUBSET u(SUC n)) /\
                UNIONS {u n | n IN (:num)} = UNIONS f`,
  REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[COUNTABLE_ASCENDING_CLOPEN_IN_CHAIN]);;

let EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> closed s \/ open s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?f'. COUNTABLE f' /\ f' SUBSET f /\ INTERS f' = INTERS f`,
  REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS]);;

let COUNTABLE_DESCENDING_CLOPEN_CHAIN = prove
 (`!f:(real^N->bool)->bool.
        ~(f = {}) /\
        (!s. s IN f ==> closed s \/ open s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> ?u. (!n. u(n) IN f) /\ (!n. u(SUC n) SUBSET u n) /\
                INTERS {u n | n IN (:num)} = INTERS f`,
  REWRITE_TAC[CLOSED_IN; OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[COUNTABLE_DESCENDING_CLOPEN_IN_CHAIN]);;

let FSIGMA_UNIONS_CLOPEN_CHAIN = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> closed s \/ open s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> fsigma(UNIONS f)`,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_UNIONS) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
  MATCH_MP_TAC FSIGMA_UNIONS THEN
  ASM_MESON_TAC[SUBSET; CLOSED_IMP_FSIGMA; OPEN_IMP_FSIGMA]);;

let GDELTA_INTERS_CLOPEN_CHAIN = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> closed s \/ open s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> gdelta(INTERS f)`,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP EFFECTIVELY_COUNTABLE_CLOPEN_CHAIN_INTERS) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
  MATCH_MP_TAC GDELTA_INTERS THEN
  ASM_MESON_TAC[SUBSET; CLOSED_IMP_GDELTA; OPEN_IMP_GDELTA]);;

let CANTOR_BAIRE_STATIONARY_PRINCIPLE = prove
 (`!f:A->real^N->bool v w.
        woset w /\ ~COUNTABLE {(x,y) | w x y} /\
        (!v. v inseg w /\ ~(v = w) ==> COUNTABLE {(x,y) | v x y}) /\
        (!i. i IN fld w ==> closed_in (subtopology euclidean v) (f i) \/
                            open_in (subtopology euclidean v) (f i)) /\
        (!i j. w i j ==> f j SUBSET f i)
        ==> ?k. k IN fld w /\ !i. w k i ==> f i = f k`,
  let lemma = prove
   (`{x,y | ?l. l IN p /\ l x y} = UNIONS {{x,y | l x y} | l IN p}`,
    REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`IMAGE (f:A->real^N->bool) (fld w)`; `v:real^N->bool`]
        EFFECTIVELY_COUNTABLE_CLOPEN_IN_CHAIN_INTERS) THEN
  ASM_REWRITE_TAC[FORALL_IN_IMAGE_2; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
   [UNDISCH_TAC `woset(w:A->A->bool)` THEN
    REWRITE_TAC[woset; IN] THEN ASM_MESON_TAC[];
    REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `k:A->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL
     [`w:A->A->bool`; `\x y. ?l. l IN {linseg w (a:A) | a IN k} /\ l x y`]
        INSEG_LINSEG) THEN
    ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT
     `p /\ ~q /\ (r ==> s) ==> (p <=> q \/ r) ==> s`) THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC UNION_INSEG THEN
      ASM_SIMP_TAC[FORALL_IN_GSPEC; LINSEG_INSEG];
      DISCH_THEN(MP_TAC o AP_TERM
       `\l:A->A->bool. COUNTABLE {(x,y) | l x y}`) THEN
      ASM_REWRITE_TAC[] THEN REWRITE_TAC[lemma] THEN
      MATCH_MP_TAC COUNTABLE_UNIONS THEN
      ASM_SIMP_TAC[COUNTABLE_IMAGE; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `a:A` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SIMP_TAC[LINSEG_INSEG; ETA_AX] THEN REWRITE_TAC[FUN_EQ_THM] THEN
      DISCH_THEN(MP_TAC o SPECL [`a:A`; `a:A`]) THEN
      REWRITE_TAC[linseg; properly] THEN UNDISCH_TAC `woset(w:A->A->bool)` THEN
      REWRITE_TAC[woset] THEN ASM SET_TAC[];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN STRIP_TAC THEN
      MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
       [ASM SET_TAC[]; DISCH_TAC] THEN
      X_GEN_TAC `b:A` THEN DISCH_TAC THEN
      ASM_SIMP_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `s = INTERS f ==> !x. x IN f ==> s SUBSET x`)) THEN
      REWRITE_TAC[FORALL_IN_IMAGE] THEN
      DISCH_THEN(MP_TAC o SPEC `b:A`) THEN REWRITE_TAC[fld; IN_ELIM_THM] THEN
      ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN
      REWRITE_TAC[SUBSET_INTERS; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `c:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o C AP_THM `a:A` o C AP_THM `a:A`) THEN
      REWRITE_TAC[EXISTS_IN_GSPEC] THEN
      REWRITE_TAC[linseg; IN_ELIM_THM] THEN
      REWRITE_TAC[IN; properly; NOT_EXISTS_THM] THEN
      DISCH_THEN(MP_TAC o SPEC `c:A`) THEN
      UNDISCH_TAC `woset(w:A->A->bool)` THEN
      REWRITE_TAC[woset; IN] THEN ASM_MESON_TAC[IN; SUBSET]]]);;

(* ------------------------------------------------------------------------- *)
(* Very basics about Borel sets.                                             *)
(* ------------------------------------------------------------------------- *)

let borel_RULES,borel_INDUCT,borel_CASES = new_inductive_definition
 `(!s. open s ==> borel s) /\
  (!s. borel s ==> borel((:real^N) DIFF s)) /\
  (!u. COUNTABLE u /\ (!s. s IN u ==> borel s) ==> borel(UNIONS u))`;;

let BOREL_INDUCT_COMPACT = prove
 (`!P. (!s. compact s ==> P s) /\
       (!s. P s ==> P ((:real^N) DIFF s)) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u))
       ==> !a. borel a ==> P a`,
  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC borel_INDUCT THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:real^N->bool` THEN
  DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_LOCALLY_COMPACT) THEN
  DISCH_THEN(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool`
    (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_SIMP_TAC[]);;

let BOREL_INDUCT_COMPACT_DIFF = prove
 (`!P. (!s. compact s ==> P s) /\
       (!s t. P s /\ P t ==> P(s DIFF t)) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u))
       ==> !a:real^N->bool. borel a ==> P a`,
  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC borel_INDUCT THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_SIMP_TAC[OPEN_UNIV]; X_GEN_TAC `s:real^N->bool`] THEN
  DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_LOCALLY_COMPACT) THEN
  DISCH_THEN(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool`
    (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_SIMP_TAC[]);;

let BOREL_INDUCT_COMPACT_ALT = prove
 (`!P. (!s. compact s ==> P s) /\
       (!s. P s ==> P((:real^N) DIFF s)) /\
       (!u. COUNTABLE u /\ ~(u = {}) /\ (!s. s IN u ==> P s) ==> P(INTERS u))
       ==> !a:real^N->bool. borel a ==> P a`,
  GEN_TAC THEN INTRO_TAC "C D I" THEN
  MATCH_MP_TAC BOREL_INDUCT_COMPACT THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN
  ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN
  ASM_SIMP_TAC[UNIONS_0; COMPACT_EMPTY] THEN
  REWRITE_TAC[UNIONS_INTERS] THEN
  USE_THEN "D" MATCH_MP_TAC THEN USE_THEN "I" MATCH_MP_TAC THEN
  ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE;
               IMAGE_EQ_EMPTY]);;

let BOREL_INDUCT_UNIONS_INTERS = prove
 (`!P. (!s. open s ==> P s) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u))
       ==> !a:real^N->bool. borel a ==> P a`,
  GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN `!a. borel a ==> P a /\ P((:real^N) DIFF a)`
   (fun th -> MESON_TAC[th]) THEN
  MATCH_MP_TAC borel_INDUCT THEN REPEAT CONJ_TAC THENL
   [X_GEN_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[] THEN
    REWRITE_TAC[OPEN_CLOSED] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CLOSED_IMP_GDELTA) THEN
    REWRITE_TAC[gdelta; INTERSECTION_OF] THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    ASM_SIMP_TAC[];
    SIMP_TAC[COMPL_COMPL];
    X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN
    ASM_SIMP_TAC[] THEN REWRITE_TAC[DIFF_UNIONS] THEN
    REWRITE_TAC[GSYM INTERS_INSERT] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[COUNTABLE_INSERT; COUNTABLE_IMAGE; SIMPLE_IMAGE] THEN
    REWRITE_TAC[FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN
    ASM_SIMP_TAC[OPEN_UNIV]]);;

let BOREL_INDUCT_COMPACT_UNIONS_INTERS = prove
 (`!P. (!s. compact s ==> P s) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u))
       ==> !a:real^N->bool. borel a ==> P a`,
  GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC BOREL_INDUCT_UNIONS_INTERS THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `s:real^N->bool` THEN
  DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_LOCALLY_COMPACT) THEN
  DISCH_THEN(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool`
    (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_SIMP_TAC[]);;

let BOREL_INDUCT_CLOSED_UNIONS_INTERS = prove
 (`!P. (!s. closed s ==> P s) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (UNIONS u)) /\
       (!u. COUNTABLE u /\ (!s. s IN u ==> P s) ==> P (INTERS u))
       ==> !a:real^N->bool. borel a ==> P a`,
  GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC BOREL_INDUCT_COMPACT_UNIONS_INTERS THEN
  ASM_MESON_TAC[COMPACT_IMP_CLOSED]);;

let OPEN_IMP_BOREL = prove
 (`!s:real^N->bool. open s ==> borel s`,
  REWRITE_TAC[borel_RULES]);;

let BOREL_COMPLEMENT = prove
 (`!s. borel((:real^N) DIFF s) <=> borel s`,
  MESON_TAC[COMPL_COMPL; borel_RULES]);;

let BOREL_UNIONS = prove
 (`!u. COUNTABLE u /\ (!s:real^N->bool. s IN u ==> borel s)
       ==> borel(UNIONS u)`,
  REWRITE_TAC[borel_RULES]);;

let BOREL_INTERS = prove
 (`!u. COUNTABLE u /\ (!s:real^N->bool. s IN u ==> borel s)
       ==> borel(INTERS u)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[INTERS_UNIONS] THEN
  REWRITE_TAC[BOREL_COMPLEMENT; SIMPLE_IMAGE] THEN
  MATCH_MP_TAC BOREL_UNIONS THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; BOREL_COMPLEMENT]);;

let BOREL_EMPTY = prove
 (`borel {}`,
  SIMP_TAC[OPEN_IMP_BOREL; OPEN_EMPTY]);;

let BOREL_UNIV = prove
 (`borel(:real^N)`,
  SIMP_TAC[OPEN_IMP_BOREL; OPEN_UNIV]);;

let BOREL_UNION = prove
 (`!s t:real^N->bool. borel s /\ borel t ==> borel(s UNION t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN
  MATCH_MP_TAC BOREL_UNIONS THEN
  REWRITE_TAC[COUNTABLE_INSERT; FORALL_IN_INSERT] THEN
  ASM_REWRITE_TAC[COUNTABLE_EMPTY; NOT_IN_EMPTY]);;

let BOREL_INTER = prove
 (`!s t:real^N->bool. borel s /\ borel t ==> borel(s INTER t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN
  MATCH_MP_TAC BOREL_INTERS THEN
  REWRITE_TAC[COUNTABLE_INSERT; FORALL_IN_INSERT] THEN
  ASM_REWRITE_TAC[COUNTABLE_EMPTY; NOT_IN_EMPTY]);;

let BOREL_DIFF = prove
 (`!s t:real^N->bool. borel s /\ borel t ==> borel(s DIFF t)`,
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
  SIMP_TAC[BOREL_INTER; BOREL_COMPLEMENT]);;

let CLOSED_IMP_BOREL = prove
 (`!s:real^N->bool. closed s ==> borel s`,
  GEN_TAC THEN REWRITE_TAC[closed] THEN
  DISCH_THEN(MP_TAC o MATCH_MP OPEN_IMP_BOREL) THEN
  REWRITE_TAC[BOREL_COMPLEMENT]);;

let COMPACT_IMP_BOREL = prove
 (`!s:real^N->bool. compact s ==> borel s`,
  SIMP_TAC[CLOSED_IMP_BOREL; COMPACT_IMP_CLOSED]);;

let FSIGMA_IMP_BOREL = prove
 (`!s:real^N->bool. fsigma s ==> borel s`,
  GEN_TAC THEN REWRITE_TAC[fsigma; UNION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_SIMP_TAC[BOREL_UNIONS; CLOSED_IMP_BOREL]);;

let GDELTA_IMP_BOREL = prove
 (`!s:real^N->bool. gdelta s ==> borel s`,
  GEN_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_SIMP_TAC[BOREL_INTERS; OPEN_IMP_BOREL]);;

let LOCALLY_COMPACT_IMP_BOREL = prove
 (`!s:real^N->bool. locally compact s ==> borel s`,
  SIMP_TAC[FSIGMA_IMP_BOREL; FSIGMA_LOCALLY_COMPACT]);;

let OPEN_IN_BOREL = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean t) s /\ borel t ==> borel s`,
  REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOREL_INTER THEN
  ASM_SIMP_TAC[OPEN_IMP_BOREL]);;

let CLOSED_IN_BOREL = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean t) s /\ borel t ==> borel s`,
  REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOREL_INTER THEN
  ASM_SIMP_TAC[CLOSED_IMP_BOREL]);;

let CONTINUOUS_BOREL_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ borel s /\ borel t
        ==> borel {x | x IN s /\ f x IN t}`,
  let lemma = prove
   (`{x | x IN s /\ f x IN UNIONS u} =
     UNIONS {{x | x IN s /\ f x IN t} | t IN u}`,
    REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN
  MATCH_MP_TAC borel_INDUCT THEN REPEAT CONJ_TAC THENL
   [X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
    MATCH_MP_TAC OPEN_IN_BOREL THEN EXISTS_TAC `s:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
    ASM_REWRITE_TAC[];
    ASM_SIMP_TAC[BOREL_DIFF; SET_RULE
     `{x | x IN s /\ f x IN UNIV DIFF t} = s DIFF {x | x IN s /\ f x IN t}`];
    REPEAT STRIP_TAC THEN REWRITE_TAC[lemma] THEN
    MATCH_MP_TAC BOREL_UNIONS THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]]);;

let HOMEOMORPHIC_BORELNESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (borel s <=> borel t)`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool.
          s homeomorphic t ==> borel s ==> borel t`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
    MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `g':real^N->real^M`] THEN
    STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
    SUBGOAL_THEN `t = {x | x IN v /\ (g':real^N->real^M) x IN s}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN
    ASM_SIMP_TAC[GDELTA_IMP_BOREL]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC lemma THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let BOREL_TRANSLATION = prove
 (`!a:real^N s. borel (IMAGE (\x. a + x) s) <=> borel s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORELNESS THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;

add_translation_invariants [BOREL_TRANSLATION];;

let BOREL_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (borel(IMAGE f s) <=> borel s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORELNESS THEN
  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
  ASM_REWRITE_TAC[]);;

add_linear_invariants [BOREL_LINEAR_IMAGE];;

let HOMEOMORPHISM_BORELNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (borel(IMAGE f k) <=> borel k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORELNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let BOREL_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool. borel s /\ borel t ==> borel(s PCROSS t)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `s PCROSS t = (s PCROSS (:real^N)) INTER ((:real^M) PCROSS t)`
  SUBST1_TAC THENL [REWRITE_TAC[INTER_PCROSS; INTER_UNIV]; ALL_TAC] THEN
  MATCH_MP_TAC BOREL_INTER THEN CONJ_TAC THENL
   [UNDISCH_TAC `borel(s:real^M->bool)` THEN
    SPEC_TAC(`s:real^M->bool`,`s:real^M->bool`);
    UNDISCH_TAC `borel(t:real^N->bool)` THEN
    SPEC_TAC(`t:real^N->bool`,`t:real^N->bool`)] THEN
  MATCH_MP_TAC borel_INDUCT THEN REWRITE_TAC[PCROSS_DIFF] THEN
  SIMP_TAC[OPEN_PCROSS; OPEN_UNIV; OPEN_IMP_BOREL; BOREL_DIFF] THEN
  REWRITE_TAC[PCROSS_UNIONS] THEN
  SIMP_TAC[BOREL_UNIONS; FORALL_IN_IMAGE; SIMPLE_IMAGE; COUNTABLE_IMAGE]);;

let BOREL_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        borel(s PCROSS t) <=> s = {} \/ t = {} \/ borel s /\ borel t`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[BOREL_PCROSS; PCROSS_EMPTY; BOREL_EMPTY] THEN
  MATCH_MP_TAC(TAUT `(~p /\ ~q ==> r) ==> p \/ q \/ r`) THEN
  REPEAT STRIP_TAC THENL
   [UNDISCH_TAC `~(t:real^N->bool = {})`;
    UNDISCH_TAC `~(s:real^M->bool = {})`] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `y:real^N`; X_GEN_TAC `x:real^M`] THEN
  DISCH_TAC THENL
   [SUBGOAL_THEN `s = {x | x IN (:real^M) /\
                           pastecart x (y:real^N) IN (s PCROSS t)}`
    SUBST1_TAC THENL
     [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC];
    SUBGOAL_THEN `t = {y | y IN (:real^N) /\
                           pastecart (x:real^M) y IN (s PCROSS t)}`
    SUBST1_TAC THENL
     [REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; ALL_TAC]] THEN
  MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN
  ASM_REWRITE_TAC[BOREL_UNIV] THEN
  MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
  REWRITE_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;

let LAVRENTIEV_BOREL = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\ borel t
        ==> ?u g. borel u /\ s SUBSET u /\ u SUBSET closure s /\
                  g continuous_on u /\ IMAGE g u SUBSET t /\
                  !x. x IN s ==> g x = f x`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL[`f:real^M->real^N`; `s:real^M->bool`; `closure t:real^N->bool`]
        LAVRENTIEV) THEN
  ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSED_IMP_GDELTA] THEN ANTS_TAC THENL
   [ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET];
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM]] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `{x | x IN u /\ (g:real^M->real^N) x IN t}` THEN
  ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN
    ASM_SIMP_TAC[GDELTA_IMP_BOREL];
    ASM SET_TAC[];
    ASM SET_TAC[];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
    ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Baire functions. We only define these for finite indices, since I can't   *)
(* imagine ever using any indexed by higher ordinals. But this means         *)
(* that "borel_measurable" is strictly stronger than "baire n for some n".   *)
(* ------------------------------------------------------------------------- *)

let baire = define
 `(baire 0 s (f:real^M->real^N) <=> f continuous_on s) /\
  (baire (SUC n) s f <=>
        ?g. (!k. baire n s (g k)) /\
            (!x. x IN s ==> ((\k. g k x) --> f x) sequentially))`;;

let BAIRE_MONO = prove
 (`!f:real^M->real^N s m n. baire m s f /\ m <= n ==> baire n s f`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ_ALT] THEN
  MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
  REPEAT(CONJ_TAC THENL [CONV_TAC TAUT; ALL_TAC]) THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[baire] THEN
  EXISTS_TAC `(\k. f):num->real^M->real^N` THEN
  ASM_SIMP_TAC[LIM_CONST]);;

let CONTINUOUS_ON_IMP_BAIRE = prove
 (`!f:real^M->real^N s n. f continuous_on s ==> baire n s f`,
  REWRITE_TAC[GSYM(CONJUNCT1 baire)] THEN
  MESON_TAC[BAIRE_MONO; LE_0]);;

let BAIRE_SUBSET = prove
 (`!f:real^M->real^N s t n.
        baire n s f /\ t SUBSET s ==> baire n t f`,
  ONCE_REWRITE_TAC[MESON[]
   `(!f s t n. P f s t n) <=> (!s t n f. P f s t n)`] THEN
  GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
  REWRITE_TAC[baire; CONTINUOUS_ON_SUBSET] THEN
  X_GEN_TAC `f:real^M->real^N` THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SUBSET]);;

let BAIRE_EQ = prove
 (`!f:real^M->real^N g s n.
        (!x. x IN s ==> f x = g x) /\ baire n s f
        ==> baire n s g`,
  ONCE_REWRITE_TAC[MESON[]
   `(!f g s n. P f g s n) <=> (!s n f g. P f g s n)`] THEN
  GEN_TAC THEN INDUCT_TAC THEN
  REWRITE_TAC[baire; CONTINUOUS_ON_EQ] THEN MESON_TAC[]);;

let BAIRE_CONST = prove
 (`!s:real^M->bool n a:real^N. baire n s (\x. a)`,
  SIMP_TAC[CONTINUOUS_ON_IMP_BAIRE; CONTINUOUS_ON_CONST]);;

let BAIRE_PASTECART = prove
 (`!f:real^M->real^N g:real^M->real^P s n.
        baire n s f /\ baire n s g
        ==> baire n s (\x. pastecart (f x) (g x))`,
  ONCE_REWRITE_TAC[MESON[]
   `(!f g s n. P f g s n) <=> (!s n f g. P f g s n)`] THEN
  GEN_TAC THEN INDUCT_TAC THEN
  REWRITE_TAC[baire; CONTINUOUS_ON_PASTECART] THEN
  MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^P`] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `k:num->real^M->real^P` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC `\n:num x:real^M. pastecart (h n x:real^N) (k n x:real^P)` THEN
  ASM_SIMP_TAC[ETA_AX; LIM_PASTECART]);;

let BAIRE_COMPOSE_CONTINUOUS = prove
 (`!f:real^M->real^N g:real^N->real^P s k.
        f continuous_on s /\ baire k (IMAGE f s) g ==> baire k s (g o f)`,
  GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  MATCH_MP_TAC num_INDUCTION THEN
  ASM_SIMP_TAC[baire; CONTINUOUS_ON_COMPOSE; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `k:num` THEN DISCH_TAC THEN
  X_GEN_TAC `g:real^N->real^P` THEN
  DISCH_THEN(X_CHOOSE_THEN `h:num->real^N->real^P` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `\n. (h:num->real^N->real^P) n o (f:real^M->real^N)` THEN
  ASM_SIMP_TAC[o_THM]);;

let BAIRE_CONTINUOUS_COMPOSE_UNIV = prove
 (`!f:real^N->real^P g:real^M->real^N s n.
        f continuous_on (:real^N) /\ baire n s g
        ==> baire n s (f o g)`,
  ONCE_REWRITE_TAC[MESON[]
   `(!f g s n. P f g s n) <=> (!f s n g. P f g s n)`] THEN
  GEN_TAC THEN GEN_TAC THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN DISCH_TAC THEN
  INDUCT_TAC THEN REWRITE_TAC[baire] THENL
   [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
    X_GEN_TAC `g:real^M->real^N` THEN DISCH_THEN(X_CHOOSE_THEN
      `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\n. (f:real^N->real^P) o ((h:num->real^M->real^N) n)` THEN
    ASM_SIMP_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE
     [CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV; o_DEF]) THEN
    ASM_SIMP_TAC[o_THM]]);;

let BAIRE_CMUL = prove
 (`!f:real^M->real^N s c n.
        baire n s f ==> baire n s (\x. c % f x)`,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; o_DEF]
    BAIRE_CONTINUOUS_COMPOSE_UNIV) THEN
  SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);;

let BAIRE_BILINEAR = prove
 (`!bop:real^N->real^P->real^Q f g s:real^M->bool n.
        bilinear bop /\ baire n s f /\ baire n s g
        ==> baire n s (\x. bop (f x) (g x))`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_PASTECART) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_CONTINUOUS_ON) THEN
  REWRITE_TAC[IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_CONTINUOUS_COMPOSE_UNIV) THEN
  REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]);;

let BAIRE_ADD = prove
 (`!f g:real^M->real^N s n.
        baire n s f /\ baire n s g ==> baire n s (\x. f x + g x)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_PASTECART) THEN
  SUBGOAL_THEN
   `(\z. (fstcart z:real^N) + sndcart z) continuous_on UNIV`
  MP_TAC THENL
   [SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
             LINEAR_SNDCART];
    REWRITE_TAC[IMP_IMP] THEN
    DISCH_THEN(MP_TAC o MATCH_MP BAIRE_CONTINUOUS_COMPOSE_UNIV) THEN
    REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]]);;

let BAIRE_SUB = prove
 (`!f g:real^M->real^N s n.
        baire n s f /\ baire n s g
        ==> baire n s (\x. f x - g x)`,
  REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --(&1) % y`] THEN
  SIMP_TAC[BAIRE_CMUL; BAIRE_ADD]);;

let BAIRE_MUL = prove
 (`!f g:real^M->real^N s n.
        baire n s (\x. lift(f x)) /\ baire n s g
        ==> baire n s (\x. f x % g x)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[BILINEAR_DROP_MUL]
    (ISPEC `\x y:real^N. drop x % y` BAIRE_BILINEAR))) THEN
  REWRITE_TAC[LIFT_DROP]);;

let BAIRE_VSUM = prove
 (`!f:A->real^M->real^N s t n.
        FINITE t /\ (!i. i IN t ==> baire n s (f i))
        ==> baire n s (\x. vsum t (\i. f i x))`,
  GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[VSUM_CLAUSES; BAIRE_CONST; BAIRE_ADD; FORALL_IN_INSERT; ETA_AX]);;

let BAIRE_PRODUCT = prove
 (`!f:A->real^N->real s t n.
        FINITE t /\ (!i. i IN t ==> baire n s (\x. lift(f i x)))
        ==> baire n s (\x. lift(product t (\i. f i x)))`,
  GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[PRODUCT_CLAUSES; BAIRE_CONST; LIFT_CMUL; BAIRE_MUL;
           FORALL_IN_INSERT; ETA_AX]);;

let BAIRE_NORM = prove
 (`!f:real^M->real^N s n. baire n s f ==> baire n s (\x. lift(norm(f x)))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF; o_ASSOC] THEN
  MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM]);;

let BAIRE_MAX = prove
 (`!f g:real^N->real s n.
        baire n s (\x. lift(f x)) /\ baire n s (\x. lift(g x))
        ==> baire n s (\x. lift(max (f x) (g x)))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
   `max x y = inv(&2) * (x + y) + inv(&2) * abs(x - y)`] THEN
  REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
  MATCH_MP_TAC BAIRE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC BAIRE_CMUL THEN
  ASM_SIMP_TAC[BAIRE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN
  MATCH_MP_TAC BAIRE_NORM THEN ASM_SIMP_TAC[BAIRE_SUB; LIFT_SUB]);;

let BAIRE_MIN = prove
 (`!f g:real^N->real s n.
        baire n s (\x. lift(f x)) /\ baire n s (\x. lift(g x))
        ==> baire n s (\x. lift(min (f x) (g x)))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
   `min x y = inv(&2) * (x + y) - inv(&2) * abs(x - y)`] THEN
  REWRITE_TAC[LIFT_ADD; LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
  MATCH_MP_TAC BAIRE_SUB THEN CONJ_TAC THEN MATCH_MP_TAC BAIRE_CMUL THEN
  ASM_SIMP_TAC[BAIRE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN
  MATCH_MP_TAC BAIRE_NORM THEN ASM_SIMP_TAC[BAIRE_SUB; LIFT_SUB]);;

let BAIRE_COMPONENTWISE = prove
 (`!f:real^M->real^N s n.
        baire n s f <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> baire n s (\x. lift(f x$i))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; o_DEF]
       BAIRE_CONTINUOUS_COMPOSE_UNIV)) THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT];
    POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(t,t))
     [`f:real^M->real^N`; `n:num`]] THEN
  INDUCT_TAC THEN GEN_TAC THEN
  REWRITE_TAC[baire; GSYM CONTINUOUS_ON_COMPONENTWISE_LIFT] 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 `g:num->num->real^M->real^1` THEN STRIP_TAC THEN
  EXISTS_TAC
   `(\n:num x. lambda i. drop((g:num->num->real^M->real^1) i n x))
    :num->real^M->real^N` THEN
  REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC;
    ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT]] THEN
  ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]);;

let BAIRE_UNIFORM_LIMIT = prove
 (`!f g:real^M->real^N s k.
        eventually (\n. baire k s (f n)) sequentially /\
        (!e. &0 < e
             ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e)
                            sequentially)
        ==> baire k s g`,
  ONCE_REWRITE_TAC[MESON[]
   `(!f g s k. P f g s k) <=> (!s k f g. P f g s k)`] THEN
  GEN_TAC THEN INDUCT_TAC THENL
   [REWRITE_TAC[baire] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN
    EXISTS_TAC `f:num->real^M->real^N` THEN
    ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY];
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`f:num->real^M->real^N`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `!n. ?m. baire (SUC k) s (f m) /\
            !x. x IN s
                ==> norm((f:num->real^M->real^N) m x - g x)
                    < inv(&2 pow (n + 1))`
  MP_TAC THENL
   [X_GEN_TAC `n:num` THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow (n + 1))`) THEN
    ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN
    UNDISCH_TAC
     `eventually (\n. baire (SUC k) s (f n:real^M->real^N)) sequentially` THEN
    REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[LE_REFL];
    REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN
  ABBREV_TAC `h = \n x. (f:num->real^M->real^N) (r(n + 1)) x - f (r n) x` THEN
  SUBGOAL_THEN
   `!n x. x IN s ==> norm((h:num->real^M->real^N) n x) < inv(&2 pow n)`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN
    FIRST_X_ASSUM(fun th ->
      MP_TAC(SPECL [`n + 1`; `x:real^M`] th) THEN
      MP_TAC(SPECL [`n:num`; `x:real^M`] th)) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
     `a + b <= c
      ==> norm(f - g:real^N) < a
          ==> norm(f' - g) < b ==> norm(f' - f) < c`) THEN
    REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN
    REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!n:num. ?d:num->real^M->real^N.
        (!m. baire k s (d m)) /\
        (!m x. norm(d m x) <= &(dimindex(:N)) / &2 pow n) /\
        (!x. x IN s ==> ((\m. d m x) --> h n x) sequentially)`
  MP_TAC THENL
   [X_GEN_TAC `n:num` THEN
    SUBGOAL_THEN `baire (SUC k) s ((h:num->real^M->real^N) n)` MP_TAC THENL
     [EXPAND_TAC "h" THEN REWRITE_TAC[] THEN MATCH_MP_TAC BAIRE_SUB THEN
      ASM_REWRITE_TAC[ETA_AX];
      REWRITE_TAC[baire; LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `d:num->real^M->real^N` THEN STRIP_TAC THEN
    EXISTS_TAC
     `(\m x. lambda i. min (max (--inv(&2 pow n))
                                ((d m x:real^N)$i))
                           (inv(&2 pow n)))
      :num->real^M->real^N` THEN
    REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[BAIRE_COMPONENTWISE] THEN
      X_GEN_TAC `i:num` THEN SIMP_TAC[LAMBDA_BETA] THEN STRIP_TAC THEN
      MATCH_MP_TAC BAIRE_MIN THEN REWRITE_TAC[BAIRE_CONST] THEN
      MATCH_MP_TAC BAIRE_MAX THEN REWRITE_TAC[BAIRE_CONST] THEN
      RULE_ASSUM_TAC(ONCE_REWRITE_RULE[BAIRE_COMPONENTWISE]) THEN
      ASM_SIMP_TAC[];
      REPEAT GEN_TAC THEN
      W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
      GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV)
       [GSYM CARD_NUMSEG_1] THEN
      SIMP_TAC[real_div; GSYM SUM_CONST; FINITE_NUMSEG] THEN
      MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[LAMBDA_BETA] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
       `&0 < a ==> abs(min (max (--a) x) a) <= a`) THEN
      REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2];
      X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
      MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
      EXISTS_TAC `\k. (d:num->real^M->real^N) k x` THEN
      ASM_SIMP_TAC[] THEN MATCH_MP_TAC EVENTUALLY_MONO THEN
      EXISTS_TAC `\m. norm((d:num->real^M->real^N) m x - h n x)
                      < inv(&2 pow n) - norm(h n x)` THEN
      RULE_ASSUM_TAC(REWRITE_RULE[tendsto; dist]) THEN
      ASM_SIMP_TAC[REAL_SUB_LT] THEN X_GEN_TAC `m:num` THEN
      DISCH_THEN(ASSUME_TAC o MATCH_MP (NORM_ARITH
       `norm(x - y:real^N) < a - norm y ==> norm(x) <= a`)) THEN
      SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
      X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
       `abs x <= n ==> x = min (max (--n) x) n`) THEN
      ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]];
    REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `d:num->num->real^M->real^N` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!m x. x IN s
          ==> summable (from 0) (\n. (d:num->num->real^M->real^N) n m x)`
  MP_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_COMPARISON THEN
    EXISTS_TAC `\n. &(dimindex(:N)) / &2 pow n` THEN
    ASM_SIMP_TAC[o_DEF] THEN
    REWRITE_TAC[real_div; LIFT_CMUL; REAL_INV_POW] THEN
    MATCH_MP_TAC SUMMABLE_CMUL THEN MATCH_MP_TAC SUMMABLE_REAL_GP THEN
    CONV_TAC REAL_RAT_REDUCE_CONV;
    REWRITE_TAC[summable; RIGHT_IMP_EXISTS_THM; SKOLEM_THM]] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `g = \x. (f:num->real^M->real^N) (r 0) x +
                        (g x - f (r 0) x)`
  SUBST1_TAC THENL
   [REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC VECTOR_ARITH;
    MATCH_MP_TAC BAIRE_ADD THEN ASM_REWRITE_TAC[ETA_AX]] THEN
  REWRITE_TAC[baire] THEN EXISTS_TAC `t:num->real^M->real^N` THEN
  SUBGOAL_THEN
   `!e. &0 < e
        ==> eventually
         (\n. !x i. x IN s
                    ==> norm(vsum (0..n)
                                  (\m. (d:num->num->real^M->real^N) m i x) -
                           t i x) < e)
         sequentially`
   (LABEL_TAC "*")
  THENL
   [X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`inv(&2)`; `e / &2 / &(dimindex(:N))`]
      REAL_ARCH_POW_INV) THEN
    ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1;
                 DIMINDEX_GE_1; EVENTUALLY_SEQUENTIALLY] THEN
    SIMP_TAC[REAL_POW_INV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; LE_1;
             DIMINDEX_GE_1] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
    DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`x:real^M`; `j:num`] THEN DISCH_TAC THEN
    MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN EXISTS_TAC
     `\m. --vsum(n+1..m) (\q. (d:num->num->real^M->real^N) q j x)` THEN
    REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN MATCH_MP_TAC LIM_NEG THEN
      REWRITE_TAC[GSYM SERIES_FROM] THEN
      SUBST1_TAC(ARITH_RULE `n = (n + 1) - 1`) THEN
      REWRITE_TAC[ARITH_RULE `(n + 1) - 1 + 1 = n + 1`] THEN
      MATCH_MP_TAC SUMS_OFFSET THEN ASM_SIMP_TAC[] THEN ARITH_TAC;
      REWRITE_TAC[NORM_NEG] THEN
      MATCH_MP_TAC EVENTUALLY_MONO THEN
      EXISTS_TAC
       `\m. sum(n + 1..m) (\q. &(dimindex (:N)) / &2 pow q) <= e / &2` THEN
      REWRITE_TAC[] THEN CONJ_TAC THENL
       [X_GEN_TAC `m:num` THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
        MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[FINITE_NUMSEG];
        REWRITE_TAC[real_div; SUM_LMUL; SUM_GP; REAL_INV_POW] THEN
        REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
        MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `m:num` THEN
        REWRITE_TAC[] THEN COND_CASES_TAC THEN
        ASM_SIMP_TAC[REAL_HALF; REAL_MUL_RZERO; REAL_LT_IMP_LE] THEN
        TRANS_TAC REAL_LE_TRANS `&(dimindex (:N)) / &2 pow N` THEN
        ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
        REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
        REWRITE_TAC[REAL_POS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
        REWRITE_TAC[GSYM ADD1; real_pow] THEN MATCH_MP_TAC(REAL_ARITH
         `x <= a /\ &0 <= y ==> (&1 / &2 * x - &1 / &2 * y) * &2 <= a`) THEN
        REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_POW] THEN
        SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN
        MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV]];
      ALL_TAC] THEN
  CONJ_TAC THENL
   [X_GEN_TAC `j:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC
     `\n x. vsum (0..n) (\m. (d:num->num->real^M->real^N) m j x)` THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `i:num` THEN
      REWRITE_TAC[] THEN MATCH_MP_TAC BAIRE_VSUM THEN
      ASM_REWRITE_TAC[FINITE_NUMSEG; ETA_AX];
      X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      REMOVE_THEN "*" (MP_TAC o SPEC `e:real`) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
      SIMP_TAC[]];
    ALL_TAC] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[tendsto] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `((\n. vsum(0..n) (\m. (h:num->real^M->real^N) m x))
     --> (g(x) - f (r 0:num) x)) sequentially`
  MP_TAC THENL
   [EXPAND_TAC "h" THEN REWRITE_TAC[VSUM_DIFFS_ALT; LE_0] THEN
    MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN
    ONCE_REWRITE_TAC[LIM_NULL] THEN
    MATCH_MP_TAC LIM_NULL_COMPARISON THEN
    EXISTS_TAC `\n. inv(&2 pow ((n + 1) + 1))` THEN
    ASM_SIMP_TAC[REAL_LT_IMP_LE; EVENTUALLY_TRUE] THEN
    REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = 2 + n`] THEN
    REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; LIFT_CMUL] THEN
    MATCH_MP_TAC LIM_NULL_CMUL THEN REWRITE_TAC[tendsto] THEN
    REWRITE_TAC[DIST_0; NORM_LIFT; REAL_INV_POW] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC ARCH_EVENTUALLY_POW_INV THEN
    ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[tendsto] THEN REMOVE_THEN "*" MP_TAC THEN
  REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
  ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
  REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
  GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_SEQUENTIALLY] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN
  REWRITE_TAC[LE_REFL; IMP_CONJ] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
  ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_FORALL_THM] THEN
  DISCH_THEN(LABEL_TAC "+") THEN
  SUBGOAL_THEN
   `((\i. vsum(0..N) (\m. (d:num->num->real^M->real^N) m i x) -
          vsum (0..N) (\m. h m x))
     --> vec 0) sequentially`
  MP_TAC THENL
   [REWRITE_TAC[GSYM VSUM_SUB_NUMSEG] THEN
    MATCH_MP_TAC LIM_NULL_VSUM THEN
    ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; GSYM LIM_NULL];
    REWRITE_TAC[tendsto] THEN
    DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
    ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`]] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  X_GEN_TAC `i:num` THEN REMOVE_THEN "+" (MP_TAC o SPEC `i:num`) THEN
  REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);;

let BAIRE_UNIFORM_APPROXIMATION = prove
 (`!f:real^M->real^N s k.
        baire k s f <=>
        !e. &0 < e ==> ?g. baire k s g /\ !x. x IN s ==> norm(g x - f x) < e`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [EXISTS_TAC `f:real^M->real^N` THEN
    ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0];
    FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`)] THEN
  REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
  X_GEN_TAC `g:num->real^M->real^N` THEN STRIP_TAC THEN
  MATCH_MP_TAC BAIRE_UNIFORM_LIMIT THEN
  EXISTS_TAC `g:num->real^M->real^N` THEN
  ASM_REWRITE_TAC[EVENTUALLY_TRUE] THEN GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM ARCH_EVENTUALLY_INV1] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_TRANS]);;

let FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN = prove
 (`!f:real^M->real^N g s t u.
        IMAGE f s SUBSET t /\
        open_in (subtopology euclidean t) u /\
        (!n. (g n) continuous_on s) /\
        (!x. x IN s ==> ((\n. g n x) --> f x) sequentially)
        ==> ?c. COUNTABLE c /\
                (!t. t IN c ==> closed_in (subtopology euclidean s) t) /\
                UNIONS c = {x | x IN s /\ f(x) IN u}`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool`
   (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
  ASM_SIMP_TAC[SET_RULE
   `IMAGE f s SUBSET t
    ==> (x IN s /\ f x IN t INTER v <=> x IN s /\ f x IN v)`] THEN
  ASM_CASES_TAC `v = (:real^N)` THENL
   [EXISTS_TAC `{s:real^M->bool}` THEN
    ASM_REWRITE_TAC[COUNTABLE_SING; UNIONS_1; IN_UNIV] THEN
    REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; CLOSED_IN_REFL] THEN SET_TAC[];
    ALL_TAC] THEN
  EXISTS_TAC
   `{INTERS
       {{x | x IN s /\
             lift(setdist({(g:num->real^M->real^N) n x},(:real^N) DIFF v)) IN
             {x | drop x >= e}} |n|
        N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
    REWRITE_TAC[NUM_COUNTABLE] THEN
    SIMP_TAC[REWRITE_RULE[IN] COUNTABLE_RESTRICT; COUNTABLE_RATIONAL];
    REWRITE_TAC[FORALL_IN_GSPEC] THEN
    MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN
    GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV; IN_ELIM_THM] THEN
    REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_INTERS THEN
    SIMP_TAC[LE_REFL; SET_RULE `N:num <= N ==> ~({f n | N <= n} = {})`] THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
    REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE] THEN
    SUBGOAL_THEN
     `(\x. lift(setdist({g n x},(:real^N) DIFF v))) =
      (\y. lift(setdist({y},(:real^N) DIFF v))) o (g:num->real^M->real^N) n`
    SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST];
    GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN
    REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN
    ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL
     [REWRITE_TAC[real_ge]; MESON_TAC[LE_REFL]] THEN
    TRANS_TAC EQ_TRANS
     `&0 < setdist({(f:real^M->real^N) x},(:real^N) DIFF v)` THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ];
      REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN
      ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]] THEN
    GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
    REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN
    REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON
     [RATIONAL_CLOSED]
     `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2))
      ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN
    CONJ_TAC THEN X_GEN_TAC `q:real` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[tendsto] THEN
    DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL
     [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
      X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
        MATCH_MP (REAL_ARITH
       `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 <= d1`));
      REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
      DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
      REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH
       `abs(d1 - d2) <= x ==> x < q / &2 /\ q <= d1 ==> q / &2 < d2`)] THEN
    REWRITE_TAC[SETDIST_SING_TRIANGLE]]);;

let FSIGMA_BAIRE1_PREIMAGE_OPEN = prove
 (`!f:real^M->real^N s u.
        fsigma s /\ open u /\ baire 1 s f
        ==> fsigma {x | x IN s /\ f(x) IN u}`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[num_CONV `1`; baire] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `g:num->real^M->real^N`;
    `s:real^M->bool`; `(:real^N)`; `u:real^N->bool`]
   FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN) THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:(real^M->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FSIGMA_UNIONS THEN
  ASM_MESON_TAC[CLOSED_IN_FSIGMA]);;

let GDELTA_BAIRE1_PREIMAGE_CLOSED = prove
 (`!f:real^M->real^N s c.
        gdelta s /\ closed c /\ baire 1 s f
        ==> gdelta {x | x IN s /\ f(x) IN c}`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[num_CONV `1`; baire] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `g:num->real^M->real^N`;
    `s:real^M->bool`; `(:real^N)`; `(:real^N) DIFF c`]
   FSIGMA_BAIRE1_PREIMAGE_OPEN_GEN) THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
  ASM_REWRITE_TAC[GSYM closed; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `d:(real^M->bool)->bool` THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  ONCE_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ f x IN c} = s DIFF {x | x IN s /\ f x IN UNIV DIFF c}`] THEN
  ASM_REWRITE_TAC[DIFF_UNIONS] THEN
  MATCH_MP_TAC GDELTA_INTER THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC GDELTA_INTERS THEN
  ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
  MATCH_MP_TAC OPEN_IN_GDELTA THEN EXISTS_TAC `s:real^M->bool` THEN
  ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);;

(* ------------------------------------------------------------------------- *)
(* Delta_n sets (defined via "baire" on indicator, not a special constant).  *)
(* We can then express Sigma_n and Pi_n using "COUNTABLE UNION_OF ..." and   *)
(* "COUNTABLE INTERSECTION_OF ...". While a bit verbose, and breaking down   *)
(* for the 0 case, it is adequate for use in occasional lemmas.              *)
(* ------------------------------------------------------------------------- *)

let BAIRE_INDICATOR_EMPTY = prove
 (`!n. baire n u (indicator {})`,
  REWRITE_TAC[indicator; NOT_IN_EMPTY; BAIRE_CONST]);;

let BAIRE_INDICATOR_UNIV = prove
 (`!n. baire n u (indicator (:real^N))`,
  REWRITE_TAC[indicator; IN_UNIV; BAIRE_CONST]);;

let BAIRE_INDICATOR_REFL = prove
 (`!u:real^N->bool n. baire n u (indicator u)`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC BAIRE_EQ THEN
  EXISTS_TAC `indicator(:real^N)` THEN CONJ_TAC THEN
  SIMP_TAC[indicator; IN_UNIV; BAIRE_CONST]);;

let BAIRE_INDICATOR_COMPLEMENT = prove
 (`!u s:real^N->bool n.
        baire n u (indicator(u DIFF s)) <=>
        baire n u (indicator s)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  MP_TAC(ISPECL [`u:real^N->bool`; `n:num`; `vec 1:real^1`]
        BAIRE_CONST) THEN
  REWRITE_TAC[IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_SUB) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] BAIRE_EQ) THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  REWRITE_TAC[indicator; IN_DIFF; IN_UNIV] THEN
  ASM_CASES_TAC `(x:real^N) IN s` THEN
  ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO]);;

let BAIRE_INDICATOR_COMPLEMENT_UNIV = prove
 (`!u s n.
        baire n u (indicator((:real^N) DIFF s)) <=> baire n u (indicator s)`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM BAIRE_INDICATOR_COMPLEMENT] THEN
  EQ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] BAIRE_EQ) THEN
  SIMP_TAC[indicator; IN_DIFF; IN_UNIV]);;

let BAIRE_INDICATOR_INTER = prove
 (`!u s t:real^N->bool n.
        baire n u (indicator s) /\ baire n u (indicator t)
        ==> baire n u (indicator(s INTER t))`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
  ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_MUL) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[indicator; FUN_EQ_THM; IN_INTER] THEN
  X_GEN_TAC `x:real^N` THEN
  MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN
  ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
  REWRITE_TAC[VECTOR_MUL_RZERO]);;

let BAIRE_INDICATOR_UNION = prove
 (`!u s t:real^N->bool n.
        baire n u (indicator s) /\ baire n u (indicator t)
        ==> baire n u (indicator(s UNION t))`,
  REPEAT GEN_TAC THEN DISCH_THEN(fun th ->
   MP_TAC(MATCH_MP BAIRE_INDICATOR_INTER th) THEN
   MP_TAC(MATCH_MP BAIRE_ADD th)) THEN
  REWRITE_TAC[IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_SUB) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[indicator; FUN_EQ_THM; IN_INTER; IN_UNION] THEN
  X_GEN_TAC `x:real^N` THEN
  MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN
  ASM_REWRITE_TAC[DROP_VEC; VECTOR_SUB_RZERO; VECTOR_ADD_RID; VECTOR_ADD_LID;
                  VECTOR_ADD_SUB]);;

let BAIRE_INDICATOR_DIFF = prove
 (`!u s t:real^N->bool n.
        baire n u (indicator s) /\ baire n u (indicator t)
        ==> baire n u (indicator(s DIFF t))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_EQ THEN
  EXISTS_TAC `indicator(s INTER (u DIFF t):real^N->bool)` THEN
  ASM_SIMP_TAC[BAIRE_INDICATOR_INTER; BAIRE_INDICATOR_COMPLEMENT] THEN
  SIMP_TAC[indicator; IN_INTER; IN_DIFF; IN_UNIV; IN_UNIV]);;

let BAIRE_INDICATOR_INTERS = prove
 (`!f n. FINITE f /\
         (!s. s IN f ==> baire n u (indicator s))
         ==> baire n u (indicator(INTERS f))`,
  GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[FORALL_IN_INSERT; INTERS_0; INTERS_INSERT] THEN
  ASM_SIMP_TAC[BAIRE_INDICATOR_UNIV; BAIRE_INDICATOR_INTER]);;

let BAIRE_INDICATOR_UNIONS = prove
 (`!f n. FINITE f /\
         (!s. s IN f ==> baire n u (indicator s))
         ==> baire n u (indicator(UNIONS f))`,
  GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[FORALL_IN_INSERT; UNIONS_0; UNIONS_INSERT] THEN
  ASM_SIMP_TAC[BAIRE_INDICATOR_EMPTY; BAIRE_INDICATOR_UNION]);;

let BAIRE0_INDICATOR = prove
 (`!s. baire 0 (:real^N) (indicator s) <=> s = {} \/ s = (:real^N)`,
  GEN_TAC THEN REWRITE_TAC[baire] THEN EQ_TAC THENL
   [DISCH_TAC THEN
    MP_TAC(ISPECL [`indicator(s:real^N->bool)`; `(:real^N)`]
     CONTINUOUS_FINITE_RANGE_CONSTANT) THEN
    ASM_REWRITE_TAC[CONNECTED_UNIV; IN_UNIV; EXTENSION; NOT_IN_EMPTY] THEN
    REWRITE_TAC[indicator] THEN ANTS_TAC THENL
     [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^1,vec 1}` THEN
      REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[];
      SUBGOAL_THEN `~(vec 0:real^1 = vec 1)` MP_TAC THENL
       [REWRITE_TAC[VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV; SET_TAC[]]];
    STRIP_TAC THEN ASM_REWRITE_TAC[indicator; IN_UNIV; NOT_IN_EMPTY] THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST]]);;

let COUNTABLE_UNION_OF_BAIRE0_INDICATOR = prove
 (`!s. (COUNTABLE UNION_OF baire 0 (:real^N) o indicator) s <=>
       s = {} \/ s = (:real^N)`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[UNION_OF; o_THM; BAIRE0_INDICATOR] THEN SET_TAC[];
    DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
    ASM_REWRITE_TAC[BAIRE0_INDICATOR; o_THM]]);;

let COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR = prove
 (`!s. (COUNTABLE INTERSECTION_OF baire 0 (:real^N) o indicator) s <=>
       s = {} \/ s = (:real^N)`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[INTERSECTION_OF; o_THM; BAIRE0_INDICATOR] THEN SET_TAC[];
    DISCH_TAC THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN
    ASM_REWRITE_TAC[BAIRE0_INDICATOR; o_THM]]);;

let BAIRE1_INDICATOR = prove
 (`!s. baire 1 (:real^N) (indicator s) <=> fsigma s /\ gdelta s`,
  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [REWRITE_TAC[GSYM FSIGMA_COMPLEMENT] THEN CONJ_TAC THENL
     [SUBGOAL_THEN `s = {x | x IN (:real^N) /\
                             indicator s x IN (UNIV DELETE vec 0)}`
      SUBST1_TAC THENL
       [REWRITE_TAC[EXTENSION; IN_ELIM_THM; indicator; IN_UNIV; IN_DELETE] THEN
        X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
        ASM_REWRITE_TAC[VEC_EQ] THEN CONV_TAC NUM_REDUCE_CONV;
        ALL_TAC];
      SUBGOAL_THEN `(:real^N) DIFF s =
                    {x | x IN (:real^N) /\
                         indicator s x IN (UNIV DELETE vec 1)}`
      SUBST1_TAC THENL
       [REWRITE_TAC[EXTENSION; IN_ELIM_THM; indicator; IN_UNIV; IN_DELETE] THEN
        X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
        ASM_REWRITE_TAC[VEC_EQ; IN_DIFF; IN_UNIV] THEN
        CONV_TAC NUM_REDUCE_CONV;
        ALL_TAC]] THEN
    MATCH_MP_TAC FSIGMA_BAIRE1_PREIMAGE_OPEN THEN
    ASM_SIMP_TAC[ETA_AX; FSIGMA_UNIV; OPEN_DELETE; OPEN_UNIV];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FSIGMA_COMPLEMENT]) THEN
    POP_ASSUM MP_TAC THEN
    REWRITE_TAC[FSIGMA_ASCENDING; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN
    X_GEN_TAC `d:num->real^N->bool` THEN STRIP_TAC THEN
    REWRITE_TAC[num_CONV `1`; baire] THEN
    SUBGOAL_THEN
     `!n:num. ?f:real^N->real^1.
        f continuous_on UNIV /\
        (!x. x IN c n ==> f x = vec 1) /\
        (!x. x IN d n ==> f x = vec 0)`
    MP_TAC THENL
     [X_GEN_TAC `n:num` THEN MP_TAC(ISPECL
       [`(c:num->real^N->bool) n`; `(d:num->real^N->bool) n`;
        `vec 1:real^1`; `vec 0:real^1`] URYSOHN) THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; MESON_TAC[]];
      REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N->real^1` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[IN_UNIV] THEN
      X_GEN_TAC `x:real^N` THEN REWRITE_TAC[indicator] THEN
      COND_CASES_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THENL
       [SUBGOAL_THEN `?n. x IN (c:num->real^N->bool) n` MP_TAC THENL
         [ASM SET_TAC[]; ALL_TAC];
        SUBGOAL_THEN `?n. x IN (d:num->real^N->bool) n` MP_TAC THENL
         [ASM SET_TAC[]; ALL_TAC]] THEN
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THENL
       [SUBGOAL_THEN
         `!m n. m <= n ==> (c:num->real^N->bool) m SUBSET c n`
        MP_TAC THENL [ALL_TAC; ASM SET_TAC[]];
        SUBGOAL_THEN
         `!m n. m <= n ==> (d:num->real^N->bool) m SUBSET d n`
        MP_TAC THENL [ALL_TAC; ASM SET_TAC[]]] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_REWRITE_TAC[SUBSET_REFL; SUBSET_TRANS]]]);;

let GDELTA_BAIRE = prove
 (`!s. gdelta s <=>
       (COUNTABLE INTERSECTION_OF baire 1 (:real^N) o indicator) s`,
  GEN_TAC THEN REWRITE_TAC[INTERSECTION_OF; o_THM] THEN EQ_TAC THENL
   [REWRITE_TAC[gdelta; INTERSECTION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN
    SIMP_TAC[BAIRE1_INDICATOR; OPEN_IMP_FSIGMA; OPEN_IMP_GDELTA];
    REWRITE_TAC[BAIRE1_INDICATOR] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC GDELTA_INTERS THEN
    ASM_SIMP_TAC[]]);;

let FSIGMA_BAIRE = prove
 (`!s. fsigma s <=> (COUNTABLE UNION_OF baire 1 (:real^N) o indicator) s`,
  GEN_TAC THEN REWRITE_TAC[UNION_OF; o_THM] THEN EQ_TAC THENL
   [REWRITE_TAC[fsigma; UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN
    SIMP_TAC[BAIRE1_INDICATOR; CLOSED_IMP_FSIGMA; CLOSED_IMP_GDELTA];
    REWRITE_TAC[BAIRE1_INDICATOR] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC FSIGMA_UNIONS THEN
    ASM_SIMP_TAC[]]);;

let CLOSED_IMP_BAIRE1_INDICATOR = prove
 (`!s. closed s ==> baire 1 (:real^N) (indicator s)`,
  SIMP_TAC[BAIRE1_INDICATOR; CLOSED_IMP_FSIGMA; CLOSED_IMP_GDELTA]);;

let OPEN_IMP_BAIRE1_INDICATOR = prove
 (`!s. open s ==> baire 1 (:real^N) (indicator s)`,
  SIMP_TAC[BAIRE1_INDICATOR; OPEN_IMP_FSIGMA; OPEN_IMP_GDELTA]);;

let BAIRE_INDICATOR_CONTINUOUS_PREIMAGE = prove
 (`!f:real^M->real^N s t u k.
        baire k u (indicator t) /\ f continuous_on s /\ IMAGE f s SUBSET u
        ==> baire k s (indicator {x | x IN s /\ f x IN t})`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_EQ THEN
  EXISTS_TAC `indicator t o (f:real^M->real^N)` THEN CONJ_TAC THENL
   [SIMP_TAC[indicator; IN_ELIM_THM; o_THM]; ALL_TAC] THEN
  MATCH_MP_TAC BAIRE_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[BAIRE_SUBSET]);;

let BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV = prove
 (`!f s k. baire k (:real^N) (indicator s) /\ f continuous_on (:real^M)
           ==> baire k (:real^M) (indicator {x | f x IN s})`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
   `{x | f x IN s} = {x | x IN UNIV /\ f x IN s}`] THEN
  MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE THEN
  ASM_MESON_TAC[SUBSET_UNIV]);;

let BAIRE_INDICATOR_TRANSLATION = prove
 (`!a s k. baire k (:real^N) (indicator (IMAGE (\x. a + x) s)) <=>
           baire k (:real^N) (indicator s)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN `s = {x:real^N | a + x IN IMAGE (\x. a + x) s}`
    SUBST1_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `(!x y. f x = f y ==> x = y) ==> s = {x | f x IN IMAGE f s}`) THEN
      CONV_TAC VECTOR_ARITH;
      MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]];
    SUBGOAL_THEN `IMAGE (\x:real^N. a + x) s = {x | x - a IN s}`
    SUBST1_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_TRANSLATION_GALOIS; IN_ELIM_THM];
      MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
                   CONTINUOUS_ON_CONST]]]);;

let BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE = prove
 (`!f s k.
        1 <= k /\ linear f /\ (!x y. f x = f y ==> x = y)
        ==> (baire k (:real^N) (indicator (IMAGE f s)) <=>
             baire k (:real^M) (indicator s))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON];
    SUBGOAL_THEN `?g:real^N->real^M. linear g /\ g o f = I` MP_TAC THENL
     [ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]; ALL_TAC] THEN
    REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `IMAGE (f:real^M->real^N) s = IMAGE f UNIV INTER {x | g x IN s}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC BAIRE_INDICATOR_INTER THEN
    ASM_SIMP_TAC[BAIRE_INDICATOR_CONTINUOUS_PREIMAGE_UNIV;
                 LINEAR_CONTINUOUS_ON] THEN
    MATCH_MP_TAC BAIRE_MONO THEN EXISTS_TAC `1` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IMP_BAIRE1_INDICATOR THEN
    MATCH_MP_TAC CLOSED_SUBSPACE THEN MATCH_MP_TAC SUBSPACE_LINEAR_IMAGE THEN
    ASM_REWRITE_TAC[SUBSPACE_UNIV]]);;

let BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE = prove
 (`!f s k.
        linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
        ==> (baire k (:real^N) (indicator (IMAGE f s)) <=>
             baire k (:real^M) (indicator s))`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THENL
   [ASM_REWRITE_TAC[BAIRE0_INDICATOR] THEN ASM SET_TAC[];
    MATCH_MP_TAC BAIRE_INDICATOR_INJECTIVE_LINEAR_IMAGE THEN
    ASM_MESON_TAC[LE_1]]);;

add_translation_invariants [BAIRE_INDICATOR_TRANSLATION];;

add_linear_invariants [BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE];;

let COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION = prove
 (`!a s k. (COUNTABLE UNION_OF baire k (:real^N) o indicator)
           (IMAGE (\x. a + x) s) <=>
           (COUNTABLE UNION_OF baire k (:real^N) o indicator) s`,
  GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC COUNTABLE_UNION_OF_BIJECTIVE_IMAGE THEN
  REWRITE_TAC[o_THM; BAIRE_INDICATOR_TRANSLATION] THEN
  REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN
  REWRITE_TAC[VECTOR_ADD_SUB]);;

add_translation_invariants [COUNTABLE_UNION_OF_BAIRE_INDICATOR_TRANSLATION];;

let COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION = prove
 (`!a s k. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator)
           (IMAGE (\x. a + x) s) <=>
           (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s`,
  GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE THEN
  REWRITE_TAC[o_THM; BAIRE_INDICATOR_TRANSLATION] THEN
  REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN
  REWRITE_TAC[VECTOR_ADD_SUB]);;

add_translation_invariants
  [COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_TRANSLATION];;

let COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE = prove
 (`!f s k.
        linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
        ==> ((COUNTABLE UNION_OF baire k (:real^N) o indicator) (IMAGE f s) <=>
             (COUNTABLE UNION_OF baire k (:real^M) o indicator) s)`,
  GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
  MATCH_MP_TAC COUNTABLE_UNION_OF_BIJECTIVE_IMAGE THEN
  ASM_REWRITE_TAC[o_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE THEN
  ASM_REWRITE_TAC[]);;

add_linear_invariants
 [COUNTABLE_UNION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE];;

let COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE = prove
 (`!f s k.
        linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
        ==> ((COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator)
             (IMAGE f s) <=>
             (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s)`,
  GEN_TAC THEN GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
  MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BIJECTIVE_IMAGE THEN
  ASM_REWRITE_TAC[o_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE THEN
  ASM_REWRITE_TAC[]);;

add_linear_invariants
 [COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR_BIJECTIVE_LINEAR_IMAGE];;

(* ------------------------------------------------------------------------- *)
(* The reduction theorem for Sigma_n sets and consequences.                  *)
(* ------------------------------------------------------------------------- *)

let FSIGMA_REDUCTION_GEN_ALT = prove
 (`!s:num->real^N->bool k.
     (!n. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (s n))
     ==> ?t. (!n. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (t n)) /\
             (!n. t n SUBSET s n) /\
             pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\
             UNIONS {t n | n IN (:num)} = UNIONS {s n | n IN (:num)}`,
  GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC GENERAL_REDUCTION_THEOREM THEN
  REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY;
              BAIRE_INDICATOR_UNION; BAIRE_INDICATOR_DIFF]);;

let FSIGMA_REDUCTION_GEN_2 = prove
 (`!s t k.
       (COUNTABLE UNION_OF baire k (:real^N) o indicator) s /\
       (COUNTABLE UNION_OF baire k (:real^N) o indicator) t
       ==> ?s' t'. (COUNTABLE UNION_OF baire k (:real^N) o indicator) s' /\
                   (COUNTABLE UNION_OF baire k (:real^N) o indicator) t' /\
                   s' SUBSET s /\ t' SUBSET t /\ DISJOINT s' t' /\
                   s' UNION t' = s UNION t`,
  ONCE_REWRITE_TAC[MESON[] `(!s t k. P s t k) <=> (!k s t. P s t k)`] THEN
  GEN_TAC THEN MATCH_MP_TAC GENERAL_REDUCTION_THEOREM_2 THEN
  REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY;
              BAIRE_INDICATOR_UNION; BAIRE_INDICATOR_DIFF]);;

let FSIGMA_REDUCTION = prove
 (`!s:num->real^N->bool.
        (!n. fsigma(s n))
        ==> ?t. (!n. fsigma(t n)) /\
                (!n. t n SUBSET s n) /\
                pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\
                UNIONS {t n | n IN (:num)} = UNIONS {s n | n IN (:num)}`,
  REWRITE_TAC[FSIGMA_BAIRE; FSIGMA_REDUCTION_GEN_ALT]);;

let BAIRE_INDICATOR_SUC,BAIRE_INDICATOR_DELTA,FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT,
    FSIGMA_REDUCTION_GEN,GDELTA_SEPARATION_GEN =
  let clemma = MESON[BAIRE_INDICATOR_COMPLEMENT; o_THM]
     `(baire k (:real^N) o indicator) ((:real^N) DIFF s) =
      (baire k (:real^N) o indicator) s` in
  let slemma = prove
   (`!s t k.
      (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s /\
      (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t /\
      DISJOINT s t
      ==> ?u. (COUNTABLE UNION_OF baire k (:real^N) o indicator) u /\
              (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) u /\
              s SUBSET u /\ DISJOINT u t`,
    GEN_REWRITE_TAC (funpow 3 BINDER_CONV o LAND_CONV o ONCE_DEPTH_CONV)
     [COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
    REWRITE_TAC[clemma] THEN
    REWRITE_TAC[SET_RULE
     `DISJOINT s t <=> (UNIV DIFF s) UNION (UNIV DIFF t) = UNIV`] THEN
    ONCE_REWRITE_TAC[SET_RULE
     `s SUBSET t <=> UNIV DIFF t SUBSET UNIV DIFF s`] THEN
    REWRITE_TAC[MESON[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]
     `((!s. P(UNIV DIFF s)) <=> (!s. P s)) /\
      ((?s. P(UNIV DIFF s)) <=> (?s. P s))`] THEN
    REPEAT GEN_TAC THEN REWRITE_TAC[ETA_AX; CONJ_ASSOC] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN(MP_TAC o MATCH_MP FSIGMA_REDUCTION_GEN_2) THEN
    ASM_REWRITE_TAC[SET_RULE
      `DISJOINT s t /\ s UNION t = UNIV <=> s = UNIV DIFF t`] THEN
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^N->bool` THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool`
     (STRIP_ASSUME_TAC o GSYM)) THEN
    ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
    ASM_REWRITE_TAC[clemma; ETA_AX]) in
  let [BAIRE_INDICATOR_SUC; BAIRE_INDICATOR_DELTA;
       FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT] = (CONJUNCTS o prove)
   (`(!s n. 1 <= n
            ==> ((COUNTABLE UNION_OF
                  COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator) s /\
                 (COUNTABLE INTERSECTION_OF
                  COUNTABLE UNION_OF baire n (:real^N) o indicator) s <=>
                 baire (n + 1) (:real^N) (indicator s))) /\
     (!s n. (COUNTABLE UNION_OF baire n (:real^N) o indicator) s /\
            (COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator) s <=>
            baire n (:real^N) (indicator s)) /\
     (!f u n. 1 <= n /\ baire (n + 1) (:real^N) (f:real^N->real^1) /\ open u
              ==> (COUNTABLE UNION_OF
                   COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator)
                  {x | f x IN u})`,
    GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o BINDER_CONV)
     [METIS[num_CASES] `(!n. P n) <=> P 0 /\ (!n. P(SUC n))`] THEN
    REWRITE_TAC[BAIRE0_INDICATOR; COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR;
                COUNTABLE_UNION_OF_BAIRE0_INDICATOR] THEN
    REWRITE_TAC[GSYM ADD1] THEN
    ONCE_REWRITE_TAC[MESON[] `(!f u n. P f u n) <=> (!f n u. P f u n)`] THEN
    ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN
    CONJ_TAC THENL
     [REWRITE_TAC[GSYM FSIGMA_BAIRE; GSYM GDELTA_BAIRE] THEN
      REWRITE_TAC[GSYM BAIRE1_INDICATOR];
      REWRITE_TAC[ARITH_RULE `1 <= SUC n`]] THEN
    X_GEN_TAC `k:num` THEN
    SUBST1_TAC(ARITH_RULE `1 <= k <=> 2 <= SUC k`) THEN
    ABBREV_TAC `k1 = SUC k` THEN DISCH_THEN
     (CONJUNCTS_THEN2 (LABEL_TAC "Lk")
       (CONJUNCTS_THEN2 (LABEL_TAC "L0") (LABEL_TAC "L2"))) THEN
    SUBGOAL_THEN
     `!s. (COUNTABLE UNION_OF
           COUNTABLE INTERSECTION_OF (baire k1 (:real^N) o indicator)) s /\
          (COUNTABLE INTERSECTION_OF
           COUNTABLE UNION_OF (baire k1 (:real^N) o indicator)) s
          ==> baire (SUC k1) (:real^N) (indicator s)`
    (LABEL_TAC "L1") THENL
     [GEN_TAC THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)
       [COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)
       [COUNTABLE_UNION_OF_COMPLEMENT] THEN
      REWRITE_TAC[COMPL_COMPL; clemma; ETA_AX] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_ASCENDING o
        lhand o lhand o snd) THEN
      W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_ASCENDING o
        rand o lhand o rand o snd) THEN
      REPLICATE_TAC 2
       (ANTS_TAC THENL
        [CONJ_TAC THENL
          [MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN
           REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY];
           MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_UNION THEN
           REWRITE_TAC[BAIRE_INDICATOR_UNION; o_THM]];
         DISCH_THEN SUBST1_TAC]) THEN
      DISCH_THEN(CONJUNCTS_THEN2
       (X_CHOOSE_THEN `t:num->real^N->bool` STRIP_ASSUME_TAC)
       (X_CHOOSE_THEN `u:num->real^N->bool` STRIP_ASSUME_TAC)) THEN
      MP_TAC(GEN `m:num` (ISPECL
       [`(t:num->real^N->bool) m`; `(u:num->real^N->bool) m`; `k1:num`]
       slemma)) THEN
      DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN
      ASM_REWRITE_TAC[CONJ_ASSOC; SKOLEM_THM] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN
      DISCH_THEN(X_CHOOSE_THEN `v:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[baire] THEN
      EXISTS_TAC `indicator o (v:num->real^N->bool)` THEN
      ASM_REWRITE_TAC[o_THM; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN
      ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[indicator] THEN
      MATCH_MP_TAC LIM_EVENTUALLY THENL
       [SUBGOAL_THEN `(x:real^N) IN UNIONS {t n | n IN (:num)}` MP_TAC THENL
         [ASM_REWRITE_TAC[]; ALL_TAC];
        SUBGOAL_THEN `(x:real^N) IN UNIONS {u n | n IN (:num)}` MP_TAC THENL
         [ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]; ALL_TAC]] THEN
      SIMP_TAC[UNIONS_GSPEC; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY;
               IN_UNIV] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
      X_GEN_TAC `m:num` THEN DISCH_TAC THEN COND_CASES_TAC THEN
      REWRITE_TAC[] THENL
       [SUBGOAL_THEN `(t:num->real^N->bool) N SUBSET t m` MP_TAC THENL
         [ALL_TAC; ASM SET_TAC[]];
        SUBGOAL_THEN `(u:num->real^N->bool) N SUBSET u m` MP_TAC THENL
         [ALL_TAC; ASM SET_TAC[]]] THEN
      UNDISCH_TAC `N:num <= m` THEN
      MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`m:num`; `N:num`] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_REWRITE_TAC[] THEN SET_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN
    CONJ_TAC THENL
     [MAP_EVERY X_GEN_TAC [`f:real^N->real^1`; `v:real^1->bool`] THEN
      DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      REWRITE_TAC[baire; LEFT_IMP_EXISTS_THM] THEN
      REWRITE_TAC[IN_UNIV; ARITH] THEN
      X_GEN_TAC `g:num->real^N->real^1` THEN STRIP_TAC THEN
      ASM_CASES_TAC `v = (:real^1)` THENL
       [ASM_REWRITE_TAC[IN_UNIV; UNIV_GSPEC] THEN
        MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
        MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN
        REWRITE_TAC[o_THM; BAIRE_INDICATOR_UNIV];
        REWRITE_TAC[UNION_OF]] THEN
      EXISTS_TAC
       `{INTERS
           {{x | x IN (:real^N) /\
                 lift(setdist({(g:num->real^N->real^1) n x},
                              (:real^1) DIFF v)) IN
                 {x | drop x >= e}} |n|
            N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}` THEN
      REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
        REWRITE_TAC[NUM_COUNTABLE] THEN
        SIMP_TAC[REWRITE_RULE[IN] COUNTABLE_RESTRICT; COUNTABLE_RATIONAL];
        REWRITE_TAC[FORALL_IN_GSPEC] THEN
        MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN
        GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
         [IN_UNIV; IN_ELIM_THM] THEN
        REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
        MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
        SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
        REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
        ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
        REWRITE_TAC[SET_RULE
         `UNIV DIFF {x | x IN UNIV /\ f x IN {y | P y}} =
          {x | x IN UNIV /\ f x IN {y | ~P y}}`] THEN
        REWRITE_TAC[real_ge; REAL_NOT_LE] THEN
        REWRITE_TAC[clemma; ETA_AX] THEN ASM_CASES_TAC `k = 0` THENL
         [SUBGOAL_THEN `k1 = 1` SUBST_ALL_TAC THENL
           [ASM_ARITH_TAC; ALL_TAC] THEN
          REWRITE_TAC[GSYM FSIGMA_BAIRE] THEN
          MATCH_MP_TAC FSIGMA_BAIRE1_PREIMAGE_OPEN THEN
          REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT; FSIGMA_UNIV] THEN
          SUBGOAL_THEN
           `(\x. lift(setdist({g n x},(:real^1) DIFF v))) =
            (\y. lift(setdist({y},(:real^1) DIFF v))) o
            (g:num->real^N->real^1) n`
          SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
          MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN
          ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST];
          REMOVE_THEN "L2" (MP_TAC o SPECL
           [`(\y. lift(setdist({y},(:real^1) DIFF v))) o
             (g:num->real^N->real^1) n`;
            `{x | drop x < e}`]) THEN
          REWRITE_TAC[] THEN ANTS_TAC THENL
           [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT] THEN
            CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
            MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN
            ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST];
            REWRITE_TAC[o_THM; IN_UNIV] THEN REMOVE_THEN "Lk" MP_TAC THEN
            REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
            ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
            REWRITE_TAC[o_DEF] THEN
            DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
            REWRITE_TAC[] THEN
            MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN
            X_GEN_TAC `s:real^N->bool` THEN
            SIMP_TAC[COUNTABLE_UNION_OF_INC] THEN
            MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO) THEN
            REWRITE_TAC[COUNTABLE_UNION_OF_INC]]];
        GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
        REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN
        REWRITE_TAC[IN_UNIV; LIFT_DROP; real_ge] THEN
        TRANS_TAC EQ_TRANS
         `&0 < setdist({(f:real^N->real^1) x},(:real^1) DIFF v)` THEN
        CONJ_TAC THENL
         [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ];
          REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN
          ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN
          ASM SET_TAC[]] THEN
        GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
        REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN
        REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON
         [RATIONAL_CLOSED]
         `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2))
          ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN
        CONJ_TAC THEN X_GEN_TAC `q:real` THEN
        DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
        ASM_REWRITE_TAC[tendsto] THEN
        DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN
        ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL
         [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
          MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
          X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM
           (MATCH_MP_TAC o MATCH_MP (REAL_ARITH
           `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 <= d1`));
          REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
          REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
          DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
          REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH
           `abs(d1 - d2) <= x ==> x < q / &2 /\ q <= d1 ==> q / &2 < d2`)] THEN
        REWRITE_TAC[SETDIST_SING_TRIANGLE]];
      DISCH_THEN(LABEL_TAC "L3")] THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [GEN_TAC THEN EQ_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
      CONJ_TAC THENL
       [SUBGOAL_THEN `s = {x:real^N | indicator s x IN (UNIV DIFF {vec 0})}`
        SUBST1_TAC THENL
         [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_SING] THEN
          REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN
          COND_CASES_TAC THEN ASM_REWRITE_TAC[VEC_EQ; ARITH_EQ];
          REMOVE_THEN "L3" MATCH_MP_TAC THEN
          ASM_SIMP_TAC[ETA_AX; OPEN_DIFF; CLOSED_SING; OPEN_UNIV]];
        ONCE_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
        GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
         [COUNTABLE_UNION_OF_COMPLEMENT] THEN
        REWRITE_TAC[COMPL_COMPL; ETA_AX; clemma] THEN
        SUBGOAL_THEN
         `(:real^N) DIFF s = {x | indicator s x IN (UNIV DIFF {vec 1})}`
        SUBST1_TAC THENL
         [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_SING] THEN
          REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN
          COND_CASES_TAC THEN ASM_REWRITE_TAC[VEC_EQ; ARITH_EQ];
          REMOVE_THEN "L3" MATCH_MP_TAC THEN
          ASM_SIMP_TAC[ETA_AX; OPEN_DIFF; CLOSED_SING; OPEN_UNIV]]];
      DISCH_THEN(LABEL_TAC "L4")] THEN
    GEN_TAC THEN EQ_TAC THEN
    SIMP_TAC[COUNTABLE_UNION_OF_INC; COUNTABLE_INTERSECTION_OF_INC; o_THM] THEN
    USE_THEN "L4" (fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
       [GSYM COUNTABLE_UNION_OF_IDEMPOT] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO);
      GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
       [GSYM COUNTABLE_INTERSECTION_OF_IDEMPOT] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO)] THEN
    REWRITE_TAC[o_THM] THEN
    USE_THEN "L4" (fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN SIMP_TAC[]) in
  let FSIGMA_REDUCTION_GEN = prove
   (`!s k. (!n. (COUNTABLE UNION_OF baire k (:real^N) o indicator) (s n)) /\
           UNIONS {s n | n IN (:num)} = (:real^N)
           ==> ?t. (!n. baire k (:real^N) (indicator(t n))) /\
                   (!n. t n SUBSET s n) /\
                   pairwise (\m n. DISJOINT (t m) (t n)) (:num) /\
                   UNIONS {t n | n IN (:num)} = (:real^N)`,
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP FSIGMA_REDUCTION_GEN_ALT) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:num->real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
    ONCE_REWRITE_TAC[GSYM BAIRE_INDICATOR_DELTA] THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
    SUBGOAL_THEN
     `(:real^N) DIFF v n =
      UNIONS(IMAGE v (:num) DIFF {v n})`
    SUBST1_TAC THENL
     [W(MP_TAC o PART_MATCH (rand o rand) DIFF_UNIONS_PAIRWISE_DISJOINT o
        rand o snd) THEN
      REWRITE_TAC[PAIRWISE_IMAGE; UNIONS_1] THEN ANTS_TAC THENL
       [CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          PAIRWISE_IMP)) THEN
        SIMP_TAC[];
        DISCH_THEN(SUBST1_TAC o SYM) THEN
        ASM_REWRITE_TAC[GSYM SIMPLE_IMAGE]];
      MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
      ASM_REWRITE_TAC[clemma; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE; ETA_AX] THEN
      MATCH_MP_TAC COUNTABLE_SUBSET THEN
      EXISTS_TAC `IMAGE (v:num->real^N->bool) (:num)` THEN
      ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN SET_TAC[]]) in
  let GDELTA_SEPARATION_GEN = prove
   (`!s t k.
          (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s /\
          (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t /\
          DISJOINT s t
          ==> ?u. baire k (:real^N) (indicator u) /\
                  s SUBSET u /\ DISJOINT u t`,
    REWRITE_TAC[GSYM BAIRE_INDICATOR_DELTA; GSYM CONJ_ASSOC] THEN
    REWRITE_TAC[slemma]) in
  BAIRE_INDICATOR_SUC,BAIRE_INDICATOR_DELTA,FGSIGMA_BAIRE_PREIMAGE_OPEN_ALT,
  FSIGMA_REDUCTION_GEN,GDELTA_SEPARATION_GEN;;

let COUNTABLE_UNION_OF_BAIRE_INDICATOR = prove
 (`!s k. (COUNTABLE UNION_OF baire k (:real^N) o indicator) s
         ==> baire (k + 1) (:real^N) (indicator s)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THENL
   [ASM_REWRITE_TAC[COUNTABLE_UNION_OF_BAIRE0_INDICATOR] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[BAIRE_INDICATOR_UNIV; BAIRE_INDICATOR_EMPTY];
    ASM_SIMP_TAC[LE_1; GSYM BAIRE_INDICATOR_SUC] THEN
    SIMP_TAC[COUNTABLE_INTERSECTION_OF_INC] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN
    REWRITE_TAC[COUNTABLE_INTERSECTION_OF_INC]]);;

let COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR = prove
 (`!s k. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s
         ==> baire (k + 1) (:real^N) (indicator s)`,
  ONCE_REWRITE_TAC[GSYM BAIRE_INDICATOR_COMPLEMENT] THEN
  REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT; FORALL_DIFF] THEN
  REWRITE_TAC[o_DEF; BAIRE_INDICATOR_COMPLEMENT] THEN
  REWRITE_TAC[REWRITE_RULE[o_DEF] COUNTABLE_UNION_OF_BAIRE_INDICATOR]);;

let GDELTA_SEPARATION = prove
 (`!s t:real^N->bool.
        gdelta s /\ gdelta t /\ DISJOINT s t
        ==> ?u. fsigma u /\ gdelta u /\ s SUBSET u /\ DISJOINT u t`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[IMP_IMP; GDELTA_BAIRE] THEN
  DISCH_THEN(MP_TAC o MATCH_MP GDELTA_SEPARATION_GEN) THEN
  REWRITE_TAC[GSYM GDELTA_BAIRE; BAIRE1_INDICATOR; CONJ_ASSOC]);;

(* ------------------------------------------------------------------------- *)
(* More on Baire functions including the full preimage characterization.     *)
(* ------------------------------------------------------------------------- *)

let FSIGMA_BAIRE_PREIMAGE_OPEN_GEN = prove
 (`!f:real^M->real^N s u k.
        1 <= k /\ baire k s f /\ open u
        ==> ?t. (COUNTABLE UNION_OF baire k (:real^M) o indicator) t /\
                {x | x IN s /\ f(x) IN u} = s INTER t`,
  ONCE_REWRITE_TAC[MESON[]
   `(!f s u k. P f s u k) <=> (!s k f u. P f s u k)`] THEN
  GEN_TAC THEN MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN
  MATCH_MP_TAC(MESON[] `(!x. Q x) ==> (!x. P x ==> Q x)`) THEN
  MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [baire]) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
 (ASM_CASES_TAC `u = (:real^N)` THENL
   [EXISTS_TAC `(:real^M)` THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
    REWRITE_TAC[o_THM; BAIRE_INDICATOR_UNIV];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x IN u} =
    UNIONS {INTERS
           {{x | x IN s /\
                 lift(setdist({(g:num->real^M->real^N) n x},
                              (:real^N) DIFF u)) IN
                 {x | drop x >= e}} |n|
            N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}`
  SUBST1_TAC THENL
   [CONV_TAC SYM_CONV THEN
    GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN
    REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN
    ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL
     [REWRITE_TAC[real_ge]; MESON_TAC[LE_REFL]] THEN
    TRANS_TAC EQ_TRANS
     `&0 < setdist({(f:real^M->real^N) x},(:real^N) DIFF u)` THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ];
      REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN
      ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]] THEN
    GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
    REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN
    REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON
     [RATIONAL_CLOSED]
     `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2))
      ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN
    CONJ_TAC THEN X_GEN_TAC `q:real` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[tendsto] THEN
    DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL
     [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
      X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
        MATCH_MP (REAL_ARITH
       `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 <= d1`));
      REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
      DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
      REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH
       `abs(d1 - d2) <= x ==> x < q / &2 /\ q <= d1 ==> q / &2 < d2`)] THEN
    REWRITE_TAC[SETDIST_SING_TRIANGLE];
    ALL_TAC])
  THENL
   [SUBGOAL_THEN
     `!n:num e.
        closed_in (subtopology euclidean s)
         {x:real^M | x IN s /\ ~(setdist ({g n x},(:real^N) DIFF u) < e)}`
    MP_TAC THENL
     [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT; GSYM real_ge] THEN
      ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x >= e <=> drop(lift x) >= e`] THEN
      ONCE_REWRITE_TAC[SET_RULE
       `{x | x IN s /\ drop(f x) >= e} =
        {x | x IN s /\ f x IN {y | drop y >= e}}`] THEN
      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
      REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE] THEN
      SUBGOAL_THEN
       `(\x. lift(setdist({g n x},(:real^N) DIFF u))) =
        (\y. lift(setdist({y},(:real^N) DIFF u))) o (g:num->real^M->real^N) n`
      SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      RULE_ASSUM_TAC(REWRITE_RULE[baire]) THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST];
      REWRITE_TAC[CLOSED_IN_CLOSED; SKOLEM_THM; real_ge; IN_ELIM_THM] THEN
      REWRITE_TAC[LIFT_DROP; REAL_NOT_LT; LEFT_IMP_EXISTS_THM]];
     FIRST_X_ASSUM(MP_TAC o GENL [`n:num`; `e:real`] o
     SPECL [`((\x. ((lambda i. drop x):real^N))) o
             (\y. lift(setdist({y},(:real^N) DIFF u))) o
             ((g:num->real^M->real^N) n)`;
            `{x:real^N | x$1 < e}`]) THEN
    REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; ARITH_RULE `1 <= SUC n`] THEN
    REWRITE_TAC[o_ASSOC; RIGHT_FORALL_IMP_THM] THEN
    DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
     [GEN_TAC THEN MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN
      MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
      SIMP_TAC[linear; LAMBDA_BETA; DROP_ADD; DROP_CMUL; CART_EQ;
               VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT];
      REWRITE_TAC[o_THM; IN_ELIM_THM; LIFT_DROP] THEN
      SIMP_TAC[LAMBDA_BETA; DIMINDEX_GE_1; LE_REFL] THEN
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
       [SET_RULE `{x | x IN s /\ P x} = s INTER t <=>
                  {x | x IN s /\ ~P x} = s INTER (UNIV DIFF t)`] THEN
       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
        [COUNTABLE_UNION_OF_COMPLEMENT] THEN
       REWRITE_TAC[MESON[COMPL_COMPL]
        `(?s. P(UNIV DIFF s)) <=> (?s. P s)`] THEN
       REWRITE_TAC[ETA_AX; MESON[BAIRE_INDICATOR_COMPLEMENT; o_THM]
        `(baire k (:real^N) o indicator) ((:real^N) DIFF s) =
         (baire k (:real^N) o indicator) s`] THEN
       REWRITE_TAC[SKOLEM_THM; real_ge; REAL_NOT_LT;
                   LEFT_IMP_EXISTS_THM]]] THEN
  (X_GEN_TAC `c:num->real->real^M->bool` THEN DISCH_TAC THEN
   EXISTS_TAC
    `UNIONS {INTERS {c n e | N <= n} |
             N IN (:num) /\
             e IN {r | r IN rational /\ &0 < r}}:real^M->bool` THEN
   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
    [ALL_TAC;
     GEN_REWRITE_TAC I [EXTENSION] THEN
     REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; LIFT_DROP; IN_ELIM_THM] THEN
     MP_TAC LE_REFL THEN SET_TAC[]] THEN
   MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
   SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT; COUNTABLE_RESTRICT;
            COUNTABLE_RATIONAL; COUNTABLE_SUBSET_NUM] THEN
   REWRITE_TAC[FORALL_IN_GSPEC] THEN
   MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN STRIP_TAC)
  THENL
   [CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[GSYM FSIGMA_BAIRE] THEN
    MATCH_MP_TAC CLOSED_IMP_FSIGMA THEN MATCH_MP_TAC CLOSED_INTERS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC];
    MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
    REWRITE_TAC[ARITH_RULE `SUC(SUC n) = SUC n + 1`; o_THM] THEN
    SIMP_TAC[GSYM BAIRE_INDICATOR_SUC; ARITH_RULE `1 <= SUC n`] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC COUNTABLE_UNION_OF_INC; ALL_TAC] THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
    ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN
    X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n:num`; `e:real`]) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO) THEN
    SIMP_TAC[COUNTABLE_UNION_OF_INC]]);;

let FSIGMA_BAIRE_PREIMAGE_OPEN = prove
 (`!f:real^M->real^N s u k.
        1 <= k /\ baire k s f /\
        (COUNTABLE UNION_OF baire k (:real^M) o indicator) s /\ open u
        ==> (COUNTABLE UNION_OF baire k (:real^M) o indicator)
            {x | x IN s /\ f(x) IN u}`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT
   `p /\ q /\ r /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN
  DISCH_TAC THEN
  DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP FSIGMA_BAIRE_PREIMAGE_OPEN_GEN) THEN
  ASM_SIMP_TAC[COUNTABLE_UNION_OF_INTER; BAIRE_INDICATOR_INTER; o_THM]);;

let GDELTA_BAIRE_PREIMAGE_CLOSED_GEN = prove
 (`!f:real^M->real^N s u k.
        1 <= k /\ baire k s f /\ closed u
        ==> ?t. (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) t /\
                {x | x IN s /\ f(x) IN u} = s INTER t`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
  ONCE_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ f x IN u} = s INTER t <=>
    {x | x IN s /\ f x IN UNIV DIFF u} = s INTER (UNIV DIFF t)`] THEN
  REWRITE_TAC[MESON[COMPL_COMPL] `(?s. P(UNIV DIFF s)) <=> (?s. P s)`] THEN
  REWRITE_TAC[ETA_AX; MESON[BAIRE_INDICATOR_COMPLEMENT; o_THM]
     `(baire k (:real^N) o indicator) ((:real^N) DIFF s) =
      (baire k (:real^N) o indicator) s`] THEN
  MATCH_MP_TAC FSIGMA_BAIRE_PREIMAGE_OPEN_GEN THEN
  ASM_REWRITE_TAC[GSYM closed]);;

let GDELTA_BAIRE_PREIMAGE_CLOSED = prove
 (`!f:real^M->real^N s u k.
        1 <= k /\ baire k s f /\
        (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s /\ closed u
        ==> (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator)
            {x | x IN s /\ f(x) IN u}`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT
   `p /\ q /\ r /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN
  DISCH_TAC THEN
  DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP GDELTA_BAIRE_PREIMAGE_CLOSED_GEN) THEN
  ASM_SIMP_TAC[COUNTABLE_INTERSECTION_OF_INTER; BAIRE_INDICATOR_INTER;
               o_THM]);;

let BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN = prove
 (`!f:real^M->real^N s k.
      1 <= k
      ==> (baire k s f <=>
           !u. open u
               ==> ?t. (COUNTABLE UNION_OF baire k (:real^M) o indicator) t /\
                       {x | x IN s /\ f(x) IN u} = s INTER t)`,
  let llemma = prove
   (`!s c u v k.
          1 <= k /\
          DISJOINT u v /\
          (COUNTABLE UNION_OF (baire k (:real^N) o indicator)) u /\
          s INTER u = s INTER c /\
          (COUNTABLE UNION_OF (baire k (:real^N) o indicator)) v /\
          s INTER v = s DIFF c
          ==> baire k s (indicator c)`,
    REPLICATE_TAC 4 GEN_TAC THEN MATCH_MP_TAC num_INDUCTION THEN
    CONV_TAC NUM_REDUCE_CONV THEN X_GEN_TAC `k:num` THEN
    DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
    SUBGOAL_THEN
     `?y z f:num->real^N->real^1.
          (!n. y n SUBSET y(SUC n)) /\
          UNIONS {y n | n IN (:num)} = u /\
          (!n. z n SUBSET z(SUC n)) /\
          UNIONS {z n | n IN (:num)} = v /\
          (!n. baire k (:real^N) (f n)) /\
          (!n x. x IN y n ==> f n x = vec 1) /\
          (!n x. x IN z n ==> f n x = vec 0)`
    STRIP_ASSUME_TAC THENL
     [ALL_TAC;
      REWRITE_TAC[baire] THEN EXISTS_TAC `f:num->real^N->real^1` THEN
      CONJ_TAC THENL [ASM_MESON_TAC[BAIRE_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN
      X_GEN_TAC `(x:real^N)` THEN DISCH_TAC THEN
      MATCH_MP_TAC LIM_EVENTUALLY THEN
      REWRITE_TAC[indicator] THEN
      ASM_CASES_TAC `(x:real^N) IN c` THEN ASM_REWRITE_TAC[] THENL
       [SUBGOAL_THEN `(x:real^N) IN UNIONS {y n | n IN (:num)}` MP_TAC THENL
         [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC];
        SUBGOAL_THEN `(x:real^N) IN UNIONS {z n | n IN (:num)}` MP_TAC THENL
         [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC]] THEN
      SIMP_TAC[UNIONS_GSPEC; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY;
               IN_UNIV] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
      X_GEN_TAC `m:num` THEN DISCH_TAC THENL
       [SUBGOAL_THEN `(y:num->real^N->bool) N SUBSET y m` MP_TAC THENL
         [ALL_TAC; ASM SET_TAC[]];
        SUBGOAL_THEN `(z:num->real^N->bool) N SUBSET z m` MP_TAC THENL
         [ALL_TAC; ASM SET_TAC[]]] THEN
      UNDISCH_TAC `N:num <= m` THEN
      MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`m:num`; `N:num`] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_REWRITE_TAC[] THEN SET_TAC[]] THEN
    ASM_CASES_TAC `k = 0` THENL
     [MAP_EVERY UNDISCH_TAC
       [`(COUNTABLE UNION_OF baire (SUC k) (:real^N) o indicator) v`;
        `(COUNTABLE UNION_OF baire (SUC k) (:real^N) o indicator) u`] THEN
      ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN
      REWRITE_TAC[GSYM FSIGMA_BAIRE; FSIGMA_ASCENDING] THEN
      REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N->bool` THEN
      REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:num->real^N->bool` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[baire] THEN MP_TAC(GEN `n:num` (ISPECL
       [`(y:num->real^N->bool) n`; `(z:num->real^N->bool) n`;
        `vec 1:real^1`; `vec 0:real^1`] URYSOHN)) THEN
      DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SKOLEM_THM] THEN ASM SET_TAC[];
      SUBGOAL_THEN
       `(COUNTABLE UNION_OF COUNTABLE INTERSECTION_OF
         baire k (:real^N) o indicator) u /\
        (COUNTABLE UNION_OF COUNTABLE INTERSECTION_OF
         baire k (:real^N) o indicator) v`
      MP_TAC THENL
       [MAP_EVERY UNDISCH_TAC
         [`(COUNTABLE UNION_OF baire (SUC k) (:real^N) o indicator) v`;
          `(COUNTABLE UNION_OF baire (SUC k) (:real^N) o indicator) u`] THEN
        REWRITE_TAC[IMP_IMP] THEN
        GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV o LAND_CONV) [GSYM ETA_AX] THEN
        ASM_SIMP_TAC[ADD1; LE_1; GSYM BAIRE_INDICATOR_SUC; o_THM] THEN
        MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
        GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
         [GSYM COUNTABLE_UNION_OF_IDEMPOT] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN
        SIMP_TAC[];
        ALL_TAC] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_ASCENDING o
        lhand o lhand o snd) THEN
      W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_ASCENDING o
        rand o lhand o rand o snd) THEN
      SIMP_TAC[COUNTABLE_INTERSECTION_OF_UNION; BAIRE_INDICATOR_UNION; o_THM;
        COUNTABLE_INTERSECTION_OF_INC; indicator; BAIRE_CONST;
        NOT_IN_EMPTY] THEN
      DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN
      REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
      REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N->bool` THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:num->real^N->bool` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(GEN `n:num` (ISPECL
       [`(y:num->real^N->bool) n`; `(z:num->real^N->bool) n`; `k:num`]
       GDELTA_SEPARATION_GEN)) THEN
      ASM_SIMP_TAC[LE_1] THEN
      DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
       [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM]] THEN
      DISCH_THEN(X_CHOOSE_THEN `w:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `indicator o (w:num->real^N->bool)` THEN
      ASM_REWRITE_TAC[o_THM] THEN
      REWRITE_TAC[indicator] THEN ASM SET_TAC[]]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  ASM_SIMP_TAC[FSIGMA_BAIRE_PREIMAGE_OPEN_GEN] THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`vec 0:real^N`; `&1:real`] HOMEOMORPHIC_BALL_UNIV) THEN
  REWRITE_TAC[REAL_LT_01; homeomorphic] THEN
  REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`h':real^N->real^N`; `h:real^N->real^N`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `f:real^M->real^N = h' o (h:real^N->real^N) o f`
  SUBST1_TAC THENL [ASM_REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN
  ABBREV_TAC `g = (h:real^N->real^N) o (f:real^M->real^N)` THEN
  SUBGOAL_THEN `!x. (g:real^M->real^N) x IN ball(vec 0,&1)` ASSUME_TAC THENL
   [EXPAND_TAC "g" THEN REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `baire k s (g:real^M->real^N)` MP_TAC THENL
   [ALL_TAC;
    SUBGOAL_THEN `?n. k = SUC n` (CHOOSE_THEN SUBST1_TAC) THENL
     [ASM_MESON_TAC[LE_1; num_CASES]; REWRITE_TAC[baire]] THEN
    DISCH_THEN(X_CHOOSE_THEN `q:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\n. (h':real^N->real^N) o
                    (\y. (min (&1 - inv(&n + &1)) (norm y)) / norm y % y) o
                    (q:num->real^M->real^N) n` THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL
     [X_GEN_TAC `m:num` THEN REWRITE_TAC[o_ASSOC] THEN
      MATCH_MP_TAC BAIRE_CONTINUOUS_COMPOSE_UNIV THEN ASM_REWRITE_TAC[] THEN
      ASM_CASES_TAC `m = 0` THENL
       [ASM_REWRITE_TAC[o_DEF] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
        SIMP_TAC[REAL_ARITH `&0 <= x ==> min (&0) x = &0`; NORM_POS_LE] THEN
        REWRITE_TAC[real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO] THEN
        REWRITE_TAC[CONTINUOUS_ON_CONST];
        ALL_TAC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `ball(vec 0,&1 - inv(&m + &1)) UNION
                    ((:real^N) DELETE vec 0)` THEN
        REWRITE_TAC[SET_RULE
          `UNIV SUBSET s UNION (UNIV DELETE a) <=> a IN s`] THEN
        REWRITE_TAC[CENTRE_IN_BALL; REAL_SUB_LT] THEN
        ASM_SIMP_TAC[REAL_INV_LT_1; REAL_LT_ADDL; REAL_OF_NUM_LT; LE_1] THEN
        MATCH_MP_TAC CONTINUOUS_ON_UNION_OPEN THEN
        SIMP_TAC[OPEN_UNIV; OPEN_DELETE; OPEN_BALL] THEN CONJ_TAC THENL
         [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `\y:real^N. y` THEN
          REWRITE_TAC[CONTINUOUS_ON_ID; IN_BALL_0] THEN
          SIMP_TAC[REAL_ARITH `x < y ==> min y x = x`] THEN
          X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN
          ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
          ASM_SIMP_TAC[REAL_DIV_REFL; NORM_EQ_0; VECTOR_MUL_LID];
          MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
          REWRITE_TAC[CONTINUOUS_ON_ID; real_div; o_DEF; LIFT_CMUL] THEN
          MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN
          CONJ_TAC THENL
           [MATCH_MP_TAC CONTINUOUS_ON_MIN_1 THEN
            SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID] THEN
            REWRITE_TAC[CONTINUOUS_ON_CONST];
            MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
            SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID] THEN
            REWRITE_TAC[NORM_EQ_0; IN_DELETE; IN_UNIV]]];
         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
           CONTINUOUS_ON_SUBSET)) THEN
         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0; IN_UNIV] THEN
         X_GEN_TAC `x:real^N` THEN
         ASM_CASES_TAC `x:real^N = vec 0` THEN
         ASM_REWRITE_TAC[VECTOR_MUL_RZERO; NORM_0; REAL_LT_01] THEN
         REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
         ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN MATCH_MP_TAC(REAL_ARITH
          `&0 <= x /\ x < &1 /\ &0 <= y ==> abs(min x y) < &1`) THEN
         REWRITE_TAC[REAL_SUB_LE; NORM_POS_LE] THEN
         SIMP_TAC[REAL_INV_LE_1; REAL_ARITH `&1 <= &m + &1`] THEN
         REWRITE_TAC[REAL_ARITH `x - y < x <=> &0 < y`; REAL_LT_INV_EQ] THEN
         REAL_ARITH_TAC];
      X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
      MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
      EXISTS_TAC `\n. (h':real^N->real^N) ((q:num->real^M->real^N) n x)` THEN
      REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
       [MP_TAC(ISPEC `(&1 - norm((g:real^M->real^N) x)) / &2`
          ARCH_EVENTUALLY_INV1) THEN
        SUBGOAL_THEN
         `((\n. (q:num->real^M->real^N) n x) --> g x) sequentially`
        MP_TAC THENL [ASM_SIMP_TAC[]; REWRITE_TAC[tendsto]] THEN
        DISCH_THEN(MP_TAC o SPEC `(&1 - norm((g:real^M->real^N) x)) / &2`) THEN
        REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL_0]) THEN
        ASM_REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
        X_GEN_TAC `m:num` THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP
         (NORM_ARITH `dist(x,y) < (&1 - norm y) / &2 /\ a < (&1 - norm y) / &2
            ==> norm(x:real^N) < &1 - a`)) THEN
        SIMP_TAC[REAL_ARITH `x < y ==> min y x = x`] THEN DISCH_TAC THEN
        ASM_CASES_TAC `(q:num->real^M->real^N) m x = vec 0` THEN
        ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
        ASM_SIMP_TAC[REAL_DIV_REFL; NORM_EQ_0; VECTOR_MUL_LID];
        MP_TAC(ISPECL [`h':real^N->real^N`; `sequentially`]
          LIM_CONTINUOUS_FUNCTION) THEN
        DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
        UNDISCH_TAC `(h':real^N->real^N) continuous_on ball(vec 0,&1)` THEN
        SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN
        DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]] THEN
  SUBGOAL_THEN
   `!u. open u
        ==> ?t. (COUNTABLE UNION_OF baire k (:real^M) o indicator) t /\
                {x | x IN s /\ (g:real^M->real^N) x IN u} = s INTER t`
  MP_TAC THENL
   [X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `{x | x IN s /\ (g:real^M->real^N) x IN u} =
      {x | x IN s /\ f(x) IN {y:real^N | h y IN u}}`
    SUBST1_TAC THENL
     [EXPAND_TAC "g" THEN REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN
      ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]];
    ALL_TAC] THEN
  SUBGOAL_THEN `bounded(IMAGE (g:real^M->real^N) s)` MP_TAC THENL
   [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,&1)` THEN
    ASM_REWRITE_TAC[BOUNDED_BALL; SUBSET; FORALL_IN_IMAGE];
    UNDISCH_TAC `1 <= k`] THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN
  SPEC_TAC(`g:real^M->real^N`,`f:real^M->real^N`) THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[BAIRE_UNIFORM_APPROXIMATION] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_EQ_TOTALLY_BOUNDED]) THEN
  DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
  ASM_CASES_TAC `c:real^N->bool = {}` THENL
   [ASM_REWRITE_TAC[IMAGE_CLAUSES; SUBSET_EMPTY; UNIONS_0; IMAGE_EQ_EMPTY] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
    MESON_TAC[BAIRE_CONST];
    STRIP_TAC] THEN
  SUBGOAL_THEN `?y:num->real^N N. IMAGE y (0..N) = c`
  MP_TAC THENL
   [MP_TAC(ISPECL [`c:real^N->bool`; `CARD(c:real^N->bool)`]
        HAS_SIZE_INDEX) THEN
    ASM_REWRITE_TAC[GSYM FINITE_HAS_SIZE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N` THEN
    STRIP_TAC THEN EXISTS_TAC `CARD(c:real^N->bool) - 1` THEN
    ASM_SIMP_TAC[numseg; LE_0; CARD_EQ_0; ARITH_RULE
      `~(c = 0) ==> (x <= c - 1 <=> x < c)`] THEN
    ASM SET_TAC[];
    DISCH_THEN(REPEAT_TCL CHOOSE_THEN (SUBST_ALL_TAC o SYM))] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM IMAGE_o; o_DEF]) THEN
  ABBREV_TAC
   `u = \n. if n <= N then ball((y:num->real^N) n,e) else {}` THEN
  SUBGOAL_THEN `!n. open((u:num->real^N->bool) n)` ASSUME_TAC THENL
   [EXPAND_TAC "u" THEN MESON_TAC[OPEN_EMPTY; OPEN_BALL]; ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `(u:num->real^N->bool) n`) THEN
  ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
  X_GEN_TAC `v:num->real^M->bool` THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINDER_CONV o ONCE_DEPTH_CONV)
   [GSYM o_DEF] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`v:num->real^M->bool`; `k:num`]
        FSIGMA_REDUCTION_GEN_ALT) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `w:num->real^M->bool` THEN STRIP_TAC THEN
  EXISTS_TAC `(\x. vsum(0..N) (\n. drop(indicator(w n:real^M->bool) x) % y n))
              :real^M->real^N` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [MATCH_MP_TAC BAIRE_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN
    X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC BAIRE_MUL THEN
    REWRITE_TAC[BAIRE_CONST; LIFT_DROP; ETA_AX] THEN
    MATCH_MP_TAC llemma THEN
    EXISTS_TAC `(w:num->real^M->bool) n` THEN
    EXISTS_TAC `UNIONS {w m | m IN (:num) DELETE n}:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pairwise; DISJOINT]) THEN
      ASM_SIMP_TAC[IN_DELETE; IN_UNIV];
      MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
      SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
      ASM_REWRITE_TAC[FORALL_IN_IMAGE];
      MATCH_MP_TAC(SET_RULE
       `DISJOINT t u /\ s SUBSET u UNION t ==> s INTER t = s DIFF u`) THEN
      ASM_REWRITE_TAC[GSYM UNIONS_INSERT; SET_RULE
       `w n INSERT {w m | m IN (UNIV DELETE n)} = {w m | m IN UNIV}`] THEN
      REWRITE_TAC[DISJOINT; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pairwise; DISJOINT]) THEN
      ASM_SIMP_TAC[IN_DELETE; IN_UNIV] THEN
      REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN
      X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; UNIONS_GSPEC] THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
      REWRITE_TAC[IN_NUMSEG; LE_0] THEN STRIP_TAC THEN
      SUBGOAL_THEN `x IN {x | x IN s /\ (f:real^M->real^N) x IN u(m:num)}`
      MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_INTER]]];
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    SUBGOAL_THEN `(x:real^M) IN UNIONS {w n | n IN (:num)}` MP_TAC THENL
     [ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; UNIONS_GSPEC] THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_UNIV] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
      REWRITE_TAC[IN_NUMSEG; LE_0] THEN STRIP_TAC THEN
      SUBGOAL_THEN `x IN {x | x IN s /\ (f:real^M->real^N) x IN u(n:num)}`
      MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_INTER]];
      REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV]] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `!m:num. indicator (w m) (x:real^M) = if m = n then vec 1 else vec 0`
     (fun th -> REWRITE_TAC[th])
    THENL
     [X_GEN_TAC `m:num` THEN REWRITE_TAC[indicator] THEN
      AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
      ASM SET_TAC[];
      REWRITE_TAC[COND_RAND; COND_RATOR]] THEN
    SIMP_TAC[DROP_VEC; VECTOR_MUL_LZERO; VSUM_DELTA] THEN
    REWRITE_TAC[IN_NUMSEG; LE_0; VECTOR_MUL_LID] THEN
    SUBGOAL_THEN `(f:real^M->real^N) x IN u(n:num)` MP_TAC THENL
     [ASM SET_TAC[]; EXPAND_TAC "u"] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_BALL; NOT_IN_EMPTY] THEN
    CONV_TAC NORM_ARITH]);;

let BAIRE_EQ_FSIGMA_PREIMAGE_OPEN = prove
 (`!f:real^M->real^N s k.
      1 <= k /\ (COUNTABLE UNION_OF baire k (:real^M) o indicator) s
      ==> (baire k s f <=>
           !u. open u
               ==> (COUNTABLE UNION_OF baire k (:real^M) o indicator)
                   {x | x IN s /\ f(x) IN u})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  ASM_SIMP_TAC[FSIGMA_BAIRE_PREIMAGE_OPEN] THEN
  ASM_SIMP_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_TAC THEN
  EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN u}` THEN
  ASM_REWRITE_TAC[] THEN SET_TAC[]);;

let BAIRE_EQ_FSIGMA_PREIMAGE_ALT = prove
 (`!f:real^M->real^N s k.
      1 <= k
      ==> ((COUNTABLE UNION_OF baire k (:real^M) o indicator) s /\
            baire k s f <=>
            !u. open u
                ==> (COUNTABLE UNION_OF baire k (:real^M) o indicator)
                    {x | x IN s /\ f(x) IN u})`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(p /\ q ==> (r <=> s)) /\ (s ==> q)
    ==> (p ==> (q /\ r <=> s))`) THEN
  REWRITE_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN] THEN
  DISCH_THEN(MP_TAC o SPEC `(:real^N)`) THEN
  REWRITE_TAC[OPEN_UNIV; IN_UNIV; SET_RULE `{x | x IN s} = s`]);;

let BAIRE_EQ_GDELTA_PREIMAGE_CLOSED_GEN = prove
 (`!f:real^M->real^N s k.
      1 <= k
      ==> (baire k s f <=>
           !u. closed u
               ==> ?t. (COUNTABLE INTERSECTION_OF
                        baire k (:real^M) o indicator) t /\
                       {x | x IN s /\ f(x) IN u} = s INTER t)`,
  REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
  ONCE_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ f x IN u} = s INTER t <=>
    {x | x IN s /\ f x IN UNIV DIFF u} = s INTER (UNIV DIFF t)`] THEN
  REWRITE_TAC[MESON[COMPL_COMPL] `(?s. P(UNIV DIFF s)) <=> (?s. P s)`] THEN
  REWRITE_TAC[ETA_AX; closed; MESON[BAIRE_INDICATOR_COMPLEMENT; o_THM]
     `(baire k (:real^N) o indicator) ((:real^N) DIFF s) =
      (baire k (:real^N) o indicator) s`] THEN
  REWRITE_TAC[MESON[COMPL_COMPL] `(!s. P(UNIV DIFF s)) <=> (!s. P s)`] THEN
  REWRITE_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN]);;

let BAIRE_EQ_GDELTA_PREIMAGE_CLOSED = prove
 (`!f:real^M->real^N s k.
      1 <= k /\ (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s
      ==> (baire k s f <=>
           !u. closed u
               ==> (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator)
                   {x | x IN s /\ f(x) IN u})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  ASM_SIMP_TAC[GDELTA_BAIRE_PREIMAGE_CLOSED] THEN
  ASM_SIMP_TAC[BAIRE_EQ_GDELTA_PREIMAGE_CLOSED_GEN] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_TAC THEN
  EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN u}` THEN
  ASM_REWRITE_TAC[] THEN SET_TAC[]);;

let BAIRE_EQ_GDELTA_PREIMAGE_ALT = prove
 (`!f:real^M->real^N s k.
      1 <= k
      ==> ((COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s /\
            baire k s f <=>
            !u. closed u
                ==> (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator)
                    {x | x IN s /\ f(x) IN u})`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(p /\ q ==> (r <=> s)) /\ (s ==> q)
    ==> (p ==> (q /\ r <=> s))`) THEN
  REWRITE_TAC[BAIRE_EQ_GDELTA_PREIMAGE_CLOSED] THEN
  DISCH_THEN(MP_TAC o SPEC `(:real^N)`) THEN
  REWRITE_TAC[CLOSED_UNIV; IN_UNIV; SET_RULE `{x | x IN s} = s`]);;

let COUNTABLE_DISCONTINUITIES_IMP_BAIRE1 = prove
 (`!f:real^M->real^N s.
        COUNTABLE {x | x IN s /\ ~(f continuous (at x within s))}
        ==> baire 1 s f`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE
     `{x | x IN s /\ ~P x} = s DIFF {x | x IN s /\ P x}`] THEN
  ABBREV_TAC
   `t = {x | x IN s /\ (f:real^M->real^N) continuous at x within s}` THEN
  DISCH_TAC THEN SIMP_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN; LE_REFL] THEN
  X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN
  REWRITE_TAC[GSYM FSIGMA_BAIRE] THEN
  SUBGOAL_THEN
   `?u r. open_in (subtopology euclidean s) u /\
          r SUBSET s DIFF t /\
          {x | x IN s /\ (f:real^M->real^N) x IN v} = u UNION r`
  STRIP_ASSUME_TAC THENL
   [SUBGOAL_THEN
     `!x. x IN t /\ f x IN v
          ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\
                  IMAGE (f:real^M->real^N) u SUBSET v`
    MP_TAC THENL
     [X_GEN_TAC `x:real^M` THEN
      EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_WITHIN_OPEN]) THEN
      DISCH_THEN(MP_TAC o SPEC `v:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `s INTER u:real^M->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN ASM SET_TAC[];
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
      REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `u:real^M->real^M->bool` THEN DISCH_TAC THEN
      EXISTS_TAC
       `UNIONS {u x:real^M->bool | x IN t /\ (f:real^M->real^N) x IN v}` THEN
      EXISTS_TAC `{x | x IN s /\ f x IN v} DIFF
                  UNIONS {u x | x IN t /\ (f:real^M->real^N) x IN v}` THEN
      ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[OPEN_IN_OPEN]) THEN
      REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]];
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `w UNION r:real^M->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC FSIGMA_UNION THEN ASM_SIMP_TAC[OPEN_IMP_FSIGMA] THEN
    MATCH_MP_TAC COUNTABLE_IMP_FSIGMA THEN ASM_MESON_TAC[COUNTABLE_SUBSET]]);;

let COUNTABLE_NEITHER_SIDED_LIMITS_IMP_BAIRE1_GEN = prove
 (`!f:real^1->real^N s.
      COUNTABLE {x | x IN s /\
                     ~(?l. (f --> l)
                           (at x within {t | t IN s /\ drop t <= drop x})) /\
                     ~(?l. (f --> l)
                           (at x within {t | t IN s /\ drop x <= drop t}))}
      ==> baire 1 s f`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COUNTABLE_DISCONTINUITIES_IMP_BAIRE1 THEN MP_TAC
   (ISPECL [`f:real^1->real^N`; `s:real^1->bool`]
           COUNTABLE_NONCONTINUOUS_ONE_SIDED_LIMITS) THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM COUNTABLE_UNION] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
  SET_TAC[]);;

let COUNTABLE_NEITHER_SIDED_LIMITS_IMP_BAIRE1 = prove
 (`!f:real^1->real^N s.
      COUNTABLE {x | x IN s /\
                     ~(?l. (f --> l) (at x within {t | drop t <= drop x})) /\
                     ~(?l. (f --> l) (at x within {t | drop x <= drop t}))}
      ==> baire 1 s f`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC COUNTABLE_NEITHER_SIDED_LIMITS_IMP_BAIRE1_GEN THEN
  POP_ASSUM MP_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT]
    COUNTABLE_SUBSET) THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
  REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
  REWRITE_TAC[CONTRAPOS_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIM_WITHIN_SUBSET) THEN
  SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Extending Baire functions and more miscellaneous properties.              *)
(* ------------------------------------------------------------------------- *)

let BAIRE_EXTENSION = prove
 (`!f:real^M->real^N s k.
        baire k s f /\
        (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s
        ==> ?g. baire k (:real^M) g /\ !x. x IN s ==> g x = f x`,
  let version1 = prove
   (`!f:real^N->real^1 s k.
          baire k s f /\ 1 <= k /\
          (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s /\
          (!x. x IN s ==> norm(f x) < &1)
          ==> ?g. baire k (:real^N) g /\
                  (!x. norm(g x) < &1) /\
                  !x. x IN s ==> g x = f x`,
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     `?g. (!n. baire k (:real^N) (g n) /\
               !x. x IN s ==> norm(g n x - f x) < (&2 / &3) pow n) /\
          (!n x. norm(g(SUC n) x - g n x:real^1) <= (&2 / &3) pow n / &3)`
    MP_TAC THENL
     [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
       [EXISTS_TAC `(\x. vec 0):real^N->real^1` THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN
        ASM_REWRITE_TAC[BAIRE_CONST; NORM_NEG; VECTOR_SUB_LZERO];
        MAP_EVERY X_GEN_TAC [`n:num`; `g:real^N->real^1`] THEN STRIP_TAC] THEN
      MP_TAC(ISPECL
       [`(\x. g x - f x):real^N->real^1`; `s:real^N->bool`; `k:num`]
       BAIRE_EQ_GDELTA_PREIMAGE_CLOSED) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN
      ANTS_TAC THENL
       [MATCH_MP_TAC BAIRE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN
        MATCH_MP_TAC BAIRE_SUBSET THEN EXISTS_TAC `(:real^N)` THEN
        ASM_REWRITE_TAC[SUBSET_UNIV];
        ALL_TAC] THEN
      DISCH_THEN(fun th ->
          MP_TAC(SPEC `{y | drop y <= --((&2 / &3) pow n / &3)}` th) THEN
          MP_TAC(SPEC `{y | drop y >= (&2 / &3) pow n / &3}` th)) THEN
      REWRITE_TAC[drop; IMP_IMP; CLOSED_HALFSPACE_COMPONENT_GE;
                  CLOSED_HALFSPACE_COMPONENT_LE] THEN
      DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE
       [TAUT `b /\ c /\ d ==> e <=> b /\ c ==> d ==> e`]
       GDELTA_SEPARATION_GEN)) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
       [MATCH_MP_TAC(SET_RULE
         `(!x. P x /\ Q x ==> F)
          ==> DISJOINT {x | x IN s /\ f x IN {y | P y}}
                       {x | x IN s /\ f x IN {y | Q y}}`) THEN
        GEN_TAC THEN
        MATCH_MP_TAC(REAL_ARITH `&0 < e ==> x >= e /\ x <= --e ==> F`) THEN
        REWRITE_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN
        MATCH_MP_TAC REAL_POW_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV;
        DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)] THEN
      EXISTS_TAC
       `\x. (g:real^N->real^1) x +
            (&2 / &3) pow n / &3 % (vec 1 - &2 % indicator u x)` THEN
      REWRITE_TAC[VECTOR_ADD_SUB] THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC BAIRE_ADD THEN ASM_REWRITE_TAC[ETA_AX] THEN
        MATCH_MP_TAC BAIRE_CMUL THEN MATCH_MP_TAC BAIRE_SUB THEN
        REWRITE_TAC[BAIRE_CONST] THEN MATCH_MP_TAC BAIRE_CMUL THEN
        ASM_REWRITE_TAC[ETA_AX];
        X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; GSYM drop]) THEN
        REWRITE_TAC[NORM_1; DROP_ADD; DROP_SUB; DROP_CMUL; DROP_VEC] THEN
        ASM_CASES_TAC `drop(g(x:real^N) - f x) >= (&2 / &3) pow n / &3` THENL
         [SUBGOAL_THEN `(x:real^N) IN u` ASSUME_TAC THENL
           [ASM SET_TAC[]; ASM_REWRITE_TAC[indicator; DROP_VEC]] THEN
          CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_pow] THEN
          MATCH_MP_TAC(REAL_ARITH
           `g - f >= b / &3 /\ abs(g - f) < b
            ==> abs((g + b / &3 * -- &1) - f) < &2 / &3 * b`) THEN
          ASM_SIMP_TAC[GSYM NORM_1; GSYM DROP_SUB];
          ALL_TAC] THEN
        ASM_CASES_TAC
         `drop(g(x:real^N) - f x) <= --((&2 / &3) pow n / &3)`
        THENL
         [SUBGOAL_THEN `~((x:real^N) IN u)` ASSUME_TAC THENL
           [ASM SET_TAC[]; ASM_REWRITE_TAC[indicator; DROP_VEC]] THEN
          CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_pow] THEN
          MATCH_MP_TAC(REAL_ARITH
           `g - f <= --(b / &3) /\ abs(g - f) < b
            ==> abs((g + b / &3 * &1) - f) < &2 / &3 * b`) THEN
          ASM_SIMP_TAC[GSYM NORM_1; GSYM DROP_SUB];
          ALL_TAC] THEN
        REWRITE_TAC[real_pow] THEN MATCH_MP_TAC(REAL_ARITH
         `abs(g - f) < b / &3 /\ abs(d) <= b / &3
          ==> abs((g + d) - f) < &2 / &3 * b`) THEN
        REWRITE_TAC[GSYM DROP_SUB] THEN
        CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC];
        GEN_TAC THEN
        REWRITE_TAC[NORM_1; DROP_CMUL; DROP_SUB; DROP_ADD; DROP_VEC]] THEN
     (REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
      MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
       [MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN
        MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV;
        REWRITE_TAC[indicator] THEN COND_CASES_TAC THEN
        REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);
      REWRITE_TAC[FORALL_AND_THM; LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `g:num->real^N->real^1` THEN STRIP_TAC THEN
    MP_TAC(snd(EQ_IMP_RULE(ISPECL
     [`\x:real^N. T`; `g:num->real^N->real^1`]
     UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT))) THEN
    REWRITE_TAC[] THEN ANTS_TAC THENL
     [X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`&2 / &3`; `e:real`] ARCH_EVENTUALLY_POW_INV) THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
      MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^N`] THEN STRIP_TAC THEN
      SUBGOAL_THEN
       `dist((g:num->real^N->real^1) m x,g n x) =
        norm(vsum(m..n-1) (\i. g(SUC i) x - g i x))`
      SUBST1_TAC THENL
       [REWRITE_TAC[ADD1; VSUM_DIFFS_ALT] THEN
        ASM_SIMP_TAC[ARITH_RULE `m < n ==> m <= n - 1`] THEN
        SUBGOAL_THEN `n - 1 + 1 = n` SUBST1_TAC THENL
         [ASM_ARITH_TAC; CONV_TAC NORM_ARITH];
        TRANS_TAC REAL_LET_TRANS `(&2 / &3) pow m` THEN
        ASM_SIMP_TAC[REAL_ARITH `abs x < e ==> x < e`] THEN
        MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
        TRANS_TAC REAL_LE_TRANS `sum(m..n-1) (\i. (&2 / &3) pow i / &3)` THEN
        ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN
        REWRITE_TAC[real_div; SUM_RMUL] THEN
        REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[SUM_GP] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN
        ASM_SIMP_TAC[ARITH_RULE `m < n ==> ~(n - 1 < m)`] THEN
        REWRITE_TAC[REAL_ARITH
         `(x - y) / (&1 / &3) / &3 <= x <=> &0 <= y`] THEN
        MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV];
      DISCH_THEN(X_CHOOSE_TAC `h:real^N->real^1`)] THEN
    MP_TAC(ISPECL [`g:num->real^N->real^1`; `h:real^N->real^1`;
                   `(:real^N)`; `k:num`] BAIRE_UNIFORM_LIMIT) THEN
    ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; IN_UNIV; GSYM dist] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN
    SUBGOAL_THEN `!x. x IN s ==> (h:real^N->real^1) x = f x` ASSUME_TAC THENL
     [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
      EXISTS_TAC `\n. (g:num->real^N->real^1) n x` THEN
      REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; tendsto] THEN CONJ_TAC THENL
       [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[];
        ALL_TAC] THEN
      X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`&2 / &3`; `e:real`] ARCH_EVENTUALLY_POW_INV) THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
      X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN
      MATCH_MP_TAC(REAL_ARITH `y < x ==> abs x < e ==> y < e`) THEN
      ASM_SIMP_TAC[dist];
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [`h:real^N->real^1`; `(:real^N)`; `k:num`]
     BAIRE_EQ_GDELTA_PREIMAGE_CLOSED) THEN
    ASM_SIMP_TAC[COUNTABLE_INTERSECTION_OF_INC; o_THM; indicator;
                 IN_UNIV; BAIRE_CONST] THEN
    DISCH_THEN(MP_TAC o SPEC `(:real^1) DIFF ball(vec 0,&1)`) THEN
    ASM_REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL] THEN
    REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0; REAL_NOT_LT] THEN DISCH_TAC THEN
    MP_TAC(ISPECL
     [`s:real^N->bool`; `{x:real^N | &1 <= norm(h x:real^1)}`; `k:num`]
     GDELTA_SEPARATION_GEN) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\x. drop(indicator u x) % (h:real^N->real^1) x` THEN
    REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC BAIRE_MUL THEN
      ASM_REWRITE_TAC[LIFT_DROP; ETA_AX];
      X_GEN_TAC `x:real^N` THEN REWRITE_TAC[NORM_MUL; indicator] THEN
      COND_CASES_TAC THEN
      REWRITE_TAC[DROP_VEC; REAL_MUL_LZERO; REAL_ABS_NUM; REAL_LT_01] THEN
      REWRITE_TAC[REAL_MUL_LID; GSYM REAL_NOT_LE] THEN ASM SET_TAC[];
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      REWRITE_TAC[NORM_MUL; indicator] THEN
      COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      ASM_SIMP_TAC[DROP_VEC; VECTOR_MUL_LID]]) in
  let version2 = prove
   (`!f:real^N->real^1 s k.
          baire k s f /\ 1 <= k /\
          (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s
          ==> ?g. baire k (:real^N) g /\ !x. x IN s ==> g x = f x`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`vec 0:real^1`; `&1:real`] HOMEOMORPHIC_BALL_UNIV) THEN
    ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
    REWRITE_TAC[REAL_LT_01; homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
    MAP_EVERY X_GEN_TAC [`h:real^1->real^1`; `h':real^1->real^1`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [`(h:real^1->real^1) o (f:real^N->real^1)`;
                   `s:real^N->bool`; `k:num`] version1) THEN
    ASM_SIMP_TAC[BAIRE_CONTINUOUS_COMPOSE_UNIV; o_THM] THEN
    REWRITE_TAC[GSYM IN_BALL_0] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^1` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(h':real^1->real^1) o (g:real^N->real^1)` THEN
    ASM_SIMP_TAC[o_THM] THEN
    W(MP_TAC o PART_MATCH (lhand o rand)
      BAIRE_EQ_FSIGMA_PREIMAGE_OPEN o snd) THEN
    ASM_SIMP_TAC[COUNTABLE_UNION_OF_INC; o_THM; indicator;
                 IN_UNIV; BAIRE_CONST] THEN
    DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `u:real^1->bool` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `{x | (h':real^1->real^1) (g x) IN u} =
      {x | x IN (:real^N) /\ g x IN {y | y IN ball(vec 0,&1) /\ h' y IN u}}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC FSIGMA_BAIRE_PREIMAGE_OPEN THEN
    ASM_SIMP_TAC[COUNTABLE_UNION_OF_INC; o_THM; indicator;
                 IN_UNIV; BAIRE_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN ASM_REWRITE_TAC[OPEN_BALL]) in
  REPEAT GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `k = 0 \/ 1 <= k`) THENL
   [ASM_REWRITE_TAC[COUNTABLE_INTERSECTION_OF_BAIRE0_INDICATOR] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC DISJ_CASES_TAC) THEN
    ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [ALL_TAC; MESON_TAC[]] THEN
    MESON_TAC[BAIRE_CONST];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[BAIRE_COMPONENTWISE] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!i. ?g. 1 <= i /\ i <= dimindex(:N)
            ==> baire k (:real^M) g /\
                !x. x IN s ==> g x = lift((f x:real^N)$i)`
  MP_TAC THENL
   [ASM_SIMP_TAC[RIGHT_EXISTS_IMP_THM; version2];
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `g:num->real^M->real^1` THEN STRIP_TAC THEN EXISTS_TAC
   `(\x. lambda i. drop((g:num->real^M->real^1) i x)):real^M->real^N` THEN
  ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX; CART_EQ]);;

let BAIRE_LAVRENTIEV = prove
 (`!f:real^M->real^N s k.
        baire k s f
        ==> ?u g. (COUNTABLE INTERSECTION_OF
                    baire (k + 1) (:real^M) o indicator) u /\
                  s SUBSET u /\
                  u SUBSET closure s /\
                  baire k u g /\
                  !x. x IN s ==> g x = f x`,
  GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN GEN_TAC THEN
  GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN
  MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[baire] THEN CONJ_TAC THENL
   [CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[GSYM GDELTA_BAIRE] THEN
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`]
        LAVRENTIEV) THEN
    ASM_REWRITE_TAC[SUBSET_UNIV; GDELTA_UNIV];
    ALL_TAC] THEN
  X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `g:real^M->real^N` THEN
  DISCH_THEN(X_CHOOSE_THEN `f:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN `k:num` o SPEC `(f:num->real^M->real^N) k`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:num->real^M->bool`; `h:num->real^M->real^N`] THEN
  STRIP_TAC THEN
  ABBREV_TAC
   `v = {x | x IN INTERS {u n | n IN (:num)} /\
             ?l. ((\n. (h:num->real^M->real^N) n x) --> l) sequentially}` THEN
  EXISTS_TAC `v:real^M->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  CONJ_TAC THENL
   [SUBGOAL_THEN
     `v = INTERS
           {UNIONS {INTERS {
                  INTERS {{x:real^M | x IN INTERS {u n | n IN (:num)} /\
                                 h m x - h n x IN cball(vec 0:real^N,e)} |m|
                                     N <= m} |n|
                             N <= n} |
                    N IN (:num)} |
            e IN {q | q IN rational /\ &0 < q}}`
    SUBST1_TAC THENL
     [EXPAND_TAC "v" THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN
      REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
      REWRITE_TAC[IN_BALL_0; NORM_ARITH `norm(x - y:real^N) = dist(x,y)`] THEN
      REWRITE_TAC[EXTENSION; IN_ELIM_THM; GE] THEN X_GEN_TAC `x:real^M` THEN
      REWRITE_TAC[IN_CBALL_0; dist] THEN
      ASM_CASES_TAC `!n. x IN (u:num->real^M->bool) n` THEN
      ASM_REWRITE_TAC[IN] THENL
       [ALL_TAC; MESON_TAC[RATIONAL_CLOSED; REAL_LT_01; LE_REFL]] THEN
      EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`&0`; `e:real`] RATIONAL_BETWEEN) THEN
      ASM_MESON_TAC[REAL_LET_TRANS; REAL_LT_IMP_LE];
      MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
      SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_RATIONAL;
               COUNTABLE_RESTRICT; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `q:real` THEN DISCH_THEN(K ALL_TAC) THEN
      ASM_CASES_TAC `n = 0` THENL
       [FIRST_X_ASSUM(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN
        RULE_ASSUM_TAC(REWRITE_RULE[baire; ARITH]) THEN
         SUBGOAL_THEN
         `?v:real->num->num->real^M->bool.
             !q m p. closed(v q m p) /\
                     {x | x IN INTERS (IMAGE u (:num)) /\
                          h m x - h p x IN cball (vec 0:real^N,q)} =
                     INTERS (IMAGE u (:num)) INTER v q m p`
        MP_TAC THENL
         [REWRITE_TAC[GSYM SKOLEM_THM; GSYM CLOSED_IN_CLOSED] THEN
          MAP_EVERY X_GEN_TAC [`q:real`; `m:num`; `p:num`] THEN
          MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
          REWRITE_TAC[CLOSED_CBALL] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
          REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN
          MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL
            [EXISTS_TAC `(u:num->real^M->bool) m`;
             EXISTS_TAC `(u:num->real^M->bool) p`] THEN
          ASM_REWRITE_TAC[] THEN SET_TAC[];
          ALL_TAC];
        MP_TAC(GENL [`q:real`; `m:num`; `p:num`]
         (ISPECL [`\x. (h:num->real^M->real^N) m x - h p x`;
                     `INTERS (IMAGE u (:num)):real^M->bool`; `n:num`]
          BAIRE_EQ_GDELTA_PREIMAGE_CLOSED_GEN)) THEN
        ASM_SIMP_TAC[LE_1] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
         `(!x y. P x y <=> Q x y) ==> (!x y. P x y) ==> (!x y. Q x y)`)) THEN
        ANTS_TAC THENL
         [MAP_EVERY X_GEN_TAC [`m:num`; `p:num`] THEN
          MATCH_MP_TAC BAIRE_SUB THEN
          REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN
          MATCH_MP_TAC BAIRE_SUBSET THENL
           [EXISTS_TAC `(u:num->real^M->bool) m`;
            EXISTS_TAC `(u:num->real^M->bool) p`] THEN
          ASM_REWRITE_TAC[] THEN SET_TAC[];
          ONCE_REWRITE_TAC[MESON[]
           `(!m p u. P m p u) <=> (!u m p. P m p u)`] THEN
          DISCH_THEN(MP_TAC o GEN `q:real` o
            SPEC `cball(vec 0:real^N,q)`)] THEN
        ASM_REWRITE_TAC[CLOSED_CBALL; SKOLEM_THM]] THEN
     (REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
      X_GEN_TAC `v:real->num->num->real^M->bool` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(MESON[]
       `!y. (COUNTABLE INTERSECTION_OF P) y /\ x = y
            ==> (COUNTABLE INTERSECTION_OF P) x`) THEN
      EXISTS_TAC
       `INTERS (IMAGE u (:num)) INTER
        (UNIONS {INTERS
         {INTERS {(v:real->num->num->real^M->bool) q m n | x <= m}
           | n | x <= n} |  x IN (:num)})` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTER THEN CONJ_TAC THENL
         [MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
          SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN
          X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_UNIV] THEN
          MATCH_MP_TAC INTERSECTION_OF_MONO THEN
          EXISTS_TAC `baire (n + 1) (:real^M) o indicator` THEN
          ASM_REWRITE_TAC[o_THM; ADD_CLAUSES] THEN
          MESON_TAC[BAIRE_MONO; LE; LE_REFL; ARITH_RULE `n + 1 <= SUC n + 1`];
          MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN
          REWRITE_TAC[o_THM] THEN
          MATCH_MP_TAC COUNTABLE_UNION_OF_BAIRE_INDICATOR THEN
          MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
          SIMP_TAC[COUNTABLE_IMAGE; SIMPLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
          REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `N:num` THEN
          REWRITE_TAC[IN_UNIV] THEN
          MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN REWRITE_TAC[o_THM] THEN
          REWRITE_TAC[ADD1]];
        GEN_REWRITE_TAC I [EXTENSION] THEN
        REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; INTERS_IMAGE;
                    UNIONS_IMAGE; IN_UNIV; IN_INTER] THEN
        MESON_TAC[LE_REFL]])
      THENL
       [CONV_TAC NUM_REDUCE_CONV THEN
        MATCH_MP_TAC CLOSED_IMP_BAIRE1_INDICATOR THEN
        MATCH_MP_TAC CLOSED_INTERS THEN
        REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN
        MATCH_MP_TAC CLOSED_INTERS THEN
        ASM_REWRITE_TAC[FORALL_IN_GSPEC];
        MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR THEN
        MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
        SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN
        MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
        SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN
        ASM_REWRITE_TAC[]]];
   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
    [EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; INTERS_GSPEC] THEN
     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN CONJ_TAC THENL
      [ASM SET_TAC[]; EXISTS_TAC `(g:real^M->real^N) x`] THEN
     MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
     EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN
     ASM_SIMP_TAC[EVENTUALLY_TRUE];
     DISCH_TAC] THEN
   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
   SUBGOAL_THEN
    `!x. ?l. x IN v
             ==> ((\n. (h:num->real^M->real^N) n x) --> l) sequentially`
   MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
   REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
   X_GEN_TAC `k:real^M->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL
    [EXISTS_TAC `h:num->real^M->real^N` THEN ASM_SIMP_TAC[] THEN
     X_GEN_TAC `k:num` THEN MATCH_MP_TAC BAIRE_SUBSET THEN
     EXISTS_TAC `(u:num->real^M->bool) k` THEN ASM SET_TAC[];
     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
     MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
     EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN
     ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
     MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
     EXISTS_TAC `\n. (h:num->real^M->real^N) n x` THEN
     REWRITE_TAC[] THEN CONJ_TAC THENL
      [ASM_SIMP_TAC[EVENTUALLY_TRUE]; FIRST_X_ASSUM MATCH_MP_TAC] THEN
     ASM SET_TAC[]]]);;

let BAIRE_CASES = prove
 (`!f:real^M->real^N g s t k.
        baire k s f /\ baire k (t DIFF s) g /\ baire k (:real^M) (indicator s)
        ==>  baire k t (\x. if x IN s then f x else g x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN ASM_CASES_TAC `k = 0` THENL
   [ASM_REWRITE_TAC[BAIRE0_INDICATOR] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (DISJ_CASES_THEN SUBST1_TAC)) THEN
    ASM_SIMP_TAC[NOT_IN_EMPTY; DIFF_EMPTY; ETA_AX; IN_UNIV] THEN
    MESON_TAC[BAIRE_SUBSET; SUBSET_UNIV];
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)] THEN
  ASM_SIMP_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN; LE_1; AND_FORALL_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN
  ASM_CASES_TAC `open(u:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC `s INTER v UNION (((:real^M) DIFF s) INTER w)` THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  REPEAT((MATCH_MP_TAC COUNTABLE_UNION_OF_UNION ORELSE
          MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
                COUNTABLE_UNION_OF_INTER)) THEN REPEAT CONJ_TAC) THEN
  ASM_SIMP_TAC[COUNTABLE_UNION_OF_INC; o_THM; BAIRE_INDICATOR_COMPLEMENT] THEN
  REWRITE_TAC[BAIRE_INDICATOR_INTER]);;

let BAIRE_RESTRICT = prove
 (`!f:real^M->real^N s k.
        baire k s f /\ baire k (:real^M) (indicator s)
        ==> baire k (:real^M) (\x. if x IN s then f x else vec 0)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_CASES THEN
  ASM_REWRITE_TAC[BAIRE_CONST]);;

let BAIRE_FSIGMA_PREIMAGE_GEN = prove
 (`!f:real^M->real^N s u m n.
        baire m s f /\ (COUNTABLE UNION_OF baire n (:real^N) o indicator) u
        ==> ?c. (COUNTABLE UNION_OF baire (m + n) (:real^M) o indicator) c /\
                {x | x IN s /\ f x IN u} = s INTER c`,
  GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN
  CONJ_TAC THENL
   [REWRITE_TAC[COUNTABLE_UNION_OF_BAIRE0_INDICATOR] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
     [EXISTS_TAC `{}:real^M->bool`; EXISTS_TAC `(:real^M)`] THEN
    (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
    REWRITE_TAC[o_THM; BAIRE_INDICATOR_EMPTY; BAIRE_INDICATOR_UNIV];
    X_GEN_TAC `n:num` THEN DISCH_TAC] THEN
  X_GEN_TAC `u:real^N->bool` THEN ASM_CASES_TAC `n = 0` THENL
   [ASM_REWRITE_TAC[ADD_CLAUSES; ARITH; GSYM FSIGMA_BAIRE] THEN
    REWRITE_TAC[FSIGMA_ASCENDING; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `c:num->real^N->bool` THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_CASES_TAC `m = 0` THENL
     [UNDISCH_TAC `baire m s (f:real^M->real^N)` THEN
      ASM_REWRITE_TAC[ARITH; GSYM FSIGMA_BAIRE; baire] THEN DISCH_TAC THEN
      SUBGOAL_THEN
       `!n. ?t. closed t /\
                {x | x IN s /\ (f:real^M->real^N) x IN c(n:num)} = s INTER t`
      MP_TAC THENL
       [GEN_TAC THEN REWRITE_TAC[GSYM CLOSED_IN_CLOSED] THEN
        MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
        ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
        REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `c:num->real^M->bool` THEN STRIP_TAC THEN
        EXISTS_TAC `UNIONS {c n | n IN (:num)}:real^M->bool` THEN
        ASM_SIMP_TAC[SIMPLE_IMAGE; FSIGMA_UNIONS; COUNTABLE_IMAGE;
          COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE; CLOSED_IMP_FSIGMA] THEN
        ASM SET_TAC[]];
      MP_TAC(GEN `n:num` (ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
                     `(c:num->real^N->bool) n`; `m:num`]
        GDELTA_BAIRE_PREIMAGE_CLOSED_GEN)) THEN
      ASM_SIMP_TAC[LE_1; COMPACT_IMP_CLOSED; SKOLEM_THM; FORALL_AND_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:num->real^M->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `UNIONS {c n | n IN (:num)}:real^M->bool` THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
      SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
      REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `k:num` THEN
      MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN REWRITE_TAC[o_THM; ADD1] THEN
      MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR THEN
      ASM_REWRITE_TAC[]];
    MATCH_MP_TAC(TAUT `!q. (p ==> q) /\ (q ==> r) ==> p ==> r`) THEN EXISTS_TAC
     `(COUNTABLE UNION_OF
       COUNTABLE INTERSECTION_OF baire n (:real^N) o indicator) u` THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV)
       [GSYM COUNTABLE_UNION_OF_IDEMPOT] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN
      ASM_SIMP_TAC[GSYM BAIRE_INDICATOR_SUC; ADD1; LE_1; o_THM];
      ALL_TAC] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_EXPLICIT o
      lhand o snd) THEN
    ANTS_TAC THENL
     [SIMP_TAC[indicator; o_THM; NOT_IN_EMPTY; BAIRE_CONST;
               COUNTABLE_INTERSECTION_OF_INC];
      DISCH_THEN SUBST1_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool`
     (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN
    FIRST_X_ASSUM(MP_TAC o GEN `k:num` o SPEC `(:real^N) DIFF d(k:num)`) THEN
    GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV)
     [GSYM EXISTS_DIFF] THEN
    REWRITE_TAC[SET_RULE
     `{x | x IN s /\ f x IN (:real^N) DIFF u} = s INTER (UNIV DIFF t) <=>
      {x | x IN s /\ f x IN u} = s INTER t`] THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
     [COUNTABLE_UNION_OF_COMPLEMENT] THEN
    REWRITE_TAC[COMPL_COMPL] THEN
    ASM_REWRITE_TAC[ETA_AX; closed; MESON[BAIRE_INDICATOR_COMPLEMENT; o_THM]
     `(baire k (:real^N) o indicator) ((:real^N) DIFF s) =
      (baire k (:real^N) o indicator) s`] THEN
    REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `c:num->real^M->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `UNIONS {c n | n IN (:num)}:real^M->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
    SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `k:num` THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
    REWRITE_TAC[o_THM; ADD_CLAUSES] THEN REWRITE_TAC[ADD1] THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR THEN
    ASM_REWRITE_TAC[]]);;

let BAIRE_COMPOSE = prove
 (`!m n f:real^M->real^N g:real^N->real^P s.
        baire m s f /\ baire n (IMAGE f s) g
        ==> baire (m + n) s (g o f)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `m + n = 0` THENL
   [ASM_REWRITE_TAC[baire] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    ASM_MESON_TAC[baire; ADD_EQ_0];
    ASM_SIMP_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN; LE_1]] THEN
  X_GEN_TAC `u:real^P->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x:real^M | x IN s /\ ((g:real^N->real^P) o f) x IN u} =
    {x | x IN s /\ f x IN {y | y IN IMAGE f s /\ g y IN u}}`
  SUBST1_TAC THENL
   [REWRITE_TAC[o_THM] THEN SET_TAC[]; ALL_TAC] THEN
  UNDISCH_TAC `baire n (IMAGE (f:real^M->real^N) s) (g:real^N->real^P)` THEN
  ASM_CASES_TAC `n = 0` THENL
   [ASM_REWRITE_TAC[baire; CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
    DISCH_THEN(MP_TAC o SPEC `u:real^P->bool`) THEN
    ASM_REWRITE_TAC[OPEN_IN_OPEN];
    DISCH_TAC THEN MP_TAC(ISPECL
     [`g:real^N->real^P`; `IMAGE (f:real^M->real^N) s`; `u:real^P->bool`;
      `n:num`] FSIGMA_BAIRE_PREIMAGE_OPEN_GEN) THEN
    ASM_SIMP_TAC[LE_1]] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ f x IN IMAGE f s INTER v} = {x | x IN s /\ f x IN v}`] THEN
  REWRITE_TAC[ADD_CLAUSES] THENL
   [MATCH_MP_TAC FSIGMA_BAIRE_PREIMAGE_OPEN_GEN THEN ASM_REWRITE_TAC[] THEN
    ASM_ARITH_TAC;
    MATCH_MP_TAC BAIRE_FSIGMA_PREIMAGE_GEN THEN ASM_REWRITE_TAC[]]);;

let BAIRE_CONTINUOUS_COMPOSE = prove
 (`!f:real^M->real^N g:real^N->real^P s k.
        baire k s f /\ g continuous_on IMAGE f s ==> baire k s (g o f)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM(CONJUNCT1 baire)] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BAIRE_COMPOSE) THEN REWRITE_TAC[ADD_CLAUSES]);;

let HOMEOMORPHIC_BAIRE_INDICATOR = prove
 (`!s t k. s homeomorphic t /\ 1 <= k
        ==> (baire k (:real^M) (indicator s) <=>
             baire k (:real^N) (indicator t))`,
  let lemma = prove
   (`!s t k. s homeomorphic t /\ 2 <= k
             ==> baire k (:real^M) (indicator s)
                 ==> baire k (:real^N) (indicator t)`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
    MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `g':real^N->real^M`] THEN
    STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
    SUBGOAL_THEN `t = {x | x IN v /\ (g':real^N->real^M) x IN s}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN
     `indicator {x | x IN v /\ (g':real^N->real^M) x IN s} =
      \x. if x IN v then indicator {x | x IN v /\ g' x IN s} x else vec 0`
    SUBST1_TAC THENL
     [REWRITE_TAC[indicator; IN_ELIM_THM; FUN_EQ_THM] THEN MESON_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC BAIRE_RESTRICT THEN CONJ_TAC THENL
     [REWRITE_TAC[ETA_AX] THEN
      MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE THEN
      ASM_MESON_TAC[SUBSET_UNIV];
      MATCH_MP_TAC BAIRE_MONO THEN EXISTS_TAC `1 + 1` THEN
      CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN
      MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR THEN
      ASM_REWRITE_TAC[GSYM GDELTA_BAIRE]]) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 1` THENL
   [ASM_REWRITE_TAC[BAIRE1_INDICATOR; LE_REFL] THEN
    MESON_TAC[HOMEOMORPHIC_FSIGMANESS; HOMEOMORPHIC_GDELTANESS];
    STRIP_TAC THEN
    SUBGOAL_THEN `2 <= k` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    EQ_TAC THEN MATCH_MP_TAC lemma THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]]);;

let HOMEOMORPHIC_COUNTABLE_UNION_OF_BAIRE_INDICATOR = prove
 (`!s t k. s homeomorphic t /\ 1 <= k
        ==> ((COUNTABLE UNION_OF baire k (:real^M) o indicator) s <=>
             (COUNTABLE UNION_OF baire k (:real^N) o indicator) t)`,
  let lemma = prove
   (`!s t k. s homeomorphic t /\ 1 <= k
             ==> (COUNTABLE UNION_OF baire k (:real^M) o indicator) s
                 ==> (COUNTABLE UNION_OF baire k (:real^N) o indicator) t`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    DISCH_TAC THEN
    X_GEN_TAC `ss:(real^M->bool)->bool` THEN STRIP_TAC THEN
    SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) (UNIONS ss)` SUBST1_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
      REWRITE_TAC[IMAGE_UNIONS]] THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
    ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
    X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
    ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC EQ_IMP THEN
    MATCH_MP_TAC HOMEOMORPHIC_BAIRE_INDICATOR THEN
    ASM_REWRITE_TAC[homeomorphic] THEN
    MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHISM_OF_SUBSETS)) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN MATCH_MP_TAC lemma THEN
  ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let HOMEOMORPHIC_COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR = prove
 (`!s t k. s homeomorphic t /\ 1 <= k
        ==> ((COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s <=>
             (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t)`,
  let lemma = prove
   (`!s t k. s homeomorphic t /\ 2 <= k
             ==> (COUNTABLE INTERSECTION_OF baire k (:real^M) o indicator) s
                 ==> (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator)
                     t`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP LAVRENTIEV_HOMEOMORPHISM) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
    MAP_EVERY X_GEN_TAC [`f':real^M->real^N`; `g':real^N->real^M`] THEN
    STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
    SUBGOAL_THEN `t = {x | x IN v /\ (g':real^N->real^M) x IN s}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN

    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [INTERSECTION_OF]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THEN
    X_GEN_TAC `ss:(real^M->bool)->bool` THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN
     `{x | x IN v /\ (g':real^N->real^M) x IN INTERS ss} =
      v INTER INTERS {{x | x IN v /\ (g':real^N->real^M) x IN w} | w IN ss}`
    SUBST1_TAC THENL
     [REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTER THEN CONJ_TAC THENL
     [UNDISCH_TAC `gdelta(v:real^N->bool)` THEN
      REWRITE_TAC[GDELTA_BAIRE] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO) THEN
      GEN_TAC THEN REWRITE_TAC[o_THM] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BAIRE_MONO) THEN ASM_ARITH_TAC;
      ALL_TAC] THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTERS THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
    X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INC THEN REWRITE_TAC[o_THM] THEN
    SUBGOAL_THEN
     `indicator {x | x IN v /\ (g':real^N->real^M) x IN c} =
      \x. if x IN v then indicator {x | x IN v /\ g' x IN c} x else vec 0`
    SUBST1_TAC THENL
     [REWRITE_TAC[indicator; IN_ELIM_THM; FUN_EQ_THM] THEN MESON_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC BAIRE_RESTRICT THEN CONJ_TAC THENL
     [REWRITE_TAC[ETA_AX] THEN
      MATCH_MP_TAC BAIRE_INDICATOR_CONTINUOUS_PREIMAGE THEN
      ASM_MESON_TAC[SUBSET_UNIV];
      MATCH_MP_TAC BAIRE_MONO THEN EXISTS_TAC `1 + 1` THEN
      CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN
      MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR THEN
      ASM_REWRITE_TAC[GSYM GDELTA_BAIRE]]) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 1` THEN
  ASM_REWRITE_TAC[GSYM GDELTA_BAIRE; HOMEOMORPHIC_GDELTANESS; LE_REFL] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `2 <= k` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
  EQ_TAC THEN MATCH_MP_TAC lemma THEN ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let FSIGMA_DISJOINT_GEN = prove
 (`!k s. (COUNTABLE UNION_OF baire k (:real^N) o indicator) s <=>
         ((COUNTABLE INTER pairwise DISJOINT) UNION_OF
          baire k (:real^N) o indicator) s`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[SET_RULE `s INTER t = \x. s x /\ t x`] THEN EQ_TAC THENL
   [ALL_TAC; REWRITE_TAC[UNION_OF] THEN MESON_TAC[]] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_EXPLICIT o
    lhand o snd) THEN
  SIMP_TAC[o_THM; COUNTABLE_INTERSECTION_OF_INC; BAIRE_INDICATOR_EMPTY] THEN
  DISCH_THEN SUBST1_TAC THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real^N->bool`
   (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN
  ABBREV_TAC `d:num->real^N->bool = \n. c n DIFF UNIONS {c m | m < n}` THEN
  SUBGOAL_THEN
   `UNIONS {c n | n IN (:num)}:real^N->bool = UNIONS {d n | n IN (:num)}`
  SUBST1_TAC THENL
   [EXPAND_TAC "d" THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION] THEN
    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN
    GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[];
    REWRITE_TAC[UNION_OF]] THEN
  EXISTS_TAC `{d n:real^N->bool | n IN (:num)}` THEN
  SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
  REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL
   [REWRITE_TAC[pairwise] THEN MATCH_MP_TAC WLOG_LT THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    EXPAND_TAC "d" THEN REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[];
    X_GEN_TAC `n:num` THEN EXPAND_TAC "d" THEN REWRITE_TAC[o_THM] THEN
    MATCH_MP_TAC BAIRE_INDICATOR_DIFF THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC BAIRE_INDICATOR_UNIONS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]]);;

let FSIGMA_GDELTA_GEN = prove
 (`!k s. 1 <= k
         ==> ((COUNTABLE UNION_OF baire (k + 1) (:real^N) o indicator) s <=>
              (COUNTABLE UNION_OF
               COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
     [GSYM COUNTABLE_UNION_OF_IDEMPOT];
    ALL_TAC] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] UNION_OF_MONO) THEN
  REWRITE_TAC[COUNTABLE_INTERSECTION_OF_BAIRE_INDICATOR; o_THM] THEN
  ASM_SIMP_TAC[GSYM BAIRE_INDICATOR_SUC]);;

let GDELTA_FSIGMA_GEN = prove
 (`!k s.
     1 <= k
     ==> ((COUNTABLE INTERSECTION_OF baire (k + 1) (:real^N) o indicator) s <=>
          (COUNTABLE INTERSECTION_OF
           COUNTABLE UNION_OF baire k (:real^N) o indicator) s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
     [GSYM COUNTABLE_INTERSECTION_OF_IDEMPOT];
    ALL_TAC] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTERSECTION_OF_MONO) THEN
  REWRITE_TAC[COUNTABLE_UNION_OF_BAIRE_INDICATOR; o_THM] THEN
  ASM_SIMP_TAC[GSYM BAIRE_INDICATOR_SUC]);;

let FSIGMA_GDELTA_DISJOINT = prove
 (`!k s. 1 <= k
         ==> ((COUNTABLE UNION_OF baire (k + 1) (:real^N) o indicator) s <=>
              ((COUNTABLE INTER pairwise DISJOINT) UNION_OF
               COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) s)`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FSIGMA_GDELTA_GEN] THEN EQ_TAC THENL
   [ALL_TAC;
    REWRITE_TAC[UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN
    REWRITE_TAC[INTER; IN_ELIM_THM] THEN SIMP_TAC[IN]] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) COUNTABLE_UNION_OF_EXPLICIT o
    lhand o snd) THEN
  SIMP_TAC[o_THM; COUNTABLE_INTERSECTION_OF_INC; BAIRE_INDICATOR_EMPTY] THEN
  DISCH_THEN SUBST1_TAC THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real^N->bool`
   (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN
  ABBREV_TAC `d:num->real^N->bool = \n. c n DIFF UNIONS {c m | m < n}` THEN
  SUBGOAL_THEN
   `UNIONS {c n | n IN (:num)}:real^N->bool = UNIONS {d n | n IN (:num)}`
  SUBST1_TAC THENL
   [EXPAND_TAC "d" THEN REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION] THEN
    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN
    GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[];
    ONCE_REWRITE_TAC[GSYM COUNTABLE_DISJOINT_UNION_OF_IDEMPOT]] THEN
  REWRITE_TAC[] THEN ONCE_REWRITE_TAC[UNION_OF] THEN
  REWRITE_TAC[] THEN EXISTS_TAC `{d n :real^N->bool | n IN (:num)}` THEN
  REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN CONJ_TAC THENL
   [REWRITE_TAC[SET_RULE `s INTER t = \x. s x /\ t x`] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; PAIRWISE_IMAGE] THEN
    REWRITE_TAC[pairwise] THEN MATCH_MP_TAC WLOG_LT THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    EXPAND_TAC "d" THEN REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[];
    X_GEN_TAC `n:num`] THEN
  EXPAND_TAC "d" THEN
  MP_TAC(fst(EQ_IMP_RULE(ISPECL
    [`k:num`; `(:real^N) DIFF UNIONS {c m | m:num < n}`]
    FSIGMA_DISJOINT_GEN))) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[COUNTABLE_UNION_OF_COMPLEMENT] THEN
    REWRITE_TAC[COMPL_COMPL] THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_UNIONS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC; ETA_AX;
                    MESON[o_THM; BAIRE_INDICATOR_COMPLEMENT]
     `(baire k (:real^N) o indicator) (UNIV DIFF s) <=>
      (baire k (:real^N) o indicator) s`] THEN
    SIMP_TAC[COUNTABLE_INTERSECTION_OF_INC; BAIRE_INDICATOR_EMPTY; o_THM] THEN
    REWRITE_TAC[BAIRE_INDICATOR_UNION] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT];
    REWRITE_TAC[UNION_OF] THEN
    DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `IMAGE (\t. (c:num->real^N->bool) n INTER t) u` THEN
    ASM_REWRITE_TAC[REWRITE_RULE[SIMPLE_IMAGE] (GSYM INTER_UNIONS)] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; SET_RULE
     `s INTER (UNIV DIFF t) = s DIFF t`] THEN
    ASM_SIMP_TAC[COUNTABLE_INTERSECTION_OF_INTER;
                 COUNTABLE_INTERSECTION_OF_INC] THEN
    UNDISCH_TAC
     `(COUNTABLE INTER pairwise DISJOINT) (u:(real^N->bool)->bool)` THEN
    REWRITE_TAC[SET_RULE `s INTER t = \x. s x /\ t x`] THEN
    SIMP_TAC[COUNTABLE_IMAGE; PAIRWISE_IMAGE] THEN
    REWRITE_TAC[pairwise] THEN SET_TAC[]]);;

let [LOCALLY_BAIRE;LOCALLY_BAIRE_ALT;LOCALLY_BAIRE_EXPLICIT] =
 (CONJUNCTS o prove)
 (`(!f:real^M->real^N s k. locally (\u. baire k u f) s <=> baire k s f) /\
   (!f:real^M->real^N s k.
        baire k s f <=>
        (!x. x IN s ==> ?u v. open_in (subtopology euclidean s) u /\
                              x IN u /\ u SUBSET v /\ baire k v f)) /\
   (!f:real^M->real^N s k.
        baire k s f <=>
        (!x. x IN s ==> ?u. open_in (subtopology euclidean s) u /\
                            x IN u /\ baire k u f))`,
  REWRITE_TAC[AND_FORALL_THM; locally] THEN REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(p ==> q) /\ (q ==> r) /\ (s ==> p) /\ (r ==> s)
    ==> (p <=> s) /\ (s <=> q) /\ (s <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[OPEN_IN_REFL];
    MESON_TAC[BAIRE_SUBSET];
    MESON_TAC[BAIRE_SUBSET; OPEN_IN_IMP_SUBSET; SUBSET_REFL];
    ASM_CASES_TAC `k = 0` THEN
    ASM_REWRITE_TAC[GSYM LOCALLY_CONTINUOUS_ON_EXPLICIT; baire]] THEN
  ASM_SIMP_TAC[BAIRE_EQ_FSIGMA_PREIMAGE_OPEN_GEN; LE_1] 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 `u:real^M->real^M->bool` THEN
  REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
  REWRITE_TAC[FORALL_AND_THM] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN
  REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  STRIP_TAC THEN X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N->bool`) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `t:real^M->real^M->bool` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`IMAGE (u:real^M->real^M->bool) s`; `s:real^M->bool`]
        LINDELOF_OPEN_IN) THEN
  ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
  SUBGOAL_THEN `UNIONS(IMAGE (u:real^M->real^M->bool) s) = s` SUBST1_TAC THENL
   [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET] THEN
    CONJ_TAC THENL [REWRITE_TAC[FORALL_IN_IMAGE]; ASM SET_TAC[]] THEN
    ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
    DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC)] THEN
  FIRST_ASSUM(MP_TAC o
    GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) [OPEN_IN_OPEN]) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `w:real^M->real^M->bool` THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN
  EXISTS_TAC `UNIONS(IMAGE (\x. (t:real^M->real^M->bool) x INTER w x) k)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
    ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
      COUNTABLE_UNION_OF_INTER) THEN
    REWRITE_TAC[o_THM; BAIRE_INDICATOR_INTER] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN REWRITE_TAC[o_THM] THEN
    MATCH_MP_TAC BAIRE_MONO THEN EXISTS_TAC `1` THEN ASM_SIMP_TAC[LE_1] THEN
    MATCH_MP_TAC OPEN_IMP_BAIRE1_INDICATOR THEN ASM SET_TAC[];
    REWRITE_TAC[UNIONS_IMAGE] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE]) THEN ASM SET_TAC[]]);;

let FSIGMA_LOCALLY_GEN = prove
 (`!u s k. 1 <= k /\ (COUNTABLE UNION_OF baire k u o indicator) s
           ==> ?t. (COUNTABLE UNION_OF baire k (:real^N) o indicator) t /\
                   u INTER t = u INTER s`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [UNION_OF] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THEN
  X_GEN_TAC `v:(real^N->bool)->bool` THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  SUBGOAL_THEN
   `!c. c IN v
        ==> ?d. (COUNTABLE UNION_OF baire k (:real^N) o indicator) d /\
                u INTER d = u INTER c`
  MP_TAC THENL
   [REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`indicator(c:real^N->bool)`; `u:real^N->bool`;
                   `(:real^1) DELETE vec 0`; `k:num`]
      FSIGMA_BAIRE_PREIMAGE_OPEN_GEN) THEN
    ASM_SIMP_TAC[LE_1; OPEN_DELETE; OPEN_UNIV] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN
    ASM_REWRITE_TAC[indicator; EXTENSION; IN_ELIM_THM; IN_INTER] THEN
    GEN_TAC THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IN_DELETE; IN_UNIV; VEC_EQ; ARITH_EQ];
    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 `d:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN
    EXISTS_TAC `UNIONS(IMAGE (d:(real^N->bool)->real^N->bool) v)` THEN
    ASM_SIMP_TAC[COUNTABLE_UNION_OF_UNIONS; COUNTABLE_IMAGE;
                 FORALL_IN_IMAGE] THEN
    ASM SET_TAC[]]);;

let FSIGMA_LOCALLY_EQ = prove
 (`!u s k. 1 <= k
           ==> (s SUBSET u /\ (COUNTABLE UNION_OF baire k u o indicator) s <=>
                ?t. (COUNTABLE UNION_OF baire k (:real^N) o indicator) t /\
                    u INTER t = s)`,
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        FSIGMA_LOCALLY_GEN)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[];
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
      COUNTABLE_UNION_OF_INTER) THEN
    ASM_REWRITE_TAC[BAIRE_INDICATOR_INTER; o_THM] THEN
    SIMP_TAC[COUNTABLE_UNION_OF_INC; BAIRE_INDICATOR_REFL; o_THM] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        UNION_OF_MONO)) THEN
    REWRITE_TAC[o_THM] THEN GEN_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BAIRE_SUBSET) THEN
    REWRITE_TAC[SUBSET_UNIV]]);;

let FSIGMA_LOCALLY_TRANS = prove
 (`!s t u:real^N->bool k.
        1 <= k /\ s SUBSET t /\ t SUBSET u /\
        (COUNTABLE UNION_OF baire k t o indicator) s /\
        (COUNTABLE UNION_OF baire k u o indicator) t
        ==> (COUNTABLE UNION_OF baire k u o indicator) s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`; `k:num`]
    FSIGMA_LOCALLY_GEN) THEN
  ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> t INTER s = s`] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
    COUNTABLE_UNION_OF_INTER) THEN
  ASM_REWRITE_TAC[BAIRE_INDICATOR_INTER; o_THM] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    UNION_OF_MONO)) THEN
  REWRITE_TAC[o_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BAIRE_SUBSET) THEN
  REWRITE_TAC[SUBSET_UNIV]);;

let GDELTA_LOCALLY_GEN = prove
 (`!u s k.
        1 <= k /\ (COUNTABLE INTERSECTION_OF baire k u o indicator) s
        ==> ?t. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t /\
                u INTER t = u INTER s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[COUNTABLE_INTERSECTION_OF_COMPLEMENT] THEN
  REWRITE_TAC[ETA_AX; MESON[o_THM; BAIRE_INDICATOR_COMPLEMENT_UNIV]
   `(baire k u o indicator) (UNIV DIFF s) <=> (baire k u o indicator) s`] THEN
  ONCE_REWRITE_TAC[GSYM EXISTS_DIFF] THEN
  DISCH_THEN(MP_TAC o MATCH_MP FSIGMA_LOCALLY_GEN) THEN
  MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[COMPL_COMPL] THEN SET_TAC[]);;

let GDELTA_LOCALLY_EQ = prove
 (`!u s k.
    1 <= k
    ==> (s SUBSET u /\
         (COUNTABLE INTERSECTION_OF baire k u o indicator) s <=>
         ?t. (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) t /\
             u INTER t = s)`,
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        GDELTA_LOCALLY_GEN)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[];
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTER THEN
    SIMP_TAC[COUNTABLE_INTERSECTION_OF_INC; BAIRE_INDICATOR_REFL; o_THM] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        INTERSECTION_OF_MONO)) THEN
    REWRITE_TAC[o_THM] THEN GEN_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BAIRE_SUBSET) THEN
    REWRITE_TAC[SUBSET_UNIV]]);;

let GDELTA_LOCALLY_TRANS = prove
 (`!s t u:real^N->bool k.
        1 <= k /\ s SUBSET t /\ t SUBSET u /\
        (COUNTABLE INTERSECTION_OF baire k t o indicator) s /\
        (COUNTABLE INTERSECTION_OF baire k u o indicator) t
        ==> (COUNTABLE INTERSECTION_OF baire k u o indicator) s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`; `k:num`]
    GDELTA_LOCALLY_GEN) THEN
  ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> t INTER s = s`] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTER THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        INTERSECTION_OF_MONO)) THEN
  REWRITE_TAC[o_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BAIRE_SUBSET) THEN
  REWRITE_TAC[SUBSET_UNIV]);;

let BAIRE_INDICATOR_LOCALLY = prove
 (`!u s k.
        1 <= k /\ baire k u (indicator s) /\
        (COUNTABLE INTERSECTION_OF baire k (:real^N) o indicator) u
        ==> ?t. baire k (:real^N) (indicator t) /\ u INTER t = u INTER s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`u INTER s:real^N->bool`; `u DIFF s:real^N->bool`; `k:num`]
          GDELTA_SEPARATION_GEN) THEN
  ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
  CONJ_TAC THEN MATCH_MP_TAC GDELTA_LOCALLY_TRANS THEN
  EXISTS_TAC `u:real^N->bool` THEN
  ASM_REWRITE_TAC[INTER_SUBSET; SUBSET_UNIV] THEN
  MATCH_MP_TAC COUNTABLE_INTERSECTION_OF_INTER THEN
  ASM_SIMP_TAC[COUNTABLE_INTERSECTION_OF_INC; o_THM;
               BAIRE_INDICATOR_COMPLEMENT_UNIV] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        INTERSECTION_OF_MONO)) THEN
  REWRITE_TAC[o_THM] THEN GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BAIRE_SUBSET) THEN
  REWRITE_TAC[SUBSET_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Basics on Borel measurability. We define it as "Baire function" and later *)
(* prove (BOREL_MEASURABLE_PREIMAGE_BOREL) that it is equivalent to another  *)
(* natural definition when the domain is a Borel set.                        *)
(* ------------------------------------------------------------------------- *)

parse_as_infix ("borel_measurable_on",(12,"right"));;

let borel_measurable_RULES,borel_measurable_INDUCT,borel_measurable_CASES =
 new_inductive_definition
 `(!f:real^M->real^N s. f continuous_on s ==> f borel_measurable_on s) /\
  (!(f:num->real^M->real^N) g s.
        (!n. f n borel_measurable_on s) /\
        (!x. x IN s ==> ((\n. f n x) --> g x) sequentially)
        ==> g borel_measurable_on s)`;;

let CONTINUOUS_IMP_BOREL_MEASURABLE_ON = prove
 (`!f:real^M->real^N s. f continuous_on s ==> f borel_measurable_on s`,
  REWRITE_TAC[borel_measurable_RULES]);;

let BAIRE_IMP_BOREL_MEASURABLE = prove
 (`!f:real^M->real^N s n. baire n s f ==> f borel_measurable_on s`,
  ONCE_REWRITE_TAC[MESON[] `(!f s n. P f s n) <=> (!n f s. P f s n)`] THEN
  INDUCT_TAC THEN
  REWRITE_TAC[baire; CONTINUOUS_IMP_BOREL_MEASURABLE_ON] THEN
  MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
  EXISTS_TAC `g:num->real^M->real^N` THEN ASM_SIMP_TAC[]);;

let BOREL_MEASURABLE_ON_SUBSET = prove
 (`!f:real^M->real^N s t.
        f borel_measurable_on s /\ t SUBSET s ==> f borel_measurable_on t`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC borel_measurable_INDUCT THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC(CONJUNCT1 borel_measurable_RULES) THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
    ASM_MESON_TAC[SUBSET]]);;

let BOREL_MEASURABLE_EQ = prove
 (`!f:real^M->real^N g s.
        (!x. x IN s ==> f x = g x) /\ f borel_measurable_on s
        ==> g borel_measurable_on s`,
  ONCE_REWRITE_TAC[CONJ_SYM] THEN
  GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC borel_measurable_INDUCT THEN
  CONJ_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_ON_EQ; CONTINUOUS_IMP_BOREL_MEASURABLE_ON];
    X_GEN_TAC `f:num->real^M->real^N` THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
    EXISTS_TAC `f:num->real^M->real^N` THEN ASM_MESON_TAC[]]);;

let BOREL_MEASURABLE_PASTECART = prove
 (`!f:real^M->real^N g:real^M->real^P s.
        f borel_measurable_on s /\ g borel_measurable_on s
        ==> (\x. pastecart (f x) (g x)) borel_measurable_on s`,
  GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
  MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL
   [REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
    ONCE_REWRITE_TAC[MESON[] `(!f s g. P f s g) <=> (!g s f. P f s g)`] THEN
    REWRITE_TAC[IMP_CONJ_ALT; RIGHT_FORALL_IMP_THM] THEN
    MATCH_MP_TAC borel_measurable_INDUCT THEN
    ASM_SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON;
                 CONTINUOUS_ON_PASTECART] THEN
    MAP_EVERY X_GEN_TAC
     [`h:num->real^M->real^P`; `g:real^M->real^P`; `s:real^M->bool`] THEN
    STRIP_TAC THEN X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN
    MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC
     `\n:num x:real^M. pastecart (f x:real^N) (h n x:real^P)` THEN
    ASM_SIMP_TAC[LIM_PASTECART; LIM_CONST];
    MAP_EVERY X_GEN_TAC
     [`f:num->real^M->real^N`; `g:real^M->real^N`; `s:real^M->bool`] THEN
    STRIP_TAC THEN X_GEN_TAC `h:real^M->real^P` THEN DISCH_TAC THEN
    MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN EXISTS_TAC
     `\n:num x:real^M. pastecart (f n x:real^N) (h x:real^P)` THEN
    ASM_SIMP_TAC[LIM_PASTECART; LIM_CONST]]);;

let BOREL_MEASURABLE_CONTINUOUS_COMPOSE = prove
 (`!f:real^N->real^P g:real^M->real^N s.
        f continuous_on (:real^N) /\ g borel_measurable_on s
        ==> (f o g) borel_measurable_on s`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
  GEN_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; SUBSET_UNIV; CONTINUOUS_ON_SUBSET;
                  CONTINUOUS_IMP_BOREL_MEASURABLE_ON];
    MAP_EVERY X_GEN_TAC
     [`g:num->real^M->real^N`; `h:real^M->real^N`; `s:real^M->bool`] THEN
    STRIP_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
    EXISTS_TAC `\n. (f:real^N->real^P) o (g:num->real^M->real^N) n` THEN
    ASM_SIMP_TAC[o_THM] THEN RULE_ASSUM_TAC(REWRITE_RULE
     [CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV; o_DEF]) THEN
    ASM_SIMP_TAC[]]);;

let BOREL_MEASURABLE_CMUL = prove
 (`!f:real^M->real^N s c.
        f borel_measurable_on s ==> (\x. c % f x) borel_measurable_on s`,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; o_DEF]
    BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN
  SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);;

let BOREL_MEASURABLE_BILINEAR = prove
 (`!bop:real^N->real^P->real^Q f g s:real^M->bool.
        bilinear bop /\ f borel_measurable_on s /\ g borel_measurable_on s
        ==> (\x. bop (f x) (g x)) borel_measurable_on s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_PASTECART) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_CONTINUOUS_ON) THEN
  REWRITE_TAC[IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN
  REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]);;

let BOREL_MEASURABLE_ADD = prove
 (`!f g:real^M->real^N s.
        f borel_measurable_on s /\ g borel_measurable_on s
        ==> (\x. f x + g x) borel_measurable_on s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_PASTECART) THEN
  SUBGOAL_THEN
   `(\z. (fstcart z:real^N) + sndcart z) continuous_on UNIV`
  MP_TAC THENL
   [SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
             LINEAR_SNDCART];
    REWRITE_TAC[IMP_IMP] THEN
    DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN
    REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]]);;

let BOREL_MEASURABLE_SUB = prove
 (`!f g:real^M->real^N s.
        f borel_measurable_on s /\ g borel_measurable_on s
        ==> (\x. f x - g x) borel_measurable_on s`,
  REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --(&1) % y`] THEN
  SIMP_TAC[BOREL_MEASURABLE_CMUL; BOREL_MEASURABLE_ADD]);;

let BOREL_MEASURABLE_CONST = prove
 (`!s:real^M->bool c:real^N. (\x. c) borel_measurable_on s`,
  SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_CONST]);;

let BOREL_MEASURABLE_VSUM = prove
 (`!f:A->real^M->real^N s t.
        FINITE t /\ (!i. i IN t ==> f i borel_measurable_on s)
        ==> (\x. vsum t (\i. f i x)) borel_measurable_on s`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[VSUM_CLAUSES; BOREL_MEASURABLE_CONST; BOREL_MEASURABLE_ADD;
           FORALL_IN_INSERT; ETA_AX]);;

let BOREL_MEASURABLE_MUL = prove
 (`!f g:real^M->real^N s.
        (\x. lift(f x)) borel_measurable_on s /\ g borel_measurable_on s
        ==> (\x. f x % g x) borel_measurable_on s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[BILINEAR_DROP_MUL]
    (ISPEC `\x y:real^N. drop x % y` BOREL_MEASURABLE_BILINEAR))) THEN
  REWRITE_TAC[LIFT_DROP]);;

let BOREL_MEASURABLE_NORM = prove
 (`!f:real^M->real^N s.
        f borel_measurable_on s
        ==> (\x. lift(norm(f x))) borel_measurable_on s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF; o_ASSOC] THEN
  MATCH_MP_TAC BOREL_MEASURABLE_CONTINUOUS_COMPOSE THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM]);;

let BOREL_MEASURABLE_MAX = prove
 (`!f g:real^N->real s.
        (\x. lift(f x)) borel_measurable_on s /\
        (\x. lift(g x)) borel_measurable_on s
        ==> (\x. lift(max (f x) (g x))) borel_measurable_on s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
   `max x y = inv(&2) * (x + y) + inv(&2) * abs(x - y)`] THEN
  REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
  MATCH_MP_TAC BOREL_MEASURABLE_ADD THEN CONJ_TAC THEN
  MATCH_MP_TAC BOREL_MEASURABLE_CMUL THEN
  ASM_SIMP_TAC[BOREL_MEASURABLE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN
  MATCH_MP_TAC BOREL_MEASURABLE_NORM THEN
  ASM_SIMP_TAC[BOREL_MEASURABLE_SUB; LIFT_SUB]);;

let BOREL_MEASURABLE_MIN = prove
 (`!f g:real^N->real s.
        (\x. lift(f x)) borel_measurable_on s /\
        (\x. lift(g x)) borel_measurable_on s
        ==> (\x. lift(min (f x) (g x))) borel_measurable_on s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
   `min x y = inv(&2) * (x + y) - inv(&2) * abs(x - y)`] THEN
  REWRITE_TAC[LIFT_ADD; LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
  MATCH_MP_TAC BOREL_MEASURABLE_SUB THEN CONJ_TAC THEN
  MATCH_MP_TAC BOREL_MEASURABLE_CMUL THEN
  ASM_SIMP_TAC[BOREL_MEASURABLE_ADD; GSYM DROP_SUB; GSYM NORM_LIFT] THEN
  MATCH_MP_TAC BOREL_MEASURABLE_NORM THEN
  ASM_SIMP_TAC[BOREL_MEASURABLE_SUB; LIFT_SUB]);;

let BOREL_MEASURABLE_PRODUCT = prove
 (`!f:A->real^N->real s t.
        FINITE t /\ (!i. i IN t ==> (\x. lift(f i x)) borel_measurable_on s)
        ==> (\x. lift(product t (\i. f i x))) borel_measurable_on s`,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[PRODUCT_CLAUSES; BOREL_MEASURABLE_CONST; LIFT_CMUL;
           BOREL_MEASURABLE_MUL; FORALL_IN_INSERT; ETA_AX]);;

let BOREL_MEASURABLE_COMPONENTWISE = prove
 (`!f:real^M->real^N s.
        f borel_measurable_on s <=>
        !i. 1 <= i /\ i <= dimindex(:N)
            ==> (\x. lift(f x$i)) borel_measurable_on s`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [UNDISCH_TAC `(f:real^M->real^N) borel_measurable_on s` THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ; o_DEF]
      BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT];
    SUBGOAL_THEN
     `!n. ((\x. lambda i. if i < n then (f:real^M->real^N) x $i else &0)
           :real^M->real^N)
          borel_measurable_on s`
    MP_TAC THENL
     [ALL_TAC;
      DISCH_THEN(MP_TAC o SPEC `SUC(dimindex(:N))`) THEN
      MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
      SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; LT_SUC_LE]] THEN
    INDUCT_TAC THEN
    REWRITE_TAC[CONJUNCT1 LT; BOREL_MEASURABLE_CONST] THEN
    ASM_CASES_TAC `1 <= n /\ n <= dimindex(:N)` THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
       `f borel_measurable_on s ==> f = g ==> g borel_measurable_on s`)) THEN
      ASM_SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN
      REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
      ASM_ARITH_TAC] THEN
    FIRST_ASSUM(MP_TAC o check ((not) o is_conj o concl)) THEN
    REWRITE_TAC[IMP_IMP] THEN
    DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_PASTECART) THEN
    SUBGOAL_THEN
     `((\z. lambda i. if i < n then fstcart z$i
                      else if i = n then sndcart z$1 else &0)
       :real^(N,1)finite_sum->real^N)
      continuous_on UNIV`
    MP_TAC THENL
     [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
      SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
      MAP_EVERY ASM_CASES_TAC [`i:num < n`; `i:num = n`] THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN
      SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
      REWRITE_TAC[IMP_IMP] THEN
      DISCH_THEN(MP_TAC o MATCH_MP BOREL_MEASURABLE_CONTINUOUS_COMPOSE) THEN
      REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN
      MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
      SIMP_TAC[FUN_EQ_THM; LAMBDA_BETA; CART_EQ] THEN
      REWRITE_TAC[LT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]]]);;

let BOREL_BOREL_MEASURABLE_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f borel_measurable_on s /\ borel s /\ borel t
        ==> borel {x | x IN s /\ f x IN t}`,
  GEN_TAC THEN GEN_TAC THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] THEN
  MATCH_MP_TAC BOREL_INDUCT_UNIONS_INTERS THEN CONJ_TAC THENL
   [X_GEN_TAC `u:real^N->bool`;
    REWRITE_TAC[IMP_IMP] THEN CONJ_TAC THEN
    X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THENL
     [SUBGOAL_THEN
       `{x | x IN s /\ (f:real^M->real^N) x IN UNIONS u} =
        UNIONS {{x | x IN s /\ f x IN t} | t IN u}`
      SUBST1_TAC THENL [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC BOREL_UNIONS THEN
      ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE];
      ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN
      ASM_SIMP_TAC[INTERS_0; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
      SUBGOAL_THEN
       `{x | x IN s /\ (f:real^M->real^N) x IN INTERS u} =
        INTERS {{x | x IN s /\ f x IN t} | t IN u}`
      SUBST1_TAC THENL
       [REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC BOREL_INTERS THEN
      ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE]]] THEN
  ONCE_REWRITE_TAC[TAUT
   `p ==> q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t))
   [`u:real^N->bool`; `s:real^M->bool`; `f:real^M->real^N`] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_BOREL THEN
    EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN ASM_REWRITE_TAC[];
    MAP_EVERY X_GEN_TAC
     [`g:num->real^M->real^N`; `f:real^M->real^N`; `s:real^M->bool`] THEN
    STRIP_TAC THEN X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC] THEN
  ASM_CASES_TAC `v = (:real^N)` THEN
  ASM_REWRITE_TAC[SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x IN v} =
    UNIONS
      {INTERS
       {{x | x IN s /\
             lift(setdist({(g:num->real^M->real^N) n x},(:real^N) DIFF v)) IN
             {x | drop x > e}} |n|
        N <= n} |N,e| N IN (:num) /\ e IN {r | rational r /\ &0 < r}}`
  SUBST1_TAC THENL
   [CONV_TAC SYM_CONV THEN
    GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^M` THEN
    REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN
    ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL
     [REWRITE_TAC[real_gt]; MESON_TAC[LE_REFL]] THEN
    TRANS_TAC EQ_TRANS
     `&0 < setdist({(f:real^M->real^N) x},(:real^N) DIFF v)` THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC RAND_CONV [GSYM RATIONAL_BETWEEN_EQ];
      REWRITE_TAC[SETDIST_POS_LT; SETDIST_EQ_0_SING] THEN
      ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]] THEN
    GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
    REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EVENTUALLY_SEQUENTIALLY] THEN
    REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON
     [RATIONAL_CLOSED]
     `(!x. Q x ==> P(x / &2)) /\ (!x. P x ==> Q(x / &2))
      ==> ((?x. rational x /\ P x) <=> (?y. rational y /\ Q y))`) THEN
    CONJ_TAC THEN X_GEN_TAC `q:real` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[tendsto] THEN
    DISCH_THEN(MP_TAC o SPEC `q / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; IMP_IMP] THENL
     [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
      X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
        MATCH_MP (REAL_ARITH
       `q < d2 ==> abs(d1 - d2) <= x ==> x < q / &2 ==> q / &2 < d1`));
      REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
      REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
      DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
      REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH
       `abs(d1 - d2) <= x ==> x < q / &2 /\ q < d1 ==> q / &2 < d2`)] THEN
    REWRITE_TAC[SETDIST_SING_TRIANGLE];
    MATCH_MP_TAC BOREL_UNIONS THEN CONJ_TAC THENL
     [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
      REWRITE_TAC[NUM_COUNTABLE] THEN
      SIMP_TAC[REWRITE_RULE[IN] COUNTABLE_RESTRICT; COUNTABLE_RATIONAL];
      REWRITE_TAC[FORALL_IN_GSPEC]] THEN
    MAP_EVERY X_GEN_TAC [`N:num`; `e:real`] THEN
    GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV; IN_ELIM_THM] THEN
    REWRITE_TAC[] THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_INTERS THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM] THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    REWRITE_TAC[SET_RULE
     `{x | x IN s /\ lift(setdist({g n x},t)) IN u} =
      {x | x IN s /\ g n x IN {y | lift(setdist({y},t)) IN u}}`] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN
    REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST; drop] THEN
    REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT]]);;

let BOREL_MEASURABLE_INDICATOR = prove
 (`!s. indicator s borel_measurable_on (:real^N) <=> borel s`,
  REWRITE_TAC[FORALL_AND_THM; TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN
  CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    SUBGOAL_THEN `s = {x | x IN (:real^N) /\ indicator s x IN {vec 1}}`
    SUBST1_TAC THENL
     [REWRITE_TAC[indicator; EXTENSION; IN_ELIM_THM; IN_SING; IN_UNIV] THEN
      REWRITE_TAC[COND_RAND; COND_RATOR; VEC_EQ] THEN
      CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[];
      MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN
      ASM_REWRITE_TAC[ETA_AX; BOREL_UNIV] THEN
      SIMP_TAC[CLOSED_IMP_BOREL; CLOSED_SING]];
    ALL_TAC] THEN
  MATCH_MP_TAC BOREL_INDUCT_COMPACT_ALT THEN REPEAT CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC BAIRE_IMP_BOREL_MEASURABLE THEN
    EXISTS_TAC `1` THEN REWRITE_TAC[BAIRE1_INDICATOR] THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_GDELTA; CLOSED_IMP_FSIGMA];
    X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
    ASM_SIMP_TAC[INDICATOR_COMPLEMENT; BOREL_MEASURABLE_SUB; ETA_AX;
                 CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_CONST];
    X_GEN_TAC `u:(real^N->bool)->bool` THEN
    REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    MP_TAC(ISPEC `u:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `c:num->real^N->bool` SUBST1_TAC) THEN
    POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
    DISCH_TAC THEN MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
    EXISTS_TAC
     `\n x:real^N. lift(product(0..n) (\m. drop(indicator (c m) x)))` THEN
    REWRITE_TAC[IN_UNIV] THEN CONJ_TAC THENL
     [GEN_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_PRODUCT THEN
      ASM_SIMP_TAC[LIFT_DROP; ETA_AX; FINITE_NUMSEG];
     X_GEN_TAC `x:real^N` THEN
     REWRITE_TAC[indicator; INTERS_IMAGE; IN_UNIV; IN_ELIM_THM] THEN
     ASM_CASES_TAC `!n:num. (x:real^N) IN c n` THEN
     ASM_REWRITE_TAC[DROP_VEC; PRODUCT_ONE; LIM_CONST; LIFT_NUM] THEN
     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
     DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
     MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
     EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
     REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ; PRODUCT_EQ_0_NUMSEG] THEN
     EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[LIFT_DROP; LE_0]]]);;

let BOREL_MEASURABLE_ON_INDICATOR = prove
 (`!s t:real^N->bool.
        borel s
        ==> (indicator t borel_measurable_on s <=> borel(s INTER t))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [SUBGOAL_THEN `s INTER t = {x:real^N | x IN s /\ indicator t x IN {vec 1}}`
    SUBST1_TAC THENL
     [REWRITE_TAC[indicator; EXTENSION; IN_ELIM_THM; IN_INTER; IN_SING] THEN
      REWRITE_TAC[COND_RAND; COND_RATOR; VEC_EQ] THEN
      CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[];
      MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN
      ASM_SIMP_TAC[ETA_AX; CLOSED_IMP_BOREL; CLOSED_SING]];
    MATCH_MP_TAC BOREL_MEASURABLE_EQ THEN
    EXISTS_TAC `indicator(s INTER t:real^N->bool)` THEN CONJ_TAC THENL
     [SIMP_TAC[indicator; IN_INTER];
      MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN
      EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN
      ASM_REWRITE_TAC[BOREL_MEASURABLE_INDICATOR]]]);;

let BOREL_MEASURABLE_PREIMAGE_BOREL = prove
 (`!f:real^M->real^N s.
        borel s /\ f borel_measurable_on s <=>
        !t. borel t ==> borel {x | x IN s /\ f x IN t}`,
  let lemma0 = prove
   (`!f:real^M->real^1 n m.
          integer m /\
          m / &2 pow n <= drop(f x) /\
          drop(f x) < (m + &1) / &2 pow n /\
          abs(m) <= &2 pow (2 * n)
          ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
                   (\k. k / &2 pow n %
                        indicator {y:real^M | k / &2 pow n <= drop(f y) /\
                                              drop(f y) < (k + &1) / &2 pow n}
                                  x) =
              lift(m / &2 pow n)`,
    REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC
     `vsum {m} (\k. k / &2 pow n %
                    indicator {y:real^M | k / &2 pow n <= drop(f y) /\
                                          drop(f y) < (k + &1) / &2 pow n}
                              x)` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC VSUM_SUPERSET THEN
      ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN
      X_GEN_TAC `k:real` THEN STRIP_TAC THEN
      REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
      ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(TAUT `F ==> p`) THEN
      UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN
      POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
      SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
      REAL_ARITH_TAC;
      ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in
  let lemma1 = prove
   (`!f:real^M->real^1 s.
          borel s /\
          (!a b. borel {x | x IN s /\ a <= drop(f x) /\ drop(f x) < b})
          ==> f borel_measurable_on s`,
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
    REWRITE_TAC[IN_UNIV] THEN
    EXISTS_TAC
     `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
                 (\k. k / &2 pow n %
                      indicator {y:real^M | k / &2 pow n <= drop(f y) /\
                                            drop(f y) < (k + &1) / &2 pow n}
                                x)` THEN
    REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [X_GEN_TAC `n:num` THEN MATCH_MP_TAC BOREL_MEASURABLE_VSUM THEN
      REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN
      GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CMUL THEN
      ASM_SIMP_TAC[BOREL_MEASURABLE_ON_INDICATOR; ETA_AX;
                   SET_RULE `s INTER {x | P x} = {x | x IN s /\ P x}`];
      X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
      MP_TAC(ISPECL [`&2`; `abs(drop((f:real^M->real^1) x))`]
          REAL_ARCH_POW) THEN
      ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN
      DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
      REWRITE_TAC[REAL_POW_INV] THEN
      ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN
      SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN
      SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN
      EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
      ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^M)))` THEN
      SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^M->real^1) x) < e`
      MP_TAC THENL
       [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN
        MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN
        REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN
        SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ;
                 REAL_OF_NUM_EQ; ARITH] THEN
        MATCH_MP_TAC(REAL_ARITH
         `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN
        EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
        ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
        EXISTS_TAC `e * &2 pow N2` THEN
        ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN
        MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
        MATCH_MP_TAC(NORM_ARITH
         `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN
        MATCH_MP_TAC lemma0 THEN
        SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
        ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
        EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
        SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE;
                 INTEGER_CLOSED] THEN
        MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN
        REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW;
                    REAL_ABS_NUM] THEN
        MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
         `x < e ==> e <= d ==> x <= d`))] THEN
      MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
      ASM_ARITH_TAC]) in
    REPEAT GEN_TAC THEN EQ_TAC THEN
    SIMP_TAC[BOREL_BOREL_MEASURABLE_PREIMAGE] THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `(:real^N)`) THEN
    REWRITE_TAC[BOREL_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
    DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
    GEN_REWRITE_TAC I [BOREL_MEASURABLE_COMPONENTWISE] THEN
    X_GEN_TAC `k:num` THEN STRIP_TAC THEN
    MATCH_MP_TAC lemma1 THEN ASM_REWRITE_TAC[LIFT_DROP] THEN
    REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE
     `{x | x IN s /\ a <= f x$k /\ f x$k < b} =
      {x | x IN s /\ f x IN ({y | a <= y$k} INTER {y | y$k < b})}`] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC BOREL_INTER THEN
    SIMP_TAC[OPEN_IMP_BOREL; OPEN_HALFSPACE_COMPONENT_LT] THEN
    SIMP_TAC[CLOSED_IMP_BOREL; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]);;

let BOREL_MEASURABLE_EXTENSION = prove
 (`!f:real^M->real^N s t.
        f borel_measurable_on s /\ IMAGE f s SUBSET t /\ borel t
        ==> ?g. g borel_measurable_on (:real^M) /\
                (~(t = {}) ==> IMAGE g (:real^M) SUBSET t) /\
                (!x. x IN s ==> g x = f x)`,
  let version1 = prove
   (`!f:real^M->real^N s.
          f borel_measurable_on s
          ==> ?u g.
                   borel u /\
                   s SUBSET u /\
                   u SUBSET closure s /\
                   g borel_measurable_on u /\
                   (!x. x IN s ==> g x = f x)`,
    MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL
     [MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
      STRIP_TAC THEN MP_TAC(ISPECL
       [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`] LAVRENTIEV) THEN
      ASM_REWRITE_TAC[GDELTA_UNIV; SUBSET_UNIV] THEN
      REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
      SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; GDELTA_IMP_BOREL];
      ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC
     [`f:num->real^M->real^N`; `g:real^M->real^N`; `s:real^M->bool`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:num->real^M->bool`; `h:num->real^M->real^N`] THEN
    STRIP_TAC THEN
    ABBREV_TAC
     `v = {x | x IN INTERS {u n | n IN (:num)} /\
               ?l. ((\n. (h:num->real^M->real^N) n x) --> l) sequentially}` THEN
    EXISTS_TAC `v:real^M->bool` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
    CONJ_TAC THENL
     [SUBGOAL_THEN
       `v = INTERS
             {UNIONS {INTERS {
                    INTERS {{x:real^M | x IN INTERS {u n | n IN (:num)} /\
                                   h m x - h n x IN ball(vec 0:real^N,e)} |m|
                                       N <= m} |n|
                               N <= n} |
                      N IN (:num)} |
              e IN {q | q IN rational /\ &0 < q}}`
      SUBST1_TAC THENL
       [EXPAND_TAC "v" THEN REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN
        REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
        REWRITE_TAC[IN_BALL_0; NORM_ARITH `norm(x - y:real^N) = dist(x,y)`] THEN
        REWRITE_TAC[EXTENSION; IN_ELIM_THM; GE] THEN X_GEN_TAC `x:real^M` THEN
        EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
        ASM_CASES_TAC `!n. x IN (u:num->real^M->bool) n` THEN
        ASM_REWRITE_TAC[IN] THENL
         [ALL_TAC; MESON_TAC[RATIONAL_CLOSED; REAL_LT_01; LE_REFL]] THEN
        DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
        MP_TAC(ISPECL [`&0`; `e:real`] RATIONAL_BETWEEN) THEN
        ASM_MESON_TAC[REAL_LT_TRANS];
        MATCH_MP_TAC BOREL_INTERS THEN
        SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_RATIONAL;
                 COUNTABLE_RESTRICT; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `q:real` THEN DISCH_THEN(K ALL_TAC) THEN
        MATCH_MP_TAC BOREL_UNIONS THEN
        SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `N:num` THEN REWRITE_TAC[IN_UNIV] THEN
        MATCH_MP_TAC BOREL_INTERS THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
        SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
        MATCH_MP_TAC BOREL_INTERS THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
        SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
        MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN
        ASM_SIMP_TAC[BOREL_INTERS; FORALL_IN_IMAGE; COUNTABLE_IMAGE;
                     NUM_COUNTABLE; OPEN_IMP_BOREL; OPEN_BALL] THEN
        MATCH_MP_TAC BOREL_MEASURABLE_SUB THEN CONJ_TAC THEN
        MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THENL
         [EXISTS_TAC `(u:num->real^M->bool) n`;
          EXISTS_TAC `(u:num->real^M->bool) m`] THEN
        ASM_REWRITE_TAC[ETA_AX] THEN ASM SET_TAC[]];
      ALL_TAC] THEN
     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
      [EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; INTERS_GSPEC] THEN
       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN CONJ_TAC THENL
        [ASM SET_TAC[]; EXISTS_TAC `(g:real^M->real^N) x`] THEN
       MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
       EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN
       ASM_SIMP_TAC[EVENTUALLY_TRUE];
       DISCH_TAC] THEN
     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
     SUBGOAL_THEN
      `!x. ?l. x IN v
               ==> ((\n. (h:num->real^M->real^N) n x) --> l) sequentially`
     MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
     REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
     X_GEN_TAC `k:real^M->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL
      [MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
       EXISTS_TAC `h:num->real^M->real^N` THEN ASM_SIMP_TAC[] THEN
       X_GEN_TAC `n:num` THEN MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN
       EXISTS_TAC `(u:num->real^M->bool) n` THEN ASM SET_TAC[];
       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
       MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
       EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN
       ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
       MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
       EXISTS_TAC `\n. (h:num->real^M->real^N) n x` THEN
       REWRITE_TAC[] THEN CONJ_TAC THENL
        [ASM_SIMP_TAC[EVENTUALLY_TRUE]; FIRST_X_ASSUM MATCH_MP_TAC] THEN
       ASM SET_TAC[]]) in
  let version2 = prove
   (`!f:real^M->real^N s t.
          f borel_measurable_on s /\ IMAGE f s SUBSET t /\ borel t
          ==> ?u g. borel u /\
                    s SUBSET u /\
                    u SUBSET closure s /\
                    g borel_measurable_on u /\
                    IMAGE g u SUBSET t /\
                    (!x. x IN s ==> g x = f x)`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] version1) THEN
    ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `{x | x IN u /\ (g:real^M->real^N) x IN t}` THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN ASM_REWRITE_TAC[];
      ASM SET_TAC[];
      ASM SET_TAC[];
      MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN
      EXISTS_TAC `u:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT];
      ASM SET_TAC[];
      ASM SET_TAC[]]) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN
    DISCH_THEN(K ALL_TAC) THEN
    EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN
    SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_ON; CONTINUOUS_ON_CONST];
    STRIP_TAC] THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
        version2) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN
  EXISTS_TAC `\x. if x IN u then (g:real^M->real^N) x else c` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  W(MP_TAC o PART_MATCH (rand o lhand)
    BOREL_MEASURABLE_PREIMAGE_BOREL o snd) THEN
  REWRITE_TAC[BOREL_UNIV; IN_UNIV] THEN DISCH_THEN SUBST1_TAC THEN
  X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x | (if x IN u then (g:real^M->real^N) x else c) IN v} =
    {x | x IN u /\ g x IN v} UNION (if c IN v then UNIV DIFF u else {})`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^M` THEN
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM SET_TAC[];
    MATCH_MP_TAC BOREL_UNION THEN
    ASM_SIMP_TAC[BOREL_BOREL_MEASURABLE_PREIMAGE] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[BOREL_EMPTY; BOREL_COMPLEMENT]]);;

let BOREL_MEASURABLE_COMPOSE = prove
 (`!f:real^M->real^N g:real^N->real^P s.
        f borel_measurable_on s /\ g borel_measurable_on IMAGE f s
         ==> g o f borel_measurable_on s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`g:real^N->real^P`; `IMAGE (f:real^M->real^N) s`;
                 `(:real^P)`] BOREL_MEASURABLE_EXTENSION) THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; BOREL_UNIV; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `h:real^N->real^P` THEN STRIP_TAC THEN
  MATCH_MP_TAC BOREL_MEASURABLE_EQ THEN
  EXISTS_TAC `(h:real^N->real^P) o (f:real^M->real^N)` THEN
  REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  UNDISCH_TAC `(f:real^M->real^N) borel_measurable_on s` THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t))
   [`s:real^M->bool`; `f:real^M->real^N`] THEN
  ABBREV_TAC `t = (:real^N)` THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN
  UNDISCH_TAC `(h:real^N->real^P) borel_measurable_on t` THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t))
   [`t:real^N->bool`; `h:real^N->real^P`] THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN
  MATCH_MP_TAC borel_measurable_INDUCT THEN CONJ_TAC THENL
   [ASM_MESON_TAC[BOREL_MEASURABLE_CONTINUOUS_COMPOSE;
                  CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
    MAP_EVERY X_GEN_TAC
      [`g:num->real^N->real^P`; `h:real^N->real^P`; `t:real^N->bool`] THEN
    ASM_CASES_TAC `t = (:real^N)` THEN
    ASM_REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
    STRIP_TAC THEN
    MATCH_MP_TAC(CONJUNCT2 borel_measurable_RULES) THEN
    EXISTS_TAC `\n. (g:num->real^N->real^P) n  o (f:real^M->real^N)` THEN
    ASM_SIMP_TAC[o_THM] THEN ASM SET_TAC[]]);;

let BOREL_MEASURABLE_CASES = prove
 (`!f g:real^M->real^N s t.
        f borel_measurable_on s /\ g borel_measurable_on (t DIFF s) /\ borel s
        ==> (\x. if x IN s then f x else g x) borel_measurable_on t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN
  DISCH_THEN(MP_TAC o SPEC `(:real^N)` o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] BOREL_MEASURABLE_EXTENSION)) THEN
  FIRST_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] BOREL_MEASURABLE_EXTENSION)) THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; BOREL_UNIV; IN_DIFF; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `f':real^M->real^N` THEN STRIP_TAC THEN
  X_GEN_TAC `g':real^M->real^N` THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC BOREL_MEASURABLE_EQ THEN
  EXISTS_TAC
   `(\x. drop(indicator s x) % f' x + (&1 - drop(indicator s x)) % g' x)
    :real^M->real^N` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN REWRITE_TAC[indicator] THEN
    COND_CASES_TAC THEN
    ASM_SIMP_TAC[DROP_VEC; REAL_SUB_REFL; REAL_SUB_RZERO] THEN
    CONV_TAC VECTOR_ARITH;
    MATCH_MP_TAC BOREL_MEASURABLE_ON_SUBSET THEN EXISTS_TAC `(:real^M)` THEN
    REWRITE_TAC[SUBSET_UNIV] THEN
    MATCH_MP_TAC BOREL_MEASURABLE_ADD THEN CONJ_TAC THEN
    MATCH_MP_TAC BOREL_MEASURABLE_MUL THEN
    ASM_SIMP_TAC[LIFT_DROP; ETA_AX; BOREL_MEASURABLE_INDICATOR; LIFT_SUB;
                 BOREL_MEASURABLE_CONST; BOREL_MEASURABLE_SUB]]);;

let BOREL_MEASURABLE_RESTRICT = prove
 (`!f:real^M->real^N s.
        f borel_measurable_on s /\ borel s
        ==> (\x. if x IN s then f x else vec 0) borel_measurable_on (:real^M)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CASES THEN
  ASM_REWRITE_TAC[BOREL_MEASURABLE_CONST]);;

(* ------------------------------------------------------------------------- *)
(* Analytic sets.                                                            *)
(* ------------------------------------------------------------------------- *)

let analytic = new_definition
 `analytic s = suslin compact s`;;

let COMPACT_IMP_ANALYTIC = prove
 (`!s. compact s ==> analytic s`,
   REWRITE_TAC[analytic; REWRITE_RULE[IN; SUBSET] SUSLIN_SUPERSET]);;

let ANALYTIC_EMPTY = prove
 (`analytic({}:real^N->bool)`,
  SIMP_TAC[COMPACT_EMPTY; COMPACT_IMP_ANALYTIC]);;

let ANALYTIC_UNIONS = prove
 (`!u:(real^N->bool)->bool.
        COUNTABLE u /\ (!s. s IN u ==> analytic s) ==> analytic(UNIONS u)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[UNIONS_0; ANALYTIC_EMPTY] THEN
  REWRITE_TAC[analytic] THEN MATCH_MP_TAC SUSLIN_UNIONS THEN
  ASM_REWRITE_TAC[GSYM analytic]);;

let ANALYTIC_UNION = prove
 (`!s t:real^N->bool. analytic s /\ analytic t ==> analytic(s UNION t)`,
  REWRITE_TAC[analytic; SUSLIN_UNION]);;

let LOCALLY_COMPACT_IMP_ANALYTIC = prove
 (`!s:real^N->bool. locally compact s ==> analytic s`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP SIGMA_COMPACT) THEN
  DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
  MATCH_MP_TAC ANALYTIC_UNIONS THEN
  ASM_SIMP_TAC[COMPACT_IMP_ANALYTIC]);;

let OPEN_IMP_ANALYTIC = prove
 (`!s:real^N->bool. open s ==> analytic s`,
  SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; LOCALLY_COMPACT_IMP_ANALYTIC]);;

let CLOSED_IMP_ANALYTIC = prove
 (`!s:real^N->bool. closed s ==> analytic s`,
  SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; LOCALLY_COMPACT_IMP_ANALYTIC]);;

let ANALYTIC_UNIV = prove
 (`analytic(:real^N)`,
  SIMP_TAC[LOCALLY_COMPACT_IMP_ANALYTIC; LOCALLY_COMPACT_UNIV]);;

let ANALYTIC_INTERS = prove
 (`!u:(real^N->bool)->bool.
        COUNTABLE u /\ (!s. s IN u ==> analytic s) ==> analytic(INTERS u)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `u:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[INTERS_0; ANALYTIC_UNIV] THEN
  REWRITE_TAC[analytic] THEN MATCH_MP_TAC SUSLIN_INTERS THEN
  ASM_REWRITE_TAC[GSYM analytic]);;

let ANALYTIC_INTER = prove
 (`!s t:real^N->bool. analytic s /\ analytic t ==> analytic(s INTER t)`,
  REWRITE_TAC[analytic; SUSLIN_INTER]);;

let OPEN_IN_ANALYTIC = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean t) s /\ analytic t ==> analytic s`,
  REPEAT GEN_TAC THEN
  SIMP_TAC[IMP_CONJ; OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM] THEN
  SIMP_TAC[ANALYTIC_INTER; OPEN_IMP_ANALYTIC]);;

let CLOSED_IN_ANALYTIC = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean t) s /\ analytic t ==> analytic s`,
  REPEAT GEN_TAC THEN
  SIMP_TAC[IMP_CONJ; CLOSED_IN_CLOSED; LEFT_IMP_EXISTS_THM] THEN
  SIMP_TAC[ANALYTIC_INTER; CLOSED_IMP_ANALYTIC]);;

let BOREL_IMP_ANALYTIC = prove
 (`!s:real^N->bool. borel s ==> analytic s`,
  MATCH_MP_TAC BOREL_INDUCT_COMPACT_UNIONS_INTERS THEN
  REWRITE_TAC[COMPACT_IMP_ANALYTIC; ANALYTIC_UNIONS; ANALYTIC_INTERS]);;

let GDELTA_IMP_ANALYTIC = prove
 (`!s:real^N->bool. gdelta s ==> analytic s`,
  SIMP_TAC[BOREL_IMP_ANALYTIC; GDELTA_IMP_BOREL]);;

let FSIGMA_IMP_ANALYTIC = prove
 (`!s:real^N->bool. fsigma s ==> analytic s`,
  SIMP_TAC[BOREL_IMP_ANALYTIC; FSIGMA_IMP_BOREL]);;

let ANALYTIC_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        analytic s /\ analytic t ==> analytic(s PCROSS t)`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool.
          analytic s /\ compact t ==> analytic(s PCROSS t)`,
    REPEAT GEN_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    REWRITE_TAC[analytic] THEN
    GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM SUSLIN_SUSLIN] THEN
    ONCE_REWRITE_TAC[suslin] THEN
    REWRITE_TAC[IN; IN_ELIM_THM; GSYM analytic] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num list->real^M->bool`
     (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
    EXISTS_TAC `\l. (f:num list->real^M->bool) l PCROSS (t:real^N->bool)` THEN
    ASM_SIMP_TAC[COMPACT_PCROSS; COMPACT_IMP_ANALYTIC] THEN
    REWRITE_TAC[suslin_operation; PCROSS_UNIONS; PCROSS_INTERS; SET_RULE
     `{f y | y IN {g x | P x}} = {f(g x) | P x}`] THEN
    REWRITE_TAC[SET_RULE `{f x | P x} = {} <=> ~(?x. P x)`] THEN
    REWRITE_TAC[MESON[LE_REFL] `?n. 1 <= n`]) in
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[analytic] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM SUSLIN_SUSLIN] THEN
  ONCE_REWRITE_TAC[suslin] THEN
  REWRITE_TAC[IN; IN_ELIM_THM; GSYM analytic] THEN
  DISCH_THEN(X_CHOOSE_THEN `f:num list->real^N->bool`
   (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
  EXISTS_TAC `\l. (s:real^M->bool) PCROSS (f:num list->real^N->bool) l` THEN
  ASM_SIMP_TAC[lemma] THEN
  REWRITE_TAC[suslin_operation; PCROSS_UNIONS; PCROSS_INTERS; SET_RULE
   `{f y | y IN {g x | P x}} = {f(g x) | P x}`] THEN
  REWRITE_TAC[SET_RULE `{f x | P x} = {} <=> ~(?x. P x)`] THEN
  REWRITE_TAC[MESON[LE_REFL] `?n. 1 <= n`]);;

let ANALYTIC_BOREL_MEASURABLE_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f borel_measurable_on s /\ analytic s /\ analytic t
        ==> analytic {x | x IN s /\ f x IN t}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^N)`]
        BOREL_MEASURABLE_EXTENSION) THEN
  ASM_REWRITE_TAC[SUBSET_UNIV; BOREL_UNIV; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x IN t} =
    s INTER {x | x IN (:real^M) /\ g x IN t}`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC ANALYTIC_INTER THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY UNDISCH_TAC
   [`analytic(t:real^N->bool)`;
    `(g:real^M->real^N) borel_measurable_on (:real^M)`] THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
  REWRITE_TAC[analytic] THEN
  GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV) [GSYM SUSLIN_SUSLIN] THEN
  GEN_REWRITE_TAC (BINOP_CONV o RATOR_CONV) [suslin] THEN
  GEN_REWRITE_TAC BINOP_CONV [GSYM IN] THEN
  SPEC_TAC(`t:real^N->bool`,`t:real^N->bool`) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:num list->real^N->bool` THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN] THEN DISCH_TAC THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [IN] THEN
  REWRITE_TAC[GSYM analytic; IN_ELIM_THM] THEN
  EXISTS_TAC `\l:num list. {x | x IN UNIV /\ (g:real^M->real^N) x IN c l}` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_IMP_ANALYTIC THEN
    MATCH_MP_TAC BOREL_BOREL_MEASURABLE_PREIMAGE THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOREL; BOREL_UNIV];
    GEN_REWRITE_TAC I [EXTENSION] THEN
    REWRITE_TAC[suslin_operation; IN_ELIM_THM] THEN
    REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
    MP_TAC LE_REFL THEN SET_TAC[]]);;

let ANALYTIC_CONTINUOUS_PREIMAGE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ analytic s /\ analytic t
        ==> analytic {x | x IN s /\ f x IN t}`,
  SIMP_TAC[ANALYTIC_BOREL_MEASURABLE_PREIMAGE;
           CONTINUOUS_IMP_BOREL_MEASURABLE_ON]);;

let ANALYTIC_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s.
        analytic s /\ f continuous_on s ==> analytic(IMAGE f s)`,
  let lemma = prove
   (`!f:real^M->real^N s.
          f continuous_on (:real^M) /\ analytic s
          ==> analytic(IMAGE f s)`,
    REPEAT GEN_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[analytic] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) SUSLIN_REGULAR o
      rator o lhand o snd) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[SUBSET; IN] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[];
      DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [th])] THEN
    REWRITE_TAC[suslin; IN_ELIM_THM; IN] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:num list->real^M->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM SUBST1_TAC THEN
    EXISTS_TAC `IMAGE (f:real^M->real^N) o (t:num list->real^M->bool)` THEN
    REWRITE_TAC[suslin_operation; o_DEF] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET;
                    SUBSET_UNIV];
      REWRITE_TAC[IMAGE_UNIONS]] THEN
    REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN AP_TERM_TAC THEN
    MATCH_MP_TAC IMAGE_EQ THEN
    X_GEN_TAC `s:num->num` THEN REWRITE_TAC[o_THM; IN_UNIV] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) CONTINUOUS_IMAGE_NESTED_INTERS_GEN o
          lhand o snd) THEN
    ASM_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN
    CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
      REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SIMP_TAC[GSYM LENGTH_EQ_NIL; LENGTH_LIST_OF_SEQ; LE_1] THEN
      ASM_ARITH_TAC]) in
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `IMAGE (f:real^M->real^N) s =
    IMAGE sndcart {x | x IN s PCROSS (:real^N) /\
                       (f(fstcart x) - sndcart x) IN {vec 0}}`
  SUBST1_TAC THENL
   [REWRITE_TAC[VECTOR_SUB_EQ; IN_SING; EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_ELIM_THM; EXISTS_PASTECART; FORALL_PASTECART] THEN
    REWRITE_TAC[SNDCART_PASTECART; PASTECART_INJ; FSTCART_PASTECART] THEN
    REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN MESON_TAC[];
    MATCH_MP_TAC lemma THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    MATCH_MP_TAC ANALYTIC_CONTINUOUS_PREIMAGE THEN
    ASM_SIMP_TAC[ANALYTIC_PCROSS; ANALYTIC_UNIV] THEN
    SIMP_TAC[CLOSED_SING; CLOSED_IMP_ANALYTIC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
    ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; UNIV_NOT_EMPTY]]);;

let HOMEOMORPHIC_ANALYTICITY = prove
 (`!s:real^M->bool t:real^N->bool.
     s homeomorphic t ==> (analytic s <=> analytic t)`,
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MESON_TAC[ANALYTIC_CONTINUOUS_IMAGE]);;

let ANALYTIC_TRANSLATION = prove
 (`!a:real^N s. analytic (IMAGE (\x. a + x) s) <=> analytic s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANALYTICITY THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;

add_translation_invariants [ANALYTIC_TRANSLATION];;

let ANALYTIC_LINEAR_IMAGE = prove
 (`!f:real^N->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (analytic(IMAGE f s) <=> analytic s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANALYTICITY THEN
  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
  ASM_REWRITE_TAC[]);;

add_linear_invariants [ANALYTIC_LINEAR_IMAGE];;

let ANALYTIC_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        analytic(s PCROSS t) <=> s = {} \/ t = {} \/ analytic s /\ analytic t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; ANALYTIC_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; ANALYTIC_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[ANALYTIC_PCROSS] THEN REPEAT STRIP_TAC THENL
   [MP_TAC(ISPEC `fstcart:real^(M,N)finite_sum->real^M`
        ANALYTIC_CONTINUOUS_IMAGE);
    MP_TAC(ISPEC `sndcart:real^(M,N)finite_sum->real^N`
        ANALYTIC_CONTINUOUS_IMAGE)] THEN
  DISCH_THEN(MP_TAC o SPEC `(s:real^M->bool) PCROSS (t:real^N->bool)`) THEN
  ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN
  DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
  REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;

let ANALYTIC_BOREL_MEASURABLE_IMAGE = prove
 (`!f:real^M->real^N s.
        analytic s /\ f borel_measurable_on s ==> analytic(IMAGE f s)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `IMAGE (f:real^M->real^N) s =
    IMAGE sndcart {x | x IN s PCROSS (:real^N) /\
                       (f(fstcart x) - sndcart x) IN {vec 0}}`
  SUBST1_TAC THENL
   [REWRITE_TAC[VECTOR_SUB_EQ; IN_SING; EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_ELIM_THM; EXISTS_PASTECART; FORALL_PASTECART] THEN
    REWRITE_TAC[SNDCART_PASTECART; PASTECART_INJ; FSTCART_PASTECART] THEN
    REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN MESON_TAC[];
    MATCH_MP_TAC ANALYTIC_CONTINUOUS_IMAGE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    MATCH_MP_TAC ANALYTIC_BOREL_MEASURABLE_PREIMAGE THEN
    ASM_SIMP_TAC[ANALYTIC_PCROSS; ANALYTIC_UNIV] THEN
    SIMP_TAC[CLOSED_SING; CLOSED_IMP_ANALYTIC] THEN
    MATCH_MP_TAC BOREL_MEASURABLE_SUB THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_IMP_BOREL_MEASURABLE_ON;
             LINEAR_SNDCART] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC BOREL_MEASURABLE_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
             CONTINUOUS_IMP_BOREL_MEASURABLE_ON] THEN
    ASM_REWRITE_TAC[IMAGE_FSTCART_PCROSS; UNIV_NOT_EMPTY]]);;

let CARD_EQ_ANALYTIC_SETS = prove
 (`{s:real^N->bool | analytic s} =_c (:real)`,
  REWRITE_TAC[analytic] THEN REWRITE_TAC[ETA_AX; SET_RULE `{x | s x} = s`] THEN
  MATCH_MP_TAC CARD_SUSLIN_EQ THEN
  GEN_REWRITE_TAC LAND_CONV [SET_RULE `s = {x | s x}`] THEN
  REWRITE_TAC[CARD_EQ_COMPACT_SETS]);;

let CARD_EQ_BOREL_SETS = prove
 (`{s:real^N->bool | borel s} =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | analytic s}` THEN
    SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_ANALYTIC_SETS] THEN
    MATCH_MP_TAC CARD_LE_SUBSET THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; BOREL_IMP_ANALYTIC];
    TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | compact s}` THEN
    SIMP_TAC[CARD_EQ_IMP_LE;
             ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_COMPACT_SETS] THEN
    MATCH_MP_TAC CARD_LE_SUBSET THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_BOREL]]);;

let CARD_EQ_BOREL_MEASURABLE_FUNCTIONS = prove
 (`{f:real^M->real^N | f borel_measurable_on UNIV} =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [ALL_TAC;
    TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL
     [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
      REWRITE_TAC[CARD_EQ_EUCLIDEAN];
      ALL_TAC] THEN
    TRANS_TAC CARD_LE_TRANS `{(\x. c):real^M->real^N | c IN UNIV}` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
      REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN
      SIMP_TAC[FUN_EQ_THM];
      MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; FORALL_IN_GSPEC] THEN
      REWRITE_TAC[IN_ELIM_THM; BOREL_MEASURABLE_CONST]]] THEN
  X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC
        UNIV_SECOND_COUNTABLE THEN
  TRANS_TAC CARD_LE_TRANS
   `{s:real^M->bool | borel s} ^_c (B:(real^N->bool)->bool)` THEN
  ASM_SIMP_TAC[CARD_EQ_BOREL_SETS; CARD_EQ_IMP_LE; CARD_EXP_LE_REAL] THEN
  REWRITE_TAC[le_c; exp_c; IN_ELIM_THM] THEN
  EXISTS_TAC `\f:real^M->real^N b.
                if b IN B then {x | x IN UNIV /\ f x IN b} else @y. F` THEN
  ASM_SIMP_TAC[BOREL_BOREL_MEASURABLE_PREIMAGE; OPEN_IMP_BOREL; OPEN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN
  GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN PURE_REWRITE_TAC[DIST_NZ] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN `?b. b IN B /\ f(x:real^M) IN b /\
                    b SUBSET ball(f x:real^N,dist(f x,g x))`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPECL  [`(f:real^M->real^N) x`; `dist((f:real^M->real^N) x,g x)`]
        OPEN_BALL) THEN
    MP_TAC(ISPECL  [`(f:real^M->real^N) x`; `dist((f:real^M->real^N) x,g x)`]
        CENTRE_IN_BALL) THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o C AP_THM `b:real^N->bool`)] THEN
  ASM_REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
  ASM_REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^M->real^N) x` o
        GEN_REWRITE_RULE I [SUBSET]) THEN
  REWRITE_TAC[IN_BALL; REAL_LT_REFL]);;

let CARD_EQ_BAIRE_FUNCTIONS = prove
 (`{f:real^M->real^N | baire k UNIV f} =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS
      `{f:real^M->real^N | f borel_measurable_on UNIV}` THEN
    SIMP_TAC[CARD_EQ_BOREL_MEASURABLE_FUNCTIONS; CARD_EQ_IMP_LE] THEN
    MATCH_MP_TAC CARD_LE_SUBSET THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; BAIRE_IMP_BOREL_MEASURABLE];
    TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL
     [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
      REWRITE_TAC[CARD_EQ_EUCLIDEAN];
      ALL_TAC] THEN
    TRANS_TAC CARD_LE_TRANS `{(\x. c):real^M->real^N | c IN UNIV}` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
      REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN
      SIMP_TAC[FUN_EQ_THM];
      MATCH_MP_TAC CARD_LE_SUBSET THEN SIMP_TAC[SUBSET; FORALL_IN_GSPEC] THEN
      REWRITE_TAC[IN_ELIM_THM; BAIRE_CONST]]]);;

(* ------------------------------------------------------------------------- *)
(* Some Borel variants of the measurability of the Banach indicatrix.        *)
(* ------------------------------------------------------------------------- *)

let FSIGMA_PREIMAGE_CARD_GE = prove
 (`!f:real^M->real^N s n.
        f continuous_on s /\ fsigma s
        ==> fsigma {y | FINITE {x | x IN s /\ f x = y}
                        ==> n <= CARD {x | x IN s /\ f x = y}}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CHOOSE_SUBSET_EQ] THEN
  REWRITE_TAC[SET_RULE
   `t SUBSET {x | x IN s /\ P x} /\ Q t <=>
    t SUBSET s /\ Q t /\ (!x. x IN t ==> P x)`] THEN
  SUBGOAL_THEN
   `{y | ?t. t SUBSET s /\ t HAS_SIZE n /\ (!x. x IN t ==> f x = y)} =
    UNIONS (IMAGE (\b. INTERS (IMAGE (IMAGE (f:real^M->real^N)) b))
     {b | b SUBSET {s INTER ball(a,r) |
                    (!i. 1 <= i /\ i <= dimindex(:M) ==> rational(a$i)) /\
                    rational r} /\
          b HAS_SIZE n /\ pairwise DISJOINT b})`
  SUBST1_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC FSIGMA_UNIONS THEN CONJ_TAC THENL
     [MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[HAS_SIZE] THEN
      REWRITE_TAC[SET_RULE
       `b SUBSET s /\ (FINITE b /\ Q b) /\ R b <=>
        b IN {c | c SUBSET s /\ FINITE c} /\ Q b /\ R b`] THEN
      MATCH_MP_TAC COUNTABLE_RESTRICT THEN
      MATCH_MP_TAC COUNTABLE_FINITE_SUBSETS THEN
      ONCE_REWRITE_TAC[SET_RULE
      `{f x y | P x /\ Q y} =
       {f x y | x IN {z | P z} /\ y IN Q}`] THEN
      MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
      REWRITE_TAC[COUNTABLE_RATIONAL_COORDINATES; COUNTABLE_RATIONAL];
      REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; HAS_SIZE] THEN
      X_GEN_TAC `b:(real^M->bool)->bool` THEN STRIP_TAC THEN
      MATCH_MP_TAC FSIGMA_INTERS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
      REWRITE_TAC[FORALL_IN_IMAGE] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (SET_RULE
         `b SUBSET c ==> (!x. x IN c ==> P x) ==> (!x. x IN b ==> P x)`)) THEN
      REWRITE_TAC[FORALL_IN_GSPEC] THEN
      MAP_EVERY X_GEN_TAC [`a:real^M`; `r:real`] THEN
      DISCH_THEN(K ALL_TAC) THEN
      MATCH_MP_TAC FSIGMA_CONTINUOUS_IMAGE THEN
      ASM_SIMP_TAC[FSIGMA_INTER; OPEN_IMP_FSIGMA; OPEN_BALL] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]]] THEN
  GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN
  REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; INTERS_IMAGE] THEN EQ_TAC THENL
   [ALL_TAC;
    DISCH_THEN(X_CHOOSE_THEN `b:(real^M->bool)->bool` MP_TAC) THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN
    REWRITE_TAC[IN_IMAGE] 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 `p:(real^M->bool)->real^M` THEN DISCH_TAC THEN
    EXISTS_TAC `IMAGE (p:(real^M->bool)->real^M) b` THEN
    ASM_SIMP_TAC[FORALL_IN_IMAGE; SUBSET] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (SET_RULE
         `(!x. x IN b ==> Q x) ==> (!x. x IN b ==> Q x ==> P x)
          ==> (!x. x IN b ==> P x)`)) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (SET_RULE
         `b SUBSET c ==> (!x. x IN c ==> P x) ==> (!x. x IN b ==> P x)`)) THEN
      REWRITE_TAC[FORALL_IN_GSPEC] THEN SET_TAC[];
      MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]]] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPEC `t:real^M->bool` FINITE_EQ_BOUNDED_DISCRETE) THEN
  ASM_CASES_TAC `FINITE(t:real^M->bool)` THENL
   [ASM_REWRITE_TAC[]; ASM_MESON_TAC[HAS_SIZE]] THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC o CONJUNCT2) THEN
  MP_TAC(ISPECL [`&0`; `r / &4`] RATIONAL_BETWEEN) THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `q:real` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!x. x IN t
        ==> ?a. (!i. 1 <= i /\ i <= dimindex(:M) ==> rational(a$i)) /\
                x IN ball(a:real^M,q)`
  MP_TAC THENL
   [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`x:real^M`;
     `{a:real^M | !i. 1 <= i /\ i <= dimindex(:M) ==> rational(a$i)}`]
        CLOSURE_APPROACHABLE) THEN
    REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; IN_UNIV; IN_BALL] THEN
    DISCH_THEN(MP_TAC o SPEC `q:real`) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[DIST_SYM];
    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 `a:real^M->real^M` THEN DISCH_TAC THEN
    EXISTS_TAC `IMAGE (\x. s INTER ball((a:real^M->real^M) x,q)) t` THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
     [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE
     `(!s. P s ==> y IN IMAGE f (g s))
      ==> (!s. P s ==> ~(g s = {}))`)) THEN
    SUBGOAL_THEN
     `pairwise (\x y. DISJOINT (s INTER ball ((a:real^M->real^M) x,q))
                               (s INTER ball(a y,q))) t`
    MP_TAC THENL
     [REWRITE_TAC[pairwise] THEN
      MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
      MATCH_MP_TAC(SET_RULE
       `(!x. ~(x IN t /\ x IN u)) ==> DISJOINT (s INTER t) (s INTER u)`) THEN
      SUBGOAL_THEN `x IN ball(a x,q) /\ y IN ball(a y:real^M,q)` MP_TAC THENL
       [ASM_SIMP_TAC[]; ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
      ASM_REWRITE_TAC[IN_BALL] THEN UNDISCH_TAC `q < r / &4` THEN
      CONV_TAC NORM_ARITH;
      REWRITE_TAC[PAIRWISE_IMAGE] THEN SIMP_TAC[pairwise] THEN DISCH_TAC THEN
      MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
      ASM_MESON_TAC[SET_RULE
       `~(s = {}) /\ ~(t = {}) /\ DISJOINT s t ==> ~(s = t)`]]]);;

let GDELTA_PREIMAGE_CARD_LE = prove
 (`!f:real^M->real^N s n.
        f continuous_on s /\ fsigma s
        ==> gdelta {y | FINITE {x | x IN s /\ f x = y} /\
                        CARD {x | x IN s /\ f x = y} <= n}`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
   `{x | P x /\ Q x} = UNIV DIFF {x | P x ==> ~Q x}`] THEN
  REWRITE_TAC[GDELTA_COMPLEMENT; ARITH_RULE `~(m <= n) <=> SUC n <= m`] THEN
  ASM_SIMP_TAC[FSIGMA_PREIMAGE_CARD_GE]);;

let BOREL_PREIMAGE_HAS_SIZE = prove
 (`!f:real^M->real^N s n.
        f continuous_on s /\ fsigma s
        ==> borel {y | {x | x IN s /\ f x = y} HAS_SIZE n}`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL
   [ASM_REWRITE_TAC[HAS_SIZE_0; SET_RULE
     `{y | {x | x IN s /\ f x = y} = {}} = UNIV DIFF IMAGE f s`] THEN
    REWRITE_TAC[BOREL_COMPLEMENT] THEN MATCH_MP_TAC FSIGMA_IMP_BOREL THEN
    ASM_MESON_TAC[FSIGMA_CONTINUOUS_IMAGE];
    REWRITE_TAC[HAS_SIZE] THEN FIRST_ASSUM(fun th -> REWRITE_TAC
     [MATCH_MP(ARITH_RULE `~(n = 0) ==> (x = n <=> x <= n /\ ~(x <= n - 1))`)
        th])] THEN
  REWRITE_TAC[SET_RULE
   `{x | P x /\ Q x /\ ~R x} = {x | P x /\ Q x} DIFF {x | P x /\ R x}`] THEN
  MATCH_MP_TAC BOREL_DIFF THEN CONJ_TAC THEN
  MATCH_MP_TAC GDELTA_IMP_BOREL THEN MATCH_MP_TAC GDELTA_PREIMAGE_CARD_LE THEN
  ASM_REWRITE_TAC[]);;

let BOREL_PREIMAGE_FINITE = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ fsigma s
        ==> borel {y | FINITE {x | x IN s /\ f x = y}}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{y | FINITE {x | x IN s /\ (f:real^M->real^N) x = y}} =
    UNIONS {{y | {x | x IN s /\ f x = y} HAS_SIZE n} | n IN (:num)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN
    MESON_TAC[HAS_SIZE];
    MATCH_MP_TAC BOREL_UNIONS THEN
    ASM_SIMP_TAC[FORALL_IN_GSPEC; BOREL_PREIMAGE_HAS_SIZE] THEN
    SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]]);;

let BOREL_PREIMAGE_INFINITE = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ fsigma s
        ==> borel {y | INFINITE {x | x IN s /\ f x = y}}`,
  REWRITE_TAC[INFINITE; SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
  REWRITE_TAC[BOREL_COMPLEMENT; BOREL_PREIMAGE_FINITE]);;

(* ------------------------------------------------------------------------- *)
(* Forms of the Baire property of dense sets.                                *)
(* ------------------------------------------------------------------------- *)

let BAIRE = prove
 (`!g s:real^N->bool.
        locally compact s /\ COUNTABLE g /\
        (!t. t IN g
             ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t)
        ==> s SUBSET closure(INTERS g)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`subtopology euclidean (s:real^N->bool)`;
                 `g:(real^N->bool)->bool`]
        BAIRE_CATEGORY) THEN
  ASM_REWRITE_TAC[LOCALLY_COMPACT_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  SIMP_TAC[HAUSDORFF_SPACE_EUCLIDEAN; HAUSDORFF_SPACE_SUBTOPOLOGY] THEN
  REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`] THEN ANTS_TAC THENL
   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SET_RULE `t SUBSET s ==> s INTER t = t`];
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
    MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[INTER_SUBSET]]);;

let BAIRE_ALT = prove
 (`!g s:real^N->bool.
        locally compact s /\ ~(s = {}) /\ COUNTABLE g /\ UNIONS g = s
        ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\ ~(u = {}) /\
                  u SUBSET (closure t)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
  [`IMAGE (\t:real^N->bool. s DIFF closure t) g`; `s:real^N->bool`] BAIRE) THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
  MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `~(s = {}) /\ (t = {} ==> closure t = {}) /\ t = {}
      ==> ~(s SUBSET closure t)`) THEN
    ASM_SIMP_TAC[CLOSURE_EMPTY] THEN
    MATCH_MP_TAC(SET_RULE `i SUBSET s /\ s DIFF i = s ==> i = {}`) THEN
    CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[DIFF_INTERS] THEN
    REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
    REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN
    REWRITE_TAC[SET_RULE `{s INTER closure t | t IN g} =
                          {s INTER t | t IN IMAGE closure g}`] THEN
    SIMP_TAC[GSYM INTER_UNIONS; SET_RULE `s INTER t = s <=> s SUBSET t`] THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN
    MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[CLOSURE_SUBSET];
    REWRITE_TAC[NOT_EXISTS_THM] THEN STRIP_TAC THEN
    X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN
      ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE; OPEN_IN_REFL];
      REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      REWRITE_TAC[CLOSURE_APPROACHABLE] THEN
      X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
       [`t:real^N->bool`; `s INTER ball(x:real^N,e)`]) THEN
      ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; SUBSET; IN_INTER; IN_BALL;
                   IN_DIFF] THEN
      MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN
      ASM_MESON_TAC[DIST_SYM; EXTENSION; IN_INTER; NOT_IN_EMPTY]]]);;

let NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN = prove
 (`!u g:(real^N->bool)->bool.
        locally compact u /\
        COUNTABLE g /\
        (!s. s IN g
             ==> closed_in (subtopology euclidean u) s /\
                 (subtopology euclidean u) interior_of s = {})
        ==> (subtopology euclidean u) interior_of (UNIONS g) = {}`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN
  ASM_REWRITE_TAC[INTERIOR_OF_EMPTY; UNIONS_0] THEN
  MP_TAC(ISPECL [`{u DIFF s:real^N->bool | s IN g}`; `u:real^N->bool`]
        BAIRE) THEN
  ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
    X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
    ASM_REWRITE_TAC[INTERIOR_OF_CLOSURE_OF] THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    MATCH_MP_TAC(SET_RULE
     `c SUBSET d ==> P /\ u DIFF c = {} ==> u SUBSET d`) THEN
    REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
    REWRITE_TAC[SET_RULE `u INTER (u DIFF s) = u DIFF s`] THEN SET_TAC[];
    REWRITE_TAC[INTERIOR_OF_CLOSURE_OF; CLOSURE_OF_SUBTOPOLOGY] THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
    MATCH_MP_TAC(SET_RULE
     `c SUBSET d ==> u SUBSET c ==> u DIFF u INTER d = {}`) THEN
    MATCH_MP_TAC SUBSET_CLOSURE THEN
    REWRITE_TAC[DIFF_UNIONS; SIMPLE_IMAGE; SUBSET_INTER; SUBSET_REFL] THEN
    MATCH_MP_TAC INTERS_SUBSET THEN
    REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]);;

let NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED = prove
 (`!g:(real^N->bool)->bool.
        COUNTABLE g /\ (!s. s IN g ==> closed s /\ interior s = {})
        ==> interior(UNIONS g) = {}`,
  MP_TAC(ISPEC `(:real^N)` NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED_IN) THEN
  REWRITE_TAC[SUBTOPOLOGY_UNIV; EUCLIDEAN_INTERIOR_OF; GSYM CLOSED_IN] THEN
  REWRITE_TAC[LOCALLY_COMPACT_UNIV]);;

let NOWHERE_DENSE_COUNTABLE_UNIONS = prove
 (`!g:(real^N->bool)->bool.
        COUNTABLE g /\ (!s. s IN g ==> interior(closure s) = {})
        ==> interior(UNIONS g) = {}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `IMAGE closure (g:(real^N->bool)->bool)`
        NOWHERE_DENSE_COUNTABLE_UNIONS_CLOSED) THEN
  ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; CLOSED_CLOSURE] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN
  MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC UNIONS_MONO THEN
  REWRITE_TAC[EXISTS_IN_IMAGE] THEN MESON_TAC[CLOSURE_SUBSET]);;

(* ------------------------------------------------------------------------- *)
(* Some cute Baire applications from Silverman's paper in AMM vol. 102       *)
(* "Intervals Contained in Arithmetic Combinations of Sets". These are       *)
(* somewhat like the Steinhaus/Piccard theorems. There are other variants.   *)
(* ------------------------------------------------------------------------- *)

let SILVERMAN_STEINHAUSLIKE = prove
 (`!s t:real^N->bool.
        gdelta s /\ gdelta t /\
        (:real^N) SUBSET closure s /\ (:real^N) SUBSET closure t
        ==> {x + y | x IN s /\ y IN t} = (:real^N)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[gdelta; INTERSECTION_OF] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `c:(real^N->bool)->bool` STRIP_ASSUME_TAC) MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC)
   STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[SET_RULE `{f x y | x IN s /\ y IN t} = UNIV <=>
                        !z. ?x y. x IN s /\ y IN t /\ f x y = z`] THEN
  X_GEN_TAC `r:real^N` THEN ASM_CASES_TAC `d:(real^N->bool)->bool = {}` THENL
   [SUBGOAL_THEN `t = (:real^N)` SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[IN_UNIV] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
    REWRITE_TAC[VECTOR_ARITH `x + y:real^N = r <=> y = r - x`] THEN
    REWRITE_TAC[UNWIND_THM2; MEMBER_NOT_EMPTY] THEN DISCH_TAC THEN
    UNDISCH_TAC `(:real^N) SUBSET closure s` THEN
    ASM_REWRITE_TAC[CLOSURE_EMPTY] THEN SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`c UNION IMAGE (IMAGE (\x:real^N. r - x)) d`; `(:real^N)`]
   BAIRE) THEN
  ASM_SIMP_TAC[LOCALLY_COMPACT_UNIV; COUNTABLE_UNION; COUNTABLE_IMAGE] THEN
  REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN ANTS_TAC THENL
   [REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_IMAGE] THEN
    SUBGOAL_THEN `(\x:real^N. r - x) = (\x. r + x) o (--)` SUBST1_TAC THENL
     [REWRITE_TAC[o_DEF] THEN ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN
    ASM_SIMP_TAC[IMAGE_o; OPEN_NEGATIONS; OPEN_TRANSLATION] THEN CONJ_TAC THEN
    X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THENL
     [TRANS_TAC SUBSET_TRANS `closure(s:real^N->bool)`;
      SUBGOAL_THEN
       `(:real^N) = IMAGE (\x. r + x) (IMAGE (--) (:real^N))`
      SUBST1_TAC THENL
       [REWRITE_TAC[GSYM IMAGE_o] THEN CONV_TAC SYM_CONV THEN
        MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
        REWRITE_TAC[IN_UNIV; o_DEF; EXISTS_REFL;
                    VECTOR_ARITH `r + --x:real^N = y <=> x = r - y`];
        REWRITE_TAC[CLOSURE_NEGATIONS; CLOSURE_TRANSLATION] THEN
        REPLICATE_TAC 2 (MATCH_MP_TAC IMAGE_SUBSET) THEN
        TRANS_TAC SUBSET_TRANS `closure(t:real^N->bool)`]] THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[];
    DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `UNIV SUBSET s ==> ~(s = {})`)) THEN
    REWRITE_TAC[CLOSURE_EQ_EMPTY; INTERS_UNION] THEN
    ASM_SIMP_TAC[GSYM(REWRITE_RULE[INJECTIVE_ON_ALT] IMAGE_INTERS);
                 VECTOR_ARITH `r - x:real^N = r - y <=> x = y`] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN
    MESON_TAC[VECTOR_ARITH `(r - x) + x:real^N = r`]]);;

let DENSE_GDELTA_IMP_LARGE = prove
 (`!s:real^N->bool.
        gdelta s /\ (:real^N) SUBSET closure s
        ==> s =_c (:real)`,
  GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THENL
   [ASM_SIMP_TAC[FINITE_IMP_CLOSED; CLOSURE_CLOSED] THEN
    ASM_MESON_TAC[EUCLIDEAN_SPACE_INFINITE; INFINITE; FINITE_SUBSET];
    ALL_TAC] THEN
  DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THEN
  TRANS_TAC CARD_LE_TRANS `(:real^N)` THENL
   [REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
    REWRITE_TAC[CARD_EQ_EUCLIDEAN];
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
      REWRITE_TAC[CARD_EQ_EUCLIDEAN];
      MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`]
        SILVERMAN_STEINHAUSLIKE) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
      TRANS_TAC CARD_LE_TRANS `IMAGE (\(x:real^N,y). x + y) (s *_c s)` THEN
      CONJ_TAC THENL
       [ASM_SIMP_TAC[mul_c; CARD_LE_REFL; SET_RULE
        `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`];
        TRANS_TAC CARD_LE_TRANS `((s:real^N->bool) *_c s)` THEN
        REWRITE_TAC[CARD_LE_IMAGE] THEN
        MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN
        ASM_REWRITE_TAC[INFINITE]]]]);;

let NOT_GDELTA_DENSE_COUNTABLE = prove
 (`!s. COUNTABLE s /\ closure s = (:real^N) ==> ~(gdelta s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `s:real^N->bool` DENSE_GDELTA_IMP_LARGE) THEN
  ASM_REWRITE_TAC[SUBSET_UNIV] THEN
  ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE]);;

(* ------------------------------------------------------------------------- *)
(* Finding borel subsets where a function is injective (mainly looking       *)
(* ahead to measure theory but maybe of some independent interest).          *)
(* ------------------------------------------------------------------------- *)

let GDELTA_CONTINUOUS_FUNCTION_MINIMA = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ compact s
        ==> gdelta {x | x IN s /\
                        !y. y IN s /\ f x = f y
                            ==> x = y \/
                                ?k. 1 <= k /\ k <= dimindex(:M) /\
                                    (!i. 1 <= i /\ i < k
                                         ==> x$i <= y$i) /\
                                    x$k < y$k}`,
  let lemma = prove
   (`(?n. inv(&n + &1) <= x) <=> &0 < x`,
    TRANS_TAC EQ_TRANS `~(!n. ~(inv(&n + &1) <= x))` THEN CONJ_TAC THENL
     [MESON_TAC[]; ALL_TAC] THEN
    W(MP_TAC o PART_MATCH (rand o rand)
      FORALL_POS_MONO_1_EQ o rand o lhand o snd) THEN
    ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN
    REWRITE_TAC[REAL_NOT_LE; GSYM REAL_LE_TRANS_LT]) in
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `{x | x IN s /\
         !y. y IN s /\ (f:real^M->real^N) x = f y
             ==> x = y \/
                 ?k. 1 <= k /\ k <= dimindex(:M) /\
                     (!i. 1 <= i /\ i < k
                          ==> x$i <= y$i) /\
                     x$k < y$k} =
    s DIFF
    UNIONS {{x | ?t. t IN s /\
                     pastecart t x IN
                     ({z | z IN s PCROSS s /\
                           (f(fstcart z) - f(sndcart z)) IN {vec 0}} INTER
                      UNIONS {{z | z IN s PCROSS s /\
                                   (sndcart z - fstcart z) IN
                                   ({a | a$k >= inv(&n + &1)} INTER
                                    INTERS {{a | a$i >= &0} | i IN 1..k-1})} |
                              k IN 1..dimindex(:M)})} |
            n IN (:num)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_SING; IN_UNIV;
                INTERS_GSPEC] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN
    REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; real_ge; VECTOR_SUB_EQ] THEN
    X_GEN_TAC `x:real^M` THEN
    ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
    REWRITE_TAC[NOT_EXISTS_THM] THEN AP_TERM_TAC THEN
    GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN
    ASM_CASES_TAC `(y:real^M) IN s` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN
    ASM_CASES_TAC `(f:real^M->real^N) x = f y` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
    REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN
    REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; lemma] THEN
    REWRITE_TAC[TAUT `(p /\ q) /\ r /\ s <=> p /\ q /\ s /\ r`] THEN
    REWRITE_TAC[VECTOR_SUB_COMPONENT; REAL_SUB_LE; REAL_SUB_LT] THEN
    REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= k - 1 <=> 1 <= i /\ i < k`] THEN
    MATCH_MP_TAC(TAUT
     `(p ==> ~r) /\ (~p ==> q \/ r) /\ ~(q /\ r)
      ==> (p \/ q <=> ~r)`) THEN
    SIMP_TAC[REAL_LT_REFL] THEN CONJ_TAC THENL
     [REWRITE_TAC[OR_EXISTS_THM; CART_EQ; NOT_FORALL_THM; IN_NUMSEG] THEN
      GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
      REWRITE_TAC[NOT_IMP] THEN
      DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
      ASM_SIMP_TAC[IMP_IMP; REAL_LE_REFL; ARITH_RULE
       `k <= N ==> (m < k /\ (1 <= m /\ m <= N) <=> 1 <= m /\ m < k)`] THEN
      DISCH_THEN(K ALL_TAC) THEN ASM_REAL_ARITH_TAC;
      REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
      REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
      REWRITE_TAC[NOT_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
      ASM_CASES_TAC `m:num = n` THEN
      ASM_REWRITE_TAC[] THENL [REAL_ARITH_TAC; ALL_TAC] THEN
      FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
       `~(m:num = n) ==> m < n \/ n < m`)) THEN
      STRIP_TAC THENL
       [UNDISCH_TAC `(x:real^M)$m < (y:real^M)$m`;
        UNDISCH_TAC `(y:real^M)$n < (x:real^M)$n`] THEN
      REWRITE_TAC[REAL_NOT_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_ARITH_TAC];
    ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
    MATCH_MP_TAC GDELTA_INTER THEN
    ASM_SIMP_TAC[CLOSED_IMP_GDELTA; COMPACT_IMP_CLOSED] THEN
    REWRITE_TAC[GDELTA_COMPLEMENT] THEN
    MATCH_MP_TAC FSIGMA_UNIONS THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `k:num` THEN
    MATCH_MP_TAC CLOSED_IMP_FSIGMA THEN
    MATCH_MP_TAC CLOSED_COMPACT_PROJECTION THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC CLOSED_UNIONS THEN
      SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
    ASM_SIMP_TAC[CLOSED_PCROSS; COMPACT_IMP_CLOSED] THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
             CONTINUOUS_ON_SUB; CLOSED_SING]
    THENL
     [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
      CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[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[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN
      SET_TAC[];
      MATCH_MP_TAC CLOSED_INTER THEN
      REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN
      MATCH_MP_TAC CLOSED_INTERS THEN
      REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
      REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE]]]);;

let GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ compact s
        ==> ?t. gdelta t /\ t SUBSET s /\
                IMAGE f t = IMAGE f s /\
                !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
      GDELTA_CONTINUOUS_FUNCTION_MINIMA) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
   `P s ==> gdelta s ==> ?t. gdelta t /\ P t`) THEN
  MATCH_MP_TAC(SET_RULE
   `t SUBSET s /\ (!z. z IN s ==> ?a. {x | x IN t /\ f x = f z} = {a})
    ==> t SUBSET s /\ IMAGE f t = IMAGE f s /\
        !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`) THEN
  REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  SUBGOAL_THEN
   `!n. n <= dimindex(:M)
        ==> ?x. x IN s /\
                (!y. y IN s /\ f x = f y
                     ==> (!i. 1 <= i /\ i <= n ==> x$i = y$i) \/
                         (?k. 1 <= k /\
                              k <= n /\
                              (!i. 1 <= i /\ i < k ==> x$i <= y$i) /\
                              x$k < y$k)) /\
                (f:real^M->real^N) x = f z`
  (MP_TAC o SPEC `dimindex(:M)`) THENL
   [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `1 <= k /\ k <= 0 <=> F`] THEN
      ASM_MESON_TAC[];
      ALL_TAC] THEN
    X_GEN_TAC `m:num` THEN
    DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
    FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE
     `SUC n <= m ==> n <= m /\ n < m`)) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
    MP_TAC(ISPECL
     [`\x:real^M. x$(SUC m)`;
      `{x | x IN s /\ (f:real^M->real^N) x IN {f z}} INTER
       INTERS {{x | x$i = (y:real^M)$i} | i IN 1..m}`]
     CONTINUOUS_ATTAINS_INF) THEN
    SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE;
             CONTINUOUS_ON_ID] THEN
    ANTS_TAC THENL
     [CONJ_TAC THENL
       [MATCH_MP_TAC COMPACT_INTER_CLOSED THEN CONJ_TAC THENL
         [MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN
          EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
          ASM_SIMP_TAC[CLOSED_IN_SING; FUN_IN_IMAGE; SUBSET_REFL];
          MATCH_MP_TAC CLOSED_INTERS THEN
          SIMP_TAC[FORALL_IN_GSPEC; CLOSED_STANDARD_HYPERPLANE]];
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^M` THEN
        ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER; INTERS_GSPEC; IN_SING]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN
      REWRITE_TAC[IN_ELIM_THM; IN_INTER; INTERS_GSPEC; IN_SING] THEN
      REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      X_GEN_TAC `w:real^M` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `w:real^M`)) THEN
      REPEAT(ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN
      FIRST_X_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL
       [REWRITE_TAC[LE; CONJ_ASSOC] THEN
        REWRITE_TAC[LEFT_OR_DISTRIB; RIGHT_OR_DISTRIB] THEN
        REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_OR_THM;
                    TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
        REWRITE_TAC[CONJ_ASSOC; ARITH_RULE
         `1 <= k /\ k = SUC n <=> k = SUC n /\ 1 <= k`] THEN
        REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM; FORALL_UNWIND_THM2;
                    IMP_CONJ; UNWIND_THM2; ARITH_RULE `1 <= SUC n`] THEN
        REWRITE_TAC[LT_SUC_LE; IMP_IMP] THEN
        ASM_SIMP_TAC[REAL_LE_REFL; DISJ_ASSOC] THEN
        DISJ1_TAC THEN
        REWRITE_TAC[REAL_ARITH `x = w \/ x < w <=> x <= w`] THEN
        ASM_MESON_TAC[];
        DISCH_THEN(fun th -> DISJ2_TAC THEN MP_TAC th) THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
        ASM_SIMP_TAC[ARITH_RULE `j <= n ==> j <= SUC n`] THEN
        ASM_MESON_TAC[LE_TRANS; LT_IMP_LE]]];
    REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
    REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !b. b IN s ==> b = a`] THEN
    ASM_SIMP_TAC[CART_EQ; IN_ELIM_THM] THEN X_GEN_TAC `b:real^M` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN
    ASM_SIMP_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `b:real^M`) THEN
    ASM_SIMP_TAC[CART_EQ] THEN REWRITE_TAC[GSYM CART_EQ] THEN
    ASM_CASES_TAC `b:real^M = a` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_EXISTS_THM;
                RIGHT_IMP_FORALL_THM] THEN
    MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ s) /\ r`] THEN
    ONCE_REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`] THEN
    DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2
      STRIP_ASSUME_TAC MP_TAC)) THEN
    ASM_CASES_TAC `i:num = j` THENL
     [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `~(i:num = j) ==> i < j \/ j < i`)) THEN
    ASM_MESON_TAC[REAL_NOT_LT]]);;

let BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN = prove
 (`!f:real^M->real^N u.
        COUNTABLE u /\
        (!k. k IN u ==> compact k /\ f continuous_on k)
        ==> ?t. borel t /\ t SUBSET UNIONS u /\
                IMAGE f t = IMAGE f (UNIONS u) /\
                !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:(real^M->bool)->bool = {}` THENL
   [EXISTS_TAC `{}:real^M->bool` THEN
    ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY; BOREL_EMPTY; SUBSET_REFL];
    ALL_TAC] THEN
  MP_TAC(ISPEC `u:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `c:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN
  SUBGOAL_THEN
   `!n. ?t. gdelta t /\
            t SUBSET (c(n:num)) /\
            IMAGE (f:real^M->real^N) t = IMAGE f (c n) /\
            !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`
  MP_TAC THENL
   [ASM_SIMP_TAC[GDELTA_DOMAIN_OF_INJECTIVITY_CONTINUOUS];
    REWRITE_TAC[INJECTIVE_ON_ALT; SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `d:num->real^M->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN
  STRIP_TAC THEN
  EXISTS_TAC
   `UNIONS {d n DIFF
            UNIONS(IMAGE (\m.
               {x | x IN d n /\ f(x) IN IMAGE (f:real^M->real^N) (d m)})
               {m | m < n}) | n IN (:num)}` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC BOREL_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
    SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; IN_UNIV] THEN
    X_GEN_TAC `n:num` THEN MATCH_MP_TAC BOREL_DIFF THEN
    ASM_SIMP_TAC[GDELTA_IMP_BOREL] THEN MATCH_MP_TAC BOREL_UNIONS THEN
    SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_IMAGE; FINITE_NUMSEG_LT] THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN
    X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN
    MATCH_MP_TAC CONTINUOUS_BOREL_PREIMAGE THEN
    ASM_SIMP_TAC[GDELTA_IMP_BOREL] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC COMPACT_IMP_BOREL THEN
    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
    ASM_REWRITE_TAC[];
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE] THEN
    MATCH_MP_TAC UNIONS_MONO_IMAGE THEN ASM SET_TAC[];
    TRANS_TAC EQ_TRANS
     `IMAGE (f:real^M->real^N) (UNIONS (IMAGE d (:num)))` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    GEN_REWRITE_TAC I [EXTENSION] THEN
    REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
    REWRITE_TAC[EXISTS_IN_UNIONS] THEN
    REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
    X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_UNIV] THEN
    GEN_REWRITE_TAC RAND_CONV [num_WOP] THEN
    REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[];
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_UNIONS] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN
    REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
    GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
    REWRITE_TAC[IMP_IMP] THEN MATCH_MP_TAC WLOG_LT THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[]]);;

let BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ fsigma s
        ==> ?t. borel t /\ t SUBSET s /\
                IMAGE f t = IMAGE f s /\
                !x y. x IN t /\ y IN t /\ f x = f y ==> x = y`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FSIGMA_UNIONS_COMPACT]) THEN
  REWRITE_TAC[UNION_OF] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  MATCH_MP_TAC BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN THEN
  ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Several variants of paracompactness.                                      *)
(* ------------------------------------------------------------------------- *)

let PARACOMPACT = prove
 (`!s c. (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c
         ==> ?c'. s SUBSET UNIONS c' /\
                  (!u. u IN c'
                       ==> open u /\ ?t. t IN c /\ u SUBSET t) /\
                  (!x. x IN s
                       ==> ?v. open v /\ x IN v /\
                               FINITE {u | u IN c' /\ ~(u INTER v = {})})`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [EXISTS_TAC `{}:(real^N->bool)->bool` THEN
    ASM_REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!x:real^N. x IN s
               ==> ?t u. x IN u /\ open u /\ closure u SUBSET t /\ t IN c`
  MP_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
    ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN
    GEN_REWRITE_TAC LAND_CONV [OPEN_CONTAINS_CBALL] 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
    EXISTS_TAC `ball(x:real^N,e)` THEN
    ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; CLOSURE_BALL];
    GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN
    MAP_EVERY X_GEN_TAC
      [`f:real^N->real^N->bool`; `e:real^N->real^N->bool`] THEN
    STRIP_TAC] THEN
  MP_TAC(ISPEC `IMAGE (e:real^N->real^N->bool) s` LINDELOF) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool`
    (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ASM_CASES_TAC `k:real^N->bool = {}` THENL
   [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPEC `k:real^N->bool` COUNTABLE_AS_IMAGE) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` SUBST_ALL_TAC) THEN
  STRIP_TAC THEN EXISTS_TAC
  `{ f(a n:real^N) DIFF UNIONS {closure(e(a m)):real^N->bool | m < n} |
     n IN (:num)}` THEN
  REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REPEAT CONJ_TAC THENL
   [X_GEN_TAC `n:num` THEN CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_DIFF THEN
      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC CLOSED_UNIONS THEN
      REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN
      ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
      SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT];
      EXISTS_TAC `f((a:num->real^N) n):real^N->bool` THEN ASM SET_TAC[]];
    REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN `?n. x IN (f((a:num->real^N) n):real^N->bool)` MP_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
      ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
      DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
      STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `(a:num->real^N) n`) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]];
      GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
      MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]];
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
    DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
    EXISTS_TAC `e((a:num->real^N) n):real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[SET_RULE
     `{u | (?n. u = f n) /\ P u} = IMAGE f {n |n| P(f n) /\ n IN (:num)}`] THEN
    MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN
    EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN
    X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN
    MATCH_MP_TAC(SET_RULE `u SUBSET t ==> (s DIFF t) INTER u = {}`) THEN
    REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC] THEN
    ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]);;

let PARACOMPACT_CLOSED_IN = prove
 (`!u:real^N->bool s c.
        closed_in (subtopology euclidean u) s /\
        (!t:real^N->bool. t IN c ==> open_in (subtopology euclidean u) t) /\
        s SUBSET UNIONS c
         ==> ?c'. s SUBSET UNIONS c' /\
                  (!v. v IN c'
                       ==> open_in (subtopology euclidean u) v /\
                           ?t. t IN c /\ v SUBSET t) /\
                  (!x. x IN u
                       ==> ?v. open_in (subtopology euclidean u) v /\ x IN v /\
                               FINITE {n | n IN c' /\ ~(n INTER v = {})})`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
   (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
  REWRITE_TAC[OPEN_IN_OPEN] 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->bool)->(real^N->bool)` THEN
  DISCH_THEN(ASSUME_TAC o GSYM) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool`
   (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
  MP_TAC(ISPECL
   [`u:real^N->bool`;
    `((:real^N) DIFF k) INSERT IMAGE (uu:(real^N->bool)->(real^N->bool)) c`]
   PARACOMPACT) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; UNIONS_INSERT; FORALL_IN_INSERT;
               EXISTS_IN_IMAGE; EXISTS_IN_INSERT; GSYM closed] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `{u INTER v:real^N->bool | v IN d /\ ~(v INTER k = {})}` THEN
  REPEAT CONJ_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
    REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[];
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `u INTER v:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    ONCE_REWRITE_TAC[SET_RULE
     `{y | y IN {f x | P x} /\ Q y} = IMAGE f {x | P x /\ Q(f x)}`] THEN
    MATCH_MP_TAC FINITE_IMAGE THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);;

let PARACOMPACT_CLOSED = prove
 (`!s:real^N->bool c.
        closed s /\ (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c
        ==> ?c'. s SUBSET UNIONS c' /\
                 (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\
                 (!x. ?v. open v /\ x IN v /\
                          FINITE {u | u IN c' /\ ~(u INTER v = {})})`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`; `c:(real^N->bool)->bool`]
        PARACOMPACT_CLOSED_IN) THEN
  ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN; IN_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Partitions of unity subordinate to locally finite open coverings.         *)
(* ------------------------------------------------------------------------- *)

let SUBORDINATE_PARTITION_OF_UNITY = prove
 (`!c s. s SUBSET UNIONS c /\ (!u. u IN c ==> open u) /\
         (!x. x IN s
              ==> ?v. open v /\ x IN v /\
                      FINITE {u | u IN c /\ ~(u INTER v = {})})
         ==> ?f:(real^N->bool)->real^N->real.
                      (!u. u IN c
                           ==> (lift o f u) continuous_on s /\
                               !x. x IN s ==> &0 <= f u x) /\
                      (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> f u x = &0) /\
                      (!x. x IN s ==> sum c (\u. f u x) = &1) /\
                      (!x. x IN s
                           ==> ?n. open n /\ x IN n /\
                                   FINITE {u | u IN c /\
                                           ~(!x. x IN n ==> f u x = &0)})`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `?u:real^N->bool. u IN c /\ s SUBSET u` THENL
   [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\v:real^N->bool x:real^N. if v = u then &1 else &0` THEN
    REWRITE_TAC[COND_RAND; COND_RATOR; o_DEF; REAL_POS;
                REAL_OF_NUM_EQ; ARITH_EQ;
                MESON[] `(if p then q else T) <=> p ==> q`] THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_CONST; COND_ID; SUM_DELTA] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    EXISTS_TAC `ball(x:real^N,&1)` THEN
    REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN
    MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N->bool}` THEN
    REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN
    X_GEN_TAC `v:real^N->bool` THEN
    ASM_CASES_TAC `v:real^N->bool = u` THEN ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  EXISTS_TAC `\u:real^N->bool x:real^N.
        if x IN s
        then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v))
        else &0` THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  SIMP_TAC[SUM_POS_LE; SETDIST_POS_LE; REAL_LE_DIV] THEN
  SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; real_div; REAL_MUL_LZERO] THEN
  REWRITE_TAC[SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN
  MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN
    ASM_CASES_TAC `(u:real^N->bool) IN c` THEN
    ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    REWRITE_TAC[real_div; REAL_ENTIRE] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `(y:real^N) IN u` THEN
    ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_MUL_LZERO] THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!v x:real^N. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF v:real^N->bool`; `x:real^N`]
        SETDIST_EQ_0_CLOSED_IN) THEN
    ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
    ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN
    DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNION] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!x:real^N. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))`
  ASSUME_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN
    REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN
    MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[SETDIST_POS_LE] THEN
    CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN
      ASM_CASES_TAC `(x:real^N) IN u` THEN
      ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF] THEN ASM SET_TAC[];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIONS] THEN
      ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
      ASM_MESON_TAC[REAL_LT_IMP_NZ]];
    ALL_TAC] THEN
  ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_REFL; o_DEF] THEN
  X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
  EXISTS_TAC `\x:real^N.
        lift(setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)))` THEN
  SIMP_TAC[] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN
  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
  SIMP_TAC[CONTINUOUS_ON_LIFT_SETDIST; o_DEF] THEN
  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
  ASM_SIMP_TAC[REAL_LT_IMP_NZ; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(fun th ->
    MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)) THEN
  MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN
  MAP_EVERY EXISTS_TAC
   [`\x:real^N. lift(sum {v | v IN c /\ ~(v INTER n = {})}
                         (\v. setdist({x},s DIFF v)))`;
    `s INTER n:real^N->bool`] THEN
  ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL
   [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN AP_TERM_TAC THEN
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN
    ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `v:real^N->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
    MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM SET_TAC[];
    ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN
    ASM_SIMP_TAC[CONTINUOUS_AT_LIFT_SETDIST; CONTINUOUS_AT_WITHIN]]);;
