colo12-c703.uibk.ac.at Git - Multivariate Analysis/.git/blob - Multivariate/measure.ml

   1 (* ========================================================================= *)
   2 (* Lebsegue measure, measurable functions (defined via the gauge integral).  *)
   3 (*                                                                           *)
   4 (*              (c) Copyright, John Harrison 1998-2008                       *)
   5 (* ========================================================================= *)
   6
   7 needs "Library/card.ml";;
   8 needs "Library/permutations.ml";;
   9 needs "Multivariate/integration.ml";;
  10 needs "Multivariate/determinants.ml";;
  11 prioritize_real();;
  12
  13 (* ------------------------------------------------------------------------- *)
  14 (* Lebesgue measure in the case where the measure is finite. This is our     *)
  15 (* default notion of "measurable", but we also define "lebesgue_measurable"  *)
  16 (* further down. Note that in neither case do we assume the set is bounded.  *)
  17 (* ------------------------------------------------------------------------- *)
  18
  19 parse_as_infix("has_measure",(12,"right"));;
  20
  21 let has_measure = new_definition
  22  `s has_measure m <=> ((\x. vec 1) has_integral (lift m)) s`;;
  23
  24 let measurable = new_definition
  25  `measurable s <=> ?m. s has_measure m`;;
  26
  27 let measure = new_definition
  28  `measure s = @m. s has_measure m`;;
  29
  30 let HAS_MEASURE_MEASURE = prove
  31  (`!s. measurable s <=> s has_measure (measure s)`,
  32   REWRITE_TAC[measure; measurable] THEN MESON_TAC[]);;
  33
  34 let HAS_MEASURE_UNIQUE = prove
  35  (`!s m1 m2. s has_measure m1 /\ s has_measure m2 ==> m1 = m2`,
  36   REWRITE_TAC[has_measure; GSYM LIFT_EQ] THEN MESON_TAC[HAS_INTEGRAL_UNIQUE]);;
  37
  38 let MEASURE_UNIQUE = prove
  39  (`!s m. s has_measure m ==> measure s = m`,
  40   MESON_TAC[HAS_MEASURE_UNIQUE; HAS_MEASURE_MEASURE; measurable]);;
  41
  42 let HAS_MEASURE_MEASURABLE_MEASURE = prove
  43  (`!s m. s has_measure m <=> measurable s /\ measure s = m`,
  44   REWRITE_TAC[HAS_MEASURE_MEASURE] THEN MESON_TAC[MEASURE_UNIQUE]);;
  45
  46 let HAS_MEASURE_IMP_MEASURABLE = prove
  47  (`!s m. s has_measure m ==> measurable s`,
  48   REWRITE_TAC[measurable] THEN MESON_TAC[]);;
  49
  50 let HAS_MEASURE = prove
  51  (`!s m. s has_measure m <=>
  52               ((\x. if x IN s then vec 1 else vec 0) has_integral (lift m))
  53               (:real^N)`,
  54   SIMP_TAC[HAS_INTEGRAL_RESTRICT_UNIV; has_measure]);;
  55
  56 let MEASURABLE = prove
  57  (`!s. measurable s <=> (\x. vec 1:real^1) integrable_on s`,
  58   REWRITE_TAC[measurable; integrable_on;
  59               has_measure; EXISTS_DROP; LIFT_DROP]);;
  60
  61 let MEASURABLE_INTEGRABLE = prove
  62  (`measurable s <=>
  63      (\x. if x IN s then vec 1 else vec 0:real^1) integrable_on UNIV`,
  64   REWRITE_TAC[measurable; integrable_on;
  65               HAS_MEASURE; EXISTS_DROP; LIFT_DROP]);;
  66
  67 let MEASURE_INTEGRAL = prove
  68  (`!s. measurable s ==> measure s = drop (integral s (\x. vec 1))`,
  69   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  70   REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
  71   MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  72   ASM_REWRITE_TAC[GSYM has_measure; GSYM HAS_MEASURE_MEASURE]);;
  73
  74 let MEASURE_INTEGRAL_UNIV = prove
  75  (`!s. measurable s
  76        ==> measure s =
  77            drop(integral UNIV (\x. if x IN s then vec 1 else vec 0))`,
  78   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  79   REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
  80   MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  81   ASM_REWRITE_TAC[GSYM HAS_MEASURE; GSYM HAS_MEASURE_MEASURE]);;
  82
  83 let INTEGRAL_MEASURE = prove
  84  (`!s. measurable s ==> integral s (\x. vec 1) = lift(measure s)`,
  85   SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; MEASURE_INTEGRAL]);;
  86
  87 let INTEGRAL_MEASURE_UNIV = prove
  88  (`!s. measurable s
  89        ==> integral UNIV (\x. if x IN s then vec 1 else vec 0) =
  90            lift(measure s)`,
  91   SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; MEASURE_INTEGRAL_UNIV]);;
  92
  93 let HAS_MEASURE_INTERVAL = prove
  94  (`(!a b:real^N. interval[a,b] has_measure content(interval[a,b])) /\
  95    (!a b:real^N. interval(a,b) has_measure content(interval[a,b]))`,
  96   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
  97    [REWRITE_TAC[has_measure] THEN
  98     ONCE_REWRITE_TAC[LIFT_EQ_CMUL] THEN REWRITE_TAC[HAS_INTEGRAL_CONST];
  99     ALL_TAC] THEN
 100   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN SIMP_TAC[HAS_MEASURE] THEN
 101   MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
 102                            HAS_INTEGRAL_SPIKE) THEN
 103   EXISTS_TAC `interval[a:real^N,b] DIFF interval(a,b)` THEN
 104   REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN
 105   MP_TAC(ISPECL [`a:real^N`; `b:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
 106   SET_TAC[]);;
 107
 108 let MEASURABLE_INTERVAL = prove
 109  (`(!a b:real^N. measurable (interval[a,b])) /\
 110    (!a b:real^N. measurable (interval(a,b)))`,
 111   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_INTERVAL]);;
 112
 113 let MEASURE_INTERVAL = prove
 114  (`(!a b:real^N. measure(interval[a,b]) = content(interval[a,b])) /\
 115    (!a b:real^N. measure(interval(a,b)) = content(interval[a,b]))`,
 116   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 117   REWRITE_TAC[HAS_MEASURE_INTERVAL]);;
 118
 119 let MEASURE_INTERVAL_1 = prove
 120  (`(!a b:real^1. measure(interval[a,b]) =
 121                     if drop a <= drop b then drop b - drop a else &0) /\
 122    (!a b:real^1. measure(interval(a,b)) =
 123                     if drop a <= drop b then drop b - drop a else &0)`,
 124   REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
 125   REWRITE_TAC[DIMINDEX_1; FORALL_1; PRODUCT_1; drop]);;
 126
 127 let MEASURE_INTERVAL_1_ALT = prove
 128  (`(!a b:real^1. measure(interval[a,b]) =
 129                     if drop a < drop b then drop b - drop a else &0) /\
 130    (!a b:real^1. measure(interval(a,b)) =
 131                     if drop a < drop b then drop b - drop a else &0)`,
 132   REWRITE_TAC[MEASURE_INTERVAL_1] THEN REAL_ARITH_TAC);;
 133
 134 let MEASURE_INTERVAL_2 = prove
 135  (`(!a b:real^2. measure(interval[a,b]) =
 136                  if a$1 <= b$1 /\ a$2 <= b$2
 137                  then (b$1 - a$1) * (b$2 - a$2)
 138                  else &0) /\
 139    (!a b:real^2. measure(interval(a,b)) =
 140                  if a$1 <= b$1 /\ a$2 <= b$2
 141                  then (b$1 - a$1) * (b$2 - a$2)
 142                  else &0)`,
 143   REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
 144   REWRITE_TAC[DIMINDEX_2; FORALL_2; PRODUCT_2]);;
 145
 146 let MEASURE_INTERVAL_2_ALT = prove
 147  (`(!a b:real^2. measure(interval[a,b]) =
 148                  if a$1 < b$1 /\ a$2 < b$2
 149                  then (b$1 - a$1) * (b$2 - a$2)
 150                  else &0) /\
 151    (!a b:real^2. measure(interval(a,b)) =
 152                  if a$1 < b$1 /\ a$2 < b$2
 153                  then (b$1 - a$1) * (b$2 - a$2)
 154                  else &0)`,
 155   REWRITE_TAC[MEASURE_INTERVAL_2] THEN REPEAT GEN_TAC THEN
 156   MAP_EVERY ASM_CASES_TAC
 157    [`(a:real^2)$1 = (b:real^2)$1`; `(a:real^2)$2 = (b:real^2)$2`] THEN
 158   ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO;
 159                   REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN
 160   ASM_REWRITE_TAC[REAL_LT_LE]);;
 161
 162 let MEASURE_INTERVAL_3 = prove
 163  (`(!a b:real^3. measure(interval[a,b]) =
 164                  if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3
 165                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3)
 166                  else &0) /\
 167    (!a b:real^3. measure(interval(a,b)) =
 168                  if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3
 169                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3)
 170                  else &0)`,
 171   REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
 172   REWRITE_TAC[DIMINDEX_3; FORALL_3; PRODUCT_3]);;
 173
 174 let MEASURE_INTERVAL_3_ALT = prove
 175  (`(!a b:real^3. measure(interval[a,b]) =
 176                  if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3
 177                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3)
 178                  else &0) /\
 179    (!a b:real^3. measure(interval(a,b)) =
 180                  if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3
 181                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3)
 182                  else &0)`,
 183   REWRITE_TAC[MEASURE_INTERVAL_3] THEN REPEAT GEN_TAC THEN
 184   MAP_EVERY ASM_CASES_TAC
 185    [`(a:real^3)$1 = (b:real^3)$1`;
 186     `(a:real^3)$2 = (b:real^3)$2`;
 187     `(a:real^3)$3 = (b:real^3)$3`] THEN
 188   ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO;
 189                   REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN
 190   ASM_REWRITE_TAC[REAL_LT_LE]);;
 191
 192 let MEASURE_INTERVAL_4 = prove
 193  (`(!a b:real^4. measure(interval[a,b]) =
 194                  if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 /\ a$4 <= b$4
 195                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4)
 196                  else &0) /\
 197    (!a b:real^4. measure(interval(a,b)) =
 198                  if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 /\ a$4 <= b$4
 199                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4)
 200                  else &0)`,
 201   REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
 202   REWRITE_TAC[DIMINDEX_4; FORALL_4; PRODUCT_4]);;
 203
 204 let MEASURE_INTERVAL_4_ALT = prove
 205  (`(!a b:real^4. measure(interval[a,b]) =
 206                  if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 /\ a$4 < b$4
 207                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4)
 208                  else &0) /\
 209    (!a b:real^4. measure(interval(a,b)) =
 210                  if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 /\ a$4 < b$4
 211                  then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4)
 212                  else &0)`,
 213   REWRITE_TAC[MEASURE_INTERVAL_4] THEN REPEAT GEN_TAC THEN
 214   MAP_EVERY ASM_CASES_TAC
 215    [`(a:real^4)$1 = (b:real^4)$1`;
 216     `(a:real^4)$2 = (b:real^4)$2`;
 217     `(a:real^4)$3 = (b:real^4)$3`;
 218     `(a:real^4)$4 = (b:real^4)$4`] THEN
 219   ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO;
 220                   REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN
 221   ASM_REWRITE_TAC[REAL_LT_LE]);;
 222
 223 let MEASURABLE_INTER = prove
 224  (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s INTER t)`,
 225   REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN REPEAT STRIP_TAC THEN
 226   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
 227   SUBGOAL_THEN
 228    `(\x. if x IN s INTER t then vec 1 else vec 0):real^N->real^1 =
 229     (\x. lambda i. min (((if x IN s then vec 1 else vec 0):real^1)$i)
 230                        (((if x IN t then vec 1 else vec 0):real^1)$i))`
 231   SUBST1_TAC THENL
 232    [SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN
 233     X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN
 234     MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN
 235     ASM_SIMP_TAC[IN_INTER; VEC_COMPONENT] THEN REAL_ARITH_TAC;
 236     ALL_TAC] THEN
 237   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN THEN
 238   CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
 239   ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
 240   COND_CASES_TAC THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS]);;
 241
 242 let MEASURABLE_UNION = prove
 243  (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s UNION t)`,
 244   REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN REPEAT STRIP_TAC THEN
 245   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
 246   SUBGOAL_THEN
 247    `(\x. if x IN s UNION t then vec 1 else vec 0):real^N->real^1 =
 248     (\x. lambda i. max (((if x IN s then vec 1 else vec 0):real^1)$i)
 249                        (((if x IN t then vec 1 else vec 0):real^1)$i))`
 250   SUBST1_TAC THENL
 251    [SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN
 252     X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN
 253     MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN
 254     ASM_SIMP_TAC[IN_UNION; VEC_COMPONENT] THEN REAL_ARITH_TAC;
 255     ALL_TAC] THEN
 256   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX THEN
 257   CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
 258   ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
 259   COND_CASES_TAC THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS]);;
 260
 261 let HAS_MEASURE_DISJOINT_UNION = prove
 262  (`!s1 s2 m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ DISJOINT s1 s2
 263                  ==> (s1 UNION s2) has_measure (m1 + m2)`,
 264   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_MEASURE; CONJ_ASSOC] THEN
 265   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
 266   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN
 267   REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC EQ_IMP THEN
 268   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
 269   REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
 270   REPEAT(COND_CASES_TAC THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]) THEN
 271   ASM SET_TAC[]);;
 272
 273 let MEASURE_DISJOINT_UNION = prove
 274  (`!s t. measurable s /\ measurable t /\ DISJOINT s t
 275          ==> measure(s UNION t) = measure s + measure t`,
 276   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 277   ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNION; GSYM HAS_MEASURE_MEASURE]);;
 278
 279 let MEASURE_DISJOINT_UNION_EQ = prove
 280  (`!s t u.
 281         measurable s /\ measurable t /\ s UNION t = u /\ DISJOINT s t
 282         ==> measure s + measure t = measure u`,
 283   MESON_TAC[MEASURE_DISJOINT_UNION]);;
 284
 285 let HAS_MEASURE_POS_LE = prove
 286  (`!m s:real^N->bool. s has_measure m ==> &0 <= m`,
 287   REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN
 288   GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN
 289   REWRITE_TAC[drop] THEN MATCH_MP_TAC(ISPEC
 290    `(\x. if x IN s then vec 1 else vec 0):real^N->real^1`
 291    HAS_INTEGRAL_COMPONENT_POS) THEN
 292   EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[DIMINDEX_1; ARITH; IN_UNIV] THEN
 293   GEN_TAC THEN COND_CASES_TAC THEN
 294   REWRITE_TAC[GSYM drop; DROP_VEC; REAL_POS]);;
 295
 296 let MEASURE_POS_LE = prove
 297  (`!s. measurable s ==> &0 <= measure s`,
 298   REWRITE_TAC[HAS_MEASURE_MEASURE; HAS_MEASURE_POS_LE]);;
 299
 300 let HAS_MEASURE_SUBSET = prove
 301  (`!s1 s2:real^N->bool m1 m2.
 302         s1 has_measure m1 /\ s2 has_measure m2 /\ s1 SUBSET s2
 303         ==> m1 <= m2`,
 304   REPEAT GEN_TAC THEN REWRITE_TAC[has_measure] THEN STRIP_TAC THEN
 305   GEN_REWRITE_TAC BINOP_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN
 306   MATCH_MP_TAC(ISPEC `(\x. vec 1):real^N->real^1`
 307     HAS_INTEGRAL_SUBSET_DROP_LE) THEN
 308   MAP_EVERY EXISTS_TAC [`s1:real^N->bool`; `s2:real^N->bool`] THEN
 309   ASM_REWRITE_TAC[DROP_VEC; REAL_POS]);;
 310
 311 let MEASURE_SUBSET = prove
 312  (`!s t. measurable s /\ measurable t /\ s SUBSET t
 313          ==> measure s <= measure t`,
 314   REWRITE_TAC[HAS_MEASURE_MEASURE] THEN MESON_TAC[HAS_MEASURE_SUBSET]);;
 315
 316 let HAS_MEASURE_0 = prove
 317  (`!s:real^N->bool. s has_measure &0 <=> negligible s`,
 318   GEN_TAC THEN EQ_TAC THENL
 319    [ALL_TAC;
 320     REWRITE_TAC[NEGLIGIBLE; has_measure] THEN
 321     DISCH_THEN(MP_TAC o SPEC `(:real^N)`) THEN
 322     ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
 323     REWRITE_TAC[IN_UNIV; indicator; LIFT_NUM]] THEN
 324   REWRITE_TAC[negligible] THEN REWRITE_TAC[has_measure] THEN
 325   ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
 326   REWRITE_TAC[LIFT_NUM] THEN DISCH_TAC THEN
 327   FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [HAS_INTEGRAL_ALT]) THEN
 328   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
 329   REWRITE_TAC[integrable_on; IN_UNIV] THEN
 330   GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV)
 331    [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
 332   REWRITE_TAC[indicator] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN
 333   SUBGOAL_THEN `y:real^1 = vec 0` (fun th -> ASM_MESON_TAC[th]) THEN
 334   REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
 335    [MATCH_MP_TAC(ISPEC
 336      `(\x. if x IN interval [a,b]
 337            then if x IN s then vec 1 else vec 0 else vec 0):real^N->real^1`
 338      HAS_INTEGRAL_DROP_LE) THEN
 339     EXISTS_TAC `(\x. if x IN s then vec 1 else vec 0):real^N->real^1`;
 340     REWRITE_TAC[DROP_VEC] THEN MATCH_MP_TAC(ISPEC
 341      `(\x. if x IN interval [a,b]
 342            then if x IN s then vec 1 else vec 0 else vec 0):real^N->real^1`
 343      HAS_INTEGRAL_DROP_POS)] THEN
 344   EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[] THEN
 345   REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
 346   REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);;
 347
 348 let MEASURE_EQ_0 = prove
 349  (`!s. negligible s ==> measure s = &0`,
 350   MESON_TAC[MEASURE_UNIQUE; HAS_MEASURE_0]);;
 351
 352 let NEGLIGIBLE_IMP_MEASURABLE = prove
 353  (`!s:real^N->bool. negligible s ==> measurable s`,
 354   MESON_TAC[HAS_MEASURE_0; measurable]);;
 355
 356 let HAS_MEASURE_EMPTY = prove
 357  (`{} has_measure &0`,
 358   REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_EMPTY]);;
 359
 360 let MEASURE_EMPTY = prove
 361  (`measure {} = &0`,
 362   SIMP_TAC[MEASURE_EQ_0; NEGLIGIBLE_EMPTY]);;
 363
 364 let MEASURABLE_EMPTY = prove
 365  (`measurable {}`,
 366   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_EMPTY]);;
 367
 368 let MEASURABLE_MEASURE_EQ_0 = prove
 369  (`!s. measurable s ==> (measure s = &0 <=> negligible s)`,
 370   REWRITE_TAC[HAS_MEASURE_MEASURE; GSYM HAS_MEASURE_0] THEN
 371   MESON_TAC[MEASURE_UNIQUE]);;
 372
 373 let NEGLIGIBLE_EQ_MEASURE_0 = prove
 374  (`!s:real^N->bool.
 375         negligible s <=> measurable s /\ measure s = &0`,
 376   MESON_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_MEASURE_EQ_0]);;
 377
 378 let MEASURABLE_MEASURE_POS_LT = prove
 379  (`!s. measurable s ==> (&0 < measure s <=> ~negligible s)`,
 380   SIMP_TAC[REAL_LT_LE; MEASURE_POS_LE; GSYM MEASURABLE_MEASURE_EQ_0] THEN
 381   REWRITE_TAC[EQ_SYM_EQ]);;
 382
 383 let NEGLIGIBLE_INTERVAL = prove
 384  (`(!a b. negligible(interval[a,b]) <=> interval(a,b) = {}) /\
 385    (!a b. negligible(interval(a,b)) <=> interval(a,b) = {})`,
 386   REWRITE_TAC[GSYM HAS_MEASURE_0] THEN
 387   MESON_TAC[HAS_MEASURE_INTERVAL; CONTENT_EQ_0_INTERIOR;
 388             INTERIOR_CLOSED_INTERVAL; HAS_MEASURE_UNIQUE]);;
 389
 390 let MEASURABLE_UNIONS = prove
 391  (`!f:(real^N->bool)->bool.
 392         FINITE f /\ (!s. s IN f ==> measurable s)
 393         ==> measurable (UNIONS f)`,
 394   REWRITE_TAC[IMP_CONJ] THEN
 395   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 396   SIMP_TAC[UNIONS_0; UNIONS_INSERT; MEASURABLE_EMPTY] THEN
 397   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
 398   MATCH_MP_TAC MEASURABLE_UNION THEN ASM_SIMP_TAC[]);;
 399
 400 let HAS_MEASURE_DIFF_SUBSET = prove
 401  (`!s1 s2 m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ s2 SUBSET s1
 402                  ==> (s1 DIFF s2) has_measure (m1 - m2)`,
 403   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_MEASURE; CONJ_ASSOC] THEN
 404   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
 405   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN
 406   REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN
 407   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
 408   REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
 409   REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
 410   REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN
 411   ASM SET_TAC[]);;
 412
 413 let MEASURABLE_DIFF = prove
 414  (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s DIFF t)`,
 415   SUBGOAL_THEN
 416    `!s t:real^N->bool. measurable s /\ measurable t /\ t SUBSET s
 417          ==> measurable (s DIFF t)`
 418   ASSUME_TAC THENL
 419    [REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_DIFF_SUBSET];
 420     ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
 421     REPEAT STRIP_TAC THEN
 422     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_INTER] THEN
 423     SET_TAC[]]);;
 424
 425 let MEASURE_DIFF_SUBSET = prove
 426  (`!s t. measurable s /\ measurable t /\ t SUBSET s
 427          ==> measure(s DIFF t) = measure s - measure t`,
 428   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 429   ASM_SIMP_TAC[HAS_MEASURE_DIFF_SUBSET; GSYM HAS_MEASURE_MEASURE]);;
 430
 431 let HAS_MEASURE_UNION_NEGLIGIBLE = prove
 432  (`!s t:real^N->bool m.
 433         s has_measure m /\ negligible t ==> (s UNION t) has_measure m`,
 434   REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN
 435   MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
 436   MAP_EVERY EXISTS_TAC
 437    [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`;
 438     `t:real^N->bool`] THEN
 439   ASM_SIMP_TAC[IN_DIFF; IN_UNIV; IN_UNION]);;
 440
 441 let HAS_MEASURE_DIFF_NEGLIGIBLE = prove
 442  (`!s t:real^N->bool m.
 443         s has_measure m /\ negligible t ==> (s DIFF t) has_measure m`,
 444   REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN
 445   MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
 446   MAP_EVERY EXISTS_TAC
 447    [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`;
 448     `t:real^N->bool`] THEN
 449   ASM_SIMP_TAC[IN_DIFF; IN_UNIV; IN_UNION]);;
 450
 451 let HAS_MEASURE_UNION_NEGLIGIBLE_EQ = prove
 452  (`!s t:real^N->bool m.
 453      negligible t ==> ((s UNION t) has_measure m <=> s has_measure m)`,
 454   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
 455   ASM_SIMP_TAC[HAS_MEASURE_UNION_NEGLIGIBLE] THEN
 456   SUBST1_TAC(SET_RULE `s:real^N->bool = (s UNION t) DIFF (t DIFF s)`) THEN
 457   MATCH_MP_TAC HAS_MEASURE_DIFF_NEGLIGIBLE THEN ASM_REWRITE_TAC[] THEN
 458   MATCH_MP_TAC NEGLIGIBLE_DIFF THEN ASM_REWRITE_TAC[]);;
 459
 460 let HAS_MEASURE_DIFF_NEGLIGIBLE_EQ = prove
 461  (`!s t:real^N->bool m.
 462      negligible t ==> ((s DIFF t) has_measure m <=> s has_measure m)`,
 463   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
 464   ASM_SIMP_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE] THEN
 465   SUBST1_TAC(SET_RULE `s:real^N->bool = (s DIFF t) UNION (t INTER s)`) THEN
 466   MATCH_MP_TAC HAS_MEASURE_UNION_NEGLIGIBLE THEN
 467   ASM_SIMP_TAC[NEGLIGIBLE_INTER]);;
 468
 469 let HAS_MEASURE_ALMOST = prove
 470  (`!s s' t m. s has_measure m /\ negligible t /\ s UNION t = s' UNION t
 471               ==> s' has_measure m`,
 472   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
 473    `s UNION t = s' UNION t ==> s' = (s UNION t) DIFF (t DIFF s')`)) THEN
 474   ASM_SIMP_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE; HAS_MEASURE_UNION_NEGLIGIBLE;
 475                NEGLIGIBLE_DIFF]);;
 476
 477 let HAS_MEASURE_ALMOST_EQ = prove
 478  (`!s s' t. negligible t /\ s UNION t = s' UNION t
 479             ==> (s has_measure m <=> s' has_measure m)`,
 480   MESON_TAC[HAS_MEASURE_ALMOST]);;
 481
 482 let MEASURABLE_ALMOST = prove
 483  (`!s s' t. measurable s /\ negligible t /\ s UNION t = s' UNION t
 484             ==> measurable s'`,
 485   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ALMOST]);;
 486
 487 let HAS_MEASURE_NEGLIGIBLE_UNION = prove
 488  (`!s1 s2:real^N->bool m1 m2.
 489         s1 has_measure m1 /\ s2 has_measure m2 /\ negligible(s1 INTER s2)
 490         ==> (s1 UNION s2) has_measure (m1 + m2)`,
 491   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN
 492   MAP_EVERY EXISTS_TAC
 493    [`(s1 DIFF (s1 INTER s2)) UNION (s2 DIFF (s1 INTER s2)):real^N->bool`;
 494     `s1 INTER s2:real^N->bool`] THEN
 495   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
 496    [ALL_TAC; SET_TAC[]] THEN
 497   MATCH_MP_TAC HAS_MEASURE_DISJOINT_UNION THEN REPEAT CONJ_TAC THENL
 498    [MATCH_MP_TAC HAS_MEASURE_ALMOST THEN EXISTS_TAC `s1:real^N->bool`;
 499     MATCH_MP_TAC HAS_MEASURE_ALMOST THEN EXISTS_TAC `s2:real^N->bool`;
 500     SET_TAC[]] THEN
 501   EXISTS_TAC `s1 INTER s2:real^N->bool` THEN
 502   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
 503
 504 let MEASURE_NEGLIGIBLE_UNION = prove
 505  (`!s t. measurable s /\ measurable t /\ negligible(s INTER t)
 506          ==> measure(s UNION t) = measure s + measure t`,
 507   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 508   ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNION; GSYM HAS_MEASURE_MEASURE]);;
 509
 510 let MEASURE_NEGLIGIBLE_UNION_EQ = prove
 511  (`!s t u.
 512         measurable s /\ measurable t /\ s UNION t = u /\ negligible(s INTER t)
 513         ==> measure s + measure t = measure u`,
 514   MESON_TAC[MEASURE_NEGLIGIBLE_UNION]);;
 515
 516 let HAS_MEASURE_NEGLIGIBLE_SYMDIFF = prove
 517  (`!s t:real^N->bool m.
 518         s has_measure m /\
 519         negligible((s DIFF t) UNION (t DIFF s))
 520         ==> t has_measure m`,
 521   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN
 522   MAP_EVERY EXISTS_TAC
 523    [`s:real^N->bool`; `(s DIFF t) UNION (t DIFF s):real^N->bool`] THEN
 524   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
 525
 526 let MEASURABLE_NEGLIGIBLE_SYMDIFF = prove
 527  (`!s t:real^N->bool.
 528         measurable s /\ negligible((s DIFF t) UNION (t DIFF s))
 529         ==> measurable t`,
 530   REWRITE_TAC[measurable] THEN
 531   MESON_TAC[HAS_MEASURE_NEGLIGIBLE_SYMDIFF]);;
 532
 533 let MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ = prove
 534  (`!s t:real^N->bool.
 535         negligible(s DIFF t UNION t DIFF s)
 536         ==> (measurable s <=> measurable t)`,
 537   MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF; UNION_COMM]);;
 538
 539 let MEASURE_NEGLIGIBLE_SYMDIFF = prove
 540  (`!s t:real^N->bool.
 541         negligible(s DIFF t UNION t DIFF s) ==> measure s = measure t`,
 542   REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC
 543    [`measurable(s:real^N->bool)`; `measurable(t:real^N->bool)`]
 544   THENL
 545    [ASM_MESON_TAC[HAS_MEASURE_NEGLIGIBLE_SYMDIFF; MEASURE_UNIQUE;
 546                   HAS_MEASURE_MEASURE];
 547     ASM_MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ];
 548     ASM_MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ];
 549     REWRITE_TAC[measure] THEN AP_TERM_TAC THEN ABS_TAC THEN
 550     ASM_MESON_TAC[measurable]]);;
 551
 552 let NEGLIGIBLE_SYMDIFF_EQ = prove
 553  (`!s t:real^N->bool.
 554         negligible (s DIFF t UNION t DIFF s)
 555         ==> (negligible s <=> negligible t)`,
 556   REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THEN
 557   REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN
 558   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
 559   SET_TAC[]);;
 560
 561 let NEGLIGIBLE_DELETE = prove
 562  (`!a:real^N. negligible(s DELETE a) <=> negligible s`,
 563   GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN
 564   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
 565   EXISTS_TAC `{a:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);;
 566
 567 let HAS_MEASURE_NEGLIGIBLE_UNIONS = prove
 568  (`!m f:(real^N->bool)->bool.
 569         FINITE f /\
 570         (!s. s IN f ==> s has_measure (m s)) /\
 571         (!s t. s IN f /\ t IN f /\ ~(s = t) ==> negligible(s INTER t))
 572         ==> (UNIONS f) has_measure (sum f m)`,
 573   GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
 574   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 575   SIMP_TAC[SUM_CLAUSES; UNIONS_0; UNIONS_INSERT; HAS_MEASURE_EMPTY] THEN
 576   REWRITE_TAC[IN_INSERT] THEN
 577   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN
 578   STRIP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNION THEN
 579   REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
 580   REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN
 581   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
 582   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
 583   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);;
 584
 585 let MEASURE_NEGLIGIBLE_UNIONS = prove
 586  (`!m f:(real^N->bool)->bool.
 587         FINITE f /\
 588         (!s. s IN f ==> s has_measure (m s)) /\
 589         (!s t. s IN f /\ t IN f /\ ~(s = t) ==> negligible(s INTER t))
 590         ==> measure(UNIONS f) = sum f m`,
 591   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 592   ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS]);;
 593
 594 let HAS_MEASURE_DISJOINT_UNIONS = prove
 595  (`!m f:(real^N->bool)->bool.
 596         FINITE f /\
 597         (!s. s IN f ==> s has_measure (m s)) /\
 598         (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t)
 599         ==> (UNIONS f) has_measure (sum f m)`,
 600   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
 601   MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS THEN
 602   ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);;
 603
 604 let MEASURE_DISJOINT_UNIONS = prove
 605  (`!m f:(real^N->bool)->bool.
 606         FINITE f /\
 607         (!s. s IN f ==> s has_measure (m s)) /\
 608         (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t)
 609         ==> measure(UNIONS f) = sum f m`,
 610   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 611   ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS]);;
 612
 613 let HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE = prove
 614  (`!f:A->real^N->bool s.
 615         FINITE s /\
 616         (!x. x IN s ==> measurable(f x)) /\
 617         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y)))
 618         ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`,
 619   REPEAT STRIP_TAC THEN
 620   SUBGOAL_THEN
 621    `sum s (\x. measure(f x)) = sum (IMAGE (f:A->real^N->bool) s) measure`
 622   SUBST1_TAC THENL
 623    [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
 624     MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN
 625     MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN
 626     FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`]) THEN
 627     ASM_SIMP_TAC[INTER_ACI; MEASURABLE_MEASURE_EQ_0];
 628     MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS THEN
 629     ASM_SIMP_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN
 630     ASM_MESON_TAC[FINITE_IMAGE; HAS_MEASURE_MEASURE]]);;
 631
 632 let MEASURE_NEGLIGIBLE_UNIONS_IMAGE = prove
 633  (`!f:A->real^N->bool s.
 634         FINITE s /\
 635         (!x. x IN s ==> measurable(f x)) /\
 636         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y)))
 637         ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`,
 638   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 639   ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE]);;
 640
 641 let HAS_MEASURE_DISJOINT_UNIONS_IMAGE = prove
 642  (`!f:A->real^N->bool s.
 643         FINITE s /\
 644         (!x. x IN s ==> measurable(f x)) /\
 645         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
 646         ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`,
 647   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
 648   MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
 649   ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);;
 650
 651 let MEASURE_DISJOINT_UNIONS_IMAGE = prove
 652  (`!f:A->real^N->bool s.
 653         FINITE s /\
 654         (!x. x IN s ==> measurable(f x)) /\
 655         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
 656         ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`,
 657   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 658   ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS_IMAGE]);;
 659
 660 let HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove
 661  (`!f:A->real^N->bool s.
 662         FINITE {x | x IN s /\ ~(f x = {})} /\
 663         (!x. x IN s ==> measurable(f x)) /\
 664         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y)))
 665         ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`,
 666   REPEAT STRIP_TAC THEN
 667   MP_TAC(ISPECL [`f:A->real^N->bool`;
 668                  `{x | x IN s /\ ~((f:A->real^N->bool) x = {})}`]
 669         HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
 670   ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN
 671   MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
 672    [GEN_REWRITE_TAC I [EXTENSION] THEN
 673     REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN
 674     MESON_TAC[NOT_IN_EMPTY];
 675     CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
 676     SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN
 677     REWRITE_TAC[MEASURE_EMPTY]]);;
 678
 679 let MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove
 680  (`!f:A->real^N->bool s.
 681         FINITE {x | x IN s /\ ~(f x = {})} /\
 682         (!x. x IN s ==> measurable(f x)) /\
 683         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y)))
 684         ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`,
 685   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 686   ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);;
 687
 688 let HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove
 689  (`!f:A->real^N->bool s.
 690         FINITE {x | x IN s /\ ~(f x = {})} /\
 691         (!x. x IN s ==> measurable(f x)) /\
 692         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
 693         ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`,
 694   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
 695   MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
 696   ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);;
 697
 698 let MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove
 699  (`!f:A->real^N->bool s.
 700         FINITE {x | x IN s /\ ~(f x = {})} /\
 701         (!x. x IN s ==> measurable(f x)) /\
 702         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
 703         ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`,
 704   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
 705   ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);;
 706
 707 let MEASURE_UNION = prove
 708  (`!s t:real^N->bool.
 709         measurable s /\ measurable t
 710         ==> measure(s UNION t) = measure(s) + measure(t) - measure(s INTER t)`,
 711   REPEAT STRIP_TAC THEN
 712   ONCE_REWRITE_TAC[SET_RULE
 713    `s UNION t = (s INTER t) UNION (s DIFF t) UNION (t DIFF s)`] THEN
 714   ONCE_REWRITE_TAC[REAL_ARITH `a + b - c:real = c + (a - c) + (b - c)`] THEN
 715   MP_TAC(ISPECL [`s DIFF t:real^N->bool`; `t DIFF s:real^N->bool`]
 716         MEASURE_DISJOINT_UNION) THEN
 717   ASM_SIMP_TAC[MEASURABLE_DIFF] THEN
 718   ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
 719   MP_TAC(ISPECL [`s INTER t:real^N->bool`;
 720                  `(s DIFF t) UNION (t DIFF s):real^N->bool`]
 721                 MEASURE_DISJOINT_UNION) THEN
 722   ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_INTER] THEN
 723   ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
 724   REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN
 725   REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL
 726    [EXISTS_TAC `measure((s DIFF t) UNION (s INTER t):real^N->bool)`;
 727     EXISTS_TAC `measure((t DIFF s) UNION (s INTER t):real^N->bool)`] THEN
 728   (CONJ_TAC THENL
 729     [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION THEN
 730      ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTER];
 731      AP_TERM_TAC] THEN
 732    SET_TAC[]));;
 733
 734 let MEASURE_UNION_LE = prove
 735  (`!s t:real^N->bool.
 736         measurable s /\ measurable t
 737         ==> measure(s UNION t) <= measure s + measure t`,
 738   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURE_UNION] THEN
 739   REWRITE_TAC[REAL_ARITH `a + b - c <= a + b <=> &0 <= c`] THEN
 740   MATCH_MP_TAC MEASURE_POS_LE THEN ASM_SIMP_TAC[MEASURABLE_INTER]);;
 741
 742 let MEASURE_UNIONS_LE = prove
 743  (`!f:(real^N->bool)->bool.
 744         FINITE f /\ (!s. s IN f ==> measurable s)
 745         ==> measure(UNIONS f) <= sum f (\s. measure s)`,
 746   REWRITE_TAC[IMP_CONJ] THEN
 747   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 748   SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN
 749   REWRITE_TAC[MEASURE_EMPTY; REAL_LE_REFL] THEN
 750   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN
 751   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
 752   MATCH_MP_TAC REAL_LE_TRANS THEN
 753   EXISTS_TAC `measure(s:real^N->bool) + measure(UNIONS f:real^N->bool)` THEN
 754   ASM_SIMP_TAC[MEASURE_UNION_LE; MEASURABLE_UNIONS] THEN
 755   REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
 756   ASM_SIMP_TAC[]);;
 757
 758 let MEASURABLE_INSERT = prove
 759  (`!x s:real^N->bool. measurable(x INSERT s) <=> measurable s`,
 760   REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ THEN
 761   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN
 762   REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);;
 763
 764 let MEASURE_INSERT = prove
 765  (`!x s:real^N->bool. measure(x INSERT s) = measure s`,
 766   REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
 767   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN
 768   REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);;
 769
 770 let MEASURE_UNIONS_LE_IMAGE = prove
 771  (`!f:A->bool s:A->(real^N->bool).
 772         FINITE f /\ (!a. a IN f ==> measurable(s a))
 773         ==> measure(UNIONS (IMAGE s f)) <= sum f (\a. measure(s a))`,
 774   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
 775   EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\k:real^N->bool. measure k)` THEN
 776   ASM_SIMP_TAC[MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
 777   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
 778   REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN
 779   ASM_SIMP_TAC[MEASURE_POS_LE]);;
 780
 781 let MEASURABLE_INNER_OUTER = prove
 782  (`!s:real^N->bool.
 783         measurable s <=>
 784                 !e. &0 < e
 785                     ==> ?t u. t SUBSET s /\ s SUBSET u /\
 786                               measurable t /\ measurable u /\
 787                               abs(measure t - measure u) < e`,
 788   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
 789    [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real^N->bool`) THEN
 790     ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM];
 791     ALL_TAC] THEN
 792   REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN
 793   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 794   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
 795   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
 796   MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN
 797   MAP_EVERY EXISTS_TAC
 798    [`(\x. if x IN t then vec 1 else vec 0):real^N->real^1`;
 799     `(\x. if x IN u then vec 1 else vec 0):real^N->real^1`;
 800     `lift(measure(t:real^N->bool))`;
 801     `lift(measure(u:real^N->bool))`] THEN
 802   ASM_REWRITE_TAC[GSYM HAS_MEASURE; GSYM HAS_MEASURE_MEASURE] THEN
 803   ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN
 804   REPEAT(COND_CASES_TAC THEN
 805          ASM_REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN
 806   ASM SET_TAC[]);;
 807
 808 let HAS_MEASURE_INNER_OUTER = prove
 809  (`!s:real^N->bool m.
 810         s has_measure m <=>
 811                 (!e. &0 < e ==> ?t. t SUBSET s /\ measurable t /\
 812                                     m - e < measure t) /\
 813                 (!e. &0 < e ==> ?u. s SUBSET u /\ measurable u /\
 814                                     measure u < m + e)`,
 815   REPEAT GEN_TAC THEN
 816   GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN EQ_TAC THENL
 817    [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real^N->bool` THEN
 818     ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC;
 819     ALL_TAC] THEN
 820   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN
 821   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
 822    [GEN_REWRITE_TAC I [MEASURABLE_INNER_OUTER] THEN
 823     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 824     REMOVE_THEN "u" (MP_TAC o SPEC `e / &2`) THEN
 825     REMOVE_THEN "t" (MP_TAC o SPEC `e / &2`) THEN
 826     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
 827     REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
 828     REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
 829     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
 830     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
 831      `&0 < e /\ t <= u /\ m - e / &2 < t /\ u < m + e / &2
 832                           ==> abs(t - u) < e`) THEN
 833     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
 834     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
 835     DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
 836      `~(&0 < x - y) /\ ~(&0 < y - x) ==> x = y`) THEN
 837     CONJ_TAC THEN DISCH_TAC THENL
 838      [REMOVE_THEN "u" (MP_TAC o SPEC `measure(s:real^N->bool) - m`) THEN
 839       ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE];
 840       REMOVE_THEN "t" (MP_TAC o SPEC `m - measure(s:real^N->bool)`) THEN
 841       ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN
 842     ASM_MESON_TAC[MEASURE_SUBSET]]);;
 843
 844 let HAS_MEASURE_INNER_OUTER_LE = prove
 845  (`!s:real^N->bool m.
 846         s has_measure m <=>
 847                 (!e. &0 < e ==> ?t. t SUBSET s /\ measurable t /\
 848                                     m - e <= measure t) /\
 849                 (!e. &0 < e ==> ?u. s SUBSET u /\ measurable u /\
 850                                     measure u <= m + e)`,
 851   REWRITE_TAC[HAS_MEASURE_INNER_OUTER] THEN
 852   MESON_TAC[REAL_ARITH `&0 < e /\ m - e / &2 <= t ==> m - e < t`;
 853             REAL_ARITH `&0 < e /\ u <= m + e / &2 ==> u < m + e`;
 854             REAL_ARITH `&0 < e <=> &0 < e / &2`; REAL_LT_IMP_LE]);;
 855
 856 let NEGLIGIBLE_OUTER = prove
 857  (`!s:real^N->bool.
 858       negligible s <=>
 859       !e. &0 < e ==> ?t. s SUBSET t /\ measurable t /\ measure t < e`,
 860   GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_INNER_OUTER] THEN
 861   REWRITE_TAC[REAL_ADD_LID] THEN MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN
 862   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN
 863   REWRITE_TAC[EMPTY_SUBSET; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN
 864   ASM_REAL_ARITH_TAC);;
 865
 866 let NEGLIGIBLE_OUTER_LE = prove
 867  (`!s:real^N->bool.
 868       negligible s <=>
 869       !e. &0 < e ==> ?t. s SUBSET t /\ measurable t /\ measure t <= e`,
 870   REWRITE_TAC[NEGLIGIBLE_OUTER] THEN
 871   MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH
 872     `&0 < e ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)`]);;
 873
 874 let HAS_MEASURE_LIMIT = prove
 875  (`!s. s has_measure m <=>
 876         !e. &0 < e
 877             ==> ?B. &0 < B /\
 878                     !a b. ball(vec 0,B) SUBSET interval[a,b]
 879                           ==> ?z. (s INTER interval[a,b]) has_measure z /\
 880                                   abs(z - m) < e`,
 881   GEN_TAC THEN REWRITE_TAC[HAS_MEASURE] THEN
 882   GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN
 883   REWRITE_TAC[IN_UNIV] THEN
 884   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
 885     [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
 886   REWRITE_TAC[MESON[IN_INTER]
 887         `(if x IN k INTER s then a else b) =
 888          (if x IN s then if x IN k then a else b else b)`] THEN
 889   REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; NORM_LIFT]);;
 890
 891 let MEASURE_LIMIT = prove
 892  (`!s:real^N->bool e.
 893         measurable s /\ &0 < e
 894         ==> ?B. &0 < B /\
 895                 !a b. ball(vec 0,B) SUBSET interval[a,b]
 896                       ==> abs(measure(s INTER interval[a,b]) -
 897                               measure s) < e`,
 898   REPEAT STRIP_TAC THEN
 899   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN
 900   GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN
 901   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
 902   ASM_MESON_TAC[MEASURE_UNIQUE]);;
 903
 904 let INTEGRABLE_ON_CONST = prove
 905  (`!c:real^N. (\x:real^M. c) integrable_on s <=> c = vec 0 \/ measurable s`,
 906   GEN_TAC THEN ASM_CASES_TAC `c:real^N = vec 0` THEN
 907   ASM_REWRITE_TAC[INTEGRABLE_0; MEASURABLE] THEN EQ_TAC THENL
 908    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
 909     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN
 910     DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
 911     DISCH_THEN(MP_TAC o
 912       ISPEC `(\y. lambda i. y$k / (c:real^N)$k):real^N->real^1` o
 913       MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_LINEAR)) THEN
 914     ASM_SIMP_TAC[vec; o_DEF; REAL_DIV_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN
 915     SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
 916              LAMBDA_BETA] THEN REAL_ARITH_TAC;
 917     DISCH_THEN(MP_TAC o
 918       ISPEC `(\y. lambda i. (c:real^N)$i * y$i):real^1->real^N` o
 919       MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_LINEAR)) THEN
 920     ANTS_TAC THENL
 921      [SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
 922                LAMBDA_BETA] THEN REAL_ARITH_TAC;
 923       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
 924       SIMP_TAC[FUN_EQ_THM; CART_EQ; o_THM; LAMBDA_BETA; VEC_COMPONENT] THEN
 925       REWRITE_TAC[REAL_MUL_RID]]]);;
 926
 927 let ABSOLUTELY_INTEGRABLE_ON_CONST = prove
 928  (`!c. (\x. c) absolutely_integrable_on s <=> c = vec 0 \/ measurable s`,
 929   REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_ON_CONST] THEN
 930   REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; NORM_EQ_0]);;
 931
 932 let OPEN_NOT_NEGLIGIBLE = prove
 933  (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(negligible s)`,
 934   GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM] THEN
 935   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN
 936   STRIP_TAC THEN
 937   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
 938   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
 939   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
 940   SUBGOAL_THEN `negligible(interval[a - e / (&(dimindex(:N))) % vec 1:real^N,
 941                                     a + e / (&(dimindex(:N))) % vec 1])`
 942   MP_TAC THENL
 943    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
 944     EXISTS_TAC `cball(a:real^N,e)` THEN
 945     CONJ_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN
 946     REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL; VECTOR_ADD_COMPONENT;
 947       VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID;
 948       REAL_ARITH `a - e <= x /\ x <= a + e <=> abs(x - a) <= e`; dist] THEN
 949     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
 950     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
 951     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
 952     MATCH_MP_TAC SUM_BOUND_GEN THEN
 953     REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY; NOT_LT] THEN
 954     REWRITE_TAC[IN_NUMSEG; VECTOR_SUB_COMPONENT; DIMINDEX_GE_1] THEN
 955     ASM_MESON_TAC[REAL_ABS_SUB];
 956     REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN
 957     REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_MUL_RID;
 958       VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
 959     REPEAT STRIP_TAC THEN
 960     REWRITE_TAC[REAL_ARITH `a - e < a + e <=> &0 < e`] THEN
 961     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]]);;
 962
 963 let NOT_NEGLIGIBLE_UNIV = prove
 964  (`~negligible(:real^N)`,
 965   SIMP_TAC[OPEN_NOT_NEGLIGIBLE; OPEN_UNIV; UNIV_NOT_EMPTY]);;
 966
 967 (* ------------------------------------------------------------------------- *)
 968 (* Properties of measure under simple affine transformations.                *)
 969 (* ------------------------------------------------------------------------- *)
 970
 971 let HAS_MEASURE_AFFINITY = prove
 972  (`!s m c y. s has_measure y
 973              ==> (IMAGE (\x:real^N. m % x + c) s)
 974                  has_measure abs(m) pow (dimindex(:N)) * y`,
 975   REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THENL
 976    [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN
 977     ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(x = 0) ==> x = SUC(x - 1)`)
 978      (SPEC_ALL DIMINDEX_NONZERO)] THEN DISCH_TAC THEN
 979     REWRITE_TAC[real_pow; REAL_MUL_LZERO; HAS_MEASURE_0] THEN
 980     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{c:real^N}` THEN
 981     SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_RULES] THEN SET_TAC[];
 982     ALL_TAC] THEN
 983   REWRITE_TAC[HAS_MEASURE] THEN
 984   ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
 985   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 986   FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(m) pow dimindex(:N)`) THEN
 987   ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
 988   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
 989   EXISTS_TAC `abs(m) * B + norm(c:real^N)` THEN
 990   ASM_SIMP_TAC[REAL_ARITH `&0 < B /\ &0 <= x ==> &0 < B + x`;
 991                NORM_POS_LE; REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
 992   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
 993   REWRITE_TAC[IN_IMAGE] THEN
 994   ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; UNWIND_THM1] THEN
 995   FIRST_X_ASSUM(MP_TAC o SPECL
 996     [`if &0 <= m then inv m % u + --(inv m % c):real^N
 997                  else inv m % v + --(inv m % c)`;
 998      `if &0 <= m then inv m % v + --(inv m % c):real^N
 999                  else inv m % u + --(inv m % c)`]) THEN
1000   MATCH_MP_TAC(TAUT `a /\ (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN
1001   CONJ_TAC THENL
1002    [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
1003     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
1004     DISCH_THEN(MP_TAC o SPEC `m % x + c:real^N`) THEN
1005     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_INTERVAL] THEN
1006     CONJ_TAC THENL
1007      [REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm(x:real^N)`] THEN
1008       DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH
1009        `norm(x:real^N) < a ==> norm(x + y) < a + norm(y)`) THEN
1010       ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL; GSYM REAL_ABS_NZ];
1011       ALL_TAC] THEN
1012     SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT;
1013              COND_COMPONENT] THEN
1014     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
1015     REWRITE_TAC[REAL_ARITH `m * u + --(m * c):real = (u - c) * m`] THEN
1016     SUBST1_TAC(REAL_ARITH
1017       `inv(m) = if &0 <= inv(m) then abs(inv m) else --(abs(inv m))`) THEN
1018     SIMP_TAC[REAL_LE_INV_EQ] THEN
1019     REWRITE_TAC[REAL_ARITH `(x - y:real) * --z = (y - x) * z`] THEN
1020     REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN COND_CASES_TAC THEN
1021     ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
1022     ASM_REWRITE_TAC[real_abs] THEN REAL_ARITH_TAC;
1023     ALL_TAC] THEN
1024   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN
1025   ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_TAC THEN
1026   DISCH_THEN(X_CHOOSE_THEN `z:real^1`
1027    (fun th -> EXISTS_TAC `(abs m pow dimindex (:N)) % z:real^1` THEN
1028               MP_TAC th)) THEN
1029   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1030   FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_FIELD `~(x = &0) ==> ~(inv x = &0)`)) THEN
1031   REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN
1032   DISCH_THEN(MP_TAC o SPEC `--(inv m % c):real^N` o
1033     MATCH_MP HAS_INTEGRAL_AFFINITY) THEN
1034   ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV] THEN
1035   SIMP_TAC[COND_ID] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1036   REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
1037                VECTOR_MUL_LNEG; VECTOR_MUL_RNEG] THEN
1038   ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_NEG_NEG] THEN
1039   REWRITE_TAC[VECTOR_ARITH `(u + --c) + c:real^N = u`] THEN
1040   REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV; GSYM REAL_POW_INV] THEN
1041   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
1042   REWRITE_TAC[LIFT_CMUL; GSYM VECTOR_SUB_LDISTRIB] THEN
1043   REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_ABS] THEN
1044   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1045   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_POW_LT; GSYM REAL_ABS_NZ]);;
1046
1047 let STRETCH_GALOIS = prove
1048  (`!x:real^N y:real^N m.
1049         (!k. 1 <= k /\ k <= dimindex(:N) ==>  ~(m k = &0))
1050         ==> ((y = (lambda k. m k * x$k)) <=> (lambda k. inv(m k) * y$k) = x)`,
1051   REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
1052   MATCH_MP_TAC(MESON[]
1053    `(!x. p x ==> (q x <=> r x))
1054     ==> (!x. p x) ==> ((!x. q x) <=> (!x. r x))`) THEN
1055   GEN_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN
1056   ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);;
1057
1058 let HAS_MEASURE_STRETCH = prove
1059  (`!s m y. s has_measure y
1060            ==> (IMAGE (\x:real^N. lambda k. m k * x$k) s :real^N->bool)
1061                has_measure abs(product (1..dimindex(:N)) m) * y`,
1062   REPEAT STRIP_TAC THEN ASM_CASES_TAC
1063    `!k. 1 <= k /\ k <= dimindex(:N) ==> ~(m k = &0)`
1064   THENL
1065    [ALL_TAC;
1066     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
1067     REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THEN
1068     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1069     SUBGOAL_THEN `product(1..dimindex (:N)) m = &0` SUBST1_TAC THENL
1070      [ASM_MESON_TAC[PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN
1071     REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; HAS_MEASURE_0] THEN
1072     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
1073     EXISTS_TAC `{x:real^N | x$k = &0}` THEN
1074     ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; SUBSET; FORALL_IN_IMAGE] THEN
1075     ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; REAL_MUL_LZERO]] THEN
1076   UNDISCH_TAC `(s:real^N->bool) has_measure y` THEN
1077   REWRITE_TAC[HAS_MEASURE] THEN
1078   ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
1079   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1080   SUBGOAL_THEN `&0 < abs(product(1..dimindex(:N)) m)` ASSUME_TAC THENL
1081    [ASM_MESON_TAC[REAL_ABS_NZ; REAL_LT_DIV; PRODUCT_EQ_0_NUMSEG];
1082     ALL_TAC] THEN
1083   FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(product(1..dimindex(:N)) m)`) THEN
1084   ASM_SIMP_TAC[REAL_LT_DIV] THEN
1085   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
1086   EXISTS_TAC `sup(IMAGE (\k. abs(m k) * B) (1..dimindex(:N)))` THEN
1087   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1088    [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; NUMSEG_EMPTY; FINITE_NUMSEG;
1089                  IN_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1; IMAGE_EQ_EMPTY;
1090                  EXISTS_IN_IMAGE] THEN
1091     ASM_MESON_TAC[IN_NUMSEG; DIMINDEX_GE_1; LE_REFL; REAL_LT_MUL; REAL_ABS_NZ];
1092     DISCH_TAC] THEN
1093   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
1094   ASM_SIMP_TAC[IN_IMAGE; STRETCH_GALOIS; UNWIND_THM1] THEN
1095   FIRST_X_ASSUM(MP_TAC o SPECL
1096     [`(lambda k. min (inv(m k) * (u:real^N)$k)
1097                      (inv(m k) * (v:real^N)$k)):real^N`;
1098      `(lambda k. max (inv(m k) * (u:real^N)$k)
1099                  (inv(m k) * (v:real^N)$k)):real^N`]) THEN
1100   MATCH_MP_TAC(TAUT `a /\ (b ==> a ==> c) ==> (a ==> b) ==> c`) THEN
1101   CONJ_TAC THENL
1102    [ALL_TAC;
1103     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN
1104     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1105     SUBGOAL_THEN `!k. 1 <= k /\ k <= dimindex (:N) ==> ~(inv(m k) = &0)`
1106     MP_TAC THENL [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN
1107     ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
1108     DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_STRETCH)] THEN
1109   (MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `\i:num. inv(m i:real)`]
1110     IMAGE_STRETCH_INTERVAL) THEN
1111    SUBGOAL_THEN `~(interval[u:real^N,v] = {})` ASSUME_TAC THENL
1112     [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1113       `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN
1114      ASM_REWRITE_TAC[BALL_EQ_EMPTY; GSYM REAL_NOT_LT];
1115      ALL_TAC] THEN
1116    ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM))
1117   THENL
1118    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1119      `b SUBSET s ==> b' SUBSET IMAGE f b ==> b' SUBSET IMAGE f s`)) THEN
1120     REWRITE_TAC[IN_BALL; SUBSET; NORM_ARITH `dist(vec 0:real^N,x) = norm x`;
1121                 IN_IMAGE] THEN
1122     ASM_SIMP_TAC[STRETCH_GALOIS; REAL_INV_EQ_0; UNWIND_THM1; REAL_INV_INV] THEN
1123     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1124     MATCH_MP_TAC REAL_LET_TRANS THEN
1125     EXISTS_TAC
1126      `norm(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) % x:real^N)` THEN
1127     CONJ_TAC THENL
1128      [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
1129       SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; REAL_ABS_MUL] THEN
1130       REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
1131       REWRITE_TAC[REAL_ABS_POS] THEN
1132       MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN
1133       ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1134                   NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1135       REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_LE_REFL];
1136       ALL_TAC] THEN
1137     REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
1138     EXISTS_TAC `abs(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))) * B` THEN
1139     SUBGOAL_THEN `&0 < sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))`
1140     ASSUME_TAC THENL
1141      [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1142                   NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1143       REWRITE_TAC[EXISTS_IN_IMAGE; GSYM REAL_ABS_NZ; IN_NUMSEG] THEN
1144       ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL];
1145       ALL_TAC] THEN
1146     ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN
1147     MATCH_MP_TAC REAL_LE_TRANS THEN
1148     EXISTS_TAC `sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) * B` THEN
1149     ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `&0 < x ==> abs x <= x`] THEN
1150     ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1151                   NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1152     ASM_SIMP_TAC[EXISTS_IN_IMAGE; REAL_LE_RMUL_EQ] THEN
1153     ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1154                  NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1155     MP_TAC(ISPEC `IMAGE (\k. abs (m k)) (1..dimindex(:N))` SUP_FINITE) THEN
1156     REWRITE_TAC[FORALL_IN_IMAGE] THEN
1157     ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY;
1158                  GSYM NOT_LE; DIMINDEX_GE_1] THEN
1159     REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[];
1160
1161     MATCH_MP_TAC(MESON[]
1162      `s = t /\ P z ==> (f has_integral z) s ==> Q
1163                        ==> ?w. (f has_integral w) t /\ P w`) THEN
1164     SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG; GSYM REAL_ABS_INV] THEN
1165     REWRITE_TAC[REAL_INV_INV] THEN CONJ_TAC THENL
1166      [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
1167        `(!x. f x = x) ==> IMAGE f s = s`) THEN
1168       SIMP_TAC[o_THM; LAMBDA_BETA; CART_EQ] THEN
1169       ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID];
1170       REWRITE_TAC[ABS_DROP; DROP_SUB; LIFT_DROP; DROP_CMUL] THEN
1171       REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; ETA_AX] THEN
1172       REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN
1173       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1174       ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN
1175       ASM_MESON_TAC[ABS_DROP; DROP_SUB; LIFT_DROP]]]);;
1176
1177 let HAS_MEASURE_TRANSLATION = prove
1178  (`!s m a. s has_measure m ==> (IMAGE (\x:real^N. a + x) s) has_measure m`,
1179   REPEAT GEN_TAC THEN
1180   MP_TAC(ISPECL [`s:real^N->bool`; `&1`; `a:real^N`; `m:real`]
1181                 HAS_MEASURE_AFFINITY) THEN
1182   REWRITE_TAC[VECTOR_MUL_LID; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN
1183   REWRITE_TAC[VECTOR_ADD_SYM]);;
1184
1185 let NEGLIGIBLE_TRANSLATION = prove
1186  (`!s a. negligible s ==> negligible (IMAGE (\x:real^N. a + x) s)`,
1187   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION]);;
1188
1189 let HAS_MEASURE_TRANSLATION_EQ = prove
1190  (`!a s m. (IMAGE (\x:real^N. a + x) s) has_measure m <=> s has_measure m`,
1191   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_TRANSLATION] THEN
1192   DISCH_THEN(MP_TAC o SPEC `--a:real^N` o
1193     MATCH_MP HAS_MEASURE_TRANSLATION) THEN
1194   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1195   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + b:real^N = b`] THEN
1196   SET_TAC[]);;
1197
1198 add_translation_invariants [HAS_MEASURE_TRANSLATION_EQ];;
1199
1200 let MEASURE_TRANSLATION = prove
1201  (`!a s. measure(IMAGE (\x:real^N. a + x) s) = measure s`,
1202   REWRITE_TAC[measure; HAS_MEASURE_TRANSLATION_EQ]);;
1203
1204 add_translation_invariants [MEASURE_TRANSLATION];;
1205
1206 let NEGLIGIBLE_TRANSLATION_REV = prove
1207  (`!s a. negligible (IMAGE (\x:real^N. a + x) s) ==> negligible s`,
1208   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);;
1209
1210 let NEGLIGIBLE_TRANSLATION_EQ = prove
1211  (`!a s. negligible (IMAGE (\x:real^N. a + x) s) <=> negligible s`,
1212   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);;
1213
1214 add_translation_invariants [NEGLIGIBLE_TRANSLATION_EQ];;
1215
1216 let MEASURABLE_TRANSLATION_EQ = prove
1217  (`!a:real^N s. measurable (IMAGE (\x. a + x) s) <=> measurable s`,
1218   REWRITE_TAC[measurable; HAS_MEASURE_TRANSLATION_EQ]);;
1219
1220 add_translation_invariants [MEASURABLE_TRANSLATION_EQ];;
1221
1222 let MEASURABLE_TRANSLATION = prove
1223  (`!s a:real^N. measurable s ==> measurable (IMAGE (\x. a + x) s)`,
1224   REWRITE_TAC[MEASURABLE_TRANSLATION_EQ]);;
1225
1226 let HAS_MEASURE_SCALING = prove
1227  (`!s m c. s has_measure m
1228            ==> (IMAGE (\x:real^N. c % x) s) has_measure
1229                (abs(c) pow dimindex(:N)) * m`,
1230   REPEAT GEN_TAC THEN
1231   MP_TAC(ISPECL [`s:real^N->bool`; `c:real`; `vec 0:real^N`; `m:real`]
1232                 HAS_MEASURE_AFFINITY) THEN
1233   REWRITE_TAC[VECTOR_ADD_RID]);;
1234
1235 let HAS_MEASURE_SCALING_EQ = prove
1236  (`!s m c. ~(c = &0)
1237            ==> (IMAGE (\x:real^N. c % x) s
1238                   has_measure (abs(c) pow dimindex(:N)) * m <=>
1239                 s has_measure m)`,
1240   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_SCALING] THEN
1241   DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP HAS_MEASURE_SCALING) THEN
1242   REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
1243   REWRITE_TAC[GSYM REAL_POW_MUL; VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
1244   ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN
1245   REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID; VECTOR_MUL_LID] THEN
1246   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);;
1247
1248 let MEASURABLE_SCALING = prove
1249  (`!s c. measurable s ==> measurable (IMAGE (\x:real^N. c % x) s)`,
1250   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_SCALING]);;
1251
1252 let MEASURABLE_SCALING_EQ = prove
1253  (`!s c. ~(c = &0)
1254          ==> (measurable (IMAGE (\x:real^N. c % x) s) <=> measurable s)`,
1255   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_SCALING] THEN
1256   DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP MEASURABLE_SCALING) THEN
1257   REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
1258   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
1259   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
1260   SET_TAC[]);;
1261
1262 let MEASURE_SCALING = prove
1263  (`!s. measurable s
1264        ==> measure(IMAGE (\x:real^N. c % x) s) =
1265               (abs(c) pow dimindex(:N)) * measure s`,
1266   REWRITE_TAC[HAS_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
1267   MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_SCALING]);;
1268
1269 (* ------------------------------------------------------------------------- *)
1270 (* Measurability of countable unions and intersections of various kinds.     *)
1271 (* ------------------------------------------------------------------------- *)
1272
1273 let HAS_MEASURE_NESTED_UNIONS = prove
1274  (`!s:num->real^N->bool B.
1275         (!n. measurable(s n)) /\
1276         (!n. measure(s n) <= B) /\
1277         (!n. s(n) SUBSET s(SUC n))
1278         ==> measurable(UNIONS { s(n) | n IN (:num) }) /\
1279             ((\n. lift(measure(s n)))
1280                   --> lift(measure(UNIONS { s(n) | n IN (:num) })))
1281             sequentially`,
1282   REPEAT GEN_TAC THEN
1283   ONCE_REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b /\ (b ==> c))`] THEN
1284   SIMP_TAC[MEASURE_INTEGRAL_UNIV; LIFT_DROP] THEN
1285   REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN
1286   STRIP_TAC THEN MATCH_MP_TAC(TAUT `b /\ c ==> b /\ (b ==> c)`) THEN
1287   MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN
1288   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
1289    [REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
1290     REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL] THEN ASM SET_TAC[];
1291     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THENL
1292      [MATCH_MP_TAC LIM_EVENTUALLY THEN
1293       REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
1294       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
1295       ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
1296       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
1297       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1298       FIRST_ASSUM(MP_TAC o PART_MATCH (rand o rand)
1299                   TRANSITIVE_STEPWISE_LE_EQ o concl) THEN
1300       ASM_REWRITE_TAC[SUBSET_TRANS; SUBSET_REFL] THEN ASM SET_TAC[];
1301       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN
1302       ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
1303       SIMP_TAC[NOT_EXISTS_THM; IN_UNIV; LIM_CONST]];
1304      RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEASURABLE_INTEGRABLE]) THEN
1305      ASM_SIMP_TAC[INTEGRAL_MEASURE_UNIV] THEN
1306      REWRITE_TAC[bounded; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
1307      EXISTS_TAC `B:real` THEN REWRITE_TAC[IN_UNIV; NORM_LIFT] THEN
1308      REWRITE_TAC[real_abs] THEN ASM_MESON_TAC[MEASURE_POS_LE]]);;
1309
1310 let MEASURABLE_NESTED_UNIONS = prove
1311  (`!s:num->real^N->bool B.
1312         (!n. measurable(s n)) /\
1313         (!n. measure(s n) <= B) /\
1314         (!n. s(n) SUBSET s(SUC n))
1315         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1316   REPEAT GEN_TAC THEN
1317   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_NESTED_UNIONS) THEN
1318   SIMP_TAC[]);;
1319
1320 let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS = prove
1321  (`!s:num->real^N->bool B.
1322         (!n. measurable(s n)) /\
1323         (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\
1324         (!n. sum (0..n) (\k. measure(s k)) <= B)
1325         ==> measurable(UNIONS { s(n) | n IN (:num) }) /\
1326             ((\n. lift(measure(s n))) sums
1327              lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`,
1328   REPEAT GEN_TAC THEN STRIP_TAC THEN
1329   MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real^N->bool`; `B:real`]
1330                HAS_MEASURE_NESTED_UNIONS) THEN
1331   REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN
1332   SUBGOAL_THEN
1333    `!n. (UNIONS (IMAGE s (0..n)):real^N->bool) has_measure
1334         (sum(0..n) (\k. measure(s k)))`
1335   MP_TAC THENL
1336    [GEN_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
1337     ASM_SIMP_TAC[FINITE_NUMSEG];
1338     ALL_TAC] THEN
1339   DISCH_THEN(fun th -> ASSUME_TAC th THEN
1340     ASSUME_TAC(GEN `n:num` (MATCH_MP MEASURE_UNIQUE (SPEC `n:num` th)))) THEN
1341   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
1342    [CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
1343     GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN
1344     MATCH_MP_TAC IMAGE_SUBSET THEN
1345     REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC;
1346     ALL_TAC] THEN
1347   SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
1348   SUBGOAL_THEN
1349    `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real^N->bool =
1350     UNIONS (IMAGE s (:num))`
1351    (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1352               REWRITE_TAC[]) THEN
1353   GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
1354   REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1355   REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN
1356   REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN
1357   REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);;
1358
1359 let NEGLIGIBLE_COUNTABLE_UNIONS_GEN = prove
1360  (`!f. COUNTABLE f /\ (!s:real^N->bool. s IN f ==> negligible s)
1361        ==> negligible(UNIONS f)`,
1362   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1363   ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
1364   ASM_REWRITE_TAC[UNIONS_0; NEGLIGIBLE_EMPTY] THEN
1365   MP_TAC(ISPEC `f:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1366   ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
1367   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
1368   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN ASM_REWRITE_TAC[]);;
1369
1370 let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED = prove
1371  (`!s:num->real^N->bool.
1372         (!n. measurable(s n)) /\
1373         (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\
1374         bounded(UNIONS { s(n) | n IN (:num) })
1375         ==> measurable(UNIONS { s(n) | n IN (:num) }) /\
1376             ((\n. lift(measure(s n))) sums
1377              lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`,
1378   REPEAT GEN_TAC THEN STRIP_TAC THEN
1379   FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
1380   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1381   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
1382   MATCH_MP_TAC HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS THEN
1383   EXISTS_TAC `measure(interval[a:real^N,b])` THEN
1384   ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1385   EXISTS_TAC `measure(UNIONS (IMAGE (s:num->real^N->bool) (0..n)))` THEN
1386   CONJ_TAC THENL
1387    [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
1388     MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
1389     ASM_SIMP_TAC[FINITE_NUMSEG];
1390     MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN
1391     CONJ_TAC THENL
1392      [MATCH_MP_TAC MEASURABLE_UNIONS THEN
1393       ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE];
1394       ASM SET_TAC[]]]);;
1395
1396 let MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove
1397  (`!s:num->real^N->bool.
1398         (!n. measurable(s n)) /\
1399         bounded(UNIONS { s(n) | n IN (:num) })
1400         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1401   REPEAT STRIP_TAC THEN
1402   SUBGOAL_THEN
1403    `UNIONS { s(n):real^N->bool | n IN (:num) } =
1404     UNIONS { UNIONS {s(m) | m IN 0..n} | n IN (:num)}`
1405   SUBST1_TAC THENL
1406    [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
1407     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1408     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1409     REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
1410     REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_UNIONS; IN_ELIM_THM] THEN
1411     REWRITE_TAC[IN_NUMSEG; IN_UNIV; LE_0] THEN MESON_TAC[LE_REFL];
1412     MATCH_MP_TAC MEASURABLE_NESTED_UNIONS THEN
1413     FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
1414     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1415     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
1416     EXISTS_TAC `measure(interval[a:real^N,b])` THEN
1417     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1418      [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN
1419       ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1420       SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG];
1421       DISCH_TAC] THEN
1422     CONJ_TAC THENL
1423      [GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
1424       ASM_REWRITE_TAC[MEASURABLE_INTERVAL] THEN ASM SET_TAC[];
1425       GEN_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; LE_0] THEN SET_TAC[]]]);;
1426
1427 let MEASURE_COUNTABLE_UNIONS_LE_STRONG = prove
1428  (`!d:num->(real^N->bool) B.
1429         (!n. measurable(d n)) /\
1430         (!n. measure(UNIONS {d k | k <= n}) <= B)
1431         ==> measurable(UNIONS {d n | n IN (:num)}) /\
1432             measure(UNIONS {d n | n IN (:num)}) <= B`,
1433   REPEAT GEN_TAC THEN STRIP_TAC THEN
1434   MP_TAC(ISPECL [`\n. UNIONS {(d:num->(real^N->bool)) k | k IN (0..n)}`;
1435                  `B:real`]
1436          HAS_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[] THEN
1437   SUBGOAL_THEN `UNIONS {UNIONS {d k | k IN (0..n)} | n IN (:num)} =
1438                 UNIONS {d n:real^N->bool | n IN (:num)}`
1439   SUBST1_TAC THENL
1440    [GEN_REWRITE_TAC I [EXTENSION] THEN
1441     REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_NUMSEG; LE_0] THEN
1442     MESON_TAC[LE_REFL];
1443     ALL_TAC] THEN
1444   ANTS_TAC THENL
1445    [REPEAT CONJ_TAC THENL
1446      [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN
1447       SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
1448       ASM_REWRITE_TAC[FORALL_IN_IMAGE];
1449       ASM_REWRITE_TAC[IN_NUMSEG; LE_0];
1450       GEN_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN
1451       MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN
1452       REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC];
1453     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1454     GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN
1455     MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN
1456     EXISTS_TAC `\n. lift(measure(UNIONS {d k | k IN 0..n} :real^N->bool))` THEN
1457     ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN
1458     EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
1459     ASM_REWRITE_TAC[LIFT_DROP; IN_NUMSEG; LE_0]]);;
1460
1461 let MEASURE_COUNTABLE_UNIONS_LE = prove
1462  (`!d:num->(real^N->bool) B.
1463         (!n. measurable(d n)) /\
1464         (!n. sum(0..n) (\k. measure(d k)) <= B)
1465         ==> measurable(UNIONS {d n | n IN (:num)}) /\
1466             measure(UNIONS {d n | n IN (:num)}) <= B`,
1467   REPEAT GEN_TAC THEN STRIP_TAC THEN
1468   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN
1469   ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
1470   MP_TAC(ISPECL [`0..n`;`d:num->real^N->bool`] MEASURE_UNIONS_LE_IMAGE) THEN
1471   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
1472   REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `n:num`)) THEN
1473   REWRITE_TAC[GSYM SIMPLE_IMAGE; numseg; LE_0; IN_ELIM_THM] THEN
1474   MESON_TAC[REAL_LE_TRANS]);;
1475
1476 let MEASURABLE_COUNTABLE_UNIONS_STRONG = prove
1477  (`!s:num->real^N->bool B.
1478         (!n. measurable(s n)) /\
1479         (!n. measure(UNIONS {s k | k <= n}) <= B)
1480         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1481   MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE_STRONG; REAL_LE_REFL]);;
1482
1483 let MEASURABLE_COUNTABLE_UNIONS = prove
1484  (`!s:num->real^N->bool B.
1485         (!n. measurable(s n)) /\
1486         (!n. sum (0..n) (\k. measure(s k)) <= B)
1487         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1488   MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE; REAL_LE_REFL]);;
1489
1490 let MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN = prove
1491  (`!D B. COUNTABLE D /\
1492          (!d:real^N->bool. d IN D ==> measurable d) /\
1493          (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B)
1494          ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`,
1495   REPEAT GEN_TAC THEN
1496   ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL
1497    [ASM_SIMP_TAC[UNIONS_0; MEASURABLE_EMPTY; SUBSET_EMPTY] THEN
1498     MESON_TAC[FINITE_EMPTY];
1499     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1500     MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1501     ASM_REWRITE_TAC[] THEN
1502     DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN
1503     REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_SUBSET_IMAGE] THEN
1504     REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN
1505     ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
1506     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN
1507     ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
1508     FIRST_X_ASSUM(MP_TAC o SPEC `{k:num | k <= n}`) THEN
1509     SIMP_TAC[FINITE_NUMSEG_LE; FINITE_IMAGE] THEN
1510     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
1511     REPLICATE_TAC 3 AP_TERM_TAC THEN SET_TAC[]]);;
1512
1513 let MEASURE_COUNTABLE_UNIONS_LE_GEN = prove
1514  (`!D B. COUNTABLE D /\
1515          (!d:real^N->bool. d IN D ==> measurable d) /\
1516          (!D'. D' SUBSET D /\ FINITE D' ==> sum D' (\d. measure d) <= B)
1517          ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`,
1518   REPEAT GEN_TAC THEN STRIP_TAC THEN
1519   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
1520   ASM_REWRITE_TAC[] THEN X_GEN_TAC `D':(real^N->bool)->bool` THEN
1521   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `D':(real^N->bool)->bool`) THEN
1522   ASM_REWRITE_TAC[] THEN
1523   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
1524   MATCH_MP_TAC MEASURE_UNIONS_LE THEN ASM SET_TAC[]);;
1525
1526 let MEASURABLE_COUNTABLE_INTERS = prove
1527  (`!s:num->real^N->bool.
1528         (!n. measurable(s n))
1529         ==> measurable(INTERS { s(n) | n IN (:num) })`,
1530   REPEAT STRIP_TAC THEN
1531   SUBGOAL_THEN `INTERS { s(n):real^N->bool | n IN (:num) } =
1532                 s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})`
1533   SUBST1_TAC THENL
1534    [GEN_REWRITE_TAC I [EXTENSION] THEN
1535     REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN
1536     REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
1537     ASM SET_TAC[];
1538     ALL_TAC] THEN
1539   MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
1540   MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_STRONG THEN
1541   EXISTS_TAC `measure(s 0:real^N->bool)` THEN
1542   ASM_SIMP_TAC[MEASURABLE_DIFF; LE_0] THEN
1543   GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
1544   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1545    [ALL_TAC;
1546     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN
1547     MESON_TAC[IN_DIFF]] THEN
1548   ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN
1549   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1550   ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
1551                MEASURABLE_DIFF; MEASURABLE_UNIONS]);;
1552
1553 let MEASURABLE_COUNTABLE_INTERS_GEN = prove
1554  (`!D. COUNTABLE D /\ ~(D = {}) /\
1555        (!d:real^N->bool. d IN D ==> measurable d)
1556        ==> measurable(INTERS D)`,
1557   REPEAT STRIP_TAC THEN
1558   MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1559   ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
1560   GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN
1561   ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
1562   MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN ASM SET_TAC[]);;
1563
1564 let MEASURE_COUNTABLE_UNIONS_APPROACHABLE = prove
1565  (`!D B e.
1566         COUNTABLE D /\
1567         (!d. d IN D ==> measurable d) /\
1568         (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B) /\
1569         &0 < e
1570         ==> ?D'. D' SUBSET D /\ FINITE D' /\
1571                  measure(UNIONS D) - e < measure(UNIONS D':real^N->bool)`,
1572   REPEAT GEN_TAC THEN
1573   ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL
1574    [DISCH_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN
1575     ASM_REWRITE_TAC[EMPTY_SUBSET; FINITE_EMPTY; UNIONS_0; MEASURE_EMPTY] THEN
1576     ASM_REAL_ARITH_TAC;
1577     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1578     MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1579     ASM_REWRITE_TAC[] THEN
1580     DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN
1581     REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE;
1582                 FORALL_SUBSET_IMAGE] THEN
1583     REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN
1584     MP_TAC(ISPECL
1585      [`\n. UNIONS(IMAGE (d:num->real^N->bool) {k | k <= n})`;
1586                    `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN
1587     REWRITE_TAC[] THEN ANTS_TAC THENL
1588      [ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE;
1589                    FINITE_NUMSEG_LE; IN_ELIM_THM] THEN
1590       GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN
1591       MATCH_MP_TAC IMAGE_SUBSET THEN
1592       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC;
1593       ALL_TAC] THEN
1594     SUBGOAL_THEN
1595      `UNIONS {UNIONS (IMAGE d {k | k <= n}) | n IN (:num)}:real^N->bool =
1596       UNIONS (IMAGE d (:num))`
1597     SUBST1_TAC THENL
1598      [REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[UNIONS_GSPEC] THEN
1599       REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EXTENSION] THEN
1600       MESON_TAC[LE_REFL];
1601       ALL_TAC] THEN
1602     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1603     REWRITE_TAC[LIM_SEQUENTIALLY; DIST_REAL; GSYM drop; LIFT_DROP] THEN
1604     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1605     DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
1606     REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN
1607     EXISTS_TAC `{k:num | k <= n}` THEN
1608     SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE] THEN
1609     ASM_SIMP_TAC[REAL_ARITH `abs(x - u) < e /\ &0 < e ==> u - e < x`]]);;
1610
1611 let HAS_MEASURE_NESTED_INTERS = prove
1612  (`!s:num->real^N->bool.
1613         (!n. measurable(s n)) /\
1614         (!n. s(SUC n) SUBSET s(n))
1615         ==> measurable(INTERS {s n | n IN (:num)}) /\
1616             ((\n. lift(measure (s n))) -->
1617                   lift(measure (INTERS {s n | n IN (:num)}))) sequentially`,
1618   GEN_TAC THEN STRIP_TAC THEN
1619   MP_TAC(ISPECL
1620    [`\n. (s:num->real^N->bool) 0 DIFF s n`; `measure(s 0:real^N->bool)`]
1621         HAS_MEASURE_NESTED_UNIONS) THEN
1622   ASM_SIMP_TAC[MEASURABLE_DIFF] THEN ANTS_TAC THENL
1623    [CONJ_TAC THEN X_GEN_TAC `n:num` THENL
1624      [MATCH_MP_TAC MEASURE_SUBSET THEN
1625       ASM_SIMP_TAC[MEASURABLE_DIFF; SUBSET_DIFF] THEN SET_TAC[];
1626       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN SET_TAC[]];
1627     SUBGOAL_THEN
1628      `UNIONS {s 0 DIFF s n | n IN (:num)} =
1629       s 0 DIFF INTERS {s n :real^N->bool | n IN (:num)}`
1630      (fun th -> REWRITE_TAC[th])
1631     THENL [REWRITE_TAC[DIFF_INTERS] THEN SET_TAC[]; ALL_TAC] THEN
1632     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1633      [DISCH_TAC THEN
1634       SUBGOAL_THEN
1635        `measurable(s 0 DIFF (s 0 DIFF INTERS {s n | n IN (:num)})
1636                    :real^N->bool)`
1637       MP_TAC THENL [ASM_SIMP_TAC[MEASURABLE_DIFF]; ALL_TAC] THEN
1638       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
1639        `t SUBSET s ==> s DIFF (s DIFF t) = t`) THEN
1640       REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM] THEN SET_TAC[];
1641
1642       MP_TAC(ISPECL [`sequentially`; `lift(measure(s 0:real^N->bool))`]
1643         LIM_CONST) THEN REWRITE_TAC[IMP_IMP] THEN
1644       DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
1645       REWRITE_TAC[GSYM LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN
1646       AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[LIFT_EQ; FUN_EQ_THM] THEN
1647       REPEAT GEN_TAC THEN
1648       REWRITE_TAC[REAL_ARITH `s - m:real = n <=> m = s - n`] THEN
1649       MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
1650       ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS] THENL
1651        [ALL_TAC; SET_TAC[]] THEN
1652       MP_TAC(ISPEC `\m n:num. (s n :real^N->bool) SUBSET (s m)`
1653           TRANSITIVE_STEPWISE_LE) THEN
1654       ASM_REWRITE_TAC[] THEN
1655       ANTS_TAC THENL [SET_TAC[]; MESON_TAC[LE_0]]]]);;
1656
1657 (* ------------------------------------------------------------------------- *)
1658 (* Measurability of compact and bounded open sets.                           *)
1659 (* ------------------------------------------------------------------------- *)
1660
1661 let MEASURABLE_COMPACT = prove
1662  (`!s:real^N->bool. compact s ==> measurable s`,
1663   let lemma = prove
1664    (`!f s:real^N->bool.
1665           (!n. FINITE(f n)) /\
1666           (!n. s SUBSET UNIONS(f n)) /\
1667           (!x. ~(x IN s) ==> ?n. ~(x IN UNIONS(f n))) /\
1668           (!n a. a IN f(SUC n) ==> ?b. b IN f(n) /\ a SUBSET b) /\
1669           (!n a. a IN f(n) ==> measurable a)
1670           ==> measurable s`,
1671     REPEAT STRIP_TAC THEN
1672     SUBGOAL_THEN `!n. UNIONS(f(SUC n):(real^N->bool)->bool) SUBSET UNIONS(f n)`
1673     ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1674     SUBGOAL_THEN `s = INTERS { UNIONS(f n) | n IN (:num) }:real^N->bool`
1675     SUBST1_TAC THENL
1676      [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1677       MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
1678       REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN
1679       REWRITE_TAC[IN_IMAGE] THEN ASM SET_TAC[];
1680       MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN
1681       ASM_REWRITE_TAC[] THEN GEN_TAC THEN
1682       MATCH_MP_TAC MEASURABLE_UNIONS THEN
1683       ASM_MESON_TAC[]]) in
1684   REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
1685   EXISTS_TAC
1686    `\n. { k | ?u:real^N. (!i. 1 <= i /\ i <= dimindex(:N)
1687                               ==> integer(u$i)) /\
1688                   k = { x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
1689                                        ==> u$i / &2 pow n <= x$i /\
1690                                            x$i < (u$i + &1) / &2 pow n } /\
1691                   ~(s INTER k = {})}` THEN
1692   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
1693    [X_GEN_TAC `n:num` THEN
1694     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1695     SUBGOAL_THEN
1696      `?N. !x:real^N i. x IN s /\ 1 <= i /\ i <= dimindex(:N)
1697                        ==> abs(x$i * &2 pow n) < &N`
1698     STRIP_ASSUME_TAC THENL
1699      [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
1700       REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN
1701       X_GEN_TAC `B:real` THEN STRIP_TAC THEN
1702       MP_TAC(SPEC `B * &2 pow n` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN
1703       MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN
1704       X_GEN_TAC `N:num` THEN
1705       REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN
1706       SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1707       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS];
1708       ALL_TAC] THEN
1709     MATCH_MP_TAC FINITE_SUBSET THEN
1710     EXISTS_TAC
1711      `IMAGE (\u. {x | !i. 1 <= i /\ i <= dimindex(:N)
1712                           ==> (u:real^N)$i <= (x:real^N)$i * &2 pow n /\
1713                               x$i * &2 pow n < u$i + &1})
1714             {u | !i. 1 <= i /\ i <= dimindex(:N) ==> integer (u$i) /\
1715                                                      abs(u$i) <= &N}` THEN
1716     CONJ_TAC THENL
1717      [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN
1718       REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG];
1719       REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN
1720       X_GEN_TAC `l:real^N->bool` THEN
1721       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN
1722       STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[] THEN
1723       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1724       MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN
1725       ASM_SIMP_TAC[INTEGER_CLOSED] THEN
1726       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1727       DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN
1728       REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
1729       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN
1730       ASM_REWRITE_TAC[] THEN
1731       FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `k:num`]) THEN
1732       ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC];
1733     X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
1734     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1735     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1736     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1737     EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN
1738     ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN
1739     REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA; FLOOR] THEN
1740     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
1741     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `x:real^N` THEN
1742     ASM_REWRITE_TAC[IN_ELIM_THM] THEN
1743     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1744     REWRITE_TAC[REAL_MUL_SYM; FLOOR];
1745     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1746     FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
1747     REWRITE_TAC[closed; open_def] THEN
1748     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
1749     ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
1750     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1751     MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN
1752     ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT;
1753                  DIMINDEX_GE_1; ARITH_RULE `0 < x <=> 1 <= x`] THEN
1754     CONV_TAC REAL_RAT_REDUCE_CONV THEN
1755     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
1756     REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
1757     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1758     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1759     ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN
1760     REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
1761     X_GEN_TAC `u:real^N` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
1762     REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
1763     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o CONJUNCT2) THEN
1764     DISCH_THEN(X_CHOOSE_THEN `y:real^N`
1765      (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
1766     REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1767     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
1768      `d < e ==> x <= d ==> x < e`)) THEN
1769     REWRITE_TAC[dist] THEN
1770     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
1771     MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
1772     GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
1773     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC SUM_BOUND THEN
1774     SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
1775     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1776     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN
1777     ASM_REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
1778     REWRITE_TAC[REAL_MUL_LID; GSYM REAL_POW_INV] THEN REAL_ARITH_TAC;
1779     MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`] THEN
1780     DISCH_THEN(X_CHOOSE_THEN `u:real^N`
1781      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1782     DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN
1783     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1784     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1785     ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN
1786     REWRITE_TAC[UNWIND_THM2] THEN
1787     EXISTS_TAC `(lambda i. floor((u:real^N)$i / &2)):real^N` THEN
1788     ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; FLOOR] THEN
1789     MATCH_MP_TAC(SET_RULE `~(s INTER a = {}) /\ a SUBSET b
1790                            ==> ~(s INTER b = {}) /\ a SUBSET b`) THEN
1791     ASM_REWRITE_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[SUBSET] THEN
1792     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
1793     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
1794     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
1795     REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
1796     REWRITE_TAC[GSYM real_div] THEN
1797     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1798     MP_TAC(SPEC `(u:real^N)$k / &2` FLOOR) THEN
1799     REWRITE_TAC[REAL_ARITH `u / &2 < floor(u / &2) + &1 <=>
1800                             u < &2 * floor(u / &2) + &2`] THEN
1801     ASM_SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; FLOOR_FRAC] THEN
1802     REAL_ARITH_TAC;
1803     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1804     MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`; `u:real^N`] THEN
1805     DISCH_THEN(SUBST1_TAC o CONJUNCT1 o CONJUNCT2) THEN
1806     ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
1807     GEN_TAC THEN DISCH_TAC THEN
1808     EXISTS_TAC `interval(inv(&2 pow n) % u:real^N,
1809                          inv(&2 pow n) % (u + vec 1))` THEN
1810     EXISTS_TAC `interval[inv(&2 pow n) % u:real^N,
1811                          inv(&2 pow n) % (u + vec 1)]` THEN
1812     REWRITE_TAC[MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN
1813     ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN
1814     REWRITE_TAC[SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN
1815     CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN
1816     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
1817     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1818     ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT;
1819                  VEC_COMPONENT] THEN
1820     REAL_ARITH_TAC]);;
1821
1822 let MEASURABLE_OPEN = prove
1823  (`!s:real^N->bool. bounded s /\ open s ==> measurable s`,
1824   REPEAT STRIP_TAC THEN
1825   FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
1826   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1827   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
1828   FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
1829    `s SUBSET t ==> s = t DIFF (t DIFF s)`)) THEN
1830   MATCH_MP_TAC MEASURABLE_DIFF THEN
1831   REWRITE_TAC[MEASURABLE_INTERVAL] THEN
1832   MATCH_MP_TAC MEASURABLE_COMPACT THEN
1833   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_DIFF; BOUNDED_INTERVAL] THEN
1834   MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]);;
1835
1836 let MEASURE_OPEN_POS_LT = prove
1837  (`!s. open s /\ bounded s /\ ~(s = {}) ==> &0 < measure s`,
1838   MESON_TAC[OPEN_NOT_NEGLIGIBLE; MEASURABLE_MEASURE_POS_LT; MEASURABLE_OPEN]);;
1839
1840 let MEASURABLE_CLOSURE = prove
1841  (`!s. bounded s ==> measurable(closure s)`,
1842   SIMP_TAC[MEASURABLE_COMPACT; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE;
1843            BOUNDED_CLOSURE]);;
1844
1845 let MEASURABLE_INTERIOR = prove
1846  (`!s. bounded s ==> measurable(interior s)`,
1847   SIMP_TAC[MEASURABLE_OPEN; OPEN_INTERIOR; BOUNDED_INTERIOR]);;
1848
1849 let MEASURABLE_FRONTIER = prove
1850  (`!s:real^N->bool. bounded s ==> measurable(frontier s)`,
1851   REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
1852   MATCH_MP_TAC MEASURABLE_DIFF THEN
1853   ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN
1854   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
1855   REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);;
1856
1857 let MEASURE_FRONTIER = prove
1858  (`!s:real^N->bool.
1859         bounded s
1860         ==> measure(frontier s) = measure(closure s) - measure(interior s)`,
1861   REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
1862   MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
1863   ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN
1864   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
1865   REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);;
1866
1867 let MEASURE_CLOSURE = prove
1868  (`!s:real^N->bool.
1869         bounded s /\ negligible(frontier s)
1870         ==> measure(closure s) = measure s`,
1871   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
1872   ASM_SIMP_TAC[MEASURABLE_CLOSURE] THEN
1873   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1874     NEGLIGIBLE_SUBSET)) THEN
1875   MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
1876   MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
1877   REWRITE_TAC[frontier] THEN SET_TAC[]);;
1878
1879 let MEASURE_INTERIOR = prove
1880  (`!s:real^N->bool.
1881         bounded s /\ negligible(frontier s)
1882         ==> measure(interior s) = measure s`,
1883   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
1884   ASM_SIMP_TAC[MEASURABLE_INTERIOR] THEN
1885   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1886     NEGLIGIBLE_SUBSET)) THEN
1887   MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
1888   MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
1889   REWRITE_TAC[frontier] THEN SET_TAC[]);;
1890
1891 let MEASURABLE_JORDAN = prove
1892  (`!s:real^N->bool. bounded s /\ negligible(frontier s) ==> measurable s`,
1893   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
1894   GEN_TAC THEN DISCH_TAC THEN
1895   EXISTS_TAC `interior(s):real^N->bool` THEN
1896   EXISTS_TAC `closure(s):real^N->bool` THEN
1897   ASM_SIMP_TAC[MEASURABLE_INTERIOR; MEASURABLE_CLOSURE] THEN
1898   REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET] THEN
1899   ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
1900   ASM_SIMP_TAC[GSYM MEASURE_FRONTIER; REAL_ABS_NUM; MEASURE_EQ_0]);;
1901
1902 let HAS_MEASURE_ELEMENTARY = prove
1903  (`!d s. d division_of s ==> s has_measure (sum d content)`,
1904   REPEAT STRIP_TAC THEN REWRITE_TAC[has_measure] THEN
1905   FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
1906   ASM_SIMP_TAC[LIFT_SUM] THEN
1907   MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
1908   ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM has_measure] THEN
1909   ASM_MESON_TAC[HAS_MEASURE_INTERVAL; division_of]);;
1910
1911 let MEASURABLE_ELEMENTARY = prove
1912  (`!d s. d division_of s ==> measurable s`,
1913   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ELEMENTARY]);;
1914
1915 let MEASURE_ELEMENTARY = prove
1916  (`!d s. d division_of s ==> measure s = sum d content`,
1917   MESON_TAC[HAS_MEASURE_ELEMENTARY; MEASURE_UNIQUE]);;
1918
1919 let MEASURABLE_INTER_INTERVAL = prove
1920  (`!s a b:real^N. measurable s ==> measurable (s INTER interval[a,b])`,
1921   SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL]);;
1922
1923 let MEASURABLE_INSIDE = prove
1924  (`!s:real^N->bool. compact s ==> measurable(inside s)`,
1925   SIMP_TAC[MEASURABLE_OPEN; BOUNDED_INSIDE; COMPACT_IMP_CLOSED;
1926            OPEN_INSIDE; COMPACT_IMP_BOUNDED]);;
1927
1928 (* ------------------------------------------------------------------------- *)
1929 (* A nice lemma for negligibility proofs.                                    *)
1930 (* ------------------------------------------------------------------------- *)
1931
1932 let STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE = prove
1933  (`!s. measurable s /\ bounded s /\
1934        (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1)
1935        ==> negligible s`,
1936   REPEAT STRIP_TAC THEN
1937   SUBGOAL_THEN `~(&0 < measure(s:real^N->bool))`
1938    (fun th -> ASM_MESON_TAC[th; MEASURABLE_MEASURE_POS_LT]) THEN
1939   DISCH_TAC THEN
1940   MP_TAC(SPEC `(vec 0:real^N) INSERT s`
1941       BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
1942   ASM_SIMP_TAC[BOUNDED_INSERT; COMPACT_IMP_BOUNDED; NOT_EXISTS_THM] THEN
1943   X_GEN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN
1944   SUBGOAL_THEN
1945    `?N. EVEN N /\ &0 < &N /\
1946         measure(interval[--a:real^N,a])
1947          < (&N * measure(s:real^N->bool)) / &4 pow dimindex (:N)`
1948   STRIP_ASSUME_TAC THENL
1949    [FIRST_ASSUM(MP_TAC o SPEC
1950      `measure(interval[--a:real^N,a]) * &4 pow (dimindex(:N))` o
1951      MATCH_MP REAL_ARCH) THEN
1952     SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
1953     SIMP_TAC[GSYM REAL_LT_LDIV_EQ; ASSUME `&0 < measure(s:real^N->bool)`] THEN
1954     DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
1955     EXISTS_TAC `2 * (N DIV 2 + 1)` THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN
1956     CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN
1957     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
1958      `x < a ==> a <= b ==> x < b`)) THEN
1959     REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC;
1960     ALL_TAC] THEN
1961   MP_TAC(ISPECL [`UNIONS (IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s)
1962                                 (1..N))`;
1963                   `interval[--a:real^N,a]`] MEASURE_SUBSET) THEN
1964   MP_TAC(ISPECL [`measure:(real^N->bool)->real`;
1965                  `IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s) (1..N)`]
1966                 HAS_MEASURE_DISJOINT_UNIONS) THEN
1967   SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMP_CONJ] THEN
1968   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
1969    [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN
1970     MATCH_MP_TAC MEASURABLE_SCALING THEN ASM_REWRITE_TAC[];
1971     ALL_TAC] THEN
1972   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
1973   ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ ~c ==> d <=> a /\ b /\ ~d ==> c`] THEN
1974   SUBGOAL_THEN
1975    `!m n. m IN 1..N /\ n IN 1..N /\
1976           ~(DISJOINT (IMAGE (\x:real^N. &m / &N % x) s)
1977                      (IMAGE (\x. &n / &N % x) s))
1978           ==> m = n`
1979   ASSUME_TAC THENL
1980    [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
1981     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1982     REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN
1983     REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
1984     DISCH_THEN(X_CHOOSE_THEN `x:real^N`
1985      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1986     REWRITE_TAC[IN_IMAGE] THEN
1987     DISCH_THEN(X_CHOOSE_THEN `y:real^N`
1988      (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
1989     DISCH_THEN(MP_TAC o AP_TERM `(%) (&N / &m) :real^N->real^N`) THEN
1990     SUBGOAL_THEN `~(&N = &0) /\ ~(&m = &0)` STRIP_ASSUME_TAC THENL
1991      [REWRITE_TAC[REAL_OF_NUM_EQ] THEN
1992       REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG])) THEN
1993       ARITH_TAC;
1994       ALL_TAC] THEN
1995     FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV)
1996      [GSYM CONTRAPOS_THM]) THEN
1997     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD
1998      `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`] THEN
1999     ASM_SIMP_TAC[REAL_FIELD
2000      `~(x = &0) /\ ~(y = &0) ==> x / y * z / x = z / y`] THEN
2001     REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST_ALL_TAC THEN
2002     FIRST_X_ASSUM(MP_TAC o SPECL [`&n / &m`; `y:real^N`]) THEN
2003     ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_FIELD
2004      `~(y = &0) ==> (x / y = &1 <=> x = y)`] THEN
2005     REWRITE_TAC[REAL_OF_NUM_EQ; EQ_SYM_EQ];
2006     ALL_TAC] THEN
2007   ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN
2008   REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
2009    [REWRITE_TAC[measurable] THEN ASM_MESON_TAC[];
2010     REWRITE_TAC[MEASURABLE_INTERVAL];
2011     REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
2012     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
2013     X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN
2014     DISCH_TAC THEN
2015     MP_TAC(ISPECL [`--a:real^N`; `a:real^N`] CONVEX_INTERVAL) THEN
2016     DISCH_THEN(MP_TAC o REWRITE_RULE[CONVEX_ALT] o CONJUNCT1) THEN
2017     DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `x:real^N`; `&n / &N`]) THEN
2018     ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
2019     DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN
2020     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2021     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN
2022     DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
2023      `1 <= n /\ n <= N ==> 0 < N /\ n <= N`)) THEN
2024     SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT; REAL_LE_LDIV_EQ] THEN
2025     SIMP_TAC[REAL_MUL_LID];
2026     ALL_TAC] THEN
2027   FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN
2028   ASM_SIMP_TAC[MEASURE_SCALING; REAL_NOT_LE] THEN
2029   FIRST_X_ASSUM(K ALL_TAC o SPEC `&0`) THEN
2030   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC
2031    `sum (1..N) (measure o (\m. IMAGE (\x:real^N. &m / &N % x) s))` THEN
2032   CONJ_TAC THENL
2033    [ALL_TAC;
2034     MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
2035     MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[] THEN
2036     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2037     ASM_REWRITE_TAC[SET_RULE `DISJOINT s s <=> s = {}`; IMAGE_EQ_EMPTY] THEN
2038     DISCH_THEN SUBST_ALL_TAC THEN
2039     ASM_MESON_TAC[REAL_LT_REFL; MEASURE_EMPTY]] THEN
2040   FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN
2041   ASM_SIMP_TAC[o_DEF; MEASURE_SCALING; SUM_RMUL] THEN
2042   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2043    `x < a ==> a <= b ==> x < b`)) THEN
2044   ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
2045   ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN
2046   ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN
2047   REWRITE_TAC[GSYM REAL_POW_MUL] THEN
2048   REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN
2049   FIRST_X_ASSUM(X_CHOOSE_THEN `M:num` SUBST_ALL_TAC o
2050         GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
2051   REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
2052   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_MUL]) THEN
2053   RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `&0 < &2 * x <=> &0 < x`]) THEN
2054   ASM_SIMP_TAC[REAL_FIELD `&0 < y ==> x / (&2 * y) * &4 = x * &2 / y`] THEN
2055   MATCH_MP_TAC REAL_LE_TRANS THEN
2056   EXISTS_TAC `sum(M..(2*M)) (\i. (&i * &2 / &M) pow dimindex (:N))` THEN
2057   CONJ_TAC THENL
2058    [ALL_TAC;
2059     MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
2060     SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_DIV; REAL_POS] THEN
2061     REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG; SUBSET] THEN
2062     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_OF_NUM_LT]) THEN
2063     ARITH_TAC] THEN
2064   MATCH_MP_TAC REAL_LE_TRANS THEN
2065   EXISTS_TAC `sum(M..(2*M)) (\i. &2)` THEN CONJ_TAC THENL
2066    [REWRITE_TAC[SUM_CONST_NUMSEG] THEN
2067     REWRITE_TAC[ARITH_RULE `(2 * M + 1) - M = M + 1`] THEN
2068     REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
2069     ALL_TAC] THEN
2070   MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
2071   X_GEN_TAC `n:num` THEN STRIP_TAC THEN
2072   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow (dimindex(:N))` THEN
2073   CONJ_TAC THENL
2074    [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN
2075     MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[DIMINDEX_GE_1] THEN
2076     ARITH_TAC;
2077     ALL_TAC] THEN
2078   MATCH_MP_TAC REAL_POW_LE2 THEN
2079   REWRITE_TAC[REAL_POS; ARITH; real_div; REAL_MUL_ASSOC] THEN
2080   ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN
2081   REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN
2082   UNDISCH_TAC `M:num <= n` THEN ARITH_TAC);;
2083
2084 let STARLIKE_NEGLIGIBLE_LEMMA = prove
2085  (`!s. compact s /\
2086        (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1)
2087        ==> negligible s`,
2088   REPEAT STRIP_TAC THEN
2089   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE THEN
2090   ASM_MESON_TAC[MEASURABLE_COMPACT; COMPACT_IMP_BOUNDED]);;
2091
2092 let STARLIKE_NEGLIGIBLE = prove
2093  (`!s a. closed s /\
2094          (!c x:real^N. &0 <= c /\ (a + x) IN s /\ (a + c % x) IN s ==> c = &1)
2095          ==> negligible s`,
2096   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN
2097   EXISTS_TAC `--a:real^N` THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
2098   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
2099   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_LEMMA THEN CONJ_TAC THENL
2100    [MATCH_MP_TAC CLOSED_INTER_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN
2101     ASM_SIMP_TAC[CLOSED_TRANSLATION];
2102     REWRITE_TAC[IN_IMAGE; IN_INTER] THEN
2103     ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> y = a + x`] THEN
2104     REWRITE_TAC[UNWIND_THM2] THEN ASM MESON_TAC[]]);;
2105
2106 let STARLIKE_NEGLIGIBLE_STRONG = prove
2107  (`!s a. closed s /\
2108          (!c x:real^N. &0 <= c /\ c < &1 /\ (a + x) IN s
2109                        ==> ~((a + c % x) IN s))
2110          ==> negligible s`,
2111   REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
2112   EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
2113   MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN
2114   MATCH_MP_TAC(REAL_ARITH `~(x < y) /\ ~(y < x) ==> x = y`) THEN
2115   STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
2116   FIRST_X_ASSUM(MP_TAC o SPECL [`inv c:real`; `c % x:real^N`]) THEN
2117   ASM_REWRITE_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN
2118   ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < c ==> ~(c = &0)`] THEN
2119   ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
2120   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN
2121   MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);;
2122
2123 (* ------------------------------------------------------------------------- *)
2124 (* In particular.                                                            *)
2125 (* ------------------------------------------------------------------------- *)
2126
2127 let NEGLIGIBLE_HYPERPLANE = prove
2128  (`!a b. ~(a = vec 0 /\ b = &0) ==> negligible {x:real^N | a dot x = b}`,
2129   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
2130   ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | F} = {}`; NEGLIGIBLE_EMPTY] THEN
2131   MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
2132   SUBGOAL_THEN `?x:real^N. ~(a dot x = b)` MP_TAC THENL
2133    [MATCH_MP_TAC(MESON[] `!a:real^N. P a \/ P(--a) ==> ?x. P x`) THEN
2134     EXISTS_TAC `a:real^N` THEN REWRITE_TAC[DOT_RNEG] THEN
2135     MATCH_MP_TAC(REAL_ARITH `~(a = &0) ==> ~(a = b) \/ ~(--a = b)`) THEN
2136     ASM_REWRITE_TAC[DOT_EQ_0];
2137     ALL_TAC] THEN
2138   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
2139   REWRITE_TAC[CLOSED_HYPERPLANE; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN
2140   MAP_EVERY X_GEN_TAC [`t:real`; `y:real^N`] THEN
2141   DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2142    `&0 <= t /\ ac + ay = b /\ ac + t * ay = b
2143     ==> ((ay = &0 ==> ac = b) /\ (t - &1) * ay = &0)`)) THEN
2144   ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0] THEN CONV_TAC TAUT);;
2145
2146 let NEGLIGIBLE_LOWDIM = prove
2147  (`!s:real^N->bool. dim(s) < dimindex(:N) ==> negligible s`,
2148   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
2149   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
2150   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2151   EXISTS_TAC `span(s):real^N->bool` THEN REWRITE_TAC[SPAN_INC] THEN
2152   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2153   EXISTS_TAC `{x:real^N | a dot x = &0}` THEN
2154   ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);;
2155
2156 let NEGLIGIBLE_AFFINE_HULL = prove
2157  (`!s:real^N->bool.
2158         FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(affine hull s)`,
2159   REWRITE_TAC[IMP_CONJ] THEN  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2160   REWRITE_TAC[AFFINE_HULL_EMPTY; NEGLIGIBLE_EMPTY] THEN
2161   SUBGOAL_THEN
2162    `!x s:real^N->bool n.
2163         ~(x IN s) /\ (x INSERT s) HAS_SIZE n /\ n <= dimindex(:N)
2164         ==> negligible(affine hull(x INSERT s))`
2165    (fun th -> MESON_TAC[th; HAS_SIZE; FINITE_INSERT]) THEN
2166   X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN
2167   SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN
2168   REWRITE_TAC[HAS_SIZE; FINITE_INSERT; IMP_CONJ] THEN
2169   SIMP_TAC[CARD_CLAUSES] THEN
2170   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
2171   MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN
2172   ASM_SIMP_TAC[DIM_LE_CARD; DIM_SPAN] THEN ASM_ARITH_TAC);;
2173
2174 let NEGLIGIBLE_AFFINE_HULL_1 = prove
2175  (`!a:real^1. negligible (affine hull {a})`,
2176   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN
2177   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN
2178   ARITH_TAC);;
2179
2180 let NEGLIGIBLE_AFFINE_HULL_2 = prove
2181  (`!a b:real^2. negligible (affine hull {a,b})`,
2182   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN
2183   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN
2184   ARITH_TAC);;
2185
2186 let NEGLIGIBLE_AFFINE_HULL_3 = prove
2187  (`!a b c:real^3. negligible (affine hull {a,b,c})`,
2188   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN
2189   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN
2190   ARITH_TAC);;
2191
2192 let NEGLIGIBLE_CONVEX_HULL = prove
2193  (`!s:real^N->bool.
2194         FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(convex hull s)`,
2195   REPEAT GEN_TAC THEN
2196   DISCH_THEN(MP_TAC o MATCH_MP NEGLIGIBLE_AFFINE_HULL) THEN
2197   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
2198   REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL]);;
2199
2200 let NEGLIGIBLE_CONVEX_HULL_1 = prove
2201  (`!a:real^1. negligible (convex hull {a})`,
2202   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
2203   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN
2204   ARITH_TAC);;
2205
2206 let NEGLIGIBLE_CONVEX_HULL_2 = prove
2207  (`!a b:real^2. negligible (convex hull {a,b})`,
2208   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
2209   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN
2210   ARITH_TAC);;
2211
2212 let NEGLIGIBLE_CONVEX_HULL_3 = prove
2213  (`!a b c:real^3. negligible (convex hull {a,b,c})`,
2214   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
2215   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN
2216   ARITH_TAC);;
2217
2218 (* ------------------------------------------------------------------------- *)
2219 (* Measurability of bounded convex sets.                                     *)
2220 (* ------------------------------------------------------------------------- *)
2221
2222 let NEGLIGIBLE_CONVEX_FRONTIER = prove
2223  (`!s:real^N->bool. convex s ==> negligible(frontier s)`,
2224   SUBGOAL_THEN
2225    `!s:real^N->bool. convex s /\ (vec 0) IN s ==> negligible(frontier s)`
2226   ASSUME_TAC THENL
2227    [ALL_TAC;
2228     X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
2229     ASM_CASES_TAC `s:real^N->bool = {}` THEN
2230     ASM_REWRITE_TAC[FRONTIER_EMPTY; NEGLIGIBLE_EMPTY] THEN
2231     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
2232     DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
2233     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN
2234     ASM_SIMP_TAC[CONVEX_TRANSLATION; IN_IMAGE] THEN
2235     ASM_REWRITE_TAC[UNWIND_THM2;
2236                     VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
2237     REWRITE_TAC[FRONTIER_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ]] THEN
2238   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIM_SUBSET_UNIV) THEN
2239   REWRITE_TAC[ARITH_RULE `d:num <= e <=> d < e \/ d = e`] THEN STRIP_TAC THENL
2240    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2241     EXISTS_TAC `closure s:real^N->bool` THEN
2242     REWRITE_TAC[frontier; SUBSET_DIFF] THEN
2243     MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_REWRITE_TAC[DIM_CLOSURE];
2244     ALL_TAC] THEN
2245   SUBGOAL_THEN `?a:real^N. a IN interior s` CHOOSE_TAC THENL
2246    [X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
2247      (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
2248     FIRST_X_ASSUM SUBST_ALL_TAC THEN
2249     MP_TAC(ISPEC `b:real^N->bool` INTERIOR_SIMPLEX_NONEMPTY) THEN
2250     ASM_REWRITE_TAC[] THEN
2251     MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM SUBSET] THEN
2252     MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN
2253     ASM_REWRITE_TAC[INSERT_SUBSET];
2254     ALL_TAC] THEN
2255   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN
2256   EXISTS_TAC `a:real^N` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
2257   REPEAT GEN_TAC THEN STRIP_TAC THEN
2258   REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN
2259   SIMP_TAC[VECTOR_ARITH
2260    `a + c % x:real^N = (a + x) - (&1 - c) % ((a + x) - a)`] THEN
2261   MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN
2262   RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
2263   ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;
2264
2265 let MEASURABLE_CONVEX = prove
2266  (`!s:real^N->bool. convex s /\ bounded s ==> measurable s`,
2267   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_JORDAN THEN
2268   ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER]);;
2269
2270 (* ------------------------------------------------------------------------- *)
2271 (* Various special cases.                                                    *)
2272 (* ------------------------------------------------------------------------- *)
2273
2274 let NEGLIGIBLE_SPHERE = prove
2275  (`!a:real^N r. negligible (sphere(a,e))`,
2276   REWRITE_TAC[GSYM FRONTIER_CBALL] THEN
2277   SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);;
2278
2279 let MEASURABLE_BALL = prove
2280  (`!a r. measurable(ball(a,r))`,
2281   SIMP_TAC[MEASURABLE_OPEN; BOUNDED_BALL; OPEN_BALL]);;
2282
2283 let MEASURABLE_CBALL = prove
2284  (`!a r. measurable(cball(a,r))`,
2285   SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CBALL]);;
2286
2287 let MEASURE_BALL_POS = prove
2288  (`!x:real^N e. &0 < e ==> &0 < measure(ball(x,e))`,
2289   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_OPEN_POS_LT THEN
2290   REWRITE_TAC[OPEN_BALL; BOUNDED_BALL; BALL_EQ_EMPTY] THEN
2291   ASM_REAL_ARITH_TAC);;
2292
2293 let MEASURE_CBALL_POS = prove
2294  (`!x:real^N e. &0 < e ==> &0 < measure(cball(x,e))`,
2295   MESON_TAC[MEASURE_SUBSET; REAL_LTE_TRANS; MEASURABLE_BALL; MEASURABLE_CBALL;
2296             BALL_SUBSET_CBALL; MEASURE_BALL_POS]);;
2297
2298 let HAS_INTEGRAL_OPEN_INTERVAL = prove
2299  (`!f a b y. (f has_integral y) (interval(a,b)) <=>
2300              (f has_integral y) (interval[a,b])`,
2301   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INTERIOR_CLOSED_INTERVAL] THEN
2302   MATCH_MP_TAC HAS_INTEGRAL_INTERIOR THEN
2303   MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN
2304   REWRITE_TAC[CONVEX_INTERVAL]);;
2305
2306 let INTEGRABLE_ON_OPEN_INTERVAL = prove
2307  (`!f a b. f integrable_on interval(a,b) <=>
2308            f integrable_on interval[a,b]`,
2309   REWRITE_TAC[integrable_on; HAS_INTEGRAL_OPEN_INTERVAL]);;
2310
2311 let INTEGRAL_OPEN_INTERVAL = prove
2312  (`!f a b. integral(interval(a,b)) f = integral(interval[a,b]) f`,
2313   REWRITE_TAC[integral; HAS_INTEGRAL_OPEN_INTERVAL]);;
2314
2315 (* ------------------------------------------------------------------------- *)
2316 (* Crude upper bounds for measure of balls.                                  *)
2317 (* ------------------------------------------------------------------------- *)
2318
2319 let MEASURE_CBALL_BOUND = prove
2320  (`!x:real^N d.
2321         &0 <= d ==> measure(cball(x,d)) <= (&2 * d) pow (dimindex(:N))`,
2322   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2323   EXISTS_TAC `measure(interval[x - d % vec 1:real^N,x + d % vec 1])` THEN
2324   CONJ_TAC THENL
2325    [MATCH_MP_TAC MEASURE_SUBSET THEN
2326     REWRITE_TAC[MEASURABLE_CBALL; MEASURABLE_INTERVAL] THEN
2327     REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN
2328     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; dist] THEN
2329     REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
2330     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
2331     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
2332     MP_TAC(ISPECL [`x - y:real^N`; `i:num`] COMPONENT_LE_NORM) THEN
2333     ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC;
2334     SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
2335     COND_CASES_TAC THEN
2336     ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_POS] THEN
2337     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
2338     REWRITE_TAC[REAL_ARITH `(x + a) - (x - a):real = &2 * a`] THEN
2339     REWRITE_TAC[PRODUCT_CONST_NUMSEG; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
2340     REWRITE_TAC[REAL_MUL_RID; ADD_SUB; REAL_LE_REFL]]);;
2341
2342 let MEASURE_BALL_BOUND = prove
2343  (`!x:real^N d.
2344         &0 <= d ==> measure(ball(x,d)) <= (&2 * d) pow (dimindex(:N))`,
2345   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2346   EXISTS_TAC `measure(cball(x:real^N,d))` THEN
2347   ASM_SIMP_TAC[MEASURE_CBALL_BOUND] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
2348   REWRITE_TAC[BALL_SUBSET_CBALL; MEASURABLE_BALL; MEASURABLE_CBALL]);;
2349
2350 (* ------------------------------------------------------------------------- *)
2351 (* Negligibility of image under non-injective linear map.                    *)
2352 (* ------------------------------------------------------------------------- *)
2353
2354 let NEGLIGIBLE_LINEAR_SINGULAR_IMAGE = prove
2355  (`!f:real^N->real^N s.
2356         linear f /\ ~(!x y. f(x) = f(y) ==> x = y)
2357         ==> negligible(IMAGE f s)`,
2358   REPEAT GEN_TAC THEN
2359   DISCH_THEN(MP_TAC o MATCH_MP LINEAR_SINGULAR_IMAGE_HYPERPLANE) THEN
2360   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
2361   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2362   EXISTS_TAC `{x:real^N | a dot x = &0}` THEN
2363   ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);;
2364
2365 (* ------------------------------------------------------------------------- *)
2366 (* Some technical lemmas used in the approximation results that follow.      *)
2367 (* Proof of the covering lemma is an obvious multidimensional generalization *)
2368 (* of Lemma 3, p65 of Swartz's "Introduction to Gauge Integrals".            *)
2369 (* ------------------------------------------------------------------------- *)
2370
2371 let COVERING_LEMMA = prove
2372  (`!a b:real^N s g.
2373         s SUBSET interval[a,b] /\ ~(interval(a,b) = {}) /\ gauge g
2374         ==> ?d. COUNTABLE d /\
2375                 (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\
2376                                 (?c d. k = interval[c,d])) /\
2377                 (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
2378                          ==> interior k1 INTER interior k2 = {}) /\
2379                 (!k. k IN d ==> ?x. x IN (s INTER k) /\ k SUBSET g(x)) /\
2380                 (!u v. interval[u,v] IN d
2381                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2382                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2383                 s SUBSET UNIONS d`,
2384   REPEAT STRIP_TAC THEN
2385   SUBGOAL_THEN
2386    `?d. COUNTABLE d /\
2387         (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\
2388                         (?c d:real^N. k = interval[c,d])) /\
2389         (!k1 k2. k1 IN d /\ k2 IN d
2390                  ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/
2391                      interior k1 INTER interior k2 = {}) /\
2392         (!x. x IN s ==> ?k. k IN d /\ x IN k /\ k SUBSET g(x)) /\
2393         (!u v. interval[u,v] IN d
2394                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2395                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2396         (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l})`
2397   ASSUME_TAC THENL
2398    [EXISTS_TAC
2399      `IMAGE (\(n,v).
2400              interval[(lambda i. a$i + &(v$i) / &2 pow n *
2401                                        ((b:real^N)$i - (a:real^N)$i)):real^N,
2402                       (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))])
2403             {n,v | n IN (:num) /\
2404                    v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N)
2405                                        ==> v$i < 2 EXP n}}` THEN
2406     CONJ_TAC THENL
2407      [MATCH_MP_TAC COUNTABLE_IMAGE THEN
2408       MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
2409       REWRITE_TAC[NUM_COUNTABLE; IN_UNIV] THEN
2410       GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN
2411       MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
2412       ALL_TAC] THEN
2413     CONJ_TAC THENL
2414      [REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
2415       MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
2416       REWRITE_TAC[IN_ELIM_PAIR_THM] THEN
2417       REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
2418       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
2419       REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN
2420       SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; LAMBDA_BETA] THEN
2421       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2422       ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LE_MUL_EQ;
2423                    REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_LE_ADDR; REAL_ARITH
2424                      `a + x * (b - a) <= b <=> &0 <= (&1 - x) * (b - a)`] THEN
2425       SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_DIV2_EQ; REAL_LT_POW2] THEN
2426       REWRITE_TAC[REAL_ARITH `x <= x + &1 /\ x < x + &1`] THEN
2427       REWRITE_TAC[REAL_SUB_LE] THEN
2428       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
2429       REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID] THEN
2430       SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
2431       ASM_SIMP_TAC[ARITH_RULE `x + 1 <= y <=> x < y`; REAL_LT_IMP_LE];
2432       ALL_TAC] THEN
2433     CONJ_TAC THENL
2434      [ONCE_REWRITE_TAC[IMP_CONJ] THEN
2435       REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; RIGHT_FORALL_IMP_THM] THEN
2436       REWRITE_TAC[IN_ELIM_PAIR_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN
2437       REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
2438       GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
2439       MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
2440        [REPEAT GEN_TAC THEN
2441         GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN
2442         REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[];
2443         ALL_TAC] THEN
2444       MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
2445       MAP_EVERY X_GEN_TAC [`v:num^N`; `w:num^N`] THEN REPEAT DISCH_TAC THEN
2446       REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; SUBSET_INTERVAL] THEN
2447       SIMP_TAC[DISJOINT_INTERVAL; LAMBDA_BETA] THEN
2448       MATCH_MP_TAC(TAUT `p \/ q \/ r ==> (a ==> p) \/ (b ==> q) \/ r`) THEN
2449       ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN
2450       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2451       ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; LAMBDA_BETA] THEN
2452       REWRITE_TAC[NOT_IMP; REAL_LE_LADD] THEN
2453       ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
2454       REWRITE_TAC[REAL_ARITH `~(x + &1 <= x)`] THEN DISJ2_TAC THEN
2455       MATCH_MP_TAC(MESON[]
2456        `(!i. ~P i ==> Q i) ==> (!i. Q i) \/ (?i. P i)`) THEN
2457       X_GEN_TAC `i:num` THEN
2458       DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
2459       ASM_REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN
2460       UNDISCH_TAC `m:num <= n` THEN REWRITE_TAC[LE_EXISTS] THEN
2461       DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN
2462       ONCE_REWRITE_TAC[ADD_SYM] THEN
2463       REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
2464       REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
2465       ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2; REAL_LT_DIV2_EQ] THEN
2466       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2;
2467                    REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN
2468       SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC;
2469       ALL_TAC] THEN
2470     CONJ_TAC THENL
2471      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2472       SUBGOAL_THEN
2473         `?e. &0 < e /\ !y. (!i. 1 <= i /\ i <= dimindex(:N)
2474                                 ==> abs((x:real^N)$i - (y:real^N)$i) <= e)
2475                            ==> y IN g(x)`
2476       STRIP_ASSUME_TAC THENL
2477        [FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [gauge]) THEN
2478         STRIP_TAC THEN
2479         FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
2480         DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
2481         DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2482         EXISTS_TAC `e / &2 / &(dimindex(:N))` THEN
2483         ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
2484                      ARITH] THEN
2485         X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
2486         MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN
2487         EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[IN_BALL] THEN
2488         MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
2489         ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2490         EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN
2491         REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
2492         ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT;
2493                      DIMINDEX_GE_1; VECTOR_SUB_COMPONENT; CARD_NUMSEG_1];
2494         ALL_TAC] THEN
2495       REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2496       MP_TAC(SPECL [`&1 / &2`; `e / norm(b - a:real^N)`]
2497         REAL_ARCH_POW_INV) THEN
2498       SUBGOAL_THEN `&0 < norm(b - a:real^N)` ASSUME_TAC THENL
2499        [ASM_MESON_TAC[VECTOR_SUB_EQ; NORM_POS_LT; INTERVAL_SING]; ALL_TAC] THEN
2500       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
2501       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
2502       REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN DISCH_TAC THEN
2503       SIMP_TAC[IN_ELIM_THM; IN_INTERVAL; SUBSET; LAMBDA_BETA] THEN
2504       MATCH_MP_TAC(MESON[]
2505        `(!x. Q x ==> R x) /\ (?x. P x /\ Q x) ==> ?x. P x /\ Q x /\ R x`) THEN
2506       CONJ_TAC THENL
2507        [REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
2508         MAP_EVERY X_GEN_TAC [`w:num^N`; `y:real^N`] THEN
2509         REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
2510         DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
2511         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
2512         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
2513         ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2514          `(a + n <= x /\ x <= a + m) /\
2515           (a + n <= y /\ y <= a + m) ==> abs(x - y) <= m - n`)) THEN
2516         MATCH_MP_TAC(REAL_ARITH
2517          `y * z <= e
2518           ==> a <= ((x + &1) * y) * z - ((x * y) * z) ==> a <= e`) THEN
2519         RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2520         ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
2521         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2522         (REAL_ARITH `n < e * x ==> &0 <= e * (inv y - x) ==> n <= e / y`)) THEN
2523         MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
2524         REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
2525         ASM_SIMP_TAC[REAL_SUB_LT] THEN
2526         MP_TAC(SPECL [`b - a:real^N`; `i:num`] COMPONENT_LE_NORM) THEN
2527         ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
2528         ALL_TAC] THEN
2529       REWRITE_TAC[IN_UNIV; AND_FORALL_THM] THEN
2530       REWRITE_TAC[TAUT `(a ==> c) /\ (a ==> b) <=> a ==> b /\ c`] THEN
2531       REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN
2532       STRIP_TAC THEN
2533       SUBGOAL_THEN `(x:real^N) IN interval[a,b]` MP_TAC THENL
2534        [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN
2535       DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
2536       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN STRIP_TAC THEN
2537       DISJ_CASES_TAC(MATCH_MP (REAL_ARITH `x <= y ==> x = y \/ x < y`)
2538        (ASSUME `(x:real^N)$i <= (b:real^N)$i`))
2539       THENL
2540        [EXISTS_TAC `2 EXP n - 1` THEN
2541         SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_LT;
2542                  EXP_LT_0; LE_1; ARITH] THEN
2543         ASM_REWRITE_TAC[REAL_SUB_ADD; REAL_ARITH `a - &1 < a`] THEN
2544         MATCH_MP_TAC(REAL_ARITH
2545          `&1 * (b - a) = x /\ y <= x ==> a + y <= b /\ b <= a + x`) THEN
2546         ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_LE_RMUL_EQ;
2547                      REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
2548         SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_MUL_RINV; REAL_POW_EQ_0;
2549                  REAL_OF_NUM_EQ; ARITH_EQ] THEN REAL_ARITH_TAC;
2550         ALL_TAC] THEN
2551       MP_TAC(SPEC `&2 pow n * ((x:real^N)$i - (a:real^N)$i) /
2552                               ((b:real^N)$i - (a:real^N)$i)` FLOOR_POS) THEN
2553       ANTS_TAC THENL
2554        [ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_MUL; REAL_POW_LE; REAL_POS;
2555                       REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_DIV];
2556         ALL_TAC] THEN
2557       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
2558       REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
2559       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
2560       REWRITE_TAC[REAL_ARITH `a + b * c <= x /\ x <= a + b' * c <=>
2561                               b * c <= x - a /\ x - a <= b' * c`] THEN
2562       ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
2563                    REAL_SUB_LT; GSYM real_div] THEN
2564       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2565       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
2566       SIMP_TAC[FLOOR; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2567       EXISTS_TAC `((x:real^N)$i - (a:real^N)$i) /
2568                   ((b:real^N)$i - (a:real^N)$i) *
2569                   &2 pow n` THEN
2570       REWRITE_TAC[FLOOR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2571       ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN
2572       ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_SUB_LT] THEN
2573       ASM_REAL_ARITH_TAC;
2574       ALL_TAC] THEN
2575     CONJ_TAC THENL
2576      [REPEAT GEN_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN
2577       REWRITE_TAC[EQ_INTERVAL; IN_ELIM_PAIR_THM] THEN
2578       REWRITE_TAC[INTERVAL_EQ_EMPTY; IN_UNIV; IN_ELIM_THM] THEN
2579       SIMP_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`; LAMBDA_BETA] THEN
2580       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2581       ASM_SIMP_TAC[REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_SUB_LT;
2582                    REAL_LT_DIV2_EQ; REAL_LT_POW2;
2583                    REAL_ARITH `~(v + &1 < v)`] THEN
2584       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
2585       STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC;
2586       ALL_TAC] THEN
2587     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2588     MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
2589     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
2590     MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC
2591      `IMAGE (\(n,v).
2592             interval[(lambda i. a$i + &(v$i) / &2 pow n *
2593                                       ((b:real^N)$i - (a:real^N)$i)):real^N,
2594                      (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))])
2595             {m,v | m IN 0..n /\
2596                    v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N)
2597                                        ==> v$i < 2 EXP m}}` THEN
2598     CONJ_TAC THENL
2599      [MATCH_MP_TAC FINITE_IMAGE THEN
2600       MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
2601       REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN
2602       MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
2603       ALL_TAC] THEN
2604     GEN_REWRITE_TAC I [SUBSET] THEN
2605     REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
2606     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2607     MAP_EVERY X_GEN_TAC [`m:num`; `w:num^N`] THEN DISCH_TAC THEN
2608     DISCH_TAC THEN SIMP_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2609     MAP_EVERY EXISTS_TAC [`m:num`; `w:num^N`] THEN ASM_REWRITE_TAC[] THEN
2610     REWRITE_TAC[IN_NUMSEG; GSYM NOT_LT; LT] THEN DISCH_TAC THEN
2611     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN
2612     SIMP_TAC[NOT_IMP; LAMBDA_BETA] THEN
2613     RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2614     ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
2615     ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
2616     REWRITE_TAC[REAL_ARITH `x <= x + &1`] THEN
2617     DISCH_THEN(MP_TAC o SPEC `1`) THEN
2618     REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN
2619     DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2620      `w / m <= v / n /\ (v + &1) / n <= (w + &1) / m
2621       ==> inv n <= inv m`)) THEN
2622     REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
2623     ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN
2624     ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
2625     ALL_TAC] THEN
2626   SUBGOAL_THEN
2627    `?d. COUNTABLE d /\
2628         (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\
2629                         (?c d:real^N. k = interval[c,d])) /\
2630         (!k1 k2. k1 IN d /\ k2 IN d
2631                  ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/
2632                      interior k1 INTER interior k2 = {}) /\
2633         (!k. k IN d ==> (?x. x IN s INTER k /\ k SUBSET g x)) /\
2634         (!u v. interval[u,v] IN d
2635                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2636                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2637         (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l}) /\
2638         s SUBSET UNIONS d`
2639   MP_TAC THENL
2640    [FIRST_X_ASSUM(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
2641     EXISTS_TAC
2642      `{k:real^N->bool | k IN d /\ ?x. x IN (s INTER k) /\ k SUBSET g x}` THEN
2643     ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
2644      [MATCH_MP_TAC COUNTABLE_SUBSET THEN
2645       EXISTS_TAC `d:(real^N->bool)->bool` THEN
2646       ASM_REWRITE_TAC[] THEN SET_TAC[];
2647       X_GEN_TAC `k:real^N->bool` THEN REPEAT STRIP_TAC THEN
2648       MATCH_MP_TAC FINITE_SUBSET THEN
2649       EXISTS_TAC `{l:real^N->bool | l IN d /\ k SUBSET l}` THEN
2650       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
2651       ASM SET_TAC[]];
2652     ALL_TAC] THEN
2653   DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
2654   EXISTS_TAC
2655    `{k:real^N->bool | k IN d /\ !k'. k' IN d /\ ~(k = k')
2656                                      ==> ~(k SUBSET k')}` THEN
2657   ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
2658    [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN
2659     ASM_REWRITE_TAC[] THEN SET_TAC[];
2660     ASM SET_TAC[];
2661     ALL_TAC] THEN
2662   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2663    (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
2664   GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN
2665   MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN
2666   REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
2667   MP_TAC(ISPEC `\k l:real^N->bool. k IN d /\ l IN d /\ l SUBSET k /\ ~(k = l)`
2668      WF_FINITE) THEN
2669   REWRITE_TAC[WF] THEN ANTS_TAC THENL
2670    [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN
2671     ASM_CASES_TAC `(l:real^N->bool) IN d` THEN
2672     ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES] THEN
2673     MATCH_MP_TAC FINITE_SUBSET THEN
2674     EXISTS_TAC `{m:real^N->bool | m IN d /\ l SUBSET m}` THEN
2675     ASM_SIMP_TAC[] THEN SET_TAC[];
2676     ALL_TAC] THEN
2677   DISCH_THEN(MP_TAC o SPEC `\l:real^N->bool. l IN d /\ x IN l`) THEN
2678   REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2679   MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);;
2680
2681 let COUNTABLE_ELEMENTARY_DIVISION = prove
2682  (`!d. COUNTABLE d /\ (!k. k IN d ==> ?a b:real^N. k = interval[a,b])
2683        ==> ?d'. COUNTABLE d' /\
2684                 (!k. k IN d' ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\
2685                 (!k l. k IN d' /\ l IN d' /\ ~(k = l)
2686                        ==> interior k INTER interior l = {}) /\
2687                 UNIONS d' = UNIONS d`,
2688   let lemma = prove
2689    (`!s. UNIONS(s DELETE {}) = UNIONS s`,
2690     REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN
2691     MESON_TAC[NOT_IN_EMPTY]) in
2692   REWRITE_TAC[IMP_CONJ; FORALL_COUNTABLE_AS_IMAGE] THEN
2693   REWRITE_TAC[UNIONS_0; EMPTY_UNIONS] THEN CONJ_TAC THENL
2694    [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN
2695     REWRITE_TAC[NOT_IN_EMPTY; COUNTABLE_EMPTY];
2696     ALL_TAC] THEN
2697   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
2698   MAP_EVERY X_GEN_TAC
2699    [`d:num->real^N->bool`; `a:num->real^N`; `b:num->real^N`] THEN
2700   DISCH_TAC THEN
2701   (CHOOSE_THEN MP_TAC o prove_recursive_functions_exist num_RECURSION)
2702    `x 0 = ({}:(real^N->bool)->bool) /\
2703     (!n. x(SUC n) = @q. (x n) SUBSET q /\
2704                         q division_of (d n) UNION UNIONS(x n))` THEN
2705   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
2706   SUBGOAL_THEN
2707    `!n:num. (x n) division_of UNIONS {d k:real^N->bool | k < n}`
2708   ASSUME_TAC THENL
2709    [INDUCT_TAC THEN
2710     ASM_REWRITE_TAC[LT; SET_RULE `UNIONS {f x |x| F} = {}`;
2711                     DIVISION_OF_TRIVIAL] THEN
2712     FIRST_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o
2713       MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o
2714       MATCH_MP DIVISION_OF_UNION_SELF) THEN
2715     DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN
2716     REWRITE_TAC[SET_RULE `{f x | x = a \/ q x} = f a INSERT {f x | q x}`] THEN
2717     REWRITE_TAC[UNIONS_INSERT] THEN
2718     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN
2719     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM o last o CONJUNCTS) THEN
2720     ASM_REWRITE_TAC[];
2721     ALL_TAC] THEN
2722   SUBGOAL_THEN
2723    `!m n. m <= n ==> (x:num->(real^N->bool)->bool) m SUBSET x n`
2724   ASSUME_TAC THENL
2725    [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
2726     REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN
2727     ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
2728     FIRST_X_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o
2729       MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o
2730       MATCH_MP DIVISION_OF_UNION_SELF o SPEC `n:num`) THEN
2731     DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[];
2732     ALL_TAC] THEN
2733   EXISTS_TAC `UNIONS(IMAGE x (:num)) DELETE ({}:real^N->bool)` THEN
2734   REWRITE_TAC[COUNTABLE_DELETE; IMP_CONJ; RIGHT_FORALL_IMP_THM;
2735               FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV] THEN
2736   REPEAT CONJ_TAC THENL
2737    [MATCH_MP_TAC COUNTABLE_UNIONS THEN
2738     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN
2739     GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN
2740     ASM_MESON_TAC[DIVISION_OF_FINITE];
2741     MAP_EVERY X_GEN_TAC [`n:num`; `k:real^N->bool`] THEN
2742     ASM_MESON_TAC[division_of];
2743     REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
2744     GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
2745     MATCH_MP_TAC WLOG_LE THEN
2746     CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN
2747     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
2748     MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
2749     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
2750     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2751     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o
2752       SPEC `n:num`) THEN ASM SET_TAC[];
2753     REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
2754     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV;
2755                 FORALL_IN_UNIONS; SUBSET; IN_UNIONS; EXISTS_IN_IMAGE]
2756     THENL
2757      [X_GEN_TAC `k:real^N->bool` THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
2758       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2759       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o
2760          SPEC `n:num`) THEN
2761       DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN ASM SET_TAC[];
2762       MAP_EVERY X_GEN_TAC [`n:num`; `y:real^N`] THEN DISCH_TAC THEN
2763       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o
2764          SPEC `SUC n`) THEN
2765       DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
2766       REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC] THEN
2767       DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
2768       ASM_MESON_TAC[ARITH_RULE `n < SUC n`]]]);;
2769
2770 let EXPAND_CLOSED_OPEN_INTERVAL = prove
2771  (`!a b:real^N e.
2772         &0 < e
2773         ==> ?c d. interval[a,b] SUBSET interval(c,d) /\
2774                   measure(interval(c,d)) <= measure(interval[a,b]) + e`,
2775   let lemma = prove
2776    (`!f n. (\x. lift(product(1..n) (\i. f i + drop x))) continuous at (vec 0)`,
2777     GEN_TAC THEN INDUCT_TAC THEN
2778     REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH_EQ; CONTINUOUS_CONST] THEN
2779     REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN
2780     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN
2781     MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[] THEN
2782     REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP] THEN
2783     SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_CONST]) in
2784   REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
2785   POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `m:real^N` THEN
2786   REWRITE_TAC[midpoint; VECTOR_ARITH
2787    `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
2788   REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN
2789   DISCH_TAC THEN ASM_CASES_TAC `interval[--b:real^N,b] = {}` THENL
2790    [MAP_EVERY EXISTS_TAC [`--b:real^N`; `b:real^N`] THEN
2791     REWRITE_TAC[MEASURE_INTERVAL] THEN
2792     ASM_REWRITE_TAC[CONTENT_EMPTY; EMPTY_SUBSET] THEN ASM_REAL_ARITH_TAC;
2793     ALL_TAC] THEN
2794   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN
2795   REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= x <=> &0 <= x`] THEN
2796   DISCH_TAC THEN
2797   MP_TAC(ISPECL [`\i. &2 * (b:real^N)$i`; `dimindex(:N)`] lemma) THEN
2798   REWRITE_TAC[continuous_at; DIST_LIFT; FORALL_LIFT; DIST_0; DROP_VEC] THEN
2799   REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ADD_RID] THEN
2800   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
2801   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
2802   MAP_EVERY EXISTS_TAC
2803    [`--(b + k / &4 % vec 1:real^N)`; `b + k / &4 % vec 1:real^N`] THEN
2804   REWRITE_TAC[MEASURE_INTERVAL; SUBSET_INTERVAL;
2805               CONTENT_CLOSED_INTERVAL_CASES] THEN
2806   REWRITE_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
2807               VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
2808   ASM_SIMP_TAC[REAL_ARITH `--x <= x <=> &0 <= x`; REAL_LT_ADDR;
2809                REAL_ARITH `&0 < k / &4 <=> &0 < k`;
2810                REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < b`;
2811                REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < --b`;
2812                REAL_ARITH `&0 <= b /\ &0 < k ==> &0 <= b + k`] THEN
2813   REWRITE_TAC[REAL_ARITH `b - --b = &2 * b`; REAL_ADD_LDISTRIB] THEN
2814   MATCH_MP_TAC(REAL_ARITH `abs(a - b) < e ==> a <= b + e`) THEN
2815   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);;
2816
2817 (* ------------------------------------------------------------------------- *)
2818 (* Outer and inner approximation of measurable set by well-behaved sets.     *)
2819 (* ------------------------------------------------------------------------- *)
2820
2821 let MEASURABLE_OUTER_INTERVALS_BOUNDED = prove
2822  (`!s a b:real^N e.
2823         measurable s /\ s SUBSET interval[a,b] /\ &0 < e
2824         ==> ?d. COUNTABLE d /\
2825                 (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\
2826                                 (?c d. k = interval[c,d])) /\
2827                 (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
2828                          ==> interior k1 INTER interior k2 = {}) /\
2829                 (!u v. interval[u,v] IN d
2830                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2831                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2832                 (!k. k IN d /\ ~(interval(a,b) = {}) ==> ~(interior k = {})) /\
2833                 s SUBSET UNIONS d /\
2834                 measurable (UNIONS d) /\
2835                 measure (UNIONS d) <= measure s + e`,
2836   let lemma = prove
2837    (`(!x y. (x,y) IN IMAGE (\z. f z,g z) s ==> P x y) <=>
2838      (!z. z IN s ==> P (f z) (g z))`,
2839   REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN MESON_TAC[]) in
2840   REPEAT GEN_TAC THEN
2841   ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
2842    [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN
2843     EXISTS_TAC `{}:(real^N->bool)->bool` THEN
2844     ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0; MEASURE_EMPTY; REAL_ADD_LID;
2845                     SUBSET_REFL; COUNTABLE_EMPTY; MEASURABLE_EMPTY] THEN
2846     ASM_SIMP_TAC[REAL_LT_IMP_LE];
2847     ALL_TAC] THEN
2848   STRIP_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN
2849   ASM_REWRITE_TAC[] THENL
2850    [EXISTS_TAC `{interval[a:real^N,b]}` THEN
2851     REWRITE_TAC[UNIONS_1; COUNTABLE_SING] THEN
2852     ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT;
2853                     NOT_IN_EMPTY; SUBSET_REFL; MEASURABLE_INTERVAL] THEN
2854     CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
2855      [ASM_REWRITE_TAC[IN_SING; EQ_INTERVAL] THEN
2856       REPEAT STRIP_TAC THEN EXISTS_TAC `0` THEN
2857       ASM_REWRITE_TAC[real_pow; REAL_DIV_1];
2858       SUBGOAL_THEN
2859        `measure(interval[a:real^N,b]) = &0 /\ measure(s:real^N->bool) = &0`
2860        (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE; REAL_ADD_LID]) THEN
2861       SUBGOAL_THEN
2862         `interval[a:real^N,b] has_measure &0 /\
2863          (s:real^N->bool) has_measure &0`
2864         (fun th -> MESON_TAC[th; MEASURE_UNIQUE]) THEN
2865       REWRITE_TAC[HAS_MEASURE_0] THEN
2866       MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2867        [ASM_REWRITE_TAC[NEGLIGIBLE_INTERVAL];
2868         ASM_MESON_TAC[NEGLIGIBLE_SUBSET]]];
2869     ALL_TAC] THEN
2870   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN
2871   DISCH_THEN(X_CHOOSE_TAC `m:real`) THEN
2872   FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_UNIQUE) THEN
2873   SUBGOAL_THEN
2874    `((\x:real^N. if x IN s then vec 1 else vec 0) has_integral (lift m))
2875     (interval[a,b])`
2876   ASSUME_TAC THENL
2877    [ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
2878     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE]) THEN
2879     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN
2880     ASM SET_TAC[];
2881     ALL_TAC] THEN
2882   FIRST_ASSUM(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN
2883   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN
2884   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
2885   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN
2886   MP_TAC(SPECL [`a:real^N`; `b:real^N`; `s:real^N->bool`;
2887                 `g:real^N->real^N->bool`] COVERING_LEMMA) THEN
2888   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
2889   X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2890   CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_EMPTY]; ALL_TAC] THEN
2891   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
2892   MP_TAC(ISPECL [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`;
2893                  `a:real^N`; `b:real^N`; `g:real^N->real^N->bool`;
2894                  `e:real`]
2895                 HENSTOCK_LEMMA_PART1) THEN
2896   ASM_REWRITE_TAC[] THEN
2897   FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN
2898   ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN
2899   SUBGOAL_THEN
2900    `!k l:real^N->bool. k IN d /\ l IN d /\ ~(k = l)
2901                        ==> negligible(k INTER l)`
2902   ASSUME_TAC THENL
2903    [REPEAT STRIP_TAC THEN
2904     FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`]) THEN
2905     ASM_SIMP_TAC[] THEN
2906     SUBGOAL_THEN
2907      `?x y:real^N u v:real^N. k = interval[x,y] /\ l = interval[u,v]`
2908     MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
2909     DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
2910     REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN
2911     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2912     EXISTS_TAC `(interval[x:real^N,y] DIFF interval(x,y)) UNION
2913                 (interval[u:real^N,v] DIFF interval(u,v)) UNION
2914                 (interval (x,y) INTER interval (u,v))` THEN
2915     CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
2916     ASM_REWRITE_TAC[UNION_EMPTY] THEN
2917     SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_FRONTIER_INTERVAL];
2918     ALL_TAC] THEN
2919   SUBGOAL_THEN
2920    `!D. FINITE D /\ D SUBSET d
2921          ==> measurable(UNIONS D :real^N->bool) /\ measure(UNIONS D) <= m + e`
2922   ASSUME_TAC THENL
2923    [GEN_TAC THEN STRIP_TAC THEN
2924     SUBGOAL_THEN
2925      `?t:(real^N->bool)->real^N. !k. k IN D ==> t(k) IN (s INTER k) /\
2926                                                 k SUBSET (g(t k))`
2927     (CHOOSE_THEN (LABEL_TAC "+")) THENL
2928      [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN
2929     REMOVE_THEN "*" (MP_TAC o SPEC
2930      `IMAGE (\k. (t:(real^N->bool)->real^N) k,k) D`) THEN
2931     ASM_SIMP_TAC[VSUM_IMAGE; PAIR_EQ] THEN REWRITE_TAC[o_DEF] THEN
2932     ANTS_TAC THENL
2933      [REWRITE_TAC[tagged_partial_division_of; fine] THEN
2934       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
2935       REWRITE_TAC[lemma; RIGHT_FORALL_IMP_THM; IMP_CONJ; PAIR_EQ] THEN
2936       ASM_SIMP_TAC[] THEN
2937       CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET]];
2938       ALL_TAC] THEN
2939     USE_THEN "+" (MP_TAC o REWRITE_RULE[IN_INTER]) THEN
2940     SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
2941     ASM_SIMP_TAC[VSUM_SUB] THEN
2942     SUBGOAL_THEN `D division_of (UNIONS D:real^N->bool)` ASSUME_TAC THENL
2943      [REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN
2944     FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_ELEMENTARY) THEN
2945     SUBGOAL_THEN `vsum D (\k:real^N->bool. content k % vec 1) =
2946                   lift(measure(UNIONS D))`
2947     SUBST1_TAC THENL
2948      [ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN
2949       ASM_SIMP_TAC[LIFT_DROP; DROP_VSUM; o_DEF; DROP_CMUL; DROP_VEC] THEN
2950       SIMP_TAC[REAL_MUL_RID; ETA_AX] THEN ASM_MESON_TAC[MEASURE_ELEMENTARY];
2951       ALL_TAC] THEN
2952     SUBGOAL_THEN
2953      `vsum D (\k. integral k (\x:real^N. if x IN s then vec 1 else vec 0)) =
2954       lift(sum D (\k. measure(k INTER s)))`
2955     SUBST1_TAC THENL
2956      [ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN
2957       X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
2958       SUBGOAL_THEN `measurable(k:real^N->bool)` ASSUME_TAC THENL
2959        [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN
2960       ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE_UNIV; MEASURABLE_INTER] THEN
2961       REWRITE_TAC[MESON[IN_INTER]
2962         `(if x IN k INTER s then a else b) =
2963          (if x IN k then if x IN s then a else b else b)`] THEN
2964       REWRITE_TAC[INTEGRAL_RESTRICT_UNIV];
2965       ALL_TAC] THEN
2966     ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
2967     MATCH_MP_TAC(REAL_ARITH `y <= m ==> abs(x - y) <= e ==> x <= m + e`) THEN
2968     MATCH_MP_TAC REAL_LE_TRANS THEN
2969     EXISTS_TAC `measure(UNIONS D INTER s:real^N->bool)` THEN
2970     CONJ_TAC THENL
2971      [ALL_TAC;
2972       EXPAND_TAC "m" THEN MATCH_MP_TAC MEASURE_SUBSET THEN
2973       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
2974       MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[]] THEN
2975     REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
2976     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN
2977     MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
2978     ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL
2979      [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_INTER];
2980       ALL_TAC] THEN
2981     MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
2982     STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2983     EXISTS_TAC `k INTER l:real^N->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[];
2984     ALL_TAC] THEN
2985   ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
2986    [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
2987   MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
2988   ASM_REWRITE_TAC[INFINITE] THEN
2989   DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
2990    (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
2991   MP_TAC(ISPECL [`s:num->real^N->bool`; `m + e:real`]
2992     HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
2993   MATCH_MP_TAC(TAUT `a /\ (a /\ b ==> c) ==> (a ==> b) ==> c`) THEN
2994   REWRITE_TAC[GSYM CONJ_ASSOC] THEN
2995   RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
2996                               FORALL_IN_IMAGE; IN_UNIV]) THEN
2997   RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
2998   REPEAT CONJ_TAC THENL
2999    [ASM_MESON_TAC[MEASURABLE_INTERVAL; MEASURABLE_INTER];
3000     ASM_MESON_TAC[];
3001     X_GEN_TAC `n:num` THEN
3002     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (s:num->real^N->bool) (0..n)`) THEN
3003     SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_SUBSET; SUBSET_UNIV] THEN
3004     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3005     MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= e ==> y <= e`) THEN
3006     MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
3007     ASM_MESON_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL];
3008     ALL_TAC] THEN
3009   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
3010   GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN
3011   REWRITE_TAC[drop] THEN
3012   MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_UBOUND) THEN
3013   EXISTS_TAC
3014    `\n. vsum(from 0 INTER (0..n)) (\n. lift(measure(s n:real^N->bool)))` THEN
3015   ASM_REWRITE_TAC[GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
3016   REWRITE_TAC[DIMINDEX_1; ARITH; EVENTUALLY_SEQUENTIALLY] THEN
3017   SIMP_TAC[VSUM_COMPONENT; ARITH; DIMINDEX_1] THEN
3018   ASM_REWRITE_TAC[GSYM drop; LIFT_DROP; FROM_INTER_NUMSEG]);;
3019
3020 let MEASURABLE_OUTER_CLOSED_INTERVALS = prove
3021  (`!s:real^N->bool e.
3022         measurable s /\ &0 < e
3023         ==> ?d. COUNTABLE d /\
3024                 (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval[a,b])) /\
3025                 (!k l. k IN d /\ l IN d /\ ~(k = l)
3026                        ==> interior k INTER interior l = {}) /\
3027                 s SUBSET UNIONS d /\
3028                 measurable (UNIONS d) /\
3029                 measure (UNIONS d) <= measure s + e`,
3030   let lemma = prove
3031    (`UNIONS (UNIONS {d n | n IN (:num)}) =
3032      UNIONS {UNIONS(d n) | n IN (:num)}`,
3033     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN
3034     GEN_REWRITE_TAC I [EXTENSION] THEN
3035     REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]) in
3036   REPEAT STRIP_TAC THEN
3037   SUBGOAL_THEN
3038    `?d. COUNTABLE d /\
3039         (!k. k IN d ==> ?a b:real^N. k = interval[a,b]) /\
3040         s SUBSET UNIONS d /\
3041         measurable (UNIONS d) /\
3042         measure (UNIONS d) <= measure s + e`
3043   MP_TAC THENL
3044    [ALL_TAC;
3045     DISCH_THEN(X_CHOOSE_THEN `d1:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3046     MP_TAC(ISPEC `d1:(real^N->bool)->bool` COUNTABLE_ELEMENTARY_DIVISION) THEN
3047     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
3048     X_GEN_TAC `d:(real^N->bool)->bool` THEN
3049     STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
3050     ASM_REWRITE_TAC[]] THEN
3051   MP_TAC(ISPECL
3052    [`\n. s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`;
3053     `measure(s:real^N->bool)`] HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
3054   ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN
3055   SUBGOAL_THEN
3056    `!m n. ~(m = n)
3057           ==> (s INTER (ball(vec 0,&m + &1) DIFF ball(vec 0,&m))) INTER
3058               (s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n))) =
3059               ({}:real^N->bool)`
3060   ASSUME_TAC THENL
3061    [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN
3062     CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN
3063     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN
3064     MATCH_MP_TAC(SET_RULE
3065      `m1 SUBSET n
3066       ==> (s INTER (m1 DIFF m)) INTER (s INTER (n1 DIFF n)) = {}`) THEN
3067     MATCH_MP_TAC SUBSET_BALL THEN
3068     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC;
3069     ALL_TAC] THEN
3070   ANTS_TAC THENL
3071    [ASM_SIMP_TAC[NEGLIGIBLE_EMPTY] THEN X_GEN_TAC `n:num` THEN
3072     W(MP_TAC o PART_MATCH (rand o rand)
3073       MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN
3074     ASM_SIMP_TAC[FINITE_NUMSEG; DISJOINT] THEN
3075     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN
3076     DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3077     SIMP_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; FORALL_IN_IMAGE;
3078              RIGHT_FORALL_IMP_THM; IN_INTER] THEN
3079     ASM_SIMP_TAC[MEASURABLE_UNIONS; FINITE_NUMSEG; FORALL_IN_IMAGE;
3080             FINITE_IMAGE; MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL];
3081     ALL_TAC] THEN
3082   SUBGOAL_THEN
3083    `UNIONS {s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n)) | n IN (:num)} =
3084     (s:real^N->bool)`
3085   ASSUME_TAC THENL
3086    [REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_INTER] THEN
3087     X_GEN_TAC `x:real^N` THEN
3088     ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
3089     SUBGOAL_THEN `?n. (x:real^N) IN ball(vec 0,&n)` MP_TAC THENL
3090      [REWRITE_TAC[IN_BALL_0; REAL_ARCH_LT];
3091       GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
3092       DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THENL
3093        [ASM_REWRITE_TAC[IN_BALL_0; GSYM REAL_NOT_LE; NORM_POS_LE];
3094         STRIP_TAC THEN EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_DIFF] THEN
3095         ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN
3096         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
3097     ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN
3098   MP_TAC(MATCH_MP MONO_FORALL (GEN `n:num`
3099    (ISPECL
3100      [`s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`;
3101       `--(vec(n + 1)):real^N`; `vec(n + 1):real^N`;
3102       `e / &2 / &2 pow n`]
3103         MEASURABLE_OUTER_INTERVALS_BOUNDED))) THEN
3104   ANTS_TAC THENL
3105    [ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_LT_POW2] THEN
3106     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN
3107     REWRITE_TAC[SUBSET; IN_INTER; IN_INTERVAL; IN_BALL_0; IN_DIFF; REAL_NOT_LT;
3108       REAL_OF_NUM_ADD; VECTOR_NEG_COMPONENT; VEC_COMPONENT; REAL_BOUNDS_LE] THEN
3109     MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; REAL_LT_IMP_LE];
3110     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN
3111   X_GEN_TAC `d:num->(real^N->bool)->bool` THEN STRIP_TAC THEN
3112   EXISTS_TAC `UNIONS {d n | n IN (:num)} :(real^N->bool)->bool` THEN
3113   REWRITE_TAC[lemma] THEN CONJ_TAC THENL
3114    [MATCH_MP_TAC COUNTABLE_UNIONS THEN
3115     ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
3116     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE];
3117     ALL_TAC] THEN
3118   CONJ_TAC THENL
3119    [REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3120     ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_MESON_TAC[];
3121     ALL_TAC] THEN
3122   CONJ_TAC THENL
3123    [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
3124     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3125     ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IN_UNIONS] THEN
3126     REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[];
3127     ALL_TAC] THEN
3128   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN
3129   X_GEN_TAC `n:num` THEN
3130   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
3131    `sum(0..n) (\k. measure(s INTER (ball(vec 0:real^N,&k + &1) DIFF
3132                                   ball(vec 0,&k))) + e / &2 / &2 pow k)` THEN
3133   ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN
3134   MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
3135    [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o
3136       lhand o snd) THEN
3137     ASM_SIMP_TAC[DISJOINT; FINITE_NUMSEG; MEASURABLE_DIFF; MEASURABLE_INTER;
3138                  MEASURABLE_BALL] THEN
3139     DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3140     ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_NUMSEG;
3141       FINITE_IMAGE; MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_BALL] THEN
3142     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
3143     MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SIMPLE_IMAGE] THEN
3144     MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV];
3145     REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP; LT] THEN
3146     REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3147     REWRITE_TAC[REAL_ARITH `e / &2 * (&1 - x) / (&1 / &2) <= e <=>
3148                             &0 <= e * x`] THEN
3149     MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
3150     MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]);;
3151
3152 let MEASURABLE_OUTER_OPEN_INTERVALS = prove
3153  (`!s:real^N->bool e.
3154         measurable s /\ &0 < e
3155         ==> ?d. COUNTABLE d /\
3156                 (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval(a,b))) /\
3157                 s SUBSET UNIONS d /\
3158                 measurable (UNIONS d) /\
3159                 measure (UNIONS d) <= measure s + e`,
3160   let lemma = prove
3161    (`!s. UNIONS(s DELETE {}) = UNIONS s`,
3162     REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN
3163     MESON_TAC[NOT_IN_EMPTY]) in
3164   REPEAT STRIP_TAC THEN
3165   MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`]
3166     MEASURABLE_OUTER_CLOSED_INTERVALS) THEN
3167   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
3168   X_GEN_TAC `dset:(real^N->bool)->bool` THEN
3169   ASM_CASES_TAC `dset:(real^N->bool)->bool = {}` THENL
3170    [ASM_REWRITE_TAC[UNIONS_0; SUBSET_EMPTY] THEN STRIP_TAC THEN
3171     EXISTS_TAC `{}:(real^N->bool)->bool` THEN
3172     ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY; MEASURE_EMPTY; SUBSET_REFL] THEN
3173     ASM_REAL_ARITH_TAC;
3174     ALL_TAC] THEN
3175   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3176   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3177   SUBGOAL_THEN
3178    `?f. dset = IMAGE (f:num->(real^N->bool)) (:num) DELETE {} /\
3179         (!m n. f m = f n ==> m = n \/ f n = {})`
3180   MP_TAC THENL
3181    [ASM_CASES_TAC `FINITE(dset:(real^N->bool)->bool)` THENL
3182      [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_HAS_SIZE]) THEN
3183       DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_INDEX) THEN
3184       ABBREV_TAC `m = CARD(dset:(real^N->bool)->bool)` THEN
3185       DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
3186       EXISTS_TAC `\i. if i < m then (f:num->real^N->bool) i else {}` THEN
3187       REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
3188       GEN_REWRITE_TAC I [EXTENSION] THEN
3189       REWRITE_TAC[IN_DELETE; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[];
3190       MP_TAC(ISPEC `dset:(real^N->bool)->bool`
3191         COUNTABLE_AS_INJECTIVE_IMAGE) THEN
3192       ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN
3193       GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL
3194        [ALL_TAC; ASM_MESON_TAC[]] THEN
3195       ASM_REWRITE_TAC[SET_RULE `s = s DELETE a <=> ~(a IN s)`] THEN
3196       ASM_MESON_TAC[]];
3197     ALL_TAC] THEN
3198   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3199   X_GEN_TAC `d:num->real^N->bool` THEN
3200   DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN
3201   FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN
3202   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM; SKOLEM_THM;
3203               IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DELETE; lemma] THEN
3204   DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
3205    `(!x. ~(P x) ==> ~(P x) /\ Q x) ==> (!x. P x ==> Q x) ==> !x. Q x`)) THEN
3206   ANTS_TAC THENL [MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN
3207   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3208   MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN
3209   DISCH_TAC THEN DISCH_TAC THEN
3210   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
3211   GEN_REWRITE_TAC I [IMP_CONJ] THEN
3212   DISCH_THEN(MP_TAC o MATCH_MP(MESON[]
3213    `(!x y. ~(P x) /\ ~(P y) /\ ~(f x = f y) ==> Q x y)
3214     ==> (!x y. P x ==> Q x y) /\ (!x y. P y ==> Q x y)
3215         ==> (!x y. ~(f x = f y) ==> Q x y)`)) THEN
3216   SIMP_TAC[INTERIOR_EMPTY; INTER_EMPTY] THEN
3217   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
3218   SUBGOAL_THEN
3219    `?d. COUNTABLE d /\
3220         (!k. k IN d ==> ?a b:real^N. k = interval(a,b)) /\
3221         s SUBSET UNIONS d /\
3222         measurable (UNIONS d) /\
3223         measure (UNIONS d) <= measure s + e`
3224   MP_TAC THENL
3225    [ALL_TAC;
3226     DISCH_THEN(X_CHOOSE_TAC `d:(real^N->bool)->bool`) THEN
3227     EXISTS_TAC `d DELETE ({}:real^N->bool)` THEN
3228     ASM_SIMP_TAC[lemma; COUNTABLE_DELETE; IN_DELETE]] THEN
3229   MP_TAC(GEN `n:num` (ISPECL [`(a:num->real^N) n`; `(b:num->real^N) n`;
3230     `e / &2 pow (n + 2)`] EXPAND_CLOSED_OPEN_INTERVAL)) THEN
3231   ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; SKOLEM_THM] THEN
3232   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
3233   MAP_EVERY X_GEN_TAC [`A:num->real^N`; `B:num->real^N`] THEN STRIP_TAC THEN
3234   EXISTS_TAC `IMAGE (\n. interval(A n:real^N,B n)) (:num)` THEN
3235   SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN
3236   CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
3237   CONJ_TAC THENL
3238    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3239      (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
3240     ASM_REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN
3241     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
3242     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN
3243     ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; IN_UNIV] THEN
3244     ASM SET_TAC[];
3245     ALL_TAC] THEN
3246   ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
3247   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN
3248   REWRITE_TAC[MEASURABLE_INTERVAL] THEN X_GEN_TAC `n:num` THEN
3249   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
3250    `sum(0..n) (\i. measure(interval[a i:real^N,b i]) + e / &2 pow (i + 2))` THEN
3251   ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN
3252   REWRITE_TAC[real_div; REAL_INV_MUL; SUM_LMUL; REAL_POW_ADD; SUM_RMUL] THEN
3253   REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3254   MATCH_MP_TAC(REAL_ARITH
3255    `s <= m + e / &2 /\ &0 <= e * x
3256     ==> s + e * (&1 - x) / (&1 / &2) * &1 / &4 <= m + e`) THEN
3257   ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_LT_IMP_LE;
3258                REAL_LE_DIV; REAL_POS] THEN
3259   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3260    (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN
3261   W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
3262         lhand o snd) THEN
3263   REWRITE_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL] THEN ANTS_TAC THENL
3264    [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
3265     ASM_CASES_TAC `interval[(a:num->real^N) i,b i] = interval[a j,b j]` THENL
3266      [UNDISCH_TAC
3267        `!m n. (d:num->real^N->bool) m = d n ==> m = n \/ d n = {}` THEN
3268       DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN
3269       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY];
3270       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE
3271        (BINDER_CONV o BINDER_CONV o RAND_CONV o LAND_CONV)
3272        [GSYM INTERIOR_INTER]) THEN
3273       DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN
3274       ASM_REWRITE_TAC[] THEN
3275       REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN
3276       SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN
3277       MATCH_MP_TAC(MESON[MEASURE_EMPTY]
3278        `measure(interior s) = measure s
3279         ==> interior s = {} ==> measure s = &0`) THEN
3280       MATCH_MP_TAC MEASURE_INTERIOR THEN
3281       SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL; NEGLIGIBLE_CONVEX_FRONTIER;
3282                CONVEX_INTER; CONVEX_INTERVAL]];
3283     DISCH_THEN(SUBST1_TAC o SYM)] THEN
3284   MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL
3285    [MATCH_MP_TAC MEASURABLE_UNIONS THEN
3286     SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL;
3287              FINITE_NUMSEG];
3288     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_UNIONS THEN
3289     ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
3290     ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]]);;
3291
3292 let MEASURABLE_OUTER_OPEN = prove
3293  (`!s:real^N->bool e.
3294         measurable s /\ &0 < e
3295         ==> ?t. open t /\ s SUBSET t /\
3296                 measurable t /\ measure t < measure s + e`,
3297   REPEAT STRIP_TAC THEN
3298   MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`]
3299     MEASURABLE_OUTER_OPEN_INTERVALS) THEN
3300   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
3301   X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN
3302   EXISTS_TAC `UNIONS d :real^N->bool` THEN
3303   ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ m <= s + e / &2 ==> m < s + e`] THEN
3304   MATCH_MP_TAC OPEN_UNIONS THEN ASM_MESON_TAC[OPEN_INTERVAL]);;
3305
3306 let MEASURABLE_INNER_COMPACT = prove
3307  (`!s:real^N->bool e.
3308         measurable s /\ &0 < e
3309         ==> ?t. compact t /\ t SUBSET s /\
3310                 measurable t /\ measure s < measure t + e`,
3311   REPEAT STRIP_TAC THEN
3312   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN
3313   GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN
3314   DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN
3315   ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN
3316   DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3317   MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3318   REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
3319   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3320   DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3321   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3322   X_GEN_TAC `z:real` THEN STRIP_TAC THEN
3323   MP_TAC(ISPECL  [`interval[a:real^N,b] DIFF s`; `e/ &4`]
3324         MEASURABLE_OUTER_OPEN) THEN
3325   ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL;
3326                REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN
3327   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
3328   EXISTS_TAC `interval[a:real^N,b] DIFF t` THEN REPEAT CONJ_TAC THENL
3329    [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
3330     ASM_SIMP_TAC[CLOSED_DIFF; CLOSED_INTERVAL; BOUNDED_DIFF; BOUNDED_INTERVAL];
3331     ASM SET_TAC[];
3332     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL];
3333     MATCH_MP_TAC(REAL_ARITH
3334         `&0 < e /\
3335          measure(s) < measure(interval[a,b] INTER s) + e / &4 /\
3336          measure(t) < measure(interval[a,b] DIFF s) + e / &4 /\
3337          measure(interval[a,b] INTER s) +
3338          measure(interval[a,b] DIFF s) = measure(interval[a,b]) /\
3339          measure(interval[a,b] INTER t) +
3340          measure(interval[a,b] DIFF t) = measure(interval[a,b]) /\
3341          measure(interval[a,b] INTER t) <= measure t
3342          ==> measure s < measure(interval[a,b] DIFF t) + e`) THEN
3343     ASM_SIMP_TAC[MEASURE_SUBSET; INTER_SUBSET; MEASURABLE_INTER;
3344                  MEASURABLE_INTERVAL] THEN
3345     CONJ_TAC THENL
3346      [FIRST_ASSUM(SUBST_ALL_TAC o SYM o MATCH_MP MEASURE_UNIQUE) THEN
3347       ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REAL_ARITH_TAC;
3348       CONJ_TAC THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION_EQ THEN
3349       ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN
3350       SET_TAC[]]]);;
3351
3352 let OPEN_MEASURABLE_INNER_DIVISION = prove
3353  (`!s:real^N->bool e.
3354         open s /\ measurable s /\ &0 < e
3355         ==> ?D. D division_of UNIONS D /\
3356                 UNIONS D SUBSET s /\
3357                 measure s < measure(UNIONS D) + e`,
3358   REPEAT STRIP_TAC THEN
3359   MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN
3360   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
3361   X_GEN_TAC `B:real` THEN STRIP_TAC THEN
3362   MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3363   ASM_REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
3364   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3365   FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3366   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3367   MP_TAC(ISPEC `s INTER interval(a - vec 1:real^N,b + vec 1)`
3368         OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN
3369   ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; SUBSET_INTER] THEN
3370   DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3371   MP_TAC(ISPECL [`D:(real^N->bool)->bool`; `measure(s:real^N->bool)`;
3372                  `e / &2`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN
3373   ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL
3374    [CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
3375     REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
3376     EXISTS_TAC `measure(UNIONS D :real^N->bool)` THEN CONJ_TAC THENL
3377      [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
3378        [MATCH_MP_TAC MEASURABLE_UNIONS THEN
3379         ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
3380         ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL];
3381         ASM_SIMP_TAC[SUBSET_UNIONS]];
3382       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3383       ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET]];
3384     DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3385     MP_TAC(ISPEC `d:(real^N->bool)->bool` ELEMENTARY_UNIONS_INTERVALS) THEN
3386     ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET]; ALL_TAC] THEN
3387     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:(real^N->bool)->bool` THEN
3388     DISCH_TAC THEN
3389     SUBGOAL_THEN `UNIONS p :real^N->bool = UNIONS d` SUBST1_TAC THENL
3390      [ASM_MESON_TAC[division_of]; ALL_TAC] THEN
3391     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3392      [MATCH_MP_TAC SUBSET_TRANS THEN
3393       EXISTS_TAC `UNIONS D :real^N->bool` THEN
3394       ASM_SIMP_TAC[SUBSET_UNIONS; INTER_SUBSET];
3395       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3396        `ms' - e / &2 < mud ==> ms < ms' + e / &2 ==> ms < mud + e`)) THEN
3397       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3398        `abs(sc - s) < e / &2
3399         ==> sc <= so /\ sc <= s ==> s < so + e / &2`)) THEN
3400       CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3401       ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET] THEN
3402       MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN
3403       REWRITE_TAC[SUBSET_INTERVAL; VECTOR_SUB_COMPONENT; VEC_COMPONENT;
3404                   VECTOR_ADD_COMPONENT] THEN
3405       MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
3406       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]]);;
3407
3408 (* ------------------------------------------------------------------------- *)
3409 (* Hence for linear transformation, suffices to check compact intervals.     *)
3410 (* ------------------------------------------------------------------------- *)
3411
3412 let MEASURABLE_LINEAR_IMAGE_INTERVAL = prove
3413  (`!f a b. linear f ==> measurable(IMAGE f (interval[a,b]))`,
3414   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL
3415    [MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN
3416     ASM_MESON_TAC[CONVEX_INTERVAL];
3417     MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
3418     ASM_MESON_TAC[BOUNDED_INTERVAL]]);;
3419
3420 let HAS_MEASURE_LINEAR_SUFFICIENT = prove
3421  (`!f:real^N->real^N m.
3422         linear f /\
3423         (!a b. IMAGE f (interval[a,b]) has_measure
3424                (m * measure(interval[a,b])))
3425         ==> !s. measurable s ==> (IMAGE f s) has_measure (m * measure s)`,
3426   REPEAT GEN_TAC THEN STRIP_TAC THEN
3427   DISJ_CASES_TAC(REAL_ARITH `m < &0 \/ &0 <= m`) THENL
3428    [FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN
3429     DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_POS_LE) THEN
3430     MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN
3431     MATCH_MP_TAC(REAL_ARITH `&0 < --m * x ==> ~(&0 <= m * x)`) THEN
3432     MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_NEG_GT0] THEN
3433     REWRITE_TAC[MEASURE_INTERVAL] THEN MATCH_MP_TAC CONTENT_POS_LT THEN
3434     SIMP_TAC[VEC_COMPONENT; REAL_LT_01];
3435     ALL_TAC] THEN
3436   ASM_CASES_TAC `!x y. (f:real^N->real^N) x = f y ==> x = y` THENL
3437    [ALL_TAC;
3438     SUBGOAL_THEN `!s. negligible(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL
3439      [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; ALL_TAC] THEN
3440     SUBGOAL_THEN `m * measure(interval[vec 0:real^N,vec 1]) = &0` MP_TAC THENL
3441      [MATCH_MP_TAC(ISPEC `IMAGE (f:real^N->real^N) (interval[vec 0,vec 1])`
3442         HAS_MEASURE_UNIQUE) THEN
3443       ASM_REWRITE_TAC[HAS_MEASURE_0];
3444       REWRITE_TAC[REAL_ENTIRE; MEASURE_INTERVAL] THEN
3445       MATCH_MP_TAC(TAUT `~b /\ (a ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
3446        [SIMP_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL;
3447                  INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01];
3448         ASM_SIMP_TAC[REAL_MUL_LZERO; HAS_MEASURE_0]]]] THEN
3449   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_ISOMORPHISM) THEN
3450   ASM_REWRITE_TAC[] THEN
3451   DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN
3452   UNDISCH_THEN `!x y. (f:real^N->real^N) x = f y ==> x = y` (K ALL_TAC) THEN
3453   SUBGOAL_THEN
3454    `!s. bounded s /\ measurable s
3455         ==> (IMAGE (f:real^N->real^N) s) has_measure (m * measure s)`
3456   ASSUME_TAC THENL
3457    [REPEAT STRIP_TAC THEN
3458     FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3459     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3460     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3461     SUBGOAL_THEN
3462      `!d. COUNTABLE d /\
3463           (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\
3464                           (?c d. k = interval[c,d])) /\
3465           (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
3466                    ==> interior k1 INTER interior k2 = {})
3467           ==> IMAGE (f:real^N->real^N) (UNIONS d) has_measure
3468                     (m * measure(UNIONS d))`
3469     ASSUME_TAC THENL
3470      [REWRITE_TAC[IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN
3471       SUBGOAL_THEN
3472        `!g:real^N->real^N.
3473           linear g
3474           ==> !k l. k IN d /\ l IN d /\ ~(k = l)
3475                     ==> negligible((IMAGE g k) INTER (IMAGE g l))`
3476       MP_TAC THENL
3477        [REPEAT STRIP_TAC THEN
3478         ASM_CASES_TAC `!x y. (g:real^N->real^N) x = g y ==> x = y` THENL
3479          [ALL_TAC;
3480           ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE;
3481                         NEGLIGIBLE_INTER]] THEN
3482         MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3483         EXISTS_TAC `frontier(IMAGE (g:real^N->real^N) k INTER IMAGE g l) UNION
3484                     interior(IMAGE g k INTER IMAGE g l)` THEN
3485         CONJ_TAC THENL
3486          [ALL_TAC;
3487           REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
3488            `s SUBSET t ==> s SUBSET (t DIFF u) UNION u`) THEN
3489           REWRITE_TAC[CLOSURE_SUBSET]] THEN
3490         MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THENL
3491          [MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN
3492           MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THEN
3493           MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL];
3494           ALL_TAC] THEN
3495         REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3496         EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k) INTER
3497                     IMAGE g (interior l)` THEN
3498         CONJ_TAC THENL
3499          [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3500           EXISTS_TAC
3501            `IMAGE (g:real^N->real^N) (interior k INTER interior l)` THEN
3502           CONJ_TAC THENL
3503            [ASM_SIMP_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]; ASM SET_TAC[]];
3504           MATCH_MP_TAC(SET_RULE
3505            `s SUBSET u /\ t SUBSET v ==> (s INTER t) SUBSET (u INTER v)`) THEN
3506           CONJ_TAC THEN MATCH_MP_TAC INTERIOR_IMAGE_SUBSET THEN
3507           ASM_MESON_TAC[LINEAR_CONTINUOUS_AT]];
3508         ALL_TAC] THEN
3509       DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^N->real^N` th) THEN
3510           MP_TAC(SPEC `\x:real^N. x` th)) THEN
3511       ASM_REWRITE_TAC[LINEAR_ID; SET_RULE `IMAGE (\x. x) s = s`] THEN
3512       REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
3513        [MP_TAC(ISPECL [`IMAGE (f:real^N->real^N)`; `d:(real^N->bool)->bool`]
3514                   HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
3515         ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
3516         MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3517         MATCH_MP_TAC EQ_TRANS THEN
3518         EXISTS_TAC `sum d (\k:real^N->bool. m * measure k)` THEN CONJ_TAC THENL
3519          [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN
3520         REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN
3521         CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS THEN
3522         ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN
3523         ASM_MESON_TAC[MEASURABLE_INTERVAL];
3524         ALL_TAC] THEN
3525       MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
3526       ASM_REWRITE_TAC[INFINITE] THEN
3527       DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
3528        (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
3529       MP_TAC(ISPEC `s:num->real^N->bool`
3530         HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
3531       MP_TAC(ISPEC `\n:num. IMAGE (f:real^N->real^N) (s n)`
3532         HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
3533       RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
3534                                   FORALL_IN_IMAGE; IN_UNIV]) THEN
3535       RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
3536       ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ANTS_TAC THENL
3537        [REPEAT CONJ_TAC THENL
3538          [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_INTERVAL];
3539           ASM_MESON_TAC[];
3540           ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3541           REWRITE_TAC[GSYM IMAGE_UNIONS; IMAGE_o] THEN
3542           MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN
3543           MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
3544           EXISTS_TAC `interval[a:real^N,b]` THEN
3545           REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
3546         ALL_TAC] THEN
3547       STRIP_TAC THEN ANTS_TAC THENL
3548        [REPEAT CONJ_TAC THENL
3549          [ASM_MESON_TAC[MEASURABLE_INTERVAL];
3550           ASM_MESON_TAC[];
3551           MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
3552           EXISTS_TAC `interval[a:real^N,b]` THEN
3553           REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
3554         ALL_TAC] THEN
3555       STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
3556       SUBGOAL_THEN `m * measure (UNIONS (IMAGE s (:num)):real^N->bool) =
3557              measure(UNIONS (IMAGE (\x. IMAGE f (s x)) (:num)):real^N->bool)`
3558        (fun th -> ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE; th]) THEN
3559       ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN
3560       MATCH_MP_TAC SERIES_UNIQUE THEN
3561       EXISTS_TAC `\n:num. lift(measure(IMAGE (f:real^N->real^N) (s n)))` THEN
3562       EXISTS_TAC `from 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUMS_EQ THEN
3563       EXISTS_TAC `\n:num. m % lift(measure(s n:real^N->bool))` THEN
3564       CONJ_TAC THENL
3565        [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_EQ] THEN
3566         ASM_MESON_TAC[MEASURE_UNIQUE];
3567         REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC SERIES_CMUL THEN
3568         ASM_REWRITE_TAC[]];
3569       ALL_TAC] THEN
3570     REWRITE_TAC[HAS_MEASURE_INNER_OUTER_LE] THEN CONJ_TAC THEN
3571     X_GEN_TAC `e:real` THEN DISCH_TAC THENL
3572      [MP_TAC(ISPECL [`interval[a,b] DIFF s:real^N->bool`; `a:real^N`;
3573        `b:real^N`; `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
3574       ANTS_TAC THENL
3575        [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN
3576         ASM_SIMP_TAC[REAL_ARITH `&0 < &1 + abs x`; REAL_LT_DIV] THEN SET_TAC[];
3577         ALL_TAC] THEN
3578       DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3579       EXISTS_TAC `IMAGE f (interval[a,b]) DIFF
3580                   IMAGE (f:real^N->real^N) (UNIONS d)` THEN
3581       FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
3582       ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_TAC THEN
3583       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
3584        [ASM_MESON_TAC[MEASURABLE_DIFF; measurable]; ALL_TAC] THEN
3585       MATCH_MP_TAC REAL_LE_TRANS THEN
3586       EXISTS_TAC `measure(IMAGE f (interval[a,b])) -
3587                   measure(IMAGE (f:real^N->real^N) (UNIONS d))` THEN
3588       CONJ_TAC THENL
3589        [ALL_TAC;
3590         MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
3591         MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
3592         REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC]) THEN
3593         MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[UNIONS_SUBSET]] THEN
3594       UNDISCH_TAC `!a b. IMAGE (f:real^N->real^N) (interval [a,b])
3595                          has_measure m * measure (interval [a,b])` THEN
3596       DISCH_THEN(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3597       REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE)) THEN
3598       MATCH_MP_TAC REAL_LE_TRANS THEN
3599       EXISTS_TAC `m * measure(s:real^N->bool) - m * e / (&1 + abs m)` THEN
3600       CONJ_TAC THENL
3601        [REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`] THEN
3602         REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
3603         REWRITE_TAC[GSYM real_div] THEN
3604         ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
3605         GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3606         ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC;
3607         ALL_TAC] THEN
3608       REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
3609       ASM_REWRITE_TAC[] THEN
3610       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3611         `d <= a + e ==> a = i - s ==> s - e <= i - d`)) THEN
3612       MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
3613       ASM_REWRITE_TAC[MEASURABLE_INTERVAL];
3614       MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`;
3615                 `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
3616       ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN
3617       DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3618       EXISTS_TAC `IMAGE (f:real^N->real^N) (UNIONS d)` THEN
3619       FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
3620       ASM_SIMP_TAC[IMAGE_SUBSET] THEN
3621       SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN
3622       MATCH_MP_TAC REAL_LE_TRANS THEN
3623       EXISTS_TAC `m * measure(s:real^N->bool) + m * e / (&1 + abs m)` THEN
3624       CONJ_TAC THENL
3625        [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_LMUL];
3626         REWRITE_TAC[REAL_LE_LADD] THEN
3627         REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
3628         REWRITE_TAC[GSYM real_div] THEN
3629         ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
3630         GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3631         ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC]];
3632       ALL_TAC] THEN
3633   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_MEASURE_LIMIT] THEN
3634   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3635   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN
3636   GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN
3637   DISCH_THEN(MP_TAC o SPEC `e / (&1 + abs m)`) THEN
3638   ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN
3639   DISCH_THEN(X_CHOOSE_THEN `B:real`
3640    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN
3641   MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3642   REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
3643   REMOVE_THEN "*" MP_TAC THEN
3644   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N` THEN
3645   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N` THEN
3646   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
3647   DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
3648   MP_TAC(ISPECL [`interval[c:real^N,d]`; `vec 0:real^N`]
3649     BOUNDED_SUBSET_BALL) THEN
3650   REWRITE_TAC[BOUNDED_INTERVAL] THEN
3651   DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN
3652   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_BOUNDED_POS) THEN
3653   ASM_REWRITE_TAC[] THEN
3654   DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
3655
3656   EXISTS_TAC `D * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
3657   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3658   FIRST_X_ASSUM(MP_TAC o SPEC
3659    `s INTER (IMAGE (h:real^N->real^N) (interval[a,b]))`) THEN
3660   SUBGOAL_THEN
3661    `IMAGE (f:real^N->real^N) (s INTER IMAGE h (interval [a,b])) =
3662     (IMAGE f s) INTER interval[a,b]`
3663   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL
3664    [ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
3665     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL];
3666     ALL_TAC] THEN
3667   DISCH_TAC THEN EXISTS_TAC
3668    `m * measure(s INTER (IMAGE (h:real^N->real^N) (interval[a,b])))` THEN
3669   ASM_REWRITE_TAC[] THEN
3670   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `m * e / (&1 + abs m)` THEN
3671   CONJ_TAC THENL
3672    [ALL_TAC;
3673     REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
3674     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
3675     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3676     ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN REAL_ARITH_TAC] THEN
3677   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN
3678   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [real_abs] THEN
3679   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN
3680   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3681    `abs(z - m) < e ==> z <= w /\ w <= m ==> abs(w - m) <= e`)) THEN
3682   SUBST1_TAC(SYM(MATCH_MP MEASURE_UNIQUE
3683    (ASSUME `s INTER interval [c:real^N,d] has_measure z`))) THEN
3684   CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3685   ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL;
3686                MEASURABLE_INTERVAL; INTER_SUBSET] THEN
3687   MATCH_MP_TAC(SET_RULE
3688    `!v. t SUBSET v /\ v SUBSET u ==> s INTER t SUBSET s INTER u`) THEN
3689   EXISTS_TAC `ball(vec 0:real^N,D)` THEN ASM_REWRITE_TAC[] THEN
3690   MATCH_MP_TAC(SET_RULE
3691    `!f. (!x. h(f x) = x) /\ IMAGE f s SUBSET t ==> s SUBSET IMAGE h t`) THEN
3692   EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN
3693   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^N,D * C)` THEN
3694   ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0] THEN
3695   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3696   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `C * norm(x:real^N)` THEN
3697   ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3698   ASM_SIMP_TAC[REAL_LT_LMUL_EQ]);;
3699
3700 (* ------------------------------------------------------------------------- *)
3701 (* Some inductions by expressing mapping in terms of elementary matrices.    *)
3702 (* ------------------------------------------------------------------------- *)
3703
3704 let INDUCT_MATRIX_ROW_OPERATIONS = prove
3705  (`!P:real^N^N->bool.
3706         (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\
3707         (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\
3708                     1 <= j /\ j <= dimindex(:N) /\ ~(i = j)
3709                     ==> A$i$j = &0) ==> P A) /\
3710         (!A m n. P A /\ 1 <= m /\ m <= dimindex(:N) /\
3711                  1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3712                  ==> P(lambda i j. A$i$(swap(m,n) j))) /\
3713         (!A m n c. P A /\ 1 <= m /\ m <= dimindex(:N) /\
3714                    1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3715                    ==> P(lambda i. if i = m then row m A + c % row n A
3716                                    else row i A))
3717         ==> !A. P A`,
3718   GEN_TAC THEN
3719   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "zero_row") MP_TAC) THEN
3720   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "diagonal") MP_TAC) THEN
3721   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "swap_cols") (LABEL_TAC "row_op")) THEN
3722   SUBGOAL_THEN
3723    `!k A:real^N^N.
3724         (!i j. 1 <= i /\ i <= dimindex(:N) /\
3725                k <= j /\ j <= dimindex(:N) /\ ~(i = j)
3726                ==> A$i$j = &0)
3727         ==> P A`
3728    (fun th -> GEN_TAC THEN MATCH_MP_TAC th THEN
3729               EXISTS_TAC `dimindex(:N) + 1` THEN ARITH_TAC) THEN
3730   MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
3731    [REPEAT STRIP_TAC THEN USE_THEN "diagonal" MATCH_MP_TAC THEN
3732     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
3733     ASM_REWRITE_TAC[LE_0];
3734     ALL_TAC] THEN
3735   X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "ind_hyp") THEN
3736   DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC (ARITH_RULE `k = 0 \/ 1 <= k`) THEN
3737   ASM_REWRITE_TAC[ARITH] THEN
3738   ASM_CASES_TAC `k <= dimindex(:N)` THENL
3739    [ALL_TAC;
3740     REPEAT STRIP_TAC THEN REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
3741     ASM_ARITH_TAC] THEN
3742   SUBGOAL_THEN
3743    `!A:real^N^N.
3744         ~(A$k$k = &0) /\
3745         (!i j. 1 <= i /\ i <= dimindex (:N) /\
3746                SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j)
3747                ==> A$i$j = &0)
3748         ==> P A`
3749   (LABEL_TAC "nonzero_hyp") THENL
3750    [ALL_TAC;
3751     X_GEN_TAC `A:real^N^N` THEN DISCH_TAC THEN
3752     ASM_CASES_TAC `row k (A:real^N^N) = vec 0` THENL
3753      [REMOVE_THEN "zero_row" MATCH_MP_TAC THEN ASM_MESON_TAC[];
3754       ALL_TAC] THEN
3755     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
3756     SIMP_TAC[VEC_COMPONENT; row; LAMBDA_BETA] THEN
3757     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
3758     X_GEN_TAC `l:num` THEN STRIP_TAC THEN
3759     ASM_CASES_TAC `l:num = k` THENL
3760      [REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ASM_MESON_TAC[];
3761       ALL_TAC] THEN
3762     REMOVE_THEN "swap_cols" (MP_TAC o SPECL
3763      [`(lambda i j. (A:real^N^N)$i$swap(k,l) j):real^N^N`;
3764       `k:num`; `l:num`]) THEN
3765     ASM_SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL
3766      [ALL_TAC;
3767       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3768       SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
3769       REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
3770       REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])] THEN
3771     REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN
3772     ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= i <=> 1 <= i /\ SUC k <= i`] THEN
3773     ASM_SIMP_TAC[LAMBDA_BETA] THEN
3774     ASM_REWRITE_TAC[swap] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN
3775     STRIP_TAC THEN SUBGOAL_THEN `l:num <= k` ASSUME_TAC THENL
3776      [FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
3777       ASM_REWRITE_TAC[] THEN ARITH_TAC;
3778       ALL_TAC] THEN
3779     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
3780     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3781     ASM_ARITH_TAC] THEN
3782    SUBGOAL_THEN
3783    `!l A:real^N^N.
3784         ~(A$k$k = &0) /\
3785         (!i j. 1 <= i /\ i <= dimindex (:N) /\
3786                SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j)
3787                ==> A$i$j = &0) /\
3788         (!i. l <= i /\ i <= dimindex(:N) /\ ~(i = k) ==> A$i$k = &0)
3789         ==> P A`
3790    MP_TAC THENL
3791     [ALL_TAC;
3792      DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN
3793      REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `~(n + 1 <= i /\ i <= n)`]] THEN
3794    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
3795     [GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3796      DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
3797      USE_THEN "ind_hyp" MATCH_MP_TAC THEN
3798      MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
3799      ASM_CASES_TAC `j:num = k` THENL
3800       [ASM_REWRITE_TAC[] THEN USE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
3801        REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
3802     ALL_TAC] THEN
3803   X_GEN_TAC `l:num` THEN DISCH_THEN(LABEL_TAC "inner_hyp") THEN
3804   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3805   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
3806   ASM_CASES_TAC `l:num = k` THENL
3807    [REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3808     REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
3809     ALL_TAC] THEN
3810   DISJ_CASES_TAC(ARITH_RULE `l = 0 \/ 1 <= l`) THENL
3811    [REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
3812     MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
3813     ASM_CASES_TAC `j:num = k` THENL
3814      [ASM_REWRITE_TAC[] THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
3815       REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
3816     ALL_TAC] THEN
3817   ASM_CASES_TAC `l <= dimindex(:N)` THENL
3818    [ALL_TAC;
3819     REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3820     ASM_ARITH_TAC] THEN
3821   REMOVE_THEN "inner_hyp" (MP_TAC o SPECL
3822    [`(lambda i. if i = l then row l (A:real^N^N) + --(A$l$k/A$k$k) % row k A
3823                 else row i A):real^N^N`]) THEN
3824   ANTS_TAC THENL
3825    [SUBGOAL_THEN `!i. l <= i ==> 1 <= i` ASSUME_TAC THENL
3826      [ASM_ARITH_TAC; ALL_TAC] THEN
3827     ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= j <=> 1 <= j /\ SUC k <= j`] THEN
3828     ASM_SIMP_TAC[LAMBDA_BETA; row; COND_COMPONENT;
3829                  VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3830     ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> x + --(x / y) * y = &0`] THEN
3831     REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN
3832     ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[] THENL
3833      [REPEAT STRIP_TAC THEN
3834       MATCH_MP_TAC(REAL_RING `x = &0 /\ y = &0 ==> x + z * y = &0`) THEN
3835       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
3836       REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC];
3837     ALL_TAC] THEN
3838   DISCH_TAC THEN REMOVE_THEN "row_op" (MP_TAC o SPECL
3839    [`(lambda i. if i = l then row l A + --(A$l$k / A$k$k) % row k A
3840                 else row i (A:real^N^N)):real^N^N`;
3841     `l:num`; `k:num`; `(A:real^N^N)$l$k / A$k$k`]) THEN
3842   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3843   ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3844                VECTOR_MUL_COMPONENT; row; COND_COMPONENT] THEN
3845   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
3846   REAL_ARITH_TAC);;
3847
3848 let INDUCT_MATRIX_ELEMENTARY = prove
3849  (`!P:real^N^N->bool.
3850         (!A B. P A /\ P B ==> P(A ** B)) /\
3851         (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\
3852         (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\
3853                     1 <= j /\ j <= dimindex(:N) /\ ~(i = j)
3854                     ==> A$i$j = &0) ==> P A) /\
3855         (!m n. 1 <= m /\ m <= dimindex(:N) /\
3856                1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3857                ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\
3858         (!m n c. 1 <= m /\ m <= dimindex(:N) /\
3859                  1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3860                  ==> P(lambda i j. if i = m /\ j = n then c
3861                                    else if i = j then &1 else &0))
3862         ==> !A. P A`,
3863   GEN_TAC THEN
3864   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3865   DISCH_THEN(fun th ->
3866     MATCH_MP_TAC INDUCT_MATRIX_ROW_OPERATIONS THEN MP_TAC th) THEN
3867   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN
3868   DISCH_THEN(fun th -> X_GEN_TAC `A:real^N^N` THEN MP_TAC th) THEN
3869   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
3870   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
3871   UNDISCH_TAC `(P:real^N^N->bool) A` THENL
3872    [REWRITE_TAC[GSYM IMP_CONJ]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
3873   DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN
3874   AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
3875   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
3876   X_GEN_TAC `j:num` THEN STRIP_TAC THEN
3877   ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul; row] THENL
3878    [ASM_SIMP_TAC[mat; IN_DIMINDEX_SWAP; LAMBDA_BETA] THEN
3879     ONCE_REWRITE_TAC[COND_RAND] THEN
3880     SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; REAL_MUL_RID] THEN
3881     COND_CASES_TAC THEN REWRITE_TAC[] THEN
3882     RULE_ASSUM_TAC(REWRITE_RULE[swap; IN_NUMSEG]) THEN ASM_ARITH_TAC;
3883     ALL_TAC] THEN
3884   ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THENL
3885    [ALL_TAC;
3886     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
3887     REWRITE_TAC[REAL_MUL_LZERO] THEN
3888     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
3889     ASM_SIMP_TAC[SUM_DELTA; LAMBDA_BETA; IN_NUMSEG; REAL_MUL_LID]] THEN
3890   ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN
3891   MATCH_MP_TAC EQ_TRANS THEN
3892   EXISTS_TAC
3893     `sum {m,n} (\k. (if k = n then c else if m = k then &1 else &0) *
3894                     (A:real^N^N)$k$j)` THEN
3895   CONJ_TAC THENL
3896    [MATCH_MP_TAC SUM_SUPERSET THEN
3897     ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
3898                  IN_NUMSEG; REAL_MUL_LZERO] THEN
3899     ASM_ARITH_TAC;
3900     ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
3901     REAL_ARITH_TAC]);;
3902
3903 let INDUCT_MATRIX_ELEMENTARY_ALT = prove
3904  (`!P:real^N^N->bool.
3905         (!A B. P A /\ P B ==> P(A ** B)) /\
3906         (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\
3907         (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\
3908                     1 <= j /\ j <= dimindex(:N) /\ ~(i = j)
3909                     ==> A$i$j = &0) ==> P A) /\
3910         (!m n. 1 <= m /\ m <= dimindex(:N) /\
3911                1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3912                ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\
3913         (!m n. 1 <= m /\ m <= dimindex(:N) /\
3914                1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3915                ==> P(lambda i j. if i = m /\ j = n \/ i = j then &1 else &0))
3916         ==> !A. P A`,
3917   GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC INDUCT_MATRIX_ELEMENTARY THEN
3918   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
3919   ASM_CASES_TAC `c = &0` THENL
3920    [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
3921         MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
3922     ASM_SIMP_TAC[LAMBDA_BETA; COND_ID];
3923     ALL_TAC] THEN
3924   SUBGOAL_THEN
3925    `(lambda i j. if i = m /\ j = n then c else if i = j then &1 else &0) =
3926   ((lambda i j. if i = j then if j = n then inv c else &1 else &0):real^N^N) **
3927     ((lambda i j. if i = m /\ j = n \/ i = j then &1 else &0):real^N^N) **
3928     ((lambda i j. if i = j then if j = n then c else &1 else &0):real^N^N)`
3929   SUBST1_TAC THENL
3930    [ALL_TAC;
3931     REPEAT(MATCH_MP_TAC(ASSUME `!A B:real^N^N. P A /\ P B ==> P(A ** B)`) THEN
3932            CONJ_TAC) THEN
3933     ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
3934         MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
3935     ASM_SIMP_TAC[LAMBDA_BETA]] THEN
3936   SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN
3937   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
3938   X_GEN_TAC `j:num` THEN STRIP_TAC THEN
3939   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_ARITH
3940        `(if p then &1 else &0) * (if q then c else &0) =
3941         if q then if p then c else &0 else &0`] THEN
3942   REWRITE_TAC[REAL_ARITH
3943    `(if p then x else &0) * y = (if p then x * y else &0)`] THEN
3944   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
3945   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN
3946   ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
3947   ASM_CASES_TAC `j:num = n` THEN ASM_REWRITE_TAC[REAL_MUL_LID; EQ_SYM_EQ] THEN
3948   ASM_CASES_TAC `i:num = n` THEN
3949   ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID; REAL_MUL_RZERO]);;
3950
3951 (* ------------------------------------------------------------------------- *)
3952 (* The same thing in mapping form (might have been easier all along).        *)
3953 (* ------------------------------------------------------------------------- *)
3954
3955 let INDUCT_LINEAR_ELEMENTARY = prove
3956  (`!P. (!f g. linear f /\ linear g /\ P f /\ P g ==> P(f o g)) /\
3957        (!f i. linear f /\ 1 <= i /\ i <= dimindex(:N) /\ (!x. (f x)$i = &0)
3958               ==> P f) /\
3959        (!c. P(\x. lambda i. c i * x$i)) /\
3960        (!m n. 1 <= m /\ m <= dimindex(:N) /\
3961               1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3962               ==> P(\x. lambda i. x$swap(m,n) i)) /\
3963        (!m n. 1 <= m /\ m <= dimindex(:N) /\
3964               1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3965               ==> P(\x. lambda i. if i = m then x$m + x$n else x$i))
3966        ==> !f:real^N->real^N. linear f ==> P f`,
3967   GEN_TAC THEN
3968   MP_TAC(ISPEC `\A:real^N^N. P(\x:real^N. A ** x):bool`
3969     INDUCT_MATRIX_ELEMENTARY_ALT) THEN
3970   REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
3971    [ALL_TAC;
3972     DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN
3973     FIRST_X_ASSUM(MP_TAC o SPEC `matrix(f:real^N->real^N)`) THEN
3974     ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX]] THEN
3975   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
3976    [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `B:real^N^N`] THEN
3977     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
3978      [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. (B:real^N^N) ** x`]) THEN
3979     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN
3980     REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC];
3981     ALL_TAC] THEN
3982   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
3983    [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `m:num`] THEN
3984     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
3985      [`\x:real^N. (A:real^N^N) ** x`; `m:num`]) THEN
3986     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
3987     DISCH_THEN MATCH_MP_TAC THEN
3988     UNDISCH_TAC `row m (A:real^N^N) = vec 0` THEN
3989     ASM_SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT; matrix_vector_mul;
3990                  REAL_MUL_LZERO; SUM_0];
3991     ALL_TAC] THEN
3992   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
3993    [DISCH_TAC THEN X_GEN_TAC `A:real^N^N` THEN STRIP_TAC THEN
3994     FIRST_X_ASSUM(MP_TAC o SPEC `\i. (A:real^N^N)$i$i`) THEN
3995     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3996     ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA] THEN
3997     MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
3998     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
3999      `sum(1..dimindex(:N)) (\j. if j = i then (A:real^N^N)$i$j * (x:real^N)$j
4000                                 else &0)` THEN
4001     CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN
4002     MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
4003     ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO];
4004     ALL_TAC] THEN
4005   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
4006   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN
4007   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
4008   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
4009   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4010   ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA;
4011                mat; IN_DIMINDEX_SWAP]
4012   THENL
4013    [ONCE_REWRITE_TAC[SWAP_GALOIS] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
4014     ONCE_REWRITE_TAC[COND_RATOR] THEN
4015     SIMP_TAC[SUM_DELTA; REAL_MUL_LID; REAL_MUL_LZERO; IN_NUMSEG] THEN
4016     REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
4017     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
4018     MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
4019     ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
4020     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
4021     GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
4022     ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_MUL_LID; IN_NUMSEG] THEN
4023     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4024      `sum {m,n} (\j. if n = j \/ j = m then (x:real^N)$j else &0)` THEN
4025     CONJ_TAC THENL
4026      [SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
4027       ASM_REWRITE_TAC[REAL_ADD_RID];
4028       CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
4029       ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
4030                    IN_NUMSEG; REAL_MUL_LZERO] THEN
4031       ASM_ARITH_TAC]]);;
4032
4033 (* ------------------------------------------------------------------------- *)
4034 (* Hence the effect of an arbitrary linear map on a measurable set.          *)
4035 (* ------------------------------------------------------------------------- *)
4036
4037 let LAMBDA_SWAP_GALOIS = prove
4038  (`!x:real^N y:real^N.
4039         1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N)
4040         ==> (x = (lambda i. y$swap(m,n) i) <=>
4041              (lambda i. x$swap(m,n) i) = y)`,
4042   SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP] THEN
4043   REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
4044   DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4045   FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
4046   ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
4047   ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]);;
4048
4049 let LAMBDA_ADD_GALOIS = prove
4050  (`!x:real^N y:real^N.
4051         1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\
4052         ~(m = n)
4053         ==> (x = (lambda i. if i = m then y$m + y$n else y$i) <=>
4054              (lambda i. if i = m then x$m - x$n else x$i) = y)`,
4055   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
4056   REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
4057   DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4058   FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4059   FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
4060   ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
4061   REAL_ARITH_TAC);;
4062
4063 let HAS_MEASURE_SHEAR_INTERVAL = prove
4064  (`!a b:real^N m n.
4065         1 <= m /\ m <= dimindex(:N) /\
4066         1 <= n /\ n <= dimindex(:N) /\
4067         ~(m = n) /\ ~(interval[a,b] = {}) /\
4068         &0 <= a$n
4069         ==> (IMAGE (\x. (lambda i. if i = m then x$m + x$n else x$i))
4070                    (interval[a,b]):real^N->bool)
4071             has_measure measure (interval [a,b])`,
4072   let lemma = prove
4073    (`!s t u v:real^N->bool.
4074           measurable s /\ measurable t /\ measurable u /\
4075           negligible(s INTER t) /\ negligible(s INTER u) /\
4076           negligible(t INTER u) /\
4077           s UNION t UNION u = v
4078           ==> v has_measure (measure s) + (measure t) + (measure u)`,
4079     REPEAT STRIP_TAC THEN
4080     ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_UNION] THEN
4081     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4082     ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_UNION] THEN
4083     ASM_SIMP_TAC[MEASURE_EQ_0; UNION_OVER_INTER; MEASURE_UNION;
4084                  MEASURABLE_UNION; NEGLIGIBLE_INTER; MEASURABLE_INTER] THEN
4085     REAL_ARITH_TAC)
4086   and lemma' = prove
4087    (`!s t u a:real^N.
4088           measurable s /\ measurable t /\
4089           s UNION (IMAGE (\x. a + x) t) = u /\
4090           negligible(s INTER (IMAGE (\x. a + x) t))
4091           ==> measure s + measure t = measure u`,
4092     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
4093     ASM_SIMP_TAC[MEASURE_NEGLIGIBLE_UNION; MEASURABLE_TRANSLATION_EQ;
4094                  MEASURE_TRANSLATION]) in
4095   REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
4096   SUBGOAL_THEN
4097    `linear((\x. lambda i. if i = m then x$m + x$n else x$i):real^N->real^N)`
4098   ASSUME_TAC THENL
4099    [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4100                  VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
4101     ALL_TAC] THEN
4102   MP_TAC(ISPECL
4103    [`IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i)
4104             (interval[a:real^N,b]):real^N->bool`;
4105     `interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
4106        {x:real^N | (basis m - basis n) dot x <= a$m}`;
4107     `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
4108        {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
4109     `interval[a:real^N,
4110               (lambda i. if i = m then (b:real^N)$m + b$n else b$i)]`]
4111      lemma) THEN
4112   ANTS_TAC THENL
4113    [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
4114                  CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
4115                  CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER;
4116                  BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
4117     REWRITE_TAC[INTER] THEN
4118     REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
4119     ASM_SIMP_TAC[LAMBDA_ADD_GALOIS; UNWIND_THM1] THEN
4120     ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
4121                  DOT_BASIS; DOT_LSUB] THEN
4122     ONCE_REWRITE_TAC[MESON[]
4123        `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN
4124     ASM_SIMP_TAC[] THEN
4125     REWRITE_TAC[TAUT `(p /\ x) /\ (q /\ x) /\ r <=> x /\ p /\ q /\ r`;
4126                 TAUT `(p /\ x) /\ q /\ (r /\ x) <=> x /\ p /\ q /\ r`;
4127                 TAUT `((p /\ x) /\ q) /\ (r /\ x) /\ s <=>
4128                             x /\ p /\ q /\ r /\ s`;
4129             TAUT `(a /\ x \/ (b /\ x) /\ c \/ (d /\ x) /\ e <=> f /\ x) <=>
4130                   x ==> (a \/ b /\ c \/ d /\ e <=> f)`] THEN
4131     ONCE_REWRITE_TAC[SET_RULE
4132      `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
4133     REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
4134      [ALL_TAC;
4135       GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN
4136       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
4137     REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN
4138     MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
4139     MATCH_MP_TAC NEGLIGIBLE_SUBSET THENL
4140      [EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`;
4141       EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`;
4142       EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`]
4143     THEN (CONJ_TAC THENL
4144       [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
4145        REWRITE_TAC[VECTOR_SUB_EQ] THEN
4146        ASM_MESON_TAC[BASIS_INJ];
4147        ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
4148                     NOT_IN_EMPTY] THEN
4149        FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN
4150        ASM_REAL_ARITH_TAC]);
4151     ALL_TAC] THEN
4152   ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE;
4153                MEASURABLE_LINEAR_IMAGE_INTERVAL;
4154                MEASURABLE_INTERVAL] THEN
4155   MP_TAC(ISPECL
4156    [`interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
4157        {x:real^N | (basis m - basis n) dot x <= a$m}`;
4158     `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
4159        {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
4160     `interval[a:real^N,
4161               (lambda i. if i = m then (a:real^N)$m + b$n
4162                          else (b:real^N)$i)]`;
4163     `(lambda i. if i = m then (a:real^N)$m - (b:real^N)$m
4164                 else &0):real^N`]
4165      lemma') THEN
4166   ANTS_TAC THENL
4167    [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
4168                  CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
4169                  CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER;
4170                  BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
4171     REWRITE_TAC[INTER] THEN
4172     REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
4173     ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = (lambda i. p i) + y <=>
4174                                    x - (lambda i. p i) = y`] THEN
4175     ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
4176                  DOT_BASIS; DOT_LSUB; UNWIND_THM1;
4177                  VECTOR_SUB_COMPONENT] THEN
4178     ONCE_REWRITE_TAC[MESON[]
4179        `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN
4180     ASM_SIMP_TAC[REAL_SUB_RZERO] THEN CONJ_TAC THENL
4181      [X_GEN_TAC `x:real^N` THEN
4182       FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4183       FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4184       ASM_REWRITE_TAC[] THEN
4185       ASM_CASES_TAC
4186        `!i. ~(i = m)
4187             ==> 1 <= i /\ i <= dimindex (:N)
4188                 ==> (a:real^N)$i <= (x:real^N)$i /\
4189                     x$i <= (b:real^N)$i` THEN
4190       ASM_REWRITE_TAC[] THEN
4191       FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
4192       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
4193       ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ (d /\ e) /\ f <=>
4194                              (b /\ e) /\ a /\ c /\ d /\ f`] THEN
4195       ONCE_REWRITE_TAC[SET_RULE
4196        `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
4197       MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
4198       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
4199       EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`
4200       THEN CONJ_TAC THENL
4201        [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
4202         REWRITE_TAC[VECTOR_SUB_EQ] THEN
4203         ASM_MESON_TAC[BASIS_INJ];
4204         ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
4205                      NOT_IN_EMPTY] THEN
4206         FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4207         FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4208         ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]];
4209     ALL_TAC] THEN
4210   DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH
4211    `a:real = b + c ==> a = x + b ==> x = c`) THEN
4212   ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES;
4213                LAMBDA_BETA] THEN
4214   REPEAT(COND_CASES_TAC THENL
4215    [ALL_TAC;
4216     FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
4217     MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
4218     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4219     COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
4220     FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4221     FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4222     ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) THEN
4223   SUBGOAL_THEN `1..dimindex(:N) = m INSERT ((1..dimindex(:N)) DELETE m)`
4224   SUBST1_TAC THENL
4225    [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN
4226     ASM_ARITH_TAC;
4227     ALL_TAC] THEN
4228   SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG] THEN
4229   ASM_SIMP_TAC[IN_DELETE] THEN
4230   MATCH_MP_TAC(REAL_RING
4231    `s1:real = s3 /\ s2 = s3
4232     ==> ((bm + bn) - am) * s1 =
4233         ((am + bn) - am) * s2 + (bm - am) * s3`) THEN
4234   CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN
4235   SIMP_TAC[IN_DELETE] THEN REAL_ARITH_TAC);;
4236
4237 let HAS_MEASURE_LINEAR_IMAGE = prove
4238  (`!f:real^N->real^N s.
4239         linear f /\ measurable s
4240         ==> (IMAGE f s) has_measure (abs(det(matrix f)) * measure s)`,
4241   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4242   MATCH_MP_TAC INDUCT_LINEAR_ELEMENTARY THEN REPEAT CONJ_TAC THENL
4243    [MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
4244     REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4245     DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
4246     DISCH_THEN(CONJUNCTS_THEN2
4247      (MP_TAC o SPEC `IMAGE (g:real^N->real^N) s`)
4248      (MP_TAC o SPEC `s:real^N->bool`)) THEN
4249     ASM_REWRITE_TAC[] THEN
4250     GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN
4251     STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_COMPOSE; DET_MUL; REAL_ABS_MUL] THEN
4252     REWRITE_TAC[IMAGE_o; GSYM REAL_MUL_ASSOC];
4253
4254     MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `m:num`] THEN STRIP_TAC THEN
4255     SUBGOAL_THEN `~(!x y. (f:real^N->real^N) x = f y ==> x = y)`
4256     ASSUME_TAC THENL
4257      [ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
4258       EXISTS_TAC `basis m:real^N` THEN
4259       ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS];
4260       ALL_TAC] THEN
4261     MP_TAC(ISPEC `matrix f:real^N^N` INVERTIBLE_DET_NZ) THEN
4262     ASM_SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_INJECTIVE;
4263                  MATRIX_WORKS; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
4264     DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[HAS_MEASURE_0] THEN
4265     ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE];
4266
4267     MAP_EVERY X_GEN_TAC [`c:num->real`; `s:real^N->bool`] THEN
4268     DISCH_TAC THEN
4269     FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[HAS_MEASURE_MEASURE]) THEN
4270     FIRST_ASSUM(MP_TAC o SPEC `c:num->real` o
4271      MATCH_MP HAS_MEASURE_STRETCH) THEN
4272     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4273     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
4274     SIMP_TAC[matrix; LAMBDA_BETA] THEN
4275     W(MP_TAC o PART_MATCH (lhs o rand) DET_DIAGONAL o rand o snd) THEN
4276     SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; REAL_MUL_RZERO] THEN
4277     DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
4278     REWRITE_TAC[REAL_MUL_RID];
4279
4280     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4281     MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN
4282     ASM_SIMP_TAC[linear; LAMBDA_BETA; IN_DIMINDEX_SWAP; VECTOR_ADD_COMPONENT;
4283                  VECTOR_MUL_COMPONENT; CART_EQ] THEN
4284     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
4285     SUBGOAL_THEN `matrix (\x:real^N. lambda i. x$swap (m,n) i):real^N^N =
4286                   transp(lambda i j. (mat 1:real^N^N)$i$swap (m,n) j)`
4287     SUBST1_TAC THENL
4288      [ASM_SIMP_TAC[MATRIX_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP;
4289                     matrix_vector_mul; CART_EQ; matrix; mat; basis;
4290                     COND_COMPONENT; transp] THEN
4291       REWRITE_TAC[EQ_SYM_EQ];
4292       ALL_TAC] THEN
4293     REWRITE_TAC[DET_TRANSP] THEN
4294     W(MP_TAC o PART_MATCH (lhs o rand) DET_PERMUTE_COLUMNS o
4295         rand o lhand o rand o snd) THEN
4296     ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; ETA_AX] THEN
4297     DISCH_THEN(K ALL_TAC) THEN
4298     REWRITE_TAC[DET_I; REAL_ABS_SIGN; REAL_MUL_RID; REAL_MUL_LID] THEN
4299     ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
4300      [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY];
4301       ALL_TAC] THEN
4302     SUBGOAL_THEN
4303      `~(IMAGE (\x:real^N. lambda i. x$swap (m,n) i)
4304               (interval[a,b]):real^N->bool = {})`
4305     MP_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
4306     SUBGOAL_THEN
4307      `IMAGE (\x:real^N. lambda i. x$swap (m,n) i)
4308               (interval[a,b]):real^N->bool =
4309       interval[(lambda i. a$swap (m,n) i),
4310                (lambda i. b$swap (m,n) i)]`
4311     SUBST1_TAC THENL
4312      [REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_IMAGE] THEN
4313       ASM_SIMP_TAC[LAMBDA_SWAP_GALOIS; UNWIND_THM1] THEN
4314       SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN EQ_TAC THEN
4315       DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4316       FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
4317       ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
4318       ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT];
4319       ALL_TAC] THEN
4320     REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL] THEN
4321     REWRITE_TAC[MEASURE_INTERVAL] THEN
4322     ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM INTERVAL_NE_EMPTY] THEN
4323     DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LAMBDA_BETA] THEN
4324     ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; IN_DIMINDEX_SWAP] THEN
4325     MP_TAC(ISPECL [`\i. (b - a:real^N)$i`; `swap(m:num,n)`; `1..dimindex(:N)`]
4326                 (GSYM PRODUCT_PERMUTE)) THEN
4327     REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
4328     ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG];
4329
4330     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4331     MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN
4332     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
4333      [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4334                    VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
4335       DISCH_TAC] THEN
4336     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
4337     SUBGOAL_THEN
4338       `det(matrix(\x. lambda i. if i = m then (x:real^N)$m + x$n
4339                                 else x$i):real^N^N) = &1`
4340     SUBST1_TAC THENL
4341      [ASM_SIMP_TAC[matrix; basis; COND_COMPONENT; LAMBDA_BETA] THEN
4342       FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
4343        `~(m:num = n) ==> m < n \/ n < m`))
4344       THENL
4345        [W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhs o snd);
4346         W(MP_TAC o PART_MATCH (lhs o rand) DET_LOWERTRIANGULAR o lhs o snd)]
4347       THEN ASM_SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
4348                         matrix; REAL_ADD_RID; COND_ID;
4349                         PRODUCT_CONST_NUMSEG; REAL_POW_ONE] THEN
4350       DISCH_THEN MATCH_MP_TAC THEN
4351       REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
4352       ASM_ARITH_TAC;
4353       ALL_TAC] THEN
4354     REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN
4355     ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
4356      [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY];
4357       ALL_TAC] THEN
4358     SUBGOAL_THEN
4359      `IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i) (interval [a,b]) =
4360       IMAGE (\x:real^N. (lambda i. if i = m \/ i = n then a$n else &0) +
4361                         x)
4362             (IMAGE (\x:real^N. lambda i. if i = m then x$m + x$n else x$i)
4363                    (IMAGE (\x. (lambda i. if i = n then --(a$n) else &0) + x)
4364                           (interval[a,b])))`
4365     SUBST1_TAC THENL
4366      [REWRITE_TAC[GSYM IMAGE_o] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4367       ASM_SIMP_TAC[FUN_EQ_THM; o_THM; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
4368                    CART_EQ] THEN
4369       MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN
4370       STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
4371       ASM_CASES_TAC `i:num = n` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
4372       ALL_TAC] THEN
4373     MATCH_MP_TAC HAS_MEASURE_TRANSLATION THEN
4374     SUBGOAL_THEN
4375      `measure(interval[a,b]) =
4376       measure(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x)
4377                     (interval[a,b]):real^N->bool)`
4378     SUBST1_TAC THENL [REWRITE_TAC[MEASURE_TRANSLATION]; ALL_TAC] THEN
4379     SUBGOAL_THEN
4380      `~(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x)
4381                     (interval[a,b]):real^N->bool = {})`
4382     MP_TAC THENL [ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
4383     ONCE_REWRITE_TAC[VECTOR_ARITH `c + x:real^N = &1 % x + c`] THEN
4384     ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS] THEN
4385     DISCH_TAC THEN MATCH_MP_TAC HAS_MEASURE_SHEAR_INTERVAL THEN
4386     ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
4387     REAL_ARITH_TAC]);;
4388
4389 let MEASURABLE_LINEAR_IMAGE = prove
4390  (`!f:real^N->real^N s.
4391         linear f /\ measurable s ==> measurable(IMAGE f s)`,
4392   REPEAT GEN_TAC THEN
4393   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN
4394   SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);;
4395
4396 let MEASURE_LINEAR_IMAGE = prove
4397  (`!f:real^N->real^N s.
4398         linear f /\ measurable s
4399         ==> measure(IMAGE f s) = abs(det(matrix f)) * measure s`,
4400   REPEAT GEN_TAC THEN
4401   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN
4402   SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);;
4403
4404 let HAS_MEASURE_LINEAR_IMAGE_ALT = prove
4405  (`!f:real^N->real^N s m.
4406         linear f /\ s has_measure m
4407         ==> (IMAGE f s) has_measure (abs(det(matrix f)) * m)`,
4408   MESON_TAC[MEASURE_UNIQUE; measurable; HAS_MEASURE_LINEAR_IMAGE]);;
4409
4410 let HAS_MEASURE_LINEAR_IMAGE_SAME = prove
4411  (`!f s. linear f /\ measurable s /\ abs(det(matrix f)) = &1
4412          ==> (IMAGE f s) has_measure (measure s)`,
4413   MESON_TAC[HAS_MEASURE_LINEAR_IMAGE; REAL_MUL_LID]);;
4414
4415 let MEASURE_LINEAR_IMAGE_SAME = prove
4416  (`!f:real^N->real^N s.
4417         linear f /\ measurable s /\ abs(det(matrix f)) = &1
4418         ==> measure(IMAGE f s) = measure s`,
4419   REPEAT GEN_TAC THEN
4420   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_SAME) THEN
4421   SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);;
4422
4423 let MEASURABLE_LINEAR_IMAGE_EQ = prove
4424  (`!f:real^N->real^N s.
4425         linear f /\ (!x y. f x = f y ==> x = y)
4426         ==> (measurable (IMAGE f s) <=> measurable s)`,
4427   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE MEASURABLE_LINEAR_IMAGE));;
4428
4429 add_linear_invariants [MEASURABLE_LINEAR_IMAGE_EQ];;
4430
4431 let NEGLIGIBLE_LINEAR_IMAGE = prove
4432  (`!f:real^N->real^N s. linear f /\ negligible s ==> negligible(IMAGE f s)`,
4433   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN DISCH_TAC THEN
4434   FIRST_ASSUM(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN
4435   REWRITE_TAC[REAL_MUL_RZERO]);;
4436
4437 let NEGLIGIBLE_LINEAR_IMAGE_EQ = prove
4438  (`!f:real^N->real^N s.
4439         linear f /\ (!x y. f x = f y ==> x = y)
4440         ==> (negligible (IMAGE f s) <=> negligible s)`,
4441   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE NEGLIGIBLE_LINEAR_IMAGE));;
4442
4443 add_linear_invariants [NEGLIGIBLE_LINEAR_IMAGE_EQ];;
4444
4445 let HAS_MEASURE_ORTHOGONAL_IMAGE = prove
4446  (`!f:real^N->real^N s m.
4447         orthogonal_transformation f /\ s has_measure m
4448         ==> (IMAGE f s) has_measure m`,
4449   REPEAT GEN_TAC THEN
4450   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4451   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN
4452   REWRITE_TAC[IMP_IMP] THEN
4453   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN
4454   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4455   MATCH_MP_TAC(REAL_RING `x = &1 ==> x * m = m`) THEN
4456   REWRITE_TAC[REAL_ARITH `abs x = &1 <=> x = &1 \/ x = -- &1`] THEN
4457   MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN
4458   ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]);;
4459
4460 let HAS_MEASURE_ORTHOGONAL_IMAGE_EQ = prove
4461  (`!f:real^N->real^N s m.
4462         orthogonal_transformation f
4463         ==> ((IMAGE f s) has_measure m <=> s has_measure m)`,
4464   REPEAT STRIP_TAC THEN EQ_TAC THEN
4465   ASM_SIMP_TAC[HAS_MEASURE_ORTHOGONAL_IMAGE] THEN
4466   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN
4467   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` MP_TAC) THEN
4468   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4469    REWRITE_TAC[IMP_IMP] THEN
4470   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_ORTHOGONAL_IMAGE) THEN
4471   ASM_SIMP_TAC[GSYM IMAGE_o; IMAGE_I]);;
4472
4473 add_linear_invariants
4474  [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] HAS_MEASURE_ORTHOGONAL_IMAGE_EQ];;
4475
4476 let MEASURE_ORTHOGONAL_IMAGE_EQ = prove
4477  (`!f:real^N->real^N s.
4478         orthogonal_transformation f
4479         ==> measure(IMAGE f s) = measure s`,
4480   SIMP_TAC[measure; HAS_MEASURE_ORTHOGONAL_IMAGE_EQ]);;
4481
4482 add_linear_invariants
4483  [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] MEASURE_ORTHOGONAL_IMAGE_EQ];;
4484
4485 (* ------------------------------------------------------------------------- *)
4486 (* Measure of a standard simplex.                                            *)
4487 (* ------------------------------------------------------------------------- *)
4488
4489 let CONGRUENT_IMAGE_STD_SIMPLEX = prove
4490  (`!p. p permutes 1..dimindex(:N)
4491        ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\
4492                        (!i. 1 <= i /\ i < dimindex(:N)
4493                             ==> x$(p i) <= x$(p(i + 1)))} =
4494            IMAGE (\x:real^N. lambda i. sum(1..inverse p(i)) (\j. x$j))
4495                  {x | (!i. 1 <= i /\ i <= dimindex (:N) ==> &0 <= x$i) /\
4496                       sum (1..dimindex (:N)) (\i. x$i) <= &1}`,
4497   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4498    [ALL_TAC;
4499     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
4500     ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
4501                  ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`;
4502                  ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1] THEN
4503     STRIP_TAC THEN
4504     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
4505     ASM_SIMP_TAC[SUM_SING_NUMSEG; DIMINDEX_GE_1; LE_REFL] THEN
4506     REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN
4507     ASM_SIMP_TAC[REAL_LE_ADDR] THEN REPEAT STRIP_TAC THEN
4508     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN
4509   REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
4510   STRIP_TAC THEN
4511   EXISTS_TAC `(lambda i. if i = 1 then x$(p 1)
4512                          else (x:real^N)$p(i) - x$p(i - 1)):real^N` THEN
4513   ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
4514                ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`;
4515                ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1; CART_EQ] THEN
4516   REPEAT CONJ_TAC THENL
4517    [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4518     SUBGOAL_THEN `1 <= inverse (p:num->num) i /\
4519                   !x. x <= inverse p i ==> x <= dimindex(:N)`
4520     ASSUME_TAC THENL
4521      [ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE];
4522       ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH]] THEN
4523     SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN
4524     GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV)
4525                 [GSYM REAL_MUL_LID] THEN
4526     ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
4527     REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
4528     REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
4529     FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
4530      `1 <= p ==> p = 1 \/ 2 <= p`) o CONJUNCT1) THEN
4531     ASM_SIMP_TAC[ARITH] THEN
4532     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
4533     REWRITE_TAC[REAL_ADD_RID] THEN TRY REAL_ARITH_TAC THEN
4534     ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE];
4535
4536     X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN
4537     ASM_REWRITE_TAC[REAL_SUB_LE] THEN
4538     FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
4539     ASM_SIMP_TAC[SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
4540
4541     SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH;
4542              ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN
4543     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o BINDER_CONV)
4544                 [GSYM REAL_MUL_LID] THEN
4545     ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
4546     REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
4547     REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
4548     COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ADD_RID] THEN
4549     ASM_REWRITE_TAC[REAL_ARITH `x + y - x:real = y`] THEN
4550     ASM_MESON_TAC[DIMINDEX_GE_1;
4551                   ARITH_RULE `1 <= n /\ ~(2 <= n) ==> n = 1`]]);;
4552
4553 let HAS_MEASURE_IMAGE_STD_SIMPLEX = prove
4554  (`!p. p permutes 1..dimindex(:N)
4555        ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\
4556                        (!i. 1 <= i /\ i < dimindex(:N)
4557                             ==> x$(p i) <= x$(p(i + 1)))}
4558            has_measure
4559            (measure (convex hull
4560              (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})))`,
4561   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONGRUENT_IMAGE_STD_SIMPLEX] THEN
4562   ASM_SIMP_TAC[GSYM STD_SIMPLEX] THEN
4563   MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE_SAME THEN
4564   REPEAT CONJ_TAC THENL
4565    [REWRITE_TAC[linear; CART_EQ] THEN
4566     ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
4567                  GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL] THEN
4568     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
4569     REPEAT STRIP_TAC THEN REWRITE_TAC[];
4570     MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4571     MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
4572     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4573     MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
4574     REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
4575     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4576      `abs(det
4577        ((lambda i. ((lambda i j. if j <= i then &1 else &0):real^N^N)
4578                    $inverse p i)
4579         :real^N^N))` THEN
4580     CONJ_TAC THENL
4581      [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
4582       ASM_SIMP_TAC[matrix; LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
4583                    LAMBDA_BETA_PERM; PERMUTES_INVERSE] THEN
4584       X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4585       X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
4586       EXISTS_TAC `sum (1..inverse (p:num->num) i)
4587                       (\k. if k = j then &1 else &0)` THEN
4588       CONJ_TAC THENL
4589        [MATCH_MP_TAC SUM_EQ THEN
4590         ASM_SIMP_TAC[IN_NUMSEG; PERMUTES_IN_IMAGE; basis] THEN
4591         REPEAT STRIP_TAC THEN MATCH_MP_TAC LAMBDA_BETA THEN
4592         ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; LE_TRANS;
4593                       PERMUTES_INVERSE];
4594         ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]];
4595       ALL_TAC] THEN
4596     ASM_SIMP_TAC[PERMUTES_INVERSE; DET_PERMUTE_ROWS; ETA_AX] THEN
4597     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SIGN; REAL_MUL_LID] THEN
4598     MATCH_MP_TAC(REAL_ARITH `x = &1 ==> abs x = &1`) THEN
4599     ASM_SIMP_TAC[DET_LOWERTRIANGULAR; GSYM NOT_LT; LAMBDA_BETA] THEN
4600     REWRITE_TAC[LT_REFL; PRODUCT_CONST_NUMSEG; REAL_POW_ONE]]);;
4601
4602 let HAS_MEASURE_STD_SIMPLEX = prove
4603  (`(convex hull (vec 0:real^N INSERT {basis i | 1 <= i /\ i <= dimindex(:N)}))
4604    has_measure inv(&(FACT(dimindex(:N))))`,
4605   let lemma = prove
4606    (`!f:num->real. (!i. 1 <= i /\ i < n ==> f i <= f(i + 1)) <=>
4607                    (!i j. 1 <= i /\ i <= j /\ j <= n ==> f i <= f j)`,
4608     GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4609      [GEN_TAC THEN INDUCT_TAC THEN
4610       SIMP_TAC[LE; REAL_LE_REFL] THEN
4611       STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN
4612       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) j` THEN
4613       ASM_SIMP_TAC[ARITH_RULE `SUC x <= y ==> x <= y`] THEN
4614       REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
4615       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]) in
4616   MP_TAC(ISPECL
4617    [`\p. {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\
4618                      (!i. 1 <= i /\ i < dimindex(:N)
4619                           ==> x$(p i) <= x$(p(i + 1)))}`;
4620     `{p | p permutes 1..dimindex(:N)}`]
4621     HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
4622   ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
4623                             HAS_MEASURE_IMAGE_STD_SIMPLEX; IN_ELIM_THM] THEN
4624   ASM_SIMP_TAC[SUM_CONST; FINITE_PERMUTATIONS; FINITE_NUMSEG;
4625                CARD_PERMUTATIONS; CARD_NUMSEG_1] THEN
4626   ANTS_TAC THENL
4627    [MAP_EVERY X_GEN_TAC [`p:num->num`; `q:num->num`] THEN STRIP_TAC THEN
4628     SUBGOAL_THEN `?i. i IN 1..dimindex(:N) /\ ~(p i:num = q i)` MP_TAC THENL
4629      [ASM_MESON_TAC[permutes; FUN_EQ_THM]; ALL_TAC] THEN
4630     GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
4631     REWRITE_TAC[TAUT `a ==> ~(b /\ ~c) <=> a /\ b ==> c`] THEN
4632     REWRITE_TAC[IN_NUMSEG] THEN
4633     DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
4634     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
4635     EXISTS_TAC `{x:real^N | (basis(p(k:num)) - basis(q k)) dot x = &0}` THEN
4636     CONJ_TAC THENL
4637      [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN
4638       MATCH_MP_TAC BASIS_NE THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG];
4639       ALL_TAC] THEN
4640     REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; DOT_LSUB; VECTOR_SUB_EQ] THEN
4641     ASM_SIMP_TAC[DOT_BASIS; GSYM IN_NUMSEG; PERMUTES_IN_IMAGE] THEN
4642     SUBGOAL_THEN `?l. (q:num->num) l = p(k:num)` STRIP_ASSUME_TAC THENL
4643      [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
4644     SUBGOAL_THEN `1 <= l /\ l <= dimindex(:N)` STRIP_ASSUME_TAC THENL
4645      [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
4646     SUBGOAL_THEN `k:num < l` ASSUME_TAC THENL
4647      [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
4648       ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
4649       ALL_TAC] THEN
4650     SUBGOAL_THEN `?m. (p:num->num) m = q(k:num)` STRIP_ASSUME_TAC THENL
4651      [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
4652     SUBGOAL_THEN `1 <= m /\ m <= dimindex(:N)` STRIP_ASSUME_TAC THENL
4653      [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
4654     SUBGOAL_THEN `k:num < m` ASSUME_TAC THENL
4655      [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
4656       ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
4657       ALL_TAC] THEN
4658     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[lemma] THEN STRIP_TAC THEN
4659     FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
4660     FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN
4661     ASM_SIMP_TAC[LT_IMP_LE; IMP_IMP; REAL_LE_ANTISYM; REAL_SUB_0] THEN
4662     MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN
4663     ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; DOT_BASIS];
4664     ALL_TAC] THEN
4665   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN
4666   DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN CONJ_TAC THENL
4667    [MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4668     MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
4669     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4670     MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
4671     REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
4672     ALL_TAC] THEN
4673   ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> (x = inv y <=> y * x = &1)`;
4674                REAL_OF_NUM_EQ; FACT_NZ] THEN
4675   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_TRANS THEN
4676   EXISTS_TAC `measure(interval[vec 0:real^N,vec 1])` THEN CONJ_TAC THENL
4677    [AP_TERM_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_UNIT]] THEN
4678   REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4679    [REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ;
4680                 RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN
4681     SIMP_TAC[IMP_IMP; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
4682     X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN
4683     STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN
4684     MATCH_MP_TAC REAL_LE_TRANS THENL
4685      [EXISTS_TAC `(x:real^N)$(p 1)`;
4686       EXISTS_TAC `(x:real^N)$(p(dimindex(:N)))`] THEN
4687     ASM_REWRITE_TAC[] THEN
4688     FIRST_ASSUM(MP_TAC o SPEC `i:num` o MATCH_MP PERMUTES_SURJECTIVE) THEN
4689     ASM_MESON_TAC[LE_REFL; PERMUTES_IN_IMAGE; IN_NUMSEG];
4690     ALL_TAC] THEN
4691   REWRITE_TAC[SET_RULE `s SUBSET UNIONS(IMAGE f t) <=>
4692                         !x. x IN s ==> ?y. y IN t /\ x IN f y`] THEN
4693   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; IN_ELIM_THM] THEN
4694   SIMP_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN
4695   MP_TAC(ISPEC `\i j. ~((x:real^N)$j <= x$i)` TOPOLOGICAL_SORT) THEN
4696   REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN
4697   ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
4698   DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)`; `1..dimindex(:N)`]) THEN
4699   REWRITE_TAC[HAS_SIZE_NUMSEG_1; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN
4700   DISCH_THEN(X_CHOOSE_THEN `f:num->num` (CONJUNCTS_THEN2
4701    (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN
4702   EXISTS_TAC `\i. if i IN 1..dimindex(:N) then f(i) else i` THEN
4703   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE
4704     `1 <= i /\ i <= j /\ j <= n <=>
4705      1 <= i /\ 1 <= j /\ i <= n /\ j <= n /\ i <= j`] THEN
4706   ASM_SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN
4707   CONJ_TAC THENL
4708    [ALL_TAC;
4709     ASM_MESON_TAC[LE_REFL; DIMINDEX_GE_1; LE_LT; REAL_LE_LT]] THEN
4710   SIMP_TAC[PERMUTES_FINITE_SURJECTIVE; FINITE_NUMSEG] THEN
4711   SIMP_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[]);;
4712
4713 (* ------------------------------------------------------------------------- *)
4714 (* Hence the measure of a general simplex.                                   *)
4715 (* ------------------------------------------------------------------------- *)
4716
4717 let HAS_MEASURE_SIMPLEX_0 = prove
4718  (`!l:(real^N)list.
4719         LENGTH l = dimindex(:N)
4720         ==> (convex hull (vec 0 INSERT set_of_list l)) has_measure
4721             abs(det(vector l)) / &(FACT(dimindex(:N)))`,
4722   REPEAT STRIP_TAC THEN
4723   SUBGOAL_THEN
4724    `vec 0 INSERT (set_of_list l) =
4725         IMAGE (\x:real^N. transp(vector l:real^N^N) ** x)
4726               (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})`
4727   SUBST1_TAC THENL
4728    [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4729     REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF] THEN
4730     REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO] THEN AP_TERM_TAC THEN
4731     SIMP_TAC[matrix_vector_mul; vector; transp; LAMBDA_BETA; basis] THEN
4732     ONCE_REWRITE_TAC[COND_RAND] THEN
4733     SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN
4734     REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
4735     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(b /\ c ==> ~a)`] THEN
4736     X_GEN_TAC `y:real^N` THEN SIMP_TAC[LAMBDA_BETA; REAL_MUL_RID] THEN
4737     SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
4738     REWRITE_TAC[NOT_IMP; REAL_MUL_RID; GSYM CART_EQ] THEN
4739     ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN
4740     EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THENL
4741      [EXISTS_TAC `SUC i`; EXISTS_TAC `i - 1`] THEN
4742     ASM_REWRITE_TAC[SUC_SUB1] THEN ASM_ARITH_TAC;
4743     ALL_TAC] THEN
4744   ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
4745   SUBGOAL_THEN
4746    `det(vector l:real^N^N) = det(matrix(\x:real^N. transp(vector l) ** x))`
4747   SUBST1_TAC THENL
4748    [REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; DET_TRANSP]; ALL_TAC] THEN
4749   REWRITE_TAC[real_div] THEN
4750   ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
4751                  HAS_MEASURE_STD_SIMPLEX)] THEN
4752   MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE THEN
4753   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
4754   MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4755   MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
4756   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4757   MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
4758   REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]);;
4759
4760 let HAS_MEASURE_SIMPLEX = prove
4761  (`!a l:(real^N)list.
4762         LENGTH l = dimindex(:N)
4763         ==> (convex hull (set_of_list(CONS a l))) has_measure
4764             abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`,
4765   REPEAT STRIP_TAC THEN
4766   MP_TAC(ISPEC `MAP (\x:real^N. x - a) l` HAS_MEASURE_SIMPLEX_0) THEN
4767   ASM_REWRITE_TAC[LENGTH_MAP; set_of_list] THEN
4768   DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP HAS_MEASURE_TRANSLATION) THEN
4769   REWRITE_TAC[GSYM CONVEX_HULL_TRANSLATION] THEN
4770   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4771   REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; SET_OF_LIST_MAP] THEN
4772   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `a + x - a:real^N = x`;
4773               SET_RULE `IMAGE (\x. x) s = s`]);;
4774
4775 let MEASURABLE_CONVEX_HULL = prove
4776  (`!s. bounded s ==> measurable(convex hull s)`,
4777   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN
4778   ASM_SIMP_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL]);;
4779
4780 let MEASURABLE_SIMPLEX = prove
4781  (`!l. measurable(convex hull (set_of_list l))`,
4782   GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX_HULL THEN
4783   MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_SET_OF_LIST]);;
4784
4785 let MEASURE_SIMPLEX = prove
4786  (`!a l:(real^N)list.
4787         LENGTH l = dimindex(:N)
4788         ==> measure(convex hull (set_of_list(CONS a l))) =
4789             abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`,
4790   MESON_TAC[HAS_MEASURE_SIMPLEX; HAS_MEASURE_MEASURABLE_MEASURE]);;
4791
4792 (* ------------------------------------------------------------------------- *)
4793 (* Area of a triangle.                                                       *)
4794 (* ------------------------------------------------------------------------- *)
4795
4796 let HAS_MEASURE_TRIANGLE = prove
4797  (`!a b c:real^2.
4798         convex hull {a,b,c} has_measure
4799         abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`,
4800   REPEAT STRIP_TAC THEN
4801   MP_TAC(ISPECL [`a:real^2`; `[b;c]:(real^2)list`] HAS_MEASURE_SIMPLEX) THEN
4802   REWRITE_TAC[LENGTH; DIMINDEX_2; ARITH; set_of_list; MAP] THEN
4803   CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_2; VECTOR_2] THEN
4804   SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH]);;
4805
4806 let MEASURABLE_TRIANGLE = prove
4807  (`!a b c:real^N. measurable(convex hull {a,b,c})`,
4808   REPEAT GEN_TAC THEN
4809   MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4810   MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
4811   REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);;
4812
4813 let MEASURE_TRIANGLE = prove
4814  (`!a b c:real^2.
4815         measure(convex hull {a,b,c}) =
4816         abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`,
4817   REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
4818                HAS_MEASURE_TRIANGLE]);;
4819
4820 (* ------------------------------------------------------------------------- *)
4821 (* Volume of a tetrahedron.                                                  *)
4822 (* ------------------------------------------------------------------------- *)
4823
4824 let HAS_MEASURE_TETRAHEDRON = prove
4825  (`!a b c d:real^3.
4826         convex hull {a,b,c,d} has_measure
4827         abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
4828             (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
4829             (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
4830             (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
4831             (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
4832             (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) /
4833            &6`,
4834   REPEAT STRIP_TAC THEN
4835   MP_TAC(ISPECL [`a:real^3`; `[b;c;d]:(real^3)list`] HAS_MEASURE_SIMPLEX) THEN
4836   REWRITE_TAC[LENGTH; DIMINDEX_3; ARITH; set_of_list; MAP] THEN
4837   CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_3; VECTOR_3] THEN
4838   SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH]);;
4839
4840 let MEASURABLE_TETRAHEDRON = prove
4841  (`!a b c d:real^N. measurable(convex hull {a,b,c,d})`,
4842   REPEAT GEN_TAC THEN
4843   MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4844   MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
4845   REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);;
4846
4847 let MEASURE_TETRAHEDRON = prove
4848  (`!a b c d:real^3.
4849         measure(convex hull {a,b,c,d}) =
4850         abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
4851             (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
4852             (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
4853             (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
4854             (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
4855             (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / &6`,
4856   REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
4857                HAS_MEASURE_TETRAHEDRON]);;
4858
4859 (* ------------------------------------------------------------------------- *)
4860 (* Steinhaus's theorem. (Stromberg's proof as given on Wikipedia.)           *)
4861 (* ------------------------------------------------------------------------- *)
4862
4863 let STEINHAUS = prove
4864  (`!s:real^N->bool.
4865         measurable s /\ &0 < measure s
4866         ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`,
4867   REPEAT STRIP_TAC THEN
4868   MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`]
4869     MEASURABLE_INNER_COMPACT) THEN
4870   MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`]
4871     MEASURABLE_OUTER_OPEN) THEN
4872   ASM_REWRITE_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN
4873   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4874   DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
4875   MP_TAC(ISPECL [`k:real^N->bool`; `(:real^N) DIFF u`]
4876     SEPARATE_COMPACT_CLOSED) THEN
4877   ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN
4878   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4879   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
4880   ASM_REWRITE_TAC[] THEN
4881   REWRITE_TAC[SUBSET; IN_BALL_0; IN_ELIM_THM] THEN
4882   X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
4883   SUBGOAL_THEN `~((IMAGE (\x:real^N. v + x) k) INTER k = {})` MP_TAC THENL
4884    [DISCH_TAC THEN
4885     MP_TAC(ISPECL [`IMAGE (\x:real^N. v + x) k`; `k:real^N->bool`]
4886         MEASURE_UNION) THEN
4887     ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_EMPTY] THEN
4888     REWRITE_TAC[MEASURE_TRANSLATION; REAL_SUB_RZERO] THEN
4889     MATCH_MP_TAC(REAL_ARITH
4890      `!s:real^N->bool u:real^N->bool.
4891         measure u < measure s + measure s / &3 /\
4892         measure s < measure k + measure s / &3 /\
4893         measure x <= measure u
4894         ==> ~(measure x = measure k + measure k)`) THEN
4895     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
4896     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
4897     ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_UNION] THEN
4898     ASM_REWRITE_TAC[UNION_SUBSET] THEN
4899     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4900     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
4901     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
4902     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `v + x:real^N`]) THEN
4903     ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; NORM_ARITH
4904      `d <= dist(x:real^N,v + x) <=> ~(norm v < d)`];
4905     REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_IMAGE] THEN
4906     REWRITE_TAC[VECTOR_ARITH `v:real^N = x - y <=> x = v + y`] THEN
4907     ASM SET_TAC[]]);;
4908
4909 (* ------------------------------------------------------------------------- *)
4910 (* A measurable set with cardinality less than c is negligible.              *)
4911 (* ------------------------------------------------------------------------- *)
4912
4913 let MEASURABLE_NONNEGLIGIBLE_IMP_LARGE = prove
4914  (`!s:real^N->bool. measurable s /\ &0 < measure s ==> s =_c (:real)`,
4915   REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THENL
4916    [ASM_MESON_TAC[NEGLIGIBLE_FINITE; MEASURABLE_MEASURE_POS_LT];
4917     ALL_TAC] THEN
4918   DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN
4919   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4920   REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
4921    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
4922     REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
4923     REWRITE_TAC[CARD_EQ_EUCLIDEAN];
4924     ALL_TAC] THEN
4925   TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL
4926    [MESON_TAC[CARD_EQ_EUCLIDEAN; CARD_EQ_SYM; CARD_EQ_IMP_LE]; ALL_TAC] THEN
4927   TRANS_TAC CARD_LE_TRANS `interval(vec 0:real^N,vec 1)` THEN CONJ_TAC THENL
4928    [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
4929     MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN
4930     MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVAL_UNIV THEN
4931     REWRITE_TAC[UNIT_INTERVAL_NONEMPTY];
4932     ALL_TAC] THEN
4933   TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^N,vec 1]` THEN
4934   SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CARD_LE_SUBSET] THEN
4935   TRANS_TAC CARD_LE_TRANS `cball(vec 0:real^N,d / &2)` THEN CONJ_TAC THENL
4936    [MATCH_MP_TAC CARD_EQ_IMP_LE THEN
4937     MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN
4938     MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN
4939     REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; INTERIOR_CLOSED_INTERVAL;
4940                 CONVEX_CBALL; COMPACT_CBALL; UNIT_INTERVAL_NONEMPTY;
4941                 INTERIOR_CBALL; BALL_EQ_EMPTY] THEN
4942     ASM_REAL_ARITH_TAC;
4943     ALL_TAC] THEN
4944   TRANS_TAC CARD_LE_TRANS `ball(vec 0:real^N,d)` THEN CONJ_TAC THENL
4945    [MATCH_MP_TAC CARD_LE_SUBSET THEN
4946     REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC;
4947     ALL_TAC] THEN
4948   TRANS_TAC CARD_LE_TRANS `IMAGE (\(x:real^N,y). x - y) (s *_c s)` THEN
4949   CONJ_TAC THENL
4950    [ASM_SIMP_TAC[mul_c; CARD_LE_SUBSET; SET_RULE
4951      `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`];
4952     ALL_TAC] THEN
4953   TRANS_TAC CARD_LE_TRANS `((s:real^N->bool) *_c s)` THEN
4954   REWRITE_TAC[CARD_LE_IMAGE] THEN
4955   MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN
4956   ASM_REWRITE_TAC[INFINITE]);;
4957
4958 let MEASURABLE_SMALL_IMP_NEGLIGIBLE = prove
4959  (`!s:real^N->bool. measurable s /\ s <_c (:real) ==> negligible s`,
4960   GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> ~c ==> ~b`] THEN
4961   SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT] THEN REWRITE_TAC[IMP_IMP] THEN
4962   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_NONNEGLIGIBLE_IMP_LARGE) THEN
4963   REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);;
4964
4965 (* ------------------------------------------------------------------------- *)
4966 (* Austin's Lemma.                                                           *)
4967 (* ------------------------------------------------------------------------- *)
4968
4969 let AUSTIN_LEMMA = prove
4970  (`!D. FINITE D /\
4971        (!d. d IN D
4972             ==> ?k a b. d = interval[a:real^N,b] /\
4973                         (!i. 1 <= i /\ i <= dimindex(:N) ==> b$i - a$i = k))
4974        ==> ?D'. D' SUBSET D /\ pairwise DISJOINT D' /\
4975                 measure(UNIONS D') >=
4976                 measure(UNIONS D) / &3 pow (dimindex(:N))`,
4977   GEN_TAC THEN WF_INDUCT_TAC `CARD(D:(real^N->bool)->bool)` THEN
4978   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN
4979   ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL
4980    [ASM_REWRITE_TAC[SUBSET_EMPTY; UNWIND_THM2; PAIRWISE_EMPTY] THEN
4981     REWRITE_TAC[UNIONS_0; real_ge; MEASURE_EMPTY; NOT_IN_EMPTY] THEN
4982     REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_LE_REFL];
4983     ALL_TAC] THEN
4984   SUBGOAL_THEN
4985    `?d:real^N->bool. d IN D /\ !d'. d' IN D ==> measure d' <= measure d`
4986   STRIP_ASSUME_TAC THENL
4987    [MP_TAC(ISPEC `IMAGE measure (D:(real^N->bool)->bool)` SUP_FINITE) THEN
4988     ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN SET_TAC[];
4989     ALL_TAC] THEN
4990   FIRST_X_ASSUM(MP_TAC o SPEC
4991     `{c:real^N->bool | c IN (D DELETE d) /\ c INTER d = {}}`) THEN
4992   ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN
4993   ASM_SIMP_TAC[FINITE_DELETE; FINITE_RESTRICT; IN_ELIM_THM; real_ge] THEN
4994   ANTS_TAC THENL [ASM_SIMP_TAC[IN_DELETE]; ALL_TAC] THEN
4995   DISCH_THEN(X_CHOOSE_THEN `D':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
4996   EXISTS_TAC `(d:real^N->bool) INSERT D'` THEN REPEAT CONJ_TAC THENL
4997    [ASM SET_TAC[];
4998     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
4999     REWRITE_TAC[pairwise; IN_INSERT] THEN ASM SET_TAC[];
5000     ALL_TAC] THEN
5001   SUBGOAL_THEN
5002    `?a3 b3:real^N.
5003         measure(interval[a3,b3]) = &3 pow dimindex(:N) * measure d /\
5004         !c. c IN D /\ ~(c INTER d = {}) ==> c SUBSET interval[a3,b3]`
5005   STRIP_ASSUME_TAC THENL
5006    [USE_THEN "*" (MP_TAC o SPEC `d:real^N->bool`) THEN
5007     ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
5008     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5009     MAP_EVERY X_GEN_TAC [`k:real`; `a:real^N`; `b:real^N`] THEN
5010     DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
5011     EXISTS_TAC `inv(&2) % (a + b) - &3 / &2 % (b - a):real^N` THEN
5012     EXISTS_TAC `inv(&2) % (a + b) + &3 / &2 % (b - a):real^N` THEN
5013     CONJ_TAC THENL
5014      [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5015       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
5016                   VECTOR_MUL_COMPONENT] THEN
5017       REWRITE_TAC[REAL_ARITH `(x + &3 / &2 * a) - (x - &3 / &2 * a) = &3 * a`;
5018                   REAL_ARITH `x - a <= x + a <=> &0 <= a`] THEN
5019       ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
5020       ASM_SIMP_TAC[REAL_ARITH `&0 <= &3 / &2 * x - &0 <=> &0 <= x`] THEN
5021       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
5022       SIMP_TAC[PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; REAL_POW_MUL];
5023       X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
5024       REMOVE_THEN "*" (MP_TAC o SPEC `c:real^N->bool`) THEN
5025       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5026       MAP_EVERY X_GEN_TAC [`k':real`; `a':real^N`; `b':real^N`] THEN
5027       DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
5028       FIRST_X_ASSUM(MP_TAC o
5029         GEN_REWRITE_RULE RAND_CONV [DISJOINT_INTERVAL]) THEN
5030       REWRITE_TAC[NOT_EXISTS_THM; SUBSET_INTERVAL] THEN
5031       REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
5032       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5033       ASM_CASES_TAC `1 <= i` THEN ASM_REWRITE_TAC[] THEN
5034       ASM_CASES_TAC `i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
5035       FIRST_X_ASSUM(MP_TAC o SPEC `interval[a':real^N,b']`) THEN
5036       ASM_REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5037       REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN
5038       REWRITE_TAC[REAL_ARITH `a$k <= b$k <=> &0 <= b$k - a$k`] THEN
5039       ASM_SIMP_TAC[IN_NUMSEG] THEN
5040       ASM_CASES_TAC `&0 <= k` THEN ASM_REWRITE_TAC[] THEN
5041       ASM_CASES_TAC `&0 <= k'` THEN ASM_REWRITE_TAC[] THEN
5042       REPEAT(FIRST_X_ASSUM(fun th ->
5043         SIMP_TAC[th] THEN MP_TAC(ISPEC `i:num` th))) THEN
5044       ASM_SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG] THEN
5045       DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
5046        (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`]
5047         REAL_POW_LE2_REV)) THEN
5048       ASM_SIMP_TAC[DIMINDEX_GE_1; LE_1] THEN
5049       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
5050                   VECTOR_MUL_COMPONENT] THEN
5051       ASM_REAL_ARITH_TAC];
5052     ALL_TAC] THEN
5053   REWRITE_TAC[UNIONS_INSERT] THEN
5054   SUBGOAL_THEN `!d:real^N->bool. d IN D ==> measurable d` ASSUME_TAC THENL
5055    [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
5056   W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DISJOINT_UNION o
5057     rand o snd) THEN
5058   ANTS_TAC THENL
5059    [ASM_SIMP_TAC[] THEN
5060     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5061     MATCH_MP_TAC MEASURABLE_UNIONS THEN
5062     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5063     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
5064       FINITE_SUBSET)) THEN
5065     ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_DELETE];
5066     DISCH_THEN SUBST1_TAC] THEN
5067   ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5068   MATCH_MP_TAC REAL_LE_TRANS THEN
5069   EXISTS_TAC `measure(interval[a3:real^N,b3]) +
5070               measure(UNIONS D DIFF interval[a3,b3])` THEN
5071   CONJ_TAC THENL
5072    [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNION o
5073       rand o snd) THEN
5074     ANTS_TAC THENL
5075      [ASM_SIMP_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF;
5076                    MEASURABLE_INTERVAL] THEN SET_TAC[];
5077       DISCH_THEN(SUBST1_TAC o SYM) THEN
5078       MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
5079        [ASM_SIMP_TAC[MEASURABLE_UNIONS];
5080         ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF;
5081                      MEASURABLE_INTERVAL; MEASURABLE_UNION];
5082         SET_TAC[]]];
5083     ASM_REWRITE_TAC[REAL_ARITH `a * x + y <= (x + z) * a <=> y <= z * a`] THEN
5084     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5085     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5086      `y <= a ==> x <= y ==> x <= a`)) THEN
5087     SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5088     MATCH_MP_TAC MEASURE_SUBSET THEN
5089     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNIONS; MEASURABLE_INTERVAL;
5090                  IN_ELIM_THM; IN_DELETE; FINITE_DELETE; FINITE_RESTRICT] THEN
5091     ASM SET_TAC[]]);;
5092
5093 (* ------------------------------------------------------------------------- *)
5094 (* Some differentiability-like properties of the indefinite integral.        *)
5095 (* The first two proofs are minor variants of each other, but it was more    *)
5096 (* work to derive one from the other.                                        *)
5097 (* ------------------------------------------------------------------------- *)
5098
5099 let INTEGRABLE_CCONTINUOUS_EXPLICIT = prove
5100  (`!f:real^M->real^N.
5101     (!a b. f integrable_on interval[a,b])
5102     ==> ?k. negligible k /\
5103          !x e. ~(x IN k) /\ &0 < e
5104                ==> ?d. &0 < d /\
5105                        !h. &0 < h /\ h < d
5106                            ==> norm(inv(content(interval[x,x + h % vec 1])) %
5107                                     integral (interval[x,x + h % vec 1]) f -
5108                                     f(x)) < e`,
5109   REPEAT STRIP_TAC THEN REWRITE_TAC[IN_UNIV] THEN
5110   MAP_EVERY ABBREV_TAC
5111    [`box = \h x. interval[x:real^M,x + h % vec 1]`;
5112     `box2 = \h x. interval[x:real^M - h % vec 1,x + h % vec 1]`;
5113     `i = \h:real x:real^M. inv(content(box h x)) %
5114                       integral (box h x) (f:real^M->real^N)`] THEN
5115   SUBGOAL_THEN
5116    `?k. negligible k /\
5117         !x e. ~(x IN k) /\ &0 < e
5118               ==> ?d. &0 < d /\
5119                       !h. &0 < h /\ h < d
5120                           ==> norm(i h x - (f:real^M->real^N) x) < e`
5121   MP_TAC THENL
5122    [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN
5123   EXISTS_TAC
5124    `{x | ~(!e. &0 < e
5125               ==> ?d. &0 < d /\
5126                       !h. &0 < h /\ h < d
5127                           ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN
5128   SIMP_TAC[IN_ELIM_THM] THEN
5129   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
5130   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
5131   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5132   EXISTS_TAC
5133    `UNIONS {{x | !d. &0 < d
5134                      ==> ?h. &0 < h /\ h < d /\
5135                              inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)}
5136             |  k IN (:num)}` THEN
5137   CONJ_TAC THENL
5138    [ALL_TAC;
5139     REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5140     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
5141     MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN
5142     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN
5143     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
5144     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
5145     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN
5146     X_GEN_TAC `d:real` THEN DISCH_TAC THEN
5147     FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN
5148     ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN
5149     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5150     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5151     ASM_REWRITE_TAC[dist] THEN
5152     MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
5153     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN
5154     CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
5155     MATCH_MP_TAC REAL_LE_INV2 THEN
5156     ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
5157     ASM_ARITH_TAC] THEN
5158   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN
5159   X_GEN_TAC `jj:num` THEN
5160   SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL
5161    [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
5162     SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN
5163   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
5164   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
5165   ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL
5166    [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN
5167   RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN
5168   RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
5169   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
5170   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5171   MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`]
5172     HENSTOCK_LEMMA) THEN
5173   ANTS_TAC THENL
5174    [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN
5175   DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &6 pow (dimindex(:M))`) THEN
5176   ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL;
5177                REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5178   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN
5179   REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN
5180   ABBREV_TAC
5181     `E = {x | x IN interval[a,b] /\
5182               !d. &0 < d
5183                    ==> ?h. &0 < h /\ h < d /\
5184                            mu <= dist(i h x,(f:real^M->real^N) x)}` THEN
5185   SUBGOAL_THEN
5186    `!x. x IN E
5187         ==> ?h. &0 < h /\
5188                 (box h x:real^M->bool) SUBSET (g x) /\
5189                 (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\
5190                 mu <= dist(i h x,(f:real^M->real^N) x)`
5191   MP_TAC THENL
5192    [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN
5193     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5194     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN
5195     REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
5196     DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
5197     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5198     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5199      (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN
5200     REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN
5201     ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN
5202     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5203     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5204      [MATCH_MP_TAC SUBSET_TRANS THEN
5205       EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN
5206       EXPAND_TAC "box" THEN
5207       REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN
5208       X_GEN_TAC `y:real^M` THEN
5209       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5210                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5211       DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5212       EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN
5213       REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
5214       REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN
5215       SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN
5216       X_GEN_TAC `i:num` THEN STRIP_TAC THEN
5217       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
5218       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
5219       UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN
5220       EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN
5221       DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN
5222       REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
5223       X_GEN_TAC `i:num` THEN
5224       DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5225       ASM_REWRITE_TAC[] THEN
5226       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5227                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5228       ASM_REAL_ARITH_TAC];
5229     ALL_TAC] THEN
5230   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5231   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5232   X_GEN_TAC `uv:real^M->real` THEN
5233   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
5234   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
5235   MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`;
5236                  `\x:real^M. if x IN E then ball(x,uv x) else g(x)`]
5237    COVERING_LEMMA) THEN
5238   REWRITE_TAC[] THEN ANTS_TAC THENL
5239    [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL
5240      [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN
5241     REWRITE_TAC[gauge] THEN GEN_TAC THEN
5242     COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
5243     RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[];
5244     ALL_TAC] THEN
5245   DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN
5246   EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5247   SUBGOAL_THEN
5248    `measurable(UNIONS D:real^M->bool) /\
5249     measure(UNIONS D) <= measure(interval[a:real^M,b])`
5250   STRIP_ASSUME_TAC THENL
5251    [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
5252     ASM_REWRITE_TAC[] THEN
5253     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN
5254     REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5255     REWRITE_TAC[MEASURABLE_INTERVAL] THEN
5256     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5257     MATCH_MP_TAC MEASURABLE_UNIONS THEN
5258     ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5259     ALL_TAC] THEN
5260   ASM_REWRITE_TAC[] THEN
5261   SUBGOAL_THEN
5262    `?d. d SUBSET D /\ FINITE d /\
5263         measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)`
5264   STRIP_ASSUME_TAC THENL
5265    [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL
5266      [EXISTS_TAC `{}:(real^M->bool)->bool` THEN
5267       ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN
5268       CONV_TAC REAL_RAT_REDUCE_CONV;
5269       MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`;
5270                      `measure(UNIONS D:real^M->bool) / &2`]
5271                 MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN
5272       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5273        [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN
5274         ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN
5275         CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
5276         REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5277         REPEAT(CONJ_TAC THENL
5278           [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS];
5279            ALL_TAC]) THEN
5280         ASM SET_TAC[];
5281         MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]];
5282     ALL_TAC] THEN
5283   FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN
5284   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
5285   ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN
5286   SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
5287   DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN
5288   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5289    `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN
5290   MP_TAC(ISPEC
5291    `IMAGE (\k:real^M->bool. (box2:real->real^M->real^M->bool)
5292                             (uv(tag k):real) ((tag k:real^M))) d`
5293    AUSTIN_LEMMA) THEN
5294   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
5295    [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box2" THEN
5296     EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN
5297     EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN
5298     EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN
5299     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5300                 VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5301     ASM_REAL_ARITH_TAC;
5302     ALL_TAC] THEN
5303   REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN
5304   SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5305   DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN
5306   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5307   MATCH_MP_TAC(REAL_ARITH
5308    `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN
5309   CONJ_TAC THENL
5310    [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
5311      [MATCH_MP_TAC MEASURABLE_UNIONS THEN
5312       ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5313       MATCH_MP_TAC MEASURABLE_UNIONS THEN
5314       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5315       EXPAND_TAC "box2" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
5316       REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN
5317       X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN
5318       X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5319       UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN
5320       REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
5321       EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN
5322       CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5323       EXPAND_TAC "box2" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN
5324       X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
5325       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5326                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5327
5328       SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
5329       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
5330       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]];
5331     ALL_TAC] THEN
5332   MATCH_MP_TAC REAL_LE_TRANS THEN
5333   EXISTS_TAC `measure(UNIONS (IMAGE (\k:real^M->bool.
5334                             (box:real->real^M->real^M->bool)
5335                             (uv(tag k):real) ((tag k:real^M))) p)) *
5336               &6 pow dimindex (:M)` THEN
5337   CONJ_TAC THENL
5338    [SUBGOAL_THEN
5339      `!box. IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool)
5340                                     (uv(tag k):real) ((tag k:real^M))) p =
5341              IMAGE (\t. box (uv t) t) (IMAGE tag p)`
5342      (fun th -> REWRITE_TAC[th])
5343     THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF]; ALL_TAC] THEN
5344     W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
5345         lhand o rand o snd) THEN
5346     W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
5347         lhand o lhand o rand o snd) THEN
5348     MATCH_MP_TAC(TAUT
5349      `fp /\ (mb /\ mb') /\ (db /\ db') /\ (m1 /\ m2 ==> p)
5350       ==> (fp /\ mb /\ db ==> m1) ==> (fp /\ mb' /\ db' ==> m2) ==> p`) THEN
5351     SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL
5352      [ASM_MESON_TAC[FINITE_SUBSET]; ASM_SIMP_TAC[FINITE_IMAGE]] THEN
5353     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5354      [MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5355       REWRITE_TAC[MEASURABLE_INTERVAL];
5356       ALL_TAC] THEN
5357     CONJ_TAC THENL
5358      [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5359       REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; AND_FORALL_THM] THEN
5360       MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN
5361       MATCH_MP_TAC(TAUT
5362         `(q ==> r) /\ (p ==> q) ==> (p ==> q) /\ (p ==> r)`) THEN
5363       CONJ_TAC THENL
5364        [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
5365         MATCH_MP_TAC(SET_RULE
5366         `s SUBSET s' /\ t SUBSET t' ==> (s INTER t) SUBSET (s' INTER t')`) THEN
5367         CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5368         REWRITE_TAC[SUBSET_INTERVAL] THEN
5369         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5370                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5371         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5372         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5373         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5374         ALL_TAC] THEN
5375       STRIP_TAC THEN
5376       MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN
5377       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
5378       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5379       DISCH_THEN(MP_TAC o SPEC `k1:real^M->bool`) THEN
5380       ASM_REWRITE_TAC[] THEN
5381       DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool`) THEN
5382       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5383        [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5384         REWRITE_TAC[SUBSET_INTERVAL] THEN
5385         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5386                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5387         REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN
5388         SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\
5389                       &0 <= uv((tag:(real^M->bool)->real^M) k2)`
5390         STRIP_ASSUME_TAC THENL
5391          [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN
5392         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
5393         MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN
5394         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5395         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5396         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5397         SET_TAC[]];
5398       ALL_TAC] THEN
5399     DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN
5400     REWRITE_TAC[GSYM SUM_RMUL] THEN
5401     MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN
5402     X_GEN_TAC `t:real^M` THEN DISCH_THEN(K ALL_TAC) THEN
5403     SUBST1_TAC(REAL_ARITH `&6 = &2 * &3`) THEN
5404     REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN
5405     AP_THM_TAC THEN AP_TERM_TAC THEN
5406     MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5407     REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5408     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5409                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5410     REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`;
5411                 REAL_ARITH `a - x <= a + x <=> &0 <= x`] THEN
5412     COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
5413     REWRITE_TAC[REAL_ARITH `(t + h) - (t - h):real = &2 * h`;
5414                 REAL_ARITH `(t + h) - t:real = h`] THEN
5415     REWRITE_TAC[PRODUCT_MUL_NUMSEG; PRODUCT_CONST_NUMSEG] THEN
5416     REWRITE_TAC[ADD_SUB; REAL_MUL_AC];
5417     ALL_TAC] THEN
5418   SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5419   SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL
5420    [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
5421   MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
5422   EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN
5423   FIRST_X_ASSUM(MP_TAC o SPEC
5424    `IMAGE (\k. (tag:(real^M->bool)->real^M) k,
5425                 (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN
5426   ANTS_TAC THENL
5427    [REWRITE_TAC[tagged_partial_division_of; fine] THEN
5428     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5429     REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN
5430     REWRITE_TAC[MESON[]
5431      `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=>
5432       (!k. k IN d ==> P (tag k) (g k))`] THEN
5433     ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL
5434      [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
5435        [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN
5436         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5437                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5438         GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
5439          `&0 < u ==> x <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET];
5440         ASM_MESON_TAC[SUBSET];
5441         EXPAND_TAC "box" THEN MESON_TAC[]];
5442       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
5443       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5444       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN
5445       ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
5446       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN
5447       ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
5448       ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN
5449       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5450        [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5451         REWRITE_TAC[SUBSET_INTERVAL] THEN
5452         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5453                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5454         REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN
5455         SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\
5456                       &0 <= uv((tag:(real^M->bool)->real^M) k2)`
5457         STRIP_ASSUME_TAC THENL
5458          [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN
5459         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
5460         MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN
5461         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5462         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5463         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5464         MATCH_MP_TAC(SET_RULE
5465          `i1 SUBSET s1 /\ i2 SUBSET s2
5466           ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN
5467         CONJ_TAC THEN MATCH_MP_TAC(MESON[INTERIOR_SUBSET; SUBSET_TRANS]
5468          `s SUBSET t ==> interior s SUBSET t`) THEN
5469         MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5470         REWRITE_TAC[SUBSET_INTERVAL] THEN
5471         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5472                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5473         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5474         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5475         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC];
5476       ASM_MESON_TAC[SUBSET]];
5477     ALL_TAC] THEN
5478   MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN
5479   CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN
5480   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
5481   W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN
5482   ANTS_TAC THENL
5483    [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5484     EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
5485     ALL_TAC] THEN
5486   MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN
5487   ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN
5488   MATCH_MP_TAC SUM_LE_INCLUDED THEN
5489   ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN
5490   REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN
5491   EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN
5492   X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
5493   EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5494   SUBGOAL_THEN
5495    `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC
5496   THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5497   SUBGOAL_THEN
5498    `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)`
5499   MP_TAC THENL
5500    [EXPAND_TAC "box" THEN
5501     REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5502     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5503                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5504     ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a <= a + x`] THEN
5505     MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN
5506     REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
5507     ALL_TAC] THEN
5508   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
5509   DISCH_THEN(fun th ->
5510    GEN_REWRITE_TAC (funpow 2 RAND_CONV)
5511     [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN
5512    ASSUME_TAC th) THEN
5513   REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN
5514   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN
5515   SUBGOAL_THEN
5516    `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N,
5517                f(tag k))`
5518   MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5519   MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN
5520   ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN
5521   REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN
5522   UNDISCH_TAC
5523     `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real)
5524                 (tag k):real^M->bool)` THEN
5525   EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN
5526   SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN
5527   REWRITE_TAC[VECTOR_MUL_LID]);;
5528
5529 let INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC = prove
5530  (`!f:real^M->real^N.
5531     (!a b. f integrable_on interval[a,b])
5532     ==> ?k. negligible k /\
5533          !x e. ~(x IN k) /\ &0 < e
5534                ==> ?d. &0 < d /\
5535                        !h. &0 < h /\ h < d
5536                 ==> norm(inv(content(interval[x - h % vec 1,x + h % vec 1])) %
5537                     integral (interval[x - h % vec 1,x + h % vec 1]) f -
5538                     f(x)) < e`,
5539   REPEAT STRIP_TAC THEN
5540   MAP_EVERY ABBREV_TAC
5541    [`box = \h x. interval[x - h % vec 1:real^M,x + h % vec 1]`;
5542     `i = \h:real x:real^M. inv(content(box h x)) %
5543                       integral (box h x) (f:real^M->real^N)`] THEN
5544   SUBGOAL_THEN
5545    `?k. negligible k /\
5546         !x e. ~(x IN k) /\ &0 < e
5547               ==> ?d. &0 < d /\
5548                       !h. &0 < h /\ h < d
5549                           ==> norm(i h x - (f:real^M->real^N) x) < e`
5550   MP_TAC THENL
5551    [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN
5552   EXISTS_TAC
5553    `{x | ~(!e. &0 < e
5554               ==> ?d. &0 < d /\
5555                       !h. &0 < h /\ h < d
5556                           ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN
5557   SIMP_TAC[IN_ELIM_THM] THEN
5558   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
5559   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
5560   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5561   EXISTS_TAC
5562    `UNIONS {{x | !d. &0 < d
5563                      ==> ?h. &0 < h /\ h < d /\
5564                              inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)}
5565             |  k IN (:num)}` THEN
5566   CONJ_TAC THENL
5567    [ALL_TAC;
5568     REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5569     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
5570     MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN
5571     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN
5572     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
5573     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
5574     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN
5575     X_GEN_TAC `d:real` THEN DISCH_TAC THEN
5576     FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN
5577     ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN
5578     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5579     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5580     ASM_REWRITE_TAC[dist] THEN
5581     MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
5582     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN
5583     CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
5584     MATCH_MP_TAC REAL_LE_INV2 THEN
5585     ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
5586     ASM_ARITH_TAC] THEN
5587   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN
5588   X_GEN_TAC `jj:num` THEN
5589   SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL
5590    [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
5591     SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN
5592   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
5593   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
5594   ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL
5595    [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN
5596   RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN
5597   RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
5598   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
5599   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5600   MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`]
5601     HENSTOCK_LEMMA) THEN
5602   ANTS_TAC THENL
5603    [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN
5604   DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &3 pow (dimindex(:M))`) THEN
5605   ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL;
5606                REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5607   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN
5608   REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN
5609   ABBREV_TAC
5610     `E = {x | x IN interval[a,b] /\
5611               !d. &0 < d
5612                    ==> ?h. &0 < h /\ h < d /\
5613                            mu <= dist(i h x,(f:real^M->real^N) x)}` THEN
5614   SUBGOAL_THEN
5615    `!x. x IN E
5616         ==> ?h. &0 < h /\
5617                 (box h x:real^M->bool) SUBSET (g x) /\
5618                 (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\
5619                 mu <= dist(i h x,(f:real^M->real^N) x)`
5620   MP_TAC THENL
5621    [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN
5622     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5623     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN
5624     REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
5625     DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
5626     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5627     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5628      (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN
5629     REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN
5630     ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN
5631     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5632     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5633      [MATCH_MP_TAC SUBSET_TRANS THEN
5634       EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN
5635       EXPAND_TAC "box" THEN
5636       REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN
5637       X_GEN_TAC `y:real^M` THEN
5638       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5639                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5640       SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
5641       DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5642       EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN
5643       REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
5644       REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN
5645       SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN
5646       ASM_MESON_TAC[REAL_LET_TRANS];
5647       UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN
5648       EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN
5649       DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN
5650       REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
5651       X_GEN_TAC `i:num` THEN
5652       DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5653       ASM_REWRITE_TAC[] THEN
5654       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5655                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5656       ASM_REAL_ARITH_TAC];
5657     ALL_TAC] THEN
5658   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5659   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5660   X_GEN_TAC `uv:real^M->real` THEN
5661   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
5662   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
5663   MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`;
5664                  `\x:real^M. if x IN E then ball(x,uv x) else g(x)`]
5665    COVERING_LEMMA) THEN
5666   REWRITE_TAC[] THEN ANTS_TAC THENL
5667    [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL
5668      [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN
5669     REWRITE_TAC[gauge] THEN GEN_TAC THEN
5670     COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
5671     RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[];
5672     ALL_TAC] THEN
5673   DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN
5674   EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5675   SUBGOAL_THEN
5676    `measurable(UNIONS D:real^M->bool) /\
5677     measure(UNIONS D) <= measure(interval[a:real^M,b])`
5678   STRIP_ASSUME_TAC THENL
5679    [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
5680     ASM_REWRITE_TAC[] THEN
5681     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN
5682     REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5683     REWRITE_TAC[MEASURABLE_INTERVAL] THEN
5684     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5685     MATCH_MP_TAC MEASURABLE_UNIONS THEN
5686     ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5687     ALL_TAC] THEN
5688   ASM_REWRITE_TAC[] THEN
5689   SUBGOAL_THEN
5690    `?d. d SUBSET D /\ FINITE d /\
5691         measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)`
5692   STRIP_ASSUME_TAC THENL
5693    [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL
5694      [EXISTS_TAC `{}:(real^M->bool)->bool` THEN
5695       ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN
5696       CONV_TAC REAL_RAT_REDUCE_CONV;
5697       MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`;
5698                      `measure(UNIONS D:real^M->bool) / &2`]
5699                 MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN
5700       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5701        [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN
5702         ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN
5703         CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
5704         REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5705         REPEAT(CONJ_TAC THENL
5706           [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS];
5707            ALL_TAC]) THEN
5708         ASM SET_TAC[];
5709         MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]];
5710     ALL_TAC] THEN
5711   FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN
5712   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
5713   ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN
5714   SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
5715   DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN
5716   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5717    `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN
5718   MP_TAC(ISPEC
5719    `IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool)
5720                             (uv(tag k):real) ((tag k:real^M))) d`
5721    AUSTIN_LEMMA) THEN
5722   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
5723    [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box" THEN
5724     EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN
5725     EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN
5726     EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN
5727     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5728                 VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5729     ASM_REAL_ARITH_TAC;
5730     ALL_TAC] THEN
5731   REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN
5732   SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5733   DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN
5734   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5735   MATCH_MP_TAC(REAL_ARITH
5736    `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN
5737   CONJ_TAC THENL
5738    [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
5739      [MATCH_MP_TAC MEASURABLE_UNIONS THEN
5740       ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5741       MATCH_MP_TAC MEASURABLE_UNIONS THEN
5742       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5743       EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
5744       REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN
5745       X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN
5746       X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5747       UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN
5748       REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
5749       EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN
5750       CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5751       EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN
5752       X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
5753       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5754                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5755       SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
5756       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
5757       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]];
5758     ALL_TAC] THEN
5759   SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5760   SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL
5761    [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
5762   MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
5763   EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN
5764   FIRST_X_ASSUM(MP_TAC o SPEC
5765    `IMAGE (\k. (tag:(real^M->bool)->real^M) k,
5766                 (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN
5767   ANTS_TAC THENL
5768    [REWRITE_TAC[tagged_partial_division_of; fine] THEN
5769     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5770     REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN
5771     REWRITE_TAC[MESON[]
5772      `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=>
5773       (!k. k IN d ==> P (tag k) (g k))`] THEN
5774     ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL
5775      [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
5776        [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN
5777         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5778                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5779         GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
5780          `&0 < u ==> x - u <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET];
5781         ASM_MESON_TAC[SUBSET];
5782         EXPAND_TAC "box" THEN MESON_TAC[]];
5783       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
5784       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5785       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN
5786       ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
5787       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN
5788       ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
5789       ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN
5790       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5791        [EXPAND_TAC "box" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5792         REWRITE_TAC[SUBSET_INTERVAL] THEN
5793         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5794                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5795         REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN
5796         SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\
5797                       &0 <= uv((tag:(real^M->bool)->real^M) k2)`
5798         STRIP_ASSUME_TAC THENL
5799          [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN
5800         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
5801         MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN
5802         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5803         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5804         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5805         MATCH_MP_TAC(SET_RULE
5806          `i1 SUBSET s1 /\ i2 SUBSET s2
5807           ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN
5808         REWRITE_TAC[INTERIOR_SUBSET]];
5809       ASM_MESON_TAC[SUBSET]];
5810     ALL_TAC] THEN
5811   MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN
5812   CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN
5813   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
5814   W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN
5815   ANTS_TAC THENL
5816    [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5817     EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
5818     ALL_TAC] THEN
5819   MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN
5820   ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN
5821   MATCH_MP_TAC SUM_LE_INCLUDED THEN
5822   ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN
5823   REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN
5824   EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN
5825   X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
5826   EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5827   SUBGOAL_THEN
5828    `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC
5829   THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5830   SUBGOAL_THEN
5831    `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag
5832 k):real^M->bool)`
5833   MP_TAC THENL
5834    [EXPAND_TAC "box" THEN
5835     REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5836     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5837                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5838     ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a - x <= a + x`] THEN
5839     MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN
5840     REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
5841     ALL_TAC] THEN
5842   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
5843   DISCH_THEN(fun th ->
5844    GEN_REWRITE_TAC (funpow 2 RAND_CONV)
5845     [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN
5846    ASSUME_TAC th) THEN
5847   REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN
5848   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN
5849   SUBGOAL_THEN
5850    `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N,
5851                f(tag k))`
5852   MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5853   MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN
5854   ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN
5855   REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN
5856   UNDISCH_TAC
5857     `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real)
5858                 (tag k):real^M->bool)` THEN
5859   EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN
5860   SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN
5861   REWRITE_TAC[VECTOR_MUL_LID]);;
5862
5863 let HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL = prove
5864  (`!f:real^1->real^N a b.
5865         f integrable_on interval[a,b]
5866         ==> ?k. negligible k /\
5867                 !x. x IN interval[a,b] DIFF k
5868                     ==> ((\x. integral(interval[a,x]) f) has_vector_derivative
5869                          f(x)) (at x within interval[a,b])`,
5870   SUBGOAL_THEN
5871    `!f:real^1->real^N a b.
5872         f integrable_on interval[a,b]
5873         ==> ?k. negligible k /\
5874                 !x e. x IN interval[a,b] DIFF k /\ & 0 < e
5875                       ==> ?d. &0 < d /\
5876                               !x'. x' IN interval[a,b] /\
5877                                    drop x < drop x' /\ drop x' < drop x + d
5878                                    ==> norm(integral(interval[x,x']) f -
5879                                             drop(x' - x) % f x) /
5880                                        norm(x' - x) < e`
5881   ASSUME_TAC THENL
5882    [REPEAT STRIP_TAC THEN MP_TAC(ISPEC
5883      `(\x. if x IN interval[a,b] then f x else vec 0):real^1->real^N`
5884      INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN
5885     REWRITE_TAC[] THEN ANTS_TAC THENL
5886      [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
5887       EXISTS_TAC `(:real^1)` THEN
5888       ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; SUBSET_UNIV];
5889       ALL_TAC] THEN
5890     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
5891     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5892     MAP_EVERY X_GEN_TAC [`x:real^1`; `e:real`] THEN
5893     REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
5894     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN
5895     ASM_REWRITE_TAC[] THEN
5896     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
5897     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5898     X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN
5899     FIRST_X_ASSUM(MP_TAC o SPEC `drop y - drop x`) THEN
5900     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5901     SUBGOAL_THEN `x + (drop y - drop x) % vec 1 = y` SUBST1_TAC THENL
5902      [REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN
5903       REAL_ARITH_TAC;
5904       ALL_TAC] THEN
5905     ASM_SIMP_TAC[CONTENT_1; REAL_LT_IMP_LE] THEN
5906     MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN
5907     ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ;
5908                  GSYM DROP_EQ; REAL_LT_IMP_NE] THEN
5909     SUBGOAL_THEN `norm(y - x) = abs(drop y - drop x)` SUBST1_TAC THENL
5910      [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB]; ALL_TAC] THEN
5911     REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM NORM_MUL)] THEN
5912     REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN
5913     ASM_SIMP_TAC[REAL_FIELD `x < y ==> (y - x) * inv(y - x) = &1`] THEN
5914     AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_MUL_LID] THEN
5915     AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN
5916     X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN
5917     COND_CASES_TAC THEN REWRITE_TAC[] THEN
5918     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5919     ALL_TAC] THEN
5920   REPEAT STRIP_TAC THEN
5921   FIRST_X_ASSUM(fun th ->
5922     MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `b:real^1`] th) THEN
5923     MP_TAC(ISPECL [`\x. (f:real^1->real^N) (--x)`; `--b:real^1`;
5924                    `--a:real^1`] th)) THEN
5925   ASM_REWRITE_TAC[INTEGRABLE_REFLECT] THEN
5926   DISCH_THEN(X_CHOOSE_THEN `k2:real^1->bool`
5927     (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
5928   DISCH_THEN(X_CHOOSE_THEN `k1:real^1->bool`
5929     (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
5930   EXISTS_TAC `k1 UNION IMAGE (--) k2:real^1->bool` THEN CONJ_TAC THENL
5931    [MATCH_MP_TAC NEGLIGIBLE_UNION THEN ASM_REWRITE_TAC[] THEN
5932     MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[linear] THEN
5933     VECTOR_ARITH_TAC;
5934     ALL_TAC] THEN
5935   X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN
5936   REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `x:real^1 = --x' <=> --x = x'`] THEN
5937   REWRITE_TAC[UNWIND_THM1] THEN STRIP_TAC THEN
5938   REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN] THEN CONJ_TAC THENL
5939    [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC;
5940     ALL_TAC] THEN
5941   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5942   REMOVE_THEN "2" (MP_TAC o SPECL [`--x:real^1`; `e:real`]) THEN
5943   REMOVE_THEN "1" (MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN
5944   ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_REFLECT] THEN
5945   DISCH_THEN(X_CHOOSE_THEN `d1:real`
5946    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
5947   DISCH_THEN(X_CHOOSE_THEN `d2:real`
5948    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
5949   EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
5950   X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN
5951   REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5952   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN STRIP_TAC THEN
5953   SUBGOAL_THEN `drop x < drop y \/ drop y < drop x` DISJ_CASES_TAC THENL
5954    [ASM_REAL_ARITH_TAC;
5955     REMOVE_THEN "1" (MP_TAC o SPEC `y:real^1`) THEN
5956     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5957     REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5958     MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN
5959     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
5960     AP_THM_TAC THEN AP_TERM_TAC THEN
5961     MATCH_MP_TAC(VECTOR_ARITH `c + a:real^N = b ==> a = b - c`) THEN
5962     MATCH_MP_TAC INTEGRAL_COMBINE THEN
5963     REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
5964     MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
5965     MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN
5966     ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC;
5967     REMOVE_THEN "2" (MP_TAC o SPEC `--y:real^1`) THEN
5968     ANTS_TAC THENL [SIMP_TAC[DROP_NEG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5969     SUBGOAL_THEN `norm(--y - --x) = abs(drop y - drop x)` SUBST1_TAC THENL
5970      [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; DROP_NEG] THEN
5971       ASM_REAL_ARITH_TAC;
5972       ALL_TAC] THEN
5973     MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN
5974     AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[INTEGRAL_REFLECT] THEN
5975     REWRITE_TAC[VECTOR_NEG_NEG; DROP_SUB; DROP_NEG] THEN
5976     ONCE_REWRITE_TAC[VECTOR_ARITH
5977       `x - (--a - --b) % y:real^N = --(--x - (a - b) % y)`] THEN
5978     REWRITE_TAC[NORM_NEG] THEN AP_TERM_TAC THEN
5979     AP_THM_TAC THEN AP_TERM_TAC THEN
5980     MATCH_MP_TAC(VECTOR_ARITH `b + a = c ==> --a:real^N = b - c`) THEN
5981     MATCH_MP_TAC INTEGRAL_COMBINE THEN
5982     REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
5983     MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
5984     MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN
5985     ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);;
5986
5987 let ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS = prove
5988  (`!f:real^M->real^N.
5989     (!a b. f absolutely_integrable_on interval[a,b])
5990     ==> ?k. negligible k /\
5991             !x e. ~(x IN k) /\ &0 < e
5992                   ==> ?d. &0 < d /\
5993                           !h. &0 < h /\ h < d
5994                              ==> norm(inv(content(interval[x - h % vec 1,
5995                                                            x + h % vec 1])) %
5996                                       integral (interval[x - h % vec 1,
5997                                                          x + h % vec 1])
5998                                                (\t. lift(norm(f t - f x))))
5999                                  < e`,
6000   REPEAT STRIP_TAC THEN
6001   MP_TAC(GEN `r:real^N` (ISPEC `\t. lift(norm((f:real^M->real^N) t - r))`
6002         INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC)) THEN
6003   REWRITE_TAC[] THEN
6004   DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
6005    [REPEAT GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
6006     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
6007     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
6008     ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST];
6009     ALL_TAC] THEN
6010   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
6011   X_GEN_TAC `k:real^N->real^M->bool` THEN STRIP_TAC THEN
6012   EXISTS_TAC
6013    `UNIONS (IMAGE (k:real^N->real^M->bool)
6014            {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)})` THEN
6015   CONJ_TAC THENL
6016    [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
6017     ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RATIONAL_COORDINATES] THEN
6018     ASM_REWRITE_TAC[FORALL_IN_IMAGE];
6019     ALL_TAC] THEN
6020   MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN
6021   REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; NOT_EXISTS_THM] THEN
6022   REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN STRIP_TAC THEN
6023   MP_TAC(SET_RULE `(f:real^M->real^N) x IN (:real^N)`) THEN
6024   REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN
6025   REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
6026   DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
6027   ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
6028   DISCH_THEN(X_CHOOSE_THEN `r:real^N` STRIP_ASSUME_TAC) THEN
6029   FIRST_X_ASSUM(MP_TAC o SPECL [`r:real^N`; `x:real^M`; `e / &3`]) THEN
6030   ASM_SIMP_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
6031   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6032   ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN
6033   FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN ASM_REWRITE_TAC[] THEN
6034   MATCH_MP_TAC(NORM_ARITH
6035    `norm(y1:real^N) < e / &3 /\ norm(i1 - i2) <= e / &3
6036     ==> norm(i1 - y1) < e / &3 ==> norm(i2) < e`) THEN
6037   REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN
6038   CONJ_TAC THENL [ASM_MESON_TAC[dist; DIST_SYM]; ALL_TAC] THEN
6039   REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
6040   MATCH_MP_TAC REAL_LE_TRANS THEN
6041   EXISTS_TAC
6042    `abs(inv(content(interval[x - h % vec 1,x + h % vec 1]))) *
6043     drop(integral (interval[x - h % vec 1,x + h % vec 1])
6044                   (\x:real^M. lift(e / &3)))` THEN
6045   CONJ_TAC THENL
6046    [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
6047     W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN
6048     ANTS_TAC THENL
6049      [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
6050       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
6051       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
6052       ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST];
6053       DISCH_THEN(SUBST1_TAC o SYM) THEN
6054       MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
6055       REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL
6056        [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
6057         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN
6058         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
6059         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
6060         ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST];
6061         X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
6062         REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP; GSYM LIFT_SUB] THEN
6063         ASM_MESON_TAC[NORM_ARITH
6064          `dist(r,x) < e / &3
6065           ==> abs(norm(y - r:real^N) - norm(y - x)) <= e / &3`]]];
6066     ASM_CASES_TAC
6067      `content(interval[x - h % vec 1:real^M,x + h % vec 1]) = &0`
6068     THENL
6069      [ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
6070       ASM_REAL_ARITH_TAC;
6071       REWRITE_TAC[REAL_ABS_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6072       ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ;
6073                    GSYM REAL_ABS_NZ] THEN
6074       REWRITE_TAC[INTEGRAL_CONST; DROP_CMUL; LIFT_DROP] THEN
6075       SIMP_TAC[real_abs; CONTENT_POS_LE; REAL_MUL_SYM; REAL_LE_REFL]]]);;
6076
6077 (* ------------------------------------------------------------------------- *)
6078 (* Measurability of a function on a set (not necessarily itself measurable). *)
6079 (* ------------------------------------------------------------------------- *)
6080
6081 parse_as_infix("measurable_on",(12,"right"));;
6082
6083 let measurable_on = new_definition
6084  `(f:real^M->real^N) measurable_on s <=>
6085         ?k g. negligible k /\
6086               (!n. (g n) continuous_on (:real^M)) /\
6087               (!x. ~(x IN k)
6088                    ==> ((\n. g n x) --> if x IN s then f(x) else vec 0)
6089                        sequentially)`;;
6090
6091 let MEASURABLE_ON_UNIV = prove
6092  (`(\x.  if x IN s then f(x) else vec 0) measurable_on (:real^M) <=>
6093    f measurable_on s`,
6094   REWRITE_TAC[measurable_on; IN_UNIV; ETA_AX]);;
6095
6096 (* ------------------------------------------------------------------------- *)
6097 (* Lebesgue measurability (like "measurable" but allowing infinite measure)  *)
6098 (* ------------------------------------------------------------------------- *)
6099
6100 let lebesgue_measurable = new_definition
6101  `lebesgue_measurable s <=> (indicator s) measurable_on (:real^N)`;;
6102
6103 (* ------------------------------------------------------------------------- *)
6104 (* Relation between measurability and integrability.                         *)
6105 (* ------------------------------------------------------------------------- *)
6106
6107 let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove
6108  (`!f:real^M->real^N g s.
6109         f measurable_on s /\
6110         g integrable_on s /\
6111         (!x. x IN s ==> norm(f x) <= drop(g x))
6112         ==> f integrable_on s`,
6113   let lemma = prove
6114    (`!f:real^M->real^N g a b.
6115           f measurable_on (:real^M) /\
6116           g integrable_on interval[a,b] /\
6117           (!x. x IN interval[a,b] ==> norm(f x) <= drop(g x))
6118           ==> f integrable_on interval[a,b]`,
6119     REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN
6120     REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
6121     MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `h:num->real^M->real^N`] THEN
6122     STRIP_TAC THEN
6123     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
6124     EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL
6125      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6126        NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
6127       ALL_TAC] THEN
6128     MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN
6129     MAP_EVERY EXISTS_TAC
6130      [`h:num->real^M->real^N`; `g:real^M->real^1`] THEN
6131     ASM_SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN
6132     X_GEN_TAC `n:num` THEN
6133     UNDISCH_TAC `(g:real^M->real^1) integrable_on interval [a,b]` THEN
6134     SUBGOAL_THEN
6135      `(h:num->real^M->real^N) n absolutely_integrable_on interval[a,b]`
6136     MP_TAC THENL
6137      [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THEN
6138       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
6139       REWRITE_TAC[IMP_IMP; absolutely_integrable_on; GSYM CONJ_ASSOC] THEN
6140       REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
6141       MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
6142       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6143        NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]) in
6144   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THEN
6145   MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN
6146   EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN
6147   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
6148   MATCH_MP_TAC lemma THEN
6149   EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN
6150   RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_ALT]) THEN
6151   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
6152   COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_POS]);;
6153
6154 let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove
6155  (`!f:real^M->real^N g s.
6156         f measurable_on s /\
6157         g integrable_on s /\
6158         (!x. x IN s ==> norm(f x) <= drop(g x))
6159         ==> f absolutely_integrable_on s`,
6160   REPEAT STRIP_TAC THEN
6161   MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^1`]
6162     ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND) THEN
6163   DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
6164    [REWRITE_TAC[NORM_REAL; GSYM drop] THEN
6165     ASM_MESON_TAC[REAL_ABS_LE; REAL_LE_TRANS];
6166     ASM_MESON_TAC[MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE];
6167     MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
6168     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6169     ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop] THEN
6170     ASM_MESON_TAC[NORM_ARITH `norm(x) <= a ==> &0 <= a`]]);;
6171
6172 let INTEGRAL_DROP_LE_MEASURABLE = prove
6173  (`!f g s:real^N->bool.
6174         f measurable_on s /\
6175         g integrable_on s /\
6176         (!x. x IN s ==> &0 <= drop(f x) /\ drop(f x) <= drop(g x))
6177         ==> drop(integral s f) <= drop(integral s g)`,
6178   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[] THEN
6179   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
6180   EXISTS_TAC `g:real^N->real^1` THEN
6181   ASM_SIMP_TAC[NORM_REAL; GSYM drop; real_abs]);;
6182
6183 let INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE = prove
6184  (`!f:real^M->real^N.
6185         (!a b. f integrable_on interval[a,b]) ==> f measurable_on (:real^M)`,
6186   REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN
6187   MAP_EVERY ABBREV_TAC
6188    [`box = \h x. interval[x:real^M,x + h % vec 1]`;
6189     `i = \h:real x:real^M. inv(content(box h x)) %
6190                       integral (box h x) (f:real^M->real^N)`] THEN
6191   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6192   EXISTS_TAC `(\n x. i (inv(&n + &1)) x):num->real^M->real^N` THEN
6193   REWRITE_TAC[] THEN
6194   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
6195   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
6196    [REWRITE_TAC[continuous_on; IN_UNIV] THEN
6197     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`; `e:real`] THEN
6198     DISCH_TAC THEN EXPAND_TAC "i" THEN EXPAND_TAC "box" THEN
6199     MP_TAC(ISPECL
6200      [`f:real^M->real^N`;
6201       `x - &2 % vec 1:real^M`;
6202       `x + &2 % vec 1:real^M`;
6203       `x:real^M`;
6204       `x + inv(&n + &1) % vec 1:real^M`;
6205       `e * (&1 / (&n + &1)) pow dimindex(:M)`]
6206      INDEFINITE_INTEGRAL_CONTINUOUS) THEN
6207     ANTS_TAC THENL
6208      [ASM_REWRITE_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT;
6209         REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
6210       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
6211        [SUBGOAL_THEN `&0 <= inv(&n + &1) /\ inv(&n + &1) <= &1` MP_TAC THENL
6212          [ALL_TAC; REAL_ARITH_TAC] THEN
6213         ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN
6214         MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC;
6215         MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN
6216         MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LT_DIV THEN
6217         REAL_ARITH_TAC];
6218       DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
6219       EXISTS_TAC `min k (&1)` THEN
6220       ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN
6221       ASM_REWRITE_TAC[dist] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
6222       REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN
6223       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6224                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6225       REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`] THEN
6226       REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN
6227       REWRITE_TAC[REAL_ARITH `(x + inv y) - x = &1 / y`] THEN
6228       REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB] THEN
6229       REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
6230       REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_DIV] THEN
6231       REWRITE_TAC[REAL_ABS_NUM; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN
6232       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
6233       ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_POW_LT;
6234                    REAL_ARITH `&0 < &1 /\ &0 < &n + &1`] THEN
6235       FIRST_X_ASSUM MATCH_MP_TAC THEN
6236       REWRITE_TAC[VECTOR_ARITH `(y + i) - (x + i):real^N = y - x`;
6237                   VECTOR_ARITH `(y - i) - (x - i):real^N = y - x`] THEN
6238       ASM_SIMP_TAC[IN_INTERVAL; REAL_LT_IMP_LE] THEN
6239       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6240                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6241       REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN
6242       ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN
6243       MATCH_MP_TAC(REAL_ARITH
6244        `&0 <= i /\ i <= &1 /\ abs(x - y) <= &1
6245         ==> (x - &2 <= y /\ y <= x + &2) /\
6246             (x - &2 <= y + i /\ y + i <= x + &2)`) THEN
6247       ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1;
6248                    REAL_ARITH `&0 <= &n + &1 /\ &1 <= &n + &1`] THEN
6249       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
6250       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; NORM_SUB;
6251                     REAL_LE_TRANS]];
6252     FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN
6253     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
6254     ASM_CASES_TAC `negligible(k:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN
6255     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN
6256     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
6257     REWRITE_TAC[LIM_SEQUENTIALLY] THEN
6258     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
6259     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
6260     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6261     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6262     MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN
6263     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
6264     STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
6265     MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[dist] THEN
6266     FIRST_X_ASSUM MATCH_MP_TAC THEN
6267     REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
6268     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
6269     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
6270     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
6271     ASM_ARITH_TAC]);;
6272
6273 let INTEGRABLE_IMP_MEASURABLE = prove
6274  (`!f:real^M->real^N s.
6275         f integrable_on s ==> f measurable_on s`,
6276   REPEAT GEN_TAC THEN
6277   ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV; GSYM MEASURABLE_ON_UNIV] THEN
6278   SPEC_TAC(`\x. if x IN s then (f:real^M->real^N) x else vec 0`,
6279            `f:real^M->real^N`) THEN
6280   REPEAT STRIP_TAC THEN
6281   MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
6282   REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
6283   EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);;
6284
6285 let ABSOLUTELY_INTEGRABLE_MEASURABLE = prove
6286  (`!f:real^M->real^N s.
6287         f absolutely_integrable_on s <=>
6288         f measurable_on s /\ (\x. lift(norm(f x))) integrable_on s`,
6289   REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN
6290   MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN
6291   REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE] THEN STRIP_TAC THEN
6292   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
6293   EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))` THEN
6294   ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);;
6295
6296 (* ------------------------------------------------------------------------- *)
6297 (* Composing continuous and measurable functions; a few variants.            *)
6298 (* ------------------------------------------------------------------------- *)
6299
6300 let MEASURABLE_ON_COMPOSE_CONTINUOUS = prove
6301  (`!f:real^M->real^N g:real^N->real^P.
6302         f measurable_on (:real^M) /\ g continuous_on (:real^N)
6303         ==> (g o f) measurable_on (:real^M)`,
6304   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6305   REWRITE_TAC[measurable_on; IN_UNIV] THEN
6306   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
6307   DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
6308   EXISTS_TAC `\n x. (g:real^N->real^P) ((h:num->real^M->real^N) n x)` THEN
6309   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6310    [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6311     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
6312     ASM_REWRITE_TAC[ETA_AX] THEN
6313     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
6314     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6315     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6316      [CONTINUOUS_ON_SEQUENTIALLY]) THEN
6317     ASM_SIMP_TAC[o_DEF; IN_UNIV]]);;
6318
6319 let MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove
6320  (`!f:real^M->real^N g:real^N->real^P s.
6321         f measurable_on s /\ g continuous_on (:real^N) /\ g(vec 0) = vec 0
6322         ==> (g o f) measurable_on s`,
6323   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6324   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
6325   DISCH_TAC THEN
6326   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN
6327   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6328   REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);;
6329
6330 let MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove
6331  (`!f:real^M->real^N g:real^N->real^P a b.
6332         f measurable_on (:real^M) /\
6333         (!x. f(x) IN interval(a,b)) /\
6334         g continuous_on interval(a,b)
6335         ==> (g o f) measurable_on (:real^M)`,
6336   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6337   REWRITE_TAC[measurable_on; IN_UNIV] THEN
6338   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
6339   DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
6340   EXISTS_TAC
6341    `(\n x. (g:real^N->real^P)
6342            (lambda i. max ((a:real^N)$i + (b$i - a$i) / (&n + &2))
6343                           (min ((h n x:real^N)$i)
6344                                ((b:real^N)$i - (b$i - a$i) / (&n + &2)))))
6345     :num->real^M->real^P` THEN
6346   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6347    [X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6348     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
6349      [MP_TAC(ISPECL
6350        [`(:real^M)`;
6351         `(lambda i. (b:real^N)$i - (b$i - (a:real^N)$i) / (&n + &2)):real^N`]
6352          CONTINUOUS_ON_CONST) THEN
6353       FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
6354       REWRITE_TAC[IMP_IMP] THEN
6355       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN
6356       MP_TAC(ISPECL
6357        [`(:real^M)`;
6358         `(lambda i. (a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2)):real^N`]
6359          CONTINUOUS_ON_CONST) THEN
6360       REWRITE_TAC[IMP_IMP] THEN
6361       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN
6362       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6363       SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA];
6364       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
6365       EXISTS_TAC `interval(a:real^N,b)` THEN
6366       ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN
6367       X_GEN_TAC `x:real^M` THEN
6368       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M` o CONJUNCT1) THEN
6369       SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN
6370       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
6371       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_TAC THEN
6372       SUBGOAL_THEN
6373         `&0 < ((b:real^N)$i - (a:real^N)$i) / (&n + &2) /\
6374          ((b:real^N)$i - (a:real^N)$i) / (&n + &2) <= (b$i - a$i) / &2` MP_TAC
6375       THENL [ALL_TAC; REAL_ARITH_TAC] THEN
6376       ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ;
6377                    REAL_ARITH `&0 < &n + &2`] THEN
6378       CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[real_div]] THEN
6379       MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
6380        [ASM_REAL_ARITH_TAC;
6381         MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC]];
6382     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6383     REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN
6384     CONJ_TAC THENL
6385      [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_INTERVAL];
6386       ALL_TAC] THEN
6387     SUBGOAL_THEN
6388      `((\n. (lambda i. ((a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2))))
6389        --> a) sequentially /\
6390       ((\n. (lambda i. ((b:real^N)$i - ((b:real^N)$i - a$i) / (&n + &2))))
6391        --> b) sequentially`
6392     MP_TAC THENL
6393      [ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
6394       SIMP_TAC[LAMBDA_BETA] THEN
6395       CONJ_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
6396       REWRITE_TAC[real_sub] THEN
6397       GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN
6398       REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC LIM_ADD THEN
6399       REWRITE_TAC[LIM_CONST; LIFT_NEG; real_div; LIFT_CMUL] THEN
6400       GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_0] THEN
6401       TRY(MATCH_MP_TAC LIM_NEG) THEN REWRITE_TAC[VECTOR_NEG_0] THEN
6402       SUBST1_TAC(VECTOR_ARITH
6403        `vec 0:real^1 = ((b:real^N)$j + --((a:real^N)$j)) % vec 0`) THEN
6404       MATCH_MP_TAC LIM_CMUL THEN
6405       REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0; NORM_LIFT] THEN
6406       X_GEN_TAC `e:real` THEN
6407       GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
6408       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
6409       X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN
6410       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
6411       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
6412       ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1;
6413                    REAL_OF_NUM_LE; REAL_ABS_NUM] THEN
6414       ASM_ARITH_TAC;
6415       ALL_TAC] THEN
6416     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
6417     ASM_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> a /\ c ==> b ==> d`] THEN
6418     DISCH_THEN(MP_TAC o MATCH_MP LIM_MIN) THEN
6419     REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
6420     DISCH_THEN(MP_TAC o MATCH_MP LIM_MAX) THEN
6421     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN
6422     SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN
6423     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
6424     ASM_MESON_TAC[REAL_ARITH `a < x /\ x < b ==> max a (min x b) = x`]]);;
6425
6426 let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove
6427  (`!f:real^M->real^N g:real^N->real^P s.
6428         closed s /\
6429         f measurable_on (:real^M) /\
6430         (!x. f(x) IN s) /\
6431         g continuous_on s
6432         ==> (g o f) measurable_on (:real^M)`,
6433   REPEAT STRIP_TAC THEN
6434   MP_TAC(ISPECL [`g:real^N->real^P`; `(:real^N)`; `s:real^N->bool`]
6435     TIETZE_UNBOUNDED) THEN
6436   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
6437   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^P` THEN
6438   DISCH_TAC THEN SUBGOAL_THEN
6439    `(g:real^N->real^P) o (f:real^M->real^N) = h o f` SUBST1_TAC
6440   THENL [ASM_SIMP_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN
6441   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[]);;
6442
6443 let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove
6444  (`!f:real^M->real^N g:real^N->real^P s t.
6445         closed s /\
6446         f measurable_on t /\
6447         (!x. f(x) IN s) /\
6448         g continuous_on s /\
6449         vec 0 IN s /\ g(vec 0) = vec 0
6450         ==> (g o f) measurable_on t`,
6451   REPEAT STRIP_TAC THEN
6452   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6453   MP_TAC(ISPECL [`(\x. if x IN t then f x else vec 0):real^M->real^N`;
6454                  `g:real^N->real^P`; `s:real^N->bool`]
6455         MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN
6456   ANTS_TAC THENL
6457    [ASM_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN ASM_MESON_TAC[];
6458     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6459     REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[]]);;
6460
6461 (* ------------------------------------------------------------------------- *)
6462 (* Basic closure properties of measurable functions.                         *)
6463 (* ------------------------------------------------------------------------- *)
6464
6465 let CONTINUOUS_IMP_MEASURABLE_ON = prove
6466  (`!f:real^M->real^N. f continuous_on (:real^M) ==> f measurable_on (:real^M)`,
6467   REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN
6468   EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN
6469   EXISTS_TAC `\n:num. (f:real^M->real^N)` THEN
6470   ASM_REWRITE_TAC[LIM_CONST]);;
6471
6472 let MEASURABLE_ON_CONST = prove
6473  (`!k:real^N. (\x. k) measurable_on (:real^M)`,
6474   SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; CONTINUOUS_ON_CONST]);;
6475
6476 let MEASURABLE_ON_0 = prove
6477  (`!s. (\x. vec 0) measurable_on s`,
6478   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6479   REWRITE_TAC[MEASURABLE_ON_CONST; COND_ID]);;
6480
6481 let MEASURABLE_ON_CMUL = prove
6482  (`!c f:real^M->real^N s.
6483         f measurable_on s ==> (\x. c % f x) measurable_on s`,
6484   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6485   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN
6486   ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
6487   GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
6488   SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);;
6489
6490 let MEASURABLE_ON_NEG = prove
6491  (`!f:real^M->real^N s.
6492      f measurable_on s ==> (\x. --(f x)) measurable_on s`,
6493   REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`;
6494               MEASURABLE_ON_CMUL]);;
6495
6496 let MEASURABLE_ON_NEG_EQ = prove
6497  (`!f:real^M->real^N s. (\x. --(f x)) measurable_on s <=> f measurable_on s`,
6498   REPEAT GEN_TAC THEN EQ_TAC THEN
6499   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
6500   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;
6501
6502 let MEASURABLE_ON_NORM = prove
6503  (`!f:real^M->real^N s.
6504         f measurable_on s ==> (\x. lift(norm(f x))) measurable_on s`,
6505   REPEAT GEN_TAC THEN
6506   DISCH_THEN(MP_TAC o ISPEC `\x:real^N. lift(norm x)` o MATCH_MP
6507    (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS_0)) THEN
6508   REWRITE_TAC[o_DEF; NORM_0; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN
6509   REWRITE_TAC[continuous_on; IN_UNIV; DIST_LIFT] THEN
6510   GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6511   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;
6512
6513 let MEASURABLE_ON_PASTECART = prove
6514  (`!f:real^M->real^N g:real^M->real^P s.
6515         f measurable_on s /\ g measurable_on s
6516         ==> (\x. pastecart (f x) (g x)) measurable_on s`,
6517   REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN
6518   DISCH_THEN(CONJUNCTS_THEN2
6519    (X_CHOOSE_THEN `k1:real^M->bool` MP_TAC)
6520    (X_CHOOSE_THEN `k2:real^M->bool` MP_TAC)) THEN
6521   DISCH_THEN(X_CHOOSE_THEN `g2:num->real^M->real^P` STRIP_ASSUME_TAC) THEN
6522   DISCH_THEN(X_CHOOSE_THEN `g1:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
6523   EXISTS_TAC `k1 UNION k2:real^M->bool` THEN
6524   ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN
6525   EXISTS_TAC `(\n x. pastecart (g1 n x) (g2 n x))
6526               :num->real^M->real^(N,P)finite_sum` THEN
6527   ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX; IN_UNION; DE_MORGAN_THM] THEN
6528   X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
6529   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
6530   ASM_CASES_TAC `(x:real^M) IN s` THEN
6531   REWRITE_TAC[GSYM PASTECART_VEC] THEN ASM_SIMP_TAC[LIM_PASTECART]);;
6532
6533 let MEASURABLE_ON_COMBINE = prove
6534  (`!h:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P s.
6535         f measurable_on s /\ g measurable_on s /\
6536         (\x. h (fstcart x) (sndcart x)) continuous_on UNIV /\
6537         h (vec 0) (vec 0) = vec 0
6538         ==> (\x. h (f x) (g x)) measurable_on s`,
6539   REPEAT STRIP_TAC THEN
6540   SUBGOAL_THEN
6541    `(\x:real^M. (h:real^N->real^P->real^Q) (f x) (g x)) =
6542     (\x. h (fstcart x) (sndcart x)) o (\x. pastecart (f x) (g x))`
6543   SUBST1_TAC THENL
6544    [REWRITE_TAC[FUN_EQ_THM; FSTCART_PASTECART; SNDCART_PASTECART; o_THM];
6545     MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN
6546     ASM_SIMP_TAC[MEASURABLE_ON_PASTECART; FSTCART_VEC; SNDCART_VEC]]);;
6547
6548 let MEASURABLE_ON_ADD = prove
6549  (`!f:real^M->real^N g:real^M->real^N s.
6550         f measurable_on s /\ g measurable_on s
6551         ==> (\x. f x + g x) measurable_on s`,
6552   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN
6553   ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
6554   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
6555   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
6556
6557 let MEASURABLE_ON_SUB = prove
6558  (`!f:real^M->real^N g:real^M->real^N s.
6559         f measurable_on s /\ g measurable_on s
6560         ==> (\x. f x - g x) measurable_on s`,
6561   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN
6562   ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
6563   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
6564   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
6565
6566 let MEASURABLE_ON_MAX = prove
6567  (`!f:real^M->real^N g:real^M->real^N s.
6568       f measurable_on s /\ g measurable_on s
6569       ==> (\x. (lambda i. max ((f x)$i) ((g x)$i)):real^N)
6570           measurable_on s`,
6571   let lemma = REWRITE_RULE[]
6572    (ISPEC `(\x y. lambda i. max (x$i) (y$i)):real^N->real^N->real^N`
6573           MEASURABLE_ON_COMBINE) in
6574   REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN
6575   ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
6576   REWRITE_TAC[REAL_ARITH `max x x = x`; LAMBDA_ETA] THEN
6577   SIMP_TAC[continuous_on; LAMBDA_BETA; IN_UNIV; DIST_LIFT] THEN
6578   GEN_TAC THEN STRIP_TAC THEN
6579   MAP_EVERY X_GEN_TAC [`x:real^(N,N)finite_sum`; `e:real`] THEN
6580   DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[dist] THEN
6581   X_GEN_TAC `y:real^(N,N)finite_sum` THEN DISCH_TAC THEN
6582   MATCH_MP_TAC(REAL_ARITH
6583    `abs(x - y) < e /\ abs(x' - y') < e
6584     ==> abs(max x x' - max y y') < e`) THEN
6585   REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN CONJ_TAC THEN
6586   MATCH_MP_TAC(REAL_ARITH
6587    `norm(x) < e /\ abs(x$i) <= norm x ==> abs(x$i) < e`) THEN
6588   ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM FSTCART_SUB; GSYM SNDCART_SUB] THEN
6589   ASM_MESON_TAC[REAL_LET_TRANS; NORM_FSTCART; NORM_SNDCART]);;
6590
6591 let MEASURABLE_ON_MIN = prove
6592  (`!f:real^M->real^N g:real^M->real^N s.
6593       f measurable_on s /\ g measurable_on s
6594       ==> (\x. (lambda i. min ((f x)$i) ((g x)$i)):real^N)
6595           measurable_on s`,
6596   REPEAT GEN_TAC THEN
6597   DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG)) THEN
6598   REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
6599   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN
6600   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
6601   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6602   REWRITE_TAC[FUN_EQ_THM] THEN
6603   SIMP_TAC[CART_EQ; VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);;
6604
6605 let MEASURABLE_ON_DROP_MUL = prove
6606  (`!f g:real^M->real^N s.
6607       f measurable_on s /\ g measurable_on s
6608       ==> (\x. drop(f x) % g x) measurable_on s`,
6609   let lemma = REWRITE_RULE[]
6610    (ISPEC `\x y. drop x % y :real^N` MEASURABLE_ON_COMBINE) in
6611   REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
6612   ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
6613   REWRITE_TAC[o_DEF; ETA_AX; LIFT_DROP] THEN
6614   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
6615   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
6616
6617 let MEASURABLE_ON_LIFT_MUL = prove
6618  (`!f g s. (\x. lift(f x)) measurable_on s /\
6619            (\x. lift(g x)) measurable_on s
6620            ==> (\x. lift(f x * g x)) measurable_on s`,
6621   REPEAT GEN_TAC THEN
6622   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN
6623   REWRITE_TAC[LIFT_CMUL; LIFT_DROP]);;
6624
6625 let MEASURABLE_ON_VSUM = prove
6626  (`!f:A->real^M->real^N t.
6627         FINITE t /\ (!i. i IN t ==> (f i) measurable_on s)
6628         ==> (\x. vsum t (\i. f i x)) measurable_on s`,
6629   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
6630   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6631   SIMP_TAC[VSUM_CLAUSES; MEASURABLE_ON_0; MEASURABLE_ON_ADD; IN_INSERT;
6632            ETA_AX]);;
6633
6634 let MEASURABLE_ON_COMPONENTWISE = prove
6635  (`!f:real^M->real^N.
6636         f measurable_on (:real^M) <=>
6637         (!i. 1 <= i /\ i <= dimindex(:N)
6638              ==> (\x. lift(f x$i)) measurable_on (:real^M))`,
6639   REPEAT GEN_TAC THEN EQ_TAC THENL
6640    [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
6641      ISPEC `\x:real^N. lift(x$i)` o MATCH_MP
6642      (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN
6643     ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF];
6644     ALL_TAC] THEN
6645   REWRITE_TAC[measurable_on; IN_UNIV] THEN
6646   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6647   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6648   MAP_EVERY X_GEN_TAC
6649    [`k:num->real^M->bool`; `g:num->num->real^M->real^1`] THEN
6650   DISCH_TAC THEN
6651   EXISTS_TAC `UNIONS(IMAGE k (1..dimindex(:N))):real^M->bool` THEN
6652   EXISTS_TAC `(\n x. lambda i. drop(g i n x)):num->real^M->real^N` THEN
6653   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6654    [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN
6655     ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; FORALL_IN_IMAGE; FINITE_IMAGE];
6656     GEN_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
6657     ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX];
6658     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN
6659     REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN
6660     REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN
6661     ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
6662     ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]);;
6663
6664 let MEASURABLE_ON_SPIKE = prove
6665  (`!f:real^M->real^N g s t.
6666         negligible s /\ (!x. x IN t DIFF s ==> g x = f x)
6667         ==> f measurable_on t ==> g measurable_on t`,
6668   REPEAT GEN_TAC THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
6669   REWRITE_TAC[measurable_on] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6670   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
6671   DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
6672   EXISTS_TAC `s UNION k:real^M->bool` THEN
6673   ASM_SIMP_TAC[DE_MORGAN_THM; IN_UNION; NEGLIGIBLE_UNION]);;
6674
6675 let MEASURABLE_ON_SPIKE_SET = prove
6676  (`!f:real^M->real^N s t.
6677         negligible (s DIFF t UNION t DIFF s)
6678         ==> f measurable_on s
6679             ==> f measurable_on t`,
6680   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[measurable_on] THEN
6681   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
6682   X_GEN_TAC `g:num->real^M->real^N` THEN
6683   DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
6684   EXISTS_TAC `k UNION (s DIFF t UNION t DIFF s):real^M->bool` THEN
6685   ASM_SIMP_TAC[NEGLIGIBLE_UNION; IN_UNION; DE_MORGAN_THM] THEN
6686   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6687   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
6688   MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN
6689   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
6690
6691 let MEASURABLE_ON_RESTRICT = prove
6692  (`!f:real^M->real^N s.
6693         f measurable_on (:real^M) /\ lebesgue_measurable s
6694         ==> (\x. if x IN s then f(x) else vec 0) measurable_on (:real^M)`,
6695   REPEAT GEN_TAC THEN REWRITE_TAC[lebesgue_measurable; indicator] THEN
6696   ONCE_REWRITE_TAC[CONJ_SYM] THEN
6697   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN
6698   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6699   REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
6700   COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN VECTOR_ARITH_TAC);;
6701
6702 let MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove
6703  (`!f s t. s SUBSET t /\ f measurable_on t /\
6704            lebesgue_measurable s
6705            ==> f measurable_on s`,
6706   REPEAT GEN_TAC THEN
6707   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6708   REWRITE_TAC[IN_UNIV] THEN
6709   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6710   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN
6711   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6712   REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);;
6713
6714 let MEASURABLE_ON_LIMIT = prove
6715  (`!f:num->real^M->real^N g s k.
6716         (!n. (f n) measurable_on s) /\
6717         negligible k /\
6718         (!x. x IN s DIFF k ==> ((\n. f n x) --> g x) sequentially)
6719         ==> g measurable_on s`,
6720   REPEAT STRIP_TAC THEN
6721   MP_TAC(ISPECL [`vec 0:real^N`; `vec 1:real^N`]
6722     HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN
6723   REWRITE_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01] THEN
6724   REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
6725   MAP_EVERY X_GEN_TAC [`h':real^N->real^N`; `h:real^N->real^N`] THEN
6726   REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN
6727   SUBGOAL_THEN
6728    `((h':real^N->real^N) o (h:real^N->real^N) o
6729      (\x. if x IN s then g x else vec 0)) measurable_on (:real^M)`
6730   MP_TAC THENL
6731    [ALL_TAC; ASM_REWRITE_TAC[o_DEF; MEASURABLE_ON_UNIV]] THEN
6732   SUBGOAL_THEN `!y:real^N. norm(h y:real^N) <= &(dimindex(:N))`
6733   ASSUME_TAC THENL
6734    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6735      `IMAGE h UNIV = s ==> (!z. z IN s ==> P z) ==> !y. P(h y)`)) THEN
6736     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN
6737     REWRITE_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN
6738     MATCH_MP_TAC REAL_LE_TRANS THEN
6739     EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((y:real^N)$i))` THEN
6740     REWRITE_TAC[NORM_LE_L1] THEN
6741     GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
6742     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
6743     MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
6744     ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`];
6745     ALL_TAC] THEN
6746   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL THEN
6747   MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `vec 1:real^N`] THEN
6748   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6749    [MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
6750     MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
6751     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
6752     EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL
6753      [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
6754       ASM_REWRITE_TAC[] THEN SET_TAC[];
6755       ALL_TAC] THEN
6756     MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN
6757     MAP_EVERY EXISTS_TAC
6758      [`(\n x. h(if x IN s then f n x else vec 0:real^N)):num->real^M->real^N`;
6759       `(\x. vec(dimindex(:N))):real^M->real^1`] THEN
6760     REWRITE_TAC[o_DEF; INTEGRABLE_CONST] THEN REPEAT CONJ_TAC THENL
6761      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC
6762         MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
6763       EXISTS_TAC `(\x. vec(dimindex(:N))):real^M->real^1` THEN
6764       ASM_REWRITE_TAC[ETA_AX; INTEGRABLE_CONST] THEN
6765       ASM_SIMP_TAC[DROP_VEC] THEN CONJ_TAC THENL
6766        [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN
6767         EXISTS_TAC `interval[a:real^M,b:real^M]` THEN CONJ_TAC THENL
6768          [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
6769           ASM_REWRITE_TAC[] THEN SET_TAC[];
6770           ALL_TAC] THEN
6771         ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6772         MATCH_MP_TAC(REWRITE_RULE[indicator; lebesgue_measurable]
6773               MEASURABLE_ON_RESTRICT) THEN
6774         REWRITE_TAC[MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL
6775          [MP_TAC(ISPECL
6776            [`(\x. if x IN s then f (n:num) x else vec 0):real^M->real^N`;
6777             `h:real^N->real^N`] MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN
6778           ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
6779           ASM_REWRITE_TAC[MEASURABLE_ON_UNIV; ETA_AX];
6780           MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
6781           REWRITE_TAC[INTEGRABLE_CONST]];
6782         MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
6783         EXISTS_TAC `interval[a:real^M,b:real^M]` THEN
6784         REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
6785         EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]];
6786       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
6787       EXISTS_TAC `interval[a:real^M,b:real^M]` THEN
6788       REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
6789       EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
6790       ASM_SIMP_TAC[DROP_VEC];
6791       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6792       ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[LIM_CONST] THEN
6793       MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN CONJ_TAC THENL
6794        [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV];
6795         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]];
6796     REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);;
6797
6798 (* ------------------------------------------------------------------------- *)
6799 (* Natural closure properties of measurable functions; the intersection      *)
6800 (* one is actually quite tedious since we end up reinventing cube roots      *)
6801 (* before they actually get introduced in transcendentals.ml                 *)
6802 (* ------------------------------------------------------------------------- *)
6803
6804 let MEASURABLE_ON_EMPTY = prove
6805  (`!f:real^M->real^N. f measurable_on {}`,
6806   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6807   REWRITE_TAC[NOT_IN_EMPTY; MEASURABLE_ON_CONST]);;
6808
6809 let MEASURABLE_ON_INTER = prove
6810  (`!f:real^M->real^N s t.
6811         f measurable_on s /\ f measurable_on t
6812         ==> f measurable_on (s INTER t)`,
6813   REPEAT GEN_TAC THEN
6814   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6815   ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN
6816   REWRITE_TAC[AND_FORALL_THM] THEN
6817   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
6818   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
6819   ASM_REWRITE_TAC[] THEN
6820   ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ p ==> q ==> r`] THEN
6821   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN
6822   REWRITE_TAC[IMP_IMP] THEN
6823   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN
6824   ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
6825   REWRITE_TAC[VEC_COMPONENT; REAL_ARITH
6826    `(if p then x else &0) * (if q then y else &0) =
6827     if p /\ q then x * y else &0`] THEN
6828   SUBGOAL_THEN `!s. (\x. lift (drop x pow 3)) continuous_on s` ASSUME_TAC THENL
6829    [GEN_TAC THEN REWRITE_TAC[REAL_ARITH `(x:real) pow 3 = x * x * x`] THEN
6830     REWRITE_TAC[LIFT_CMUL] THEN
6831     REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
6832            ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]);
6833     ALL_TAC] THEN
6834   SUBGOAL_THEN `?r. !x. lift(drop(r x) pow 3) = x` STRIP_ASSUME_TAC THENL
6835    [REWRITE_TAC[GSYM SKOLEM_THM; FORALL_LIFT; GSYM EXISTS_DROP; LIFT_EQ] THEN
6836     X_GEN_TAC `x:real` THEN  MP_TAC(ISPECL
6837      [`\x. lift (drop x pow 3)`; `lift(--(abs x + &1))`;
6838       `lift(abs x + &1)`;`x:real`; `1`] IVT_INCREASING_COMPONENT_1) THEN
6839     REWRITE_TAC[GSYM drop; LIFT_DROP; EXISTS_DROP] THEN
6840     ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
6841     REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN
6842     CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL
6843      [FIRST_X_ASSUM(MP_TAC o SPEC `(:real^1)`) THEN
6844       ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV];
6845       REWRITE_TAC[REAL_BOUNDS_LE; REAL_POW_NEG; ARITH] THEN
6846       MATCH_MP_TAC(REAL_ARITH
6847       `&0 <= x /\ &0 <= x pow 2 /\ &0 <= x pow 3 ==> x <= (x + &1) pow 3`) THEN
6848       SIMP_TAC[REAL_POW_LE; REAL_ABS_POS]];
6849     ALL_TAC] THEN
6850   SUBGOAL_THEN `!x.  r(lift(x pow 3)) = lift x` STRIP_ASSUME_TAC THENL
6851    [REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN GEN_TAC THEN
6852     MATCH_MP_TAC REAL_POW_EQ_ODD THEN EXISTS_TAC `3` THEN
6853     ASM_REWRITE_TAC[ARITH; GSYM LIFT_EQ; LIFT_DROP];
6854     ALL_TAC] THEN
6855   SUBGOAL_THEN `(r:real^1->real^1) continuous_on (:real^1)` ASSUME_TAC THENL
6856    [MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN
6857     MAP_EVERY EXISTS_TAC [`\x. lift(drop x pow 3)`; `(:real^1)`] THEN
6858     ASM_REWRITE_TAC[LIFT_DROP] THEN
6859     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
6860      [ASM SET_TAC[]; ALL_TAC] THEN
6861     DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN SUBST1_TAC(SYM th)) THEN
6862     MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN
6863     ASM_REWRITE_TAC[PATH_CONNECTED_UNIV; LIFT_EQ] THEN
6864     SIMP_TAC[REAL_POW_EQ_ODD_EQ; ARITH; DROP_EQ];
6865     ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 pow 3`] THEN
6866     REWRITE_TAC[REAL_ARITH `(x * x) * x:real = x pow 3`; IN_INTER] THEN
6867     REWRITE_TAC[MESON[] `(if p then x pow 3 else y pow 3) =
6868                          (if p then x else y:real) pow 3`] THEN
6869     CONV_TAC REAL_RAT_REDUCE_CONV THEN
6870     DISCH_THEN(MP_TAC o ISPEC `r:real^1->real^1` o
6871       MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN
6872     ASM_REWRITE_TAC[o_DEF]]);;
6873
6874 let MEASURABLE_ON_DIFF = prove
6875  (`!f:real^M->real^N s t.
6876     f measurable_on s /\ f measurable_on t ==> f measurable_on (s DIFF t)`,
6877   REPEAT GEN_TAC THEN DISCH_TAC THEN
6878   FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN
6879   FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IMP_IMP] THEN
6880   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6881   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN
6882   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6883   REWRITE_TAC[FUN_EQ_THM; IN_DIFF; IN_INTER] THEN
6884   X_GEN_TAC `x:real^M` THEN
6885   MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN
6886   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
6887
6888 let MEASURABLE_ON_UNION = prove
6889  (`!f:real^M->real^N s t.
6890     f measurable_on s /\ f measurable_on t ==> f measurable_on (s UNION t)`,
6891   REPEAT GEN_TAC THEN DISCH_TAC THEN
6892   FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN
6893   POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6894   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN
6895   REWRITE_TAC[IMP_IMP] THEN
6896   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN
6897   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6898   REWRITE_TAC[FUN_EQ_THM; IN_UNION; IN_INTER] THEN
6899   X_GEN_TAC `x:real^M` THEN
6900   MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN
6901   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
6902
6903 let MEASURABLE_ON_UNIONS = prove
6904  (`!f:real^M->real^N k.
6905         FINITE k /\ (!s. s IN k ==> f measurable_on s)
6906         ==> f measurable_on (UNIONS k)`,
6907   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
6908   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6909   REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY; UNIONS_INSERT] THEN
6910   SIMP_TAC[FORALL_IN_INSERT; MEASURABLE_ON_UNION]);;
6911
6912 let MEASURABLE_ON_COUNTABLE_UNIONS = prove
6913  (`!f:real^M->real^N k.
6914         COUNTABLE k /\ (!s. s IN k ==> f measurable_on s)
6915         ==> f measurable_on (UNIONS k)`,
6916   REPEAT STRIP_TAC THEN
6917   ASM_CASES_TAC `k:(real^M->bool)->bool = {}` THEN
6918   ASM_REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY] THEN
6919   MP_TAC(ISPEC `k:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN
6920   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6921   X_GEN_TAC `d:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN
6922   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6923   MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
6924   EXISTS_TAC `(\n x. if x IN UNIONS (IMAGE d (0..n)) then f x else vec 0):
6925               num->real^M->real^N` THEN
6926   EXISTS_TAC `{}:real^M->bool` THEN
6927   ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY; MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL
6928    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_UNIONS THEN
6929     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FORALL_IN_IMAGE]) THEN
6930     SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV; FINITE_IMAGE; FINITE_NUMSEG];
6931     X_GEN_TAC `x:real^M` THEN DISCH_THEN(K ALL_TAC) THEN
6932     ASM_CASES_TAC `(x:real^M) IN UNIONS (IMAGE d (:num))` THEN
6933     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THENL
6934      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
6935       REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV; EVENTUALLY_SEQUENTIALLY] THEN
6936       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
6937       X_GEN_TAC `n:num` THEN DISCH_TAC THEN
6938       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
6939       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN
6940       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
6941       REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[];
6942       MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[]]]);;
6943
6944 (* ------------------------------------------------------------------------- *)
6945 (* Negligibility of a Lipschitz image of a negligible set.                   *)
6946 (* ------------------------------------------------------------------------- *)
6947
6948 let NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE = prove
6949  (`!f:real^M->real^N s.
6950         dimindex(:M) <= dimindex(:N) /\ negligible s /\
6951         (!x. x IN s
6952              ==> ?t b. open t /\ x IN t /\
6953                        !y. y IN s INTER t
6954                            ==> norm(f y - f x) <= b * norm(y - x))
6955         ==> negligible(IMAGE f s)`,
6956   let lemma = prove
6957    (`!f:real^M->real^N s B.
6958         dimindex(:M) <= dimindex(:N) /\ bounded s /\ negligible s /\ &0 < B /\
6959         (!x. x IN s
6960              ==> ?t. open t /\ x IN t /\
6961                      !y. y IN s INTER t
6962                          ==> norm(f y - f x) <= B * norm(y - x))
6963         ==> negligible(IMAGE f s)`,
6964     REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN
6965     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6966     MP_TAC(ISPECL [`s:real^M->bool`;
6967                    `e / &2 / (&2 * B * &(dimindex(:M))) pow (dimindex(:N))`]
6968       MEASURABLE_OUTER_OPEN) THEN
6969     ANTS_TAC THENL
6970      [ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE] THEN
6971       MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN
6972       MATCH_MP_TAC REAL_POW_LT THEN
6973       REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN
6974       ASM_SIMP_TAC[DIMINDEX_GE_1; REAL_OF_NUM_LT; ARITH; LE_1];
6975       ALL_TAC] THEN
6976     ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_HALF; MEASURE_EQ_0] THEN
6977     REWRITE_TAC[REAL_ADD_LID] THEN
6978     DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
6979     SUBGOAL_THEN
6980      `!x. ?r. &0 < r /\ r <= &1 / &2 /\
6981               (x IN s
6982                ==> !y. norm(y - x:real^M) < r
6983                        ==> y IN t /\
6984                            (y IN s
6985                             ==> norm(f y - f x:real^N) <= B * norm(y - x)))`
6986     MP_TAC THENL
6987      [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN
6988       ASM_REWRITE_TAC[] THENL
6989        [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN
6990       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
6991       ASM_REWRITE_TAC[IN_INTER] THEN
6992       DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
6993       MP_TAC(ISPEC `t INTER u :real^M->bool` open_def) THEN
6994       ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL] THEN
6995       DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
6996       ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTER; dist]] THEN
6997       DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
6998       EXISTS_TAC `min (&1 / &2) r` THEN
6999       ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN] THEN
7000       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[];
7001       FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN
7002       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
7003       REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
7004       X_GEN_TAC `r:real^M->real` THEN STRIP_TAC] THEN
7005     SUBGOAL_THEN
7006      `?c. s SUBSET interval[--(vec c):real^M,vec c] /\
7007           ~(interval(--(vec c):real^M,vec c) = {})`
7008     STRIP_ASSUME_TAC THENL
7009      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
7010       DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
7011       MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN
7012       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
7013       DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN
7014       REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7015       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
7016       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN
7017       STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN W(MP_TAC o
7018         PART_MATCH (lhand o rand) COMPONENT_LE_NORM o lhand o snd) THEN
7019       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
7020       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
7021       ALL_TAC] THEN
7022     MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`;
7023                    `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN
7024     ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN
7025
7026     REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7027     DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
7028     SUBGOAL_THEN
7029      `!k. k IN D
7030           ==> ?u v z. k = interval[u,v] /\ ~(interval(u,v) = {}) /\
7031                       z IN s /\ z IN interval[u,v] /\
7032                       interval[u:real^M,v] SUBSET ball(z,r z)`
7033     MP_TAC THENL
7034      [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
7035       SUBGOAL_THEN `?u v:real^M. d = interval[u,v]` MP_TAC THENL
7036        [ASM_MESON_TAC[]; ALL_TAC] THEN
7037       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M` THEN
7038       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M` THEN
7039       DISCH_THEN SUBST_ALL_TAC THEN
7040       ASM_MESON_TAC[SUBSET; INTERIOR_CLOSED_INTERVAL; IN_INTER];
7041       ALL_TAC] THEN
7042     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7043     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
7044      [`u:(real^M->bool)->real^M`; `v:(real^M->bool)->real^M`;
7045       `z:(real^M->bool)->real^M`] THEN
7046     DISCH_THEN(LABEL_TAC "*") THEN EXISTS_TAC
7047      `UNIONS(IMAGE (\d:real^M->bool.
7048          interval[(f:real^M->real^N)(z d) -
7049       (B * &(dimindex(:M)) *
7050       ((v(d):real^M)$1 - (u(d):real^M)$1)) % vec 1:real^N,
7051                   f(z d) +
7052                   (B * &(dimindex(:M)) * (v(d)$1 - u(d)$1)) % vec 1]) D)` THEN
7053     CONJ_TAC THENL
7054      [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
7055       X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
7056       SUBGOAL_THEN `(y:real^M) IN UNIONS D` MP_TAC THENL
7057        [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[UNIONS_IMAGE]] THEN
7058       REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
7059       X_GEN_TAC `d:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7060       SUBGOAL_THEN `(y:real^M) IN ball(z(d:real^M->bool),r(z d))` MP_TAC THENL
7061        [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[IN_BALL; dist]] THEN
7062       ONCE_REWRITE_TAC[NORM_SUB] THEN DISCH_TAC THEN
7063       SUBGOAL_THEN
7064        `y IN t /\
7065         norm((f:real^M->real^N) y - f(z d)) <= B * norm(y - z(d:real^M->bool))`
7066       STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
7067       REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
7068       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
7069       REWRITE_TAC[REAL_ARITH
7070        `z - b <= y /\ y <= z + b <=> abs(y - z) <= b`] THEN
7071       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN W(MP_TAC o
7072         PART_MATCH (lhand o rand) COMPONENT_LE_NORM o lhand o snd) THEN
7073       ASM_REWRITE_TAC[] THEN
7074       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7075       REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
7076       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7077           REAL_LE_TRANS)) THEN
7078       ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
7079       W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
7080       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7081       GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV)
7082        [GSYM CARD_NUMSEG_1] THEN
7083       SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN
7084       MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
7085       MATCH_MP_TAC REAL_LE_TRANS THEN
7086       EXISTS_TAC `((v:(real^M->bool)->real^M) d - u d)$j` THEN
7087       REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN CONJ_TAC THENL
7088        [SUBGOAL_THEN `y IN interval[(u:(real^M->bool)->real^M) d,v d] /\
7089                       (z d) IN interval[u d,v d]`
7090         MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN
7091         DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `j:num`)) THEN
7092         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
7093         MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o SPECL
7094          [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN
7095         ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]];
7096       ALL_TAC] THEN
7097     MATCH_MP_TAC(MESON[]
7098      `(x <= e / &2 ==> x < e) /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN
7099     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
7100     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN
7101     ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN
7102     ONCE_REWRITE_TAC[CONJ_SYM] THEN
7103     REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
7104     X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN
7105     W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN
7106     ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN
7107     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7108     REWRITE_TAC[o_DEF] THEN
7109     MATCH_MP_TAC REAL_LE_TRANS THEN
7110     EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow (dimindex(:N)) *
7111                 sum D' (\d:real^M->bool. measure d)` THEN
7112     SUBGOAL_THEN `FINITE(D':(real^M->bool)->bool)` ASSUME_TAC THENL
7113      [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
7114     CONJ_TAC THENL
7115      [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN
7116       ASM_REWRITE_TAC[MEASURE_INTERVAL] THEN X_GEN_TAC `d:real^M->bool` THEN
7117       DISCH_TAC THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN
7118       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; REAL_ARITH
7119        `(a - x <= a + x <=> &0 <= x) /\ (a + x) - (a - x) = &2 * x`] THEN
7120       REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
7121       ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
7122       SUBGOAL_THEN `d = interval[u d:real^M,v d]`
7123        (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])
7124       THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
7125       REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7126       SUBGOAL_THEN
7127        `!i. 1 <= i /\ i <= dimindex(:M)
7128             ==> ((u:(real^M->bool)->real^M) d)$i <= (v d:real^M)$i`
7129       MP_TAC THENL
7130        [ASM_MESON_TAC[SUBSET; INTERVAL_NE_EMPTY; REAL_LT_IMP_LE]; ALL_TAC] THEN
7131       SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN DISCH_TAC THEN
7132       REWRITE_TAC[PRODUCT_CONST_NUMSEG; REAL_POW_MUL] THEN
7133       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH;
7134                    GSYM REAL_MUL_ASSOC; ADD_SUB; DIMINDEX_GE_1; LE_1] THEN
7135       MATCH_MP_TAC REAL_LE_TRANS THEN
7136       EXISTS_TAC `((v d:real^M)$1 - ((u:(real^M->bool)->real^M) d)$1)
7137                   pow (dimindex(:M))` THEN
7138       CONJ_TAC THENL
7139        [MATCH_MP_TAC REAL_POW_MONO_INV THEN
7140         ASM_SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN
7141         REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
7142         MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN W(MP_TAC o
7143           PART_MATCH (lhand o rand) COMPONENT_LE_NORM o lhand o snd) THEN
7144         REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN
7145         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7146         MATCH_MP_TAC(NORM_ARITH
7147          `!z r. norm(z - u) < r /\ norm(z - v) < r /\ r <= &1 / &2
7148                 ==> norm(v - u:real^M) <= &1`) THEN
7149         MAP_EVERY EXISTS_TAC
7150          [`(z:(real^M->bool)->real^M) d`;
7151           `r((z:(real^M->bool)->real^M) d):real`] THEN
7152         ASM_REWRITE_TAC[GSYM dist; GSYM IN_BALL] THEN
7153         SUBGOAL_THEN
7154          `(u:(real^M->bool)->real^M) d IN interval[u d,v d] /\
7155           (v:(real^M->bool)->real^M) d IN interval[u d,v d]`
7156         MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
7157         ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY];
7158         GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
7159         SIMP_TAC[GSYM PRODUCT_CONST; FINITE_NUMSEG] THEN
7160         MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
7161         FIRST_X_ASSUM(MP_TAC o SPECL
7162          [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN
7163         ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL; SUBSET]];
7164       MATCH_MP_TAC REAL_LE_TRANS THEN
7165       EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow dimindex(:N) *
7166                   measure(t:real^M->bool)` THEN
7167       CONJ_TAC THENL
7168        [MATCH_MP_TAC REAL_LE_LMUL THEN
7169         CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC];
7170         MATCH_MP_TAC REAL_LT_IMP_LE THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
7171         W(MP_TAC o PART_MATCH (rand o rand) REAL_LT_RDIV_EQ o snd)] THEN
7172       ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_MUL; LE_1; DIMINDEX_GE_1;
7173                    REAL_ARITH `&0 < &2 * B <=> &0 < B`; REAL_OF_NUM_LT] THEN
7174       MATCH_MP_TAC REAL_LE_TRANS THEN
7175       EXISTS_TAC `measure(UNIONS D':real^M->bool)` THEN CONJ_TAC THENL
7176        [MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`]
7177           MEASURE_ELEMENTARY) THEN
7178         ANTS_TAC THENL
7179          [ASM_REWRITE_TAC[division_of] THEN
7180           CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
7181           GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL
7182            [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]];
7183           DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
7184           MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]];
7185         MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL
7186          [MATCH_MP_TAC MEASURABLE_UNIONS THEN
7187           ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET];
7188           ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN
7189           EXISTS_TAC `UNIONS D:real^M->bool` THEN
7190           ASM_SIMP_TAC[SUBSET_UNIONS] THEN
7191           REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN
7192           X_GEN_TAC `d:real^M->bool` THEN
7193           REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
7194           DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN
7195           SUBGOAL_THEN `d SUBSET ball(z d:real^M,r(z d))` MP_TAC THENL
7196            [ASM_MESON_TAC[];
7197             REWRITE_TAC[SUBSET; IN_BALL; dist] THEN
7198             ASM_MESON_TAC[NORM_SUB]]]]]) in
7199   REPEAT STRIP_TAC THEN
7200   SUBGOAL_THEN
7201    `s = UNIONS
7202     {{x | x IN s /\ norm(x:real^M) <= &n /\
7203           ?t. open t /\ x IN t /\
7204               !y. y IN s INTER t
7205                   ==> norm(f y - f x:real^N) <= (&n + &1) * norm(y - x)} |
7206      n IN (:num)}`
7207   SUBST1_TAC THENL
7208    [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
7209     X_GEN_TAC `x:real^M` THEN
7210     ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
7211     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
7212     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
7213     REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
7214     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
7215     X_GEN_TAC `t:real^M->bool` THEN
7216     DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN
7217     MP_TAC(SPEC `max (norm(x:real^M)) b` REAL_ARCH_SIMPLE) THEN
7218     MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MAX_LE] THEN
7219     X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7220     MATCH_MP_TAC REAL_LE_TRANS THEN
7221     EXISTS_TAC `b * norm(y - x:real^M)` THEN ASM_SIMP_TAC[] THEN
7222     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
7223     ASM_REAL_ARITH_TAC;
7224     REWRITE_TAC[IMAGE_UNIONS] THEN
7225     MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
7226     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
7227     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
7228     ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
7229     X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN
7230     MATCH_MP_TAC lemma THEN EXISTS_TAC `&n + &1` THEN ASM_REWRITE_TAC[] THEN
7231     REPEAT CONJ_TAC THENL
7232      [MATCH_MP_TAC BOUNDED_SUBSET THEN
7233       EXISTS_TAC `cball(vec 0:real^M,&n)` THEN
7234       SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM];
7235       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
7236       ASM_REWRITE_TAC[] THEN SET_TAC[];
7237       REAL_ARITH_TAC;
7238       REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN MESON_TAC[]]]);;
7239
7240 let NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV = prove
7241  (`!f:real^N->real^N s B.
7242         negligible s /\ (!x y. norm(f x - f y) <= B * norm(x - y))
7243         ==> negligible(IMAGE f s)`,
7244   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN
7245   ASM_REWRITE_TAC[LE_REFL] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
7246   MAP_EVERY EXISTS_TAC [`interval(a - vec 1:real^N,a + vec 1)`; `B:real`] THEN
7247   ASM_REWRITE_TAC[OPEN_INTERVAL; IN_INTERVAL] THEN
7248   REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN
7249   REAL_ARITH_TAC);;
7250
7251 let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE = prove
7252  (`!f:real^M->real^N s.
7253         dimindex(:M) <= dimindex(:N) /\ negligible s /\ f differentiable_on s
7254         ==> negligible(IMAGE f s)`,
7255   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN
7256   ASM_REWRITE_TAC[IN_INTER] THEN
7257   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7258   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN
7259   DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
7260   ASM_REWRITE_TAC[differentiable; HAS_DERIVATIVE_WITHIN_ALT] THEN
7261   DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN
7262   FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN
7263   REWRITE_TAC[REAL_LT_01; REAL_MUL_RID] THEN
7264   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
7265   FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN
7266   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
7267   EXISTS_TAC `ball(x:real^M,d)` THEN EXISTS_TAC `B + &1` THEN
7268   ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
7269   REWRITE_TAC[IN_BALL; dist; REAL_ADD_RDISTRIB] THEN REPEAT STRIP_TAC THEN
7270   MATCH_MP_TAC(NORM_ARITH
7271    `!d. norm(y - x - d:real^N) <= z /\ norm(d) <= b
7272         ==> norm(y - x) <= b + z`) THEN
7273   EXISTS_TAC `(f':real^M->real^N)(y - x)` THEN
7274   ASM_MESON_TAC[NORM_SUB]);;
7275
7276 let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM = prove
7277  (`!f:real^M->real^N s.
7278         dimindex(:M) < dimindex(:N) /\ f differentiable_on s
7279         ==> negligible(IMAGE f s)`,
7280   REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP
7281    (ARITH_RULE `m < n ==> !x:num. x <= m ==> x <= n`)) THEN
7282   SUBGOAL_THEN
7283    `(f:real^M->real^N) =
7284     (f o ((\x. lambda i. x$i):real^N->real^M)) o
7285     ((\x. lambda i. if i <= dimindex(:M) then x$i else &0):real^M->real^N)`
7286   SUBST1_TAC THENL
7287    [SIMP_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
7288     ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA];
7289     ONCE_REWRITE_TAC[IMAGE_o] THEN
7290     MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN
7291     REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL
7292      [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
7293       EXISTS_TAC `{y:real^N | y$(dimindex(:N)) = &0}` THEN
7294       SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; LE_REFL; DIMINDEX_GE_1] THEN
7295       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
7296       SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_GE_1] THEN
7297       ASM_REWRITE_TAC[GSYM NOT_LT];
7298       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN
7299       REWRITE_TAC[differentiable_on; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
7300       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7301       MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL
7302        [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN
7303         SIMP_TAC[linear; LAMBDA_BETA; CART_EQ;
7304                  VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT];
7305         FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
7306         MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THENL
7307          [AP_TERM_TAC;
7308           MATCH_MP_TAC(SET_RULE
7309            `(!x. f(g x) = x) ==> s = IMAGE f (IMAGE g s)`)] THEN
7310         ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]]]]);;
7311
7312 (* ------------------------------------------------------------------------- *)
7313 (* Simplest case of Sard's theorem (we don't need continuity of derivative). *)
7314 (* ------------------------------------------------------------------------- *)
7315
7316 let BABY_SARD = prove
7317  (`!f:real^M->real^N f' s.
7318         dimindex(:M) <= dimindex(:N) /\
7319         (!x. x IN s
7320              ==> (f has_derivative f' x) (at x within s) /\
7321                  rank(matrix(f' x)) < dimindex(:N))
7322         ==> negligible(IMAGE f s)`,
7323   let lemma = prove
7324    (`!p w e m.
7325       dim p < dimindex(:N) /\ &0 <= m /\ &0 <= e
7326       ==> ?s. measurable s /\
7327               {z:real^N | norm(z - w) <= m /\
7328                           ?t. t IN p /\ norm(z - w - t) <= e}
7329               SUBSET s /\
7330               measure s <= (&2 * e) * (&2 * m) pow (dimindex(:N) - 1)`,
7331     REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `w:real^N` ["t"; "p"] THEN
7332     REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
7333     DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
7334     REWRITE_TAC[VECTOR_SUB_RZERO; LEFT_IMP_EXISTS_THM] THEN
7335     X_GEN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN
7336     X_GEN_TAC `a:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
7337     ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
7338     REPEAT STRIP_TAC THEN
7339     EXISTS_TAC
7340      `interval[--(lambda i. if i = 1 then e else m):real^N,
7341                (lambda i. if i = 1 then e else m)]` THEN
7342     REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL
7343      [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN
7344       SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN
7345       X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
7346       REWRITE_TAC[REAL_BOUNDS_LE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
7347       COND_CASES_TAC THENL
7348        [ALL_TAC; ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]] THEN
7349       FIRST_X_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
7350       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7351       DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
7352       ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM; DOT_BASIS; DOT_LMUL;
7353                    DIMINDEX_GE_1; LE_REFL; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN
7354       MP_TAC(ISPECL [`x - y:real^N`; `1`] COMPONENT_LE_NORM) THEN
7355       REWRITE_TAC[VECTOR_SUB_COMPONENT; ARITH; DIMINDEX_GE_1] THEN
7356       ASM_REAL_ARITH_TAC;
7357       REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7358       SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN
7359       COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_POS] THEN
7360       REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN
7361       SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1] THEN
7362       MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN
7363       SIMP_TAC[ARITH; ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN
7364       SIMP_TAC[PRODUCT_CONST_NUMSEG; DIMINDEX_GE_1; REAL_LE_REFL; ARITH_RULE
7365        `1 <= n ==> (n + 1) - 2 = n - 1`]]) in
7366   let semma = prove
7367    (`!f:real^M->real^N f' s B.
7368           dimindex(:M) <= dimindex(:N) /\ &0 < B /\ bounded s /\
7369           (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\
7370                          rank(matrix(f' x)) < dimindex(:N) /\ onorm(f' x) <= B)
7371           ==> negligible(IMAGE f s)`,
7372     REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
7373     REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN
7374     SUBGOAL_THEN `!x. x IN s ==> linear((f':real^M->real^M->real^N) x)`
7375     ASSUME_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN
7376     REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
7377     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7378     SUBGOAL_THEN
7379      `?c. s SUBSET interval(--(vec c):real^M,vec c) /\
7380             ~(interval(--(vec c):real^M,vec c) = {})`
7381     STRIP_ASSUME_TAC THENL
7382      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
7383       DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
7384       MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN
7385       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
7386       DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN
7387       REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7388       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
7389       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN
7390       STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LT] THEN W(MP_TAC o
7391         PART_MATCH (lhand o rand) COMPONENT_LE_NORM o lhand o snd) THEN
7392       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
7393       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
7394       ALL_TAC] THEN
7395     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN
7396     DISCH_THEN(MP_TAC o SPEC `1`) THEN
7397     REWRITE_TAC[VEC_COMPONENT; DIMINDEX_GE_1;
7398                 LE_REFL; VECTOR_NEG_COMPONENT] THEN
7399     REWRITE_TAC[REAL_ARITH `--x < x <=> &0 < &2 * x`; REAL_OF_NUM_MUL] THEN
7400     DISCH_TAC THEN
7401     SUBGOAL_THEN
7402      `?d. &0 < d /\ d <= B /\
7403           (d * &2) * (&4 * B) pow (dimindex(:N) - 1) <=
7404           e / &(2 * c) pow dimindex(:M) / &(dimindex(:M)) pow dimindex(:M)`
7405     STRIP_ASSUME_TAC THENL
7406      [EXISTS_TAC
7407        `min B (e / &(2 * c) pow dimindex(:M) /
7408                &(dimindex(:M)) pow dimindex(:M) /
7409                (&4 * B) pow (dimindex(:N) - 1) / &2)` THEN
7410       ASM_REWRITE_TAC[REAL_LT_MIN; REAL_ARITH `min x y <= x`] THEN
7411       CONJ_TAC THENL
7412        [REPEAT(MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC) THEN
7413         ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1;
7414                      REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH];
7415         ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT;
7416                      REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH] THEN
7417         REAL_ARITH_TAC];
7418       ALL_TAC] THEN
7419     SUBGOAL_THEN
7420      `!x. ?r. &0 < r /\ r <= &1 / &2 /\
7421               (x IN s
7422                ==> !y. y IN s /\ norm(y - x) < r
7423                        ==> norm((f:real^M->real^N) y - f x - f' x (y - x)) <=
7424                            d * norm(y - x))`
7425     MP_TAC THENL
7426      [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN
7427       ASM_REWRITE_TAC[] THENL
7428        [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN
7429       UNDISCH_THEN
7430        `!x. x IN s ==> ((f:real^M->real^N) has_derivative f' x) (at x within s)`
7431        (MP_TAC o REWRITE_RULE[HAS_DERIVATIVE_WITHIN_ALT]) THEN
7432       ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM] THEN
7433       DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `d:real`]) THEN
7434       ASM_REWRITE_TAC[] THEN
7435       DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
7436       EXISTS_TAC `min r (&1 / &2)` THEN
7437       ASM_REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LE_REFL] THEN
7438       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[];
7439       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
7440       X_GEN_TAC `r:real^M->real` THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
7441       REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
7442       REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7443       DISCH_THEN(LABEL_TAC "*")] THEN
7444     MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`;
7445                    `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN
7446     ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL
7447      [ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN
7448     REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7449     DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
7450     SUBGOAL_THEN
7451      `!k:real^M->bool.
7452           k IN D
7453           ==> ?t. measurable(t) /\
7454                   IMAGE (f:real^M->real^N) (k INTER s) SUBSET t /\
7455                   measure t <= e / &(2 * c) pow (dimindex(:M)) * measure(k)`
7456     MP_TAC THENL
7457      [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
7458       SUBGOAL_THEN `?u v:real^M. k = interval[u,v]`
7459        (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
7460       THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
7461       SUBGOAL_THEN `?x:real^M. x IN (s INTER interval[u,v]) /\
7462                                interval[u,v] SUBSET ball(x,r x)`
7463       MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTER]] THEN
7464       DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
7465       MP_TAC(ISPECL [`IMAGE ((f':real^M->real^M->real^N) x) (:real^M)`;
7466                `(f:real^M->real^N) x`;
7467                  `d * norm(v - u:real^M)`;
7468                  `(&2 * B) * norm(v - u:real^M)`]
7469           lemma) THEN
7470       ANTS_TAC THENL
7471        [ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN
7472         MP_TAC(ISPEC `matrix ((f':real^M->real^M->real^N) x)`
7473           RANK_DIM_IM) THEN
7474         ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX] THEN
7475         ASM_MESON_TAC[];
7476         ALL_TAC] THEN
7477       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
7478       REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN CONJ_TAC THENL
7479        [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN
7480         REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN
7481         X_GEN_TAC `y:real^M` THEN
7482         REWRITE_TAC[IN_INTER; EXISTS_IN_IMAGE; IN_UNIV] THEN
7483         STRIP_TAC THEN REMOVE_THEN "*"
7484          (MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
7485         ANTS_TAC THENL
7486          [ASM_MESON_TAC[IN_BALL; SUBSET; NORM_SUB; dist]; ALL_TAC] THEN
7487         DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL
7488          [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC(NORM_ARITH
7489            `norm(z) <= B /\ d <= B
7490             ==> norm(y - x - z:real^N) <= d
7491                 ==> norm(y - x) <= &2 * B`) THEN
7492           CONJ_TAC THENL
7493            [MP_TAC(ISPEC `(f':real^M->real^M->real^N) x` ONORM) THEN
7494             ASM_SIMP_TAC[] THEN
7495             DISCH_THEN(MP_TAC o SPEC `y - x:real^M` o CONJUNCT1) THEN
7496             MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7497             MATCH_MP_TAC REAL_LE_MUL2 THEN
7498             ASM_SIMP_TAC[ONORM_POS_LE; NORM_POS_LE];
7499             MATCH_MP_TAC REAL_LE_MUL2 THEN
7500             ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]];
7501           DISCH_THEN(fun th -> EXISTS_TAC `y - x:real^M` THEN MP_TAC th) THEN
7502           MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7503           ASM_SIMP_TAC[REAL_LE_LMUL_EQ]] THEN
7504         MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
7505         REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])) THEN
7506         REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
7507         MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
7508         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
7509         ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
7510         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7511         REWRITE_TAC[REAL_ARITH `&2 * (&2 * B) * n = (&4 * B) * n`] THEN
7512         GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_POW_MUL] THEN
7513         SIMP_TAC[REAL_ARITH `(&2 * d * n) * a * b = d * &2 * a * (n * b)`] THEN
7514         REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN
7515         SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`] THEN
7516         MATCH_MP_TAC REAL_LE_TRANS THEN
7517         EXISTS_TAC `e / &(2 * c) pow (dimindex(:M)) /
7518                     (&(dimindex(:M)) pow dimindex(:M)) *
7519                     norm(v - u:real^M) pow dimindex(:N)` THEN
7520         CONJ_TAC THENL
7521          [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
7522           ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE];
7523           ALL_TAC] THEN
7524         GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_div] THEN
7525         REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
7526         ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE] THEN
7527         REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
7528         SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT;
7529                  LE_1; DIMINDEX_GE_1] THEN
7530         MATCH_MP_TAC REAL_LE_TRANS THEN
7531         EXISTS_TAC `norm(v - u:real^M) pow dimindex(:M)` THEN CONJ_TAC THENL
7532          [MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN
7533           SUBGOAL_THEN `u IN ball(x:real^M,r x) /\ v IN ball(x,r x)` MP_TAC
7534           THENL
7535            [ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL; INTERIOR_EMPTY];
7536             REWRITE_TAC[IN_BALL] THEN
7537             SUBGOAL_THEN `(r:real^M->real) x <= &1 / &2` MP_TAC THENL
7538               [ASM_REWRITE_TAC[]; CONV_TAC NORM_ARITH]];
7539           REMOVE_THEN "*" (K ALL_TAC) THEN
7540           FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M`; `v:real^M`]) THEN
7541           ASM_REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN
7542           REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_OF_NUM_MUL] THEN
7543           X_GEN_TAC `p:num` THEN DISCH_TAC THEN
7544           MATCH_MP_TAC REAL_LE_TRANS THEN
7545           EXISTS_TAC `(sum(1..dimindex(:M)) (\i. abs((v - u:real^M)$i)))
7546                       pow (dimindex(:M))` THEN
7547           CONJ_TAC THENL
7548            [MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[NORM_POS_LE; NORM_LE_L1];
7549             REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7550             GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
7551              [GSYM REAL_SUB_LE] THEN
7552             ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2] THEN
7553             ASM_SIMP_TAC[SUM_CONST_NUMSEG; PRODUCT_CONST_NUMSEG;
7554                          VECTOR_SUB_COMPONENT; ADD_SUB] THEN
7555             REWRITE_TAC[REAL_POW_MUL; REAL_MUL_SYM] THEN
7556             MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN REWRITE_TAC[] THEN
7557             AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[REAL_ABS_REFL] THEN
7558             ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2]]]];
7559       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7560       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
7561       X_GEN_TAC `g:(real^M->bool)->(real^N->bool)` THEN DISCH_TAC THEN
7562       EXISTS_TAC `UNIONS (IMAGE (g:(real^M->bool)->(real^N->bool)) D)` THEN
7563       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7564       MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
7565       ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
7566       ONCE_REWRITE_TAC[CONJ_SYM] THEN
7567       REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
7568       X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN
7569       W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o
7570         lhand o snd) THEN
7571       ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
7572       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7573       MATCH_MP_TAC REAL_LE_TRANS THEN
7574       EXISTS_TAC
7575        `sum D' (\k:real^M->bool.
7576                   e / &(2 * c) pow (dimindex(:M)) * measure k)` THEN CONJ_TAC
7577       THENL [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
7578       REWRITE_TAC[SUM_LMUL] THEN
7579       REWRITE_TAC[REAL_ARITH `e / b * x:real = (e * x) / b`] THEN
7580       ASM_SIMP_TAC[REAL_POW_LT; REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ] THEN
7581       MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`]
7582               MEASURE_ELEMENTARY) THEN
7583       ANTS_TAC THENL
7584        [ASM_REWRITE_TAC[division_of] THEN
7585         CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
7586         GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL
7587          [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]];
7588         ALL_TAC] THEN
7589       MATCH_MP_TAC(REAL_ARITH `y = z /\ x <= e ==> x = y ==> z <= e`) THEN
7590       CONJ_TAC THENL
7591        [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET];
7592         ALL_TAC] THEN
7593       MATCH_MP_TAC REAL_LE_TRANS THEN
7594       EXISTS_TAC `measure(interval[--(vec c):real^M,vec c])` THEN CONJ_TAC THENL
7595        [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN
7596         CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS; ASM SET_TAC[]] THEN
7597         ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
7598         SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7599         REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT; REAL_ARITH
7600          `x - --x = &2 * x /\ (--x <= x <=> &0 <= &2 * x)`] THEN
7601         ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_LT_IMP_LE] THEN
7602         REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB; REAL_LE_REFL]]]) in
7603   REPEAT STRIP_TAC THEN
7604   SUBGOAL_THEN
7605    `s = UNIONS
7606     {{x | x IN s /\ norm(x:real^M) <= &n /\
7607           onorm((f':real^M->real^M->real^N) x) <= &n} |
7608      n IN (:num)}`
7609   SUBST1_TAC THENL
7610    [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
7611     X_GEN_TAC `x:real^M` THEN
7612     ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
7613     REWRITE_TAC[GSYM REAL_MAX_LE; REAL_ARCH_SIMPLE];
7614     REWRITE_TAC[IMAGE_UNIONS] THEN
7615     MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
7616     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
7617     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
7618     ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
7619     X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN
7620     MATCH_MP_TAC semma THEN
7621     MAP_EVERY EXISTS_TAC [`f':real^M->real^M->real^N`; `&n + &1:real`] THEN
7622     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
7623     CONJ_TAC THENL
7624      [MATCH_MP_TAC BOUNDED_SUBSET THEN
7625       EXISTS_TAC `cball(vec 0:real^M,&n)` THEN
7626       SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM];
7627       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
7628       ASM_SIMP_TAC[REAL_ARITH `x <= n ==> x <= n + &1`] THEN
7629       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
7630       REPEAT STRIP_TAC THEN
7631       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7632        HAS_DERIVATIVE_WITHIN_SUBSET)) THEN SET_TAC[]]]);;
7633
7634 (* ------------------------------------------------------------------------- *)
7635 (* Also negligibility of BV low-dimensional image.                           *)
7636 (* ------------------------------------------------------------------------- *)
7637
7638 let NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL = prove
7639  (`!f:real^1->real^N a b.
7640         2 <= dimindex(:N) /\ f has_bounded_variation_on interval[a,b]
7641         ==> negligible(IMAGE f (interval[a,b]))`,
7642   REPEAT STRIP_TAC THEN
7643   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7644         HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT)) THEN
7645   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7646         HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT)) THEN
7647   REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN
7648   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
7649   X_GEN_TAC `l:real^1->real^N` THEN DISCH_TAC THEN
7650   X_GEN_TAC `r:real^1->real^N` THEN DISCH_TAC THEN
7651   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `ee:real` THEN DISCH_TAC THEN
7652   ABBREV_TAC
7653    `e = min (&1) (ee /
7654      (&2 pow (dimindex(:N)) *
7655       vector_variation (interval[a,b]) (f:real^1->real^N) + &1))` THEN
7656   SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
7657    [EXPAND_TAC "e" THEN
7658     MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < min (&1) x`) THEN
7659     MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN
7660     MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN
7661     MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[VECTOR_VARIATION_POS_LE] THEN
7662     MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC;
7663     ALL_TAC] THEN
7664   SUBGOAL_THEN
7665    `!c. ?d. &0 < d /\
7666             (c IN interval[a,b]
7667              ==> (!x. x IN interval[a,c] /\ ~(x = c) /\ dist(x,c) < d
7668                       ==> dist((f:real^1->real^N) x,l c) < e) /\
7669                  (!x. x IN interval[c,b] /\ ~(x = c) /\ dist(x,c) < d
7670                       ==> dist(f x,r c) < e))`
7671   MP_TAC THENL
7672    [X_GEN_TAC `c:real^1` THEN ASM_CASES_TAC `(c:real^1) IN interval[a,b]` THENL
7673      [ALL_TAC; EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN
7674     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^1`)) THEN
7675     ASM_REWRITE_TAC[LIM_WITHIN; IMP_IMP; AND_FORALL_THM] THEN
7676     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN
7677     DISCH_THEN(CONJUNCTS_THEN2
7678      (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC)
7679      (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN
7680     EXISTS_TAC `min d1 d2:real` THEN ASM_SIMP_TAC[REAL_LT_MIN];
7681     REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
7682     X_GEN_TAC `d:real^1->real` THEN
7683     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN
7684   MP_TAC(ISPECL [`\x:real^1. ball(x,d x)`; `a:real^1`; `b:real^1`]
7685     FINE_DIVISION_EXISTS) THEN
7686   ASM_REWRITE_TAC[fine; gauge; OPEN_BALL; CENTRE_IN_BALL] THEN
7687   DISCH_THEN(X_CHOOSE_THEN
7688    `p:(real^1#(real^1->bool))->bool` STRIP_ASSUME_TAC) THEN
7689   FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
7690   EXISTS_TAC
7691    `UNIONS(IMAGE (\(c,k).
7692        (f c) INSERT
7693        (cball((l:real^1->real^N) c,
7694               min e (vector_variation (interval[interval_lowerbound k,c])
7695                                       (f:real^1->real^N))) UNION
7696         cball((r:real^1->real^N) c,
7697               min e (vector_variation (interval[c,interval_upperbound k])
7698                                       (f:real^1->real^N))))) p)` THEN
7699   REPEAT CONJ_TAC THENL
7700    [FIRST_ASSUM(SUBST1_TAC o MATCH_MP TAGGED_DIVISION_UNION_IMAGE_SND) THEN
7701     REWRITE_TAC[IMAGE_UNIONS; GSYM IMAGE_o] THEN
7702     MATCH_MP_TAC UNIONS_MONO_IMAGE THEN
7703     REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN
7704     MAP_EVERY X_GEN_TAC [`c:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN
7705     SUBGOAL_THEN `?u v:real^1. k = interval[u,v]`
7706      (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
7707     THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN
7708     SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL
7709      [ASM_MESON_TAC[TAGGED_DIVISION_OF; INTERVAL_NE_EMPTY_1; NOT_IN_EMPTY];
7710       ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1]] THEN
7711     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
7712     X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN
7713     FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `interval[u:real^1,v]`]) THEN
7714     ASM_REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_CBALL] THEN DISCH_TAC THEN
7715     REWRITE_TAC[IN_INSERT; IN_UNION] THEN ASM_CASES_TAC `x:real^1 = c` THEN
7716     ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN
7717     SIMP_TAC[IN_CBALL; REAL_LE_MIN] THEN ASM_CASES_TAC `drop x <= drop c` THENL
7718      [DISJ1_TAC THEN CONJ_TAC THENL
7719        [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
7720         REMOVE_THEN "*" (MP_TAC o SPEC `c:real^1`) THEN ANTS_TAC THENL
7721          [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN
7722         DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN
7723         ASM_SIMP_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN
7724         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF];
7725         ALL_TAC] THEN
7726       SUBGOAL_THEN `drop a <= drop u /\ drop x < drop c /\
7727                     drop c <= drop v /\ drop v <= drop b`
7728       STRIP_ASSUME_TAC THENL
7729        [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN
7730         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF;
7731                       REAL_LE_TOTAL];
7732         ALL_TAC] THEN
7733       REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
7734       MATCH_MP_TAC
7735        (REWRITE_RULE[LIFT_DROP; FORALL_LIFT]
7736           (ISPEC `at c within interval [u:real^1,c]` LIM_DROP_UBOUND)) THEN
7737       EXISTS_TAC `\y:real^1. lift(norm(f x - f y:real^N))` THEN
7738       REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIFT_DROP] THEN REPEAT CONJ_TAC THENL
7739        [MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN
7740         ASM_SIMP_TAC[IN_INTERVAL_1; LIM_CONST] THEN
7741         MATCH_MP_TAC LIM_WITHIN_SUBSET THEN
7742         EXISTS_TAC `interval[a:real^1,c]` THEN CONJ_TAC THENL
7743          [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN
7744           ASM_REAL_ARITH_TAC;
7745           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC];
7746         W(MP_TAC o PART_MATCH (lhs o rand) LIMPT_OF_CONVEX o snd) THEN
7747         ANTS_TAC THENL
7748          [SIMP_TAC[CONVEX_INTERVAL; ENDS_IN_INTERVAL;
7749                    INTERVAL_NE_EMPTY_1] THEN
7750           ASM_REAL_ARITH_TAC;
7751           DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE
7752            `(?y. ~(y = x) /\ y IN s) ==> ~(s = {x})`) THEN
7753           EXISTS_TAC `u:real^1` THEN
7754           REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC];
7755         REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN
7756         REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN
7757         REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN
7758         MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL
7759          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7760             HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
7761           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC;
7762           MATCH_MP_TAC(CONJUNCT1(SPEC_ALL
7763            (REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_INTERVAL))) THEN
7764           REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]];
7765       DISJ2_TAC THEN CONJ_TAC THENL
7766        [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
7767         REMOVE_THEN "*" (MP_TAC o SPEC `c:real^1`) THEN ANTS_TAC THENL
7768          [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN
7769         DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
7770         ASM_SIMP_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN
7771         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF;
7772                       REAL_LE_TOTAL];
7773         ALL_TAC] THEN
7774       SUBGOAL_THEN `drop a <= drop c /\ drop c < drop x /\
7775                     drop x <= drop v /\ drop v <= drop b`
7776       STRIP_ASSUME_TAC THENL
7777        [ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN
7778         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF;
7779                       REAL_LE_TOTAL];
7780         ALL_TAC] THEN
7781       REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
7782       MATCH_MP_TAC
7783        (REWRITE_RULE[LIFT_DROP; FORALL_LIFT]
7784           (ISPEC `at c within interval [c:real^1,v]` LIM_DROP_UBOUND)) THEN
7785       EXISTS_TAC `\y:real^1. lift(norm(f x - f y:real^N))` THEN
7786       REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIFT_DROP] THEN REPEAT CONJ_TAC THENL
7787        [MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN
7788         ASM_SIMP_TAC[IN_INTERVAL_1; LIM_CONST] THEN
7789         MATCH_MP_TAC LIM_WITHIN_SUBSET THEN
7790         EXISTS_TAC `interval[c:real^1,b]` THEN CONJ_TAC THENL
7791          [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN
7792           ASM_REAL_ARITH_TAC;
7793           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC];
7794         W(MP_TAC o PART_MATCH (lhs o rand) LIMPT_OF_CONVEX o snd) THEN
7795         ANTS_TAC THENL
7796          [SIMP_TAC[CONVEX_INTERVAL; ENDS_IN_INTERVAL;
7797                    INTERVAL_NE_EMPTY_1] THEN
7798           ASM_REAL_ARITH_TAC;
7799           DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE
7800            `(?y. ~(y = x) /\ y IN s) ==> ~(s = {x})`) THEN
7801           EXISTS_TAC `v:real^1` THEN
7802           REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC];
7803         REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN
7804         REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN
7805         REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN
7806         MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL
7807          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7808             HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
7809           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC;
7810           MATCH_MP_TAC(CONJUNCT1(SPEC_ALL
7811            (REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_INTERVAL))) THEN
7812           REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]];
7813     MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
7814     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
7815     SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_UNION; MEASURABLE_INSERT];
7816     W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o
7817       lhand o snd) THEN
7818     ANTS_TAC THENL
7819      [ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
7820       SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_UNION; MEASURABLE_INSERT];
7821       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN
7822     ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[MEASURE_INSERT] THEN
7823     MATCH_MP_TAC REAL_LE_TRANS THEN
7824     EXISTS_TAC
7825      `&2 pow (dimindex(:N)) *
7826       e * sum p (\(x:real^1,k). vector_variation k (f:real^1->real^N))` THEN
7827     CONJ_TAC THENL
7828      [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN
7829       ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN
7830       MAP_EVERY X_GEN_TAC [`c:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN
7831       SUBGOAL_THEN `?u v:real^1. k = interval[u,v]`
7832        (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
7833       THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN
7834       SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL
7835        [ASM_MESON_TAC[TAGGED_DIVISION_OF; INTERVAL_NE_EMPTY_1; NOT_IN_EMPTY];
7836         ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1]] THEN
7837       SUBGOAL_THEN
7838        `(f:real^1->real^N) has_bounded_variation_on interval[u,c] /\
7839         (f:real^1->real^N) has_bounded_variation_on interval[c,v]`
7840       STRIP_ASSUME_TAC THENL
7841        [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
7842          (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
7843         MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interval[u:real^1,v]` THEN
7844         (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[TAGGED_DIVISION_OF]]) THEN
7845         REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
7846         REWRITE_TAC[GSYM IN_INTERVAL_1] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF];
7847         ALL_TAC] THEN
7848       SUBGOAL_THEN
7849        `vector_variation (interval [u,v]) (f:real^1->real^N) =
7850         vector_variation (interval [u,c]) f +
7851         vector_variation (interval [c,v]) f`
7852       SUBST1_TAC THENL
7853        [CONV_TAC SYM_CONV THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN
7854         ASM_REWRITE_TAC[CONJ_ASSOC; GSYM IN_INTERVAL_1] THEN
7855         CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN
7856         ASM_MESON_TAC[TAGGED_DIVISION_OF; HAS_BOUNDED_VARIATION_ON_SUBSET];
7857         ALL_TAC] THEN
7858       W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNION_LE o lhand o snd) THEN
7859       REWRITE_TAC[MEASURABLE_CBALL; REAL_ADD_LDISTRIB] THEN
7860       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7861       MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN
7862       W(MP_TAC o PART_MATCH (lhand o rand)
7863         MEASURE_CBALL_BOUND o lhand o snd) THEN
7864       ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE] THEN
7865       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7866       REWRITE_TAC[REAL_POW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
7867       SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
7868       (SUBGOAL_THEN `dimindex(:N) = (dimindex(:N) - 1) + 1` SUBST1_TAC THENL
7869        [ASM_ARITH_TAC; REWRITE_TAC[REAL_POW_ADD; REAL_POW_1]]) THEN
7870       MATCH_MP_TAC REAL_LE_MUL2 THEN
7871       ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE;
7872                    REAL_POW_LE; REAL_ARITH `min e v <= v`] THEN
7873       MATCH_MP_TAC REAL_LE_TRANS THEN
7874       EXISTS_TAC `(e:real) pow (dimindex(:N) - 1)` THEN
7875       (CONJ_TAC THENL
7876        [MATCH_MP_TAC REAL_POW_LE2 THEN
7877         ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE] THEN
7878         REAL_ARITH_TAC;
7879         GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN
7880         MATCH_MP_TAC REAL_POW_MONO_INV THEN
7881         ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "e" THEN CONJ_TAC THENL
7882          [ASM_REAL_ARITH_TAC; ASM_ARITH_TAC]]);
7883       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
7884        `&2 pow dimindex (:N) *
7885         (ee / (&2 pow (dimindex(:N)) *
7886             vector_variation (interval[a,b]) (f:real^1->real^N) + &1)) *
7887         sum p (\(x:real^1,k). vector_variation k f)` THEN
7888       CONJ_TAC THENL
7889        [MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POS; REAL_POW_LE] THEN
7890         MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL
7891          [EXPAND_TAC "e" THEN REAL_ARITH_TAC; ALL_TAC] THEN
7892         MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN
7893         ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; TAGGED_DIVISION_OF;
7894                       VECTOR_VARIATION_POS_LE];
7895         ALL_TAC] THEN
7896       REWRITE_TAC[REAL_ARITH `a * b / c * d:real = (b * a * d) / c`] THEN
7897       W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_LDIV_EQ o snd) THEN
7898       ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; VECTOR_VARIATION_POS_LE;
7899                    REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN
7900       DISCH_THEN SUBST1_TAC THEN
7901       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC] THEN
7902       MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= y + &1`) THEN
7903       MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
7904       FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7905           SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN DISCH_THEN(fun th ->
7906       W(MP_TAC o PART_MATCH (lhs o rand) th o lhand o snd)) THEN
7907       SIMP_TAC[VECTOR_VARIATION_ON_NULL; BOUNDED_INTERVAL] THEN
7908       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ETA_AX] THEN
7909       MATCH_MP_TAC REAL_EQ_IMP_LE THEN
7910       MATCH_MP_TAC VECTOR_VARIATION_ON_DIVISION THEN
7911       ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]]]);;
7912
7913 let NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE = prove
7914  (`!g:real^1->real^N.
7915         2 <= dimindex(:N) /\ rectifiable_path g ==> negligible(path_image g)`,
7916   REWRITE_TAC[rectifiable_path; path_image] THEN
7917   SIMP_TAC[NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL]);;
7918
7919 (* ------------------------------------------------------------------------- *)
7920 (* Properties of Lebesgue measurable sets.                                   *)
7921 (* ------------------------------------------------------------------------- *)
7922
7923 let MEASURABLE_IMP_LEBESGUE_MEASURABLE = prove
7924  (`!s:real^N->bool. measurable s ==> lebesgue_measurable s`,
7925   REPEAT STRIP_TAC THEN REWRITE_TAC[lebesgue_measurable] THEN
7926   MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
7927   ASM_REWRITE_TAC[indicator; GSYM MEASURABLE_INTEGRABLE]);;
7928
7929 let NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE = prove
7930  (`!s:real^N->bool. negligible s ==> lebesgue_measurable s`,
7931   SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);;
7932
7933 let LEBESGUE_MEASURABLE_EMPTY = prove
7934  (`lebesgue_measurable {}`,
7935   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_EMPTY]);;
7936
7937 let LEBESGUE_MEASURABLE_UNIV = prove
7938  (`lebesgue_measurable (:real^N)`,
7939   REWRITE_TAC[lebesgue_measurable; indicator; IN_UNIV; MEASURABLE_ON_CONST]);;
7940
7941 let LEBESGUE_MEASURABLE_COMPACT = prove
7942  (`!s:real^N->bool. compact s ==> lebesgue_measurable s`,
7943   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_COMPACT]);;
7944
7945 let LEBESGUE_MEASURABLE_INTERVAL = prove
7946  (`(!a b:real^N. lebesgue_measurable(interval[a,b])) /\
7947    (!a b:real^N. lebesgue_measurable(interval(a,b)))`,
7948   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_INTERVAL]);;
7949
7950 let LEBESGUE_MEASURABLE_INTER = prove
7951  (`!s t:real^N->bool.
7952         lebesgue_measurable s /\ lebesgue_measurable t
7953         ==> lebesgue_measurable(s INTER t)`,
7954   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
7955   REWRITE_TAC[MEASURABLE_ON_INTER]);;
7956
7957 let LEBESGUE_MEASURABLE_UNION = prove
7958  (`!s t:real^N->bool.
7959         lebesgue_measurable s /\ lebesgue_measurable t
7960         ==> lebesgue_measurable(s UNION t)`,
7961   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
7962   REWRITE_TAC[MEASURABLE_ON_UNION]);;
7963
7964 let LEBESGUE_MEASURABLE_DIFF = prove
7965  (`!s t:real^N->bool.
7966         lebesgue_measurable s /\ lebesgue_measurable t
7967         ==> lebesgue_measurable(s DIFF t)`,
7968   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
7969   REWRITE_TAC[MEASURABLE_ON_DIFF]);;
7970
7971 let LEBESGUE_MEASURABLE_COMPL = prove
7972  (`!s. lebesgue_measurable((:real^N) DIFF s) <=> lebesgue_measurable s`,
7973   MESON_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_UNIV;
7974             SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]);;
7975
7976 let LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove
7977  (`!s. lebesgue_measurable s <=>
7978        !a b:real^N. lebesgue_measurable(s INTER interval[a,b])`,
7979   GEN_TAC THEN EQ_TAC THEN
7980   SIMP_TAC[LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_INTER] THEN
7981   REWRITE_TAC[lebesgue_measurable] THEN DISCH_TAC THEN
7982   MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
7983   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
7984   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
7985   EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN
7986   REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL
7987    [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7988     FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
7989     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7990     REWRITE_TAC[FUN_EQ_THM; indicator; IN_INTER] THEN MESON_TAC[];
7991     REPEAT STRIP_TAC THEN REWRITE_TAC[indicator] THEN
7992     COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop] THEN
7993     REAL_ARITH_TAC]);;
7994
7995 let LEBESGUE_MEASURABLE_CLOSED = prove
7996  (`!s:real^N->bool. closed s ==> lebesgue_measurable s`,
7997   REPEAT STRIP_TAC THEN
7998   ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
7999   ASM_SIMP_TAC[CLOSED_INTER_COMPACT; LEBESGUE_MEASURABLE_COMPACT;
8000                COMPACT_INTERVAL]);;
8001
8002 let LEBESGUE_MEASURABLE_OPEN = prove
8003  (`!s:real^N->bool. open s ==> lebesgue_measurable s`,
8004   REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN
8005   ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN
8006   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED]);;
8007
8008 let LEBESGUE_MEASURABLE_UNIONS = prove
8009  (`!f. FINITE f /\ (!s. s IN f ==> lebesgue_measurable s)
8010        ==> lebesgue_measurable (UNIONS f)`,
8011   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8012   REWRITE_TAC[MEASURABLE_ON_UNIONS]);;
8013
8014 let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove
8015  (`!f:(real^N->bool)->bool.
8016         COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s)
8017         ==> lebesgue_measurable (UNIONS f)`,
8018   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8019   REWRITE_TAC[MEASURABLE_ON_COUNTABLE_UNIONS]);;
8020
8021 let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove
8022  (`!s:num->real^N->bool.
8023         (!n. lebesgue_measurable(s n))
8024         ==> lebesgue_measurable(UNIONS {s n | n IN (:num)})`,
8025   REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8026   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8027   ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV; NUM_COUNTABLE]);;
8028
8029 let LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove
8030  (`!f:(real^N->bool)->bool.
8031         COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s)
8032         ==> lebesgue_measurable (INTERS f)`,
8033   REPEAT STRIP_TAC THEN
8034   REWRITE_TAC[INTERS_UNIONS; LEBESGUE_MEASURABLE_COMPL] THEN
8035   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8036   ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE;
8037                LEBESGUE_MEASURABLE_COMPL]);;
8038
8039 let LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove
8040  (`!s:num->real^N->bool.
8041         (!n. lebesgue_measurable(s n))
8042         ==> lebesgue_measurable(INTERS {s n | n IN (:num)})`,
8043   REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
8044   ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE;
8045                NUM_COUNTABLE]);;
8046
8047 let LEBESGUE_MEASURABLE_INTERS = prove
8048  (`!f:(real^N->bool)->bool.
8049         FINITE f /\ (!s. s IN f ==> lebesgue_measurable s)
8050         ==> lebesgue_measurable (INTERS f)`,
8051   SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);;
8052
8053 let LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove
8054  (`!s:real^N->bool. bounded s ==> (lebesgue_measurable s <=> measurable s)`,
8055   REPEAT STRIP_TAC THEN EQ_TAC THEN
8056   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
8057   REWRITE_TAC[lebesgue_measurable; indicator; MEASURABLE_INTEGRABLE] THEN
8058   SUBGOAL_THEN `?a b:real^N. s = s INTER interval[a,b]`
8059    (REPEAT_TCL CHOOSE_THEN SUBST1_TAC)
8060   THENL [REWRITE_TAC[SET_RULE `s = s INTER t <=> s SUBSET t`] THEN
8061          ASM_MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL]; ALL_TAC] THEN
8062   REWRITE_TAC[IN_INTER; MESON[]
8063    `(if P x /\ Q x then a else b) =
8064     (if Q x then if P x then a else b else b)`] THEN
8065   REWRITE_TAC[MEASURABLE_ON_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN
8066   STRIP_TAC THEN MATCH_MP_TAC
8067     MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
8068   EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN
8069   ASM_REWRITE_TAC[INTEGRABLE_CONST; NORM_REAL; DROP_VEC; GSYM drop] THEN
8070   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN SIMP_TAC[DROP_VEC] THEN
8071   REAL_ARITH_TAC);;
8072
8073 let MEASURABLE_ON_MEASURABLE_SUBSET = prove
8074  (`!f s t. s SUBSET t /\ f measurable_on t /\ measurable s
8075            ==> f measurable_on s`,
8076   MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET;
8077             MEASURABLE_IMP_LEBESGUE_MEASURABLE]);;
8078
8079 let MEASURABLE_ON_CASES = prove
8080  (`!P f g:real^M->real^N s.
8081         lebesgue_measurable {x | P x} /\
8082         f measurable_on s /\ g measurable_on s
8083         ==> (\x. if P x then f x else g x) measurable_on s`,
8084   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
8085   REPEAT STRIP_TAC THEN
8086   SUBGOAL_THEN
8087    `!x. (if x IN s then if P x then (f:real^M->real^N) x else g x else vec 0) =
8088         (if x IN {x | P x} then if x IN s then f x else vec 0 else vec 0) +
8089         (if x IN (:real^M) DIFF {x | P x}
8090          then if x IN s then g x else vec 0 else vec 0)`
8091    (fun th -> REWRITE_TAC[th])
8092   THENL
8093    [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN
8094     MESON_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID];
8095     MATCH_MP_TAC MEASURABLE_ON_ADD THEN
8096     CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN
8097     ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]]);;
8098
8099 let LEBESGUE_MEASURABLE_JORDAN = prove
8100  (`!s:real^N->bool. negligible(frontier s) ==> lebesgue_measurable s`,
8101   REPEAT STRIP_TAC THEN
8102   ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
8103   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
8104   MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN
8105   MATCH_MP_TAC MEASURABLE_JORDAN THEN
8106   SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL] THEN
8107   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
8108   EXISTS_TAC `frontier s UNION frontier(interval[a:real^N,b])` THEN
8109   ASM_REWRITE_TAC[FRONTIER_INTER_SUBSET; NEGLIGIBLE_UNION_EQ] THEN
8110   SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_INTERVAL]);;
8111
8112 let LEBESGUE_MEASURABLE_CONVEX = prove
8113  (`!s:real^N->bool. convex s ==> lebesgue_measurable s`,
8114   SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN; NEGLIGIBLE_CONVEX_FRONTIER]);;
8115
8116 (* ------------------------------------------------------------------------- *)
8117 (* Invariance theorems for Lebesgue measurability.                           *)
8118 (* ------------------------------------------------------------------------- *)
8119
8120 let MEASURABLE_ON_TRANSLATION = prove
8121  (`!f:real^M->real^N s a.
8122           f measurable_on (IMAGE (\x. a + x) s)
8123           ==> (\x. f(a + x)) measurable_on s`,
8124   REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM] THEN
8125   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^N`] THEN
8126   STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^M. --a + x) k` THEN
8127   EXISTS_TAC `\n. (g:num->real^M->real^N) n o (\x. a + x)` THEN
8128   ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN CONJ_TAC THENL
8129    [GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
8130     SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
8131     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
8132     X_GEN_TAC `x:real^M` THEN
8133     FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN
8134     REWRITE_TAC[o_DEF; IN_IMAGE] THEN
8135     ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> a + x = y`] THEN
8136     REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]);;
8137
8138 let MEASURABLE_ON_TRANSLATION_EQ = prove
8139  (`!f:real^M->real^N s a.
8140         (\x. f(a + x)) measurable_on s <=>
8141         f measurable_on (IMAGE (\x. a + x) s)`,
8142   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_ON_TRANSLATION] THEN
8143   MP_TAC(ISPECL [`\x. (f:real^M->real^N) (a + x)`;
8144                  `IMAGE (\x:real^M. a + x) s`; `--a:real^M`]
8145     MEASURABLE_ON_TRANSLATION) THEN
8146   REWRITE_TAC[GSYM IMAGE_o; o_DEF; ETA_AX; IMAGE_ID; VECTOR_ARITH
8147    `--a + a + x:real^N = x /\ a + --a + x = x`]);;
8148
8149 let MEASURABLE_ON_LINEAR_IMAGE_EQ = prove
8150  (`!f:real^N->real^N h:real^N->real^P s.
8151         linear f /\ (!x y. f x = f y ==> x = y)
8152         ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`,
8153   let lemma = prove
8154    (`!f:real^N->real^P g:real^N->real^N h s.
8155         linear g /\ linear h /\ (!x. h(g x) = x) /\ (!x. g(h x) = x)
8156         ==> (f o g) measurable_on s ==> f measurable_on (IMAGE g s)`,
8157     REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN
8158     STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool`
8159      (X_CHOOSE_THEN `G:num->real^N->real^P` STRIP_ASSUME_TAC)) THEN
8160     EXISTS_TAC `IMAGE (g:real^N->real^N) k` THEN
8161     EXISTS_TAC `\n x. (G:num->real^N->real^P) n ((h:real^N->real^N) x)` THEN
8162     ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_IMAGE] THEN CONJ_TAC THENL
8163      [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
8164       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
8165       ASM_MESON_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
8166       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
8167       FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^N->real^N) y`) THEN
8168       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8169       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8170       ASM_REWRITE_TAC[o_THM] THEN
8171       AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]) in
8172   REPEAT GEN_TAC THEN DISCH_TAC THEN
8173   FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN
8174   POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
8175   DISCH_TAC THEN
8176   FIRST_ASSUM(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC o
8177         MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN
8178   EQ_TAC THENL [ASM_MESON_TAC[lemma]; DISCH_TAC] THEN
8179   MP_TAC(ISPECL [`(h:real^N->real^P) o (f:real^N->real^N)`;
8180                  `g:real^N->real^N`; `f:real^N->real^N`;
8181                  `IMAGE (f:real^N->real^N) s`] lemma) THEN
8182   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; ETA_AX]);;
8183
8184 let LEBESGUE_MEASURABLE_TRANSLATION = prove
8185  (`!a:real^N s.
8186      lebesgue_measurable (IMAGE (\x. a + x) s) <=>
8187      lebesgue_measurable s`,
8188   ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
8189   SIMP_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE;
8190            BOUNDED_INTER; BOUNDED_INTERVAL] THEN
8191   GEOM_TRANSLATE_TAC[]);;
8192
8193 add_translation_invariants [LEBESGUE_MEASURABLE_TRANSLATION];;
8194
8195 let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ = prove
8196  (`!f:real^N->real^N s.
8197         linear f /\ (!x y. f x = f y ==> x = y)
8198          ==> (lebesgue_measurable (IMAGE f s) <=>
8199               lebesgue_measurable s)`,
8200   REPEAT GEN_TAC THEN DISCH_TAC THEN
8201   FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN
8202   POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
8203   DISCH_TAC THEN
8204   FIRST_ASSUM(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC o
8205         MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN
8206   REWRITE_TAC[lebesgue_measurable] THEN MP_TAC(ISPECL
8207    [`g:real^N->real^N`; `indicator(s:real^N->bool)`; `(:real^N)`]
8208    MEASURABLE_ON_LINEAR_IMAGE_EQ) THEN
8209   ASM_REWRITE_TAC[indicator; o_DEF] THEN
8210   ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC EQ_IMP] THEN
8211   BINOP_TAC THENL
8212    [AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
8213     AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[];
8214     AP_TERM_TAC THEN ASM SET_TAC[]]);;
8215
8216 add_linear_invariants [LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ];;
8217
8218 (* ------------------------------------------------------------------------- *)
8219 (* Various common equivalent forms of function measurability.                *)
8220 (* ------------------------------------------------------------------------- *)
8221
8222 let (MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT,
8223      MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT) = (CONJ_PAIR o prove)
8224  (`(!f:real^M->real^N.
8225         f measurable_on (:real^M) <=>
8226         !a k. 1 <= k /\ k <= dimindex(:N)
8227               ==> lebesgue_measurable {x | f(x)$k < a}) /\
8228    (!f:real^M->real^N.
8229         f measurable_on (:real^M) <=>
8230         ?g. (!n. (g n) measurable_on (:real^M)) /\
8231             (!n. FINITE(IMAGE (g n) (:real^M))) /\
8232             (!x. ((\n. g n x) --> f x) sequentially))`,
8233   let lemma0 = prove
8234    (`!f:real^M->real^1 n m.
8235           integer m /\
8236           m / &2 pow n <= drop(f x) /\
8237           drop(f x) < (m + &1) / &2 pow n /\
8238           abs(m) <= &2 pow (2 * n)
8239           ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
8240                    (\k. k / &2 pow n %
8241                         indicator {y:real^M | k / &2 pow n <= drop(f y) /\
8242                                               drop(f y) < (k + &1) / &2 pow n}
8243                                   x) =
8244               lift(m / &2 pow n)`,
8245     REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
8246     EXISTS_TAC
8247      `vsum {m} (\k. k / &2 pow n %
8248                     indicator {y:real^M | k / &2 pow n <= drop(f y) /\
8249                                           drop(f y) < (k + &1) / &2 pow n}
8250                               x)` THEN
8251     CONJ_TAC THENL
8252      [MATCH_MP_TAC VSUM_SUPERSET THEN
8253       ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN
8254       X_GEN_TAC `k:real` THEN STRIP_TAC THEN
8255       REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
8256       ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN
8257       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
8258       MATCH_MP_TAC(TAUT `F ==> p`) THEN
8259       UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN
8260       POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
8261       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
8262       REAL_ARITH_TAC;
8263       ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in
8264   let lemma1 = prove
8265    (`!f:real^M->real^1.
8266           (!a b. lebesgue_measurable {x | a <= drop(f x) /\ drop(f x) < b})
8267           ==> ?g. (!n. (g n) measurable_on (:real^M)) /\
8268                   (!n. FINITE(IMAGE (g n) (:real^M))) /\
8269                   (!x. ((\n. g n x) --> f x) sequentially)`,
8270     REPEAT STRIP_TAC THEN
8271     EXISTS_TAC
8272      `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
8273                  (\k. k / &2 pow n %
8274                       indicator {y:real^M | k / &2 pow n <= drop(f y) /\
8275                                             drop(f y) < (k + &1) / &2 pow n}
8276                                 x)` THEN
8277     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8278      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN
8279       REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN
8280       GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN
8281       ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX];
8282       X_GEN_TAC `n:num` THEN
8283       MATCH_MP_TAC FINITE_SUBSET THEN
8284       EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n))
8285                         {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN
8286       CONJ_TAC THENL
8287        [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE];
8288         ALL_TAC] THEN
8289       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN
8290       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_IMAGE] THEN
8291       ASM_CASES_TAC
8292        `?k. integer k /\ abs k <= &2 pow (2 * n) /\
8293             k / &2 pow n <= drop(f(x:real^M)) /\
8294             drop(f x) < (k + &1) / &2 pow n`
8295       THENL
8296        [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN
8297         X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
8298         MATCH_MP_TAC lemma0 THEN ASM_REWRITE_TAC[];
8299         EXISTS_TAC `&0` THEN
8300         ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN
8301         SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN
8302         REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN
8303         MATCH_MP_TAC VSUM_EQ_0 THEN
8304         X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
8305         REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
8306         REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]];
8307       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
8308       MP_TAC(ISPECL [`&2`; `abs(drop((f:real^M->real^1) x))`]
8309           REAL_ARCH_POW) THEN
8310       ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN
8311       X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8312       MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
8313       REWRITE_TAC[REAL_POW_INV] THEN
8314       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8315       DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN
8316       SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN
8317       SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN
8318       EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
8319       ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^M)))` THEN
8320       SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^M->real^1) x) < e`
8321       MP_TAC THENL
8322        [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN
8323         MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN
8324         REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN
8325         SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ;
8326                  REAL_OF_NUM_EQ; ARITH] THEN
8327         MATCH_MP_TAC(REAL_ARITH
8328          `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN
8329         EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
8330         ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
8331         EXISTS_TAC `e * &2 pow N2` THEN
8332         ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN
8333         MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
8334         MATCH_MP_TAC(NORM_ARITH
8335          `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN
8336         MATCH_MP_TAC lemma0 THEN
8337         SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
8338         ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
8339         EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
8340         SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE;
8341                  INTEGER_CLOSED] THEN
8342         MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN
8343         REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW;
8344                     REAL_ABS_NUM] THEN
8345         MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
8346         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
8347          `x < e ==> e <= d ==> x <= d`))] THEN
8348       MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
8349       ASM_ARITH_TAC]) in
8350   MATCH_MP_TAC(MESON[]
8351    `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f)
8352     ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN
8353   REPEAT CONJ_TAC THENL
8354    [X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN
8355     ABBREV_TAC `f:real^M->real^N = \x. --(g x)` THEN
8356     SUBGOAL_THEN `(f:real^M->real^N) measurable_on (:real^M)` ASSUME_TAC THENL
8357      [EXPAND_TAC "f" THEN MATCH_MP_TAC MEASURABLE_ON_NEG THEN ASM_SIMP_TAC[];
8358       ALL_TAC] THEN
8359     ONCE_REWRITE_TAC[GSYM REAL_LT_NEG2] THEN X_GEN_TAC `a:real` THEN
8360     SPEC_TAC(`--a:real`,`a:real`) THEN
8361     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
8362     SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN DISCH_THEN(K ALL_TAC) THEN
8363     REPEAT STRIP_TAC THEN
8364     FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o
8365       GEN_REWRITE_RULE I [MEASURABLE_ON_COMPONENTWISE]) THEN
8366     ASM_REWRITE_TAC[] THEN  REPEAT STRIP_TAC THEN
8367     MP_TAC(GEN `d:real` (ISPECL
8368      [`\x. lift ((f:real^M->real^N) x$k)`;
8369        `(\x. lift a + (lambda i. d)):real^M->real^1`;
8370       `(:real^M)`] MEASURABLE_ON_MIN)) THEN
8371     ASM_REWRITE_TAC[MEASURABLE_ON_CONST] THEN
8372     DISCH_THEN(fun th ->
8373       MP_TAC(GEN `n:num` (ISPEC `&n + &1` (MATCH_MP MEASURABLE_ON_CMUL
8374         (MATCH_MP MEASURABLE_ON_SUB
8375        (CONJ (SPEC `inv(&n + &1)` th) (SPEC `&0` th))))))) THEN
8376     REWRITE_TAC[lebesgue_measurable; indicator] THEN
8377     DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
8378           MEASURABLE_ON_LIMIT)) THEN
8379     EXISTS_TAC `{}:real^M->bool` THEN
8380     REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; IN_UNIV; NOT_IN_EMPTY] THEN
8381     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN
8382     SIMP_TAC[LIM_SEQUENTIALLY; DIST_REAL; VECTOR_MUL_COMPONENT;
8383              VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
8384              LAMBDA_BETA; DIMINDEX_1; ARITH] THEN
8385     REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_ADD_RID] THEN
8386     SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; REAL_ARITH
8387      `&0 < d ==> (min x (a + d) - min x a =
8388                   if x <= a then &0 else if x <= a + d then x - a else d)`] THEN
8389     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8390     ASM_CASES_TAC `a < (f:real^M->real^N) x $k` THEN ASM_REWRITE_TAC[] THEN
8391     ASM_REWRITE_TAC[REAL_ARITH `(x:real^N)$k <= a <=> ~(a < x$k)`] THEN
8392     ASM_REWRITE_TAC[REAL_MUL_RZERO; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN
8393     MP_TAC(SPEC `((f:real^M->real^N) x)$k - a` REAL_ARCH_INV) THEN
8394     ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN
8395     X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
8396     SUBGOAL_THEN `a + inv(&n + &1) < ((f:real^M->real^N) x)$k` ASSUME_TAC THENL
8397      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
8398        `N < f - a ==> n <= N ==> a + n < f`)) THEN
8399       MATCH_MP_TAC REAL_LE_INV2 THEN
8400       REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
8401       ASM_ARITH_TAC;
8402       ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `~(&n + &1 = &0)`] THEN
8403       ASM_REAL_ARITH_TAC];
8404     REPEAT STRIP_TAC THEN
8405     SUBGOAL_THEN
8406      `!k. 1 <= k /\ k <= dimindex(:N)
8407           ==> ?g. (!n. (g n) measurable_on (:real^M)) /\
8408                   (!n. FINITE(IMAGE (g n) (:real^M))) /\
8409                   (!x. ((\n. g n x) --> lift((f x:real^N)$k)) sequentially)`
8410     MP_TAC THENL
8411      [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN
8412       ASM_SIMP_TAC[LIFT_DROP] THEN
8413       MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN
8414       REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN
8415       MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN
8416       ASM_SIMP_TAC[REAL_NOT_LE];
8417       GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM]] THEN
8418     REWRITE_TAC[SKOLEM_THM] THEN
8419     DISCH_THEN(X_CHOOSE_THEN `g:num->num->real^M->real^1` MP_TAC) THEN
8420     REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
8421     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
8422     EXISTS_TAC
8423       `\n x. (lambda k. drop((g:num->num->real^M->real^1) k n x)):real^N` THEN
8424     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8425      [X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN
8426       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
8427       ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX];
8428       X_GEN_TAC `n:num` THEN MATCH_MP_TAC FINITE_SUBSET THEN
8429       EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
8430                         ==> lift(x$i) IN IMAGE (g i (n:num)) (:real^M)}` THEN
8431       ASM_SIMP_TAC[GSYM IN_IMAGE_LIFT_DROP; SET_RULE `{x | x IN s} = s`;
8432                    FINITE_IMAGE; FINITE_CART] THEN
8433       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
8434       SIMP_TAC[IN_IMAGE; IN_UNIV; LAMBDA_BETA; DROP_EQ] THEN MESON_TAC[];
8435       X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
8436       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
8437       ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]];
8438     X_GEN_TAC `f:real^M->real^N` THEN
8439     DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
8440     MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
8441     MAP_EVERY EXISTS_TAC [`g:num->real^M->real^N`; `{}:real^M->bool`] THEN
8442     ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY]]);;
8443
8444 let MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GE = prove
8445  (`!f:real^M->real^N.
8446         f measurable_on (:real^M) <=>
8447         !a k. 1 <= k /\ k <= dimindex(:N)
8448               ==> lebesgue_measurable {x | f(x)$k >= a}`,
8449   GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x >= a <=> ~(x < a)`] THEN
8450   REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
8451   REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN
8452   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT]);;
8453
8454 let MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT = prove
8455  (`!f:real^M->real^N.
8456         f measurable_on (:real^M) <=>
8457         !a k. 1 <= k /\ k <= dimindex(:N)
8458               ==> lebesgue_measurable {x | f(x)$k > a}`,
8459   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
8460   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT] THEN
8461   GEN_REWRITE_TAC LAND_CONV
8462    [MESON[REAL_NEG_NEG] `(!x. P x) <=> (!x:real. P(--x))`] THEN
8463   REWRITE_TAC[real_gt; VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);;
8464
8465 let MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE = prove
8466  (`!f:real^M->real^N.
8467         f measurable_on (:real^M) <=>
8468         !a k. 1 <= k /\ k <= dimindex(:N)
8469               ==> lebesgue_measurable {x | f(x)$k <= a}`,
8470   GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x <= a <=> ~(x > a)`] THEN
8471   REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
8472   REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN
8473   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT]);;
8474
8475 let (MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL,
8476     MEASURABLE_ON_PREIMAGE_OPEN) = (CONJ_PAIR o prove)
8477  (`(!f:real^M->real^N.
8478         f measurable_on (:real^M) <=>
8479         !a b. lebesgue_measurable {x | f(x) IN interval(a,b)}) /\
8480    (!f:real^M->real^N.
8481         f measurable_on (:real^M) <=>
8482         !t. open t ==> lebesgue_measurable {x | f(x) IN t})`,
8483   let ulemma = prove
8484    (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`,
8485     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
8486   MATCH_MP_TAC(MESON[]
8487    `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f)
8488     ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN
8489   REPEAT CONJ_TAC THENL
8490    [REPEAT STRIP_TAC THEN SUBGOAL_THEN
8491     `{x | (f:real^M->real^N) x IN interval(a,b)} =
8492         INTERS {{x | a$k < f(x)$k} | k IN 1..dimindex(:N)} INTER
8493         INTERS {{x | (--b)$k < --(f(x))$k} | k IN 1..dimindex(:N)}`
8494     SUBST1_TAC THENL
8495      [REWRITE_TAC[IN_INTERVAL; GSYM IN_NUMSEG] THEN
8496       REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_LT_NEG2] THEN
8497       REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[];
8498       MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN
8499       CONJ_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN
8500       SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
8501       REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THENL
8502        [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
8503          [MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT]);
8504         FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
8505         REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT]] THEN
8506       ASM_SIMP_TAC[real_gt]];
8507     REPEAT STRIP_TAC THEN
8508     FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_OPEN_INTERVALS) THEN
8509     DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
8510     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN
8511     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8512     ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
8513     X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN
8514     FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN
8515     ASM_REWRITE_TAC[] THEN
8516     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8517     ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM];
8518     REPEAT STRIP_TAC THEN
8519     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT] THEN
8520     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
8521       `{x:real^M | (f x)$k < a} = {x | f x IN {y:real^N | y$k < a}}`] THEN
8522     FIRST_X_ASSUM MATCH_MP_TAC THEN
8523     REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]]);;
8524
8525 let MEASURABLE_ON_PREIMAGE_CLOSED = prove
8526  (`!f:real^M->real^N.
8527         f measurable_on (:real^M) <=>
8528         !t. closed t ==> lebesgue_measurable {x | f(x) IN t}`,
8529   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL; closed] THEN
8530   REWRITE_TAC[SET_RULE
8531    `UNIV DIFF {x | f x IN t} = {x | f x IN (UNIV DIFF t)}`] THEN
8532   REWRITE_TAC[MESON[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]
8533    `(!s. P(UNIV DIFF s)) <=> (!s. P s)`] THEN
8534   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);;
8535
8536 let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove
8537  (`!f:real^M->real^N.
8538          f measurable_on (:real^M) <=>
8539          !a b. lebesgue_measurable {x | f(x) IN interval[a,b]}`,
8540   let ulemma = prove
8541    (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`,
8542     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
8543   GEN_TAC THEN EQ_TAC THENL
8544    [SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED; CLOSED_INTERVAL]; DISCH_TAC] THEN
8545   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN REPEAT STRIP_TAC THEN
8546   FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN
8547   DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
8548   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN
8549   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8550   ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
8551   X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN
8552   FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
8553   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8554   ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM]);;
8555
8556 let LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove
8557  (`!f:real^M->real^N t.
8558         f measurable_on (:real^M) /\ open t
8559         ==> lebesgue_measurable {x | f(x) IN t}`,
8560   SIMP_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);;
8561
8562 let LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove
8563  (`!f:real^M->real^N t.
8564         f measurable_on (:real^M) /\ closed t
8565         ==> lebesgue_measurable {x | f(x) IN t}`,
8566   SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED]);;
8567
8568 (* ------------------------------------------------------------------------- *)
8569 (* More connections with measure where Lebesgue measurability is useful.     *)
8570 (* ------------------------------------------------------------------------- *)
8571
8572 let MEASURABLE_LEGESGUE_MEASURABLE_SUBSET = prove
8573  (`!s t:real^N->bool.
8574         lebesgue_measurable s /\ measurable t /\ s SUBSET t
8575         ==> measurable s`,
8576   REWRITE_TAC[lebesgue_measurable; MEASURABLE_INTEGRABLE] THEN
8577   REWRITE_TAC[indicator] THEN REPEAT STRIP_TAC THEN
8578   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
8579   EXISTS_TAC `(\x. if x IN t then vec 1 else vec 0):real^N->real^1` THEN
8580   ASM_REWRITE_TAC[IN_UNIV] THEN GEN_TAC THEN
8581   REPEAT(COND_CASES_TAC THEN
8582          ASM_REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop]) THEN
8583   REWRITE_TAC[REAL_ABS_NUM; REAL_LE_REFL; REAL_POS] THEN ASM SET_TAC[]);;
8584
8585 let MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE = prove
8586  (`!s t:real^N->bool.
8587         lebesgue_measurable s /\ measurable t ==> measurable(s INTER t)`,
8588   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN
8589   EXISTS_TAC `t:real^N->bool` THEN
8590   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_INTER; MEASURABLE_IMP_LEBESGUE_MEASURABLE;
8591                INTER_SUBSET]);;
8592
8593 let MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE = prove
8594  (`!s t:real^N->bool.
8595         measurable s /\ lebesgue_measurable t ==> measurable(s INTER t)`,
8596   MESON_TAC[INTER_COMM; MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE]);;
8597
8598 let MEASURABLE_INTER_HALFSPACE_LE = prove
8599  (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i <= a})`,
8600   REPEAT GEN_TAC THEN
8601   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
8602   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
8603   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
8604   MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE THEN
8605   ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_LE; LEBESGUE_MEASURABLE_CLOSED]);;
8606
8607 let MEASURABLE_INTER_HALFSPACE_GE = prove
8608  (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i >= a})`,
8609   REPEAT GEN_TAC THEN
8610   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
8611   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
8612   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
8613   MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE THEN
8614   ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_GE; LEBESGUE_MEASURABLE_CLOSED]);;
8615
8616 let MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE = prove
8617  (`!s t. measurable s /\ lebesgue_measurable t ==> measurable(s DIFF t)`,
8618   REPEAT STRIP_TAC THEN
8619   ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
8620   ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE;
8621                 LEBESGUE_MEASURABLE_COMPL]);;
8622
8623 (* ------------------------------------------------------------------------- *)
8624 (* Localized variants of function measurability equivalents.                 *)
8625 (* ------------------------------------------------------------------------- *)
8626
8627 let [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED;
8628      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL;
8629      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN;
8630      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GE;
8631      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT;
8632      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE;
8633      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT;
8634      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL] =
8635   (CONJUNCTS o prove)
8636  (`(!f:real^M->real^N s.
8637       lebesgue_measurable s
8638       ==> (f measurable_on s <=>
8639            !t. closed t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\
8640    (!f:real^M->real^N s.
8641       lebesgue_measurable s
8642       ==> (f measurable_on s <=>
8643            !a b. lebesgue_measurable {x | x IN s /\ f x IN interval[a,b]})) /\
8644    (!f:real^M->real^N s.
8645       lebesgue_measurable s
8646       ==> (f measurable_on s <=>
8647            !t. open t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\
8648    (!f:real^M->real^N s.
8649       lebesgue_measurable s
8650       ==> (f measurable_on s <=>
8651            !a k. 1 <= k /\ k <= dimindex(:N)
8652                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k >= a})) /\
8653    (!f:real^M->real^N s.
8654       lebesgue_measurable s
8655       ==> (f measurable_on s <=>
8656            !a k. 1 <= k /\ k <= dimindex(:N)
8657                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k > a})) /\
8658    (!f:real^M->real^N s.
8659       lebesgue_measurable s
8660       ==> (f measurable_on s <=>
8661            !a k. 1 <= k /\ k <= dimindex(:N)
8662                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k <= a})) /\
8663    (!f:real^M->real^N s.
8664       lebesgue_measurable s
8665       ==> (f measurable_on s <=>
8666            !a k. 1 <= k /\ k <= dimindex(:N)
8667                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k < a})) /\
8668    (!f:real^M->real^N s.
8669       lebesgue_measurable s
8670       ==> (f measurable_on s <=>
8671            !a b. lebesgue_measurable {x | x IN s /\ f x IN interval(a,b)}))`,
8672   let lemma = prove
8673    (`!f s P. {x | P(if x IN s then f x else vec 0)} =
8674              if P(vec 0) then s INTER {x | P(f x)} UNION ((:real^M) DIFF s)
8675              else {x | x IN s /\ P(f x)}`,
8676     REPEAT GEN_TAC THEN
8677     COND_CASES_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in
8678   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN  REPEAT STRIP_TAC THENL
8679    [REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED];
8680     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL];
8681     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN];
8682     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GE];
8683     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT];
8684     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE];
8685     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT];
8686     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL]] THEN
8687   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] lemma) THEN
8688   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
8689   REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
8690   TRY(MATCH_MP_TAC(TAUT `(q <=> q') ==> (p ==> q <=> p ==> q')`)) THEN
8691   COND_CASES_TAC THEN REWRITE_TAC[] THEN
8692   REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
8693   EQ_TAC THEN
8694   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_UNION; LEBESGUE_MEASURABLE_COMPL] THEN
8695   UNDISCH_TAC `lebesgue_measurable(s:real^M->bool)` THEN
8696   REWRITE_TAC[IMP_IMP] THEN
8697   DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN
8698   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;
8699
8700 let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove
8701  (`!f:real^M->real^N s t.
8702         f measurable_on s /\ lebesgue_measurable s /\ open t
8703         ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
8704   MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);;
8705
8706 let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove
8707  (`!f:real^M->real^N s t.
8708         f measurable_on s /\ lebesgue_measurable s /\ closed t
8709         ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
8710   MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);;
8711
8712 let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ = prove
8713  (`!f:real^M->real^N s.
8714         f measurable_on s /\ lebesgue_measurable s <=>
8715         !t. open t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
8716   REPEAT GEN_TAC THEN EQ_TAC THEN
8717   SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN
8718   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
8719   REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
8720   SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);;
8721
8722 let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ = prove
8723  (`!f:real^M->real^N s.
8724         f measurable_on s /\ lebesgue_measurable s <=>
8725         !t. closed t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
8726   REPEAT GEN_TAC THEN EQ_TAC THEN
8727   SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED] THEN
8728   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
8729   REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
8730   SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);;
8731
8732 let [MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED;
8733      MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL;
8734      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN;
8735      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GE;
8736      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT;
8737      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE;
8738      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT;
8739      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL] =
8740   (CONJUNCTS o prove)
8741  (`(!f:real^M->real^N s.
8742       measurable s
8743       ==> (f measurable_on s <=>
8744            !t. closed t ==> measurable {x | x IN s /\ f x IN t})) /\
8745    (!f:real^M->real^N s.
8746       measurable s
8747       ==> (f measurable_on s <=>
8748            !a b. measurable {x | x IN s /\ f x IN interval[a,b]})) /\
8749    (!f:real^M->real^N s.
8750       measurable s
8751       ==> (f measurable_on s <=>
8752            !t. open t ==> measurable {x | x IN s /\ f x IN t})) /\
8753    (!f:real^M->real^N s.
8754       measurable s
8755       ==> (f measurable_on s <=>
8756            !a k. 1 <= k /\ k <= dimindex(:N)
8757                  ==> measurable {x | x IN s /\ (f x)$k >= a})) /\
8758    (!f:real^M->real^N s.
8759       measurable s
8760       ==> (f measurable_on s <=>
8761            !a k. 1 <= k /\ k <= dimindex(:N)
8762                  ==> measurable {x | x IN s /\ (f x)$k > a})) /\
8763    (!f:real^M->real^N s.
8764       measurable s
8765       ==> (f measurable_on s <=>
8766            !a k. 1 <= k /\ k <= dimindex(:N)
8767                  ==> measurable {x | x IN s /\ (f x)$k <= a})) /\
8768    (!f:real^M->real^N s.
8769       measurable s
8770       ==> (f measurable_on s <=>
8771            !a k. 1 <= k /\ k <= dimindex(:N)
8772                  ==> measurable {x | x IN s /\ (f x)$k < a})) /\
8773    (!f:real^M->real^N s.
8774       measurable s
8775       ==> (f measurable_on s <=>
8776            !a b. measurable {x | x IN s /\ f x IN interval(a,b)}))`,
8777   REPEAT STRIP_TAC THEN
8778   FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_IMP_LEBESGUE_MEASURABLE) THENL
8779    [ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED];
8780     ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL];
8781     ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN];
8782     ASM_SIMP_TAC
8783      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GE];
8784     ASM_SIMP_TAC
8785      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT];
8786     ASM_SIMP_TAC
8787      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE];
8788     ASM_SIMP_TAC
8789      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT];
8790     ASM_SIMP_TAC
8791      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL]] THEN
8792   EQ_TAC THEN SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
8793   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN
8794   EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[]);;
8795
8796 let MEASURABLE_MEASURABLE_PREIMAGE_OPEN = prove
8797  (`!f:real^M->real^N s t.
8798         f measurable_on s /\ measurable s /\ open t
8799         ==> measurable {x | x IN s /\ f(x) IN t}`,
8800   MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);;
8801
8802 let MEASURABLE_MEASURABLE_PREIMAGE_CLOSED = prove
8803  (`!f:real^M->real^N s t.
8804         f measurable_on s /\ measurable s /\ closed t
8805         ==> measurable {x | x IN s /\ f(x) IN t}`,
8806   MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);;
8807
8808 let MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ = prove
8809  (`!f:real^M->real^N s.
8810         f measurable_on s /\ measurable s <=>
8811         !t. open t ==> measurable {x | x IN s /\ f(x) IN t}`,
8812   REPEAT GEN_TAC THEN EQ_TAC THEN
8813   SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_OPEN] THEN
8814   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
8815   REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
8816   SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);;
8817
8818 let MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ = prove
8819  (`!f:real^M->real^N s.
8820         f measurable_on s /\ measurable s <=>
8821         !t. closed t ==> measurable {x | x IN s /\ f(x) IN t}`,
8822   REPEAT GEN_TAC THEN EQ_TAC THEN
8823   SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_CLOSED] THEN
8824   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
8825   REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
8826   SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);;
8827
8828 (* ------------------------------------------------------------------------- *)
8829 (* Regularity properties and Steinhaus, this time for Lebesgue measure.      *)
8830 (* ------------------------------------------------------------------------- *)
8831
8832 let LEBESGUE_MEASURABLE_OUTER_OPEN = prove
8833  (`!s:real^N->bool e.
8834         lebesgue_measurable s /\ &0 < e
8835         ==> ?t. open t /\
8836                 s SUBSET t /\
8837                 measurable(t DIFF s) /\
8838                 measure(t DIFF s) < e`,
8839   REPEAT STRIP_TAC THEN MP_TAC(GEN `n:num`
8840    (ISPECL [`s INTER ball(vec 0:real^N,&2 pow n)`;
8841             `e / &4 / &2 pow n`]
8842         MEASURABLE_OUTER_OPEN)) THEN
8843   ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; REAL_LT_DIV;
8844                MEASURABLE_BALL; REAL_LT_INV_EQ; REAL_LT_POW2;
8845                REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN
8846   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
8847   X_GEN_TAC `t:num->real^N->bool` THEN STRIP_TAC THEN
8848   EXISTS_TAC `UNIONS(IMAGE t (:num)):real^N->bool` THEN
8849   ASM_SIMP_TAC[OPEN_UNIONS; FORALL_IN_IMAGE] THEN CONJ_TAC THENL
8850    [REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
8851     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8852     MP_TAC(ISPEC `norm(x:real^N)` REAL_ARCH_POW2) THEN
8853     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
8854     DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
8855     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_BALL_0; IN_INTER];
8856     REWRITE_TAC[UNIONS_DIFF; SET_RULE
8857      `{f x | x IN IMAGE g s} = {f(g(x)) | x IN s}`] THEN
8858     MATCH_MP_TAC(MESON[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`]
8859         `&0 < e /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN
8860     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN
8861     ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE] THEN
8862     X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
8863     EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL
8864      [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
8865       MATCH_MP_TAC REAL_LE_TRANS THEN
8866       EXISTS_TAC `measure(t i DIFF (s INTER ball(vec 0:real^N,&2 pow i)))` THEN
8867       REWRITE_TAC[] THEN CONJ_TAC THENL
8868        [MATCH_MP_TAC MEASURE_SUBSET THEN
8869         ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE;
8870           MEASURABLE_INTER; MEASURABLE_BALL; LEBESGUE_MEASURABLE_INTER;
8871           MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
8872         SET_TAC[];
8873         ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_DIFF; MEASURABLE_BALL;
8874                      MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
8875         ASM_SIMP_TAC[REAL_ARITH `t < s + e ==> t - s <= e`]];
8876       REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP] THEN
8877       CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 LT] THEN
8878       ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN
8879       REWRITE_TAC[REAL_ARITH
8880         `&1 / &4 * (&1 - x) * &2 <= &1 / &2 <=> &0 <= x`] THEN
8881       MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]]);;
8882
8883 let LEBESGUE_MEASURABLE_INNER_CLOSED = prove
8884  (`!s:real^N->bool e.
8885         lebesgue_measurable s /\ &0 < e
8886         ==> ?t. closed t /\
8887                 t SUBSET s /\
8888                 measurable(s DIFF t) /\
8889                 measure(s DIFF t) < e`,
8890   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN
8891   DISCH_THEN(X_CHOOSE_TAC `t:real^N->bool` o MATCH_MP
8892     LEBESGUE_MEASURABLE_OUTER_OPEN) THEN
8893   EXISTS_TAC `(:real^N) DIFF t` THEN POP_ASSUM MP_TAC THEN
8894   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
8895   REWRITE_TAC[GSYM OPEN_CLOSED] THENL
8896    [SET_TAC[];
8897     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC;
8898     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC] THEN
8899   SET_TAC[]);;
8900
8901 let STEINHAUS_LEBESGUE = prove
8902  (`!s:real^N->bool.
8903         lebesgue_measurable s /\ ~negligible s
8904         ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`,
8905   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8906   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
8907   REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN
8908   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
8909   MP_TAC(ISPEC `s INTER interval[a:real^N,b]` STEINHAUS) THEN
8910   ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL;
8911                MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
8912   SET_TAC[]);;
8913
8914 let LEBESGUE_MEASURABLE_REGULAR_OUTER = prove
8915  (`!s:real^N->bool.
8916         lebesgue_measurable s
8917         ==> ?k c. negligible k /\ (!n. open(c n)) /\
8918                   s = INTERS {c n | n IN (:num)} DIFF k`,
8919   REPEAT STRIP_TAC THEN
8920   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8921     LEBESGUE_MEASURABLE_OUTER_OPEN)) THEN
8922   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
8923   REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN
8924   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
8925   X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN
8926   EXISTS_TAC `INTERS {c n | n IN (:num)} DIFF s:real^N->bool` THEN
8927   EXISTS_TAC `c:num->real^N->bool` THEN
8928   ASM_REWRITE_TAC[SET_RULE `s = t DIFF (t DIFF s) <=> s SUBSET t`] THEN
8929   ASM_REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN
8930   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8931   MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
8932   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN
8933   DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
8934   EXISTS_TAC `(c:num->real^N->bool) n DIFF s` THEN
8935   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
8936    [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]);;
8937
8938 let LEBESGUE_MEASURABLE_REGULAR_INNER = prove
8939  (`!s:real^N->bool.
8940         lebesgue_measurable s
8941         ==> ?k c. negligible k /\ (!n. compact(c n)) /\
8942                   s = UNIONS {c n | n IN (:num)} UNION k`,
8943   REPEAT STRIP_TAC THEN
8944   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8945     LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN
8946   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
8947   REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN
8948   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
8949   X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN
8950   EXISTS_TAC `s DIFF UNIONS {c n | n IN (:num)}:real^N->bool` THEN
8951   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
8952    [REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN
8953     DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
8954     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN
8955     DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
8956     EXISTS_TAC `s DIFF (c:num->real^N->bool) n` THEN
8957     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
8958      [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]];
8959     SUBGOAL_THEN
8960      `?d. (!n. compact(d n:real^N->bool)) /\
8961           UNIONS {d n | n IN (:num)} = UNIONS {c n | n IN (:num)}`
8962     MP_TAC THENL
8963      [MP_TAC(GEN `n:num` (ISPEC
8964        `(c:num->real^N->bool) n` CLOSED_UNION_COMPACT_SUBSETS)) THEN
8965       ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN
8966        (X_CHOOSE_THEN `d:num->num->real^N->bool` STRIP_ASSUME_TAC) THEN
8967       SUBGOAL_THEN
8968        `COUNTABLE {d n m:real^N->bool | n IN (:num) /\ m IN (:num)}`
8969       MP_TAC THENL
8970        [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
8971         REWRITE_TAC[NUM_COUNTABLE];
8972         DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8973           COUNTABLE_AS_IMAGE)) THEN
8974         ANTS_TAC THENL [SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
8975         ASM SET_TAC[]];
8976       MATCH_MP_TAC MONO_EXISTS THEN
8977       REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8978       ASM_REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN
8979       ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC]]]);;
8980
8981 (* ------------------------------------------------------------------------- *)
8982 (* Existence of nonmeasurable subsets of any set of positive measure.        *)
8983 (* ------------------------------------------------------------------------- *)
8984
8985 let NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS = prove
8986  (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> lebesgue_measurable t`,
8987   let lemma = prove
8988    (`!s:real^N->bool.
8989       lebesgue_measurable s /\
8990       (!x y q. x IN s /\ y IN s /\ rational q /\ y = q % basis 1 + x ==> y = x)
8991       ==> negligible s`,
8992     SIMP_TAC[VECTOR_ARITH `q + x:real^N = x <=> q = vec 0`; VECTOR_MUL_EQ_0;
8993              BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN
8994     REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN
8995     DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` STEINHAUS_LEBESGUE) THEN
8996     ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
8997     FIRST_ASSUM(X_CHOOSE_TAC `q:real` o MATCH_MP RATIONAL_BETWEEN) THEN
8998     FIRST_X_ASSUM
8999      (MP_TAC o SPEC `q % basis 1:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
9000     SIMP_TAC[IN_BALL_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1;
9001              ARITH; NOT_IMP] THEN
9002     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN
9003     ASM_REWRITE_TAC[REAL_MUL_RID; IN_ELIM_THM; NOT_EXISTS_THM;
9004                     VECTOR_ARITH `q:real^N = x - y <=> x = q + y`] THEN
9005     ASM_CASES_TAC `q = &0` THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]) in
9006   GEN_TAC THEN EQ_TAC THENL
9007    [MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE];
9008     DISCH_TAC] THEN
9009   ABBREV_TAC
9010    `(canonize:real^N->real^N) =
9011     \x. @y. y IN s /\ ?q. rational q /\ q % basis 1 + y = x` THEN
9012   SUBGOAL_THEN
9013    `!x:real^N. x IN s
9014                ==> canonize x IN s /\
9015                    ?q. rational q /\ q % basis 1 + canonize x = x`
9016   ASSUME_TAC THENL
9017    [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "canonize" THEN
9018     CONV_TAC SELECT_CONV THEN EXISTS_TAC `x:real^N` THEN
9019     ASM_REWRITE_TAC[] THEN EXISTS_TAC `&0` THEN
9020     REWRITE_TAC[RATIONAL_CLOSED] THEN VECTOR_ARITH_TAC;
9021     ALL_TAC] THEN
9022   ABBREV_TAC `v = IMAGE (canonize:real^N->real^N) s` THEN
9023   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC
9024    `UNIONS (IMAGE (\q. IMAGE (\x:real^N. q % basis 1 + x) v) rational)` THEN
9025   CONJ_TAC THENL
9026    [ALL_TAC;
9027     REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN ASM SET_TAC[]] THEN
9028   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
9029   SIMP_TAC[COUNTABLE_RATIONAL; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
9030   ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN GEN_TAC THEN
9031   DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC lemma THEN
9032   CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
9033   EXPAND_TAC "v" THEN
9034   REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN
9035   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9036   X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
9037   X_GEN_TAC `q:real` THEN REPEAT DISCH_TAC THEN
9038   EXPAND_TAC "canonize" THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
9039   X_GEN_TAC `z:real^N` THEN AP_TERM_TAC THEN FIRST_X_ASSUM(fun th ->
9040     MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
9041   ASM_REWRITE_TAC[VECTOR_ARITH `q % b + x:real^N = y <=> x = y - q % b`] THEN
9042   STRIP_TAC THEN
9043   ASM_REWRITE_TAC[VECTOR_ARITH `x - q % b:real^N = y - r % b - s % b <=>
9044                    y + (q - r - s) % b = x /\ x + (r + s - q) % b = y`] THEN
9045   STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9046   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
9047    (BINDER_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN
9048   SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; ARITH; VECTOR_ARITH
9049    `y - q % b:real^N = (y + r % b) - s % b <=> (q + r - s) % b = vec 0`] THEN
9050   ONCE_REWRITE_TAC[CONJ_SYM] THEN
9051   REWRITE_TAC[REAL_ARITH `a + b - c = &0 <=> c = a + b`; UNWIND_THM2] THEN
9052   ASM_SIMP_TAC[RATIONAL_CLOSED]);;
9053
9054 let NEGLIGIBLE_IFF_MEASURABLE_SUBSETS = prove
9055  (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> measurable t`,
9056   MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_MEASURABLE;
9057             MEASURABLE_IMP_LEBESGUE_MEASURABLE;
9058             NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS]);;
9059
9060 (* ------------------------------------------------------------------------- *)
9061 (* Preserving Lebesgue measurability vs. preserving negligibility.           *)
9062 (* ------------------------------------------------------------------------- *)
9063
9064 let PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE = prove
9065  (`!f s:real^N->bool.
9066         (!t. negligible t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t))
9067         ==> (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t))`,
9068   REPEAT STRIP_TAC THEN
9069   REWRITE_TAC[NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS] THEN
9070   REWRITE_TAC[FORALL_SUBSET_IMAGE] THEN
9071   ASM_MESON_TAC[NEGLIGIBLE_SUBSET; SUBSET_TRANS]);;
9072
9073 let LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE = prove
9074  (`!f:real^M->real^N s.
9075         f continuous_on s /\
9076         (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t))
9077         ==> !t. lebesgue_measurable t /\ t SUBSET s
9078                 ==> lebesgue_measurable(IMAGE f t)`,
9079   REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o
9080     MATCH_MP LEBESGUE_MEASURABLE_REGULAR_INNER) THEN
9081   ASM_REWRITE_TAC[IMAGE_UNION; IMAGE_UNIONS] THEN
9082   MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN
9083   SUBGOAL_THEN `(k:real^M->bool) SUBSET s` ASSUME_TAC THENL
9084    [ASM SET_TAC[]; ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]] THEN
9085   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
9086   REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; FORALL_IN_IMAGE] THEN
9087   SIMP_TAC[IN_UNIV; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
9088   GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COMPACT THEN
9089   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
9090   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9091     CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
9092
9093 let LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE = prove
9094  (`!f:real^M->real^N s.
9095         dimindex(:M) <= dimindex(:N) /\
9096         f differentiable_on s /\ lebesgue_measurable s
9097         ==> lebesgue_measurable(IMAGE f s)`,
9098   REPEAT STRIP_TAC THEN MATCH_MP_TAC
9099    (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
9100         LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE) THEN
9101   EXISTS_TAC `s:real^M->bool` THEN
9102   ASM_SIMP_TAC[SUBSET_REFL; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN
9103   REPEAT STRIP_TAC THEN
9104   MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN
9105   ASM_MESON_TAC[DIFFERENTIABLE_ON_SUBSET]);;
9106
9107 (* ------------------------------------------------------------------------- *)
9108 (* Measurability of continuous functions.                                    *)
9109 (* ------------------------------------------------------------------------- *)
9110
9111 let CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove
9112  (`!f:real^M->real^N s.
9113         f continuous_on s /\ lebesgue_measurable s
9114         ==> f measurable_on s`,
9115   let lemma = prove
9116    (`!s. lebesgue_measurable s
9117          ==> ?u:num->real^M->bool.
9118                 (!n. closed(u n)) /\ (!n. u n SUBSET s) /\
9119                 (!n. measurable(s DIFF u n) /\
9120                      measure(s DIFF u n) < inv(&n + &1)) /\
9121                 (!n. u(n) SUBSET u(SUC n))`,
9122     REPEAT STRIP_TAC THEN
9123     SUBGOAL_THEN
9124      `!n t. closed t /\ t SUBSET s
9125             ==> ?u:real^M->bool.
9126                       closed u /\ t SUBSET u /\ u SUBSET s /\
9127                       measurable(s DIFF u) /\ measure(s DIFF u) < inv(&n + &1)`
9128     MP_TAC THENL
9129      [REPEAT STRIP_TAC THEN
9130       MP_TAC(ISPECL [`s DIFF t:real^M->bool`; `inv(&n + &1)`]
9131         LEBESGUE_MEASURABLE_INNER_CLOSED) THEN
9132       ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_CLOSED] THEN
9133       REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
9134       DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
9135       EXISTS_TAC `t UNION u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNION] THEN
9136       CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
9137       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9138       ASM_REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = s DIFF t DIFF u`];
9139       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
9140       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
9141       X_GEN_TAC `v:num->(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN
9142       MP_TAC(prove_recursive_functions_exist num_RECURSION
9143           `(u:num->real^M->bool) 0 = v 0 {} /\
9144            (!n. u(SUC n) = v (SUC n) (u n))`) THEN
9145       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->real^M->bool` THEN
9146       STRIP_TAC THEN
9147       SUBGOAL_THEN
9148        `!n. closed(u n) /\ (u:num->real^M->bool) n SUBSET s`
9149       ASSUME_TAC THENL
9150        [INDUCT_TAC THEN
9151         ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET];
9152         ASM_SIMP_TAC[]] THEN
9153       INDUCT_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
9154       ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET]]) in
9155   REPEAT STRIP_TAC THEN
9156   FIRST_ASSUM(X_CHOOSE_THEN `u:num->real^M->bool` STRIP_ASSUME_TAC o
9157     MATCH_MP lemma) THEN
9158   SUBGOAL_THEN `lebesgue_measurable((:real^M) DIFF s)` MP_TAC THENL
9159    [ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]; ALL_TAC] THEN
9160   DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC o
9161     MATCH_MP lemma) THEN
9162   REWRITE_TAC[measurable_on] THEN
9163   EXISTS_TAC `(:real^M) DIFF
9164            (UNIONS {u n | n IN (:num)} UNION UNIONS {v n | n IN (:num)})` THEN
9165   SUBGOAL_THEN
9166    `!n. ?g. g continuous_on (:real^M) /\
9167             (!x. x IN u(n) UNION v(n:num)
9168                  ==> g x = if x IN s then (f:real^M->real^N)(x) else vec 0)`
9169   MP_TAC THENL
9170    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN
9171     ASM_SIMP_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; CLOSED_UNION] THEN
9172     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
9173     ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
9174     CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
9175     REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS] THEN
9176   X_GEN_TAC `g:num->real^M->real^N` THEN
9177   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9178   CONJ_TAC THENL
9179    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
9180     EXISTS_TAC `(s DIFF UNIONS {u n | n IN (:num)}) UNION
9181                 ((:real^M) DIFF s DIFF UNIONS {v n | n IN (:num)})` THEN
9182     CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
9183     MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THEN
9184     REWRITE_TAC[NEGLIGIBLE_OUTER] THEN
9185     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
9186     MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN
9187     ASM_REWRITE_TAC[] THEN
9188     DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL
9189      [EXISTS_TAC `s DIFF u(n:num):real^M->bool`;
9190       EXISTS_TAC `(:real^M) DIFF s DIFF v(n:num):real^M->bool`] THEN
9191     (CONJ_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[]] THEN
9192      MATCH_MP_TAC REAL_LT_TRANS THEN
9193      EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
9194      MATCH_MP_TAC REAL_LT_TRANS THEN
9195      EXISTS_TAC `inv(&n)` THEN ASM_REWRITE_TAC[] THEN
9196      MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN
9197      CONJ_TAC THENL [ASM_ARITH_TAC; REAL_ARITH_TAC]);
9198     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[SET_RULE
9199      `~(x IN (UNIV DIFF (s UNION t))) <=> x IN s \/ x IN t`] THEN
9200     REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
9201     REWRITE_TAC[OR_EXISTS_THM] THEN
9202     DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
9203     MATCH_MP_TAC LIM_EVENTUALLY THEN
9204     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
9205     EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
9206     FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_UNION] THEN
9207     SUBGOAL_THEN
9208      `!i j. i <= j ==> (u:num->real^M->bool)(i) SUBSET u(j) /\
9209                        (v:num->real^M->bool)(i) SUBSET v(j)`
9210      (fun th -> ASM_MESON_TAC[SUBSET; th]) THEN
9211     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
9212    ASM_REWRITE_TAC[] THEN SET_TAC[]]);;
9213
9214 let CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET = prove
9215  (`!f:real^M->real^N s.
9216         f continuous_on s /\ closed s ==> f measurable_on s`,
9217   SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET;
9218            LEBESGUE_MEASURABLE_CLOSED]);;
9219
9220 (* ------------------------------------------------------------------------- *)
9221 (* Measurability of a.e. derivatives.                                        *)
9222 (* ------------------------------------------------------------------------- *)
9223
9224 let MEASURABLE_ON_VECTOR_DERIVATIVE = prove
9225  (`!f:real^1->real^N f' s k.
9226         negligible k /\ negligible(frontier s) /\
9227         (!x. x IN (s DIFF k) ==> (f has_vector_derivative f'(x)) (at x))
9228         ==> f' measurable_on s`,
9229   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
9230   ABBREV_TAC `g:real^1->real^N = \x. if x IN s then f(x) else vec 0` THEN
9231   SUBGOAL_THEN `(g:real^1->real^N) measurable_on (:real^1)` ASSUME_TAC THENL
9232    [EXPAND_TAC "g" THEN REWRITE_TAC[MEASURABLE_ON_UNIV] THEN
9233     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN
9234     EXISTS_TAC `s DIFF k:real^1->bool` THEN CONJ_TAC THENL
9235      [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
9236       EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
9237       MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
9238       CONJ_TAC THENL
9239        [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN
9240         MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
9241         ASM_MESON_TAC[differentiable; has_vector_derivative];
9242         MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN
9243         ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE] THEN
9244         ASM_SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN]]];
9245      ALL_TAC] THEN
9246   MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
9247   EXISTS_TAC `\n x. (&n + &1) % (g(x + lift(inv(&n + &1))) - g(x):real^N)` THEN
9248   EXISTS_TAC `k UNION frontier s:real^1->bool` THEN
9249   ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL
9250    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN
9251     MATCH_MP_TAC MEASURABLE_ON_SUB THEN ASM_REWRITE_TAC[] THEN
9252     ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
9253     REWRITE_TAC[MEASURABLE_ON_TRANSLATION_EQ] THEN
9254     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
9255      `g measurable_on s ==> t = s ==> g measurable_on t`)) THEN
9256     MATCH_MP_TAC(SET_RULE
9257      `!g. (!x. f(g x) = x /\ g(f x) = x) ==> IMAGE f UNIV = UNIV`) THEN
9258     EXISTS_TAC `\x. --(lift(inv(&n + &1))) + x` THEN VECTOR_ARITH_TAC;
9259
9260     X_GEN_TAC `x:real^1` THEN
9261     REWRITE_TAC[IN_UNIV; IN_DIFF; IN_UNION; DE_MORGAN_THM; frontier;
9262                 CLOSURE_INTERIOR] THEN
9263     STRIP_TAC THEN
9264     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN
9265     REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL; IN_DIFF; IN_UNIV] THEN
9266     X_GEN_TAC `d:real` THEN ASM_SIMP_TAC[DIST_REFL] THEN STRIP_TAC THEN
9267     MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THENL
9268      [EXISTS_TAC `(\n. vec 0):num->real^N`;
9269       EXISTS_TAC `(\n. (&n + &1) % (f(x + lift (inv (&n + &1))) - f x))
9270                   :num->real^N`] THEN
9271     (CONJ_TAC THENL
9272       [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
9273        MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN
9274        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
9275        X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
9276        DISCH_TAC THEN
9277        SUBGOAL_THEN `dist(x,x + lift(inv(&n + &1))) < d` ASSUME_TAC THENL
9278         [REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
9279          REWRITE_TAC[NORM_LIFT; REAL_ABS_INV] THEN
9280          REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN
9281          MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&N)` THEN
9282          ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
9283          ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC;
9284          EXPAND_TAC "g" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[DIST_REFL] THEN
9285          VECTOR_ARITH_TAC];
9286        ALL_TAC]) THEN
9287      REWRITE_TAC[LIM_CONST] THEN
9288      UNDISCH_THEN
9289       `!x. x IN s DIFF k
9290            ==> ((f:real^1->real^N) has_vector_derivative f' x) (at x)`
9291       (MP_TAC o SPEC `x:real^1`) THEN
9292      ASM_SIMP_TAC[IN_DIFF; DIST_REFL; has_vector_derivative] THEN
9293      REWRITE_TAC[has_derivative; NETLIMIT_AT] THEN
9294      DISCH_THEN(MP_TAC o CONJUNCT2) THEN
9295      REWRITE_TAC[LIM_AT; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
9296      X_GEN_TAC `e:real` THEN DISCH_TAC THEN
9297      FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
9298      DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
9299      MP_TAC(SPEC `k:real` REAL_ARCH_INV) THEN
9300      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
9301      X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
9302      DISCH_TAC THEN
9303      FIRST_X_ASSUM(MP_TAC o SPEC `x +  lift(inv(&n + &1))` o CONJUNCT2) THEN
9304      REWRITE_TAC[NORM_ARITH `dist(x + a:real^N,x) = norm a`] THEN
9305      REWRITE_TAC[NORM_LIFT; REAL_ABS_INV; REAL_ARITH `abs(&n + &1) = &n + &1`;
9306               VECTOR_ARITH `(x + e) - x:real^N = e`; LIFT_DROP] THEN
9307      ANTS_TAC THENL
9308       [REWRITE_TAC[REAL_LT_INV_EQ] THEN
9309        CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_TRANS] THEN
9310        EXISTS_TAC `inv(&N)` THEN
9311        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
9312        ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC;
9313        MATCH_MP_TAC(NORM_ARITH
9314         `x - y:real^N = z ==> dist(z,vec 0) < e ==> dist(x,y) < e`) THEN
9315        REWRITE_TAC[REAL_INV_INV; VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN
9316        SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID;
9317                 REAL_ARITH `~(&n + &1 = &0)`] THEN
9318        VECTOR_ARITH_TAC]]);;
9319
9320 (* ------------------------------------------------------------------------- *)
9321 (* Approximation of L_1 functions by bounded continuous ones.                *)
9322 (* Note that 100/fourier.ml has some generalizations to L_p spaces.          *)
9323 (* ------------------------------------------------------------------------- *)
9324
9325 let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove
9326  (`!f:real^M->real^N s e.
9327         measurable s /\ f absolutely_integrable_on s /\ &0 < e
9328         ==> ?g. g absolutely_integrable_on s /\
9329                 g continuous_on (:real^M) /\
9330                 bounded (IMAGE g (:real^M)) /\
9331                 norm(integral s (\x. lift(norm(f x - g x)))) < e`,
9332   REPEAT STRIP_TAC THEN
9333   SUBGOAL_THEN
9334     `?h. h absolutely_integrable_on s /\
9335          bounded (IMAGE h (:real^M)) /\
9336          norm(integral s (\x. lift(norm(f x - h x:real^N)))) < e / &2`
9337   STRIP_ASSUME_TAC THENL
9338    [MP_TAC(ISPECL
9339      [`\n x. lift(norm
9340        (f x - (lambda i. max (--(&n)) (min (&n) ((f:real^M->real^N)(x)$i)))))`;
9341       `(\x. vec 0):real^M->real^1`;
9342       `\x. lift(norm((f:real^M->real^N)(x)))`;
9343       `s:real^M->bool`]
9344           DOMINATED_CONVERGENCE) THEN
9345     ASM_REWRITE_TAC[] THEN
9346     SUBGOAL_THEN
9347      `!n. ((\x. lambda i. max (--(&n)) (min (&n) ((f x:real^N)$i)))
9348           :real^M->real^N) absolutely_integrable_on s`
9349     ASSUME_TAC THENL
9350      [GEN_TAC THEN
9351       FIRST_ASSUM(MP_TAC o SPEC `(\x. lambda i. &n):real^M->real^N` o
9352         MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MIN)) THEN
9353       ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN
9354       DISCH_THEN(MP_TAC o SPEC `(\x. lambda i. --(&n)):real^M->real^N` o
9355         MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MAX)) THEN
9356       ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN
9357       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
9358       SIMP_TAC[CART_EQ; LAMBDA_BETA];
9359       ALL_TAC] THEN
9360     ANTS_TAC THENL
9361      [REPEAT CONJ_TAC THENL
9362        [X_GEN_TAC `n:num` THEN
9363         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
9364         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
9365         ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SUB];
9366         ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
9367                      ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE];
9368         MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN DISCH_TAC THEN
9369         REWRITE_TAC[LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN
9370         MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
9371         SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
9372         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
9373         REWRITE_TAC[LIM_SEQUENTIALLY] THEN
9374         X_GEN_TAC `d:real` THEN DISCH_TAC THEN
9375         MP_TAC(SPEC `norm((f:real^M->real^N) x)` REAL_ARCH_SIMPLE) THEN
9376         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
9377         DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
9378         REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_NORM; GSYM LIFT_SUB] THEN
9379         MATCH_MP_TAC(NORM_ARITH
9380          `&0 < d /\ x = y ==> norm(x:real^N - y) < d`) THEN
9381         ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN
9382         MATCH_MP_TAC(REAL_ARITH
9383           `abs(x) <= n ==> x = max (--n) (min n x)`) THEN
9384         ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_OF_NUM_LE]];
9385       DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
9386       DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
9387       DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
9388       REWRITE_TAC[INTEGRAL_0; DIST_0; LE_REFL] THEN DISCH_TAC THEN
9389       EXISTS_TAC `(\x. lambda i. max (--(&n)) (min (&n)
9390                              ((f:real^M->real^N)(x)$i))):real^M->real^N` THEN
9391       ASM_REWRITE_TAC[] THEN
9392       ONCE_REWRITE_TAC[BOUNDED_COMPONENTWISE] THEN
9393       REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN
9394       X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `&n` THEN
9395       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
9396       ASM_SIMP_TAC[NORM_LIFT; LAMBDA_BETA] THEN REAL_ARITH_TAC];
9397     ALL_TAC] THEN
9398   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
9399   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
9400   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
9401   SUBGOAL_THEN
9402    `?k g. negligible k /\
9403           (!n. g n continuous_on (:real^M)) /\
9404           (!n x. norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\
9405           (!x. x IN (s DIFF k)  ==> ((\n. g n x) --> h x) sequentially)`
9406   STRIP_ASSUME_TAC THENL
9407    [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL
9408      [ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; ALL_TAC] THEN
9409     REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN
9410     X_GEN_TAC `k:real^M->bool` THEN
9411     DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
9412     EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))):
9413                 num->real^M->real^N` THEN
9414     ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
9415      [X_GEN_TAC `n:num` THEN
9416       FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
9417       MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`]
9418                 CONTINUOUS_ON_CONST) THEN
9419       REWRITE_TAC[IMP_IMP] THEN
9420       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN
9421       MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`]
9422                 CONTINUOUS_ON_CONST) THEN
9423       REWRITE_TAC[IMP_IMP] THEN
9424       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN
9425       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
9426       SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA];
9427       REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
9428       SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN
9429       REAL_ARITH_TAC;
9430       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
9431       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
9432       REWRITE_TAC[LIM_SEQUENTIALLY] THEN
9433       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN
9434       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
9435       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
9436       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
9437       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
9438       MATCH_MP_TAC(NORM_ARITH
9439        `norm(c - a:real^N) <= norm(b - a)
9440         ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN
9441       MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
9442       SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN
9443       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
9444       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
9445       DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN
9446       DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN
9447       REAL_ARITH_TAC];
9448     ALL_TAC] THEN
9449   SUBGOAL_THEN
9450    `!n. (g:num->real^M->real^N) n absolutely_integrable_on s`
9451   ASSUME_TAC THENL
9452    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC
9453       MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
9454     EXISTS_TAC `(\x. lift(norm(B % vec 1:real^N))):real^M->real^1` THEN
9455     ASM_REWRITE_TAC[LIFT_DROP; INTEGRABLE_ON_CONST] THEN
9456     ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
9457     MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator]
9458         MEASURABLE_ON_RESTRICT) THEN
9459     ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN
9460     MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
9461     ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE];
9462     ALL_TAC] THEN
9463   MP_TAC(ISPECL
9464    [`\n x. lift(norm((g:num->real^M->real^N) n x - h x))`;
9465     `(\x. vec 0):real^M->real^1`;
9466     `(\x. lift(B + norm(B % vec 1:real^N))):real^M->real^1`;
9467     `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN
9468   ASM_SIMP_TAC[INTEGRAL_0; INTEGRABLE_ON_CONST; MEASURABLE_DIFF;
9469                NEGLIGIBLE_IMP_MEASURABLE] THEN
9470   ANTS_TAC THENL
9471    [REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN REPEAT CONJ_TAC THENL
9472      [GEN_TAC THEN
9473       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
9474       EXISTS_TAC `s:real^M->bool` THEN
9475       ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
9476                    ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE;
9477                    ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN
9478       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
9479       ASM_REWRITE_TAC[] THEN SET_TAC[];
9480       REPEAT STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN
9481       MATCH_MP_TAC(NORM_ARITH
9482        `norm(g:real^N) <= b /\ norm(h) <= a ==> norm(g - h) <= a + b`) THEN
9483       ASM_REWRITE_TAC[];
9484       ASM_REWRITE_TAC[GSYM LIM_NULL_NORM; GSYM LIM_NULL]];
9485     REWRITE_TAC[LIM_SEQUENTIALLY] THEN
9486     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
9487     DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
9488     REWRITE_TAC[LE_REFL; DIST_0] THEN DISCH_TAC THEN
9489     EXISTS_TAC `(g:num->real^M->real^N) n` THEN ASM_REWRITE_TAC[] THEN
9490     REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN
9491     CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9492     MATCH_MP_TAC REAL_LET_TRANS THEN
9493     EXISTS_TAC `norm(integral s (\x. lift(norm(f x - h x)))) +
9494      norm(integral s (\x. lift(norm((g:num->real^M->real^N) n x - h x))))` THEN
9495     CONJ_TAC THENL
9496      [MATCH_MP_TAC(NORM_ARITH
9497        `norm(x:real^N) <= norm(y + z:real^N)
9498         ==> norm(x) <= norm(y) + norm(z)`) THEN
9499       W(MP_TAC o PART_MATCH (lhs o rand) (GSYM INTEGRAL_ADD) o
9500          rand o rand o snd) THEN
9501       ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
9502                ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE;
9503                ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN
9504       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[]
9505        `norm x = drop x /\ norm(a:real^N) <= drop x ==> norm a <= norm x`) THEN
9506       CONJ_TAC THENL
9507        [MATCH_MP_TAC NORM_1_POS THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN
9508         SIMP_TAC[DROP_ADD; LIFT_DROP; NORM_POS_LE; REAL_LE_ADD] THEN
9509         MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC;
9510         MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
9511         REWRITE_TAC[DROP_ADD; LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN
9512         REWRITE_TAC[NORM_ARITH
9513          `norm(f - g:real^N) <= norm(f - h) + norm(g - h)`] THEN
9514         CONJ_TAC THENL
9515          [ALL_TAC; MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC]] THEN
9516       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
9517       ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
9518                    ABSOLUTELY_INTEGRABLE_SUB; ETA_AX];
9519       MATCH_MP_TAC(REAL_ARITH `a < e / &2 /\ b < e / &2 ==> a + b < e`) THEN
9520       ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
9521        `x < e ==> x = y ==> y < e`)) THEN AP_TERM_TAC THEN
9522       MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN
9523       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
9524       ASM_REWRITE_TAC[] THEN SET_TAC[]]]);;
9525
9526 (* ------------------------------------------------------------------------- *)
9527 (* Luzin's theorem (Talvila and Loeb's proof from Marius Junge's notes).     *)
9528 (* ------------------------------------------------------------------------- *)
9529
9530 let LUZIN = prove
9531  (`!f:real^M->real^N s e.
9532         measurable s /\ f measurable_on s /\ &0 < e
9533         ==> ?k. compact k /\ k SUBSET s /\
9534                 measure(s DIFF k) < e /\ f continuous_on k`,
9535   REPEAT STRIP_TAC THEN
9536   X_CHOOSE_THEN `v:num->real^N->bool` STRIP_ASSUME_TAC
9537     UNIV_SECOND_COUNTABLE_SEQUENCE THEN
9538   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
9539         MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN) THEN
9540   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
9541         MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED) THEN
9542   ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
9543   SUBGOAL_THEN
9544    `!n. ?k k'.
9545         compact k /\ k SUBSET {x | x IN s /\ (f:real^M->real^N) x IN v n} /\
9546         compact k' /\ k' SUBSET {x | x IN s /\ f x IN ((:real^N) DIFF v n)} /\
9547         measure(s DIFF (k UNION k')) < e / &4 / &2 pow n`
9548   MP_TAC THENL
9549    [GEN_TAC THEN
9550     MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (v:num->real^N->bool) n}`;
9551                    `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN
9552     ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH; REAL_LT_DIV; REAL_LT_POW2] THEN
9553     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
9554     STRIP_TAC THEN
9555     MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (:real^N) DIFF v(n:num)}`;
9556                    `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN
9557     ASM_SIMP_TAC[GSYM OPEN_CLOSED; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT;
9558                  ARITH] THEN
9559     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k':real^M->bool` THEN
9560     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9561     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
9562      `measure(({x | x IN s /\ (f:real^M->real^N) x IN v n} DIFF k) UNION
9563               ({x | x IN s /\ f x IN ((:real^N) DIFF v(n:num))} DIFF k'))` THEN
9564     CONJ_TAC THENL
9565      [MATCH_MP_TAC MEASURE_SUBSET THEN
9566       ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT;
9567                    GSYM OPEN_CLOSED] THEN SET_TAC[];
9568       ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_DIFF; MEASURABLE_COMPACT;
9569                    GSYM OPEN_CLOSED; MEASURE_DIFF_SUBSET] THEN
9570       MATCH_MP_TAC(REAL_ARITH
9571        `s < k + e / &4 / &2 / d /\ s' < k' + e / &4 / &2 / d /\ m = &0
9572         ==> (s - k) + (s' - k') - m < e / &4 / d`) THEN
9573       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[MEASURE_EMPTY]
9574        `s = {} ==> measure s = &0`) THEN SET_TAC[]];
9575     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_DIFF; IN_UNIV] THEN
9576     MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `k':num->real^M->bool`] THEN
9577     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
9578   EXISTS_TAC `INTERS {k n UNION k' n | n IN (:num)} :real^M->bool` THEN
9579   REPEAT CONJ_TAC THENL
9580    [MATCH_MP_TAC COMPACT_INTERS THEN
9581     ASM_SIMP_TAC[FORALL_IN_GSPEC; COMPACT_UNION] THEN SET_TAC[];
9582     REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[];
9583     REWRITE_TAC[DIFF_INTERS; SET_RULE
9584      `{f y | y IN {g x | x IN s}} = {f(g x) | x IN s}`] THEN
9585     MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
9586     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
9587      (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN
9588     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN
9589     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT] THEN
9590     X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9591     EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL
9592      [ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE]; ALL_TAC] THEN
9593     ASM_SIMP_TAC[real_div; SUM_LMUL; REAL_LE_LMUL_EQ; REAL_ARITH
9594      `(e * inv(&4)) * s <= e * inv(&2) <=> e * s <= e * &2`] THEN
9595     REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN
9596     CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH
9597      `(&1 - s) / (&1 / &2) <= &2 <=> &0 <= s`] THEN
9598     MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV;
9599
9600     REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
9601     REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
9602     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
9603     REWRITE_TAC[CONTINUOUS_WITHIN_OPEN; IN_ELIM_THM] THEN
9604     X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
9605     SUBGOAL_THEN
9606      `?n:num. (f:real^M->real^N)(x) IN v(n) /\ v(n) SUBSET t`
9607     STRIP_ASSUME_TAC THENL
9608      [UNDISCH_THEN
9609        `!s. open s ==> (?k. s:real^N->bool = UNIONS {v(n:num) | n IN k})`
9610        (MP_TAC o SPEC `t:real^N->bool`) THEN
9611       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; UNIONS_GSPEC] THEN ASM SET_TAC[];
9612       EXISTS_TAC `(:real^M) DIFF k'(n:num)` THEN
9613       ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]]);;
9614
9615 let LUZIN_EQ,LUZIN_EQ_ALT = (CONJ_PAIR o prove)
9616  (`(!f:real^M->real^N s.
9617         measurable s
9618         ==> (f measurable_on s <=>
9619              !e. &0 < e
9620                  ==> ?k. compact k /\ k SUBSET s /\
9621                          measure(s DIFF k) < e /\ f continuous_on k)) /\
9622    (!f:real^M->real^N s.
9623         measurable s
9624         ==> (f measurable_on s <=>
9625              !e. &0 < e
9626                  ==> ?k g. compact k /\ k SUBSET s /\
9627                            measure(s DIFF k) < e /\
9628                            g continuous_on (:real^M) /\
9629                            (!x. x IN k ==> g x = f x)))`,
9630   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
9631   ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN
9632   MATCH_MP_TAC(TAUT
9633    `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN
9634   REPEAT CONJ_TAC THENL
9635    [ASM_MESON_TAC[LUZIN];
9636     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
9637     ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
9638     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
9639     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN
9640     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBTOPOLOGY_UNIV; GSYM CLOSED_IN];
9641     DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
9642     REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN
9643     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
9644     MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `g:num->real^M->real^N`] THEN
9645     STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC
9646      [`g:num->real^M->real^N`;
9647       `s DIFF UNIONS {INTERS {k m | n <= m} | n IN (:num)}:real^M->bool`] THEN
9648     REPEAT CONJ_TAC THENL
9649      [X_GEN_TAC `n:num` THEN
9650       MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
9651       ASM_MESON_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; CONTINUOUS_ON_SUBSET;
9652                     SUBSET_UNIV];
9653       SIMP_TAC[DIFF_UNIONS_NONEMPTY; SET_RULE `~({f x | x IN UNIV} = {})`] THEN
9654       REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
9655       MP_TAC(SPECL [`inv(&2)`; `e / &4`] REAL_ARCH_POW_INV) THEN
9656       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN
9657       DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
9658       EXISTS_TAC `s DIFF INTERS {k m | n:num <= m}:real^M->bool` THEN
9659       REPEAT CONJ_TAC THENL
9660        [REWRITE_TAC[INTERS_GSPEC; FORALL_IN_GSPEC] THEN ASM SET_TAC[];
9661         MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
9662         MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS_GEN THEN
9663         ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT] THEN
9664         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[LE_REFL]] THEN
9665         ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
9666         MATCH_MP_TAC COUNTABLE_IMAGE THEN
9667         MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV];
9668         REWRITE_TAC[DIFF_INTERS] THEN
9669         MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
9670         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
9671          (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN
9672         MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN
9673         ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT; MEASURABLE_DIFF] THEN
9674         CONJ_TAC THENL
9675          [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
9676           MATCH_MP_TAC COUNTABLE_IMAGE THEN
9677           REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN
9678           ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
9679           MATCH_MP_TAC COUNTABLE_IMAGE THEN
9680           MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV];
9681           REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
9682           REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
9683           ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
9684           REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
9685           X_GEN_TAC `ns:num->bool` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
9686           STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN
9687           W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN
9688           ASM_SIMP_TAC[o_DEF; MEASURE_POS_LE; MEASURABLE_DIFF;
9689                        MEASURABLE_COMPACT] THEN
9690           MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
9691           FIRST_ASSUM(MP_TAC o SPEC `\x:num. x` o
9692             MATCH_MP UPPER_BOUND_FINITE_SET) THEN
9693           REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN
9694           STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9695           EXISTS_TAC `sum (n..m) (\i. measure(s DIFF k i:real^M->bool))` THEN
9696           CONJ_TAC THENL
9697            [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
9698             ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_COMPACT;
9699                          FINITE_NUMSEG; SUBSET; IN_NUMSEG];
9700             ALL_TAC] THEN
9701           MATCH_MP_TAC REAL_LE_TRANS THEN
9702           EXISTS_TAC `sum (n..m) (\i. inv(&2 pow i))` THEN
9703           ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN
9704           REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN
9705           COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9706           CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH
9707            `a <= e / &4 /\ &0 <= b
9708             ==> (a - b) / (&1 / &2) <= e / &2`) THEN
9709           REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN
9710           ASM_SIMP_TAC[GSYM real_div; REAL_LT_IMP_LE; REAL_LE_INV_EQ;
9711                        REAL_LT_POW2]]];
9712       REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN
9713       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; IN_INTER] THEN
9714       REWRITE_TAC[IN_UNIV; IN_ELIM_THM; INTERS_GSPEC] THEN
9715       STRIP_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN
9716       REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]]]);;