Multivariate/measure.ml

   1 (* ========================================================================= *)
   2 (* Lebesgue 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 let NEGLIGIBLE_EMPTY_INTERIOR = prove
 968  (`!s:real^N->bool. negligible s ==> interior s = {}`,
 969   MESON_TAC[OPEN_NOT_NEGLIGIBLE; INTERIOR_SUBSET; OPEN_INTERIOR;
 970             NEGLIGIBLE_SUBSET]);;
 971
 972 let HAS_INTEGRAL_NEGLIGIBLE_EQ_AE = prove
 973  (`!f:real^M->real^N s t.
 974         negligible t /\
 975         (!x i. x IN s DIFF t /\ 1 <= i /\ i <= dimindex (:N) ==> &0 <= f x$i)
 976         ==> ((f has_integral vec 0) s <=>
 977              negligible {x | x IN s /\ ~(f x = vec 0)})`,
 978   REPEAT STRIP_TAC THEN
 979   MP_TAC(ISPECL
 980    [`\x. if x IN t then vec 0 else (f:real^M->real^N) x`;
 981     `s:real^M->bool`] HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN
 982   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
 983    [ASM_MESON_TAC[VEC_COMPONENT; IN_DIFF; REAL_LE_REFL]; ALL_TAC] THEN
 984   MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
 985    [MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ;
 986     MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN
 987     MATCH_MP_TAC NEGLIGIBLE_SUBSET] THEN
 988   EXISTS_TAC `t:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
 989
 990 (* ------------------------------------------------------------------------- *)
 991 (* Properties of measure under simple affine transformations.                *)
 992 (* ------------------------------------------------------------------------- *)
 993
 994 let HAS_MEASURE_AFFINITY = prove
 995  (`!s m c y. s has_measure y
 996              ==> (IMAGE (\x:real^N. m % x + c) s)
 997                  has_measure abs(m) pow (dimindex(:N)) * y`,
 998   REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THENL
 999    [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN
1000     ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(x = 0) ==> x = SUC(x - 1)`)
1001      (SPEC_ALL DIMINDEX_NONZERO)] THEN DISCH_TAC THEN
1002     REWRITE_TAC[real_pow; REAL_MUL_LZERO; HAS_MEASURE_0] THEN
1003     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{c:real^N}` THEN
1004     SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_RULES] THEN SET_TAC[];
1005     ALL_TAC] THEN
1006   REWRITE_TAC[HAS_MEASURE] THEN
1007   ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
1008   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1009   FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(m) pow dimindex(:N)`) THEN
1010   ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
1011   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
1012   EXISTS_TAC `abs(m) * B + norm(c:real^N)` THEN
1013   ASM_SIMP_TAC[REAL_ARITH `&0 < B /\ &0 <= x ==> &0 < B + x`;
1014                NORM_POS_LE; REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
1015   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
1016   REWRITE_TAC[IN_IMAGE] THEN
1017   ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; UNWIND_THM1] THEN
1018   FIRST_X_ASSUM(MP_TAC o SPECL
1019     [`if &0 <= m then inv m % u + --(inv m % c):real^N
1020                  else inv m % v + --(inv m % c)`;
1021      `if &0 <= m then inv m % v + --(inv m % c):real^N
1022                  else inv m % u + --(inv m % c)`]) THEN
1023   MATCH_MP_TAC(TAUT `a /\ (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN
1024   CONJ_TAC THENL
1025    [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
1026     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
1027     DISCH_THEN(MP_TAC o SPEC `m % x + c:real^N`) THEN
1028     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_INTERVAL] THEN
1029     CONJ_TAC THENL
1030      [REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm(x:real^N)`] THEN
1031       DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH
1032        `norm(x:real^N) < a ==> norm(x + y) < a + norm(y)`) THEN
1033       ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL; GSYM REAL_ABS_NZ];
1034       ALL_TAC] THEN
1035     SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT;
1036              COND_COMPONENT] THEN
1037     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
1038     REWRITE_TAC[REAL_ARITH `m * u + --(m * c):real = (u - c) * m`] THEN
1039     SUBST1_TAC(REAL_ARITH
1040       `inv(m) = if &0 <= inv(m) then abs(inv m) else --(abs(inv m))`) THEN
1041     SIMP_TAC[REAL_LE_INV_EQ] THEN
1042     REWRITE_TAC[REAL_ARITH `(x - y:real) * --z = (y - x) * z`] THEN
1043     REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN COND_CASES_TAC THEN
1044     ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
1045     ASM_REWRITE_TAC[real_abs] THEN REAL_ARITH_TAC;
1046     ALL_TAC] THEN
1047   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN
1048   ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_TAC THEN
1049   DISCH_THEN(X_CHOOSE_THEN `z:real^1`
1050    (fun th -> EXISTS_TAC `(abs m pow dimindex (:N)) % z:real^1` THEN
1051               MP_TAC th)) THEN
1052   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1053   FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_FIELD `~(x = &0) ==> ~(inv x = &0)`)) THEN
1054   REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN
1055   DISCH_THEN(MP_TAC o SPEC `--(inv m % c):real^N` o
1056     MATCH_MP HAS_INTEGRAL_AFFINITY) THEN
1057   ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV] THEN
1058   SIMP_TAC[COND_ID] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1059   REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
1060                VECTOR_MUL_LNEG; VECTOR_MUL_RNEG] THEN
1061   ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_NEG_NEG] THEN
1062   REWRITE_TAC[VECTOR_ARITH `(u + --c) + c:real^N = u`] THEN
1063   REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV; GSYM REAL_POW_INV] THEN
1064   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
1065   REWRITE_TAC[LIFT_CMUL; GSYM VECTOR_SUB_LDISTRIB] THEN
1066   REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_ABS] THEN
1067   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1068   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_POW_LT; GSYM REAL_ABS_NZ]);;
1069
1070 let STRETCH_GALOIS = prove
1071  (`!x:real^N y:real^N m.
1072         (!k. 1 <= k /\ k <= dimindex(:N) ==>  ~(m k = &0))
1073         ==> ((y = (lambda k. m k * x$k)) <=> (lambda k. inv(m k) * y$k) = x)`,
1074   REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
1075   MATCH_MP_TAC(MESON[]
1076    `(!x. p x ==> (q x <=> r x))
1077     ==> (!x. p x) ==> ((!x. q x) <=> (!x. r x))`) THEN
1078   GEN_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN
1079   ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);;
1080
1081 let HAS_MEASURE_STRETCH = prove
1082  (`!s m y. s has_measure y
1083            ==> (IMAGE (\x:real^N. lambda k. m k * x$k) s :real^N->bool)
1084                has_measure abs(product (1..dimindex(:N)) m) * y`,
1085   REPEAT STRIP_TAC THEN ASM_CASES_TAC
1086    `!k. 1 <= k /\ k <= dimindex(:N) ==> ~(m k = &0)`
1087   THENL
1088    [ALL_TAC;
1089     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
1090     REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THEN
1091     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1092     SUBGOAL_THEN `product(1..dimindex (:N)) m = &0` SUBST1_TAC THENL
1093      [ASM_MESON_TAC[PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN
1094     REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; HAS_MEASURE_0] THEN
1095     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
1096     EXISTS_TAC `{x:real^N | x$k = &0}` THEN
1097     ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; SUBSET; FORALL_IN_IMAGE] THEN
1098     ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; REAL_MUL_LZERO]] THEN
1099   UNDISCH_TAC `(s:real^N->bool) has_measure y` THEN
1100   REWRITE_TAC[HAS_MEASURE] THEN
1101   ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
1102   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1103   SUBGOAL_THEN `&0 < abs(product(1..dimindex(:N)) m)` ASSUME_TAC THENL
1104    [ASM_MESON_TAC[REAL_ABS_NZ; REAL_LT_DIV; PRODUCT_EQ_0_NUMSEG];
1105     ALL_TAC] THEN
1106   FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(product(1..dimindex(:N)) m)`) THEN
1107   ASM_SIMP_TAC[REAL_LT_DIV] THEN
1108   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
1109   EXISTS_TAC `sup(IMAGE (\k. abs(m k) * B) (1..dimindex(:N)))` THEN
1110   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1111    [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; NUMSEG_EMPTY; FINITE_NUMSEG;
1112                  IN_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1; IMAGE_EQ_EMPTY;
1113                  EXISTS_IN_IMAGE] THEN
1114     ASM_MESON_TAC[IN_NUMSEG; DIMINDEX_GE_1; LE_REFL; REAL_LT_MUL; REAL_ABS_NZ];
1115     DISCH_TAC] THEN
1116   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
1117   ASM_SIMP_TAC[IN_IMAGE; STRETCH_GALOIS; UNWIND_THM1] THEN
1118   FIRST_X_ASSUM(MP_TAC o SPECL
1119     [`(lambda k. min (inv(m k) * (u:real^N)$k)
1120                      (inv(m k) * (v:real^N)$k)):real^N`;
1121      `(lambda k. max (inv(m k) * (u:real^N)$k)
1122                  (inv(m k) * (v:real^N)$k)):real^N`]) THEN
1123   MATCH_MP_TAC(TAUT `a /\ (b ==> a ==> c) ==> (a ==> b) ==> c`) THEN
1124   CONJ_TAC THENL
1125    [ALL_TAC;
1126     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN
1127     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1128     SUBGOAL_THEN `!k. 1 <= k /\ k <= dimindex (:N) ==> ~(inv(m k) = &0)`
1129     MP_TAC THENL [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN
1130     ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
1131     DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_STRETCH)] THEN
1132   (MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `\i:num. inv(m i:real)`]
1133     IMAGE_STRETCH_INTERVAL) THEN
1134    SUBGOAL_THEN `~(interval[u:real^N,v] = {})` ASSUME_TAC THENL
1135     [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1136       `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN
1137      ASM_REWRITE_TAC[BALL_EQ_EMPTY; GSYM REAL_NOT_LT];
1138      ALL_TAC] THEN
1139    ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM))
1140   THENL
1141    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1142      `b SUBSET s ==> b' SUBSET IMAGE f b ==> b' SUBSET IMAGE f s`)) THEN
1143     REWRITE_TAC[IN_BALL; SUBSET; NORM_ARITH `dist(vec 0:real^N,x) = norm x`;
1144                 IN_IMAGE] THEN
1145     ASM_SIMP_TAC[STRETCH_GALOIS; REAL_INV_EQ_0; UNWIND_THM1; REAL_INV_INV] THEN
1146     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1147     MATCH_MP_TAC REAL_LET_TRANS THEN
1148     EXISTS_TAC
1149      `norm(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) % x:real^N)` THEN
1150     CONJ_TAC THENL
1151      [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
1152       SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; REAL_ABS_MUL] THEN
1153       REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
1154       REWRITE_TAC[REAL_ABS_POS] THEN
1155       MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN
1156       ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1157                   NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1158       REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_LE_REFL];
1159       ALL_TAC] THEN
1160     REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
1161     EXISTS_TAC `abs(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))) * B` THEN
1162     SUBGOAL_THEN `&0 < sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))`
1163     ASSUME_TAC THENL
1164      [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1165                   NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1166       REWRITE_TAC[EXISTS_IN_IMAGE; GSYM REAL_ABS_NZ; IN_NUMSEG] THEN
1167       ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL];
1168       ALL_TAC] THEN
1169     ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN
1170     MATCH_MP_TAC REAL_LE_TRANS THEN
1171     EXISTS_TAC `sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) * B` THEN
1172     ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `&0 < x ==> abs x <= x`] THEN
1173     ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1174                   NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1175     ASM_SIMP_TAC[EXISTS_IN_IMAGE; REAL_LE_RMUL_EQ] THEN
1176     ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
1177                  NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
1178     MP_TAC(ISPEC `IMAGE (\k. abs (m k)) (1..dimindex(:N))` SUP_FINITE) THEN
1179     REWRITE_TAC[FORALL_IN_IMAGE] THEN
1180     ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY;
1181                  GSYM NOT_LE; DIMINDEX_GE_1] THEN
1182     REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[];
1183
1184     MATCH_MP_TAC(MESON[]
1185      `s = t /\ P z ==> (f has_integral z) s ==> Q
1186                        ==> ?w. (f has_integral w) t /\ P w`) THEN
1187     SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG; GSYM REAL_ABS_INV] THEN
1188     REWRITE_TAC[REAL_INV_INV] THEN CONJ_TAC THENL
1189      [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
1190        `(!x. f x = x) ==> IMAGE f s = s`) THEN
1191       SIMP_TAC[o_THM; LAMBDA_BETA; CART_EQ] THEN
1192       ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID];
1193       REWRITE_TAC[ABS_DROP; DROP_SUB; LIFT_DROP; DROP_CMUL] THEN
1194       REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; ETA_AX] THEN
1195       REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN
1196       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1197       ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN
1198       ASM_MESON_TAC[ABS_DROP; DROP_SUB; LIFT_DROP]]]);;
1199
1200 let HAS_MEASURE_TRANSLATION = prove
1201  (`!s m a. s has_measure m ==> (IMAGE (\x:real^N. a + x) s) has_measure m`,
1202   REPEAT GEN_TAC THEN
1203   MP_TAC(ISPECL [`s:real^N->bool`; `&1`; `a:real^N`; `m:real`]
1204                 HAS_MEASURE_AFFINITY) THEN
1205   REWRITE_TAC[VECTOR_MUL_LID; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN
1206   REWRITE_TAC[VECTOR_ADD_SYM]);;
1207
1208 let NEGLIGIBLE_TRANSLATION = prove
1209  (`!s a. negligible s ==> negligible (IMAGE (\x:real^N. a + x) s)`,
1210   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION]);;
1211
1212 let HAS_MEASURE_TRANSLATION_EQ = prove
1213  (`!a s m. (IMAGE (\x:real^N. a + x) s) has_measure m <=> s has_measure m`,
1214   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_TRANSLATION] THEN
1215   DISCH_THEN(MP_TAC o SPEC `--a:real^N` o
1216     MATCH_MP HAS_MEASURE_TRANSLATION) THEN
1217   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1218   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + b:real^N = b`] THEN
1219   SET_TAC[]);;
1220
1221 add_translation_invariants [HAS_MEASURE_TRANSLATION_EQ];;
1222
1223 let MEASURE_TRANSLATION = prove
1224  (`!a s. measure(IMAGE (\x:real^N. a + x) s) = measure s`,
1225   REWRITE_TAC[measure; HAS_MEASURE_TRANSLATION_EQ]);;
1226
1227 add_translation_invariants [MEASURE_TRANSLATION];;
1228
1229 let NEGLIGIBLE_TRANSLATION_REV = prove
1230  (`!s a. negligible (IMAGE (\x:real^N. a + x) s) ==> negligible s`,
1231   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);;
1232
1233 let NEGLIGIBLE_TRANSLATION_EQ = prove
1234  (`!a s. negligible (IMAGE (\x:real^N. a + x) s) <=> negligible s`,
1235   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);;
1236
1237 add_translation_invariants [NEGLIGIBLE_TRANSLATION_EQ];;
1238
1239 let MEASURABLE_TRANSLATION_EQ = prove
1240  (`!a:real^N s. measurable (IMAGE (\x. a + x) s) <=> measurable s`,
1241   REWRITE_TAC[measurable; HAS_MEASURE_TRANSLATION_EQ]);;
1242
1243 add_translation_invariants [MEASURABLE_TRANSLATION_EQ];;
1244
1245 let MEASURABLE_TRANSLATION = prove
1246  (`!s a:real^N. measurable s ==> measurable (IMAGE (\x. a + x) s)`,
1247   REWRITE_TAC[MEASURABLE_TRANSLATION_EQ]);;
1248
1249 let HAS_MEASURE_SCALING = prove
1250  (`!s m c. s has_measure m
1251            ==> (IMAGE (\x:real^N. c % x) s) has_measure
1252                (abs(c) pow dimindex(:N)) * m`,
1253   REPEAT GEN_TAC THEN
1254   MP_TAC(ISPECL [`s:real^N->bool`; `c:real`; `vec 0:real^N`; `m:real`]
1255                 HAS_MEASURE_AFFINITY) THEN
1256   REWRITE_TAC[VECTOR_ADD_RID]);;
1257
1258 let HAS_MEASURE_SCALING_EQ = prove
1259  (`!s m c. ~(c = &0)
1260            ==> (IMAGE (\x:real^N. c % x) s
1261                   has_measure (abs(c) pow dimindex(:N)) * m <=>
1262                 s has_measure m)`,
1263   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_SCALING] THEN
1264   DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP HAS_MEASURE_SCALING) THEN
1265   REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
1266   REWRITE_TAC[GSYM REAL_POW_MUL; VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
1267   ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN
1268   REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID; VECTOR_MUL_LID] THEN
1269   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);;
1270
1271 let MEASURABLE_SCALING = prove
1272  (`!s c. measurable s ==> measurable (IMAGE (\x:real^N. c % x) s)`,
1273   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_SCALING]);;
1274
1275 let MEASURABLE_SCALING_EQ = prove
1276  (`!s c. ~(c = &0)
1277          ==> (measurable (IMAGE (\x:real^N. c % x) s) <=> measurable s)`,
1278   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_SCALING] THEN
1279   DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP MEASURABLE_SCALING) THEN
1280   REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
1281   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
1282   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
1283   SET_TAC[]);;
1284
1285 let MEASURE_SCALING = prove
1286  (`!s. measurable s
1287        ==> measure(IMAGE (\x:real^N. c % x) s) =
1288               (abs(c) pow dimindex(:N)) * measure s`,
1289   REWRITE_TAC[HAS_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
1290   MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_SCALING]);;
1291
1292 (* ------------------------------------------------------------------------- *)
1293 (* Measurability of countable unions and intersections of various kinds.     *)
1294 (* ------------------------------------------------------------------------- *)
1295
1296 let HAS_MEASURE_NESTED_UNIONS = prove
1297  (`!s:num->real^N->bool B.
1298         (!n. measurable(s n)) /\
1299         (!n. measure(s n) <= B) /\
1300         (!n. s(n) SUBSET s(SUC n))
1301         ==> measurable(UNIONS { s(n) | n IN (:num) }) /\
1302             ((\n. lift(measure(s n)))
1303                   --> lift(measure(UNIONS { s(n) | n IN (:num) })))
1304             sequentially`,
1305   REPEAT GEN_TAC THEN
1306   ONCE_REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b /\ (b ==> c))`] THEN
1307   SIMP_TAC[MEASURE_INTEGRAL_UNIV; LIFT_DROP] THEN
1308   REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN
1309   STRIP_TAC THEN MATCH_MP_TAC(TAUT `b /\ c ==> b /\ (b ==> c)`) THEN
1310   MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN
1311   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
1312    [REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
1313     REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL] THEN ASM SET_TAC[];
1314     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THENL
1315      [MATCH_MP_TAC LIM_EVENTUALLY THEN
1316       REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
1317       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
1318       ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
1319       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
1320       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1321       FIRST_ASSUM(MP_TAC o PART_MATCH (rand o rand)
1322                   TRANSITIVE_STEPWISE_LE_EQ o concl) THEN
1323       ASM_REWRITE_TAC[SUBSET_TRANS; SUBSET_REFL] THEN ASM SET_TAC[];
1324       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN
1325       ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
1326       SIMP_TAC[NOT_EXISTS_THM; IN_UNIV; LIM_CONST]];
1327      RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEASURABLE_INTEGRABLE]) THEN
1328      ASM_SIMP_TAC[INTEGRAL_MEASURE_UNIV] THEN
1329      REWRITE_TAC[bounded; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
1330      EXISTS_TAC `B:real` THEN REWRITE_TAC[IN_UNIV; NORM_LIFT] THEN
1331      REWRITE_TAC[real_abs] THEN ASM_MESON_TAC[MEASURE_POS_LE]]);;
1332
1333 let MEASURABLE_NESTED_UNIONS = prove
1334  (`!s:num->real^N->bool B.
1335         (!n. measurable(s n)) /\
1336         (!n. measure(s n) <= B) /\
1337         (!n. s(n) SUBSET s(SUC n))
1338         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1339   REPEAT GEN_TAC THEN
1340   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_NESTED_UNIONS) THEN
1341   SIMP_TAC[]);;
1342
1343 let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS = prove
1344  (`!s:num->real^N->bool B.
1345         (!n. measurable(s n)) /\
1346         (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\
1347         (!n. sum (0..n) (\k. measure(s k)) <= B)
1348         ==> measurable(UNIONS { s(n) | n IN (:num) }) /\
1349             ((\n. lift(measure(s n))) sums
1350              lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`,
1351   REPEAT GEN_TAC THEN STRIP_TAC THEN
1352   MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real^N->bool`; `B:real`]
1353                HAS_MEASURE_NESTED_UNIONS) THEN
1354   REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN
1355   SUBGOAL_THEN
1356    `!n. (UNIONS (IMAGE s (0..n)):real^N->bool) has_measure
1357         (sum(0..n) (\k. measure(s k)))`
1358   MP_TAC THENL
1359    [GEN_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
1360     ASM_SIMP_TAC[FINITE_NUMSEG];
1361     ALL_TAC] THEN
1362   DISCH_THEN(fun th -> ASSUME_TAC th THEN
1363     ASSUME_TAC(GEN `n:num` (MATCH_MP MEASURE_UNIQUE (SPEC `n:num` th)))) THEN
1364   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
1365    [CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
1366     GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN
1367     MATCH_MP_TAC IMAGE_SUBSET THEN
1368     REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC;
1369     ALL_TAC] THEN
1370   SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
1371   SUBGOAL_THEN
1372    `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real^N->bool =
1373     UNIONS (IMAGE s (:num))`
1374    (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1375               REWRITE_TAC[]) THEN
1376   GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
1377   REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1378   REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN
1379   REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN
1380   REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);;
1381
1382 let NEGLIGIBLE_COUNTABLE_UNIONS_GEN = prove
1383  (`!f. COUNTABLE f /\ (!s:real^N->bool. s IN f ==> negligible s)
1384        ==> negligible(UNIONS f)`,
1385   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1386   ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
1387   ASM_REWRITE_TAC[UNIONS_0; NEGLIGIBLE_EMPTY] THEN
1388   MP_TAC(ISPEC `f:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1389   ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
1390   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
1391   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN ASM_REWRITE_TAC[]);;
1392
1393 let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED = prove
1394  (`!s:num->real^N->bool.
1395         (!n. measurable(s n)) /\
1396         (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\
1397         bounded(UNIONS { s(n) | n IN (:num) })
1398         ==> measurable(UNIONS { s(n) | n IN (:num) }) /\
1399             ((\n. lift(measure(s n))) sums
1400              lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`,
1401   REPEAT GEN_TAC THEN STRIP_TAC THEN
1402   FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
1403   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1404   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
1405   MATCH_MP_TAC HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS THEN
1406   EXISTS_TAC `measure(interval[a:real^N,b])` THEN
1407   ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1408   EXISTS_TAC `measure(UNIONS (IMAGE (s:num->real^N->bool) (0..n)))` THEN
1409   CONJ_TAC THENL
1410    [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
1411     MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
1412     ASM_SIMP_TAC[FINITE_NUMSEG];
1413     MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN
1414     CONJ_TAC THENL
1415      [MATCH_MP_TAC MEASURABLE_UNIONS THEN
1416       ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE];
1417       ASM SET_TAC[]]]);;
1418
1419 let MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove
1420  (`!s:num->real^N->bool.
1421         (!n. measurable(s n)) /\
1422         bounded(UNIONS { s(n) | n IN (:num) })
1423         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1424   REPEAT STRIP_TAC THEN
1425   SUBGOAL_THEN
1426    `UNIONS { s(n):real^N->bool | n IN (:num) } =
1427     UNIONS { UNIONS {s(m) | m IN 0..n} | n IN (:num)}`
1428   SUBST1_TAC THENL
1429    [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
1430     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1431     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1432     REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
1433     REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_UNIONS; IN_ELIM_THM] THEN
1434     REWRITE_TAC[IN_NUMSEG; IN_UNIV; LE_0] THEN MESON_TAC[LE_REFL];
1435     MATCH_MP_TAC MEASURABLE_NESTED_UNIONS THEN
1436     FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
1437     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1438     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
1439     EXISTS_TAC `measure(interval[a:real^N,b])` THEN
1440     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1441      [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN
1442       ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1443       SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG];
1444       DISCH_TAC] THEN
1445     CONJ_TAC THENL
1446      [GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
1447       ASM_REWRITE_TAC[MEASURABLE_INTERVAL] THEN ASM SET_TAC[];
1448       GEN_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; LE_0] THEN SET_TAC[]]]);;
1449
1450 let MEASURE_COUNTABLE_UNIONS_LE_STRONG = prove
1451  (`!d:num->(real^N->bool) B.
1452         (!n. measurable(d n)) /\
1453         (!n. measure(UNIONS {d k | k <= n}) <= B)
1454         ==> measurable(UNIONS {d n | n IN (:num)}) /\
1455             measure(UNIONS {d n | n IN (:num)}) <= B`,
1456   REPEAT GEN_TAC THEN STRIP_TAC THEN
1457   MP_TAC(ISPECL [`\n. UNIONS {(d:num->(real^N->bool)) k | k IN (0..n)}`;
1458                  `B:real`]
1459          HAS_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[] THEN
1460   SUBGOAL_THEN `UNIONS {UNIONS {d k | k IN (0..n)} | n IN (:num)} =
1461                 UNIONS {d n:real^N->bool | n IN (:num)}`
1462   SUBST1_TAC THENL
1463    [GEN_REWRITE_TAC I [EXTENSION] THEN
1464     REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_NUMSEG; LE_0] THEN
1465     MESON_TAC[LE_REFL];
1466     ALL_TAC] THEN
1467   ANTS_TAC THENL
1468    [REPEAT CONJ_TAC THENL
1469      [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN
1470       SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
1471       ASM_REWRITE_TAC[FORALL_IN_IMAGE];
1472       ASM_REWRITE_TAC[IN_NUMSEG; LE_0];
1473       GEN_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN
1474       MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN
1475       REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC];
1476     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1477     GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN
1478     MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN
1479     EXISTS_TAC `\n. lift(measure(UNIONS {d k | k IN 0..n} :real^N->bool))` THEN
1480     ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN
1481     EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
1482     ASM_REWRITE_TAC[LIFT_DROP; IN_NUMSEG; LE_0]]);;
1483
1484 let MEASURE_COUNTABLE_UNIONS_LE = prove
1485  (`!d:num->(real^N->bool) B.
1486         (!n. measurable(d n)) /\
1487         (!n. sum(0..n) (\k. measure(d k)) <= B)
1488         ==> measurable(UNIONS {d n | n IN (:num)}) /\
1489             measure(UNIONS {d n | n IN (:num)}) <= B`,
1490   REPEAT GEN_TAC THEN STRIP_TAC THEN
1491   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN
1492   ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
1493   MP_TAC(ISPECL [`0..n`;`d:num->real^N->bool`] MEASURE_UNIONS_LE_IMAGE) THEN
1494   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
1495   REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `n:num`)) THEN
1496   REWRITE_TAC[GSYM SIMPLE_IMAGE; numseg; LE_0; IN_ELIM_THM] THEN
1497   MESON_TAC[REAL_LE_TRANS]);;
1498
1499 let MEASURABLE_COUNTABLE_UNIONS_STRONG = prove
1500  (`!s:num->real^N->bool B.
1501         (!n. measurable(s n)) /\
1502         (!n. measure(UNIONS {s k | k <= n}) <= B)
1503         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1504   MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE_STRONG; REAL_LE_REFL]);;
1505
1506 let MEASURABLE_COUNTABLE_UNIONS = prove
1507  (`!s:num->real^N->bool B.
1508         (!n. measurable(s n)) /\
1509         (!n. sum (0..n) (\k. measure(s k)) <= B)
1510         ==> measurable(UNIONS { s(n) | n IN (:num) })`,
1511   MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE; REAL_LE_REFL]);;
1512
1513 let MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN = prove
1514  (`!D B. COUNTABLE D /\
1515          (!d:real^N->bool. d IN D ==> measurable d) /\
1516          (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B)
1517          ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`,
1518   REPEAT GEN_TAC THEN
1519   ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL
1520    [ASM_SIMP_TAC[UNIONS_0; MEASURABLE_EMPTY; SUBSET_EMPTY] THEN
1521     MESON_TAC[FINITE_EMPTY];
1522     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1523     MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1524     ASM_REWRITE_TAC[] THEN
1525     DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN
1526     REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_SUBSET_IMAGE] THEN
1527     REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN
1528     ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
1529     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN
1530     ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
1531     FIRST_X_ASSUM(MP_TAC o SPEC `{k:num | k <= n}`) THEN
1532     SIMP_TAC[FINITE_NUMSEG_LE; FINITE_IMAGE] THEN
1533     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
1534     REPLICATE_TAC 3 AP_TERM_TAC THEN SET_TAC[]]);;
1535
1536 let MEASURE_COUNTABLE_UNIONS_LE_GEN = prove
1537  (`!D B. COUNTABLE D /\
1538          (!d:real^N->bool. d IN D ==> measurable d) /\
1539          (!D'. D' SUBSET D /\ FINITE D' ==> sum D' (\d. measure d) <= B)
1540          ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`,
1541   REPEAT GEN_TAC THEN STRIP_TAC THEN
1542   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
1543   ASM_REWRITE_TAC[] THEN X_GEN_TAC `D':(real^N->bool)->bool` THEN
1544   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `D':(real^N->bool)->bool`) THEN
1545   ASM_REWRITE_TAC[] THEN
1546   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
1547   MATCH_MP_TAC MEASURE_UNIONS_LE THEN ASM SET_TAC[]);;
1548
1549 let MEASURABLE_COUNTABLE_INTERS = prove
1550  (`!s:num->real^N->bool.
1551         (!n. measurable(s n))
1552         ==> measurable(INTERS { s(n) | n IN (:num) })`,
1553   REPEAT STRIP_TAC THEN
1554   SUBGOAL_THEN `INTERS { s(n):real^N->bool | n IN (:num) } =
1555                 s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})`
1556   SUBST1_TAC THENL
1557    [GEN_REWRITE_TAC I [EXTENSION] THEN
1558     REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN
1559     REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
1560     ASM SET_TAC[];
1561     ALL_TAC] THEN
1562   MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
1563   MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_STRONG THEN
1564   EXISTS_TAC `measure(s 0:real^N->bool)` THEN
1565   ASM_SIMP_TAC[MEASURABLE_DIFF; LE_0] THEN
1566   GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
1567   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1568    [ALL_TAC;
1569     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN
1570     MESON_TAC[IN_DIFF]] THEN
1571   ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN
1572   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1573   ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
1574                MEASURABLE_DIFF; MEASURABLE_UNIONS]);;
1575
1576 let MEASURABLE_COUNTABLE_INTERS_GEN = prove
1577  (`!D. COUNTABLE D /\ ~(D = {}) /\
1578        (!d:real^N->bool. d IN D ==> measurable d)
1579        ==> measurable(INTERS D)`,
1580   REPEAT STRIP_TAC THEN
1581   MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1582   ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
1583   GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN
1584   ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
1585   MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN ASM SET_TAC[]);;
1586
1587 let MEASURE_COUNTABLE_UNIONS_APPROACHABLE = prove
1588  (`!D B e.
1589         COUNTABLE D /\
1590         (!d. d IN D ==> measurable d) /\
1591         (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B) /\
1592         &0 < e
1593         ==> ?D'. D' SUBSET D /\ FINITE D' /\
1594                  measure(UNIONS D) - e < measure(UNIONS D':real^N->bool)`,
1595   REPEAT GEN_TAC THEN
1596   ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL
1597    [DISCH_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN
1598     ASM_REWRITE_TAC[EMPTY_SUBSET; FINITE_EMPTY; UNIONS_0; MEASURE_EMPTY] THEN
1599     ASM_REAL_ARITH_TAC;
1600     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1601     MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
1602     ASM_REWRITE_TAC[] THEN
1603     DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN
1604     REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE;
1605                 FORALL_SUBSET_IMAGE] THEN
1606     REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN
1607     MP_TAC(ISPECL
1608      [`\n. UNIONS(IMAGE (d:num->real^N->bool) {k | k <= n})`;
1609                    `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN
1610     REWRITE_TAC[] THEN ANTS_TAC THENL
1611      [ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE;
1612                    FINITE_NUMSEG_LE; IN_ELIM_THM] THEN
1613       GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN
1614       MATCH_MP_TAC IMAGE_SUBSET THEN
1615       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC;
1616       ALL_TAC] THEN
1617     SUBGOAL_THEN
1618      `UNIONS {UNIONS (IMAGE d {k | k <= n}) | n IN (:num)}:real^N->bool =
1619       UNIONS (IMAGE d (:num))`
1620     SUBST1_TAC THENL
1621      [REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[UNIONS_GSPEC] THEN
1622       REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EXTENSION] THEN
1623       MESON_TAC[LE_REFL];
1624       ALL_TAC] THEN
1625     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1626     REWRITE_TAC[LIM_SEQUENTIALLY; DIST_REAL; GSYM drop; LIFT_DROP] THEN
1627     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1628     DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
1629     REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN
1630     EXISTS_TAC `{k:num | k <= n}` THEN
1631     SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE] THEN
1632     ASM_SIMP_TAC[REAL_ARITH `abs(x - u) < e /\ &0 < e ==> u - e < x`]]);;
1633
1634 let HAS_MEASURE_NESTED_INTERS = prove
1635  (`!s:num->real^N->bool.
1636         (!n. measurable(s n)) /\
1637         (!n. s(SUC n) SUBSET s(n))
1638         ==> measurable(INTERS {s n | n IN (:num)}) /\
1639             ((\n. lift(measure (s n))) -->
1640                   lift(measure (INTERS {s n | n IN (:num)}))) sequentially`,
1641   GEN_TAC THEN STRIP_TAC THEN
1642   MP_TAC(ISPECL
1643    [`\n. (s:num->real^N->bool) 0 DIFF s n`; `measure(s 0:real^N->bool)`]
1644         HAS_MEASURE_NESTED_UNIONS) THEN
1645   ASM_SIMP_TAC[MEASURABLE_DIFF] THEN ANTS_TAC THENL
1646    [CONJ_TAC THEN X_GEN_TAC `n:num` THENL
1647      [MATCH_MP_TAC MEASURE_SUBSET THEN
1648       ASM_SIMP_TAC[MEASURABLE_DIFF; SUBSET_DIFF] THEN SET_TAC[];
1649       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN SET_TAC[]];
1650     SUBGOAL_THEN
1651      `UNIONS {s 0 DIFF s n | n IN (:num)} =
1652       s 0 DIFF INTERS {s n :real^N->bool | n IN (:num)}`
1653      (fun th -> REWRITE_TAC[th])
1654     THENL [REWRITE_TAC[DIFF_INTERS] THEN SET_TAC[]; ALL_TAC] THEN
1655     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1656      [DISCH_TAC THEN
1657       SUBGOAL_THEN
1658        `measurable(s 0 DIFF (s 0 DIFF INTERS {s n | n IN (:num)})
1659                    :real^N->bool)`
1660       MP_TAC THENL [ASM_SIMP_TAC[MEASURABLE_DIFF]; ALL_TAC] THEN
1661       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
1662        `t SUBSET s ==> s DIFF (s DIFF t) = t`) THEN
1663       REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM] THEN SET_TAC[];
1664
1665       MP_TAC(ISPECL [`sequentially`; `lift(measure(s 0:real^N->bool))`]
1666         LIM_CONST) THEN REWRITE_TAC[IMP_IMP] THEN
1667       DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
1668       REWRITE_TAC[GSYM LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN
1669       AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[LIFT_EQ; FUN_EQ_THM] THEN
1670       REPEAT GEN_TAC THEN
1671       REWRITE_TAC[REAL_ARITH `s - m:real = n <=> m = s - n`] THEN
1672       MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
1673       ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS] THENL
1674        [ALL_TAC; SET_TAC[]] THEN
1675       MP_TAC(ISPEC `\m n:num. (s n :real^N->bool) SUBSET (s m)`
1676           TRANSITIVE_STEPWISE_LE) THEN
1677       ASM_REWRITE_TAC[] THEN
1678       ANTS_TAC THENL [SET_TAC[]; MESON_TAC[LE_0]]]]);;
1679
1680 (* ------------------------------------------------------------------------- *)
1681 (* Measurability of compact and bounded open sets.                           *)
1682 (* ------------------------------------------------------------------------- *)
1683
1684 let MEASURABLE_COMPACT = prove
1685  (`!s:real^N->bool. compact s ==> measurable s`,
1686   let lemma = prove
1687    (`!f s:real^N->bool.
1688           (!n. FINITE(f n)) /\
1689           (!n. s SUBSET UNIONS(f n)) /\
1690           (!x. ~(x IN s) ==> ?n. ~(x IN UNIONS(f n))) /\
1691           (!n a. a IN f(SUC n) ==> ?b. b IN f(n) /\ a SUBSET b) /\
1692           (!n a. a IN f(n) ==> measurable a)
1693           ==> measurable s`,
1694     REPEAT STRIP_TAC THEN
1695     SUBGOAL_THEN `!n. UNIONS(f(SUC n):(real^N->bool)->bool) SUBSET UNIONS(f n)`
1696     ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1697     SUBGOAL_THEN `s = INTERS { UNIONS(f n) | n IN (:num) }:real^N->bool`
1698     SUBST1_TAC THENL
1699      [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
1700       MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
1701       REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN
1702       REWRITE_TAC[IN_IMAGE] THEN ASM SET_TAC[];
1703       MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN
1704       ASM_REWRITE_TAC[] THEN GEN_TAC THEN
1705       MATCH_MP_TAC MEASURABLE_UNIONS THEN
1706       ASM_MESON_TAC[]]) in
1707   REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
1708   EXISTS_TAC
1709    `\n. { k | ?u:real^N. (!i. 1 <= i /\ i <= dimindex(:N)
1710                               ==> integer(u$i)) /\
1711                   k = { x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
1712                                        ==> u$i / &2 pow n <= x$i /\
1713                                            x$i < (u$i + &1) / &2 pow n } /\
1714                   ~(s INTER k = {})}` THEN
1715   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
1716    [X_GEN_TAC `n:num` THEN
1717     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1718     SUBGOAL_THEN
1719      `?N. !x:real^N i. x IN s /\ 1 <= i /\ i <= dimindex(:N)
1720                        ==> abs(x$i * &2 pow n) < &N`
1721     STRIP_ASSUME_TAC THENL
1722      [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
1723       REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN
1724       X_GEN_TAC `B:real` THEN STRIP_TAC THEN
1725       MP_TAC(SPEC `B * &2 pow n` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN
1726       MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN
1727       X_GEN_TAC `N:num` THEN
1728       REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN
1729       SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1730       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS];
1731       ALL_TAC] THEN
1732     MATCH_MP_TAC FINITE_SUBSET THEN
1733     EXISTS_TAC
1734      `IMAGE (\u. {x | !i. 1 <= i /\ i <= dimindex(:N)
1735                           ==> (u:real^N)$i <= (x:real^N)$i * &2 pow n /\
1736                               x$i * &2 pow n < u$i + &1})
1737             {u | !i. 1 <= i /\ i <= dimindex(:N) ==> integer (u$i) /\
1738                                                      abs(u$i) <= &N}` THEN
1739     CONJ_TAC THENL
1740      [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN
1741       REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG];
1742       REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN
1743       X_GEN_TAC `l:real^N->bool` THEN
1744       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN
1745       STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[] THEN
1746       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1747       MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN
1748       ASM_SIMP_TAC[INTEGER_CLOSED] THEN
1749       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1750       DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN
1751       REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
1752       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN
1753       ASM_REWRITE_TAC[] THEN
1754       FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `k:num`]) THEN
1755       ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC];
1756     X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
1757     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1758     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1759     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1760     EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN
1761     ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN
1762     REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA; FLOOR] THEN
1763     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
1764     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `x:real^N` THEN
1765     ASM_REWRITE_TAC[IN_ELIM_THM] THEN
1766     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1767     REWRITE_TAC[REAL_MUL_SYM; FLOOR];
1768     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1769     FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
1770     REWRITE_TAC[closed; open_def] THEN
1771     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
1772     ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
1773     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1774     MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN
1775     ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT;
1776                  DIMINDEX_GE_1; ARITH_RULE `0 < x <=> 1 <= x`] THEN
1777     CONV_TAC REAL_RAT_REDUCE_CONV THEN
1778     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
1779     REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
1780     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1781     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1782     ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN
1783     REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
1784     X_GEN_TAC `u:real^N` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
1785     REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
1786     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o CONJUNCT2) THEN
1787     DISCH_THEN(X_CHOOSE_THEN `y:real^N`
1788      (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
1789     REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1790     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
1791      `d < e ==> x <= d ==> x < e`)) THEN
1792     REWRITE_TAC[dist] THEN
1793     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
1794     MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
1795     GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
1796     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC SUM_BOUND THEN
1797     SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
1798     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1799     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN
1800     ASM_REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
1801     REWRITE_TAC[REAL_MUL_LID; GSYM REAL_POW_INV] THEN REAL_ARITH_TAC;
1802     MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`] THEN
1803     DISCH_THEN(X_CHOOSE_THEN `u:real^N`
1804      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1805     DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN
1806     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1807     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1808     ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN
1809     REWRITE_TAC[UNWIND_THM2] THEN
1810     EXISTS_TAC `(lambda i. floor((u:real^N)$i / &2)):real^N` THEN
1811     ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; FLOOR] THEN
1812     MATCH_MP_TAC(SET_RULE `~(s INTER a = {}) /\ a SUBSET b
1813                            ==> ~(s INTER b = {}) /\ a SUBSET b`) THEN
1814     ASM_REWRITE_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[SUBSET] THEN
1815     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] 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 ASM_REWRITE_TAC[] THEN
1818     REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
1819     REWRITE_TAC[GSYM real_div] THEN
1820     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
1821     MP_TAC(SPEC `(u:real^N)$k / &2` FLOOR) THEN
1822     REWRITE_TAC[REAL_ARITH `u / &2 < floor(u / &2) + &1 <=>
1823                             u < &2 * floor(u / &2) + &2`] THEN
1824     ASM_SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; FLOOR_FRAC] THEN
1825     REAL_ARITH_TAC;
1826     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1827     MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`; `u:real^N`] THEN
1828     DISCH_THEN(SUBST1_TAC o CONJUNCT1 o CONJUNCT2) THEN
1829     ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
1830     GEN_TAC THEN DISCH_TAC THEN
1831     EXISTS_TAC `interval(inv(&2 pow n) % u:real^N,
1832                          inv(&2 pow n) % (u + vec 1))` THEN
1833     EXISTS_TAC `interval[inv(&2 pow n) % u:real^N,
1834                          inv(&2 pow n) % (u + vec 1)]` THEN
1835     REWRITE_TAC[MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN
1836     ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN
1837     REWRITE_TAC[SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN
1838     CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN
1839     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
1840     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1841     ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT;
1842                  VEC_COMPONENT] THEN
1843     REAL_ARITH_TAC]);;
1844
1845 let MEASURABLE_OPEN = prove
1846  (`!s:real^N->bool. bounded s /\ open s ==> measurable s`,
1847   REPEAT STRIP_TAC THEN
1848   FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
1849   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1850   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
1851   FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
1852    `s SUBSET t ==> s = t DIFF (t DIFF s)`)) THEN
1853   MATCH_MP_TAC MEASURABLE_DIFF THEN
1854   REWRITE_TAC[MEASURABLE_INTERVAL] THEN
1855   MATCH_MP_TAC MEASURABLE_COMPACT THEN
1856   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_DIFF; BOUNDED_INTERVAL] THEN
1857   MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]);;
1858
1859 let MEASURE_OPEN_POS_LT = prove
1860  (`!s. open s /\ bounded s /\ ~(s = {}) ==> &0 < measure s`,
1861   MESON_TAC[OPEN_NOT_NEGLIGIBLE; MEASURABLE_MEASURE_POS_LT; MEASURABLE_OPEN]);;
1862
1863 let MEASURABLE_CLOSURE = prove
1864  (`!s. bounded s ==> measurable(closure s)`,
1865   SIMP_TAC[MEASURABLE_COMPACT; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE;
1866            BOUNDED_CLOSURE]);;
1867
1868 let MEASURABLE_INTERIOR = prove
1869  (`!s. bounded s ==> measurable(interior s)`,
1870   SIMP_TAC[MEASURABLE_OPEN; OPEN_INTERIOR; BOUNDED_INTERIOR]);;
1871
1872 let MEASURABLE_FRONTIER = prove
1873  (`!s:real^N->bool. bounded s ==> measurable(frontier s)`,
1874   REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
1875   MATCH_MP_TAC MEASURABLE_DIFF THEN
1876   ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN
1877   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
1878   REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);;
1879
1880 let MEASURE_FRONTIER = prove
1881  (`!s:real^N->bool.
1882         bounded s
1883         ==> measure(frontier s) = measure(closure s) - measure(interior s)`,
1884   REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
1885   MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
1886   ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN
1887   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
1888   REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);;
1889
1890 let MEASURE_CLOSURE = prove
1891  (`!s:real^N->bool.
1892         bounded s /\ negligible(frontier s)
1893         ==> measure(closure s) = measure s`,
1894   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
1895   ASM_SIMP_TAC[MEASURABLE_CLOSURE] THEN
1896   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1897     NEGLIGIBLE_SUBSET)) THEN
1898   MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
1899   MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
1900   REWRITE_TAC[frontier] THEN SET_TAC[]);;
1901
1902 let MEASURE_INTERIOR = prove
1903  (`!s:real^N->bool.
1904         bounded s /\ negligible(frontier s)
1905         ==> measure(interior s) = measure s`,
1906   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
1907   ASM_SIMP_TAC[MEASURABLE_INTERIOR] THEN
1908   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1909     NEGLIGIBLE_SUBSET)) THEN
1910   MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN
1911   MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
1912   REWRITE_TAC[frontier] THEN SET_TAC[]);;
1913
1914 let MEASURABLE_JORDAN = prove
1915  (`!s:real^N->bool. bounded s /\ negligible(frontier s) ==> measurable s`,
1916   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
1917   GEN_TAC THEN DISCH_TAC THEN
1918   EXISTS_TAC `interior(s):real^N->bool` THEN
1919   EXISTS_TAC `closure(s):real^N->bool` THEN
1920   ASM_SIMP_TAC[MEASURABLE_INTERIOR; MEASURABLE_CLOSURE] THEN
1921   REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET] THEN
1922   ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
1923   ASM_SIMP_TAC[GSYM MEASURE_FRONTIER; REAL_ABS_NUM; MEASURE_EQ_0]);;
1924
1925 let HAS_MEASURE_ELEMENTARY = prove
1926  (`!d s. d division_of s ==> s has_measure (sum d content)`,
1927   REPEAT STRIP_TAC THEN REWRITE_TAC[has_measure] THEN
1928   FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
1929   ASM_SIMP_TAC[LIFT_SUM] THEN
1930   MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
1931   ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM has_measure] THEN
1932   ASM_MESON_TAC[HAS_MEASURE_INTERVAL; division_of]);;
1933
1934 let MEASURABLE_ELEMENTARY = prove
1935  (`!d s. d division_of s ==> measurable s`,
1936   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ELEMENTARY]);;
1937
1938 let MEASURE_ELEMENTARY = prove
1939  (`!d s. d division_of s ==> measure s = sum d content`,
1940   MESON_TAC[HAS_MEASURE_ELEMENTARY; MEASURE_UNIQUE]);;
1941
1942 let MEASURABLE_INTER_INTERVAL = prove
1943  (`!s a b:real^N. measurable s ==> measurable (s INTER interval[a,b])`,
1944   SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL]);;
1945
1946 let MEASURABLE_INSIDE = prove
1947  (`!s:real^N->bool. compact s ==> measurable(inside s)`,
1948   SIMP_TAC[MEASURABLE_OPEN; BOUNDED_INSIDE; COMPACT_IMP_CLOSED;
1949            OPEN_INSIDE; COMPACT_IMP_BOUNDED]);;
1950
1951 (* ------------------------------------------------------------------------- *)
1952 (* A nice lemma for negligibility proofs.                                    *)
1953 (* ------------------------------------------------------------------------- *)
1954
1955 let STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE = prove
1956  (`!s. measurable s /\ bounded s /\
1957        (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1)
1958        ==> negligible s`,
1959   REPEAT STRIP_TAC THEN
1960   SUBGOAL_THEN `~(&0 < measure(s:real^N->bool))`
1961    (fun th -> ASM_MESON_TAC[th; MEASURABLE_MEASURE_POS_LT]) THEN
1962   DISCH_TAC THEN
1963   MP_TAC(SPEC `(vec 0:real^N) INSERT s`
1964       BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
1965   ASM_SIMP_TAC[BOUNDED_INSERT; COMPACT_IMP_BOUNDED; NOT_EXISTS_THM] THEN
1966   X_GEN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN
1967   SUBGOAL_THEN
1968    `?N. EVEN N /\ &0 < &N /\
1969         measure(interval[--a:real^N,a])
1970          < (&N * measure(s:real^N->bool)) / &4 pow dimindex (:N)`
1971   STRIP_ASSUME_TAC THENL
1972    [FIRST_ASSUM(MP_TAC o SPEC
1973      `measure(interval[--a:real^N,a]) * &4 pow (dimindex(:N))` o
1974      MATCH_MP REAL_ARCH) THEN
1975     SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
1976     SIMP_TAC[GSYM REAL_LT_LDIV_EQ; ASSUME `&0 < measure(s:real^N->bool)`] THEN
1977     DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
1978     EXISTS_TAC `2 * (N DIV 2 + 1)` THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN
1979     CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN
1980     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
1981      `x < a ==> a <= b ==> x < b`)) THEN
1982     REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC;
1983     ALL_TAC] THEN
1984   MP_TAC(ISPECL [`UNIONS (IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s)
1985                                 (1..N))`;
1986                   `interval[--a:real^N,a]`] MEASURE_SUBSET) THEN
1987   MP_TAC(ISPECL [`measure:(real^N->bool)->real`;
1988                  `IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s) (1..N)`]
1989                 HAS_MEASURE_DISJOINT_UNIONS) THEN
1990   SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMP_CONJ] THEN
1991   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
1992    [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN
1993     MATCH_MP_TAC MEASURABLE_SCALING THEN ASM_REWRITE_TAC[];
1994     ALL_TAC] THEN
1995   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
1996   ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ ~c ==> d <=> a /\ b /\ ~d ==> c`] THEN
1997   SUBGOAL_THEN
1998    `!m n. m IN 1..N /\ n IN 1..N /\
1999           ~(DISJOINT (IMAGE (\x:real^N. &m / &N % x) s)
2000                      (IMAGE (\x. &n / &N % x) s))
2001           ==> m = n`
2002   ASSUME_TAC THENL
2003    [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
2004     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2005     REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN
2006     REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
2007     DISCH_THEN(X_CHOOSE_THEN `x:real^N`
2008      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2009     REWRITE_TAC[IN_IMAGE] THEN
2010     DISCH_THEN(X_CHOOSE_THEN `y:real^N`
2011      (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
2012     DISCH_THEN(MP_TAC o AP_TERM `(%) (&N / &m) :real^N->real^N`) THEN
2013     SUBGOAL_THEN `~(&N = &0) /\ ~(&m = &0)` STRIP_ASSUME_TAC THENL
2014      [REWRITE_TAC[REAL_OF_NUM_EQ] THEN
2015       REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG])) THEN
2016       ARITH_TAC;
2017       ALL_TAC] THEN
2018     FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV)
2019      [GSYM CONTRAPOS_THM]) THEN
2020     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD
2021      `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`] THEN
2022     ASM_SIMP_TAC[REAL_FIELD
2023      `~(x = &0) /\ ~(y = &0) ==> x / y * z / x = z / y`] THEN
2024     REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST_ALL_TAC THEN
2025     FIRST_X_ASSUM(MP_TAC o SPECL [`&n / &m`; `y:real^N`]) THEN
2026     ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_FIELD
2027      `~(y = &0) ==> (x / y = &1 <=> x = y)`] THEN
2028     REWRITE_TAC[REAL_OF_NUM_EQ; EQ_SYM_EQ];
2029     ALL_TAC] THEN
2030   ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN
2031   REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
2032    [REWRITE_TAC[measurable] THEN ASM_MESON_TAC[];
2033     REWRITE_TAC[MEASURABLE_INTERVAL];
2034     REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
2035     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
2036     X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN
2037     DISCH_TAC THEN
2038     MP_TAC(ISPECL [`--a:real^N`; `a:real^N`] CONVEX_INTERVAL) THEN
2039     DISCH_THEN(MP_TAC o REWRITE_RULE[CONVEX_ALT] o CONJUNCT1) THEN
2040     DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `x:real^N`; `&n / &N`]) THEN
2041     ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
2042     DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN
2043     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2044     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN
2045     DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
2046      `1 <= n /\ n <= N ==> 0 < N /\ n <= N`)) THEN
2047     SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT; REAL_LE_LDIV_EQ] THEN
2048     SIMP_TAC[REAL_MUL_LID];
2049     ALL_TAC] THEN
2050   FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN
2051   ASM_SIMP_TAC[MEASURE_SCALING; REAL_NOT_LE] THEN
2052   FIRST_X_ASSUM(K ALL_TAC o SPEC `&0`) THEN
2053   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC
2054    `sum (1..N) (measure o (\m. IMAGE (\x:real^N. &m / &N % x) s))` THEN
2055   CONJ_TAC THENL
2056    [ALL_TAC;
2057     MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
2058     MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[] THEN
2059     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2060     ASM_REWRITE_TAC[SET_RULE `DISJOINT s s <=> s = {}`; IMAGE_EQ_EMPTY] THEN
2061     DISCH_THEN SUBST_ALL_TAC THEN
2062     ASM_MESON_TAC[REAL_LT_REFL; MEASURE_EMPTY]] THEN
2063   FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN
2064   ASM_SIMP_TAC[o_DEF; MEASURE_SCALING; SUM_RMUL] THEN
2065   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2066    `x < a ==> a <= b ==> x < b`)) THEN
2067   ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
2068   ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN
2069   ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN
2070   REWRITE_TAC[GSYM REAL_POW_MUL] THEN
2071   REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN
2072   FIRST_X_ASSUM(X_CHOOSE_THEN `M:num` SUBST_ALL_TAC o
2073         GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
2074   REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
2075   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_MUL]) THEN
2076   RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `&0 < &2 * x <=> &0 < x`]) THEN
2077   ASM_SIMP_TAC[REAL_FIELD `&0 < y ==> x / (&2 * y) * &4 = x * &2 / y`] THEN
2078   MATCH_MP_TAC REAL_LE_TRANS THEN
2079   EXISTS_TAC `sum(M..(2*M)) (\i. (&i * &2 / &M) pow dimindex (:N))` THEN
2080   CONJ_TAC THENL
2081    [ALL_TAC;
2082     MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
2083     SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_DIV; REAL_POS] THEN
2084     REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG; SUBSET] THEN
2085     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_OF_NUM_LT]) THEN
2086     ARITH_TAC] THEN
2087   MATCH_MP_TAC REAL_LE_TRANS THEN
2088   EXISTS_TAC `sum(M..(2*M)) (\i. &2)` THEN CONJ_TAC THENL
2089    [REWRITE_TAC[SUM_CONST_NUMSEG] THEN
2090     REWRITE_TAC[ARITH_RULE `(2 * M + 1) - M = M + 1`] THEN
2091     REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
2092     ALL_TAC] THEN
2093   MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
2094   X_GEN_TAC `n:num` THEN STRIP_TAC THEN
2095   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow (dimindex(:N))` THEN
2096   CONJ_TAC THENL
2097    [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN
2098     MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[DIMINDEX_GE_1] THEN
2099     ARITH_TAC;
2100     ALL_TAC] THEN
2101   MATCH_MP_TAC REAL_POW_LE2 THEN
2102   REWRITE_TAC[REAL_POS; ARITH; real_div; REAL_MUL_ASSOC] THEN
2103   ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN
2104   REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN
2105   UNDISCH_TAC `M:num <= n` THEN ARITH_TAC);;
2106
2107 let STARLIKE_NEGLIGIBLE_LEMMA = prove
2108  (`!s. compact s /\
2109        (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1)
2110        ==> negligible s`,
2111   REPEAT STRIP_TAC THEN
2112   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE THEN
2113   ASM_MESON_TAC[MEASURABLE_COMPACT; COMPACT_IMP_BOUNDED]);;
2114
2115 let STARLIKE_NEGLIGIBLE = prove
2116  (`!s a. closed s /\
2117          (!c x:real^N. &0 <= c /\ (a + x) IN s /\ (a + c % x) IN s ==> c = &1)
2118          ==> negligible s`,
2119   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN
2120   EXISTS_TAC `--a:real^N` THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
2121   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
2122   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_LEMMA THEN CONJ_TAC THENL
2123    [MATCH_MP_TAC CLOSED_INTER_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN
2124     ASM_SIMP_TAC[CLOSED_TRANSLATION];
2125     REWRITE_TAC[IN_IMAGE; IN_INTER] THEN
2126     ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> y = a + x`] THEN
2127     REWRITE_TAC[UNWIND_THM2] THEN ASM MESON_TAC[]]);;
2128
2129 let STARLIKE_NEGLIGIBLE_STRONG = prove
2130  (`!s a. closed s /\
2131          (!c x:real^N. &0 <= c /\ c < &1 /\ (a + x) IN s
2132                        ==> ~((a + c % x) IN s))
2133          ==> negligible s`,
2134   REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
2135   EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
2136   MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN
2137   MATCH_MP_TAC(REAL_ARITH `~(x < y) /\ ~(y < x) ==> x = y`) THEN
2138   STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
2139   FIRST_X_ASSUM(MP_TAC o SPECL [`inv c:real`; `c % x:real^N`]) THEN
2140   ASM_REWRITE_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN
2141   ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < c ==> ~(c = &0)`] THEN
2142   ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
2143   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN
2144   MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);;
2145
2146 (* ------------------------------------------------------------------------- *)
2147 (* In particular.                                                            *)
2148 (* ------------------------------------------------------------------------- *)
2149
2150 let NEGLIGIBLE_HYPERPLANE = prove
2151  (`!a b. ~(a = vec 0 /\ b = &0) ==> negligible {x:real^N | a dot x = b}`,
2152   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
2153   ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | F} = {}`; NEGLIGIBLE_EMPTY] THEN
2154   MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
2155   SUBGOAL_THEN `?x:real^N. ~(a dot x = b)` MP_TAC THENL
2156    [MATCH_MP_TAC(MESON[] `!a:real^N. P a \/ P(--a) ==> ?x. P x`) THEN
2157     EXISTS_TAC `a:real^N` THEN REWRITE_TAC[DOT_RNEG] THEN
2158     MATCH_MP_TAC(REAL_ARITH `~(a = &0) ==> ~(a = b) \/ ~(--a = b)`) THEN
2159     ASM_REWRITE_TAC[DOT_EQ_0];
2160     ALL_TAC] THEN
2161   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
2162   REWRITE_TAC[CLOSED_HYPERPLANE; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN
2163   MAP_EVERY X_GEN_TAC [`t:real`; `y:real^N`] THEN
2164   DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2165    `&0 <= t /\ ac + ay = b /\ ac + t * ay = b
2166     ==> ((ay = &0 ==> ac = b) /\ (t - &1) * ay = &0)`)) THEN
2167   ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0] THEN CONV_TAC TAUT);;
2168
2169 let NEGLIGIBLE_LOWDIM = prove
2170  (`!s:real^N->bool. dim(s) < dimindex(:N) ==> negligible s`,
2171   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
2172   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
2173   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2174   EXISTS_TAC `span(s):real^N->bool` THEN REWRITE_TAC[SPAN_INC] THEN
2175   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2176   EXISTS_TAC `{x:real^N | a dot x = &0}` THEN
2177   ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);;
2178
2179 let NEGLIGIBLE_AFFINE_HULL = prove
2180  (`!s:real^N->bool.
2181         FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(affine hull s)`,
2182   REWRITE_TAC[IMP_CONJ] THEN  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2183   REWRITE_TAC[AFFINE_HULL_EMPTY; NEGLIGIBLE_EMPTY] THEN
2184   SUBGOAL_THEN
2185    `!x s:real^N->bool n.
2186         ~(x IN s) /\ (x INSERT s) HAS_SIZE n /\ n <= dimindex(:N)
2187         ==> negligible(affine hull(x INSERT s))`
2188    (fun th -> MESON_TAC[th; HAS_SIZE; FINITE_INSERT]) THEN
2189   X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN
2190   SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN
2191   REWRITE_TAC[HAS_SIZE; FINITE_INSERT; IMP_CONJ] THEN
2192   SIMP_TAC[CARD_CLAUSES] THEN
2193   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
2194   MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN
2195   ASM_SIMP_TAC[DIM_LE_CARD; DIM_SPAN] THEN ASM_ARITH_TAC);;
2196
2197 let NEGLIGIBLE_AFFINE_HULL_1 = prove
2198  (`!a:real^1. negligible (affine hull {a})`,
2199   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN
2200   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN
2201   ARITH_TAC);;
2202
2203 let NEGLIGIBLE_AFFINE_HULL_2 = prove
2204  (`!a b:real^2. negligible (affine hull {a,b})`,
2205   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN
2206   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN
2207   ARITH_TAC);;
2208
2209 let NEGLIGIBLE_AFFINE_HULL_3 = prove
2210  (`!a b c:real^3. negligible (affine hull {a,b,c})`,
2211   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN
2212   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN
2213   ARITH_TAC);;
2214
2215 let NEGLIGIBLE_CONVEX_HULL = prove
2216  (`!s:real^N->bool.
2217         FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(convex hull s)`,
2218   REPEAT GEN_TAC THEN
2219   DISCH_THEN(MP_TAC o MATCH_MP NEGLIGIBLE_AFFINE_HULL) THEN
2220   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
2221   REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL]);;
2222
2223 let NEGLIGIBLE_CONVEX_HULL_1 = prove
2224  (`!a:real^1. negligible (convex hull {a})`,
2225   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
2226   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN
2227   ARITH_TAC);;
2228
2229 let NEGLIGIBLE_CONVEX_HULL_2 = prove
2230  (`!a b:real^2. negligible (convex hull {a,b})`,
2231   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
2232   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN
2233   ARITH_TAC);;
2234
2235 let NEGLIGIBLE_CONVEX_HULL_3 = prove
2236  (`!a b c:real^3. negligible (convex hull {a,b,c})`,
2237   REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
2238   SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN
2239   ARITH_TAC);;
2240
2241 (* ------------------------------------------------------------------------- *)
2242 (* Measurability of bounded convex sets.                                     *)
2243 (* ------------------------------------------------------------------------- *)
2244
2245 let NEGLIGIBLE_CONVEX_FRONTIER = prove
2246  (`!s:real^N->bool. convex s ==> negligible(frontier s)`,
2247   SUBGOAL_THEN
2248    `!s:real^N->bool. convex s /\ (vec 0) IN s ==> negligible(frontier s)`
2249   ASSUME_TAC THENL
2250    [ALL_TAC;
2251     X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
2252     ASM_CASES_TAC `s:real^N->bool = {}` THEN
2253     ASM_REWRITE_TAC[FRONTIER_EMPTY; NEGLIGIBLE_EMPTY] THEN
2254     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
2255     DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
2256     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN
2257     ASM_SIMP_TAC[CONVEX_TRANSLATION; IN_IMAGE] THEN
2258     ASM_REWRITE_TAC[UNWIND_THM2;
2259                     VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
2260     REWRITE_TAC[FRONTIER_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ]] THEN
2261   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIM_SUBSET_UNIV) THEN
2262   REWRITE_TAC[ARITH_RULE `d:num <= e <=> d < e \/ d = e`] THEN STRIP_TAC THENL
2263    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2264     EXISTS_TAC `closure s:real^N->bool` THEN
2265     REWRITE_TAC[frontier; SUBSET_DIFF] THEN
2266     MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_REWRITE_TAC[DIM_CLOSURE];
2267     ALL_TAC] THEN
2268   SUBGOAL_THEN `?a:real^N. a IN interior s` CHOOSE_TAC THENL
2269    [X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
2270      (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
2271     FIRST_X_ASSUM SUBST_ALL_TAC THEN
2272     MP_TAC(ISPEC `b:real^N->bool` INTERIOR_SIMPLEX_NONEMPTY) THEN
2273     ASM_REWRITE_TAC[] THEN
2274     MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM SUBSET] THEN
2275     MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN
2276     ASM_REWRITE_TAC[INSERT_SUBSET];
2277     ALL_TAC] THEN
2278   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN
2279   EXISTS_TAC `a:real^N` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
2280   REPEAT GEN_TAC THEN STRIP_TAC THEN
2281   REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN
2282   SIMP_TAC[VECTOR_ARITH
2283    `a + c % x:real^N = (a + x) - (&1 - c) % ((a + x) - a)`] THEN
2284   MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN
2285   RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
2286   ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;
2287
2288 let MEASURABLE_CONVEX = prove
2289  (`!s:real^N->bool. convex s /\ bounded s ==> measurable s`,
2290   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_JORDAN THEN
2291   ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER]);;
2292
2293 let NEGLIGIBLE_CONVEX_INTERIOR = prove
2294  (`!s:real^N->bool. convex s ==> (negligible s <=> interior s = {})`,
2295   REPEAT STRIP_TAC THEN EQ_TAC THENL
2296    [MESON_TAC[OPEN_NOT_NEGLIGIBLE; INTERIOR_SUBSET; OPEN_INTERIOR;
2297               NEGLIGIBLE_SUBSET];
2298     DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2299     EXISTS_TAC `frontier s:real^N->bool` THEN
2300     ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER] THEN
2301     ASM_REWRITE_TAC[frontier; DIFF_EMPTY; CLOSURE_SUBSET]]);;
2302
2303 (* ------------------------------------------------------------------------- *)
2304 (* Various special cases.                                                    *)
2305 (* ------------------------------------------------------------------------- *)
2306
2307 let NEGLIGIBLE_SPHERE = prove
2308  (`!a:real^N r. negligible (sphere(a,e))`,
2309   REWRITE_TAC[GSYM FRONTIER_CBALL] THEN
2310   SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);;
2311
2312 let MEASURABLE_BALL = prove
2313  (`!a r. measurable(ball(a,r))`,
2314   SIMP_TAC[MEASURABLE_OPEN; BOUNDED_BALL; OPEN_BALL]);;
2315
2316 let MEASURABLE_CBALL = prove
2317  (`!a r. measurable(cball(a,r))`,
2318   SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CBALL]);;
2319
2320 let MEASURE_BALL_POS = prove
2321  (`!x:real^N e. &0 < e ==> &0 < measure(ball(x,e))`,
2322   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_OPEN_POS_LT THEN
2323   REWRITE_TAC[OPEN_BALL; BOUNDED_BALL; BALL_EQ_EMPTY] THEN
2324   ASM_REAL_ARITH_TAC);;
2325
2326 let MEASURE_CBALL_POS = prove
2327  (`!x:real^N e. &0 < e ==> &0 < measure(cball(x,e))`,
2328   MESON_TAC[MEASURE_SUBSET; REAL_LTE_TRANS; MEASURABLE_BALL; MEASURABLE_CBALL;
2329             BALL_SUBSET_CBALL; MEASURE_BALL_POS]);;
2330
2331 let HAS_INTEGRAL_OPEN_INTERVAL = prove
2332  (`!f a b y. (f has_integral y) (interval(a,b)) <=>
2333              (f has_integral y) (interval[a,b])`,
2334   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INTERIOR_CLOSED_INTERVAL] THEN
2335   MATCH_MP_TAC HAS_INTEGRAL_INTERIOR THEN
2336   MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN
2337   REWRITE_TAC[CONVEX_INTERVAL]);;
2338
2339 let INTEGRABLE_ON_OPEN_INTERVAL = prove
2340  (`!f a b. f integrable_on interval(a,b) <=>
2341            f integrable_on interval[a,b]`,
2342   REWRITE_TAC[integrable_on; HAS_INTEGRAL_OPEN_INTERVAL]);;
2343
2344 let INTEGRAL_OPEN_INTERVAL = prove
2345  (`!f a b. integral(interval(a,b)) f = integral(interval[a,b]) f`,
2346   REWRITE_TAC[integral; HAS_INTEGRAL_OPEN_INTERVAL]);;
2347
2348 (* ------------------------------------------------------------------------- *)
2349 (* An existence theorem for "improper" integrals. Hake's theorem implies     *)
2350 (* that if the integrals over subintervals have a limit then the integral    *)
2351 (* exists. This is incomparable: we only need a priori to assume that        *)
2352 (* the integrals are bounded, and we get absolute integrability, but we      *)
2353 (* also need a (rather weak) bound assumption on the function.               *)
2354 (* ------------------------------------------------------------------------- *)
2355
2356 let ABSOLUTELY_INTEGRABLE_IMPROPER = prove
2357  (`!net:A net f:real^M->real^N a b.
2358      (!c d. interval[c,d] SUBSET interval(a,b)
2359             ==> f integrable_on interval[c,d]) /\
2360      bounded { integral (interval[c,d]) f |
2361                interval[c,d] SUBSET interval(a,b)} /\
2362      (!i. 1 <= i /\ i <= dimindex(:N)
2363           ==> ?g. g absolutely_integrable_on interval[a,b] /\
2364                   ((!x. x IN interval[a,b] ==> (f x)$i <= drop(g x)) \/
2365                    (!x. x IN interval[a,b] ==> (f x)$i >= drop(g x))))
2366    ==> f absolutely_integrable_on interval[a,b]`,
2367   REPEAT GEN_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN
2368   ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_NULL] THEN
2369   RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONTENT_LT_NZ; CONTENT_POS_LT_EQ]) THEN
2370   STRIP_TAC THEN
2371   ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN
2372   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
2373   FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[real_ge] THEN
2374   SUBGOAL_THEN
2375    `(!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET
2376          interval(a:real^M,b)) /\
2377     (!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET
2378          interval[a:real^M,b])`
2379   STRIP_ASSUME_TAC THENL
2380    [REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(SET_RULE
2381      `s SUBSET t /\ t SUBSET u ==> s SUBSET t /\ s SUBSET u`) THEN
2382     REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN
2383     REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_THEN(K ALL_TAC) THEN
2384     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
2385                 VECTOR_SUB_COMPONENT] THEN
2386     ASM_SIMP_TAC[REAL_ARITH `a < a + x <=> &0 < x`;
2387                  REAL_ARITH `b - x < b <=> &0 < x`; REAL_LT_MUL;
2388                  REAL_SUB_LT; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`];
2389     ALL_TAC] THEN
2390   SUBGOAL_THEN
2391    `!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET
2392         interval[a + inv(&(SUC n) + &1) % (b - a):real^M,
2393                  b - inv(&(SUC n) + &1) % (b - a)]`
2394   ASSUME_TAC THENL
2395    [REWRITE_TAC[SUBSET_INTERVAL] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
2396     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
2397                 VECTOR_SUB_COMPONENT] THEN
2398     REWRITE_TAC[REAL_ARITH `a + x * y <= a + w * y <=> &0 <= (w - x) * y`;
2399                 REAL_ARITH `b - w * y <= b - x * y <=> &0 <= (w - x) * y`] THEN
2400     REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
2401     ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE; GSYM REAL_OF_NUM_SUC] THEN
2402     MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC;
2403     ALL_TAC] THEN
2404   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^1` STRIP_ASSUME_TAC) THENL
2405    [MATCH_MP_TAC
2406      ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN
2407     EXISTS_TAC `g:real^M->real^1` THEN
2408     ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN
2409     ASM_REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP] THEN
2410     SUBGOAL_THEN
2411      `(\x. lift((f:real^M->real^N) x$i)) = (\x. g x - (g x - lift(f x$i)))`
2412     SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN
2413     MATCH_MP_TAC INTEGRABLE_SUB THEN
2414     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
2415     MP_TAC(ISPECL
2416      [`\n x. if x IN interval[a + inv(&n + &1) % (b - a),
2417                               b - inv(&n + &1) % (b - a)]
2418              then g x - lift((f:real^M->real^N) x $i) else vec 0`;
2419       `\x. g x - lift((f:real^M->real^N) x$i)`;
2420       `interval(a:real^M,b)`] MONOTONE_CONVERGENCE_INCREASING) THEN
2421     REWRITE_TAC[] THEN ANTS_TAC THENL
2422      [ALL_TAC; SIMP_TAC[INTEGRABLE_ON_OPEN_INTERVAL]] THEN
2423     REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN
2424     ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN
2425     CONJ_TAC THENL
2426      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL
2427        [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL;
2428                       ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE];
2429         RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN
2430         ASM_MESON_TAC[]];
2431       ALL_TAC];
2432     MATCH_MP_TAC
2433      ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN
2434     EXISTS_TAC `g:real^M->real^1` THEN
2435     ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN
2436     ASM_REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP] THEN
2437     SUBGOAL_THEN
2438      `(\x. lift((f:real^M->real^N) x$i)) = (\x. (lift(f x$i) - g x) + g x)`
2439     SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN
2440     MATCH_MP_TAC INTEGRABLE_ADD THEN
2441     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
2442     MP_TAC(ISPECL
2443      [`\n x. if x IN interval[a + inv(&n + &1) % (b - a),
2444                               b - inv(&n + &1) % (b - a)]
2445              then lift((f:real^M->real^N) x $i) - g x else vec 0`;
2446       `\x. lift((f:real^M->real^N) x$i) - g x`;
2447       `interval(a:real^M,b)`] MONOTONE_CONVERGENCE_INCREASING) THEN
2448     REWRITE_TAC[] THEN ANTS_TAC THENL
2449      [ALL_TAC; SIMP_TAC[INTEGRABLE_ON_OPEN_INTERVAL]] THEN
2450     REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN
2451     ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN
2452     CONJ_TAC THENL
2453      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL
2454        [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN
2455         ASM_MESON_TAC[];
2456         ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL;
2457                       ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]];
2458       ALL_TAC]] THEN
2459   (REPEAT CONJ_TAC THENL
2460     [REPEAT STRIP_TAC THEN
2461      REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN
2462      ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; LIFT_DROP] THEN
2463      ASM SET_TAC[];
2464      X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN
2465      DISCH_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MP_TAC(SPEC
2466       `inf({(x - a:real^M)$i / (b - a)$i | i IN 1..dimindex(:M)} UNION
2467            {(b - x:real^M)$i / (b - a)$i | i IN 1..dimindex(:M)})`
2468        REAL_ARCH_INV) THEN
2469      SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
2470               IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1;
2471               FINITE_UNION; IMAGE_UNION; EMPTY_UNION] THEN
2472      REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_IMAGE] THEN
2473      SIMP_TAC[VECTOR_SUB_COMPONENT; IN_NUMSEG; EVENTUALLY_SEQUENTIALLY] THEN
2474      ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_RDIV_EQ; REAL_MUL_LZERO] THEN
2475      MATCH_MP_TAC MONO_EXISTS THEN
2476      X_GEN_TAC `N:num` THEN STRIP_TAC THEN
2477      X_GEN_TAC `n:num` THEN DISCH_TAC THEN
2478      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
2479      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
2480      MATCH_MP_TAC(MESON[] `(!x. ~P x) ==> (?x. P x) ==> Q`) THEN
2481      X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN STRIP_TAC THEN
2482      REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
2483                  VECTOR_MUL_COMPONENT; REAL_ARITH
2484             `a + y <= x /\ x <= b - y <=> y <= x - a /\ y <= b - x`] THEN
2485      ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
2486      CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2487      EXISTS_TAC `inv(&N)` THEN
2488      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT; REAL_LT_IMP_LE] THEN
2489      MATCH_MP_TAC REAL_LE_INV2 THEN
2490      ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1] THEN
2491      ASM_ARITH_TAC;
2492      FIRST_ASSUM(MP_TAC o MATCH_MP
2493        ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN
2494      DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_INTEGRALS_OVER_SUBINTERVALS) THEN
2495      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
2496      REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC; IN_UNIV] THEN
2497      DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
2498      DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
2499      EXISTS_TAC `B + C:real` THEN ASM_SIMP_TAC[REAL_LT_ADD] THEN
2500      RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN
2501      GEN_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) INTEGRAL_SUB o
2502        rand o lhand o snd) THEN
2503      ASM_SIMP_TAC[] THEN ANTS_TAC THENL
2504       [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL;
2505                      ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE];
2506        DISCH_THEN SUBST1_TAC]])
2507   THENL
2508    [MATCH_MP_TAC(NORM_ARITH
2509        `norm(x:real^N) <= c /\ norm(y) <= b ==> norm(x - y) <= b + c`);
2510     MATCH_MP_TAC(NORM_ARITH
2511        `norm(x:real^N) <= c /\ norm(y) <= b ==> norm(x - y) <= c + b`)] THEN
2512   ASM_SIMP_TAC[] THEN IMP_REWRITE_TAC[GSYM LIFT_INTEGRAL_COMPONENT] THEN
2513   RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTEGRABLE_COMPONENTWISE]) THEN
2514   ASM_SIMP_TAC[NORM_LIFT] THEN
2515   W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN
2516   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[]);;
2517
2518 (* ------------------------------------------------------------------------- *)
2519 (* Crude upper bounds for measure of balls.                                  *)
2520 (* ------------------------------------------------------------------------- *)
2521
2522 let MEASURE_CBALL_BOUND = prove
2523  (`!x:real^N d.
2524         &0 <= d ==> measure(cball(x,d)) <= (&2 * d) pow (dimindex(:N))`,
2525   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2526   EXISTS_TAC `measure(interval[x - d % vec 1:real^N,x + d % vec 1])` THEN
2527   CONJ_TAC THENL
2528    [MATCH_MP_TAC MEASURE_SUBSET THEN
2529     REWRITE_TAC[MEASURABLE_CBALL; MEASURABLE_INTERVAL] THEN
2530     REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN
2531     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; dist] THEN
2532     REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
2533     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
2534     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
2535     MP_TAC(ISPECL [`x - y:real^N`; `i:num`] COMPONENT_LE_NORM) THEN
2536     ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC;
2537     SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
2538     COND_CASES_TAC THEN
2539     ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_POS] THEN
2540     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
2541     REWRITE_TAC[REAL_ARITH `(x + a) - (x - a):real = &2 * a`] THEN
2542     REWRITE_TAC[PRODUCT_CONST_NUMSEG; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
2543     REWRITE_TAC[REAL_MUL_RID; ADD_SUB; REAL_LE_REFL]]);;
2544
2545 let MEASURE_BALL_BOUND = prove
2546  (`!x:real^N d.
2547         &0 <= d ==> measure(ball(x,d)) <= (&2 * d) pow (dimindex(:N))`,
2548   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2549   EXISTS_TAC `measure(cball(x:real^N,d))` THEN
2550   ASM_SIMP_TAC[MEASURE_CBALL_BOUND] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
2551   REWRITE_TAC[BALL_SUBSET_CBALL; MEASURABLE_BALL; MEASURABLE_CBALL]);;
2552
2553 (* ------------------------------------------------------------------------- *)
2554 (* Negligibility of image under non-injective linear map.                    *)
2555 (* ------------------------------------------------------------------------- *)
2556
2557 let NEGLIGIBLE_LINEAR_SINGULAR_IMAGE = prove
2558  (`!f:real^N->real^N s.
2559         linear f /\ ~(!x y. f(x) = f(y) ==> x = y)
2560         ==> negligible(IMAGE f s)`,
2561   REPEAT GEN_TAC THEN
2562   DISCH_THEN(MP_TAC o MATCH_MP LINEAR_SINGULAR_IMAGE_HYPERPLANE) THEN
2563   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
2564   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
2565   EXISTS_TAC `{x:real^N | a dot x = &0}` THEN
2566   ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);;
2567
2568 (* ------------------------------------------------------------------------- *)
2569 (* Some technical lemmas used in the approximation results that follow.      *)
2570 (* Proof of the covering lemma is an obvious multidimensional generalization *)
2571 (* of Lemma 3, p65 of Swartz's "Introduction to Gauge Integrals".            *)
2572 (* ------------------------------------------------------------------------- *)
2573
2574 let COVERING_LEMMA = prove
2575  (`!a b:real^N s g.
2576         s SUBSET interval[a,b] /\ ~(interval(a,b) = {}) /\ gauge g
2577         ==> ?d. COUNTABLE d /\
2578                 (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\
2579                                 (?c d. k = interval[c,d])) /\
2580                 (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
2581                          ==> interior k1 INTER interior k2 = {}) /\
2582                 (!k. k IN d ==> ?x. x IN (s INTER k) /\ k SUBSET g(x)) /\
2583                 (!u v. interval[u,v] IN d
2584                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2585                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2586                 s SUBSET UNIONS d`,
2587   REPEAT STRIP_TAC THEN
2588   SUBGOAL_THEN
2589    `?d. COUNTABLE d /\
2590         (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\
2591                         (?c d:real^N. k = interval[c,d])) /\
2592         (!k1 k2. k1 IN d /\ k2 IN d
2593                  ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/
2594                      interior k1 INTER interior k2 = {}) /\
2595         (!x. x IN s ==> ?k. k IN d /\ x IN k /\ k SUBSET g(x)) /\
2596         (!u v. interval[u,v] IN d
2597                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2598                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2599         (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l})`
2600   ASSUME_TAC THENL
2601    [EXISTS_TAC
2602      `IMAGE (\(n,v).
2603              interval[(lambda i. a$i + &(v$i) / &2 pow n *
2604                                        ((b:real^N)$i - (a:real^N)$i)):real^N,
2605                       (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))])
2606             {n,v | n IN (:num) /\
2607                    v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N)
2608                                        ==> v$i < 2 EXP n}}` THEN
2609     CONJ_TAC THENL
2610      [MATCH_MP_TAC COUNTABLE_IMAGE THEN
2611       MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
2612       REWRITE_TAC[NUM_COUNTABLE; IN_UNIV] THEN
2613       GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN
2614       MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
2615       ALL_TAC] THEN
2616     CONJ_TAC THENL
2617      [REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
2618       MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
2619       REWRITE_TAC[IN_ELIM_PAIR_THM] THEN
2620       REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
2621       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
2622       REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN
2623       SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; LAMBDA_BETA] THEN
2624       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2625       ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LE_MUL_EQ;
2626                    REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_LE_ADDR; REAL_ARITH
2627                      `a + x * (b - a) <= b <=> &0 <= (&1 - x) * (b - a)`] THEN
2628       SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_DIV2_EQ; REAL_LT_POW2] THEN
2629       REWRITE_TAC[REAL_ARITH `x <= x + &1 /\ x < x + &1`] THEN
2630       REWRITE_TAC[REAL_SUB_LE] THEN
2631       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
2632       REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID] THEN
2633       SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
2634       ASM_SIMP_TAC[ARITH_RULE `x + 1 <= y <=> x < y`; REAL_LT_IMP_LE];
2635       ALL_TAC] THEN
2636     CONJ_TAC THENL
2637      [ONCE_REWRITE_TAC[IMP_CONJ] THEN
2638       REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; RIGHT_FORALL_IMP_THM] THEN
2639       REWRITE_TAC[IN_ELIM_PAIR_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN
2640       REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
2641       GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
2642       MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
2643        [REPEAT GEN_TAC THEN
2644         GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN
2645         REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[];
2646         ALL_TAC] THEN
2647       MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
2648       MAP_EVERY X_GEN_TAC [`v:num^N`; `w:num^N`] THEN REPEAT DISCH_TAC THEN
2649       REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; SUBSET_INTERVAL] THEN
2650       SIMP_TAC[DISJOINT_INTERVAL; LAMBDA_BETA] THEN
2651       MATCH_MP_TAC(TAUT `p \/ q \/ r ==> (a ==> p) \/ (b ==> q) \/ r`) THEN
2652       ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN
2653       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2654       ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; LAMBDA_BETA] THEN
2655       REWRITE_TAC[NOT_IMP; REAL_LE_LADD] THEN
2656       ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
2657       REWRITE_TAC[REAL_ARITH `~(x + &1 <= x)`] THEN DISJ2_TAC THEN
2658       MATCH_MP_TAC(MESON[]
2659        `(!i. ~P i ==> Q i) ==> (!i. Q i) \/ (?i. P i)`) THEN
2660       X_GEN_TAC `i:num` THEN
2661       DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
2662       ASM_REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN
2663       UNDISCH_TAC `m:num <= n` THEN REWRITE_TAC[LE_EXISTS] THEN
2664       DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN
2665       ONCE_REWRITE_TAC[ADD_SYM] THEN
2666       REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
2667       REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
2668       ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2; REAL_LT_DIV2_EQ] THEN
2669       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2;
2670                    REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN
2671       SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC;
2672       ALL_TAC] THEN
2673     CONJ_TAC THENL
2674      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2675       SUBGOAL_THEN
2676         `?e. &0 < e /\ !y. (!i. 1 <= i /\ i <= dimindex(:N)
2677                                 ==> abs((x:real^N)$i - (y:real^N)$i) <= e)
2678                            ==> y IN g(x)`
2679       STRIP_ASSUME_TAC THENL
2680        [FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [gauge]) THEN
2681         STRIP_TAC THEN
2682         FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
2683         DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
2684         DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2685         EXISTS_TAC `e / &2 / &(dimindex(:N))` THEN
2686         ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
2687                      ARITH] THEN
2688         X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
2689         MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN
2690         EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[IN_BALL] THEN
2691         MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
2692         ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2693         EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN
2694         REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
2695         ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT;
2696                      DIMINDEX_GE_1; VECTOR_SUB_COMPONENT; CARD_NUMSEG_1];
2697         ALL_TAC] THEN
2698       REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2699       MP_TAC(SPECL [`&1 / &2`; `e / norm(b - a:real^N)`]
2700         REAL_ARCH_POW_INV) THEN
2701       SUBGOAL_THEN `&0 < norm(b - a:real^N)` ASSUME_TAC THENL
2702        [ASM_MESON_TAC[VECTOR_SUB_EQ; NORM_POS_LT; INTERVAL_SING]; ALL_TAC] THEN
2703       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
2704       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
2705       REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN DISCH_TAC THEN
2706       SIMP_TAC[IN_ELIM_THM; IN_INTERVAL; SUBSET; LAMBDA_BETA] THEN
2707       MATCH_MP_TAC(MESON[]
2708        `(!x. Q x ==> R x) /\ (?x. P x /\ Q x) ==> ?x. P x /\ Q x /\ R x`) THEN
2709       CONJ_TAC THENL
2710        [REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
2711         MAP_EVERY X_GEN_TAC [`w:num^N`; `y:real^N`] THEN
2712         REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
2713         DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
2714         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
2715         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
2716         ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2717          `(a + n <= x /\ x <= a + m) /\
2718           (a + n <= y /\ y <= a + m) ==> abs(x - y) <= m - n`)) THEN
2719         MATCH_MP_TAC(REAL_ARITH
2720          `y * z <= e
2721           ==> a <= ((x + &1) * y) * z - ((x * y) * z) ==> a <= e`) THEN
2722         RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2723         ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
2724         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2725         (REAL_ARITH `n < e * x ==> &0 <= e * (inv y - x) ==> n <= e / y`)) THEN
2726         MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
2727         REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
2728         ASM_SIMP_TAC[REAL_SUB_LT] THEN
2729         MP_TAC(SPECL [`b - a:real^N`; `i:num`] COMPONENT_LE_NORM) THEN
2730         ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
2731         ALL_TAC] THEN
2732       REWRITE_TAC[IN_UNIV; AND_FORALL_THM] THEN
2733       REWRITE_TAC[TAUT `(a ==> c) /\ (a ==> b) <=> a ==> b /\ c`] THEN
2734       REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN
2735       STRIP_TAC THEN
2736       SUBGOAL_THEN `(x:real^N) IN interval[a,b]` MP_TAC THENL
2737        [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN
2738       DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
2739       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN STRIP_TAC THEN
2740       DISJ_CASES_TAC(MATCH_MP (REAL_ARITH `x <= y ==> x = y \/ x < y`)
2741        (ASSUME `(x:real^N)$i <= (b:real^N)$i`))
2742       THENL
2743        [EXISTS_TAC `2 EXP n - 1` THEN
2744         SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_LT;
2745                  EXP_LT_0; LE_1; ARITH] THEN
2746         ASM_REWRITE_TAC[REAL_SUB_ADD; REAL_ARITH `a - &1 < a`] THEN
2747         MATCH_MP_TAC(REAL_ARITH
2748          `&1 * (b - a) = x /\ y <= x ==> a + y <= b /\ b <= a + x`) THEN
2749         ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_LE_RMUL_EQ;
2750                      REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
2751         SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_MUL_RINV; REAL_POW_EQ_0;
2752                  REAL_OF_NUM_EQ; ARITH_EQ] THEN REAL_ARITH_TAC;
2753         ALL_TAC] THEN
2754       MP_TAC(SPEC `&2 pow n * ((x:real^N)$i - (a:real^N)$i) /
2755                               ((b:real^N)$i - (a:real^N)$i)` FLOOR_POS) THEN
2756       ANTS_TAC THENL
2757        [ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_MUL; REAL_POW_LE; REAL_POS;
2758                       REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_DIV];
2759         ALL_TAC] THEN
2760       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
2761       REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
2762       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
2763       REWRITE_TAC[REAL_ARITH `a + b * c <= x /\ x <= a + b' * c <=>
2764                               b * c <= x - a /\ x - a <= b' * c`] THEN
2765       ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
2766                    REAL_SUB_LT; GSYM real_div] THEN
2767       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2768       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
2769       SIMP_TAC[FLOOR; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2770       EXISTS_TAC `((x:real^N)$i - (a:real^N)$i) /
2771                   ((b:real^N)$i - (a:real^N)$i) *
2772                   &2 pow n` THEN
2773       REWRITE_TAC[FLOOR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2774       ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN
2775       ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_SUB_LT] THEN
2776       ASM_REAL_ARITH_TAC;
2777       ALL_TAC] THEN
2778     CONJ_TAC THENL
2779      [REPEAT GEN_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN
2780       REWRITE_TAC[EQ_INTERVAL; IN_ELIM_PAIR_THM] THEN
2781       REWRITE_TAC[INTERVAL_EQ_EMPTY; IN_UNIV; IN_ELIM_THM] THEN
2782       SIMP_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`; LAMBDA_BETA] THEN
2783       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2784       ASM_SIMP_TAC[REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_SUB_LT;
2785                    REAL_LT_DIV2_EQ; REAL_LT_POW2;
2786                    REAL_ARITH `~(v + &1 < v)`] THEN
2787       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
2788       STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC;
2789       ALL_TAC] THEN
2790     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2791     MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
2792     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
2793     MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC
2794      `IMAGE (\(n,v).
2795             interval[(lambda i. a$i + &(v$i) / &2 pow n *
2796                                       ((b:real^N)$i - (a:real^N)$i)):real^N,
2797                      (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))])
2798             {m,v | m IN 0..n /\
2799                    v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N)
2800                                        ==> v$i < 2 EXP m}}` THEN
2801     CONJ_TAC THENL
2802      [MATCH_MP_TAC FINITE_IMAGE THEN
2803       MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
2804       REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN
2805       MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
2806       ALL_TAC] THEN
2807     GEN_REWRITE_TAC I [SUBSET] THEN
2808     REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
2809     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2810     MAP_EVERY X_GEN_TAC [`m:num`; `w:num^N`] THEN DISCH_TAC THEN
2811     DISCH_TAC THEN SIMP_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
2812     MAP_EVERY EXISTS_TAC [`m:num`; `w:num^N`] THEN ASM_REWRITE_TAC[] THEN
2813     REWRITE_TAC[IN_NUMSEG; GSYM NOT_LT; LT] THEN DISCH_TAC THEN
2814     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN
2815     SIMP_TAC[NOT_IMP; LAMBDA_BETA] THEN
2816     RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
2817     ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
2818     ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
2819     REWRITE_TAC[REAL_ARITH `x <= x + &1`] THEN
2820     DISCH_THEN(MP_TAC o SPEC `1`) THEN
2821     REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN
2822     DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2823      `w / m <= v / n /\ (v + &1) / n <= (w + &1) / m
2824       ==> inv n <= inv m`)) THEN
2825     REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
2826     ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN
2827     ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
2828     ALL_TAC] THEN
2829   SUBGOAL_THEN
2830    `?d. COUNTABLE d /\
2831         (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\
2832                         (?c d:real^N. k = interval[c,d])) /\
2833         (!k1 k2. k1 IN d /\ k2 IN d
2834                  ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/
2835                      interior k1 INTER interior k2 = {}) /\
2836         (!k. k IN d ==> (?x. x IN s INTER k /\ k SUBSET g x)) /\
2837         (!u v. interval[u,v] IN d
2838                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
2839                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
2840         (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l}) /\
2841         s SUBSET UNIONS d`
2842   MP_TAC THENL
2843    [FIRST_X_ASSUM(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
2844     EXISTS_TAC
2845      `{k:real^N->bool | k IN d /\ ?x. x IN (s INTER k) /\ k SUBSET g x}` THEN
2846     ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
2847      [MATCH_MP_TAC COUNTABLE_SUBSET THEN
2848       EXISTS_TAC `d:(real^N->bool)->bool` THEN
2849       ASM_REWRITE_TAC[] THEN SET_TAC[];
2850       X_GEN_TAC `k:real^N->bool` THEN REPEAT STRIP_TAC THEN
2851       MATCH_MP_TAC FINITE_SUBSET THEN
2852       EXISTS_TAC `{l:real^N->bool | l IN d /\ k SUBSET l}` THEN
2853       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
2854       ASM SET_TAC[]];
2855     ALL_TAC] THEN
2856   DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
2857   EXISTS_TAC
2858    `{k:real^N->bool | k IN d /\ !k'. k' IN d /\ ~(k = k')
2859                                      ==> ~(k SUBSET k')}` THEN
2860   ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
2861    [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN
2862     ASM_REWRITE_TAC[] THEN SET_TAC[];
2863     ASM SET_TAC[];
2864     ALL_TAC] THEN
2865   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2866    (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
2867   GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN
2868   MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN
2869   REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
2870   MP_TAC(ISPEC `\k l:real^N->bool. k IN d /\ l IN d /\ l SUBSET k /\ ~(k = l)`
2871      WF_FINITE) THEN
2872   REWRITE_TAC[WF] THEN ANTS_TAC THENL
2873    [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN
2874     ASM_CASES_TAC `(l:real^N->bool) IN d` THEN
2875     ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES] THEN
2876     MATCH_MP_TAC FINITE_SUBSET THEN
2877     EXISTS_TAC `{m:real^N->bool | m IN d /\ l SUBSET m}` THEN
2878     ASM_SIMP_TAC[] THEN SET_TAC[];
2879     ALL_TAC] THEN
2880   DISCH_THEN(MP_TAC o SPEC `\l:real^N->bool. l IN d /\ x IN l`) THEN
2881   REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2882   MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);;
2883
2884 let COUNTABLE_ELEMENTARY_DIVISION = prove
2885  (`!d. COUNTABLE d /\ (!k. k IN d ==> ?a b:real^N. k = interval[a,b])
2886        ==> ?d'. COUNTABLE d' /\
2887                 (!k. k IN d' ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\
2888                 (!k l. k IN d' /\ l IN d' /\ ~(k = l)
2889                        ==> interior k INTER interior l = {}) /\
2890                 UNIONS d' = UNIONS d`,
2891   let lemma = prove
2892    (`!s. UNIONS(s DELETE {}) = UNIONS s`,
2893     REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN
2894     MESON_TAC[NOT_IN_EMPTY]) in
2895   REWRITE_TAC[IMP_CONJ; FORALL_COUNTABLE_AS_IMAGE] THEN
2896   REWRITE_TAC[UNIONS_0; EMPTY_UNIONS] THEN CONJ_TAC THENL
2897    [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN
2898     REWRITE_TAC[NOT_IN_EMPTY; COUNTABLE_EMPTY];
2899     ALL_TAC] THEN
2900   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
2901   MAP_EVERY X_GEN_TAC
2902    [`d:num->real^N->bool`; `a:num->real^N`; `b:num->real^N`] THEN
2903   DISCH_TAC THEN
2904   (CHOOSE_THEN MP_TAC o prove_recursive_functions_exist num_RECURSION)
2905    `x 0 = ({}:(real^N->bool)->bool) /\
2906     (!n. x(SUC n) = @q. (x n) SUBSET q /\
2907                         q division_of (d n) UNION UNIONS(x n))` THEN
2908   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
2909   SUBGOAL_THEN
2910    `!n:num. (x n) division_of UNIONS {d k:real^N->bool | k < n}`
2911   ASSUME_TAC THENL
2912    [INDUCT_TAC THEN
2913     ASM_REWRITE_TAC[LT; SET_RULE `UNIONS {f x |x| F} = {}`;
2914                     DIVISION_OF_TRIVIAL] THEN
2915     FIRST_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o
2916       MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o
2917       MATCH_MP DIVISION_OF_UNION_SELF) THEN
2918     DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN
2919     REWRITE_TAC[SET_RULE `{f x | x = a \/ q x} = f a INSERT {f x | q x}`] THEN
2920     REWRITE_TAC[UNIONS_INSERT] THEN
2921     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN
2922     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM o last o CONJUNCTS) THEN
2923     ASM_REWRITE_TAC[];
2924     ALL_TAC] THEN
2925   SUBGOAL_THEN
2926    `!m n. m <= n ==> (x:num->(real^N->bool)->bool) m SUBSET x n`
2927   ASSUME_TAC THENL
2928    [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
2929     REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN
2930     ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
2931     FIRST_X_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o
2932       MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o
2933       MATCH_MP DIVISION_OF_UNION_SELF o SPEC `n:num`) THEN
2934     DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[];
2935     ALL_TAC] THEN
2936   EXISTS_TAC `UNIONS(IMAGE x (:num)) DELETE ({}:real^N->bool)` THEN
2937   REWRITE_TAC[COUNTABLE_DELETE; IMP_CONJ; RIGHT_FORALL_IMP_THM;
2938               FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV] THEN
2939   REPEAT CONJ_TAC THENL
2940    [MATCH_MP_TAC COUNTABLE_UNIONS THEN
2941     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN
2942     GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN
2943     ASM_MESON_TAC[DIVISION_OF_FINITE];
2944     MAP_EVERY X_GEN_TAC [`n:num`; `k:real^N->bool`] THEN
2945     ASM_MESON_TAC[division_of];
2946     REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
2947     GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
2948     MATCH_MP_TAC WLOG_LE THEN
2949     CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN
2950     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
2951     MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
2952     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
2953     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2954     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o
2955       SPEC `n:num`) THEN ASM SET_TAC[];
2956     REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
2957     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV;
2958                 FORALL_IN_UNIONS; SUBSET; IN_UNIONS; EXISTS_IN_IMAGE]
2959     THENL
2960      [X_GEN_TAC `k:real^N->bool` THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
2961       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2962       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o
2963          SPEC `n:num`) THEN
2964       DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN ASM SET_TAC[];
2965       MAP_EVERY X_GEN_TAC [`n:num`; `y:real^N`] THEN DISCH_TAC THEN
2966       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o
2967          SPEC `SUC n`) THEN
2968       DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
2969       REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC] THEN
2970       DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
2971       ASM_MESON_TAC[ARITH_RULE `n < SUC n`]]]);;
2972
2973 let EXPAND_CLOSED_OPEN_INTERVAL = prove
2974  (`!a b:real^N e.
2975         &0 < e
2976         ==> ?c d. interval[a,b] SUBSET interval(c,d) /\
2977                   measure(interval(c,d)) <= measure(interval[a,b]) + e`,
2978   let lemma = prove
2979    (`!f n. (\x. lift(product(1..n) (\i. f i + drop x))) continuous at (vec 0)`,
2980     GEN_TAC THEN INDUCT_TAC THEN
2981     REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH_EQ; CONTINUOUS_CONST] THEN
2982     REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN
2983     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN
2984     MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[] THEN
2985     REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP] THEN
2986     SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_CONST]) in
2987   REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
2988   POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `m:real^N` THEN
2989   REWRITE_TAC[midpoint; VECTOR_ARITH
2990    `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
2991   REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN
2992   DISCH_TAC THEN ASM_CASES_TAC `interval[--b:real^N,b] = {}` THENL
2993    [MAP_EVERY EXISTS_TAC [`--b:real^N`; `b:real^N`] THEN
2994     REWRITE_TAC[MEASURE_INTERVAL] THEN
2995     ASM_REWRITE_TAC[CONTENT_EMPTY; EMPTY_SUBSET] THEN ASM_REAL_ARITH_TAC;
2996     ALL_TAC] THEN
2997   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN
2998   REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= x <=> &0 <= x`] THEN
2999   DISCH_TAC THEN
3000   MP_TAC(ISPECL [`\i. &2 * (b:real^N)$i`; `dimindex(:N)`] lemma) THEN
3001   REWRITE_TAC[continuous_at; DIST_LIFT; FORALL_LIFT; DIST_0; DROP_VEC] THEN
3002   REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ADD_RID] THEN
3003   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
3004   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
3005   MAP_EVERY EXISTS_TAC
3006    [`--(b + k / &4 % vec 1:real^N)`; `b + k / &4 % vec 1:real^N`] THEN
3007   REWRITE_TAC[MEASURE_INTERVAL; SUBSET_INTERVAL;
3008               CONTENT_CLOSED_INTERVAL_CASES] THEN
3009   REWRITE_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
3010               VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
3011   ASM_SIMP_TAC[REAL_ARITH `--x <= x <=> &0 <= x`; REAL_LT_ADDR;
3012                REAL_ARITH `&0 < k / &4 <=> &0 < k`;
3013                REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < b`;
3014                REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < --b`;
3015                REAL_ARITH `&0 <= b /\ &0 < k ==> &0 <= b + k`] THEN
3016   REWRITE_TAC[REAL_ARITH `b - --b = &2 * b`; REAL_ADD_LDISTRIB] THEN
3017   MATCH_MP_TAC(REAL_ARITH `abs(a - b) < e ==> a <= b + e`) THEN
3018   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);;
3019
3020 (* ------------------------------------------------------------------------- *)
3021 (* Outer and inner approximation of measurable set by well-behaved sets.     *)
3022 (* ------------------------------------------------------------------------- *)
3023
3024 let MEASURABLE_OUTER_INTERVALS_BOUNDED = prove
3025  (`!s a b:real^N e.
3026         measurable s /\ s SUBSET interval[a,b] /\ &0 < e
3027         ==> ?d. COUNTABLE d /\
3028                 (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\
3029                                 (?c d. k = interval[c,d])) /\
3030                 (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
3031                          ==> interior k1 INTER interior k2 = {}) /\
3032                 (!u v. interval[u,v] IN d
3033                        ==> ?n. !i. 1 <= i /\ i <= dimindex(:N)
3034                                    ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\
3035                 (!k. k IN d /\ ~(interval(a,b) = {}) ==> ~(interior k = {})) /\
3036                 s SUBSET UNIONS d /\
3037                 measurable (UNIONS d) /\
3038                 measure (UNIONS d) <= measure s + e`,
3039   let lemma = prove
3040    (`(!x y. (x,y) IN IMAGE (\z. f z,g z) s ==> P x y) <=>
3041      (!z. z IN s ==> P (f z) (g z))`,
3042   REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN MESON_TAC[]) in
3043   REPEAT GEN_TAC THEN
3044   ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
3045    [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN
3046     EXISTS_TAC `{}:(real^N->bool)->bool` THEN
3047     ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0; MEASURE_EMPTY; REAL_ADD_LID;
3048                     SUBSET_REFL; COUNTABLE_EMPTY; MEASURABLE_EMPTY] THEN
3049     ASM_SIMP_TAC[REAL_LT_IMP_LE];
3050     ALL_TAC] THEN
3051   STRIP_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN
3052   ASM_REWRITE_TAC[] THENL
3053    [EXISTS_TAC `{interval[a:real^N,b]}` THEN
3054     REWRITE_TAC[UNIONS_1; COUNTABLE_SING] THEN
3055     ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT;
3056                     NOT_IN_EMPTY; SUBSET_REFL; MEASURABLE_INTERVAL] THEN
3057     CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
3058      [ASM_REWRITE_TAC[IN_SING; EQ_INTERVAL] THEN
3059       REPEAT STRIP_TAC THEN EXISTS_TAC `0` THEN
3060       ASM_REWRITE_TAC[real_pow; REAL_DIV_1];
3061       SUBGOAL_THEN
3062        `measure(interval[a:real^N,b]) = &0 /\ measure(s:real^N->bool) = &0`
3063        (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE; REAL_ADD_LID]) THEN
3064       SUBGOAL_THEN
3065         `interval[a:real^N,b] has_measure &0 /\
3066          (s:real^N->bool) has_measure &0`
3067         (fun th -> MESON_TAC[th; MEASURE_UNIQUE]) THEN
3068       REWRITE_TAC[HAS_MEASURE_0] THEN
3069       MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
3070        [ASM_REWRITE_TAC[NEGLIGIBLE_INTERVAL];
3071         ASM_MESON_TAC[NEGLIGIBLE_SUBSET]]];
3072     ALL_TAC] THEN
3073   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN
3074   DISCH_THEN(X_CHOOSE_TAC `m:real`) THEN
3075   FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_UNIQUE) THEN
3076   SUBGOAL_THEN
3077    `((\x:real^N. if x IN s then vec 1 else vec 0) has_integral (lift m))
3078     (interval[a,b])`
3079   ASSUME_TAC THENL
3080    [ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
3081     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE]) THEN
3082     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN
3083     ASM SET_TAC[];
3084     ALL_TAC] THEN
3085   FIRST_ASSUM(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN
3086   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN
3087   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
3088   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN
3089   MP_TAC(SPECL [`a:real^N`; `b:real^N`; `s:real^N->bool`;
3090                 `g:real^N->real^N->bool`] COVERING_LEMMA) THEN
3091   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
3092   X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
3093   CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_EMPTY]; ALL_TAC] THEN
3094   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
3095   MP_TAC(ISPECL [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`;
3096                  `a:real^N`; `b:real^N`; `g:real^N->real^N->bool`;
3097                  `e:real`]
3098                 HENSTOCK_LEMMA_PART1) THEN
3099   ASM_REWRITE_TAC[] THEN
3100   FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN
3101   ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN
3102   SUBGOAL_THEN
3103    `!k l:real^N->bool. k IN d /\ l IN d /\ ~(k = l)
3104                        ==> negligible(k INTER l)`
3105   ASSUME_TAC THENL
3106    [REPEAT STRIP_TAC THEN
3107     FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`]) THEN
3108     ASM_SIMP_TAC[] THEN
3109     SUBGOAL_THEN
3110      `?x y:real^N u v:real^N. k = interval[x,y] /\ l = interval[u,v]`
3111     MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
3112     DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
3113     REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN
3114     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3115     EXISTS_TAC `(interval[x:real^N,y] DIFF interval(x,y)) UNION
3116                 (interval[u:real^N,v] DIFF interval(u,v)) UNION
3117                 (interval (x,y) INTER interval (u,v))` THEN
3118     CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
3119     ASM_REWRITE_TAC[UNION_EMPTY] THEN
3120     SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_FRONTIER_INTERVAL];
3121     ALL_TAC] THEN
3122   SUBGOAL_THEN
3123    `!D. FINITE D /\ D SUBSET d
3124          ==> measurable(UNIONS D :real^N->bool) /\ measure(UNIONS D) <= m + e`
3125   ASSUME_TAC THENL
3126    [GEN_TAC THEN STRIP_TAC THEN
3127     SUBGOAL_THEN
3128      `?t:(real^N->bool)->real^N. !k. k IN D ==> t(k) IN (s INTER k) /\
3129                                                 k SUBSET (g(t k))`
3130     (CHOOSE_THEN (LABEL_TAC "+")) THENL
3131      [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN
3132     REMOVE_THEN "*" (MP_TAC o SPEC
3133      `IMAGE (\k. (t:(real^N->bool)->real^N) k,k) D`) THEN
3134     ASM_SIMP_TAC[VSUM_IMAGE; PAIR_EQ] THEN REWRITE_TAC[o_DEF] THEN
3135     ANTS_TAC THENL
3136      [REWRITE_TAC[tagged_partial_division_of; fine] THEN
3137       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
3138       REWRITE_TAC[lemma; RIGHT_FORALL_IMP_THM; IMP_CONJ; PAIR_EQ] THEN
3139       ASM_SIMP_TAC[] THEN
3140       CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET]];
3141       ALL_TAC] THEN
3142     USE_THEN "+" (MP_TAC o REWRITE_RULE[IN_INTER]) THEN
3143     SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
3144     ASM_SIMP_TAC[VSUM_SUB] THEN
3145     SUBGOAL_THEN `D division_of (UNIONS D:real^N->bool)` ASSUME_TAC THENL
3146      [REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN
3147     FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_ELEMENTARY) THEN
3148     SUBGOAL_THEN `vsum D (\k:real^N->bool. content k % vec 1) =
3149                   lift(measure(UNIONS D))`
3150     SUBST1_TAC THENL
3151      [ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN
3152       ASM_SIMP_TAC[LIFT_DROP; DROP_VSUM; o_DEF; DROP_CMUL; DROP_VEC] THEN
3153       SIMP_TAC[REAL_MUL_RID; ETA_AX] THEN ASM_MESON_TAC[MEASURE_ELEMENTARY];
3154       ALL_TAC] THEN
3155     SUBGOAL_THEN
3156      `vsum D (\k. integral k (\x:real^N. if x IN s then vec 1 else vec 0)) =
3157       lift(sum D (\k. measure(k INTER s)))`
3158     SUBST1_TAC THENL
3159      [ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN
3160       X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
3161       SUBGOAL_THEN `measurable(k:real^N->bool)` ASSUME_TAC THENL
3162        [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN
3163       ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE_UNIV; MEASURABLE_INTER] THEN
3164       REWRITE_TAC[MESON[IN_INTER]
3165         `(if x IN k INTER s then a else b) =
3166          (if x IN k then if x IN s then a else b else b)`] THEN
3167       REWRITE_TAC[INTEGRAL_RESTRICT_UNIV];
3168       ALL_TAC] THEN
3169     ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
3170     MATCH_MP_TAC(REAL_ARITH `y <= m ==> abs(x - y) <= e ==> x <= m + e`) THEN
3171     MATCH_MP_TAC REAL_LE_TRANS THEN
3172     EXISTS_TAC `measure(UNIONS D INTER s:real^N->bool)` THEN
3173     CONJ_TAC THENL
3174      [ALL_TAC;
3175       EXPAND_TAC "m" THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3176       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
3177       MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[]] THEN
3178     REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
3179     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN
3180     MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
3181     ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL
3182      [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_INTER];
3183       ALL_TAC] THEN
3184     MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
3185     STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3186     EXISTS_TAC `k INTER l:real^N->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[];
3187     ALL_TAC] THEN
3188   ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
3189    [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
3190   MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
3191   ASM_REWRITE_TAC[INFINITE] THEN
3192   DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
3193    (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
3194   MP_TAC(ISPECL [`s:num->real^N->bool`; `m + e:real`]
3195     HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
3196   MATCH_MP_TAC(TAUT `a /\ (a /\ b ==> c) ==> (a ==> b) ==> c`) THEN
3197   REWRITE_TAC[GSYM CONJ_ASSOC] THEN
3198   RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
3199                               FORALL_IN_IMAGE; IN_UNIV]) THEN
3200   RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
3201   REPEAT CONJ_TAC THENL
3202    [ASM_MESON_TAC[MEASURABLE_INTERVAL; MEASURABLE_INTER];
3203     ASM_MESON_TAC[];
3204     X_GEN_TAC `n:num` THEN
3205     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (s:num->real^N->bool) (0..n)`) THEN
3206     SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_SUBSET; SUBSET_UNIV] THEN
3207     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3208     MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= e ==> y <= e`) THEN
3209     MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
3210     ASM_MESON_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL];
3211     ALL_TAC] THEN
3212   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
3213   GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN
3214   REWRITE_TAC[drop] THEN
3215   MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_UBOUND) THEN
3216   EXISTS_TAC
3217    `\n. vsum(from 0 INTER (0..n)) (\n. lift(measure(s n:real^N->bool)))` THEN
3218   ASM_REWRITE_TAC[GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
3219   REWRITE_TAC[DIMINDEX_1; ARITH; EVENTUALLY_SEQUENTIALLY] THEN
3220   SIMP_TAC[VSUM_COMPONENT; ARITH; DIMINDEX_1] THEN
3221   ASM_REWRITE_TAC[GSYM drop; LIFT_DROP; FROM_INTER_NUMSEG]);;
3222
3223 let MEASURABLE_OUTER_CLOSED_INTERVALS = prove
3224  (`!s:real^N->bool e.
3225         measurable s /\ &0 < e
3226         ==> ?d. COUNTABLE d /\
3227                 (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval[a,b])) /\
3228                 (!k l. k IN d /\ l IN d /\ ~(k = l)
3229                        ==> interior k INTER interior l = {}) /\
3230                 s SUBSET UNIONS d /\
3231                 measurable (UNIONS d) /\
3232                 measure (UNIONS d) <= measure s + e`,
3233   let lemma = prove
3234    (`UNIONS (UNIONS {d n | n IN (:num)}) =
3235      UNIONS {UNIONS(d n) | n IN (:num)}`,
3236     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN
3237     GEN_REWRITE_TAC I [EXTENSION] THEN
3238     REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]) in
3239   REPEAT STRIP_TAC THEN
3240   SUBGOAL_THEN
3241    `?d. COUNTABLE d /\
3242         (!k. k IN d ==> ?a b:real^N. k = interval[a,b]) /\
3243         s SUBSET UNIONS d /\
3244         measurable (UNIONS d) /\
3245         measure (UNIONS d) <= measure s + e`
3246   MP_TAC THENL
3247    [ALL_TAC;
3248     DISCH_THEN(X_CHOOSE_THEN `d1:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3249     MP_TAC(ISPEC `d1:(real^N->bool)->bool` COUNTABLE_ELEMENTARY_DIVISION) THEN
3250     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
3251     X_GEN_TAC `d:(real^N->bool)->bool` THEN
3252     STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
3253     ASM_REWRITE_TAC[]] THEN
3254   MP_TAC(ISPECL
3255    [`\n. s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`;
3256     `measure(s:real^N->bool)`] HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
3257   ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN
3258   SUBGOAL_THEN
3259    `!m n. ~(m = n)
3260           ==> (s INTER (ball(vec 0,&m + &1) DIFF ball(vec 0,&m))) INTER
3261               (s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n))) =
3262               ({}:real^N->bool)`
3263   ASSUME_TAC THENL
3264    [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN
3265     CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN
3266     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN
3267     MATCH_MP_TAC(SET_RULE
3268      `m1 SUBSET n
3269       ==> (s INTER (m1 DIFF m)) INTER (s INTER (n1 DIFF n)) = {}`) THEN
3270     MATCH_MP_TAC SUBSET_BALL THEN
3271     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC;
3272     ALL_TAC] THEN
3273   ANTS_TAC THENL
3274    [ASM_SIMP_TAC[NEGLIGIBLE_EMPTY] THEN X_GEN_TAC `n:num` THEN
3275     W(MP_TAC o PART_MATCH (rand o rand)
3276       MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN
3277     ASM_SIMP_TAC[FINITE_NUMSEG; DISJOINT] THEN
3278     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN
3279     DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3280     SIMP_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; FORALL_IN_IMAGE;
3281              RIGHT_FORALL_IMP_THM; IN_INTER] THEN
3282     ASM_SIMP_TAC[MEASURABLE_UNIONS; FINITE_NUMSEG; FORALL_IN_IMAGE;
3283             FINITE_IMAGE; MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL];
3284     ALL_TAC] THEN
3285   SUBGOAL_THEN
3286    `UNIONS {s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n)) | n IN (:num)} =
3287     (s:real^N->bool)`
3288   ASSUME_TAC THENL
3289    [REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_INTER] THEN
3290     X_GEN_TAC `x:real^N` THEN
3291     ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
3292     SUBGOAL_THEN `?n. (x:real^N) IN ball(vec 0,&n)` MP_TAC THENL
3293      [REWRITE_TAC[IN_BALL_0; REAL_ARCH_LT];
3294       GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
3295       DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THENL
3296        [ASM_REWRITE_TAC[IN_BALL_0; GSYM REAL_NOT_LE; NORM_POS_LE];
3297         STRIP_TAC THEN EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_DIFF] THEN
3298         ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN
3299         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
3300     ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN
3301   MP_TAC(MATCH_MP MONO_FORALL (GEN `n:num`
3302    (ISPECL
3303      [`s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`;
3304       `--(vec(n + 1)):real^N`; `vec(n + 1):real^N`;
3305       `e / &2 / &2 pow n`]
3306         MEASURABLE_OUTER_INTERVALS_BOUNDED))) THEN
3307   ANTS_TAC THENL
3308    [ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_LT_POW2] THEN
3309     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN
3310     REWRITE_TAC[SUBSET; IN_INTER; IN_INTERVAL; IN_BALL_0; IN_DIFF; REAL_NOT_LT;
3311       REAL_OF_NUM_ADD; VECTOR_NEG_COMPONENT; VEC_COMPONENT; REAL_BOUNDS_LE] THEN
3312     MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; REAL_LT_IMP_LE];
3313     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN
3314   X_GEN_TAC `d:num->(real^N->bool)->bool` THEN STRIP_TAC THEN
3315   EXISTS_TAC `UNIONS {d n | n IN (:num)} :(real^N->bool)->bool` THEN
3316   REWRITE_TAC[lemma] THEN CONJ_TAC THENL
3317    [MATCH_MP_TAC COUNTABLE_UNIONS THEN
3318     ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
3319     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE];
3320     ALL_TAC] THEN
3321   CONJ_TAC THENL
3322    [REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3323     ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_MESON_TAC[];
3324     ALL_TAC] THEN
3325   CONJ_TAC THENL
3326    [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
3327     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3328     ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IN_UNIONS] THEN
3329     REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[];
3330     ALL_TAC] THEN
3331   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN
3332   X_GEN_TAC `n:num` THEN
3333   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
3334    `sum(0..n) (\k. measure(s INTER (ball(vec 0:real^N,&k + &1) DIFF
3335                                   ball(vec 0,&k))) + e / &2 / &2 pow k)` THEN
3336   ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN
3337   MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
3338    [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o
3339       lhand o snd) THEN
3340     ASM_SIMP_TAC[DISJOINT; FINITE_NUMSEG; MEASURABLE_DIFF; MEASURABLE_INTER;
3341                  MEASURABLE_BALL] THEN
3342     DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3343     ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_NUMSEG;
3344       FINITE_IMAGE; MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_BALL] THEN
3345     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
3346     MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SIMPLE_IMAGE] THEN
3347     MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV];
3348     REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP; LT] THEN
3349     REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3350     REWRITE_TAC[REAL_ARITH `e / &2 * (&1 - x) / (&1 / &2) <= e <=>
3351                             &0 <= e * x`] THEN
3352     MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
3353     MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]);;
3354
3355 let MEASURABLE_OUTER_OPEN_INTERVALS = prove
3356  (`!s:real^N->bool e.
3357         measurable s /\ &0 < e
3358         ==> ?d. COUNTABLE d /\
3359                 (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval(a,b))) /\
3360                 s SUBSET UNIONS d /\
3361                 measurable (UNIONS d) /\
3362                 measure (UNIONS d) <= measure s + e`,
3363   let lemma = prove
3364    (`!s. UNIONS(s DELETE {}) = UNIONS s`,
3365     REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN
3366     MESON_TAC[NOT_IN_EMPTY]) in
3367   REPEAT STRIP_TAC THEN
3368   MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`]
3369     MEASURABLE_OUTER_CLOSED_INTERVALS) THEN
3370   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
3371   X_GEN_TAC `dset:(real^N->bool)->bool` THEN
3372   ASM_CASES_TAC `dset:(real^N->bool)->bool = {}` THENL
3373    [ASM_REWRITE_TAC[UNIONS_0; SUBSET_EMPTY] THEN STRIP_TAC THEN
3374     EXISTS_TAC `{}:(real^N->bool)->bool` THEN
3375     ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY; MEASURE_EMPTY; SUBSET_REFL] THEN
3376     ASM_REAL_ARITH_TAC;
3377     ALL_TAC] THEN
3378   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3379   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3380   SUBGOAL_THEN
3381    `?f. dset = IMAGE (f:num->(real^N->bool)) (:num) DELETE {} /\
3382         (!m n. f m = f n ==> m = n \/ f n = {})`
3383   MP_TAC THENL
3384    [ASM_CASES_TAC `FINITE(dset:(real^N->bool)->bool)` THENL
3385      [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_HAS_SIZE]) THEN
3386       DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_INDEX) THEN
3387       ABBREV_TAC `m = CARD(dset:(real^N->bool)->bool)` THEN
3388       DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
3389       EXISTS_TAC `\i. if i < m then (f:num->real^N->bool) i else {}` THEN
3390       REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
3391       GEN_REWRITE_TAC I [EXTENSION] THEN
3392       REWRITE_TAC[IN_DELETE; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[];
3393       MP_TAC(ISPEC `dset:(real^N->bool)->bool`
3394         COUNTABLE_AS_INJECTIVE_IMAGE) THEN
3395       ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN
3396       GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL
3397        [ALL_TAC; ASM_MESON_TAC[]] THEN
3398       ASM_REWRITE_TAC[SET_RULE `s = s DELETE a <=> ~(a IN s)`] THEN
3399       ASM_MESON_TAC[]];
3400     ALL_TAC] THEN
3401   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3402   X_GEN_TAC `d:num->real^N->bool` THEN
3403   DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN
3404   FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN
3405   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM; SKOLEM_THM;
3406               IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DELETE; lemma] THEN
3407   DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
3408    `(!x. ~(P x) ==> ~(P x) /\ Q x) ==> (!x. P x ==> Q x) ==> !x. Q x`)) THEN
3409   ANTS_TAC THENL [MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN
3410   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3411   MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN
3412   DISCH_TAC THEN DISCH_TAC THEN
3413   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
3414   GEN_REWRITE_TAC I [IMP_CONJ] THEN
3415   DISCH_THEN(MP_TAC o MATCH_MP(MESON[]
3416    `(!x y. ~(P x) /\ ~(P y) /\ ~(f x = f y) ==> Q x y)
3417     ==> (!x y. P x ==> Q x y) /\ (!x y. P y ==> Q x y)
3418         ==> (!x y. ~(f x = f y) ==> Q x y)`)) THEN
3419   SIMP_TAC[INTERIOR_EMPTY; INTER_EMPTY] THEN
3420   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
3421   SUBGOAL_THEN
3422    `?d. COUNTABLE d /\
3423         (!k. k IN d ==> ?a b:real^N. k = interval(a,b)) /\
3424         s SUBSET UNIONS d /\
3425         measurable (UNIONS d) /\
3426         measure (UNIONS d) <= measure s + e`
3427   MP_TAC THENL
3428    [ALL_TAC;
3429     DISCH_THEN(X_CHOOSE_TAC `d:(real^N->bool)->bool`) THEN
3430     EXISTS_TAC `d DELETE ({}:real^N->bool)` THEN
3431     ASM_SIMP_TAC[lemma; COUNTABLE_DELETE; IN_DELETE]] THEN
3432   MP_TAC(GEN `n:num` (ISPECL [`(a:num->real^N) n`; `(b:num->real^N) n`;
3433     `e / &2 pow (n + 2)`] EXPAND_CLOSED_OPEN_INTERVAL)) THEN
3434   ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; SKOLEM_THM] THEN
3435   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
3436   MAP_EVERY X_GEN_TAC [`A:num->real^N`; `B:num->real^N`] THEN STRIP_TAC THEN
3437   EXISTS_TAC `IMAGE (\n. interval(A n:real^N,B n)) (:num)` THEN
3438   SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN
3439   CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
3440   CONJ_TAC THENL
3441    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3442      (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
3443     ASM_REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN
3444     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
3445     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN
3446     ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; IN_UNIV] THEN
3447     ASM SET_TAC[];
3448     ALL_TAC] THEN
3449   ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
3450   MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN
3451   REWRITE_TAC[MEASURABLE_INTERVAL] THEN X_GEN_TAC `n:num` THEN
3452   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
3453    `sum(0..n) (\i. measure(interval[a i:real^N,b i]) + e / &2 pow (i + 2))` THEN
3454   ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN
3455   REWRITE_TAC[real_div; REAL_INV_MUL; SUM_LMUL; REAL_POW_ADD; SUM_RMUL] THEN
3456   REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3457   MATCH_MP_TAC(REAL_ARITH
3458    `s <= m + e / &2 /\ &0 <= e * x
3459     ==> s + e * (&1 - x) / (&1 / &2) * &1 / &4 <= m + e`) THEN
3460   ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_LT_IMP_LE;
3461                REAL_LE_DIV; REAL_POS] THEN
3462   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3463    (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN
3464   W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
3465         lhand o snd) THEN
3466   REWRITE_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL] THEN ANTS_TAC THENL
3467    [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
3468     ASM_CASES_TAC `interval[(a:num->real^N) i,b i] = interval[a j,b j]` THENL
3469      [UNDISCH_TAC
3470        `!m n. (d:num->real^N->bool) m = d n ==> m = n \/ d n = {}` THEN
3471       DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN
3472       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY];
3473       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE
3474        (BINDER_CONV o BINDER_CONV o RAND_CONV o LAND_CONV)
3475        [GSYM INTERIOR_INTER]) THEN
3476       DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN
3477       ASM_REWRITE_TAC[] THEN
3478       REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN
3479       SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN
3480       MATCH_MP_TAC(MESON[MEASURE_EMPTY]
3481        `measure(interior s) = measure s
3482         ==> interior s = {} ==> measure s = &0`) THEN
3483       MATCH_MP_TAC MEASURE_INTERIOR THEN
3484       SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL; NEGLIGIBLE_CONVEX_FRONTIER;
3485                CONVEX_INTER; CONVEX_INTERVAL]];
3486     DISCH_THEN(SUBST1_TAC o SYM)] THEN
3487   MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL
3488    [MATCH_MP_TAC MEASURABLE_UNIONS THEN
3489     SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL;
3490              FINITE_NUMSEG];
3491     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_UNIONS THEN
3492     ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
3493     ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]]);;
3494
3495 let MEASURABLE_OUTER_OPEN = prove
3496  (`!s:real^N->bool e.
3497         measurable s /\ &0 < e
3498         ==> ?t. open t /\ s SUBSET t /\
3499                 measurable t /\ measure t < measure s + e`,
3500   REPEAT STRIP_TAC THEN
3501   MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`]
3502     MEASURABLE_OUTER_OPEN_INTERVALS) THEN
3503   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
3504   X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN
3505   EXISTS_TAC `UNIONS d :real^N->bool` THEN
3506   ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ m <= s + e / &2 ==> m < s + e`] THEN
3507   MATCH_MP_TAC OPEN_UNIONS THEN ASM_MESON_TAC[OPEN_INTERVAL]);;
3508
3509 let MEASURABLE_INNER_COMPACT = prove
3510  (`!s:real^N->bool e.
3511         measurable s /\ &0 < e
3512         ==> ?t. compact t /\ t SUBSET s /\
3513                 measurable t /\ measure s < measure t + e`,
3514   REPEAT STRIP_TAC THEN
3515   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN
3516   GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN
3517   DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN
3518   ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN
3519   DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3520   MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3521   REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
3522   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3523   DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3524   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3525   X_GEN_TAC `z:real` THEN STRIP_TAC THEN
3526   MP_TAC(ISPECL  [`interval[a:real^N,b] DIFF s`; `e/ &4`]
3527         MEASURABLE_OUTER_OPEN) THEN
3528   ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL;
3529                REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN
3530   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
3531   EXISTS_TAC `interval[a:real^N,b] DIFF t` THEN REPEAT CONJ_TAC THENL
3532    [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
3533     ASM_SIMP_TAC[CLOSED_DIFF; CLOSED_INTERVAL; BOUNDED_DIFF; BOUNDED_INTERVAL];
3534     ASM SET_TAC[];
3535     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL];
3536     MATCH_MP_TAC(REAL_ARITH
3537         `&0 < e /\
3538          measure(s) < measure(interval[a,b] INTER s) + e / &4 /\
3539          measure(t) < measure(interval[a,b] DIFF s) + e / &4 /\
3540          measure(interval[a,b] INTER s) +
3541          measure(interval[a,b] DIFF s) = measure(interval[a,b]) /\
3542          measure(interval[a,b] INTER t) +
3543          measure(interval[a,b] DIFF t) = measure(interval[a,b]) /\
3544          measure(interval[a,b] INTER t) <= measure t
3545          ==> measure s < measure(interval[a,b] DIFF t) + e`) THEN
3546     ASM_SIMP_TAC[MEASURE_SUBSET; INTER_SUBSET; MEASURABLE_INTER;
3547                  MEASURABLE_INTERVAL] THEN
3548     CONJ_TAC THENL
3549      [FIRST_ASSUM(SUBST_ALL_TAC o SYM o MATCH_MP MEASURE_UNIQUE) THEN
3550       ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REAL_ARITH_TAC;
3551       CONJ_TAC THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION_EQ THEN
3552       ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN
3553       SET_TAC[]]]);;
3554
3555 let OPEN_MEASURABLE_INNER_DIVISION = prove
3556  (`!s:real^N->bool e.
3557         open s /\ measurable s /\ &0 < e
3558         ==> ?D. D division_of UNIONS D /\
3559                 UNIONS D SUBSET s /\
3560                 measure s < measure(UNIONS D) + e`,
3561   REPEAT STRIP_TAC THEN
3562   MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN
3563   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
3564   X_GEN_TAC `B:real` THEN STRIP_TAC THEN
3565   MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3566   ASM_REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
3567   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3568   FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3569   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3570   MP_TAC(ISPEC `s INTER interval(a - vec 1:real^N,b + vec 1)`
3571         OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN
3572   ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; SUBSET_INTER] THEN
3573   DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3574   MP_TAC(ISPECL [`D:(real^N->bool)->bool`; `measure(s:real^N->bool)`;
3575                  `e / &2`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN
3576   ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL
3577    [CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
3578     REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
3579     EXISTS_TAC `measure(UNIONS D :real^N->bool)` THEN CONJ_TAC THENL
3580      [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
3581        [MATCH_MP_TAC MEASURABLE_UNIONS THEN
3582         ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
3583         ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL];
3584         ASM_SIMP_TAC[SUBSET_UNIONS]];
3585       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3586       ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET]];
3587     DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3588     MP_TAC(ISPEC `d:(real^N->bool)->bool` ELEMENTARY_UNIONS_INTERVALS) THEN
3589     ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET]; ALL_TAC] THEN
3590     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:(real^N->bool)->bool` THEN
3591     DISCH_TAC THEN
3592     SUBGOAL_THEN `UNIONS p :real^N->bool = UNIONS d` SUBST1_TAC THENL
3593      [ASM_MESON_TAC[division_of]; ALL_TAC] THEN
3594     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3595      [MATCH_MP_TAC SUBSET_TRANS THEN
3596       EXISTS_TAC `UNIONS D :real^N->bool` THEN
3597       ASM_SIMP_TAC[SUBSET_UNIONS; INTER_SUBSET];
3598       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3599        `ms' - e / &2 < mud ==> ms < ms' + e / &2 ==> ms < mud + e`)) THEN
3600       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3601        `abs(sc - s) < e / &2
3602         ==> sc <= so /\ sc <= s ==> s < so + e / &2`)) THEN
3603       CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3604       ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET] THEN
3605       MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN
3606       REWRITE_TAC[SUBSET_INTERVAL; VECTOR_SUB_COMPONENT; VEC_COMPONENT;
3607                   VECTOR_ADD_COMPONENT] THEN
3608       MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
3609       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]]);;
3610
3611 (* ------------------------------------------------------------------------- *)
3612 (* Hence for linear transformation, suffices to check compact intervals.     *)
3613 (* ------------------------------------------------------------------------- *)
3614
3615 let MEASURABLE_LINEAR_IMAGE_INTERVAL = prove
3616  (`!f a b. linear f ==> measurable(IMAGE f (interval[a,b]))`,
3617   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL
3618    [MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN
3619     ASM_MESON_TAC[CONVEX_INTERVAL];
3620     MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
3621     ASM_MESON_TAC[BOUNDED_INTERVAL]]);;
3622
3623 let HAS_MEASURE_LINEAR_SUFFICIENT = prove
3624  (`!f:real^N->real^N m.
3625         linear f /\
3626         (!a b. IMAGE f (interval[a,b]) has_measure
3627                (m * measure(interval[a,b])))
3628         ==> !s. measurable s ==> (IMAGE f s) has_measure (m * measure s)`,
3629   REPEAT GEN_TAC THEN STRIP_TAC THEN
3630   DISJ_CASES_TAC(REAL_ARITH `m < &0 \/ &0 <= m`) THENL
3631    [FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN
3632     DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_POS_LE) THEN
3633     MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN
3634     MATCH_MP_TAC(REAL_ARITH `&0 < --m * x ==> ~(&0 <= m * x)`) THEN
3635     MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_NEG_GT0] THEN
3636     REWRITE_TAC[MEASURE_INTERVAL] THEN MATCH_MP_TAC CONTENT_POS_LT THEN
3637     SIMP_TAC[VEC_COMPONENT; REAL_LT_01];
3638     ALL_TAC] THEN
3639   ASM_CASES_TAC `!x y. (f:real^N->real^N) x = f y ==> x = y` THENL
3640    [ALL_TAC;
3641     SUBGOAL_THEN `!s. negligible(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL
3642      [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; ALL_TAC] THEN
3643     SUBGOAL_THEN `m * measure(interval[vec 0:real^N,vec 1]) = &0` MP_TAC THENL
3644      [MATCH_MP_TAC(ISPEC `IMAGE (f:real^N->real^N) (interval[vec 0,vec 1])`
3645         HAS_MEASURE_UNIQUE) THEN
3646       ASM_REWRITE_TAC[HAS_MEASURE_0];
3647       REWRITE_TAC[REAL_ENTIRE; MEASURE_INTERVAL] THEN
3648       MATCH_MP_TAC(TAUT `~b /\ (a ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
3649        [SIMP_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL;
3650                  INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01];
3651         ASM_SIMP_TAC[REAL_MUL_LZERO; HAS_MEASURE_0]]]] THEN
3652   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_ISOMORPHISM) THEN
3653   ASM_REWRITE_TAC[] THEN
3654   DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN
3655   UNDISCH_THEN `!x y. (f:real^N->real^N) x = f y ==> x = y` (K ALL_TAC) THEN
3656   SUBGOAL_THEN
3657    `!s. bounded s /\ measurable s
3658         ==> (IMAGE (f:real^N->real^N) s) has_measure (m * measure s)`
3659   ASSUME_TAC THENL
3660    [REPEAT STRIP_TAC THEN
3661     FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3662     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3663     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3664     SUBGOAL_THEN
3665      `!d. COUNTABLE d /\
3666           (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\
3667                           (?c d. k = interval[c,d])) /\
3668           (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
3669                    ==> interior k1 INTER interior k2 = {})
3670           ==> IMAGE (f:real^N->real^N) (UNIONS d) has_measure
3671                     (m * measure(UNIONS d))`
3672     ASSUME_TAC THENL
3673      [REWRITE_TAC[IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN
3674       SUBGOAL_THEN
3675        `!g:real^N->real^N.
3676           linear g
3677           ==> !k l. k IN d /\ l IN d /\ ~(k = l)
3678                     ==> negligible((IMAGE g k) INTER (IMAGE g l))`
3679       MP_TAC THENL
3680        [REPEAT STRIP_TAC THEN
3681         ASM_CASES_TAC `!x y. (g:real^N->real^N) x = g y ==> x = y` THENL
3682          [ALL_TAC;
3683           ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE;
3684                         NEGLIGIBLE_INTER]] THEN
3685         MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3686         EXISTS_TAC `frontier(IMAGE (g:real^N->real^N) k INTER IMAGE g l) UNION
3687                     interior(IMAGE g k INTER IMAGE g l)` THEN
3688         CONJ_TAC THENL
3689          [ALL_TAC;
3690           REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
3691            `s SUBSET t ==> s SUBSET (t DIFF u) UNION u`) THEN
3692           REWRITE_TAC[CLOSURE_SUBSET]] THEN
3693         MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THENL
3694          [MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN
3695           MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THEN
3696           MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL];
3697           ALL_TAC] THEN
3698         REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3699         EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k) INTER
3700                     IMAGE g (interior l)` THEN
3701         CONJ_TAC THENL
3702          [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
3703           EXISTS_TAC
3704            `IMAGE (g:real^N->real^N) (interior k INTER interior l)` THEN
3705           CONJ_TAC THENL
3706            [ASM_SIMP_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]; ASM SET_TAC[]];
3707           MATCH_MP_TAC(SET_RULE
3708            `s SUBSET u /\ t SUBSET v ==> (s INTER t) SUBSET (u INTER v)`) THEN
3709           CONJ_TAC THEN MATCH_MP_TAC INTERIOR_IMAGE_SUBSET THEN
3710           ASM_MESON_TAC[LINEAR_CONTINUOUS_AT]];
3711         ALL_TAC] THEN
3712       DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^N->real^N` th) THEN
3713           MP_TAC(SPEC `\x:real^N. x` th)) THEN
3714       ASM_REWRITE_TAC[LINEAR_ID; SET_RULE `IMAGE (\x. x) s = s`] THEN
3715       REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
3716        [MP_TAC(ISPECL [`IMAGE (f:real^N->real^N)`; `d:(real^N->bool)->bool`]
3717                   HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
3718         ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
3719         MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3720         MATCH_MP_TAC EQ_TRANS THEN
3721         EXISTS_TAC `sum d (\k:real^N->bool. m * measure k)` THEN CONJ_TAC THENL
3722          [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN
3723         REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN
3724         CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS THEN
3725         ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN
3726         ASM_MESON_TAC[MEASURABLE_INTERVAL];
3727         ALL_TAC] THEN
3728       MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
3729       ASM_REWRITE_TAC[INFINITE] THEN
3730       DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
3731        (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
3732       MP_TAC(ISPEC `s:num->real^N->bool`
3733         HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
3734       MP_TAC(ISPEC `\n:num. IMAGE (f:real^N->real^N) (s n)`
3735         HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
3736       RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
3737                                   FORALL_IN_IMAGE; IN_UNIV]) THEN
3738       RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
3739       ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ANTS_TAC THENL
3740        [REPEAT CONJ_TAC THENL
3741          [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_INTERVAL];
3742           ASM_MESON_TAC[];
3743           ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3744           REWRITE_TAC[GSYM IMAGE_UNIONS; IMAGE_o] THEN
3745           MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN
3746           MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
3747           EXISTS_TAC `interval[a:real^N,b]` THEN
3748           REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
3749         ALL_TAC] THEN
3750       STRIP_TAC THEN ANTS_TAC THENL
3751        [REPEAT CONJ_TAC THENL
3752          [ASM_MESON_TAC[MEASURABLE_INTERVAL];
3753           ASM_MESON_TAC[];
3754           MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
3755           EXISTS_TAC `interval[a:real^N,b]` THEN
3756           REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
3757         ALL_TAC] THEN
3758       STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
3759       SUBGOAL_THEN `m * measure (UNIONS (IMAGE s (:num)):real^N->bool) =
3760              measure(UNIONS (IMAGE (\x. IMAGE f (s x)) (:num)):real^N->bool)`
3761        (fun th -> ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE; th]) THEN
3762       ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN
3763       MATCH_MP_TAC SERIES_UNIQUE THEN
3764       EXISTS_TAC `\n:num. lift(measure(IMAGE (f:real^N->real^N) (s n)))` THEN
3765       EXISTS_TAC `from 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUMS_EQ THEN
3766       EXISTS_TAC `\n:num. m % lift(measure(s n:real^N->bool))` THEN
3767       CONJ_TAC THENL
3768        [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_EQ] THEN
3769         ASM_MESON_TAC[MEASURE_UNIQUE];
3770         REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC SERIES_CMUL THEN
3771         ASM_REWRITE_TAC[]];
3772       ALL_TAC] THEN
3773     REWRITE_TAC[HAS_MEASURE_INNER_OUTER_LE] THEN CONJ_TAC THEN
3774     X_GEN_TAC `e:real` THEN DISCH_TAC THENL
3775      [MP_TAC(ISPECL [`interval[a,b] DIFF s:real^N->bool`; `a:real^N`;
3776        `b:real^N`; `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
3777       ANTS_TAC THENL
3778        [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN
3779         ASM_SIMP_TAC[REAL_ARITH `&0 < &1 + abs x`; REAL_LT_DIV] THEN SET_TAC[];
3780         ALL_TAC] THEN
3781       DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3782       EXISTS_TAC `IMAGE f (interval[a,b]) DIFF
3783                   IMAGE (f:real^N->real^N) (UNIONS d)` THEN
3784       FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
3785       ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_TAC THEN
3786       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
3787        [ASM_MESON_TAC[MEASURABLE_DIFF; measurable]; ALL_TAC] THEN
3788       MATCH_MP_TAC REAL_LE_TRANS THEN
3789       EXISTS_TAC `measure(IMAGE f (interval[a,b])) -
3790                   measure(IMAGE (f:real^N->real^N) (UNIONS d))` THEN
3791       CONJ_TAC THENL
3792        [ALL_TAC;
3793         MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
3794         MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
3795         REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC]) THEN
3796         MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[UNIONS_SUBSET]] THEN
3797       UNDISCH_TAC `!a b. IMAGE (f:real^N->real^N) (interval [a,b])
3798                          has_measure m * measure (interval [a,b])` THEN
3799       DISCH_THEN(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3800       REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE)) THEN
3801       MATCH_MP_TAC REAL_LE_TRANS THEN
3802       EXISTS_TAC `m * measure(s:real^N->bool) - m * e / (&1 + abs m)` THEN
3803       CONJ_TAC THENL
3804        [REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`] THEN
3805         REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
3806         REWRITE_TAC[GSYM real_div] THEN
3807         ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
3808         GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3809         ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC;
3810         ALL_TAC] THEN
3811       REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
3812       ASM_REWRITE_TAC[] THEN
3813       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3814         `d <= a + e ==> a = i - s ==> s - e <= i - d`)) THEN
3815       MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
3816       ASM_REWRITE_TAC[MEASURABLE_INTERVAL];
3817       MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`;
3818                 `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
3819       ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN
3820       DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
3821       EXISTS_TAC `IMAGE (f:real^N->real^N) (UNIONS d)` THEN
3822       FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
3823       ASM_SIMP_TAC[IMAGE_SUBSET] THEN
3824       SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN
3825       MATCH_MP_TAC REAL_LE_TRANS THEN
3826       EXISTS_TAC `m * measure(s:real^N->bool) + m * e / (&1 + abs m)` THEN
3827       CONJ_TAC THENL
3828        [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_LMUL];
3829         REWRITE_TAC[REAL_LE_LADD] THEN
3830         REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
3831         REWRITE_TAC[GSYM real_div] THEN
3832         ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
3833         GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3834         ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC]];
3835       ALL_TAC] THEN
3836   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_MEASURE_LIMIT] THEN
3837   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3838   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN
3839   GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN
3840   DISCH_THEN(MP_TAC o SPEC `e / (&1 + abs m)`) THEN
3841   ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN
3842   DISCH_THEN(X_CHOOSE_THEN `B:real`
3843    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN
3844   MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
3845   REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
3846   REMOVE_THEN "*" MP_TAC THEN
3847   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N` THEN
3848   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N` THEN
3849   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
3850   DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
3851   MP_TAC(ISPECL [`interval[c:real^N,d]`; `vec 0:real^N`]
3852     BOUNDED_SUBSET_BALL) THEN
3853   REWRITE_TAC[BOUNDED_INTERVAL] THEN
3854   DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN
3855   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_BOUNDED_POS) THEN
3856   ASM_REWRITE_TAC[] THEN
3857   DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
3858
3859   EXISTS_TAC `D * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
3860   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
3861   FIRST_X_ASSUM(MP_TAC o SPEC
3862    `s INTER (IMAGE (h:real^N->real^N) (interval[a,b]))`) THEN
3863   SUBGOAL_THEN
3864    `IMAGE (f:real^N->real^N) (s INTER IMAGE h (interval [a,b])) =
3865     (IMAGE f s) INTER interval[a,b]`
3866   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL
3867    [ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
3868     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL];
3869     ALL_TAC] THEN
3870   DISCH_TAC THEN EXISTS_TAC
3871    `m * measure(s INTER (IMAGE (h:real^N->real^N) (interval[a,b])))` THEN
3872   ASM_REWRITE_TAC[] THEN
3873   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `m * e / (&1 + abs m)` THEN
3874   CONJ_TAC THENL
3875    [ALL_TAC;
3876     REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
3877     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
3878     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3879     ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN REAL_ARITH_TAC] THEN
3880   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN
3881   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [real_abs] THEN
3882   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN
3883   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3884    `abs(z - m) < e ==> z <= w /\ w <= m ==> abs(w - m) <= e`)) THEN
3885   SUBST1_TAC(SYM(MATCH_MP MEASURE_UNIQUE
3886    (ASSUME `s INTER interval [c:real^N,d] has_measure z`))) THEN
3887   CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
3888   ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL;
3889                MEASURABLE_INTERVAL; INTER_SUBSET] THEN
3890   MATCH_MP_TAC(SET_RULE
3891    `!v. t SUBSET v /\ v SUBSET u ==> s INTER t SUBSET s INTER u`) THEN
3892   EXISTS_TAC `ball(vec 0:real^N,D)` THEN ASM_REWRITE_TAC[] THEN
3893   MATCH_MP_TAC(SET_RULE
3894    `!f. (!x. h(f x) = x) /\ IMAGE f s SUBSET t ==> s SUBSET IMAGE h t`) THEN
3895   EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN
3896   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^N,D * C)` THEN
3897   ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0] THEN
3898   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3899   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `C * norm(x:real^N)` THEN
3900   ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3901   ASM_SIMP_TAC[REAL_LT_LMUL_EQ]);;
3902
3903 (* ------------------------------------------------------------------------- *)
3904 (* Some inductions by expressing mapping in terms of elementary matrices.    *)
3905 (* ------------------------------------------------------------------------- *)
3906
3907 let INDUCT_MATRIX_ROW_OPERATIONS = prove
3908  (`!P:real^N^N->bool.
3909         (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\
3910         (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\
3911                     1 <= j /\ j <= dimindex(:N) /\ ~(i = j)
3912                     ==> A$i$j = &0) ==> P A) /\
3913         (!A m n. P A /\ 1 <= m /\ m <= dimindex(:N) /\
3914                  1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3915                  ==> P(lambda i j. A$i$(swap(m,n) j))) /\
3916         (!A m n c. P A /\ 1 <= m /\ m <= dimindex(:N) /\
3917                    1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
3918                    ==> P(lambda i. if i = m then row m A + c % row n A
3919                                    else row i A))
3920         ==> !A. P A`,
3921   GEN_TAC THEN
3922   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "zero_row") MP_TAC) THEN
3923   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "diagonal") MP_TAC) THEN
3924   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "swap_cols") (LABEL_TAC "row_op")) THEN
3925   SUBGOAL_THEN
3926    `!k A:real^N^N.
3927         (!i j. 1 <= i /\ i <= dimindex(:N) /\
3928                k <= j /\ j <= dimindex(:N) /\ ~(i = j)
3929                ==> A$i$j = &0)
3930         ==> P A`
3931    (fun th -> GEN_TAC THEN MATCH_MP_TAC th THEN
3932               EXISTS_TAC `dimindex(:N) + 1` THEN ARITH_TAC) THEN
3933   MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
3934    [REPEAT STRIP_TAC THEN USE_THEN "diagonal" MATCH_MP_TAC THEN
3935     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
3936     ASM_REWRITE_TAC[LE_0];
3937     ALL_TAC] THEN
3938   X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "ind_hyp") THEN
3939   DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC (ARITH_RULE `k = 0 \/ 1 <= k`) THEN
3940   ASM_REWRITE_TAC[ARITH] THEN
3941   ASM_CASES_TAC `k <= dimindex(:N)` THENL
3942    [ALL_TAC;
3943     REPEAT STRIP_TAC THEN REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
3944     ASM_ARITH_TAC] THEN
3945   SUBGOAL_THEN
3946    `!A:real^N^N.
3947         ~(A$k$k = &0) /\
3948         (!i j. 1 <= i /\ i <= dimindex (:N) /\
3949                SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j)
3950                ==> A$i$j = &0)
3951         ==> P A`
3952   (LABEL_TAC "nonzero_hyp") THENL
3953    [ALL_TAC;
3954     X_GEN_TAC `A:real^N^N` THEN DISCH_TAC THEN
3955     ASM_CASES_TAC `row k (A:real^N^N) = vec 0` THENL
3956      [REMOVE_THEN "zero_row" MATCH_MP_TAC THEN ASM_MESON_TAC[];
3957       ALL_TAC] THEN
3958     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
3959     SIMP_TAC[VEC_COMPONENT; row; LAMBDA_BETA] THEN
3960     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
3961     X_GEN_TAC `l:num` THEN STRIP_TAC THEN
3962     ASM_CASES_TAC `l:num = k` THENL
3963      [REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ASM_MESON_TAC[];
3964       ALL_TAC] THEN
3965     REMOVE_THEN "swap_cols" (MP_TAC o SPECL
3966      [`(lambda i j. (A:real^N^N)$i$swap(k,l) j):real^N^N`;
3967       `k:num`; `l:num`]) THEN
3968     ASM_SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL
3969      [ALL_TAC;
3970       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3971       SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
3972       REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
3973       REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])] THEN
3974     REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN
3975     ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= i <=> 1 <= i /\ SUC k <= i`] THEN
3976     ASM_SIMP_TAC[LAMBDA_BETA] THEN
3977     ASM_REWRITE_TAC[swap] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN
3978     STRIP_TAC THEN SUBGOAL_THEN `l:num <= k` ASSUME_TAC THENL
3979      [FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
3980       ASM_REWRITE_TAC[] THEN ARITH_TAC;
3981       ALL_TAC] THEN
3982     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
3983     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3984     ASM_ARITH_TAC] THEN
3985    SUBGOAL_THEN
3986    `!l A:real^N^N.
3987         ~(A$k$k = &0) /\
3988         (!i j. 1 <= i /\ i <= dimindex (:N) /\
3989                SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j)
3990                ==> A$i$j = &0) /\
3991         (!i. l <= i /\ i <= dimindex(:N) /\ ~(i = k) ==> A$i$k = &0)
3992         ==> P A`
3993    MP_TAC THENL
3994     [ALL_TAC;
3995      DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN
3996      REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `~(n + 1 <= i /\ i <= n)`]] THEN
3997    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
3998     [GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3999      DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
4000      USE_THEN "ind_hyp" MATCH_MP_TAC THEN
4001      MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
4002      ASM_CASES_TAC `j:num = k` THENL
4003       [ASM_REWRITE_TAC[] THEN USE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
4004        REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
4005     ALL_TAC] THEN
4006   X_GEN_TAC `l:num` THEN DISCH_THEN(LABEL_TAC "inner_hyp") THEN
4007   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4008   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
4009   ASM_CASES_TAC `l:num = k` THENL
4010    [REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
4011     REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
4012     ALL_TAC] THEN
4013   DISJ_CASES_TAC(ARITH_RULE `l = 0 \/ 1 <= l`) THENL
4014    [REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
4015     MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
4016     ASM_CASES_TAC `j:num = k` THENL
4017      [ASM_REWRITE_TAC[] THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
4018       REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
4019     ALL_TAC] THEN
4020   ASM_CASES_TAC `l <= dimindex(:N)` THENL
4021    [ALL_TAC;
4022     REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
4023     ASM_ARITH_TAC] THEN
4024   REMOVE_THEN "inner_hyp" (MP_TAC o SPECL
4025    [`(lambda i. if i = l then row l (A:real^N^N) + --(A$l$k/A$k$k) % row k A
4026                 else row i A):real^N^N`]) THEN
4027   ANTS_TAC THENL
4028    [SUBGOAL_THEN `!i. l <= i ==> 1 <= i` ASSUME_TAC THENL
4029      [ASM_ARITH_TAC; ALL_TAC] THEN
4030     ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= j <=> 1 <= j /\ SUC k <= j`] THEN
4031     ASM_SIMP_TAC[LAMBDA_BETA; row; COND_COMPONENT;
4032                  VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
4033     ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> x + --(x / y) * y = &0`] THEN
4034     REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN
4035     ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[] THENL
4036      [REPEAT STRIP_TAC THEN
4037       MATCH_MP_TAC(REAL_RING `x = &0 /\ y = &0 ==> x + z * y = &0`) THEN
4038       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
4039       REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC];
4040     ALL_TAC] THEN
4041   DISCH_TAC THEN REMOVE_THEN "row_op" (MP_TAC o SPECL
4042    [`(lambda i. if i = l then row l A + --(A$l$k / A$k$k) % row k A
4043                 else row i (A:real^N^N)):real^N^N`;
4044     `l:num`; `k:num`; `(A:real^N^N)$l$k / A$k$k`]) THEN
4045   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4046   ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4047                VECTOR_MUL_COMPONENT; row; COND_COMPONENT] THEN
4048   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
4049   REAL_ARITH_TAC);;
4050
4051 let INDUCT_MATRIX_ELEMENTARY = prove
4052  (`!P:real^N^N->bool.
4053         (!A B. P A /\ P B ==> P(A ** B)) /\
4054         (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\
4055         (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\
4056                     1 <= j /\ j <= dimindex(:N) /\ ~(i = j)
4057                     ==> A$i$j = &0) ==> P A) /\
4058         (!m n. 1 <= m /\ m <= dimindex(:N) /\
4059                1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
4060                ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\
4061         (!m n c. 1 <= m /\ m <= dimindex(:N) /\
4062                  1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
4063                  ==> P(lambda i j. if i = m /\ j = n then c
4064                                    else if i = j then &1 else &0))
4065         ==> !A. P A`,
4066   GEN_TAC THEN
4067   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4068   DISCH_THEN(fun th ->
4069     MATCH_MP_TAC INDUCT_MATRIX_ROW_OPERATIONS THEN MP_TAC th) THEN
4070   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN
4071   DISCH_THEN(fun th -> X_GEN_TAC `A:real^N^N` THEN MP_TAC th) THEN
4072   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
4073   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
4074   UNDISCH_TAC `(P:real^N^N->bool) A` THENL
4075    [REWRITE_TAC[GSYM IMP_CONJ]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
4076   DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN
4077   AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
4078   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4079   X_GEN_TAC `j:num` THEN STRIP_TAC THEN
4080   ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul; row] THENL
4081    [ASM_SIMP_TAC[mat; IN_DIMINDEX_SWAP; LAMBDA_BETA] THEN
4082     ONCE_REWRITE_TAC[COND_RAND] THEN
4083     SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; REAL_MUL_RID] THEN
4084     COND_CASES_TAC THEN REWRITE_TAC[] THEN
4085     RULE_ASSUM_TAC(REWRITE_RULE[swap; IN_NUMSEG]) THEN ASM_ARITH_TAC;
4086     ALL_TAC] THEN
4087   ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THENL
4088    [ALL_TAC;
4089     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
4090     REWRITE_TAC[REAL_MUL_LZERO] THEN
4091     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
4092     ASM_SIMP_TAC[SUM_DELTA; LAMBDA_BETA; IN_NUMSEG; REAL_MUL_LID]] THEN
4093   ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN
4094   MATCH_MP_TAC EQ_TRANS THEN
4095   EXISTS_TAC
4096     `sum {m,n} (\k. (if k = n then c else if m = k then &1 else &0) *
4097                     (A:real^N^N)$k$j)` THEN
4098   CONJ_TAC THENL
4099    [MATCH_MP_TAC SUM_SUPERSET THEN
4100     ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
4101                  IN_NUMSEG; REAL_MUL_LZERO] THEN
4102     ASM_ARITH_TAC;
4103     ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
4104     REAL_ARITH_TAC]);;
4105
4106 let INDUCT_MATRIX_ELEMENTARY_ALT = prove
4107  (`!P:real^N^N->bool.
4108         (!A B. P A /\ P B ==> P(A ** B)) /\
4109         (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\
4110         (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\
4111                     1 <= j /\ j <= dimindex(:N) /\ ~(i = j)
4112                     ==> A$i$j = &0) ==> P A) /\
4113         (!m n. 1 <= m /\ m <= dimindex(:N) /\
4114                1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
4115                ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\
4116         (!m n. 1 <= m /\ m <= dimindex(:N) /\
4117                1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
4118                ==> P(lambda i j. if i = m /\ j = n \/ i = j then &1 else &0))
4119         ==> !A. P A`,
4120   GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC INDUCT_MATRIX_ELEMENTARY THEN
4121   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
4122   ASM_CASES_TAC `c = &0` THENL
4123    [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
4124         MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
4125     ASM_SIMP_TAC[LAMBDA_BETA; COND_ID];
4126     ALL_TAC] THEN
4127   SUBGOAL_THEN
4128    `(lambda i j. if i = m /\ j = n then c else if i = j then &1 else &0) =
4129   ((lambda i j. if i = j then if j = n then inv c else &1 else &0):real^N^N) **
4130     ((lambda i j. if i = m /\ j = n \/ i = j then &1 else &0):real^N^N) **
4131     ((lambda i j. if i = j then if j = n then c else &1 else &0):real^N^N)`
4132   SUBST1_TAC THENL
4133    [ALL_TAC;
4134     REPEAT(MATCH_MP_TAC(ASSUME `!A B:real^N^N. P A /\ P B ==> P(A ** B)`) THEN
4135            CONJ_TAC) THEN
4136     ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
4137         MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
4138     ASM_SIMP_TAC[LAMBDA_BETA]] THEN
4139   SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN
4140   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4141   X_GEN_TAC `j:num` THEN STRIP_TAC THEN
4142   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_ARITH
4143        `(if p then &1 else &0) * (if q then c else &0) =
4144         if q then if p then c else &0 else &0`] THEN
4145   REWRITE_TAC[REAL_ARITH
4146    `(if p then x else &0) * y = (if p then x * y else &0)`] THEN
4147   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
4148   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN
4149   ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
4150   ASM_CASES_TAC `j:num = n` THEN ASM_REWRITE_TAC[REAL_MUL_LID; EQ_SYM_EQ] THEN
4151   ASM_CASES_TAC `i:num = n` THEN
4152   ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID; REAL_MUL_RZERO]);;
4153
4154 (* ------------------------------------------------------------------------- *)
4155 (* The same thing in mapping form (might have been easier all along).        *)
4156 (* ------------------------------------------------------------------------- *)
4157
4158 let INDUCT_LINEAR_ELEMENTARY = prove
4159  (`!P. (!f g. linear f /\ linear g /\ P f /\ P g ==> P(f o g)) /\
4160        (!f i. linear f /\ 1 <= i /\ i <= dimindex(:N) /\ (!x. (f x)$i = &0)
4161               ==> P f) /\
4162        (!c. P(\x. lambda i. c i * x$i)) /\
4163        (!m n. 1 <= m /\ m <= dimindex(:N) /\
4164               1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
4165               ==> P(\x. lambda i. x$swap(m,n) i)) /\
4166        (!m n. 1 <= m /\ m <= dimindex(:N) /\
4167               1 <= n /\ n <= dimindex(:N) /\ ~(m = n)
4168               ==> P(\x. lambda i. if i = m then x$m + x$n else x$i))
4169        ==> !f:real^N->real^N. linear f ==> P f`,
4170   GEN_TAC THEN
4171   MP_TAC(ISPEC `\A:real^N^N. P(\x:real^N. A ** x):bool`
4172     INDUCT_MATRIX_ELEMENTARY_ALT) THEN
4173   REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
4174    [ALL_TAC;
4175     DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN
4176     FIRST_X_ASSUM(MP_TAC o SPEC `matrix(f:real^N->real^N)`) THEN
4177     ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX]] THEN
4178   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
4179    [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `B:real^N^N`] THEN
4180     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
4181      [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. (B:real^N^N) ** x`]) THEN
4182     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN
4183     REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC];
4184     ALL_TAC] THEN
4185   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
4186    [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `m:num`] THEN
4187     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
4188      [`\x:real^N. (A:real^N^N) ** x`; `m:num`]) THEN
4189     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
4190     DISCH_THEN MATCH_MP_TAC THEN
4191     UNDISCH_TAC `row m (A:real^N^N) = vec 0` THEN
4192     ASM_SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT; matrix_vector_mul;
4193                  REAL_MUL_LZERO; SUM_0];
4194     ALL_TAC] THEN
4195   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
4196    [DISCH_TAC THEN X_GEN_TAC `A:real^N^N` THEN STRIP_TAC THEN
4197     FIRST_X_ASSUM(MP_TAC o SPEC `\i. (A:real^N^N)$i$i`) THEN
4198     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4199     ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA] THEN
4200     MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
4201     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4202      `sum(1..dimindex(:N)) (\j. if j = i then (A:real^N^N)$i$j * (x:real^N)$j
4203                                 else &0)` THEN
4204     CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN
4205     MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
4206     ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO];
4207     ALL_TAC] THEN
4208   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
4209   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN
4210   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
4211   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
4212   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4213   ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA;
4214                mat; IN_DIMINDEX_SWAP]
4215   THENL
4216    [ONCE_REWRITE_TAC[SWAP_GALOIS] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
4217     ONCE_REWRITE_TAC[COND_RATOR] THEN
4218     SIMP_TAC[SUM_DELTA; REAL_MUL_LID; REAL_MUL_LZERO; IN_NUMSEG] THEN
4219     REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
4220     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
4221     MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
4222     ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
4223     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
4224     GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
4225     ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_MUL_LID; IN_NUMSEG] THEN
4226     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4227      `sum {m,n} (\j. if n = j \/ j = m then (x:real^N)$j else &0)` THEN
4228     CONJ_TAC THENL
4229      [SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
4230       ASM_REWRITE_TAC[REAL_ADD_RID];
4231       CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
4232       ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
4233                    IN_NUMSEG; REAL_MUL_LZERO] THEN
4234       ASM_ARITH_TAC]]);;
4235
4236 (* ------------------------------------------------------------------------- *)
4237 (* Hence the effect of an arbitrary linear map on a measurable set.          *)
4238 (* ------------------------------------------------------------------------- *)
4239
4240 let LAMBDA_SWAP_GALOIS = prove
4241  (`!x:real^N y:real^N.
4242         1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N)
4243         ==> (x = (lambda i. y$swap(m,n) i) <=>
4244              (lambda i. x$swap(m,n) i) = y)`,
4245   SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP] THEN
4246   REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
4247   DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4248   FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
4249   ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
4250   ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]);;
4251
4252 let LAMBDA_ADD_GALOIS = prove
4253  (`!x:real^N y:real^N.
4254         1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\
4255         ~(m = n)
4256         ==> (x = (lambda i. if i = m then y$m + y$n else y$i) <=>
4257              (lambda i. if i = m then x$m - x$n else x$i) = y)`,
4258   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
4259   REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
4260   DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4261   FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4262   FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
4263   ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
4264   REAL_ARITH_TAC);;
4265
4266 let HAS_MEASURE_SHEAR_INTERVAL = prove
4267  (`!a b:real^N m n.
4268         1 <= m /\ m <= dimindex(:N) /\
4269         1 <= n /\ n <= dimindex(:N) /\
4270         ~(m = n) /\ ~(interval[a,b] = {}) /\
4271         &0 <= a$n
4272         ==> (IMAGE (\x. (lambda i. if i = m then x$m + x$n else x$i))
4273                    (interval[a,b]):real^N->bool)
4274             has_measure measure (interval [a,b])`,
4275   let lemma = prove
4276    (`!s t u v:real^N->bool.
4277           measurable s /\ measurable t /\ measurable u /\
4278           negligible(s INTER t) /\ negligible(s INTER u) /\
4279           negligible(t INTER u) /\
4280           s UNION t UNION u = v
4281           ==> v has_measure (measure s) + (measure t) + (measure u)`,
4282     REPEAT STRIP_TAC THEN
4283     ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_UNION] THEN
4284     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4285     ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_UNION] THEN
4286     ASM_SIMP_TAC[MEASURE_EQ_0; UNION_OVER_INTER; MEASURE_UNION;
4287                  MEASURABLE_UNION; NEGLIGIBLE_INTER; MEASURABLE_INTER] THEN
4288     REAL_ARITH_TAC)
4289   and lemma' = prove
4290    (`!s t u a:real^N.
4291           measurable s /\ measurable t /\
4292           s UNION (IMAGE (\x. a + x) t) = u /\
4293           negligible(s INTER (IMAGE (\x. a + x) t))
4294           ==> measure s + measure t = measure u`,
4295     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
4296     ASM_SIMP_TAC[MEASURE_NEGLIGIBLE_UNION; MEASURABLE_TRANSLATION_EQ;
4297                  MEASURE_TRANSLATION]) in
4298   REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
4299   SUBGOAL_THEN
4300    `linear((\x. lambda i. if i = m then x$m + x$n else x$i):real^N->real^N)`
4301   ASSUME_TAC THENL
4302    [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4303                  VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
4304     ALL_TAC] THEN
4305   MP_TAC(ISPECL
4306    [`IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i)
4307             (interval[a:real^N,b]):real^N->bool`;
4308     `interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
4309        {x:real^N | (basis m - basis n) dot x <= a$m}`;
4310     `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
4311        {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
4312     `interval[a:real^N,
4313               (lambda i. if i = m then (b:real^N)$m + b$n else b$i)]`]
4314      lemma) THEN
4315   ANTS_TAC THENL
4316    [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
4317                  CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
4318                  CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER;
4319                  BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
4320     REWRITE_TAC[INTER] THEN
4321     REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
4322     ASM_SIMP_TAC[LAMBDA_ADD_GALOIS; UNWIND_THM1] THEN
4323     ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
4324                  DOT_BASIS; DOT_LSUB] THEN
4325     ONCE_REWRITE_TAC[MESON[]
4326        `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN
4327     ASM_SIMP_TAC[] THEN
4328     REWRITE_TAC[TAUT `(p /\ x) /\ (q /\ x) /\ r <=> x /\ p /\ q /\ r`;
4329                 TAUT `(p /\ x) /\ q /\ (r /\ x) <=> x /\ p /\ q /\ r`;
4330                 TAUT `((p /\ x) /\ q) /\ (r /\ x) /\ s <=>
4331                             x /\ p /\ q /\ r /\ s`;
4332             TAUT `(a /\ x \/ (b /\ x) /\ c \/ (d /\ x) /\ e <=> f /\ x) <=>
4333                   x ==> (a \/ b /\ c \/ d /\ e <=> f)`] THEN
4334     ONCE_REWRITE_TAC[SET_RULE
4335      `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
4336     REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
4337      [ALL_TAC;
4338       GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN
4339       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
4340     REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN
4341     MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
4342     MATCH_MP_TAC NEGLIGIBLE_SUBSET THENL
4343      [EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`;
4344       EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`;
4345       EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`]
4346     THEN (CONJ_TAC THENL
4347       [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
4348        REWRITE_TAC[VECTOR_SUB_EQ] THEN
4349        ASM_MESON_TAC[BASIS_INJ];
4350        ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
4351                     NOT_IN_EMPTY] THEN
4352        FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN
4353        ASM_REAL_ARITH_TAC]);
4354     ALL_TAC] THEN
4355   ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE;
4356                MEASURABLE_LINEAR_IMAGE_INTERVAL;
4357                MEASURABLE_INTERVAL] THEN
4358   MP_TAC(ISPECL
4359    [`interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
4360        {x:real^N | (basis m - basis n) dot x <= a$m}`;
4361     `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
4362        {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
4363     `interval[a:real^N,
4364               (lambda i. if i = m then (a:real^N)$m + b$n
4365                          else (b:real^N)$i)]`;
4366     `(lambda i. if i = m then (a:real^N)$m - (b:real^N)$m
4367                 else &0):real^N`]
4368      lemma') THEN
4369   ANTS_TAC THENL
4370    [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
4371                  CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
4372                  CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER;
4373                  BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
4374     REWRITE_TAC[INTER] THEN
4375     REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
4376     ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = (lambda i. p i) + y <=>
4377                                    x - (lambda i. p i) = y`] THEN
4378     ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
4379                  DOT_BASIS; DOT_LSUB; UNWIND_THM1;
4380                  VECTOR_SUB_COMPONENT] THEN
4381     ONCE_REWRITE_TAC[MESON[]
4382        `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN
4383     ASM_SIMP_TAC[REAL_SUB_RZERO] THEN CONJ_TAC THENL
4384      [X_GEN_TAC `x:real^N` THEN
4385       FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4386       FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4387       ASM_REWRITE_TAC[] THEN
4388       ASM_CASES_TAC
4389        `!i. ~(i = m)
4390             ==> 1 <= i /\ i <= dimindex (:N)
4391                 ==> (a:real^N)$i <= (x:real^N)$i /\
4392                     x$i <= (b:real^N)$i` THEN
4393       ASM_REWRITE_TAC[] THEN
4394       FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
4395       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
4396       ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ (d /\ e) /\ f <=>
4397                              (b /\ e) /\ a /\ c /\ d /\ f`] THEN
4398       ONCE_REWRITE_TAC[SET_RULE
4399        `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
4400       MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
4401       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
4402       EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`
4403       THEN CONJ_TAC THENL
4404        [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
4405         REWRITE_TAC[VECTOR_SUB_EQ] THEN
4406         ASM_MESON_TAC[BASIS_INJ];
4407         ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
4408                      NOT_IN_EMPTY] THEN
4409         FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4410         FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4411         ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]];
4412     ALL_TAC] THEN
4413   DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH
4414    `a:real = b + c ==> a = x + b ==> x = c`) THEN
4415   ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES;
4416                LAMBDA_BETA] THEN
4417   REPEAT(COND_CASES_TAC THENL
4418    [ALL_TAC;
4419     FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
4420     MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
4421     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4422     COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
4423     FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
4424     FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4425     ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) THEN
4426   SUBGOAL_THEN `1..dimindex(:N) = m INSERT ((1..dimindex(:N)) DELETE m)`
4427   SUBST1_TAC THENL
4428    [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN
4429     ASM_ARITH_TAC;
4430     ALL_TAC] THEN
4431   SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG] THEN
4432   ASM_SIMP_TAC[IN_DELETE] THEN
4433   MATCH_MP_TAC(REAL_RING
4434    `s1:real = s3 /\ s2 = s3
4435     ==> ((bm + bn) - am) * s1 =
4436         ((am + bn) - am) * s2 + (bm - am) * s3`) THEN
4437   CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN
4438   SIMP_TAC[IN_DELETE] THEN REAL_ARITH_TAC);;
4439
4440 let HAS_MEASURE_LINEAR_IMAGE = prove
4441  (`!f:real^N->real^N s.
4442         linear f /\ measurable s
4443         ==> (IMAGE f s) has_measure (abs(det(matrix f)) * measure s)`,
4444   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4445   MATCH_MP_TAC INDUCT_LINEAR_ELEMENTARY THEN REPEAT CONJ_TAC THENL
4446    [MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
4447     REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4448     DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
4449     DISCH_THEN(CONJUNCTS_THEN2
4450      (MP_TAC o SPEC `IMAGE (g:real^N->real^N) s`)
4451      (MP_TAC o SPEC `s:real^N->bool`)) THEN
4452     ASM_REWRITE_TAC[] THEN
4453     GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN
4454     STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_COMPOSE; DET_MUL; REAL_ABS_MUL] THEN
4455     REWRITE_TAC[IMAGE_o; GSYM REAL_MUL_ASSOC];
4456
4457     MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `m:num`] THEN STRIP_TAC THEN
4458     SUBGOAL_THEN `~(!x y. (f:real^N->real^N) x = f y ==> x = y)`
4459     ASSUME_TAC THENL
4460      [ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
4461       EXISTS_TAC `basis m:real^N` THEN
4462       ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS];
4463       ALL_TAC] THEN
4464     MP_TAC(ISPEC `matrix f:real^N^N` INVERTIBLE_DET_NZ) THEN
4465     ASM_SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_INJECTIVE;
4466                  MATRIX_WORKS; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
4467     DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[HAS_MEASURE_0] THEN
4468     ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE];
4469
4470     MAP_EVERY X_GEN_TAC [`c:num->real`; `s:real^N->bool`] THEN
4471     DISCH_TAC THEN
4472     FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[HAS_MEASURE_MEASURE]) THEN
4473     FIRST_ASSUM(MP_TAC o SPEC `c:num->real` o
4474      MATCH_MP HAS_MEASURE_STRETCH) THEN
4475     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4476     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
4477     SIMP_TAC[matrix; LAMBDA_BETA] THEN
4478     W(MP_TAC o PART_MATCH (lhs o rand) DET_DIAGONAL o rand o snd) THEN
4479     SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; REAL_MUL_RZERO] THEN
4480     DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
4481     REWRITE_TAC[REAL_MUL_RID];
4482
4483     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4484     MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN
4485     ASM_SIMP_TAC[linear; LAMBDA_BETA; IN_DIMINDEX_SWAP; VECTOR_ADD_COMPONENT;
4486                  VECTOR_MUL_COMPONENT; CART_EQ] THEN
4487     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
4488     SUBGOAL_THEN `matrix (\x:real^N. lambda i. x$swap (m,n) i):real^N^N =
4489                   transp(lambda i j. (mat 1:real^N^N)$i$swap (m,n) j)`
4490     SUBST1_TAC THENL
4491      [ASM_SIMP_TAC[MATRIX_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP;
4492                     matrix_vector_mul; CART_EQ; matrix; mat; basis;
4493                     COND_COMPONENT; transp] THEN
4494       REWRITE_TAC[EQ_SYM_EQ];
4495       ALL_TAC] THEN
4496     REWRITE_TAC[DET_TRANSP] THEN
4497     W(MP_TAC o PART_MATCH (lhs o rand) DET_PERMUTE_COLUMNS o
4498         rand o lhand o rand o snd) THEN
4499     ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; ETA_AX] THEN
4500     DISCH_THEN(K ALL_TAC) THEN
4501     REWRITE_TAC[DET_I; REAL_ABS_SIGN; REAL_MUL_RID; REAL_MUL_LID] THEN
4502     ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
4503      [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY];
4504       ALL_TAC] THEN
4505     SUBGOAL_THEN
4506      `~(IMAGE (\x:real^N. lambda i. x$swap (m,n) i)
4507               (interval[a,b]):real^N->bool = {})`
4508     MP_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
4509     SUBGOAL_THEN
4510      `IMAGE (\x:real^N. lambda i. x$swap (m,n) i)
4511               (interval[a,b]):real^N->bool =
4512       interval[(lambda i. a$swap (m,n) i),
4513                (lambda i. b$swap (m,n) i)]`
4514     SUBST1_TAC THENL
4515      [REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_IMAGE] THEN
4516       ASM_SIMP_TAC[LAMBDA_SWAP_GALOIS; UNWIND_THM1] THEN
4517       SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN EQ_TAC THEN
4518       DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4519       FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
4520       ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
4521       ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT];
4522       ALL_TAC] THEN
4523     REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL] THEN
4524     REWRITE_TAC[MEASURE_INTERVAL] THEN
4525     ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM INTERVAL_NE_EMPTY] THEN
4526     DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LAMBDA_BETA] THEN
4527     ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; IN_DIMINDEX_SWAP] THEN
4528     MP_TAC(ISPECL [`\i. (b - a:real^N)$i`; `swap(m:num,n)`; `1..dimindex(:N)`]
4529                 (GSYM PRODUCT_PERMUTE)) THEN
4530     REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
4531     ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG];
4532
4533     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4534     MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN
4535     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
4536      [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4537                    VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
4538       DISCH_TAC] THEN
4539     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
4540     SUBGOAL_THEN
4541       `det(matrix(\x. lambda i. if i = m then (x:real^N)$m + x$n
4542                                 else x$i):real^N^N) = &1`
4543     SUBST1_TAC THENL
4544      [ASM_SIMP_TAC[matrix; basis; COND_COMPONENT; LAMBDA_BETA] THEN
4545       FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
4546        `~(m:num = n) ==> m < n \/ n < m`))
4547       THENL
4548        [W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhs o snd);
4549         W(MP_TAC o PART_MATCH (lhs o rand) DET_LOWERTRIANGULAR o lhs o snd)]
4550       THEN ASM_SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
4551                         matrix; REAL_ADD_RID; COND_ID;
4552                         PRODUCT_CONST_NUMSEG; REAL_POW_ONE] THEN
4553       DISCH_THEN MATCH_MP_TAC THEN
4554       REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
4555       ASM_ARITH_TAC;
4556       ALL_TAC] THEN
4557     REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN
4558     ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
4559      [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY];
4560       ALL_TAC] THEN
4561     SUBGOAL_THEN
4562      `IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i) (interval [a,b]) =
4563       IMAGE (\x:real^N. (lambda i. if i = m \/ i = n then a$n else &0) +
4564                         x)
4565             (IMAGE (\x:real^N. lambda i. if i = m then x$m + x$n else x$i)
4566                    (IMAGE (\x. (lambda i. if i = n then --(a$n) else &0) + x)
4567                           (interval[a,b])))`
4568     SUBST1_TAC THENL
4569      [REWRITE_TAC[GSYM IMAGE_o] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4570       ASM_SIMP_TAC[FUN_EQ_THM; o_THM; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
4571                    CART_EQ] THEN
4572       MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN
4573       STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
4574       ASM_CASES_TAC `i:num = n` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
4575       ALL_TAC] THEN
4576     MATCH_MP_TAC HAS_MEASURE_TRANSLATION THEN
4577     SUBGOAL_THEN
4578      `measure(interval[a,b]) =
4579       measure(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x)
4580                     (interval[a,b]):real^N->bool)`
4581     SUBST1_TAC THENL [REWRITE_TAC[MEASURE_TRANSLATION]; ALL_TAC] THEN
4582     SUBGOAL_THEN
4583      `~(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x)
4584                     (interval[a,b]):real^N->bool = {})`
4585     MP_TAC THENL [ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
4586     ONCE_REWRITE_TAC[VECTOR_ARITH `c + x:real^N = &1 % x + c`] THEN
4587     ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS] THEN
4588     DISCH_TAC THEN MATCH_MP_TAC HAS_MEASURE_SHEAR_INTERVAL THEN
4589     ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
4590     REAL_ARITH_TAC]);;
4591
4592 let MEASURABLE_LINEAR_IMAGE = prove
4593  (`!f:real^N->real^N s.
4594         linear f /\ measurable s ==> measurable(IMAGE f s)`,
4595   REPEAT GEN_TAC THEN
4596   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN
4597   SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);;
4598
4599 let MEASURE_LINEAR_IMAGE = prove
4600  (`!f:real^N->real^N s.
4601         linear f /\ measurable s
4602         ==> measure(IMAGE f s) = abs(det(matrix f)) * measure s`,
4603   REPEAT GEN_TAC THEN
4604   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN
4605   SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);;
4606
4607 let HAS_MEASURE_LINEAR_IMAGE_ALT = prove
4608  (`!f:real^N->real^N s m.
4609         linear f /\ s has_measure m
4610         ==> (IMAGE f s) has_measure (abs(det(matrix f)) * m)`,
4611   MESON_TAC[MEASURE_UNIQUE; measurable; HAS_MEASURE_LINEAR_IMAGE]);;
4612
4613 let HAS_MEASURE_LINEAR_IMAGE_SAME = prove
4614  (`!f s. linear f /\ measurable s /\ abs(det(matrix f)) = &1
4615          ==> (IMAGE f s) has_measure (measure s)`,
4616   MESON_TAC[HAS_MEASURE_LINEAR_IMAGE; REAL_MUL_LID]);;
4617
4618 let MEASURE_LINEAR_IMAGE_SAME = prove
4619  (`!f:real^N->real^N s.
4620         linear f /\ measurable s /\ abs(det(matrix f)) = &1
4621         ==> measure(IMAGE f s) = measure s`,
4622   REPEAT GEN_TAC THEN
4623   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_SAME) THEN
4624   SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);;
4625
4626 let MEASURABLE_LINEAR_IMAGE_EQ = prove
4627  (`!f:real^N->real^N s.
4628         linear f /\ (!x y. f x = f y ==> x = y)
4629         ==> (measurable (IMAGE f s) <=> measurable s)`,
4630   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE MEASURABLE_LINEAR_IMAGE));;
4631
4632 add_linear_invariants [MEASURABLE_LINEAR_IMAGE_EQ];;
4633
4634 let NEGLIGIBLE_LINEAR_IMAGE = prove
4635  (`!f:real^N->real^N s. linear f /\ negligible s ==> negligible(IMAGE f s)`,
4636   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN DISCH_TAC THEN
4637   FIRST_ASSUM(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN
4638   REWRITE_TAC[REAL_MUL_RZERO]);;
4639
4640 let NEGLIGIBLE_LINEAR_IMAGE_EQ = prove
4641  (`!f:real^N->real^N s.
4642         linear f /\ (!x y. f x = f y ==> x = y)
4643         ==> (negligible (IMAGE f s) <=> negligible s)`,
4644   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE NEGLIGIBLE_LINEAR_IMAGE));;
4645
4646 add_linear_invariants [NEGLIGIBLE_LINEAR_IMAGE_EQ];;
4647
4648 let HAS_MEASURE_ORTHOGONAL_IMAGE = prove
4649  (`!f:real^N->real^N s m.
4650         orthogonal_transformation f /\ s has_measure m
4651         ==> (IMAGE f s) has_measure m`,
4652   REPEAT GEN_TAC THEN
4653   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4654   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN
4655   REWRITE_TAC[IMP_IMP] THEN
4656   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN
4657   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4658   MATCH_MP_TAC(REAL_RING `x = &1 ==> x * m = m`) THEN
4659   REWRITE_TAC[REAL_ARITH `abs x = &1 <=> x = &1 \/ x = -- &1`] THEN
4660   MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN
4661   ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]);;
4662
4663 let HAS_MEASURE_ORTHOGONAL_IMAGE_EQ = prove
4664  (`!f:real^N->real^N s m.
4665         orthogonal_transformation f
4666         ==> ((IMAGE f s) has_measure m <=> s has_measure m)`,
4667   REPEAT STRIP_TAC THEN EQ_TAC THEN
4668   ASM_SIMP_TAC[HAS_MEASURE_ORTHOGONAL_IMAGE] THEN
4669   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN
4670   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` MP_TAC) THEN
4671   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4672    REWRITE_TAC[IMP_IMP] THEN
4673   DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_ORTHOGONAL_IMAGE) THEN
4674   ASM_SIMP_TAC[GSYM IMAGE_o; IMAGE_I]);;
4675
4676 add_linear_invariants
4677  [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] HAS_MEASURE_ORTHOGONAL_IMAGE_EQ];;
4678
4679 let MEASURE_ORTHOGONAL_IMAGE_EQ = prove
4680  (`!f:real^N->real^N s.
4681         orthogonal_transformation f
4682         ==> measure(IMAGE f s) = measure s`,
4683   SIMP_TAC[measure; HAS_MEASURE_ORTHOGONAL_IMAGE_EQ]);;
4684
4685 add_linear_invariants
4686  [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] MEASURE_ORTHOGONAL_IMAGE_EQ];;
4687
4688 let HAS_MEASURE_ISOMETRY = prove
4689  (`!f:real^M->real^N s m.
4690         dimindex(:M) = dimindex(:N) /\ linear f /\ (!x. norm(f x) = norm x)
4691         ==> (IMAGE f s has_measure m <=> s has_measure m)`,
4692   REPEAT STRIP_TAC THEN
4693   TRANS_TAC EQ_TRANS
4694    `IMAGE ((\x. lambda i. x$i):real^N->real^M) (IMAGE (f:real^M->real^N) s)
4695     has_measure m` THEN
4696   CONJ_TAC THENL
4697    [SPEC_TAC(`IMAGE (f:real^M->real^N) s`,`s:real^N->bool`) THEN GEN_TAC THEN
4698     CONV_TAC SYM_CONV THEN REWRITE_TAC[has_measure] THEN
4699     W(MP_TAC o PART_MATCH (lhand o rand)
4700         HAS_INTEGRAL_TWIZZLE_EQ o lhand o snd) THEN
4701     REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
4702     ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM I_DEF; PERMUTES_I];
4703     REWRITE_TAC[GSYM IMAGE_o] THEN
4704     MATCH_MP_TAC HAS_MEASURE_ORTHOGONAL_IMAGE_EQ THEN
4705     ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; o_THM] THEN CONJ_TAC THENL
4706      [MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_REWRITE_TAC[] THEN
4707       SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4708                VECTOR_MUL_COMPONENT];
4709       X_GEN_TAC `x:real^M` THEN
4710       TRANS_TAC EQ_TRANS `norm((f:real^M->real^N) x)` THEN
4711       CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN
4712       SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN
4713       FIRST_ASSUM(SUBST1_TAC o SYM) THEN
4714       MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LAMBDA_BETA]]]);;
4715
4716 let MEASURABLE_LINEAR_IMAGE_EQ_GEN = prove
4717  (`!f:real^M->real^N s.
4718         dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y)
4719         ==> (measurable(IMAGE f s) <=> measurable s)`,
4720   REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS
4721    `measurable(IMAGE ((\x. lambda i. x$i):real^N->real^M)
4722                      (IMAGE (f:real^M->real^N) s))` THEN
4723   CONJ_TAC THENL
4724    [CONV_TAC SYM_CONV THEN REWRITE_TAC[measurable] THEN
4725     AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_MEASURE_ISOMETRY THEN
4726     ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
4727      [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4728                VECTOR_MUL_COMPONENT];
4729       SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN
4730       ASM_MESON_TAC[]];
4731     REWRITE_TAC[GSYM IMAGE_o] THEN
4732     MATCH_MP_TAC MEASURABLE_LINEAR_IMAGE_EQ THEN CONJ_TAC THENL
4733      [MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_REWRITE_TAC[] THEN
4734       SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
4735                VECTOR_MUL_COMPONENT];
4736       SIMP_TAC[CART_EQ; LAMBDA_BETA; o_DEF] THEN
4737       ASM_MESON_TAC[CART_EQ]]]);;
4738
4739 let MEASURE_ISOMETRY = prove
4740  (`!f:real^M->real^N s.
4741         dimindex(:M) = dimindex(:N) /\ linear f /\ (!x. norm(f x) = norm x)
4742         ==> measure (IMAGE f s) = measure s`,
4743   REPEAT GEN_TAC THEN REWRITE_TAC[measure] THEN
4744   DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP HAS_MEASURE_ISOMETRY th]));;
4745
4746 (* ------------------------------------------------------------------------- *)
4747 (* Measure of a standard simplex.                                            *)
4748 (* ------------------------------------------------------------------------- *)
4749
4750 let CONGRUENT_IMAGE_STD_SIMPLEX = prove
4751  (`!p. p permutes 1..dimindex(:N)
4752        ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\
4753                        (!i. 1 <= i /\ i < dimindex(:N)
4754                             ==> x$(p i) <= x$(p(i + 1)))} =
4755            IMAGE (\x:real^N. lambda i. sum(1..inverse p(i)) (\j. x$j))
4756                  {x | (!i. 1 <= i /\ i <= dimindex (:N) ==> &0 <= x$i) /\
4757                       sum (1..dimindex (:N)) (\i. x$i) <= &1}`,
4758   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4759    [ALL_TAC;
4760     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
4761     ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
4762                  ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`;
4763                  ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1] THEN
4764     STRIP_TAC THEN
4765     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
4766     ASM_SIMP_TAC[SUM_SING_NUMSEG; DIMINDEX_GE_1; LE_REFL] THEN
4767     REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN
4768     ASM_SIMP_TAC[REAL_LE_ADDR] THEN REPEAT STRIP_TAC THEN
4769     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN
4770   REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
4771   STRIP_TAC THEN
4772   EXISTS_TAC `(lambda i. if i = 1 then x$(p 1)
4773                          else (x:real^N)$p(i) - x$p(i - 1)):real^N` THEN
4774   ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
4775                ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`;
4776                ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1; CART_EQ] THEN
4777   REPEAT CONJ_TAC THENL
4778    [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4779     SUBGOAL_THEN `1 <= inverse (p:num->num) i /\
4780                   !x. x <= inverse p i ==> x <= dimindex(:N)`
4781     ASSUME_TAC THENL
4782      [ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE];
4783       ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH]] THEN
4784     SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN
4785     GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV)
4786                 [GSYM REAL_MUL_LID] THEN
4787     ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
4788     REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
4789     REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
4790     FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
4791      `1 <= p ==> p = 1 \/ 2 <= p`) o CONJUNCT1) THEN
4792     ASM_SIMP_TAC[ARITH] THEN
4793     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
4794     REWRITE_TAC[REAL_ADD_RID] THEN TRY REAL_ARITH_TAC THEN
4795     ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE];
4796
4797     X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN
4798     ASM_REWRITE_TAC[REAL_SUB_LE] THEN
4799     FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
4800     ASM_SIMP_TAC[SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
4801
4802     SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH;
4803              ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN
4804     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o BINDER_CONV)
4805                 [GSYM REAL_MUL_LID] THEN
4806     ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
4807     REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
4808     REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
4809     COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ADD_RID] THEN
4810     ASM_REWRITE_TAC[REAL_ARITH `x + y - x:real = y`] THEN
4811     ASM_MESON_TAC[DIMINDEX_GE_1;
4812                   ARITH_RULE `1 <= n /\ ~(2 <= n) ==> n = 1`]]);;
4813
4814 let HAS_MEASURE_IMAGE_STD_SIMPLEX = prove
4815  (`!p. p permutes 1..dimindex(:N)
4816        ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\
4817                        (!i. 1 <= i /\ i < dimindex(:N)
4818                             ==> x$(p i) <= x$(p(i + 1)))}
4819            has_measure
4820            (measure (convex hull
4821              (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})))`,
4822   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONGRUENT_IMAGE_STD_SIMPLEX] THEN
4823   ASM_SIMP_TAC[GSYM STD_SIMPLEX] THEN
4824   MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE_SAME THEN
4825   REPEAT CONJ_TAC THENL
4826    [REWRITE_TAC[linear; CART_EQ] THEN
4827     ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
4828                  GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL] THEN
4829     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
4830     REPEAT STRIP_TAC THEN REWRITE_TAC[];
4831     MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4832     MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
4833     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4834     MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
4835     REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
4836     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4837      `abs(det
4838        ((lambda i. ((lambda i j. if j <= i then &1 else &0):real^N^N)
4839                    $inverse p i)
4840         :real^N^N))` THEN
4841     CONJ_TAC THENL
4842      [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
4843       ASM_SIMP_TAC[matrix; LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
4844                    LAMBDA_BETA_PERM; PERMUTES_INVERSE] THEN
4845       X_GEN_TAC `i:num` THEN STRIP_TAC THEN
4846       X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
4847       EXISTS_TAC `sum (1..inverse (p:num->num) i)
4848                       (\k. if k = j then &1 else &0)` THEN
4849       CONJ_TAC THENL
4850        [MATCH_MP_TAC SUM_EQ THEN
4851         ASM_SIMP_TAC[IN_NUMSEG; PERMUTES_IN_IMAGE; basis] THEN
4852         REPEAT STRIP_TAC THEN MATCH_MP_TAC LAMBDA_BETA THEN
4853         ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; LE_TRANS;
4854                       PERMUTES_INVERSE];
4855         ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]];
4856       ALL_TAC] THEN
4857     ASM_SIMP_TAC[PERMUTES_INVERSE; DET_PERMUTE_ROWS; ETA_AX] THEN
4858     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SIGN; REAL_MUL_LID] THEN
4859     MATCH_MP_TAC(REAL_ARITH `x = &1 ==> abs x = &1`) THEN
4860     ASM_SIMP_TAC[DET_LOWERTRIANGULAR; GSYM NOT_LT; LAMBDA_BETA] THEN
4861     REWRITE_TAC[LT_REFL; PRODUCT_CONST_NUMSEG; REAL_POW_ONE]]);;
4862
4863 let HAS_MEASURE_STD_SIMPLEX = prove
4864  (`(convex hull (vec 0:real^N INSERT {basis i | 1 <= i /\ i <= dimindex(:N)}))
4865    has_measure inv(&(FACT(dimindex(:N))))`,
4866   let lemma = prove
4867    (`!f:num->real. (!i. 1 <= i /\ i < n ==> f i <= f(i + 1)) <=>
4868                    (!i j. 1 <= i /\ i <= j /\ j <= n ==> f i <= f j)`,
4869     GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4870      [GEN_TAC THEN INDUCT_TAC THEN
4871       SIMP_TAC[LE; REAL_LE_REFL] THEN
4872       STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN
4873       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) j` THEN
4874       ASM_SIMP_TAC[ARITH_RULE `SUC x <= y ==> x <= y`] THEN
4875       REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
4876       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]) in
4877   MP_TAC(ISPECL
4878    [`\p. {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\
4879                      (!i. 1 <= i /\ i < dimindex(:N)
4880                           ==> x$(p i) <= x$(p(i + 1)))}`;
4881     `{p | p permutes 1..dimindex(:N)}`]
4882     HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
4883   ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
4884                             HAS_MEASURE_IMAGE_STD_SIMPLEX; IN_ELIM_THM] THEN
4885   ASM_SIMP_TAC[SUM_CONST; FINITE_PERMUTATIONS; FINITE_NUMSEG;
4886                CARD_PERMUTATIONS; CARD_NUMSEG_1] THEN
4887   ANTS_TAC THENL
4888    [MAP_EVERY X_GEN_TAC [`p:num->num`; `q:num->num`] THEN STRIP_TAC THEN
4889     SUBGOAL_THEN `?i. i IN 1..dimindex(:N) /\ ~(p i:num = q i)` MP_TAC THENL
4890      [ASM_MESON_TAC[permutes; FUN_EQ_THM]; ALL_TAC] THEN
4891     GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
4892     REWRITE_TAC[TAUT `a ==> ~(b /\ ~c) <=> a /\ b ==> c`] THEN
4893     REWRITE_TAC[IN_NUMSEG] THEN
4894     DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
4895     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
4896     EXISTS_TAC `{x:real^N | (basis(p(k:num)) - basis(q k)) dot x = &0}` THEN
4897     CONJ_TAC THENL
4898      [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN
4899       MATCH_MP_TAC BASIS_NE THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG];
4900       ALL_TAC] THEN
4901     REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; DOT_LSUB; VECTOR_SUB_EQ] THEN
4902     ASM_SIMP_TAC[DOT_BASIS; GSYM IN_NUMSEG; PERMUTES_IN_IMAGE] THEN
4903     SUBGOAL_THEN `?l. (q:num->num) l = p(k:num)` STRIP_ASSUME_TAC THENL
4904      [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
4905     SUBGOAL_THEN `1 <= l /\ l <= dimindex(:N)` STRIP_ASSUME_TAC THENL
4906      [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
4907     SUBGOAL_THEN `k:num < l` ASSUME_TAC THENL
4908      [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
4909       ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
4910       ALL_TAC] THEN
4911     SUBGOAL_THEN `?m. (p:num->num) m = q(k:num)` STRIP_ASSUME_TAC THENL
4912      [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
4913     SUBGOAL_THEN `1 <= m /\ m <= dimindex(:N)` STRIP_ASSUME_TAC THENL
4914      [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
4915     SUBGOAL_THEN `k:num < m` ASSUME_TAC THENL
4916      [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
4917       ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
4918       ALL_TAC] THEN
4919     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[lemma] THEN STRIP_TAC THEN
4920     FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
4921     FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN
4922     ASM_SIMP_TAC[LT_IMP_LE; IMP_IMP; REAL_LE_ANTISYM; REAL_SUB_0] THEN
4923     MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN
4924     ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; DOT_BASIS];
4925     ALL_TAC] THEN
4926   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN
4927   DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN CONJ_TAC THENL
4928    [MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
4929     MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
4930     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4931     MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
4932     REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
4933     ALL_TAC] THEN
4934   ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> (x = inv y <=> y * x = &1)`;
4935                REAL_OF_NUM_EQ; FACT_NZ] THEN
4936   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_TRANS THEN
4937   EXISTS_TAC `measure(interval[vec 0:real^N,vec 1])` THEN CONJ_TAC THENL
4938    [AP_TERM_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_UNIT]] THEN
4939   REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4940    [REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ;
4941                 RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN
4942     SIMP_TAC[IMP_IMP; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
4943     X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN
4944     STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN
4945     MATCH_MP_TAC REAL_LE_TRANS THENL
4946      [EXISTS_TAC `(x:real^N)$(p 1)`;
4947       EXISTS_TAC `(x:real^N)$(p(dimindex(:N)))`] THEN
4948     ASM_REWRITE_TAC[] THEN
4949     FIRST_ASSUM(MP_TAC o SPEC `i:num` o MATCH_MP PERMUTES_SURJECTIVE) THEN
4950     ASM_MESON_TAC[LE_REFL; PERMUTES_IN_IMAGE; IN_NUMSEG];
4951     ALL_TAC] THEN
4952   REWRITE_TAC[SET_RULE `s SUBSET UNIONS(IMAGE f t) <=>
4953                         !x. x IN s ==> ?y. y IN t /\ x IN f y`] THEN
4954   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; IN_ELIM_THM] THEN
4955   SIMP_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN
4956   MP_TAC(ISPEC `\i j. ~((x:real^N)$j <= x$i)` TOPOLOGICAL_SORT) THEN
4957   REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN
4958   ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
4959   DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)`; `1..dimindex(:N)`]) THEN
4960   REWRITE_TAC[HAS_SIZE_NUMSEG_1; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN
4961   DISCH_THEN(X_CHOOSE_THEN `f:num->num` (CONJUNCTS_THEN2
4962    (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN
4963   EXISTS_TAC `\i. if i IN 1..dimindex(:N) then f(i) else i` THEN
4964   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE
4965     `1 <= i /\ i <= j /\ j <= n <=>
4966      1 <= i /\ 1 <= j /\ i <= n /\ j <= n /\ i <= j`] THEN
4967   ASM_SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN
4968   CONJ_TAC THENL
4969    [ALL_TAC;
4970     ASM_MESON_TAC[LE_REFL; DIMINDEX_GE_1; LE_LT; REAL_LE_LT]] THEN
4971   SIMP_TAC[PERMUTES_FINITE_SURJECTIVE; FINITE_NUMSEG] THEN
4972   SIMP_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[]);;
4973
4974 (* ------------------------------------------------------------------------- *)
4975 (* Hence the measure of a general simplex.                                   *)
4976 (* ------------------------------------------------------------------------- *)
4977
4978 let HAS_MEASURE_SIMPLEX_0 = prove
4979  (`!l:(real^N)list.
4980         LENGTH l = dimindex(:N)
4981         ==> (convex hull (vec 0 INSERT set_of_list l)) has_measure
4982             abs(det(vector l)) / &(FACT(dimindex(:N)))`,
4983   REPEAT STRIP_TAC THEN
4984   SUBGOAL_THEN
4985    `vec 0 INSERT (set_of_list l) =
4986         IMAGE (\x:real^N. transp(vector l:real^N^N) ** x)
4987               (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})`
4988   SUBST1_TAC THENL
4989    [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4990     REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF] THEN
4991     REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO] THEN AP_TERM_TAC THEN
4992     SIMP_TAC[matrix_vector_mul; vector; transp; LAMBDA_BETA; basis] THEN
4993     ONCE_REWRITE_TAC[COND_RAND] THEN
4994     SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN
4995     REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
4996     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(b /\ c ==> ~a)`] THEN
4997     X_GEN_TAC `y:real^N` THEN SIMP_TAC[LAMBDA_BETA; REAL_MUL_RID] THEN
4998     SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
4999     REWRITE_TAC[NOT_IMP; REAL_MUL_RID; GSYM CART_EQ] THEN
5000     ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN
5001     EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THENL
5002      [EXISTS_TAC `SUC i`; EXISTS_TAC `i - 1`] THEN
5003     ASM_REWRITE_TAC[SUC_SUB1] THEN ASM_ARITH_TAC;
5004     ALL_TAC] THEN
5005   ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
5006   SUBGOAL_THEN
5007    `det(vector l:real^N^N) = det(matrix(\x:real^N. transp(vector l) ** x))`
5008   SUBST1_TAC THENL
5009    [REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; DET_TRANSP]; ALL_TAC] THEN
5010   REWRITE_TAC[real_div] THEN
5011   ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
5012                  HAS_MEASURE_STD_SIMPLEX)] THEN
5013   MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE THEN
5014   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5015   MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
5016   MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
5017   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
5018   MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
5019   REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]);;
5020
5021 let HAS_MEASURE_SIMPLEX = prove
5022  (`!a l:(real^N)list.
5023         LENGTH l = dimindex(:N)
5024         ==> (convex hull (set_of_list(CONS a l))) has_measure
5025             abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`,
5026   REPEAT STRIP_TAC THEN
5027   MP_TAC(ISPEC `MAP (\x:real^N. x - a) l` HAS_MEASURE_SIMPLEX_0) THEN
5028   ASM_REWRITE_TAC[LENGTH_MAP; set_of_list] THEN
5029   DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP HAS_MEASURE_TRANSLATION) THEN
5030   REWRITE_TAC[GSYM CONVEX_HULL_TRANSLATION] THEN
5031   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
5032   REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; SET_OF_LIST_MAP] THEN
5033   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `a + x - a:real^N = x`;
5034               SET_RULE `IMAGE (\x. x) s = s`]);;
5035
5036 let MEASURABLE_CONVEX_HULL = prove
5037  (`!s. bounded s ==> measurable(convex hull s)`,
5038   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN
5039   ASM_SIMP_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL]);;
5040
5041 let MEASURABLE_SIMPLEX = prove
5042  (`!l. measurable(convex hull (set_of_list l))`,
5043   GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX_HULL THEN
5044   MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_SET_OF_LIST]);;
5045
5046 let MEASURE_SIMPLEX = prove
5047  (`!a l:(real^N)list.
5048         LENGTH l = dimindex(:N)
5049         ==> measure(convex hull (set_of_list(CONS a l))) =
5050             abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`,
5051   MESON_TAC[HAS_MEASURE_SIMPLEX; HAS_MEASURE_MEASURABLE_MEASURE]);;
5052
5053 (* ------------------------------------------------------------------------- *)
5054 (* Area of a triangle.                                                       *)
5055 (* ------------------------------------------------------------------------- *)
5056
5057 let HAS_MEASURE_TRIANGLE = prove
5058  (`!a b c:real^2.
5059         convex hull {a,b,c} has_measure
5060         abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`,
5061   REPEAT STRIP_TAC THEN
5062   MP_TAC(ISPECL [`a:real^2`; `[b;c]:(real^2)list`] HAS_MEASURE_SIMPLEX) THEN
5063   REWRITE_TAC[LENGTH; DIMINDEX_2; ARITH; set_of_list; MAP] THEN
5064   CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_2; VECTOR_2] THEN
5065   SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH]);;
5066
5067 let MEASURABLE_TRIANGLE = prove
5068  (`!a b c:real^N. measurable(convex hull {a,b,c})`,
5069   REPEAT GEN_TAC THEN
5070   MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
5071   MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
5072   REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);;
5073
5074 let MEASURE_TRIANGLE = prove
5075  (`!a b c:real^2.
5076         measure(convex hull {a,b,c}) =
5077         abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`,
5078   REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
5079                HAS_MEASURE_TRIANGLE]);;
5080
5081 (* ------------------------------------------------------------------------- *)
5082 (* Volume of a tetrahedron.                                                  *)
5083 (* ------------------------------------------------------------------------- *)
5084
5085 let HAS_MEASURE_TETRAHEDRON = prove
5086  (`!a b c d:real^3.
5087         convex hull {a,b,c,d} has_measure
5088         abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
5089             (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
5090             (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
5091             (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
5092             (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
5093             (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) /
5094            &6`,
5095   REPEAT STRIP_TAC THEN
5096   MP_TAC(ISPECL [`a:real^3`; `[b;c;d]:(real^3)list`] HAS_MEASURE_SIMPLEX) THEN
5097   REWRITE_TAC[LENGTH; DIMINDEX_3; ARITH; set_of_list; MAP] THEN
5098   CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_3; VECTOR_3] THEN
5099   SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH]);;
5100
5101 let MEASURABLE_TETRAHEDRON = prove
5102  (`!a b c d:real^N. measurable(convex hull {a,b,c,d})`,
5103   REPEAT GEN_TAC THEN
5104   MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
5105   MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
5106   REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);;
5107
5108 let MEASURE_TETRAHEDRON = prove
5109  (`!a b c d:real^3.
5110         measure(convex hull {a,b,c,d}) =
5111         abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
5112             (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
5113             (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
5114             (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
5115             (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
5116             (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / &6`,
5117   REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
5118                HAS_MEASURE_TETRAHEDRON]);;
5119
5120 (* ------------------------------------------------------------------------- *)
5121 (* Steinhaus's theorem. (Stromberg's proof as given on Wikipedia.)           *)
5122 (* ------------------------------------------------------------------------- *)
5123
5124 let STEINHAUS = prove
5125  (`!s:real^N->bool.
5126         measurable s /\ &0 < measure s
5127         ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`,
5128   REPEAT STRIP_TAC THEN
5129   MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`]
5130     MEASURABLE_INNER_COMPACT) THEN
5131   MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`]
5132     MEASURABLE_OUTER_OPEN) THEN
5133   ASM_REWRITE_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN
5134   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
5135   DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
5136   MP_TAC(ISPECL [`k:real^N->bool`; `(:real^N) DIFF u`]
5137     SEPARATE_COMPACT_CLOSED) THEN
5138   ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN
5139   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5140   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
5141   ASM_REWRITE_TAC[] THEN
5142   REWRITE_TAC[SUBSET; IN_BALL_0; IN_ELIM_THM] THEN
5143   X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
5144   SUBGOAL_THEN `~((IMAGE (\x:real^N. v + x) k) INTER k = {})` MP_TAC THENL
5145    [DISCH_TAC THEN
5146     MP_TAC(ISPECL [`IMAGE (\x:real^N. v + x) k`; `k:real^N->bool`]
5147         MEASURE_UNION) THEN
5148     ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_EMPTY] THEN
5149     REWRITE_TAC[MEASURE_TRANSLATION; REAL_SUB_RZERO] THEN
5150     MATCH_MP_TAC(REAL_ARITH
5151      `!s:real^N->bool u:real^N->bool.
5152         measure u < measure s + measure s / &3 /\
5153         measure s < measure k + measure s / &3 /\
5154         measure x <= measure u
5155         ==> ~(measure x = measure k + measure k)`) THEN
5156     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
5157     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5158     ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_UNION] THEN
5159     ASM_REWRITE_TAC[UNION_SUBSET] THEN
5160     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5161     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
5162     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5163     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `v + x:real^N`]) THEN
5164     ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; NORM_ARITH
5165      `d <= dist(x:real^N,v + x) <=> ~(norm v < d)`];
5166     REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_IMAGE] THEN
5167     REWRITE_TAC[VECTOR_ARITH `v:real^N = x - y <=> x = v + y`] THEN
5168     ASM SET_TAC[]]);;
5169
5170 (* ------------------------------------------------------------------------- *)
5171 (* A measurable set with cardinality less than c is negligible.              *)
5172 (* ------------------------------------------------------------------------- *)
5173
5174 let MEASURABLE_NONNEGLIGIBLE_IMP_LARGE = prove
5175  (`!s:real^N->bool. measurable s /\ &0 < measure s ==> s =_c (:real)`,
5176   REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THENL
5177    [ASM_MESON_TAC[NEGLIGIBLE_FINITE; MEASURABLE_MEASURE_POS_LT];
5178     ALL_TAC] THEN
5179   DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN
5180   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5181   REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
5182    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
5183     REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
5184     REWRITE_TAC[CARD_EQ_EUCLIDEAN];
5185     ALL_TAC] THEN
5186   TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL
5187    [MESON_TAC[CARD_EQ_EUCLIDEAN; CARD_EQ_SYM; CARD_EQ_IMP_LE]; ALL_TAC] THEN
5188   TRANS_TAC CARD_LE_TRANS `interval(vec 0:real^N,vec 1)` THEN CONJ_TAC THENL
5189    [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
5190     MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN
5191     MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVAL_UNIV THEN
5192     REWRITE_TAC[UNIT_INTERVAL_NONEMPTY];
5193     ALL_TAC] THEN
5194   TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^N,vec 1]` THEN
5195   SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CARD_LE_SUBSET] THEN
5196   TRANS_TAC CARD_LE_TRANS `cball(vec 0:real^N,d / &2)` THEN CONJ_TAC THENL
5197    [MATCH_MP_TAC CARD_EQ_IMP_LE THEN
5198     MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN
5199     MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN
5200     REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; INTERIOR_CLOSED_INTERVAL;
5201                 CONVEX_CBALL; COMPACT_CBALL; UNIT_INTERVAL_NONEMPTY;
5202                 INTERIOR_CBALL; BALL_EQ_EMPTY] THEN
5203     ASM_REAL_ARITH_TAC;
5204     ALL_TAC] THEN
5205   TRANS_TAC CARD_LE_TRANS `ball(vec 0:real^N,d)` THEN CONJ_TAC THENL
5206    [MATCH_MP_TAC CARD_LE_SUBSET THEN
5207     REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC;
5208     ALL_TAC] THEN
5209   TRANS_TAC CARD_LE_TRANS `IMAGE (\(x:real^N,y). x - y) (s *_c s)` THEN
5210   CONJ_TAC THENL
5211    [ASM_SIMP_TAC[mul_c; CARD_LE_SUBSET; SET_RULE
5212      `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`];
5213     ALL_TAC] THEN
5214   TRANS_TAC CARD_LE_TRANS `((s:real^N->bool) *_c s)` THEN
5215   REWRITE_TAC[CARD_LE_IMAGE] THEN
5216   MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN
5217   ASM_REWRITE_TAC[INFINITE]);;
5218
5219 let MEASURABLE_SMALL_IMP_NEGLIGIBLE = prove
5220  (`!s:real^N->bool. measurable s /\ s <_c (:real) ==> negligible s`,
5221   GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> ~c ==> ~b`] THEN
5222   SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT] THEN REWRITE_TAC[IMP_IMP] THEN
5223   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_NONNEGLIGIBLE_IMP_LARGE) THEN
5224   REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);;
5225
5226 (* ------------------------------------------------------------------------- *)
5227 (* Austin's Lemma.                                                           *)
5228 (* ------------------------------------------------------------------------- *)
5229
5230 let AUSTIN_LEMMA = prove
5231  (`!D. FINITE D /\
5232        (!d. d IN D
5233             ==> ?k a b. d = interval[a:real^N,b] /\
5234                         (!i. 1 <= i /\ i <= dimindex(:N) ==> b$i - a$i = k))
5235        ==> ?D'. D' SUBSET D /\ pairwise DISJOINT D' /\
5236                 measure(UNIONS D') >=
5237                 measure(UNIONS D) / &3 pow (dimindex(:N))`,
5238   GEN_TAC THEN WF_INDUCT_TAC `CARD(D:(real^N->bool)->bool)` THEN
5239   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN
5240   ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL
5241    [ASM_REWRITE_TAC[SUBSET_EMPTY; UNWIND_THM2; PAIRWISE_EMPTY] THEN
5242     REWRITE_TAC[UNIONS_0; real_ge; MEASURE_EMPTY; NOT_IN_EMPTY] THEN
5243     REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_LE_REFL];
5244     ALL_TAC] THEN
5245   SUBGOAL_THEN
5246    `?d:real^N->bool. d IN D /\ !d'. d' IN D ==> measure d' <= measure d`
5247   STRIP_ASSUME_TAC THENL
5248    [MP_TAC(ISPEC `IMAGE measure (D:(real^N->bool)->bool)` SUP_FINITE) THEN
5249     ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN SET_TAC[];
5250     ALL_TAC] THEN
5251   FIRST_X_ASSUM(MP_TAC o SPEC
5252     `{c:real^N->bool | c IN (D DELETE d) /\ c INTER d = {}}`) THEN
5253   ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN
5254   ASM_SIMP_TAC[FINITE_DELETE; FINITE_RESTRICT; IN_ELIM_THM; real_ge] THEN
5255   ANTS_TAC THENL [ASM_SIMP_TAC[IN_DELETE]; ALL_TAC] THEN
5256   DISCH_THEN(X_CHOOSE_THEN `D':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
5257   EXISTS_TAC `(d:real^N->bool) INSERT D'` THEN REPEAT CONJ_TAC THENL
5258    [ASM SET_TAC[];
5259     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
5260     REWRITE_TAC[pairwise; IN_INSERT] THEN ASM SET_TAC[];
5261     ALL_TAC] THEN
5262   SUBGOAL_THEN
5263    `?a3 b3:real^N.
5264         measure(interval[a3,b3]) = &3 pow dimindex(:N) * measure d /\
5265         !c. c IN D /\ ~(c INTER d = {}) ==> c SUBSET interval[a3,b3]`
5266   STRIP_ASSUME_TAC THENL
5267    [USE_THEN "*" (MP_TAC o SPEC `d:real^N->bool`) THEN
5268     ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
5269     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5270     MAP_EVERY X_GEN_TAC [`k:real`; `a:real^N`; `b:real^N`] THEN
5271     DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
5272     EXISTS_TAC `inv(&2) % (a + b) - &3 / &2 % (b - a):real^N` THEN
5273     EXISTS_TAC `inv(&2) % (a + b) + &3 / &2 % (b - a):real^N` THEN
5274     CONJ_TAC THENL
5275      [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5276       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
5277                   VECTOR_MUL_COMPONENT] THEN
5278       REWRITE_TAC[REAL_ARITH `(x + &3 / &2 * a) - (x - &3 / &2 * a) = &3 * a`;
5279                   REAL_ARITH `x - a <= x + a <=> &0 <= a`] THEN
5280       ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
5281       ASM_SIMP_TAC[REAL_ARITH `&0 <= &3 / &2 * x - &0 <=> &0 <= x`] THEN
5282       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
5283       SIMP_TAC[PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; REAL_POW_MUL];
5284       X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
5285       REMOVE_THEN "*" (MP_TAC o SPEC `c:real^N->bool`) THEN
5286       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5287       MAP_EVERY X_GEN_TAC [`k':real`; `a':real^N`; `b':real^N`] THEN
5288       DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
5289       FIRST_X_ASSUM(MP_TAC o
5290         GEN_REWRITE_RULE RAND_CONV [DISJOINT_INTERVAL]) THEN
5291       REWRITE_TAC[NOT_EXISTS_THM; SUBSET_INTERVAL] THEN
5292       REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
5293       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5294       ASM_CASES_TAC `1 <= i` THEN ASM_REWRITE_TAC[] THEN
5295       ASM_CASES_TAC `i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
5296       FIRST_X_ASSUM(MP_TAC o SPEC `interval[a':real^N,b']`) THEN
5297       ASM_REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5298       REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN
5299       REWRITE_TAC[REAL_ARITH `a$k <= b$k <=> &0 <= b$k - a$k`] THEN
5300       ASM_SIMP_TAC[IN_NUMSEG] THEN
5301       ASM_CASES_TAC `&0 <= k` THEN ASM_REWRITE_TAC[] THEN
5302       ASM_CASES_TAC `&0 <= k'` THEN ASM_REWRITE_TAC[] THEN
5303       REPEAT(FIRST_X_ASSUM(fun th ->
5304         SIMP_TAC[th] THEN MP_TAC(ISPEC `i:num` th))) THEN
5305       ASM_SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG] THEN
5306       DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
5307        (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`]
5308         REAL_POW_LE2_REV)) THEN
5309       ASM_SIMP_TAC[DIMINDEX_GE_1; LE_1] THEN
5310       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
5311                   VECTOR_MUL_COMPONENT] THEN
5312       ASM_REAL_ARITH_TAC];
5313     ALL_TAC] THEN
5314   REWRITE_TAC[UNIONS_INSERT] THEN
5315   SUBGOAL_THEN `!d:real^N->bool. d IN D ==> measurable d` ASSUME_TAC THENL
5316    [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
5317   W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DISJOINT_UNION o
5318     rand o snd) THEN
5319   ANTS_TAC THENL
5320    [ASM_SIMP_TAC[] THEN
5321     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5322     MATCH_MP_TAC MEASURABLE_UNIONS THEN
5323     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5324     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
5325       FINITE_SUBSET)) THEN
5326     ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_DELETE];
5327     DISCH_THEN SUBST1_TAC] THEN
5328   ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5329   MATCH_MP_TAC REAL_LE_TRANS THEN
5330   EXISTS_TAC `measure(interval[a3:real^N,b3]) +
5331               measure(UNIONS D DIFF interval[a3,b3])` THEN
5332   CONJ_TAC THENL
5333    [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNION o
5334       rand o snd) THEN
5335     ANTS_TAC THENL
5336      [ASM_SIMP_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF;
5337                    MEASURABLE_INTERVAL] THEN SET_TAC[];
5338       DISCH_THEN(SUBST1_TAC o SYM) THEN
5339       MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
5340        [ASM_SIMP_TAC[MEASURABLE_UNIONS];
5341         ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF;
5342                      MEASURABLE_INTERVAL; MEASURABLE_UNION];
5343         SET_TAC[]]];
5344     ASM_REWRITE_TAC[REAL_ARITH `a * x + y <= (x + z) * a <=> y <= z * a`] THEN
5345     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5346     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5347      `y <= a ==> x <= y ==> x <= a`)) THEN
5348     SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5349     MATCH_MP_TAC MEASURE_SUBSET THEN
5350     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNIONS; MEASURABLE_INTERVAL;
5351                  IN_ELIM_THM; IN_DELETE; FINITE_DELETE; FINITE_RESTRICT] THEN
5352     ASM SET_TAC[]]);;
5353
5354 (* ------------------------------------------------------------------------- *)
5355 (* Some differentiability-like properties of the indefinite integral.        *)
5356 (* The first two proofs are minor variants of each other, but it was more    *)
5357 (* work to derive one from the other.                                        *)
5358 (* ------------------------------------------------------------------------- *)
5359
5360 let INTEGRABLE_CCONTINUOUS_EXPLICIT = prove
5361  (`!f:real^M->real^N.
5362     (!a b. f integrable_on interval[a,b])
5363     ==> ?k. negligible k /\
5364          !x e. ~(x IN k) /\ &0 < e
5365                ==> ?d. &0 < d /\
5366                        !h. &0 < h /\ h < d
5367                            ==> norm(inv(content(interval[x,x + h % vec 1])) %
5368                                     integral (interval[x,x + h % vec 1]) f -
5369                                     f(x)) < e`,
5370   REPEAT STRIP_TAC THEN REWRITE_TAC[IN_UNIV] THEN
5371   MAP_EVERY ABBREV_TAC
5372    [`box = \h x. interval[x:real^M,x + h % vec 1]`;
5373     `box2 = \h x. interval[x:real^M - h % vec 1,x + h % vec 1]`;
5374     `i = \h:real x:real^M. inv(content(box h x)) %
5375                       integral (box h x) (f:real^M->real^N)`] THEN
5376   SUBGOAL_THEN
5377    `?k. negligible k /\
5378         !x e. ~(x IN k) /\ &0 < e
5379               ==> ?d. &0 < d /\
5380                       !h. &0 < h /\ h < d
5381                           ==> norm(i h x - (f:real^M->real^N) x) < e`
5382   MP_TAC THENL
5383    [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN
5384   EXISTS_TAC
5385    `{x | ~(!e. &0 < e
5386               ==> ?d. &0 < d /\
5387                       !h. &0 < h /\ h < d
5388                           ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN
5389   SIMP_TAC[IN_ELIM_THM] THEN
5390   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
5391   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
5392   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5393   EXISTS_TAC
5394    `UNIONS {{x | !d. &0 < d
5395                      ==> ?h. &0 < h /\ h < d /\
5396                              inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)}
5397             |  k IN (:num)}` THEN
5398   CONJ_TAC THENL
5399    [ALL_TAC;
5400     REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5401     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
5402     MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN
5403     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN
5404     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
5405     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
5406     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN
5407     X_GEN_TAC `d:real` THEN DISCH_TAC THEN
5408     FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN
5409     ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN
5410     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5411     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5412     ASM_REWRITE_TAC[dist] THEN
5413     MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
5414     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN
5415     CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
5416     MATCH_MP_TAC REAL_LE_INV2 THEN
5417     ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
5418     ASM_ARITH_TAC] THEN
5419   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN
5420   X_GEN_TAC `jj:num` THEN
5421   SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL
5422    [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
5423     SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN
5424   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
5425   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
5426   ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL
5427    [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN
5428   RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN
5429   RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
5430   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
5431   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5432   MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`]
5433     HENSTOCK_LEMMA) THEN
5434   ANTS_TAC THENL
5435    [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN
5436   DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &6 pow (dimindex(:M))`) THEN
5437   ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL;
5438                REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5439   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN
5440   REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN
5441   ABBREV_TAC
5442     `E = {x | x IN interval[a,b] /\
5443               !d. &0 < d
5444                    ==> ?h. &0 < h /\ h < d /\
5445                            mu <= dist(i h x,(f:real^M->real^N) x)}` THEN
5446   SUBGOAL_THEN
5447    `!x. x IN E
5448         ==> ?h. &0 < h /\
5449                 (box h x:real^M->bool) SUBSET (g x) /\
5450                 (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\
5451                 mu <= dist(i h x,(f:real^M->real^N) x)`
5452   MP_TAC THENL
5453    [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN
5454     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5455     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN
5456     REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
5457     DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
5458     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5459     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5460      (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN
5461     REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN
5462     ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN
5463     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5464     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5465      [MATCH_MP_TAC SUBSET_TRANS THEN
5466       EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN
5467       EXPAND_TAC "box" THEN
5468       REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN
5469       X_GEN_TAC `y:real^M` THEN
5470       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5471                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5472       DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5473       EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN
5474       REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
5475       REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN
5476       SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN
5477       X_GEN_TAC `i:num` THEN STRIP_TAC THEN
5478       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
5479       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
5480       UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN
5481       EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN
5482       DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN
5483       REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
5484       X_GEN_TAC `i:num` THEN
5485       DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5486       ASM_REWRITE_TAC[] THEN
5487       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5488                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5489       ASM_REAL_ARITH_TAC];
5490     ALL_TAC] THEN
5491   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5492   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5493   X_GEN_TAC `uv:real^M->real` THEN
5494   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
5495   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
5496   MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`;
5497                  `\x:real^M. if x IN E then ball(x,uv x) else g(x)`]
5498    COVERING_LEMMA) THEN
5499   REWRITE_TAC[] THEN ANTS_TAC THENL
5500    [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL
5501      [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN
5502     REWRITE_TAC[gauge] THEN GEN_TAC THEN
5503     COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
5504     RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[];
5505     ALL_TAC] THEN
5506   DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN
5507   EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5508   SUBGOAL_THEN
5509    `measurable(UNIONS D:real^M->bool) /\
5510     measure(UNIONS D) <= measure(interval[a:real^M,b])`
5511   STRIP_ASSUME_TAC THENL
5512    [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
5513     ASM_REWRITE_TAC[] THEN
5514     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN
5515     REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5516     REWRITE_TAC[MEASURABLE_INTERVAL] THEN
5517     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5518     MATCH_MP_TAC MEASURABLE_UNIONS THEN
5519     ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5520     ALL_TAC] THEN
5521   ASM_REWRITE_TAC[] THEN
5522   SUBGOAL_THEN
5523    `?d. d SUBSET D /\ FINITE d /\
5524         measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)`
5525   STRIP_ASSUME_TAC THENL
5526    [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL
5527      [EXISTS_TAC `{}:(real^M->bool)->bool` THEN
5528       ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN
5529       CONV_TAC REAL_RAT_REDUCE_CONV;
5530       MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`;
5531                      `measure(UNIONS D:real^M->bool) / &2`]
5532                 MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN
5533       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5534        [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN
5535         ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN
5536         CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
5537         REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5538         REPEAT(CONJ_TAC THENL
5539           [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS];
5540            ALL_TAC]) THEN
5541         ASM SET_TAC[];
5542         MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]];
5543     ALL_TAC] THEN
5544   FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN
5545   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
5546   ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN
5547   SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
5548   DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN
5549   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5550    `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN
5551   MP_TAC(ISPEC
5552    `IMAGE (\k:real^M->bool. (box2:real->real^M->real^M->bool)
5553                             (uv(tag k):real) ((tag k:real^M))) d`
5554    AUSTIN_LEMMA) THEN
5555   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
5556    [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box2" THEN
5557     EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN
5558     EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN
5559     EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN
5560     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5561                 VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5562     ASM_REAL_ARITH_TAC;
5563     ALL_TAC] THEN
5564   REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN
5565   SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5566   DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN
5567   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5568   MATCH_MP_TAC(REAL_ARITH
5569    `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN
5570   CONJ_TAC THENL
5571    [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
5572      [MATCH_MP_TAC MEASURABLE_UNIONS THEN
5573       ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5574       MATCH_MP_TAC MEASURABLE_UNIONS THEN
5575       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5576       EXPAND_TAC "box2" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
5577       REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN
5578       X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN
5579       X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5580       UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN
5581       REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
5582       EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN
5583       CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5584       EXPAND_TAC "box2" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN
5585       X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
5586       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5587                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5588
5589       SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
5590       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
5591       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]];
5592     ALL_TAC] THEN
5593   MATCH_MP_TAC REAL_LE_TRANS THEN
5594   EXISTS_TAC `measure(UNIONS (IMAGE (\k:real^M->bool.
5595                             (box:real->real^M->real^M->bool)
5596                             (uv(tag k):real) ((tag k:real^M))) p)) *
5597               &6 pow dimindex (:M)` THEN
5598   CONJ_TAC THENL
5599    [SUBGOAL_THEN
5600      `!box. IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool)
5601                                     (uv(tag k):real) ((tag k:real^M))) p =
5602              IMAGE (\t. box (uv t) t) (IMAGE tag p)`
5603      (fun th -> REWRITE_TAC[th])
5604     THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF]; ALL_TAC] THEN
5605     W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
5606         lhand o rand o snd) THEN
5607     W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
5608         lhand o lhand o rand o snd) THEN
5609     MATCH_MP_TAC(TAUT
5610      `fp /\ (mb /\ mb') /\ (db /\ db') /\ (m1 /\ m2 ==> p)
5611       ==> (fp /\ mb /\ db ==> m1) ==> (fp /\ mb' /\ db' ==> m2) ==> p`) THEN
5612     SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL
5613      [ASM_MESON_TAC[FINITE_SUBSET]; ASM_SIMP_TAC[FINITE_IMAGE]] THEN
5614     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5615      [MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5616       REWRITE_TAC[MEASURABLE_INTERVAL];
5617       ALL_TAC] THEN
5618     CONJ_TAC THENL
5619      [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5620       REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; AND_FORALL_THM] THEN
5621       MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN
5622       MATCH_MP_TAC(TAUT
5623         `(q ==> r) /\ (p ==> q) ==> (p ==> q) /\ (p ==> r)`) THEN
5624       CONJ_TAC THENL
5625        [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
5626         MATCH_MP_TAC(SET_RULE
5627         `s SUBSET s' /\ t SUBSET t' ==> (s INTER t) SUBSET (s' INTER t')`) THEN
5628         CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5629         REWRITE_TAC[SUBSET_INTERVAL] THEN
5630         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5631                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5632         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5633         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5634         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5635         ALL_TAC] THEN
5636       STRIP_TAC THEN
5637       MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN
5638       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
5639       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5640       DISCH_THEN(MP_TAC o SPEC `k1:real^M->bool`) THEN
5641       ASM_REWRITE_TAC[] THEN
5642       DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool`) THEN
5643       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5644        [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5645         REWRITE_TAC[SUBSET_INTERVAL] THEN
5646         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5647                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5648         REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN
5649         SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\
5650                       &0 <= uv((tag:(real^M->bool)->real^M) k2)`
5651         STRIP_ASSUME_TAC THENL
5652          [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN
5653         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
5654         MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN
5655         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5656         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5657         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5658         SET_TAC[]];
5659       ALL_TAC] THEN
5660     DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN
5661     REWRITE_TAC[GSYM SUM_RMUL] THEN
5662     MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN
5663     X_GEN_TAC `t:real^M` THEN DISCH_THEN(K ALL_TAC) THEN
5664     SUBST1_TAC(REAL_ARITH `&6 = &2 * &3`) THEN
5665     REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN
5666     AP_THM_TAC THEN AP_TERM_TAC THEN
5667     MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5668     REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5669     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5670                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5671     REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`;
5672                 REAL_ARITH `a - x <= a + x <=> &0 <= x`] THEN
5673     COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
5674     REWRITE_TAC[REAL_ARITH `(t + h) - (t - h):real = &2 * h`;
5675                 REAL_ARITH `(t + h) - t:real = h`] THEN
5676     REWRITE_TAC[PRODUCT_MUL_NUMSEG; PRODUCT_CONST_NUMSEG] THEN
5677     REWRITE_TAC[ADD_SUB; REAL_MUL_AC];
5678     ALL_TAC] THEN
5679   SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5680   SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL
5681    [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
5682   MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
5683   EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN
5684   FIRST_X_ASSUM(MP_TAC o SPEC
5685    `IMAGE (\k. (tag:(real^M->bool)->real^M) k,
5686                 (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN
5687   ANTS_TAC THENL
5688    [REWRITE_TAC[tagged_partial_division_of; fine] THEN
5689     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5690     REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN
5691     REWRITE_TAC[MESON[]
5692      `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=>
5693       (!k. k IN d ==> P (tag k) (g k))`] THEN
5694     ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL
5695      [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
5696        [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN
5697         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5698                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5699         GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
5700          `&0 < u ==> x <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET];
5701         ASM_MESON_TAC[SUBSET];
5702         EXPAND_TAC "box" THEN MESON_TAC[]];
5703       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
5704       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5705       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN
5706       ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
5707       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN
5708       ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
5709       ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN
5710       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5711        [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5712         REWRITE_TAC[SUBSET_INTERVAL] THEN
5713         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5714                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5715         REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN
5716         SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\
5717                       &0 <= uv((tag:(real^M->bool)->real^M) k2)`
5718         STRIP_ASSUME_TAC THENL
5719          [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN
5720         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
5721         MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN
5722         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5723         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5724         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5725         MATCH_MP_TAC(SET_RULE
5726          `i1 SUBSET s1 /\ i2 SUBSET s2
5727           ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN
5728         CONJ_TAC THEN MATCH_MP_TAC(MESON[INTERIOR_SUBSET; SUBSET_TRANS]
5729          `s SUBSET t ==> interior s SUBSET t`) THEN
5730         MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN
5731         REWRITE_TAC[SUBSET_INTERVAL] THEN
5732         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5733                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5734         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
5735         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5736         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC];
5737       ASM_MESON_TAC[SUBSET]];
5738     ALL_TAC] THEN
5739   MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN
5740   CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN
5741   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
5742   W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN
5743   ANTS_TAC THENL
5744    [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5745     EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
5746     ALL_TAC] THEN
5747   MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN
5748   ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN
5749   MATCH_MP_TAC SUM_LE_INCLUDED THEN
5750   ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN
5751   REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN
5752   EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN
5753   X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
5754   EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5755   SUBGOAL_THEN
5756    `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC
5757   THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5758   SUBGOAL_THEN
5759    `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)`
5760   MP_TAC THENL
5761    [EXPAND_TAC "box" THEN
5762     REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5763     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5764                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5765     ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a <= a + x`] THEN
5766     MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN
5767     REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
5768     ALL_TAC] THEN
5769   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
5770   DISCH_THEN(fun th ->
5771    GEN_REWRITE_TAC (funpow 2 RAND_CONV)
5772     [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN
5773    ASSUME_TAC th) THEN
5774   REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN
5775   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN
5776   SUBGOAL_THEN
5777    `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N,
5778                f(tag k))`
5779   MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
5780   MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN
5781   ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN
5782   REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN
5783   UNDISCH_TAC
5784     `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real)
5785                 (tag k):real^M->bool)` THEN
5786   EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN
5787   SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN
5788   REWRITE_TAC[VECTOR_MUL_LID]);;
5789
5790 let INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC = prove
5791  (`!f:real^M->real^N.
5792     (!a b. f integrable_on interval[a,b])
5793     ==> ?k. negligible k /\
5794          !x e. ~(x IN k) /\ &0 < e
5795                ==> ?d. &0 < d /\
5796                        !h. &0 < h /\ h < d
5797                 ==> norm(inv(content(interval[x - h % vec 1,x + h % vec 1])) %
5798                     integral (interval[x - h % vec 1,x + h % vec 1]) f -
5799                     f(x)) < e`,
5800   REPEAT STRIP_TAC THEN
5801   MAP_EVERY ABBREV_TAC
5802    [`box = \h x. interval[x - h % vec 1:real^M,x + h % vec 1]`;
5803     `i = \h:real x:real^M. inv(content(box h x)) %
5804                       integral (box h x) (f:real^M->real^N)`] THEN
5805   SUBGOAL_THEN
5806    `?k. negligible k /\
5807         !x e. ~(x IN k) /\ &0 < e
5808               ==> ?d. &0 < d /\
5809                       !h. &0 < h /\ h < d
5810                           ==> norm(i h x - (f:real^M->real^N) x) < e`
5811   MP_TAC THENL
5812    [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN
5813   EXISTS_TAC
5814    `{x | ~(!e. &0 < e
5815               ==> ?d. &0 < d /\
5816                       !h. &0 < h /\ h < d
5817                           ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN
5818   SIMP_TAC[IN_ELIM_THM] THEN
5819   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
5820   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
5821   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5822   EXISTS_TAC
5823    `UNIONS {{x | !d. &0 < d
5824                      ==> ?h. &0 < h /\ h < d /\
5825                              inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)}
5826             |  k IN (:num)}` THEN
5827   CONJ_TAC THENL
5828    [ALL_TAC;
5829     REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5830     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
5831     MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN
5832     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN
5833     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
5834     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
5835     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN
5836     X_GEN_TAC `d:real` THEN DISCH_TAC THEN
5837     FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN
5838     ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN
5839     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5840     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5841     ASM_REWRITE_TAC[dist] THEN
5842     MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
5843     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN
5844     CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
5845     MATCH_MP_TAC REAL_LE_INV2 THEN
5846     ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
5847     ASM_ARITH_TAC] THEN
5848   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN
5849   X_GEN_TAC `jj:num` THEN
5850   SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL
5851    [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
5852     SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN
5853   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
5854   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
5855   ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL
5856    [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN
5857   RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN
5858   RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
5859   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
5860   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5861   MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`]
5862     HENSTOCK_LEMMA) THEN
5863   ANTS_TAC THENL
5864    [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN
5865   DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &3 pow (dimindex(:M))`) THEN
5866   ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL;
5867                REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5868   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN
5869   REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN
5870   ABBREV_TAC
5871     `E = {x | x IN interval[a,b] /\
5872               !d. &0 < d
5873                    ==> ?h. &0 < h /\ h < d /\
5874                            mu <= dist(i h x,(f:real^M->real^N) x)}` THEN
5875   SUBGOAL_THEN
5876    `!x. x IN E
5877         ==> ?h. &0 < h /\
5878                 (box h x:real^M->bool) SUBSET (g x) /\
5879                 (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\
5880                 mu <= dist(i h x,(f:real^M->real^N) x)`
5881   MP_TAC THENL
5882    [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN
5883     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5884     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN
5885     REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
5886     DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
5887     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5888     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5889      (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN
5890     REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN
5891     ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN
5892     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN
5893     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5894      [MATCH_MP_TAC SUBSET_TRANS THEN
5895       EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN
5896       EXPAND_TAC "box" THEN
5897       REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN
5898       X_GEN_TAC `y:real^M` THEN
5899       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5900                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5901       SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
5902       DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5903       EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN
5904       REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
5905       REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN
5906       SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN
5907       ASM_MESON_TAC[REAL_LET_TRANS];
5908       UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN
5909       EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN
5910       DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN
5911       REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
5912       X_GEN_TAC `i:num` THEN
5913       DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5914       ASM_REWRITE_TAC[] THEN
5915       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5916                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5917       ASM_REAL_ARITH_TAC];
5918     ALL_TAC] THEN
5919   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5920   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5921   X_GEN_TAC `uv:real^M->real` THEN
5922   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
5923   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
5924   MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`;
5925                  `\x:real^M. if x IN E then ball(x,uv x) else g(x)`]
5926    COVERING_LEMMA) THEN
5927   REWRITE_TAC[] THEN ANTS_TAC THENL
5928    [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL
5929      [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN
5930     REWRITE_TAC[gauge] THEN GEN_TAC THEN
5931     COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
5932     RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[];
5933     ALL_TAC] THEN
5934   DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN
5935   EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
5936   SUBGOAL_THEN
5937    `measurable(UNIONS D:real^M->bool) /\
5938     measure(UNIONS D) <= measure(interval[a:real^M,b])`
5939   STRIP_ASSUME_TAC THENL
5940    [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
5941     ASM_REWRITE_TAC[] THEN
5942     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN
5943     REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5944     REWRITE_TAC[MEASURABLE_INTERVAL] THEN
5945     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5946     MATCH_MP_TAC MEASURABLE_UNIONS THEN
5947     ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
5948     ALL_TAC] THEN
5949   ASM_REWRITE_TAC[] THEN
5950   SUBGOAL_THEN
5951    `?d. d SUBSET D /\ FINITE d /\
5952         measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)`
5953   STRIP_ASSUME_TAC THENL
5954    [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL
5955      [EXISTS_TAC `{}:(real^M->bool)->bool` THEN
5956       ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN
5957       CONV_TAC REAL_RAT_REDUCE_CONV;
5958       MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`;
5959                      `measure(UNIONS D:real^M->bool) / &2`]
5960                 MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN
5961       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5962        [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN
5963         ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN
5964         CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
5965         REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
5966         REPEAT(CONJ_TAC THENL
5967           [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS];
5968            ALL_TAC]) THEN
5969         ASM SET_TAC[];
5970         MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]];
5971     ALL_TAC] THEN
5972   FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN
5973   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
5974   ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN
5975   SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
5976   DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN
5977   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5978    `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN
5979   MP_TAC(ISPEC
5980    `IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool)
5981                             (uv(tag k):real) ((tag k:real^M))) d`
5982    AUSTIN_LEMMA) THEN
5983   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
5984    [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box" THEN
5985     EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN
5986     EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN
5987     EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN
5988     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
5989                 VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
5990     ASM_REAL_ARITH_TAC;
5991     ALL_TAC] THEN
5992   REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN
5993   SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5994   DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN
5995   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5996   MATCH_MP_TAC(REAL_ARITH
5997    `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN
5998   CONJ_TAC THENL
5999    [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL
6000      [MATCH_MP_TAC MEASURABLE_UNIONS THEN
6001       ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
6002       MATCH_MP_TAC MEASURABLE_UNIONS THEN
6003       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
6004       EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
6005       REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN
6006       X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN
6007       X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6008       UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN
6009       REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
6010       EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN
6011       CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
6012       EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN
6013       X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
6014       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6015                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6016       SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
6017       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
6018       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]];
6019     ALL_TAC] THEN
6020   SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
6021   SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL
6022    [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
6023   MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
6024   EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN
6025   FIRST_X_ASSUM(MP_TAC o SPEC
6026    `IMAGE (\k. (tag:(real^M->bool)->real^M) k,
6027                 (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN
6028   ANTS_TAC THENL
6029    [REWRITE_TAC[tagged_partial_division_of; fine] THEN
6030     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6031     REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN
6032     REWRITE_TAC[MESON[]
6033      `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=>
6034       (!k. k IN d ==> P (tag k) (g k))`] THEN
6035     ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL
6036      [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
6037        [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN
6038         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6039                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6040         GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
6041          `&0 < u ==> x - u <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET];
6042         ASM_MESON_TAC[SUBSET];
6043         EXPAND_TAC "box" THEN MESON_TAC[]];
6044       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
6045       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
6046       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN
6047       ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
6048       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN
6049       ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN
6050       ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN
6051       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
6052        [EXPAND_TAC "box" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
6053         REWRITE_TAC[SUBSET_INTERVAL] THEN
6054         REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6055                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6056         REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN
6057         SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\
6058                       &0 <= uv((tag:(real^M->bool)->real^M) k2)`
6059         STRIP_ASSUME_TAC THENL
6060          [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN
6061         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
6062         MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN
6063         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
6064         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
6065         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
6066         MATCH_MP_TAC(SET_RULE
6067          `i1 SUBSET s1 /\ i2 SUBSET s2
6068           ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN
6069         REWRITE_TAC[INTERIOR_SUBSET]];
6070       ASM_MESON_TAC[SUBSET]];
6071     ALL_TAC] THEN
6072   MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN
6073   CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN
6074   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
6075   W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN
6076   ANTS_TAC THENL
6077    [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
6078     EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL];
6079     ALL_TAC] THEN
6080   MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN
6081   ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN
6082   MATCH_MP_TAC SUM_LE_INCLUDED THEN
6083   ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN
6084   REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN
6085   EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN
6086   X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
6087   EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
6088   SUBGOAL_THEN
6089    `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC
6090   THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
6091   SUBGOAL_THEN
6092    `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag
6093 k):real^M->bool)`
6094   MP_TAC THENL
6095    [EXPAND_TAC "box" THEN
6096     REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
6097     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6098                    VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6099     ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a - x <= a + x`] THEN
6100     MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN
6101     REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
6102     ALL_TAC] THEN
6103   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
6104   DISCH_THEN(fun th ->
6105    GEN_REWRITE_TAC (funpow 2 RAND_CONV)
6106     [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN
6107    ASSUME_TAC th) THEN
6108   REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN
6109   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN
6110   SUBGOAL_THEN
6111    `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N,
6112                f(tag k))`
6113   MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
6114   MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN
6115   ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN
6116   REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN
6117   UNDISCH_TAC
6118     `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real)
6119                 (tag k):real^M->bool)` THEN
6120   EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN
6121   SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN
6122   REWRITE_TAC[VECTOR_MUL_LID]);;
6123
6124 let HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL = prove
6125  (`!f:real^1->real^N a b.
6126         f integrable_on interval[a,b]
6127         ==> ?k. negligible k /\
6128                 !x. x IN interval[a,b] DIFF k
6129                     ==> ((\x. integral(interval[a,x]) f) has_vector_derivative
6130                          f(x)) (at x within interval[a,b])`,
6131   SUBGOAL_THEN
6132    `!f:real^1->real^N a b.
6133         f integrable_on interval[a,b]
6134         ==> ?k. negligible k /\
6135                 !x e. x IN interval[a,b] DIFF k /\ & 0 < e
6136                       ==> ?d. &0 < d /\
6137                               !x'. x' IN interval[a,b] /\
6138                                    drop x < drop x' /\ drop x' < drop x + d
6139                                    ==> norm(integral(interval[x,x']) f -
6140                                             drop(x' - x) % f x) /
6141                                        norm(x' - x) < e`
6142   ASSUME_TAC THENL
6143    [REPEAT STRIP_TAC THEN MP_TAC(ISPEC
6144      `(\x. if x IN interval[a,b] then f x else vec 0):real^1->real^N`
6145      INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN
6146     REWRITE_TAC[] THEN ANTS_TAC THENL
6147      [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
6148       EXISTS_TAC `(:real^1)` THEN
6149       ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; SUBSET_UNIV];
6150       ALL_TAC] THEN
6151     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
6152     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6153     MAP_EVERY X_GEN_TAC [`x:real^1`; `e:real`] THEN
6154     REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
6155     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN
6156     ASM_REWRITE_TAC[] THEN
6157     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
6158     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6159     X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN
6160     FIRST_X_ASSUM(MP_TAC o SPEC `drop y - drop x`) THEN
6161     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6162     SUBGOAL_THEN `x + (drop y - drop x) % vec 1 = y` SUBST1_TAC THENL
6163      [REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN
6164       REAL_ARITH_TAC;
6165       ALL_TAC] THEN
6166     ASM_SIMP_TAC[CONTENT_1; REAL_LT_IMP_LE] THEN
6167     MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN
6168     ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ;
6169                  GSYM DROP_EQ; REAL_LT_IMP_NE] THEN
6170     SUBGOAL_THEN `norm(y - x) = abs(drop y - drop x)` SUBST1_TAC THENL
6171      [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB]; ALL_TAC] THEN
6172     REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM NORM_MUL)] THEN
6173     REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN
6174     ASM_SIMP_TAC[REAL_FIELD `x < y ==> (y - x) * inv(y - x) = &1`] THEN
6175     AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_MUL_LID] THEN
6176     AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN
6177     X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN
6178     COND_CASES_TAC THEN REWRITE_TAC[] THEN
6179     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
6180     ALL_TAC] THEN
6181   REPEAT STRIP_TAC THEN
6182   FIRST_X_ASSUM(fun th ->
6183     MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `b:real^1`] th) THEN
6184     MP_TAC(ISPECL [`\x. (f:real^1->real^N) (--x)`; `--b:real^1`;
6185                    `--a:real^1`] th)) THEN
6186   ASM_REWRITE_TAC[INTEGRABLE_REFLECT] THEN
6187   DISCH_THEN(X_CHOOSE_THEN `k2:real^1->bool`
6188     (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
6189   DISCH_THEN(X_CHOOSE_THEN `k1:real^1->bool`
6190     (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
6191   EXISTS_TAC `k1 UNION IMAGE (--) k2:real^1->bool` THEN CONJ_TAC THENL
6192    [MATCH_MP_TAC NEGLIGIBLE_UNION THEN ASM_REWRITE_TAC[] THEN
6193     MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[linear] THEN
6194     VECTOR_ARITH_TAC;
6195     ALL_TAC] THEN
6196   X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN
6197   REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `x:real^1 = --x' <=> --x = x'`] THEN
6198   REWRITE_TAC[UNWIND_THM1] THEN STRIP_TAC THEN
6199   REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN] THEN CONJ_TAC THENL
6200    [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC;
6201     ALL_TAC] THEN
6202   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6203   REMOVE_THEN "2" (MP_TAC o SPECL [`--x:real^1`; `e:real`]) THEN
6204   REMOVE_THEN "1" (MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN
6205   ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_REFLECT] THEN
6206   DISCH_THEN(X_CHOOSE_THEN `d1:real`
6207    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
6208   DISCH_THEN(X_CHOOSE_THEN `d2:real`
6209    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
6210   EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6211   X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN
6212   REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
6213   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN STRIP_TAC THEN
6214   SUBGOAL_THEN `drop x < drop y \/ drop y < drop x` DISJ_CASES_TAC THENL
6215    [ASM_REAL_ARITH_TAC;
6216     REMOVE_THEN "1" (MP_TAC o SPEC `y:real^1`) THEN
6217     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6218     REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
6219     MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN
6220     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
6221     AP_THM_TAC THEN AP_TERM_TAC THEN
6222     MATCH_MP_TAC(VECTOR_ARITH `c + a:real^N = b ==> a = b - c`) THEN
6223     MATCH_MP_TAC INTEGRAL_COMBINE THEN
6224     REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
6225     MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
6226     MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN
6227     ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC;
6228     REMOVE_THEN "2" (MP_TAC o SPEC `--y:real^1`) THEN
6229     ANTS_TAC THENL [SIMP_TAC[DROP_NEG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6230     SUBGOAL_THEN `norm(--y - --x) = abs(drop y - drop x)` SUBST1_TAC THENL
6231      [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; DROP_NEG] THEN
6232       ASM_REAL_ARITH_TAC;
6233       ALL_TAC] THEN
6234     MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN
6235     AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[INTEGRAL_REFLECT] THEN
6236     REWRITE_TAC[VECTOR_NEG_NEG; DROP_SUB; DROP_NEG] THEN
6237     ONCE_REWRITE_TAC[VECTOR_ARITH
6238       `x - (--a - --b) % y:real^N = --(--x - (a - b) % y)`] THEN
6239     REWRITE_TAC[NORM_NEG] THEN AP_TERM_TAC THEN
6240     AP_THM_TAC THEN AP_TERM_TAC THEN
6241     MATCH_MP_TAC(VECTOR_ARITH `b + a = c ==> --a:real^N = b - c`) THEN
6242     MATCH_MP_TAC INTEGRAL_COMBINE THEN
6243     REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
6244     MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
6245     MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN
6246     ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);;
6247
6248 let ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS = prove
6249  (`!f:real^M->real^N.
6250     (!a b. f absolutely_integrable_on interval[a,b])
6251     ==> ?k. negligible k /\
6252             !x e. ~(x IN k) /\ &0 < e
6253                   ==> ?d. &0 < d /\
6254                           !h. &0 < h /\ h < d
6255                              ==> norm(inv(content(interval[x - h % vec 1,
6256                                                            x + h % vec 1])) %
6257                                       integral (interval[x - h % vec 1,
6258                                                          x + h % vec 1])
6259                                                (\t. lift(norm(f t - f x))))
6260                                  < e`,
6261   REPEAT STRIP_TAC THEN
6262   MP_TAC(GEN `r:real^N` (ISPEC `\t. lift(norm((f:real^M->real^N) t - r))`
6263         INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC)) THEN
6264   REWRITE_TAC[] THEN
6265   DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
6266    [REPEAT GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
6267     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
6268     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
6269     ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST];
6270     ALL_TAC] THEN
6271   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
6272   X_GEN_TAC `k:real^N->real^M->bool` THEN STRIP_TAC THEN
6273   EXISTS_TAC
6274    `UNIONS (IMAGE (k:real^N->real^M->bool)
6275            {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)})` THEN
6276   CONJ_TAC THENL
6277    [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
6278     ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RATIONAL_COORDINATES] THEN
6279     ASM_REWRITE_TAC[FORALL_IN_IMAGE];
6280     ALL_TAC] THEN
6281   MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN
6282   REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; NOT_EXISTS_THM] THEN
6283   REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN STRIP_TAC THEN
6284   MP_TAC(SET_RULE `(f:real^M->real^N) x IN (:real^N)`) THEN
6285   REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN
6286   REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
6287   DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
6288   ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
6289   DISCH_THEN(X_CHOOSE_THEN `r:real^N` STRIP_ASSUME_TAC) THEN
6290   FIRST_X_ASSUM(MP_TAC o SPECL [`r:real^N`; `x:real^M`; `e / &3`]) THEN
6291   ASM_SIMP_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
6292   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6293   ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN
6294   FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN ASM_REWRITE_TAC[] THEN
6295   MATCH_MP_TAC(NORM_ARITH
6296    `norm(y1:real^N) < e / &3 /\ norm(i1 - i2) <= e / &3
6297     ==> norm(i1 - y1) < e / &3 ==> norm(i2) < e`) THEN
6298   REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN
6299   CONJ_TAC THENL [ASM_MESON_TAC[dist; DIST_SYM]; ALL_TAC] THEN
6300   REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
6301   MATCH_MP_TAC REAL_LE_TRANS THEN
6302   EXISTS_TAC
6303    `abs(inv(content(interval[x - h % vec 1,x + h % vec 1]))) *
6304     drop(integral (interval[x - h % vec 1,x + h % vec 1])
6305                   (\x:real^M. lift(e / &3)))` THEN
6306   CONJ_TAC THENL
6307    [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
6308     W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN
6309     ANTS_TAC THENL
6310      [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
6311       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
6312       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
6313       ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST];
6314       DISCH_THEN(SUBST1_TAC o SYM) THEN
6315       MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
6316       REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL
6317        [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
6318         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN
6319         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
6320         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
6321         ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST];
6322         X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
6323         REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP; GSYM LIFT_SUB] THEN
6324         ASM_MESON_TAC[NORM_ARITH
6325          `dist(r,x) < e / &3
6326           ==> abs(norm(y - r:real^N) - norm(y - x)) <= e / &3`]]];
6327     ASM_CASES_TAC
6328      `content(interval[x - h % vec 1:real^M,x + h % vec 1]) = &0`
6329     THENL
6330      [ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
6331       ASM_REAL_ARITH_TAC;
6332       REWRITE_TAC[REAL_ABS_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6333       ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ;
6334                    GSYM REAL_ABS_NZ] THEN
6335       REWRITE_TAC[INTEGRAL_CONST; DROP_CMUL; LIFT_DROP] THEN
6336       SIMP_TAC[real_abs; CONTENT_POS_LE; REAL_MUL_SYM; REAL_LE_REFL]]]);;
6337
6338 (* ------------------------------------------------------------------------- *)
6339 (* Measurability of a function on a set (not necessarily itself measurable). *)
6340 (* ------------------------------------------------------------------------- *)
6341
6342 parse_as_infix("measurable_on",(12,"right"));;
6343
6344 let measurable_on = new_definition
6345  `(f:real^M->real^N) measurable_on s <=>
6346         ?k g. negligible k /\
6347               (!n. (g n) continuous_on (:real^M)) /\
6348               (!x. ~(x IN k)
6349                    ==> ((\n. g n x) --> if x IN s then f(x) else vec 0)
6350                        sequentially)`;;
6351
6352 let MEASURABLE_ON_UNIV = prove
6353  (`(\x.  if x IN s then f(x) else vec 0) measurable_on (:real^M) <=>
6354    f measurable_on s`,
6355   REWRITE_TAC[measurable_on; IN_UNIV; ETA_AX]);;
6356
6357 (* ------------------------------------------------------------------------- *)
6358 (* Lebesgue measurability (like "measurable" but allowing infinite measure)  *)
6359 (* ------------------------------------------------------------------------- *)
6360
6361 let lebesgue_measurable = new_definition
6362  `lebesgue_measurable s <=> (indicator s) measurable_on (:real^N)`;;
6363
6364 (* ------------------------------------------------------------------------- *)
6365 (* Relation between measurability and integrability.                         *)
6366 (* ------------------------------------------------------------------------- *)
6367
6368 let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove
6369  (`!f:real^M->real^N g s.
6370         f measurable_on s /\
6371         g integrable_on s /\
6372         (!x. x IN s ==> norm(f x) <= drop(g x))
6373         ==> f integrable_on s`,
6374   let lemma = prove
6375    (`!f:real^M->real^N g a b.
6376           f measurable_on (:real^M) /\
6377           g integrable_on interval[a,b] /\
6378           (!x. x IN interval[a,b] ==> norm(f x) <= drop(g x))
6379           ==> f integrable_on interval[a,b]`,
6380     REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN
6381     REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
6382     MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `h:num->real^M->real^N`] THEN
6383     STRIP_TAC THEN
6384     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
6385     EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL
6386      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6387        NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
6388       ALL_TAC] THEN
6389     MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN
6390     MAP_EVERY EXISTS_TAC
6391      [`h:num->real^M->real^N`; `g:real^M->real^1`] THEN
6392     ASM_SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN
6393     X_GEN_TAC `n:num` THEN
6394     UNDISCH_TAC `(g:real^M->real^1) integrable_on interval [a,b]` THEN
6395     SUBGOAL_THEN
6396      `(h:num->real^M->real^N) n absolutely_integrable_on interval[a,b]`
6397     MP_TAC THENL
6398      [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THEN
6399       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
6400       REWRITE_TAC[IMP_IMP; absolutely_integrable_on; GSYM CONJ_ASSOC] THEN
6401       REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
6402       MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
6403       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6404        NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]) in
6405   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THEN
6406   MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN
6407   EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN
6408   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
6409   MATCH_MP_TAC lemma THEN
6410   EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN
6411   RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_ALT]) THEN
6412   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
6413   COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_POS]);;
6414
6415 let MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE = prove
6416  (`!f:real^M->real^N g s k.
6417         f measurable_on s /\ g integrable_on s /\ negligible k /\
6418         (!x. x IN s DIFF k ==> norm(f x) <= drop(g x))
6419         ==> f integrable_on s`,
6420   REPEAT STRIP_TAC THEN
6421   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC
6422    `\x. if x IN k then lift(norm((f:real^M->real^N) x)) else g x` THEN
6423   ASM_SIMP_TAC[COND_RAND; IN_DIFF; LIFT_DROP; REAL_LE_REFL; COND_ID] THEN
6424   MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN
6425   MAP_EVERY EXISTS_TAC [`g:real^M->real^1`; `k:real^M->bool`] THEN
6426   ASM_SIMP_TAC[IN_DIFF]);;
6427
6428 let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove
6429  (`!f:real^M->real^N g s.
6430         f measurable_on s /\
6431         g integrable_on s /\
6432         (!x. x IN s ==> norm(f x) <= drop(g x))
6433         ==> f absolutely_integrable_on s`,
6434   REPEAT STRIP_TAC THEN
6435   MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^1`]
6436     ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND) THEN
6437   DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
6438    [REWRITE_TAC[NORM_REAL; GSYM drop] THEN
6439     ASM_MESON_TAC[REAL_ABS_LE; REAL_LE_TRANS];
6440     ASM_MESON_TAC[MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE];
6441     MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
6442     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6443     ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop] THEN
6444     ASM_MESON_TAC[NORM_ARITH `norm(x) <= a ==> &0 <= a`]]);;
6445
6446 let INTEGRAL_DROP_LE_MEASURABLE = prove
6447  (`!f g s:real^N->bool.
6448         f measurable_on s /\
6449         g integrable_on s /\
6450         (!x. x IN s ==> &0 <= drop(f x) /\ drop(f x) <= drop(g x))
6451         ==> drop(integral s f) <= drop(integral s g)`,
6452   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[] THEN
6453   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
6454   EXISTS_TAC `g:real^N->real^1` THEN
6455   ASM_SIMP_TAC[NORM_REAL; GSYM drop; real_abs]);;
6456
6457 let INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE = prove
6458  (`!f:real^M->real^N.
6459         (!a b. f integrable_on interval[a,b]) ==> f measurable_on (:real^M)`,
6460   REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN
6461   MAP_EVERY ABBREV_TAC
6462    [`box = \h x. interval[x:real^M,x + h % vec 1]`;
6463     `i = \h:real x:real^M. inv(content(box h x)) %
6464                       integral (box h x) (f:real^M->real^N)`] THEN
6465   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6466   EXISTS_TAC `(\n x. i (inv(&n + &1)) x):num->real^M->real^N` THEN
6467   REWRITE_TAC[] THEN
6468   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
6469   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
6470    [REWRITE_TAC[continuous_on; IN_UNIV] THEN
6471     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`; `e:real`] THEN
6472     DISCH_TAC THEN EXPAND_TAC "i" THEN EXPAND_TAC "box" THEN
6473     MP_TAC(ISPECL
6474      [`f:real^M->real^N`;
6475       `x - &2 % vec 1:real^M`;
6476       `x + &2 % vec 1:real^M`;
6477       `x:real^M`;
6478       `x + inv(&n + &1) % vec 1:real^M`;
6479       `e * (&1 / (&n + &1)) pow dimindex(:M)`]
6480      INDEFINITE_INTEGRAL_CONTINUOUS) THEN
6481     ANTS_TAC THENL
6482      [ASM_REWRITE_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT;
6483         REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
6484       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
6485        [SUBGOAL_THEN `&0 <= inv(&n + &1) /\ inv(&n + &1) <= &1` MP_TAC THENL
6486          [ALL_TAC; REAL_ARITH_TAC] THEN
6487         ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN
6488         MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC;
6489         MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN
6490         MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LT_DIV THEN
6491         REAL_ARITH_TAC];
6492       DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
6493       EXISTS_TAC `min k (&1)` THEN
6494       ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN
6495       ASM_REWRITE_TAC[dist] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
6496       REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN
6497       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6498                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6499       REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`] THEN
6500       REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN
6501       REWRITE_TAC[REAL_ARITH `(x + inv y) - x = &1 / y`] THEN
6502       REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB] THEN
6503       REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
6504       REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_DIV] THEN
6505       REWRITE_TAC[REAL_ABS_NUM; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN
6506       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
6507       ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_POW_LT;
6508                    REAL_ARITH `&0 < &1 /\ &0 < &n + &1`] THEN
6509       FIRST_X_ASSUM MATCH_MP_TAC THEN
6510       REWRITE_TAC[VECTOR_ARITH `(y + i) - (x + i):real^N = y - x`;
6511                   VECTOR_ARITH `(y - i) - (x - i):real^N = y - x`] THEN
6512       ASM_SIMP_TAC[IN_INTERVAL; REAL_LT_IMP_LE] THEN
6513       REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist;
6514                   VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
6515       REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN
6516       ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN
6517       MATCH_MP_TAC(REAL_ARITH
6518        `&0 <= i /\ i <= &1 /\ abs(x - y) <= &1
6519         ==> (x - &2 <= y /\ y <= x + &2) /\
6520             (x - &2 <= y + i /\ y + i <= x + &2)`) THEN
6521       ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1;
6522                    REAL_ARITH `&0 <= &n + &1 /\ &1 <= &n + &1`] THEN
6523       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
6524       ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; NORM_SUB;
6525                     REAL_LE_TRANS]];
6526     FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN
6527     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
6528     ASM_CASES_TAC `negligible(k:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN
6529     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN
6530     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
6531     REWRITE_TAC[LIM_SEQUENTIALLY] THEN
6532     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
6533     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
6534     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6535     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6536     MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN
6537     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
6538     STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
6539     MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[dist] THEN
6540     FIRST_X_ASSUM MATCH_MP_TAC THEN
6541     REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
6542     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
6543     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
6544     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
6545     ASM_ARITH_TAC]);;
6546
6547 let INTEGRABLE_IMP_MEASURABLE = prove
6548  (`!f:real^M->real^N s.
6549         f integrable_on s ==> f measurable_on s`,
6550   REPEAT GEN_TAC THEN
6551   ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV; GSYM MEASURABLE_ON_UNIV] THEN
6552   SPEC_TAC(`\x. if x IN s then (f:real^M->real^N) x else vec 0`,
6553            `f:real^M->real^N`) THEN
6554   REPEAT STRIP_TAC THEN
6555   MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
6556   REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
6557   EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);;
6558
6559 let ABSOLUTELY_INTEGRABLE_MEASURABLE = prove
6560  (`!f:real^M->real^N s.
6561         f absolutely_integrable_on s <=>
6562         f measurable_on s /\ (\x. lift(norm(f x))) integrable_on s`,
6563   REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN
6564   MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN
6565   REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE] THEN STRIP_TAC THEN
6566   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
6567   EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))` THEN
6568   ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);;
6569
6570 (* ------------------------------------------------------------------------- *)
6571 (* Composing continuous and measurable functions; a few variants.            *)
6572 (* ------------------------------------------------------------------------- *)
6573
6574 let MEASURABLE_ON_COMPOSE_CONTINUOUS = prove
6575  (`!f:real^M->real^N g:real^N->real^P.
6576         f measurable_on (:real^M) /\ g continuous_on (:real^N)
6577         ==> (g o f) measurable_on (:real^M)`,
6578   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6579   REWRITE_TAC[measurable_on; IN_UNIV] THEN
6580   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
6581   DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
6582   EXISTS_TAC `\n x. (g:real^N->real^P) ((h:num->real^M->real^N) n x)` THEN
6583   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6584    [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6585     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
6586     ASM_REWRITE_TAC[ETA_AX] THEN
6587     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
6588     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6589     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6590      [CONTINUOUS_ON_SEQUENTIALLY]) THEN
6591     ASM_SIMP_TAC[o_DEF; IN_UNIV]]);;
6592
6593 let MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove
6594  (`!f:real^M->real^N g:real^N->real^P s.
6595         f measurable_on s /\ g continuous_on (:real^N) /\ g(vec 0) = vec 0
6596         ==> (g o f) measurable_on s`,
6597   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6598   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
6599   DISCH_TAC THEN
6600   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN
6601   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6602   REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);;
6603
6604 let MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove
6605  (`!f:real^M->real^N g:real^N->real^P a b.
6606         f measurable_on (:real^M) /\
6607         (!x. f(x) IN interval(a,b)) /\
6608         g continuous_on interval(a,b)
6609         ==> (g o f) measurable_on (:real^M)`,
6610   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6611   REWRITE_TAC[measurable_on; IN_UNIV] THEN
6612   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
6613   DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
6614   EXISTS_TAC
6615    `(\n x. (g:real^N->real^P)
6616            (lambda i. max ((a:real^N)$i + (b$i - a$i) / (&n + &2))
6617                           (min ((h n x:real^N)$i)
6618                                ((b:real^N)$i - (b$i - a$i) / (&n + &2)))))
6619     :num->real^M->real^P` THEN
6620   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6621    [X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6622     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
6623      [MP_TAC(ISPECL
6624        [`(:real^M)`;
6625         `(lambda i. (b:real^N)$i - (b$i - (a:real^N)$i) / (&n + &2)):real^N`]
6626          CONTINUOUS_ON_CONST) THEN
6627       FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
6628       REWRITE_TAC[IMP_IMP] THEN
6629       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN
6630       MP_TAC(ISPECL
6631        [`(:real^M)`;
6632         `(lambda i. (a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2)):real^N`]
6633          CONTINUOUS_ON_CONST) THEN
6634       REWRITE_TAC[IMP_IMP] THEN
6635       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN
6636       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6637       SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA];
6638       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
6639       EXISTS_TAC `interval(a:real^N,b)` THEN
6640       ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN
6641       X_GEN_TAC `x:real^M` THEN
6642       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M` o CONJUNCT1) THEN
6643       SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN
6644       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
6645       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_TAC THEN
6646       SUBGOAL_THEN
6647         `&0 < ((b:real^N)$i - (a:real^N)$i) / (&n + &2) /\
6648          ((b:real^N)$i - (a:real^N)$i) / (&n + &2) <= (b$i - a$i) / &2` MP_TAC
6649       THENL [ALL_TAC; REAL_ARITH_TAC] THEN
6650       ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ;
6651                    REAL_ARITH `&0 < &n + &2`] THEN
6652       CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[real_div]] THEN
6653       MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
6654        [ASM_REAL_ARITH_TAC;
6655         MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC]];
6656     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6657     REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN
6658     CONJ_TAC THENL
6659      [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_INTERVAL];
6660       ALL_TAC] THEN
6661     SUBGOAL_THEN
6662      `((\n. (lambda i. ((a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2))))
6663        --> a) sequentially /\
6664       ((\n. (lambda i. ((b:real^N)$i - ((b:real^N)$i - a$i) / (&n + &2))))
6665        --> b) sequentially`
6666     MP_TAC THENL
6667      [ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
6668       SIMP_TAC[LAMBDA_BETA] THEN
6669       CONJ_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
6670       REWRITE_TAC[real_sub] THEN
6671       GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN
6672       REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC LIM_ADD THEN
6673       REWRITE_TAC[LIM_CONST; LIFT_NEG; real_div; LIFT_CMUL] THEN
6674       GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_0] THEN
6675       TRY(MATCH_MP_TAC LIM_NEG) THEN REWRITE_TAC[VECTOR_NEG_0] THEN
6676       SUBST1_TAC(VECTOR_ARITH
6677        `vec 0:real^1 = ((b:real^N)$j + --((a:real^N)$j)) % vec 0`) THEN
6678       MATCH_MP_TAC LIM_CMUL THEN
6679       REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0; NORM_LIFT] THEN
6680       X_GEN_TAC `e:real` THEN
6681       GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
6682       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
6683       X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN
6684       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
6685       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
6686       ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1;
6687                    REAL_OF_NUM_LE; REAL_ABS_NUM] THEN
6688       ASM_ARITH_TAC;
6689       ALL_TAC] THEN
6690     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
6691     ASM_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> a /\ c ==> b ==> d`] THEN
6692     DISCH_THEN(MP_TAC o MATCH_MP LIM_MIN) THEN
6693     REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
6694     DISCH_THEN(MP_TAC o MATCH_MP LIM_MAX) THEN
6695     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN
6696     SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN
6697     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
6698     ASM_MESON_TAC[REAL_ARITH `a < x /\ x < b ==> max a (min x b) = x`]]);;
6699
6700 let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove
6701  (`!f:real^M->real^N g:real^N->real^P s.
6702         closed s /\
6703         f measurable_on (:real^M) /\
6704         (!x. f(x) IN s) /\
6705         g continuous_on s
6706         ==> (g o f) measurable_on (:real^M)`,
6707   REPEAT STRIP_TAC THEN
6708   MP_TAC(ISPECL [`g:real^N->real^P`; `(:real^N)`; `s:real^N->bool`]
6709     TIETZE_UNBOUNDED) THEN
6710   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
6711   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^P` THEN
6712   DISCH_TAC THEN SUBGOAL_THEN
6713    `(g:real^N->real^P) o (f:real^M->real^N) = h o f` SUBST1_TAC
6714   THENL [ASM_SIMP_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN
6715   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[]);;
6716
6717 let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove
6718  (`!f:real^M->real^N g:real^N->real^P s t.
6719         closed s /\
6720         f measurable_on t /\
6721         (!x. f(x) IN s) /\
6722         g continuous_on s /\
6723         vec 0 IN s /\ g(vec 0) = vec 0
6724         ==> (g o f) measurable_on t`,
6725   REPEAT STRIP_TAC THEN
6726   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6727   MP_TAC(ISPECL [`(\x. if x IN t then f x else vec 0):real^M->real^N`;
6728                  `g:real^N->real^P`; `s:real^N->bool`]
6729         MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN
6730   ANTS_TAC THENL
6731    [ASM_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN ASM_MESON_TAC[];
6732     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6733     REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[]]);;
6734
6735 (* ------------------------------------------------------------------------- *)
6736 (* Basic closure properties of measurable functions.                         *)
6737 (* ------------------------------------------------------------------------- *)
6738
6739 let CONTINUOUS_IMP_MEASURABLE_ON = prove
6740  (`!f:real^M->real^N. f continuous_on (:real^M) ==> f measurable_on (:real^M)`,
6741   REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN
6742   EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN
6743   EXISTS_TAC `\n:num. (f:real^M->real^N)` THEN
6744   ASM_REWRITE_TAC[LIM_CONST]);;
6745
6746 let MEASURABLE_ON_CONST = prove
6747  (`!k:real^N. (\x. k) measurable_on (:real^M)`,
6748   SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; CONTINUOUS_ON_CONST]);;
6749
6750 let MEASURABLE_ON_0 = prove
6751  (`!s. (\x. vec 0) measurable_on s`,
6752   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6753   REWRITE_TAC[MEASURABLE_ON_CONST; COND_ID]);;
6754
6755 let MEASURABLE_ON_CMUL = prove
6756  (`!c f:real^M->real^N s.
6757         f measurable_on s ==> (\x. c % f x) measurable_on s`,
6758   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6759   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN
6760   ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
6761   GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
6762   SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);;
6763
6764 let MEASURABLE_ON_NEG = prove
6765  (`!f:real^M->real^N s.
6766      f measurable_on s ==> (\x. --(f x)) measurable_on s`,
6767   REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`;
6768               MEASURABLE_ON_CMUL]);;
6769
6770 let MEASURABLE_ON_NEG_EQ = prove
6771  (`!f:real^M->real^N s. (\x. --(f x)) measurable_on s <=> f measurable_on s`,
6772   REPEAT GEN_TAC THEN EQ_TAC THEN
6773   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
6774   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;
6775
6776 let MEASURABLE_ON_NORM = prove
6777  (`!f:real^M->real^N s.
6778         f measurable_on s ==> (\x. lift(norm(f x))) measurable_on s`,
6779   REPEAT GEN_TAC THEN
6780   DISCH_THEN(MP_TAC o ISPEC `\x:real^N. lift(norm x)` o MATCH_MP
6781    (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS_0)) THEN
6782   REWRITE_TAC[o_DEF; NORM_0; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN
6783   REWRITE_TAC[continuous_on; IN_UNIV; DIST_LIFT] THEN
6784   GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6785   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;
6786
6787 let MEASURABLE_ON_PASTECART = prove
6788  (`!f:real^M->real^N g:real^M->real^P s.
6789         f measurable_on s /\ g measurable_on s
6790         ==> (\x. pastecart (f x) (g x)) measurable_on s`,
6791   REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN
6792   DISCH_THEN(CONJUNCTS_THEN2
6793    (X_CHOOSE_THEN `k1:real^M->bool` MP_TAC)
6794    (X_CHOOSE_THEN `k2:real^M->bool` MP_TAC)) THEN
6795   DISCH_THEN(X_CHOOSE_THEN `g2:num->real^M->real^P` STRIP_ASSUME_TAC) THEN
6796   DISCH_THEN(X_CHOOSE_THEN `g1:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
6797   EXISTS_TAC `k1 UNION k2:real^M->bool` THEN
6798   ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN
6799   EXISTS_TAC `(\n x. pastecart (g1 n x) (g2 n x))
6800               :num->real^M->real^(N,P)finite_sum` THEN
6801   ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX; IN_UNION; DE_MORGAN_THM] THEN
6802   X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
6803   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
6804   ASM_CASES_TAC `(x:real^M) IN s` THEN
6805   REWRITE_TAC[GSYM PASTECART_VEC] THEN ASM_SIMP_TAC[LIM_PASTECART]);;
6806
6807 let MEASURABLE_ON_COMBINE = prove
6808  (`!h:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P s.
6809         f measurable_on s /\ g measurable_on s /\
6810         (\x. h (fstcart x) (sndcart x)) continuous_on UNIV /\
6811         h (vec 0) (vec 0) = vec 0
6812         ==> (\x. h (f x) (g x)) measurable_on s`,
6813   REPEAT STRIP_TAC THEN
6814   SUBGOAL_THEN
6815    `(\x:real^M. (h:real^N->real^P->real^Q) (f x) (g x)) =
6816     (\x. h (fstcart x) (sndcart x)) o (\x. pastecart (f x) (g x))`
6817   SUBST1_TAC THENL
6818    [REWRITE_TAC[FUN_EQ_THM; FSTCART_PASTECART; SNDCART_PASTECART; o_THM];
6819     MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN
6820     ASM_SIMP_TAC[MEASURABLE_ON_PASTECART; FSTCART_VEC; SNDCART_VEC]]);;
6821
6822 let MEASURABLE_ON_ADD = prove
6823  (`!f:real^M->real^N g:real^M->real^N s.
6824         f measurable_on s /\ g measurable_on s
6825         ==> (\x. f x + g x) measurable_on s`,
6826   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN
6827   ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
6828   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
6829   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
6830
6831 let MEASURABLE_ON_SUB = prove
6832  (`!f:real^M->real^N g:real^M->real^N s.
6833         f measurable_on s /\ g measurable_on s
6834         ==> (\x. f x - g x) measurable_on s`,
6835   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN
6836   ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
6837   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
6838   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
6839
6840 let MEASURABLE_ON_MAX = prove
6841  (`!f:real^M->real^N g:real^M->real^N s.
6842       f measurable_on s /\ g measurable_on s
6843       ==> (\x. (lambda i. max ((f x)$i) ((g x)$i)):real^N)
6844           measurable_on s`,
6845   let lemma = REWRITE_RULE[]
6846    (ISPEC `(\x y. lambda i. max (x$i) (y$i)):real^N->real^N->real^N`
6847           MEASURABLE_ON_COMBINE) in
6848   REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN
6849   ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
6850   REWRITE_TAC[REAL_ARITH `max x x = x`; LAMBDA_ETA] THEN
6851   SIMP_TAC[continuous_on; LAMBDA_BETA; IN_UNIV; DIST_LIFT] THEN
6852   GEN_TAC THEN STRIP_TAC THEN
6853   MAP_EVERY X_GEN_TAC [`x:real^(N,N)finite_sum`; `e:real`] THEN
6854   DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[dist] THEN
6855   X_GEN_TAC `y:real^(N,N)finite_sum` THEN DISCH_TAC THEN
6856   MATCH_MP_TAC(REAL_ARITH
6857    `abs(x - y) < e /\ abs(x' - y') < e
6858     ==> abs(max x x' - max y y') < e`) THEN
6859   REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN CONJ_TAC THEN
6860   MATCH_MP_TAC(REAL_ARITH
6861    `norm(x) < e /\ abs(x$i) <= norm x ==> abs(x$i) < e`) THEN
6862   ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM FSTCART_SUB; GSYM SNDCART_SUB] THEN
6863   ASM_MESON_TAC[REAL_LET_TRANS; NORM_FSTCART; NORM_SNDCART]);;
6864
6865 let MEASURABLE_ON_MIN = prove
6866  (`!f:real^M->real^N g:real^M->real^N s.
6867       f measurable_on s /\ g measurable_on s
6868       ==> (\x. (lambda i. min ((f x)$i) ((g x)$i)):real^N)
6869           measurable_on s`,
6870   REPEAT GEN_TAC THEN
6871   DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG)) THEN
6872   REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
6873   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN
6874   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
6875   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6876   REWRITE_TAC[FUN_EQ_THM] THEN
6877   SIMP_TAC[CART_EQ; VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);;
6878
6879 let MEASURABLE_ON_DROP_MUL = prove
6880  (`!f g:real^M->real^N s.
6881       f measurable_on s /\ g measurable_on s
6882       ==> (\x. drop(f x) % g x) measurable_on s`,
6883   let lemma = REWRITE_RULE[]
6884    (ISPEC `\x y. drop x % y :real^N` MEASURABLE_ON_COMBINE) in
6885   REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
6886   ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
6887   REWRITE_TAC[o_DEF; ETA_AX; LIFT_DROP] THEN
6888   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
6889   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
6890
6891 let MEASURABLE_ON_LIFT_MUL = prove
6892  (`!f g s. (\x. lift(f x)) measurable_on s /\
6893            (\x. lift(g x)) measurable_on s
6894            ==> (\x. lift(f x * g x)) measurable_on s`,
6895   REPEAT GEN_TAC THEN
6896   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN
6897   REWRITE_TAC[LIFT_CMUL; LIFT_DROP]);;
6898
6899 let MEASURABLE_ON_VSUM = prove
6900  (`!f:A->real^M->real^N t.
6901         FINITE t /\ (!i. i IN t ==> (f i) measurable_on s)
6902         ==> (\x. vsum t (\i. f i x)) measurable_on s`,
6903   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
6904   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6905   SIMP_TAC[VSUM_CLAUSES; MEASURABLE_ON_0; MEASURABLE_ON_ADD; IN_INSERT;
6906            ETA_AX]);;
6907
6908 let MEASURABLE_ON_COMPONENTWISE = prove
6909  (`!f:real^M->real^N.
6910         f measurable_on (:real^M) <=>
6911         (!i. 1 <= i /\ i <= dimindex(:N)
6912              ==> (\x. lift(f x$i)) measurable_on (:real^M))`,
6913   REPEAT GEN_TAC THEN EQ_TAC THENL
6914    [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
6915      ISPEC `\x:real^N. lift(x$i)` o MATCH_MP
6916      (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN
6917     ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF];
6918     ALL_TAC] THEN
6919   REWRITE_TAC[measurable_on; IN_UNIV] THEN
6920   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6921   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6922   MAP_EVERY X_GEN_TAC
6923    [`k:num->real^M->bool`; `g:num->num->real^M->real^1`] THEN
6924   DISCH_TAC THEN
6925   EXISTS_TAC `UNIONS(IMAGE k (1..dimindex(:N))):real^M->bool` THEN
6926   EXISTS_TAC `(\n x. lambda i. drop(g i n x)):num->real^M->real^N` THEN
6927   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6928    [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN
6929     ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; FORALL_IN_IMAGE; FINITE_IMAGE];
6930     GEN_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
6931     ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX];
6932     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN
6933     REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN
6934     REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN
6935     ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
6936     ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]);;
6937
6938 let MEASURABLE_ON_SPIKE = prove
6939  (`!f:real^M->real^N g s t.
6940         negligible s /\ (!x. x IN t DIFF s ==> g x = f x)
6941         ==> f measurable_on t ==> g measurable_on t`,
6942   REPEAT GEN_TAC THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
6943   REWRITE_TAC[measurable_on] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6944   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
6945   DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
6946   EXISTS_TAC `s UNION k:real^M->bool` THEN
6947   ASM_SIMP_TAC[DE_MORGAN_THM; IN_UNION; NEGLIGIBLE_UNION]);;
6948
6949 let MEASURABLE_ON_SPIKE_SET = prove
6950  (`!f:real^M->real^N s t.
6951         negligible (s DIFF t UNION t DIFF s)
6952         ==> f measurable_on s
6953             ==> f measurable_on t`,
6954   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[measurable_on] THEN
6955   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
6956   X_GEN_TAC `g:num->real^M->real^N` THEN
6957   DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
6958   EXISTS_TAC `k UNION (s DIFF t UNION t DIFF s):real^M->bool` THEN
6959   ASM_SIMP_TAC[NEGLIGIBLE_UNION; IN_UNION; DE_MORGAN_THM] THEN
6960   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6961   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
6962   MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN
6963   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
6964
6965 let MEASURABLE_ON_RESTRICT = prove
6966  (`!f:real^M->real^N s.
6967         f measurable_on (:real^M) /\ lebesgue_measurable s
6968         ==> (\x. if x IN s then f(x) else vec 0) measurable_on (:real^M)`,
6969   REPEAT GEN_TAC THEN REWRITE_TAC[lebesgue_measurable; indicator] THEN
6970   ONCE_REWRITE_TAC[CONJ_SYM] THEN
6971   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN
6972   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6973   REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
6974   COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN VECTOR_ARITH_TAC);;
6975
6976 let MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove
6977  (`!f s t. s SUBSET t /\ f measurable_on t /\
6978            lebesgue_measurable s
6979            ==> f measurable_on s`,
6980   REPEAT GEN_TAC THEN
6981   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
6982   REWRITE_TAC[IN_UNIV] THEN
6983   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6984   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN
6985   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6986   REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);;
6987
6988 let MEASURABLE_ON_LIMIT = prove
6989  (`!f:num->real^M->real^N g s k.
6990         (!n. (f n) measurable_on s) /\
6991         negligible k /\
6992         (!x. x IN s DIFF k ==> ((\n. f n x) --> g x) sequentially)
6993         ==> g measurable_on s`,
6994   REPEAT STRIP_TAC THEN
6995   MP_TAC(ISPECL [`vec 0:real^N`; `vec 1:real^N`]
6996     HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN
6997   REWRITE_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01] THEN
6998   REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
6999   MAP_EVERY X_GEN_TAC [`h':real^N->real^N`; `h:real^N->real^N`] THEN
7000   REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN
7001   SUBGOAL_THEN
7002    `((h':real^N->real^N) o (h:real^N->real^N) o
7003      (\x. if x IN s then g x else vec 0)) measurable_on (:real^M)`
7004   MP_TAC THENL
7005    [ALL_TAC; ASM_REWRITE_TAC[o_DEF; MEASURABLE_ON_UNIV]] THEN
7006   SUBGOAL_THEN `!y:real^N. norm(h y:real^N) <= &(dimindex(:N))`
7007   ASSUME_TAC THENL
7008    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7009      `IMAGE h UNIV = s ==> (!z. z IN s ==> P z) ==> !y. P(h y)`)) THEN
7010     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN
7011     REWRITE_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN
7012     MATCH_MP_TAC REAL_LE_TRANS THEN
7013     EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((y:real^N)$i))` THEN
7014     REWRITE_TAC[NORM_LE_L1] THEN
7015     GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
7016     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
7017     MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
7018     ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`];
7019     ALL_TAC] THEN
7020   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL THEN
7021   MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `vec 1:real^N`] THEN
7022   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
7023    [MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
7024     MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN
7025     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
7026     EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL
7027      [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
7028       ASM_REWRITE_TAC[] THEN SET_TAC[];
7029       ALL_TAC] THEN
7030     MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN
7031     MAP_EVERY EXISTS_TAC
7032      [`(\n x. h(if x IN s then f n x else vec 0:real^N)):num->real^M->real^N`;
7033       `(\x. vec(dimindex(:N))):real^M->real^1`] THEN
7034     REWRITE_TAC[o_DEF; INTEGRABLE_CONST] THEN REPEAT CONJ_TAC THENL
7035      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC
7036         MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
7037       EXISTS_TAC `(\x. vec(dimindex(:N))):real^M->real^1` THEN
7038       ASM_REWRITE_TAC[ETA_AX; INTEGRABLE_CONST] THEN
7039       ASM_SIMP_TAC[DROP_VEC] THEN CONJ_TAC THENL
7040        [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN
7041         EXISTS_TAC `interval[a:real^M,b:real^M]` THEN CONJ_TAC THENL
7042          [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
7043           ASM_REWRITE_TAC[] THEN SET_TAC[];
7044           ALL_TAC] THEN
7045         ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7046         MATCH_MP_TAC(REWRITE_RULE[indicator; lebesgue_measurable]
7047               MEASURABLE_ON_RESTRICT) THEN
7048         REWRITE_TAC[MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL
7049          [MP_TAC(ISPECL
7050            [`(\x. if x IN s then f (n:num) x else vec 0):real^M->real^N`;
7051             `h:real^N->real^N`] MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN
7052           ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
7053           ASM_REWRITE_TAC[MEASURABLE_ON_UNIV; ETA_AX];
7054           MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
7055           REWRITE_TAC[INTEGRABLE_CONST]];
7056         MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
7057         EXISTS_TAC `interval[a:real^M,b:real^M]` THEN
7058         REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
7059         EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]];
7060       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
7061       EXISTS_TAC `interval[a:real^M,b:real^M]` THEN
7062       REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
7063       EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
7064       ASM_SIMP_TAC[DROP_VEC];
7065       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7066       ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[LIM_CONST] THEN
7067       MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN CONJ_TAC THENL
7068        [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV];
7069         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]];
7070     REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);;
7071
7072 let MEASURABLE_ON_BILINEAR = prove
7073  (`!op:real^N->real^P->real^Q f g s:real^M->bool.
7074         bilinear op /\ f measurable_on s /\ g measurable_on s
7075         ==> (\x. op (f x) (g x)) measurable_on s`,
7076   REPEAT GEN_TAC THEN
7077   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7078   REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
7079   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `ff:num->real^M->real^N`] THEN
7080   REPLICATE_TAC 3 DISCH_TAC THEN
7081   MAP_EVERY X_GEN_TAC [`k':real^M->bool`; `gg:num->real^M->real^P`] THEN
7082   REPLICATE_TAC 3 DISCH_TAC THEN EXISTS_TAC `k UNION k':real^M->bool` THEN
7083   EXISTS_TAC
7084    `\n:num x:real^M. (op:real^N->real^P->real^Q) (ff n x) (gg n x)` THEN
7085   ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL
7086    [GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
7087      (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
7088         BILINEAR_CONTINUOUS_ON_COMPOSE)) THEN
7089     ASM_REWRITE_TAC[ETA_AX];
7090     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN
7091     DISCH_TAC THEN
7092     SUBGOAL_THEN
7093      `(if x IN s then (op:real^N->real^P->real^Q) (f x) (g x) else vec 0) =
7094       op (if x IN s then f(x:real^M) else vec 0)
7095          (if x IN s then g(x:real^M) else vec 0)`
7096     SUBST1_TAC THENL
7097      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bilinear]) THEN
7098       DISCH_THEN(CONJUNCTS_THEN2
7099        (MP_TAC o GEN `y:real^N` o MATCH_MP LINEAR_0 o SPEC `y:real^N`)
7100        (MP_TAC o GEN `z:real^P` o MATCH_MP LINEAR_0 o SPEC `z:real^P`)) THEN
7101       MESON_TAC[];
7102       REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
7103        (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
7104                 LIM_BILINEAR)) THEN
7105       ASM_SIMP_TAC[]]]);;
7106
7107 let ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT = prove
7108  (`!op:real^N->real^P->real^Q f g s:real^M->bool.
7109         bilinear op /\
7110         f measurable_on s /\ bounded (IMAGE f s) /\
7111         g absolutely_integrable_on s
7112         ==> (\x. op (f x) (g x)) absolutely_integrable_on s`,
7113   REPEAT STRIP_TAC THEN
7114   FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN
7115   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
7116   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
7117   REWRITE_TAC[FORALL_IN_IMAGE] THEN
7118   DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
7119   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
7120   EXISTS_TAC `\x:real^M. lift(B * C * norm((g:real^M->real^P) x))` THEN
7121   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
7122    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
7123         MEASURABLE_ON_BILINEAR)) THEN
7124     ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE];
7125     REWRITE_TAC[LIFT_CMUL] THEN
7126     REPEAT(MATCH_MP_TAC INTEGRABLE_CMUL) THEN
7127     RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN
7128     ASM_REWRITE_TAC[];
7129     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP] THEN
7130     TRANS_TAC REAL_LE_TRANS
7131      `B * norm((f:real^M->real^N) x) * norm(g x:real^P)` THEN
7132     ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
7133     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
7134     ASM_SIMP_TAC[NORM_POS_LE]]);;
7135
7136 let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE = prove
7137  (`!f:real^M->real^N g s t.
7138         f measurable_on s /\  g integrable_on s /\ negligible t /\
7139         (!x. x IN s DIFF t ==> norm(f x) <= drop(g x))
7140         ==> f absolutely_integrable_on s`,
7141   REPEAT STRIP_TAC THEN
7142   MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN
7143   MAP_EVERY EXISTS_TAC
7144    [`\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0`;
7145     `t:real^M->bool`] THEN
7146   ASM_SIMP_TAC[] THEN
7147   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
7148   EXISTS_TAC `\x. if x IN s DIFF t then (g:real^M->real^1) x else vec 0` THEN
7149   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
7150    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
7151      (ONCE_REWRITE_RULE[TAUT `p ==> q ==> r <=> q ==> p ==> r`]
7152         MEASURABLE_ON_SPIKE));
7153     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
7154      (ONCE_REWRITE_RULE[TAUT `p ==> q ==> r <=> q ==> p ==> r`]
7155         INTEGRABLE_SPIKE));
7156     ASM_MESON_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN
7157   EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[]);;
7158
7159 (* ------------------------------------------------------------------------- *)
7160 (* Natural closure properties of measurable functions; the intersection      *)
7161 (* one is actually quite tedious since we end up reinventing cube roots      *)
7162 (* before they actually get introduced in transcendentals.ml                 *)
7163 (* ------------------------------------------------------------------------- *)
7164
7165 let MEASURABLE_ON_EMPTY = prove
7166  (`!f:real^M->real^N. f measurable_on {}`,
7167   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7168   REWRITE_TAC[NOT_IN_EMPTY; MEASURABLE_ON_CONST]);;
7169
7170 let MEASURABLE_ON_INTER = prove
7171  (`!f:real^M->real^N s t.
7172         f measurable_on s /\ f measurable_on t
7173         ==> f measurable_on (s INTER t)`,
7174   REPEAT GEN_TAC THEN
7175   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7176   ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN
7177   REWRITE_TAC[AND_FORALL_THM] THEN
7178   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
7179   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
7180   ASM_REWRITE_TAC[] THEN
7181   ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ p ==> q ==> r`] THEN
7182   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN
7183   REWRITE_TAC[IMP_IMP] THEN
7184   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN
7185   ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
7186   REWRITE_TAC[VEC_COMPONENT; REAL_ARITH
7187    `(if p then x else &0) * (if q then y else &0) =
7188     if p /\ q then x * y else &0`] THEN
7189   SUBGOAL_THEN `!s. (\x. lift (drop x pow 3)) continuous_on s` ASSUME_TAC THENL
7190    [GEN_TAC THEN REWRITE_TAC[REAL_ARITH `(x:real) pow 3 = x * x * x`] THEN
7191     REWRITE_TAC[LIFT_CMUL] THEN
7192     REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
7193            ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]);
7194     ALL_TAC] THEN
7195   SUBGOAL_THEN `?r. !x. lift(drop(r x) pow 3) = x` STRIP_ASSUME_TAC THENL
7196    [REWRITE_TAC[GSYM SKOLEM_THM; FORALL_LIFT; GSYM EXISTS_DROP; LIFT_EQ] THEN
7197     X_GEN_TAC `x:real` THEN  MP_TAC(ISPECL
7198      [`\x. lift (drop x pow 3)`; `lift(--(abs x + &1))`;
7199       `lift(abs x + &1)`;`x:real`; `1`] IVT_INCREASING_COMPONENT_1) THEN
7200     REWRITE_TAC[GSYM drop; LIFT_DROP; EXISTS_DROP] THEN
7201     ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
7202     REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN
7203     CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL
7204      [FIRST_X_ASSUM(MP_TAC o SPEC `(:real^1)`) THEN
7205       ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV];
7206       REWRITE_TAC[REAL_BOUNDS_LE; REAL_POW_NEG; ARITH] THEN
7207       MATCH_MP_TAC(REAL_ARITH
7208       `&0 <= x /\ &0 <= x pow 2 /\ &0 <= x pow 3 ==> x <= (x + &1) pow 3`) THEN
7209       SIMP_TAC[REAL_POW_LE; REAL_ABS_POS]];
7210     ALL_TAC] THEN
7211   SUBGOAL_THEN `!x.  r(lift(x pow 3)) = lift x` STRIP_ASSUME_TAC THENL
7212    [REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN GEN_TAC THEN
7213     MATCH_MP_TAC REAL_POW_EQ_ODD THEN EXISTS_TAC `3` THEN
7214     ASM_REWRITE_TAC[ARITH; GSYM LIFT_EQ; LIFT_DROP];
7215     ALL_TAC] THEN
7216   SUBGOAL_THEN `(r:real^1->real^1) continuous_on (:real^1)` ASSUME_TAC THENL
7217    [MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN
7218     MAP_EVERY EXISTS_TAC [`\x. lift(drop x pow 3)`; `(:real^1)`] THEN
7219     ASM_REWRITE_TAC[LIFT_DROP] THEN
7220     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
7221      [ASM SET_TAC[]; ALL_TAC] THEN
7222     DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN SUBST1_TAC(SYM th)) THEN
7223     MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN
7224     ASM_REWRITE_TAC[PATH_CONNECTED_UNIV; LIFT_EQ] THEN
7225     SIMP_TAC[REAL_POW_EQ_ODD_EQ; ARITH; DROP_EQ];
7226     ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 pow 3`] THEN
7227     REWRITE_TAC[REAL_ARITH `(x * x) * x:real = x pow 3`; IN_INTER] THEN
7228     REWRITE_TAC[MESON[] `(if p then x pow 3 else y pow 3) =
7229                          (if p then x else y:real) pow 3`] THEN
7230     CONV_TAC REAL_RAT_REDUCE_CONV THEN
7231     DISCH_THEN(MP_TAC o ISPEC `r:real^1->real^1` o
7232       MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN
7233     ASM_REWRITE_TAC[o_DEF]]);;
7234
7235 let MEASURABLE_ON_DIFF = prove
7236  (`!f:real^M->real^N s t.
7237     f measurable_on s /\ f measurable_on t ==> f measurable_on (s DIFF t)`,
7238   REPEAT GEN_TAC THEN DISCH_TAC THEN
7239   FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN
7240   FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IMP_IMP] THEN
7241   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7242   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN
7243   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7244   REWRITE_TAC[FUN_EQ_THM; IN_DIFF; IN_INTER] THEN
7245   X_GEN_TAC `x:real^M` THEN
7246   MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN
7247   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
7248
7249 let MEASURABLE_ON_UNION = prove
7250  (`!f:real^M->real^N s t.
7251     f measurable_on s /\ f measurable_on t ==> f measurable_on (s UNION t)`,
7252   REPEAT GEN_TAC THEN DISCH_TAC THEN
7253   FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN
7254   POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7255   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN
7256   REWRITE_TAC[IMP_IMP] THEN
7257   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN
7258   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7259   REWRITE_TAC[FUN_EQ_THM; IN_UNION; IN_INTER] THEN
7260   X_GEN_TAC `x:real^M` THEN
7261   MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN
7262   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
7263
7264 let MEASURABLE_ON_UNIONS = prove
7265  (`!f:real^M->real^N k.
7266         FINITE k /\ (!s. s IN k ==> f measurable_on s)
7267         ==> f measurable_on (UNIONS k)`,
7268   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
7269   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
7270   REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY; UNIONS_INSERT] THEN
7271   SIMP_TAC[FORALL_IN_INSERT; MEASURABLE_ON_UNION]);;
7272
7273 let MEASURABLE_ON_COUNTABLE_UNIONS = prove
7274  (`!f:real^M->real^N k.
7275         COUNTABLE k /\ (!s. s IN k ==> f measurable_on s)
7276         ==> f measurable_on (UNIONS k)`,
7277   REPEAT STRIP_TAC THEN
7278   ASM_CASES_TAC `k:(real^M->bool)->bool = {}` THEN
7279   ASM_REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY] THEN
7280   MP_TAC(ISPEC `k:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN
7281   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7282   X_GEN_TAC `d:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN
7283   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
7284   MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
7285   EXISTS_TAC `(\n x. if x IN UNIONS (IMAGE d (0..n)) then f x else vec 0):
7286               num->real^M->real^N` THEN
7287   EXISTS_TAC `{}:real^M->bool` THEN
7288   ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY; MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL
7289    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_UNIONS THEN
7290     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FORALL_IN_IMAGE]) THEN
7291     SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV; FINITE_IMAGE; FINITE_NUMSEG];
7292     X_GEN_TAC `x:real^M` THEN DISCH_THEN(K ALL_TAC) THEN
7293     ASM_CASES_TAC `(x:real^M) IN UNIONS (IMAGE d (:num))` THEN
7294     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THENL
7295      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
7296       REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV; EVENTUALLY_SEQUENTIALLY] THEN
7297       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
7298       X_GEN_TAC `n:num` THEN DISCH_TAC THEN
7299       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
7300       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN
7301       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7302       REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[];
7303       MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[]]]);;
7304
7305 (* ------------------------------------------------------------------------- *)
7306 (* Negligibility of a Lipschitz image of a negligible set.                   *)
7307 (* ------------------------------------------------------------------------- *)
7308
7309 let NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE = prove
7310  (`!f:real^M->real^N s.
7311         dimindex(:M) <= dimindex(:N) /\ negligible s /\
7312         (!x. x IN s
7313              ==> ?t b. open t /\ x IN t /\
7314                        !y. y IN s INTER t
7315                            ==> norm(f y - f x) <= b * norm(y - x))
7316         ==> negligible(IMAGE f s)`,
7317   let lemma = prove
7318    (`!f:real^M->real^N s B.
7319         dimindex(:M) <= dimindex(:N) /\ bounded s /\ negligible s /\ &0 < B /\
7320         (!x. x IN s
7321              ==> ?t. open t /\ x IN t /\
7322                      !y. y IN s INTER t
7323                          ==> norm(f y - f x) <= B * norm(y - x))
7324         ==> negligible(IMAGE f s)`,
7325     REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN
7326     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7327     MP_TAC(ISPECL [`s:real^M->bool`;
7328                    `e / &2 / (&2 * B * &(dimindex(:M))) pow (dimindex(:N))`]
7329       MEASURABLE_OUTER_OPEN) THEN
7330     ANTS_TAC THENL
7331      [ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE] THEN
7332       MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN
7333       MATCH_MP_TAC REAL_POW_LT THEN
7334       REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN
7335       ASM_SIMP_TAC[DIMINDEX_GE_1; REAL_OF_NUM_LT; ARITH; LE_1];
7336       ALL_TAC] THEN
7337     ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_HALF; MEASURE_EQ_0] THEN
7338     REWRITE_TAC[REAL_ADD_LID] THEN
7339     DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
7340     SUBGOAL_THEN
7341      `!x. ?r. &0 < r /\ r <= &1 / &2 /\
7342               (x IN s
7343                ==> !y. norm(y - x:real^M) < r
7344                        ==> y IN t /\
7345                            (y IN s
7346                             ==> norm(f y - f x:real^N) <= B * norm(y - x)))`
7347     MP_TAC THENL
7348      [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN
7349       ASM_REWRITE_TAC[] THENL
7350        [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN
7351       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
7352       ASM_REWRITE_TAC[IN_INTER] THEN
7353       DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
7354       MP_TAC(ISPEC `t INTER u :real^M->bool` open_def) THEN
7355       ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL] THEN
7356       DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
7357       ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTER; dist]] THEN
7358       DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
7359       EXISTS_TAC `min (&1 / &2) r` THEN
7360       ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN] THEN
7361       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[];
7362       FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN
7363       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
7364       REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
7365       X_GEN_TAC `r:real^M->real` THEN STRIP_TAC] THEN
7366     SUBGOAL_THEN
7367      `?c. s SUBSET interval[--(vec c):real^M,vec c] /\
7368           ~(interval(--(vec c):real^M,vec c) = {})`
7369     STRIP_ASSUME_TAC THENL
7370      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
7371       DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
7372       MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN
7373       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
7374       DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN
7375       REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7376       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
7377       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN
7378       STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN W(MP_TAC o
7379         PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN
7380       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
7381       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
7382       ALL_TAC] THEN
7383     MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`;
7384                    `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN
7385     ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN
7386
7387     REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7388     DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
7389     SUBGOAL_THEN
7390      `!k. k IN D
7391           ==> ?u v z. k = interval[u,v] /\ ~(interval(u,v) = {}) /\
7392                       z IN s /\ z IN interval[u,v] /\
7393                       interval[u:real^M,v] SUBSET ball(z,r z)`
7394     MP_TAC THENL
7395      [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
7396       SUBGOAL_THEN `?u v:real^M. d = interval[u,v]` MP_TAC THENL
7397        [ASM_MESON_TAC[]; ALL_TAC] THEN
7398       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M` THEN
7399       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M` THEN
7400       DISCH_THEN SUBST_ALL_TAC THEN
7401       ASM_MESON_TAC[SUBSET; INTERIOR_CLOSED_INTERVAL; IN_INTER];
7402       ALL_TAC] THEN
7403     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7404     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
7405      [`u:(real^M->bool)->real^M`; `v:(real^M->bool)->real^M`;
7406       `z:(real^M->bool)->real^M`] THEN
7407     DISCH_THEN(LABEL_TAC "*") THEN EXISTS_TAC
7408      `UNIONS(IMAGE (\d:real^M->bool.
7409          interval[(f:real^M->real^N)(z d) -
7410       (B * &(dimindex(:M)) *
7411       ((v(d):real^M)$1 - (u(d):real^M)$1)) % vec 1:real^N,
7412                   f(z d) +
7413                   (B * &(dimindex(:M)) * (v(d)$1 - u(d)$1)) % vec 1]) D)` THEN
7414     CONJ_TAC THENL
7415      [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
7416       X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
7417       SUBGOAL_THEN `(y:real^M) IN UNIONS D` MP_TAC THENL
7418        [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[UNIONS_IMAGE]] THEN
7419       REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
7420       X_GEN_TAC `d:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7421       SUBGOAL_THEN `(y:real^M) IN ball(z(d:real^M->bool),r(z d))` MP_TAC THENL
7422        [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[IN_BALL; dist]] THEN
7423       ONCE_REWRITE_TAC[NORM_SUB] THEN DISCH_TAC THEN
7424       SUBGOAL_THEN
7425        `y IN t /\
7426         norm((f:real^M->real^N) y - f(z d)) <= B * norm(y - z(d:real^M->bool))`
7427       STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
7428       REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
7429       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
7430       REWRITE_TAC[REAL_ARITH
7431        `z - b <= y /\ y <= z + b <=> abs(y - z) <= b`] THEN
7432       REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN W(MP_TAC o
7433         PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN
7434       ASM_REWRITE_TAC[] THEN
7435       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7436       REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
7437       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7438           REAL_LE_TRANS)) THEN
7439       ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
7440       W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
7441       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7442       GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV)
7443        [GSYM CARD_NUMSEG_1] THEN
7444       SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN
7445       MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
7446       MATCH_MP_TAC REAL_LE_TRANS THEN
7447       EXISTS_TAC `((v:(real^M->bool)->real^M) d - u d)$j` THEN
7448       REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN CONJ_TAC THENL
7449        [SUBGOAL_THEN `y IN interval[(u:(real^M->bool)->real^M) d,v d] /\
7450                       (z d) IN interval[u d,v d]`
7451         MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN
7452         DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `j:num`)) THEN
7453         ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
7454         MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o SPECL
7455          [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN
7456         ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]];
7457       ALL_TAC] THEN
7458     MATCH_MP_TAC(MESON[]
7459      `(x <= e / &2 ==> x < e) /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN
7460     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
7461     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN
7462     ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN
7463     ONCE_REWRITE_TAC[CONJ_SYM] THEN
7464     REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
7465     X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN
7466     W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN
7467     ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN
7468     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7469     REWRITE_TAC[o_DEF] THEN
7470     MATCH_MP_TAC REAL_LE_TRANS THEN
7471     EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow (dimindex(:N)) *
7472                 sum D' (\d:real^M->bool. measure d)` THEN
7473     SUBGOAL_THEN `FINITE(D':(real^M->bool)->bool)` ASSUME_TAC THENL
7474      [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
7475     CONJ_TAC THENL
7476      [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN
7477       ASM_REWRITE_TAC[MEASURE_INTERVAL] THEN X_GEN_TAC `d:real^M->bool` THEN
7478       DISCH_TAC THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN
7479       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; REAL_ARITH
7480        `(a - x <= a + x <=> &0 <= x) /\ (a + x) - (a - x) = &2 * x`] THEN
7481       REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN
7482       ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
7483       SUBGOAL_THEN `d = interval[u d:real^M,v d]`
7484        (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])
7485       THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
7486       REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7487       SUBGOAL_THEN
7488        `!i. 1 <= i /\ i <= dimindex(:M)
7489             ==> ((u:(real^M->bool)->real^M) d)$i <= (v d:real^M)$i`
7490       MP_TAC THENL
7491        [ASM_MESON_TAC[SUBSET; INTERVAL_NE_EMPTY; REAL_LT_IMP_LE]; ALL_TAC] THEN
7492       SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN DISCH_TAC THEN
7493       REWRITE_TAC[PRODUCT_CONST_NUMSEG; REAL_POW_MUL] THEN
7494       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH;
7495                    GSYM REAL_MUL_ASSOC; ADD_SUB; DIMINDEX_GE_1; LE_1] THEN
7496       MATCH_MP_TAC REAL_LE_TRANS THEN
7497       EXISTS_TAC `((v d:real^M)$1 - ((u:(real^M->bool)->real^M) d)$1)
7498                   pow (dimindex(:M))` THEN
7499       CONJ_TAC THENL
7500        [MATCH_MP_TAC REAL_POW_MONO_INV THEN
7501         ASM_SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN
7502         REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
7503         MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN W(MP_TAC o
7504           PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN
7505         REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN
7506         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7507         MATCH_MP_TAC(NORM_ARITH
7508          `!z r. norm(z - u) < r /\ norm(z - v) < r /\ r <= &1 / &2
7509                 ==> norm(v - u:real^M) <= &1`) THEN
7510         MAP_EVERY EXISTS_TAC
7511          [`(z:(real^M->bool)->real^M) d`;
7512           `r((z:(real^M->bool)->real^M) d):real`] THEN
7513         ASM_REWRITE_TAC[GSYM dist; GSYM IN_BALL] THEN
7514         SUBGOAL_THEN
7515          `(u:(real^M->bool)->real^M) d IN interval[u d,v d] /\
7516           (v:(real^M->bool)->real^M) d IN interval[u d,v d]`
7517         MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
7518         ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY];
7519         GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
7520         SIMP_TAC[GSYM PRODUCT_CONST; FINITE_NUMSEG] THEN
7521         MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
7522         FIRST_X_ASSUM(MP_TAC o SPECL
7523          [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN
7524         ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL; SUBSET]];
7525       MATCH_MP_TAC REAL_LE_TRANS THEN
7526       EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow dimindex(:N) *
7527                   measure(t:real^M->bool)` THEN
7528       CONJ_TAC THENL
7529        [MATCH_MP_TAC REAL_LE_LMUL THEN
7530         CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC];
7531         MATCH_MP_TAC REAL_LT_IMP_LE THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
7532         W(MP_TAC o PART_MATCH (rand o rand) REAL_LT_RDIV_EQ o snd)] THEN
7533       ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_MUL; LE_1; DIMINDEX_GE_1;
7534                    REAL_ARITH `&0 < &2 * B <=> &0 < B`; REAL_OF_NUM_LT] THEN
7535       MATCH_MP_TAC REAL_LE_TRANS THEN
7536       EXISTS_TAC `measure(UNIONS D':real^M->bool)` THEN CONJ_TAC THENL
7537        [MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`]
7538           MEASURE_ELEMENTARY) THEN
7539         ANTS_TAC THENL
7540          [ASM_REWRITE_TAC[division_of] THEN
7541           CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
7542           GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL
7543            [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]];
7544           DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
7545           MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]];
7546         MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL
7547          [MATCH_MP_TAC MEASURABLE_UNIONS THEN
7548           ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET];
7549           ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN
7550           EXISTS_TAC `UNIONS D:real^M->bool` THEN
7551           ASM_SIMP_TAC[SUBSET_UNIONS] THEN
7552           REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN
7553           X_GEN_TAC `d:real^M->bool` THEN
7554           REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
7555           DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN
7556           SUBGOAL_THEN `d SUBSET ball(z d:real^M,r(z d))` MP_TAC THENL
7557            [ASM_MESON_TAC[];
7558             REWRITE_TAC[SUBSET; IN_BALL; dist] THEN
7559             ASM_MESON_TAC[NORM_SUB]]]]]) in
7560   REPEAT STRIP_TAC THEN
7561   SUBGOAL_THEN
7562    `s = UNIONS
7563     {{x | x IN s /\ norm(x:real^M) <= &n /\
7564           ?t. open t /\ x IN t /\
7565               !y. y IN s INTER t
7566                   ==> norm(f y - f x:real^N) <= (&n + &1) * norm(y - x)} |
7567      n IN (:num)}`
7568   SUBST1_TAC THENL
7569    [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
7570     X_GEN_TAC `x:real^M` THEN
7571     ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
7572     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
7573     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
7574     REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
7575     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
7576     X_GEN_TAC `t:real^M->bool` THEN
7577     DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN
7578     MP_TAC(SPEC `max (norm(x:real^M)) b` REAL_ARCH_SIMPLE) THEN
7579     MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MAX_LE] THEN
7580     X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7581     MATCH_MP_TAC REAL_LE_TRANS THEN
7582     EXISTS_TAC `b * norm(y - x:real^M)` THEN ASM_SIMP_TAC[] THEN
7583     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
7584     ASM_REAL_ARITH_TAC;
7585     REWRITE_TAC[IMAGE_UNIONS] THEN
7586     MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
7587     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
7588     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
7589     ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
7590     X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN
7591     MATCH_MP_TAC lemma THEN EXISTS_TAC `&n + &1` THEN ASM_REWRITE_TAC[] THEN
7592     REPEAT CONJ_TAC THENL
7593      [MATCH_MP_TAC BOUNDED_SUBSET THEN
7594       EXISTS_TAC `cball(vec 0:real^M,&n)` THEN
7595       SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM];
7596       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
7597       ASM_REWRITE_TAC[] THEN SET_TAC[];
7598       REAL_ARITH_TAC;
7599       REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN MESON_TAC[]]]);;
7600
7601 let NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV = prove
7602  (`!f:real^N->real^N s B.
7603         negligible s /\ (!x y. norm(f x - f y) <= B * norm(x - y))
7604         ==> negligible(IMAGE f s)`,
7605   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN
7606   ASM_REWRITE_TAC[LE_REFL] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
7607   MAP_EVERY EXISTS_TAC [`interval(a - vec 1:real^N,a + vec 1)`; `B:real`] THEN
7608   ASM_REWRITE_TAC[OPEN_INTERVAL; IN_INTERVAL] THEN
7609   REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN
7610   REAL_ARITH_TAC);;
7611
7612 let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE = prove
7613  (`!f:real^M->real^N s.
7614         dimindex(:M) <= dimindex(:N) /\ negligible s /\ f differentiable_on s
7615         ==> negligible(IMAGE f s)`,
7616   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN
7617   ASM_REWRITE_TAC[IN_INTER] THEN
7618   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7619   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN
7620   DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
7621   ASM_REWRITE_TAC[differentiable; HAS_DERIVATIVE_WITHIN_ALT] THEN
7622   DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN
7623   FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN
7624   REWRITE_TAC[REAL_LT_01; REAL_MUL_RID] THEN
7625   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
7626   FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN
7627   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
7628   EXISTS_TAC `ball(x:real^M,d)` THEN EXISTS_TAC `B + &1` THEN
7629   ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
7630   REWRITE_TAC[IN_BALL; dist; REAL_ADD_RDISTRIB] THEN REPEAT STRIP_TAC THEN
7631   MATCH_MP_TAC(NORM_ARITH
7632    `!d. norm(y - x - d:real^N) <= z /\ norm(d) <= b
7633         ==> norm(y - x) <= b + z`) THEN
7634   EXISTS_TAC `(f':real^M->real^N)(y - x)` THEN
7635   ASM_MESON_TAC[NORM_SUB]);;
7636
7637 let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM = prove
7638  (`!f:real^M->real^N s.
7639         dimindex(:M) < dimindex(:N) /\ f differentiable_on s
7640         ==> negligible(IMAGE f s)`,
7641   REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP
7642    (ARITH_RULE `m < n ==> !x:num. x <= m ==> x <= n`)) THEN
7643   SUBGOAL_THEN
7644    `(f:real^M->real^N) =
7645     (f o ((\x. lambda i. x$i):real^N->real^M)) o
7646     ((\x. lambda i. if i <= dimindex(:M) then x$i else &0):real^M->real^N)`
7647   SUBST1_TAC THENL
7648    [SIMP_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
7649     ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA];
7650     ONCE_REWRITE_TAC[IMAGE_o] THEN
7651     MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN
7652     REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL
7653      [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
7654       EXISTS_TAC `{y:real^N | y$(dimindex(:N)) = &0}` THEN
7655       SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; LE_REFL; DIMINDEX_GE_1] THEN
7656       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
7657       SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_GE_1] THEN
7658       ASM_REWRITE_TAC[GSYM NOT_LT];
7659       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN
7660       REWRITE_TAC[differentiable_on; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
7661       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7662       MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL
7663        [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN
7664         SIMP_TAC[linear; LAMBDA_BETA; CART_EQ;
7665                  VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT];
7666         FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
7667         MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THENL
7668          [AP_TERM_TAC;
7669           MATCH_MP_TAC(SET_RULE
7670            `(!x. f(g x) = x) ==> s = IMAGE f (IMAGE g s)`)] THEN
7671         ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]]]]);;
7672
7673 (* ------------------------------------------------------------------------- *)
7674 (* Simplest case of Sard's theorem (we don't need continuity of derivative). *)
7675 (* ------------------------------------------------------------------------- *)
7676
7677 let BABY_SARD = prove
7678  (`!f:real^M->real^N f' s.
7679         dimindex(:M) <= dimindex(:N) /\
7680         (!x. x IN s
7681              ==> (f has_derivative f' x) (at x within s) /\
7682                  rank(matrix(f' x)) < dimindex(:N))
7683         ==> negligible(IMAGE f s)`,
7684   let lemma = prove
7685    (`!p w e m.
7686       dim p < dimindex(:N) /\ &0 <= m /\ &0 <= e
7687       ==> ?s. measurable s /\
7688               {z:real^N | norm(z - w) <= m /\
7689                           ?t. t IN p /\ norm(z - w - t) <= e}
7690               SUBSET s /\
7691               measure s <= (&2 * e) * (&2 * m) pow (dimindex(:N) - 1)`,
7692     REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `w:real^N` ["t"; "p"] THEN
7693     REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
7694     DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
7695     REWRITE_TAC[VECTOR_SUB_RZERO; LEFT_IMP_EXISTS_THM] THEN
7696     X_GEN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN
7697     X_GEN_TAC `a:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
7698     ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
7699     REPEAT STRIP_TAC THEN
7700     EXISTS_TAC
7701      `interval[--(lambda i. if i = 1 then e else m):real^N,
7702                (lambda i. if i = 1 then e else m)]` THEN
7703     REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL
7704      [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN
7705       SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN
7706       X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
7707       REWRITE_TAC[REAL_BOUNDS_LE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
7708       COND_CASES_TAC THENL
7709        [ALL_TAC; ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]] THEN
7710       FIRST_X_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
7711       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7712       DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
7713       ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM; DOT_BASIS; DOT_LMUL;
7714                    DIMINDEX_GE_1; LE_REFL; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN
7715       MP_TAC(ISPECL [`x - y:real^N`; `1`] COMPONENT_LE_NORM) THEN
7716       REWRITE_TAC[VECTOR_SUB_COMPONENT; ARITH; DIMINDEX_GE_1] THEN
7717       ASM_REAL_ARITH_TAC;
7718       REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7719       SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN
7720       COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_POS] THEN
7721       REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN
7722       SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1] THEN
7723       MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN
7724       SIMP_TAC[ARITH; ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN
7725       SIMP_TAC[PRODUCT_CONST_NUMSEG; DIMINDEX_GE_1; REAL_LE_REFL; ARITH_RULE
7726        `1 <= n ==> (n + 1) - 2 = n - 1`]]) in
7727   let semma = prove
7728    (`!f:real^M->real^N f' s B.
7729           dimindex(:M) <= dimindex(:N) /\ &0 < B /\ bounded s /\
7730           (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\
7731                          rank(matrix(f' x)) < dimindex(:N) /\ onorm(f' x) <= B)
7732           ==> negligible(IMAGE f s)`,
7733     REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
7734     REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN
7735     SUBGOAL_THEN `!x. x IN s ==> linear((f':real^M->real^M->real^N) x)`
7736     ASSUME_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN
7737     REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
7738     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7739     SUBGOAL_THEN
7740      `?c. s SUBSET interval(--(vec c):real^M,vec c) /\
7741             ~(interval(--(vec c):real^M,vec c) = {})`
7742     STRIP_ASSUME_TAC THENL
7743      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
7744       DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
7745       MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN
7746       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
7747       DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN
7748       REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7749       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
7750       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN
7751       STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LT] THEN W(MP_TAC o
7752         PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN
7753       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
7754       ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
7755       ALL_TAC] THEN
7756     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN
7757     DISCH_THEN(MP_TAC o SPEC `1`) THEN
7758     REWRITE_TAC[VEC_COMPONENT; DIMINDEX_GE_1;
7759                 LE_REFL; VECTOR_NEG_COMPONENT] THEN
7760     REWRITE_TAC[REAL_ARITH `--x < x <=> &0 < &2 * x`; REAL_OF_NUM_MUL] THEN
7761     DISCH_TAC THEN
7762     SUBGOAL_THEN
7763      `?d. &0 < d /\ d <= B /\
7764           (d * &2) * (&4 * B) pow (dimindex(:N) - 1) <=
7765           e / &(2 * c) pow dimindex(:M) / &(dimindex(:M)) pow dimindex(:M)`
7766     STRIP_ASSUME_TAC THENL
7767      [EXISTS_TAC
7768        `min B (e / &(2 * c) pow dimindex(:M) /
7769                &(dimindex(:M)) pow dimindex(:M) /
7770                (&4 * B) pow (dimindex(:N) - 1) / &2)` THEN
7771       ASM_REWRITE_TAC[REAL_LT_MIN; REAL_ARITH `min x y <= x`] THEN
7772       CONJ_TAC THENL
7773        [REPEAT(MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC) THEN
7774         ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1;
7775                      REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH];
7776         ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT;
7777                      REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH] THEN
7778         REAL_ARITH_TAC];
7779       ALL_TAC] THEN
7780     SUBGOAL_THEN
7781      `!x. ?r. &0 < r /\ r <= &1 / &2 /\
7782               (x IN s
7783                ==> !y. y IN s /\ norm(y - x) < r
7784                        ==> norm((f:real^M->real^N) y - f x - f' x (y - x)) <=
7785                            d * norm(y - x))`
7786     MP_TAC THENL
7787      [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN
7788       ASM_REWRITE_TAC[] THENL
7789        [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN
7790       UNDISCH_THEN
7791        `!x. x IN s ==> ((f:real^M->real^N) has_derivative f' x) (at x within s)`
7792        (MP_TAC o REWRITE_RULE[HAS_DERIVATIVE_WITHIN_ALT]) THEN
7793       ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM] THEN
7794       DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `d:real`]) THEN
7795       ASM_REWRITE_TAC[] THEN
7796       DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
7797       EXISTS_TAC `min r (&1 / &2)` THEN
7798       ASM_REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LE_REFL] THEN
7799       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[];
7800       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
7801       X_GEN_TAC `r:real^M->real` THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
7802       REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
7803       REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7804       DISCH_THEN(LABEL_TAC "*")] THEN
7805     MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`;
7806                    `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN
7807     ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL
7808      [ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN
7809     REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
7810     DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
7811     SUBGOAL_THEN
7812      `!k:real^M->bool.
7813           k IN D
7814           ==> ?t. measurable(t) /\
7815                   IMAGE (f:real^M->real^N) (k INTER s) SUBSET t /\
7816                   measure t <= e / &(2 * c) pow (dimindex(:M)) * measure(k)`
7817     MP_TAC THENL
7818      [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
7819       SUBGOAL_THEN `?u v:real^M. k = interval[u,v]`
7820        (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
7821       THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
7822       SUBGOAL_THEN `?x:real^M. x IN (s INTER interval[u,v]) /\
7823                                interval[u,v] SUBSET ball(x,r x)`
7824       MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTER]] THEN
7825       DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
7826       MP_TAC(ISPECL [`IMAGE ((f':real^M->real^M->real^N) x) (:real^M)`;
7827                `(f:real^M->real^N) x`;
7828                  `d * norm(v - u:real^M)`;
7829                  `(&2 * B) * norm(v - u:real^M)`]
7830           lemma) THEN
7831       ANTS_TAC THENL
7832        [ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN
7833         MP_TAC(ISPEC `matrix ((f':real^M->real^M->real^N) x)`
7834           RANK_DIM_IM) THEN
7835         ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX] THEN
7836         ASM_MESON_TAC[];
7837         ALL_TAC] THEN
7838       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
7839       REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN CONJ_TAC THENL
7840        [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN
7841         REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN
7842         X_GEN_TAC `y:real^M` THEN
7843         REWRITE_TAC[IN_INTER; EXISTS_IN_IMAGE; IN_UNIV] THEN
7844         STRIP_TAC THEN REMOVE_THEN "*"
7845          (MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
7846         ANTS_TAC THENL
7847          [ASM_MESON_TAC[IN_BALL; SUBSET; NORM_SUB; dist]; ALL_TAC] THEN
7848         DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL
7849          [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC(NORM_ARITH
7850            `norm(z) <= B /\ d <= B
7851             ==> norm(y - x - z:real^N) <= d
7852                 ==> norm(y - x) <= &2 * B`) THEN
7853           CONJ_TAC THENL
7854            [MP_TAC(ISPEC `(f':real^M->real^M->real^N) x` ONORM) THEN
7855             ASM_SIMP_TAC[] THEN
7856             DISCH_THEN(MP_TAC o SPEC `y - x:real^M` o CONJUNCT1) THEN
7857             MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7858             MATCH_MP_TAC REAL_LE_MUL2 THEN
7859             ASM_SIMP_TAC[ONORM_POS_LE; NORM_POS_LE];
7860             MATCH_MP_TAC REAL_LE_MUL2 THEN
7861             ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]];
7862           DISCH_THEN(fun th -> EXISTS_TAC `y - x:real^M` THEN MP_TAC th) THEN
7863           MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7864           ASM_SIMP_TAC[REAL_LE_LMUL_EQ]] THEN
7865         MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
7866         REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])) THEN
7867         REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
7868         MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
7869         DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
7870         ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
7871         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7872         REWRITE_TAC[REAL_ARITH `&2 * (&2 * B) * n = (&4 * B) * n`] THEN
7873         GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_POW_MUL] THEN
7874         SIMP_TAC[REAL_ARITH `(&2 * d * n) * a * b = d * &2 * a * (n * b)`] THEN
7875         REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN
7876         SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`] THEN
7877         MATCH_MP_TAC REAL_LE_TRANS THEN
7878         EXISTS_TAC `e / &(2 * c) pow (dimindex(:M)) /
7879                     (&(dimindex(:M)) pow dimindex(:M)) *
7880                     norm(v - u:real^M) pow dimindex(:N)` THEN
7881         CONJ_TAC THENL
7882          [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
7883           ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE];
7884           ALL_TAC] THEN
7885         GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_div] THEN
7886         REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
7887         ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE] THEN
7888         REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
7889         SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT;
7890                  LE_1; DIMINDEX_GE_1] THEN
7891         MATCH_MP_TAC REAL_LE_TRANS THEN
7892         EXISTS_TAC `norm(v - u:real^M) pow dimindex(:M)` THEN CONJ_TAC THENL
7893          [MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN
7894           SUBGOAL_THEN `u IN ball(x:real^M,r x) /\ v IN ball(x,r x)` MP_TAC
7895           THENL
7896            [ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL; INTERIOR_EMPTY];
7897             REWRITE_TAC[IN_BALL] THEN
7898             SUBGOAL_THEN `(r:real^M->real) x <= &1 / &2` MP_TAC THENL
7899               [ASM_REWRITE_TAC[]; CONV_TAC NORM_ARITH]];
7900           REMOVE_THEN "*" (K ALL_TAC) THEN
7901           FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M`; `v:real^M`]) THEN
7902           ASM_REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN
7903           REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_OF_NUM_MUL] THEN
7904           X_GEN_TAC `p:num` THEN DISCH_TAC THEN
7905           MATCH_MP_TAC REAL_LE_TRANS THEN
7906           EXISTS_TAC `(sum(1..dimindex(:M)) (\i. abs((v - u:real^M)$i)))
7907                       pow (dimindex(:M))` THEN
7908           CONJ_TAC THENL
7909            [MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[NORM_POS_LE; NORM_LE_L1];
7910             REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7911             GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
7912              [GSYM REAL_SUB_LE] THEN
7913             ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2] THEN
7914             ASM_SIMP_TAC[SUM_CONST_NUMSEG; PRODUCT_CONST_NUMSEG;
7915                          VECTOR_SUB_COMPONENT; ADD_SUB] THEN
7916             REWRITE_TAC[REAL_POW_MUL; REAL_MUL_SYM] THEN
7917             MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN REWRITE_TAC[] THEN
7918             AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[REAL_ABS_REFL] THEN
7919             ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2]]]];
7920       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7921       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
7922       X_GEN_TAC `g:(real^M->bool)->(real^N->bool)` THEN DISCH_TAC THEN
7923       EXISTS_TAC `UNIONS (IMAGE (g:(real^M->bool)->(real^N->bool)) D)` THEN
7924       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7925       MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
7926       ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
7927       ONCE_REWRITE_TAC[CONJ_SYM] THEN
7928       REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
7929       X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN
7930       W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o
7931         lhand o snd) THEN
7932       ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
7933       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
7934       MATCH_MP_TAC REAL_LE_TRANS THEN
7935       EXISTS_TAC
7936        `sum D' (\k:real^M->bool.
7937                   e / &(2 * c) pow (dimindex(:M)) * measure k)` THEN CONJ_TAC
7938       THENL [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
7939       REWRITE_TAC[SUM_LMUL] THEN
7940       REWRITE_TAC[REAL_ARITH `e / b * x:real = (e * x) / b`] THEN
7941       ASM_SIMP_TAC[REAL_POW_LT; REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ] THEN
7942       MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`]
7943               MEASURE_ELEMENTARY) THEN
7944       ANTS_TAC THENL
7945        [ASM_REWRITE_TAC[division_of] THEN
7946         CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN
7947         GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL
7948          [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]];
7949         ALL_TAC] THEN
7950       MATCH_MP_TAC(REAL_ARITH `y = z /\ x <= e ==> x = y ==> z <= e`) THEN
7951       CONJ_TAC THENL
7952        [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET];
7953         ALL_TAC] THEN
7954       MATCH_MP_TAC REAL_LE_TRANS THEN
7955       EXISTS_TAC `measure(interval[--(vec c):real^M,vec c])` THEN CONJ_TAC THENL
7956        [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN
7957         CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS; ASM SET_TAC[]] THEN
7958         ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL];
7959         SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
7960         REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT; REAL_ARITH
7961          `x - --x = &2 * x /\ (--x <= x <=> &0 <= &2 * x)`] THEN
7962         ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_LT_IMP_LE] THEN
7963         REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB; REAL_LE_REFL]]]) in
7964   REPEAT STRIP_TAC THEN
7965   SUBGOAL_THEN
7966    `s = UNIONS
7967     {{x | x IN s /\ norm(x:real^M) <= &n /\
7968           onorm((f':real^M->real^M->real^N) x) <= &n} |
7969      n IN (:num)}`
7970   SUBST1_TAC THENL
7971    [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
7972     X_GEN_TAC `x:real^M` THEN
7973     ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
7974     REWRITE_TAC[GSYM REAL_MAX_LE; REAL_ARCH_SIMPLE];
7975     REWRITE_TAC[IMAGE_UNIONS] THEN
7976     MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
7977     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
7978     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
7979     ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
7980     X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN
7981     MATCH_MP_TAC semma THEN
7982     MAP_EVERY EXISTS_TAC [`f':real^M->real^M->real^N`; `&n + &1:real`] THEN
7983     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
7984     CONJ_TAC THENL
7985      [MATCH_MP_TAC BOUNDED_SUBSET THEN
7986       EXISTS_TAC `cball(vec 0:real^M,&n)` THEN
7987       SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM];
7988       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
7989       ASM_SIMP_TAC[REAL_ARITH `x <= n ==> x <= n + &1`] THEN
7990       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
7991       REPEAT STRIP_TAC THEN
7992       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7993        HAS_DERIVATIVE_WITHIN_SUBSET)) THEN SET_TAC[]]]);;
7994
7995 (* ------------------------------------------------------------------------- *)
7996 (* Also negligibility of BV low-dimensional image.                           *)
7997 (* ------------------------------------------------------------------------- *)
7998
7999 let NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL = prove
8000  (`!f:real^1->real^N a b.
8001         2 <= dimindex(:N) /\ f has_bounded_variation_on interval[a,b]
8002         ==> negligible(IMAGE f (interval[a,b]))`,
8003   REPEAT STRIP_TAC THEN
8004   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8005         HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT)) THEN
8006   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8007         HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT)) THEN
8008   REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN
8009   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
8010   X_GEN_TAC `l:real^1->real^N` THEN DISCH_TAC THEN
8011   X_GEN_TAC `r:real^1->real^N` THEN DISCH_TAC THEN
8012   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `ee:real` THEN DISCH_TAC THEN
8013   ABBREV_TAC
8014    `e = min (&1) (ee /
8015      (&2 pow (dimindex(:N)) *
8016       vector_variation (interval[a,b]) (f:real^1->real^N) + &1))` THEN
8017   SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
8018    [EXPAND_TAC "e" THEN
8019     MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < min (&1) x`) THEN
8020     MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN
8021     MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN
8022     MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[VECTOR_VARIATION_POS_LE] THEN
8023     MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC;
8024     ALL_TAC] THEN
8025   SUBGOAL_THEN
8026    `!c. ?d. &0 < d /\
8027             (c IN interval[a,b]
8028              ==> (!x. x IN interval[a,c] /\ ~(x = c) /\ dist(x,c) < d
8029                       ==> dist((f:real^1->real^N) x,l c) < e) /\
8030                  (!x. x IN interval[c,b] /\ ~(x = c) /\ dist(x,c) < d
8031                       ==> dist(f x,r c) < e))`
8032   MP_TAC THENL
8033    [X_GEN_TAC `c:real^1` THEN ASM_CASES_TAC `(c:real^1) IN interval[a,b]` THENL
8034      [ALL_TAC; EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN
8035     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^1`)) THEN
8036     ASM_REWRITE_TAC[LIM_WITHIN; IMP_IMP; AND_FORALL_THM] THEN
8037     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN
8038     DISCH_THEN(CONJUNCTS_THEN2
8039      (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC)
8040      (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN
8041     EXISTS_TAC `min d1 d2:real` THEN ASM_SIMP_TAC[REAL_LT_MIN];
8042     REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
8043     X_GEN_TAC `d:real^1->real` THEN
8044     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN
8045   MP_TAC(ISPECL [`\x:real^1. ball(x,d x)`; `a:real^1`; `b:real^1`]
8046     FINE_DIVISION_EXISTS) THEN
8047   ASM_REWRITE_TAC[fine; gauge; OPEN_BALL; CENTRE_IN_BALL] THEN
8048   DISCH_THEN(X_CHOOSE_THEN
8049    `p:(real^1#(real^1->bool))->bool` STRIP_ASSUME_TAC) THEN
8050   FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
8051   EXISTS_TAC
8052    `UNIONS(IMAGE (\(c,k).
8053        (f c) INSERT
8054        (cball((l:real^1->real^N) c,
8055               min e (vector_variation (interval[interval_lowerbound k,c])
8056                                       (f:real^1->real^N))) UNION
8057         cball((r:real^1->real^N) c,
8058               min e (vector_variation (interval[c,interval_upperbound k])
8059                                       (f:real^1->real^N))))) p)` THEN
8060   REPEAT CONJ_TAC THENL
8061    [FIRST_ASSUM(SUBST1_TAC o MATCH_MP TAGGED_DIVISION_UNION_IMAGE_SND) THEN
8062     REWRITE_TAC[IMAGE_UNIONS; GSYM IMAGE_o] THEN
8063     MATCH_MP_TAC UNIONS_MONO_IMAGE THEN
8064     REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN
8065     MAP_EVERY X_GEN_TAC [`c:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN
8066     SUBGOAL_THEN `?u v:real^1. k = interval[u,v]`
8067      (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
8068     THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN
8069     SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL
8070      [ASM_MESON_TAC[TAGGED_DIVISION_OF; INTERVAL_NE_EMPTY_1; NOT_IN_EMPTY];
8071       ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1]] THEN
8072     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
8073     X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN
8074     FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `interval[u:real^1,v]`]) THEN
8075     ASM_REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_CBALL] THEN DISCH_TAC THEN
8076     REWRITE_TAC[IN_INSERT; IN_UNION] THEN ASM_CASES_TAC `x:real^1 = c` THEN
8077     ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN
8078     SIMP_TAC[IN_CBALL; REAL_LE_MIN] THEN ASM_CASES_TAC `drop x <= drop c` THENL
8079      [DISJ1_TAC THEN CONJ_TAC THENL
8080        [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
8081         REMOVE_THEN "*" (MP_TAC o SPEC `c:real^1`) THEN ANTS_TAC THENL
8082          [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN
8083         DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN
8084         ASM_SIMP_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN
8085         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF];
8086         ALL_TAC] THEN
8087       SUBGOAL_THEN `drop a <= drop u /\ drop x < drop c /\
8088                     drop c <= drop v /\ drop v <= drop b`
8089       STRIP_ASSUME_TAC THENL
8090        [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN
8091         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF;
8092                       REAL_LE_TOTAL];
8093         ALL_TAC] THEN
8094       REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
8095       MATCH_MP_TAC
8096        (REWRITE_RULE[LIFT_DROP; FORALL_LIFT]
8097           (ISPEC `at c within interval [u:real^1,c]` LIM_DROP_UBOUND)) THEN
8098       EXISTS_TAC `\y:real^1. lift(norm(f x - f y:real^N))` THEN
8099       REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIFT_DROP] THEN REPEAT CONJ_TAC THENL
8100        [MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN
8101         ASM_SIMP_TAC[IN_INTERVAL_1; LIM_CONST] THEN
8102         MATCH_MP_TAC LIM_WITHIN_SUBSET THEN
8103         EXISTS_TAC `interval[a:real^1,c]` THEN CONJ_TAC THENL
8104          [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN
8105           ASM_REAL_ARITH_TAC;
8106           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC];
8107         W(MP_TAC o PART_MATCH (lhs o rand) LIMPT_OF_CONVEX o snd) THEN
8108         ANTS_TAC THENL
8109          [SIMP_TAC[CONVEX_INTERVAL; ENDS_IN_INTERVAL;
8110                    INTERVAL_NE_EMPTY_1] THEN
8111           ASM_REAL_ARITH_TAC;
8112           DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE
8113            `(?y. ~(y = x) /\ y IN s) ==> ~(s = {x})`) THEN
8114           EXISTS_TAC `u:real^1` THEN
8115           REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC];
8116         REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN
8117         REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN
8118         REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN
8119         MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL
8120          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8121             HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
8122           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC;
8123           MATCH_MP_TAC(CONJUNCT1(SPEC_ALL
8124            (REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_INTERVAL))) THEN
8125           REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]];
8126       DISJ2_TAC THEN CONJ_TAC THENL
8127        [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
8128         REMOVE_THEN "*" (MP_TAC o SPEC `c:real^1`) THEN ANTS_TAC THENL
8129          [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN
8130         DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
8131         ASM_SIMP_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN
8132         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF;
8133                       REAL_LE_TOTAL];
8134         ALL_TAC] THEN
8135       SUBGOAL_THEN `drop a <= drop c /\ drop c < drop x /\
8136                     drop x <= drop v /\ drop v <= drop b`
8137       STRIP_ASSUME_TAC THENL
8138        [ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN
8139         ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF;
8140                       REAL_LE_TOTAL];
8141         ALL_TAC] THEN
8142       REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
8143       MATCH_MP_TAC
8144        (REWRITE_RULE[LIFT_DROP; FORALL_LIFT]
8145           (ISPEC `at c within interval [c:real^1,v]` LIM_DROP_UBOUND)) THEN
8146       EXISTS_TAC `\y:real^1. lift(norm(f x - f y:real^N))` THEN
8147       REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIFT_DROP] THEN REPEAT CONJ_TAC THENL
8148        [MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN
8149         ASM_SIMP_TAC[IN_INTERVAL_1; LIM_CONST] THEN
8150         MATCH_MP_TAC LIM_WITHIN_SUBSET THEN
8151         EXISTS_TAC `interval[c:real^1,b]` THEN CONJ_TAC THENL
8152          [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN
8153           ASM_REAL_ARITH_TAC;
8154           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC];
8155         W(MP_TAC o PART_MATCH (lhs o rand) LIMPT_OF_CONVEX o snd) THEN
8156         ANTS_TAC THENL
8157          [SIMP_TAC[CONVEX_INTERVAL; ENDS_IN_INTERVAL;
8158                    INTERVAL_NE_EMPTY_1] THEN
8159           ASM_REAL_ARITH_TAC;
8160           DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE
8161            `(?y. ~(y = x) /\ y IN s) ==> ~(s = {x})`) THEN
8162           EXISTS_TAC `v:real^1` THEN
8163           REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC];
8164         REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN
8165         REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN
8166         REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN
8167         MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL
8168          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8169             HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
8170           REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC;
8171           MATCH_MP_TAC(CONJUNCT1(SPEC_ALL
8172            (REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_INTERVAL))) THEN
8173           REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]];
8174     MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
8175     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
8176     SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_UNION; MEASURABLE_INSERT];
8177     W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o
8178       lhand o snd) THEN
8179     ANTS_TAC THENL
8180      [ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
8181       SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_UNION; MEASURABLE_INSERT];
8182       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN
8183     ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[MEASURE_INSERT] THEN
8184     MATCH_MP_TAC REAL_LE_TRANS THEN
8185     EXISTS_TAC
8186      `&2 pow (dimindex(:N)) *
8187       e * sum p (\(x:real^1,k). vector_variation k (f:real^1->real^N))` THEN
8188     CONJ_TAC THENL
8189      [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN
8190       ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN
8191       MAP_EVERY X_GEN_TAC [`c:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN
8192       SUBGOAL_THEN `?u v:real^1. k = interval[u,v]`
8193        (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
8194       THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN
8195       SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL
8196        [ASM_MESON_TAC[TAGGED_DIVISION_OF; INTERVAL_NE_EMPTY_1; NOT_IN_EMPTY];
8197         ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1]] THEN
8198       SUBGOAL_THEN
8199        `(f:real^1->real^N) has_bounded_variation_on interval[u,c] /\
8200         (f:real^1->real^N) has_bounded_variation_on interval[c,v]`
8201       STRIP_ASSUME_TAC THENL
8202        [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
8203          (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
8204         MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interval[u:real^1,v]` THEN
8205         (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[TAGGED_DIVISION_OF]]) THEN
8206         REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
8207         REWRITE_TAC[GSYM IN_INTERVAL_1] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF];
8208         ALL_TAC] THEN
8209       SUBGOAL_THEN
8210        `vector_variation (interval [u,v]) (f:real^1->real^N) =
8211         vector_variation (interval [u,c]) f +
8212         vector_variation (interval [c,v]) f`
8213       SUBST1_TAC THENL
8214        [CONV_TAC SYM_CONV THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN
8215         ASM_REWRITE_TAC[CONJ_ASSOC; GSYM IN_INTERVAL_1] THEN
8216         CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN
8217         ASM_MESON_TAC[TAGGED_DIVISION_OF; HAS_BOUNDED_VARIATION_ON_SUBSET];
8218         ALL_TAC] THEN
8219       W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNION_LE o lhand o snd) THEN
8220       REWRITE_TAC[MEASURABLE_CBALL; REAL_ADD_LDISTRIB] THEN
8221       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
8222       MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN
8223       W(MP_TAC o PART_MATCH (lhand o rand)
8224         MEASURE_CBALL_BOUND o lhand o snd) THEN
8225       ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE] THEN
8226       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
8227       REWRITE_TAC[REAL_POW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
8228       SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
8229       (SUBGOAL_THEN `dimindex(:N) = (dimindex(:N) - 1) + 1` SUBST1_TAC THENL
8230        [ASM_ARITH_TAC; REWRITE_TAC[REAL_POW_ADD; REAL_POW_1]]) THEN
8231       MATCH_MP_TAC REAL_LE_MUL2 THEN
8232       ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE;
8233                    REAL_POW_LE; REAL_ARITH `min e v <= v`] THEN
8234       MATCH_MP_TAC REAL_LE_TRANS THEN
8235       EXISTS_TAC `(e:real) pow (dimindex(:N) - 1)` THEN
8236       (CONJ_TAC THENL
8237        [MATCH_MP_TAC REAL_POW_LE2 THEN
8238         ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE] THEN
8239         REAL_ARITH_TAC;
8240         GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN
8241         MATCH_MP_TAC REAL_POW_MONO_INV THEN
8242         ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "e" THEN CONJ_TAC THENL
8243          [ASM_REAL_ARITH_TAC; ASM_ARITH_TAC]]);
8244       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
8245        `&2 pow dimindex (:N) *
8246         (ee / (&2 pow (dimindex(:N)) *
8247             vector_variation (interval[a,b]) (f:real^1->real^N) + &1)) *
8248         sum p (\(x:real^1,k). vector_variation k f)` THEN
8249       CONJ_TAC THENL
8250        [MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POS; REAL_POW_LE] THEN
8251         MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL
8252          [EXPAND_TAC "e" THEN REAL_ARITH_TAC; ALL_TAC] THEN
8253         MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN
8254         ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; TAGGED_DIVISION_OF;
8255                       VECTOR_VARIATION_POS_LE];
8256         ALL_TAC] THEN
8257       REWRITE_TAC[REAL_ARITH `a * b / c * d:real = (b * a * d) / c`] THEN
8258       W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_LDIV_EQ o snd) THEN
8259       ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; VECTOR_VARIATION_POS_LE;
8260                    REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN
8261       DISCH_THEN SUBST1_TAC THEN
8262       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC] THEN
8263       MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= y + &1`) THEN
8264       MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
8265       FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8266           SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN DISCH_THEN(fun th ->
8267       W(MP_TAC o PART_MATCH (lhs o rand) th o lhand o snd)) THEN
8268       SIMP_TAC[VECTOR_VARIATION_ON_NULL; BOUNDED_INTERVAL] THEN
8269       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ETA_AX] THEN
8270       MATCH_MP_TAC REAL_EQ_IMP_LE THEN
8271       MATCH_MP_TAC VECTOR_VARIATION_ON_DIVISION THEN
8272       ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]]]);;
8273
8274 let NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE = prove
8275  (`!g:real^1->real^N.
8276         2 <= dimindex(:N) /\ rectifiable_path g ==> negligible(path_image g)`,
8277   REWRITE_TAC[rectifiable_path; path_image] THEN
8278   SIMP_TAC[NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL]);;
8279
8280 (* ------------------------------------------------------------------------- *)
8281 (* Properties of Lebesgue measurable sets.                                   *)
8282 (* ------------------------------------------------------------------------- *)
8283
8284 let MEASURABLE_IMP_LEBESGUE_MEASURABLE = prove
8285  (`!s:real^N->bool. measurable s ==> lebesgue_measurable s`,
8286   REPEAT STRIP_TAC THEN REWRITE_TAC[lebesgue_measurable] THEN
8287   MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
8288   ASM_REWRITE_TAC[indicator; GSYM MEASURABLE_INTEGRABLE]);;
8289
8290 let NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE = prove
8291  (`!s:real^N->bool. negligible s ==> lebesgue_measurable s`,
8292   SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);;
8293
8294 let LEBESGUE_MEASURABLE_EMPTY = prove
8295  (`lebesgue_measurable {}`,
8296   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_EMPTY]);;
8297
8298 let LEBESGUE_MEASURABLE_UNIV = prove
8299  (`lebesgue_measurable (:real^N)`,
8300   REWRITE_TAC[lebesgue_measurable; indicator; IN_UNIV; MEASURABLE_ON_CONST]);;
8301
8302 let LEBESGUE_MEASURABLE_COMPACT = prove
8303  (`!s:real^N->bool. compact s ==> lebesgue_measurable s`,
8304   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_COMPACT]);;
8305
8306 let LEBESGUE_MEASURABLE_INTERVAL = prove
8307  (`(!a b:real^N. lebesgue_measurable(interval[a,b])) /\
8308    (!a b:real^N. lebesgue_measurable(interval(a,b)))`,
8309   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_INTERVAL]);;
8310
8311 let LEBESGUE_MEASURABLE_INTER = prove
8312  (`!s t:real^N->bool.
8313         lebesgue_measurable s /\ lebesgue_measurable t
8314         ==> lebesgue_measurable(s INTER t)`,
8315   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8316   REWRITE_TAC[MEASURABLE_ON_INTER]);;
8317
8318 let LEBESGUE_MEASURABLE_UNION = prove
8319  (`!s t:real^N->bool.
8320         lebesgue_measurable s /\ lebesgue_measurable t
8321         ==> lebesgue_measurable(s UNION t)`,
8322   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8323   REWRITE_TAC[MEASURABLE_ON_UNION]);;
8324
8325 let LEBESGUE_MEASURABLE_DIFF = prove
8326  (`!s t:real^N->bool.
8327         lebesgue_measurable s /\ lebesgue_measurable t
8328         ==> lebesgue_measurable(s DIFF t)`,
8329   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8330   REWRITE_TAC[MEASURABLE_ON_DIFF]);;
8331
8332 let LEBESGUE_MEASURABLE_COMPL = prove
8333  (`!s. lebesgue_measurable((:real^N) DIFF s) <=> lebesgue_measurable s`,
8334   MESON_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_UNIV;
8335             SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]);;
8336
8337 let LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove
8338  (`!s. lebesgue_measurable s <=>
8339        !a b:real^N. lebesgue_measurable(s INTER interval[a,b])`,
8340   GEN_TAC THEN EQ_TAC THEN
8341   SIMP_TAC[LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_INTER] THEN
8342   REWRITE_TAC[lebesgue_measurable] THEN DISCH_TAC THEN
8343   MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
8344   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
8345   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
8346   EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN
8347   REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL
8348    [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
8349     FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
8350     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8351     REWRITE_TAC[FUN_EQ_THM; indicator; IN_INTER] THEN MESON_TAC[];
8352     REPEAT STRIP_TAC THEN REWRITE_TAC[indicator] THEN
8353     COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop] THEN
8354     REAL_ARITH_TAC]);;
8355
8356 let LEBESGUE_MEASURABLE_CLOSED = prove
8357  (`!s:real^N->bool. closed s ==> lebesgue_measurable s`,
8358   REPEAT STRIP_TAC THEN
8359   ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
8360   ASM_SIMP_TAC[CLOSED_INTER_COMPACT; LEBESGUE_MEASURABLE_COMPACT;
8361                COMPACT_INTERVAL]);;
8362
8363 let LEBESGUE_MEASURABLE_OPEN = prove
8364  (`!s:real^N->bool. open s ==> lebesgue_measurable s`,
8365   REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN
8366   ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN
8367   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED]);;
8368
8369 let LEBESGUE_MEASURABLE_UNIONS = prove
8370  (`!f. FINITE f /\ (!s. s IN f ==> lebesgue_measurable s)
8371        ==> lebesgue_measurable (UNIONS f)`,
8372   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8373   REWRITE_TAC[MEASURABLE_ON_UNIONS]);;
8374
8375 let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove
8376  (`!f:(real^N->bool)->bool.
8377         COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s)
8378         ==> lebesgue_measurable (UNIONS f)`,
8379   REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN
8380   REWRITE_TAC[MEASURABLE_ON_COUNTABLE_UNIONS]);;
8381
8382 let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove
8383  (`!s:num->real^N->bool.
8384         (!n. lebesgue_measurable(s n))
8385         ==> lebesgue_measurable(UNIONS {s n | n IN (:num)})`,
8386   REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8387   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8388   ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV; NUM_COUNTABLE]);;
8389
8390 let LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove
8391  (`!f:(real^N->bool)->bool.
8392         COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s)
8393         ==> lebesgue_measurable (INTERS f)`,
8394   REPEAT STRIP_TAC THEN
8395   REWRITE_TAC[INTERS_UNIONS; LEBESGUE_MEASURABLE_COMPL] THEN
8396   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8397   ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE;
8398                LEBESGUE_MEASURABLE_COMPL]);;
8399
8400 let LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove
8401  (`!s:num->real^N->bool.
8402         (!n. lebesgue_measurable(s n))
8403         ==> lebesgue_measurable(INTERS {s n | n IN (:num)})`,
8404   REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
8405   ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE;
8406                NUM_COUNTABLE]);;
8407
8408 let LEBESGUE_MEASURABLE_INTERS = prove
8409  (`!f:(real^N->bool)->bool.
8410         FINITE f /\ (!s. s IN f ==> lebesgue_measurable s)
8411         ==> lebesgue_measurable (INTERS f)`,
8412   SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);;
8413
8414 let LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove
8415  (`!s:real^N->bool. bounded s ==> (lebesgue_measurable s <=> measurable s)`,
8416   REPEAT STRIP_TAC THEN EQ_TAC THEN
8417   SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
8418   REWRITE_TAC[lebesgue_measurable; indicator; MEASURABLE_INTEGRABLE] THEN
8419   SUBGOAL_THEN `?a b:real^N. s = s INTER interval[a,b]`
8420    (REPEAT_TCL CHOOSE_THEN SUBST1_TAC)
8421   THENL [REWRITE_TAC[SET_RULE `s = s INTER t <=> s SUBSET t`] THEN
8422          ASM_MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL]; ALL_TAC] THEN
8423   REWRITE_TAC[IN_INTER; MESON[]
8424    `(if P x /\ Q x then a else b) =
8425     (if Q x then if P x then a else b else b)`] THEN
8426   REWRITE_TAC[MEASURABLE_ON_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN
8427   STRIP_TAC THEN MATCH_MP_TAC
8428     MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
8429   EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN
8430   ASM_REWRITE_TAC[INTEGRABLE_CONST; NORM_REAL; DROP_VEC; GSYM drop] THEN
8431   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN SIMP_TAC[DROP_VEC] THEN
8432   REAL_ARITH_TAC);;
8433
8434 let LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS = prove
8435  (`!s:real^N->bool.
8436         lebesgue_measurable s <=>
8437         (!a b. measurable(s INTER interval[a,b]))`,
8438   MESON_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS;
8439             LEBESGUE_MEASURABLE_IFF_MEASURABLE;
8440             BOUNDED_INTER; BOUNDED_INTERVAL]);;
8441
8442 let LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS = prove
8443  (`!s:real^N->bool.
8444         lebesgue_measurable s <=>
8445         (!n. measurable(s INTER interval[--vec n,vec n]))`,
8446   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV
8447    [LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS] THEN
8448   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
8449   SUBGOAL_THEN
8450    `!a b:real^N. ?n. s INTER interval[a,b] =
8451                      ((s INTER interval[--vec n,vec n]) INTER interval[a,b])`
8452    (fun th -> ASM_MESON_TAC[th; MEASURABLE_INTERVAL; MEASURABLE_INTER]) THEN
8453   REPEAT GEN_TAC THEN
8454   MP_TAC(ISPECL [`interval[a:real^N,b]`; `vec 0:real^N`]
8455         BOUNDED_SUBSET_CBALL) THEN
8456   REWRITE_TAC[BOUNDED_INTERVAL] THEN
8457   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8458   MP_TAC(SPEC `r:real` REAL_ARCH_SIMPLE) THEN
8459   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
8460   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8461    `i SUBSET b ==> b SUBSET n ==> s INTER i = (s INTER n) INTER i`)) THEN
8462   REWRITE_TAC[SUBSET; IN_CBALL_0; IN_INTERVAL; VEC_COMPONENT;
8463               VECTOR_NEG_COMPONENT; GSYM REAL_ABS_BOUNDS]  THEN
8464   ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);;
8465
8466 let MEASURABLE_ON_MEASURABLE_SUBSET = prove
8467  (`!f s t. s SUBSET t /\ f measurable_on t /\ measurable s
8468            ==> f measurable_on s`,
8469   MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET;
8470             MEASURABLE_IMP_LEBESGUE_MEASURABLE]);;
8471
8472 let MEASURABLE_ON_CASES = prove
8473  (`!P f g:real^M->real^N s.
8474         lebesgue_measurable {x | P x} /\
8475         f measurable_on s /\ g measurable_on s
8476         ==> (\x. if P x then f x else g x) measurable_on s`,
8477   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
8478   REPEAT STRIP_TAC THEN
8479   SUBGOAL_THEN
8480    `!x. (if x IN s then if P x then (f:real^M->real^N) x else g x else vec 0) =
8481         (if x IN {x | P x} then if x IN s then f x else vec 0 else vec 0) +
8482         (if x IN (:real^M) DIFF {x | P x}
8483          then if x IN s then g x else vec 0 else vec 0)`
8484    (fun th -> REWRITE_TAC[th])
8485   THENL
8486    [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN
8487     MESON_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID];
8488     MATCH_MP_TAC MEASURABLE_ON_ADD THEN
8489     CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN
8490     ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]]);;
8491
8492 let LEBESGUE_MEASURABLE_JORDAN = prove
8493  (`!s:real^N->bool. negligible(frontier s) ==> lebesgue_measurable s`,
8494   REPEAT STRIP_TAC THEN
8495   ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
8496   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
8497   MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN
8498   MATCH_MP_TAC MEASURABLE_JORDAN THEN
8499   SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL] THEN
8500   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
8501   EXISTS_TAC `frontier s UNION frontier(interval[a:real^N,b])` THEN
8502   ASM_REWRITE_TAC[FRONTIER_INTER_SUBSET; NEGLIGIBLE_UNION_EQ] THEN
8503   SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_INTERVAL]);;
8504
8505 let LEBESGUE_MEASURABLE_CONVEX = prove
8506  (`!s:real^N->bool. convex s ==> lebesgue_measurable s`,
8507   SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN; NEGLIGIBLE_CONVEX_FRONTIER]);;
8508
8509 (* ------------------------------------------------------------------------- *)
8510 (* Invariance theorems for Lebesgue measurability.                           *)
8511 (* ------------------------------------------------------------------------- *)
8512
8513 let MEASURABLE_ON_TRANSLATION = prove
8514  (`!f:real^M->real^N s a.
8515           f measurable_on (IMAGE (\x. a + x) s)
8516           ==> (\x. f(a + x)) measurable_on s`,
8517   REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM] THEN
8518   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^N`] THEN
8519   STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^M. --a + x) k` THEN
8520   EXISTS_TAC `\n. (g:num->real^M->real^N) n o (\x. a + x)` THEN
8521   ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN CONJ_TAC THENL
8522    [GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
8523     SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
8524     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
8525     X_GEN_TAC `x:real^M` THEN
8526     FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN
8527     REWRITE_TAC[o_DEF; IN_IMAGE] THEN
8528     ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> a + x = y`] THEN
8529     REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]);;
8530
8531 let MEASURABLE_ON_TRANSLATION_EQ = prove
8532  (`!f:real^M->real^N s a.
8533         (\x. f(a + x)) measurable_on s <=>
8534         f measurable_on (IMAGE (\x. a + x) s)`,
8535   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_ON_TRANSLATION] THEN
8536   MP_TAC(ISPECL [`\x. (f:real^M->real^N) (a + x)`;
8537                  `IMAGE (\x:real^M. a + x) s`; `--a:real^M`]
8538     MEASURABLE_ON_TRANSLATION) THEN
8539   REWRITE_TAC[GSYM IMAGE_o; o_DEF; ETA_AX; IMAGE_ID; VECTOR_ARITH
8540    `--a + a + x:real^N = x /\ a + --a + x = x`]);;
8541
8542 let NEGLIGIBLE_LINEAR_IMAGE_GEN = prove
8543  (`!f:real^M->real^N s.
8544         linear f /\ negligible s /\ dimindex(:M) <= dimindex(:N)
8545         ==> negligible (IMAGE f s)`,
8546   REPEAT STRIP_TAC THEN
8547   MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN
8548   ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);;
8549
8550 let MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN = prove
8551  (`!f:real^M->real^N h:real^N->real^P s.
8552         dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y)
8553         ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`,
8554   let lemma = prove
8555    (`!f:real^N->real^P g:real^M->real^N h s.
8556         dimindex(:M) = dimindex(:N) /\
8557         linear g /\ linear h /\ (!x. h(g x) = x) /\ (!x. g(h x) = x)
8558         ==> (f o g) measurable_on s ==> f measurable_on (IMAGE g s)`,
8559     REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN
8560     STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool`
8561      (X_CHOOSE_THEN `G:num->real^M->real^P` STRIP_ASSUME_TAC)) THEN
8562     EXISTS_TAC `IMAGE (g:real^M->real^N) k` THEN
8563     EXISTS_TAC `\n x. (G:num->real^M->real^P) n ((h:real^N->real^M) x)` THEN
8564     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8565      [MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_GEN THEN
8566       ASM_MESON_TAC[LE_REFL];
8567       GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
8568       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
8569       ASM_MESON_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
8570       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
8571       FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^N->real^M) y`) THEN
8572       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8573       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8574       ASM_REWRITE_TAC[o_THM] THEN
8575       AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]) in
8576   REPEAT GEN_TAC THEN STRIP_TAC THEN
8577   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
8578   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; FUN_EQ_THM; o_THM; I_THM] THEN
8579   X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN
8580   SUBGOAL_THEN `!y:real^N. (f:real^M->real^N) ((g:real^N->real^M) y) = y`
8581   ASSUME_TAC THENL
8582    [SUBGOAL_THEN `IMAGE (f:real^M->real^N) UNIV = UNIV` MP_TAC THENL
8583      [ALL_TAC; ASM SET_TAC[]] THEN
8584     REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN
8585     ASM_MESON_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN];
8586     ALL_TAC] THEN
8587   EQ_TAC THENL [ASM_MESON_TAC[lemma]; DISCH_TAC] THEN
8588   MP_TAC(ISPECL [`(h:real^N->real^P) o (f:real^M->real^N)`;
8589                  `g:real^N->real^M`; `f:real^M->real^N`;
8590                  `IMAGE (f:real^M->real^N) s`] lemma) THEN
8591   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; ETA_AX] THEN
8592   DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[]);;
8593
8594 let MEASURABLE_ON_LINEAR_IMAGE_EQ = prove
8595  (`!f:real^N->real^N h:real^N->real^P s.
8596         linear f /\ (!x y. f x = f y ==> x = y)
8597         ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`,
8598   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN THEN
8599   ASM_MESON_TAC[]);;
8600
8601 let LEBESGUE_MEASURABLE_TRANSLATION = prove
8602  (`!a:real^N s.
8603      lebesgue_measurable (IMAGE (\x. a + x) s) <=>
8604      lebesgue_measurable s`,
8605   ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
8606   SIMP_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE;
8607            BOUNDED_INTER; BOUNDED_INTERVAL] THEN
8608   GEOM_TRANSLATE_TAC[]);;
8609
8610 add_translation_invariants [LEBESGUE_MEASURABLE_TRANSLATION];;
8611
8612 let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ = prove
8613  (`!f:real^N->real^N s.
8614         linear f /\ (!x y. f x = f y ==> x = y)
8615          ==> (lebesgue_measurable (IMAGE f s) <=>
8616               lebesgue_measurable s)`,
8617   REPEAT GEN_TAC THEN DISCH_TAC THEN
8618   FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN
8619   POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
8620   DISCH_TAC THEN
8621   FIRST_ASSUM(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC o
8622         MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN
8623   REWRITE_TAC[lebesgue_measurable] THEN MP_TAC(ISPECL
8624    [`g:real^N->real^N`; `indicator(s:real^N->bool)`; `(:real^N)`]
8625    MEASURABLE_ON_LINEAR_IMAGE_EQ) THEN
8626   ASM_REWRITE_TAC[indicator; o_DEF] THEN
8627   ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC EQ_IMP] THEN
8628   BINOP_TAC THENL
8629    [AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
8630     AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[];
8631     AP_TERM_TAC THEN ASM SET_TAC[]]);;
8632
8633 add_linear_invariants [LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ];;
8634
8635 (* ------------------------------------------------------------------------- *)
8636 (* Various common equivalent forms of function measurability.                *)
8637 (* ------------------------------------------------------------------------- *)
8638
8639 let (MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT,
8640      MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT) = (CONJ_PAIR o prove)
8641  (`(!f:real^M->real^N.
8642         f measurable_on (:real^M) <=>
8643         !a k. 1 <= k /\ k <= dimindex(:N)
8644               ==> lebesgue_measurable {x | f(x)$k < a}) /\
8645    (!f:real^M->real^N.
8646         f measurable_on (:real^M) <=>
8647         ?g. (!n. (g n) measurable_on (:real^M)) /\
8648             (!n. FINITE(IMAGE (g n) (:real^M))) /\
8649             (!x. ((\n. g n x) --> f x) sequentially))`,
8650   let lemma0 = prove
8651    (`!f:real^M->real^1 n m.
8652           integer m /\
8653           m / &2 pow n <= drop(f x) /\
8654           drop(f x) < (m + &1) / &2 pow n /\
8655           abs(m) <= &2 pow (2 * n)
8656           ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
8657                    (\k. k / &2 pow n %
8658                         indicator {y:real^M | k / &2 pow n <= drop(f y) /\
8659                                               drop(f y) < (k + &1) / &2 pow n}
8660                                   x) =
8661               lift(m / &2 pow n)`,
8662     REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
8663     EXISTS_TAC
8664      `vsum {m} (\k. k / &2 pow n %
8665                     indicator {y:real^M | k / &2 pow n <= drop(f y) /\
8666                                           drop(f y) < (k + &1) / &2 pow n}
8667                               x)` THEN
8668     CONJ_TAC THENL
8669      [MATCH_MP_TAC VSUM_SUPERSET THEN
8670       ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN
8671       X_GEN_TAC `k:real` THEN STRIP_TAC THEN
8672       REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
8673       ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN
8674       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
8675       MATCH_MP_TAC(TAUT `F ==> p`) THEN
8676       UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN
8677       POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
8678       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
8679       REAL_ARITH_TAC;
8680       ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in
8681   let lemma1 = prove
8682    (`!f:real^M->real^1.
8683           (!a b. lebesgue_measurable {x | a <= drop(f x) /\ drop(f x) < b})
8684           ==> ?g. (!n. (g n) measurable_on (:real^M)) /\
8685                   (!n. FINITE(IMAGE (g n) (:real^M))) /\
8686                   (!x. ((\n. g n x) --> f x) sequentially)`,
8687     REPEAT STRIP_TAC THEN
8688     EXISTS_TAC
8689      `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
8690                  (\k. k / &2 pow n %
8691                       indicator {y:real^M | k / &2 pow n <= drop(f y) /\
8692                                             drop(f y) < (k + &1) / &2 pow n}
8693                                 x)` THEN
8694     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8695      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN
8696       REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN
8697       GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN
8698       ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX];
8699       X_GEN_TAC `n:num` THEN
8700       MATCH_MP_TAC FINITE_SUBSET THEN
8701       EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n))
8702                         {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN
8703       CONJ_TAC THENL
8704        [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE];
8705         ALL_TAC] THEN
8706       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN
8707       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_IMAGE] THEN
8708       ASM_CASES_TAC
8709        `?k. integer k /\ abs k <= &2 pow (2 * n) /\
8710             k / &2 pow n <= drop(f(x:real^M)) /\
8711             drop(f x) < (k + &1) / &2 pow n`
8712       THENL
8713        [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN
8714         X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
8715         MATCH_MP_TAC lemma0 THEN ASM_REWRITE_TAC[];
8716         EXISTS_TAC `&0` THEN
8717         ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN
8718         SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN
8719         REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN
8720         MATCH_MP_TAC VSUM_EQ_0 THEN
8721         X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
8722         REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
8723         REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]];
8724       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
8725       MP_TAC(ISPECL [`&2`; `abs(drop((f:real^M->real^1) x))`]
8726           REAL_ARCH_POW) THEN
8727       ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN
8728       X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8729       MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
8730       REWRITE_TAC[REAL_POW_INV] THEN
8731       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8732       DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN
8733       SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN
8734       SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN
8735       EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
8736       ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^M)))` THEN
8737       SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^M->real^1) x) < e`
8738       MP_TAC THENL
8739        [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN
8740         MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN
8741         REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN
8742         SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ;
8743                  REAL_OF_NUM_EQ; ARITH] THEN
8744         MATCH_MP_TAC(REAL_ARITH
8745          `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN
8746         EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
8747         ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
8748         EXISTS_TAC `e * &2 pow N2` THEN
8749         ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN
8750         MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
8751         MATCH_MP_TAC(NORM_ARITH
8752          `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN
8753         MATCH_MP_TAC lemma0 THEN
8754         SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
8755         ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
8756         EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
8757         SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE;
8758                  INTEGER_CLOSED] THEN
8759         MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN
8760         REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW;
8761                     REAL_ABS_NUM] THEN
8762         MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
8763         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
8764          `x < e ==> e <= d ==> x <= d`))] THEN
8765       MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
8766       ASM_ARITH_TAC]) in
8767   MATCH_MP_TAC(MESON[]
8768    `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f)
8769     ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN
8770   REPEAT CONJ_TAC THENL
8771    [X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN
8772     ABBREV_TAC `f:real^M->real^N = \x. --(g x)` THEN
8773     SUBGOAL_THEN `(f:real^M->real^N) measurable_on (:real^M)` ASSUME_TAC THENL
8774      [EXPAND_TAC "f" THEN MATCH_MP_TAC MEASURABLE_ON_NEG THEN ASM_SIMP_TAC[];
8775       ALL_TAC] THEN
8776     ONCE_REWRITE_TAC[GSYM REAL_LT_NEG2] THEN X_GEN_TAC `a:real` THEN
8777     SPEC_TAC(`--a:real`,`a:real`) THEN
8778     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
8779     SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN DISCH_THEN(K ALL_TAC) THEN
8780     REPEAT STRIP_TAC THEN
8781     FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o
8782       GEN_REWRITE_RULE I [MEASURABLE_ON_COMPONENTWISE]) THEN
8783     ASM_REWRITE_TAC[] THEN  REPEAT STRIP_TAC THEN
8784     MP_TAC(GEN `d:real` (ISPECL
8785      [`\x. lift ((f:real^M->real^N) x$k)`;
8786        `(\x. lift a + (lambda i. d)):real^M->real^1`;
8787       `(:real^M)`] MEASURABLE_ON_MIN)) THEN
8788     ASM_REWRITE_TAC[MEASURABLE_ON_CONST] THEN
8789     DISCH_THEN(fun th ->
8790       MP_TAC(GEN `n:num` (ISPEC `&n + &1` (MATCH_MP MEASURABLE_ON_CMUL
8791         (MATCH_MP MEASURABLE_ON_SUB
8792        (CONJ (SPEC `inv(&n + &1)` th) (SPEC `&0` th))))))) THEN
8793     REWRITE_TAC[lebesgue_measurable; indicator] THEN
8794     DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
8795           MEASURABLE_ON_LIMIT)) THEN
8796     EXISTS_TAC `{}:real^M->bool` THEN
8797     REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; IN_UNIV; NOT_IN_EMPTY] THEN
8798     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN
8799     SIMP_TAC[LIM_SEQUENTIALLY; DIST_REAL; VECTOR_MUL_COMPONENT;
8800              VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
8801              LAMBDA_BETA; DIMINDEX_1; ARITH] THEN
8802     REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_ADD_RID] THEN
8803     SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; REAL_ARITH
8804      `&0 < d ==> (min x (a + d) - min x a =
8805                   if x <= a then &0 else if x <= a + d then x - a else d)`] THEN
8806     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8807     ASM_CASES_TAC `a < (f:real^M->real^N) x $k` THEN ASM_REWRITE_TAC[] THEN
8808     ASM_REWRITE_TAC[REAL_ARITH `(x:real^N)$k <= a <=> ~(a < x$k)`] THEN
8809     ASM_REWRITE_TAC[REAL_MUL_RZERO; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN
8810     MP_TAC(SPEC `((f:real^M->real^N) x)$k - a` REAL_ARCH_INV) THEN
8811     ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN
8812     X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
8813     SUBGOAL_THEN `a + inv(&n + &1) < ((f:real^M->real^N) x)$k` ASSUME_TAC THENL
8814      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
8815        `N < f - a ==> n <= N ==> a + n < f`)) THEN
8816       MATCH_MP_TAC REAL_LE_INV2 THEN
8817       REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
8818       ASM_ARITH_TAC;
8819       ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `~(&n + &1 = &0)`] THEN
8820       ASM_REAL_ARITH_TAC];
8821     REPEAT STRIP_TAC THEN
8822     SUBGOAL_THEN
8823      `!k. 1 <= k /\ k <= dimindex(:N)
8824           ==> ?g. (!n. (g n) measurable_on (:real^M)) /\
8825                   (!n. FINITE(IMAGE (g n) (:real^M))) /\
8826                   (!x. ((\n. g n x) --> lift((f x:real^N)$k)) sequentially)`
8827     MP_TAC THENL
8828      [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN
8829       ASM_SIMP_TAC[LIFT_DROP] THEN
8830       MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN
8831       REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN
8832       MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN
8833       ASM_SIMP_TAC[REAL_NOT_LE];
8834       GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM]] THEN
8835     REWRITE_TAC[SKOLEM_THM] THEN
8836     DISCH_THEN(X_CHOOSE_THEN `g:num->num->real^M->real^1` MP_TAC) THEN
8837     REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
8838     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
8839     EXISTS_TAC
8840       `\n x. (lambda k. drop((g:num->num->real^M->real^1) k n x)):real^N` THEN
8841     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8842      [X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN
8843       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
8844       ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX];
8845       X_GEN_TAC `n:num` THEN MATCH_MP_TAC FINITE_SUBSET THEN
8846       EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
8847                         ==> lift(x$i) IN IMAGE (g i (n:num)) (:real^M)}` THEN
8848       ASM_SIMP_TAC[GSYM IN_IMAGE_LIFT_DROP; SET_RULE `{x | x IN s} = s`;
8849                    FINITE_IMAGE; FINITE_CART] THEN
8850       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
8851       SIMP_TAC[IN_IMAGE; IN_UNIV; LAMBDA_BETA; DROP_EQ] THEN MESON_TAC[];
8852       X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
8853       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
8854       ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]];
8855     X_GEN_TAC `f:real^M->real^N` THEN
8856     DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
8857     MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
8858     MAP_EVERY EXISTS_TAC [`g:num->real^M->real^N`; `{}:real^M->bool`] THEN
8859     ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY]]);;
8860
8861 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE = prove
8862  (`!f:real^M->real^N.
8863         f measurable_on (:real^M) <=>
8864         !a k. 1 <= k /\ k <= dimindex(:N)
8865               ==> lebesgue_measurable {x | f(x)$k >= a}`,
8866   GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x >= a <=> ~(x < a)`] THEN
8867   REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
8868   REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN
8869   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]);;
8870
8871 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT = prove
8872  (`!f:real^M->real^N.
8873         f measurable_on (:real^M) <=>
8874         !a k. 1 <= k /\ k <= dimindex(:N)
8875               ==> lebesgue_measurable {x | f(x)$k > a}`,
8876   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
8877   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN
8878   GEN_REWRITE_TAC LAND_CONV
8879    [MESON[REAL_NEG_NEG] `(!x. P x) <=> (!x:real. P(--x))`] THEN
8880   REWRITE_TAC[real_gt; VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);;
8881
8882 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE = prove
8883  (`!f:real^M->real^N.
8884         f measurable_on (:real^M) <=>
8885         !a k. 1 <= k /\ k <= dimindex(:N)
8886               ==> lebesgue_measurable {x | f(x)$k <= a}`,
8887   GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x <= a <=> ~(x > a)`] THEN
8888   REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
8889   REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN
8890   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]);;
8891
8892 let (MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL,
8893     MEASURABLE_ON_PREIMAGE_OPEN) = (CONJ_PAIR o prove)
8894  (`(!f:real^M->real^N.
8895         f measurable_on (:real^M) <=>
8896         !a b. lebesgue_measurable {x | f(x) IN interval(a,b)}) /\
8897    (!f:real^M->real^N.
8898         f measurable_on (:real^M) <=>
8899         !t. open t ==> lebesgue_measurable {x | f(x) IN t})`,
8900   let ulemma = prove
8901    (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`,
8902     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
8903   MATCH_MP_TAC(MESON[]
8904    `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f)
8905     ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN
8906   REPEAT CONJ_TAC THENL
8907    [REPEAT STRIP_TAC THEN SUBGOAL_THEN
8908     `{x | (f:real^M->real^N) x IN interval(a,b)} =
8909         INTERS {{x | a$k < f(x)$k} | k IN 1..dimindex(:N)} INTER
8910         INTERS {{x | (--b)$k < --(f(x))$k} | k IN 1..dimindex(:N)}`
8911     SUBST1_TAC THENL
8912      [REWRITE_TAC[IN_INTERVAL; GSYM IN_NUMSEG] THEN
8913       REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_LT_NEG2] THEN
8914       REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[];
8915       MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN
8916       CONJ_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN
8917       SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
8918       REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THENL
8919        [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
8920          [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]);
8921         FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
8922         REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]] THEN
8923       ASM_SIMP_TAC[real_gt]];
8924     REPEAT STRIP_TAC THEN
8925     FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_OPEN_INTERVALS) THEN
8926     DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
8927     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN
8928     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8929     ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
8930     X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN
8931     FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN
8932     ASM_REWRITE_TAC[] THEN
8933     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8934     ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM];
8935     REPEAT STRIP_TAC THEN
8936     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN
8937     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
8938       `{x:real^M | (f x)$k < a} = {x | f x IN {y:real^N | y$k < a}}`] THEN
8939     FIRST_X_ASSUM MATCH_MP_TAC THEN
8940     REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]]);;
8941
8942 let MEASURABLE_ON_PREIMAGE_CLOSED = prove
8943  (`!f:real^M->real^N.
8944         f measurable_on (:real^M) <=>
8945         !t. closed t ==> lebesgue_measurable {x | f(x) IN t}`,
8946   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL; closed] THEN
8947   REWRITE_TAC[SET_RULE
8948    `UNIV DIFF {x | f x IN t} = {x | f x IN (UNIV DIFF t)}`] THEN
8949   REWRITE_TAC[MESON[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]
8950    `(!s. P(UNIV DIFF s)) <=> (!s. P s)`] THEN
8951   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);;
8952
8953 let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove
8954  (`!f:real^M->real^N.
8955          f measurable_on (:real^M) <=>
8956          !a b. lebesgue_measurable {x | f(x) IN interval[a,b]}`,
8957   let ulemma = prove
8958    (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`,
8959     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
8960   GEN_TAC THEN EQ_TAC THENL
8961    [SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED; CLOSED_INTERVAL]; DISCH_TAC] THEN
8962   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN REPEAT STRIP_TAC THEN
8963   FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN
8964   DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
8965   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN
8966   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
8967   ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
8968   X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN
8969   FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
8970   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8971   ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM]);;
8972
8973 let LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove
8974  (`!f:real^M->real^N t.
8975         f measurable_on (:real^M) /\ open t
8976         ==> lebesgue_measurable {x | f(x) IN t}`,
8977   SIMP_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);;
8978
8979 let LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove
8980  (`!f:real^M->real^N t.
8981         f measurable_on (:real^M) /\ closed t
8982         ==> lebesgue_measurable {x | f(x) IN t}`,
8983   SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED]);;
8984
8985 let MEASURABLE_ON_PREIMAGE_ORTHANT_LE = prove
8986  (`!f:real^M->real^N.
8987         f measurable_on (:real^M) <=>
8988         !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N)
8989                                          ==> f(x)$k <= (a:real^N)$k}`,
8990   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
8991    [GEN_TAC THEN
8992     ONCE_REWRITE_TAC[SET_RULE `{x | !k. P k ==> f x$k <= a k} =
8993                      {x | f(x) IN {y | !k. P k ==> y$k <= a k}}`] THEN
8994     FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
8995         [MEASURABLE_ON_PREIMAGE_CLOSED]) THEN
8996     REWRITE_TAC[CLOSED_INTERVAL_LEFT];
8997     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN
8998     MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN
8999     SUBGOAL_THEN
9000      `{x | (f:real^M->real^N) x$k <= a} =
9001       UNIONS
9002        {{x | !j. 1 <= j /\ j <= dimindex(:N) ==>
9003                  f x$j <= ((lambda i. if i = k then a else &n):real^N)$j} |
9004         n IN (:num)}`
9005     SUBST1_TAC THENL
9006      [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
9007       X_GEN_TAC `x:real^M` THEN SIMP_TAC[LAMBDA_BETA] THEN
9008       SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN GEN_TAC THEN
9009       ASM_CASES_TAC `(y:real^N)$k <= a` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
9010       ASM_REWRITE_TAC[] THEN
9011       MP_TAC(SPEC
9012        `sup {(y:real^N)$j | j IN 1..dimindex(:N)}` REAL_ARCH_SIMPLE) THEN
9013       MATCH_MP_TAC MONO_EXISTS THEN
9014       SIMP_TAC[REAL_SUP_LE_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
9015                IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1]  THEN
9016       REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[];
9017       MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
9018       ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE;
9019                    FORALL_IN_IMAGE]]]);;
9020
9021 let MEASURABLE_ON_PREIMAGE_ORTHANT_GE = prove
9022  (`!f:real^M->real^N.
9023         f measurable_on (:real^M) <=>
9024         !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N)
9025                                          ==> f(x)$k >= (a:real^N)$k}`,
9026   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
9027   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_ORTHANT_LE] THEN
9028   GEN_REWRITE_TAC LAND_CONV
9029    [MESON[VECTOR_NEG_NEG] `(!x:real^N. P x) <=> (!x. P(--x))`] THEN
9030   REWRITE_TAC[REAL_ARITH `--x <= --y <=> x >= y`; VECTOR_NEG_COMPONENT]);;
9031
9032 let MEASURABLE_ON_PREIMAGE_ORTHANT_LT = prove
9033  (`!f:real^M->real^N.
9034         f measurable_on (:real^M) <=>
9035         !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N)
9036                                          ==> f(x)$k < (a:real^N)$k}`,
9037   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
9038    [GEN_TAC THEN
9039     ONCE_REWRITE_TAC[SET_RULE `{x | !k. P k ==> f x$k < a k} =
9040                      {x | f(x) IN {y | !k. P k ==> y$k < a k}}`] THEN
9041     FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
9042         [MEASURABLE_ON_PREIMAGE_OPEN]) THEN
9043     REWRITE_TAC[OPEN_INTERVAL_LEFT];
9044     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN
9045     MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN
9046     SUBGOAL_THEN
9047      `{x | (f:real^M->real^N) x$k < a} =
9048       UNIONS
9049        {{x | !j. 1 <= j /\ j <= dimindex(:N) ==>
9050                  f x$j < ((lambda i. if i = k then a else &n):real^N)$j} |
9051         n IN (:num)}`
9052     SUBST1_TAC THENL
9053      [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
9054       X_GEN_TAC `x:real^M` THEN SIMP_TAC[LAMBDA_BETA] THEN
9055       SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN GEN_TAC THEN
9056       ASM_CASES_TAC `(y:real^N)$k < a` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
9057       ASM_REWRITE_TAC[] THEN
9058       MP_TAC(SPEC
9059        `&1 + sup {(y:real^N)$j | j IN 1..dimindex(:N)}` REAL_ARCH_SIMPLE) THEN
9060       MATCH_MP_TAC MONO_EXISTS THEN
9061       REWRITE_TAC[REAL_ARITH `&1 + x <= y <=> x <= y - &1`] THEN
9062       SIMP_TAC[REAL_SUP_LE_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
9063                IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1]  THEN
9064       REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
9065       ASM_MESON_TAC[REAL_ARITH `x <= y - &1 ==> x < y`];
9066       MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
9067       ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE;
9068                    FORALL_IN_IMAGE]]]);;
9069
9070 let MEASURABLE_ON_PREIMAGE_ORTHANT_GT = prove
9071  (`!f:real^M->real^N.
9072         f measurable_on (:real^M) <=>
9073         !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N)
9074                                          ==> f(x)$k > (a:real^N)$k}`,
9075   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
9076   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_ORTHANT_LT] THEN
9077   GEN_REWRITE_TAC LAND_CONV
9078    [MESON[VECTOR_NEG_NEG] `(!x:real^N. P x) <=> (!x. P(--x))`] THEN
9079   REWRITE_TAC[REAL_ARITH `--x < --y <=> x > y`; VECTOR_NEG_COMPONENT]);;
9080
9081 let MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING = prove
9082  (`!f:real^N->real^1.
9083         f measurable_on (:real^N) /\ (!x. &0 <= drop(f x)) <=>
9084         ?g. (!n x. &0 <= drop(g n x) /\ drop(g n x) <= drop(f x)) /\
9085             (!n x. drop(g n x) <= drop(g(SUC n) x)) /\
9086             (!n. (g n) measurable_on (:real^N)) /\
9087             (!n. FINITE(IMAGE (g n) (:real^N))) /\
9088             (!x. ((\n. g n x) --> f x) sequentially)`,
9089   let lemma = prove
9090    (`!f:real^M->real^1 n m.
9091           integer m /\
9092           m / &2 pow n <= drop(f x) /\
9093           drop(f x) < (m + &1) / &2 pow n /\
9094           abs(m) <= &2 pow (2 * n)
9095           ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
9096                    (\k. k / &2 pow n %
9097                         indicator {y:real^M | k / &2 pow n <= drop(f y) /\
9098                                               drop(f y) < (k + &1) / &2 pow n}
9099                                   x) =
9100               lift(m / &2 pow n)`,
9101     REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
9102     EXISTS_TAC
9103      `vsum {m} (\k. k / &2 pow n %
9104                     indicator {y:real^M | k / &2 pow n <= drop(f y) /\
9105                                           drop(f y) < (k + &1) / &2 pow n}
9106                               x)` THEN
9107     CONJ_TAC THENL
9108      [MATCH_MP_TAC VSUM_SUPERSET THEN
9109       ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN
9110       X_GEN_TAC `k:real` THEN STRIP_TAC THEN
9111       REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
9112       ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN
9113       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9114       MATCH_MP_TAC(TAUT `F ==> p`) THEN
9115       UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN
9116       POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
9117       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
9118       REAL_ARITH_TAC;
9119       ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in
9120   REPEAT STRIP_TAC THEN EQ_TAC THENL
9121    [STRIP_TAC;
9122     DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL
9123      [GEN_REWRITE_TAC RAND_CONV [MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT] THEN
9124       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
9125       MESON_TAC[REAL_LE_TRANS]]] THEN
9126   SUBGOAL_THEN
9127    `!a b. lebesgue_measurable {x:real^N | a <= drop(f x) /\ drop(f x) < b}`
9128   ASSUME_TAC THENL
9129    [REPEAT GEN_TAC THEN
9130     REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN
9131     MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN REWRITE_TAC[REAL_NOT_LE] THEN
9132     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
9133      [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]) THEN
9134     SIMP_TAC[drop; FORALL_1; DIMINDEX_1];
9135     FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [measurable_on])] THEN
9136   REWRITE_TAC[FORALL_AND_THM; GSYM CONJ_ASSOC] THEN
9137   MATCH_MP_TAC(MESON[]
9138    `(!x. P x /\ R x ==> Q x) /\ (?x. P x /\ R x)
9139     ==> (?x. P x /\ Q x /\ R x)`) THEN
9140   CONJ_TAC THENL
9141    [X_GEN_TAC `g:num->real^N->real^1` THEN STRIP_TAC THEN
9142     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN
9143     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY] o
9144         SPEC `x:real^N`) THEN
9145     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9146     REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
9147     DISCH_THEN(MP_TAC o SPEC `drop((g:num->real^N->real^1) n x - f x)`) THEN
9148     ASM_REWRITE_TAC[DROP_SUB; REAL_SUB_LT; NOT_EXISTS_THM] THEN
9149     X_GEN_TAC `N:num` THEN DISCH_THEN(MP_TAC o SPEC `N + n:num`) THEN
9150     REWRITE_TAC[LE_ADD; DIST_REAL; GSYM drop] THEN
9151     MATCH_MP_TAC(REAL_ARITH
9152      `f < g /\ g <= g' ==> ~(abs(g' - f) < g - f)`) THEN
9153     ASM_REWRITE_TAC[] THEN MP_TAC(ARITH_RULE `n:num <= N + n`) THEN
9154     SPEC_TAC(`N + n:num`,`m:num`) THEN SPEC_TAC(`n:num`,`n:num`) THEN
9155     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
9156     REAL_ARITH_TAC;
9157     ALL_TAC] THEN
9158   EXISTS_TAC
9159    `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
9160                (\k. k / &2 pow n %
9161                     indicator {y:real^N | k / &2 pow n <= drop(f y) /\
9162                                           drop(f y) < (k + &1) / &2 pow n}
9163                               x)` THEN
9164   REWRITE_TAC[] THEN
9165   SUBGOAL_THEN `!n. FINITE {k | integer k /\ abs k <= &2 pow (2 * n)}`
9166   ASSUME_TAC THENL
9167    [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE];
9168     ALL_TAC] THEN
9169   REPEAT CONJ_TAC THENL
9170    [REPEAT GEN_TAC THEN REWRITE_TAC[VSUM_REAL; LIFT_DROP; o_DEF] THEN
9171     MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
9172     X_GEN_TAC `k:real` THEN STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN
9173     ASM_CASES_TAC `&0 <= k` THENL
9174      [MATCH_MP_TAC REAL_LE_MUL THEN
9175       ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN
9176       REWRITE_TAC[DROP_INDICATOR_POS_LE];
9177       MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 <= x`) THEN
9178       REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[indicator] THEN
9179       COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC] THEN
9180       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN
9181       MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN
9182       REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9183       EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN
9184       ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; REAL_MUL_LZERO; INTEGER_CLOSED] THEN
9185       ASM_REAL_ARITH_TAC];
9186     REPEAT GEN_TAC THEN SIMP_TAC[VSUM_REAL; LIFT_DROP; o_DEF; DROP_CMUL] THEN
9187     TRANS_TAC REAL_LE_TRANS
9188      `sum {k | integer k /\ abs(k) <= &2 pow (2 * n)}
9189           (\k. k / &2 pow n *
9190            (drop(indicator {y:real^N | k / &2 pow n <= drop(f y) /\
9191                          drop(f y) < (k + &1 / &2) / &2 pow n} x) +
9192             drop(indicator {y:real^N | (k + &1 / &2) / &2 pow n <= drop(f y) /\
9193                              drop(f y) < (k + &1) / &2 pow n} x)))` THEN
9194     CONJ_TAC THENL
9195      [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN
9196       REWRITE_TAC[FORALL_IN_GSPEC] THEN
9197       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
9198       X_GEN_TAC `k:real` THEN STRIP_TAC THEN AP_TERM_TAC THEN
9199       REWRITE_TAC[indicator; IN_ELIM_THM] THEN
9200       REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC]) THEN
9201       ASM_REAL_ARITH_TAC;
9202       ALL_TAC] THEN
9203     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
9204      [REAL_ARITH `x / y = (&2 * x) * inv(&2) * inv(y)`] THEN
9205     REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN
9206     REWRITE_TAC[GSYM(CONJUNCT2 real_pow);
9207                 REAL_ARITH `&2 * (k + &1 / &2) = &2 * k + &1`;
9208                 REAL_ARITH `&2 * (k + &1) = (&2 * k + &1) + &1`] THEN
9209     ASM_SIMP_TAC[REAL_ADD_LDISTRIB; SUM_ADD]  THEN
9210     MATCH_MP_TAC(REAL_ARITH
9211      `!g. sum s f <= sum s g /\ a + sum s g <= b ==> a + sum s f <= b`) THEN
9212     EXISTS_TAC
9213      `\k. (&2 * k + &1) / &2 pow SUC n *
9214           drop
9215           (indicator
9216            {y | (&2 * k + &1) / &2 pow SUC n <= drop ((f:real^N->real^1) y) /\
9217                 drop (f y) < ((&2 * k + &1) + &1) / &2 pow SUC n} x)` THEN
9218     REWRITE_TAC[] THEN CONJ_TAC THENL
9219      [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
9220       REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
9221       SIMP_TAC[DROP_INDICATOR_POS_LE; REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
9222       REAL_ARITH_TAC;
9223       ALL_TAC] THEN
9224     MP_TAC(ISPEC `\x. &2 * x` SUM_IMAGE) THEN
9225     MP_TAC(ISPEC `\x. &2 * x + &1` SUM_IMAGE) THEN
9226     REWRITE_TAC[REAL_EQ_ADD_RCANCEL; REAL_EQ_MUL_LCANCEL] THEN
9227     REWRITE_TAC[REAL_OF_NUM_EQ; ARITH; IMP_CONJ; o_DEF] THEN
9228     REPEAT(DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th])) THEN
9229     W(MP_TAC o PART_MATCH (rand o rand) SUM_UNION o lhand o snd) THEN
9230     ANTS_TAC THENL
9231      [ASM_SIMP_TAC[FINITE_IMAGE; SET_RULE
9232        `DISJOINT (IMAGE f s) (IMAGE g s) <=>
9233         !x. x IN s ==> !y. y IN s ==> ~(f x = g y)`] THEN
9234       REWRITE_TAC[FORALL_IN_GSPEC] THEN
9235       X_GEN_TAC `i:real` THEN STRIP_TAC THEN
9236       X_GEN_TAC `j:real` THEN STRIP_TAC THEN
9237       DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
9238        `&2 * x = &2 * y + &1 ==> &2 * abs(x - y) = &1`)) THEN
9239       SUBGOAL_THEN `integer(i - j)` MP_TAC THENL
9240        [ASM_SIMP_TAC[INTEGER_CLOSED]; REWRITE_TAC[integer]] THEN
9241       STRIP_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN
9242       DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN
9243       REWRITE_TAC[EVEN_MULT; ARITH];
9244       DISCH_THEN(SUBST1_TAC o SYM)] THEN
9245     MATCH_MP_TAC SUM_SUBSET THEN
9246     ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE] THEN CONJ_TAC THENL
9247      [MATCH_MP_TAC(SET_RULE
9248        `(!x. x IN s ==> x IN u) /\ (!x. x IN t ==> x IN u)
9249         ==> !x. x IN (s UNION t) DIFF u ==> P x`) THEN
9250       REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN
9251       SIMP_TAC[INTEGER_CLOSED; ARITH_RULE `2 * SUC n = 2 + 2 * n`] THEN
9252       REWRITE_TAC[REAL_POW_ADD] THEN
9253       CONJ_TAC THENL [REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN
9254       MATCH_MP_TAC(REAL_ARITH
9255        `abs(x) <= n /\ &1 <= n ==> abs(&2 * x + &1) <= &2 pow 2 * n`) THEN
9256       ASM_REWRITE_TAC[REAL_LE_POW2];
9257       X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN
9258       STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN
9259       ASM_CASES_TAC `&0 <= k` THENL
9260        [MATCH_MP_TAC REAL_LE_MUL THEN
9261         ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN
9262         REWRITE_TAC[DROP_INDICATOR_POS_LE];
9263         MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 <= x`) THEN
9264         REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN
9265         REWRITE_TAC[indicator] THEN
9266         COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC] THEN
9267         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN
9268         MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN
9269         REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9270         EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN
9271         ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; REAL_MUL_LZERO;
9272                      INTEGER_CLOSED] THEN
9273         ASM_REAL_ARITH_TAC]];
9274     X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN
9275     REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN
9276     GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN
9277     ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX];
9278     X_GEN_TAC `n:num` THEN
9279     MATCH_MP_TAC FINITE_SUBSET THEN
9280     EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n))
9281                       {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN
9282     CONJ_TAC THENL
9283      [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE];
9284       ALL_TAC] THEN
9285     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN
9286     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_IMAGE] THEN
9287     ASM_CASES_TAC
9288      `?k. integer k /\ abs k <= &2 pow (2 * n) /\
9289           k / &2 pow n <= drop(f(x:real^N)) /\
9290           drop(f x) < (k + &1) / &2 pow n`
9291     THENL
9292      [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN
9293       X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
9294       MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[];
9295       EXISTS_TAC `&0` THEN
9296       ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN
9297       SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN
9298       REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN
9299       MATCH_MP_TAC VSUM_EQ_0 THEN
9300       X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
9301       REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN
9302       REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]];
9303     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
9304     MP_TAC(ISPECL [`&2`; `abs(drop((f:real^N->real^1) x))`]
9305         REAL_ARCH_POW) THEN
9306     ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN
9307     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
9308     MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
9309     REWRITE_TAC[REAL_POW_INV] THEN
9310     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9311     DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN
9312     SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN
9313     SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN
9314     EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
9315     ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^N)))` THEN
9316     SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^N->real^1) x) < e`
9317     MP_TAC THENL
9318      [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN
9319       MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN
9320       REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN
9321       SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ;
9322                REAL_OF_NUM_EQ; ARITH] THEN
9323       MATCH_MP_TAC(REAL_ARITH
9324        `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN
9325       EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
9326       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9327       EXISTS_TAC `e * &2 pow N2` THEN
9328       ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN
9329       MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
9330       MATCH_MP_TAC(NORM_ARITH
9331        `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN
9332       MATCH_MP_TAC lemma THEN
9333       SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
9334       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
9335       EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN
9336       SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE;
9337                INTEGER_CLOSED] THEN
9338       MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN
9339       REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW;
9340                   REAL_ABS_NUM] THEN
9341       MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN
9342       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
9343        `x < e ==> e <= d ==> x <= d`))] THEN
9344     MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
9345     ASM_ARITH_TAC]);;
9346
9347 (* ------------------------------------------------------------------------- *)
9348 (* More connections with measure where Lebesgue measurability is useful.     *)
9349 (* ------------------------------------------------------------------------- *)
9350
9351 let MEASURABLE_LEGESGUE_MEASURABLE_SUBSET = prove
9352  (`!s t:real^N->bool.
9353         lebesgue_measurable s /\ measurable t /\ s SUBSET t
9354         ==> measurable s`,
9355   REWRITE_TAC[lebesgue_measurable; MEASURABLE_INTEGRABLE] THEN
9356   REWRITE_TAC[indicator] THEN REPEAT STRIP_TAC THEN
9357   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
9358   EXISTS_TAC `(\x. if x IN t then vec 1 else vec 0):real^N->real^1` THEN
9359   ASM_REWRITE_TAC[IN_UNIV] THEN GEN_TAC THEN
9360   REPEAT(COND_CASES_TAC THEN
9361          ASM_REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop]) THEN
9362   REWRITE_TAC[REAL_ABS_NUM; REAL_LE_REFL; REAL_POS] THEN ASM SET_TAC[]);;
9363
9364 let MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE = prove
9365  (`!s t:real^N->bool.
9366         lebesgue_measurable s /\ measurable t ==> measurable(s INTER t)`,
9367   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN
9368   EXISTS_TAC `t:real^N->bool` THEN
9369   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_INTER; MEASURABLE_IMP_LEBESGUE_MEASURABLE;
9370                INTER_SUBSET]);;
9371
9372 let MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE = prove
9373  (`!s t:real^N->bool.
9374         measurable s /\ lebesgue_measurable t ==> measurable(s INTER t)`,
9375   MESON_TAC[INTER_COMM; MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE]);;
9376
9377 let MEASURABLE_INTER_HALFSPACE_LE = prove
9378  (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i <= a})`,
9379   REPEAT GEN_TAC THEN
9380   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
9381   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
9382   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9383   MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE THEN
9384   ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_LE; LEBESGUE_MEASURABLE_CLOSED]);;
9385
9386 let MEASURABLE_INTER_HALFSPACE_GE = prove
9387  (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i >= a})`,
9388   REPEAT GEN_TAC THEN
9389   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
9390   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
9391   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9392   MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE THEN
9393   ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_GE; LEBESGUE_MEASURABLE_CLOSED]);;
9394
9395 let MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE = prove
9396  (`!s t. measurable s /\ lebesgue_measurable t ==> measurable(s DIFF t)`,
9397   REPEAT STRIP_TAC THEN
9398   ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
9399   ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE;
9400                 LEBESGUE_MEASURABLE_COMPL]);;
9401
9402 (* ------------------------------------------------------------------------- *)
9403 (* Negigibility of set with uncountably many disjoint translates.            *)
9404 (* ------------------------------------------------------------------------- *)
9405
9406 let NEGLIGIBLE_DISJOINT_TRANSLATES = prove
9407  (`!s:real^N->bool k z.
9408         lebesgue_measurable s /\ z limit_point_of k /\
9409         pairwise (\a b. DISJOINT (IMAGE (\x. a + x) s) (IMAGE (\x. b + x) s)) k
9410         ==> negligible s`,
9411   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
9412   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
9413   ABBREV_TAC `t = s INTER interval[a:real^N,b]` THEN
9414   SUBGOAL_THEN `measurable(t:real^N->bool)` ASSUME_TAC THENL
9415    [ASM_MESON_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE;
9416                   MEASURABLE_INTERVAL; INTER_COMM];
9417     ALL_TAC] THEN
9418   SUBGOAL_THEN `bounded(t:real^N->bool)` ASSUME_TAC THENL
9419    [ASM_MESON_TAC[BOUNDED_INTER; BOUNDED_INTERVAL]; ALL_TAC] THEN
9420   ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN
9421   MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN
9422   ASM_SIMP_TAC[MEASURE_POS_LE] THEN DISCH_TAC THEN
9423   FIRST_X_ASSUM(MP_TAC o SPEC `&1` o
9424     GEN_REWRITE_RULE I [LIMPT_INFINITE_CBALL]) THEN
9425   REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN
9426   FIRST_ASSUM(MP_TAC o
9427     SPEC `measure(IMAGE (\x:real^N. z + x) (interval[a - vec 1,b + vec 1]))` o
9428     MATCH_MP REAL_ARCH) THEN
9429   DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
9430   MP_TAC(ISPECL [`n:num`; `k INTER cball(z:real^N,&1)`]
9431     CHOOSE_SUBSET_STRONG) THEN
9432   ANTS_TAC THENL [ASM_MESON_TAC[INFINITE]; ALL_TAC] THEN
9433   REWRITE_TAC[SUBSET_INTER; LEFT_IMP_EXISTS_THM; REAL_NOT_LT] THEN
9434   X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
9435   TRANS_TAC REAL_LE_TRANS
9436    `measure(UNIONS(IMAGE (\a. IMAGE (\x:real^N. a + x) t) u))` THEN
9437   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
9438   SUBGOAL_THEN
9439    `UNIONS(IMAGE (\a. IMAGE (\x:real^N. a + x) t) u) has_measure
9440     &n * measure(t:real^N->bool)`
9441   MP_TAC THENL
9442    [REPEAT STRIP_TAC THEN
9443     MP_TAC(ISPECL [`\a. IMAGE (\x:real^N. a + x) t`; `u:real^N->bool`]
9444         HAS_MEASURE_DISJOINT_UNIONS_IMAGE) THEN
9445     ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_TRANSLATION;
9446                  SUM_CONST] THEN
9447     DISCH_THEN MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
9448     ASM SET_TAC[];
9449     REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC] THEN
9450   CONJ_TAC THENL
9451    [ASM_REWRITE_TAC[REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET] THEN
9452   ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_INTERVAL] THEN
9453   REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ;
9454               RIGHT_FORALL_IMP_THM] THEN
9455   X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN
9456   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9457   REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH
9458    `d + e:real^N = z + y <=> e + d - z = y`] THEN
9459   SUBGOAL_THEN `x IN interval[a:real^N,b]` MP_TAC THENL
9460    [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN
9461   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
9462   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
9463   ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
9464   REWRITE_TAC[VEC_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH
9465    `abs(d) <= &1
9466     ==> a <= x /\ x <= b ==> a - &1 <= x + d /\ x + d <= b + &1`) THEN
9467   SUBGOAL_THEN `e IN cball(z:real^N,&1)` MP_TAC THENL
9468    [ASM SET_TAC[]; REWRITE_TAC[IN_CBALL]] THEN
9469   REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
9470   REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
9471   MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM]);;
9472
9473 (* ------------------------------------------------------------------------- *)
9474 (* Sometimes convenient to restrict the sets in "preimage" characterization  *)
9475 (* of measurable functions to choose points from a dense set.                *)
9476 (* ------------------------------------------------------------------------- *)
9477
9478 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE = prove
9479  (`!f:real^M->real^N r.
9480         closure (IMAGE lift r) = (:real^1)
9481         ==> (f measurable_on (:real^M) <=>
9482              !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r
9483                    ==> lebesgue_measurable {x | f(x)$k <= a})`,
9484   REPEAT STRIP_TAC THEN
9485   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN
9486   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
9487   MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN
9488   SUBGOAL_THEN
9489    `!n. ?x. x IN r /\ a < x /\ x < a + inv(&n + &1)`
9490   MP_TAC THENL
9491    [GEN_TAC THEN
9492     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
9493     REWRITE_TAC[IN_UNIV; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN
9494     DISCH_THEN(MP_TAC o SPECL
9495      [`lift(a + inv(&n + &1) / &2)`; `inv(&n + &1) / &2`]) THEN
9496     REWRITE_TAC[REAL_HALF; DIST_LIFT; REAL_LT_INV_EQ] THEN
9497     ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
9498     SIMP_TAC[] THEN REAL_ARITH_TAC;
9499     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
9500   X_GEN_TAC `t:num->real` THEN DISCH_TAC THEN
9501   SUBGOAL_THEN
9502    `{x | (f:real^M->real^N) x$k <= a} =
9503     INTERS {{x | (f x)$k <= t n} | n IN (:num)}`
9504   SUBST1_TAC THENL
9505    [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
9506     X_GEN_TAC `x:real^M` THEN EQ_TAC THENL
9507      [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN
9508     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9509     REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN
9510     ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
9511     GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
9512     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
9513     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
9514      `i < f - a ==> !j. j <= i /\ a < t /\ t < a + j ==> &0 < f - t`)) THEN
9515     EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
9516     MATCH_MP_TAC REAL_LE_INV2 THEN
9517     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
9518     ASM_ARITH_TAC;
9519     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
9520     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN
9521     ASM_SIMP_TAC[FORALL_IN_IMAGE]]);;
9522
9523 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE = prove
9524  (`!f:real^M->real^N r.
9525         closure (IMAGE lift r) = (:real^1)
9526         ==> (f measurable_on (:real^M) <=>
9527              !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r
9528                    ==> lebesgue_measurable {x | f(x)$k >= a})`,
9529   REPEAT STRIP_TAC THEN
9530   GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
9531   MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) r:real->bool`]
9532         MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE) THEN
9533   REWRITE_TAC[] THEN ANTS_TAC THENL
9534    [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_NEG] THEN
9535     ASM_REWRITE_TAC[GSYM o_DEF; IMAGE_o; CLOSURE_NEGATIONS] THEN
9536     MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN
9537     MESON_TAC[VECTOR_NEG_NEG];
9538     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
9539     ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
9540     REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
9541     REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= --y <=> x >= y`]]);;
9542
9543 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE = prove
9544  (`!f:real^M->real^N r.
9545         closure (IMAGE lift r) = (:real^1)
9546         ==> (f measurable_on (:real^M) <=>
9547              !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r
9548                    ==> lebesgue_measurable {x | f(x)$k < a})`,
9549   GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`] THEN
9550   REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
9551   REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN
9552   SIMP_TAC[GSYM MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE]);;
9553
9554 let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE = prove
9555  (`!f:real^M->real^N r.
9556         closure (IMAGE lift r) = (:real^1)
9557         ==> (f measurable_on (:real^M) <=>
9558              !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r
9559                    ==> lebesgue_measurable {x | f(x)$k > a})`,
9560   GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`] THEN
9561   REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
9562   REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN
9563   SIMP_TAC[GSYM MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE]);;
9564
9565 let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE = prove
9566  (`!f:real^M->real^N t.
9567         closure t = (:real^N)
9568         ==> (f measurable_on (:real^M) <=>
9569              !a b. a IN t /\ b IN t
9570                    ==> lebesgue_measurable {x | f(x) IN interval[a,b]})`,
9571   REPEAT STRIP_TAC THEN
9572   GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL] THEN
9573   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
9574   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
9575   SUBGOAL_THEN
9576    `!n. ?u v:real^N.
9577         (u IN t /\ u IN interval[(a - lambda i. inv(&n + &1)),a]) /\
9578         (v IN t /\ v IN interval[b,(b + lambda i. inv(&n + &1))])`
9579   MP_TAC THENL
9580    [GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN
9581     CONJ_TAC THEN MATCH_MP_TAC(SET_RULE
9582      `~(interior s INTER t = {}) /\ interior s SUBSET s
9583       ==> ?x. x IN t /\ x IN s`) THEN
9584     REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN
9585     W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o
9586       rand o snd) THEN
9587     REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
9588     ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN
9589     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
9590     REWRITE_TAC[REAL_ARITH `a - i < a <=> &0 < i`;
9591                 REAL_ARITH `b < b + i <=> &0 < i`] THEN
9592     REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
9593     REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
9594     MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`] THEN
9595     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN
9596     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN
9597   STRIP_TAC THEN
9598   SUBGOAL_THEN
9599    `{x | (f:real^M->real^N) x IN interval[a,b]} =
9600     INTERS {{x | f x IN interval[u n,v n]} | n IN (:num)}`
9601   SUBST1_TAC THENL
9602    [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
9603     X_GEN_TAC `x:real^M` THEN
9604     REWRITE_TAC[IN_INTERVAL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
9605     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN
9606     ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
9607     EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN
9608     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9609     REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN
9610     REWRITE_TAC[DE_MORGAN_THM; EXISTS_OR_THM; REAL_NOT_LE] THEN
9611     MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN
9612     ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
9613     GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
9614     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THENL
9615      [MATCH_MP_TAC(REAL_ARITH
9616        `!a i j. i < a - f /\ j <= i /\ a - j <= t /\ t <= a
9617                 ==> &0 < t - f`) THEN EXISTS_TAC `(a:real^N)$k`;
9618       MATCH_MP_TAC(REAL_ARITH
9619        `!a i j. i < f - a /\ j <= i /\ a <= t /\ t <= a + j
9620                 ==> &0 < f - t`) THEN EXISTS_TAC `(b:real^N)$k`] THEN
9621     MAP_EVERY EXISTS_TAC [`inv(&n)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN
9622     MATCH_MP_TAC REAL_LE_INV2 THEN
9623     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
9624     ASM_ARITH_TAC;
9625     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
9626     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN
9627     ASM_SIMP_TAC[FORALL_IN_IMAGE]]);;
9628
9629 let MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE = prove
9630  (`!f:real^M->real^N t.
9631         closure t = (:real^N)
9632         ==> (f measurable_on (:real^M) <=>
9633              !a b. a IN t /\ b IN t
9634                    ==> lebesgue_measurable {x | f(x) IN interval(a,b)})`,
9635   REPEAT STRIP_TAC THEN
9636   GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL] THEN
9637   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
9638   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
9639   SUBGOAL_THEN
9640    `!n. ?u v:real^N.
9641         (u IN t /\ u IN interval[a,(a + lambda i. inv(&n + &1))]) /\
9642         (v IN t /\ v IN interval[(b - lambda i. inv(&n + &1)),b])`
9643   MP_TAC THENL
9644    [GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN
9645     CONJ_TAC THEN MATCH_MP_TAC(SET_RULE
9646      `~(interior s INTER t = {}) /\ interior s SUBSET s
9647       ==> ?x. x IN t /\ x IN s`) THEN
9648     REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN
9649     W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o
9650       rand o snd) THEN
9651     REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
9652     ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN
9653     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
9654     REWRITE_TAC[REAL_ARITH `a - i < a <=> &0 < i`;
9655                 REAL_ARITH `b < b + i <=> &0 < i`] THEN
9656     REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
9657     REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
9658     MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`] THEN
9659     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN
9660     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN
9661   STRIP_TAC THEN
9662   SUBGOAL_THEN
9663    `{x | (f:real^M->real^N) x IN interval(a,b)} =
9664     UNIONS {{x | f x IN interval(u n,v n)} | n IN (:num)}`
9665   SUBST1_TAC THENL
9666    [REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
9667     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN
9668     EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]] THEN
9669     SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REPEAT STRIP_TAC THEN
9670     SUBGOAL_THEN
9671      `&0 < inf { min ((y - a:real^N)$i) ((b - y:real^N)$i) |
9672                  i IN 1..dimindex(:N)}`
9673     MP_TAC THENL
9674      [SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
9675                IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN
9676       ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; REAL_SUB_LT;
9677                    VECTOR_SUB_COMPONENT; IN_NUMSEG];
9678       ALL_TAC] THEN
9679     GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
9680     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
9681     SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
9682              IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN
9683     REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN
9684     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9685     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
9686     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
9687     ASM_REWRITE_TAC[] THEN
9688     REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `k:num`])) THEN
9689     ASM_REWRITE_TAC[] THEN
9690     SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL
9691      [ALL_TAC; REAL_ARITH_TAC] THEN
9692     MATCH_MP_TAC REAL_LE_INV2 THEN
9693     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
9694     ASM_ARITH_TAC;
9695     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
9696     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN
9697     ASM_SIMP_TAC[FORALL_IN_IMAGE]]);;
9698
9699 let MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE = prove
9700  (`!f:real^M->real^N t.
9701         closure t = (:real^N)
9702         ==> (f measurable_on (:real^M) <=>
9703              !a. a IN t
9704                  ==> lebesgue_measurable
9705                         {x | !k. 1 <= k /\ k <= dimindex(:N)
9706                                  ==> f(x)$k <= (a:real^N)$k})`,
9707   REPEAT STRIP_TAC THEN
9708   GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_ORTHANT_LE] THEN
9709   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN
9710   SUBGOAL_THEN
9711    `!n. ?u:real^N.
9712         u IN t /\ u IN interval[a,(a + lambda i. inv(&n + &1))]`
9713   MP_TAC THENL
9714    [GEN_TAC THEN MATCH_MP_TAC(SET_RULE
9715      `~(interior s INTER t = {}) /\ interior s SUBSET s
9716       ==> ?x. x IN t /\ x IN s`) THEN
9717     REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN
9718     W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o
9719       rand o snd) THEN
9720     REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
9721     ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN
9722     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
9723     REWRITE_TAC[REAL_ARITH `b < b + i <=> &0 < i`] THEN
9724     REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
9725     REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
9726     X_GEN_TAC `u:num->real^N` THEN
9727     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN
9728     SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN
9729   STRIP_TAC THEN
9730   SUBGOAL_THEN
9731    `{x | !i. 1 <= i /\ i <= dimindex(:N)
9732              ==> (f:real^M->real^N) x$i <= (a:real^N)$i} =
9733     INTERS {{x | !i. 1 <= i /\ i <= dimindex(:N)
9734                       ==> (f:real^M->real^N) x$i <= (u n:real^N)$i} |
9735             n IN (:num)}`
9736   SUBST1_TAC THENL
9737    [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
9738     X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
9739     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN
9740     ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
9741     EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN
9742     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9743     REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN
9744     ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
9745     GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
9746     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
9747     MATCH_MP_TAC(REAL_ARITH
9748      `!a i j. i < f - a /\ j <= i /\ a <= t /\ t <= a + j
9749               ==> &0 < f - t`) THEN EXISTS_TAC `(a:real^N)$k` THEN
9750     MAP_EVERY EXISTS_TAC [`inv(&n)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN
9751     MATCH_MP_TAC REAL_LE_INV2 THEN
9752     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
9753     ASM_ARITH_TAC;
9754     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
9755     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN
9756     ASM_SIMP_TAC[FORALL_IN_IMAGE]]);;
9757
9758 let MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE = prove
9759  (`!f:real^M->real^N t.
9760         closure t = (:real^N)
9761         ==> (f measurable_on (:real^M) <=>
9762              !a. a IN t
9763                  ==> lebesgue_measurable
9764                         {x | !k. 1 <= k /\ k <= dimindex(:N)
9765                                  ==> f(x)$k >= (a:real^N)$k})`,
9766   REPEAT STRIP_TAC THEN
9767   GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
9768   MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) t:real^N->bool`]
9769         MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE) THEN
9770   ASM_REWRITE_TAC[CLOSURE_NEGATIONS; FORALL_IN_IMAGE] THEN
9771   REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= --y <=> x >= y`] THEN
9772   DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
9773   REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]);;
9774
9775 let MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE = prove
9776  (`!f:real^M->real^N t.
9777         closure t = (:real^N)
9778         ==> (f measurable_on (:real^M) <=>
9779              !a. a IN t
9780                  ==> lebesgue_measurable
9781                         {x | !k. 1 <= k /\ k <= dimindex(:N)
9782                                  ==> f(x)$k < (a:real^N)$k})`,
9783   REPEAT STRIP_TAC THEN
9784   GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_ORTHANT_LT] THEN
9785   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN
9786   SUBGOAL_THEN
9787    `!n. ?u:real^N.
9788         u IN t /\ u IN interval[(a - lambda i. inv(&n + &1)):real^N,a]`
9789   MP_TAC THENL
9790    [GEN_TAC THEN MATCH_MP_TAC(SET_RULE
9791      `~(interior s INTER t = {}) /\ interior s SUBSET s
9792       ==> ?x. x IN t /\ x IN s`) THEN
9793     REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN
9794     W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o
9795       rand o snd) THEN
9796     REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
9797     ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN
9798     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
9799     REWRITE_TAC[REAL_ARITH `b - i < b <=> &0 < i`] THEN
9800     REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
9801     REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN
9802     X_GEN_TAC `u:num->real^N` THEN
9803     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN
9804     SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN
9805   STRIP_TAC THEN
9806   SUBGOAL_THEN
9807    `{x | !i. 1 <= i /\ i <= dimindex(:N)
9808              ==> (f:real^M->real^N) x$i < (a:real^N)$i} =
9809     UNIONS {{x | !i. 1 <= i /\ i <= dimindex(:N)
9810                       ==> (f:real^M->real^N) x$i < (u n:real^N)$i} |
9811             n IN (:num)}`
9812   SUBST1_TAC THENL
9813    [REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
9814     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN
9815     EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]] THEN
9816     SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REPEAT STRIP_TAC THEN
9817     SUBGOAL_THEN
9818      `&0 < inf { (a - y:real^N)$i | i IN 1..dimindex(:N)}`
9819     MP_TAC THENL
9820      [SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
9821                IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN
9822       ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; REAL_SUB_LT;
9823                    VECTOR_SUB_COMPONENT; IN_NUMSEG];
9824       ALL_TAC] THEN
9825     GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
9826     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
9827     SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
9828              IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN
9829     REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN
9830     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9831     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
9832     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
9833     ASM_REWRITE_TAC[] THEN
9834     REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `k:num`])) THEN
9835     ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN
9836     SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL
9837      [ALL_TAC; REAL_ARITH_TAC] THEN
9838     MATCH_MP_TAC REAL_LE_INV2 THEN
9839     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
9840     ASM_ARITH_TAC;
9841     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
9842     SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN
9843     ASM_SIMP_TAC[FORALL_IN_IMAGE]]);;
9844
9845 let MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE = prove
9846  (`!f:real^M->real^N t.
9847         closure t = (:real^N)
9848         ==> (f measurable_on (:real^M) <=>
9849              !a. a IN t
9850                  ==> lebesgue_measurable
9851                         {x | !k. 1 <= k /\ k <= dimindex(:N)
9852                                  ==> f(x)$k > (a:real^N)$k})`,
9853   REPEAT STRIP_TAC THEN
9854   GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN
9855   MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) t:real^N->bool`]
9856         MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE) THEN
9857   ASM_REWRITE_TAC[CLOSURE_NEGATIONS; FORALL_IN_IMAGE] THEN
9858   REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x < --y <=> x > y`] THEN
9859   DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
9860   REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]);;
9861
9862 (* ------------------------------------------------------------------------- *)
9863 (* Localized variants of function measurability equivalents.                 *)
9864 (* ------------------------------------------------------------------------- *)
9865
9866 let [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED;
9867      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL;
9868      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN;
9869      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE;
9870      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT;
9871      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE;
9872      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT;
9873      MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL] =
9874   (CONJUNCTS o prove)
9875  (`(!f:real^M->real^N s.
9876       lebesgue_measurable s
9877       ==> (f measurable_on s <=>
9878            !t. closed t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\
9879    (!f:real^M->real^N s.
9880       lebesgue_measurable s
9881       ==> (f measurable_on s <=>
9882            !a b. lebesgue_measurable {x | x IN s /\ f x IN interval[a,b]})) /\
9883    (!f:real^M->real^N s.
9884       lebesgue_measurable s
9885       ==> (f measurable_on s <=>
9886            !t. open t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\
9887    (!f:real^M->real^N s.
9888       lebesgue_measurable s
9889       ==> (f measurable_on s <=>
9890            !a k. 1 <= k /\ k <= dimindex(:N)
9891                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k >= a})) /\
9892    (!f:real^M->real^N s.
9893       lebesgue_measurable s
9894       ==> (f measurable_on s <=>
9895            !a k. 1 <= k /\ k <= dimindex(:N)
9896                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k > a})) /\
9897    (!f:real^M->real^N s.
9898       lebesgue_measurable s
9899       ==> (f measurable_on s <=>
9900            !a k. 1 <= k /\ k <= dimindex(:N)
9901                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k <= a})) /\
9902    (!f:real^M->real^N s.
9903       lebesgue_measurable s
9904       ==> (f measurable_on s <=>
9905            !a k. 1 <= k /\ k <= dimindex(:N)
9906                  ==> lebesgue_measurable {x | x IN s /\ (f x)$k < a})) /\
9907    (!f:real^M->real^N s.
9908       lebesgue_measurable s
9909       ==> (f measurable_on s <=>
9910            !a b. lebesgue_measurable {x | x IN s /\ f x IN interval(a,b)}))`,
9911   let lemma = prove
9912    (`!f s P. {x | P(if x IN s then f x else vec 0)} =
9913              if P(vec 0) then s INTER {x | P(f x)} UNION ((:real^M) DIFF s)
9914              else {x | x IN s /\ P(f x)}`,
9915     REPEAT GEN_TAC THEN
9916     COND_CASES_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in
9917   ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN  REPEAT STRIP_TAC THENL
9918    [REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED];
9919     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL];
9920     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN];
9921     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE];
9922     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT];
9923     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE];
9924     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT];
9925     REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL]] THEN
9926   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] lemma) THEN
9927   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
9928   REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
9929   TRY(MATCH_MP_TAC(TAUT `(q <=> q') ==> (p ==> q <=> p ==> q')`)) THEN
9930   COND_CASES_TAC THEN REWRITE_TAC[] THEN
9931   REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
9932   EQ_TAC THEN
9933   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_UNION; LEBESGUE_MEASURABLE_COMPL] THEN
9934   UNDISCH_TAC `lebesgue_measurable(s:real^M->bool)` THEN
9935   REWRITE_TAC[IMP_IMP] THEN
9936   DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN
9937   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;
9938
9939 let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove
9940  (`!f:real^M->real^N s t.
9941         f measurable_on s /\ lebesgue_measurable s /\ open t
9942         ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
9943   MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);;
9944
9945 let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove
9946  (`!f:real^M->real^N s t.
9947         f measurable_on s /\ lebesgue_measurable s /\ closed t
9948         ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
9949   MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);;
9950
9951 let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ = prove
9952  (`!f:real^M->real^N s.
9953         f measurable_on s /\ lebesgue_measurable s <=>
9954         !t. open t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
9955   REPEAT GEN_TAC THEN EQ_TAC THEN
9956   SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN
9957   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
9958   REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
9959   SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);;
9960
9961 let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ = prove
9962  (`!f:real^M->real^N s.
9963         f measurable_on s /\ lebesgue_measurable s <=>
9964         !t. closed t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`,
9965   REPEAT GEN_TAC THEN EQ_TAC THEN
9966   SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED] THEN
9967   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
9968   REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
9969   SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);;
9970
9971 let [MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED;
9972      MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL;
9973      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN;
9974      MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE;
9975      MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT;
9976      MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE;
9977      MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT;
9978      MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL] =
9979   (CONJUNCTS o prove)
9980  (`(!f:real^M->real^N s.
9981       measurable s
9982       ==> (f measurable_on s <=>
9983            !t. closed t ==> measurable {x | x IN s /\ f x IN t})) /\
9984    (!f:real^M->real^N s.
9985       measurable s
9986       ==> (f measurable_on s <=>
9987            !a b. measurable {x | x IN s /\ f x IN interval[a,b]})) /\
9988    (!f:real^M->real^N s.
9989       measurable s
9990       ==> (f measurable_on s <=>
9991            !t. open t ==> measurable {x | x IN s /\ f x IN t})) /\
9992    (!f:real^M->real^N s.
9993       measurable s
9994       ==> (f measurable_on s <=>
9995            !a k. 1 <= k /\ k <= dimindex(:N)
9996                  ==> measurable {x | x IN s /\ (f x)$k >= a})) /\
9997    (!f:real^M->real^N s.
9998       measurable s
9999       ==> (f measurable_on s <=>
10000            !a k. 1 <= k /\ k <= dimindex(:N)
10001                  ==> measurable {x | x IN s /\ (f x)$k > a})) /\
10002    (!f:real^M->real^N s.
10003       measurable s
10004       ==> (f measurable_on s <=>
10005            !a k. 1 <= k /\ k <= dimindex(:N)
10006                  ==> measurable {x | x IN s /\ (f x)$k <= a})) /\
10007    (!f:real^M->real^N s.
10008       measurable s
10009       ==> (f measurable_on s <=>
10010            !a k. 1 <= k /\ k <= dimindex(:N)
10011                  ==> measurable {x | x IN s /\ (f x)$k < a})) /\
10012    (!f:real^M->real^N s.
10013       measurable s
10014       ==> (f measurable_on s <=>
10015            !a b. measurable {x | x IN s /\ f x IN interval(a,b)}))`,
10016   REPEAT STRIP_TAC THEN
10017   FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_IMP_LEBESGUE_MEASURABLE) THENL
10018    [ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED];
10019     ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL];
10020     ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN];
10021     ASM_SIMP_TAC
10022      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE];
10023     ASM_SIMP_TAC
10024      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT];
10025     ASM_SIMP_TAC
10026      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE];
10027     ASM_SIMP_TAC
10028      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT];
10029     ASM_SIMP_TAC
10030      [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL]] THEN
10031   EQ_TAC THEN SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
10032   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN
10033   EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[]);;
10034
10035 let MEASURABLE_MEASURABLE_PREIMAGE_OPEN = prove
10036  (`!f:real^M->real^N s t.
10037         f measurable_on s /\ measurable s /\ open t
10038         ==> measurable {x | x IN s /\ f(x) IN t}`,
10039   MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);;
10040
10041 let MEASURABLE_MEASURABLE_PREIMAGE_CLOSED = prove
10042  (`!f:real^M->real^N s t.
10043         f measurable_on s /\ measurable s /\ closed t
10044         ==> measurable {x | x IN s /\ f(x) IN t}`,
10045   MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);;
10046
10047 let MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ = prove
10048  (`!f:real^M->real^N s.
10049         f measurable_on s /\ measurable s <=>
10050         !t. open t ==> measurable {x | x IN s /\ f(x) IN t}`,
10051   REPEAT GEN_TAC THEN EQ_TAC THEN
10052   SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_OPEN] THEN
10053   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
10054   REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
10055   SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);;
10056
10057 let MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ = prove
10058  (`!f:real^M->real^N s.
10059         f measurable_on s /\ measurable s <=>
10060         !t. closed t ==> measurable {x | x IN s /\ f(x) IN t}`,
10061   REPEAT GEN_TAC THEN EQ_TAC THEN
10062   SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_CLOSED] THEN
10063   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN
10064   REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
10065   SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);;
10066
10067 (* ------------------------------------------------------------------------- *)
10068 (* Regularity properties and Steinhaus, this time for Lebesgue measure.      *)
10069 (* ------------------------------------------------------------------------- *)
10070
10071 let LEBESGUE_MEASURABLE_OUTER_OPEN = prove
10072  (`!s:real^N->bool e.
10073         lebesgue_measurable s /\ &0 < e
10074         ==> ?t. open t /\
10075                 s SUBSET t /\
10076                 measurable(t DIFF s) /\
10077                 measure(t DIFF s) < e`,
10078   REPEAT STRIP_TAC THEN MP_TAC(GEN `n:num`
10079    (ISPECL [`s INTER ball(vec 0:real^N,&2 pow n)`;
10080             `e / &4 / &2 pow n`]
10081         MEASURABLE_OUTER_OPEN)) THEN
10082   ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; REAL_LT_DIV;
10083                MEASURABLE_BALL; REAL_LT_INV_EQ; REAL_LT_POW2;
10084                REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN
10085   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
10086   X_GEN_TAC `t:num->real^N->bool` THEN STRIP_TAC THEN
10087   EXISTS_TAC `UNIONS(IMAGE t (:num)):real^N->bool` THEN
10088   ASM_SIMP_TAC[OPEN_UNIONS; FORALL_IN_IMAGE] THEN CONJ_TAC THENL
10089    [REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
10090     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10091     MP_TAC(ISPEC `norm(x:real^N)` REAL_ARCH_POW2) THEN
10092     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
10093     DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
10094     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_BALL_0; IN_INTER];
10095     REWRITE_TAC[UNIONS_DIFF; SET_RULE
10096      `{f x | x IN IMAGE g s} = {f(g(x)) | x IN s}`] THEN
10097     MATCH_MP_TAC(MESON[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`]
10098         `&0 < e /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN
10099     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN
10100     ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE] THEN
10101     X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
10102     EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL
10103      [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
10104       MATCH_MP_TAC REAL_LE_TRANS THEN
10105       EXISTS_TAC `measure(t i DIFF (s INTER ball(vec 0:real^N,&2 pow i)))` THEN
10106       REWRITE_TAC[] THEN CONJ_TAC THENL
10107        [MATCH_MP_TAC MEASURE_SUBSET THEN
10108         ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE;
10109           MEASURABLE_INTER; MEASURABLE_BALL; LEBESGUE_MEASURABLE_INTER;
10110           MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
10111         SET_TAC[];
10112         ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_DIFF; MEASURABLE_BALL;
10113                      MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
10114         ASM_SIMP_TAC[REAL_ARITH `t < s + e ==> t - s <= e`]];
10115       REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP] THEN
10116       CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 LT] THEN
10117       ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN
10118       REWRITE_TAC[REAL_ARITH
10119         `&1 / &4 * (&1 - x) * &2 <= &1 / &2 <=> &0 <= x`] THEN
10120       MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]]);;
10121
10122 let LEBESGUE_MEASURABLE_INNER_CLOSED = prove
10123  (`!s:real^N->bool e.
10124         lebesgue_measurable s /\ &0 < e
10125         ==> ?t. closed t /\
10126                 t SUBSET s /\
10127                 measurable(s DIFF t) /\
10128                 measure(s DIFF t) < e`,
10129   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN
10130   DISCH_THEN(X_CHOOSE_TAC `t:real^N->bool` o MATCH_MP
10131     LEBESGUE_MEASURABLE_OUTER_OPEN) THEN
10132   EXISTS_TAC `(:real^N) DIFF t` THEN POP_ASSUM MP_TAC THEN
10133   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
10134   REWRITE_TAC[GSYM OPEN_CLOSED] THENL
10135    [SET_TAC[];
10136     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC;
10137     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC] THEN
10138   SET_TAC[]);;
10139
10140 let STEINHAUS_LEBESGUE = prove
10141  (`!s:real^N->bool.
10142         lebesgue_measurable s /\ ~negligible s
10143         ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`,
10144   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10145   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
10146   REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN
10147   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
10148   MP_TAC(ISPEC `s INTER interval[a:real^N,b]` STEINHAUS) THEN
10149   ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL;
10150                MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
10151   SET_TAC[]);;
10152
10153 let LEBESGUE_MEASURABLE_REGULAR_OUTER = prove
10154  (`!s:real^N->bool.
10155         lebesgue_measurable s
10156         ==> ?k c. negligible k /\ (!n. open(c n)) /\
10157                   s = INTERS {c n | n IN (:num)} DIFF k`,
10158   REPEAT STRIP_TAC THEN
10159   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10160     LEBESGUE_MEASURABLE_OUTER_OPEN)) THEN
10161   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
10162   REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN
10163   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
10164   X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN
10165   EXISTS_TAC `INTERS {c n | n IN (:num)} DIFF s:real^N->bool` THEN
10166   EXISTS_TAC `c:num->real^N->bool` THEN
10167   ASM_REWRITE_TAC[SET_RULE `s = t DIFF (t DIFF s) <=> s SUBSET t`] THEN
10168   ASM_REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN
10169   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10170   MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
10171   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN
10172   DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
10173   EXISTS_TAC `(c:num->real^N->bool) n DIFF s` THEN
10174   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
10175    [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]);;
10176
10177 let LEBESGUE_MEASURABLE_REGULAR_INNER = prove
10178  (`!s:real^N->bool.
10179         lebesgue_measurable s
10180         ==> ?k c. negligible k /\ (!n. compact(c n)) /\
10181                   s = UNIONS {c n | n IN (:num)} UNION k`,
10182   REPEAT STRIP_TAC THEN
10183   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10184     LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN
10185   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
10186   REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN
10187   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
10188   X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN
10189   EXISTS_TAC `s DIFF UNIONS {c n | n IN (:num)}:real^N->bool` THEN
10190   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
10191    [REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN
10192     DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
10193     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN
10194     DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
10195     EXISTS_TAC `s DIFF (c:num->real^N->bool) n` THEN
10196     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
10197      [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]];
10198     SUBGOAL_THEN
10199      `?d. (!n. compact(d n:real^N->bool)) /\
10200           UNIONS {d n | n IN (:num)} = UNIONS {c n | n IN (:num)}`
10201     MP_TAC THENL
10202      [MP_TAC(GEN `n:num` (ISPEC
10203        `(c:num->real^N->bool) n` CLOSED_UNION_COMPACT_SUBSETS)) THEN
10204       ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN
10205        (X_CHOOSE_THEN `d:num->num->real^N->bool` STRIP_ASSUME_TAC) THEN
10206       SUBGOAL_THEN
10207        `COUNTABLE {d n m:real^N->bool | n IN (:num) /\ m IN (:num)}`
10208       MP_TAC THENL
10209        [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
10210         REWRITE_TAC[NUM_COUNTABLE];
10211         DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10212           COUNTABLE_AS_IMAGE)) THEN
10213         ANTS_TAC THENL [SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
10214         ASM SET_TAC[]];
10215       MATCH_MP_TAC MONO_EXISTS THEN
10216       REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10217       ASM_REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN
10218       ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC]]]);;
10219
10220 (* ------------------------------------------------------------------------- *)
10221 (* A Lebesgue measurable set is almost an F_sigma.                           *)
10222 (* ------------------------------------------------------------------------- *)
10223
10224 let LEBESGUE_MEASURABLE_ALMOST_FSIGMA = prove
10225  (`!s:real^N->bool.
10226         lebesgue_measurable s
10227         ==> ?c t. UNIONS c UNION t = s /\ DISJOINT (UNIONS c) t /\
10228                   COUNTABLE c /\ (!u. u IN c ==> closed u) /\ negligible t`,
10229   REPEAT STRIP_TAC THEN
10230   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10231         LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN
10232   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN
10233   REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
10234   REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM] THEN
10235   X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN
10236   EXISTS_TAC `IMAGE (f:num->real^N->bool) (:num)` THEN
10237   EXISTS_TAC `s DIFF UNIONS (IMAGE (f:num->real^N->bool) (:num))` THEN
10238   ASM_SIMP_TAC[SET_RULE `DISJOINT s (u DIFF s)`; COUNTABLE_IMAGE;
10239                NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV; UNIONS_SUBSET;
10240                SET_RULE `s UNION (u DIFF s) = u <=> s SUBSET u`] THEN
10241   REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10242   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
10243   DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
10244   EXISTS_TAC `s DIFF (f:num->real^N->bool) n` THEN
10245   ASM_REWRITE_TAC[UNIONS_IMAGE] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
10246   TRANS_TAC REAL_LE_TRANS `inv(&n + &1)` THEN
10247   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN TRANS_TAC REAL_LE_TRANS `inv(&n)` THEN
10248   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
10249   REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN
10250   ASM_ARITH_TAC);;
10251
10252 (* ------------------------------------------------------------------------- *)
10253 (* Existence of nonmeasurable subsets of any set of positive measure.        *)
10254 (* ------------------------------------------------------------------------- *)
10255
10256 let NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS = prove
10257  (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> lebesgue_measurable t`,
10258   let lemma = prove
10259    (`!s:real^N->bool.
10260       lebesgue_measurable s /\
10261       (!x y q. x IN s /\ y IN s /\ rational q /\ y = q % basis 1 + x ==> y = x)
10262       ==> negligible s`,
10263     SIMP_TAC[VECTOR_ARITH `q + x:real^N = x <=> q = vec 0`; VECTOR_MUL_EQ_0;
10264              BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN
10265     REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN
10266     DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` STEINHAUS_LEBESGUE) THEN
10267     ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
10268     FIRST_ASSUM(X_CHOOSE_TAC `q:real` o MATCH_MP RATIONAL_BETWEEN) THEN
10269     FIRST_X_ASSUM
10270      (MP_TAC o SPEC `q % basis 1:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
10271     SIMP_TAC[IN_BALL_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1;
10272              ARITH; NOT_IMP] THEN
10273     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN
10274     ASM_REWRITE_TAC[REAL_MUL_RID; IN_ELIM_THM; NOT_EXISTS_THM;
10275                     VECTOR_ARITH `q:real^N = x - y <=> x = q + y`] THEN
10276     ASM_CASES_TAC `q = &0` THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]) in
10277   GEN_TAC THEN EQ_TAC THENL
10278    [MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE];
10279     DISCH_TAC] THEN
10280   ABBREV_TAC
10281    `(canonize:real^N->real^N) =
10282     \x. @y. y IN s /\ ?q. rational q /\ q % basis 1 + y = x` THEN
10283   SUBGOAL_THEN
10284    `!x:real^N. x IN s
10285                ==> canonize x IN s /\
10286                    ?q. rational q /\ q % basis 1 + canonize x = x`
10287   ASSUME_TAC THENL
10288    [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "canonize" THEN
10289     CONV_TAC SELECT_CONV THEN EXISTS_TAC `x:real^N` THEN
10290     ASM_REWRITE_TAC[] THEN EXISTS_TAC `&0` THEN
10291     REWRITE_TAC[RATIONAL_CLOSED] THEN VECTOR_ARITH_TAC;
10292     ALL_TAC] THEN
10293   ABBREV_TAC `v = IMAGE (canonize:real^N->real^N) s` THEN
10294   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC
10295    `UNIONS (IMAGE (\q. IMAGE (\x:real^N. q % basis 1 + x) v) rational)` THEN
10296   CONJ_TAC THENL
10297    [ALL_TAC;
10298     REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN ASM SET_TAC[]] THEN
10299   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN
10300   SIMP_TAC[COUNTABLE_RATIONAL; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
10301   ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN GEN_TAC THEN
10302   DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC lemma THEN
10303   CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
10304   EXPAND_TAC "v" THEN
10305   REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN
10306   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10307   X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10308   X_GEN_TAC `q:real` THEN REPEAT DISCH_TAC THEN
10309   EXPAND_TAC "canonize" THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
10310   X_GEN_TAC `z:real^N` THEN AP_TERM_TAC THEN FIRST_X_ASSUM(fun th ->
10311     MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
10312   ASM_REWRITE_TAC[VECTOR_ARITH `q % b + x:real^N = y <=> x = y - q % b`] THEN
10313   STRIP_TAC THEN
10314   ASM_REWRITE_TAC[VECTOR_ARITH `x - q % b:real^N = y - r % b - s % b <=>
10315                    y + (q - r - s) % b = x /\ x + (r + s - q) % b = y`] THEN
10316   STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10317   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
10318    (BINDER_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN
10319   SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; ARITH; VECTOR_ARITH
10320    `y - q % b:real^N = (y + r % b) - s % b <=> (q + r - s) % b = vec 0`] THEN
10321   ONCE_REWRITE_TAC[CONJ_SYM] THEN
10322   REWRITE_TAC[REAL_ARITH `a + b - c = &0 <=> c = a + b`; UNWIND_THM2] THEN
10323   ASM_SIMP_TAC[RATIONAL_CLOSED]);;
10324
10325 let NEGLIGIBLE_IFF_MEASURABLE_SUBSETS = prove
10326  (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> measurable t`,
10327   MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_MEASURABLE;
10328             MEASURABLE_IMP_LEBESGUE_MEASURABLE;
10329             NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS]);;
10330
10331 (* ------------------------------------------------------------------------- *)
10332 (* Preserving Lebesgue measurability vs. preserving negligibility.           *)
10333 (* ------------------------------------------------------------------------- *)
10334
10335 let PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE = prove
10336  (`!f s:real^N->bool.
10337         (!t. negligible t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t))
10338         ==> (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t))`,
10339   REPEAT STRIP_TAC THEN
10340   REWRITE_TAC[NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS] THEN
10341   REWRITE_TAC[FORALL_SUBSET_IMAGE] THEN
10342   ASM_MESON_TAC[NEGLIGIBLE_SUBSET; SUBSET_TRANS]);;
10343
10344 let LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE = prove
10345  (`!f:real^M->real^N s.
10346         f continuous_on s /\
10347         (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t))
10348         ==> !t. lebesgue_measurable t /\ t SUBSET s
10349                 ==> lebesgue_measurable(IMAGE f t)`,
10350   REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o
10351     MATCH_MP LEBESGUE_MEASURABLE_REGULAR_INNER) THEN
10352   ASM_REWRITE_TAC[IMAGE_UNION; IMAGE_UNIONS] THEN
10353   MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN
10354   SUBGOAL_THEN `(k:real^M->bool) SUBSET s` ASSUME_TAC THENL
10355    [ASM SET_TAC[]; ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]] THEN
10356   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
10357   REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; FORALL_IN_IMAGE] THEN
10358   SIMP_TAC[IN_UNIV; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
10359   GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COMPACT THEN
10360   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
10361   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10362     CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
10363
10364 let LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE = prove
10365  (`!f:real^M->real^N s.
10366         dimindex(:M) <= dimindex(:N) /\
10367         f differentiable_on s /\ lebesgue_measurable s
10368         ==> lebesgue_measurable(IMAGE f s)`,
10369   REPEAT STRIP_TAC THEN MATCH_MP_TAC
10370    (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
10371         LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE) THEN
10372   EXISTS_TAC `s:real^M->bool` THEN
10373   ASM_SIMP_TAC[SUBSET_REFL; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN
10374   REPEAT STRIP_TAC THEN
10375   MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN
10376   ASM_MESON_TAC[DIFFERENTIABLE_ON_SUBSET]);;
10377
10378 let LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN = prove
10379  (`!f:real^M->real^N s.
10380         linear f /\ lebesgue_measurable s /\ dimindex(:M) <= dimindex(:N)
10381         ==> lebesgue_measurable(IMAGE f s)`,
10382   REPEAT STRIP_TAC THEN
10383   MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN
10384   ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);;
10385
10386 let MEASURABLE_LINEAR_IMAGE_GEN = prove
10387  (`!f:real^M->real^N s.
10388         linear f /\ measurable s /\ dimindex(:M) <= dimindex(:N)
10389         ==> measurable(IMAGE f s)`,
10390   REPEAT STRIP_TAC THEN
10391   FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
10392    `m:num <= n ==> m < n \/ m = n`))
10393   THENL
10394    [MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN
10395     MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM THEN
10396     ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR];
10397     ASM_CASES_TAC `!x y. (f:real^M->real^N) x = f y ==> x = y` THENL
10398      [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_EQ_GEN]; ALL_TAC] THEN
10399     MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN
10400     MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
10401     MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`]
10402         DIM_IMAGE_KERNEL_GEN) THEN
10403     ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV] THEN ONCE_ASM_REWRITE_TAC[] THEN
10404     DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(ARITH_RULE
10405      `x <= y /\ ~(d = 0) ==> x < y + d`) THEN
10406     SIMP_TAC[DIM_SUBSET; IMAGE_SUBSET; SUBSET_UNIV] THEN
10407     REWRITE_TAC[IN_UNIV; DIM_EQ_0] THEN
10408     FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_0) THEN ASM SET_TAC[]]);;
10409
10410 let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN = prove
10411  (`!f:real^M->real^N s.
10412         dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y)
10413         ==> (lebesgue_measurable(IMAGE f s) <=> lebesgue_measurable s)`,
10414   REPEAT STRIP_TAC THEN
10415   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
10416   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
10417   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
10418   SUBGOAL_THEN `!y. f((g:real^N->real^M) y) = y` ASSUME_TAC THENL
10419    [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN) THEN
10420     ASM_MESON_TAC[];
10421     ALL_TAC] THEN
10422   EQ_TAC THENL
10423    [ALL_TAC;
10424     ASM_MESON_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL]] THEN
10425   DISCH_TAC THEN
10426   SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) (IMAGE f s)` SUBST1_TAC THENL
10427    [ASM SET_TAC[];
10428     ASM_MESON_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL]]);;
10429
10430 (* ------------------------------------------------------------------------- *)
10431 (* Measurability of continuous functions.                                    *)
10432 (* ------------------------------------------------------------------------- *)
10433
10434 let CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove
10435  (`!f:real^M->real^N s.
10436         f continuous_on s /\ lebesgue_measurable s
10437         ==> f measurable_on s`,
10438   let lemma = prove
10439    (`!s. lebesgue_measurable s
10440          ==> ?u:num->real^M->bool.
10441                 (!n. closed(u n)) /\ (!n. u n SUBSET s) /\
10442                 (!n. measurable(s DIFF u n) /\
10443                      measure(s DIFF u n) < inv(&n + &1)) /\
10444                 (!n. u(n) SUBSET u(SUC n))`,
10445     REPEAT STRIP_TAC THEN
10446     SUBGOAL_THEN
10447      `!n t. closed t /\ t SUBSET s
10448             ==> ?u:real^M->bool.
10449                       closed u /\ t SUBSET u /\ u SUBSET s /\
10450                       measurable(s DIFF u) /\ measure(s DIFF u) < inv(&n + &1)`
10451     MP_TAC THENL
10452      [REPEAT STRIP_TAC THEN
10453       MP_TAC(ISPECL [`s DIFF t:real^M->bool`; `inv(&n + &1)`]
10454         LEBESGUE_MEASURABLE_INNER_CLOSED) THEN
10455       ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_CLOSED] THEN
10456       REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
10457       DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
10458       EXISTS_TAC `t UNION u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNION] THEN
10459       CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
10460       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10461       ASM_REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = s DIFF t DIFF u`];
10462       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
10463       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
10464       X_GEN_TAC `v:num->(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN
10465       MP_TAC(prove_recursive_functions_exist num_RECURSION
10466           `(u:num->real^M->bool) 0 = v 0 {} /\
10467            (!n. u(SUC n) = v (SUC n) (u n))`) THEN
10468       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->real^M->bool` THEN
10469       STRIP_TAC THEN
10470       SUBGOAL_THEN
10471        `!n. closed(u n) /\ (u:num->real^M->bool) n SUBSET s`
10472       ASSUME_TAC THENL
10473        [INDUCT_TAC THEN
10474         ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET];
10475         ASM_SIMP_TAC[]] THEN
10476       INDUCT_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
10477       ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET]]) in
10478   REPEAT STRIP_TAC THEN
10479   FIRST_ASSUM(X_CHOOSE_THEN `u:num->real^M->bool` STRIP_ASSUME_TAC o
10480     MATCH_MP lemma) THEN
10481   SUBGOAL_THEN `lebesgue_measurable((:real^M) DIFF s)` MP_TAC THENL
10482    [ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]; ALL_TAC] THEN
10483   DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC o
10484     MATCH_MP lemma) THEN
10485   REWRITE_TAC[measurable_on] THEN
10486   EXISTS_TAC `(:real^M) DIFF
10487            (UNIONS {u n | n IN (:num)} UNION UNIONS {v n | n IN (:num)})` THEN
10488   SUBGOAL_THEN
10489    `!n. ?g. g continuous_on (:real^M) /\
10490             (!x. x IN u(n) UNION v(n:num)
10491                  ==> g x = if x IN s then (f:real^M->real^N)(x) else vec 0)`
10492   MP_TAC THENL
10493    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN
10494     ASM_SIMP_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; CLOSED_UNION] THEN
10495     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
10496     ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
10497     CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
10498     REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS] THEN
10499   X_GEN_TAC `g:num->real^M->real^N` THEN
10500   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10501   CONJ_TAC THENL
10502    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
10503     EXISTS_TAC `(s DIFF UNIONS {u n | n IN (:num)}) UNION
10504                 ((:real^M) DIFF s DIFF UNIONS {v n | n IN (:num)})` THEN
10505     CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
10506     MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THEN
10507     REWRITE_TAC[NEGLIGIBLE_OUTER] THEN
10508     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10509     MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN
10510     ASM_REWRITE_TAC[] THEN
10511     DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL
10512      [EXISTS_TAC `s DIFF u(n:num):real^M->bool`;
10513       EXISTS_TAC `(:real^M) DIFF s DIFF v(n:num):real^M->bool`] THEN
10514     (CONJ_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[]] THEN
10515      MATCH_MP_TAC REAL_LT_TRANS THEN
10516      EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
10517      MATCH_MP_TAC REAL_LT_TRANS THEN
10518      EXISTS_TAC `inv(&n)` THEN ASM_REWRITE_TAC[] THEN
10519      MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN
10520      CONJ_TAC THENL [ASM_ARITH_TAC; REAL_ARITH_TAC]);
10521     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[SET_RULE
10522      `~(x IN (UNIV DIFF (s UNION t))) <=> x IN s \/ x IN t`] THEN
10523     REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
10524     REWRITE_TAC[OR_EXISTS_THM] THEN
10525     DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
10526     MATCH_MP_TAC LIM_EVENTUALLY THEN
10527     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
10528     EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
10529     FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_UNION] THEN
10530     SUBGOAL_THEN
10531      `!i j. i <= j ==> (u:num->real^M->bool)(i) SUBSET u(j) /\
10532                        (v:num->real^M->bool)(i) SUBSET v(j)`
10533      (fun th -> ASM_MESON_TAC[SUBSET; th]) THEN
10534     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
10535    ASM_REWRITE_TAC[] THEN SET_TAC[]]);;
10536
10537 let CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET = prove
10538  (`!f:real^M->real^N s.
10539         f continuous_on s /\ closed s ==> f measurable_on s`,
10540   SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET;
10541            LEBESGUE_MEASURABLE_CLOSED]);;
10542
10543 let CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove
10544  (`!f:real^M->real^N s m.
10545         f continuous_on (s DIFF m) /\ lebesgue_measurable s /\ negligible m
10546         ==> f measurable_on s`,
10547   REPEAT STRIP_TAC THEN
10548   SUBGOAL_THEN `(f:real^M->real^N) measurable_on (s DIFF m)` MP_TAC THENL
10549    [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
10550     ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE];
10551     MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN
10552     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10553        NEGLIGIBLE_SUBSET)) THEN
10554     SET_TAC[]]);;
10555
10556 (* ------------------------------------------------------------------------- *)
10557 (* Measurability of a.e. derivatives.                                        *)
10558 (* ------------------------------------------------------------------------- *)
10559
10560 let MEASURABLE_ON_VECTOR_DERIVATIVE = prove
10561  (`!f:real^1->real^N f' s k.
10562         negligible k /\ negligible(frontier s) /\
10563         (!x. x IN (s DIFF k) ==> (f has_vector_derivative f'(x)) (at x))
10564         ==> f' measurable_on s`,
10565   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
10566   ABBREV_TAC `g:real^1->real^N = \x. if x IN s then f(x) else vec 0` THEN
10567   SUBGOAL_THEN `(g:real^1->real^N) measurable_on (:real^1)` ASSUME_TAC THENL
10568    [EXPAND_TAC "g" THEN REWRITE_TAC[MEASURABLE_ON_UNIV] THEN
10569     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN
10570     EXISTS_TAC `s DIFF k:real^1->bool` THEN CONJ_TAC THENL
10571      [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
10572       EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
10573       MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
10574       CONJ_TAC THENL
10575        [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN
10576         MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
10577         ASM_MESON_TAC[differentiable; has_vector_derivative];
10578         MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN
10579         ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE] THEN
10580         ASM_SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN]]];
10581      ALL_TAC] THEN
10582   MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
10583   EXISTS_TAC `\n x. (&n + &1) % (g(x + lift(inv(&n + &1))) - g(x):real^N)` THEN
10584   EXISTS_TAC `k UNION frontier s:real^1->bool` THEN
10585   ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL
10586    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN
10587     MATCH_MP_TAC MEASURABLE_ON_SUB THEN ASM_REWRITE_TAC[] THEN
10588     ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
10589     REWRITE_TAC[MEASURABLE_ON_TRANSLATION_EQ] THEN
10590     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
10591      `g measurable_on s ==> t = s ==> g measurable_on t`)) THEN
10592     MATCH_MP_TAC(SET_RULE
10593      `!g. (!x. f(g x) = x /\ g(f x) = x) ==> IMAGE f UNIV = UNIV`) THEN
10594     EXISTS_TAC `\x. --(lift(inv(&n + &1))) + x` THEN VECTOR_ARITH_TAC;
10595
10596     X_GEN_TAC `x:real^1` THEN
10597     REWRITE_TAC[IN_UNIV; IN_DIFF; IN_UNION; DE_MORGAN_THM; frontier;
10598                 CLOSURE_INTERIOR] THEN
10599     STRIP_TAC THEN
10600     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN
10601     REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL; IN_DIFF; IN_UNIV] THEN
10602     X_GEN_TAC `d:real` THEN ASM_SIMP_TAC[DIST_REFL] THEN STRIP_TAC THEN
10603     MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THENL
10604      [EXISTS_TAC `(\n. vec 0):num->real^N`;
10605       EXISTS_TAC `(\n. (&n + &1) % (f(x + lift (inv (&n + &1))) - f x))
10606                   :num->real^N`] THEN
10607     (CONJ_TAC THENL
10608       [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
10609        MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN
10610        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
10611        X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
10612        DISCH_TAC THEN
10613        SUBGOAL_THEN `dist(x,x + lift(inv(&n + &1))) < d` ASSUME_TAC THENL
10614         [REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
10615          REWRITE_TAC[NORM_LIFT; REAL_ABS_INV] THEN
10616          REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN
10617          MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&N)` THEN
10618          ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
10619          ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC;
10620          EXPAND_TAC "g" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[DIST_REFL] THEN
10621          VECTOR_ARITH_TAC];
10622        ALL_TAC]) THEN
10623      REWRITE_TAC[LIM_CONST] THEN
10624      UNDISCH_THEN
10625       `!x. x IN s DIFF k
10626            ==> ((f:real^1->real^N) has_vector_derivative f' x) (at x)`
10627       (MP_TAC o SPEC `x:real^1`) THEN
10628      ASM_SIMP_TAC[IN_DIFF; DIST_REFL; has_vector_derivative] THEN
10629      REWRITE_TAC[has_derivative; NETLIMIT_AT] THEN
10630      DISCH_THEN(MP_TAC o CONJUNCT2) THEN
10631      REWRITE_TAC[LIM_AT; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
10632      X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10633      FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
10634      DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
10635      MP_TAC(SPEC `k:real` REAL_ARCH_INV) THEN
10636      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
10637      X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
10638      DISCH_TAC THEN
10639      FIRST_X_ASSUM(MP_TAC o SPEC `x +  lift(inv(&n + &1))` o CONJUNCT2) THEN
10640      REWRITE_TAC[NORM_ARITH `dist(x + a:real^N,x) = norm a`] THEN
10641      REWRITE_TAC[NORM_LIFT; REAL_ABS_INV; REAL_ARITH `abs(&n + &1) = &n + &1`;
10642               VECTOR_ARITH `(x + e) - x:real^N = e`; LIFT_DROP] THEN
10643      ANTS_TAC THENL
10644       [REWRITE_TAC[REAL_LT_INV_EQ] THEN
10645        CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_TRANS] THEN
10646        EXISTS_TAC `inv(&N)` THEN
10647        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
10648        ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC;
10649        MATCH_MP_TAC(NORM_ARITH
10650         `x - y:real^N = z ==> dist(z,vec 0) < e ==> dist(x,y) < e`) THEN
10651        REWRITE_TAC[REAL_INV_INV; VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN
10652        SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID;
10653                 REAL_ARITH `~(&n + &1 = &0)`] THEN
10654        VECTOR_ARITH_TAC]]);;
10655
10656 let ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER = prove
10657  (`!f:real^M->real^N s t.
10658         f absolutely_integrable_on s /\ lebesgue_measurable t
10659         ==> f absolutely_integrable_on (s INTER t)`,
10660   REPEAT GEN_TAC THEN
10661   ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
10662   STRIP_TAC THEN
10663   MATCH_MP_TAC
10664     MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
10665   EXISTS_TAC
10666    `\x. lift(norm(if x IN s then (f:real^M->real^N) x else vec 0))` THEN
10667   ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; IN_UNIV; IN_INTER;
10668                ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
10669   REWRITE_TAC[MESON[]
10670    `(if p /\ q then x else y) = if q then if p then x else y else y`] THEN
10671   CONJ_TAC THENL
10672    [MATCH_MP_TAC MEASURABLE_ON_CASES THEN
10673     ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`; MEASURABLE_ON_0] THEN
10674     ASM_SIMP_TAC[INTEGRABLE_IMP_MEASURABLE;
10675                  ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE];
10676     X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN t` THEN
10677     ASM_REWRITE_TAC[REAL_LE_REFL; LIFT_DROP; NORM_0; NORM_POS_LE]]);;
10678
10679 let ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET = prove
10680  (`!f:real^M->real^N s t.
10681         f absolutely_integrable_on s /\ t SUBSET s /\ lebesgue_measurable t
10682         ==> f absolutely_integrable_on t`,
10683   MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER;
10684             SET_RULE `s SUBSET t ==> s = t INTER s`]);;
10685
10686 (* ------------------------------------------------------------------------- *)
10687 (* Approximation of L_1 functions by bounded continuous ones.                *)
10688 (* Note that 100/fourier.ml has some generalizations to L_p spaces.          *)
10689 (* ------------------------------------------------------------------------- *)
10690
10691 let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove
10692  (`!f:real^M->real^N s e.
10693         lebesgue_measurable s /\ f absolutely_integrable_on s /\ &0 < e
10694         ==> ?g. g absolutely_integrable_on s /\
10695                 g continuous_on (:real^M) /\
10696                 bounded (IMAGE g (:real^M)) /\
10697                 norm(integral s (\x. lift(norm(f x - g x)))) < e`,
10698   let lemma = prove
10699    (`!f:real^M->real^N s e.
10700           measurable s /\ f absolutely_integrable_on s /\ &0 < e
10701           ==> ?g. g absolutely_integrable_on s /\
10702                   g continuous_on (:real^M) /\
10703                   bounded (IMAGE g (:real^M)) /\
10704                   norm(integral s (\x. lift(norm(f x - g x)))) < e`,
10705     REPEAT STRIP_TAC THEN
10706     SUBGOAL_THEN
10707       `?h. h absolutely_integrable_on s /\
10708            bounded (IMAGE h (:real^M)) /\
10709            norm(integral s (\x. lift(norm(f x - h x:real^N)))) < e / &2`
10710     STRIP_ASSUME_TAC THENL
10711      [MP_TAC(ISPECL
10712        [`\n x. lift(norm
10713          (f x - (lambda i. max (--(&n))
10714                              (min (&n) ((f:real^M->real^N)(x)$i)))))`;
10715         `(\x. vec 0):real^M->real^1`;
10716         `\x. lift(norm((f:real^M->real^N)(x)))`;
10717         `s:real^M->bool`]
10718             DOMINATED_CONVERGENCE) THEN
10719       ASM_REWRITE_TAC[] THEN
10720       SUBGOAL_THEN
10721        `!n. ((\x. lambda i. max (--(&n)) (min (&n) ((f x:real^N)$i)))
10722             :real^M->real^N) absolutely_integrable_on s`
10723       ASSUME_TAC THENL
10724        [GEN_TAC THEN
10725         FIRST_ASSUM(MP_TAC o SPEC `(\x. lambda i. &n):real^M->real^N` o
10726           MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MIN)) THEN
10727         ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN
10728         DISCH_THEN(MP_TAC o SPEC `(\x. lambda i. --(&n)):real^M->real^N` o
10729           MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MAX)) THEN
10730         ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN
10731         MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
10732         SIMP_TAC[CART_EQ; LAMBDA_BETA];
10733         ALL_TAC] THEN
10734       ANTS_TAC THENL
10735        [REPEAT CONJ_TAC THENL
10736          [X_GEN_TAC `n:num` THEN
10737           MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
10738           MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
10739           ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SUB];
10740           ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
10741                        ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE];
10742           MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN DISCH_TAC THEN
10743           REWRITE_TAC[LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN
10744           MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
10745           SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
10746           X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
10747           REWRITE_TAC[LIM_SEQUENTIALLY] THEN
10748           X_GEN_TAC `d:real` THEN DISCH_TAC THEN
10749           MP_TAC(SPEC `norm((f:real^M->real^N) x)` REAL_ARCH_SIMPLE) THEN
10750           MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
10751           DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
10752           REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_NORM; GSYM LIFT_SUB] THEN
10753           MATCH_MP_TAC(NORM_ARITH
10754            `&0 < d /\ x = y ==> norm(x:real^N - y) < d`) THEN
10755           ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN
10756           MATCH_MP_TAC(REAL_ARITH
10757             `abs(x) <= n ==> x = max (--n) (min n x)`) THEN
10758           ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_OF_NUM_LE]];
10759         DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
10760         DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
10761         DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
10762         REWRITE_TAC[INTEGRAL_0; DIST_0; LE_REFL] THEN DISCH_TAC THEN
10763         EXISTS_TAC `(\x. lambda i. max (--(&n)) (min (&n)
10764                                ((f:real^M->real^N)(x)$i))):real^M->real^N` THEN
10765         ASM_REWRITE_TAC[] THEN
10766         ONCE_REWRITE_TAC[BOUNDED_COMPONENTWISE] THEN
10767         REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN
10768         X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `&n` THEN
10769         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
10770         ASM_SIMP_TAC[NORM_LIFT; LAMBDA_BETA] THEN REAL_ARITH_TAC];
10771       ALL_TAC] THEN
10772     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
10773     REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
10774     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
10775     SUBGOAL_THEN
10776      `?k g. negligible k /\
10777             (!n. g n continuous_on (:real^M)) /\
10778             (!n x. norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\
10779             (!x. x IN (s DIFF k)  ==> ((\n. g n x) --> h x) sequentially)`
10780     STRIP_ASSUME_TAC THENL
10781      [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL
10782        [ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; ALL_TAC] THEN
10783       REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN
10784       X_GEN_TAC `k:real^M->bool` THEN
10785       DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
10786       EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))):
10787                   num->real^M->real^N` THEN
10788       ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
10789        [X_GEN_TAC `n:num` THEN
10790         FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
10791         MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`]
10792                   CONTINUOUS_ON_CONST) THEN
10793         REWRITE_TAC[IMP_IMP] THEN
10794         DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN
10795         MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`]
10796                   CONTINUOUS_ON_CONST) THEN
10797         REWRITE_TAC[IMP_IMP] THEN
10798         DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN
10799         MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
10800         SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA];
10801         REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
10802         SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN
10803         REAL_ARITH_TAC;
10804         X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
10805         FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
10806         REWRITE_TAC[LIM_SEQUENTIALLY] THEN
10807         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN
10808         MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
10809         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
10810         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
10811         MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
10812         MATCH_MP_TAC(NORM_ARITH
10813          `norm(c - a:real^N) <= norm(b - a)
10814           ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN
10815         MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
10816         SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN
10817         X_GEN_TAC `k:num` THEN STRIP_TAC THEN
10818         FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
10819         DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN
10820         DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN
10821         REAL_ARITH_TAC];
10822       ALL_TAC] THEN
10823     SUBGOAL_THEN
10824      `!n. (g:num->real^M->real^N) n absolutely_integrable_on s`
10825     ASSUME_TAC THENL
10826      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC
10827         MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
10828       EXISTS_TAC `(\x. lift(norm(B % vec 1:real^N))):real^M->real^1` THEN
10829       ASM_REWRITE_TAC[LIFT_DROP; INTEGRABLE_ON_CONST] THEN
10830       ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
10831       MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator]
10832           MEASURABLE_ON_RESTRICT) THEN
10833       ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN
10834       MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
10835       ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE];
10836       ALL_TAC] THEN
10837     MP_TAC(ISPECL
10838      [`\n x. lift(norm((g:num->real^M->real^N) n x - h x))`;
10839       `(\x. vec 0):real^M->real^1`;
10840       `(\x. lift(B + norm(B % vec 1:real^N))):real^M->real^1`;
10841       `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN
10842     ASM_SIMP_TAC[INTEGRAL_0; INTEGRABLE_ON_CONST; MEASURABLE_DIFF;
10843                  NEGLIGIBLE_IMP_MEASURABLE] THEN
10844     ANTS_TAC THENL
10845      [REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN REPEAT CONJ_TAC THENL
10846        [GEN_TAC THEN
10847         MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
10848         EXISTS_TAC `s:real^M->bool` THEN
10849         ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
10850                      ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE;
10851                      ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN
10852         MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
10853         ASM_REWRITE_TAC[] THEN SET_TAC[];
10854         REPEAT STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN
10855         MATCH_MP_TAC(NORM_ARITH
10856          `norm(g:real^N) <= b /\ norm(h) <= a ==> norm(g - h) <= a + b`) THEN
10857         ASM_REWRITE_TAC[];
10858         ASM_REWRITE_TAC[GSYM LIM_NULL_NORM; GSYM LIM_NULL]];
10859       REWRITE_TAC[LIM_SEQUENTIALLY] THEN
10860       DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
10861       DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
10862       REWRITE_TAC[LE_REFL; DIST_0] THEN DISCH_TAC THEN
10863       EXISTS_TAC `(g:num->real^M->real^N) n` THEN ASM_REWRITE_TAC[] THEN
10864       REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN
10865       CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
10866       MATCH_MP_TAC REAL_LET_TRANS THEN
10867       EXISTS_TAC `norm(integral s (\x. lift(norm(f x - h x)))) +
10868        norm(integral s (\x. lift(norm
10869              ((g:num->real^M->real^N) n x - h x))))` THEN
10870       CONJ_TAC THENL
10871        [MATCH_MP_TAC(NORM_ARITH
10872          `norm(x:real^N) <= norm(y + z:real^N)
10873           ==> norm(x) <= norm(y) + norm(z)`) THEN
10874         W(MP_TAC o PART_MATCH (lhs o rand) (GSYM INTEGRAL_ADD) o
10875            rand o rand o snd) THEN
10876         ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
10877                  ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE;
10878                  ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN
10879         DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[]
10880          `norm x = drop x /\ norm(a:real^N) <= drop x
10881           ==> norm a <= norm x`) THEN
10882         CONJ_TAC THENL
10883          [MATCH_MP_TAC NORM_1_POS THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN
10884           SIMP_TAC[DROP_ADD; LIFT_DROP; NORM_POS_LE; REAL_LE_ADD] THEN
10885           MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC;
10886           MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
10887           REWRITE_TAC[DROP_ADD; LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN
10888           REWRITE_TAC[NORM_ARITH
10889            `norm(f - g:real^N) <= norm(f - h) + norm(g - h)`] THEN
10890           CONJ_TAC THENL
10891            [ALL_TAC; MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC]] THEN
10892         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
10893         ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
10894                      ABSOLUTELY_INTEGRABLE_SUB; ETA_AX];
10895         MATCH_MP_TAC(REAL_ARITH `a < e / &2 /\ b < e / &2 ==> a + b < e`) THEN
10896         ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
10897           (REAL_ARITH `x < e ==> x = y ==> y < e`)) THEN AP_TERM_TAC THEN
10898         MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN
10899         MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN
10900         ASM_REWRITE_TAC[] THEN SET_TAC[]]]) in
10901   REPEAT STRIP_TAC THEN
10902   SUBGOAL_THEN
10903    `(!u v. f absolutely_integrable_on (s INTER interval[u,v])) /\
10904     (!u v. (f:real^M->real^N) absolutely_integrable_on (s DIFF interval[u,v]))`
10905   STRIP_ASSUME_TAC THENL
10906    [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
10907     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER;
10908                  LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_DIFF;
10909                  LEBESGUE_MEASURABLE_UNIV];
10910     ALL_TAC] THEN
10911   SUBGOAL_THEN
10912    `?a b. norm(integral (s INTER interval[a,b]) (\x. lift(norm(f x))) -
10913                integral s (\x. lift(norm((f:real^M->real^N) x)))) < e / &3`
10914   STRIP_ASSUME_TAC THENL
10915    [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN
10916     DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRAL] THEN
10917     REWRITE_TAC[HAS_INTEGRAL_ALT; INTEGRAL_RESTRICT_INTER] THEN
10918     DISCH_THEN(MP_TAC o SPEC `e / &3` o CONJUNCT2) THEN
10919     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
10920     MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL; BOUNDED_BALL];
10921     ALL_TAC] THEN
10922   MP_TAC(ISPECL
10923    [`f:real^M->real^N`; `s INTER interval[a:real^M,b]`; `e / &3`]
10924         lemma) THEN
10925   ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE;
10926                MEASURABLE_INTERVAL; REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
10927   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
10928   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
10929   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
10930   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
10931   SUBGOAL_THEN
10932    `?c d. interval[a:real^M,b] SUBSET interval(c,d) /\
10933           measure(interval(c,d)) - measure(interval[a,b]) < e / &3 / B`
10934   STRIP_ASSUME_TAC THENL
10935    [MP_TAC(ISPECL [`a:real^M`; `b:real^M`;
10936                    `e / &3 / B / &2`]
10937         EXPAND_CLOSED_OPEN_INTERVAL) THEN
10938     ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_ARITH `&0 < &3`] THEN
10939     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
10940     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10941     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
10942      `&0 < e ==> x <= y + e / &2 ==> x - y < e`) THEN
10943     ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &3`];
10944     ALL_TAC] THEN
10945   MP_TAC(ISPECL
10946    [`\x. if x IN interval[a,b] then (g:real^M->real^N) x else vec 0`;
10947     `(:real^M)`;
10948     `interval[a,b] UNION ((:real^M) DIFF interval(c,d))`;
10949     `B:real`] TIETZE) THEN
10950   REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; IN_UNIV] THEN ANTS_TAC THENL
10951    [ASM_SIMP_TAC[REAL_LT_IMP_LE; FORALL_IN_UNION] THEN
10952     SIMP_TAC[CLOSED_UNION; CLOSED_INTERVAL; GSYM OPEN_CLOSED; OPEN_INTERVAL;
10953              IN_DIFF; IN_UNIV] THEN
10954     ASM_SIMP_TAC[COND_RAND; NORM_0; COND_RATOR; REAL_LT_IMP_LE; COND_ID] THEN
10955     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
10956     SIMP_TAC[CLOSED_INTERVAL; GSYM OPEN_CLOSED; OPEN_INTERVAL] THEN
10957     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL
10958      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ASM SET_TAC[]];
10959     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N`] THEN
10960   REWRITE_TAC[FORALL_IN_UNION; bounded; FORALL_IN_IMAGE; IN_UNIV] THEN
10961   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10962   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
10963    [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
10964     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_EQ THEN
10965     EXISTS_TAC `\x. if x IN s INTER interval(c,d)
10966                     then (h:real^M->real^N) x else vec 0` THEN
10967     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10968     REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
10969     ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_INTER] THEN
10970     MATCH_MP_TAC
10971       MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
10972     EXISTS_TAC `(\x. lift B):real^M->real^1` THEN
10973     ASM_REWRITE_TAC[INTEGRABLE_CONST; LIFT_DROP] THEN
10974     REPEAT CONJ_TAC THENL
10975      [MATCH_MP_TAC MEASURABLE_ON_CASES THEN
10976       ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`; MEASURABLE_ON_0] THEN
10977       MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
10978       REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN
10979       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
10980       REWRITE_TAC[INTEGRABLE_ON_OPEN_INTERVAL; INTEGRABLE_CONST];
10981       GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE]];
10982     DISCH_TAC] THEN
10983   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
10984   SUBGOAL_THEN
10985    `(!u v. h absolutely_integrable_on (s INTER interval[u,v])) /\
10986     (!u v. (h:real^M->real^N) absolutely_integrable_on (s DIFF interval[u,v]))`
10987   STRIP_ASSUME_TAC THENL
10988    [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
10989     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER;
10990                  LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_DIFF;
10991                  LEBESGUE_MEASURABLE_UNIV];
10992     ALL_TAC] THEN
10993   TRANS_TAC REAL_LET_TRANS
10994     `norm(integral (s INTER interval[a,b])
10995                    (\x. lift(norm((f:real^M->real^N) x - h x)))) +
10996      norm(integral (s DIFF interval[a,b])
10997                    (\x. lift(norm(f x - h x))))` THEN
10998   CONJ_TAC THENL
10999    [MATCH_MP_TAC(NORM_ARITH
11000      `a + b:real^N = c ==> norm(c) <= norm(a) + norm(b)`) THEN
11001     W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o lhand o snd) THEN
11002     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB;
11003                  ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
11004     REWRITE_TAC[NEGLIGIBLE_EMPTY; SET_RULE
11005      `(s INTER t) INTER (s DIFF t) = {} /\
11006       (s INTER t) UNION (s DIFF t) = s`] THEN
11007     DISCH_THEN SUBST1_TAC THEN REFL_TAC;
11008     ALL_TAC] THEN
11009   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
11010    `norm(integral s f) < e / &3
11011     ==> integral s f = integral s g /\
11012         y < &2 / &3 * e ==> norm(integral s g) + y < e`)) THEN
11013   CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_EQ THEN ASM SET_TAC[]; ALL_TAC] THEN
11014   TRANS_TAC REAL_LET_TRANS
11015     `drop(integral (s DIFF interval[a,b])
11016                    (\x. lift(norm((f:real^M->real^N) x)) +
11017                         lift(norm(h x:real^N))))` THEN
11018   CONJ_TAC THENL
11019    [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
11020     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB;
11021                  ABSOLUTELY_INTEGRABLE_ADD; LIFT_DROP; DROP_ADD; NORM_LIFT;
11022                  ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
11023     CONV_TAC NORM_ARITH;
11024     ASM_SIMP_TAC[INTEGRAL_ADD; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE;
11025                  ABSOLUTELY_INTEGRABLE_NORM; DROP_ADD]] THEN
11026   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
11027    `x < e / &3 ==> z = x /\ y <= e / &3 ==> z + y < &2 / &3 * e`)) THEN
11028   CONJ_TAC THENL
11029    [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
11030     MATCH_MP_TAC(REAL_ARITH
11031      `z + y = x /\ &0 <= y ==> y = abs(z - x)`) THEN
11032     ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE;
11033                   ABSOLUTELY_INTEGRABLE_NORM;
11034                   ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
11035     REWRITE_TAC[GSYM DROP_ADD; DROP_EQ] THEN
11036     W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o lhand o snd) THEN
11037     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM;
11038                  ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
11039     REWRITE_TAC[NEGLIGIBLE_EMPTY; SET_RULE
11040      `(s INTER t) INTER (s DIFF t) = {} /\
11041       (s INTER t) UNION (s DIFF t) = s`]  THEN
11042     DISCH_THEN SUBST1_TAC THEN REFL_TAC;
11043     ALL_TAC] THEN
11044   TRANS_TAC REAL_LE_TRANS
11045    `drop(integral (interval(c,d) DIFF interval[a,b]) (\x:real^M. lift B))` THEN
11046   CONJ_TAC THENL
11047    [ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN
11048     MATCH_MP_TAC INTEGRAL_DROP_LE THEN
11049     ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; IN_UNIV] THEN
11050     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; INTEGRABLE_ON_CONST;
11051                  ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
11052     SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN
11053     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN
11054     ASM_CASES_TAC `x IN interval(c:real^M,d)` THEN ASM_REWRITE_TAC[] THEN
11055     ASM_CASES_TAC `x IN interval[a:real^M,b]` THEN ASM_REWRITE_TAC[] THEN
11056     REPEAT COND_CASES_TAC THEN
11057     ASM_SIMP_TAC[REAL_LE_REFL; LIFT_DROP; NORM_0; REAL_LT_IMP_LE;
11058                  DROP_VEC] THEN
11059     ASM_MESON_TAC[IN_DIFF; IN_UNIV; NORM_0; REAL_LE_REFL];
11060     SIMP_TAC[LIFT_EQ_CMUL; INTEGRAL_CMUL; INTEGRABLE_ON_CONST;
11061              MEASURABLE_DIFF; MEASURABLE_INTERVAL; INTEGRAL_MEASURE] THEN
11062     REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN
11063     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN
11064     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
11065      `x < e ==> y = x ==> y <= e`)) THEN
11066     MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
11067     ASM_REWRITE_TAC[MEASURABLE_INTERVAL]]);;
11068
11069 (* ------------------------------------------------------------------------- *)
11070 (* Luzin's theorem (Talvila and Loeb's proof from Marius Junge's notes).     *)
11071 (* ------------------------------------------------------------------------- *)
11072
11073 let LUZIN = prove
11074  (`!f:real^M->real^N s e.
11075         measurable s /\ f measurable_on s /\ &0 < e
11076         ==> ?k. compact k /\ k SUBSET s /\
11077                 measure(s DIFF k) < e /\ f continuous_on k`,
11078   REPEAT STRIP_TAC THEN
11079   X_CHOOSE_THEN `v:num->real^N->bool` STRIP_ASSUME_TAC
11080     UNIV_SECOND_COUNTABLE_SEQUENCE THEN
11081   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
11082         MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN) THEN
11083   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
11084         MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED) THEN
11085   ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
11086   SUBGOAL_THEN
11087    `!n. ?k k'.
11088         compact k /\ k SUBSET {x | x IN s /\ (f:real^M->real^N) x IN v n} /\
11089         compact k' /\ k' SUBSET {x | x IN s /\ f x IN ((:real^N) DIFF v n)} /\
11090         measure(s DIFF (k UNION k')) < e / &4 / &2 pow n`
11091   MP_TAC THENL
11092    [GEN_TAC THEN
11093     MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (v:num->real^N->bool) n}`;
11094                    `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN
11095     ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH; REAL_LT_DIV; REAL_LT_POW2] THEN
11096     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
11097     STRIP_TAC THEN
11098     MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (:real^N) DIFF v(n:num)}`;
11099                    `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN
11100     ASM_SIMP_TAC[GSYM OPEN_CLOSED; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT;
11101                  ARITH] THEN
11102     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k':real^M->bool` THEN
11103     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11104     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
11105      `measure(({x | x IN s /\ (f:real^M->real^N) x IN v n} DIFF k) UNION
11106               ({x | x IN s /\ f x IN ((:real^N) DIFF v(n:num))} DIFF k'))` THEN
11107     CONJ_TAC THENL
11108      [MATCH_MP_TAC MEASURE_SUBSET THEN
11109       ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT;
11110                    GSYM OPEN_CLOSED] THEN SET_TAC[];
11111       ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_DIFF; MEASURABLE_COMPACT;
11112                    GSYM OPEN_CLOSED; MEASURE_DIFF_SUBSET] THEN
11113       MATCH_MP_TAC(REAL_ARITH
11114        `s < k + e / &4 / &2 / d /\ s' < k' + e / &4 / &2 / d /\ m = &0
11115         ==> (s - k) + (s' - k') - m < e / &4 / d`) THEN
11116       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[MEASURE_EMPTY]
11117        `s = {} ==> measure s = &0`) THEN SET_TAC[]];
11118     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_DIFF; IN_UNIV] THEN
11119     MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `k':num->real^M->bool`] THEN
11120     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
11121   EXISTS_TAC `INTERS {k n UNION k' n | n IN (:num)} :real^M->bool` THEN
11122   REPEAT CONJ_TAC THENL
11123    [MATCH_MP_TAC COMPACT_INTERS THEN
11124     ASM_SIMP_TAC[FORALL_IN_GSPEC; COMPACT_UNION] THEN SET_TAC[];
11125     REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[];
11126     REWRITE_TAC[DIFF_INTERS; SET_RULE
11127      `{f y | y IN {g x | x IN s}} = {f(g x) | x IN s}`] THEN
11128     MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
11129     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
11130      (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN
11131     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN
11132     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT] THEN
11133     X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
11134     EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL
11135      [ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE]; ALL_TAC] THEN
11136     ASM_SIMP_TAC[real_div; SUM_LMUL; REAL_LE_LMUL_EQ; REAL_ARITH
11137      `(e * inv(&4)) * s <= e * inv(&2) <=> e * s <= e * &2`] THEN
11138     REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN
11139     CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH
11140      `(&1 - s) / (&1 / &2) <= &2 <=> &0 <= s`] THEN
11141     MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV;
11142
11143     REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
11144     REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
11145     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11146     REWRITE_TAC[CONTINUOUS_WITHIN_OPEN; IN_ELIM_THM] THEN
11147     X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
11148     SUBGOAL_THEN
11149      `?n:num. (f:real^M->real^N)(x) IN v(n) /\ v(n) SUBSET t`
11150     STRIP_ASSUME_TAC THENL
11151      [UNDISCH_THEN
11152        `!s. open s ==> (?k. s:real^N->bool = UNIONS {v(n:num) | n IN k})`
11153        (MP_TAC o SPEC `t:real^N->bool`) THEN
11154       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; UNIONS_GSPEC] THEN ASM SET_TAC[];
11155       EXISTS_TAC `(:real^M) DIFF k'(n:num)` THEN
11156       ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]]);;
11157
11158 let LUZIN_EQ,LUZIN_EQ_ALT = (CONJ_PAIR o prove)
11159  (`(!f:real^M->real^N s.
11160         measurable s
11161         ==> (f measurable_on s <=>
11162              !e. &0 < e
11163                  ==> ?k. compact k /\ k SUBSET s /\
11164                          measure(s DIFF k) < e /\ f continuous_on k)) /\
11165    (!f:real^M->real^N s.
11166         measurable s
11167         ==> (f measurable_on s <=>
11168              !e. &0 < e
11169                  ==> ?k g. compact k /\ k SUBSET s /\
11170                            measure(s DIFF k) < e /\
11171                            g continuous_on (:real^M) /\
11172                            (!x. x IN k ==> g x = f x)))`,
11173   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
11174   ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN
11175   MATCH_MP_TAC(TAUT
11176    `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN
11177   REPEAT CONJ_TAC THENL
11178    [ASM_MESON_TAC[LUZIN];
11179     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
11180     ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
11181     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
11182     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN
11183     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBTOPOLOGY_UNIV; GSYM CLOSED_IN];
11184     DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
11185     REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN
11186     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
11187     MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `g:num->real^M->real^N`] THEN
11188     STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC
11189      [`g:num->real^M->real^N`;
11190       `s DIFF UNIONS {INTERS {k m | n <= m} | n IN (:num)}:real^M->bool`] THEN
11191     REPEAT CONJ_TAC THENL
11192      [X_GEN_TAC `n:num` THEN
11193       MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
11194       ASM_MESON_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; CONTINUOUS_ON_SUBSET;
11195                     SUBSET_UNIV];
11196       SIMP_TAC[DIFF_UNIONS_NONEMPTY; SET_RULE `~({f x | x IN UNIV} = {})`] THEN
11197       REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11198       MP_TAC(SPECL [`inv(&2)`; `e / &4`] REAL_ARCH_POW_INV) THEN
11199       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN
11200       DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
11201       EXISTS_TAC `s DIFF INTERS {k m | n:num <= m}:real^M->bool` THEN
11202       REPEAT CONJ_TAC THENL
11203        [REWRITE_TAC[INTERS_GSPEC; FORALL_IN_GSPEC] THEN ASM SET_TAC[];
11204         MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
11205         MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS_GEN THEN
11206         ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT] THEN
11207         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[LE_REFL]] THEN
11208         ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11209         MATCH_MP_TAC COUNTABLE_IMAGE THEN
11210         MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV];
11211         REWRITE_TAC[DIFF_INTERS] THEN
11212         MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
11213         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC
11214          (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN
11215         MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN
11216         ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT; MEASURABLE_DIFF] THEN
11217         CONJ_TAC THENL
11218          [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11219           MATCH_MP_TAC COUNTABLE_IMAGE THEN
11220           REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN
11221           ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11222           MATCH_MP_TAC COUNTABLE_IMAGE THEN
11223           MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV];
11224           REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
11225           REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
11226           ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11227           REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
11228           X_GEN_TAC `ns:num->bool` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
11229           STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN
11230           W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN
11231           ASM_SIMP_TAC[o_DEF; MEASURE_POS_LE; MEASURABLE_DIFF;
11232                        MEASURABLE_COMPACT] THEN
11233           MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
11234           FIRST_ASSUM(MP_TAC o SPEC `\x:num. x` o
11235             MATCH_MP UPPER_BOUND_FINITE_SET) THEN
11236           REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN
11237           STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
11238           EXISTS_TAC `sum (n..m) (\i. measure(s DIFF k i:real^M->bool))` THEN
11239           CONJ_TAC THENL
11240            [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
11241             ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_COMPACT;
11242                          FINITE_NUMSEG; SUBSET; IN_NUMSEG];
11243             ALL_TAC] THEN
11244           MATCH_MP_TAC REAL_LE_TRANS THEN
11245           EXISTS_TAC `sum (n..m) (\i. inv(&2 pow i))` THEN
11246           ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN
11247           REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN
11248           COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
11249           CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH
11250            `a <= e / &4 /\ &0 <= b
11251             ==> (a - b) / (&1 / &2) <= e / &2`) THEN
11252           REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN
11253           ASM_SIMP_TAC[GSYM real_div; REAL_LT_IMP_LE; REAL_LE_INV_EQ;
11254                        REAL_LT_POW2]]];
11255       REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN
11256       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; IN_INTER] THEN
11257       REWRITE_TAC[IN_UNIV; IN_ELIM_THM; INTERS_GSPEC] THEN
11258       STRIP_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN
11259       REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]]]);;
11260
11261 (* ------------------------------------------------------------------------- *)
11262 (* Egorov's thoerem.                                                         *)
11263 (* ------------------------------------------------------------------------- *)
11264
11265 let EGOROV = prove
11266  (`!f:num->real^M->real^N g s t.
11267         measurable s /\ negligible t /\
11268         (!n. f n measurable_on s) /\ g measurable_on s /\
11269         (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially)
11270         ==> !d. &0 < d
11271                 ==> ?k. k SUBSET s /\ measurable k /\ measure k < d /\
11272                         !e. &0 < e
11273                             ==> ?N. !n x. N <= n /\ x IN s DIFF k
11274                                           ==> dist(f n x,g x) < e`,
11275   REPEAT STRIP_TAC THEN
11276   ABBREV_TAC `e = \n m. UNIONS{{x | x IN s /\
11277                                     dist((f:num->real^M->real^N) k x,g x)
11278                                       >= inv(&m + &1)} | n <= k}` THEN
11279   SUBGOAL_THEN
11280    `!m n. measurable ((e:num->num->real^M->bool) n m)`
11281   ASSUME_TAC THENL
11282    [REPEAT GEN_TAC THEN
11283     MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN
11284     EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
11285     EXPAND_TAC "e" THEN CONJ_TAC THENL
11286      [ALL_TAC; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN SET_TAC[]] THEN
11287     MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
11288     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
11289     SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_GSPEC] THEN
11290     REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_ARITH
11291      `dist(a:real^M,b) >= e <=> ~(dist(vec 0,a - b) < e)`] THEN
11292     REWRITE_TAC[GSYM IN_BALL; SET_RULE `~(x IN s) <=> x IN UNIV DIFF s`] THEN
11293     MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN
11294     ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_BALL;
11295                  MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN
11296     MATCH_MP_TAC MEASURABLE_ON_SUB THEN CONJ_TAC THEN
11297     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN
11298     EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN
11299     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11300      NEGLIGIBLE_SUBSET)) THEN
11301     SET_TAC[];
11302     ALL_TAC] THEN
11303   SUBGOAL_THEN
11304    `!m. ?k. measure((e:num->num->real^M->bool) k m) < d / &2 pow (m + 2)`
11305   MP_TAC THENL
11306    [GEN_TAC THEN MP_TAC(ISPEC
11307       `\n. (e:num->num->real^M->bool) n m` HAS_MEASURE_NESTED_INTERS) THEN
11308     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
11309      [GEN_TAC THEN EXPAND_TAC "e" THEN REWRITE_TAC[] THEN
11310       MATCH_MP_TAC SUBSET_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11311       MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
11312       ARITH_TAC;
11313       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN
11314     SUBGOAL_THEN
11315      `measure (INTERS {(e:num->num->real^M->bool) n m | n IN (:num)}) = &0`
11316     SUBST1_TAC THENL
11317      [MATCH_MP_TAC MEASURE_EQ_0 THEN
11318       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real^M->bool` THEN
11319       ASM_REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
11320       X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
11321       ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_REWRITE_TAC[IN_DIFF] THEN
11322       EXPAND_TAC "e" THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN
11323       ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
11324       REWRITE_TAC[LIM_SEQUENTIALLY; NOT_FORALL_THM; NOT_EXISTS_THM] THEN
11325       DISCH_THEN(MP_TAC o SPEC `inv(&m + &1)`) THEN
11326       REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &m + &1`] THEN
11327       REWRITE_TAC[DE_MORGAN_THM; real_ge; REAL_NOT_LE] THEN MESON_TAC[];
11328       ALL_TAC] THEN
11329     REWRITE_TAC[LIM_SEQUENTIALLY; LIFT_NUM; DIST_0; NORM_LIFT] THEN
11330     DISCH_THEN(MP_TAC o SPEC `d / &2 pow (m + 2)`) THEN
11331     ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN
11332     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
11333     DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN
11334     REAL_ARITH_TAC;
11335     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
11336     X_GEN_TAC `k:num->num` THEN DISCH_TAC] THEN
11337   EXISTS_TAC `UNIONS {(e:num->num->real^M->bool) (k m) m | m IN (:num)}` THEN
11338   CONJ_TAC THENL
11339    [REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN EXPAND_TAC "e" THEN
11340     REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN SET_TAC[];
11341     ALL_TAC] THEN
11342   REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
11343    [MP_TAC(ISPECL [`\m. (e:num->num->real^M->bool) (k m) m`; `d / &2`]
11344         MEASURE_COUNTABLE_UNIONS_LE) THEN ASM_REWRITE_TAC[] THEN
11345     ANTS_TAC THENL
11346      [X_GEN_TAC `n:num`;
11347       ASM_MESON_TAC[REAL_ARITH `&0 < d /\ x <= d / &2 ==> x < d`]] THEN
11348     TRANS_TAC REAL_LE_TRANS `sum(0..n) (\m. d / &2 pow (m + 2))` THEN
11349     ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN
11350     REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_POW; REAL_MUL_ASSOC] THEN
11351     REWRITE_TAC[SUM_RMUL; SUM_LMUL; SUM_GP; CONJUNCT1 LT] THEN
11352     CONV_TAC REAL_RAT_REDUCE_CONV THEN
11353     ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC] THEN
11354     MATCH_MP_TAC(REAL_ARITH
11355      `&0 <= x ==> (&1 - x) / (&1 / &2) * &1 / &4 <= &1 / &2`) THEN
11356     MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV;
11357
11358     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11359     MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
11360     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11361     X_GEN_TAC `m:num` THEN STRIP_TAC THEN EXISTS_TAC `(k:num->num) m` THEN
11362     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN EXPAND_TAC "e" THEN
11363     REWRITE_TAC[IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM] THEN
11364     REWRITE_TAC[NOT_EXISTS_THM; IN_UNIV] THEN
11365     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11366     ASM_REWRITE_TAC[] THEN
11367     DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
11368     ASM_REWRITE_TAC[REAL_NOT_LE; real_ge] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
11369      MATCH_MP (REAL_ARITH `i < e ==> m <= i ==> d < m ==> d < e`)) THEN
11370     MATCH_MP_TAC REAL_LE_INV2 THEN
11371     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
11372     ASM_ARITH_TAC]);;
11373
11374 (* ------------------------------------------------------------------------- *)
11375 (* A kind of absolute continuity of the integral.                            *)
11376 (* ------------------------------------------------------------------------- *)
11377
11378 let ABSOLUTELY_CONTINUOUS_INTEGRAL = prove
11379  (`!f:real^M->real^N s e.
11380         f absolutely_integrable_on s /\ &0 < e
11381         ==> ?d. &0 < d /\
11382                 !t. t SUBSET s /\ measurable t /\ measure t < d
11383                     ==> norm(integral t f) < e`,
11384   ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
11385   REPEAT STRIP_TAC THEN
11386   MP_TAC(ISPECL
11387    [`\x. if x IN s then (f:real^M->real^N) x else vec 0`;
11388     `(:real^M)`; `e / &2`]
11389    ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN
11390   ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV; REAL_HALF] THEN
11391   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
11392   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
11393   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
11394   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
11395   EXISTS_TAC `e / &2 / B` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF] THEN
11396   X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN
11397   TRANS_TAC REAL_LET_TRANS
11398    `drop(integral t (\x. lift(norm((if x IN s then f x else vec 0) - g x)) +
11399                          lift(norm((g:real^M->real^N) x))))` THEN
11400
11401   SUBGOAL_THEN
11402    `(g:real^M->real^N) absolutely_integrable_on t /\
11403     (\x. if x IN s then (f:real^M->real^N) x else vec 0)
11404     absolutely_integrable_on t`
11405   STRIP_ASSUME_TAC THENL
11406    [CONJ_TAC THEN
11407     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET THEN
11408     EXISTS_TAC `(:real^M)` THEN
11409     ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; SUBSET_UNIV];
11410     ALL_TAC] THEN
11411   SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on t` ASSUME_TAC THENL
11412    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
11413         ABSOLUTELY_INTEGRABLE_EQ)) THEN
11414     ASM SET_TAC[];
11415     ALL_TAC] THEN
11416   CONJ_TAC THENL
11417    [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
11418     ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
11419      [ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_ADD;
11420       ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN
11421     GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP; DROP_ADD] THEN
11422     COND_CASES_TAC THENL [CONV_TAC NORM_ARITH; ASM SET_TAC[]];
11423     ALL_TAC] THEN
11424   ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
11425    [ABSOLUTELY_INTEGRABLE_NORM; INTEGRAL_ADD; DROP_ADD;
11426     ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN
11427   MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN
11428   CONJ_TAC THENL
11429    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
11430      `norm(integral s (f:real^M->real^1)) < e / &2
11431       ==> drop(integral t f) <= norm(integral s f)
11432            ==> drop(integral t f) < e / &2`)) THEN
11433     REWRITE_TAC[NORM_REAL; GSYM drop] THEN
11434     MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN
11435     MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
11436     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; IN_UNIV; SUBSET_UNIV; LIFT_DROP;
11437      ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN
11438     REWRITE_TAC[NORM_POS_LE];
11439
11440     TRANS_TAC REAL_LET_TRANS `drop(integral t (\x:real^M. lift B))` THEN
11441     CONJ_TAC THENL
11442      [MATCH_MP_TAC INTEGRAL_DROP_LE THEN
11443       ASM_SIMP_TAC[LIFT_DROP; ABSOLUTELY_INTEGRABLE_NORM; INTEGRABLE_ON_CONST;
11444                    ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE];
11445       ASM_SIMP_TAC[LIFT_EQ_CMUL; INTEGRAL_CMUL; INTEGRABLE_ON_CONST;
11446                    INTEGRAL_MEASURE] THEN
11447       REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN
11448      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
11449      ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]]]);;
11450
11451 (* ------------------------------------------------------------------------- *)
11452 (* Convergence in measure implies convergence AE of a subsequence.           *)
11453 (* ------------------------------------------------------------------------- *)
11454
11455 let CONVERGENCE_IN_MEASURE = prove
11456  (`!f:num->real^M->real^N g s.
11457         (!n. f n measurable_on s) /\
11458         (!e. &0 < e
11459              ==> eventually
11460                   (\n. ?t. {x | x IN s /\ dist(f n x,g x) >= e} SUBSET t /\
11461                            measurable t /\ measure t < e)
11462                   sequentially)
11463         ==> ?r t. (!m n:num. m < n ==> r m < r n) /\
11464                   negligible t /\ t SUBSET s /\
11465                   !x. x IN s DIFF t
11466                       ==> ((\n. f (r n) x) --> g x) sequentially`,
11467   REPEAT STRIP_TAC THEN
11468   SUBGOAL_THEN
11469    `?r. (!n. ?t. {x | x IN s /\ dist(f (r n) x,(g:real^M->real^N) x)
11470                                 >= inv(&2 pow n)} SUBSET t /\
11471                       measurable t /\ measure t < inv(&2 pow n)) /\
11472         (!n. r n :num < r(SUC n))`
11473   MP_TAC THENL
11474    [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
11475      [FIRST_X_ASSUM(MP_TAC o SPEC `&1`);
11476       MAP_EVERY X_GEN_TAC [`n:num`; `p:num`] THEN REPEAT STRIP_TAC THEN
11477       FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow (SUC n))`)] THEN
11478     ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
11479     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THENL
11480      [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
11481       DISCH_THEN(MP_TAC o SPEC `m:num`) THEN
11482       CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_REFL];
11483       DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m + p + 1:num`)) THEN
11484       DISCH_THEN(fun th -> EXISTS_TAC `m + p + 1:num` THEN MP_TAC th) THEN
11485       REWRITE_TAC[LE_ADD; ARITH_RULE `p < m + p + 1`]];
11486     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
11487     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
11488     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
11489     X_GEN_TAC `t:num->real^M->bool` THEN STRIP_TAC] THEN
11490   EXISTS_TAC `s INTER
11491        INTERS {UNIONS {(t:num->real^M->bool) k | n <= k} | n IN (:num)}` THEN
11492   REPEAT CONJ_TAC THENL
11493    [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN ARITH_TAC;
11494     MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
11495     SIMP_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11496     MP_TAC(ISPECL [`inv(&2)`; `e / &2`] REAL_ARCH_POW_INV) THEN
11497     ASM_REWRITE_TAC[REAL_POW_INV; REAL_HALF] THEN
11498     CONV_TAC REAL_RAT_REDUCE_CONV THEN
11499     DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
11500     EXISTS_TAC `UNIONS {(t:num->real^M->bool) k | N <= k}` THEN CONJ_TAC THENL
11501      [MATCH_MP_TAC(SET_RULE `x IN s ==> INTERS s SUBSET x`) THEN SET_TAC[];
11502       ALL_TAC] THEN
11503     REWRITE_TAC[LE_EXISTS; SET_RULE
11504      `{f n | ?d. n = N + d} = {f(N + n) | n IN (:num)}`] THEN
11505     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN
11506     X_GEN_TAC `n:num` THEN
11507     TRANS_TAC REAL_LE_TRANS `sum(0..n) (\k. inv(&2 pow (N + k)))` THEN
11508     CONJ_TAC THENL
11509      [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
11510       ALL_TAC] THEN
11511     REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; SUM_LMUL; GSYM REAL_POW_INV] THEN
11512     REWRITE_TAC[SUM_GP; CONJUNCT1 LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11513     REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_INV] THEN
11514     REWRITE_TAC[REAL_ARITH `x * y * &2 <= e <=> y * x <= e / &2`] THEN
11515     REWRITE_TAC[REAL_POW_INV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
11516      (REAL_ARITH `n < e / &2 ==> &0 <= x * n ==> (&1 - x) * n <= e / &2`)) THEN
11517     REWRITE_TAC[GSYM REAL_INV_MUL; REAL_LE_INV_EQ; GSYM REAL_POW_ADD] THEN
11518     SIMP_TAC[REAL_POW_LE; REAL_POS];
11519
11520     REWRITE_TAC[INTER_SUBSET];
11521     X_GEN_TAC `x:real^M` THEN
11522     REWRITE_TAC[SET_RULE `s DIFF (s INTER t) = s DIFF t`] THEN
11523     REWRITE_TAC[IN_DIFF; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
11524     REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN
11525     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
11526     REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM] THEN
11527     REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN
11528     DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN
11529     REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN
11530     DISCH_TAC THEN
11531     MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
11532     ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11533     DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN
11534     EXISTS_TAC `N + M:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
11535     REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN
11536     ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN
11537     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN
11538     DISCH_THEN(MP_TAC o SPECL [`n:num`; `x:real^M`]) THEN
11539     ASM_REWRITE_TAC[IN_ELIM_THM; real_ge; REAL_NOT_LE] THEN
11540     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN
11541     TRANS_TAC REAL_LET_TRANS `inv(&2 pow M)` THEN ASM_REWRITE_TAC[] THEN
11542     REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN
11543     CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC]);;
11544
11545 (* ------------------------------------------------------------------------- *)
11546 (* Fubini-type results for measure.                                          *)
11547 (* ------------------------------------------------------------------------- *)
11548
11549 let FUBINI_MEASURE = prove
11550  (`!s:real^(M,N)finite_sum->bool.
11551         measurable s
11552         ==> negligible {x | ~measurable {y | pastecart x y IN s}} /\
11553             ((\x. lift(measure {y | pastecart x y IN s}))
11554              has_integral lift(measure s)) UNIV`,
11555   let MEASURE_PASTECART_INTERVAL = prove
11556    (`!a b:real^(M,N)finite_sum.
11557           (!x. measurable {y | pastecart x y IN interval[a,b]}) /\
11558           ((\x. lift(measure {y | pastecart x y IN interval[a,b]}))
11559            has_integral lift(measure(interval[a,b]))) UNIV`,
11560     REWRITE_TAC[FORALL_PASTECART] THEN
11561     MAP_EVERY X_GEN_TAC [`a:real^M`; `c:real^N`; `b:real^M`; `d:real^N`] THEN
11562     REWRITE_TAC[GSYM PCROSS_INTERVAL; PASTECART_IN_PCROSS] THEN
11563     REWRITE_TAC[SET_RULE `{x | P /\ Q x} = if P then {x | Q x} else {}`] THEN
11564     REWRITE_TAC[COND_RAND; SET_RULE `{x | x IN s} = s`] THEN
11565     REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_EMPTY; COND_ID] THEN
11566     REWRITE_TAC[MEASURE_EMPTY; LIFT_NUM; HAS_INTEGRAL_RESTRICT_UNIV] THEN
11567     REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART] THEN
11568     REWRITE_TAC[LIFT_CMUL; HAS_INTEGRAL_CONST]) in
11569   let MEASURE_PASTECART_ELEMENTARY = prove
11570    (`!s:real^(M,N)finite_sum->bool.
11571           (?d. d division_of s)
11572           ==> (!x. measurable {y | pastecart x y IN s}) /\
11573               ((\x. lift(measure {y | pastecart x y IN s}))
11574                has_integral lift(measure s)) UNIV`,
11575     let lemma = prove
11576      (`{x | f x IN UNIONS s} = UNIONS {{x | f x IN d} | d IN s}`,
11577       REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
11578     GEN_TAC THEN REWRITE_TAC[division_of; LEFT_IMP_EXISTS_THM] THEN
11579     X_GEN_TAC `d:(real^(M,N)finite_sum->bool)->bool` THEN
11580     STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma] THEN
11581     CONJ_TAC THENL
11582      [X_GEN_TAC `s:real^M` THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN
11583       ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
11584       X_GEN_TAC `k:real^(M,N)finite_sum->bool` THEN DISCH_TAC THEN
11585       SUBGOAL_THEN `?a b:real^(M,N)finite_sum. k = interval[a,b]`
11586       STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
11587       ASM_REWRITE_TAC[MEASURE_PASTECART_INTERVAL];
11588       ALL_TAC] THEN
11589     SUBGOAL_THEN
11590      `((\x. vsum d (\k. lift(measure {y | pastecart x y IN k}))) has_integral
11591        vsum d (\k:real^(M,N)finite_sum->bool. lift(measure k))) UNIV`
11592     MP_TAC THENL
11593      [MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN ASM_REWRITE_TAC[] THEN
11594       X_GEN_TAC `k:real^(M,N)finite_sum->bool` THEN DISCH_TAC THEN
11595       SUBGOAL_THEN `?a b:real^(M,N)finite_sum. k = interval[a,b]`
11596       STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
11597       ASM_REWRITE_TAC[MEASURE_PASTECART_INTERVAL];
11598       ALL_TAC] THEN
11599     MATCH_MP_TAC(MESON[HAS_INTEGRAL_SPIKE]
11600      `!t. negligible t /\ a = b /\ (!x. x IN s DIFF t ==> g x = f x)
11601           ==> (f has_integral a) s ==> (g has_integral b) s`) THEN
11602     EXISTS_TAC
11603      `UNIONS { {x | (x:real^M)$i =
11604                     fstcart(interval_lowerbound k:real^(M,N)finite_sum)$i} |
11605                i IN 1..dimindex(:M) /\ k IN d} UNION
11606       UNIONS { {x | x$i = fstcart(interval_upperbound k)$i} |
11607                i IN 1..dimindex(:M) /\ k IN d}` THEN
11608     CONJ_TAC THENL
11609      [REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN
11610       CONJ_TAC THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN
11611       ASM_SIMP_TAC[ONCE_REWRITE_RULE[CONJ_SYM] FINITE_PRODUCT_DEPENDENT;
11612                    FINITE_NUMSEG] THEN
11613       SIMP_TAC[FORALL_IN_GSPEC; NEGLIGIBLE_STANDARD_HYPERPLANE; IN_NUMSEG];
11614       REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN
11615     REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM LIFT_SUM); FUN_EQ_THM; LIFT_EQ] THEN
11616     CONJ_TAC THENL
11617      [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS;
11618       GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN
11619       MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE] THEN
11620     ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN
11621     (CONJ_TAC THENL
11622       [ASM_MESON_TAC[MEASURE_PASTECART_INTERVAL; MEASURABLE_INTERVAL];
11623        ALL_TAC]) THEN
11624     MAP_EVERY X_GEN_TAC
11625      [`k:real^(M,N)finite_sum->bool`; `l:real^(M,N)finite_sum->bool`] THEN
11626     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
11627      [`k:real^(M,N)finite_sum->bool`; `l:real^(M,N)finite_sum->bool`]) THEN
11628     ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN
11629     (SUBGOAL_THEN
11630       `?a b:real^(M,N)finite_sum c d:real^(M,N)finite_sum.
11631               k = interval[a,b] /\ l = interval[c,d]`
11632      MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
11633     SIMP_TAC[LEFT_IMP_EXISTS_THM; NEGLIGIBLE_CONVEX_INTERIOR;
11634              CONVEX_INTER; CONVEX_INTERVAL] THEN
11635     REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL;
11636                 PASTECART_IN_PCROSS] THEN
11637     ONCE_REWRITE_TAC[SET_RULE
11638      `{x | P /\ Q x} INTER {x | R /\ S x} =
11639       {x | P /\ R} INTER {x | Q x /\ S x}`] THEN
11640     REWRITE_TAC[INTER_PCROSS; INTERIOR_PCROSS; GSYM INTER] THEN
11641     REWRITE_TAC[SET_RULE `{x | P} = if P then UNIV else {}`] THEN
11642     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
11643     ONCE_REWRITE_TAC[COND_RAND] THEN
11644     REWRITE_TAC[NEGLIGIBLE_EMPTY; INTER_EMPTY; INTER_UNIV] THEN
11645     SIMP_TAC[NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_INTER; CONVEX_INTERVAL] THEN
11646     REWRITE_TAC[PCROSS_EQ_EMPTY; TAUT `(if p then q else T) <=> p ==> q`] THEN
11647     REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
11648     SIMP_TAC[] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
11649     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNION]) THEN
11650     REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN
11651     DISCH_THEN(CONJUNCTS_THEN(fun th ->
11652      MP_TAC(SPEC  `l:real^(M,N)finite_sum->bool` th) THEN
11653      MP_TAC(SPEC  `k:real^(M,N)finite_sum->bool` th))) THEN
11654     REWRITE_TAC[] THEN
11655     RULE_ASSUM_TAC(REWRITE_RULE[PCROSS_INTERVAL]) THEN
11656     REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN
11657     ASM_REWRITE_TAC[TAUT `~a \/ b <=> a ==> b`] THEN
11658     ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY;
11659                  FSTCART_PASTECART] THEN
11660     REPLICATE_TAC 3 (GEN_REWRITE_TAC I [IMP_IMP]) THEN
11661     MATCH_MP_TAC(TAUT `(a ==> c ==> ~b) ==> a ==> b ==> c ==> d`) THEN
11662     REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY; AND_FORALL_THM;
11663                 INTERIOR_INTERVAL; IMP_IMP; INTER_INTERVAL] THEN
11664     MATCH_MP_TAC MONO_FORALL THEN SIMP_TAC[LAMBDA_BETA] THEN
11665     GEN_TAC THEN ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
11666     ONCE_REWRITE_TAC[IMP_CONJ] THEN STRIP_TAC THEN
11667     ASM_REWRITE_TAC[IN_NUMSEG] THEN REAL_ARITH_TAC) in
11668   let MEASURE_PASTECART_OPEN_MEASURABLE = prove
11669    (`!s:real^(M,N)finite_sum->bool.
11670           open s /\ measurable s
11671           ==> negligible {x | ~measurable {y | pastecart x y IN s}} /\
11672               ((\x. lift(measure {y | pastecart x y IN s}))
11673                has_integral lift(measure s)) UNIV`,
11674     let lemur = prove
11675      (`UNIONS {{y | pastecart x y IN g n} | n IN (:num)} =
11676        {y | pastecart x y IN UNIONS {g n | n IN (:num)}}`,
11677       REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
11678     GEN_TAC THEN STRIP_TAC THEN
11679     FIRST_ASSUM(X_CHOOSE_THEN `g:num->real^(M,N)finite_sum->bool`
11680      STRIP_ASSUME_TAC o MATCH_MP OPEN_COUNTABLE_LIMIT_ELEMENTARY) THEN
11681     SUBGOAL_THEN `!n:num. g n SUBSET (s:real^(M,N)finite_sum->bool)`
11682     ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
11683     MP_TAC(ISPECL
11684      [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)})`;
11685       `(:real^M)`] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN
11686     MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->bool) n`
11687           MEASURE_PASTECART_ELEMENTARY)) THEN
11688     ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN
11689     STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LIFT_DROP] THEN
11690     ANTS_TAC THENL
11691      [CONJ_TAC THENL
11692        [REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11693         REPEAT(CONJ_TAC THENL
11694          [ASM_MESON_TAC[MEASURE_PASTECART_ELEMENTARY]; ALL_TAC]) THEN
11695         ASM SET_TAC[];
11696         REWRITE_TAC[bounded; FORALL_IN_GSPEC; NORM_LIFT] THEN
11697         EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN
11698         GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
11699          `&0 <= x /\ x <= y ==> abs x <= y`) THEN
11700         CONJ_TAC THENL
11701          [MATCH_MP_TAC MEASURE_POS_LE;
11702           MATCH_MP_TAC MEASURE_SUBSET] THEN
11703         ASM_MESON_TAC[MEASURABLE_ELEMENTARY]];
11704       REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
11705     MAP_EVERY X_GEN_TAC [`f:real^M->real^1`; `t:real^M->bool`] THEN
11706     STRIP_TAC THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
11707     SUBGOAL_THEN
11708      `!x:real^M.
11709          ~(x IN t) ==> {y:real^N | pastecart x y IN s} has_measure drop(f x)`
11710     ASSUME_TAC THENL
11711      [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11712       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
11713       DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
11714       REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV; NORM_LIFT] THEN
11715       DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL
11716        [`\n. {y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) n}`;
11717         `B:real`]
11718        HAS_MEASURE_NESTED_UNIONS) THEN
11719       ASM_SIMP_TAC[lemur; REAL_ARITH `abs x <= B ==> x <= B`] THEN
11720       ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
11721       ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; GSYM LIFT_EQ] THEN
11722       ASM_MESON_TAC[LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP];
11723       CONJ_TAC THENL
11724        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11725           NEGLIGIBLE_SUBSET)) THEN
11726         REWRITE_TAC[measurable] THEN ASM SET_TAC[];
11727         MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
11728         MAP_EVERY EXISTS_TAC [`f:real^M->real^1`; `t:real^M->bool`] THEN
11729         ASM_REWRITE_TAC[NEGLIGIBLE; IN_DIFF; IN_UNIV] THEN
11730         REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN
11731         CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN
11732         ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
11733         MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC
11734           `\k. lift(measure ((g:num->real^(M,N)finite_sum->bool) k))` THEN
11735         ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
11736         MP_TAC(ISPECL [`g:num->real^(M,N)finite_sum->bool`;
11737                        `measure(s:real^(M,N)finite_sum->bool)`]
11738                   HAS_MEASURE_NESTED_UNIONS) THEN
11739         ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
11740         ASM_MESON_TAC[MEASURABLE_ELEMENTARY; MEASURE_SUBSET]]]) in
11741   let MEASURE_PASTECART_COMPACT = prove
11742    (`!s:real^(M,N)finite_sum->bool.
11743           compact s
11744           ==> (!x. measurable {y | pastecart x y IN s}) /\
11745               ((\x. lift(measure {y | pastecart x y IN s}))
11746                has_integral lift(measure s)) UNIV`,
11747     GEN_TAC THEN DISCH_TAC THEN
11748     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
11749      [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN
11750       REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
11751        [FIRST_X_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
11752         REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC] THEN
11753         MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS];
11754         MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
11755         ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CONTINUOUS_PASTECART;
11756                      CONTINUOUS_CONST; CONTINUOUS_AT_ID]];
11757       DISCH_TAC] THEN
11758     SUBGOAL_THEN
11759      `?t:real^(M,N)finite_sum->bool.
11760           open t /\ measurable t /\ s SUBSET t`
11761     STRIP_ASSUME_TAC THENL
11762      [ASM_MESON_TAC[BOUNDED_SUBSET_BALL; COMPACT_IMP_BOUNDED;
11763                     MEASURABLE_BALL; OPEN_BALL];
11764       ALL_TAC] THEN
11765     MP_TAC(ISPEC `t:real^(M,N)finite_sum->bool`
11766       MEASURE_PASTECART_OPEN_MEASURABLE) THEN
11767     MP_TAC(ISPEC `t DIFF s:real^(M,N)finite_sum->bool`
11768       MEASURE_PASTECART_OPEN_MEASURABLE) THEN
11769     ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_COMPACT; OPEN_DIFF;
11770                  COMPACT_IMP_CLOSED; MEASURE_DIFF_SUBSET; IMP_IMP] THEN
11771     DISCH_THEN(CONJUNCTS_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11772     REWRITE_TAC[LIFT_SUB; IMP_IMP] THEN
11773     DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN
11774     REWRITE_TAC[VECTOR_ARITH `t - (t - s):real^1 = s`] THEN
11775     MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC]
11776           HAS_INTEGRAL_SPIKE)) THEN
11777     EXISTS_TAC
11778      `{x | ~measurable {y | pastecart x y IN t DIFF s}} UNION
11779       {x:real^M | ~measurable {y:real^N | pastecart x y IN t}}` THEN
11780     ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNIV] THEN
11781     X_GEN_TAC `x:real^M` THEN
11782     SIMP_TAC[IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN
11783     STRIP_TAC THEN REWRITE_TAC[LIFT_EQ; GSYM LIFT_SUB] THEN
11784     ONCE_REWRITE_TAC[REAL_ARITH `a:real = b - c <=> c = b - a`] THEN
11785     REWRITE_TAC[SET_RULE
11786      `{y | pastecart x y IN t /\ ~(pastecart x y IN s)} =
11787       {y | pastecart x y IN t} DIFF {y | pastecart x y IN s}`] THEN
11788     MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM SET_TAC[]) in
11789   GEN_TAC THEN DISCH_TAC THEN
11790   SUBGOAL_THEN
11791    `?f. (!n. compact(f n) /\ f n SUBSET s /\ measurable(f n) /\
11792              measure s < measure(f n) + inv(&n + &1)) /\
11793         (!n. (f:num->real^(M,N)finite_sum->bool) n SUBSET f(SUC n))`
11794   STRIP_ASSUME_TAC THENL
11795    [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
11796      [MATCH_MP_TAC MEASURABLE_INNER_COMPACT THEN
11797       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[];
11798       ALL_TAC] THEN
11799     MAP_EVERY X_GEN_TAC [`n:num`; `t:real^(M,N)finite_sum->bool`] THEN
11800     STRIP_TAC THEN
11801     MP_TAC(ISPECL [`s:real^(M,N)finite_sum->bool`; `inv(&(SUC n) + &1)`]
11802         MEASURABLE_INNER_COMPACT) THEN
11803     ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
11804     DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool`
11805         STRIP_ASSUME_TAC) THEN
11806     EXISTS_TAC `t UNION u:real^(M,N)finite_sum->bool` THEN
11807     ASM_SIMP_TAC[COMPACT_UNION; UNION_SUBSET; MEASURABLE_UNION] THEN
11808     REWRITE_TAC[SUBSET_UNION] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
11809      (REAL_ARITH `s < a + e ==> a <= b ==> s < b + e`)) THEN
11810     MATCH_MP_TAC MEASURE_SUBSET THEN
11811     ASM_SIMP_TAC[MEASURABLE_UNION; SUBSET_UNION];
11812     ALL_TAC] THEN
11813   SUBGOAL_THEN
11814    `?g. (!n. open(g n) /\ s SUBSET g n /\ measurable(g n) /\
11815              measure(g n) < measure s + inv(&n + &1)) /\
11816         (!n. (g:num->real^(M,N)finite_sum->bool) (SUC n) SUBSET g n)`
11817   STRIP_ASSUME_TAC THENL
11818    [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL
11819      [MATCH_MP_TAC MEASURABLE_OUTER_OPEN THEN
11820       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[];
11821       ALL_TAC] THEN
11822     MAP_EVERY X_GEN_TAC [`n:num`; `t:real^(M,N)finite_sum->bool`] THEN
11823     STRIP_TAC THEN
11824     MP_TAC(ISPECL [`s:real^(M,N)finite_sum->bool`; `inv(&(SUC n) + &1)`]
11825         MEASURABLE_OUTER_OPEN) THEN
11826     ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
11827     DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool`
11828         STRIP_ASSUME_TAC) THEN
11829     EXISTS_TAC `t INTER u:real^(M,N)finite_sum->bool` THEN
11830     ASM_SIMP_TAC[OPEN_INTER; SUBSET_INTER; MEASURABLE_INTER] THEN
11831     REWRITE_TAC[INTER_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
11832      (REAL_ARITH `a < s + e ==> b <= a ==> b < s + e`)) THEN
11833     MATCH_MP_TAC MEASURE_SUBSET THEN
11834     ASM_SIMP_TAC[MEASURABLE_INTER; INTER_SUBSET];
11835     ALL_TAC] THEN
11836   MP_TAC(ISPECL
11837    [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)}) -
11838                       lift(measure {y:real^N | pastecart x y IN (f n)})`;
11839     `(:real^M)`] BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE) THEN
11840   MP_TAC(GEN `n:num` (ISPEC `(f:num->real^(M,N)finite_sum->bool) n`
11841         MEASURE_PASTECART_COMPACT)) THEN
11842   MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->bool) n`
11843         MEASURE_PASTECART_OPEN_MEASURABLE)) THEN
11844   ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN
11845   STRIP_TAC THEN STRIP_TAC THEN
11846   ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; DROP_SUB; LIFT_DROP] THEN
11847   ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRAL_SUB] THEN ANTS_TAC THENL
11848    [CONJ_TAC THENL
11849      [X_GEN_TAC `n:num` THEN EXISTS_TAC
11850        `{x:real^M | ~measurable {y:real^N | pastecart x y IN g n}} UNION
11851         {x:real^M | ~measurable {y | pastecart x y IN g (SUC n)}}` THEN
11852       ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_UNION; DE_MORGAN_THM] THEN
11853       X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
11854       MATCH_MP_TAC(REAL_ARITH `f <= f' /\ g' <= g ==> g' - f' <= g - f`) THEN
11855       CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11856       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
11857       REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
11858       EXISTS_TAC `measure((g:num->real^(M,N)finite_sum->bool) 0) -
11859                   measure((f:num->real^(M,N)finite_sum->bool) 0)` THEN
11860       X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
11861       MATCH_MP_TAC(REAL_ARITH
11862        `!s. f' <= s /\ s <= g' /\ f <= f' /\ g' <= g
11863             ==> abs(g' - f') <= g - f`) THEN
11864       EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN
11865       REPEAT CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11866       ASM_REWRITE_TAC[] THEN MP_TAC(ARITH_RULE `0 <= n`) THEN
11867       SPEC_TAC(`n:num`,`n:num`) THEN SPEC_TAC(`0`,`m:num`) THEN
11868       MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
11869       SET_TAC[]];
11870     REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
11871   MAP_EVERY X_GEN_TAC [`h:real^M->real^1`; `k:real^M->bool`] THEN
11872   STRIP_TAC THEN
11873   SUBGOAL_THEN
11874    `?t. negligible t /\
11875         (!n x. ~(x IN t) ==> measurable {y:real^N | pastecart x y IN g n}) /\
11876         (!x. ~(x IN t)
11877              ==> ((\k. lift(measure {y | pastecart x y IN g k}) -
11878                   lift(measure {y:real^N | pastecart x y IN f k})) --> vec 0)
11879                   sequentially) /\
11880         (!x. ~(x IN t) ==> (h:real^M->real^1) x = vec 0)`
11881   MP_TAC THENL
11882    [MP_TAC(ISPECL
11883      [`\x. if x IN UNIONS{ {x | ~measurable {y:real^N | pastecart x y IN g n}}
11884                            |  n IN (:num)} UNION k
11885            then vec 0 else (h:real^M->real^1) x`; `(:real^M)`]
11886      HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN
11887     REWRITE_TAC[IN_UNIV; DIMINDEX_1; FORALL_1] THEN ANTS_TAC THENL
11888      [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN
11889       COND_CASES_TAC THEN REWRITE_TAC[VEC_COMPONENT; REAL_LE_REFL] THEN
11890       FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN
11891       MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_LBOUND) THEN
11892       EXISTS_TAC
11893        `\k:num. lift(measure {y | pastecart x y IN
11894                                   (g:num->real^(M,N)finite_sum->bool) k}) -
11895                 lift(measure {y | pastecart x y IN
11896                                   (f:num->real^(M,N)finite_sum->bool) k})` THEN
11897       REWRITE_TAC[DIMINDEX_1; TRIVIAL_LIMIT_SEQUENTIALLY; LE_REFL] THEN
11898       ASM_SIMP_TAC[] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN
11899       X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP] THEN
11900       REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11901       ASM_REWRITE_TAC[] THEN
11902       RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_GSPEC]) THEN ASM SET_TAC[];
11903       ALL_TAC] THEN
11904     DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL
11905      [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
11906       EXISTS_TAC `h:real^M->real^1` THEN
11907       EXISTS_TAC `UNIONS{ {x | ~measurable {y | pastecart x y IN
11908                                  (g:num->real^(M,N)finite_sum->bool) n}}
11909                            |  n IN (:num)} UNION k` THEN
11910       ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNION; IN_UNIV] THEN
11911       REPEAT CONJ_TAC THENL
11912        [MATCH_MP_TAC(REWRITE_RULE[IN_UNIV] NEGLIGIBLE_COUNTABLE_UNIONS) THEN
11913         ASM_REWRITE_TAC[];
11914         MESON_TAC[];
11915         ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
11916         MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC
11917          `\k. lift(measure((g:num->real^(M,N)finite_sum->bool) k)) -
11918               lift(measure((f:num->real^(M,N)finite_sum->bool) k))` THEN
11919         ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
11920         REWRITE_TAC[LIM_SEQUENTIALLY; GSYM LIFT_SUB; DIST_0; NORM_LIFT] THEN
11921         X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11922         MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN
11923         ASM_REWRITE_TAC[REAL_HALF] THEN
11924         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
11925         X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
11926          `!s d. f <= s /\ s <= g /\ s < f + d /\ g < s + d /\ d <= e / &2
11927                 ==> abs(g - f) < e`) THEN
11928         EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN
11929         EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN
11930         CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_SUBSET]; ALL_TAC] THEN
11931         TRANS_TAC REAL_LE_TRANS `inv(&N)` THEN
11932         ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
11933         REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN
11934         ASM_ARITH_TAC];
11935       DISCH_TAC THEN EXISTS_TAC
11936        `{x | ~((if x IN
11937          UNIONS {{x | ~measurable {y | pastecart x y IN g n}} | n | T} UNION k
11938                 then vec 0 else (h:real^M->real^1) x) = vec 0)} UNION
11939         UNIONS {{x | ~measurable {y | pastecart x y IN
11940                      (g:num->real^(M,N)finite_sum->bool) n}} | n | T} UNION
11941         k` THEN
11942       ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN
11943       ASM_SIMP_TAC[IN_UNION; DE_MORGAN_THM] THEN CONJ_TAC THENL
11944        [MATCH_MP_TAC(REWRITE_RULE[IN_UNIV] NEGLIGIBLE_COUNTABLE_UNIONS) THEN
11945         ASM_REWRITE_TAC[];
11946         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
11947         REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]];
11948     FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`) THEN STRIP_TAC] THEN
11949   SUBGOAL_THEN
11950    `!x:real^M. ~(x IN t) ==> measurable {y:real^N | pastecart x y IN s}`
11951   ASSUME_TAC THENL
11952    [REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN
11953     ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
11954     X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th ->
11955       MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN
11956       GEN_REWRITE_TAC LAND_CONV [LIM_SEQUENTIALLY]) THEN
11957     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[DIST_0] THEN
11958     DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN
11959     REWRITE_TAC[LE_REFL; GSYM LIFT_SUB; NORM_LIFT] THEN DISCH_TAC THEN
11960     MAP_EVERY EXISTS_TAC
11961      [`{y | pastecart x y IN (f:num->real^(M,N)finite_sum->bool) N}`;
11962       `{y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) N}`] THEN
11963     ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
11964     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
11965     ALL_TAC] THEN
11966   CONJ_TAC THENL
11967    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real^M->bool` THEN
11968     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
11969     ALL_TAC] THEN
11970   MP_TAC(ISPECL
11971    [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)})`;
11972     `\x:real^M. lift(measure {y:real^N | pastecart x y IN s})`;
11973     `(:real^M)`; `t:real^M->bool`] MONOTONE_CONVERGENCE_DECREASING_AE) THEN
11974   ASM_REWRITE_TAC[LIFT_DROP; IN_UNIV; IN_DIFF] THEN ANTS_TAC THENL
11975    [REPEAT CONJ_TAC THENL
11976      [REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11977       ASM_SIMP_TAC[IN_DIFF] THEN ASM SET_TAC[];
11978       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11979       REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11980       FIRST_X_ASSUM(fun th ->
11981         MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN
11982         GEN_REWRITE_TAC LAND_CONV [LIM_SEQUENTIALLY]) THEN
11983       DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[DIST_0] THEN
11984       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
11985       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
11986       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[DIST_LIFT; GSYM dist] THEN
11987       MATCH_MP_TAC(REAL_ARITH
11988        `f <= s /\ s <= g ==> abs(g - f) < e ==> abs(g - s) < e`) THEN
11989       CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11990       ASM_SIMP_TAC[IN_DIFF] THEN ASM SET_TAC[];
11991       REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
11992       EXISTS_TAC `measure((g:num->real^(M,N)finite_sum->bool) 0)` THEN
11993       ASM_SIMP_TAC[NORM_LIFT; real_abs; MEASURE_POS_LE] THEN
11994       X_GEN_TAC `m:num` THEN MP_TAC(ARITH_RULE `0 <= m`) THEN
11995       SPEC_TAC(`m:num`,`m:num`) THEN SPEC_TAC(`0`,`n:num`) THEN
11996       MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
11997       REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN
11998       GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
11999       ASM_SIMP_TAC[]];
12000     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
12001     MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
12002     EXISTS_TAC `\k. lift(measure((g:num->real^(M,N)finite_sum->bool) k))` THEN
12003     ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
12004     REWRITE_TAC[LIM_SEQUENTIALLY; DIST_LIFT] THEN
12005     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
12006     MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN
12007     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
12008     X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
12009      `!d. g < s + d /\ s <= g /\ d < e ==> abs(g - s) < e`) THEN
12010     EXISTS_TAC `inv(&n + &1)` THEN ASM_SIMP_TAC[MEASURE_SUBSET] THEN
12011     TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN
12012     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
12013     REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN
12014     ASM_ARITH_TAC]);;
12015
12016 let FUBINI_MEASURE_ALT = prove
12017  (`!s:real^(M,N)finite_sum->bool.
12018         measurable s
12019         ==> negligible {y | ~measurable {x | pastecart x y IN s}} /\
12020             ((\y. lift(measure {x | pastecart x y IN s}))
12021              has_integral lift(measure s)) UNIV`,
12022   GEN_TAC THEN DISCH_TAC THEN
12023   MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z))
12024                       (s:real^(M,N)finite_sum->bool)`
12025         FUBINI_MEASURE) THEN
12026   MP_TAC(ISPEC
12027    `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)`
12028    HAS_MEASURE_ISOMETRY) THEN
12029   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL
12030    [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN
12031     SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN
12032     SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN
12033     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC];
12034     DISCH_TAC THEN ASM_REWRITE_TAC[measurable; measure] THEN
12035     ASM_REWRITE_TAC[GSYM measurable; GSYM measure] THEN
12036     REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART;
12037                 SNDCART_PASTECART; PASTECART_INJ] THEN
12038     REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);;
12039
12040 let FUBINI_LEBESGUE_MEASURABLE = prove
12041  (`!s:real^(M,N)finite_sum->bool.
12042         lebesgue_measurable s
12043         ==> negligible {x | ~lebesgue_measurable {y | pastecart x y IN s}}`,
12044   let lemma = prove
12045    (`{x | ?n. P n x} = UNIONS {{x | P n x} | n IN (:num)}`,
12046     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
12047   REPEAT STRIP_TAC THEN
12048   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_COUNTABLE_INTERVALS] THEN
12049   X_GEN_TAC `m:num` THEN
12050   REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN
12051   REWRITE_TAC[INTER; IN_ELIM_THM; NOT_FORALL_THM; LEFT_AND_EXISTS_THM] THEN
12052   REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN
12053   X_GEN_TAC `n:num` THEN
12054   MP_TAC(ISPEC `(s:real^(M,N)finite_sum->bool) INTER
12055                 (interval[--vec m,vec m] PCROSS interval[--vec n,vec n])`
12056         FUBINI_MEASURE) THEN
12057   ANTS_TAC THENL
12058    [REWRITE_TAC[PCROSS_INTERVAL] THEN
12059     ASM_MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS];
12060     DISCH_THEN(MP_TAC o CONJUNCT1)] THEN
12061   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
12062   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
12063   X_GEN_TAC `x:real^M` THEN
12064   REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN
12065   ASM_CASES_TAC `(x:real^M) IN interval[--vec m,vec m]` THEN
12066   ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);;
12067
12068 let FUBINI_LEBESGUE_MEASURABLE_ALT = prove
12069  (`!s:real^(M,N)finite_sum->bool.
12070         lebesgue_measurable s
12071         ==> negligible {y | ~lebesgue_measurable {x | pastecart x y IN s}}`,
12072   let lemma = prove
12073    (`{x | ?n. P n x} = UNIONS {{x | P n x} | n IN (:num)}`,
12074     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
12075   REPEAT STRIP_TAC THEN
12076   ONCE_REWRITE_TAC[NEGLIGIBLE_ON_COUNTABLE_INTERVALS] THEN
12077   X_GEN_TAC `n:num` THEN
12078   REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN
12079   REWRITE_TAC[INTER; IN_ELIM_THM; NOT_FORALL_THM; LEFT_AND_EXISTS_THM] THEN
12080   REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN
12081   X_GEN_TAC `m:num` THEN
12082   MP_TAC(ISPEC `(s:real^(M,N)finite_sum->bool) INTER
12083                 (interval[--vec m,vec m] PCROSS interval[--vec n,vec n])`
12084         FUBINI_MEASURE_ALT) THEN
12085   ANTS_TAC THENL
12086    [REWRITE_TAC[PCROSS_INTERVAL] THEN
12087     ASM_MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS];
12088     DISCH_THEN(MP_TAC o CONJUNCT1)] THEN
12089   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
12090   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
12091   X_GEN_TAC `y:real^N` THEN
12092   REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN
12093   ASM_CASES_TAC `(y:real^N) IN interval[--vec n,vec n]` THEN
12094   ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);;
12095
12096 let FUBINI_NEGLIGIBLE = prove
12097  (`!s. negligible s
12098        ==> negligible
12099             {x:real^M | ~negligible {y:real^N | pastecart x y IN s}}`,
12100   REPEAT STRIP_TAC THEN
12101   FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE o MATCH_MP
12102     NEGLIGIBLE_IMP_MEASURABLE) THEN
12103   ASM_SIMP_TAC[MEASURE_EQ_0; LIFT_NUM; IMP_CONJ] THEN DISCH_TAC THEN
12104   MP_TAC(ISPECL
12105    [`\x:real^M. lift (measure {y:real^N | pastecart x y IN s})`;
12106     `(:real^M)`;
12107     `{x:real^M | ~measurable {y:real^N | pastecart x y IN s}}`]
12108    HAS_INTEGRAL_NEGLIGIBLE_EQ_AE) THEN
12109   ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN
12110   SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP; IN_UNIV] THEN
12111   ASM_SIMP_TAC[MEASURE_POS_LE; IMP_CONJ] THEN DISCH_THEN(K ALL_TAC) THEN
12112   UNDISCH_TAC
12113    `negligible {x:real^M | ~measurable {y:real^N | pastecart x y IN s}}` THEN
12114   REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN
12115   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
12116   REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; GSYM DROP_EQ] THEN
12117   REWRITE_TAC[LIFT_DROP; DROP_VEC] THEN
12118   REWRITE_TAC[HAS_MEASURE_MEASURE; GSYM HAS_MEASURE_0] THEN
12119   SET_TAC[]);;
12120
12121 let FUBINI_NEGLIGIBLE_ALT = prove
12122  (`!s. negligible s
12123        ==> negligible
12124             {y:real^N | ~negligible {x:real^M | pastecart x y IN s}}`,
12125   let lemma = prove
12126    (`!s:real^(M,N)finite_sum->bool.
12127         negligible s
12128          ==> negligible (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s)`,
12129     REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_GEN THEN
12130     ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM; LE_REFL] THEN
12131     REWRITE_TAC[linear; FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART;
12132                 FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL;
12133                 GSYM PASTECART_ADD; GSYM PASTECART_CMUL]) in
12134   GEN_TAC THEN
12135   DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
12136   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_NEGLIGIBLE) THEN
12137   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
12138   REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ;
12139                 FSTCART_PASTECART; SNDCART_PASTECART] THEN
12140   REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN
12141   REWRITE_TAC[UNWIND_THM1; UNWIND_THM2]);;
12142
12143 let NEGLIGIBLE_PCROSS = prove
12144  (`!s:real^M->bool t:real^N->bool.
12145         negligible(s PCROSS t) <=> negligible s \/ negligible t`,
12146   REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
12147    [FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_NEGLIGIBLE) THEN
12148     REWRITE_TAC[PASTECART_IN_PCROSS] THEN
12149     REWRITE_TAC[SET_RULE `{y | P /\ Q y} = if P then {y | Q y} else {}`] THEN
12150     ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN
12151     ASM_CASES_TAC `negligible(t:real^N->bool)` THEN
12152     ASM_REWRITE_TAC[SET_RULE `~(if P then F else T) = P`;
12153                     SET_RULE `{x | x IN s} = s`];
12154     ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
12155     REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; INTER_PCROSS] THEN
12156     MAP_EVERY X_GEN_TAC [`aa:real^M`; `a:real^N`; `bb:real^M`; `b:real^N`] THEN
12157     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
12158     EXISTS_TAC `(s:real^M->bool) PCROSS interval[a:real^N,b]` THEN
12159     REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN
12160     REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
12161     X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL
12162      [`s:real^M->bool`; `e / (content(interval[a:real^N,b]) + &1)`]
12163      MEASURABLE_OUTER_CLOSED_INTERVALS) THEN
12164     ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_LT_DIV; CONTENT_POS_LE;
12165       MEASURE_EQ_0; REAL_ADD_LID; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN
12166     DISCH_THEN(X_CHOOSE_THEN `d:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
12167     EXISTS_TAC `UNIONS { (k:real^M->bool) PCROSS interval[a:real^N,b] |
12168                          k IN d}` THEN
12169     ASM_REWRITE_TAC[GSYM PCROSS_UNIONS; SUBSET_PCROSS; SUBSET_REFL] THEN
12170     REWRITE_TAC[PCROSS_UNIONS] THEN
12171     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
12172     ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
12173     CONJ_TAC THENL
12174      [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL]; ALL_TAC] THEN
12175     ONCE_REWRITE_TAC[CONJ_SYM] THEN
12176     REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
12177     X_GEN_TAC `D:(real^M->bool)->bool` THEN STRIP_TAC THEN
12178     W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o
12179       lhand o snd) THEN
12180     ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
12181      [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL; SUBSET];
12182       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN
12183     TRANS_TAC REAL_LE_TRANS
12184      `sum D (\k:real^M->bool. measure k * content(interval[a:real^N,b]))` THEN
12185     CONJ_TAC THENL
12186      [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN
12187       X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN
12188       SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` STRIP_ASSUME_TAC THENL
12189        [ASM_MESON_TAC[SUBSET]; ASM_REWRITE_TAC[]] THEN
12190       ASM_REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART];
12191       REWRITE_TAC[SUM_RMUL]] THEN
12192     MATCH_MP_TAC(REAL_ARITH
12193      `&0 <= x /\ x * (y + &1) <= e ==> x * y <= e`) THEN
12194     CONJ_TAC THENL
12195      [MATCH_MP_TAC SUM_POS_LE THEN
12196       ASM_MESON_TAC[MEASURE_POS_LE; SUBSET; MEASURABLE_INTERVAL];
12197       SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < x + &1`;
12198                CONTENT_POS_LE]] THEN
12199     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
12200      (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN
12201     TRANS_TAC REAL_LE_TRANS `measure(UNIONS D:real^M->bool)` THEN
12202     CONJ_TAC THENL
12203      [MATCH_MP_TAC REAL_EQ_IMP_LE;
12204       MATCH_MP_TAC MEASURE_SUBSET THEN
12205       ASM_SIMP_TAC[SUBSET_UNIONS] THEN
12206       ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_INTERVAL; SUBSET]] THEN
12207     TRANS_TAC EQ_TRANS `sum (D:(real^M->bool)->bool) content` THEN
12208     CONJ_TAC THENL
12209      [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET];
12210       CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN
12211       REWRITE_TAC[division_of] THEN ASM SET_TAC[]];
12212     ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
12213     REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; INTER_PCROSS] THEN
12214     MAP_EVERY X_GEN_TAC [`a:real^M`; `aa:real^N`; `b:real^M`; `bb:real^N`] THEN
12215     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
12216     EXISTS_TAC `interval[a:real^M,b] PCROSS (t:real^N->bool)` THEN
12217     REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN
12218     REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN
12219     X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL
12220      [`t:real^N->bool`; `e / (content(interval[a:real^M,b]) + &1)`]
12221      MEASURABLE_OUTER_CLOSED_INTERVALS) THEN
12222     ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_LT_DIV; CONTENT_POS_LE;
12223       MEASURE_EQ_0; REAL_ADD_LID; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN
12224     DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
12225     EXISTS_TAC `UNIONS { interval[a:real^M,b] PCROSS (k:real^N->bool) |
12226                          k IN d}` THEN
12227     ASM_REWRITE_TAC[GSYM PCROSS_UNIONS; SUBSET_PCROSS; SUBSET_REFL] THEN
12228     REWRITE_TAC[PCROSS_UNIONS] THEN
12229     MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN
12230     ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
12231     CONJ_TAC THENL
12232      [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL]; ALL_TAC] THEN
12233     ONCE_REWRITE_TAC[CONJ_SYM] THEN
12234     REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
12235     X_GEN_TAC `D:(real^N->bool)->bool` THEN STRIP_TAC THEN
12236     W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o
12237       lhand o snd) THEN
12238     ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
12239      [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL; SUBSET];
12240       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN
12241     TRANS_TAC REAL_LE_TRANS
12242      `sum D (\k:real^N->bool. content(interval[a:real^M,b]) * measure k)` THEN
12243     CONJ_TAC THENL
12244      [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN
12245       X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
12246       SUBGOAL_THEN `?u v:real^N. k = interval[u,v]` STRIP_ASSUME_TAC THENL
12247        [ASM_MESON_TAC[SUBSET]; ASM_REWRITE_TAC[]] THEN
12248       ASM_REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART];
12249       REWRITE_TAC[SUM_LMUL]] THEN
12250     MATCH_MP_TAC(REAL_ARITH
12251      `&0 <= x /\ x * (y + &1) <= e ==> y * x <= e`) THEN
12252     CONJ_TAC THENL
12253      [MATCH_MP_TAC SUM_POS_LE THEN
12254       ASM_MESON_TAC[MEASURE_POS_LE; SUBSET; MEASURABLE_INTERVAL];
12255       SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < x + &1`;
12256                CONTENT_POS_LE]] THEN
12257     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
12258      (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN
12259     TRANS_TAC REAL_LE_TRANS `measure(UNIONS D:real^N->bool)` THEN
12260     CONJ_TAC THENL
12261      [MATCH_MP_TAC REAL_EQ_IMP_LE;
12262       MATCH_MP_TAC MEASURE_SUBSET THEN
12263       ASM_SIMP_TAC[SUBSET_UNIONS] THEN
12264       ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_INTERVAL; SUBSET]] THEN
12265     TRANS_TAC EQ_TRANS `sum (D:(real^N->bool)->bool) content` THEN
12266     CONJ_TAC THENL
12267      [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET];
12268       CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN
12269       REWRITE_TAC[division_of] THEN ASM SET_TAC[]]]);;
12270
12271 let FUBINI_TONELLI_MEASURE = prove
12272  (`!s:real^(M,N)finite_sum->bool.
12273         lebesgue_measurable s
12274         ==> (measurable s <=>
12275              negligible {x | ~measurable {y | pastecart x y IN s}} /\
12276              (\x. lift(measure {y | pastecart x y IN s})) integrable_on UNIV)`,
12277   REPEAT STRIP_TAC THEN EQ_TAC THENL
12278    [ASM_MESON_TAC[FUBINI_MEASURE; integrable_on]; STRIP_TAC] THEN
12279   MP_TAC(ISPECL
12280    [`\n. s INTER ball(vec 0:real^(M,N)finite_sum,&n)`;
12281     `drop(integral (:real^M)
12282        (\x. lift (measure {y:real^N | pastecart x y IN s})))`]
12283        MEASURABLE_NESTED_UNIONS) THEN
12284   ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE;
12285                MEASURABLE_BALL; GSYM REAL_OF_NUM_SUC; SUBSET_BALL;
12286                REAL_ARITH `x <= x + &1`;
12287                SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN
12288   ANTS_TAC THENL
12289    [X_GEN_TAC `n:num` THEN
12290     MP_TAC(SPEC `s INTER ball(vec 0:real^(M,N)finite_sum,&n)`
12291         FUBINI_MEASURE) THEN
12292     ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE;
12293                  MEASURABLE_BALL; HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
12294     REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN STRIP_TAC THEN
12295     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN
12296     ASM_REWRITE_TAC[] THEN
12297     EXISTS_TAC `{x:real^M | ~measurable {y:real^N | pastecart x y IN s}} UNION
12298                 {x:real^M | ~measurable {y:real^N | pastecart x y IN s INTER
12299                                                     ball (vec 0,&n)}}` THEN
12300     ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNIV; DE_MORGAN_THM;
12301                     IN_UNION; IN_ELIM_THM; LIFT_DROP] THEN
12302     REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
12303     ASM_REWRITE_TAC[] THEN SET_TAC[];
12304     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
12305     REWRITE_TAC[UNIONS_GSPEC; IN_INTER; IN_BALL_0; IN_UNIV] THEN
12306     REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[REAL_ARCH_LT]]);;
12307
12308 let FUBINI_TONELLI_MEASURE_ALT = prove
12309  (`!s:real^(M,N)finite_sum->bool.
12310         lebesgue_measurable s
12311         ==> (measurable s <=>
12312              negligible {y | ~measurable {x | pastecart x y IN s}} /\
12313              (\y. lift(measure {x | pastecart x y IN s})) integrable_on UNIV)`,
12314   GEN_TAC THEN DISCH_TAC THEN
12315   MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z))
12316                       (s:real^(M,N)finite_sum->bool)`
12317         FUBINI_TONELLI_MEASURE) THEN
12318   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LINEAR_PASTECART;
12319                LINEAR_FSTCART; LINEAR_SNDCART; DIMINDEX_FINITE_SUM;
12320                ARITH_RULE `m + n:num <= n + m`] THEN
12321   MP_TAC(ISPEC
12322    `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)`
12323    HAS_MEASURE_ISOMETRY) THEN
12324   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL
12325    [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN
12326     SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN
12327     SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN
12328     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC];
12329     DISCH_TAC THEN ASM_REWRITE_TAC[measurable; measure] THEN
12330     ASM_REWRITE_TAC[GSYM measurable; GSYM measure] THEN
12331     REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART;
12332                 SNDCART_PASTECART; PASTECART_INJ] THEN
12333     REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);;
12334
12335 let FUBINI_TONELLI_NEGLIGIBLE = prove
12336  (`!s:real^(M,N)finite_sum->bool.
12337         lebesgue_measurable s
12338         ==> (negligible s <=>
12339              negligible {x | ~negligible {y | pastecart x y IN s}})`,
12340   REPEAT STRIP_TAC THEN EQ_TAC THEN
12341   ASM_SIMP_TAC[FUBINI_NEGLIGIBLE] THEN DISCH_TAC THEN
12342   REWRITE_TAC[NEGLIGIBLE_EQ_MEASURE_0] THEN
12343   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
12344    [ASM_SIMP_TAC[FUBINI_TONELLI_MEASURE] THEN CONJ_TAC THENL
12345      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12346         NEGLIGIBLE_SUBSET)) THEN
12347       REWRITE_TAC[SUBSET; IN_ELIM_THM; CONTRAPOS_THM;
12348                   NEGLIGIBLE_IMP_MEASURABLE];
12349       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE)];
12350     DISCH_TAC THEN
12351     REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
12352     FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FUBINI_MEASURE) THEN
12353     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12354           HAS_INTEGRAL_UNIQUE)) THEN
12355     MATCH_MP_TAC HAS_INTEGRAL_SPIKE] THEN
12356   EXISTS_TAC `(\x. vec 0):real^M->real^1` THEN
12357   EXISTS_TAC
12358    `{x:real^M | ~negligible {y:real^N | pastecart x y IN s}}` THEN
12359    ASM_REWRITE_TAC[INTEGRABLE_0; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
12360   SIMP_TAC[MEASURE_EQ_0; GSYM DROP_EQ; DROP_VEC; LIFT_DROP; HAS_INTEGRAL_0]);;
12361
12362 let FUBINI_TONELLI_NEGLIGIBLE_ALT = prove
12363  (`!s:real^(M,N)finite_sum->bool.
12364         lebesgue_measurable s
12365         ==> (negligible s <=>
12366              negligible {y | ~negligible {x | pastecart x y IN s}})`,
12367   GEN_TAC THEN DISCH_TAC THEN
12368   MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z))
12369                       (s:real^(M,N)finite_sum->bool)`
12370         FUBINI_TONELLI_NEGLIGIBLE) THEN
12371   ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LINEAR_PASTECART;
12372                LINEAR_FSTCART; LINEAR_SNDCART; DIMINDEX_FINITE_SUM;
12373                ARITH_RULE `m + n:num <= n + m`] THEN
12374   MP_TAC(ISPEC
12375    `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)`
12376    HAS_MEASURE_ISOMETRY) THEN
12377   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL
12378    [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN
12379     SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN
12380     SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN
12381     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC];
12382     DISCH_TAC THEN ASM_REWRITE_TAC[HAS_MEASURE_0] THEN
12383     ASM_REWRITE_TAC[GSYM HAS_MEASURE_0] THEN
12384     REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART;
12385                 SNDCART_PASTECART; PASTECART_INJ] THEN
12386     REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);;
12387
12388 let LEBESGUE_MEASURABLE_PCROSS = prove
12389  (`!s:real^M->bool t:real^N->bool.
12390         lebesgue_measurable(s PCROSS t) <=>
12391         negligible s \/ negligible t \/
12392         (lebesgue_measurable s /\ lebesgue_measurable t)`,
12393   REPEAT GEN_TAC THEN
12394   ASM_CASES_TAC `negligible(s:real^M->bool)` THENL
12395    [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE];
12396     ASM_REWRITE_TAC[]] THEN
12397   ASM_CASES_TAC `negligible(t:real^N->bool)` THENL
12398    [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE];
12399     ASM_REWRITE_TAC[]] THEN
12400   REWRITE_TAC[lebesgue_measurable; measurable_on; IN_UNIV] THEN
12401   REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
12402   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
12403   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
12404    [MAP_EVERY X_GEN_TAC
12405      [`k:real^(M,N)finite_sum->bool`;
12406       `g:num->real^(M,N)finite_sum->real^1`] THEN
12407     STRIP_TAC THEN FIRST_ASSUM(fun th ->
12408       ASSUME_TAC(MATCH_MP FUBINI_NEGLIGIBLE th) THEN
12409       ASSUME_TAC(MATCH_MP FUBINI_NEGLIGIBLE_ALT th)) THEN
12410     SUBGOAL_THEN
12411      `~(s SUBSET {x:real^M | ~negligible {y:real^N | pastecart x y IN k}})`
12412     MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN
12413     SUBGOAL_THEN
12414      `~(t SUBSET {y:real^N | ~negligible {x:real^M | pastecart x y IN k}})`
12415     MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN
12416     REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM] THEN
12417     DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
12418     DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
12419     EXISTS_TAC `{x:real^M | pastecart x (y:real^N) IN k}` THEN
12420     EXISTS_TAC `\n x. (g:num->real^(M,N)finite_sum->real^1)
12421                       n (pastecart x y)` THEN
12422     EXISTS_TAC `{y:real^N | pastecart (x:real^M) y IN k}` THEN
12423     EXISTS_TAC `\n y. (g:num->real^(M,N)finite_sum->real^1)
12424                       n (pastecart x y)` THEN
12425     ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THEN
12426     (CONJ_TAC THENL
12427       [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12428        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12429        SIMP_TAC[CONTINUOUS_ON_PASTECART;
12430                 CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
12431        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
12432        ALL_TAC])
12433     THENL
12434      [X_GEN_TAC `u:real^M` THEN DISCH_TAC THEN
12435       FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (u:real^M) (y:real^N)`);
12436       X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
12437       FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (x:real^M) (v:real^N)`)] THEN
12438     ASM_REWRITE_TAC[indicator; PASTECART_IN_PCROSS];
12439     MAP_EVERY X_GEN_TAC
12440      [`u:real^M->bool`; `f:num->real^M->real^1`;
12441       `v:real^N->bool`; `g:num->real^N->real^1`] THEN
12442     STRIP_TAC THEN
12443     EXISTS_TAC `u PCROSS (:real^N) UNION (:real^M) PCROSS v` THEN
12444     EXISTS_TAC `\n:num z:real^(M,N)finite_sum.
12445       lift(drop(f n (fstcart z)) * drop(g n (sndcart z)))` THEN
12446     ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_PCROSS] THEN
12447     CONJ_TAC THENL
12448      [GEN_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN
12449       MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12450       REWRITE_TAC[o_DEF; LIFT_DROP] THEN
12451       CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12452       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12453       SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
12454       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
12455       REWRITE_TAC[FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN
12456       REWRITE_TAC[IN_UNIV; DE_MORGAN_THM; LIFT_CMUL; LIFT_DROP] THEN
12457       MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN
12458       REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12459       SUBGOAL_THEN `indicator (s PCROSS t) (pastecart x y) =
12460                     drop(indicator s (x:real^M)) % indicator t (y:real^N)`
12461       SUBST1_TAC THENL
12462        [REWRITE_TAC[indicator; PASTECART_IN_PCROSS] THEN
12463         MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(y:real^N) IN t`] THEN
12464         ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN
12465         CONV_TAC REAL_RAT_REDUCE_CONV;
12466         MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN
12467         ASM_SIMP_TAC[]]]]);;
12468
12469 let MEASURABLE_PCROSS = prove
12470  (`!s:real^M->bool t:real^N->bool.
12471         measurable(s PCROSS t) <=>
12472         negligible s \/ negligible t \/ (measurable s /\ measurable t)`,
12473   REPEAT GEN_TAC THEN
12474   ASM_CASES_TAC `negligible(s:real^M->bool)` THENL
12475    [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_MEASURABLE];
12476     ASM_REWRITE_TAC[]] THEN
12477   ASM_CASES_TAC `negligible(t:real^N->bool)` THENL
12478    [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_MEASURABLE];
12479     ASM_REWRITE_TAC[]] THEN
12480   ASM_CASES_TAC
12481    `lebesgue_measurable((s:real^M->bool) PCROSS (t:real^N->bool))`
12482   THENL
12483    [ASM_SIMP_TAC[FUBINI_TONELLI_MEASURE; PASTECART_IN_PCROSS];
12484     ASM_MESON_TAC[LEBESGUE_MEASURABLE_PCROSS;
12485     MEASURABLE_IMP_LEBESGUE_MEASURABLE]] THEN
12486   REWRITE_TAC[SET_RULE `{x | P /\ x IN s} = if P then s else {}`] THEN
12487   ONCE_REWRITE_TAC[COND_RAND] THEN
12488   REWRITE_TAC[MEASURABLE_EMPTY; MEASURE_EMPTY] THEN
12489   ONCE_REWRITE_TAC[COND_RAND] THEN
12490   REWRITE_TAC[LIFT_NUM; INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN
12491   REWRITE_TAC[SET_RULE
12492    `{x | if x IN s then P else F} = if P then s else {}`] THEN
12493   ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN
12494   ASM_CASES_TAC `measurable(t:real^N->bool)` THEN
12495   ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN
12496   REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN
12497   ASM_MESON_TAC[NEGLIGIBLE_EQ_MEASURE_0]);;
12498
12499 let HAS_MEASURE_PCROSS = prove
12500  (`!s:real^M->bool t:real^N->bool a b.
12501         s has_measure a /\ t has_measure b
12502         ==> (s PCROSS t) has_measure (a * b)`,
12503   REPEAT STRIP_TAC THEN
12504   MP_TAC(ISPEC `(s:real^M->bool) PCROSS (t:real^N->bool)`
12505         FUBINI_MEASURE) THEN
12506   REWRITE_TAC[MEASURABLE_PCROSS; PASTECART_IN_PCROSS] THEN
12507   ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
12508   REWRITE_TAC[SET_RULE `{y | P /\ y IN s} = if P then s else {}`] THEN
12509   ONCE_REWRITE_TAC[COND_RAND] THEN
12510   REWRITE_TAC[MEASURABLE_EMPTY; MEASURE_EMPTY] THEN
12511   ONCE_REWRITE_TAC[COND_RAND] THEN
12512   REWRITE_TAC[LIFT_NUM; INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN
12513   REWRITE_TAC[SET_RULE
12514    `{x | if x IN s then P else F} = if P then s else {}`] THEN
12515   REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN STRIP_TAC THEN
12516   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_PCROSS] THEN
12517   CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
12518   REWRITE_TAC[GSYM LIFT_EQ] THEN
12519   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12520           HAS_INTEGRAL_UNIQUE)) THEN
12521   RULE_ASSUM_TAC(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]) THEN
12522   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN
12523   ASM_REWRITE_TAC[LIFT_EQ_CMUL] THEN MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN
12524   REWRITE_TAC[GSYM LIFT_EQ_CMUL] THEN
12525   ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
12526   ASM_REWRITE_TAC[GSYM HAS_MEASURE; HAS_MEASURE_MEASURABLE_MEASURE]);;
12527
12528 let MEASURE_PCROSS = prove
12529  (`!s:real^M->bool t:real^N->bool.
12530         measurable s /\ measurable t
12531         ==> measure(s PCROSS t) = measure s * measure t`,
12532   MESON_TAC[HAS_MEASURE_MEASURABLE_MEASURE; HAS_MEASURE_PCROSS]);;
12533
12534 (* ------------------------------------------------------------------------- *)
12535 (* Relate the measurability of a function and of its ordinate set.           *)
12536 (* ------------------------------------------------------------------------- *)
12537
12538 let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE = prove
12539  (`!f:real^M->real^N k.
12540         f measurable_on (:real^M)
12541         ==> lebesgue_measurable {pastecart x (y:real^N) | y$k <= (f x)$k}`,
12542   let lemma = prove
12543    (`!x y. x <= y <=> !q. rational q /\ y < q ==> x < q`,
12544     REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LET_TRANS]; ALL_TAC] THEN
12545     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
12546     REWRITE_TAC[REAL_NOT_LE; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN
12547     MESON_TAC[RATIONAL_BETWEEN; REAL_LT_IMP_LE]) in
12548   REPEAT STRIP_TAC THEN
12549   SUBGOAL_THEN
12550    `{pastecart (x:real^M) (y:real^N) | y$k <= (f x:real^N)$k} =
12551     INTERS {{pastecart x y | (f x)$k < q ==> y$k < q} | q IN rational}`
12552   SUBST1_TAC THENL
12553    [REWRITE_TAC[INTERS_GSPEC; EXTENSION; FORALL_PASTECART] THEN
12554     REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
12555     ONCE_REWRITE_TAC[IN_ELIM_THM] THEN
12556     REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN MESON_TAC[lemma; IN];
12557     ALL_TAC] THEN
12558   MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
12559   SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_RATIONAL] THEN
12560   REWRITE_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[SET_RULE
12561    `{f x y | P x y ==> Q x y} = {f x y | Q x y} UNION {f x y | ~(P x y)}`] THEN
12562   X_GEN_TAC `q:real` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN
12563   MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN
12564   REWRITE_TAC[REAL_NOT_LT; GSYM PCROSS; LEBESGUE_MEASURABLE_PCROSS;
12565    SET_RULE `{f x y |x,y| P x} = {f x y | x IN {x | P x} /\ y IN UNIV}`;
12566    SET_RULE `{f x y |x,y| Q y} = {f x y | x IN UNIV /\ y IN {x | Q x}}`] THEN
12567   CONJ_TAC THEN REPEAT DISJ2_TAC THEN
12568   REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THENL
12569    [MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN
12570     REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT];
12571     ONCE_REWRITE_TAC[SET_RULE
12572      `{x | q <= (f x)$k} = {x | f x IN {y | q <= y$k}}`] THEN
12573     MATCH_MP_TAC LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN
12574     ASM_REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]]);;
12575
12576 let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT = prove
12577  (`!f:real^M->real^N k.
12578         f measurable_on (:real^M)
12579         ==> lebesgue_measurable {pastecart x (y:real^N) | y$k < (f x)$k}`,
12580   REPEAT STRIP_TAC THEN
12581   REWRITE_TAC[REAL_ARITH `f < y <=> ~(--f <= --y)`] THEN
12582   MP_TAC(ISPECL [`(--) o (f:real^M->real^N)`; `k:num`]
12583     LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE) THEN
12584   ANTS_TAC THENL
12585    [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN
12586     ASM_REWRITE_TAC[] THEN
12587     GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
12588     SIMP_TAC[CONTINUOUS_ON_NEG; CONTINUOUS_ON_ID];
12589     ALL_TAC] THEN
12590   MP_TAC(ISPEC
12591    `\z:real^(M,N)finite_sum. pastecart (fstcart z) (--sndcart z)`
12592    LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ) THEN
12593   REWRITE_TAC[RIGHT_FORALL_IMP_THM; PASTECART_INJ; VECTOR_EQ_NEG2;
12594               GSYM PASTECART_EQ] THEN
12595   ANTS_TAC THENL
12596    [REWRITE_TAC[linear; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART;
12597                 FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; SNDCART_CMUL] THEN
12598     VECTOR_ARITH_TAC;
12599     DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th])] THEN
12600   GEN_REWRITE_TAC LAND_CONV [GSYM LEBESGUE_MEASURABLE_COMPL] THEN
12601   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
12602   ONCE_REWRITE_TAC[SET_RULE `UNIV DIFF s = t <=> s = UNIV DIFF t`] THEN
12603   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12604   REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_PASTECART_THM; o_DEF;
12605               FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN
12606   REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_NEG_NEG] THEN
12607   MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VECTOR_NEG_NEG]);;
12608
12609 let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ,
12610     LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ = (CONJ_PAIR o prove)
12611  (`(!f:real^M->real^N.
12612         f measurable_on (:real^M) <=>
12613         !k. 1 <= k /\ k <= dimindex(:N)
12614             ==> lebesgue_measurable
12615                   {pastecart x (y:real^N) | y$k <= (f x)$k}) /\
12616    (!f:real^M->real^N.
12617         f measurable_on (:real^M) <=>
12618         lebesgue_measurable
12619           {pastecart x (y:real^N) | !k. 1 <= k /\ k <= dimindex(:N)
12620                                         ==> y$k <= (f x)$k})`,
12621   REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
12622    `(p ==> q) /\ (q ==> r) /\ (r ==> p)
12623     ==> (p <=> q) /\ (p <=> r)`) THEN
12624   REPEAT CONJ_TAC THEN DISCH_TAC THENL
12625    [ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE];
12626     SUBGOAL_THEN
12627      `{ pastecart x y |
12628         !k. 1 <= k /\ k <= dimindex(:N)
12629             ==> (y:real^N)$k <= (f:real^M->real^N) x$k } =
12630       INTERS {{ pastecart x y | (y:real^N)$k <= (f:real^M->real^N) x$k} |
12631                 k IN 1..dimindex(:N)}`
12632     SUBST1_TAC THENL
12633      [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN
12634       REWRITE_TAC[FORALL_PASTECART; PASTECART_INJ] THEN MESON_TAC[];
12635       MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN
12636       SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
12637       ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG]];
12638     MP_TAC(ISPECL
12639      [`f:real^M->real^N`;
12640       `{y | lebesgue_measurable
12641               {x | !k. 1 <= k /\ k <= dimindex (:N)
12642                        ==> (y:real^N)$k <= (f:real^M->real^N) x$k}}`]
12643      MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE) THEN
12644     ASM_REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_THEN MATCH_MP_TAC THEN
12645     FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_LEBESGUE_MEASURABLE_ALT) THEN
12646     REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
12647     REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
12648     REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN
12649     REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; NEGLIGIBLE_EMPTY_INTERIOR]]);;
12650
12651 let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ,
12652     LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ = (CONJ_PAIR o prove)
12653  (`(!f:real^M->real^N.
12654         f measurable_on (:real^M) <=>
12655         !k. 1 <= k /\ k <= dimindex(:N)
12656             ==> lebesgue_measurable
12657                   {pastecart x (y:real^N) | y$k < (f x)$k}) /\
12658    (!f:real^M->real^N.
12659         f measurable_on (:real^M) <=>
12660         lebesgue_measurable
12661           {pastecart x (y:real^N) | !k. 1 <= k /\ k <= dimindex(:N)
12662                                         ==> y$k < (f x)$k})`,
12663   REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
12664    `(p ==> q) /\ (q ==> r) /\ (r ==> p)
12665     ==> (p <=> q) /\ (p <=> r)`) THEN
12666   REPEAT CONJ_TAC THEN DISCH_TAC THENL
12667    [ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT];
12668     SUBGOAL_THEN
12669      `{ pastecart x y |
12670         !k. 1 <= k /\ k <= dimindex(:N)
12671             ==> (y:real^N)$k < (f:real^M->real^N) x$k } =
12672       INTERS {{ pastecart x y | (y:real^N)$k < (f:real^M->real^N) x$k} |
12673                 k IN 1..dimindex(:N)}`
12674     SUBST1_TAC THENL
12675      [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN
12676       REWRITE_TAC[FORALL_PASTECART; PASTECART_INJ] THEN MESON_TAC[];
12677       MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN
12678       SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
12679       ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG]];
12680     MP_TAC(ISPECL
12681      [`f:real^M->real^N`;
12682       `{y | lebesgue_measurable
12683               {x | !k. 1 <= k /\ k <= dimindex (:N)
12684                        ==> (y:real^N)$k < (f:real^M->real^N) x$k}}`]
12685      MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE) THEN
12686     ASM_REWRITE_TAC[IN_ELIM_THM; real_gt] THEN DISCH_THEN MATCH_MP_TAC THEN
12687     FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_LEBESGUE_MEASURABLE_ALT) THEN
12688     REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
12689     REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
12690     REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN
12691     REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; NEGLIGIBLE_EMPTY_INTERIOR]]);;
12692
12693 let NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH = prove
12694  (`!f:real^M->real^N.
12695         f measurable_on (:real^M) ==> negligible {pastecart x y | f x = y}`,
12696   REPEAT STRIP_TAC THEN
12697   MATCH_MP_TAC NEGLIGIBLE_DISJOINT_TRANSLATES THEN
12698   EXISTS_TAC `{pastecart (vec 0:real^M) x | x IN (:real^N)}` THEN
12699   EXISTS_TAC `vec 0:real^(M,N)finite_sum` THEN REPEAT CONJ_TAC THENL
12700    [SUBGOAL_THEN
12701      `{pastecart x y | (f:real^M->real^N) x = y} =
12702       INTERS {{pastecart x y | y$i <= (f x)$i} DIFF
12703               {pastecart x y | y$i < (f x)$i} | i IN 1..dimindex(:N)}`
12704     SUBST1_TAC THENL
12705      [REWRITE_TAC[CART_EQ; INTERS_GSPEC; EXTENSION; FORALL_PASTECART] THEN
12706       REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_NUMSEG] THEN
12707       ONCE_REWRITE_TAC[IN_ELIM_THM] THEN
12708       REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF; REAL_NOT_LT] THEN
12709       REWRITE_TAC[REAL_LE_ANTISYM] THEN MESON_TAC[];
12710       ALL_TAC] THEN
12711     MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN
12712     SIMP_TAC[FINITE_IMAGE; SIMPLE_IMAGE; FINITE_NUMSEG] THEN
12713     REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN
12714     STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN
12715     ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE;
12716                  LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT];
12717     MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN
12718     REWRITE_TAC[GSYM PCROSS; SET_RULE
12719      `{f a x | x IN s} = {f w x | w IN {a} /\ x IN s}`] THEN
12720     REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN
12721     REWRITE_TAC[CONNECTED_SING; CONNECTED_PCROSS_EQ; CONNECTED_UNIV] THEN
12722     REWRITE_TAC[IN_SING; IN_UNIV] THEN MATCH_MP_TAC(SET_RULE
12723      `!a b. a IN s /\ b IN s /\ ~(a = b) ==> ~(?a. s = {a})`) THEN
12724     EXISTS_TAC `pastecart (vec 0:real^M) (vec 0:real^N)` THEN
12725     EXISTS_TAC `pastecart (vec 0:real^M) (vec 1:real^N)` THEN
12726     REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING; IN_UNIV] THEN
12727     REWRITE_TAC[PASTECART_INJ; VEC_EQ; ARITH_EQ];
12728
12729     REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12730     REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; PASTECART_INJ] THEN
12731     REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; PASTECART_INJ; FORALL_IN_IMAGE;
12732       SET_RULE `DISJOINT s t <=> !x. x IN s ==> !y. y IN t ==> ~(x = y)`] THEN
12733     REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; PASTECART_INJ] THEN
12734     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
12735     MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN
12736     MAP_EVERY X_GEN_TAC [`x':real^M`; `y':real^N`] THEN DISCH_TAC THEN
12737     REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN
12738     ASM_CASES_TAC `x':real^M = x` THEN ASM_REWRITE_TAC[] THEN
12739     UNDISCH_TAC `~(a:real^N = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN
12740     CONV_TAC VECTOR_ARITH]);;
12741
12742 (* ------------------------------------------------------------------------- *)
12743 (* Hence relate integrals and "area under curve" for functions into R^+.     *)
12744 (* ------------------------------------------------------------------------- *)
12745
12746 let MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE = prove
12747  (`!f:real^N->real^1.
12748         (!x. &0 <= drop(f x))
12749         ==> (f measurable_on (:real^N) <=>
12750              lebesgue_measurable { pastecart x y | y IN interval[vec 0,f x]})`,
12751   REPEAT STRIP_TAC THEN
12752   REWRITE_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ] THEN
12753   REWRITE_TAC[DIMINDEX_1; FORALL_1; IN_INTERVAL_1; GSYM drop; DROP_VEC] THEN
12754   EQ_TAC THEN DISCH_TAC THENL
12755    [SUBGOAL_THEN
12756      `{pastecart x y | &0 <= drop y /\ drop y <= drop (f x)} =
12757       (:real^N) PCROSS {y | &0 <= drop y} INTER
12758       {pastecart (x:real^N) y | drop y <= drop (f x)}`
12759     SUBST1_TAC THENL
12760      [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
12761                   IN_INTER; IN_ELIM_PASTECART_THM] THEN
12762       REWRITE_TAC[IN_UNIV; IN_ELIM_THM];
12763       MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN
12764       ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN
12765       SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED; GSYM real_ge; drop;
12766                CLOSED_HALFSPACE_COMPONENT_GE]];
12767     SUBGOAL_THEN
12768      `{pastecart (x:real^N) y | drop y <= drop (f x)} =
12769       {pastecart x y | &0 <= drop y /\ drop y <= drop (f x)} UNION
12770        (:real^N) PCROSS {y | drop y < &0}`
12771     SUBST1_TAC THENL
12772      [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
12773                   IN_UNION; IN_ELIM_PASTECART_THM] THEN
12774       REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN
12775       ASM_MESON_TAC[REAL_NOT_LE; REAL_LT_IMP_LE; REAL_LE_TRANS];
12776       MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN
12777       ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN
12778       SIMP_TAC[LEBESGUE_MEASURABLE_OPEN; drop;
12779                OPEN_HALFSPACE_COMPONENT_LT]]]);;
12780
12781 let INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE = prove
12782  (`!f:real^N->real^1.
12783         (!x. &0 <= drop(f x))
12784         ==> (f integrable_on (:real^N) <=>
12785              measurable { pastecart x y | y IN interval[vec 0,f x]})`,
12786   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
12787    [W(MP_TAC o PART_MATCH (lhand o rand) FUBINI_TONELLI_MEASURE o snd) THEN
12788     REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN
12789     ASM_SIMP_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN
12790     REWRITE_TAC[MEASURABLE_INTERVAL; EMPTY_GSPEC; NEGLIGIBLE_EMPTY] THEN
12791     ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN
12792     SUBGOAL_THEN
12793      `{pastecart x y | y IN interval [vec 0,f x]} =
12794       {pastecart x y | drop y <= drop(f x)} INTER
12795       (:real^N) PCROSS {x | &0 <= drop x}`
12796     SUBST1_TAC THENL
12797      [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM;
12798                   PASTECART_IN_PCROSS; IN_UNIV] THEN
12799       REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; DROP_VEC; CONJ_SYM];
12800       MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN REWRITE_TAC[drop] THEN
12801       ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE;
12802                    INTEGRABLE_IMP_MEASURABLE; LEBESGUE_MEASURABLE_PCROSS] THEN
12803       REPEAT DISJ2_TAC THEN REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THEN
12804       MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED THEN
12805       REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]];
12806     FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN
12807     REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN
12808     ASM_SIMP_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN
12809     REWRITE_TAC[ETA_AX; GSYM LIFT_EQ] THEN MESON_TAC[integrable_on]]);;
12810
12811 let HAS_INTEGRAL_MEASURE_UNDER_CURVE = prove
12812  (`!f:real^N->real^1 m.
12813         (!x. &0 <= drop(f x))
12814         ==> ((f has_integral lift m) (:real^N) <=>
12815              { pastecart x y | y IN interval[vec 0,f x]} has_measure m)`,
12816   REPEAT STRIP_TAC THEN
12817   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE;
12818               HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
12819   MATCH_MP_TAC(TAUT
12820    `(p <=> p') /\ (p /\ p' ==> (q <=> q')) ==> (p /\ q <=> p' /\ q')`) THEN
12821   CONJ_TAC THENL
12822    [ASM_SIMP_TAC[INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE]; STRIP_TAC] THEN
12823   FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN
12824   REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN
12825   ASM_REWRITE_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN
12826   REWRITE_TAC[ETA_AX; GSYM LIFT_EQ] THEN
12827   ASM_MESON_TAC[integrable_on; INTEGRAL_UNIQUE]);;
12828
12829 (* ------------------------------------------------------------------------- *)
12830 (* Some miscellanous lemmas.                                                 *)
12831 (* ------------------------------------------------------------------------- *)
12832
12833 let MEASURABLE_ON_COMPOSE_FSTCART = prove
12834  (`!f:real^M->real^P.
12835         f measurable_on (:real^M)
12836         ==> (\z:real^(M,N)finite_sum. f(fstcart z)) measurable_on
12837             (:real^(M,N)finite_sum)`,
12838   GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
12839   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^P`] THEN
12840   STRIP_TAC THEN
12841   EXISTS_TAC `(k:real^M->bool) PCROSS (:real^N)` THEN
12842   EXISTS_TAC `(\n z. g n (fstcart z)):num->real^(M,N)finite_sum->real^P` THEN
12843   ASM_REWRITE_TAC[NEGLIGIBLE_PCROSS; FORALL_PASTECART; PASTECART_IN_PCROSS;
12844                   IN_UNIV; FSTCART_PASTECART; SNDCART_PASTECART] THEN
12845   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12846   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12847   SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN
12848   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);;
12849
12850 let MEASURABLE_ON_COMPOSE_SNDCART = prove
12851  (`!f:real^N->real^P.
12852         f measurable_on (:real^N)
12853         ==> (\z:real^(M,N)finite_sum. f(sndcart z)) measurable_on
12854             (:real^(M,N)finite_sum)`,
12855   GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
12856   MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `g:num->real^N->real^P`] THEN
12857   STRIP_TAC THEN
12858   EXISTS_TAC `(:real^M) PCROSS (k:real^N->bool)` THEN
12859   EXISTS_TAC `(\n z. g n (sndcart z)):num->real^(M,N)finite_sum->real^P` THEN
12860   ASM_REWRITE_TAC[NEGLIGIBLE_PCROSS; FORALL_PASTECART; PASTECART_IN_PCROSS;
12861                   IN_UNIV; SNDCART_PASTECART; SNDCART_PASTECART] THEN
12862   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12863   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12864   SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
12865   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);;
12866
12867 let MEASURABLE_ON_COMPOSE_SUB = prove
12868  (`!f:real^M->real^N.
12869         f measurable_on (:real^M)
12870         ==> (\z. f(fstcart z - sndcart z))
12871             measurable_on (:real^(M,M)finite_sum)`,
12872   REPEAT STRIP_TAC THEN
12873   SUBGOAL_THEN
12874    `(\z. f(fstcart z - sndcart z)):real^(M,M)finite_sum->real^N =
12875     (\z. f(fstcart z)) o
12876     (\z. pastecart (fstcart z - sndcart z) (sndcart z))`
12877   SUBST1_TAC THENL
12878    [REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
12879     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART];
12880     W(MP_TAC o PART_MATCH (lhs o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o
12881       snd)] THEN
12882   REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN
12883   ANTS_TAC THENL
12884    [REWRITE_TAC[PASTECART_INJ] THEN
12885     CONJ_TAC THENL [MATCH_MP_TAC LINEAR_PASTECART; CONV_TAC VECTOR_ARITH] THEN
12886     SIMP_TAC[LINEAR_SNDCART; LINEAR_FSTCART; LINEAR_COMPOSE_SUB];
12887     DISCH_THEN SUBST1_TAC THEN
12888     MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
12889     EXISTS_TAC `(:real^(M,M)finite_sum)` THEN
12890     ASM_SIMP_TAC[MEASURABLE_ON_COMPOSE_FSTCART; SUBSET_UNIV] THEN
12891     MATCH_MP_TAC LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN THEN
12892     REWRITE_TAC[LE_REFL; LEBESGUE_MEASURABLE_UNIV] THEN
12893     MATCH_MP_TAC LINEAR_PASTECART THEN
12894     SIMP_TAC[LINEAR_SNDCART; LINEAR_FSTCART; LINEAR_COMPOSE_SUB]]);;
12895
12896 (* ------------------------------------------------------------------------- *)
12897 (* Fubini for absolute integrability.                                        *)
12898 (* ------------------------------------------------------------------------- *)
12899
12900 let FUBINI_ABSOLUTELY_INTEGRABLE = prove
12901  (`!f:real^(M,N)finite_sum->real^P.
12902         f absolutely_integrable_on (:real^(M,N)finite_sum)
12903         ==> negligible
12904              {x | ~((\y. f(pastecart x y))
12905                      absolutely_integrable_on (:real^N))} /\
12906             ((\x. integral (:real^N) (\y. f(pastecart x y))) has_integral
12907              integral (:real^(M,N)finite_sum) f) (:real^M)`,
12908   let lemma = prove
12909    (`{x | ~(!i. i IN k ==> P i x)} = UNIONS {{x | ~P i x} | i IN k}`,
12910     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
12911   let assoclemma = prove
12912    (`!P:real^(M,N)finite_sum->real^P->bool.
12913           {pastecart x y | P x y} has_measure m
12914           ==> {pastecart x (pastecart y z) | P (pastecart x y) z}
12915               has_measure m`,
12916     GEN_TAC THEN MP_TAC(ISPECL
12917      [`\z. pastecart (fstcart(fstcart z):real^M)
12918                      (pastecart (sndcart(fstcart z):real^N)
12919                                 (sndcart z:real^P))`;
12920       `{pastecart (x:real^(M,N)finite_sum) (y:real^P) | P x y}`;
12921       `m:real`] HAS_MEASURE_ISOMETRY) THEN
12922     REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_AC] THEN ANTS_TAC THENL
12923      [CONJ_TAC THENL
12924        [REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN
12925         REWRITE_TAC[GSYM o_DEF] THEN
12926         REPEAT(MATCH_MP_TAC LINEAR_COMPOSE THEN CONJ_TAC) THEN
12927         REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART];
12928         SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART;
12929                  FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]];
12930       DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_IMP THEN
12931       AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12932       REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART;
12933                   IN_ELIM_THM; EXISTS_PASTECART; PASTECART_INJ] THEN
12934       MESON_TAC[]]) in
12935   let FUBINI_LEMMA = prove
12936    (`!f:real^(M,N)finite_sum->real^1.
12937           f integrable_on (:real^(M,N)finite_sum) /\ (!x. &0 <= drop(f x))
12938           ==> negligible {x | ~((f o pastecart x) integrable_on (:real^N))} /\
12939               ((\x. integral (:real^N) (f o pastecart x)) has_integral
12940                integral (:real^(M,N)finite_sum) f) (:real^M)`,
12941     REPEAT GEN_TAC THEN STRIP_TAC THEN
12942     MP_TAC(ISPEC `f:real^(M,N)finite_sum->real^1`
12943       INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE) THEN
12944     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
12945     SUBGOAL_THEN
12946      `measurable { pastecart x (pastecart y z) |
12947                    z IN interval[vec 0,(f:real^(M,N)finite_sum->real^1)
12948                                        (pastecart x y)] }`
12949     ASSUME_TAC THENL
12950      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN
12951       REWRITE_TAC[measurable] THEN MATCH_MP_TAC MONO_EXISTS THEN
12952       REWRITE_TAC[assoclemma];
12953       ALL_TAC] THEN
12954     FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN
12955     REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ] THEN
12956     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
12957     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
12958     REWRITE_TAC[SET_RULE
12959      `{x | ?y z. P y z /\ x = pastecart y z} =
12960       {pastecart y z | P y z}`] THEN
12961     MP_TAC(GEN `x:real^M` (ISPEC
12962        `(f:real^(M,N)finite_sum->real^1) o pastecart x`
12963           INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE)) THEN
12964     ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN
12965     ASM_REWRITE_TAC[] THEN
12966     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
12967     MATCH_MP_TAC(MESON[]
12968      `y = z /\ ((f has_integral y) s ==> (g has_integral y) s)
12969       ==> (f has_integral y) s ==> (g has_integral z) s`) THEN
12970     CONJ_TAC THENL
12971      [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
12972       ASM_SIMP_TAC[HAS_INTEGRAL_MEASURE_UNDER_CURVE] THEN
12973       ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN
12974       CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
12975       MATCH_MP_TAC assoclemma THEN
12976       ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE];
12977       MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
12978           (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN
12979       EXISTS_TAC
12980        `{x | ~((\y. (f:real^(M,N)finite_sum->real^1) (pastecart x y))
12981                integrable_on (:real^N))}` THEN
12982       ASM_REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN
12983       REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
12984       ASM_SIMP_TAC[HAS_INTEGRAL_MEASURE_UNDER_CURVE] THEN
12985       ASM_SIMP_TAC[GSYM HAS_MEASURE_MEASURE]]) in
12986   let FUBINI_1 = prove
12987    (`!f:real^(M,N)finite_sum->real^1.
12988           f absolutely_integrable_on (:real^(M,N)finite_sum)
12989           ==> negligible
12990                {x | ~((f o pastecart x) absolutely_integrable_on (:real^N))} /\
12991               ((\x. integral (:real^N) (f o pastecart x)) has_integral
12992                integral (:real^(M,N)finite_sum) f) (:real^M)`,
12993     REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC
12994      [`g = \x:real^(M,N)finite_sum. lift (max (&0) (drop(f x)))`;
12995       `h = \x:real^(M,N)finite_sum. --(lift (min (&0) (drop(f x))))`] THEN
12996     SUBGOAL_THEN `!x:real^(M,N)finite_sum. &0 <= drop(g x) /\ &0 <= drop(h x)`
12997     STRIP_ASSUME_TAC THENL
12998      [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN
12999       REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN REAL_ARITH_TAC;
13000       ALL_TAC] THEN
13001     SUBGOAL_THEN
13002      `(g:real^(M,N)finite_sum->real^1) absolutely_integrable_on UNIV /\
13003       (h:real^(M,N)finite_sum->real^1) absolutely_integrable_on UNIV`
13004     STRIP_ASSUME_TAC THENL
13005      [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN
13006       TRY(MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NEG) THENL
13007        [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1;
13008         MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1] THEN
13009       ASM_REWRITE_TAC[LIFT_DROP; ETA_AX; LIFT_NUM] THEN
13010       REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0];
13011       ALL_TAC] THEN
13012     SUBGOAL_THEN
13013      `(f:real^(M,N)finite_sum->real^1) = \x. g x - h x`
13014     SUBST1_TAC THENL
13015      [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN
13016       REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; LIFT_DROP; DROP_SUB; DROP_NEG] THEN
13017       REAL_ARITH_TAC;
13018       ALL_TAC] THEN
13019     MP_TAC(ISPEC `h:real^(M,N)finite_sum->real^1` FUBINI_LEMMA) THEN
13020     MP_TAC(ISPEC `g:real^(M,N)finite_sum->real^1` FUBINI_LEMMA) THEN
13021     ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
13022     ONCE_REWRITE_TAC[TAUT
13023      `p /\ q ==> r /\ s ==> t <=> p /\ r ==> q /\ s ==> t`] THEN
13024     REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ; o_DEF] THEN DISCH_TAC THEN
13025     DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN CONJ_TAC THENL
13026      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13027           NEGLIGIBLE_SUBSET)) THEN
13028       REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; GSYM DE_MORGAN_THM] THEN
13029       REWRITE_TAC[CONTRAPOS_THM; o_DEF] THEN REPEAT STRIP_TAC THEN
13030       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
13031       CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
13032       ASM_REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; IN_UNIV];
13033       ASM_SIMP_TAC[INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
13034       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
13035        (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE))) THEN
13036       FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN
13037           CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN
13038       REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN
13039       SIMP_TAC[DE_MORGAN_THM; INTEGRAL_SUB]]) in
13040   REPEAT GEN_TAC THEN DISCH_TAC THEN
13041   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
13042    [ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN
13043     REWRITE_TAC[GSYM IN_NUMSEG; lemma] THEN
13044     MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN
13045     SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN
13046     REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG];
13047     DISCH_TAC THEN
13048     ONCE_REWRITE_TAC[HAS_INTEGRAL_COMPONENTWISE]] THEN
13049   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
13050   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13051     [ABSOLUTELY_INTEGRABLE_COMPONENTWISE]) THEN
13052   DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
13053   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_1) THEN SIMP_TAC[o_DEF] THEN
13054   DISCH_THEN(MP_TAC o CONJUNCT2) THEN
13055   ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT;
13056                ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
13057   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC]
13058         HAS_INTEGRAL_SPIKE)) THEN
13059   FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN
13060     CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN
13061   REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN
13062   ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT;
13063                ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);;
13064
13065 let FUBINI_ABSOLUTELY_INTEGRABLE_ALT = prove
13066  (`!f:real^(M,N)finite_sum->real^P.
13067         f absolutely_integrable_on (:real^(M,N)finite_sum)
13068         ==> negligible
13069              {y | ~((\x. f(pastecart x y))
13070                      absolutely_integrable_on (:real^M))} /\
13071             ((\y. integral (:real^M) (\x. f(pastecart x y))) has_integral
13072              integral (:real^(M,N)finite_sum) f) (:real^N)`,
13073   REPEAT GEN_TAC THEN DISCH_TAC THEN
13074   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13075    [GSYM ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV]) THEN
13076   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN
13077   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
13078   REWRITE_TAC[INTEGRAL_PASTECART_SYM_UNIV]);;
13079
13080 let FUBINI_INTEGRAL = prove
13081  (`!f:real^(M,N)finite_sum->real^P.
13082         f absolutely_integrable_on UNIV
13083         ==> integral UNIV f =
13084             integral UNIV (\x. integral UNIV (\y. f(pastecart x y)))`,
13085   REPEAT STRIP_TAC THEN FIRST_ASSUM
13086    (MP_TAC o CONJUNCT2 o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN
13087   DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);;
13088
13089 let FUBINI_INTEGRAL_ALT = prove
13090  (`!f:real^(M,N)finite_sum->real^P.
13091         f absolutely_integrable_on UNIV
13092         ==> integral UNIV f =
13093             integral UNIV (\y. integral UNIV (\x. f(pastecart x y)))`,
13094   REPEAT STRIP_TAC THEN FIRST_ASSUM
13095     (MP_TAC o CONJUNCT2 o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT) THEN
13096   DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);;
13097
13098 let FUBINI_INTEGRAL_INTERVAL = prove
13099  (`!f:real^(M,N)finite_sum->real^P a b c d.
13100         f absolutely_integrable_on interval[pastecart a c,pastecart b d]
13101         ==> integral (interval[pastecart a c,pastecart b d]) f =
13102             integral (interval[a,b])
13103                      (\x. integral (interval[c,d])
13104                                    (\y. f(pastecart x y)))`,
13105   REPEAT GEN_TAC THEN
13106   ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
13107   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_INTEGRAL) THEN
13108   REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN DISCH_THEN SUBST1_TAC THEN
13109   GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN
13110   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
13111   REWRITE_TAC[PASTECART_IN_PCROSS; GSYM PCROSS_INTERVAL] THEN
13112   COND_CASES_TAC THEN ASM_REWRITE_TAC[INTEGRAL_0] THEN
13113   REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);;
13114
13115 let FUBINI_INTEGRAL_INTERVAL_ALT = prove
13116  (`!f:real^(M,N)finite_sum->real^P a b c d.
13117         f absolutely_integrable_on interval[pastecart a c,pastecart b d]
13118         ==> integral (interval[pastecart a c,pastecart b d]) f =
13119             integral (interval[c,d])
13120                      (\y. integral (interval[a,b])
13121                                    (\x. f(pastecart x y)))`,
13122   REPEAT GEN_TAC THEN
13123   ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
13124   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_INTEGRAL_ALT) THEN
13125   REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN DISCH_THEN SUBST1_TAC THEN
13126   GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN
13127   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
13128   REWRITE_TAC[PASTECART_IN_PCROSS; GSYM PCROSS_INTERVAL] THEN
13129   COND_CASES_TAC THEN ASM_REWRITE_TAC[INTEGRAL_0] THEN
13130   REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);;
13131
13132 let INTEGRAL_PASTECART_CONTINUOUS = prove
13133  (`!f:real^(M,N)finite_sum->real^P a b c d.
13134         f continuous_on interval[pastecart a c,pastecart b d]
13135         ==> integral (interval[pastecart a c,pastecart b d]) f =
13136             integral (interval[a,b])
13137                      (\x. integral (interval[c,d])
13138                                    (\y. f(pastecart x y)))`,
13139   SIMP_TAC[FUBINI_INTEGRAL_INTERVAL; ABSOLUTELY_INTEGRABLE_CONTINUOUS]);;
13140
13141 let INTEGRAL_SWAP_CONTINUOUS = prove
13142  (`!f:real^M->real^N->real^P a b c d.
13143         (\z. f (fstcart z) (sndcart z))
13144         continuous_on interval[pastecart a c,pastecart b d]
13145         ==> integral (interval[a,b]) (\x. integral (interval[c,d]) (f x)) =
13146             integral (interval[c,d])
13147                      (\y. integral (interval[a,b]) (\x. f x y))`,
13148   REPEAT STRIP_TAC THEN
13149   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_CONTINUOUS) THEN
13150   FIRST_X_ASSUM(fun th ->
13151     MP_TAC(MATCH_MP FUBINI_INTEGRAL_INTERVAL_ALT th) THEN
13152     MP_TAC(MATCH_MP FUBINI_INTEGRAL_INTERVAL th)) THEN
13153   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
13154   DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ETA_AX]);;
13155
13156 let FUBINI_TONELLI = prove
13157  (`!f:real^(M,N)finite_sum->real^P.
13158    f measurable_on (:real^(M,N)finite_sum)
13159    ==> (f absolutely_integrable_on (:real^(M,N)finite_sum) <=>
13160         negligible
13161           {x | ~((\y. f(pastecart x y)) absolutely_integrable_on (:real^N))} /\
13162         (\x. integral (:real^N) (\y. lift(norm(f(pastecart x y)))))
13163         integrable_on (:real^M))`,
13164   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
13165    [FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN
13166     FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN
13167     DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN
13168     ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
13169     FIRST_ASSUM(ACCEPT_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE);
13170     ALL_TAC] THEN
13171   ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN ABBREV_TAC
13172     `g = \n x. if x IN interval[--vec n,vec n]
13173                then lift(min (norm ((f:real^(M,N)finite_sum->real^P) x)) (&n))
13174                else vec 0` THEN
13175   SUBGOAL_THEN
13176    `!n. (g:num->real^(M,N)finite_sum->real^1) n absolutely_integrable_on UNIV`
13177   ASSUME_TAC THENL
13178    [X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
13179     MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
13180     REWRITE_TAC[IN_UNIV; DIMINDEX_1; FORALL_1] THEN
13181     REWRITE_TAC[COND_RAND; COND_RATOR; GSYM drop; LIFT_DROP; DROP_VEC] THEN
13182     CONJ_TAC THENL [CONV_TAC NORM_ARITH; ALL_TAC] THEN
13183     MATCH_MP_TAC INTEGRABLE_CASES THEN
13184     REWRITE_TAC[INTEGRABLE_0; IN_UNIV; SET_RULE `{x | x IN s} = s`] THEN
13185     MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
13186     EXISTS_TAC `\x:real^(M,N)finite_sum. lift(&n)` THEN
13187     REWRITE_TAC[INTEGRABLE_CONST; NORM_LIFT; LIFT_DROP] THEN
13188     SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> abs(min x (&n)) <= &n`] THEN
13189     MP_TAC(ISPECL
13190      [`\x. lift(norm((f:real^(M,N)finite_sum->real^P) x))`;
13191       `\x:real^(M,N)finite_sum. lift(&n)`;
13192       `interval[--vec n:real^(M,N)finite_sum,vec n]`] MEASURABLE_ON_MIN) THEN
13193     ANTS_TAC THENL
13194      [CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
13195       EXISTS_TAC `(:real^(M,N)finite_sum)` THEN
13196       REWRITE_TAC[SUBSET_UNIV; LEBESGUE_MEASURABLE_INTERVAL] THEN
13197       ASM_SIMP_TAC[MEASURABLE_ON_NORM; MEASURABLE_ON_CONST];
13198       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
13199       SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN
13200       REWRITE_TAC[DIMINDEX_1; LIFT_DROP; FORALL_1; GSYM drop]];
13201     ALL_TAC] THEN
13202   MP_TAC(ISPECL
13203    [`g:num->real^(M,N)finite_sum->real^1`;
13204     `\x. lift(norm((f:real^(M,N)finite_sum->real^P) x))`;
13205     `(:real^(M,N)finite_sum)`]
13206    MONOTONE_CONVERGENCE_INCREASING) THEN
13207   ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN
13208   ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; IN_UNIV] THEN
13209   REPEAT CONJ_TAC THENL
13210    [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
13211     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN
13212     REWRITE_TAC[REAL_LE_REFL; DROP_VEC; GSYM REAL_OF_NUM_SUC] THEN
13213     TRY(CONV_TAC NORM_ARITH) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
13214      (TAUT `~p ==> p ==> q`)) THEN
13215     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13216      `x IN s ==> s SUBSET t ==> x IN t`)) THEN
13217     REWRITE_TAC[SUBSET_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN
13218     REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REPEAT STRIP_TAC THEN
13219     REAL_ARITH_TAC;
13220     X_GEN_TAC `z:real^(M,N)finite_sum` THEN
13221     MATCH_MP_TAC LIM_EVENTUALLY THEN
13222     MP_TAC(ISPEC `&1 + max (norm z) (norm((f:real^(M,N)finite_sum->real^P) z))`
13223         REAL_ARCH_SIMPLE) THEN
13224     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN
13225     X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN
13226     REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN DISCH_TAC THEN
13227     EXPAND_TAC "g" THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL
13228      [AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `min a b = a <=> a <= b`] THEN
13229       ASM_REAL_ARITH_TAC;
13230       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~p ==> p ==> q`)) THEN
13231       REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN
13232       REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN REPEAT STRIP_TAC THEN
13233       MATCH_MP_TAC(REAL_ARITH
13234        `abs(x$i) <= norm(x:real^N) /\ norm x <= a ==> abs(x$i) <= a`) THEN
13235       REWRITE_TAC[COMPONENT_LE_NORM] THEN ASM_REAL_ARITH_TAC];
13236     MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->real^1) n`
13237       FUBINI_ABSOLUTELY_INTEGRABLE)) THEN
13238     ASM_REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
13239     FIRST_ASSUM(fun th ->
13240      REWRITE_TAC[GSYM(MATCH_MP INTEGRAL_UNIQUE (SPEC `n:num` th))]) THEN
13241     REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
13242     EXISTS_TAC
13243      `drop(integral (:real^M)
13244             (\x. lift(norm(integral (:real^N)
13245               (\y. lift(norm(
13246                 (f:real^(M,N)finite_sum->real^P) (pastecart x y))))))))` THEN
13247     X_GEN_TAC `n:num` THEN
13248     MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_AE THEN
13249     EXISTS_TAC
13250      `{x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y))
13251              absolutely_integrable_on (:real^N))} UNION
13252       {x | ~((\y. (g:num->real^(M,N)finite_sum->real^1) n (pastecart x y))
13253              absolutely_integrable_on (:real^N))}` THEN
13254     ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN REPEAT CONJ_TAC THENL
13255      [ASM_MESON_TAC[integrable_on];
13256       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
13257       MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
13258       MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN
13259       EXISTS_TAC
13260        `{x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y))
13261              absolutely_integrable_on (:real^N))}` THEN
13262       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
13263       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
13264       REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; IN_ELIM_THM] THEN
13265       X_GEN_TAC `x:real^M` THEN
13266       REWRITE_TAC[absolutely_integrable_on; GSYM drop] THEN
13267       STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN
13268       ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE];
13269       X_GEN_TAC `x:real^M` THEN
13270       REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN
13271       STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN
13272       MATCH_MP_TAC(REAL_ARITH
13273         `drop a <= norm a /\ x <= drop a==> x <= norm a`) THEN CONJ_TAC
13274       THENL [REWRITE_TAC[drop; NORM_REAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN
13275       MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
13276       RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN
13277       ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; IN_UNIV] THEN
13278       X_GEN_TAC `y:real^N` THEN EXPAND_TAC "g" THEN
13279       COND_CASES_TAC THEN REWRITE_TAC[NORM_0; NORM_POS_LE] THEN
13280       REWRITE_TAC[NORM_LIFT] THEN CONV_TAC NORM_ARITH]]);;
13281
13282 let FUBINI_TONELLI_ALT = prove
13283  (`!f:real^(M,N)finite_sum->real^P.
13284    f measurable_on (:real^(M,N)finite_sum)
13285    ==> (f absolutely_integrable_on (:real^(M,N)finite_sum) <=>
13286         negligible
13287           {y | ~((\x. f(pastecart x y)) absolutely_integrable_on (:real^M))} /\
13288         (\y. integral (:real^M) (\x. lift(norm(f(pastecart x y)))))
13289         integrable_on (:real^N))`,
13290   REPEAT STRIP_TAC THEN
13291   MP_TAC(ISPEC
13292    `(f:real^(M,N)finite_sum->real^P) o (\z. pastecart (sndcart z) (fstcart z))`
13293    FUBINI_TONELLI) THEN
13294   REWRITE_TAC[] THEN ANTS_TAC THENL
13295    [W(MP_TAC o PART_MATCH (lhand o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o
13296         snd) THEN
13297     ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN ANTS_TAC THENL
13298      [SIMP_TAC[linear; FORALL_PASTECART; FSTCART_PASTECART;
13299                SNDCART_PASTECART; PASTECART_INJ;
13300                FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL] THEN
13301       REWRITE_TAC[GSYM PASTECART_ADD; GSYM PASTECART_CMUL];
13302       DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN
13303       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
13304       MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN
13305       REWRITE_TAC[EXISTS_PASTECART; FORALL_PASTECART] THEN
13306       REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]];
13307     REWRITE_TAC[ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; o_DEF;
13308                 FSTCART_PASTECART; SNDCART_PASTECART]]);;