1(* ------------------------------------------------------------------------- *) 2(* Measure Theory defined on the extended reals *) 3(* Authors: Tarek Mhamdi, Osman Hasan, Sofiene Tahar (2013, 2015) [2] *) 4(* HVG Group, Concordia University, Montreal *) 5(* *) 6(* Measures are now in the range [0, +infinity] (type: 'a set -> extreal) *) 7(* ------------------------------------------------------------------------- *) 8(* Based on the work of Joe Hurd [4] (2001) and Aaron Coble [7] (2010) *) 9(* Cambridge University. *) 10(* ------------------------------------------------------------------------- *) 11(* The Uniqueness and Existence of Measure *) 12(* *) 13(* Author: Chun Tian (2018, 2019) *) 14(* Fondazione Bruno Kessler and University of Trento, Italy *) 15(* *) 16(* Caratheodory's extension theorem (real_measureTheory.CARATHEODORY) was *) 17(* originally proved by Joe Hurd [4] under algebra and [0, +inf) measure. *) 18(* The theorem is now reproved under semiring and [0, +inf] measure. *) 19(* ------------------------------------------------------------------------- *) 20 21open HolKernel Parse boolLib bossLib; 22 23open prim_recTheory arithmeticTheory optionTheory pairTheory 24 numpairTheory combinTheory pred_setTheory pred_setLib; 25 26open realTheory realLib seqTheory transcTheory real_sigmaTheory; 27 28open hurdUtils util_probTheory extrealTheory sigma_algebraTheory; 29 30val _ = new_theory "measure"; 31 32val DISC_RW_KILL = DISCH_TAC >> ONCE_ASM_REWRITE_TAC [] >> POP_ASSUM K_TAC; 33val SET_SPEC_TAC = SIMP_TAC (std_ss ++ SET_SPEC_ss); 34fun METIS ths tm = prove(tm, METIS_TAC ths); 35val set_ss = std_ss ++ PRED_SET_ss; 36 37val _ = hide "S"; 38 39(* ------------------------------------------------------------------------- *) 40(* Basic measure theory definitions. *) 41(* ------------------------------------------------------------------------- *) 42 43val _ = type_abbrev_pp ("measure", ``:'a set -> extreal``); 44val _ = type_abbrev_pp ("m_space", ``:'a set # 'a set set # 'a measure``); 45 46(* These're accessors of the triple of measure space *) 47val m_space_def = Define 48 `m_space (sp :'a set, sts :('a set) set, mu :('a set) -> extreal) = sp`; 49 50val measurable_sets_def = Define 51 `measurable_sets (sp :'a set, sts :('a set) set, mu :('a set) -> extreal) = sts`; 52 53val _ = hide "measure"; (* prim_recTheory *) 54val measure_def = Define 55 `measure (sp :'a set, sts :('a set) set, mu :('a set) -> extreal) = mu`; 56 57val _ = export_rewrites ["m_space_def", "measurable_sets_def", "measure_def"]; 58 59(* NOTE: `{} IN measurable_sets m` is not assumed, instead it must be provided by 60 definition of the system of sets. *) 61val positive_def = Define 62 `positive m <=> 63 (measure m {} = 0) /\ !s. s IN measurable_sets m ==> 0 <= measure m s`; 64 65(* NOTE: add ``s UNION t IN measurable_sets m`` into antecedents, like in the 66 case of "countably_additive_def", because otherwise this definition only works 67 with system of sets stable under (finite) union. *) 68val additive_def = Define 69 `additive m = 70 !s t. s IN measurable_sets m /\ t IN measurable_sets m /\ DISJOINT s t /\ 71 s UNION t IN measurable_sets m 72 ==> (measure m (s UNION t) = measure m s + measure m t)`; 73 74(* to derive finite additivity from countable additivity for all systems *) 75val finite_additive_def = Define (* new *) 76 `finite_additive m = 77 !f :num -> ('a -> bool) n. 78 (!i. i < n ==> f i IN measurable_sets m) /\ 79 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) /\ 80 BIGUNION (IMAGE f (count n)) IN measurable_sets m ==> 81 (measure m (BIGUNION (IMAGE f (count n))) = SIGMA (measure m o f) (count n))`; 82 83(* NOTE: ``summable (measure m o f)`` was removed from the antecedents *) 84val countably_additive_def = Define 85 `countably_additive m = 86 !f :num -> ('a -> bool). 87 f IN (UNIV -> measurable_sets m) /\ 88 (!i j. i <> j ==> DISJOINT (f i) (f j)) /\ 89 BIGUNION (IMAGE f UNIV) IN measurable_sets m ==> 90 (measure m (BIGUNION (IMAGE f UNIV)) = suminf (measure m o f))`; 91 92(* NOTE: added ``s UNION t IN measurable_sets m`` into antecedents *) 93val subadditive_def = Define 94 `subadditive m = 95 !s t. s IN measurable_sets m /\ t IN measurable_sets m /\ 96 s UNION t IN measurable_sets m 97 ==> measure m (s UNION t) <= measure m s + measure m t`; 98 99val finite_subadditive_def = Define (* new *) 100 `finite_subadditive m = 101 !f :num -> ('a set) n. 102 (!i. i < n ==> f i IN measurable_sets m) /\ 103 BIGUNION (IMAGE f (count n)) IN measurable_sets m ==> 104 measure m (BIGUNION (IMAGE f (count n))) <= SIGMA (measure m o f) (count n)`; 105 106val countably_subadditive_def = Define 107 `countably_subadditive m = 108 !f :num -> ('a set). 109 f IN (UNIV -> measurable_sets m) /\ 110 BIGUNION (IMAGE f UNIV) IN measurable_sets m ==> 111 measure m (BIGUNION (IMAGE f UNIV)) <= suminf (measure m o f)`; 112 113val increasing_def = Define 114 `increasing m = 115 !s t. 116 s IN measurable_sets m /\ t IN measurable_sets m /\ s SUBSET t ==> 117 measure m s <= measure m t`; 118 119val measure_space_def = Define 120 `measure_space m <=> 121 sigma_algebra (m_space m, measurable_sets m) /\ positive m /\ countably_additive m`; 122 123(* The set of measure-preserving measurable mappings. 124 NOTE: ``measure_space m1 /\ measure_space m2`` was removed. *) 125val measure_preserving_def = Define 126 `measure_preserving m1 m2 = 127 {f | 128 f IN measurable (m_space m1, measurable_sets m1) (m_space m2, measurable_sets m2) /\ 129 !s. 130 s IN measurable_sets m2 ==> 131 (measure m1 ((PREIMAGE f s) INTER (m_space m1)) = measure m2 s)}`; 132 133(* ------------------------------------------------------------------------- *) 134(* Basic measure theory theorems *) 135(* ------------------------------------------------------------------------- *) 136 137val positive_not_infty = store_thm 138 ("positive_not_infty", 139 ``!m. positive m ==> 140 (!s. s IN measurable_sets m ==> measure m s <> NegInf)``, 141 RW_TAC std_ss [positive_def] 142 >> METIS_TAC [lt_infty, extreal_of_num_def, extreal_not_infty, lte_trans]); 143 144(* added `u IN measurable_sets m` into antecedents *) 145val SUBADDITIVE = store_thm 146 ("SUBADDITIVE", 147 ``!m s t u. 148 subadditive m /\ s IN measurable_sets m /\ t IN measurable_sets m /\ 149 u IN measurable_sets m /\ (u = s UNION t) ==> 150 measure m u <= measure m s + measure m t``, 151 RW_TAC std_ss [subadditive_def] 152 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []); 153 154(* added `u IN measurable_sets m` into antecedents *) 155val ADDITIVE = store_thm 156 ("ADDITIVE", 157 ``!m s t u. 158 additive m /\ s IN measurable_sets m /\ t IN measurable_sets m /\ 159 DISJOINT s t /\ u IN measurable_sets m /\ (u = s UNION t) ==> 160 (measure m u = measure m s + measure m t)``, 161 RW_TAC std_ss [additive_def] 162 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []); 163 164(* removed `summable (measure m o f)` *) 165val COUNTABLY_SUBADDITIVE = store_thm 166 ("COUNTABLY_SUBADDITIVE", 167 ``!m f s. 168 countably_subadditive m /\ f IN (UNIV -> measurable_sets m) /\ 169 (s = BIGUNION (IMAGE f UNIV)) /\ 170 (s IN measurable_sets m) ==> 171 (measure m s <= suminf (measure m o f))``, 172 PROVE_TAC [countably_subadditive_def]); 173 174val ADDITIVE_SUM = store_thm 175 ("ADDITIVE_SUM", 176 ``!m f n. 177 algebra (m_space m, measurable_sets m) /\ positive m /\ additive m /\ 178 f IN (UNIV -> measurable_sets m) /\ 179 (!m n : num. ~(m = n) ==> DISJOINT (f m) (f n)) ==> 180 (SIGMA (measure m o f) (count n) = 181 measure m (BIGUNION (IMAGE f (count n))))``, 182 RW_TAC std_ss [IN_FUNSET, IN_UNIV] 183 >> Induct_on `n` 184 >- (RW_TAC std_ss [COUNT_ZERO,EXTREAL_SUM_IMAGE_EMPTY,IMAGE_EMPTY,BIGUNION_EMPTY] 185 >> PROVE_TAC [positive_def]) 186 >> `FINITE (count n)` by PROVE_TAC [FINITE_COUNT] 187 >> `!x. (measure m o f) x <> NegInf` by METIS_TAC [positive_not_infty,o_DEF] 188 >> RW_TAC std_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT,EXTREAL_SUM_IMAGE_PROPERTY] 189 >> `(IMAGE f (count n)) SUBSET measurable_sets m` by METIS_TAC [SUBSET_DEF,IN_IMAGE] 190 >> `measurable_sets m = subsets (m_space m,measurable_sets m)` 191 by (METIS_TAC [subsets_def,measurable_sets_def]) 192 >> `BIGUNION (IMAGE f (count n)) IN measurable_sets m` 193 by (RW_TAC std_ss [] 194 >> METIS_TAC [ALGEBRA_FINITE_UNION,IMAGE_FINITE]) 195 >> `DISJOINT (f n) (BIGUNION (IMAGE f (count n)))` 196 by (RW_TAC std_ss [DISJOINT_BIGUNION,IN_IMAGE,IN_COUNT] 197 >> `x <> n` by RW_TAC real_ss [] 198 >> METIS_TAC []) 199 >> `(count n) DELETE n = count n` by RW_TAC real_ss [EXTENSION,IN_DELETE,IN_COUNT] 200 >> POP_ORW >> art [] 201 >> MATCH_MP_TAC (GSYM ADDITIVE) 202 >> METIS_TAC [ALGEBRA_UNION]); 203 204val INCREASING = store_thm 205 ("INCREASING", 206 ``!m s t. 207 increasing m /\ s SUBSET t /\ s IN measurable_sets m /\ 208 t IN measurable_sets m ==> 209 measure m s <= measure m t``, 210 PROVE_TAC [increasing_def]); 211 212(* This result holds as long as m is a ring, cf. RING_ADDITIVE_INCREASING *) 213val ADDITIVE_INCREASING = store_thm (* merged *) 214 ("ADDITIVE_INCREASING", 215 ``!m. algebra (m_space m, measurable_sets m) /\ positive m /\ additive m ==> 216 increasing m``, 217 RW_TAC std_ss [increasing_def, positive_def] 218 >> Suff 219 `?u. u IN measurable_sets m /\ (measure m t = measure m s + measure m u)` 220 >- METIS_TAC [le_addr_imp] 221 >> Q.EXISTS_TAC `t DIFF s` 222 >> STRONG_CONJ_TAC >- PROVE_TAC [ALGEBRA_DIFF, subsets_def] 223 >> RW_TAC std_ss [] 224 >> MATCH_MP_TAC ADDITIVE 225 >> RW_TAC std_ss [DISJOINT_DEF,IN_DIFF,IN_UNION,EXTENSION,IN_INTER,NOT_IN_EMPTY] 226 >> PROVE_TAC [SUBSET_DEF]); 227 228val FINITE_ADDITIVE = store_thm 229 ("FINITE_ADDITIVE", 230 ``!m s f n. 231 finite_additive m /\ (!i. i < n ==> f i IN measurable_sets m) 232 /\ (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) /\ 233 (s = BIGUNION (IMAGE f (count n))) /\ s IN measurable_sets m ==> 234 (SIGMA (measure m o f) (count n) = measure m s)``, 235 RW_TAC std_ss [finite_additive_def] 236 >> MATCH_MP_TAC EQ_SYM 237 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []); 238 239val FINITE_ADDITIVE_ALT = store_thm 240 ("FINITE_ADDITIVE_ALT", 241 ``!m s c. 242 positive m /\ finite_additive m /\ c SUBSET measurable_sets m /\ 243 FINITE c /\ disjoint c /\ BIGUNION c IN measurable_sets m ==> 244 (SIGMA (measure m) c = measure m (BIGUNION c))``, 245 RW_TAC std_ss [finite_additive_def] 246 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition 247 (CONJ (ASSUME ``FINITE (c :'a set set)``) 248 (ASSUME ``disjoint (c :'a set set)``))) 249 >> ASM_REWRITE_TAC [] 250 >> Know `measure m (BIGUNION (IMAGE f (count n))) = SIGMA (measure m o f) (count n)` 251 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\ 252 CONJ_TAC >- PROVE_TAC [SUBSET_DEF] \\ 253 PROVE_TAC []) 254 >> Rewr' 255 >> irule EXTREAL_SUM_IMAGE_IMAGE 256 >> REWRITE_TAC [FINITE_COUNT, IN_COUNT, IN_IMAGE] 257 >> CONJ_TAC 258 >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> MATCH_MP_TAC pos_not_neginf >> art [] \\ 259 `f x' IN measurable_sets m` by PROVE_TAC [SUBSET_DEF] \\ 260 fs [positive_def]) 261 >> MATCH_MP_TAC INJ_IMAGE 262 >> Q.EXISTS_TAC `c` 263 >> RW_TAC std_ss [INJ_DEF, IN_COUNT] 264 >> METIS_TAC []); 265 266val FINITE_SUBADDITIVE = store_thm 267 ("FINITE_SUBADDITIVE", 268 ``!m s f n. 269 finite_subadditive m /\ (!i. i < n ==> f i IN measurable_sets m) /\ 270 (s = BIGUNION (IMAGE f (count n))) /\ s IN measurable_sets m ==> 271 measure m s <= SIGMA (measure m o f) (count n)``, 272 RW_TAC std_ss [finite_subadditive_def] 273 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []); 274 275val FINITE_SUBADDITIVE_ALT = store_thm 276 ("FINITE_SUBADDITIVE_ALT", 277 ``!m c. 278 positive m /\ finite_subadditive m /\ c SUBSET measurable_sets m /\ 279 FINITE c /\ disjoint c /\ BIGUNION c IN measurable_sets m ==> 280 measure m (BIGUNION c) <= SIGMA (measure m) c``, 281 RW_TAC std_ss [finite_subadditive_def] 282 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition 283 (CONJ (ASSUME ``FINITE (c :'a set set)``) 284 (ASSUME ``disjoint (c :'a set set)``))) 285 >> ASM_REWRITE_TAC [] 286 >> Know `measure m (BIGUNION (IMAGE f (count n))) <= SIGMA (measure m o f) (count n)` 287 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\ 288 CONJ_TAC >- PROVE_TAC [SUBSET_DEF] \\ 289 PROVE_TAC []) 290 >> DISCH_TAC 291 >> Suff `SIGMA (measure m) (IMAGE f (count n)) = SIGMA (measure m o f) (count n)` 292 >- METIS_TAC [] 293 >> irule EXTREAL_SUM_IMAGE_IMAGE 294 >> REWRITE_TAC [FINITE_COUNT, IN_COUNT, IN_IMAGE] 295 >> CONJ_TAC 296 >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> MATCH_MP_TAC pos_not_neginf >> art [] \\ 297 `f x' IN measurable_sets m` by PROVE_TAC [SUBSET_DEF] \\ 298 fs [positive_def]) 299 >> MATCH_MP_TAC INJ_IMAGE 300 >> Q.EXISTS_TAC `c` 301 >> RW_TAC std_ss [INJ_DEF, IN_COUNT] 302 >> METIS_TAC []); 303 304val COUNTABLY_ADDITIVE = store_thm 305 ("COUNTABLY_ADDITIVE", 306 ``!m s f. 307 countably_additive m /\ f IN (UNIV -> measurable_sets m) 308 /\ (!i j. i <> j ==> DISJOINT (f i) (f j)) /\ 309 (s = BIGUNION (IMAGE f UNIV)) /\ s IN measurable_sets m ==> 310 (suminf (measure m o f) = measure m s)``, 311 RW_TAC std_ss [] 312 >> PROVE_TAC [countably_additive_def]); 313 314val COUNTABLY_ADDITIVE_ADDITIVE_lemma = Q.prove ( 315 `!m s t. {} IN measurable_sets m /\ (measure m {} = 0) /\ 316 (!s. s IN measurable_sets m ==> 0 <= measure m s) /\ 317 s IN measurable_sets m /\ t IN measurable_sets m ==> 318 (suminf (measure m o (\n. if n = 0 then s else if n = 1 then t else {})) = 319 measure m s + measure m t)`, 320 rpt STRIP_TAC 321 >> `FINITE (count 2)` by RW_TAC std_ss [FINITE_COUNT] 322 >> `!n. FINITE ((count n) DIFF (count 2))` by METIS_TAC [FINITE_COUNT, FINITE_DIFF] 323 >> `!n:num. (2 <= n) ==> 324 (SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) (count n) = 325 SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) (count 2))` 326 by (Q.ABBREV_TAC `f = (\n:num. measure m (if n = 0 then s else if n = 1 then t else {}))` 327 >> RW_TAC std_ss [] 328 >> `count 2 SUBSET (count n)` by RW_TAC real_ss [SUBSET_DEF,IN_COUNT] 329 >> `(count n) = (count 2) UNION ((count n) DIFF (count 2))` 330 by RW_TAC std_ss [UNION_DIFF] 331 >> `DISJOINT (count 2) ((count n) DIFF (count 2))` 332 by RW_TAC real_ss [EXTENSION,IN_DISJOINT, IN_COUNT,IN_DIFF] 333 >> `!n. f n <> NegInf` 334 by (Q.UNABBREV_TAC `f` 335 >> RW_TAC std_ss [] 336 >> METIS_TAC [positive_def,positive_not_infty,extreal_of_num_def, 337 extreal_not_infty]) 338 >> (MP_TAC o (Q.SPECL [`count 2`,`count n DIFF count 2`]) o 339 (INST_TYPE [alpha |-> ``:num``])) EXTREAL_SUM_IMAGE_DISJOINT_UNION 340 >> FULL_SIMP_TAC std_ss [] 341 >> Suff `SIGMA f (count n DIFF count 2) = 0` >- METIS_TAC [add_rzero] 342 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_0 343 >> RW_TAC std_ss [IN_COUNT,IN_DIFF,NOT_LESS] 344 >> Q.UNABBREV_TAC `f` 345 >> RW_TAC real_ss []) 346 >> `SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) (count 2) = 347 measure m s + measure m t` 348 by (`count 2 = (1:num) INSERT {0}` 349 by METIS_TAC [TWO,ONE,COUNT_SUC,EXTENSION, IN_INSERT,COUNT_ZERO] 350 >> `~(0=1:num)` by RW_TAC real_ss [] 351 >> `{0:num} DELETE 1 = {0}` by METIS_TAC [DELETE_NON_ELEMENT,IN_SING] 352 >> (MP_TAC o (Q.SPEC `1:num` o REWRITE_RULE [FINITE_SING]) o 353 (Q.SPECL [`(measure m o (\n. if n = 0 then s else if n = 1 then t else {}))`, 354 `{0:num}`])) 355 (INST_TYPE [``:'a`` |-> ``:num`` ] EXTREAL_SUM_IMAGE_PROPERTY) 356 >> RW_TAC real_ss [EXTREAL_SUM_IMAGE_SING,o_DEF] 357 >> `measure m s + measure m t = measure m t + measure m s` 358 by METIS_TAC [positive_def,positive_not_infty,add_comm] 359 >> POP_ORW 360 >> POP_ASSUM MATCH_MP_TAC 361 >> DISJ1_TAC 362 >> RW_TAC real_ss [] >> METIS_TAC [positive_def,positive_not_infty, 363 add_comm,extreal_of_num_def,extreal_not_infty]) 364 (* stage work *) 365 >> Know `!i:num. 0 <= (measure m o (\n. if n = 0 then s else if n = 1 366 then t else {})) i` 367 >- RW_TAC std_ss [o_DEF] 368 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' 369 >> RW_TAC std_ss [sup_eq', o_DEF, IN_IMAGE, IN_UNIV] 370 >- (Cases_on `2 <= n` >- METIS_TAC [le_refl] \\ 371 `(n = 0) \/ (n = 1)` by RW_TAC real_ss [] 372 >- RW_TAC real_ss [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY, le_add] \\ 373 `count 1 = {0}` by RW_TAC real_ss [EXTENSION, IN_COUNT, IN_SING] \\ 374 FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_SING, le_addr_imp]) 375 >> Suff `(measure m s + measure m t) IN 376 IMAGE (\n. SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) 377 (count n)) univ(:num)` 378 >- METIS_TAC [IN_DEF] 379 >> RW_TAC std_ss [IN_IMAGE, IN_UNIV] 380 >> Q.EXISTS_TAC `2` 381 >> METIS_TAC []); 382 383(* removed `algebra (m_space m, measurable_sets m)` from antecedents, 384 added `{} IN measurable_sets m` into antecedents. *) 385val COUNTABLY_ADDITIVE_ADDITIVE = store_thm 386 ("COUNTABLY_ADDITIVE_ADDITIVE", 387 ``!m. {} IN measurable_sets m /\ positive m /\ countably_additive m ==> additive m``, 388(* proof *) 389 RW_TAC std_ss [additive_def, positive_def, countably_additive_def] 390 >> Q.PAT_X_ASSUM `!f. P f` 391 (MP_TAC o Q.SPEC `\n : num. if n = 0 then s else if n = 1 then t else {}`) 392 >> Know 393 `BIGUNION 394 (IMAGE (\n : num. (if n = 0 then s else (if n = 1 then t else {}))) 395 UNIV) = 396 s UNION t` 397 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION] 398 >> EQ_TAC >- PROVE_TAC [NOT_IN_EMPTY] 399 >> Know `~(1 = (0:num))` >- DECIDE_TAC 400 >> RW_TAC std_ss [] >- PROVE_TAC [] 401 >> Q.EXISTS_TAC `t` 402 >> RW_TAC std_ss [] 403 >> Q.EXISTS_TAC `1` 404 >> RW_TAC std_ss [] 405 >> PROVE_TAC []) 406 >> Rewr 407 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV] 408 >> `!n:num. (if n = 0 then s else if n = 1 then t else {}) IN measurable_sets m` 409 by METIS_TAC [] 410 >> `!m n:num. m <> n ==> DISJOINT (if m = 0 then s else if m = 1 then t else {}) 411 (if n = 0 then s else if n = 1 then t else {})` 412 by RW_TAC real_ss [DISJOINT_EMPTY, DISJOINT_SYM] 413 >> FULL_SIMP_TAC std_ss [] 414 >> NTAC 5 (POP_ASSUM K_TAC) 415 (* now use the lemma instead *) 416 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE_lemma >> art []); 417 418Theorem COUNTABLY_SUBADDITIVE_SUBADDITIVE : 419 !m. {} IN measurable_sets m /\ positive m /\ countably_subadditive m ==> 420 subadditive m 421Proof 422 RW_TAC std_ss [subadditive_def, positive_def, countably_subadditive_def] 423 >> Q.PAT_X_ASSUM `!f. P f` 424 (MP_TAC o Q.SPEC `\n : num. if n = 0 then s else if n = 1 then t else {}`) 425 >> Know 426 `BIGUNION 427 (IMAGE (\n : num. (if n = 0 then s else (if n = 1 then t else {}))) UNIV) = 428 s UNION t` 429 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION] 430 >> EQ_TAC >- PROVE_TAC [NOT_IN_EMPTY] 431 >> Know `~(1 = (0:num))` >- DECIDE_TAC 432 >> RW_TAC std_ss [] >- PROVE_TAC [] 433 >> Q.EXISTS_TAC `t` 434 >> RW_TAC std_ss [] 435 >> Q.EXISTS_TAC `1` 436 >> RW_TAC std_ss [] 437 >> PROVE_TAC []) 438 >> Rewr 439 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV] 440 >> `!n:num. (if n = 0 then s else if n = 1 then t else {}) IN measurable_sets m` 441 by METIS_TAC [] 442 >> fs [] 443 >> POP_ASSUM K_TAC 444 >> Suff `suminf (measure m o (\n. if n = 0 then s else if n = 1 then t else {})) = 445 measure m s + measure m t` >- METIS_TAC [] 446 >> NTAC 2 (POP_ASSUM K_TAC) 447 (* now use the lemma instead *) 448 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE_lemma >> art [] 449QED 450 451val COUNTABLY_ADDITIVE_FINITE_ADDITIVE_lemma = Q.prove ( 452 `!m f n. {} IN measurable_sets m /\ (measure m {} = 0) /\ 453 (!s. s IN measurable_sets m ==> 0 <= measure m s) /\ 454 (!i. i < n ==> f i IN measurable_sets m) ==> 455 (suminf (measure m o (\i. if i < n then f i else {})) = SIGMA (measure m o f) (count n))`, 456 rpt STRIP_TAC 457 >> Know `!j. 0 <= (measure m o (\i. if i < n then f i else {})) j` 458 >- RW_TAC std_ss [o_DEF, le_refl] 459 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr 460 >> RW_TAC std_ss [sup_eq, o_DEF, IN_IMAGE, IN_UNIV] 461 >- (`y IN IMAGE (\n'. SIGMA (\i. measure m (if i < n then f i else {})) (count n')) univ(:num)` 462 by METIS_TAC [IN_DEF] \\ 463 FULL_SIMP_TAC std_ss [IN_IMAGE, IN_UNIV] \\ 464 Cases_on `n <= n'` 465 >- (Know `SIGMA (\i. measure m (if i < n then f i else {})) (count n') = 466 SIGMA (\i. measure m (if i < n then f i else {})) (count n)` 467 >- (Q.ABBREV_TAC `g = (\i:num. measure m (if i < n then f i else {}))` \\ 468 `count n SUBSET count n'` by RW_TAC arith_ss [SUBSET_DEF, IN_COUNT] \\ 469 `count n UNION (count n' DIFF count n) = count n'` by RW_TAC std_ss [UNION_DIFF] \\ 470 (MP_TAC o (Q.SPECL [`count n`,`count n' DIFF count n`]) o 471 (INST_TYPE [alpha |-> ``:num``])) EXTREAL_SUM_IMAGE_DISJOINT_UNION \\ 472 `DISJOINT (count n) (count n' DIFF count n)` 473 by RW_TAC real_ss [EXTENSION, IN_DISJOINT, IN_COUNT, IN_DIFF] \\ 474 `FINITE (count n)` by PROVE_TAC [FINITE_COUNT] \\ 475 `FINITE (count n' DIFF count n)` by PROVE_TAC [FINITE_COUNT, FINITE_DIFF] \\ 476 `!n. g n <> NegInf` 477 by (Q.UNABBREV_TAC `g` >> RW_TAC std_ss [] \\ 478 METIS_TAC [positive_def, positive_not_infty, extreal_of_num_def, 479 extreal_not_infty]) \\ 480 FULL_SIMP_TAC std_ss [] \\ 481 rpt STRIP_TAC \\ 482 Suff `SIGMA g (count n' DIFF count n) = 0` >- METIS_TAC [add_rzero] \\ 483 MATCH_MP_TAC EXTREAL_SUM_IMAGE_0 \\ 484 RW_TAC std_ss [IN_COUNT, IN_DIFF, NOT_LESS] \\ 485 Q.UNABBREV_TAC `g` >> RW_TAC arith_ss []) \\ 486 Rewr \\ 487 irule EXTREAL_SUM_IMAGE_MONO \\ 488 RW_TAC std_ss [le_refl, IN_COUNT, FINITE_COUNT] \\ 489 DISJ1_TAC \\ 490 RW_TAC arith_ss [IN_COUNT] >> PROVE_TAC [le_not_infty]) \\ 491 Know `SIGMA (\x. measure m (f x)) (count n) = 492 SIGMA (\x. if x IN count n then (\x. measure m (f x)) x else 0) (count n)` 493 >- (irule EXTREAL_SUM_IMAGE_IN_IF \\ 494 REWRITE_TAC [FINITE_COUNT] >> DISJ1_TAC >> PROVE_TAC [IN_COUNT, le_not_infty]) \\ 495 Rewr >> SIMP_TAC std_ss [IN_COUNT] \\ 496 `(\i. measure m (if i < n then f i else {})) = (\x. if x < n then measure m (f x) else 0)` 497 by METIS_TAC [] >> POP_ORW \\ 498 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> REWRITE_TAC [FINITE_COUNT] \\ 499 CONJ_TAC >- RW_TAC arith_ss [SUBSET_DEF, IN_COUNT] \\ 500 RW_TAC std_ss [IN_COUNT]) 501 (* SIGMA (\x. measure m (f x)) (count n) <= y *) 502 >> Know `SIGMA (\x. measure m (f x)) (count n) = 503 SIGMA (\i. measure m (if i < n then f i else {})) (count n)` 504 >- (Know `SIGMA (\x. measure m (f x)) (count n) = 505 SIGMA (\x. if x IN count n then (\x. measure m (f x)) x else 0) (count n)` 506 >- (irule EXTREAL_SUM_IMAGE_IN_IF \\ 507 REWRITE_TAC [FINITE_COUNT] >> DISJ1_TAC >> PROVE_TAC [IN_COUNT, le_not_infty]) \\ 508 Rewr >> SIMP_TAC std_ss [IN_COUNT] \\ 509 `(\x. if x < n then measure m (f x) else 0) = (\i. measure m (if i < n then (f i) else {}))` 510 by METIS_TAC [] >> POP_ORW \\ 511 REWRITE_TAC []) 512 >> Rewr 513 >> POP_ASSUM MATCH_MP_TAC 514 >> Suff `(SIGMA (\i. measure m (if i < n then f i else {})) (count n)) IN 515 (IMAGE (\n'. SIGMA (\i. measure m (if i < n then f i else {})) (count n')) univ(:num))` 516 >- METIS_TAC [IN_APP] 517 >> SIMP_TAC std_ss [IN_IMAGE, IN_UNIV] 518 >> Q.EXISTS_TAC `n` 519 >> METIS_TAC []); 520 521Theorem COUNTABLY_ADDITIVE_FINITE_ADDITIVE : 522 !m. {} IN measurable_sets m /\ positive m /\ countably_additive m ==> 523 finite_additive m 524Proof 525 RW_TAC std_ss [positive_def, countably_additive_def, finite_additive_def, 526 IN_FUNSET, IN_UNIV] 527 >> Q.PAT_X_ASSUM `!f. P f` (MP_TAC o Q.SPEC `\i :num. if i < n then (f i) else {}`) 528 >> Know 529 `BIGUNION (IMAGE (\i :num. if i < n then (f i) else {}) UNIV) = 530 BIGUNION (IMAGE f (count n))` 531 >- (RW_TAC arith_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION, IN_COUNT] \\ 532 EQ_TAC >> rpt STRIP_TAC >| 533 [ (* goal 1 (of 2) *) 534 Q.EXISTS_TAC `s` \\ 535 CONJ_TAC >- (POP_ASSUM K_TAC >> art []) \\ 536 Q.EXISTS_TAC `i` >> PROVE_TAC [NOT_IN_EMPTY], 537 (* goal 2 (of 2) *) 538 Q.EXISTS_TAC `s` \\ 539 CONJ_TAC >- (NTAC 2 (POP_ASSUM K_TAC) >> art []) \\ 540 Q.EXISTS_TAC `x'` >> PROVE_TAC [NOT_IN_EMPTY] ]) >> Rewr 541 >> RW_TAC std_ss [] 542 (* `{} IN measurable_sets m` is used here *) 543 >> `!i:num. (if i < n then (f i) else {}) IN measurable_sets m` by METIS_TAC [] 544 >> `!i j:num. i <> j ==> DISJOINT (if i < n then (f i) else {}) 545 (if j < n then (f j) else {})` 546 by RW_TAC real_ss [DISJOINT_EMPTY,DISJOINT_SYM] 547 >> FULL_SIMP_TAC std_ss [] 548 >> NTAC 5 (POP_ASSUM K_TAC) 549 (* now use the lemma instead *) 550 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE_lemma >> art [] 551QED 552 553Theorem COUNTABLY_SUBADDITIVE_FINITE_SUBADDITIVE : 554 !m. {} IN measurable_sets m /\ positive m /\ countably_subadditive m ==> 555 finite_subadditive m 556Proof 557 RW_TAC std_ss [positive_def, countably_subadditive_def, finite_subadditive_def, 558 IN_FUNSET, IN_UNIV] 559 >> Q.PAT_X_ASSUM `!f. P f` (MP_TAC o Q.SPEC `\i :num. if i < n then (f i) else {}`) 560 >> Know 561 `BIGUNION (IMAGE (\i :num. if i < n then (f i) else {}) UNIV) = 562 BIGUNION (IMAGE f (count n))` 563 >- (RW_TAC arith_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION, IN_COUNT] \\ 564 EQ_TAC >> rpt STRIP_TAC >| 565 [ (* goal 1 (of 2) *) 566 Q.EXISTS_TAC `s` \\ 567 CONJ_TAC >- (POP_ASSUM K_TAC >> art []) \\ 568 Q.EXISTS_TAC `i` >> PROVE_TAC [NOT_IN_EMPTY], 569 (* goal 2 (of 2) *) 570 Q.EXISTS_TAC `s` \\ 571 CONJ_TAC >- (NTAC 2 (POP_ASSUM K_TAC) >> art []) \\ 572 Q.EXISTS_TAC `x'` >> PROVE_TAC [NOT_IN_EMPTY] ]) >> Rewr 573 >> RW_TAC std_ss [] 574 (* `{} IN measurable_sets m` is used here *) 575 >> `!x:num. (if x < n then (f x) else {}) IN measurable_sets m` by METIS_TAC [] 576 >> FULL_SIMP_TAC std_ss [] 577 >> POP_ASSUM K_TAC 578 >> Suff `suminf (measure m o (\i. if i < n then f i else {})) = SIGMA (measure m o f) (count n)` 579 >- METIS_TAC [] 580 >> NTAC 2 (POP_ASSUM K_TAC) 581 (* now use the lemma instead *) 582 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE_lemma >> art [] 583QED 584 585val MEASURE_DOWN = store_thm 586 ("MEASURE_DOWN", 587 ``!m0 m1. 588 sigma_algebra (m_space m0,measurable_sets m0) /\ 589 measurable_sets m0 SUBSET measurable_sets m1 /\ 590 (measure m0 = measure m1) /\ measure_space m1 ==> 591 measure_space m0``, 592 RW_TAC std_ss [measure_space_def, positive_def, SUBSET_DEF, 593 countably_additive_def, IN_FUNSET, IN_UNIV]); 594 595(* added ``measure m s < PosInf`` into antecedents, cf. MEASURE_SPACE_FINITE_DIFF *) 596val MEASURE_COMPL = store_thm 597 ("MEASURE_COMPL", 598 ``!m s. 599 measure_space m /\ s IN measurable_sets m /\ 600 measure m s < PosInf ==> 601 (measure m (m_space m DIFF s) = measure m (m_space m) - measure m s)``, 602 RW_TAC std_ss [] 603 >> Know `(measure m (m_space m DIFF s) = measure m (m_space m) - measure m s) <=> 604 (measure m (m_space m DIFF s) + measure m s = measure m (m_space m))` 605 >- (MATCH_MP_TAC eq_sub_ladd \\ 606 `positive m` by PROVE_TAC [measure_space_def] \\ 607 PROVE_TAC [positive_not_infty, lt_infty]) 608 >> DISCH_THEN (REWRITE_TAC o wrap) 609 >> MATCH_MP_TAC EQ_SYM 610 >> MATCH_MP_TAC ADDITIVE 611 >> Q.PAT_X_ASSUM `measure_space m` MP_TAC 612 >> RW_TAC std_ss [measure_space_def, sigma_algebra_def, DISJOINT_DEF, 613 EXTENSION, IN_DIFF, IN_UNIV, IN_UNION, IN_INTER, 614 NOT_IN_EMPTY] 615 >> PROVE_TAC [COUNTABLY_ADDITIVE_ADDITIVE, ALGEBRA_COMPL, subsets_def, space_def, 616 algebra_def, subset_class_def, SUBSET_DEF, ALGEBRA_SPACE, positive_def]); 617 618val MEASURE_EMPTY = store_thm 619 ("MEASURE_EMPTY", 620 ``!m. measure_space m ==> (measure m {} = 0)``, 621 RW_TAC std_ss [measure_space_def, positive_def]); 622 623val SIGMA_SUBSET_MEASURABLE_SETS = store_thm 624 ("SIGMA_SUBSET_MEASURABLE_SETS", 625 ``!a m. 626 measure_space m /\ a SUBSET measurable_sets m ==> 627 subsets (sigma (m_space m) a) SUBSET measurable_sets m``, 628 RW_TAC std_ss [measure_space_def] 629 >> MATCH_MP_TAC SIGMA_PROPERTY 630 >> RW_TAC std_ss [IN_INTER, SUBSET_INTER] 631 >> PROVE_TAC [SIGMA_ALGEBRA, space_def, subsets_def]); 632 633val MEASURE_COUNTABLY_ADDITIVE = store_thm (* merged *) 634 ("MEASURE_COUNTABLY_ADDITIVE", 635 ``!m s f. 636 measure_space m /\ f IN (UNIV -> measurable_sets m) /\ 637 (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) /\ 638 (s = BIGUNION (IMAGE f UNIV)) ==> 639 (suminf (measure m o f) = measure m s)``, 640 RW_TAC std_ss [] 641 >> MATCH_MP_TAC COUNTABLY_ADDITIVE 642 >> RW_TAC std_ss [] 643 >- PROVE_TAC [measure_space_def] 644 >> (MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o 645 Q.SPEC `(m_space m, measurable_sets m)`) SIGMA_ALGEBRA_COUNTABLE_UNION 646 >> CONJ_TAC >- PROVE_TAC [measure_space_def] 647 >> Q.PAT_X_ASSUM `f IN P` MP_TAC 648 >> RW_TAC std_ss [COUNTABLE_IMAGE_NUM, SUBSET_DEF, IN_IMAGE, IN_UNIV, 649 IN_FUNSET] 650 >> PROVE_TAC []); 651 652val MEASURE_SPACE_ADDITIVE = store_thm 653 ("MEASURE_SPACE_ADDITIVE", 654 ``!m. measure_space m ==> additive m``, 655 RW_TAC std_ss [] 656 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE 657 >> PROVE_TAC [measure_space_def, SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY, subsets_def]); 658 659val MEASURE_ADDITIVE = store_thm 660 ("MEASURE_ADDITIVE", 661 ``!m s t u. 662 measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\ 663 DISJOINT s t /\ (u = s UNION t) ==> 664 (measure m u = measure m s + measure m t)``, 665 RW_TAC std_ss [] 666 >> MATCH_MP_TAC ADDITIVE 667 >> RW_TAC std_ss [MEASURE_SPACE_ADDITIVE] 668 >> PROVE_TAC [measure_space_def, SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_UNION, subsets_def]); 669 670(* The following theorems were merged from measure_hvgScript.sml *) 671val MEASURE_SPACE_INCREASING = store_thm 672 ("MEASURE_SPACE_INCREASING", ``!m. measure_space m ==> increasing m``, 673 RW_TAC real_ss [] 674 >> `additive m` by RW_TAC real_ss [MEASURE_SPACE_ADDITIVE] 675 >> FULL_SIMP_TAC real_ss [measure_space_def,sigma_algebra_def,ADDITIVE_INCREASING]); 676 677val MEASURE_SPACE_POSITIVE = store_thm 678 ("MEASURE_SPACE_POSITIVE",``!m. measure_space m ==> positive m``, 679 PROVE_TAC [measure_space_def]); 680 681Theorem measure_space_eq : 682 !m1 m2. measure_space m1 /\ 683 (m_space m2 = m_space m1) /\ 684 (measurable_sets m2 = measurable_sets m1) /\ 685 (!s. s IN measurable_sets m2 ==> (measure m2 s = measure m1 s)) ==> 686 measure_space m2 687Proof 688 rpt STRIP_TAC 689 >> RW_TAC std_ss [measure_space_def] 690 >| [ (* goal 1 (of 3) *) 691 fs [measure_space_def], 692 (* goal 2 (of 3) *) 693 IMP_RES_TAC MEASURE_SPACE_POSITIVE \\ 694 rw [positive_def] 695 >- (���{} IN measurable_sets m1��� by 696 fs [measure_space_def, sigma_algebra_def, algebra_def] \\ 697 fs [positive_def]) \\ 698 fs [positive_def], 699 (* goal 3 (of 3) *) 700 rw [countably_additive_def, IN_FUNSET, IN_UNIV, o_DEF] \\ 701 fs [measure_space_def, countably_additive_def, IN_FUNSET, IN_UNIV, o_DEF] ] 702QED 703 704val MEASURE_SPACE_INTER = store_thm 705 ("MEASURE_SPACE_INTER", 706 ``!m s t. (measure_space m) /\ (s IN measurable_sets m) /\ (t IN measurable_sets m) ==> 707 (s INTER t IN measurable_sets m)``, 708 METIS_TAC [measure_space_def,sigma_algebra_def,subsets_def, 709 (REWRITE_RULE [subsets_def] (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER))]); 710 711val MEASURE_SPACE_UNION = store_thm 712 ("MEASURE_SPACE_UNION", 713 ``!m s t. (measure_space m) /\ (s IN measurable_sets m) /\ (t IN measurable_sets m) ==> 714 (s UNION t IN measurable_sets m)``, 715 METIS_TAC [measure_space_def,sigma_algebra_def,subsets_def, 716 (REWRITE_RULE [subsets_def] (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_UNION))]); 717 718val MEASURE_SPACE_DIFF = store_thm 719 ("MEASURE_SPACE_DIFF", 720 ``!m s t. (measure_space m) /\ (s IN measurable_sets m) /\ (t IN measurable_sets m) ==> 721 (s DIFF t IN measurable_sets m)``, 722 METIS_TAC [measure_space_def,sigma_algebra_def,subsets_def, 723 (REWRITE_RULE [subsets_def] (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_DIFF))]); 724 725Theorem MEASURE_SPACE_SPACE : 726 !m. measure_space m ==> m_space m IN measurable_sets m 727Proof 728 RW_TAC std_ss [measure_space_def, sigma_algebra_def, subsets_def] 729 >> MATCH_MP_TAC 730 (REWRITE_RULE [space_def, subsets_def] 731 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_SPACE)) 732 >> ASM_REWRITE_TAC [] 733QED 734 735Theorem MEASURE_SPACE_COMPL : 736 !m s. measure_space m /\ s IN measurable_sets m ==> 737 (m_space m) DIFF s IN measurable_sets m 738Proof 739 rpt STRIP_TAC 740 >> MATCH_MP_TAC MEASURE_SPACE_DIFF >> art [] 741 >> MATCH_MP_TAC MEASURE_SPACE_SPACE >> art [] 742QED 743 744val MEASURE_SPACE_BIGUNION = store_thm 745 ("MEASURE_SPACE_BIGUNION", 746 ``!m s. measure_space m /\ (!n:num. s n IN measurable_sets m) ==> 747 (BIGUNION (IMAGE s UNIV) IN measurable_sets m)``, 748 RW_TAC std_ss [] 749 >> (MP_TAC o REWRITE_RULE [subsets_def,space_def,IN_UNIV,IN_FUNSET] o 750 (Q.SPEC `(m_space m,measurable_sets m)`)) SIGMA_ALGEBRA_FN 751 >> METIS_TAC [measure_space_def]); 752 753val MEASURE_SPACE_IN_MSPACE = store_thm 754 ("MEASURE_SPACE_IN_MSPACE", 755 ``!m A. measure_space m /\ A IN measurable_sets m ==> (!x. x IN A ==> x IN m_space m)``, 756 METIS_TAC [measure_space_def,sigma_algebra_def,algebra_def,measurable_sets_def, 757 space_def,subset_class_def,subsets_def,SUBSET_DEF]); 758 759val MEASURE_SPACE_SUBSET_MSPACE = store_thm 760 ("MEASURE_SPACE_SUBSET_MSPACE", 761 ``!A m. measure_space m /\ A IN measurable_sets m ==> A SUBSET m_space m``, 762 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def,subset_class_def, 763 subsets_def, space_def]); 764 765val MEASURE_SPACE_EMPTY_MEASURABLE = store_thm 766 ("MEASURE_SPACE_EMPTY_MEASURABLE",``!m. measure_space m ==> {} IN measurable_sets m``, 767 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def,subsets_def, space_def]); 768 769val MEASURE_SPACE_MSPACE_MEASURABLE = store_thm 770 ("MEASURE_SPACE_MSPACE_MEASURABLE",``!m. measure_space m ==> (m_space m) IN measurable_sets m``, 771 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def, subsets_def, space_def] 772 >> METIS_TAC [DIFF_EMPTY]); 773 774val MEASURE_SPACE_BIGINTER = store_thm 775 ("MEASURE_SPACE_BIGINTER", 776 ``!m s. measure_space m /\ (!n:num. s n IN measurable_sets m) ==> 777 (BIGINTER (IMAGE s UNIV) IN measurable_sets m)``, 778 RW_TAC std_ss [] 779 >> (MP_TAC o REWRITE_RULE [subsets_def,space_def,IN_UNIV,IN_FUNSET] o 780 (Q.SPEC `(m_space m,measurable_sets m)`)) SIGMA_ALGEBRA_FN_BIGINTER 781 >> METIS_TAC [measure_space_def]); 782 783(* use MONOTONE_CONVERGENCE when `f 0 = {}` doesn't hold *) 784Theorem MEASURE_COUNTABLE_INCREASING : 785 !m s f. 786 measure_space m /\ f IN (UNIV -> measurable_sets m) /\ 787 (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) /\ 788 (s = BIGUNION (IMAGE f UNIV)) ==> 789 (sup (IMAGE (measure m o f) UNIV) = measure m s) 790Proof 791 RW_TAC std_ss [IN_FUNSET, IN_UNIV] 792 >> Know `measure m o f = (\n. SIGMA (measure m o (\m. f (SUC m) DIFF f m)) (count n))` 793 >- (FUN_EQ_TAC 794 >> Induct >- RW_TAC std_ss [o_THM, MEASURE_EMPTY,COUNT_ZERO,EXTREAL_SUM_IMAGE_EMPTY] 795 >> POP_ASSUM (MP_TAC o SYM) 796 >> RW_TAC arith_ss [o_THM, COUNT_SUC] 797 >> Know `!n. (measure m o (\m. f (SUC m) DIFF f m)) n <> NegInf` 798 >- ( RW_TAC std_ss [] 799 >> `f (SUC n) DIFF f n IN measurable_sets m` 800 by METIS_TAC [measure_space_def, sigma_algebra_def, algebra_def, ALGEBRA_DIFF, 801 subsets_def] 802 >> METIS_TAC [measure_space_def,positive_not_infty,o_DEF] ) 803 >> DISCH_TAC 804 >> `FINITE (count x)` by RW_TAC std_ss [FINITE_COUNT] 805 >> `count x DELETE x = count x` 806 by METIS_TAC [IN_COUNT, DELETE_NON_ELEMENT, LESS_REFL] 807 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY] 808 >> MATCH_MP_TAC MEASURE_ADDITIVE 809 >> FULL_SIMP_TAC std_ss [EXTENSION, IN_UNION, IN_DIFF, DISJOINT_DEF, NOT_IN_EMPTY, 810 IN_INTER, SUBSET_DEF] 811 >> Know `algebra (m_space m, measurable_sets m)` 812 >- FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def, 813 space_def, subsets_def] 814 >> DISCH_TAC 815 >> (MP_TAC o REWRITE_RULE [subsets_def, space_def] o 816 (Q.SPEC `(m_space m, measurable_sets m)`)) ALGEBRA_DIFF 817 >> PROVE_TAC []) 818 >> Rewr 819 >> Know `!n. 0 <= (measure m o (\m. f (SUC m) DIFF f m)) n` 820 >- (RW_TAC std_ss [o_DEF] \\ 821 IMP_RES_TAC MEASURE_SPACE_POSITIVE \\ 822 fs [positive_def] \\ 823 FIRST_X_ASSUM MATCH_MP_TAC \\ 824 MATCH_MP_TAC MEASURE_SPACE_DIFF >> art []) 825 >> DISCH_THEN (MP_TAC o SYM o (MATCH_MP ext_suminf_def)) >> Rewr' 826 >> MATCH_MP_TAC COUNTABLY_ADDITIVE 827 >> CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def] 828 >> CONJ_TAC 829 >- (RW_TAC std_ss [IN_UNIV,IN_FUNSET] 830 >> (((MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o 831 (Q.SPEC `(m_space m, measurable_sets m)`)) ALGEBRA_DIFF 832 >> FULL_SIMP_TAC std_ss [measure_space_def,sigma_algebra_def]))) 833 >> CONJ_TAC 834 >- (rpt STRIP_TAC 835 >> MATCH_MP_TAC DISJOINT_DIFFS 836 >> Q.EXISTS_TAC `f` 837 >> RW_TAC std_ss []) 838 >> CONJ_TAC 839 >- (RW_TAC std_ss [IN_BIGUNION_IMAGE,IN_DIFF,IN_UNIV,EXTENSION] 840 >> reverse (EQ_TAC >> RW_TAC std_ss []) 841 >- METIS_TAC [] 842 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY] 843 >> METIS_TAC []) 844 >> (MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o 845 (Q.SPEC `(m_space m, measurable_sets m)`)) SIGMA_ALGEBRA_COUNTABLE_UNION 846 >> CONJ_TAC >- PROVE_TAC [measure_space_def] 847 >> RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV,COUNTABLE_IMAGE_NUM] 848 >> PROVE_TAC [] 849QED 850 851(* cf. MEASURE_COMPL *) 852val MEASURE_SPACE_FINITE_DIFF = store_thm 853 ("MEASURE_SPACE_FINITE_DIFF", 854 ``!m s. measure_space m /\ s IN measurable_sets m /\ measure m s <> PosInf ==> 855 (measure m (m_space m DIFF s) = measure m (m_space m) - measure m s)``, 856 RW_TAC std_ss [] 857 >> `(m_space m) IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_MSPACE_MEASURABLE] 858 >> `(m_space m DIFF s) IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_DIFF] 859 >> `!s. s IN measurable_sets m ==> measure m s <> NegInf` 860 by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty] 861 >> `measure m (m_space m DIFF s) <= measure m (m_space m)` 862 by METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,MEASURE_SPACE_SUBSET_MSPACE] 863 >> `measure m (m_space m) = measure m (m_space m DIFF s) + measure m s` 864 by METIS_TAC [MEASURE_SPACE_ADDITIVE,UNION_DIFF,DISJOINT_DIFF,MEASURE_SPACE_SUBSET_MSPACE,ADDITIVE] 865 >> Cases_on `measure m (m_space m DIFF s)` 866 >> Cases_on `measure m (m_space m)` 867 >> Cases_on `measure m s` 868 >> RW_TAC std_ss [extreal_sub_def,extreal_not_infty,extreal_add_def] 869 >> FULL_SIMP_TAC std_ss [extreal_add_def,REAL_EQ_SUB_LADD,REAL_ADD_COMM,EQ_SYM,extreal_11] 870 >> METIS_TAC [lt_infty,extreal_not_infty,let_trans,extreal_add_def]); 871 872(* cf. MEASURE_DIFF_SUBSET *) 873val MEASURE_SPACE_FINITE_DIFF_SUBSET = store_thm 874 ("MEASURE_SPACE_FINITE_DIFF_SUBSET", 875 ``!m s t. measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\ 876 t SUBSET s /\ measure m s <> PosInf ==> 877 (measure m (s DIFF t) = measure m s - measure m t)``, 878 RW_TAC std_ss [] 879 >> `!s. s IN measurable_sets m ==> measure m s <> NegInf` 880 by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty] 881 >> `measure m s = measure m (s DIFF t) + measure m t` 882 by (MATCH_MP_TAC ADDITIVE 883 >> METIS_TAC [MEASURE_SPACE_ADDITIVE,UNION_DIFF,DISJOINT_DIFF,ADDITIVE,MEASURE_SPACE_DIFF]) 884 >> `s DIFF t IN measurable_sets m ` by METIS_TAC [MEASURE_SPACE_DIFF] 885 >> `measure m (s DIFF t) <= measure m s` by METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,DIFF_SUBSET] 886 >> `measure m (s DIFF t) <> PosInf` by METIS_TAC [lt_infty,let_trans] 887 >> `measure m t <> PosInf` by METIS_TAC [lt_infty,let_trans,MEASURE_SPACE_INCREASING,INCREASING] 888 >> Cases_on `measure m (s DIFF t)` 889 >> Cases_on `measure m s` 890 >> Cases_on `measure m t` 891 >> RW_TAC std_ss [extreal_sub_def,extreal_not_infty,extreal_add_def] 892 >> FULL_SIMP_TAC real_ss [extreal_add_def,extreal_11] 893 >> METIS_TAC []); 894 895val MEASURE_SPACE_FINITE_MEASURE = store_thm 896 ("MEASURE_SPACE_FINITE_MEASURE", 897 ``!m s. measure_space m /\ s IN measurable_sets m /\ measure m (m_space m) <> PosInf ==> 898 measure m s <> PosInf``, 899 METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,MEASURE_SPACE_MSPACE_MEASURABLE, 900 lt_infty,let_trans,MEASURE_SPACE_SUBSET_MSPACE]); 901 902Theorem MEASURE_SPACE_REDUCE[simp] : 903 !m. (m_space m, measurable_sets m, measure m) = m 904Proof 905 GEN_TAC >> Cases_on ���m��� >> Cases_on ���r��� >> rw [] 906QED 907 908val MONOTONE_CONVERGENCE = store_thm 909 ("MONOTONE_CONVERGENCE", 910 ``!m s f. 911 measure_space m /\ f IN (UNIV -> measurable_sets m) /\ 912 (!n. f n SUBSET f (SUC n)) /\ 913 (s = BIGUNION (IMAGE f UNIV)) ==> 914 (sup (IMAGE (measure m o f) univ(:num)) = measure m s)``, 915 RW_TAC std_ss [measure_space_def, IN_FUNSET, IN_UNIV] 916 >> (MP_TAC o 917 INST_TYPE [beta |-> ``:num``] o 918 Q.SPECL [`m`, `BIGUNION (IMAGE f UNIV)`, `\x. num_CASE x {} f`]) 919 MEASURE_COUNTABLE_INCREASING 920 >> Cond 921 >- (RW_TAC std_ss [IN_FUNSET, IN_UNIV, num_case_def, measure_space_def] >| 922 [Cases_on `x` >| 923 [RW_TAC std_ss [num_case_def] 924 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY, subsets_def], 925 RW_TAC std_ss [num_case_def]], 926 Cases_on `n` 927 >> RW_TAC std_ss [num_case_def, EMPTY_SUBSET], 928 SET_EQ_TAC 929 >> RW_TAC std_ss [IN_BIGUNION_IMAGE, IN_UNIV] 930 >> EQ_TAC >| 931 [RW_TAC std_ss [] 932 >> Q.EXISTS_TAC `SUC x'` 933 >> RW_TAC std_ss [num_case_def], 934 RW_TAC std_ss [] 935 >> POP_ASSUM MP_TAC 936 >> Cases_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY, num_case_def] 937 >> RW_TAC std_ss [num_case_def] 938 >> PROVE_TAC []]]) 939 >> RW_TAC std_ss [] 940 >> Know `measure m o f = (\n. (measure m o (\x. num_CASE x {} f)) (SUC n))` 941 >- (FUN_EQ_TAC 942 >> RW_TAC std_ss [num_case_def, o_THM]) 943 >> Rewr 944 >> `sup (IMAGE (\n. (measure m o (\x. num_CASE x {} f)) (SUC n)) UNIV) = 945 sup (IMAGE (measure m o (\x. num_CASE x {} f)) UNIV)` 946 by (MATCH_MP_TAC sup_suc 947 >> RW_TAC std_ss [o_DEF] 948 >> MATCH_MP_TAC INCREASING 949 >> CONJ_TAC >- METIS_TAC [measure_space_def,MEASURE_SPACE_INCREASING] 950 >> CONJ_TAC 951 >- (Cases_on `n` >- FULL_SIMP_TAC std_ss [LE,EMPTY_SUBSET,num_case_def] 952 >> Cases_on `m'` >- FULL_SIMP_TAC std_ss [EMPTY_SUBSET,num_case_def] 953 >> `!n m:num. m <= n ==> f m SUBSET f n` 954 by (RW_TAC std_ss [] 955 >> Know `?d:num. n'' = m' + d` >- PROVE_TAC [LESS_EQ_EXISTS] 956 >> RW_TAC std_ss [] 957 >> Induct_on `d` >- RW_TAC std_ss [add_rzero,SUBSET_REFL] 958 >> RW_TAC std_ss [] 959 >> Q.PAT_ASSUM `!n. f n SUBSET f (SUC n)` (MP_TAC o Q.SPEC `m' + d`) 960 >> METIS_TAC [SUBSET_TRANS,ADD_CLAUSES,LESS_EQ_ADD]) 961 >> FULL_SIMP_TAC std_ss [num_case_def,LESS_EQ_MONO]) 962 >> CONJ_TAC 963 >- (Cases_on `m'` 964 >- METIS_TAC [measure_space_def,MEASURE_SPACE_EMPTY_MEASURABLE,num_case_def] 965 >> RW_TAC std_ss [num_case_def]) 966 >> Cases_on `n` 967 >- METIS_TAC [measure_space_def,MEASURE_SPACE_EMPTY_MEASURABLE,num_case_def] 968 >> RW_TAC std_ss [num_case_def]) 969 >> METIS_TAC []); 970 971val MONOTONE_CONVERGENCE2 = store_thm 972 ("MONOTONE_CONVERGENCE2", 973 ``!m f. measure_space m /\ f IN (UNIV -> measurable_sets m) /\ 974 (!n. f n SUBSET f (SUC n)) ==> 975 (sup (IMAGE (measure m o f) univ(:num)) = measure m (BIGUNION (IMAGE f UNIV)))``, 976 METIS_TAC [MONOTONE_CONVERGENCE]); 977 978val MONOTONE_CONVERGENCE_BIGINTER = store_thm 979 ("MONOTONE_CONVERGENCE_BIGINTER", 980 ``!m s f. 981 measure_space m /\ f IN (UNIV -> measurable_sets m) /\ 982 (!n. measure m (f n) <> PosInf) /\ 983 (!n. f (SUC n) SUBSET f n) /\ 984 (s = BIGINTER (IMAGE f UNIV)) ==> 985 (inf (IMAGE (measure m o f) univ(:num)) = measure m s)``, 986 RW_TAC std_ss [IN_FUNSET, IN_UNIV] 987 >> `BIGINTER (IMAGE f UNIV) IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_BIGINTER] 988 >> `!n. f n SUBSET f 0` 989 by (Induct_on `n` >- RW_TAC std_ss [SUBSET_REFL] 990 >> METIS_TAC [SUBSET_TRANS]) 991 >> `BIGINTER (IMAGE f UNIV) SUBSET (f 0)` 992 by (MATCH_MP_TAC BIGINTER_SUBSET 993 >> METIS_TAC [IMAGE_EQ_EMPTY,UNIV_NOT_EMPTY,IN_IMAGE,IN_UNIV]) 994 >> `measure m (BIGINTER (IMAGE f UNIV)) <> PosInf` 995 by METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,let_trans,lt_infty] 996 >> `inf (IMAGE (measure m o f) UNIV) <= measure m (f 0)` 997 by (MATCH_MP_TAC inf_le_imp 998 >> ONCE_REWRITE_TAC [GSYM SPECIFICATION] 999 >> RW_TAC std_ss [IN_UNIV,IN_IMAGE,o_DEF] 1000 >> METIS_TAC []) 1001 >> `!n. measure m (f n) <> NegInf` by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty] 1002 >> `?r. measure m (f 0) = Normal r` by METIS_TAC [extreal_cases] 1003 >> `measure m (f 0) - inf (IMAGE (measure m o f) UNIV) = 1004 sup (IMAGE (\n. measure m (f 0) - measure m (f n)) UNIV)` 1005 by RW_TAC std_ss [inf_cminus] 1006 >> Q.ABBREV_TAC `g = (\n. (f 0) DIFF (f n))` 1007 >> `!n. measure m (f 0) - measure m (f n) = measure m (g n)` 1008 by METIS_TAC [MEASURE_SPACE_FINITE_DIFF_SUBSET] 1009 >> FULL_SIMP_TAC std_ss [] 1010 >> `sup (IMAGE (\n. measure m (g n)) UNIV) = measure m (BIGUNION (IMAGE g UNIV))` 1011 by ((MATCH_MP_TAC o REWRITE_RULE [o_DEF]) MONOTONE_CONVERGENCE2 1012 >> RW_TAC std_ss [IN_FUNSET,IN_UNIV] 1013 >- METIS_TAC [MEASURE_SPACE_DIFF] 1014 >> Q.UNABBREV_TAC `g` 1015 >> RW_TAC std_ss [SUBSET_DEF,IN_DIFF,GSPECIFICATION] 1016 >> METIS_TAC [SUBSET_DEF]) 1017 >> Q.UNABBREV_TAC `g` 1018 >> `BIGINTER (IMAGE f UNIV) = (f 0) DIFF BIGUNION (IMAGE (\u. (f 0) DIFF u) (IMAGE f UNIV))` 1019 by (MATCH_MP_TAC DIFF_BIGINTER 1020 >> METIS_TAC [IN_IMAGE,IN_UNIV,IMAGE_EQ_EMPTY,UNIV_NOT_EMPTY]) 1021 >> POP_ORW 1022 >> `BIGUNION (IMAGE (\u. f 0 DIFF u) (IMAGE f UNIV)) = BIGUNION (IMAGE (\n. f 0 DIFF f n) UNIV)` 1023 by (RW_TAC std_ss [EXTENSION,IN_BIGUNION_IMAGE,IN_UNIV,IN_IMAGE] 1024 >> METIS_TAC [SUBSET_DEF,IN_DIFF]) 1025 >> POP_ORW 1026 >> Suff `measure m (f 0 DIFF BIGUNION (IMAGE (\n. f 0 DIFF f n) UNIV)) = 1027 measure m (f 0) - measure m (BIGUNION (IMAGE (\n. f 0 DIFF f n) UNIV))` 1028 >- METIS_TAC [eq_sub_switch] 1029 >> MATCH_MP_TAC MEASURE_SPACE_FINITE_DIFF_SUBSET 1030 >> RW_TAC std_ss [] 1031 >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION 1032 >> METIS_TAC [MEASURE_SPACE_DIFF]) 1033 >> RW_TAC std_ss [BIGUNION_SUBSET,IN_IMAGE,IN_UNIV] 1034 >> METIS_TAC [DIFF_SUBSET]); 1035 1036val MONOTONE_CONVERGENCE_BIGINTER2 = store_thm 1037 ("MONOTONE_CONVERGENCE_BIGINTER2", 1038 ``!m f. measure_space m /\ f IN (UNIV -> measurable_sets m) /\ 1039 (!n. measure m (f n) <> PosInf) /\ 1040 (!n. f (SUC n) SUBSET f n) ==> 1041 (inf (IMAGE (measure m o f) univ(:num)) = measure m (BIGINTER (IMAGE f UNIV)))``, 1042 METIS_TAC [MONOTONE_CONVERGENCE_BIGINTER]); 1043 1044val MEASURABLE_SETS_SUBSET_SPACE = store_thm 1045 ("MEASURABLE_SETS_SUBSET_SPACE", 1046 ``!m s. measure_space m /\ s IN measurable_sets m ==> s SUBSET m_space m``, 1047 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def, subsets_def, space_def, 1048 subset_class_def]); 1049 1050val IN_MEASURE_PRESERVING = store_thm 1051 ("IN_MEASURE_PRESERVING", 1052 ``!m1 m2 f. 1053 f IN measure_preserving m1 m2 <=> 1054 f IN measurable (m_space m1, measurable_sets m1) (m_space m2, measurable_sets m2) /\ 1055 !s. 1056 s IN measurable_sets m2 ==> 1057 (measure m1 ((PREIMAGE f s)INTER(m_space m1)) = measure m2 s)``, 1058 RW_TAC std_ss [measure_preserving_def, GSPECIFICATION]); 1059 1060(* The old definition of `measure_preserving m1 m2` requires that both 1061 `m1` and `m2` must be measure_space. Now they're removed, and we must add 1062 `measure_space (m_space m2,a,measure m2)` into the antecedents, which cannot 1063 be derived from other conditions, since we don't know if `a` (for sure 1064 smaller than `measurable_sets m2`, as a generator) is countably_additive. 1065 1066 Furthermore, due to the changes to [0,+inf]-measure, now the theorem requires 1067 that both m1 and m2 are finite measure spaces. 1068 *) 1069Theorem MEASURE_PRESERVING_LIFT : 1070 !m1 m2 a f. 1071 measure_space m1 /\ measure_space m2 /\ 1072 measure_space (m_space m2,a,measure m2) /\ 1073 measure m1 (m_space m1) <> PosInf /\ 1074 measure m2 (m_space m2) <> PosInf /\ 1075 (measurable_sets m2 = subsets (sigma (m_space m2) a)) /\ 1076 f IN measure_preserving m1 (m_space m2,a,measure m2) ==> 1077 f IN measure_preserving m1 m2 1078Proof 1079 RW_TAC std_ss [] 1080 >> reverse (Cases_on `algebra (m_space m2,a)`) 1081 >- FULL_SIMP_TAC std_ss [IN_MEASURE_PRESERVING, IN_MEASURABLE, m_space_def, 1082 measurable_sets_def, sigma_algebra_def] 1083 >> Suff `f IN measure_preserving m1 (m_space m2,measurable_sets m2,measure m2)` 1084 >- RW_TAC std_ss [MEASURE_SPACE_REDUCE] 1085 >> ASM_REWRITE_TAC [] 1086 >> Q.PAT_X_ASSUM `f IN X` MP_TAC 1087 >> REWRITE_TAC [IN_MEASURE_PRESERVING, measurable_sets_def, measure_def, m_space_def] 1088 >> STRIP_TAC 1089 >> STRONG_CONJ_TAC 1090 >- (Know `(m_space m2,subsets (sigma (m_space m2) a)) = sigma (m_space m2) a` 1091 >- (Q.ABBREV_TAC `Q = (m_space m2,subsets (sigma (m_space m2) a))` 1092 >> Know `sigma (m_space m2) a = (space (sigma (m_space m2) a), 1093 subsets (sigma (m_space m2) a))` 1094 >- RW_TAC std_ss [SPACE] 1095 >> STRIP_TAC >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]) 1096 >> Q.UNABBREV_TAC `Q` 1097 >> RW_TAC std_ss [PAIR_EQ, sigma_def, space_def]) 1098 >> RW_TAC std_ss [] 1099 >> POP_ASSUM (K ALL_TAC) 1100 >> Know `(sigma (m_space m2) a) = sigma (space (m_space m2, a)) (subsets (m_space m2, a))` 1101 >- RW_TAC std_ss [space_def, subsets_def] 1102 >> STRIP_TAC >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]) 1103 >> MATCH_MP_TAC MEASURABLE_LIFT 1104 >> ASM_REWRITE_TAC []) 1105 >> Q.PAT_X_ASSUM `f IN X` K_TAC 1106 >> REWRITE_TAC [IN_MEASURABLE, space_def, subsets_def] 1107 >> STRIP_TAC 1108 >> ASM_REWRITE_TAC [] 1109 (* stage work *) 1110 >> Suff `subsets (sigma (m_space m2) a) SUBSET 1111 {s | measure m1 ((PREIMAGE f s) INTER (m_space m1)) = measure m2 s}` 1112 >- RW_TAC std_ss [SUBSET_DEF, GSPECIFICATION] 1113 >> MATCH_MP_TAC SIGMA_PROPERTY_DISJOINT 1114 >> Know `!s. s IN subsets (sigma (m_space m2) a) ==> measure m2 s <> PosInf` 1115 >- (NTAC 2 STRIP_TAC \\ 1116 `s IN measurable_sets m2` by PROVE_TAC [] \\ 1117 MATCH_MP_TAC MEASURE_SPACE_FINITE_MEASURE >> art []) 1118 >> RW_TAC std_ss [GSPECIFICATION, SUBSET_DEF, IN_INTER, IN_FUNSET, 1119 IN_UNIV, PREIMAGE_COMPL, PREIMAGE_BIGUNION, IMAGE_IMAGE, 1120 MEASURE_SPACE_FINITE_DIFF] (* 3 subgoals *) 1121 >| [ (* goal 1 (of 3) *) 1122 Q.PAT_X_ASSUM `measure m1 (PREIMAGE f s INTER m_space m1) = measure m2 s` 1123 (fn thm => ONCE_REWRITE_TAC [GSYM thm]) \\ 1124 Know `m_space m2 IN a` >- PROVE_TAC [ALGEBRA_SPACE, subsets_def, space_def] \\ 1125 STRIP_TAC \\ 1126 Q.PAT_X_ASSUM `!s. s IN a ==> (measure m1 (PREIMAGE f s INTER m_space m1) = measure m2 s)` 1127 ((fn thm => ONCE_REWRITE_TAC [GSYM thm]) o UNDISCH o Q.SPEC `m_space m2`) \\ 1128 Know `PREIMAGE f (m_space m2) INTER m_space m1 = m_space m1` 1129 >- (FULL_SIMP_TAC std_ss [Once EXTENSION, IN_INTER, IN_PREIMAGE, IN_FUNSET] \\ 1130 METIS_TAC []) \\ 1131 RW_TAC std_ss [PREIMAGE_DIFF] \\ 1132 `(PREIMAGE f (m_space m2) DIFF PREIMAGE f s) INTER m_space m1 = 1133 (PREIMAGE f (m_space m2) INTER m_space m1) DIFF (PREIMAGE f s INTER m_space m1)` 1134 by (RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_DIFF, IN_PREIMAGE] \\ 1135 DECIDE_TAC) >> POP_ORW \\ 1136 POP_ORW \\ 1137 `measure m1 (PREIMAGE f s INTER m_space m1) <> PosInf` 1138 by METIS_TAC [MEASURE_SPACE_FINITE_MEASURE] \\ 1139 RW_TAC std_ss [MEASURE_SPACE_FINITE_DIFF], 1140 (* goal 2 (of 3) *) 1141 `BIGUNION (IMAGE (PREIMAGE f o f') UNIV) INTER m_space m1 = 1142 BIGUNION (IMAGE (\x:num. (PREIMAGE f o f') x INTER m_space m1) UNIV)` 1143 by (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, IN_INTER, IN_IMAGE, IN_UNIV] \\ 1144 FULL_SIMP_TAC std_ss [IN_FUNSET] \\ 1145 EQ_TAC 1146 >- (RW_TAC std_ss [] \\ 1147 Q.EXISTS_TAC `PREIMAGE f (f' x') INTER m_space m1` \\ 1148 ASM_REWRITE_TAC [IN_INTER] \\ 1149 Q.EXISTS_TAC `x'` >> RW_TAC std_ss []) \\ 1150 RW_TAC std_ss [] >> METIS_TAC [IN_PREIMAGE, IN_INTER]) \\ 1151 POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]) \\ 1152 Suff 1153 `sup (IMAGE (measure m2 o f') univ(:num)) = measure m2 (BIGUNION (IMAGE f' UNIV)) /\ 1154 sup (IMAGE (measure m2 o f') univ(:num)) = 1155 measure m1 (BIGUNION (IMAGE (\x. (PREIMAGE f o f') x INTER m_space m1) UNIV))` 1156 >- PROVE_TAC [] \\ 1157 CONJ_TAC >- (MATCH_MP_TAC MEASURE_COUNTABLE_INCREASING \\ 1158 RW_TAC std_ss [IN_FUNSET, IN_UNIV, SUBSET_DEF]) \\ 1159 Know `measure m2 o f' = measure m1 o (\x. (PREIMAGE f o f') x INTER m_space m1)` 1160 >- (RW_TAC std_ss [FUN_EQ_THM] >> RW_TAC std_ss [o_THM]) \\ 1161 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\ 1162 MATCH_MP_TAC MEASURE_COUNTABLE_INCREASING \\ 1163 RW_TAC std_ss [IN_FUNSET, IN_UNIV, o_THM, PREIMAGE_EMPTY, INTER_EMPTY] \\ 1164 Suff `PREIMAGE f (f' n) SUBSET PREIMAGE f (f' (SUC n))` 1165 >- RW_TAC std_ss [SUBSET_DEF, IN_INTER] \\ 1166 MATCH_MP_TAC PREIMAGE_SUBSET \\ 1167 RW_TAC std_ss [SUBSET_DEF], 1168 (* goal 3 of 3 *) 1169 `BIGUNION (IMAGE (PREIMAGE f o f') UNIV) INTER m_space m1 = 1170 BIGUNION (IMAGE (\x:num. (PREIMAGE f o f') x INTER m_space m1) UNIV)` 1171 by (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, IN_INTER, IN_IMAGE, IN_UNIV] 1172 >> FULL_SIMP_TAC std_ss [IN_FUNSET] 1173 >> EQ_TAC 1174 >- (RW_TAC std_ss [] >> Q.EXISTS_TAC `PREIMAGE f (f' x') INTER m_space m1` 1175 >> ASM_REWRITE_TAC [IN_INTER] >> Q.EXISTS_TAC `x'` >> RW_TAC std_ss []) 1176 >> RW_TAC std_ss [] >> METIS_TAC [IN_PREIMAGE, IN_INTER]) \\ 1177 POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]) \\ 1178 Suff 1179 `suminf (measure m2 o f') = measure m2 (BIGUNION (IMAGE f' UNIV)) /\ 1180 suminf (measure m2 o f') = 1181 measure m1 (BIGUNION (IMAGE (\x. (PREIMAGE f o f') x INTER m_space m1) UNIV))` 1182 >- PROVE_TAC [] \\ 1183 CONJ_TAC >- (MATCH_MP_TAC MEASURE_COUNTABLY_ADDITIVE \\ 1184 RW_TAC std_ss [IN_FUNSET, IN_UNIV]) \\ 1185 Know `measure m2 o f' = measure m1 o (\x. (PREIMAGE f o f') x INTER m_space m1)` 1186 >- (RW_TAC std_ss [FUN_EQ_THM] >> RW_TAC std_ss [o_THM]) \\ 1187 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\ 1188 MATCH_MP_TAC MEASURE_COUNTABLY_ADDITIVE \\ 1189 RW_TAC std_ss [IN_FUNSET, IN_UNIV, o_THM, IN_DISJOINT, PREIMAGE_DISJOINT, IN_INTER] \\ 1190 METIS_TAC [IN_DISJOINT, PREIMAGE_DISJOINT] ] 1191QED 1192 1193(* added the same more requirements as for MEASURE_PRESERVING_LIFT *) 1194val MEASURE_PRESERVING_SUBSET = store_thm 1195 ("MEASURE_PRESERVING_SUBSET", 1196 ``!m1 m2 a. 1197 measure_space m1 /\ measure_space m2 /\ 1198 measure_space (m_space m2,a,measure m2) /\ 1199 measure m1 (m_space m1) <> PosInf /\ 1200 measure m2 (m_space m2) <> PosInf /\ 1201 (measurable_sets m2 = subsets (sigma (m_space m2) a)) ==> 1202 measure_preserving m1 (m_space m2, a, measure m2) SUBSET 1203 measure_preserving m1 m2``, 1204 RW_TAC std_ss [SUBSET_DEF] 1205 >> MATCH_MP_TAC MEASURE_PRESERVING_LIFT 1206 >> PROVE_TAC []); 1207 1208(* fewer antecedents *) 1209val MEASURE_PRESERVING_UP_LIFT = store_thm 1210 ("MEASURE_PRESERVING_UP_LIFT", 1211 ``!m1 m2 f a. 1212 f IN measure_preserving (m_space m1, a, measure m1) m2 /\ 1213 sigma_algebra (m_space m1, measurable_sets m1) /\ 1214 a SUBSET measurable_sets m1 ==> 1215 f IN measure_preserving m1 m2``, 1216 RW_TAC std_ss [measure_preserving_def, GSPECIFICATION, SUBSET_DEF, 1217 measure_def, measurable_sets_def, m_space_def, SPACE] 1218 >> MATCH_MP_TAC MEASURABLE_UP_LIFT 1219 >> Q.EXISTS_TAC `a` 1220 >> RW_TAC std_ss [SUBSET_DEF]); 1221 1222(* fewer antecedents *) 1223val MEASURE_PRESERVING_UP_SUBSET = store_thm 1224 ("MEASURE_PRESERVING_UP_SUBSET", 1225 ``!m1 m2 a. 1226 a SUBSET measurable_sets m1 /\ 1227 sigma_algebra (m_space m1, measurable_sets m1) ==> 1228 measure_preserving (m_space m1, a, measure m1) m2 SUBSET measure_preserving m1 m2``, 1229 RW_TAC std_ss [MEASURE_PRESERVING_UP_LIFT, SUBSET_DEF] 1230 >> MATCH_MP_TAC MEASURE_PRESERVING_UP_LIFT 1231 >> PROVE_TAC [SUBSET_DEF]); 1232 1233val MEASURE_PRESERVING_UP_SIGMA = store_thm 1234 ("MEASURE_PRESERVING_UP_SIGMA", 1235 ``!m1 m2 a. 1236 (measurable_sets m1 = subsets (sigma (m_space m1) a)) ==> 1237 measure_preserving (m_space m1, a, measure m1) m2 SUBSET measure_preserving m1 m2``, 1238 RW_TAC std_ss [MEASURE_PRESERVING_UP_LIFT, SUBSET_DEF] 1239 >> MATCH_MP_TAC MEASURE_PRESERVING_UP_LIFT 1240 >> Q.EXISTS_TAC `a` 1241 >> ASM_REWRITE_TAC [SIGMA_SUBSET_SUBSETS, SIGMA_REDUCE] 1242 >> FULL_SIMP_TAC std_ss [IN_MEASURE_PRESERVING, IN_MEASURABLE, m_space_def, measurable_sets_def] 1243 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA 1244 >> FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, space_def, subsets_def]); 1245 1246(* ****************** *) 1247 1248val MEASURABLE_RANGE_REDUCE = store_thm 1249 ("MEASURABLE_RANGE_REDUCE", 1250 ``!m f s. measure_space m /\ 1251 f IN measurable (m_space m, measurable_sets m) (s, POW s) /\ 1252 (~(s = {})) ==> 1253 f IN measurable (m_space m, measurable_sets m) 1254 (s INTER (IMAGE f (m_space m)), POW (s INTER (IMAGE f (m_space m))))``, 1255 RW_TAC std_ss [IN_MEASURABLE, POW_SIGMA_ALGEBRA, subsets_def, space_def, IN_FUNSET, 1256 IN_INTER, IN_IMAGE, IN_POW, SUBSET_INTER, 1257 MEASURABLE_SETS_SUBSET_SPACE, INTER_SUBSET] 1258 >> METIS_TAC []); 1259 1260val MEASURABLE_POW_TO_POW = store_thm 1261 ("MEASURABLE_POW_TO_POW", 1262 ``!m f. 1263 measure_space m /\ 1264 (measurable_sets m = POW (m_space m)) ==> 1265 f IN measurable (m_space m, measurable_sets m) (UNIV, POW(UNIV))``, 1266 RW_TAC std_ss [IN_MEASURABLE, IN_POW, IN_UNIV, POW_SIGMA_ALGEBRA, subsets_def, space_def, 1267 IN_FUNSET, PREIMAGE_UNIV, SUBSET_UNIV, measure_space_def, SUBSET_DEF, 1268 IN_INTER]); 1269 1270val MEASURABLE_POW_TO_POW_IMAGE = store_thm 1271 ("MEASURABLE_POW_TO_POW_IMAGE", 1272 ``!m f. 1273 measure_space m /\ 1274 (measurable_sets m = POW (m_space m)) ==> 1275 f IN measurable (m_space m, measurable_sets m) 1276 (IMAGE f (m_space m), POW(IMAGE f (m_space m)))``, 1277 rpt STRIP_TAC 1278 >> (MP_TAC o Q.SPECL [`m`,`f`,`UNIV`]) MEASURABLE_RANGE_REDUCE 1279 >> ASM_SIMP_TAC std_ss [UNIV_NOT_EMPTY, INTER_UNIV, MEASURABLE_POW_TO_POW]); 1280 1281val MEASURE_SPACE_SUBSET = store_thm 1282 ("MEASURE_SPACE_SUBSET", 1283 ``!s s' m. s' SUBSET s /\ measure_space (s,POW s, m) ==> 1284 measure_space (s',POW s', m)``, 1285 RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def, POW_SIGMA_ALGEBRA, 1286 positive_def, measure_def, IN_POW, countably_additive_def, IN_FUNSET, IN_POW] 1287 >> METIS_TAC [SUBSET_TRANS, SUBSET_REFL]); 1288 1289val STRONG_MEASURE_SPACE_SUBSET = store_thm 1290 ("STRONG_MEASURE_SPACE_SUBSET", 1291 ``!s s'. s' SUBSET m_space s /\ measure_space s /\ POW s' SUBSET measurable_sets s ==> 1292 measure_space (s',POW s', measure s)``, 1293 rpt STRIP_TAC >> MATCH_MP_TAC MEASURE_DOWN 1294 >> Q.EXISTS_TAC `s` 1295 >> RW_TAC std_ss [measure_def, m_space_def, measurable_sets_def, POW_SIGMA_ALGEBRA]); 1296 1297val MEASURE_EXTREAL_SUM_IMAGE = store_thm 1298 ("MEASURE_EXTREAL_SUM_IMAGE", 1299 ``!m s. measure_space m /\ s IN measurable_sets m /\ 1300 (!x. x IN s ==> {x} IN measurable_sets m) /\ FINITE s ==> 1301 (measure m s = SIGMA (\x. measure m {x}) s)``, 1302 Suff `!s. FINITE s ==> 1303 (\s. !m. measure_space m /\ s IN measurable_sets m /\ 1304 (!x. x IN s ==> {x} IN measurable_sets m) ==> 1305 (measure m s = SIGMA (\x. measure m {x}) s)) s` 1306 >- METIS_TAC [] 1307 >> MATCH_MP_TAC FINITE_INDUCT 1308 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_EMPTY, MEASURE_EMPTY, DELETE_NON_ELEMENT, IN_INSERT] 1309 >> `!x. x IN e INSERT s ==> (\x. measure m {x}) x <> NegInf` 1310 by METIS_TAC [IN_INSERT,measure_space_def,positive_not_infty] 1311 >> FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY, DELETE_NON_ELEMENT] 1312 >> Q.PAT_X_ASSUM `!m. a /\ b /\ c ==> d` (MP_TAC o GSYM o Q.SPEC `m`) 1313 >> `s IN measurable_sets m` 1314 by (`s = (e INSERT s) DIFF {e}` 1315 by (RW_TAC std_ss [EXTENSION, IN_INSERT, IN_DIFF, IN_SING] 1316 >> METIS_TAC [GSYM DELETE_NON_ELEMENT]) 1317 >> POP_ORW 1318 >> FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def] 1319 >> METIS_TAC [space_def, subsets_def, ALGEBRA_DIFF]) 1320 >> RW_TAC std_ss [] 1321 >> MATCH_MP_TAC MEASURE_ADDITIVE 1322 >> RW_TAC std_ss [IN_DISJOINT, IN_SING, Once INSERT_SING_UNION] 1323 >> FULL_SIMP_TAC std_ss [GSYM DELETE_NON_ELEMENT]); 1324 1325Theorem finite_additivity_sufficient_for_finite_spaces : 1326 !s m. sigma_algebra s /\ FINITE (space s) /\ 1327 positive (space s, subsets s, m) /\ 1328 additive (space s, subsets s, m) ==> 1329 measure_space (space s, subsets s, m) 1330Proof 1331 RW_TAC std_ss [countably_additive_def, additive_def, measurable_sets_def, 1332 measure_def, IN_FUNSET, IN_UNIV, measure_space_def, m_space_def, SPACE] 1333 >> `FINITE (subsets s)` 1334 by (Suff `subsets s SUBSET (POW (space s))` 1335 >- METIS_TAC [SUBSET_FINITE, FINITE_POW] 1336 >> FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, subset_class_def, SUBSET_DEF, IN_POW] 1337 >> METIS_TAC []) 1338 >> `?N. !n. n >= N ==> (f n = {})` 1339 by METIS_TAC [finite_enumeration_of_sets_has_max_non_empty] 1340 >> FULL_SIMP_TAC std_ss [GREATER_EQ] 1341 >> `BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE f (count N))` 1342 by METIS_TAC [BIGUNION_IMAGE_UNIV] 1343 (* stage work *) 1344 >> Know `!n. 0 <= (m o f) n` 1345 >- fs [positive_def, measure_def, measurable_sets_def] 1346 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' 1347 >> RW_TAC std_ss [sup_eq', IN_IMAGE, IN_UNIV] 1348 >- (Cases_on `N <= n` 1349 >- (`count n = (count N) UNION (count n DIFF count N)` 1350 by METIS_TAC [UNION_DIFF,SUBSET_DEF,IN_COUNT,SUBSET_DEF,IN_COUNT,LESS_EQ_TRANS,LESS_EQ] 1351 >> POP_ORW 1352 >> `FINITE (count N) /\ FINITE (count n DIFF count N)` 1353 by RW_TAC std_ss [FINITE_COUNT,FINITE_DIFF] 1354 >> `DISJOINT (count N) (count n DIFF count N)` 1355 by METIS_TAC [EXTENSION,IN_DISJOINT,IN_COUNT,IN_DIFF,IN_INTER,NOT_IN_EMPTY] 1356 >> `!x. (m o f) x <> NegInf` 1357 by METIS_TAC [positive_not_infty,measurable_sets_def,subsets_def,measure_def,o_DEF] 1358 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_DISJOINT_UNION] 1359 >> (MP_TAC o Q.SPEC `(m :('a -> bool) -> extreal) o f` o UNDISCH o 1360 (Q.SPEC `count n DIFF count N`) o INST_TYPE [alpha |-> ``:num``]) EXTREAL_SUM_IMAGE_IN_IF 1361 >> RW_TAC std_ss [] 1362 >> `(\x. if x IN count n DIFF count N then m (f x) else 0) = (\x. 0)` 1363 by (FUN_EQ_TAC 1364 >> RW_TAC std_ss [IN_COUNT,IN_DIFF,NOT_LESS] 1365 >> FULL_SIMP_TAC std_ss [positive_def,measure_def]) 1366 >> POP_ORW 1367 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_ZERO,add_rzero] 1368 >> Suff `SIGMA (m o f) (count N) = m (BIGUNION (IMAGE f (count N)))` 1369 >- RW_TAC std_ss [le_refl] 1370 >> (MATCH_MP_TAC o REWRITE_RULE [m_space_def,measurable_sets_def,measure_def] o 1371 Q.SPECL [`(space s,subsets s, m)`,`f`,`N`]) ADDITIVE_SUM 1372 >> FULL_SIMP_TAC std_ss [IN_FUNSET,IN_UNIV,SPACE,sigma_algebra_def] 1373 >> METIS_TAC [additive_def,measure_def,measurable_sets_def,m_space_def]) 1374 >> FULL_SIMP_TAC std_ss [NOT_LESS_EQUAL] 1375 >> `SIGMA (m o f) (count n) = m (BIGUNION (IMAGE f (count n)))` 1376 by ((MATCH_MP_TAC o REWRITE_RULE [m_space_def,measurable_sets_def,measure_def] o 1377 Q.SPECL [`(space s,subsets s, m)`,`f`,`n`]) ADDITIVE_SUM 1378 >> RW_TAC std_ss [IN_FUNSET,IN_UNIV] 1379 >- FULL_SIMP_TAC std_ss [sigma_algebra_def,SPACE] 1380 >> METIS_TAC [additive_def,measure_def,measurable_sets_def,m_space_def]) 1381 >> POP_ORW 1382 >> (MATCH_MP_TAC o REWRITE_RULE [measurable_sets_def,subsets_def,measure_def] o 1383 Q.SPECL [`(space s,subsets s,m)`, 1384 `BIGUNION (IMAGE f (count n))`, 1385 `BIGUNION (IMAGE f (count N))`]) INCREASING 1386 >> CONJ_TAC 1387 >- (MATCH_MP_TAC ADDITIVE_INCREASING 1388 >> FULL_SIMP_TAC std_ss [m_space_def,measurable_sets_def,sigma_algebra_def,SPACE] 1389 >> METIS_TAC [additive_def,measure_def,m_space_def,measurable_sets_def]) 1390 >> RW_TAC std_ss [SUBSET_DEF,IN_BIGUNION_IMAGE,IN_COUNT] 1391 >- METIS_TAC [LESS_TRANS] 1392 >> FULL_SIMP_TAC std_ss [sigma_algebra_def] 1393 >> Q.PAT_X_ASSUM ` !c. P c /\ Q c ==> BIGUNION c IN subsets s` MATCH_MP_TAC 1394 >> RW_TAC std_ss [COUNTABLE_IMAGE_NUM,SUBSET_DEF,IN_IMAGE,IN_COUNT] 1395 >> METIS_TAC []) 1396 >> POP_ASSUM MATCH_MP_TAC 1397 >> Q.EXISTS_TAC `N` 1398 >> (MATCH_MP_TAC o GSYM o REWRITE_RULE [m_space_def,measurable_sets_def,measure_def] o 1399 Q.SPECL [`(space s,subsets s, m)`,`f`,`N`]) ADDITIVE_SUM 1400 >> RW_TAC std_ss [IN_FUNSET,IN_UNIV] 1401 >- FULL_SIMP_TAC std_ss [sigma_algebra_def,SPACE] 1402 >> METIS_TAC [additive_def,measure_def,measurable_sets_def,m_space_def] 1403QED 1404 1405val finite_additivity_sufficient_for_finite_spaces2 = store_thm 1406 ("finite_additivity_sufficient_for_finite_spaces2", 1407 ``!m. sigma_algebra (m_space m, measurable_sets m) /\ FINITE (m_space m) /\ 1408 positive m /\ additive m ==> measure_space m``, 1409 rpt STRIP_TAC 1410 >> Suff `measure_space (space (m_space m, measurable_sets m), 1411 subsets (m_space m, measurable_sets m), measure m)` 1412 >- RW_TAC std_ss [space_def, subsets_def, MEASURE_SPACE_REDUCE] 1413 >> MATCH_MP_TAC finite_additivity_sufficient_for_finite_spaces 1414 >> RW_TAC std_ss [space_def, subsets_def, MEASURE_SPACE_REDUCE]); 1415 1416(* added ``measure m t < PosInf`` into antecedents, cf. MEASURE_SPACE_FINITE_DIFF_SUBSET *) 1417val MEASURE_DIFF_SUBSET = store_thm (* was: measure_Diff *) 1418 ("MEASURE_DIFF_SUBSET", 1419 ``!m s t. 1420 measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\ 1421 (t SUBSET s) /\ measure m t < PosInf ==> 1422 (measure m (s DIFF t) = measure m s - measure m t)``, 1423 RW_TAC std_ss [] 1424 >> Know `(measure m (s DIFF t) = measure m s - measure m t) <=> 1425 (measure m (s DIFF t) + measure m t = measure m s)` 1426 >- (MATCH_MP_TAC eq_sub_ladd \\ 1427 `positive m` by PROVE_TAC [measure_space_def] \\ 1428 PROVE_TAC [positive_not_infty, lt_infty]) 1429 >> DISCH_THEN (REWRITE_TAC o wrap) 1430 >> MATCH_MP_TAC EQ_SYM 1431 >> MATCH_MP_TAC ADDITIVE 1432 >> Q.PAT_X_ASSUM `measure_space m` MP_TAC 1433 >> RW_TAC std_ss [measure_space_def, sigma_algebra_def, DISJOINT_DEF, 1434 EXTENSION, IN_DIFF, IN_UNIV, IN_UNION, IN_INTER, 1435 NOT_IN_EMPTY] 1436 >> METIS_TAC [COUNTABLY_ADDITIVE_ADDITIVE, MEASURE_SPACE_DIFF, measure_space_def, 1437 sigma_algebra_def, SUBSET_DEF, ALGEBRA_EMPTY, subsets_def, positive_def]); 1438 1439val MEASURE_COMPL_SUBSET = save_thm (* old name for compatibility purposes *) 1440 ("MEASURE_COMPL_SUBSET", MEASURE_DIFF_SUBSET); 1441 1442(* cf. MEASURE_SPACE_RESTRICTION *) 1443val MEASURE_SPACE_RESTRICTED = store_thm 1444 ("MEASURE_SPACE_RESTRICTED", 1445 ``!m s. measure_space m /\ s IN measurable_sets m ==> 1446 measure_space (s, IMAGE (\t. s INTER t) (measurable_sets m), measure m)``, 1447 RW_TAC std_ss [] 1448 >> `positive (s,IMAGE (\t. s INTER t) (measurable_sets m),measure m)` 1449 by (RW_TAC std_ss [positive_def,measure_def,measurable_sets_def,IN_IMAGE] 1450 >> METIS_TAC [MEASURE_SPACE_POSITIVE,MEASURE_SPACE_INTER,positive_def]) 1451 >> `countably_additive (s,IMAGE (\t. s INTER t) (measurable_sets m),measure m)` 1452 by (RW_TAC std_ss [countably_additive_def,measure_def,measurable_sets_def, 1453 IN_IMAGE,IN_FUNSET,IN_UNIV] 1454 >> `!x. f x IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_INTER] 1455 >> `BIGUNION (IMAGE f univ(:num)) IN measurable_sets m` 1456 by METIS_TAC [MEASURE_SPACE_INTER] 1457 >> `countably_additive m` by METIS_TAC [measure_space_def] 1458 >> FULL_SIMP_TAC std_ss [countably_additive_def,IN_FUNSET,IN_UNIV]) 1459 >> RW_TAC std_ss [measure_space_def,sigma_algebra_def,measurable_sets_def,subsets_def, 1460 m_space_def,IN_IMAGE] 1461 >- (RW_TAC std_ss [algebra_def,space_def,subsets_def,subset_class_def,IN_IMAGE] 1462 >| [RW_TAC std_ss [INTER_SUBSET], 1463 METIS_TAC [INTER_EMPTY,MEASURE_SPACE_EMPTY_MEASURABLE], 1464 Q.EXISTS_TAC `m_space m DIFF t` 1465 >> RW_TAC std_ss [MEASURE_SPACE_DIFF,MEASURE_SPACE_MSPACE_MEASURABLE,EXTENSION, 1466 IN_DIFF,IN_INTER] 1467 >> METIS_TAC [MEASURE_SPACE_SUBSET_MSPACE,SUBSET_DEF], 1468 Q.EXISTS_TAC `t' UNION t''` 1469 >> RW_TAC std_ss [MEASURE_SPACE_UNION,UNION_OVER_INTER]]) 1470 >> `BIGUNION c SUBSET s` 1471 by (RW_TAC std_ss [SUBSET_DEF,IN_BIGUNION] 1472 >> FULL_SIMP_TAC std_ss [SUBSET_DEF,IN_IMAGE] 1473 >> `?t. (s' = s INTER t) /\ t IN measurable_sets m` by METIS_TAC [] 1474 >> METIS_TAC [IN_INTER]) 1475 >> Q.EXISTS_TAC `BIGUNION c` 1476 >> RW_TAC std_ss [SUBSET_INTER2] 1477 >> Suff `BIGUNION c IN subsets (m_space m, measurable_sets m)` 1478 >- RW_TAC std_ss [subsets_def] 1479 >> MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION 1480 >> RW_TAC std_ss [subsets_def] 1481 >- FULL_SIMP_TAC std_ss [measure_space_def] 1482 >> FULL_SIMP_TAC std_ss [SUBSET_DEF,IN_IMAGE] 1483 >> METIS_TAC [MEASURE_SPACE_INTER]); 1484 1485(* Another way to restrict a measure space *) 1486val MEASURE_SPACE_RESTRICTED_MEASURE = store_thm 1487 ("MEASURE_SPACE_RESTRICTED_MEASURE", 1488 ``!m s. measure_space m /\ s IN measurable_sets m ==> 1489 measure_space (m_space m,measurable_sets m,(\a. measure m (s INTER a)))``, 1490 (* proof *) 1491 RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def, measure_def, positive_def, 1492 INTER_EMPTY] 1493 >- (FIRST_ASSUM MATCH_MP_TAC \\ 1494 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 1495 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER)) \\ 1496 fs [sigma_algebra_def]) 1497 >> fs [countably_additive_def, measurable_sets_def, measure_def, m_space_def, IN_FUNSET, IN_UNIV] 1498 >> RW_TAC std_ss [o_DEF] 1499 >> Know `(\x. measure m (s INTER f x)) = measure m o (\x. s INTER f x)` 1500 >- (FUN_EQ_TAC >> SIMP_TAC std_ss [o_DEF]) >> Rewr' 1501 >> REWRITE_TAC [BIGUNION_OVER_INTER_R] 1502 >> FIRST_X_ASSUM MATCH_MP_TAC 1503 >> RW_TAC std_ss [o_DEF, GSYM BIGUNION_OVER_INTER_R] (* 3 subgoals *) 1504 >| [ (* goal 1 (of 3) *) 1505 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 1506 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER)) \\ 1507 fs [sigma_algebra_def], 1508 (* goal 2 (of 3) *) 1509 MATCH_MP_TAC DISJOINT_RESTRICT_R \\ 1510 FIRST_X_ASSUM MATCH_MP_TAC >> art [], 1511 (* goal 3 (of 3) *) 1512 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 1513 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER)) \\ 1514 fs [sigma_algebra_def] ]); 1515 1516val MEASURE_SPACE_CMUL = store_thm 1517 ("MEASURE_SPACE_CMUL", 1518 ``!m c. measure_space m /\ 0 <= c ==> 1519 measure_space (m_space m, measurable_sets m, (\a. Normal c * measure m a))``, 1520 RW_TAC std_ss [measure_space_def,m_space_def,measurable_sets_def,measure_def, 1521 positive_def,mul_rzero] 1522 >- METIS_TAC [extreal_le_def,le_mul,extreal_of_num_def] 1523 >> RW_TAC std_ss [countably_additive_def,measure_def,measurable_sets_def,o_DEF] 1524 >> `measure m (BIGUNION (IMAGE f univ(:num))) = suminf (measure m o f)` 1525 by METIS_TAC [countably_additive_def] 1526 >> `suminf (\x. Normal c * measure m (f x)) = suminf (\x. Normal c * (\x. measure m (f x)) x)` 1527 by METIS_TAC [] 1528 >> POP_ORW 1529 >> Suff `suminf (\x. Normal c * (\x. measure m (f x)) x) = Normal c * suminf (\x. measure m (f x))` 1530 >- METIS_TAC [] 1531 >> MATCH_MP_TAC ext_suminf_cmul 1532 >> METIS_TAC [IN_UNIV,IN_FUNSET,extreal_le_def,extreal_of_num_def]); 1533 1534val BIGUNION_IMAGE_Q = store_thm 1535 ("BIGUNION_IMAGE_Q", 1536 ``!a f: extreal -> 'a -> bool. sigma_algebra a /\ f IN (Q_set -> subsets a) 1537 ==> BIGUNION (IMAGE f Q_set) IN subsets a``, 1538 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, IN_UNIV, SUBSET_DEF] 1539 >> Q.PAT_X_ASSUM `!c. countable c /\ P c ==> Q c` MATCH_MP_TAC 1540 >> RW_TAC std_ss [image_countable, IN_IMAGE, Q_COUNTABLE] 1541 >> METIS_TAC []); 1542 1543val measure_split = store_thm 1544 ("measure_split", 1545 ``!(r :num -> bool) (b :num -> ('a -> bool)) m. 1546 measure_space m /\ FINITE r /\ 1547 (BIGUNION (IMAGE b r) = m_space m) /\ 1548 (!i j. i IN r /\ j IN r /\ (~(i = j)) ==> DISJOINT (b i) (b j)) /\ 1549 (!i. i IN r ==> b i IN measurable_sets m) ==> 1550 !a. a IN measurable_sets m ==> 1551 ((measure m) a = SIGMA (\i. (measure m) (a INTER (b i))) r)``, 1552(* proof *) 1553 Suff `!r. FINITE r ==> 1554 (\r. !(b :num -> ('a -> bool)) m. 1555 measure_space m /\ 1556 (BIGUNION (IMAGE b r) = m_space m) /\ 1557 (!i j. i IN r /\ j IN r /\ (~(i=j)) ==> DISJOINT (b i) (b j)) /\ 1558 (!i. i IN r ==> b i IN measurable_sets m) ==> 1559 !a. a IN measurable_sets m ==> 1560 ((measure m) a = SIGMA (\i. (measure m) (a INTER (b i))) r)) r` 1561 >- RW_TAC std_ss [] 1562 >> MATCH_MP_TAC FINITE_INDUCT 1563 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_EMPTY, IMAGE_EMPTY, BIGUNION_EMPTY, DELETE_NON_ELEMENT, 1564 IN_INSERT, NOT_IN_EMPTY] 1565 >- METIS_TAC [MEASURE_SPACE_SUBSET_MSPACE,SUBSET_EMPTY,MEASURE_EMPTY] 1566 >> `!i. i IN e INSERT s ==> (\i. measure m (a INTER b i)) i <> NegInf` 1567 by METIS_TAC [measure_space_def,positive_not_infty,MEASURE_SPACE_INTER,IN_INSERT] 1568 >> Cases_on `s = {}` 1569 >- (FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY, IMAGE_DEF, IN_SING, BIGUNION, 1570 GSPECIFICATION, GSPEC_ID, SUBSET_DEF, add_rzero, 1571 EXTREAL_SUM_IMAGE_SING] 1572 >> METIS_TAC [SUBSET_INTER1,MEASURE_SPACE_SUBSET_MSPACE]) 1573 >> `?x s'. (s = x INSERT s') /\ ~(x IN s')` by METIS_TAC [SET_CASES] 1574 >> FULL_SIMP_TAC std_ss [GSYM DELETE_NON_ELEMENT, IN_INSERT] 1575 >> Q.PAT_X_ASSUM `!b' m'. P ==> !a'. Q ==> (f = g)` 1576 (MP_TAC o Q.ISPECL [`(\i:num. if i = x then b x UNION b e else b i)`, 1577 `(m :('a -> bool) # (('a -> bool) -> bool) # (('a -> bool) -> extreal))`]) 1578 >> `IMAGE (\i. (if i = x then b x UNION b e else b i)) s' = IMAGE b s'` 1579 by (RW_TAC std_ss [Once EXTENSION, IN_IMAGE] 1580 >> EQ_TAC 1581 >- (RW_TAC std_ss [] >> Q.EXISTS_TAC `i` >> METIS_TAC []) 1582 >> RW_TAC std_ss [] >> Q.EXISTS_TAC `x''` >> METIS_TAC []) 1583 >> FULL_SIMP_TAC std_ss [IMAGE_INSERT, BIGUNION_INSERT, UNION_ASSOC] 1584 >> POP_ASSUM (K ALL_TAC) 1585 >> `(b x UNION (b e UNION BIGUNION (IMAGE b s')) = m_space m)` 1586 by METIS_TAC [UNION_COMM,UNION_ASSOC] 1587 >> ASM_REWRITE_TAC [] 1588 >> `(!i j. ((i = x) \/ i IN s') /\ ((j = x) \/ j IN s') /\ ~(i = j) ==> 1589 DISJOINT (if i = x then b x UNION b e else b i) 1590 (if j = x then b x UNION b e else b j))` 1591 by (FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, GSPECIFICATION, IN_INSERT, 1592 IN_INTER, NOT_IN_EMPTY] 1593 >> METIS_TAC [IN_UNION]) 1594 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC) 1595 >> `(!i. 1596 (i = x) \/ i IN s' ==> 1597 (if i = x then b x UNION b e else b i) IN measurable_sets m)` 1598 by METIS_TAC [ALGEBRA_UNION, sigma_algebra_def, measure_space_def, subsets_def] 1599 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC) 1600 >> STRIP_TAC 1601 >> FULL_SIMP_TAC std_ss [UNION_ASSOC] 1602 >> POP_ASSUM MP_TAC >> ASM_REWRITE_TAC [] 1603 >> DISCH_THEN (MP_TAC o Q.SPEC `a`) >> ASM_REWRITE_TAC [] 1604 >> DISCH_TAC 1605 >> `!i. i IN x INSERT s' ==> 1606 (\i. measure m (a INTER if i = x then b x UNION b e else b i)) i <> NegInf` 1607 by (RW_TAC std_ss [] 1608 >- (`a INTER (b i UNION b e) IN measurable_sets m` 1609 by METIS_TAC [MEASURE_SPACE_INTER,MEASURE_SPACE_UNION] 1610 >> METIS_TAC [measure_space_def,positive_not_infty]) 1611 >> METIS_TAC [IN_INSERT]) 1612 >> `!i. i IN (e INSERT x INSERT s') ==> (\i. measure m (a INTER b i)) i <> NegInf` 1613 by METIS_TAC [IN_INSERT] 1614 >> `!i. i IN (x INSERT s') ==> (\i. measure m (a INTER b i)) i <> NegInf` 1615 by METIS_TAC [IN_INSERT] 1616 >> `(x INSERT s') DELETE e = x INSERT s'` by METIS_TAC [EXTENSION,IN_DELETE,IN_INSERT] 1617 >> FULL_SIMP_TAC real_ss [FINITE_INSERT, EXTREAL_SUM_IMAGE_PROPERTY, DELETE_NON_ELEMENT] 1618 >> Suff `(measure m (a INTER (b x UNION b e)) = 1619 measure m (a INTER b e) + measure m (a INTER b x)) /\ 1620 (SIGMA (\i. measure m (a INTER 1621 (if i = x then b x UNION b e else b i))) s' = 1622 SIGMA (\i. measure m (a INTER b i)) s')` 1623 >- (`measure m (a INTER (b x UNION b e)) <> NegInf` 1624 by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty,MEASURE_SPACE_INTER, 1625 MEASURE_SPACE_UNION] 1626 >> `SIGMA (\i. measure m (a INTER if i = x then b x UNION b e else b i)) s' <> NegInf` 1627 by FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_NOT_INFTY,IN_INSERT] 1628 >> METIS_TAC [add_assoc,IN_INSERT,EXTREAL_SUM_IMAGE_NOT_INFTY,add_not_infty, 1629 MEASURE_SPACE_POSITIVE,positive_not_infty,MEASURE_SPACE_INTER, 1630 MEASURE_SPACE_UNION]) 1631 >> CONJ_TAC 1632 >- (`a INTER (b x UNION b e) = (a INTER b e) UNION (a INTER b x)` 1633 by (FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, GSPECIFICATION, 1634 NOT_IN_EMPTY, IN_INTER, IN_UNION] 1635 >> METIS_TAC []) 1636 >> POP_ORW 1637 >> (MATCH_MP_TAC o REWRITE_RULE [additive_def] o UNDISCH o Q.SPEC `m`) 1638 MEASURE_SPACE_ADDITIVE 1639 >> STRONG_CONJ_TAC 1640 >- METIS_TAC [ALGEBRA_INTER, sigma_algebra_def, measure_space_def, subsets_def] 1641 >> DISCH_TAC 1642 >> STRONG_CONJ_TAC 1643 >- METIS_TAC [ALGEBRA_INTER, sigma_algebra_def, measure_space_def, subsets_def] 1644 >> DISCH_TAC 1645 >> CONJ_TAC 1646 >- (FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] \\ 1647 METIS_TAC []) 1648 >> METIS_TAC [ALGEBRA_UNION, sigma_algebra_def, measure_space_def, subsets_def]) 1649 >> FULL_SIMP_TAC std_ss [(Once o UNDISCH o Q.ISPEC `(s' :num -> bool)`) 1650 EXTREAL_SUM_IMAGE_IN_IF, IN_INSERT] 1651 >> (MP_TAC o Q.SPEC `(\i. measure m (a INTER b i))` o UNDISCH o 1652 Q.ISPEC `(s' :num -> bool)`) EXTREAL_SUM_IMAGE_IN_IF 1653 >> RW_TAC std_ss [] 1654 >> MATCH_MP_TAC (METIS_PROVE [] ``!f x y z. (x = y) ==> (f x z = f y z)``) 1655 >> RW_TAC std_ss [FUN_EQ_THM] 1656 >> RW_TAC std_ss [] 1657 >> FULL_SIMP_TAC std_ss [GSYM DELETE_NON_ELEMENT]); 1658 1659(* ------------------------------------------------------------------------- *) 1660(* Uniqueness of Measure - Dynkin system [3] *) 1661(* ------------------------------------------------------------------------- *) 1662 1663(* `sigma-finite` is a property of measure space but sigma algebra *) 1664val sigma_finite_def = Define 1665 `sigma_finite m = 1666 ?f :num -> 'a set. 1667 f IN (UNIV -> measurable_sets m) /\ 1668 (!n. f n SUBSET f (SUC n)) /\ 1669 (BIGUNION (IMAGE f UNIV) = m_space m) /\ 1670 (!n. measure m (f n) < PosInf)`; 1671 1672(* this definition is sometimes useful for not repeating ���m��� *) 1673Definition sigma_finite_measure_space_def : 1674 sigma_finite_measure_space m = (measure_space m /\ sigma_finite m) 1675End 1676 1677(* NOTE: this definition should always be used together with a system of sets, 1678 e.g. algebra, ring, semiring, ... because by itself `m` is not meaningful. *) 1679val premeasure_def = Define ` 1680 premeasure m <=> positive m /\ countably_additive m`; 1681 1682(*****************************************************************************) 1683(* Premeasure properties of various systems of sets *) 1684(* ========================================================================= *) 1685(* Property name SEMIRING DYNKIN RING ALGEBRA MEASURE *) 1686(* ========================================================================= *) 1687(* INCREASING (MONOTONE) YES* YES YES YES YES *) 1688(* ADDITIVE YES YES YES YES YES *) 1689(* FINITE_ADDITIVE YES* YES YES YES YES *) 1690(* STRONG_ADDITIVE NO ? YES YES YES *) 1691(* SUBADDITIVE NO ? YES+ YES YES *) 1692(* FINITE_SUBADDIIVE NO ? YES+ YES YES *) 1693(* COUNTABLY_SUBADDITIVE NO ? YES* YES YES *) 1694(* COUNTABLE_INCREASING NO ? YES+ YES YES *) 1695(* COMPL_SUBSET NO YES? YES YES YES *) 1696(* COMPL NO YES? NO YES YES *) 1697(* ========================================================================= *) 1698(* [*] directly used in the proof of CARATHEODORY_SEMIRING *) 1699(* [+] indirectly used in the proof of CARATHEODORY_SEMIRING *) 1700(*****************************************************************************) 1701 1702val ALGEBRA_PREMEASURE_ADDITIVE = store_thm 1703 ("ALGEBRA_PREMEASURE_ADDITIVE", 1704 ``!m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> additive m``, 1705 RW_TAC std_ss [premeasure_def] 1706 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE 1707 >> PROVE_TAC [ALGEBRA_EMPTY, subsets_def]); 1708 1709(* |- !m. algebra (m_space m,measurable_sets m) /\ positive m /\ 1710 countably_additive m ==> additive m 1711 old name: COUNTABLY_ADDITIVE_ADDITIVE *) 1712val ALGEBRA_COUNTABLY_ADDITIVE_ADDITIVE = save_thm 1713 ("ALGEBRA_COUNTABLY_ADDITIVE_ADDITIVE", 1714 REWRITE_RULE [premeasure_def] ALGEBRA_PREMEASURE_ADDITIVE); 1715 1716val ALGEBRA_PREMEASURE_FINITE_ADDITIVE = store_thm 1717 ("ALGEBRA_PREMEASURE_FINITE_ADDITIVE", 1718 ``!m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> finite_additive m``, 1719 RW_TAC std_ss [premeasure_def] 1720 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE 1721 >> PROVE_TAC [ALGEBRA_EMPTY, subsets_def]); 1722 1723val MEASURE_FINITE_ADDITIVE = store_thm 1724 ("MEASURE_FINITE_ADDITIVE", 1725 ``!m. measure_space m ==> finite_additive m``, 1726 RW_TAC std_ss [measure_space_def] 1727 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_FINITE_ADDITIVE >> art [] 1728 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]); 1729 1730(*****************************************************************************) 1731 1732val DYNKIN_SYSTEM_PREMEASURE_ADDITIVE = store_thm 1733 ("DYNKIN_SYSTEM_PREMEASURE_ADDITIVE", 1734 ``!m. dynkin_system (m_space m, measurable_sets m) /\ premeasure m ==> additive m``, 1735 RW_TAC std_ss [premeasure_def] 1736 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE 1737 >> PROVE_TAC [DYNKIN_SYSTEM_EMPTY, subsets_def]); 1738 1739val DYNKIN_SYSTEM_PREMEASURE_FINITE_ADDITIVE = store_thm 1740 ("DYNKIN_SYSTEM_PREMEASURE_FINITE_ADDITIVE", 1741 ``!m. dynkin_system (m_space m, measurable_sets m) /\ premeasure m ==> finite_additive m``, 1742 RW_TAC std_ss [premeasure_def] 1743 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE 1744 >> PROVE_TAC [DYNKIN_SYSTEM_EMPTY, subsets_def]); 1745 1746(*****************************************************************************) 1747 1748 1749(* Assume that (sp, A) is a measurable space and that (A = sigma sp sts) is generated by 1750 a family `sts` such that 1751 1752 - `sts` is stable under finite intersections: G,H IN sts ==> G INTER H IN sts; 1753 - there exists an exhausting sequence (f n) SUBSET g with (f n) --> X. 1754 1755 Any two measures u, v that coincide on sts and are finite for all members of the 1756 exhausting sequence u(f n) = v(f n) < Inf, are equal on sts, i.e. u(s) = v(s) for 1757 all s IN A. 1758 *) 1759val UNIQUENESS_OF_MEASURE = store_thm 1760 ("UNIQUENESS_OF_MEASURE", 1761 ``!sp sts u v. 1762 subset_class sp sts /\ 1763 (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\ 1764 sigma_finite (sp,sts,u) /\ 1765 measure_space (sp,subsets (sigma sp sts),u) /\ 1766 measure_space (sp,subsets (sigma sp sts),v) /\ 1767 (!s. s IN sts ==> (u s = v s)) 1768 ==> 1769 (!s. s IN subsets (sigma sp sts) ==> (u s = v s))``, 1770 (* proof: expand `sigma_finite` first *) 1771 REWRITE_TAC [sigma_finite_def, space_def, subsets_def, m_space_def, 1772 measurable_sets_def, measure_def] 1773 >> rpt STRIP_TAC 1774 >> IMP_RES_TAC SIGMA_ALGEBRA_SIGMA 1775 >> Q.ABBREV_TAC `A = subsets (sigma sp sts)` 1776 >> Q.ABBREV_TAC `D = \j. (sp, {q | q IN A /\ (u (f j INTER q) = v (f j INTER q))})` 1777 >> `!j. space (D j) = sp` by METIS_TAC [space_def] 1778 >> IMP_RES_TAC DYNKIN_THM 1779 >> Know `!j. sts SUBSET subsets (D j)` 1780 >- (GEN_TAC >> REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\ 1781 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 1782 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 1783 CONJ_TAC >- PROVE_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF] \\ 1784 fs [IN_FUNSET, IN_UNIV]) 1785 >> DISCH_TAC 1786 (* Part 1: u (f j INTER a) < PosInf *) 1787 >> Know `!n. v (f n) < PosInf` 1788 >- (GEN_TAC >> `f n IN sts` by PROVE_TAC [IN_UNIV, IN_FUNSET] \\ 1789 PROVE_TAC []) 1790 >> DISCH_TAC 1791 >> Know `!j a. a IN A ==> u (f j INTER a) < PosInf` 1792 >- (rpt STRIP_TAC \\ 1793 MATCH_MP_TAC let_trans \\ 1794 Q.EXISTS_TAC `u (f j)` >> ASM_REWRITE_TAC [] \\ 1795 `u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\ 1796 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 1797 MATCH_MP_TAC INCREASING \\ 1798 CONJ_TAC >- IMP_RES_TAC MEASURE_SPACE_INCREASING \\ 1799 CONJ_TAC >- REWRITE_TAC [INTER_SUBSET] \\ 1800 REWRITE_TAC [measurable_sets_def, Once CONJ_COMM] \\ 1801 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1802 STRONG_CONJ_TAC >- PROVE_TAC [IN_UNIV, IN_FUNSET, SUBSET_DEF] \\ 1803 DISCH_TAC \\ 1804 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\ 1805 fs [sigma_algebra_def]) 1806 >> DISCH_TAC 1807 >> Know `!j a. a IN A ==> v (f j INTER a) < PosInf` 1808 >- (rpt STRIP_TAC \\ 1809 MATCH_MP_TAC let_trans \\ 1810 Q.EXISTS_TAC `v (f j)` >> ASM_REWRITE_TAC [] \\ 1811 `v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\ 1812 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 1813 MATCH_MP_TAC INCREASING \\ 1814 CONJ_TAC >- IMP_RES_TAC MEASURE_SPACE_INCREASING \\ 1815 CONJ_TAC >- REWRITE_TAC [INTER_SUBSET] \\ 1816 REWRITE_TAC [measurable_sets_def, Once CONJ_COMM] \\ 1817 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1818 STRONG_CONJ_TAC >- PROVE_TAC [IN_UNIV, IN_FUNSET, SUBSET_DEF] \\ 1819 DISCH_TAC \\ 1820 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\ 1821 fs [sigma_algebra_def]) 1822 >> DISCH_TAC 1823 (* Part 2: (D j) is dynkin system *) 1824 >> Know `!j. dynkin_system (D j)` 1825 >- (GEN_TAC >> REWRITE_TAC [dynkin_system_def] \\ 1826 CONJ_TAC (* subset_class (space (D j)) (subsets (D j)) *) 1827 >- (Q.PAT_X_ASSUM `!j. space (D j) = sp` (REWRITE_TAC o wrap) \\ 1828 REWRITE_TAC [subset_class_def] >> GEN_TAC \\ 1829 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 1830 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 1831 `subset_class sp A` by PROVE_TAC [SPACE_SIGMA, sigma_algebra_def, algebra_def] \\ 1832 STRIP_TAC >> PROVE_TAC [subset_class_def]) \\ 1833 CONJ_TAC (* space (D j) IN subsets (D j) *) 1834 >- (ASM_REWRITE_TAC [] \\ 1835 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 1836 `!n. f n SUBSET sp` by PROVE_TAC [IN_UNIV, IN_FUNSET, subset_class_def] \\ 1837 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 1838 CONJ_TAC (* sp IN A *) 1839 >- (Q.UNABBREV_TAC `A` \\ 1840 Suff `space (sigma sp sts) IN subsets (sigma sp sts)` >- PROVE_TAC [SPACE_SIGMA] \\ 1841 MATCH_MP_TAC (Q.SPEC `sigma sp sts` ALGEBRA_SPACE) \\ 1842 PROVE_TAC [sigma_algebra_def]) \\ 1843 (* u (f j INTER sp) = v (f j INTER sp) *) 1844 `f j INTER sp = f j` by PROVE_TAC [INTER_SUBSET_EQN] \\ 1845 POP_ASSUM (REWRITE_TAC o wrap) \\ 1846 PROVE_TAC [IN_FUNSET, IN_UNIV]) \\ 1847 CONJ_TAC (* under COMPL *) 1848 >- (Q.X_GEN_TAC `a` >> ONCE_ASM_REWRITE_TAC [] \\ 1849 Q.UNABBREV_TAC `D` >> BETA_TAC >> SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 1850 STRIP_TAC >> CONJ_TAC 1851 >- (Q.UNABBREV_TAC `A` \\ 1852 `sp DIFF a = space (sigma sp sts) DIFF a` by PROVE_TAC [SPACE_SIGMA] \\ 1853 POP_ASSUM (REWRITE_TAC o wrap) \\ 1854 MATCH_MP_TAC ALGEBRA_COMPL \\ 1855 PROVE_TAC [sigma_algebra_def]) \\ 1856 `!n. f n SUBSET sp` by PROVE_TAC [IN_UNIV, IN_FUNSET, subset_class_def] \\ 1857 `f j INTER (sp DIFF a) = f j DIFF (f j INTER a)` by ASM_SET_TAC [] \\ 1858 POP_ASSUM (REWRITE_TAC o wrap) \\ 1859 `(f j INTER a) SUBSET f j` by ASM_SET_TAC [] \\ 1860 Know `u (f j DIFF (f j INTER a)) = u (f j) - u (f j INTER a)` 1861 >- (`u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\ 1862 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 1863 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\ 1864 ASM_REWRITE_TAC [measurable_sets_def, measure_def] \\ 1865 STRONG_CONJ_TAC (* f j IN A *) 1866 >- (Q.UNABBREV_TAC `A` \\ 1867 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1868 PROVE_TAC [SUBSET_DEF, IN_FUNSET, IN_UNIV]) \\ 1869 DISCH_TAC >> CONJ_TAC 1870 >- (Q.UNABBREV_TAC `A` \\ 1871 MATCH_MP_TAC ALGEBRA_INTER >> PROVE_TAC [sigma_algebra_def]) \\ 1872 PROVE_TAC []) \\ 1873 DISCH_TAC \\ 1874 Know `v (f j DIFF (f j INTER a)) = v (f j) - v (f j INTER a)` 1875 >- (`v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\ 1876 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 1877 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\ 1878 ASM_REWRITE_TAC [measurable_sets_def, measure_def] \\ 1879 STRONG_CONJ_TAC (* f j IN A *) 1880 >- (Q.UNABBREV_TAC `A` \\ 1881 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1882 PROVE_TAC [SUBSET_DEF, IN_FUNSET, IN_UNIV]) \\ 1883 DISCH_TAC >> CONJ_TAC 1884 >- (Q.UNABBREV_TAC `A` \\ 1885 MATCH_MP_TAC ALGEBRA_INTER >> PROVE_TAC [sigma_algebra_def]) \\ 1886 PROVE_TAC []) \\ 1887 DISCH_TAC \\ 1888 NTAC 2 (POP_ASSUM (ONCE_REWRITE_TAC o wrap)) \\ 1889 fs [IN_UNIV, IN_FUNSET]) \\ 1890 (* 4. under COUNTABLE DIJOINT UNION *) 1891 Q.X_GEN_TAC `g` >> rpt STRIP_TAC \\ 1892 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 1893 Q.PAT_X_ASSUM `g IN X` MP_TAC \\ 1894 SIMP_TAC std_ss [subsets_def, GSPECIFICATION, IN_UNIV, IN_FUNSET] \\ 1895 STRIP_TAC \\ 1896 CONJ_TAC (* BIGUNION (IMAGE g univ(:num)) IN A *) 1897 >- (Q.UNABBREV_TAC `A` \\ 1898 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT] 1899 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\ 1900 POP_ASSUM MATCH_MP_TAC \\ 1901 fs [IN_FUNSET, IN_UNIV]) \\ 1902 REWRITE_TAC [ONCE_REWRITE_RULE [INTER_COMM] BIGUNION_OVER_INTER_L] \\ 1903 Know `u (BIGUNION (IMAGE (\i. f j INTER g i) univ(:num))) = suminf (u o (\i. f j INTER g i))` 1904 >- (`countably_additive (sp,A,u)` by PROVE_TAC [measure_space_def] \\ 1905 POP_ASSUM (MATCH_MP_TAC o 1906 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\ 1907 CONJ_TAC 1908 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> BETA_TAC \\ 1909 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\ 1910 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\ 1911 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1912 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\ 1913 METIS_TAC []) \\ 1914 CONJ_TAC (* disjoint *) 1915 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC \\ 1916 BETA_TAC >> ASM_SET_TAC []) \\ 1917 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT] 1918 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\ 1919 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\ 1920 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] \\ 1921 GEN_TAC >> MATCH_MP_TAC ALGEBRA_INTER \\ 1922 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 1923 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1924 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\ 1925 METIS_TAC []) \\ 1926 DISCH_THEN (REWRITE_TAC o wrap) \\ 1927 Know `v (BIGUNION (IMAGE (\i. f j INTER g i) univ(:num))) = suminf (v o (\i. f j INTER g i))` 1928 >- (`countably_additive (sp,A,v)` by PROVE_TAC [measure_space_def] \\ 1929 POP_ASSUM (MATCH_MP_TAC o 1930 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\ 1931 CONJ_TAC 1932 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> BETA_TAC \\ 1933 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\ 1934 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\ 1935 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1936 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\ 1937 METIS_TAC []) \\ 1938 CONJ_TAC (* disjoint *) 1939 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC \\ 1940 BETA_TAC >> ASM_SET_TAC []) \\ 1941 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT] 1942 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\ 1943 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\ 1944 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] \\ 1945 GEN_TAC >> MATCH_MP_TAC ALGEBRA_INTER \\ 1946 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 1947 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1948 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\ 1949 METIS_TAC []) \\ 1950 DISCH_THEN (REWRITE_TAC o wrap) \\ 1951 `u o (\i. f j INTER g i) = \i. u (f j INTER g i)` by METIS_TAC [o_DEF] \\ 1952 POP_ASSUM (REWRITE_TAC o wrap) \\ 1953 `v o (\i. f j INTER g i) = \i. v (f j INTER g i)` by METIS_TAC [o_DEF] \\ 1954 POP_ASSUM (REWRITE_TAC o wrap) \\ 1955 Know `(\i. u (f j INTER g i)) = (\i. v (f j INTER g i))` 1956 >- (FUN_EQ_TAC >> GEN_TAC >> BETA_TAC >> METIS_TAC []) \\ 1957 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\ 1958 KILL_TAC >> METIS_TAC []) 1959 >> DISCH_TAC 1960 (* Part 3: the main proof *) 1961 >> Know `!j. subsets (sigma sp sts) SUBSET subsets (D j)` 1962 >- (Q.PAT_ASSUM `dynkin sp sts = sigma sp sts` (ONCE_REWRITE_TAC o wrap o SYM) \\ 1963 GEN_TAC >> `sts SUBSET subsets (D j)` by PROVE_TAC [] \\ 1964 POP_ASSUM (MP_TAC o (MATCH_MP (Q.SPECL [`sp`, `sts`, `subsets (D j)`] DYNKIN_MONOTONE))) \\ 1965 METIS_TAC [(Q.SPEC `D j` DYNKIN_STABLE)]) 1966 >> DISCH_TAC 1967 >> Know `!j. A = subsets (D j)` 1968 >- (GEN_TAC >> REWRITE_TAC [SET_EQ_SUBSET] \\ 1969 CONJ_TAC >- PROVE_TAC [] \\ 1970 REWRITE_TAC [SUBSET_DEF] \\ 1971 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 1972 SIMP_TAC std_ss [subsets_def, GSPECIFICATION]) 1973 >> DISCH_TAC 1974 >> Know `!j a. a IN A ==> (u (f j INTER a) = v (f j INTER a))` 1975 >- (ASM_REWRITE_TAC [] >> rpt GEN_TAC \\ 1976 Q.UNABBREV_TAC `D` >> KILL_TAC >> BETA_TAC \\ 1977 SIMP_TAC std_ss [subsets_def, GSPECIFICATION]) 1978 >> DISCH_TAC 1979 >> Know `!a. a IN A ==> (u a = sup (IMAGE (u o (\i. (f i) INTER a)) UNIV))` 1980 >- (rpt STRIP_TAC \\ 1981 Q.ABBREV_TAC `g = \i. f i INTER a` \\ 1982 MATCH_MP_TAC EQ_SYM \\ 1983 `u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\ 1984 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 1985 MATCH_MP_TAC MONOTONE_CONVERGENCE \\ (* the "sup" is removed here! *) 1986 REWRITE_TAC [measurable_sets_def] \\ 1987 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 1988 CONJ_TAC 1989 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] \\ 1990 GEN_TAC >> Q.UNABBREV_TAC `g` >> BETA_TAC \\ 1991 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\ 1992 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\ 1993 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 1994 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\ 1995 ASM_REWRITE_TAC []) \\ 1996 CONJ_TAC (* !n. g n SUBSET g (SUC n) *) 1997 >- (Q.UNABBREV_TAC `g` >> BETA_TAC \\ 1998 GEN_TAC >> ASM_SET_TAC []) \\ 1999 (* a = BIGUNION (IMAGE g univ(:num)) *) 2000 Q.UNABBREV_TAC `g` >> BETA_TAC \\ 2001 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L] \\ 2002 Suff `a SUBSET sp` >- PROVE_TAC [INTER_SUBSET_EQN] \\ 2003 Q.UNABBREV_TAC `A` \\ 2004 `subset_class sp (subsets (sigma sp sts))` 2005 by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\ 2006 PROVE_TAC [subset_class_def]) 2007 >> DISCH_TAC 2008 >> Know `!a. a IN subsets (sigma sp sts) ==> 2009 (v a = sup (IMAGE (v o (\i. (f i) INTER a)) UNIV))` 2010 >- (rpt STRIP_TAC \\ 2011 Q.ABBREV_TAC `g = \i. f i INTER a` \\ 2012 MATCH_MP_TAC EQ_SYM \\ 2013 `v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\ 2014 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 2015 MATCH_MP_TAC MONOTONE_CONVERGENCE \\ (* the "sup" is removed here! *) 2016 REWRITE_TAC [measurable_sets_def] \\ 2017 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 2018 CONJ_TAC 2019 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] \\ 2020 GEN_TAC >> Q.UNABBREV_TAC `g` >> BETA_TAC \\ 2021 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\ 2022 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\ 2023 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\ 2024 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\ 2025 ASM_REWRITE_TAC []) \\ 2026 CONJ_TAC (* !n. g n SUBSET g (SUC n) *) 2027 >- (Q.UNABBREV_TAC `g` >> BETA_TAC \\ 2028 GEN_TAC >> ASM_SET_TAC []) \\ 2029 (* a = BIGUNION (IMAGE g univ(:num)) *) 2030 Q.UNABBREV_TAC `g` >> BETA_TAC \\ 2031 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L] \\ 2032 Suff `a SUBSET sp` >- PROVE_TAC [INTER_SUBSET_EQN] \\ 2033 Q.UNABBREV_TAC `A` \\ 2034 `subset_class sp (subsets (sigma sp sts))` 2035 by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\ 2036 PROVE_TAC [subset_class_def]) 2037 >> DISCH_TAC >> RES_TAC >> fs [o_DEF]); 2038 2039(* In this version, added assums: `(u sp = v sp) /\ (u sp < PosInf)` 2040 removed assums: `sigma_finite (sp,sts,u)` 2041 2042 see https://en.wikipedia.org/wiki/Pi-system 2043 *) 2044val UNIQUENESS_OF_MEASURE_FINITE = store_thm 2045 ("UNIQUENESS_OF_MEASURE_FINITE", 2046 ``!sp sts u v. 2047 subset_class sp sts /\ 2048 (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\ 2049 measure_space (sp,subsets (sigma sp sts),u) /\ 2050 measure_space (sp,subsets (sigma sp sts),v) /\ 2051 (u sp = v sp) /\ (u sp < PosInf) /\ (!s. s IN sts ==> (u s = v s)) 2052 ==> 2053 (!s. s IN subsets (sigma sp sts) ==> (u s = v s))``, 2054 rpt STRIP_TAC 2055 (* Part 1: some common facts *) 2056 >> IMP_RES_TAC SIGMA_ALGEBRA_SIGMA 2057 >> Q.ABBREV_TAC `A = subsets (sigma sp sts)` 2058 >> Q.ABBREV_TAC `D = (sp, {q | q IN A /\ (u q = v q)})` 2059 >> `space D = sp` by METIS_TAC [space_def] 2060 >> IMP_RES_TAC DYNKIN_THM 2061 >> Know `sts SUBSET subsets D` 2062 >- (REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\ 2063 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 2064 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 2065 CONJ_TAC >- PROVE_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF] >> fs []) 2066 >> DISCH_TAC 2067 (* Part 2: D is dynkin system *) 2068 >> Know `dynkin_system D` 2069 >- (REWRITE_TAC [dynkin_system_def] \\ 2070 CONJ_TAC (* subset_class (space D) (subsets D) *) 2071 >- (Q.PAT_X_ASSUM `space D = sp` (REWRITE_TAC o wrap) \\ 2072 REWRITE_TAC [subset_class_def] >> GEN_TAC \\ 2073 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 2074 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 2075 `subset_class sp A` by PROVE_TAC [SPACE_SIGMA, sigma_algebra_def, algebra_def] \\ 2076 STRIP_TAC >> PROVE_TAC [subset_class_def]) \\ 2077 CONJ_TAC (* space D IN subsets D *) 2078 >- (ASM_REWRITE_TAC [] \\ 2079 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 2080 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 2081 CONJ_TAC (* sp IN A *) 2082 >- (Q.UNABBREV_TAC `A` \\ 2083 Suff `space (sigma sp sts) IN subsets (sigma sp sts)` >- PROVE_TAC [SPACE_SIGMA] \\ 2084 MATCH_MP_TAC (Q.SPEC `sigma sp sts` ALGEBRA_SPACE) \\ 2085 PROVE_TAC [sigma_algebra_def]) \\ 2086 ASM_REWRITE_TAC []) \\ 2087 CONJ_TAC (* under COMPL *) 2088 >- (Q.X_GEN_TAC `a` >> ONCE_ASM_REWRITE_TAC [] \\ 2089 Q.UNABBREV_TAC `D` >> BETA_TAC >> SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\ 2090 STRIP_TAC >> CONJ_TAC (* sp DIFF a IN A *) 2091 >- (Q.UNABBREV_TAC `A` \\ 2092 `sp DIFF a = space (sigma sp sts) DIFF a` by PROVE_TAC [SPACE_SIGMA] \\ 2093 POP_ASSUM (REWRITE_TAC o wrap) \\ 2094 MATCH_MP_TAC ALGEBRA_COMPL \\ 2095 PROVE_TAC [sigma_algebra_def]) \\ 2096 Know `u (sp DIFF a) = u sp - u a` 2097 >- (`u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\ 2098 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 2099 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\ 2100 REWRITE_TAC [measurable_sets_def, measure_def] \\ 2101 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 2102 STRONG_CONJ_TAC >- PROVE_TAC [sigma_algebra_def, ALGEBRA_SPACE, SPACE_SIGMA] \\ 2103 DISCH_TAC \\ 2104 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 2105 STRONG_CONJ_TAC (* a SUBSET sp *) 2106 >- (`subset_class sp A` by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\ 2107 PROVE_TAC [subset_class_def]) \\ 2108 DISCH_TAC \\ 2109 MATCH_MP_TAC let_trans \\ 2110 Q.EXISTS_TAC `u sp` \\ 2111 reverse CONJ_TAC >- ASM_REWRITE_TAC [] \\ 2112 (* u a <= u sp *) 2113 `u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\ 2114 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 2115 MATCH_MP_TAC INCREASING \\ 2116 CONJ_TAC >- PROVE_TAC [MEASURE_SPACE_INCREASING] \\ 2117 ASM_REWRITE_TAC [measurable_sets_def]) \\ 2118 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\ 2119 Know `v (sp DIFF a) = v sp - v a` 2120 >- (`v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\ 2121 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 2122 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\ 2123 REWRITE_TAC [measurable_sets_def, measure_def] \\ 2124 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 2125 STRONG_CONJ_TAC >- PROVE_TAC [sigma_algebra_def, ALGEBRA_SPACE, SPACE_SIGMA] \\ 2126 DISCH_TAC \\ 2127 CONJ_TAC >- ASM_REWRITE_TAC [] \\ 2128 STRONG_CONJ_TAC (* a SUBSET sp *) 2129 >- (`subset_class sp A` by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\ 2130 PROVE_TAC [subset_class_def]) \\ 2131 DISCH_TAC \\ 2132 MATCH_MP_TAC let_trans \\ 2133 Q.EXISTS_TAC `v sp` \\ 2134 reverse CONJ_TAC >- PROVE_TAC [] \\ 2135 (* v a <= v sp *) 2136 `v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\ 2137 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 2138 MATCH_MP_TAC INCREASING \\ 2139 CONJ_TAC >- PROVE_TAC [MEASURE_SPACE_INCREASING] \\ 2140 ASM_REWRITE_TAC [measurable_sets_def]) \\ 2141 DISCH_THEN (ONCE_REWRITE_TAC o wrap) >> fs []) \\ 2142 (* under COUNTABLE UNION *) 2143 Q.X_GEN_TAC `g` >> rpt STRIP_TAC \\ 2144 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 2145 Q.PAT_X_ASSUM `g IN X` MP_TAC \\ 2146 SIMP_TAC std_ss [subsets_def, GSPECIFICATION, IN_UNIV, IN_FUNSET] \\ 2147 STRIP_TAC >> CONJ_TAC 2148 (* BIGUNION (IMAGE g univ(:num)) IN A *) 2149 >- (Q.UNABBREV_TAC `A` \\ 2150 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT] 2151 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\ 2152 POP_ASSUM MATCH_MP_TAC \\ 2153 fs [IN_FUNSET, IN_UNIV]) \\ 2154 (* u (BIGUNION (IMAGE g univ(:num))) = v (BIGUNION (IMAGE g univ(:num))) *) 2155 Know `u (BIGUNION (IMAGE g univ(:num))) = suminf (u o g)` 2156 >- (`countably_additive (sp,A,u)` by PROVE_TAC [measure_space_def] \\ 2157 POP_ASSUM (MATCH_MP_TAC o 2158 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\ 2159 CONJ_TAC 2160 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> METIS_TAC []) \\ 2161 CONJ_TAC (* disjoint *) 2162 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC >> METIS_TAC []) \\ 2163 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT] 2164 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\ 2165 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\ 2166 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] >> METIS_TAC []) \\ 2167 DISCH_THEN (REWRITE_TAC o wrap) \\ 2168 Know `v (BIGUNION (IMAGE g univ(:num))) = suminf (v o g)` 2169 >- (`countably_additive (sp,A,v)` by PROVE_TAC [measure_space_def] \\ 2170 POP_ASSUM (MATCH_MP_TAC o 2171 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\ 2172 CONJ_TAC 2173 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> METIS_TAC []) \\ 2174 CONJ_TAC (* disjoint *) 2175 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC >> METIS_TAC []) \\ 2176 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT] 2177 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\ 2178 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\ 2179 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] >> METIS_TAC []) \\ 2180 DISCH_THEN (REWRITE_TAC o wrap) \\ 2181 `u o g = \i. u (g i)` by METIS_TAC [o_DEF] \\ 2182 POP_ASSUM (REWRITE_TAC o wrap) \\ 2183 `v o g = \i. v (g i)` by METIS_TAC [o_DEF] \\ 2184 POP_ASSUM (REWRITE_TAC o wrap) \\ 2185 Know `(\i. u (g i)) = (\i. v (g i))` 2186 >- (FUN_EQ_TAC >> GEN_TAC >> BETA_TAC >> METIS_TAC []) \\ 2187 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\ 2188 KILL_TAC >> METIS_TAC []) 2189 >> DISCH_TAC 2190 (* Part 3: the main proof, much easier than those in UNIQUENESS_OF_MEASURE *) 2191 >> Know `subsets (sigma sp sts) SUBSET subsets D` 2192 >- (Q.PAT_ASSUM `dynkin sp sts = sigma sp sts` (ONCE_REWRITE_TAC o wrap o SYM) \\ 2193 Q.PAT_ASSUM `sts SUBSET subsets D` 2194 (MP_TAC o (MATCH_MP (Q.SPECL [`sp`, `sts`, `subsets D`] DYNKIN_MONOTONE))) \\ 2195 METIS_TAC [Q.SPEC `D` DYNKIN_STABLE]) 2196 >> DISCH_TAC 2197 >> Know `A = subsets D` 2198 >- (REWRITE_TAC [SET_EQ_SUBSET] \\ 2199 CONJ_TAC >- PROVE_TAC [] \\ 2200 REWRITE_TAC [SUBSET_DEF] \\ 2201 Q.UNABBREV_TAC `D` >> BETA_TAC \\ 2202 SIMP_TAC std_ss [subsets_def, GSPECIFICATION]) 2203 >> DISCH_TAC 2204 >> Know `!a. a IN A ==> (u a = v a)` 2205 >- (ASM_REWRITE_TAC [] >> rpt GEN_TAC \\ 2206 Q.UNABBREV_TAC `D` >> KILL_TAC >> BETA_TAC \\ 2207 SIMP_TAC std_ss [subsets_def, GSPECIFICATION]) 2208 >> DISCH_TAC >> RES_TAC); 2209 2210(* Dynkin system is closed under subset diff, a little surprised *) 2211val DYNKIN_SYSTEM_DIFF_SUBSET = store_thm 2212 ("DYNKIN_SYSTEM_DIFF_SUBSET", 2213 ``!d s t. dynkin_system d /\ s IN subsets d /\ t IN subsets d /\ s SUBSET t ==> 2214 t DIFF s IN subsets d``, 2215 rpt STRIP_TAC 2216 >> `subset_class (space d) (subsets d)` by PROVE_TAC [dynkin_system_def] 2217 >> `t DIFF s = space d DIFF ((space d DIFF t) UNION s)` by ASM_SET_TAC [subset_class_def] 2218 >> POP_ORW 2219 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL >> art [] 2220 >> `DISJOINT (space d DIFF t) s` by ASM_SET_TAC [DISJOINT_DEF, subset_class_def] 2221 >> MATCH_MP_TAC DYNKIN_SYSTEM_DUNION >> art [] 2222 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL >> art []); 2223 2224val DYNKIN_SYSTEM_PREMEASURE_INCREASING = store_thm 2225 ("DYNKIN_SYSTEM_PREMEASURE_INCREASING", 2226 ``!m. dynkin_system (m_space m, measurable_sets m) /\ premeasure m ==> increasing m``, 2227 rpt STRIP_TAC 2228 >> `additive m` by PROVE_TAC [DYNKIN_SYSTEM_PREMEASURE_ADDITIVE] 2229 >> fs [premeasure_def, increasing_def, positive_def] 2230 >> rpt STRIP_TAC 2231 >> `t = s UNION (t DIFF s)` by PROVE_TAC [UNION_DIFF] >> POP_ORW 2232 >> `DISJOINT s (t DIFF s)` by SET_TAC [DISJOINT_DEF] 2233 >> `t DIFF s IN measurable_sets m` by PROVE_TAC [DYNKIN_SYSTEM_DIFF_SUBSET, subsets_def] 2234 >> Know `measure m (s UNION (t DIFF s)) = measure m s + measure m (t DIFF s)` 2235 >- (MATCH_MP_TAC ADDITIVE >> art [] \\ 2236 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 2237 (Q.SPEC `(m_space m,measurable_sets m)` DYNKIN_SYSTEM_DUNION)) \\ 2238 ASM_REWRITE_TAC []) >> Rewr' 2239 >> MATCH_MP_TAC le_addr_imp >> PROVE_TAC []); 2240 2241(* ------------------------------------------------------------------------- *) 2242(* Existence of Measure - Caratheodory's celebrated extension theorem *) 2243(* ------------------------------------------------------------------------- *) 2244 2245(* (measure m) is an outer measure in (m_space m, measurable_sets m), which may 2246 not even be an algebra but at least `{} IN measurable_sets m` should hold. *) 2247val outer_measure_space_def = Define ` 2248 outer_measure_space m <=> 2249 subset_class (m_space m) (measurable_sets m) /\ 2250 {} IN (measurable_sets m) /\ 2251 positive m /\ increasing m /\ countably_subadditive m`; 2252 2253(* Defition 18.1 of [1]: the family of countable S-covers 2254 2255 Notice that `BIGUNION (IMAGE f UNIV)` needs not be disjoint or in `sts` 2256 *) 2257val countable_covers_def = Define 2258 `countable_covers (sts :'a set set) = 2259 \a. {f | f IN (univ(:num) -> sts) /\ a SUBSET (BIGUNION (IMAGE f UNIV))}`; 2260 2261(* Defition 18.1 of [1]: outer measure of the set-function m for C (covering), 2262 which could be `coutable_covers sts`. *) 2263val outer_measure_def = Define 2264 `outer_measure (m :'a measure) (C :('a set) -> (num -> 'a set) set) = 2265 \a. inf {r | ?f. f IN (C a) /\ (suminf (m o f) = r)}`; 2266 2267(* Defition 18.1 of [1]: m-measurable sets (caratheodory sets) of m *) 2268val caratheodory_sets_def = Define 2269 `caratheodory_sets (sp :'a set) (m :'a measure) = 2270 {a | a SUBSET sp /\ !q. q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a))}`; 2271 2272(* premeasure ==> countably_additive ==> additive *) 2273val SEMIRING_PREMEASURE_ADDITIVE = store_thm 2274 ("SEMIRING_PREMEASURE_ADDITIVE", 2275 ``!m. semiring (m_space m, measurable_sets m) /\ premeasure m ==> additive m``, 2276 RW_TAC std_ss [premeasure_def] 2277 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE 2278 >> PROVE_TAC [SEMIRING_EMPTY, subsets_def]); 2279 2280(* premeasure ==> countably_additive ==> finite_additive *) 2281val SEMIRING_PREMEASURE_FINITE_ADDITIVE = store_thm 2282 ("SEMIRING_PREMEASURE_FINITE_ADDITIVE", 2283 ``!m. semiring (m_space m, measurable_sets m) /\ premeasure m ==> 2284 finite_additive m``, 2285 rpt STRIP_TAC 2286 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE 2287 >> PROVE_TAC [SEMIRING_EMPTY, subsets_def, premeasure_def]); 2288 2289Theorem SEMIRING_PREMEASURE_INCREASING : 2290 !m. semiring (m_space m, measurable_sets m) /\ premeasure m ==> increasing m 2291Proof 2292 rpt STRIP_TAC 2293 >> IMP_RES_TAC SEMIRING_PREMEASURE_FINITE_ADDITIVE 2294 >> fs [increasing_def, positive_def, premeasure_def] 2295 >> rpt STRIP_TAC 2296 >> `t = s UNION (t DIFF s)` by PROVE_TAC [UNION_DIFF] >> POP_ORW 2297 >> `DISJOINT s (t DIFF s)` by SET_TAC [DISJOINT_DEF] 2298 >> fs [semiring_def, space_def, subsets_def,Excl"UNION_DIFF_EQ"] 2299 >> `?c. c SUBSET measurable_sets m /\ FINITE c /\ disjoint c /\ (t DIFF s = BIGUNION c)` 2300 by PROVE_TAC [] >> art [] 2301 >> REWRITE_TAC [GSYM BIGUNION_INSERT] 2302 >> Know `FINITE (s INSERT c) /\ disjoint (s INSERT c)` 2303 >- (CONJ_TAC >- PROVE_TAC [FINITE_INSERT] \\ 2304 ONCE_REWRITE_TAC [INSERT_SING_UNION] \\ 2305 MATCH_MP_TAC disjoint_union >> art [disjoint_sing, BIGUNION_SING] \\ 2306 PROVE_TAC [DISJOINT_DEF]) 2307 >> DISCH_THEN (STRIP_ASSUME_TAC o (MATCH_MP finite_disjoint_decomposition)) 2308 >> ASM_REWRITE_TAC [] 2309 >> Know `measure m (BIGUNION (IMAGE f (count n))) = SIGMA (measure m o f) (count n)` 2310 >- (fs [finite_additive_def] \\ 2311 FIRST_X_ASSUM MATCH_MP_TAC \\ 2312 RW_TAC std_ss [] >- PROVE_TAC [SUBSET_DEF] \\ 2313 Q.PAT_X_ASSUM `s INSERT c = IMAGE f (count n)` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ 2314 REWRITE_TAC [BIGUNION_INSERT] \\ 2315 Q.PAT_X_ASSUM `t DIFF s = BIGUNION c` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ 2316 `s UNION (t DIFF s) = t` by PROVE_TAC [UNION_DIFF] \\ 2317 POP_ASSUM (ASM_REWRITE_TAC o wrap)) 2318 >> Rewr 2319 >> Know `SIGMA (measure m o f) (count n) = SIGMA (measure m) (IMAGE f (count n))` 2320 >- (MATCH_MP_TAC EQ_SYM >> irule EXTREAL_SUM_IMAGE_IMAGE \\ 2321 REWRITE_TAC [FINITE_COUNT, IN_IMAGE, IN_COUNT] \\ 2322 CONJ_TAC >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\ 2323 MATCH_MP_TAC pos_not_neginf >> art [] \\ 2324 fs [IN_INSERT] >> METIS_TAC [SUBSET_DEF]) \\ 2325 MATCH_MP_TAC INJ_IMAGE \\ 2326 Q.EXISTS_TAC `s INSERT c` \\ 2327 RW_TAC std_ss [INJ_DEF, IN_COUNT] >> METIS_TAC []) 2328 >> Rewr' 2329 >> Q.PAT_X_ASSUM `s INSERT c = IMAGE f (count n)` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) 2330 >> Know `SIGMA (measure m) (s INSERT c) = measure m s + SIGMA (measure m) (c DELETE s)` 2331 >- (STRIP_ASSUME_TAC (Q.ISPEC `measure m` EXTREAL_SUM_IMAGE_THM) \\ 2332 POP_ASSUM MATCH_MP_TAC >> art [] \\ 2333 DISJ2_TAC >> GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\ 2334 FIRST_X_ASSUM MATCH_MP_TAC >> fs [IN_INSERT] >> PROVE_TAC [SUBSET_DEF]) 2335 >> Rewr 2336 >> MATCH_MP_TAC le_addr_imp 2337 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS 2338 >> RW_TAC std_ss [FINITE_DELETE, IN_DELETE] 2339 >> PROVE_TAC [SUBSET_DEF] 2340QED 2341 2342val RING_PREMEASURE_INCREASING = store_thm (* cf. ADDITIVE_INCREASING *) 2343 ("RING_PREMEASURE_INCREASING", 2344 ``!m. ring (m_space m, measurable_sets m) /\ premeasure m ==> increasing m``, 2345 rpt STRIP_TAC 2346 >> MATCH_MP_TAC SEMIRING_PREMEASURE_INCREASING >> art [] 2347 >> IMP_RES_TAC RING_IMP_SEMIRING); 2348 2349val ALGEBRA_PREMEASURE_INCREASING = store_thm (* cf. ADDITIVE_INCREASING *) 2350 ("ALGEBRA_PREMEASURE_INCREASING", 2351 ``!m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> increasing m``, 2352 rpt STRIP_TAC 2353 >> MATCH_MP_TAC RING_PREMEASURE_INCREASING >> art [] 2354 >> IMP_RES_TAC ALGEBRA_IMP_RING); 2355 2356val RING_PREMEASURE_ADDITIVE = store_thm 2357 ("RING_PREMEASURE_ADDITIVE", 2358 ``!m. ring (m_space m, measurable_sets m) /\ premeasure m ==> additive m``, 2359 RW_TAC std_ss [premeasure_def] 2360 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE 2361 >> PROVE_TAC [RING_EMPTY, subsets_def]); 2362 2363val RING_PREMEASURE_FINITE_ADDITIVE = store_thm 2364 ("RING_PREMEASURE_FINITE_ADDITIVE", 2365 ``!m. ring (m_space m, measurable_sets m) /\ premeasure m ==> finite_additive m``, 2366 RW_TAC std_ss [premeasure_def] 2367 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE 2368 >> PROVE_TAC [RING_EMPTY, subsets_def]); 2369 2370val RING_PREMEASURE_DIFF_SUBSET = store_thm 2371 ("RING_PREMEASURE_DIFF_SUBSET", 2372 ``!m s t. ring (m_space m, measurable_sets m) /\ premeasure m /\ 2373 s IN measurable_sets m /\ t IN measurable_sets m /\ s SUBSET t /\ 2374 measure m s < PosInf ==> (measure m (t DIFF s) = measure m t - measure m s)``, 2375 rpt STRIP_TAC 2376 >> `additive m` by PROVE_TAC [RING_PREMEASURE_ADDITIVE] 2377 >> Know `measure m s <> NegInf /\ measure m s <> PosInf` 2378 >- (CONJ_TAC >- PROVE_TAC [positive_not_infty, premeasure_def] \\ 2379 art [lt_infty]) 2380 >> DISCH_TAC 2381 >> Suff `measure m (t DIFF s) + measure m s = measure m t - measure m s + measure m s` 2382 >- (POP_ASSUM (STRIP_ASSUME_TAC o (MATCH_MP EXTREAL_EQ_RADD)) \\ 2383 PROVE_TAC []) 2384 >> POP_ASSUM (STRIP_ASSUME_TAC o (MATCH_MP sub_add)) >> POP_ORW 2385 >> MATCH_MP_TAC EQ_SYM 2386 >> MATCH_MP_TAC ADDITIVE >> art [] 2387 >> CONJ_TAC >- (MATCH_MP_TAC (((REWRITE_RULE [subsets_def]) o 2388 (Q.SPEC `(m_space m, measurable_sets m)`)) RING_DIFF) \\ 2389 ASM_REWRITE_TAC []) 2390 >> ASM_SET_TAC [DISJOINT_DEF]); 2391 2392val ALGEBRA_PREMEASURE_DIFF_SUBSET = store_thm 2393 ("ALGEBRA_PREMEASURE_DIFF_SUBSET", 2394 ``!m s t. algebra (m_space m, measurable_sets m) /\ premeasure m /\ 2395 s IN measurable_sets m /\ t IN measurable_sets m /\ s SUBSET t /\ 2396 measure m s < PosInf ==> (measure m (t DIFF s) = measure m t - measure m s)``, 2397 rpt STRIP_TAC 2398 >> MATCH_MP_TAC RING_PREMEASURE_DIFF_SUBSET >> art [] 2399 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2400 2401val ALGEBRA_PREMEASURE_COMPL = store_thm 2402 ("ALGEBRA_PREMEASURE_COMPL", 2403 ``!m s. algebra (m_space m, measurable_sets m) /\ premeasure m /\ 2404 s IN measurable_sets m /\ measure m s < PosInf ==> 2405 (measure m (m_space m DIFF s) = measure m (m_space m) - measure m s)``, 2406 rpt STRIP_TAC 2407 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_DIFF_SUBSET >> art [] 2408 >> CONJ_TAC >- PROVE_TAC [ALGEBRA_SPACE, space_def, subsets_def] 2409 >> fs [algebra_def, subset_class_def, space_def, subsets_def]); 2410 2411Theorem RING_ADDITIVE_STRONG_ADDITIVE : 2412 !m s t. ring (m_space m, measurable_sets m) /\ additive m /\ positive m /\ 2413 s IN measurable_sets m /\ t IN measurable_sets m ==> 2414 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t) 2415Proof 2416 rpt STRIP_TAC 2417 >> `s UNION t = s UNION (t DIFF s)` by SET_TAC [] >> POP_ORW 2418 >> `s INTER t IN measurable_sets m` by PROVE_TAC [RING_INTER, subsets_def] 2419 >> `t DIFF s IN measurable_sets m` by PROVE_TAC [RING_DIFF, subsets_def] 2420 >> Know `measure m (s UNION (t DIFF s)) = measure m s + measure m (t DIFF s)` 2421 >- (MATCH_MP_TAC ADDITIVE >> art [] \\ 2422 CONJ_TAC >- SET_TAC [DISJOINT_DEF] \\ 2423 PROVE_TAC [RING_UNION, subsets_def]) 2424 >> Rewr' 2425 >> Know `measure m s + measure m (t DIFF s) + measure m (s INTER t) = 2426 measure m s + (measure m (t DIFF s) + measure m (s INTER t))` 2427 >- (MATCH_MP_TAC EQ_SYM \\ 2428 MATCH_MP_TAC add_assoc >> DISJ1_TAC \\ 2429 RW_TAC std_ss [] \\ (* 3 subgoals, same tactics *) 2430 MATCH_MP_TAC pos_not_neginf >> PROVE_TAC [positive_def]) 2431 >> Rewr' 2432 >> Know `measure m (t DIFF s) + measure m (s INTER t) = measure m t` 2433 >- (MATCH_MP_TAC EQ_SYM \\ 2434 MATCH_MP_TAC ADDITIVE >> art [] \\ 2435 SET_TAC [DISJOINT_DEF]) 2436 >> Rewr 2437QED 2438 2439val RING_PREMEASURE_STRONG_ADDITIVE = store_thm 2440 ("RING_PREMEASURE_STRONG_ADDITIVE", 2441 ``!m s t. ring (m_space m, measurable_sets m) /\ premeasure m /\ 2442 s IN measurable_sets m /\ t IN measurable_sets m ==> 2443 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)``, 2444 rpt STRIP_TAC 2445 >> MATCH_MP_TAC RING_ADDITIVE_STRONG_ADDITIVE 2446 >> fs [premeasure_def] 2447 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE 2448 >> fs [positive_def, ring_def, subsets_def]); 2449 2450val ALGEBRA_PREMEASURE_STRONG_ADDITIVE = store_thm 2451 ("ALGEBRA_PREMEASURE_STRONG_ADDITIVE", 2452 ``!m s t. algebra (m_space m, measurable_sets m) /\ premeasure m /\ 2453 s IN measurable_sets m /\ t IN measurable_sets m ==> 2454 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)``, 2455 rpt STRIP_TAC 2456 >> MATCH_MP_TAC RING_PREMEASURE_STRONG_ADDITIVE >> art [] 2457 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2458 2459val MEASURE_SPACE_STRONG_ADDITIVE = store_thm 2460 ("MEASURE_SPACE_STRONG_ADDITIVE", 2461 ``!m s t. measure_space m /\ 2462 s IN measurable_sets m /\ t IN measurable_sets m ==> 2463 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)``, 2464 RW_TAC std_ss [measure_space_def] 2465 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_STRONG_ADDITIVE >> art [] 2466 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]); 2467 2468(* This is a more general version of MEASURE_COUNTABLE_INCREASING, 2469 `s IN measurable_sets m` must be added into antecedents. *) 2470Theorem RING_PREMEASURE_COUNTABLE_INCREASING : 2471 !m s f. 2472 ring (m_space m, measurable_sets m) /\ premeasure m /\ 2473 f IN (UNIV -> measurable_sets m) /\ 2474 (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) /\ 2475 (s = BIGUNION (IMAGE f UNIV)) /\ s IN measurable_sets m ==> 2476 (sup (IMAGE (measure m o f) UNIV) = measure m s) 2477Proof 2478 RW_TAC std_ss [IN_FUNSET, IN_UNIV, premeasure_def] 2479 >> Know `measure m o f = (\n. SIGMA (measure m o (\m. f (SUC m) DIFF f m)) (count n))` 2480 >- (FUN_EQ_TAC \\ 2481 Induct >- (RW_TAC std_ss [o_THM, RING_EMPTY, subsets_def, COUNT_ZERO, 2482 EXTREAL_SUM_IMAGE_EMPTY] >> PROVE_TAC [positive_def]) \\ 2483 POP_ASSUM (MP_TAC o SYM) \\ 2484 RW_TAC arith_ss [o_THM, COUNT_SUC] \\ 2485 Know `!n. (measure m o (\m. f (SUC m) DIFF f m)) n <> NegInf` 2486 >- (RW_TAC std_ss [] \\ 2487 `f (SUC n) DIFF f n IN measurable_sets m` by METIS_TAC [RING_DIFF, subsets_def] \\ 2488 METIS_TAC [positive_def, positive_not_infty, o_DEF]) >> DISCH_TAC \\ 2489 `FINITE (count x)` by RW_TAC std_ss [FINITE_COUNT] \\ 2490 `count x DELETE x = count x` 2491 by METIS_TAC [IN_COUNT, DELETE_NON_ELEMENT, LESS_REFL] \\ 2492 RW_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY] \\ 2493 `additive m` by PROVE_TAC [RING_PREMEASURE_ADDITIVE, premeasure_def] \\ 2494 MATCH_MP_TAC ADDITIVE \\ 2495 FULL_SIMP_TAC arith_ss [EXTENSION, IN_UNION, IN_DIFF, DISJOINT_DEF, NOT_IN_EMPTY, 2496 IN_INTER, SUBSET_DEF, IN_COUNT, IN_DELETE] \\ 2497 (MP_TAC o REWRITE_RULE [subsets_def, space_def] o 2498 (Q.SPEC `(m_space m, measurable_sets m)`)) RING_DIFF >> PROVE_TAC []) 2499 >> Rewr' 2500 >> Know `!n. 0 <= (measure m o (\m. f (SUC m) DIFF f m)) n` 2501 >- (RW_TAC std_ss [o_DEF] \\ 2502 fs [positive_def] >> FIRST_X_ASSUM MATCH_MP_TAC \\ 2503 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 2504 (Q.SPEC `(m_space m,measurable_sets m)` RING_DIFF)) >> art []) 2505 >> DISCH_THEN (MP_TAC o SYM o (MATCH_MP ext_suminf_def)) >> Rewr' 2506 >> MATCH_MP_TAC COUNTABLY_ADDITIVE >> art [] 2507 >> CONJ_TAC 2508 >- (RW_TAC std_ss [IN_UNIV, IN_FUNSET] \\ 2509 (MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o 2510 (Q.SPEC `(m_space m, measurable_sets m)`)) RING_DIFF \\ 2511 FULL_SIMP_TAC std_ss []) 2512 >> CONJ_TAC 2513 >- (rpt STRIP_TAC \\ 2514 MATCH_MP_TAC DISJOINT_DIFFS \\ 2515 Q.EXISTS_TAC `f` >> RW_TAC std_ss []) 2516 >> RW_TAC std_ss [IN_BIGUNION_IMAGE,IN_DIFF,IN_UNIV,EXTENSION] 2517 >> reverse EQ_TAC >> RW_TAC std_ss [] >- METIS_TAC [] 2518 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY] 2519 >> METIS_TAC [] 2520QED 2521 2522val ALGEBRA_PREMEASURE_COUNTABLE_INCREASING = store_thm 2523 ("ALGEBRA_PREMEASURE_COUNTABLE_INCREASING", 2524 ``!m s f. 2525 algebra (m_space m, measurable_sets m) /\ premeasure m /\ 2526 f IN (UNIV -> measurable_sets m) /\ 2527 (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) /\ 2528 (s = BIGUNION (IMAGE f UNIV)) /\ s IN measurable_sets m ==> 2529 (sup (IMAGE (measure m o f) UNIV) = measure m s)``, 2530 rpt STRIP_TAC 2531 >> MATCH_MP_TAC RING_PREMEASURE_COUNTABLE_INCREASING >> art [] 2532 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2533 2534Theorem RING_ADDITIVE_SUBADDITIVE : 2535 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==> 2536 subadditive m 2537Proof 2538 RW_TAC std_ss [subadditive_def] 2539 >> `measure m s + measure m t = measure m (s UNION t) + measure m (s INTER t)` 2540 by PROVE_TAC [RING_ADDITIVE_STRONG_ADDITIVE] 2541 >> POP_ORW 2542 >> MATCH_MP_TAC le_addr_imp 2543 >> `s INTER t IN measurable_sets m` by PROVE_TAC [RING_INTER, subsets_def] 2544 >> PROVE_TAC [positive_def] 2545QED 2546 2547Theorem RING_ADDITIVE_FINITE_ADDITIVE : 2548 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==> 2549 finite_additive m 2550Proof 2551 RW_TAC std_ss [additive_def, finite_additive_def] 2552 >> Induct_on `n` 2553 >- fs [COUNT_ZERO, positive_def, ring_def, subsets_def, EXTREAL_SUM_IMAGE_EMPTY] 2554 >> RW_TAC std_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT, 2555 EXTREAL_SUM_IMAGE_THM] 2556 >> Know `SIGMA (measure m o f) (n INSERT count n) = 2557 (measure m o f) n + SIGMA (measure m o f) ((count n) DELETE n)` 2558 >- (irule EXTREAL_SUM_IMAGE_PROPERTY_NEG \\ 2559 RW_TAC std_ss [FINITE_COUNT, GSYM COUNT_SUC, IN_COUNT, o_DEF] \\ 2560 MATCH_MP_TAC pos_not_neginf \\ 2561 fs [positive_def]) >> Rewr' 2562 >> REWRITE_TAC [COUNT_DELETE] 2563 >> Q.ABBREV_TAC `A = BIGUNION (IMAGE f (count n))` 2564 >> Know `DISJOINT A (f n)` 2565 >- (Q.UNABBREV_TAC `A` \\ 2566 RW_TAC set_ss [List.nth (CONJUNCTS DISJOINT_BIGUNION, 0)] \\ 2567 FIRST_X_ASSUM MATCH_MP_TAC >> rw []) 2568 >> DISCH_TAC 2569 >> Know `A IN measurable_sets m` 2570 >- (Suff `A = (f n UNION A) DIFF (f n)` 2571 >- (Rewr' \\ 2572 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 2573 (Q.SPEC `(m_space m,measurable_sets m)` 2574 RING_DIFF)) >> rw []) \\ 2575 POP_ASSUM MP_TAC >> SET_TAC []) 2576 >> DISCH_TAC 2577 >> Know `SIGMA (measure m o f) (count n) = measure m A` 2578 >- (MATCH_MP_TAC EQ_SYM \\ 2579 FIRST_X_ASSUM irule >> rw []) >> Rewr' 2580 >> SIMP_TAC std_ss [o_DEF] 2581 >> FIRST_X_ASSUM MATCH_MP_TAC >> rw [DISJOINT_SYM] 2582QED 2583 2584Theorem RING_SUBADDITIVE_FINITE_SUBADDITIVE : 2585 !m. ring (m_space m, measurable_sets m) /\ positive m /\ 2586 subadditive m ==> finite_subadditive m 2587Proof 2588 RW_TAC std_ss [subadditive_def, finite_subadditive_def] 2589 >> Induct_on `n` 2590 >- fs [COUNT_ZERO, positive_def, ring_def, subsets_def, 2591 EXTREAL_SUM_IMAGE_EMPTY, le_refl] 2592 >> RW_TAC std_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT, 2593 EXTREAL_SUM_IMAGE_THM] 2594 >> Know `SIGMA (measure m o f) (n INSERT count n) = 2595 (measure m o f) n + SIGMA (measure m o f) ((count n) DELETE n)` 2596 >- (irule EXTREAL_SUM_IMAGE_PROPERTY_NEG \\ 2597 RW_TAC std_ss [FINITE_COUNT, GSYM COUNT_SUC, IN_COUNT, o_DEF] \\ 2598 MATCH_MP_TAC pos_not_neginf \\ 2599 fs [positive_def]) >> Rewr' 2600 >> REWRITE_TAC [COUNT_DELETE] 2601 >> Q.ABBREV_TAC `A = BIGUNION (IMAGE f (count n))` 2602 >> Know `A IN measurable_sets m` 2603 >- (Q.UNABBREV_TAC `A` \\ 2604 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 2605 (Q.SPEC `(m_space m,measurable_sets m)` 2606 RING_FINITE_UNION)) \\ 2607 rw [FINITE_COUNT, IMAGE_FINITE] \\ 2608 rw [SUBSET_DEF, IN_IMAGE] \\ 2609 FIRST_X_ASSUM MATCH_MP_TAC >> rw []) >> DISCH_TAC 2610 >> MATCH_MP_TAC le_trans 2611 >> Q.EXISTS_TAC `(measure m o f) n + measure m A` 2612 >> CONJ_TAC 2613 >- (SIMP_TAC std_ss [o_DEF] \\ 2614 FIRST_X_ASSUM MATCH_MP_TAC >> rw []) 2615 >> Q.ABBREV_TAC `x = (measure m o f) n` 2616 >> Cases_on `x = PosInf` 2617 >- (POP_ORW \\ 2618 Know `measure m A <> NegInf` 2619 >- (MATCH_MP_TAC pos_not_neginf >> fs [positive_def]) \\ 2620 Know `SIGMA (measure m o f) (count n) <> NegInf` 2621 >- (MATCH_MP_TAC pos_not_neginf \\ 2622 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\ 2623 rw [FINITE_COUNT, IN_COUNT, o_DEF] \\ 2624 fs [positive_def]) \\ 2625 rw [add_infty, le_refl]) 2626 >> Know `x <> NegInf` 2627 >- (MATCH_MP_TAC pos_not_neginf \\ 2628 Q.UNABBREV_TAC `x` >> SIMP_TAC std_ss [o_DEF] \\ 2629 fs [positive_def]) 2630 >> rw [le_ladd] 2631QED 2632 2633val RING_PREMEASURE_SUBADDITIVE = store_thm 2634 ("RING_PREMEASURE_SUBADDITIVE", 2635 ``!m. ring (m_space m, measurable_sets m) /\ premeasure m ==> subadditive m``, 2636 RW_TAC std_ss [subadditive_def] 2637 >> `measure m s + measure m t = measure m (s UNION t) + measure m (s INTER t)` 2638 by PROVE_TAC [RING_PREMEASURE_STRONG_ADDITIVE] 2639 >> POP_ORW 2640 >> MATCH_MP_TAC le_addr_imp 2641 >> `s INTER t IN measurable_sets m` by PROVE_TAC [RING_INTER, subsets_def] 2642 >> PROVE_TAC [premeasure_def, positive_def]); 2643 2644val ALGEBRA_PREMEASURE_SUBADDITIVE = store_thm 2645 ("ALGEBRA_PREMEASURE_SUBADDITIVE", 2646 ``!m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> subadditive m``, 2647 rpt STRIP_TAC 2648 >> MATCH_MP_TAC RING_PREMEASURE_SUBADDITIVE >> art [] 2649 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2650 2651val MEASURE_SPACE_SUBADDITIVE = store_thm 2652 ("MEASURE_SPACE_SUBADDITIVE", 2653 ``!m. measure_space m ==> subadditive m``, 2654 RW_TAC std_ss [measure_space_def] 2655 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_SUBADDITIVE >> art [] 2656 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]); 2657 2658val RING_PREMEASURE_FINITE_SUBADDITIVE = store_thm 2659 ("RING_PREMEASURE_FINITE_SUBADDITIVE", 2660 ``!m. ring (m_space m, measurable_sets m) /\ premeasure m ==> finite_subadditive m``, 2661 rpt STRIP_TAC 2662 >> `subadditive m` by PROVE_TAC [RING_PREMEASURE_SUBADDITIVE] 2663 >> fs [premeasure_def, finite_subadditive_def] 2664 >> GEN_TAC >> Induct_on `n` 2665 >- (RW_TAC arith_ss [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, EXTREAL_SUM_IMAGE_EMPTY] \\ 2666 PROVE_TAC [le_refl, positive_def]) 2667 >> RW_TAC arith_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT] 2668 >> `!i. i < n ==> f i IN measurable_sets m` by RW_TAC arith_ss [] 2669 >> Know `BIGUNION (IMAGE f (count n)) IN measurable_sets m` 2670 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def] 2671 (Q.SPEC `(m_space m,measurable_sets m)` RING_FINITE_UNION_ALT)) \\ 2672 ASM_REWRITE_TAC []) 2673 >> DISCH_TAC 2674 >> Q.PAT_X_ASSUM `X ==> measure m (BIGUNION (IMAGE f (count n))) <= 2675 SIGMA (measure m o f) (count n)` MP_TAC 2676 >> RW_TAC std_ss [] 2677 >> Know `SIGMA (measure m o f) (n INSERT count n) = 2678 (measure m o f) n + SIGMA (measure m o f) ((count n) DELETE n)` 2679 >- (irule EXTREAL_SUM_IMAGE_PROPERTY \\ 2680 SIMP_TAC std_ss [FINITE_COUNT, IN_INSERT, IN_COUNT] \\ 2681 DISJ1_TAC >> GEN_TAC >> DISCH_TAC \\ 2682 MATCH_MP_TAC pos_not_neginf \\ 2683 METIS_TAC [positive_def, LESS_SUC_REFL]) >> Rewr' 2684 >> Know `count n DELETE n = count n` 2685 >- (REWRITE_TAC [EXTENSION] \\ 2686 GEN_TAC >> REWRITE_TAC [IN_DELETE, IN_COUNT] \\ 2687 RW_TAC arith_ss []) >> Rewr' 2688 >> MATCH_MP_TAC le_trans 2689 >> Q.EXISTS_TAC `measure m (f n) + measure m (BIGUNION (IMAGE f (count n)))` 2690 >> CONJ_TAC 2691 >- (MATCH_MP_TAC SUBADDITIVE >> art [] \\ 2692 PROVE_TAC [positive_def, LESS_SUC_REFL]) 2693 >> fs [o_DEF] >> MATCH_MP_TAC le_ladd_imp >> art []); 2694 2695val ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE = store_thm 2696 ("ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE", 2697 ``!m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> finite_subadditive m``, 2698 rpt STRIP_TAC 2699 >> MATCH_MP_TAC RING_PREMEASURE_FINITE_SUBADDITIVE >> art [] 2700 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2701 2702val MEASURE_SPACE_FINITE_SUBADDITIVE = store_thm 2703 ("MEASURE_SPACE_FINITE_SUBADDITIVE", 2704 ``!m. measure_space m ==> finite_subadditive m``, 2705 RW_TAC std_ss [measure_space_def] 2706 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE >> art [] 2707 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]); 2708 2709(* This non-trivial result is needed by CARATHEODORY_SEMIRING *) 2710Theorem RING_PREMEASURE_COUNTABLY_SUBADDITIVE : 2711 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==> 2712 countably_subadditive m 2713Proof 2714 RW_TAC std_ss [countably_subadditive_def, premeasure_def] 2715 >> STRIP_ASSUME_TAC (Q.SPEC `f` SETS_TO_INCREASING_SETS') >> art [] 2716 >> Know `g IN (univ(:num) -> measurable_sets m)` 2717 >- (REWRITE_TAC [IN_FUNSET, IN_UNIV] \\ 2718 GEN_TAC >> art [] \\ 2719 MATCH_MP_TAC (((REWRITE_RULE [subsets_def]) o 2720 (Q.SPEC `(m_space m,measurable_sets m)`)) RING_FINITE_UNION_ALT) \\ 2721 RW_TAC std_ss [] >> PROVE_TAC [IN_FUNSET, IN_UNIV]) 2722 >> DISCH_TAC 2723 >> Know `measure m (BIGUNION (IMAGE g univ(:num))) = sup (IMAGE (measure m o g) UNIV)` 2724 >- (MATCH_MP_TAC EQ_SYM \\ 2725 MATCH_MP_TAC RING_PREMEASURE_COUNTABLE_INCREASING >> art [premeasure_def] \\ 2726 PROVE_TAC []) >> Rewr' 2727 (* stage work *) 2728 >> Know `!n. 0 <= (measure m o f) n` 2729 >- (RW_TAC std_ss [o_DEF] \\ 2730 fs [positive_def] >> FIRST_X_ASSUM MATCH_MP_TAC \\ 2731 fs [IN_FUNSET, IN_UNIV]) 2732 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' 2733 >> MATCH_MP_TAC sup_mono 2734 >> GEN_TAC 2735 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [o_DEF] 2736 >> BETA_TAC >> art [] 2737 >> MATCH_MP_TAC FINITE_SUBADDITIVE >> art [] 2738 >> fs [IN_FUNSET, IN_UNIV] 2739 >> CONJ_TAC 2740 >- (MATCH_MP_TAC RING_PREMEASURE_FINITE_SUBADDITIVE >> art [premeasure_def]) 2741 >> MATCH_MP_TAC (((REWRITE_RULE [subsets_def]) o 2742 (Q.SPEC `(m_space m,measurable_sets m)`)) RING_FINITE_UNION_ALT) 2743 >> ASM_REWRITE_TAC [] 2744QED 2745 2746val ALGEBRA_PREMEASURE_COUNTABLY_SUBADDITIVE = store_thm 2747 ("ALGEBRA_PREMEASURE_COUNTABLY_SUBADDITIVE", 2748 ``!m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> 2749 countably_subadditive m``, 2750 rpt STRIP_TAC 2751 >> MATCH_MP_TAC RING_PREMEASURE_COUNTABLY_SUBADDITIVE >> art [] 2752 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2753 2754(* Proposition 4.3 (viii) [1] *) 2755val MEASURE_SPACE_COUNTABLY_SUBADDITIVE = store_thm 2756 ("MEASURE_SPACE_COUNTABLY_SUBADDITIVE", 2757 ``!m. measure_space m ==> countably_subadditive m``, 2758 RW_TAC std_ss [measure_space_def, sigma_algebra_def] 2759 >> MATCH_MP_TAC RING_PREMEASURE_COUNTABLY_SUBADDITIVE 2760 >> ASM_REWRITE_TAC [premeasure_def] 2761 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []); 2762 2763Theorem RING_ADDITIVE_INCREASING : 2764 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==> 2765 increasing m 2766Proof 2767 RW_TAC std_ss [increasing_def, positive_def] 2768 >> Suff 2769 `?u. u IN measurable_sets m /\ (measure m t = measure m s + measure m u)` 2770 >- METIS_TAC [le_addr_imp] 2771 >> Q.EXISTS_TAC `t DIFF s` 2772 >> STRONG_CONJ_TAC >- PROVE_TAC [RING_DIFF, subsets_def] 2773 >> RW_TAC std_ss [] 2774 >> MATCH_MP_TAC ADDITIVE 2775 >> ASM_SET_TAC [] 2776QED 2777 2778Theorem RING_ADDITIVE_EVERYTHING : 2779 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==> 2780 finite_additive m /\ increasing m /\ 2781 subadditive m /\ finite_subadditive m 2782Proof 2783 GEN_TAC >> STRIP_TAC 2784 >> CONJ_TAC >- PROVE_TAC [RING_ADDITIVE_FINITE_ADDITIVE] 2785 >> CONJ_TAC >- PROVE_TAC [RING_ADDITIVE_INCREASING] 2786 >> STRONG_CONJ_TAC >- PROVE_TAC [RING_ADDITIVE_SUBADDITIVE] 2787 >> DISCH_TAC 2788 >> PROVE_TAC [RING_SUBADDITIVE_FINITE_SUBADDITIVE] 2789QED 2790 2791val OUTER_MEASURE_SPACE_POSITIVE = store_thm 2792 ("OUTER_MEASURE_SPACE_POSITIVE", 2793 ``!m. outer_measure_space m ==> positive m``, 2794 PROVE_TAC [outer_measure_space_def]); 2795 2796val OUTER_MEASURE_SPACE_SUBADDITIVE = store_thm 2797 ("OUTER_MEASURE_SPACE_SUBADDITIVE", 2798 ``!m. outer_measure_space m ==> subadditive m``, 2799 RW_TAC std_ss [outer_measure_space_def] 2800 >> MATCH_MP_TAC COUNTABLY_SUBADDITIVE_SUBADDITIVE 2801 >> ASM_REWRITE_TAC []); 2802 2803val OUTER_MEASURE_SPACE_FINITE_SUBADDITIVE = store_thm 2804 ("OUTER_MEASURE_SPACE_FINITE_SUBADDITIVE", 2805 ``!m. outer_measure_space m ==> finite_subadditive m``, 2806 RW_TAC std_ss [outer_measure_space_def] 2807 >> MATCH_MP_TAC COUNTABLY_SUBADDITIVE_FINITE_SUBADDITIVE 2808 >> ASM_REWRITE_TAC []); 2809 2810(* cf. MEASURE_SPACE_RESTRICTED *) 2811val MEASURE_SPACE_RESTRICTION = store_thm 2812 ("MEASURE_SPACE_RESTRICTION", 2813 ``!sp sts m sub. measure_space (sp,sts,m) /\ sub SUBSET sts /\ sigma_algebra (sp,sub) ==> 2814 measure_space (sp,sub,m)``, 2815 RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def] 2816 >- (REWRITE_TAC [positive_def, measure_def, measurable_sets_def] \\ 2817 CONJ_TAC >- PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\ 2818 rpt STRIP_TAC >> fs [positive_def, measure_def, measurable_sets_def] \\ 2819 FIRST_X_ASSUM MATCH_MP_TAC >> PROVE_TAC [SUBSET_DEF]) 2820 >> fs [countably_additive_def, IN_FUNSET, IN_UNIV, measurable_sets_def, measure_def] 2821 >> RW_TAC std_ss [] 2822 >> FIRST_X_ASSUM MATCH_MP_TAC >> art [] 2823 >> PROVE_TAC [SUBSET_DEF]); 2824 2825(* Theorem 18.2 of [1]. Given (sp,sts,m) and u = outer_measure m (countable_covers sts): 2826 2827 (*1*) u is an outer measure such that u(x) <= m(x) for all x IN sts; 2828 (*2*) A (caratheodory_sets sp u) is a sigma-algebra and u|A is a measure; 2829 (*3*) u is maximal: if v is another outer measure such that v(x) <= mu(x) 2830 for all x IN sts, then v(x) <= m(x) for all x SUBSET sp. 2831 2832 NOTE: there's no structual requirements on `sts` and `mu` (except for `{} IN sts`); 2833 and (*3*) is not needed by CARATHEODORY_SEMIRING. 2834 *) 2835Theorem OUTER_MEASURE_CONSTRUCTION : 2836 !sp sts m u. subset_class sp sts /\ {} IN sts /\ positive (sp,sts,m) /\ 2837 (u = outer_measure m (countable_covers sts)) ==> 2838 outer_measure_space (sp,POW sp,u) /\ (!x. x IN sts ==> u x <= m x) /\ 2839 measure_space (sp,caratheodory_sets sp u,u) /\ 2840 !v. outer_measure_space (sp,POW sp,v) /\ (!x. x IN sts ==> v x <= m x) ==> 2841 !x. x SUBSET sp ==> v x <= u x 2842Proof 2843 rpt GEN_TAC >> STRIP_TAC 2844 >> rename1 `positive (sp,sts,mu)` >> rename1 `m = _` (* m -> mu, u -> m *) 2845 >> Q.ABBREV_TAC `C = countable_covers sts` 2846 >> Q.ABBREV_TAC `A = caratheodory_sets sp m` 2847 >> STRONG_CONJ_TAC 2848 >- (REWRITE_TAC [outer_measure_space_def, m_space_def, measurable_sets_def, 2849 subset_class_POW, EMPTY_IN_POW] \\ 2850 fs [countable_covers_def, outer_measure_def] \\ 2851 Q.PAT_ASSUM `m = _` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ (* recover `m` *) 2852 (* C is anti-monotone (or antitone) *) 2853 Know `!a b. a SUBSET b ==> (C b) SUBSET (C a)` 2854 >- (rpt STRIP_TAC \\ 2855 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 2856 ONCE_REWRITE_TAC [SUBSET_DEF] \\ 2857 SET_SPEC_TAC [IN_FUNSET, IN_UNIV] \\ 2858 RW_TAC std_ss [] >> PROVE_TAC [SUBSET_TRANS]) >> DISCH_TAC \\ 2859 (* m is positive *) 2860 Know `!s. s SUBSET sp ==> 0 <= m s` 2861 >- (Q.PAT_X_ASSUM `m = _` ((SIMP_TAC std_ss) o wrap) \\ 2862 rpt STRIP_TAC >> REWRITE_TAC [le_inf'] \\ 2863 GEN_TAC >> RW_TAC std_ss [GSPECIFICATION] \\ 2864 MATCH_MP_TAC ext_suminf_pos \\ 2865 GEN_TAC >> SIMP_TAC std_ss [o_DEF] \\ 2866 fs [positive_def, measure_def, measurable_sets_def] \\ 2867 FIRST_X_ASSUM MATCH_MP_TAC \\ 2868 POP_ASSUM MP_TAC \\ 2869 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 2870 RW_TAC std_ss [GSPECIFICATION, IN_FUNSET, IN_UNIV]) >> DISCH_TAC \\ 2871 (* joint-property I of C and m *) 2872 Know `!a. m a < PosInf ==> (C a) <> EMPTY` 2873 >- (GEN_TAC >> REWRITE_TAC [GSYM lt_infty] \\ 2874 MATCH_MP_TAC MONO_NOT \\ 2875 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 2876 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\ 2877 SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] >> DISCH_TAC \\ 2878 Know `!r. (?f. f IN (univ(:num) -> sts) /\ a SUBSET BIGUNION (IMAGE f univ(:num)) /\ 2879 (suminf (mu o f) = r)) = F` 2880 >- (GEN_TAC >> MATCH_MP_TAC NOT_F >> SIMP_TAC bool_ss [] \\ 2881 GEN_TAC >> POP_ASSUM MP_TAC \\ 2882 SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] \\ 2883 METIS_TAC []) >> DISCH_TAC \\ 2884 Know `{r | ?f. (f IN (univ(:num) -> sts) /\ a SUBSET BIGUNION (IMAGE f univ(:num))) /\ 2885 (suminf (mu o f) = r)} = EMPTY` 2886 >- ASM_SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] \\ 2887 DISCH_THEN (ONCE_REWRITE_TAC o wrap) >> KILL_TAC \\ 2888 ACCEPT_TAC inf_empty) >> DISCH_TAC \\ 2889 (* joint-property II of C and m *) 2890 Know `!a. m a < PosInf ==> ?f. f IN (C a) /\ suminf (mu o f) <> PosInf` 2891 >- (GEN_TAC \\ 2892 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\ 2893 REWRITE_TAC [Q.SPECL [`{r | ?f. f IN (C :('a set)->(num->'a set)->bool) (a :'a set) /\ 2894 (suminf (mu o f) = r)}`, `PosInf`] (GSYM inf_lt')] \\ 2895 RW_TAC std_ss [GSPECIFICATION] \\ 2896 Q.EXISTS_TAC `f` >> PROVE_TAC [lt_infty]) >> DISCH_TAC \\ 2897 (* joint-property III of C and m *) 2898 Know `!a e. a SUBSET sp /\ 0 < e /\ m a < PosInf ==> 2899 ?f. f IN (C a) /\ suminf (mu o f) <= m a + e` 2900 >- (rpt STRIP_TAC \\ 2901 MP_TAC (Q.SPEC `{r | ?f. f IN ((C :('a->bool)->(num->'a->bool)->bool) (a :'a->bool)) /\ 2902 (suminf (mu o f) = r)}` le_inf_epsilon_set) \\ 2903 `inf {r | ?f. f IN (C a) /\ (suminf (mu o f) = r)} = m a` by METIS_TAC [] \\ 2904 POP_ASSUM (REWRITE_TAC o wrap) \\ 2905 SIMP_TAC std_ss [GSPECIFICATION] \\ 2906 DISCH_THEN (MP_TAC o (Q.SPEC `e`)) \\ 2907 `(?x. (?f. f IN C a /\ (suminf (mu o f) = x)) /\ x <= m a + e) = 2908 (?f. f IN C a /\ suminf (mu o f) <= m a + e)` by METIS_TAC [] \\ 2909 POP_ASSUM (REWRITE_TAC o wrap) \\ 2910 `(?x. (?f. f IN C a /\ (suminf (mu o f) = x)) /\ x <> PosInf) = 2911 (?f. f IN C a /\ (suminf (mu o f) <> PosInf))` by METIS_TAC [] \\ 2912 POP_ASSUM (REWRITE_TAC o wrap) \\ 2913 DISCH_THEN MATCH_MP_TAC \\ 2914 ASM_REWRITE_TAC [] \\ 2915 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC >> ASM_REWRITE_TAC []) \\ 2916 METIS_TAC [lt_infty, extreal_of_num_def, extreal_not_infty, lte_trans]) >> DISCH_TAC \\ 2917 (* joint-property IV of C and m *) 2918 Know `!a f. f IN (univ(:num) -> sts) /\ a SUBSET BIGUNION (IMAGE f univ(:num)) ==> 2919 m a <= suminf (mu o f)` 2920 >- (rpt STRIP_TAC \\ 2921 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\ 2922 MATCH_MP_TAC inf_le_imp' >> SET_SPEC_TAC [] \\ 2923 Q.EXISTS_TAC `f` >> REWRITE_TAC [] \\ 2924 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 2925 ASM_SIMP_TAC std_ss [GSPECIFICATION]) >> DISCH_TAC \\ 2926 (* OM1. positive (sp, POW sp, m) *) 2927 STRONG_CONJ_TAC 2928 >- (REWRITE_TAC [positive_def, measure_def, measurable_sets_def, IN_POW] \\ 2929 reverse CONJ_TAC >- art [] \\ 2930 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\ 2931 ONCE_REWRITE_TAC [GSYM le_antisym] \\ 2932 reverse CONJ_TAC 2933 >- (REWRITE_TAC [le_inf'] \\ 2934 RW_TAC std_ss [GSPECIFICATION] \\ 2935 Know `!n. 0 <= (mu o f) n` 2936 >- (Q.UNABBREV_TAC `C` \\ 2937 FULL_SIMP_TAC std_ss [positive_def, measure_def, 2938 GSPECIFICATION, IN_FUNSET, 2939 IN_UNIV, measurable_sets_def]) \\ 2940 DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' \\ 2941 MATCH_MP_TAC le_sup_imp' \\ 2942 REWRITE_TAC [IN_IMAGE, IN_UNIV] \\ 2943 Q.EXISTS_TAC `0` >> BETA_TAC \\ 2944 REWRITE_TAC [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY]) \\ 2945 MATCH_MP_TAC inf_le_imp' \\ 2946 RW_TAC std_ss [GSPECIFICATION] \\ 2947 Q.EXISTS_TAC `\n. EMPTY` \\ 2948 REWRITE_TAC [o_DEF] \\ 2949 reverse CONJ_TAC >- (MATCH_MP_TAC ext_suminf_zero >> GEN_TAC >> BETA_TAC \\ 2950 PROVE_TAC [positive_def, measure_def]) \\ 2951 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 2952 RW_TAC std_ss [EMPTY_SUBSET, GSPECIFICATION, IN_FUNSET, IN_UNIV]) >> DISCH_TAC \\ 2953 (* OM2. increasing (sp, POW sp, m) *) 2954 STRONG_CONJ_TAC 2955 >- (RW_TAC std_ss [increasing_def, measurable_sets_def, measure_def, IN_POW] \\ 2956 (* equivalent definition of `m` in IMAGE, use when needed *) 2957 Know `!S. {r | ?f. f IN S /\ (suminf (mu o f) = r)} = IMAGE (\f. (suminf (mu o f))) S` 2958 >- (GEN_TAC >> RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE, o_DEF] \\ 2959 METIS_TAC []) \\ 2960 DISCH_THEN (REWRITE_TAC o wrap) \\ 2961 MATCH_MP_TAC inf_mono_subset \\ 2962 PROVE_TAC [IMAGE_SUBSET]) >> DISCH_TAC \\ 2963 (* OM3. countably_subadditive (sp, POW sp, m) *) 2964 SIMP_TAC std_ss [countably_subadditive_def, measure_def, measurable_sets_def, 2965 IN_FUNSET, IN_UNIV, IN_POW] \\ 2966 rpt STRIP_TAC \\ 2967 (* assume wlog: !x. m (f x) < PosInf *) 2968 reverse (Cases_on `!x. m (f x) < PosInf`) 2969 >- (REWRITE_TAC [o_DEF] \\ 2970 POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE std_ss [GSYM lt_infty])) \\ 2971 Suff `suminf (\x. m (f x)) = PosInf` 2972 >- (DISCH_THEN (ONCE_REWRITE_TAC o wrap) >> REWRITE_TAC [le_infty]) \\ 2973 MATCH_MP_TAC ext_suminf_posinf >> BETA_TAC \\ 2974 CONJ_TAC >- PROVE_TAC [positive_def, measurable_sets_def, measure_def, IN_POW] \\ 2975 Q.EXISTS_TAC `x` >> art []) \\ 2976 (* assume wlog: suminf (m o f) < PosInf *) 2977 reverse (Cases_on `suminf (m o f) < PosInf`) 2978 >- (fs [GSYM lt_infty] >> REWRITE_TAC [le_infty]) \\ 2979 (* m (BIGUNION (IMAGE f univ(:num))) <= suminf (m o f) *) 2980 MATCH_MP_TAC le_epsilon >> rpt STRIP_TAC \\ 2981 IMP_RES_TAC pow_half_ser_by_e \\ 2982 Q.PAT_ASSUM `e = _` (ONCE_REWRITE_TAC o wrap) \\ 2983 (* m (BIGUNION (IMAGE f univ(:num))) <= suminf (m o f) + suminf (\n. e * (1 / 2) pow (n + 1)) *) 2984 MATCH_MP_TAC le_trans \\ 2985 Q.PAT_X_ASSUM `!a e. X ==> ?f. P` 2986 (STRIP_ASSUME_TAC o (Q.GEN `n`) o 2987 (Q.SPECL [`(f :num->'a->bool) n`, `e * (1 / 2) pow (n + 1)`])) \\ 2988 `!n. 0 < e * (1 / 2) pow (n + 1)` by PROVE_TAC [lt_mul, pow_half_pos_lt] \\ 2989 `!n. ?g. g IN C (f n) /\ suminf (mu o g) <= (m o f) n + e * (1 / 2) pow (n + 1)` 2990 by METIS_TAC [o_DEF] \\ 2991 Q.PAT_X_ASSUM `!n. X => ?f'. Y` K_TAC (* cleanup *) \\ 2992 POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE bool_ss [SKOLEM_THM])) \\ (* f' is a cover for each f *) 2993 Q.EXISTS_TAC `suminf (\n. suminf (mu o f' n))` \\ 2994 ONCE_REWRITE_TAC [CONJ_COMM] \\ 2995 STRONG_CONJ_TAC 2996 >- (Know `suminf (m o f) + suminf (\n. e * (1 / 2) pow (n + 1)) = 2997 suminf (\n. (m o f) n + (\n. e * (1 / 2) pow (n + 1)) n)` 2998 >- (MATCH_MP_TAC EQ_SYM \\ 2999 MATCH_MP_TAC ext_suminf_add >> BETA_TAC \\ 3000 GEN_TAC >> reverse CONJ_TAC >- PROVE_TAC [le_mul, lt_le, pow_half_pos_le] \\ 3001 SIMP_TAC std_ss [o_DEF] \\ 3002 fs [positive_def]) >> Rewr' \\ 3003 MATCH_MP_TAC ext_suminf_mono >> BETA_TAC \\ 3004 reverse CONJ_TAC >- METIS_TAC [] \\ 3005 GEN_TAC >> MATCH_MP_TAC ext_suminf_pos \\ 3006 GEN_TAC >> REWRITE_TAC [o_DEF] >> BETA_TAC \\ 3007 Suff `f' n n' IN sts` >- PROVE_TAC [positive_def, measurable_sets_def, measure_def] \\ 3008 `f' n IN C (f n)` by METIS_TAC [] >> POP_ASSUM MP_TAC \\ 3009 Q.ABBREV_TAC `g = f' n` \\ 3010 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 3011 SIMP_TAC std_ss [GSPECIFICATION, IN_FUNSET, IN_UNIV]) \\ 3012 Q.PAT_X_ASSUM `e = _` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ 3013 DISCH_TAC \\ 3014 Know `suminf (\n. suminf (mu o f' n)) < PosInf` 3015 >- (MATCH_MP_TAC let_trans >> Q.EXISTS_TAC `suminf (m o f) + e` \\ 3016 PROVE_TAC [lt_infty, add_not_infty]) >> DISCH_TAC \\ 3017 `!n. f' n IN C (f n)` by METIS_TAC [] \\ 3018 rename1 `!n. g n IN C (f n)` \\ 3019 Q.PAT_X_ASSUM `!n. g n IN C (f n) /\ X` K_TAC \\ (* cleanup *) 3020 (* m (BIGUNION (IMAGE f univ(:num))) <= suminf (\n. suminf (mu o g n)) *) 3021 Know `!n. (g n) IN (univ(:num) -> sts) /\ (f n) SUBSET BIGUNION (IMAGE (g n) univ(:num))` 3022 >- (GEN_TAC >> POP_ASSUM (MP_TAC o (Q.SPEC `n`)) \\ 3023 Q.UNABBREV_TAC `C` >> SET_SPEC_TAC []) >> DISCH_TAC \\ 3024 (* `!n. m (f n) <= suminf (mu o g n)` by METIS_TAC [] \\ *) 3025 Know `BIGUNION (IMAGE f univ(:num)) SUBSET 3026 BIGUNION (IMAGE (\n. BIGUNION (IMAGE (g n) univ(:num))) univ(:num))` 3027 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_IMAGE, IN_UNIV] \\ 3028 rename1 `x IN f n` \\ 3029 Q.EXISTS_TAC `BIGUNION (IMAGE (g n) univ(:num))` \\ 3030 reverse CONJ_TAC >- (Q.EXISTS_TAC `n` >> REWRITE_TAC []) \\ 3031 PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC \\ 3032 (* merge two nesting BIGUNIONs into one BIGUNION *) 3033 `!i j. g i j IN sts` by PROVE_TAC [IN_FUNSET, IN_UNIV] \\ 3034 Q.ABBREV_TAC `ff = \n. g (nfst n) (nsnd n)` \\ 3035 `ff IN (univ(:num) -> sts)` by PROVE_TAC [IN_FUNSET, IN_UNIV] \\ 3036 Know `BIGUNION (IMAGE (\n. BIGUNION (IMAGE (g n) univ(:num))) univ(:num)) = 3037 BIGUNION (IMAGE ff (univ(:num)))` 3038 >- (RW_TAC std_ss [SET_EQ_SUBSET, SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] >| 3039 [ (* goal 1 (of 2) *) 3040 Q.EXISTS_TAC `npair n x'` \\ (* numpairTheory is used here! *) 3041 Q.UNABBREV_TAC `ff` >> BETA_TAC >> PROVE_TAC [nfst_npair, nsnd_npair], 3042 (* goal 2 (of 2) *) 3043 Q.EXISTS_TAC `nfst x'` \\ 3044 Q.EXISTS_TAC `nsnd x'` \\ 3045 POP_ASSUM MP_TAC >> Q.UNABBREV_TAC `ff` >> BETA_TAC \\ 3046 REWRITE_TAC [] ]) \\ 3047 DISCH_TAC \\ 3048 Q.PAT_X_ASSUM `BIGUNION (IMAGE f UNIV) SUBSET X` MP_TAC \\ 3049 POP_ORW >> DISCH_TAC \\ 3050 Suff `suminf (\n. suminf (mu o g n)) = suminf (mu o ff)` 3051 >- (DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\ 3052 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_REWRITE_TAC []) \\ 3053 Q.UNABBREV_TAC `ff` \\ 3054 (* prepare for applying "ext_suminf_2d" *) 3055 MATCH_MP_TAC EQ_SYM \\ 3056 Q.ABBREV_TAC `h = \n. (nfst n, nsnd n)` \\ 3057 Q.ABBREV_TAC `ff = \m n. mu (g m n)` \\ 3058 Know `(mu o (\n. g (nfst n) (nsnd n))) = UNCURRY ff o h` 3059 >- (SIMP_TAC std_ss [o_DEF, FUN_EQ_THM, UNCURRY] \\ 3060 Q.UNABBREV_TAC `h` >> Q.UNABBREV_TAC `ff` \\ 3061 ASM_SIMP_TAC std_ss []) >> Rewr \\ 3062 (* finally, apply "ext_suminf_2d", cleaning up easy goals *) 3063 MATCH_MP_TAC ext_suminf_2d \\ 3064 `!n. suminf (ff n) = (\n. suminf (mu o g n)) n` by METIS_TAC [o_DEF] \\ 3065 POP_ASSUM ((ASM_SIMP_TAC std_ss) o wrap) \\ 3066 Know `BIJ h univ(:num) (univ(:num) CROSS univ(:num))` 3067 >- (Q.UNABBREV_TAC `h` >> REWRITE_TAC [NUM_2D_BIJ_nfst_nsnd]) >> Rewr \\ 3068 (* !m n. 0 <= ff m n *) 3069 Q.UNABBREV_TAC `ff` >> BETA_TAC \\ 3070 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) 3071 (* Part II *) 3072 >> DISCH_TAC >> STRONG_CONJ_TAC 3073 >- (rpt STRIP_TAC >> fs [countable_covers_def, outer_measure_def] \\ 3074 MATCH_MP_TAC inf_le_imp \\ 3075 SIMP_TAC std_ss [GSPECIFICATION, Once (GSYM IN_APP)] \\ 3076 Q.EXISTS_TAC `\n. if n = 0 then x else EMPTY` \\ 3077 Know `mu o (\n :num. if n = 0 then x else EMPTY) = (\n. if n = 0 then mu x else 0)` 3078 >- (RW_TAC arith_ss [o_DEF, FUN_EQ_THM] \\ 3079 Cases_on `n = 0` >- METIS_TAC [] \\ 3080 PROVE_TAC [positive_def, measure_def]) >> Rewr' \\ 3081 `0 <= mu x` by PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\ 3082 POP_ASSUM (fn th => REWRITE_TAC [MATCH_MP ext_suminf_sing th]) \\ 3083 Q.UNABBREV_TAC `C` >> BETA_TAC \\ 3084 SIMP_TAC std_ss [GSPECIFICATION] \\ 3085 CONJ_TAC >- (SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\ 3086 GEN_TAC >> Cases_on `n = 0` >- METIS_TAC [] \\ 3087 METIS_TAC [semiring_def, subsets_def]) \\ 3088 SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] \\ 3089 rpt STRIP_TAC >> Q.EXISTS_TAC `0` >> METIS_TAC []) 3090 >> DISCH_TAC >> STRONG_CONJ_TAC 3091 (* Part III: measure_space (sp,A,m) *) 3092 >- (fs [countable_covers_def, outer_measure_def, caratheodory_sets_def] \\ 3093 Q.PAT_ASSUM `m = _` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ (* recover `m` *) 3094 REWRITE_TAC [measure_space_def, m_space_def, measurable_sets_def, measure_def] \\ 3095 `increasing (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\ 3096 `subset_class sp sts` by PROVE_TAC [semiring_def, space_def, subsets_def] \\ 3097 `positive (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\ 3098 `!s. s SUBSET sp ==> 0 <= m s` 3099 by PROVE_TAC [positive_def, measure_def, measurable_sets_def, IN_POW] \\ 3100 Know `positive (sp,A,m)` 3101 >- (REWRITE_TAC [positive_def, measure_def, measurable_sets_def] \\ 3102 CONJ_TAC >- PROVE_TAC [positive_def, measure_def] \\ 3103 GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\ 3104 METIS_TAC []) >> DISCH_TAC \\ 3105 ONCE_REWRITE_TAC [DECIDE ``A /\ B /\ C <=> B /\ (A /\ C)``] \\ 3106 CONJ_TAC >- art [] \\ 3107 (* Dynkin's lemma is used here *) 3108 REWRITE_TAC [GSYM DYNKIN_LEMMA, subsets_def] \\ 3109 REWRITE_TAC [dynkin_system_def, space_def, subsets_def, GSYM CONJ_ASSOC] \\ 3110 STRONG_CONJ_TAC 3111 >- (REWRITE_TAC [subset_class_def] \\ 3112 GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC []) >> DISCH_TAC \\ 3113 MATCH_MP_TAC (prove (``!a b c. b /\ a /\ c ==> a /\ b /\ c``, PROVE_TAC [])) \\ 3114 STRONG_CONJ_TAC 3115 >- (GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\ 3116 rpt STRIP_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> REWRITE_TAC [SUBSET_REFL]) \\ 3117 `q INTER (sp DIFF s) = q DIFF s` by ASM_SET_TAC [] >> POP_ORW \\ 3118 `q DIFF (sp DIFF s) = q INTER s` by ASM_SET_TAC [] >> POP_ORW \\ 3119 MATCH_MP_TAC add_comm >> DISJ1_TAC \\ 3120 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf \\ 3121 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) \\ 3122 MATCH_MP_TAC pos_not_neginf \\ 3123 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) >> DISCH_TAC \\ 3124 Know `{} IN A` 3125 >- (Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\ 3126 REWRITE_TAC [EMPTY_SUBSET, INTER_EMPTY, DIFF_EMPTY] >> rpt STRIP_TAC \\ 3127 `m {} = 0` by PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\ 3128 POP_ORW >> REWRITE_TAC [add_lzero]) >> DISCH_TAC \\ 3129 STRONG_CONJ_TAC >- METIS_TAC [DIFF_EMPTY] >> DISCH_TAC \\ 3130 SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\ 3131 `subadditive (sp,POW sp,m)` by PROVE_TAC [OUTER_MEASURE_SPACE_SUBADDITIVE] \\ 3132 Know `!a q. a IN A /\ q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a))` 3133 >- (rpt GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\ 3134 rpt STRIP_TAC >> PROVE_TAC []) >> DISCH_TAC \\ 3135 (* A is stable under union *) 3136 Know `!s t. s IN A /\ t IN A ==> s UNION t IN A` 3137 >- (rpt STRIP_TAC \\ 3138 Suff `s UNION t IN {a | a SUBSET sp /\ 3139 !q. q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a))}` 3140 >- METIS_TAC [] \\ 3141 SET_SPEC_TAC [] \\ 3142 CONJ_TAC >- PROVE_TAC [UNION_SUBSET, subset_class_def] \\ 3143 rpt STRIP_TAC >> rename1 `p SUBSET sp` \\ 3144 REWRITE_TAC [GSYM le_antisym] \\ 3145 CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 3146 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\ 3147 ASM_SET_TAC [IN_POW]) \\ 3148 `p INTER (s UNION t) = p INTER (s UNION (t DIFF s))` by SET_TAC [] >> POP_ORW \\ 3149 REWRITE_TAC [UNION_OVER_INTER] \\ 3150 MATCH_MP_TAC le_trans \\ 3151 Q.EXISTS_TAC `m (p INTER s) + m (p INTER (t DIFF s)) + m (p DIFF (s UNION t))` \\ 3152 CONJ_TAC >- (MATCH_MP_TAC le_radd_imp \\ 3153 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 3154 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\ 3155 ASM_SET_TAC [IN_POW]) \\ 3156 `p INTER (t DIFF s) = (p DIFF s) INTER t` by SET_TAC [] >> POP_ORW \\ 3157 `p DIFF (s UNION t) = (p DIFF s) DIFF t` by SET_TAC [] >> POP_ORW \\ 3158 Know `m (p INTER s) + m ((p DIFF s) INTER t) + m (p DIFF s DIFF t) = 3159 m (p INTER s) + (m ((p DIFF s) INTER t) + m (p DIFF s DIFF t))` 3160 >- (MATCH_MP_TAC EQ_SYM >> MATCH_MP_TAC add_assoc \\ 3161 DISJ1_TAC \\ 3162 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf >> FIRST_X_ASSUM MATCH_MP_TAC \\ 3163 ASM_SET_TAC []) \\ 3164 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf >> FIRST_X_ASSUM MATCH_MP_TAC \\ 3165 ASM_SET_TAC []) \\ 3166 MATCH_MP_TAC pos_not_neginf \\ 3167 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) >> Rewr' \\ 3168 Know `m ((p DIFF s) INTER t) + m (p DIFF s DIFF t) = m (p DIFF s)` 3169 >- (MATCH_MP_TAC EQ_SYM \\ 3170 FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\ 3171 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) >> Rewr' \\ 3172 Know `m (p INTER s) + m (p DIFF s) = m p` 3173 >- (MATCH_MP_TAC EQ_SYM >> FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr' \\ 3174 REWRITE_TAC [le_refl]) >> DISCH_TAC \\ 3175 (* A is stable under finite union *) 3176 Know `!f n. (!i. i < n ==> f i IN A) ==> BIGUNION (IMAGE f (count n)) IN A` 3177 >- (GEN_TAC >> Induct_on `n` 3178 >- ASM_SIMP_TAC arith_ss [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\ 3179 RW_TAC arith_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT]) >> DISCH_TAC \\ 3180 Know `!q s t. q SUBSET sp /\ s IN A /\ t IN A /\ DISJOINT s t ==> 3181 (m (q INTER (s UNION t)) = m (q INTER s) + m (q INTER t))` 3182 >- (rpt STRIP_TAC \\ 3183 `q INTER s = (q INTER (s UNION t)) INTER s` by SET_TAC [] >> POP_ORW \\ 3184 `q INTER t = (q INTER (s UNION t)) DIFF s` 3185 by ASM_SET_TAC [DISJOINT_DEF] >> POP_ORW \\ 3186 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) >> DISCH_TAC \\ 3187 Know `!q f. q SUBSET sp ==> 3188 !n. (!i. i < n ==> f i IN A) /\ 3189 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) ==> 3190 (m (q INTER (BIGUNION (IMAGE f (count n)))) = 3191 SIGMA (\i. m (q INTER f i)) (count n))` 3192 >- (rpt GEN_TAC >> DISCH_TAC \\ 3193 Induct_on `n` >- (SIMP_TAC arith_ss [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, 3194 EXTREAL_SUM_IMAGE_EMPTY, INTER_EMPTY] \\ 3195 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) \\ 3196 SIMP_TAC arith_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT] \\ 3197 STRIP_TAC \\ 3198 Know `DISJOINT (f n) (BIGUNION (IMAGE f (count n)))` 3199 >- (REWRITE_TAC [DISJOINT_BIGUNION] \\ 3200 RW_TAC std_ss [IN_IMAGE, IN_COUNT] \\ 3201 FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) >> DISCH_TAC \\ 3202 Know `m (q INTER (f n UNION BIGUNION (IMAGE f (count n)))) = 3203 m (q INTER f n) + m (q INTER BIGUNION (IMAGE f (count n)))` 3204 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\ 3205 CONJ_TAC >- PROVE_TAC [LESS_SUC_REFL] \\ 3206 FIRST_X_ASSUM MATCH_MP_TAC \\ 3207 rpt STRIP_TAC >> PROVE_TAC [LESS_SUC]) >> Rewr' \\ 3208 Know `SIGMA (\i. m (q INTER f i)) (n INSERT count n) = 3209 (\i. m (q INTER f i)) n + SIGMA (\i. m (q INTER f i)) (count n DELETE n)` 3210 >- (irule EXTREAL_SUM_IMAGE_PROPERTY \\ 3211 REWRITE_TAC [FINITE_COUNT, IN_INSERT, IN_COUNT] \\ 3212 DISJ1_TAC >> GEN_TAC >> DISCH_TAC >> BETA_TAC \\ 3213 MATCH_MP_TAC pos_not_neginf \\ 3214 FIRST_X_ASSUM MATCH_MP_TAC \\ 3215 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) >> Rewr' \\ 3216 `count n DELETE n = count n` by REWRITE_TAC [COUNT_DELETE] >> POP_ORW \\ 3217 BETA_TAC \\ 3218 (* m (q INTER f n) + m (q INTER BIGUNION (IMAGE f (count n))) = 3219 m (q INTER f n) + SIGMA (\i. m (q INTER f i)) (count n) *) 3220 Cases_on `m (q INTER f n) = PosInf` >- fs [positive_def] \\ 3221 Know `m (q INTER f n) <> NegInf /\ m (q INTER f n) <> PosInf` 3222 >- (POP_ASSUM (REWRITE_TAC o wrap) \\ 3223 MATCH_MP_TAC pos_not_neginf \\ 3224 FIRST_X_ASSUM MATCH_MP_TAC \\ 3225 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\ 3226 DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP EXTREAL_EQ_LADD)) \\ 3227 FIRST_X_ASSUM MATCH_MP_TAC \\ 3228 RW_TAC arith_ss []) >> DISCH_TAC \\ 3229 (* now prove that A is stable under countably disjoint unions *) 3230 STRONG_CONJ_TAC 3231 >- (rpt STRIP_TAC \\ (* goal: BIGUNION (IMAGE f univ(:num)) IN A *) 3232 Know `!a. a IN A <=> (a SUBSET sp /\ 3233 !q. q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a)))` 3234 >- (GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC []) >> Rewr' \\ 3235 STRONG_CONJ_TAC >- (RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 3236 PROVE_TAC [subset_class_def]) >> DISCH_TAC \\ 3237 rpt STRIP_TAC >> REWRITE_TAC [GSYM le_antisym] \\ 3238 CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW] 3239 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\ 3240 art [] >> ASM_SET_TAC []) \\ 3241 REWRITE_TAC [BIGUNION_OVER_INTER_R] \\ 3242 MATCH_MP_TAC le_trans \\ 3243 Q.EXISTS_TAC `suminf (m o (\i. q INTER f i)) + m (q DIFF BIGUNION (IMAGE f univ(:num)))` \\ 3244 CONJ_TAC >- (MATCH_MP_TAC le_radd_imp \\ 3245 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW] 3246 (Q.SPEC `(sp,POW sp,m)` COUNTABLY_SUBADDITIVE)) \\ 3247 REWRITE_TAC [] \\ 3248 CONJ_TAC >- PROVE_TAC [outer_measure_space_def] \\ 3249 SIMP_TAC std_ss [IN_FUNSET, IN_UNIV, IN_POW] \\ 3250 CONJ_TAC >- (GEN_TAC >> MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\ 3251 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 3252 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\ 3253 (* preparing for applying le_sub_eq2 *) 3254 Cases_on `m q = PosInf` >- METIS_TAC [le_infty] \\ 3255 Know `m q <> NegInf` 3256 >- (MATCH_MP_TAC pos_not_neginf \\ 3257 FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC \\ 3258 Know `suminf (m o (\i. q INTER f i)) <> NegInf` 3259 >- (MATCH_MP_TAC pos_not_neginf \\ 3260 MATCH_MP_TAC ext_suminf_pos >> SIMP_TAC std_ss [o_DEF] \\ 3261 GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\ 3262 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) >> DISCH_TAC \\ 3263 Know `m (q DIFF BIGUNION (IMAGE f univ(:num))) <> NegInf` 3264 >- (MATCH_MP_TAC pos_not_neginf \\ 3265 FIRST_X_ASSUM MATCH_MP_TAC \\ 3266 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) >> DISCH_TAC \\ 3267 Know `(* z *) m q <> NegInf /\ m q <> PosInf /\ 3268 (* x *) m (q DIFF BIGUNION (IMAGE f univ(:num))) <> NegInf /\ 3269 (* y *) suminf (m o (\i. q INTER f i)) <> NegInf` >- art [] \\ 3270 DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM) o (MATCH_MP le_sub_eq2)) \\ 3271 (* suminf (m o (\i. q INTER f i)) <= m q - m (q DIFF BIGUNION (IMAGE f univ(:num))) *) 3272 Know `!n. 0 <= (m o (\i. q INTER f i)) n` 3273 >- (GEN_TAC >> SIMP_TAC std_ss [o_DEF] \\ 3274 FIRST_X_ASSUM MATCH_MP_TAC \\ 3275 ASM_SET_TAC []) \\ 3276 DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' \\ 3277 REWRITE_TAC [sup_le'] >> GEN_TAC \\ 3278 SIMP_TAC std_ss [IN_IMAGE, IN_UNIV, IN_COUNT] >> STRIP_TAC \\ 3279 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 3280 (* preparing for applying le_sub_eq2 again *) 3281 Know `SIGMA (m o (\i. q INTER f i)) (count n) <> NegInf` 3282 >- (MATCH_MP_TAC pos_not_neginf \\ 3283 irule EXTREAL_SUM_IMAGE_POS \\ 3284 SIMP_TAC std_ss [o_DEF, IN_COUNT, FINITE_COUNT] >> rpt STRIP_TAC \\ 3285 FIRST_X_ASSUM MATCH_MP_TAC \\ 3286 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) >> DISCH_TAC \\ 3287 Know `(* z *) m q <> NegInf /\ m q <> PosInf /\ 3288 (* x *) m (q DIFF BIGUNION (IMAGE f univ(:num))) <> NegInf /\ 3289 (* y *) SIGMA (m o (\i. q INTER f i)) (count n) <> NegInf` >- art [] \\ 3290 DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP le_sub_eq2)) \\ 3291 SIMP_TAC std_ss [o_DEF] \\ 3292 (* SIGMA (\i. m (q INTER f i)) (count n) + m (q DIFF BIGUNION (IMAGE f univ(:num))) <= m q *) 3293 Know `SIGMA (\i. m (q INTER f i)) (count n) = m (q INTER BIGUNION (IMAGE f (count n)))` 3294 >- (MATCH_MP_TAC EQ_SYM >> FIRST_X_ASSUM irule >> PROVE_TAC []) >> Rewr' \\ 3295 Know `m q = m (q INTER BIGUNION (IMAGE f (count n))) + 3296 m (q DIFF BIGUNION (IMAGE f (count n)))` 3297 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\ 3298 FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC std_ss []) >> Rewr' \\ 3299 MATCH_MP_TAC le_ladd_imp \\ 3300 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW] 3301 (Q.SPEC `(sp,POW sp,m)` INCREASING)) \\ 3302 ASM_REWRITE_TAC [] \\ 3303 MATCH_MP_TAC (prove (``!a b c. b /\ c /\ a ==> a /\ b /\ c``, PROVE_TAC [])) \\ 3304 CONJ_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) \\ 3305 CONJ_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) \\ 3306 (* q DIFF BIGUNION (IMAGE f univ(:num)) SUBSET q DIFF BIGUNION (IMAGE f (count n)) *) 3307 MATCH_MP_TAC SUBSET_RESTRICT_DIFF \\ 3308 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV] \\ 3309 Q.EXISTS_TAC `x'` >> art []) >> DISCH_TAC \\ 3310 (* !s t. s IN A /\ t IN A ==> s INTER t IN A *) 3311 STRONG_CONJ_TAC 3312 >- (rpt STRIP_TAC \\ 3313 `s INTER t = sp DIFF ((sp DIFF s) UNION (sp DIFF t))` by ASM_SET_TAC [] >> POP_ORW \\ 3314 FIRST_ASSUM MATCH_MP_TAC \\ (* removed one (sp DIFF ...) *) 3315 FIRST_ASSUM MATCH_MP_TAC \\ (* removed one (... UNION ...) *) 3316 CONJ_TAC >- (FIRST_ASSUM MATCH_MP_TAC >> art []) \\ 3317 FIRST_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC \\ 3318 (* countably_additive (sp,A,m) *) 3319 SIMP_TAC std_ss [countably_additive_def, measurable_sets_def, measure_def, 3320 IN_FUNSET, IN_UNIV] \\ 3321 rpt STRIP_TAC \\ 3322 REWRITE_TAC [GSYM le_antisym] \\ 3323 CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW] 3324 (Q.SPEC `(sp,POW sp,m)` COUNTABLY_SUBADDITIVE)) \\ 3325 REWRITE_TAC [IN_FUNSET, IN_UNIV, IN_POW] \\ 3326 CONJ_TAC >- PROVE_TAC [outer_measure_space_def] \\ 3327 CONJ_TAC >- PROVE_TAC [subset_class_def] \\ 3328 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 3329 PROVE_TAC [subset_class_def]) \\ 3330 Know `!n. 0 <= (m o f) n` 3331 >- (GEN_TAC >> SIMP_TAC std_ss [o_DEF] \\ 3332 FIRST_X_ASSUM MATCH_MP_TAC \\ 3333 FULL_SIMP_TAC std_ss [subset_class_def]) \\ 3334 DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' \\ 3335 REWRITE_TAC [sup_le'] >> GEN_TAC \\ 3336 SIMP_TAC std_ss [IN_IMAGE, IN_UNIV, IN_COUNT] \\ 3337 STRIP_TAC >> POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\ 3338 MATCH_MP_TAC le_trans >> Q.EXISTS_TAC `m (BIGUNION (IMAGE f (count n)))` \\ 3339 reverse CONJ_TAC 3340 >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW] 3341 (Q.SPEC `(sp,POW sp,m)` INCREASING)) \\ 3342 CONJ_TAC >- art [] \\ 3343 MATCH_MP_TAC (prove (``!a b c. b /\ c /\ a ==> a /\ b /\ c``, PROVE_TAC [])) \\ 3344 CONJ_TAC >- (RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_COUNT] \\ 3345 PROVE_TAC [subset_class_def]) \\ 3346 CONJ_TAC >- (RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 3347 PROVE_TAC [subset_class_def]) \\ 3348 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV] \\ 3349 Q.EXISTS_TAC `x'` >> art []) \\ 3350 `BIGUNION (IMAGE f univ(:num)) SUBSET sp` by PROVE_TAC [subset_class_def] \\ 3351 Q.PAT_X_ASSUM `!q f. q SUBSET sp ==> X` 3352 (fn th => MP_TAC (Q.SPECL [`f`, `n`] 3353 (MATCH_MP th (ASSUME ``BIGUNION (IMAGE f univ(:num)) SUBSET sp``)))) \\ 3354 Know `BIGUNION (IMAGE f univ(:num)) INTER BIGUNION (IMAGE f (count n)) = 3355 BIGUNION (IMAGE f (count n))` 3356 >- (MATCH_MP_TAC SUBSET_INTER2 \\ 3357 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV] \\ 3358 Q.EXISTS_TAC `x'` >> art []) >> Rewr' \\ 3359 Know `(\i. m (BIGUNION (IMAGE f univ(:num)) INTER f i)) = (m o f)` 3360 >- (REWRITE_TAC [o_DEF] >> FUN_EQ_TAC >> GEN_TAC >> BETA_TAC \\ 3361 Suff `BIGUNION (IMAGE f univ(:num)) INTER f x = f x` >- PROVE_TAC [] \\ 3362 MATCH_MP_TAC SUBSET_INTER2 \\ 3363 MATCH_MP_TAC SUBSET_BIGUNION_I \\ 3364 RW_TAC std_ss [IN_IMAGE, IN_UNIV] \\ 3365 Q.EXISTS_TAC `x` >> REWRITE_TAC []) >> Rewr \\ 3366 METIS_TAC [le_refl]) >> rpt STRIP_TAC 3367 >> fs [outer_measure_def] 3368 >> RW_TAC std_ss [le_inf', GSPECIFICATION] 3369 >> Know `!x. f x IN sts` 3370 >- (GEN_TAC \\ 3371 Q.UNABBREV_TAC `C` >> fs [countable_covers_def, IN_FUNSET, IN_UNIV]) >> DISCH_TAC 3372 >> MATCH_MP_TAC le_trans 3373 >> Q.EXISTS_TAC `suminf (v o f)` 3374 >> reverse CONJ_TAC 3375 >- (MATCH_MP_TAC ext_suminf_mono \\ 3376 RW_TAC std_ss [o_DEF] \\ 3377 `positive (sp,POW sp,v)` by PROVE_TAC [outer_measure_space_def] \\ 3378 METIS_TAC [positive_def, measurable_sets_def, measure_def, subset_class_def, IN_POW]) 3379 >> MATCH_MP_TAC le_trans 3380 >> Q.EXISTS_TAC `v (BIGUNION (IMAGE f univ(:num)))` 3381 >> reverse CONJ_TAC 3382 >- (`countably_subadditive (sp,POW sp,v)` by PROVE_TAC [outer_measure_space_def] \\ 3383 MATCH_MP_TAC (REWRITE_RULE [measurable_sets_def, measure_def] 3384 (Q.SPEC `(sp,POW sp,v)` COUNTABLY_SUBADDITIVE)) \\ 3385 RW_TAC std_ss [IN_POW, IN_FUNSET, IN_UNIV, BIGUNION_SUBSET, IN_IMAGE] \\ 3386 METIS_TAC [subset_class_def]) 3387 >> Know `x SUBSET (BIGUNION (IMAGE f univ(:num)))` 3388 >- (Q.UNABBREV_TAC `C` >> fs [countable_covers_def, IN_FUNSET, IN_UNIV]) >> DISCH_TAC 3389 >> `increasing (sp,POW sp,v)` by PROVE_TAC [outer_measure_space_def] 3390 >> MATCH_MP_TAC (REWRITE_RULE [measurable_sets_def, measure_def] 3391 (Q.SPEC `(sp,POW sp,v)` INCREASING)) 3392 >> RW_TAC std_ss [IN_POW, BIGUNION_SUBSET, IN_IMAGE] 3393 >> METIS_TAC [subset_class_def] 3394QED 3395 3396(* extracted from CARATHEODORY_SEMIRING for `lborel` construction *) 3397Theorem SEMIRING_FINITE_ADDITIVE_EXTENSION : 3398 !m0. semiring (m_space m0, measurable_sets m0) /\ 3399 positive m0 /\ finite_additive m0 ==> 3400 ?m. ((m_space m, measurable_sets m) = 3401 smallest_ring (m_space m0) (measurable_sets m0)) /\ 3402 (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\ 3403 positive m /\ additive m 3404Proof 3405 rpt STRIP_TAC >> Cases_on `m0` >> Cases_on `r` 3406 >> fs [m_space_def, measurable_sets_def, measure_def] 3407 >> rename1 `positive (sp,sts,mu)` (* m0 now disappeared *) 3408 >> Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}` 3409 >> Know `sts SUBSET S /\ ring (sp,S)` 3410 >- (Know `S = subsets (smallest_ring sp sts)` 3411 >- (Q.UNABBREV_TAC `S` \\ 3412 MATCH_MP_TAC EQ_SYM \\ 3413 MATCH_MP_TAC SMALLEST_RING_OF_SEMIRING >> art []) >> Rewr' \\ 3414 CONJ_TAC >- REWRITE_TAC [SMALLEST_RING_SUBSET_SUBSETS] \\ 3415 fs [semiring_def, space_def, subsets_def] \\ 3416 METIS_TAC [SPACE, SPACE_SMALLEST_RING, SMALLEST_RING]) 3417 >> STRIP_TAC 3418 >> Q.ABBREV_TAC `M = \a. {r | ?c. c SUBSET sts /\ FINITE c /\ disjoint c /\ 3419 (a = BIGUNION c) /\ (r = SIGMA mu c)}` 3420 >> Know `!a s t. s IN (M a) /\ t IN (M a) ==> (s = t)` 3421 >- (rpt GEN_TAC >> Q.UNABBREV_TAC `M` >> RW_TAC std_ss [GSPECIFICATION] \\ 3422 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition 3423 (CONJ (ASSUME ``FINITE (c :'a set set)``) 3424 (ASSUME ``disjoint (c :'a set set)``))) \\ 3425 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition 3426 (CONJ (ASSUME ``FINITE (c' :'a set set)``) 3427 (ASSUME ``disjoint (c' :'a set set)``))) \\ 3428 Q.PAT_X_ASSUM `BIGUNION c' = BIGUNION c` MP_TAC >> art [] \\ 3429 DISCH_TAC \\ 3430 Know `!i. i < n ==> (f i = f i INTER BIGUNION (IMAGE f' (count n')))` 3431 >- (POP_ORW >> rpt STRIP_TAC \\ 3432 MATCH_MP_TAC EQ_SYM >> REWRITE_TAC [INTER_SUBSET_EQN] \\ 3433 MATCH_MP_TAC SUBSET_BIGUNION_I \\ 3434 PROVE_TAC [IN_IMAGE, IN_COUNT]) >> DISCH_TAC \\ 3435 Know `IMAGE f (count n) = 3436 IMAGE (\i. f i INTER BIGUNION (IMAGE f' (count n'))) (count n)` 3437 >- (MATCH_MP_TAC SUBSET_ANTISYM \\ 3438 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 3439 rpt STRIP_TAC >- (Q.EXISTS_TAC `x'` >> METIS_TAC []) \\ 3440 Q.EXISTS_TAC `i` >> METIS_TAC []) >> Rewr \\ 3441 Know `!i. i < n' ==> (f' i = f' i INTER BIGUNION (IMAGE f (count n)))` 3442 >- (Q.PAT_X_ASSUM `BIGUNION (IMAGE f' (count n')) = BIGUNION (IMAGE f (count n))` 3443 (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) >> rpt STRIP_TAC \\ 3444 MATCH_MP_TAC EQ_SYM >> REWRITE_TAC [INTER_SUBSET_EQN] \\ 3445 MATCH_MP_TAC SUBSET_BIGUNION_I \\ 3446 PROVE_TAC [IN_IMAGE, IN_COUNT]) >> DISCH_TAC \\ 3447 Know `IMAGE f' (count n') = 3448 IMAGE (\i. f' i INTER BIGUNION (IMAGE f (count n))) (count n')` 3449 >- (MATCH_MP_TAC SUBSET_ANTISYM \\ 3450 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 3451 rpt STRIP_TAC >- (Q.EXISTS_TAC `x'` >> METIS_TAC []) \\ 3452 Q.EXISTS_TAC `i` >> METIS_TAC []) \\ 3453 DISCH_THEN 3454 ((GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap) \\ 3455 Know `SIGMA mu (IMAGE (\i. f i INTER BIGUNION (IMAGE f' (count n'))) (count n)) = 3456 SIGMA (mu o (\i. f i INTER BIGUNION (IMAGE f' (count n')))) (count n)` 3457 >- (irule EXTREAL_SUM_IMAGE_IMAGE \\ 3458 REWRITE_TAC [FINITE_COUNT] >> CONJ_TAC 3459 >- (DISJ1_TAC >> GEN_TAC >> RW_TAC std_ss [IN_IMAGE, IN_COUNT] \\ 3460 Suff `0 <= mu (f i)` >- METIS_TAC [le_not_infty] \\ 3461 METIS_TAC [SUBSET_DEF, positive_def, measure_def, measurable_sets_def]) \\ 3462 MATCH_MP_TAC INJ_IMAGE \\ 3463 Q.EXISTS_TAC `c` >> REWRITE_TAC [INJ_DEF, IN_COUNT] >> BETA_TAC \\ 3464 METIS_TAC []) >> Rewr' \\ 3465 Know `SIGMA mu (IMAGE (\i. f' i INTER BIGUNION (IMAGE f (count n))) (count n')) = 3466 SIGMA (mu o (\i. f' i INTER BIGUNION (IMAGE f (count n)))) (count n')` 3467 >- (irule EXTREAL_SUM_IMAGE_IMAGE \\ 3468 REWRITE_TAC [FINITE_COUNT] >> CONJ_TAC 3469 >- (DISJ1_TAC >> GEN_TAC >> RW_TAC std_ss [IN_IMAGE, IN_COUNT] \\ 3470 Suff `0 <= mu (f' i)` >- METIS_TAC [le_not_infty] \\ 3471 METIS_TAC [SUBSET_DEF, positive_def, measure_def, measurable_sets_def]) \\ 3472 MATCH_MP_TAC INJ_IMAGE \\ 3473 Q.EXISTS_TAC `c'` >> REWRITE_TAC [INJ_DEF, IN_COUNT] >> BETA_TAC \\ 3474 METIS_TAC []) >> Rewr' \\ 3475 SIMP_TAC std_ss [BIGUNION_IMAGE_OVER_INTER_R, o_DEF] \\ 3476 (* applying FINITE_ADDITIVE and EXTREAL_SUM_IMAGE_EQ *) 3477 Know `SIGMA (\i. mu (BIGUNION (IMAGE (\i'. f i INTER f' i') (count n')))) (count n) = 3478 SIGMA (\i. SIGMA (mu o (\i'. f i INTER f' i')) (count n')) (count n)` 3479 >- (irule EXTREAL_SUM_IMAGE_EQ \\ 3480 SIMP_TAC std_ss [o_DEF, FINITE_COUNT, IN_COUNT] \\ 3481 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\ 3482 STRONG_CONJ_TAC 3483 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC 3484 (* mu (BIGUNION (IMAGE (\i'. f x' INTER f' i') (count n'))) <> NegInf *) 3485 >- (MATCH_MP_TAC pos_not_neginf \\ 3486 fs [positive_def, measure_def, measurable_sets_def] \\ 3487 Q.PAT_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3488 REWRITE_TAC [GSYM BIGUNION_IMAGE_OVER_INTER_R] \\ 3489 `f x INTER BIGUNION (IMAGE f' (count n')) = f x` by PROVE_TAC [] \\ 3490 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) \\ 3491 (* SIGMA (\i'. mu (f x' INTER f' i')) (count n') <> NegInf *) 3492 MATCH_MP_TAC pos_not_neginf \\ 3493 irule EXTREAL_SUM_IMAGE_POS >> RW_TAC std_ss [IN_COUNT, FINITE_COUNT] \\ 3494 fs [positive_def, measure_def, measurable_sets_def] \\ 3495 Q.PAT_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3496 MATCH_MP_TAC 3497 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3498 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\ 3499 rpt STRIP_TAC \\ 3500 (* applying FINITE_ADDITIVE on (sp,sts,mu) *) 3501 Suff `SIGMA (mu o (\i'. f x INTER f' i')) (count n') = 3502 mu (BIGUNION (IMAGE (\i'. f x INTER f' i') (count n')))` >- METIS_TAC [o_DEF] \\ 3503 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 3504 (Q.SPEC `(sp,sts,mu)` FINITE_ADDITIVE)) \\ 3505 ASM_SIMP_TAC std_ss [] \\ 3506 CONJ_TAC >- (rpt STRIP_TAC \\ 3507 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 3508 (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3509 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\ 3510 CONJ_TAC >- (rpt STRIP_TAC \\ 3511 MATCH_MP_TAC DISJOINT_RESTRICT_R >> PROVE_TAC []) \\ 3512 (* `BIGUNION (IMAGE (\i'. f x' INTER f' i') (count n')) IN sts` *) 3513 REWRITE_TAC [GSYM BIGUNION_IMAGE_OVER_INTER_R] \\ 3514 `f x INTER BIGUNION (IMAGE f' (count n')) = f x` by PROVE_TAC [] \\ 3515 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> Rewr' \\ 3516 (* symmetric with previous known *) 3517 Know `SIGMA (\i. mu (BIGUNION (IMAGE (\i'. f' i INTER f i') (count n)))) (count n') = 3518 SIGMA (\i. SIGMA (mu o (\i'. f' i INTER f i')) (count n)) (count n')` 3519 >- (irule EXTREAL_SUM_IMAGE_EQ \\ 3520 SIMP_TAC std_ss [o_DEF, FINITE_COUNT, IN_COUNT] \\ 3521 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\ 3522 STRONG_CONJ_TAC 3523 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC 3524 (* mu (BIGUNION (IMAGE (\i'. f' x' INTER f i') (count n))) <> NegInf *) 3525 >- (MATCH_MP_TAC pos_not_neginf \\ 3526 fs [positive_def, measure_def, measurable_sets_def] \\ 3527 Q.PAT_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3528 (* BIGUNION (IMAGE (\i'. f' x' INTER f i') (count n)) IN sts *) 3529 REWRITE_TAC [GSYM BIGUNION_IMAGE_OVER_INTER_R] \\ 3530 `f' x INTER BIGUNION (IMAGE f (count n)) = f' x` by PROVE_TAC [] \\ 3531 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) \\ 3532 (* SIGMA (\i'. mu (f' x' INTER f i')) (count n) <> NegInf *) 3533 MATCH_MP_TAC pos_not_neginf \\ 3534 irule EXTREAL_SUM_IMAGE_POS >> RW_TAC std_ss [IN_COUNT, FINITE_COUNT] \\ 3535 fs [positive_def, measure_def, measurable_sets_def] \\ 3536 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3537 MATCH_MP_TAC 3538 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3539 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\ 3540 rpt STRIP_TAC \\ 3541 (* applying FINITE_ADDITIVE on (sp,sts,mu) *) 3542 Suff `SIGMA (mu o (\i'. f' x INTER f i')) (count n) = 3543 mu (BIGUNION (IMAGE (\i'. f' x INTER f i') (count n)))` >- METIS_TAC [o_DEF] \\ 3544 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 3545 (Q.SPEC `(sp,sts,mu)` FINITE_ADDITIVE)) \\ 3546 ASM_SIMP_TAC std_ss [] \\ 3547 CONJ_TAC >- (rpt STRIP_TAC \\ 3548 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 3549 (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3550 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\ 3551 CONJ_TAC >- (rpt STRIP_TAC \\ 3552 MATCH_MP_TAC DISJOINT_RESTRICT_R >> PROVE_TAC []) \\ 3553 (* `BIGUNION (IMAGE (\i'. f' x' INTER f i') (count n)) IN sts` *) 3554 REWRITE_TAC [GSYM BIGUNION_IMAGE_OVER_INTER_R] \\ 3555 `f' x INTER BIGUNION (IMAGE f (count n)) = f' x` by PROVE_TAC [] \\ 3556 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> Rewr' \\ 3557 SIMP_TAC std_ss [o_DEF] \\ 3558 (* applying NESTED_EXTREAL_SUM_IMAGE_REVERSE, swapping the two SIGMAs *) 3559 Know `!i. (\i'. mu (f i INTER f' i')) = (\i i'. mu (f i INTER f' i')) i` 3560 >- PROVE_TAC [] >> Rewr' \\ 3561 Know `!i. (\i'. mu (f' i INTER f i')) = (\i i'. mu (f' i INTER f i')) i` 3562 >- PROVE_TAC [] >> Rewr' \\ 3563 Know `SIGMA (\i. SIGMA ((\i i'. mu (f' i INTER f i')) i) (count n)) (count n') = 3564 SIGMA (\i. SIGMA (\y. (\i i'. mu (f' i INTER f i')) y i) (count n')) (count n)` 3565 >- (MATCH_MP_TAC NESTED_EXTREAL_SUM_IMAGE_REVERSE \\ 3566 RW_TAC std_ss [FINITE_COUNT, IN_COUNT] \\ 3567 MATCH_MP_TAC pos_not_neginf \\ 3568 fs [positive_def, measure_def, measurable_sets_def] \\ 3569 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3570 MATCH_MP_TAC 3571 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3572 METIS_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) >> Rewr' \\ 3573 (* reduce one level of SIGMA *) 3574 irule EXTREAL_SUM_IMAGE_EQ \\ 3575 SIMP_TAC std_ss [IN_COUNT, FINITE_COUNT] \\ 3576 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\ 3577 STRONG_CONJ_TAC 3578 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC \\ (* 2 subgoals, same tactics *) 3579 MATCH_MP_TAC pos_not_neginf \\ 3580 irule EXTREAL_SUM_IMAGE_POS >> RW_TAC std_ss [IN_COUNT, FINITE_COUNT] \\ 3581 fs [positive_def, measure_def, measurable_sets_def] \\ 3582 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3583 MATCH_MP_TAC 3584 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3585 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\ 3586 rpt STRIP_TAC \\ 3587 (* reduce another level of SIGMA *) 3588 irule EXTREAL_SUM_IMAGE_EQ \\ 3589 SIMP_TAC std_ss [IN_COUNT, FINITE_COUNT] \\ 3590 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\ 3591 STRONG_CONJ_TAC 3592 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC \\ (* 2 subgoals, same tactics *) 3593 MATCH_MP_TAC pos_not_neginf \\ 3594 fs [positive_def, measure_def, measurable_sets_def] \\ 3595 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3596 MATCH_MP_TAC 3597 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3598 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\ 3599 rpt STRIP_TAC \\ 3600 PROVE_TAC [INTER_COMM]) 3601 >> DISCH_TAC 3602 (* m' is the inf (or sup) of M, which is either empty or a singleton *) 3603 >> Q.ABBREV_TAC `(m' :'a measure) = inf o M` 3604 (* we prove that the "inf" can be eliminated given one element in (M a) *) 3605 >> Know `!a r. r IN (M a) ==> (m' a = r)` 3606 >- (rpt STRIP_TAC \\ 3607 Q.UNABBREV_TAC `m'` >> SIMP_TAC std_ss [GSPECIFICATION] \\ 3608 MATCH_MP_TAC inf_const_alt \\ 3609 CONJ_TAC >- (Q.EXISTS_TAC `r` >> PROVE_TAC [IN_APP]) \\ 3610 METIS_TAC [IN_APP]) >> DISCH_TAC 3611 (* now we can prove (6.3) as a property of m', easily. *) 3612 >> Know `!c. c SUBSET sts /\ FINITE c /\ disjoint c ==> (m' (BIGUNION c) = SIGMA mu c)` 3613 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\ 3614 Q.UNABBREV_TAC `M` >> SIMP_TAC std_ss [GSPECIFICATION] \\ 3615 Q.EXISTS_TAC `c` >> art []) >> DISCH_TAC 3616 >> Q.EXISTS_TAC `(sp,S,m')` 3617 >> REWRITE_TAC [m_space_def, measurable_sets_def, measure_def] 3618 (* (sp,S) = smallest_ring sp sts *) 3619 >> CONJ_TAC 3620 >- (Q.UNABBREV_TAC `S` \\ 3621 METIS_TAC [SPACE, SPACE_SMALLEST_RING, SMALLEST_RING_OF_SEMIRING, 3622 space_def, subsets_def]) 3623 (* m' extends mu on sts *) 3624 >> STRONG_CONJ_TAC 3625 >- (rpt STRIP_TAC \\ 3626 `m' s = m' (BIGUNION {s})` by PROVE_TAC [BIGUNION_SING] >> POP_ORW \\ 3627 Know `m' (BIGUNION {s}) = SIGMA mu {s}` 3628 >- (FIRST_X_ASSUM MATCH_MP_TAC >> REWRITE_TAC [FINITE_SING, disjoint_sing] \\ 3629 PROVE_TAC [SUBSET_DEF, IN_SING]) >> Rewr' \\ 3630 REWRITE_TAC [EXTREAL_SUM_IMAGE_SING]) >> DISCH_TAC 3631 (* positive (sp,S,m') *) 3632 >> STRONG_CONJ_TAC 3633 >- (RW_TAC std_ss [positive_def, measure_def] >| (* 2 subgoals *) 3634 [ (* goal 1 (of 2): m' {} = 0 *) 3635 FIRST_X_ASSUM MATCH_MP_TAC \\ 3636 Q.UNABBREV_TAC `M` >> SIMP_TAC std_ss [GSPECIFICATION] \\ 3637 Q.EXISTS_TAC `{}` \\ 3638 REWRITE_TAC [EMPTY_SUBSET, FINITE_EMPTY, disjoint_empty, BIGUNION_EMPTY, 3639 EXTREAL_SUM_IMAGE_EMPTY], 3640 (* goal 2 (of 2): 0 <= m' s *) 3641 Q.UNABBREV_TAC `m'` >> SIMP_TAC std_ss [GSPECIFICATION] \\ 3642 REWRITE_TAC [le_inf] >> GEN_TAC \\ 3643 Suff `y IN (M s) ==> 0 <= y` >- PROVE_TAC [IN_APP] \\ 3644 Q.UNABBREV_TAC `M` >> SIMP_TAC std_ss [GSPECIFICATION] \\ 3645 rpt STRIP_TAC >> POP_ORW \\ 3646 (* 0 <= SIGMA mu c *) 3647 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> art [] \\ 3648 rpt STRIP_TAC \\ 3649 fs [positive_def, measure_def, measurable_sets_def] \\ 3650 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 3651 PROVE_TAC [SUBSET_DEF] ]) >> DISCH_TAC 3652 (* additive (sp,S,m') *) 3653 >> RW_TAC std_ss [additive_def, measurable_sets_def, measure_def] 3654 (* m' (s UNION t) = m' s + m' t *) 3655 >> Q.UNABBREV_TAC `S` >> fs [] 3656 (* NOTE: `DISJOINT c c'` doesn't hold *) 3657 >> Know `DISJOINT (c DELETE {}) (c' DELETE {})` 3658 >- (RW_TAC std_ss [DISJOINT_DEF, INTER_DEF, NOT_IN_EMPTY, Once EXTENSION, 3659 GSPECIFICATION, IN_DELETE] \\ 3660 STRONG_DISJ_TAC >> DISJ2_TAC \\ 3661 STRONG_DISJ_TAC >> ASM_SET_TAC []) 3662 >> DISCH_TAC 3663 >> Know `(SIGMA mu c = SIGMA mu (c DELETE {})) /\ 3664 (SIGMA mu c' = SIGMA mu (c' DELETE {})) /\ 3665 (SIGMA mu c'' = SIGMA mu (c'' DELETE {}))` 3666 >- (rpt STRIP_TAC \\ (* 3 subgoals, same tactics *) 3667 (rename1 `SIGMA mu d = SIGMA mu (d DELETE {})` \\ 3668 reverse (Cases_on `{} IN d`) 3669 >- (`d DELETE {} = d` by PROVE_TAC [DELETE_NON_ELEMENT] >> art []) \\ 3670 `d = {} INSERT d` by ASM_SET_TAC [] \\ 3671 POP_ASSUM (* only rewrite LHS *) 3672 ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap) \\ 3673 Know `SIGMA mu (d DELETE {}) = mu {} + SIGMA mu (d DELETE {})` 3674 >- fs [positive_def, measure_def, add_lzero] >> Rewr' \\ 3675 irule EXTREAL_SUM_IMAGE_PROPERTY_NEG >> RW_TAC std_ss [] \\ 3676 MATCH_MP_TAC (MATCH_MP (REWRITE_RULE [measure_def, measurable_sets_def] 3677 (Q.SPEC `(sp,sts,mu)` positive_not_infty)) 3678 (ASSUME ``positive (sp,sts,mu)``)) \\ 3679 ASM_SET_TAC [])) >> Rewr' 3680 >> Know `SIGMA mu (c DELETE {}) + SIGMA mu (c' DELETE {}) = 3681 SIGMA mu ((c DELETE {}) UNION (c' DELETE {}))` 3682 >- (MATCH_MP_TAC EQ_SYM >> irule EXTREAL_SUM_IMAGE_DISJOINT_UNION \\ 3683 rw [FINITE_DELETE] >> DISJ1_TAC >> RW_TAC std_ss [] \\ 3684 MATCH_MP_TAC (MATCH_MP (REWRITE_RULE [measure_def, measurable_sets_def] 3685 (Q.SPEC `(sp,sts,mu)` positive_not_infty)) 3686 (ASSUME ``positive (sp,sts,mu)``)) \\ 3687 ASM_SET_TAC []) >> Rewr' 3688 >> `((c DELETE {}) UNION (c' DELETE {})) = (c UNION c') DELETE {}` by SET_TAC [] 3689 >> POP_ORW 3690 >> Q.PAT_X_ASSUM `!a s t. s IN (M a) /\ t IN (M a) ==> (s = t)` MATCH_MP_TAC 3691 >> Q.EXISTS_TAC `BIGUNION (c'' DELETE {})` 3692 >> Q.PAT_X_ASSUM `!a r. r IN M a ==> m' a = r` K_TAC 3693 >> Q.UNABBREV_TAC `M` 3694 >> RW_TAC std_ss [GSPECIFICATION] 3695 >- (Q.EXISTS_TAC `c'' DELETE {}` \\ 3696 rw [FINITE_DELETE] >- ASM_SET_TAC [] \\ 3697 ASM_SET_TAC [disjoint_def]) 3698 >> Q.EXISTS_TAC `c UNION c' DELETE {}` >> rw [FINITE_DELETE] 3699 >- ASM_SET_TAC [] 3700 >- ASM_SET_TAC [disjoint_def] 3701 >> Q.PAT_X_ASSUM `BIGUNION c UNION BIGUNION c' = BIGUNION c''` MP_TAC 3702 >> RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_UNION, IN_DELETE, 3703 NOT_IN_EMPTY] 3704 >> EQ_TAC >> rpt STRIP_TAC >> METIS_TAC [] 3705QED 3706 3707(* extracted from CARATHEODORY_SEMIRING *) 3708Theorem SEMIRING_PREMEASURE_EXTENSION : 3709 !m0. semiring (m_space m0, measurable_sets m0) /\ premeasure m0 ==> 3710 ?m. ((m_space m, measurable_sets m) = 3711 smallest_ring (m_space m0) (measurable_sets m0)) /\ 3712 (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\ 3713 premeasure m 3714Proof 3715 rpt STRIP_TAC 3716 >> `finite_additive m0` by PROVE_TAC [SEMIRING_PREMEASURE_FINITE_ADDITIVE] 3717 >> fs [premeasure_def] 3718 >> `?m. ((m_space m,measurable_sets m) = 3719 smallest_ring (m_space m0) (measurable_sets m0)) /\ 3720 (!s. s IN measurable_sets m0 ==> measure m s = measure m0 s) /\ 3721 positive m /\ additive m` 3722 by METIS_TAC [Q.SPEC `m0` SEMIRING_FINITE_ADDITIVE_EXTENSION] 3723 >> Know `ring (m_space m,measurable_sets m)` 3724 >- (art [] >> MATCH_MP_TAC SMALLEST_RING \\ 3725 fs [semiring_def, space_def, subsets_def]) >> DISCH_TAC 3726 >> `finite_additive m` by PROVE_TAC [RING_ADDITIVE_FINITE_ADDITIVE] 3727 (* cleanup the goal *) 3728 >> Q.EXISTS_TAC `m` >> rw [] 3729 >> Cases_on `m0` >> Cases_on `r` 3730 >> fs [m_space_def, measurable_sets_def, measure_def] 3731 >> rename1 `positive (sp,sts,mu)` (* m0 disappears *) 3732 >> Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}` 3733 >> Cases_on `m` >> Cases_on `r` 3734 >> fs [m_space_def, measurable_sets_def, measure_def] 3735 >> rename1 `positive (sp',S',m')` (* m disappears *) 3736 >> `sp' = sp` by PROVE_TAC [SPACE_SMALLEST_RING, SPACE, space_def, subsets_def] 3737 >> Know `S' = S` 3738 >- (Q.UNABBREV_TAC `S` \\ 3739 METIS_TAC [SMALLEST_RING_OF_SEMIRING, SPACE, space_def, subsets_def]) 3740 >> DISCH_TAC >> fs [] 3741 >> NTAC 2 (POP_ASSUM K_TAC) (* sp' and S' disappear *) 3742 >> `sts SUBSET S` by PROVE_TAC [SMALLEST_RING_SUBSET_SUBSETS, subsets_def] 3743 >> Q.PAT_X_ASSUM `(sp,S) = smallest_ring sp sts` K_TAC 3744 (* recover the original definition of m' *) 3745 >> Know `!c. c SUBSET sts /\ FINITE c /\ disjoint c ==> (m' (BIGUNION c) = SIGMA mu c)` 3746 >- (rpt STRIP_TAC \\ 3747 MATCH_MP_TAC EQ_TRANS >> Q.EXISTS_TAC `SIGMA m' c` \\ 3748 reverse CONJ_TAC 3749 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\ 3750 STRONG_CONJ_TAC (* !x. x IN c ==> m' x = mu x *) 3751 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\ 3752 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\ 3753 RW_TAC std_ss [] >> DISJ1_TAC \\ 3754 GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\ 3755 fs [positive_def, measure_def, measurable_sets_def] \\ 3756 FIRST_X_ASSUM MATCH_MP_TAC \\ 3757 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\ 3758 MATCH_MP_TAC EQ_SYM \\ 3759 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 3760 (Q.SPEC `(sp,S,m')` FINITE_ADDITIVE_ALT)) \\ 3761 rw [] >> ASM_SET_TAC []) >> DISCH_TAC 3762 (* countably_additive (sp,S,m') *) 3763 >> RW_TAC std_ss [countably_additive_def, measure_def, measurable_sets_def, 3764 IN_FUNSET, IN_UNIV] 3765 >> Know `!x. ?c. (f x = BIGUNION c) /\ c SUBSET sts /\ FINITE c /\ disjoint c` 3766 >- (Q.X_GEN_TAC `x` \\ 3767 Q.PAT_X_ASSUM `!x. f x IN S` (MP_TAC o (Q.SPEC `x`)) \\ 3768 Q.UNABBREV_TAC `S` >> SIMP_TAC std_ss [GSPECIFICATION]) 3769 >> SIMP_TAC std_ss [SKOLEM_THM] >> STRIP_TAC (* skolemization here *) 3770 (* g is a finite disjoint union of (f n) *) 3771 >> `!n. f n = BIGUNION (f' n)` 3772 by PROVE_TAC [] >> rename1 `!n. f n = BIGUNION (g n)` 3773 >> `!n. g n SUBSET sts` by PROVE_TAC [] 3774 >> `!n. FINITE (g n)` by PROVE_TAC [] 3775 >> `!n. disjoint (g n)` by PROVE_TAC [] 3776 >> Q.PAT_X_ASSUM `!x. (f x = BIGUNION (g x)) /\ P` K_TAC 3777 (* applying countable_disjoint_decomposition *) 3778 >> Know `!x. ?h n. (!i. i < n ==> h i IN (g x)) /\ (!i. n <= i ==> (h i = {})) /\ 3779 (g x = IMAGE h (count n)) /\ 3780 (BIGUNION (g x) = BIGUNION (IMAGE h univ(:num))) /\ 3781 (!i j. i < n /\ j < n /\ i <> j ==> h i <> h j) /\ 3782 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (h i) (h j))` 3783 >- (Q.X_GEN_TAC `n` \\ 3784 Know `FINITE (g n) /\ disjoint (g n)` >- PROVE_TAC [] \\ 3785 DISCH_THEN (STRIP_ASSUME_TAC o (MATCH_MP countable_disjoint_decomposition)) \\ 3786 Q.EXISTS_TAC `f'` >> Q.EXISTS_TAC `n'` >> art []) 3787 >> SIMP_TAC std_ss [SKOLEM_THM] >> STRIP_TAC (* skolemization here *) 3788 >> `!n i. i < f'' n ==> f' n i IN g n` by PROVE_TAC [] 3789 >> rename1 `!n i. i < p n ==> s n i IN g n` 3790 >> `!n i. p n <= i ==> (s n i = {})` by PROVE_TAC [] 3791 >> `!n. g n = IMAGE (s n) (count (p n))` by PROVE_TAC [] 3792 >> `!n. BIGUNION (g n) = BIGUNION (IMAGE (s n) univ(:num))` by PROVE_TAC [] 3793 >> `!n i j. i < p n /\ j < p n /\ i <> j ==> s n i <> s n j` by PROVE_TAC [] 3794 >> `!n i j. i < p n /\ j < p n /\ i <> j ==> 3795 DISJOINT (s n i) (s n j)` by PROVE_TAC [] 3796 >> Q.PAT_X_ASSUM `!x. (!i. i < p x ==> s x i IN g x) /\ X` K_TAC 3797 (* properties of 2-dimension sets s(n,i), p(n) is the length of each f(n) *) 3798 >> Know `!n i. s n i IN sts` 3799 >- (rpt GEN_TAC >> Cases_on `p n <= i` (* easy case *) 3800 >- (`s n i = {}` by PROVE_TAC [] >> art [] \\ 3801 PROVE_TAC [semiring_def, subsets_def]) \\ 3802 POP_ASSUM (STRIP_ASSUME_TAC o (REWRITE_RULE [GSYM NOT_LESS])) \\ 3803 `s n i IN g n` by PROVE_TAC [] \\ 3804 PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC 3805 >> STRIP_ASSUME_TAC NUM_2D_BIJ_INV 3806 >> rename1 `BIJ h univ(:num) (univ(:num) CROSS univ(:num))` 3807 >> Know `BIGUNION (IMAGE f univ(:num)) = 3808 BIGUNION (IMAGE (\n. BIGUNION (IMAGE (s n) univ(:num))) univ(:num))` 3809 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV]) >> DISCH_TAC 3810 >> STRIP_ASSUME_TAC (Q.SPEC `s` BIGUNION_IMAGE_BIGUNION_IMAGE_UNIV) 3811 >> STRIP_ASSUME_TAC (MATCH_MP (Q.SPEC `s` BIGUNION_IMAGE_UNIV_CROSS_UNIV) 3812 (ASSUME ``BIJ h univ(:num) (univ(:num) CROSS univ(:num))``)) 3813 >> Know `BIGUNION (IMAGE f univ(:num)) = BIGUNION (IMAGE (UNCURRY s o h) univ(:num))` 3814 >- METIS_TAC [] >> NTAC 3 (POP_ASSUM K_TAC) >> DISCH_TAC >> art [] 3815 (* now we show that `z` is a countable disjoint union of sets in sts, constructed by 3816 compressing f and g together. Once the properties of z were established, we don't 3817 need to uncompress it back any more, nor needed properties of f and g. *) 3818 >> Q.ABBREV_TAC `z = UNCURRY s o h` 3819 >> Know `!n. (z n) IN sts` 3820 >- (Q.UNABBREV_TAC `z` >> RW_TAC std_ss [UNCURRY, o_DEF]) >> DISCH_TAC 3821 >> Know `BIGUNION (IMAGE z univ(:num)) IN S` 3822 >- (Q.UNABBREV_TAC `z` >> METIS_TAC []) >> DISCH_TAC 3823 (* disjointness of z *) 3824 >> Know `!i j k l. i <> j ==> DISJOINT (s i k) (s j l)` 3825 >- (rpt STRIP_TAC \\ 3826 Cases_on `p i <= k` >- METIS_TAC [DISJOINT_EMPTY] \\ 3827 Cases_on `p j <= l` >- METIS_TAC [DISJOINT_EMPTY] \\ 3828 `DISJOINT (BIGUNION (g i)) (BIGUNION (g j))` by PROVE_TAC [] \\ 3829 POP_ASSUM (irule o (REWRITE_RULE [DISJOINT_BIGUNION])) \\ 3830 fs [NOT_LESS_EQUAL]) >> DISCH_TAC 3831 >> Know `!i j. i <> j ==> DISJOINT (z i) (z j)` 3832 >- (rpt STRIP_TAC \\ 3833 Q.UNABBREV_TAC `z` >> SIMP_TAC std_ss [o_DEF, UNCURRY] \\ 3834 Cases_on `FST (h i) = FST (h j)` 3835 >- (Cases_on `p (FST (h i)) <= SND (h i)` >- METIS_TAC [DISJOINT_EMPTY] \\ 3836 Cases_on `p (FST (h j)) <= SND (h j)` >- METIS_TAC [DISJOINT_EMPTY] \\ 3837 fs [NOT_LESS_EQUAL] \\ 3838 LAST_X_ASSUM MATCH_MP_TAC >> rfs [] \\ 3839 CCONTR_TAC >> fs [] \\ 3840 `h i = h j` by PROVE_TAC [PAIR_FST_SND_EQ] \\ 3841 METIS_TAC [BIJ_DEF, INJ_DEF, IN_UNIV, IN_CROSS]) \\ 3842 FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC 3843 (* construct another finite disjoint union such that BIGUNION c = Z *) 3844 >> Q.ABBREV_TAC `Z = BIGUNION (IMAGE z univ(:num))` 3845 >> Know `?c. (Z = BIGUNION c) /\ c SUBSET sts /\ FINITE c /\ disjoint c` 3846 >- (Q.PAT_X_ASSUM `Z IN S` MP_TAC \\ 3847 Q.UNABBREV_TAC `S` >> SET_SPEC_TAC [] >> STRIP_TAC \\ 3848 Q.EXISTS_TAC `c` >> art []) >> STRIP_TAC 3849 >> PURE_ASM_REWRITE_TAC [] 3850 >> Know `m' (BIGUNION c) = SIGMA mu c` 3851 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr' 3852 (* convert c into a disjoint sequence f' of sets *) 3853 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition 3854 (CONJ (ASSUME ``FINITE (c :'a set set)``) 3855 (ASSUME ``disjoint (c :'a set set)``))) 3856 >> PURE_ASM_REWRITE_TAC [] 3857 (* SIGMA mu (IMAGE f' (count n)) = suminf (m' o f) *) 3858 >> Know `!i. i < n ==> (f' i = (f' i) INTER BIGUNION (IMAGE z univ(:num)))` 3859 >- (rpt STRIP_TAC \\ 3860 MATCH_MP_TAC EQ_SYM >> REWRITE_TAC [INTER_SUBSET_EQN] \\ 3861 `BIGUNION (IMAGE z univ(:num)) = BIGUNION (IMAGE f' (count n))` by PROVE_TAC [] \\ 3862 POP_ORW >> MATCH_MP_TAC SUBSET_BIGUNION_I \\ 3863 RW_TAC std_ss [IN_IMAGE, IN_COUNT]) >> DISCH_TAC 3864 (* LHS reductions *) 3865 >> Know `SIGMA mu (IMAGE f' (count n)) = SIGMA (mu o f') (count n)` 3866 >- (irule EXTREAL_SUM_IMAGE_IMAGE \\ 3867 RW_TAC std_ss [FINITE_COUNT, IN_IMAGE, IN_COUNT] >| (* 2 subgoals *) 3868 [ (* goal 1 (of 2) *) 3869 DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> art [] \\ 3870 MATCH_MP_TAC pos_not_neginf \\ 3871 `f' x' IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 3872 METIS_TAC [positive_def, measure_def, measurable_sets_def], 3873 (* goal 2 (of 2) *) 3874 MATCH_MP_TAC INJ_IMAGE >> Q.EXISTS_TAC `sts` \\ 3875 RW_TAC std_ss [INJ_DEF, IN_COUNT] >- PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 3876 CCONTR_TAC >> PROVE_TAC [] ]) >> Rewr' 3877 >> Know `SIGMA (mu o f') (count n) = 3878 SIGMA (mu o (\i. (f' i) INTER BIGUNION (IMAGE z univ(:num)))) (count n)` 3879 >- (irule EXTREAL_SUM_IMAGE_EQ \\ 3880 SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT, o_DEF] \\ 3881 CONJ_TAC >- (rpt STRIP_TAC >> METIS_TAC []) \\ 3882 DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\ 3883 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf \\ 3884 `f' x IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 3885 METIS_TAC [positive_def, measure_def, measurable_sets_def]) \\ 3886 `f' x INTER BIGUNION (IMAGE z univ(:num)) = f' x` by METIS_TAC [] >> POP_ORW \\ 3887 MATCH_MP_TAC pos_not_neginf \\ 3888 `f' x IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 3889 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' 3890 >> `!i. f' i INTER BIGUNION (IMAGE z univ(:num)) = 3891 BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num))` 3892 by REWRITE_TAC [BIGUNION_OVER_INTER_R] >> art [] 3893 >> Know `!i. i < n ==> BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num)) IN sts` 3894 >- (rpt STRIP_TAC \\ 3895 FIRST_X_ASSUM (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM) o (Q.SPEC `i`)) \\ 3896 Q.PAT_X_ASSUM `!i. i < n ==> X` 3897 (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM) o 3898 (fn th => (MATCH_MP th (ASSUME ``(i :num) < n``)))) \\ 3899 PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> DISCH_TAC 3900 >> Know `!i j. i < n ==> (f' i INTER z j) IN sts` 3901 >- (rpt STRIP_TAC \\ 3902 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3903 art [] >> PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) >> DISCH_TAC 3904 >> Know `!i. i < n ==> (mu (BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num))) = 3905 suminf (mu o (\n. f' i INTER z n)))` 3906 >- (rpt STRIP_TAC >> MATCH_MP_TAC EQ_SYM \\ 3907 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 3908 (Q.SPEC `(sp,sts,mu)` COUNTABLY_ADDITIVE)) \\ 3909 ASM_SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\ 3910 Q.X_GEN_TAC `a` >> Q.X_GEN_TAC `b` >> DISCH_TAC \\ 3911 MATCH_MP_TAC DISJOINT_RESTRICT_R \\ 3912 FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC 3913 (* only rewrite LHS *) 3914 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [o_DEF] 3915 >> BETA_TAC 3916 >> Know `SIGMA (\i. mu (BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num)))) (count n) = 3917 SIGMA (\i. suminf (mu o (\n. f' i INTER z n))) (count n)` 3918 >- (irule EXTREAL_SUM_IMAGE_EQ \\ 3919 SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT] \\ 3920 CONJ_TAC >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\ 3921 DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\ 3922 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf \\ 3923 METIS_TAC [positive_def, measure_def, measurable_sets_def]) \\ 3924 MATCH_MP_TAC pos_not_neginf \\ 3925 MATCH_MP_TAC ext_suminf_pos >> RW_TAC std_ss [o_DEF] \\ 3926 Know `(f' x INTER z n') IN sts` 3927 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3928 art [] >> PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> DISCH_TAC \\ 3929 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' 3930 (* only rewrite LHS *) 3931 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [o_DEF] 3932 >> BETA_TAC 3933 (* clean up useless assums *) 3934 >> POP_ASSUM K_TAC 3935 >> Q.PAT_X_ASSUM `!i. f' i INTER BIGUNION (IMAGE z univ(:num)) = X` K_TAC 3936 >> Q.PAT_X_ASSUM `!i. i < n ==> (f' i = f' i INTER BIGUNION (IMAGE z univ(:num)))` K_TAC 3937 >> Q.PAT_X_ASSUM `!i. i < n ==> BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num)) IN sts` K_TAC 3938 (* stage: SIGMA (\i. suminf (\x. mu (f' i INTER z x))) (count n) = suminf (m' o f) *) 3939 >> Know `(\i. suminf (\x. mu (f' i INTER z x))) = (suminf o (\i x. mu (f' i INTER z x)))` 3940 >- (FUN_EQ_TAC >> Q.X_GEN_TAC `i` >> REWRITE_TAC [o_DEF] \\ 3941 BETA_TAC >> REWRITE_TAC []) >> Rewr' 3942 >> Know `SIGMA (suminf o (\i x. mu (f' i INTER z x))) (count n) = 3943 suminf (\x. SIGMA (\i. (\i x. mu (f' i INTER z x)) i x) (count n))` 3944 >- (MATCH_MP_TAC ext_suminf_sigma >> BETA_TAC >> rpt STRIP_TAC \\ 3945 Know `f' i INTER z x IN sts` 3946 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 3947 art [] >> PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC \\ 3948 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' 3949 >> BETA_TAC 3950 (* suminf (\x. SIGMA (\i. mu (f' i INTER z x)) (count n)) = suminf (m' o f) *) 3951 >> Know `!x. (\i. mu (f' i INTER z x)) = mu o (\i. f' i INTER z x)` 3952 >- (REWRITE_TAC [o_DEF] >> BETA_TAC >> GEN_TAC >> FUN_EQ_TAC \\ 3953 BETA_TAC >> GEN_TAC >> REWRITE_TAC []) >> Rewr' 3954 >> Know `!x. SIGMA (mu o (\i. f' i INTER z x)) (count n) = 3955 SIGMA mu (IMAGE (\i. f' i INTER z x) (count n))` 3956 >- (Q.X_GEN_TAC `j` \\ 3957 NTAC 3 (POP_ASSUM MP_TAC) \\ 3958 POP_ASSUM K_TAC \\ (* c = IMAGE f' (count n) *) 3959 POP_ASSUM MP_TAC \\ 3960 Q.SPEC_TAC (`n`, `n`) \\ 3961 Induct_on `n` >- (RW_TAC arith_ss [] \\ 3962 art [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY, IMAGE_EMPTY]) \\ 3963 rpt STRIP_TAC \\ 3964 `mu {} = 0` by PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\ 3965 REWRITE_TAC [COUNT_SUC, IMAGE_INSERT] \\ 3966 Know `SIGMA (mu o (\i. f' i INTER z j)) (n INSERT count n) = 3967 (mu o (\i. f' i INTER z j)) n + SIGMA (mu o (\i. f' i INTER z j)) (count n DELETE n)` 3968 >- (irule EXTREAL_SUM_IMAGE_PROPERTY >> art [FINITE_COUNT] \\ 3969 DISJ1_TAC >> SIMP_TAC std_ss [IN_INSERT, IN_COUNT, o_DEF] \\ 3970 GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\ 3971 `x < SUC n` by RW_TAC arith_ss [] \\ 3972 `f' x INTER z j IN sts` by PROVE_TAC [] \\ 3973 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' \\ 3974 SIMP_TAC std_ss [COUNT_DELETE] \\ 3975 Know `SIGMA mu (f' n INTER z j INSERT IMAGE (\i. f' i INTER z j) (count n)) = 3976 mu (f' n INTER z j) + 3977 SIGMA mu ((IMAGE (\i. f' i INTER z j) (count n)) DELETE (f' n INTER z j))` 3978 >- (irule EXTREAL_SUM_IMAGE_PROPERTY \\ 3979 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\ 3980 DISJ1_TAC >> GEN_TAC >> SIMP_TAC std_ss [IN_INSERT, IN_IMAGE, IN_COUNT] \\ 3981 STRIP_TAC 3982 >- (art [] >> MATCH_MP_TAC pos_not_neginf \\ 3983 `f' n INTER z j IN sts` by RW_TAC std_ss [] \\ 3984 METIS_TAC [positive_def, measure_def, measurable_sets_def]) \\ 3985 art [] >> MATCH_MP_TAC pos_not_neginf \\ 3986 `f' i INTER z j IN sts` by RW_TAC arith_ss [] \\ 3987 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' \\ 3988 Know `SIGMA mu (IMAGE (\i. f' i INTER z j) (count n) DELETE f' n INTER z j) = 3989 SIGMA mu (IMAGE (\i. f' i INTER z j) (count n))` 3990 >- (Cases_on `(f' n INTER z j) NOTIN (IMAGE (\i. f' i INTER z j) (count n))` 3991 >- METIS_TAC [DELETE_NON_ELEMENT] \\ 3992 POP_ASSUM MP_TAC >> SIMP_TAC arith_ss [IN_IMAGE, IN_COUNT] \\ 3993 (* ?i. (f' n INTER z j = f' i INTER z j) /\ i < n *) 3994 STRIP_TAC \\ 3995 `n < SUC n /\ i < SUC n /\ n <> i` by RW_TAC arith_ss [] \\ 3996 `DISJOINT (f' n INTER z j) (f' i INTER z j)` by PROVE_TAC [DISJOINT_RESTRICT_L] \\ 3997 `(f' n INTER z j = {}) /\ (f' i INTER z j = {})` by PROVE_TAC [DISJOINT_EMPTY_REFL] \\ 3998 art [DELETE_DEF] >> MATCH_MP_TAC EQ_SYM \\ 3999 irule EXTREAL_SUM_IMAGE_ZERO_DIFF \\ 4000 ASM_SIMP_TAC std_ss [IN_SING, IN_IMAGE, IN_COUNT] \\ 4001 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\ 4002 DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> art [] \\ 4003 MATCH_MP_TAC pos_not_neginf \\ 4004 `f' i' INTER z j IN sts` by RW_TAC arith_ss [] \\ 4005 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' \\ 4006 `!i. i < n ==> f' i IN c` by RW_TAC arith_ss [] \\ 4007 `!i j. i < n /\ j < n /\ i <> j ==> f' i <> f' j` by RW_TAC arith_ss [] \\ 4008 `!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f' i) (f' j)` by RW_TAC arith_ss [] \\ 4009 `!i j. i < n ==> f' i INTER z j IN sts` by RW_TAC arith_ss [] \\ 4010 `SIGMA (mu o (\i. f' i INTER z j)) (count n) = 4011 SIGMA mu (IMAGE (\i. f' i INTER z j) (count n))` by PROVE_TAC [] \\ 4012 Q.PAT_X_ASSUM `(!i. i < n ==> f' i IN c) ==> X` K_TAC \\ 4013 ASM_REWRITE_TAC []) >> Rewr' 4014 (* suminf (\x. SIGMA mu (IMAGE (\i. f' i INTER z x) (count n))) = suminf (m' o f) *) 4015 >> Know `!x. SIGMA mu (IMAGE (\i. f' i INTER z x) (count n)) = 4016 m' (BIGUNION (IMAGE (\i. f' i INTER z x) (count n)))` 4017 >- (Q.X_GEN_TAC `y` >> MATCH_MP_TAC EQ_SYM \\ 4018 FIRST_X_ASSUM MATCH_MP_TAC \\ 4019 CONJ_TAC >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] >> PROVE_TAC []) \\ 4020 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\ 4021 RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT] \\ 4022 Cases_on `i = i'` >- METIS_TAC [] \\ 4023 MATCH_MP_TAC DISJOINT_RESTRICT_L >> PROVE_TAC []) >> Rewr' 4024 >> REWRITE_TAC [GSYM BIGUNION_IMAGE_OVER_INTER_L] 4025 >> `BIGUNION (IMAGE f' (count n)) = BIGUNION (IMAGE z univ(:num))` by PROVE_TAC [] 4026 >> POP_ORW 4027 >> Know `!x. BIGUNION (IMAGE z univ(:num)) INTER z x = z x` 4028 >- (GEN_TAC >> REWRITE_TAC [INTER_SUBSET_EQN] \\ 4029 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] \\ 4030 Q.EXISTS_TAC `x` >> art []) >> Rewr' 4031 (* RHS reductions: *) 4032 >> `f = \n. BIGUNION (IMAGE (s n) (count (p n)))` by METIS_TAC [] >> POP_ORW 4033 >> SIMP_TAC std_ss [o_DEF] 4034 >> Know `!n. m' (BIGUNION (IMAGE (s n) (count (p n)))) = 4035 SIGMA mu (IMAGE (s n) (count (p n)))` 4036 >- (GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\ 4037 CONJ_TAC >- METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\ 4038 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\ 4039 RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT] \\ 4040 LAST_X_ASSUM MATCH_MP_TAC >> art [] >> PROVE_TAC []) >> Rewr' 4041 >> Know `!n. SIGMA mu (IMAGE (s n) (count (p n))) = SIGMA (mu o (s n)) (count (p n))` 4042 >- (GEN_TAC >> irule EXTREAL_SUM_IMAGE_IMAGE \\ 4043 art [FINITE_COUNT, IN_IMAGE, IN_COUNT] >> CONJ_TAC 4044 >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\ 4045 MATCH_MP_TAC pos_not_neginf >> art [] \\ 4046 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) \\ 4047 MATCH_MP_TAC INJ_IMAGE >> Q.EXISTS_TAC `sts` \\ 4048 RW_TAC std_ss [INJ_DEF, IN_COUNT] >> PROVE_TAC []) >> Rewr' 4049 >> Know `!n. SIGMA (mu o s n) (count (p n)) = suminf (mu o s n)` 4050 >- (GEN_TAC >> MATCH_MP_TAC EQ_SYM \\ 4051 MATCH_MP_TAC ext_suminf_sum >> SIMP_TAC std_ss [o_DEF] \\ 4052 CONJ_TAC >- (GEN_TAC >> PROVE_TAC [positive_def, measure_def, measurable_sets_def]) \\ 4053 RW_TAC std_ss [] \\ 4054 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' 4055 >> Know `!x. m' (z x) = mu (z x)` >- METIS_TAC [] >> Rewr' 4056 (* suminf (\x. mu (z x)) = suminf (\n. suminf (mu o s n)) *) 4057 >> Q.UNABBREV_TAC `z` >> SIMP_TAC std_ss [o_DEF, UNCURRY] 4058 (* preparing for applying ext_suminf_2d *) 4059 >> Q.ABBREV_TAC `ms = \x y. mu (s x y)` 4060 >> `!x. mu (s (FST (h x)) (SND (h x))) = ms (FST (h x)) (SND (h x))` 4061 by METIS_TAC [] >> POP_ORW 4062 >> `!n x. mu (s n x) = ms n x` by METIS_TAC [] >> POP_ORW 4063 >> `(\x. ms (FST (h x)) (SND (h x))) = UNCURRY ms o h` 4064 by METIS_TAC [o_DEF, UNCURRY] >> POP_ORW 4065 (* suminf (UNCURRY ms o h) = suminf (\n. suminf (\x. ms n x)) *) 4066 >> MATCH_MP_TAC ext_suminf_2d_full 4067 >> Q.UNABBREV_TAC `ms` >> ASM_SIMP_TAC std_ss [] 4068 >> rpt GEN_TAC 4069 >> PROVE_TAC [positive_def, measure_def, measurable_sets_def] 4070QED 4071 4072(* The "semiring" version of Caratheodory's Extension Theorem 4073 (Theorem 6.1 of [1, p.38-45]) 4074 4075 named after Constantin Caratheodory, a Greek mathematician who spent most 4076 of his professional career in Germany. [9] 4077 *) 4078Theorem CARATHEODORY_SEMIRING : 4079 !m0. semiring (m_space m0, measurable_sets m0) /\ premeasure m0 ==> 4080 ?m. (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\ 4081 ((m_space m, measurable_sets m) = 4082 sigma (m_space m0) (measurable_sets m0)) /\ measure_space m 4083Proof 4084 rpt STRIP_TAC >> Cases_on `m0` >> Cases_on `r` 4085 >> fs [m_space_def, measurable_sets_def, measure_def, premeasure_def] 4086 >> rename1 `positive (sp,sts,mu)` 4087 (* Step 1: m is an outer measure, which will eventually extend mu *) 4088 >> Q.ABBREV_TAC `C = countable_covers sts` 4089 >> Q.ABBREV_TAC `m = outer_measure mu C` 4090 >> Q.ABBREV_TAC `A' = caratheodory_sets sp m` 4091 >> fs [countable_covers_def, outer_measure_def, caratheodory_sets_def] 4092 >> Know `outer_measure_space (sp, POW sp, m) /\ 4093 (!x. x IN sts ==> m x <= mu x) /\ measure_space (sp,A',m)` 4094 >- (`subset_class sp sts /\ {} IN sts` 4095 by PROVE_TAC [semiring_def, space_def, subsets_def] \\ 4096 METIS_TAC [OUTER_MEASURE_CONSTRUCTION, 4097 outer_measure_def, countable_covers_def, caratheodory_sets_def]) 4098 >> STRIP_TAC 4099 (* Step 2a. Extend the measure from semi-ring (mu) to ring (m') *) 4100 >> Know `!x. x IN sts ==> (m x = mu x)` 4101 >- (rpt STRIP_TAC >> REWRITE_TAC [GSYM le_antisym] \\ 4102 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\ 4103 `?m1. ((m_space m1,measurable_sets m1) = smallest_ring sp sts) /\ 4104 (!s. s IN sts ==> measure m1 s = mu s) /\ premeasure m1` 4105 by METIS_TAC [premeasure_def, 4106 REWRITE_RULE [m_space_def, measurable_sets_def, measure_def, 4107 premeasure_def] 4108 (Q.SPEC `(sp,sts,mu)` SEMIRING_PREMEASURE_EXTENSION)] \\ 4109 Know `ring (m_space m1,measurable_sets m1)` 4110 >- (art [] >> MATCH_MP_TAC SMALLEST_RING \\ 4111 fs [semiring_def, space_def, subsets_def]) >> DISCH_TAC \\ 4112 `finite_additive m1 /\ countably_subadditive m1` 4113 by PROVE_TAC [RING_PREMEASURE_FINITE_ADDITIVE, 4114 RING_PREMEASURE_COUNTABLY_SUBADDITIVE] \\ 4115 (* now `mu x <= m x`, S is the set of finite unions of disjoint sets from sts. *) 4116 Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}` \\ 4117 Cases_on `m1` >> Cases_on `r` \\ 4118 fs [m_space_def, measurable_sets_def, measure_def] \\ 4119 rename1 `premeasure (sp',S',m')` (* m1 disappears *) \\ 4120 `sp' = sp` by PROVE_TAC [SPACE_SMALLEST_RING, SPACE, space_def, subsets_def] \\ 4121 Know `S' = S` 4122 >- (Q.UNABBREV_TAC `S` \\ 4123 METIS_TAC [SMALLEST_RING_OF_SEMIRING, SPACE, space_def, subsets_def]) \\ 4124 DISCH_TAC >> fs [] \\ 4125 NTAC 2 (POP_ASSUM K_TAC) (* sp' and S' disappear *) \\ 4126 `sts SUBSET S` by PROVE_TAC [SMALLEST_RING_SUBSET_SUBSETS, subsets_def] \\ 4127 (* Step 2b. Claim: m extends mu, i.e. m(x) = mu(x), !x IN sts" *) 4128 Know `!c. c SUBSET sts /\ FINITE c /\ disjoint c ==> (m' (BIGUNION c) = SIGMA mu c)` 4129 >- (rpt STRIP_TAC \\ 4130 MATCH_MP_TAC EQ_TRANS >> Q.EXISTS_TAC `SIGMA m' c` \\ 4131 reverse CONJ_TAC 4132 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\ 4133 STRONG_CONJ_TAC (* !x. x IN c ==> m' x = mu x *) 4134 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\ 4135 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\ 4136 RW_TAC std_ss [] >> DISJ1_TAC \\ 4137 GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\ 4138 fs [positive_def, measure_def, measurable_sets_def] \\ 4139 FIRST_X_ASSUM MATCH_MP_TAC \\ 4140 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\ 4141 MATCH_MP_TAC EQ_SYM \\ 4142 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4143 (Q.SPEC `(sp,S,m')` FINITE_ADDITIVE_ALT)) \\ 4144 fs [premeasure_def] >> ASM_SET_TAC []) >> DISCH_TAC \\ 4145 (* mu x <= m x *) 4146 `mu x = m' x` by PROVE_TAC [] >> POP_ORW \\ 4147 Q.PAT_X_ASSUM `outer_measure_space (sp,POW sp,m)` K_TAC \\ 4148 (* m' x <= m x *) 4149 Q.UNABBREV_TAC `A'` (* this just removes it *) \\ 4150 Q.PAT_X_ASSUM `measure_space (sp,_,m)` K_TAC \\ 4151 Q.UNABBREV_TAC `m` >> BETA_TAC \\ 4152 SET_SPEC_TAC [le_inf'] >> rpt STRIP_TAC \\ 4153 POP_ASSUM (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ 4154 (* m' x <= suminf (mu o f) *) 4155 POP_ASSUM MP_TAC (* f IN C x *) \\ 4156 Q.UNABBREV_TAC `C` >> SIMP_TAC std_ss [GSPECIFICATION, IN_FUNSET, IN_UNIV] \\ 4157 rpt STRIP_TAC \\ 4158 `m' x = m' (BIGUNION (IMAGE f univ(:num)) INTER x)` 4159 by PROVE_TAC [SUBSET_INTER2] >> POP_ORW \\ 4160 REWRITE_TAC [BIGUNION_OVER_INTER_L] \\ 4161 MATCH_MP_TAC le_trans \\ 4162 Q.EXISTS_TAC `suminf (m' o (\i. f i INTER x))` \\ 4163 CONJ_TAC 4164 >- (fs [countably_subadditive_def, measure_def, measurable_sets_def, IN_FUNSET, IN_UNIV] \\ 4165 FIRST_X_ASSUM MATCH_MP_TAC >> BETA_TAC \\ 4166 STRONG_CONJ_TAC (* !x'. f x' INTER x IN S *) 4167 >- (GEN_TAC >> MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,S)` RING_INTER)) \\ 4168 PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC \\ 4169 (* BIGUNION (IMAGE (\i. f i INTER x) univ(:num)) IN S *) 4170 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L] \\ 4171 PROVE_TAC [SUBSET_INTER2, SUBSET_DEF]) \\ 4172 Know `m' o (\i. f i INTER x) = mu o (\i. f i INTER x)` 4173 >- (SIMP_TAC std_ss [o_DEF] >> FUN_EQ_TAC >> GEN_TAC >> BETA_TAC \\ 4174 FIRST_X_ASSUM MATCH_MP_TAC \\ 4175 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 4176 art []) >> Rewr' \\ 4177 (* suminf (mu o (\i. f i INTER x)) <= suminf (mu o f) *) 4178 MATCH_MP_TAC ext_suminf_mono >> SIMP_TAC std_ss [o_DEF] \\ 4179 STRONG_CONJ_TAC 4180 >- (GEN_TAC >> fs [positive_def, measure_def, measurable_sets_def] \\ 4181 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\ 4182 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 4183 METIS_TAC [SUBSET_DEF]) >> DISCH_TAC \\ 4184 GEN_TAC \\ 4185 `increasing (sp,sts,mu)` 4186 by PROVE_TAC [SEMIRING_PREMEASURE_INCREASING, 4187 premeasure_def, m_space_def, measurable_sets_def] \\ 4188 fs [increasing_def, measure_def, measurable_sets_def] \\ 4189 FIRST_X_ASSUM MATCH_MP_TAC >> art [INTER_SUBSET] \\ 4190 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\ 4191 PROVE_TAC [SUBSET_DEF]) 4192 >> DISCH_TAC 4193 (* Step 3. Claim: sts SUBSET A, where A is m-measurable sets *) 4194 >> Know `!s t. s IN sts /\ t IN sts ==> m (s INTER t) + m (s DIFF t) <= m s` 4195 >- (rpt STRIP_TAC \\ 4196 `s INTER t IN sts` by PROVE_TAC [SEMIRING_INTER, subsets_def] \\ 4197 (* special case *) 4198 Cases_on `s INTER t = {}` 4199 >- (`s DIFF t = s` by ASM_SET_TAC [] \\ 4200 `mu {} = 0` by PROVE_TAC [positive_def, semiring_def, measure_def, subsets_def, 4201 measurable_sets_def] \\ 4202 `{} IN sts` by PROVE_TAC [semiring_def, subsets_def] \\ 4203 `m {} = 0` by PROVE_TAC [] \\ 4204 art [add_lzero, le_refl]) \\ 4205 (* general case *) 4206 MP_TAC (REWRITE_RULE [subsets_def] 4207 (Q.SPECL [`(sp,sts)`, `s`, `t`] SEMIRING_DIFF)) \\ 4208 RW_TAC std_ss [] \\ 4209 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition 4210 (CONJ (ASSUME ``FINITE (c :'a set set)``) 4211 (ASSUME ``disjoint (c :'a set set)``))) \\ 4212 `((s INTER t) UNION (s DIFF t) = s) /\ 4213 DISJOINT (s INTER t) (s DIFF t)` by SET_TAC [DISJOINT_DEF] \\ 4214 `mu ((s INTER t) UNION (s DIFF t)) = mu s` by PROVE_TAC [] \\ 4215 (* IMPORTANT: (s INTER t) is disjoint with all (f i), i < n *) 4216 Know `!i. i < n ==> DISJOINT (s INTER t) (f i)` 4217 >- (rpt STRIP_TAC \\ 4218 `DISJOINT (s INTER t) (BIGUNION (IMAGE f (count n)))` by PROVE_TAC [] \\ 4219 POP_ASSUM MP_TAC \\ 4220 REWRITE_TAC [DISJOINT_ALT, IN_BIGUNION_IMAGE, IN_COUNT] \\ 4221 METIS_TAC []) >> DISCH_TAC \\ 4222 Know `mu ((s INTER t) UNION (BIGUNION c)) = mu s` >- PROVE_TAC [] \\ 4223 REWRITE_TAC [GSYM BIGUNION_INSERT] >> DISCH_TAC \\ 4224 Know `disjoint ((s INTER t) INSERT c)` 4225 >- (`(s INTER t) INSERT c = 4226 {s INTER t} UNION c` by SET_TAC [] >> POP_ORW \\ 4227 MATCH_MP_TAC disjoint_union >> art [disjoint_sing] \\ 4228 ASM_SET_TAC [BIGUNION_SING, disjoint_def, IN_BIGUNION_IMAGE, IN_COUNT]) \\ 4229 DISCH_TAC \\ 4230 Know `mu (BIGUNION (s INTER t INSERT c)) = SIGMA mu (s INTER t INSERT c)` 4231 >- (MATCH_MP_TAC EQ_SYM \\ 4232 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4233 (Q.SPEC `(sp,sts,mu)` FINITE_ADDITIVE_ALT)) \\ 4234 `finite_additive (sp,sts,mu)` 4235 by PROVE_TAC [SEMIRING_PREMEASURE_FINITE_ADDITIVE, 4236 premeasure_def, m_space_def, measurable_sets_def] \\ 4237 Know `BIGUNION ((s INTER t) INSERT c) = s` 4238 >- (REWRITE_TAC [BIGUNION_INSERT] \\ 4239 Q.PAT_X_ASSUM `s DIFF t = BIGUNION c` (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ 4240 SET_TAC []) \\ 4241 Rewr' >> art [FINITE_INSERT, INSERT_SUBSET]) >> DISCH_TAC \\ 4242 `(s INTER t) INSERT c = {s INTER t} UNION c` by SET_TAC [] \\ 4243 Know `c DELETE (s INTER t) = c` 4244 >- (MATCH_MP_TAC DELETE_NON_ELEMENT_RWT \\ 4245 CCONTR_TAC >> rfs [] \\ 4246 `DISJOINT (s INTER t) (f x)` by PROVE_TAC [] \\ 4247 PROVE_TAC [DISJOINT_EMPTY_REFL_RWT]) >> DISCH_TAC \\ 4248 Know `SIGMA mu (s INTER t INSERT c) = mu (s INTER t) + SIGMA mu (c DELETE s INTER t)` 4249 >- (irule EXTREAL_SUM_IMAGE_PROPERTY >> art [] \\ 4250 DISJ1_TAC \\ 4251 RW_TAC std_ss [IN_UNION, IN_IMAGE, IN_COUNT, IN_SING] >| (* 2 subgoals *) 4252 [ (* goal 1 (of 2) *) 4253 MATCH_MP_TAC pos_not_neginf \\ 4254 PROVE_TAC [positive_def, measure_def, measurable_sets_def], 4255 (* goal 2 (of 2) *) 4256 MATCH_MP_TAC pos_not_neginf \\ 4257 `f x' IN sts` by PROVE_TAC [SUBSET_DEF] \\ 4258 PROVE_TAC [positive_def, measure_def, measurable_sets_def] ]) >> DISCH_TAC \\ 4259 Know `m (BIGUNION c) <= SIGMA m c` 4260 >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4261 (Q.SPECL [`(sp,POW sp,m)`, `c`] FINITE_SUBADDITIVE_ALT)) \\ 4262 `finite_subadditive (sp,POW sp,m)` 4263 by PROVE_TAC [OUTER_MEASURE_SPACE_FINITE_SUBADDITIVE] \\ 4264 fs [outer_measure_space_def] \\ 4265 `subset_class sp sts` by PROVE_TAC [semiring_def, space_def, subsets_def] \\ 4266 RW_TAC std_ss [SUBSET_DEF, IN_POW, IN_BIGUNION] \\ (* 2 subgoals, same tactics *) 4267 ASM_SET_TAC [subset_class_def]) >> DISCH_TAC \\ 4268 Know `SIGMA mu c = SIGMA m c` 4269 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\ 4270 CONJ_TAC >- (rpt STRIP_TAC >> PROVE_TAC [SUBSET_DEF]) \\ 4271 DISJ1_TAC >> RW_TAC std_ss [IN_IMAGE, IN_COUNT] >| (* 2 subgoals *) 4272 [ (* goal 1 (of 2) *) 4273 MATCH_MP_TAC pos_not_neginf \\ 4274 `f x' IN sts` by PROVE_TAC [SUBSET_DEF] \\ 4275 PROVE_TAC [positive_def, measure_def, measurable_sets_def], 4276 (* goal 2 (of 2) *) 4277 MATCH_MP_TAC pos_not_neginf \\ 4278 `f x' IN sts` by PROVE_TAC [SUBSET_DEF] \\ 4279 PROVE_TAC [positive_def, measure_def, measurable_sets_def] ]) >> DISCH_TAC \\ 4280 Know `mu s = m (s INTER t) + SIGMA m c` >- PROVE_TAC [] >> Rewr' \\ 4281 Know `m (s DIFF t) = m (BIGUNION c)` >- PROVE_TAC [] >> Rewr' \\ 4282 Know `mu (s INTER t) = m (s INTER t)` >- PROVE_TAC [] >> Rewr' \\ 4283 MATCH_MP_TAC le_ladd_imp >> art []) 4284 >> DISCH_TAC 4285 >> Know `!b s f. s IN sts /\ b SUBSET sp /\ f IN (C b) ==> 4286 m (b INTER s) + m (b DIFF s) <= suminf (mu o f)` 4287 >- (rpt GEN_TAC \\ 4288 Q.PAT_X_ASSUM `Abbrev (m = X)` K_TAC \\ (* useless here *) 4289 Q.UNABBREV_TAC `C` >> SET_SPEC_TAC [IN_FUNSET, IN_UNIV] >> STRIP_TAC \\ 4290 MATCH_MP_TAC le_trans \\ 4291 Q.EXISTS_TAC `m (BIGUNION (IMAGE f univ(:num)) INTER s) + m (BIGUNION (IMAGE f univ(:num)) DIFF s)` \\ 4292 `increasing (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\ 4293 `subset_class sp sts` by PROVE_TAC [semiring_def, space_def, subsets_def] \\ 4294 `positive (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\ 4295 `!s. s SUBSET sp ==> 0 <= m s` 4296 by PROVE_TAC [positive_def, measure_def, measurable_sets_def, IN_POW] \\ 4297 `countably_subadditive (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\ 4298 `subadditive (sp,POW sp,m)` by PROVE_TAC [OUTER_MEASURE_SPACE_SUBADDITIVE] \\ 4299 CONJ_TAC (* m (b INTER s) + m (b DIFF s) <= ... *) 4300 >- (MATCH_MP_TAC le_add2 >> STRIP_TAC >| 4301 [ (* goal 1 (of 2) *) 4302 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4303 (Q.SPEC `(sp,POW sp,m)` INCREASING)) >> art [IN_POW] \\ 4304 CONJ_TAC >- (MATCH_MP_TAC SUBSET_RESTRICT_L >> art []) \\ 4305 CONJ_TAC >- (MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\ 4306 MATCH_MP_TAC SUBSET_INTER_SUBSET_L \\ 4307 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 4308 PROVE_TAC [subset_class_def], 4309 (* goal 2 (of 2) *) 4310 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4311 (Q.SPEC `(sp,POW sp,m)` INCREASING)) >> art [IN_POW] \\ 4312 CONJ_TAC >- (MATCH_MP_TAC SUBSET_MONO_DIFF >> art []) \\ 4313 CONJ_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) \\ 4314 MATCH_MP_TAC SUBSET_DIFF_SUBSET \\ 4315 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 4316 PROVE_TAC [subset_class_def] ]) \\ 4317 Know `suminf (mu o f) = suminf (m o f)` 4318 >- (MATCH_MP_TAC ext_suminf_eq >> SIMP_TAC std_ss [o_DEF] \\ 4319 GEN_TAC >> METIS_TAC []) >> Rewr' \\ 4320 REWRITE_TAC [BIGUNION_OVER_INTER_L, BIGUNION_OVER_DIFF] \\ 4321 (* m (BIGUNION (IMAGE (\i. f i INTER s) univ(:num))) + ... <= suminf (m o f) *) 4322 MATCH_MP_TAC le_trans \\ 4323 Q.EXISTS_TAC `suminf (m o (\i. f i INTER s)) + suminf (m o (\i. f i DIFF s))` \\ 4324 CONJ_TAC 4325 >- (MATCH_MP_TAC le_add2 >> STRIP_TAC >| (* 2 subgoals *) 4326 [ (* goal 1 (of 2) *) 4327 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4328 (Q.SPECL [`(sp,POW sp,m)`, `c`] COUNTABLY_SUBADDITIVE)) \\ 4329 art [IN_POW, IN_FUNSET, IN_UNIV] >> BETA_TAC \\ 4330 CONJ_TAC >- (GEN_TAC >> MATCH_MP_TAC SUBSET_INTER_SUBSET_R \\ 4331 PROVE_TAC [subset_class_def]) \\ 4332 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 4333 MATCH_MP_TAC SUBSET_INTER_SUBSET_R >> PROVE_TAC [subset_class_def], 4334 (* goal 2 (of 2) *) 4335 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4336 (Q.SPECL [`(sp,POW sp,m)`, `c`] COUNTABLY_SUBADDITIVE)) \\ 4337 art [IN_POW, IN_FUNSET, IN_UNIV] >> BETA_TAC \\ 4338 CONJ_TAC >- (GEN_TAC >> MATCH_MP_TAC SUBSET_DIFF_SUBSET \\ 4339 PROVE_TAC [subset_class_def]) \\ 4340 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\ 4341 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> PROVE_TAC [subset_class_def] ]) \\ 4342 (* suminf (m o (\i. f i INTER s)) + suminf (m o (\i. f i DIFF s)) <= suminf (m o f) *) 4343 Know `suminf (m o (\i. f i INTER s)) + suminf (m o (\i. f i DIFF s)) = 4344 suminf (\n. (m o (\i. f i INTER s)) n + (m o (\i. f i DIFF s)) n)` 4345 >- (MATCH_MP_TAC EQ_SYM >> MATCH_MP_TAC ext_suminf_add \\ 4346 RW_TAC std_ss [o_DEF] 4347 >- (FIRST_X_ASSUM MATCH_MP_TAC \\ 4348 MATCH_MP_TAC SUBSET_INTER_SUBSET_R >> PROVE_TAC [subset_class_def]) \\ 4349 FIRST_X_ASSUM MATCH_MP_TAC \\ 4350 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> PROVE_TAC [subset_class_def]) >> Rewr' \\ 4351 (* suminf (\n. (m o (\i. f i INTER s)) n + (m o (\i. f i DIFF s)) n) <= suminf (m o f) *) 4352 MATCH_MP_TAC ext_suminf_mono \\ 4353 SIMP_TAC std_ss [o_DEF] \\ 4354 reverse CONJ_TAC >- PROVE_TAC [] \\ 4355 GEN_TAC >> MATCH_MP_TAC le_add \\ 4356 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC \\ 4357 MATCH_MP_TAC SUBSET_INTER_SUBSET_R >> PROVE_TAC [subset_class_def]) \\ 4358 FIRST_X_ASSUM MATCH_MP_TAC \\ 4359 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> PROVE_TAC [subset_class_def]) 4360 >> DISCH_TAC 4361 (* core definition: m-measurable sets *) 4362 >> Know `sts SUBSET A'` (* this doesn't hold is `sts` is not semiring *) 4363 >- (REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\ 4364 rename1 `s IN A'` \\ 4365 Q.UNABBREV_TAC `A'` >> SET_SPEC_TAC [] \\ 4366 CONJ_TAC >- PROVE_TAC [semiring_def, subset_class_def, space_def, subsets_def] \\ 4367 Q.X_GEN_TAC `b` >> DISCH_TAC \\ 4368 `subadditive (sp,POW sp,m)` by PROVE_TAC [OUTER_MEASURE_SPACE_SUBADDITIVE] \\ 4369 (* m b = m (b INTER s) + m (b DIFF s) *) 4370 REWRITE_TAC [GSYM le_antisym] >> CONJ_TAC 4371 >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def] 4372 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\ 4373 ASM_SIMP_TAC std_ss [IN_POW] >> ASM_SET_TAC []) \\ 4374 (* m (b INTER s) + m (b DIFF s) <= m b *) 4375 `m b = inf {r | (?f. f IN C b /\ (suminf (mu o f) = r))}` by METIS_TAC [] \\ 4376 POP_ORW >> REWRITE_TAC [le_inf'] >> GEN_TAC \\ 4377 SET_SPEC_TAC [] >> STRIP_TAC >> PROVE_TAC []) >> DISCH_TAC 4378 >> Q.PAT_X_ASSUM `!s t. s IN sts /\ t IN sts ==> X` K_TAC 4379 >> Q.PAT_X_ASSUM `!b s f. s IN sts /\ b SUBSET sp /\ f IN C b ==> X` K_TAC 4380 (* Step 4. Claim: A' is sigma-algebra and m is measure on (sp,A') *) 4381 >> `sigma_algebra (sp,A')` 4382 by PROVE_TAC [measure_space_def, m_space_def, measurable_sets_def] 4383 (* Step 5. Claim: m is mseaure on (sigma sp sts) which extends mu *) 4384 >> Q.EXISTS_TAC `(sp,subsets (sigma sp sts),m)` 4385 >> art [m_space_def, measurable_sets_def, measure_def] 4386 (* measure_space (sp,subsets (sigma sp sts),m) *) 4387 >> reverse CONJ_TAC 4388 >- (`(subsets (sigma sp sts)) SUBSET (subsets (sigma sp A'))` 4389 by PROVE_TAC [SIGMA_MONOTONE] \\ 4390 `sigma sp A' = (sp,A')` by PROVE_TAC [SIGMA_STABLE_LEMMA] \\ 4391 `sigma_algebra (sigma sp sts)` 4392 by PROVE_TAC [SIGMA_ALGEBRA_SIGMA, semiring_def, space_def, subsets_def] \\ 4393 `(subsets (sigma sp sts)) SUBSET A'` by PROVE_TAC [subsets_def] \\ 4394 MATCH_MP_TAC MEASURE_SPACE_RESTRICTION \\ 4395 Q.EXISTS_TAC `A'` >> art [] \\ 4396 `(sp,subsets (sigma sp sts)) = sigma sp sts` 4397 by METIS_TAC [SPACE_SIGMA, SPACE, space_def, subsets_def] >> POP_ORW \\ 4398 MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\ 4399 PROVE_TAC [semiring_def, space_def, subsets_def]) 4400 >> METIS_TAC [SPACE_SIGMA, SPACE, space_def, subsets_def] 4401QED 4402 4403(* The "ring" version (weaker) of Caratheodory theorem *) 4404Theorem CARATHEODORY_RING : 4405 !m0. ring (m_space m0, measurable_sets m0) /\ 4406 positive m0 /\ countably_additive m0 ==> 4407 ?m. (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\ 4408 ((m_space m, measurable_sets m) = 4409 sigma (m_space m0) (measurable_sets m0)) /\ measure_space m 4410Proof 4411 GEN_TAC >> STRIP_TAC 4412 >> MATCH_MP_TAC CARATHEODORY_SEMIRING 4413 >> IMP_RES_TAC RING_IMP_SEMIRING >> art [premeasure_def] 4414 >> fs [algebra_def, space_def, subsets_def] 4415QED 4416 4417(* The "algebra" version (weakest) of Caratheodory theorem *) 4418Theorem CARATHEODORY : 4419 !m0. algebra (m_space m0, measurable_sets m0) /\ 4420 positive m0 /\ countably_additive m0 ==> 4421 ?m. (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\ 4422 ((m_space m, measurable_sets m) = 4423 sigma (m_space m0) (measurable_sets m0)) /\ measure_space m 4424Proof 4425 GEN_TAC >> STRIP_TAC 4426 >> MATCH_MP_TAC CARATHEODORY_SEMIRING 4427 >> IMP_RES_TAC ALGEBRA_IMP_SEMIRING >> art [premeasure_def] 4428 >> fs [algebra_def, space_def, subsets_def] 4429QED 4430 4431(* ------------------------------------------------------------------------- *) 4432(* Completeness of Measure - Null sets *) 4433(* ------------------------------------------------------------------------- *) 4434 4435(* s is a null set on measure sapce m, see [1] (p.29) *) 4436val null_set_def = Define 4437 `null_set m s <=> s IN measurable_sets m /\ (measure m s = 0)`; 4438 4439(* MATHEMATICAL SCRIPT CAPITAL N, not very meaningful 4440val _ = Unicode.unicode_version {u = UTF8.chr 0x1D4A9, tmnm = "null_set"}; 4441 *) 4442 4443(* a measure space m which is not yet complete can be completed *) 4444val complete_of_def = Define 4445 `complete_of m = 4446 (m_space m, {s UNION n | s IN measurable_sets m /\ ?t. n SUBSET t /\ null_set m t}, 4447 measure m)`; 4448 4449(* the measure space m is called complete iff any subset of a null set is again 4450 in `subsets m` (thus also a null set) see [1] (p.29], [5] (p.382) *) 4451val complete_measure_space_def = Define 4452 `complete_measure_space m <=> 4453 measure_space m /\ 4454 !s. null_set m s ==> !t. t SUBSET s ==> t IN measurable_sets m`; 4455 4456val IN_NULL_SET = store_thm 4457 ("IN_NULL_SET", ``!m s. s IN null_set m <=> null_set m s``, 4458 GEN_TAC >> SIMP_TAC std_ss [IN_APP]); 4459 4460(* This is HVG's original definition of "null_sets" *) 4461Theorem null_sets : 4462 null_set M = {N | N IN measurable_sets M /\ (measure M N = 0)} 4463Proof 4464 RW_TAC std_ss [Once EXTENSION, GSPECIFICATION, IN_NULL_SET, null_set_def] 4465QED 4466 4467val NULL_SET_EMPTY = store_thm 4468 ("NULL_SET_EMPTY", ``!m. measure_space m ==> null_set m {}``, 4469 RW_TAC std_ss [measure_space_def, positive_def, null_set_def] 4470 >> PROVE_TAC [sigma_algebra_def, ALGEBRA_EMPTY, space_def, subsets_def]); 4471 4472(* properties of the set of m-null sets, see [1] (p.29, Problem 4.10) *) 4473val NULL_SET_THM = store_thm 4474 ("NULL_SET_THM", 4475 ``!m s t. measure_space m ==> 4476 {} IN null_set m /\ 4477 (t IN null_set m /\ s IN measurable_sets m /\ s SUBSET t ==> s IN null_set m) /\ 4478 !f. f IN (univ(:num) -> null_set m) ==> 4479 BIGUNION (IMAGE f univ(:num)) IN null_set m``, 4480 rpt GEN_TAC >> DISCH_TAC 4481 >> SIMP_TAC std_ss [IN_NULL_SET, null_set_def] 4482 >> CONJ_TAC >- (PROVE_TAC [MEASURE_SPACE_EMPTY_MEASURABLE, MEASURE_EMPTY]) 4483 >> CONJ_TAC >- (rpt STRIP_TAC \\ 4484 Suff `measure m s <= measure m t` 4485 >- (DISCH_TAC >> REWRITE_TAC [GSYM le_antisym] \\ 4486 CONJ_TAC >- PROVE_TAC [] \\ 4487 fs [measure_space_def, positive_def]) \\ 4488 MATCH_MP_TAC INCREASING >> art [] \\ 4489 IMP_RES_TAC MEASURE_SPACE_INCREASING) 4490 >> GEN_TAC >> REWRITE_TAC [IN_FUNSET, IN_UNIV, IN_NULL_SET, null_set_def] 4491 >> STRIP_TAC >> STRONG_CONJ_TAC 4492 >- (fs [measure_space_def, sigma_algebra_def, subsets_def] \\ 4493 FIRST_X_ASSUM MATCH_MP_TAC \\ 4494 REWRITE_TAC [COUNTABLE_IMAGE_NUM] \\ 4495 fs [SUBSET_DEF, IN_FUNSET, IN_UNIV, IN_NULL_SET, null_set_def] \\ 4496 PROVE_TAC []) >> DISCH_TAC 4497 >> IMP_RES_TAC MEASURE_SPACE_COUNTABLY_SUBADDITIVE 4498 >> fs [countably_subadditive_def] 4499 >> Know `measure m (BIGUNION (IMAGE f univ(:num))) <= suminf (measure m o f)` 4500 >- (FIRST_X_ASSUM MATCH_MP_TAC >> PROVE_TAC [IN_FUNSET, IN_UNIV]) >> DISCH_TAC 4501 >> Suff `suminf (measure m o f) = 0` 4502 >- (DISCH_TAC >> fs [] >> REWRITE_TAC [GSYM le_antisym] >> art [] \\ 4503 fs [measure_space_def, positive_def]) 4504 >> MATCH_MP_TAC ext_suminf_zero >> METIS_TAC [o_DEF]); 4505 4506(* in complete measure space, the subset of a null set is still a null set. *) 4507val COMPLETE_MEASURE_THM = store_thm 4508 ("COMPLETE_MEASURE_THM", 4509 ``!m s t. complete_measure_space m /\ t IN null_set m /\ s SUBSET t ==> s IN null_set m``, 4510 RW_TAC std_ss [complete_measure_space_def] 4511 >> PROVE_TAC [NULL_SET_THM, IN_NULL_SET]); 4512 4513Theorem NULL_SET_UNION : 4514 !m N1 N2. measure_space m /\ N1 IN null_set m /\ N2 IN null_set m ==> 4515 (N1 UNION N2) IN null_set m 4516Proof 4517 rpt GEN_TAC 4518 >> SIMP_TAC std_ss [IN_NULL_SET, null_set_def] 4519 >> STRIP_TAC 4520 >> STRONG_CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_UNION >> art []) 4521 >> DISCH_TAC 4522 >> REWRITE_TAC [GSYM le_antisym] 4523 >> reverse CONJ_TAC 4524 >- (IMP_RES_TAC MEASURE_SPACE_POSITIVE >> fs [positive_def]) 4525 >> `0 = measure m N1 + measure m N2` by METIS_TAC [add_rzero] 4526 >> POP_ORW 4527 >> MATCH_MP_TAC SUBADDITIVE >> art [] 4528 >> IMP_RES_TAC MEASURE_SPACE_SUBADDITIVE 4529QED 4530 4531Theorem NULL_SET_INTER : 4532 !m N1 N2. measure_space m /\ N1 IN null_set m /\ N2 IN null_set m ==> 4533 (N1 INTER N2) IN null_set m 4534Proof 4535 rpt GEN_TAC 4536 >> SIMP_TAC std_ss [IN_NULL_SET, null_set_def] 4537 >> STRIP_TAC 4538 >> STRONG_CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_INTER >> art []) 4539 >> DISCH_TAC 4540 >> REWRITE_TAC [GSYM le_antisym] 4541 >> reverse CONJ_TAC 4542 >- (IMP_RES_TAC MEASURE_SPACE_POSITIVE >> fs [positive_def]) 4543 >> Q.PAT_X_ASSUM `measure m N1 = 0` (ONCE_REWRITE_TAC o wrap o SYM) 4544 >> MATCH_MP_TAC INCREASING >> art [] 4545 >> reverse CONJ_TAC >- SET_TAC [] 4546 >> IMP_RES_TAC MEASURE_SPACE_INCREASING 4547QED 4548 4549(* ------------------------------------------------------------------------- *) 4550(* Alternative definitions of `sigma_finite` *) 4551(* ------------------------------------------------------------------------- *) 4552 4553Theorem FINITE_IMP_SIGMA_FINITE : 4554 !m. measure_space m /\ measure m (m_space m) <> PosInf ==> sigma_finite m 4555Proof 4556 RW_TAC std_ss [sigma_finite_def] 4557 >> Q.EXISTS_TAC `\n. m_space m` 4558 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV, GSYM lt_infty, SUBSET_REFL, 4559 MEASURE_SPACE_MSPACE_MEASURABLE] 4560 >> RW_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV] 4561QED 4562 4563(* The increasing sequence in "sigma_finite_def" is not required *) 4564val SIGMA_FINITE_ALT = store_thm (* was: sigma_finite (HVG) *) 4565 ("SIGMA_FINITE_ALT", 4566 ``!m. measure_space m ==> 4567 (sigma_finite m <=> ?f :num -> 'a set. 4568 f IN (UNIV -> measurable_sets m) /\ 4569 (BIGUNION (IMAGE f UNIV) = m_space m) /\ 4570 (!n. measure m (f n) < PosInf))``, 4571 GEN_TAC >> DISCH_TAC 4572 >> REWRITE_TAC [sigma_finite_def] 4573 >> EQ_TAC >> rpt STRIP_TAC 4574 >- (Q.EXISTS_TAC `f` >> art []) 4575 >> STRIP_ASSUME_TAC (Q.SPEC `f` SETS_TO_INCREASING_SETS) 4576 >> Q.EXISTS_TAC `g` 4577 >> fs [IN_FUNSET, IN_UNIV, measure_space_def] 4578 >> CONJ_TAC 4579 >- (GEN_TAC \\ 4580 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 4581 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_FINITE_UNION)) \\ 4582 CONJ_TAC >- fs [sigma_algebra_def] \\ 4583 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\ 4584 RW_TAC arith_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] >> art []) 4585 >> GEN_TAC 4586 >> MATCH_MP_TAC let_trans 4587 >> Q.EXISTS_TAC `SIGMA (measure m o f) (count (SUC n))` 4588 >> CONJ_TAC 4589 >- (MATCH_MP_TAC FINITE_SUBADDITIVE >> art [] \\ 4590 CONJ_TAC >- (MATCH_MP_TAC ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE \\ 4591 fs [sigma_algebra_def, premeasure_def]) \\ 4592 MATCH_MP_TAC (REWRITE_RULE [subsets_def] 4593 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_FINITE_UNION)) \\ 4594 CONJ_TAC >- fs [sigma_algebra_def] \\ 4595 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\ 4596 RW_TAC arith_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] >> art []) 4597 >> REWRITE_TAC [GSYM lt_infty] 4598 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_NOT_POSINF 4599 >> CONJ_TAC >- REWRITE_TAC [FINITE_COUNT] 4600 >> RW_TAC std_ss [o_DEF, lt_infty]); 4601 4602val SIGMA_FINITE_ALT2 = store_thm (* was: sigma_finite_measure (HVG) *) 4603 ("SIGMA_FINITE_ALT2", 4604 ``!m. measure_space m ==> 4605 (sigma_finite m <=> ?A. countable A /\ A SUBSET measurable_sets m /\ 4606 (BIGUNION A = m_space m) /\ 4607 (!a. a IN A ==> measure m a <> PosInf))``, 4608 GEN_TAC >> DISCH_TAC 4609 >> EQ_TAC >> rpt STRIP_TAC 4610 >- (fs [sigma_finite_def] \\ 4611 Q.EXISTS_TAC `IMAGE f univ(:num)` >> art [] \\ 4612 CONJ_TAC >- REWRITE_TAC [countable_image_nats] \\ 4613 CONJ_TAC >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV] \\ 4614 fs [IN_FUNSET, IN_UNIV]) \\ 4615 RW_TAC std_ss [IN_IMAGE, lt_infty] >> art []) 4616 >> fs [COUNTABLE_ENUM] 4617 >| [ (* goal 1 (of 2) *) 4618 REWRITE_TAC [sigma_finite_def] \\ 4619 Q.EXISTS_TAC `\n. {}` \\ 4620 CONJ_TAC >- (RW_TAC std_ss [IN_FUNSET, IN_UNIV] \\ 4621 METIS_TAC [measure_space_def, sigma_algebra_def, ALGEBRA_EMPTY, ALGEBRA_SPACE, 4622 space_def, subsets_def]) \\ 4623 CONJ_TAC >- RW_TAC std_ss [SUBSET_REFL] \\ 4624 CONJ_TAC >- (Suff `BIGUNION (IMAGE (\n. {}) univ(:num)) = BIGUNION {}` >- METIS_TAC [] \\ 4625 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_BIGUNION, IN_UNIV, 4626 NOT_IN_EMPTY]) \\ 4627 GEN_TAC >> BETA_TAC \\ 4628 fs [measure_space_def, positive_def] \\ 4629 REWRITE_TAC [extreal_of_num_def, lt_infty], 4630 (* goal 2 (of 2) *) 4631 RW_TAC std_ss [SIGMA_FINITE_ALT] \\ 4632 Q.EXISTS_TAC `f` >> art [] \\ 4633 CONJ_TAC >- (fs [IN_FUNSET, IN_UNIV, SUBSET_DEF, IN_IMAGE] \\ 4634 GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\ 4635 Q.EXISTS_TAC `x` >> REWRITE_TAC []) \\ 4636 GEN_TAC >> REWRITE_TAC [GSYM lt_infty] \\ 4637 FIRST_X_ASSUM MATCH_MP_TAC \\ 4638 REWRITE_TAC [IN_IMAGE, IN_UNIV] \\ 4639 Q.EXISTS_TAC `n` >> REWRITE_TAC [] ]); 4640 4641Theorem sigma_finite : 4642 !m. measure_space m /\ sigma_finite m ==> 4643 ?A. IMAGE A UNIV SUBSET measurable_sets m /\ 4644 (BIGUNION {A i | i IN UNIV} = m_space m) /\ 4645 (!i:num. measure m (A i) <> PosInf) 4646Proof 4647 rpt STRIP_TAC 4648 >> fs [MATCH_MP SIGMA_FINITE_ALT2 (ASSUME ``measure_space m``)] 4649 >> Cases_on `A = {}` 4650 >- (FULL_SIMP_TAC std_ss [NOT_IN_EMPTY, BIGUNION_EMPTY] \\ 4651 Q.EXISTS_TAC `\n. {}` \\ 4652 SIMP_TAC std_ss [IMAGE_DEF, SUBSET_DEF] \\ 4653 REWRITE_TAC [SET_RULE ``{{} | i IN univ(:num)} = {{}}``] \\ 4654 ASM_SIMP_TAC std_ss [BIGUNION_SING, IN_SING] \\ 4655 ASM_SIMP_TAC std_ss [MEASURE_SPACE_MSPACE_MEASURABLE] \\ 4656 CONJ_TAC >- (SET_TAC []) \\ 4657 METIS_TAC [MEASURE_EMPTY, num_not_infty]) 4658 >> Q.PAT_X_ASSUM `COUNTABLE A` (STRIP_ASSUME_TAC o (REWRITE_RULE [COUNTABLE_ENUM])) 4659 >> Q.EXISTS_TAC `f` >> rw [] 4660 >> Q.PAT_X_ASSUM `_ = m_space m` (ONCE_REWRITE_TAC o wrap o SYM) 4661 >> SET_TAC [] 4662QED 4663 4664Theorem sigma_finite_disjoint : 4665 !m. measure_space m /\ sigma_finite m ==> 4666 ?A. IMAGE A UNIV SUBSET measurable_sets m /\ 4667 (BIGUNION {A i | i IN UNIV} = m_space m) /\ 4668 (!i:num. measure m (A i) <> PosInf) /\ disjoint_family A 4669Proof 4670 RW_TAC std_ss [] 4671 >> `?A. IMAGE A univ(:num) SUBSET measurable_sets m /\ 4672 (BIGUNION {A i | i IN univ(:num)} = m_space m) /\ 4673 !i. measure m (A i) <> PosInf` by METIS_TAC [sigma_finite] 4674 >> Know `!i. measure m (disjointed A i) <= measure m (A i)` 4675 >- (GEN_TAC THEN 4676 MATCH_MP_TAC INCREASING THEN SIMP_TAC std_ss [disjointed_subset] \\ 4677 reverse CONJ_TAC 4678 >- (reverse CONJ_TAC >- ASM_SET_TAC [] \\ 4679 `IMAGE (\n. disjointed A n) UNIV SUBSET measurable_sets m` 4680 by METIS_TAC [measure_space_def, sigma_algebra_alt, algebra_alt, 4681 ring_disjointed_sets] \\ 4682 ASM_SET_TAC []) \\ 4683 FULL_SIMP_TAC std_ss [MEASURE_SPACE_INCREASING]) 4684 >> DISCH_TAC 4685 >> Know `!i. measure m (disjointed A i) <> PosInf` 4686 >- (FULL_SIMP_TAC std_ss [lt_infty] >> METIS_TAC [let_trans]) 4687 >> DISCH_TAC 4688 >> Q.EXISTS_TAC `\n. disjointed A n` >> RW_TAC std_ss [] 4689 >| [ (* goal 1 (of 3) *) 4690 MATCH_MP_TAC ring_disjointed_sets THEN Q.EXISTS_TAC `m_space m` THEN 4691 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_alt, algebra_alt], 4692 (* goal 2 (of 3) *) 4693 ASM_SIMP_TAC std_ss [BIGUNION_disjointed], 4694 (* goal 3 (of 3) *) 4695 METIS_TAC [disjoint_family_disjoint, ETA_THM] ] 4696QED 4697 4698Theorem MEASURABLE_IF : (* was: measurable_If *) 4699 !f g M N P. f IN measurable (m_space M, measurable_sets M) 4700 (m_space N, measurable_sets N) /\ 4701 g IN measurable (m_space M, measurable_sets M) 4702 (m_space N, measurable_sets N) /\ 4703 {x | x IN m_space M /\ P x} IN measurable_sets M /\ 4704 measure_space M ==> 4705 (\x. if P x then f x else g x) IN 4706 measurable (m_space M, measurable_sets M) 4707 (m_space N, measurable_sets N) 4708Proof 4709 RW_TAC std_ss [measurable_def, IN_MEASURABLE, space_def, subsets_def] THENL 4710 [FULL_SIMP_TAC std_ss [IN_FUNSET] THEN METIS_TAC [], ALL_TAC] THEN 4711 KNOW_TAC ``PREIMAGE (\x. if P x then f x else g x) s INTER m_space M = 4712 (((PREIMAGE f s) INTER m_space M) INTER {x | x IN m_space M /\ P x}) UNION 4713 (((PREIMAGE g s) INTER m_space M) INTER 4714 (m_space M DIFF {x | x IN m_space M /\ P x}))`` THENL 4715 [SIMP_TAC std_ss [PREIMAGE_def] THEN 4716 SET_TAC [], ALL_TAC] THEN 4717 ONCE_REWRITE_TAC [METIS [subsets_def] ``measurable_sets M = 4718 subsets (m_space M, measurable_sets M)``] THEN 4719 SIMP_TAC std_ss [] THEN DISC_RW_KILL THEN 4720 MATCH_MP_TAC ALGEBRA_UNION THEN FULL_SIMP_TAC std_ss [sigma_algebra_def] THEN 4721 CONJ_TAC THEN MATCH_MP_TAC ALGEBRA_INTER THEN 4722 FULL_SIMP_TAC std_ss [] THENL 4723 [METIS_TAC [subsets_def], ALL_TAC] THEN 4724 CONJ_TAC THENL [METIS_TAC [subsets_def], ALL_TAC] THEN 4725 MATCH_MP_TAC ALGEBRA_DIFF THEN FULL_SIMP_TAC std_ss [subsets_def] THEN 4726 MATCH_MP_TAC MEASURE_SPACE_MSPACE_MEASURABLE THEN ASM_REWRITE_TAC [] 4727QED 4728 4729Theorem MEASURABLE_IF_SET : (* was: measurable_If_set *) 4730 !f g M N A. f IN measurable (m_space M, measurable_sets M) 4731 (m_space N, measurable_sets N) /\ 4732 g IN measurable (m_space M, measurable_sets M) 4733 (m_space N, measurable_sets N) /\ 4734 A INTER m_space M IN measurable_sets M /\ 4735 measure_space M ==> (\x. if x IN A then f x else g x) IN 4736 measurable (m_space M, measurable_sets M) 4737 (m_space N, measurable_sets N) 4738Proof 4739 RW_TAC std_ss [] THEN 4740 ONCE_REWRITE_TAC [METIS [] ``(\x. if x IN A then f x else g x) = 4741 (\x. if (\x. x IN A) x then f x else g x)``] THEN 4742 MATCH_MP_TAC MEASURABLE_IF THEN ASM_SIMP_TAC std_ss [] THEN 4743 ONCE_REWRITE_TAC [SET_RULE ``{x | x IN m_space M /\ x IN A} = 4744 A INTER m_space M``] THEN 4745 ASM_SIMP_TAC std_ss [] 4746QED 4747 4748val lemma1 = prove ( 4749 ``!A sp M u. A IN (univ(:num) -> measurable_sets (sp,M,u)) <=> 4750 IMAGE A UNIV SUBSET M``, 4751 REPEAT STRIP_TAC THEN SIMP_TAC std_ss [measurable_sets_def] THEN 4752 EVAL_TAC THEN SRW_TAC[] [IN_FUNSET,IN_UNIV,SUBSET_DEF,IMAGE_DEF] THEN METIS_TAC[]); 4753 4754val lemma2 = prove ( 4755 ``!A. (!m n. m <> n ==> DISJOINT (A m) (A n)) <=> disjoint_family A``, 4756 STRIP_TAC THEN SIMP_TAC std_ss [disjoint_family, disjoint_family_on] THEN 4757 SET_TAC []); 4758 4759val lemma3 = prove ( 4760 ``!A sp M u. BIGUNION (IMAGE A univ(:num)) IN measurable_sets (sp,M,u) <=> 4761 BIGUNION {A i | i IN UNIV} IN M``, 4762 REPEAT STRIP_TAC THEN SIMP_TAC std_ss [measurable_sets_def, IMAGE_DEF]); 4763 4764Theorem countably_additive_alt_eq : 4765 !sp M u. countably_additive (sp,M,u) <=> 4766 !A. IMAGE A UNIV SUBSET M ==> disjoint_family A ==> 4767 BIGUNION {A i | i IN UNIV} IN M ==> 4768 (u (BIGUNION {A i | i IN univ(:num)}) = suminf (u o A)) 4769Proof 4770 SIMP_TAC std_ss [countably_additive_def] THEN REPEAT STRIP_TAC THEN 4771 SIMP_TAC std_ss [measure_def, o_DEF, lemma2, lemma3] THEN 4772 SIMP_TAC std_ss [GSYM IMAGE_DEF, SUBSET_DEF, measurable_sets_def] THEN 4773 EQ_TAC THEN RW_TAC std_ss [] THENL 4774 [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [] THEN 4775 EVAL_TAC THEN ASM_SET_TAC [IN_IMAGE,IN_FUNSET], ALL_TAC] THEN 4776 FIRST_X_ASSUM (MP_TAC o Q.SPEC `f`) THEN RW_TAC std_ss [] THEN 4777 POP_ASSUM MATCH_MP_TAC THEN 4778 fs [IN_IMAGE, IN_UNIV, IN_FUNSET] >> RW_TAC std_ss [] >> art [] 4779QED 4780 4781val sets_eq_imp_space_eq = store_thm ("sets_eq_imp_space_eq", 4782 ``!M M'. measure_space M /\ measure_space M' /\ 4783 (measurable_sets M = measurable_sets M') ==> (m_space M = m_space M')``, 4784 REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN 4785 FIRST_ASSUM (MP_TAC o MATCH_MP MEASURE_SPACE_MSPACE_MEASURABLE) THEN 4786 POP_ASSUM (MP_TAC o REWRITE_RULE [measure_space_def, sigma_algebra_alt_pow]) THEN 4787 FIRST_ASSUM (MP_TAC o MATCH_MP MEASURE_SPACE_MSPACE_MEASURABLE) THEN 4788 POP_ASSUM (MP_TAC o REWRITE_RULE [measure_space_def, sigma_algebra_alt_pow]) THEN 4789 REPEAT STRIP_TAC THEN FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_POW] THEN 4790 ASM_SET_TAC []); 4791 4792(* Any sigma-algebra induce a trivial (sigma-finite) measure space with (\s. 0) *) 4793Theorem measure_space_trivial : 4794 !a. sigma_algebra a ==> sigma_finite_measure_space (space a,subsets a,(\s. 0)) 4795Proof 4796 rpt STRIP_TAC 4797 >> simp [sigma_finite_measure_space_def] 4798 >> STRONG_CONJ_TAC 4799 >- (rw [measure_space_def] >| (* 2 subgoals *) 4800 [ (* goal 1 (of 2) *) 4801 rw [positive_def], 4802 (* goal 2 (of 2) *) 4803 rw [countably_additive_def, o_DEF, ext_suminf_0] ]) 4804 >> DISCH_TAC 4805 >> MATCH_MP_TAC FINITE_IMP_SIGMA_FINITE 4806 >> rw [extreal_of_num_def, extreal_not_infty] 4807QED 4808 4809val _ = export_theory (); 4810 4811(* References: 4812 4813 [1] Schilling, R.L.: Measures, Integrals and Martingales (Second Edition). 4814 Cambridge University Press (2017). 4815 [2] Mhamdi, T., Hasan, O., Tahar, S.: Formalization of Measure Theory and Lebesgue Integration 4816 for Probabilistic Analysis in HOL. ACM Trans. Embedded Comput. Syst. 12, 1--23 (2013). 4817 [4] Hurd, J.: Formal verification of probabilistic algorithms. University of Cambridge (2001). 4818 [5] Chung, K.L.: A Course in Probability Theory, Third Edition. Academic Press (2001). 4819 [7] Coble, A.R.: Anonymity, information, and machine-assisted proof. University of Cambridge (2010). 4820 [9] Wikipedia: https://en.wikipedia.org/wiki/Constantin_Carath%C3%A9odory 4821 *) 4822