measureScript.sml
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, PosInf] (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
21Theory measure
22Ancestors
23 prim_rec arithmetic option pair combin pred_set topology
24 iterate real metric seq transc real_sigma real_topology extreal
25 sigma_algebra
26Libs
27 pred_setLib jrhUtils numLib realLib hurdUtils tautLib
28
29val DISC_RW_KILL = DISCH_TAC >> ONCE_ASM_REWRITE_TAC [] >> POP_ASSUM K_TAC;
30val SET_SPEC_TAC = SIMP_TAC (std_ss ++ pred_setSimps.SET_SPEC_ss);
31fun METIS ths tm = prove(tm, METIS_TAC ths);
32val set_ss = std_ss ++ PRED_SET_ss;
33
34val _ = hide "S";
35
36val _ = intLib.deprecate_int ();
37val _ = ratLib.deprecate_rat ();
38
39(* ------------------------------------------------------------------------- *)
40(* Basic measure theory definitions. *)
41(* ------------------------------------------------------------------------- *)
42
43Type measure[pp] = “:'a set -> extreal”
44Type m_space[pp] = “:'a set # 'a set set # 'a measure”
45
46(* These're accessors of the triple of measure space *)
47Definition m_space_def[simp]:
48 m_space (sp :'a set, sts :('a set) set, mu :('a set) -> extreal) = sp
49End
50
51Definition measurable_sets_def[simp]:
52 measurable_sets (sp :'a set, sts :('a set) set, mu :('a set) -> extreal) = sts
53End
54
55val _ = hide "measure"; (* prim_recTheory *)
56Definition measure_def[simp]:
57 measure (sp :'a set, sts :('a set) set, mu :('a set) -> extreal) = mu
58End
59
60(* NOTE: `{} IN measurable_sets m` is not assumed, instead it must be provided by
61 definition of the system of sets. *)
62Definition positive_def:
63 positive m <=>
64 (measure m {} = 0) /\ !s. s IN measurable_sets m ==> 0 <= measure m s
65End
66
67(* NOTE: add ``s UNION t IN measurable_sets m`` into antecedents, like in the
68 case of "countably_additive_def", because otherwise this definition only works
69 with system of sets stable under (finite) union. *)
70Definition additive_def:
71 additive m =
72 !s t. s IN measurable_sets m /\ t IN measurable_sets m /\ DISJOINT s t /\
73 s UNION t IN measurable_sets m
74 ==> (measure m (s UNION t) = measure m s + measure m t)
75End
76
77(* to derive finite additivity from countable additivity for all systems *)
78Definition finite_additive_def: (* new *)
79 finite_additive m =
80 !f :num -> ('a -> bool) n.
81 (!i. i < n ==> f i IN measurable_sets m) /\
82 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) /\
83 BIGUNION (IMAGE f (count n)) IN measurable_sets m ==>
84 (measure m (BIGUNION (IMAGE f (count n))) = SIGMA (measure m o f) (count n))
85End
86
87(* NOTE: ``summable (measure m o f)`` was removed from the antecedents *)
88Definition countably_additive_def:
89 countably_additive m =
90 !f :num -> ('a -> bool).
91 f IN (UNIV -> measurable_sets m) /\
92 (!i j. i <> j ==> DISJOINT (f i) (f j)) /\
93 BIGUNION (IMAGE f UNIV) IN measurable_sets m ==>
94 (measure m (BIGUNION (IMAGE f UNIV)) = suminf (measure m o f))
95End
96
97(* NOTE: added ``s UNION t IN measurable_sets m`` into antecedents *)
98Definition subadditive_def:
99 subadditive m =
100 !s t. s IN measurable_sets m /\ t IN measurable_sets m /\
101 s UNION t IN measurable_sets m
102 ==> measure m (s UNION t) <= measure m s + measure m t
103End
104
105Definition finite_subadditive_def: (* new *)
106 finite_subadditive m =
107 !f :num -> ('a set) n.
108 (!i. i < n ==> f i IN measurable_sets m) /\
109 BIGUNION (IMAGE f (count n)) IN measurable_sets m ==>
110 measure m (BIGUNION (IMAGE f (count n))) <= SIGMA (measure m o f) (count n)
111End
112
113Definition countably_subadditive_def:
114 countably_subadditive m =
115 !f :num -> ('a set).
116 f IN (UNIV -> measurable_sets m) /\
117 BIGUNION (IMAGE f UNIV) IN measurable_sets m ==>
118 measure m (BIGUNION (IMAGE f UNIV)) <= suminf (measure m o f)
119End
120
121Definition increasing_def:
122 increasing m =
123 !s t.
124 s IN measurable_sets m /\ t IN measurable_sets m /\ s SUBSET t ==>
125 measure m s <= measure m t
126End
127
128Definition measure_space_def :
129 measure_space m <=>
130 sigma_algebra (m_space m, measurable_sets m) /\
131 positive m /\ countably_additive m
132End
133
134Theorem MEASURE_SPACE_COUNTABLY_ADDITIVE :
135 !m. measure_space m ==> countably_additive m
136Proof
137 PROVE_TAC [measure_space_def]
138QED
139
140(* ‘measurable_space m’ is the sigma_algebra of ‘measure_space m’ *)
141Overload measurable_space = “\m. (m_space m, measurable_sets m)”
142
143(* The set of measure-preserving measurable mappings.
144 NOTE: ``measure_space m1 /\ measure_space m2`` was removed. *)
145Definition measure_preserving_def:
146 measure_preserving m1 m2 =
147 {f |
148 f IN measurable (m_space m1, measurable_sets m1) (m_space m2, measurable_sets m2) /\
149 !s.
150 s IN measurable_sets m2 ==>
151 (measure m1 ((PREIMAGE f s) INTER (m_space m1)) = measure m2 s)}
152End
153
154(* This substitutes HVG's ‘measure_of’ methodology: instead of writing things like
155 ‘measure_of m1 = measure_of m2’ now we write ‘measure_space_eq m1 m2’ instead.
156 *)
157Definition measure_space_eq_def :
158 measure_space_eq m1 m2 =
159 (m_space m1 = m_space m2 /\
160 measurable_sets m1 = measurable_sets m2 /\
161 (!s. s IN measurable_sets m1 ==> (measure m1 s = measure m2 s)))
162End
163
164(* ------------------------------------------------------------------------- *)
165(* Basic measure theory theorems *)
166(* ------------------------------------------------------------------------- *)
167
168Theorem positive_not_infty:
169 !m. positive m ==>
170 (!s. s IN measurable_sets m ==> measure m s <> NegInf)
171Proof
172 RW_TAC std_ss [positive_def]
173 >> METIS_TAC [lt_infty, extreal_of_num_def, extreal_not_infty, lte_trans]
174QED
175
176(* added `u IN measurable_sets m` into antecedents *)
177Theorem SUBADDITIVE:
178 !m s t u.
179 subadditive m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
180 u IN measurable_sets m /\ (u = s UNION t) ==>
181 measure m u <= measure m s + measure m t
182Proof
183 RW_TAC std_ss [subadditive_def]
184 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
185QED
186
187(* added `u IN measurable_sets m` into antecedents *)
188Theorem ADDITIVE:
189 !m s t u.
190 additive m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
191 DISJOINT s t /\ u IN measurable_sets m /\ (u = s UNION t) ==>
192 (measure m u = measure m s + measure m t)
193Proof
194 RW_TAC std_ss [additive_def]
195 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
196QED
197
198(* removed `summable (measure m o f)` *)
199Theorem COUNTABLY_SUBADDITIVE:
200 !m f s.
201 countably_subadditive m /\ f IN (UNIV -> measurable_sets m) /\
202 (s = BIGUNION (IMAGE f UNIV)) /\
203 (s IN measurable_sets m) ==>
204 (measure m s <= suminf (measure m o f))
205Proof
206 PROVE_TAC [countably_subadditive_def]
207QED
208
209Theorem ADDITIVE_SUM:
210 !m f n.
211 algebra (m_space m, measurable_sets m) /\ positive m /\ additive m /\
212 f IN (UNIV -> measurable_sets m) /\
213 (!m n : num. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
214 (SIGMA (measure m o f) (count n) =
215 measure m (BIGUNION (IMAGE f (count n))))
216Proof
217 RW_TAC std_ss [IN_FUNSET, IN_UNIV]
218 >> Induct_on `n`
219 >- (RW_TAC std_ss [COUNT_ZERO,EXTREAL_SUM_IMAGE_EMPTY,IMAGE_EMPTY,BIGUNION_EMPTY]
220 >> PROVE_TAC [positive_def])
221 >> `FINITE (count n)` by PROVE_TAC [FINITE_COUNT]
222 >> `!x. (measure m o f) x <> NegInf` by METIS_TAC [positive_not_infty,o_DEF]
223 >> RW_TAC std_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT,EXTREAL_SUM_IMAGE_PROPERTY]
224 >> `(IMAGE f (count n)) SUBSET measurable_sets m` by METIS_TAC [SUBSET_DEF,IN_IMAGE]
225 >> `measurable_sets m = subsets (m_space m,measurable_sets m)`
226 by (METIS_TAC [subsets_def,measurable_sets_def])
227 >> `BIGUNION (IMAGE f (count n)) IN measurable_sets m`
228 by (RW_TAC std_ss []
229 >> METIS_TAC [ALGEBRA_FINITE_UNION,IMAGE_FINITE])
230 >> `DISJOINT (f n) (BIGUNION (IMAGE f (count n)))`
231 by (RW_TAC std_ss [DISJOINT_BIGUNION,IN_IMAGE,IN_COUNT]
232 >> `x <> n` by RW_TAC real_ss []
233 >> METIS_TAC [])
234 >> `(count n) DELETE n = count n` by RW_TAC real_ss [EXTENSION,IN_DELETE,IN_COUNT]
235 >> POP_ORW >> art []
236 >> MATCH_MP_TAC (GSYM ADDITIVE)
237 >> METIS_TAC [ALGEBRA_UNION]
238QED
239
240Theorem INCREASING:
241 !m s t.
242 increasing m /\ s SUBSET t /\ s IN measurable_sets m /\
243 t IN measurable_sets m ==>
244 measure m s <= measure m t
245Proof
246 PROVE_TAC [increasing_def]
247QED
248
249(* This result holds as long as m is a ring, cf. RING_ADDITIVE_INCREASING *)
250Theorem ADDITIVE_INCREASING:
251 !m. algebra (m_space m, measurable_sets m) /\ positive m /\ additive m ==>
252 increasing m
253Proof
254 RW_TAC std_ss [increasing_def, positive_def]
255 >> Suff
256 `?u. u IN measurable_sets m /\ (measure m t = measure m s + measure m u)`
257 >- METIS_TAC [le_addr_imp]
258 >> Q.EXISTS_TAC `t DIFF s`
259 >> STRONG_CONJ_TAC >- PROVE_TAC [ALGEBRA_DIFF, subsets_def]
260 >> RW_TAC std_ss []
261 >> MATCH_MP_TAC ADDITIVE
262 >> RW_TAC std_ss [DISJOINT_DEF,IN_DIFF,IN_UNION,EXTENSION,IN_INTER,NOT_IN_EMPTY]
263 >> PROVE_TAC [SUBSET_DEF]
264QED
265
266Theorem FINITE_ADDITIVE:
267 !m s f n.
268 finite_additive m /\ (!i. i < n ==> f i IN measurable_sets m)
269 /\ (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) /\
270 (s = BIGUNION (IMAGE f (count n))) /\ s IN measurable_sets m ==>
271 (SIGMA (measure m o f) (count n) = measure m s)
272Proof
273 RW_TAC std_ss [finite_additive_def]
274 >> MATCH_MP_TAC EQ_SYM
275 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
276QED
277
278Theorem FINITE_ADDITIVE_ALT:
279 !m s c.
280 positive m /\ finite_additive m /\ c SUBSET measurable_sets m /\
281 FINITE c /\ disjoint c /\ BIGUNION c IN measurable_sets m ==>
282 (SIGMA (measure m) c = measure m (BIGUNION c))
283Proof
284 RW_TAC std_ss [finite_additive_def]
285 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
286 (CONJ (ASSUME ``FINITE (c :'a set set)``)
287 (ASSUME ``disjoint (c :'a set set)``)))
288 >> ASM_REWRITE_TAC []
289 >> Know `measure m (BIGUNION (IMAGE f (count n))) = SIGMA (measure m o f) (count n)`
290 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
291 CONJ_TAC >- PROVE_TAC [SUBSET_DEF] \\
292 PROVE_TAC [])
293 >> Rewr'
294 >> irule EXTREAL_SUM_IMAGE_IMAGE
295 >> REWRITE_TAC [FINITE_COUNT, IN_COUNT, IN_IMAGE]
296 >> CONJ_TAC
297 >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> MATCH_MP_TAC pos_not_neginf >> art [] \\
298 `f x' IN measurable_sets m` by PROVE_TAC [SUBSET_DEF] \\
299 fs [positive_def])
300 >> MATCH_MP_TAC INJ_IMAGE
301 >> Q.EXISTS_TAC `c`
302 >> RW_TAC std_ss [INJ_DEF, IN_COUNT]
303 >> METIS_TAC []
304QED
305
306Theorem FINITE_SUBADDITIVE:
307 !m s f n.
308 finite_subadditive m /\ (!i. i < n ==> f i IN measurable_sets m) /\
309 (s = BIGUNION (IMAGE f (count n))) /\ s IN measurable_sets m ==>
310 measure m s <= SIGMA (measure m o f) (count n)
311Proof
312 RW_TAC std_ss [finite_subadditive_def]
313 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
314QED
315
316Theorem FINITE_SUBADDITIVE_ALT:
317 !m c.
318 positive m /\ finite_subadditive m /\ c SUBSET measurable_sets m /\
319 FINITE c /\ disjoint c /\ BIGUNION c IN measurable_sets m ==>
320 measure m (BIGUNION c) <= SIGMA (measure m) c
321Proof
322 RW_TAC std_ss [finite_subadditive_def]
323 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
324 (CONJ (ASSUME ``FINITE (c :'a set set)``)
325 (ASSUME ``disjoint (c :'a set set)``)))
326 >> ASM_REWRITE_TAC []
327 >> Know `measure m (BIGUNION (IMAGE f (count n))) <= SIGMA (measure m o f) (count n)`
328 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
329 CONJ_TAC >- PROVE_TAC [SUBSET_DEF] \\
330 PROVE_TAC [])
331 >> DISCH_TAC
332 >> Suff `SIGMA (measure m) (IMAGE f (count n)) = SIGMA (measure m o f) (count n)`
333 >- METIS_TAC []
334 >> irule EXTREAL_SUM_IMAGE_IMAGE
335 >> REWRITE_TAC [FINITE_COUNT, IN_COUNT, IN_IMAGE]
336 >> CONJ_TAC
337 >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> MATCH_MP_TAC pos_not_neginf >> art [] \\
338 `f x' IN measurable_sets m` by PROVE_TAC [SUBSET_DEF] \\
339 fs [positive_def])
340 >> MATCH_MP_TAC INJ_IMAGE
341 >> Q.EXISTS_TAC `c`
342 >> RW_TAC std_ss [INJ_DEF, IN_COUNT]
343 >> METIS_TAC []
344QED
345
346Theorem COUNTABLY_ADDITIVE:
347 !m s f.
348 countably_additive m /\ f IN (UNIV -> measurable_sets m)
349 /\ (!i j. i <> j ==> DISJOINT (f i) (f j)) /\
350 (s = BIGUNION (IMAGE f UNIV)) /\ s IN measurable_sets m ==>
351 (suminf (measure m o f) = measure m s)
352Proof
353 RW_TAC std_ss []
354 >> PROVE_TAC [countably_additive_def]
355QED
356
357Theorem COUNTABLY_ADDITIVE_ADDITIVE_lemma[local]:
358 !m s t. {} IN measurable_sets m /\ (measure m {} = 0) /\
359 (!s. s IN measurable_sets m ==> 0 <= measure m s) /\
360 s IN measurable_sets m /\ t IN measurable_sets m ==>
361 (suminf (measure m o (\n. if n = 0 then s else if n = 1 then t else {})) =
362 measure m s + measure m t)
363Proof
364 rpt STRIP_TAC
365 >> `FINITE (count 2)` by RW_TAC std_ss [FINITE_COUNT]
366 >> `!n. FINITE ((count n) DIFF (count 2))` by METIS_TAC [FINITE_COUNT, FINITE_DIFF]
367 >> `!n:num. (2 <= n) ==>
368 (SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) (count n) =
369 SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) (count 2))`
370 by (Q.ABBREV_TAC `f = (\n:num. measure m (if n = 0 then s else if n = 1 then t else {}))`
371 >> RW_TAC std_ss []
372 >> `count 2 SUBSET (count n)` by RW_TAC real_ss [SUBSET_DEF,IN_COUNT]
373 >> `(count n) = (count 2) UNION ((count n) DIFF (count 2))`
374 by RW_TAC std_ss [UNION_DIFF]
375 >> `DISJOINT (count 2) ((count n) DIFF (count 2))`
376 by RW_TAC real_ss [EXTENSION,IN_DISJOINT, IN_COUNT,IN_DIFF]
377 >> `!n. f n <> NegInf`
378 by (Q.UNABBREV_TAC `f`
379 >> RW_TAC std_ss []
380 >> METIS_TAC [positive_def,positive_not_infty,extreal_of_num_def,
381 extreal_not_infty])
382 >> (MP_TAC o (Q.SPECL [`count 2`,`count n DIFF count 2`]) o
383 (INST_TYPE [alpha |-> ``:num``])) EXTREAL_SUM_IMAGE_DISJOINT_UNION
384 >> FULL_SIMP_TAC std_ss []
385 >> Suff `SIGMA f (count n DIFF count 2) = 0` >- METIS_TAC [add_rzero]
386 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_0
387 >> RW_TAC std_ss [IN_COUNT,IN_DIFF,NOT_LESS]
388 >> Q.UNABBREV_TAC `f`
389 >> RW_TAC real_ss [])
390 >> `SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {})) (count 2) =
391 measure m s + measure m t`
392 by (`count 2 = (1:num) INSERT {0}`
393 by METIS_TAC [TWO,ONE,COUNT_SUC,EXTENSION, IN_INSERT,COUNT_ZERO]
394 >> `~(0=1:num)` by RW_TAC real_ss []
395 >> `{0:num} DELETE 1 = {0}` by METIS_TAC [DELETE_NON_ELEMENT,IN_SING]
396 >> (MP_TAC o (Q.SPEC `1:num` o REWRITE_RULE [FINITE_SING]) o
397 (Q.SPECL [`(measure m o (\n. if n = 0 then s else if n = 1 then t else {}))`,
398 `{0:num}`]))
399 (INST_TYPE [``:'a`` |-> ``:num`` ] EXTREAL_SUM_IMAGE_PROPERTY)
400 >> RW_TAC real_ss [EXTREAL_SUM_IMAGE_SING,o_DEF]
401 >> `measure m s + measure m t = measure m t + measure m s`
402 by METIS_TAC [positive_def,positive_not_infty,add_comm]
403 >> POP_ORW
404 >> POP_ASSUM MATCH_MP_TAC
405 >> DISJ1_TAC
406 >> RW_TAC real_ss [] >> METIS_TAC [positive_def,positive_not_infty,
407 add_comm,extreal_of_num_def,extreal_not_infty])
408 (* stage work *)
409 >> Know `!i:num. 0 <= (measure m o (\n. if n = 0 then s else if n = 1
410 then t else {})) i`
411 >- RW_TAC std_ss [o_DEF]
412 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr'
413 >> RW_TAC std_ss [sup_eq', o_DEF, IN_IMAGE, IN_UNIV]
414 >- (Cases_on `2 <= n` >- METIS_TAC [le_refl] \\
415 `(n = 0) \/ (n = 1)` by RW_TAC real_ss []
416 >- RW_TAC real_ss [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY, le_add] \\
417 `count 1 = {0}` by RW_TAC real_ss [EXTENSION, IN_COUNT, IN_SING] \\
418 FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_SING, le_addr_imp])
419 >> Suff `(measure m s + measure m t) IN
420 IMAGE (\n. SIGMA (\n. measure m (if n = 0 then s else if n = 1 then t else {}))
421 (count n)) univ(:num)`
422 >- METIS_TAC [IN_DEF]
423 >> RW_TAC std_ss [IN_IMAGE, IN_UNIV]
424 >> Q.EXISTS_TAC `2`
425 >> METIS_TAC []
426QED
427
428(* removed `algebra (m_space m, measurable_sets m)` from antecedents,
429 added `{} IN measurable_sets m` into antecedents. *)
430Theorem COUNTABLY_ADDITIVE_ADDITIVE:
431 !m. {} IN measurable_sets m /\ positive m /\ countably_additive m ==> additive m
432Proof
433 RW_TAC std_ss [additive_def, positive_def, countably_additive_def]
434 >> Q.PAT_X_ASSUM `!f. P f`
435 (MP_TAC o Q.SPEC `\n : num. if n = 0 then s else if n = 1 then t else {}`)
436 >> Know
437 `BIGUNION
438 (IMAGE (\n : num. (if n = 0 then s else (if n = 1 then t else {})))
439 UNIV) =
440 s UNION t`
441 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION]
442 >> EQ_TAC >- PROVE_TAC [NOT_IN_EMPTY]
443 >> Know `~(1 = (0:num))` >- DECIDE_TAC
444 >> RW_TAC std_ss [] >- PROVE_TAC []
445 >> Q.EXISTS_TAC `t`
446 >> RW_TAC std_ss []
447 >> Q.EXISTS_TAC `1`
448 >> RW_TAC std_ss []
449 >> PROVE_TAC [])
450 >> Rewr
451 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV]
452 >> `!n:num. (if n = 0 then s else if n = 1 then t else {}) IN measurable_sets m`
453 by METIS_TAC []
454 >> `!m n:num. m <> n ==> DISJOINT (if m = 0 then s else if m = 1 then t else {})
455 (if n = 0 then s else if n = 1 then t else {})`
456 by RW_TAC real_ss [DISJOINT_EMPTY, DISJOINT_SYM]
457 >> FULL_SIMP_TAC std_ss []
458 >> NTAC 5 (POP_ASSUM K_TAC)
459 (* now use the lemma instead *)
460 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE_lemma >> art []
461QED
462
463Theorem COUNTABLY_SUBADDITIVE_SUBADDITIVE :
464 !m. {} IN measurable_sets m /\ positive m /\ countably_subadditive m ==>
465 subadditive m
466Proof
467 RW_TAC std_ss [subadditive_def, positive_def, countably_subadditive_def]
468 >> Q.PAT_X_ASSUM `!f. P f`
469 (MP_TAC o Q.SPEC `\n : num. if n = 0 then s else if n = 1 then t else {}`)
470 >> Know
471 `BIGUNION
472 (IMAGE (\n : num. (if n = 0 then s else (if n = 1 then t else {}))) UNIV) =
473 s UNION t`
474 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION]
475 >> EQ_TAC >- PROVE_TAC [NOT_IN_EMPTY]
476 >> Know `~(1 = (0:num))` >- DECIDE_TAC
477 >> RW_TAC std_ss [] >- PROVE_TAC []
478 >> Q.EXISTS_TAC `t`
479 >> RW_TAC std_ss []
480 >> Q.EXISTS_TAC `1`
481 >> RW_TAC std_ss []
482 >> PROVE_TAC [])
483 >> Rewr
484 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV]
485 >> `!n:num. (if n = 0 then s else if n = 1 then t else {}) IN measurable_sets m`
486 by METIS_TAC []
487 >> fs []
488 >> POP_ASSUM K_TAC
489 >> Suff `suminf (measure m o (\n. if n = 0 then s else if n = 1 then t else {})) =
490 measure m s + measure m t` >- METIS_TAC []
491 >> NTAC 2 (POP_ASSUM K_TAC)
492 (* now use the lemma instead *)
493 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE_lemma >> art []
494QED
495
496Theorem COUNTABLY_ADDITIVE_FINITE_ADDITIVE_lemma[local]:
497 !m f n. {} IN measurable_sets m /\ (measure m {} = 0) /\
498 (!s. s IN measurable_sets m ==> 0 <= measure m s) /\
499 (!i. i < n ==> f i IN measurable_sets m) ==>
500 (suminf (measure m o (\i. if i < n then f i else {})) = SIGMA (measure m o f) (count n))
501Proof
502 rpt STRIP_TAC
503 >> Know `!j. 0 <= (measure m o (\i. if i < n then f i else {})) j`
504 >- RW_TAC std_ss [o_DEF, le_refl]
505 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr
506 >> RW_TAC std_ss [sup_eq, o_DEF, IN_IMAGE, IN_UNIV]
507 >- (`y IN IMAGE (\n'. SIGMA (\i. measure m (if i < n then f i else {})) (count n')) univ(:num)`
508 by METIS_TAC [IN_DEF] \\
509 FULL_SIMP_TAC std_ss [IN_IMAGE, IN_UNIV] \\
510 Cases_on `n <= n'`
511 >- (Know `SIGMA (\i. measure m (if i < n then f i else {})) (count n') =
512 SIGMA (\i. measure m (if i < n then f i else {})) (count n)`
513 >- (Q.ABBREV_TAC `g = (\i:num. measure m (if i < n then f i else {}))` \\
514 `count n SUBSET count n'` by RW_TAC arith_ss [SUBSET_DEF, IN_COUNT] \\
515 `count n UNION (count n' DIFF count n) = count n'` by RW_TAC std_ss [UNION_DIFF] \\
516 (MP_TAC o (Q.SPECL [`count n`,`count n' DIFF count n`]) o
517 (INST_TYPE [alpha |-> ``:num``])) EXTREAL_SUM_IMAGE_DISJOINT_UNION \\
518 `DISJOINT (count n) (count n' DIFF count n)`
519 by RW_TAC real_ss [EXTENSION, IN_DISJOINT, IN_COUNT, IN_DIFF] \\
520 `FINITE (count n)` by PROVE_TAC [FINITE_COUNT] \\
521 `FINITE (count n' DIFF count n)` by PROVE_TAC [FINITE_COUNT, FINITE_DIFF] \\
522 `!n. g n <> NegInf`
523 by (Q.UNABBREV_TAC `g` >> RW_TAC std_ss [] \\
524 METIS_TAC [positive_def, positive_not_infty, extreal_of_num_def,
525 extreal_not_infty]) \\
526 FULL_SIMP_TAC std_ss [] \\
527 rpt STRIP_TAC \\
528 Suff `SIGMA g (count n' DIFF count n) = 0` >- METIS_TAC [add_rzero] \\
529 MATCH_MP_TAC EXTREAL_SUM_IMAGE_0 \\
530 RW_TAC std_ss [IN_COUNT, IN_DIFF, NOT_LESS] \\
531 Q.UNABBREV_TAC `g` >> RW_TAC arith_ss []) \\
532 Rewr \\
533 irule EXTREAL_SUM_IMAGE_MONO \\
534 RW_TAC std_ss [le_refl, IN_COUNT, FINITE_COUNT] \\
535 DISJ1_TAC \\
536 RW_TAC arith_ss [IN_COUNT] >> PROVE_TAC [le_not_infty]) \\
537 Know `SIGMA (\x. measure m (f x)) (count n) =
538 SIGMA (\x. if x IN count n then (\x. measure m (f x)) x else 0) (count n)`
539 >- (irule EXTREAL_SUM_IMAGE_IN_IF \\
540 REWRITE_TAC [FINITE_COUNT] >> DISJ1_TAC >> PROVE_TAC [IN_COUNT, le_not_infty]) \\
541 Rewr >> SIMP_TAC std_ss [IN_COUNT] \\
542 `(\i. measure m (if i < n then f i else {})) = (\x. if x < n then measure m (f x) else 0)`
543 by METIS_TAC [] >> POP_ORW \\
544 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> REWRITE_TAC [FINITE_COUNT] \\
545 CONJ_TAC >- RW_TAC arith_ss [SUBSET_DEF, IN_COUNT] \\
546 RW_TAC std_ss [IN_COUNT])
547 (* SIGMA (\x. measure m (f x)) (count n) <= y *)
548 >> Know `SIGMA (\x. measure m (f x)) (count n) =
549 SIGMA (\i. measure m (if i < n then f i else {})) (count n)`
550 >- (Know `SIGMA (\x. measure m (f x)) (count n) =
551 SIGMA (\x. if x IN count n then (\x. measure m (f x)) x else 0) (count n)`
552 >- (irule EXTREAL_SUM_IMAGE_IN_IF \\
553 REWRITE_TAC [FINITE_COUNT] >> DISJ1_TAC >> PROVE_TAC [IN_COUNT, le_not_infty]) \\
554 Rewr >> SIMP_TAC std_ss [IN_COUNT] \\
555 `(\x. if x < n then measure m (f x) else 0) = (\i. measure m (if i < n then (f i) else {}))`
556 by METIS_TAC [] >> POP_ORW \\
557 REWRITE_TAC [])
558 >> Rewr
559 >> POP_ASSUM MATCH_MP_TAC
560 >> Suff `(SIGMA (\i. measure m (if i < n then f i else {})) (count n)) IN
561 (IMAGE (\n'. SIGMA (\i. measure m (if i < n then f i else {})) (count n')) univ(:num))`
562 >- METIS_TAC [IN_APP]
563 >> SIMP_TAC std_ss [IN_IMAGE, IN_UNIV]
564 >> Q.EXISTS_TAC `n`
565 >> METIS_TAC []
566QED
567
568Theorem COUNTABLY_ADDITIVE_FINITE_ADDITIVE :
569 !m. {} IN measurable_sets m /\ positive m /\ countably_additive m ==>
570 finite_additive m
571Proof
572 RW_TAC std_ss [positive_def, countably_additive_def, finite_additive_def,
573 IN_FUNSET, IN_UNIV]
574 >> Q.PAT_X_ASSUM `!f. P f` (MP_TAC o Q.SPEC `\i :num. if i < n then (f i) else {}`)
575 >> Know
576 `BIGUNION (IMAGE (\i :num. if i < n then (f i) else {}) UNIV) =
577 BIGUNION (IMAGE f (count n))`
578 >- (RW_TAC arith_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION, IN_COUNT] \\
579 EQ_TAC >> rpt STRIP_TAC >|
580 [ (* goal 1 (of 2) *)
581 Q.EXISTS_TAC `s` \\
582 CONJ_TAC >- (POP_ASSUM K_TAC >> art []) \\
583 Q.EXISTS_TAC `i` >> PROVE_TAC [NOT_IN_EMPTY],
584 (* goal 2 (of 2) *)
585 Q.EXISTS_TAC `s` \\
586 CONJ_TAC >- (NTAC 2 (POP_ASSUM K_TAC) >> art []) \\
587 Q.EXISTS_TAC `x'` >> PROVE_TAC [NOT_IN_EMPTY] ]) >> Rewr
588 >> RW_TAC std_ss []
589 (* `{} IN measurable_sets m` is used here *)
590 >> `!i:num. (if i < n then (f i) else {}) IN measurable_sets m` by METIS_TAC []
591 >> `!i j:num. i <> j ==> DISJOINT (if i < n then (f i) else {})
592 (if j < n then (f j) else {})`
593 by RW_TAC real_ss [DISJOINT_EMPTY,DISJOINT_SYM]
594 >> FULL_SIMP_TAC std_ss []
595 >> NTAC 5 (POP_ASSUM K_TAC)
596 (* now use the lemma instead *)
597 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE_lemma >> art []
598QED
599
600Theorem COUNTABLY_SUBADDITIVE_FINITE_SUBADDITIVE :
601 !m. {} IN measurable_sets m /\ positive m /\ countably_subadditive m ==>
602 finite_subadditive m
603Proof
604 RW_TAC std_ss [positive_def, countably_subadditive_def, finite_subadditive_def,
605 IN_FUNSET, IN_UNIV]
606 >> Q.PAT_X_ASSUM `!f. P f` (MP_TAC o Q.SPEC `\i :num. if i < n then (f i) else {}`)
607 >> Know
608 `BIGUNION (IMAGE (\i :num. if i < n then (f i) else {}) UNIV) =
609 BIGUNION (IMAGE f (count n))`
610 >- (RW_TAC arith_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_UNION, IN_COUNT] \\
611 EQ_TAC >> rpt STRIP_TAC >|
612 [ (* goal 1 (of 2) *)
613 Q.EXISTS_TAC `s` \\
614 CONJ_TAC >- (POP_ASSUM K_TAC >> art []) \\
615 Q.EXISTS_TAC `i` >> PROVE_TAC [NOT_IN_EMPTY],
616 (* goal 2 (of 2) *)
617 Q.EXISTS_TAC `s` \\
618 CONJ_TAC >- (NTAC 2 (POP_ASSUM K_TAC) >> art []) \\
619 Q.EXISTS_TAC `x'` >> PROVE_TAC [NOT_IN_EMPTY] ]) >> Rewr
620 >> RW_TAC std_ss []
621 (* `{} IN measurable_sets m` is used here *)
622 >> `!x:num. (if x < n then (f x) else {}) IN measurable_sets m` by METIS_TAC []
623 >> FULL_SIMP_TAC std_ss []
624 >> POP_ASSUM K_TAC
625 >> Suff `suminf (measure m o (\i. if i < n then f i else {})) = SIGMA (measure m o f) (count n)`
626 >- METIS_TAC []
627 >> NTAC 2 (POP_ASSUM K_TAC)
628 (* now use the lemma instead *)
629 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE_lemma >> art []
630QED
631
632Theorem MEASURE_DOWN:
633 !m0 m1.
634 sigma_algebra (m_space m0,measurable_sets m0) /\
635 measurable_sets m0 SUBSET measurable_sets m1 /\
636 (measure m0 = measure m1) /\ measure_space m1 ==>
637 measure_space m0
638Proof
639 RW_TAC std_ss [measure_space_def, positive_def, SUBSET_DEF,
640 countably_additive_def, IN_FUNSET, IN_UNIV]
641QED
642
643(* added ``measure m s < PosInf`` into antecedents, cf. MEASURE_SPACE_FINITE_DIFF *)
644Theorem MEASURE_COMPL:
645 !m s.
646 measure_space m /\ s IN measurable_sets m /\
647 measure m s < PosInf ==>
648 (measure m (m_space m DIFF s) = measure m (m_space m) - measure m s)
649Proof
650 RW_TAC std_ss []
651 >> Know `(measure m (m_space m DIFF s) = measure m (m_space m) - measure m s) <=>
652 (measure m (m_space m DIFF s) + measure m s = measure m (m_space m))`
653 >- (MATCH_MP_TAC eq_sub_ladd \\
654 `positive m` by PROVE_TAC [measure_space_def] \\
655 PROVE_TAC [positive_not_infty, lt_infty])
656 >> DISCH_THEN (REWRITE_TAC o wrap)
657 >> MATCH_MP_TAC EQ_SYM
658 >> MATCH_MP_TAC ADDITIVE
659 >> Q.PAT_X_ASSUM `measure_space m` MP_TAC
660 >> RW_TAC std_ss [measure_space_def, sigma_algebra_def, DISJOINT_DEF,
661 EXTENSION, IN_DIFF, IN_UNIV, IN_UNION, IN_INTER,
662 NOT_IN_EMPTY]
663 >> PROVE_TAC [COUNTABLY_ADDITIVE_ADDITIVE, ALGEBRA_COMPL, subsets_def, space_def,
664 algebra_def, subset_class_def, SUBSET_DEF, ALGEBRA_SPACE, positive_def]
665QED
666
667Theorem MEASURE_EMPTY:
668 !m. measure_space m ==> (measure m {} = 0)
669Proof
670 RW_TAC std_ss [measure_space_def, positive_def]
671QED
672
673Theorem SIGMA_SUBSET_MEASURABLE_SETS:
674 !a m.
675 measure_space m /\ a SUBSET measurable_sets m ==>
676 subsets (sigma (m_space m) a) SUBSET measurable_sets m
677Proof
678 RW_TAC std_ss [measure_space_def]
679 >> MATCH_MP_TAC SIGMA_PROPERTY
680 >> RW_TAC std_ss [IN_INTER, SUBSET_INTER]
681 >> PROVE_TAC [SIGMA_ALGEBRA, space_def, subsets_def]
682QED
683
684Theorem MEASURE_COUNTABLY_ADDITIVE:
685 !m s f.
686 measure_space m /\ f IN (UNIV -> measurable_sets m) /\
687 (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) /\
688 (s = BIGUNION (IMAGE f UNIV)) ==>
689 (suminf (measure m o f) = measure m s)
690Proof
691 RW_TAC std_ss []
692 >> MATCH_MP_TAC COUNTABLY_ADDITIVE
693 >> RW_TAC std_ss []
694 >- PROVE_TAC [measure_space_def]
695 >> (MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o
696 Q.SPEC `(m_space m, measurable_sets m)`) SIGMA_ALGEBRA_COUNTABLE_UNION
697 >> CONJ_TAC >- PROVE_TAC [measure_space_def]
698 >> Q.PAT_X_ASSUM `f IN P` MP_TAC
699 >> RW_TAC std_ss [COUNTABLE_IMAGE_NUM, SUBSET_DEF, IN_IMAGE, IN_UNIV,
700 IN_FUNSET]
701 >> PROVE_TAC []
702QED
703
704Theorem MEASURE_SPACE_ADDITIVE:
705 !m. measure_space m ==> additive m
706Proof
707 RW_TAC std_ss []
708 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE
709 >> PROVE_TAC [measure_space_def, SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY, subsets_def]
710QED
711
712Theorem MEASURE_ADDITIVE:
713 !m s t u.
714 measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
715 DISJOINT s t /\ (u = s UNION t) ==>
716 (measure m u = measure m s + measure m t)
717Proof
718 RW_TAC std_ss []
719 >> MATCH_MP_TAC ADDITIVE
720 >> RW_TAC std_ss [MEASURE_SPACE_ADDITIVE]
721 >> PROVE_TAC [measure_space_def, SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_UNION, subsets_def]
722QED
723
724(* The following theorems were merged from measure_hvgScript.sml *)
725Theorem MEASURE_SPACE_INCREASING: !m. measure_space m ==> increasing m
726Proof
727 RW_TAC real_ss []
728 >> `additive m` by RW_TAC real_ss [MEASURE_SPACE_ADDITIVE]
729 >> FULL_SIMP_TAC real_ss [measure_space_def,sigma_algebra_def,ADDITIVE_INCREASING]
730QED
731
732Theorem MEASURE_INCREASING :
733 !m s t. measure_space m /\ s SUBSET t /\
734 s IN measurable_sets m /\ t IN measurable_sets m ==>
735 measure m s <= measure m t
736Proof
737 rpt STRIP_TAC
738 >> MATCH_MP_TAC INCREASING >> art []
739 >> MATCH_MP_TAC MEASURE_SPACE_INCREASING >> art []
740QED
741
742Theorem MEASURE_SPACE_POSITIVE: !m. measure_space m ==> positive m
743Proof
744 PROVE_TAC [measure_space_def]
745QED
746
747Theorem MEASURE_POSITIVE :
748 !m s. measure_space m /\ s IN measurable_sets m ==> 0 <= measure m s
749Proof
750 rpt STRIP_TAC
751 >> ‘positive m’ by PROVE_TAC [MEASURE_SPACE_POSITIVE]
752 >> fs [positive_def]
753QED
754
755Theorem measure_space_eq :
756 !m1 m2. measure_space m1 /\
757 (m_space m2 = m_space m1) /\
758 (measurable_sets m2 = measurable_sets m1) /\
759 (!s. s IN measurable_sets m2 ==> (measure m2 s = measure m1 s)) ==>
760 measure_space m2
761Proof
762 rpt STRIP_TAC
763 >> RW_TAC std_ss [measure_space_def]
764 >| [ (* goal 1 (of 3) *)
765 fs [measure_space_def],
766 (* goal 2 (of 3) *)
767 IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
768 rw [positive_def]
769 >- (‘{} IN measurable_sets m1’ by
770 fs [measure_space_def, sigma_algebra_def, algebra_def] \\
771 fs [positive_def]) \\
772 fs [positive_def],
773 (* goal 3 (of 3) *)
774 rw [countably_additive_def, IN_FUNSET, IN_UNIV, o_DEF] \\
775 fs [measure_space_def, countably_additive_def, IN_FUNSET, IN_UNIV, o_DEF] ]
776QED
777
778Theorem measure_space_eq' :
779 !m1 m2. measure_space m1 /\ measure_space_eq m1 m2 ==> measure_space m2
780Proof
781 RW_TAC std_ss [measure_space_eq_def]
782 >> MATCH_MP_TAC measure_space_eq
783 >> Q.EXISTS_TAC ‘m1’ >> rw []
784QED
785
786Theorem measure_space_eq_comm :
787 !m1 m2. measure_space_eq m1 m2 ==> measure_space_eq m2 m1
788Proof
789 RW_TAC std_ss [measure_space_eq_def]
790QED
791
792Theorem measure_space_eq_trans :
793 !m1 m2 m3. measure_space_eq m1 m2 /\ measure_space_eq m2 m3 ==>
794 measure_space_eq m1 m3
795Proof
796 RW_TAC std_ss [measure_space_eq_def]
797QED
798
799Theorem MEASURE_SPACE_INTER:
800 !m s t. (measure_space m) /\ (s IN measurable_sets m) /\ (t IN measurable_sets m) ==>
801 (s INTER t IN measurable_sets m)
802Proof
803 METIS_TAC [measure_space_def,sigma_algebra_def,subsets_def,
804 (REWRITE_RULE [subsets_def] (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER))]
805QED
806
807Theorem MEASURE_SPACE_UNION:
808 !m s t. (measure_space m) /\ (s IN measurable_sets m) /\ (t IN measurable_sets m) ==>
809 (s UNION t IN measurable_sets m)
810Proof
811 METIS_TAC [measure_space_def,sigma_algebra_def,subsets_def,
812 (REWRITE_RULE [subsets_def] (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_UNION))]
813QED
814
815Theorem MEASURE_SPACE_DIFF:
816 !m s t. (measure_space m) /\ (s IN measurable_sets m) /\ (t IN measurable_sets m) ==>
817 (s DIFF t IN measurable_sets m)
818Proof
819 METIS_TAC [measure_space_def,sigma_algebra_def,subsets_def,
820 (REWRITE_RULE [subsets_def] (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_DIFF))]
821QED
822
823Theorem MEASURE_SPACE_MSPACE_MEASURABLE :
824 !m. measure_space m ==> (m_space m) IN measurable_sets m
825Proof
826 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def, subsets_def, space_def]
827 >> METIS_TAC [DIFF_EMPTY]
828QED
829
830Theorem MEASURE_SPACE_SPACE = MEASURE_SPACE_MSPACE_MEASURABLE
831
832Theorem MEASURE_SPACE_COMPL :
833 !m s. measure_space m /\ s IN measurable_sets m ==>
834 (m_space m) DIFF s IN measurable_sets m
835Proof
836 rpt STRIP_TAC
837 >> MATCH_MP_TAC MEASURE_SPACE_DIFF >> art []
838 >> MATCH_MP_TAC MEASURE_SPACE_SPACE >> art []
839QED
840
841Theorem MEASURE_SPACE_BIGUNION :
842 !m s. measure_space m /\ (!n:num. s n IN measurable_sets m) ==>
843 (BIGUNION (IMAGE s UNIV) IN measurable_sets m)
844Proof
845 RW_TAC std_ss []
846 >> (MP_TAC o REWRITE_RULE [subsets_def,space_def,IN_UNIV,IN_FUNSET] o
847 (Q.SPEC `(m_space m,measurable_sets m)`)) SIGMA_ALGEBRA_FN
848 >> METIS_TAC [measure_space_def]
849QED
850
851Theorem MEASURE_SPACE_FINITE_UNION :
852 !m f n. measure_space m /\ (!i. i < n ==> f i IN measurable_sets m) ==>
853 BIGUNION (IMAGE f (count n)) IN measurable_sets m
854Proof
855 rpt STRIP_TAC
856 >> ‘sigma_algebra (measurable_space m)’ by PROVE_TAC [measure_space_def]
857 >> MP_TAC (Q.SPECL [‘measurable_space m’, ‘IMAGE f (count n)’]
858 SIGMA_ALGEBRA_FINITE_UNION)
859 >> rw [SUBSET_DEF]
860 >> POP_ASSUM MATCH_MP_TAC >> rw []
861 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
862QED
863
864(* NOTE: changed order of universal quantifiers *)
865Theorem MEASURE_SPACE_SUBSET_MSPACE :
866 !m s. measure_space m /\ s IN measurable_sets m ==> s SUBSET m_space m
867Proof
868 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def,
869 subset_class_def, subsets_def, space_def]
870QED
871
872Theorem MEASURE_SPACE_IN_MSPACE :
873 !m s. measure_space m /\ s IN measurable_sets m ==> (!x. x IN s ==> x IN m_space m)
874Proof
875 METIS_TAC [MEASURE_SPACE_SUBSET_MSPACE, SUBSET_DEF]
876QED
877
878Theorem MEASURE_SPACE_EMPTY_MEASURABLE :
879 !m. measure_space m ==> {} IN measurable_sets m
880Proof
881 RW_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def,
882 subsets_def, space_def]
883QED
884
885Theorem MEASURE_SPACE_BIGINTER :
886 !m s. measure_space m /\ (!n:num. s n IN measurable_sets m) ==>
887 (BIGINTER (IMAGE s UNIV) IN measurable_sets m)
888Proof
889 RW_TAC std_ss []
890 >> (MP_TAC o REWRITE_RULE [subsets_def,space_def,IN_UNIV,IN_FUNSET] o
891 (Q.SPEC `(m_space m,measurable_sets m)`)) SIGMA_ALGEBRA_FN_BIGINTER
892 >> METIS_TAC [measure_space_def]
893QED
894
895Theorem MEASURE_SPACE_FINITE_INTER :
896 !m f n. measure_space m /\ (!i. i < n ==> f i IN measurable_sets m) /\ 0 < n ==>
897 BIGINTER (IMAGE f (count n)) IN measurable_sets m
898Proof
899 rpt STRIP_TAC
900 >> ‘sigma_algebra (measurable_space m)’ by PROVE_TAC [measure_space_def]
901 >> MP_TAC (Q.SPECL [‘measurable_space m’, ‘f’, ‘n’]
902 SIGMA_ALGEBRA_FINITE_INTER)
903 >> rw [SUBSET_DEF]
904QED
905
906(* use MONOTONE_CONVERGENCE when `f 0 = {}` doesn't hold *)
907Theorem MEASURE_COUNTABLE_INCREASING :
908 !m s f.
909 measure_space m /\ f IN (UNIV -> measurable_sets m) /\
910 (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) /\
911 (s = BIGUNION (IMAGE f UNIV)) ==>
912 (sup (IMAGE (measure m o f) UNIV) = measure m s)
913Proof
914 RW_TAC std_ss [IN_FUNSET, IN_UNIV]
915 >> Know `measure m o f = (\n. SIGMA (measure m o (\m. f (SUC m) DIFF f m)) (count n))`
916 >- (FUN_EQ_TAC
917 >> Induct >- RW_TAC std_ss [o_THM, MEASURE_EMPTY,COUNT_ZERO,EXTREAL_SUM_IMAGE_EMPTY]
918 >> POP_ASSUM (MP_TAC o SYM)
919 >> RW_TAC arith_ss [o_THM, COUNT_SUC]
920 >> Know `!n. (measure m o (\m. f (SUC m) DIFF f m)) n <> NegInf`
921 >- ( RW_TAC std_ss []
922 >> `f (SUC n) DIFF f n IN measurable_sets m`
923 by METIS_TAC [measure_space_def, sigma_algebra_def, algebra_def, ALGEBRA_DIFF,
924 subsets_def]
925 >> METIS_TAC [measure_space_def,positive_not_infty,o_DEF] )
926 >> DISCH_TAC
927 >> `FINITE (count x)` by RW_TAC std_ss [FINITE_COUNT]
928 >> `count x DELETE x = count x`
929 by METIS_TAC [IN_COUNT, DELETE_NON_ELEMENT, LESS_REFL]
930 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY]
931 >> MATCH_MP_TAC MEASURE_ADDITIVE
932 >> FULL_SIMP_TAC std_ss [EXTENSION, IN_UNION, IN_DIFF, DISJOINT_DEF, NOT_IN_EMPTY,
933 IN_INTER, SUBSET_DEF]
934 >> Know `algebra (m_space m, measurable_sets m)`
935 >- FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def,
936 space_def, subsets_def]
937 >> DISCH_TAC
938 >> (MP_TAC o REWRITE_RULE [subsets_def, space_def] o
939 (Q.SPEC `(m_space m, measurable_sets m)`)) ALGEBRA_DIFF
940 >> PROVE_TAC [])
941 >> Rewr
942 >> Know `!n. 0 <= (measure m o (\m. f (SUC m) DIFF f m)) n`
943 >- (RW_TAC std_ss [o_DEF] \\
944 IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
945 fs [positive_def] \\
946 FIRST_X_ASSUM MATCH_MP_TAC \\
947 MATCH_MP_TAC MEASURE_SPACE_DIFF >> art [])
948 >> DISCH_THEN (MP_TAC o SYM o (MATCH_MP ext_suminf_def)) >> Rewr'
949 >> MATCH_MP_TAC COUNTABLY_ADDITIVE
950 >> CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def]
951 >> CONJ_TAC
952 >- (RW_TAC std_ss [IN_UNIV,IN_FUNSET]
953 >> (((MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o
954 (Q.SPEC `(m_space m, measurable_sets m)`)) ALGEBRA_DIFF
955 >> FULL_SIMP_TAC std_ss [measure_space_def,sigma_algebra_def])))
956 >> CONJ_TAC
957 >- (rpt STRIP_TAC
958 >> MATCH_MP_TAC DISJOINT_DIFFS
959 >> Q.EXISTS_TAC `f`
960 >> RW_TAC std_ss [])
961 >> CONJ_TAC
962 >- (RW_TAC std_ss [IN_BIGUNION_IMAGE,IN_DIFF,IN_UNIV,EXTENSION]
963 >> reverse (EQ_TAC >> RW_TAC std_ss [])
964 >- METIS_TAC []
965 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY]
966 >> METIS_TAC [])
967 >> (MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o
968 (Q.SPEC `(m_space m, measurable_sets m)`)) SIGMA_ALGEBRA_COUNTABLE_UNION
969 >> CONJ_TAC >- PROVE_TAC [measure_space_def]
970 >> RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV,COUNTABLE_IMAGE_NUM]
971 >> PROVE_TAC []
972QED
973
974(* cf. MEASURE_COMPL *)
975Theorem MEASURE_SPACE_FINITE_DIFF:
976 !m s. measure_space m /\ s IN measurable_sets m /\ measure m s <> PosInf ==>
977 (measure m (m_space m DIFF s) = measure m (m_space m) - measure m s)
978Proof
979 RW_TAC std_ss []
980 >> `(m_space m) IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_MSPACE_MEASURABLE]
981 >> `(m_space m DIFF s) IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_DIFF]
982 >> `!s. s IN measurable_sets m ==> measure m s <> NegInf`
983 by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty]
984 >> `measure m (m_space m DIFF s) <= measure m (m_space m)`
985 by METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,MEASURE_SPACE_SUBSET_MSPACE]
986 >> `measure m (m_space m) = measure m (m_space m DIFF s) + measure m s`
987 by METIS_TAC [MEASURE_SPACE_ADDITIVE,UNION_DIFF,DISJOINT_DIFF,MEASURE_SPACE_SUBSET_MSPACE,ADDITIVE]
988 >> Cases_on `measure m (m_space m DIFF s)`
989 >> Cases_on `measure m (m_space m)`
990 >> Cases_on `measure m s`
991 >> RW_TAC std_ss [extreal_sub_def,extreal_not_infty,extreal_add_def]
992 >> FULL_SIMP_TAC std_ss [extreal_add_def,REAL_EQ_SUB_LADD,REAL_ADD_COMM,EQ_SYM,extreal_11]
993 >> METIS_TAC [lt_infty,extreal_not_infty,let_trans,extreal_add_def]
994QED
995
996(* cf. MEASURE_DIFF_SUBSET *)
997Theorem MEASURE_SPACE_FINITE_DIFF_SUBSET:
998 !m s t. measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
999 t SUBSET s /\ measure m s <> PosInf ==>
1000 (measure m (s DIFF t) = measure m s - measure m t)
1001Proof
1002 RW_TAC std_ss []
1003 >> `!s. s IN measurable_sets m ==> measure m s <> NegInf`
1004 by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty]
1005 >> `measure m s = measure m (s DIFF t) + measure m t`
1006 by (MATCH_MP_TAC ADDITIVE
1007 >> METIS_TAC [MEASURE_SPACE_ADDITIVE,UNION_DIFF,DISJOINT_DIFF,ADDITIVE,MEASURE_SPACE_DIFF])
1008 >> `s DIFF t IN measurable_sets m ` by METIS_TAC [MEASURE_SPACE_DIFF]
1009 >> `measure m (s DIFF t) <= measure m s` by METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,DIFF_SUBSET]
1010 >> `measure m (s DIFF t) <> PosInf` by METIS_TAC [lt_infty,let_trans]
1011 >> `measure m t <> PosInf` by METIS_TAC [lt_infty,let_trans,MEASURE_SPACE_INCREASING,INCREASING]
1012 >> Cases_on `measure m (s DIFF t)`
1013 >> Cases_on `measure m s`
1014 >> Cases_on `measure m t`
1015 >> RW_TAC std_ss [extreal_sub_def,extreal_not_infty,extreal_add_def]
1016 >> FULL_SIMP_TAC real_ss [extreal_add_def,extreal_11]
1017 >> METIS_TAC []
1018QED
1019
1020Theorem MEASURE_SPACE_FINITE_MEASURE:
1021 !m s. measure_space m /\ s IN measurable_sets m /\ measure m (m_space m) <> PosInf ==>
1022 measure m s <> PosInf
1023Proof
1024 METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,MEASURE_SPACE_MSPACE_MEASURABLE,
1025 lt_infty,let_trans,MEASURE_SPACE_SUBSET_MSPACE]
1026QED
1027
1028Theorem MEASURE_SPACE_REDUCE[simp] :
1029 !m. (m_space m, measurable_sets m, measure m) = m
1030Proof
1031 GEN_TAC >> Cases_on ‘m’ >> Cases_on ‘r’ >> rw []
1032QED
1033
1034Theorem MONOTONE_CONVERGENCE:
1035 !m s f.
1036 measure_space m /\ f IN (UNIV -> measurable_sets m) /\
1037 (!n. f n SUBSET f (SUC n)) /\
1038 (s = BIGUNION (IMAGE f UNIV)) ==>
1039 (sup (IMAGE (measure m o f) univ(:num)) = measure m s)
1040Proof
1041 RW_TAC std_ss [measure_space_def, IN_FUNSET, IN_UNIV]
1042 >> (MP_TAC o
1043 INST_TYPE [beta |-> ``:num``] o
1044 Q.SPECL [`m`, `BIGUNION (IMAGE f UNIV)`, `\x. num_CASE x {} f`])
1045 MEASURE_COUNTABLE_INCREASING
1046 >> impl_tac
1047 >- (RW_TAC std_ss [IN_FUNSET, IN_UNIV, num_case_def, measure_space_def] >|
1048 [Cases_on `x` >|
1049 [RW_TAC std_ss [num_case_def]
1050 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY, subsets_def],
1051 RW_TAC std_ss [num_case_def]],
1052 Cases_on `n`
1053 >> RW_TAC std_ss [num_case_def, EMPTY_SUBSET],
1054 SET_EQ_TAC
1055 >> RW_TAC std_ss [IN_BIGUNION_IMAGE, IN_UNIV]
1056 >> EQ_TAC >|
1057 [RW_TAC std_ss []
1058 >> Q.EXISTS_TAC `SUC x'`
1059 >> RW_TAC std_ss [num_case_def],
1060 RW_TAC std_ss []
1061 >> POP_ASSUM MP_TAC
1062 >> Cases_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY, num_case_def]
1063 >> RW_TAC std_ss [num_case_def]
1064 >> PROVE_TAC []]])
1065 >> RW_TAC std_ss []
1066 >> Know `measure m o f = (\n. (measure m o (\x. num_CASE x {} f)) (SUC n))`
1067 >- (FUN_EQ_TAC
1068 >> RW_TAC std_ss [num_case_def, o_THM])
1069 >> Rewr
1070 >> `sup (IMAGE (\n. (measure m o (\x. num_CASE x {} f)) (SUC n)) UNIV) =
1071 sup (IMAGE (measure m o (\x. num_CASE x {} f)) UNIV)`
1072 by (MATCH_MP_TAC sup_suc
1073 >> RW_TAC std_ss [o_DEF]
1074 >> MATCH_MP_TAC INCREASING
1075 >> CONJ_TAC >- METIS_TAC [measure_space_def,MEASURE_SPACE_INCREASING]
1076 >> CONJ_TAC
1077 >- (Cases_on `n` >- FULL_SIMP_TAC std_ss [LE,EMPTY_SUBSET,num_case_def]
1078 >> Cases_on `m'` >- FULL_SIMP_TAC std_ss [EMPTY_SUBSET,num_case_def]
1079 >> `!n m:num. m <= n ==> f m SUBSET f n`
1080 by (RW_TAC std_ss []
1081 >> Know `?d:num. n'' = m' + d` >- PROVE_TAC [LESS_EQ_EXISTS]
1082 >> RW_TAC std_ss []
1083 >> Induct_on `d` >- RW_TAC std_ss [add_rzero,SUBSET_REFL]
1084 >> RW_TAC std_ss []
1085 >> Q.PAT_ASSUM `!n. f n SUBSET f (SUC n)` (MP_TAC o Q.SPEC `m' + d`)
1086 >> METIS_TAC [SUBSET_TRANS,ADD_CLAUSES,LESS_EQ_ADD])
1087 >> FULL_SIMP_TAC std_ss [num_case_def,LESS_EQ_MONO])
1088 >> CONJ_TAC
1089 >- (Cases_on `m'`
1090 >- METIS_TAC [measure_space_def,MEASURE_SPACE_EMPTY_MEASURABLE,num_case_def]
1091 >> RW_TAC std_ss [num_case_def])
1092 >> Cases_on `n`
1093 >- METIS_TAC [measure_space_def,MEASURE_SPACE_EMPTY_MEASURABLE,num_case_def]
1094 >> RW_TAC std_ss [num_case_def])
1095 >> METIS_TAC []
1096QED
1097
1098Theorem MONOTONE_CONVERGENCE2:
1099 !m f. measure_space m /\ f IN (UNIV -> measurable_sets m) /\
1100 (!n. f n SUBSET f (SUC n)) ==>
1101 (sup (IMAGE (measure m o f) univ(:num)) = measure m (BIGUNION (IMAGE f UNIV)))
1102Proof
1103 METIS_TAC [MONOTONE_CONVERGENCE]
1104QED
1105
1106Theorem MONOTONE_CONVERGENCE_BIGINTER:
1107 !m s f.
1108 measure_space m /\ f IN (UNIV -> measurable_sets m) /\
1109 (!n. measure m (f n) <> PosInf) /\
1110 (!n. f (SUC n) SUBSET f n) /\
1111 (s = BIGINTER (IMAGE f UNIV)) ==>
1112 (inf (IMAGE (measure m o f) univ(:num)) = measure m s)
1113Proof
1114 RW_TAC std_ss [IN_FUNSET, IN_UNIV]
1115 >> `BIGINTER (IMAGE f UNIV) IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_BIGINTER]
1116 >> `!n. f n SUBSET f 0`
1117 by (Induct_on `n` >- RW_TAC std_ss [SUBSET_REFL]
1118 >> METIS_TAC [SUBSET_TRANS])
1119 >> `BIGINTER (IMAGE f UNIV) SUBSET (f 0)`
1120 by (MATCH_MP_TAC BIGINTER_SUBSET
1121 >> METIS_TAC [IMAGE_EQ_EMPTY,UNIV_NOT_EMPTY,IN_IMAGE,IN_UNIV])
1122 >> `measure m (BIGINTER (IMAGE f UNIV)) <> PosInf`
1123 by METIS_TAC [MEASURE_SPACE_INCREASING,INCREASING,let_trans,lt_infty]
1124 >> `inf (IMAGE (measure m o f) UNIV) <= measure m (f 0)`
1125 by (MATCH_MP_TAC inf_le_imp
1126 >> ONCE_REWRITE_TAC [GSYM SPECIFICATION]
1127 >> RW_TAC std_ss [IN_UNIV,IN_IMAGE,o_DEF]
1128 >> METIS_TAC [])
1129 >> `!n. measure m (f n) <> NegInf` by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty]
1130 >> `?r. measure m (f 0) = Normal r` by METIS_TAC [extreal_cases]
1131 >> `measure m (f 0) - inf (IMAGE (measure m o f) UNIV) =
1132 sup (IMAGE (\n. measure m (f 0) - measure m (f n)) UNIV)`
1133 by RW_TAC std_ss [inf_cminus]
1134 >> Q.ABBREV_TAC `g = (\n. (f 0) DIFF (f n))`
1135 >> `!n. measure m (f 0) - measure m (f n) = measure m (g n)`
1136 by METIS_TAC [MEASURE_SPACE_FINITE_DIFF_SUBSET]
1137 >> FULL_SIMP_TAC std_ss []
1138 >> `sup (IMAGE (\n. measure m (g n)) UNIV) = measure m (BIGUNION (IMAGE g UNIV))`
1139 by ((MATCH_MP_TAC o REWRITE_RULE [o_DEF]) MONOTONE_CONVERGENCE2
1140 >> RW_TAC std_ss [IN_FUNSET,IN_UNIV]
1141 >- METIS_TAC [MEASURE_SPACE_DIFF]
1142 >> Q.UNABBREV_TAC `g`
1143 >> RW_TAC std_ss [SUBSET_DEF,IN_DIFF,GSPECIFICATION]
1144 >> METIS_TAC [SUBSET_DEF])
1145 >> Q.UNABBREV_TAC `g`
1146 >> `BIGINTER (IMAGE f UNIV) = (f 0) DIFF BIGUNION (IMAGE (\u. (f 0) DIFF u) (IMAGE f UNIV))`
1147 by (MATCH_MP_TAC DIFF_BIGINTER
1148 >> METIS_TAC [IN_IMAGE,IN_UNIV,IMAGE_EQ_EMPTY,UNIV_NOT_EMPTY])
1149 >> POP_ORW
1150 >> `BIGUNION (IMAGE (\u. f 0 DIFF u) (IMAGE f UNIV)) = BIGUNION (IMAGE (\n. f 0 DIFF f n) UNIV)`
1151 by (RW_TAC std_ss [EXTENSION,IN_BIGUNION_IMAGE,IN_UNIV,IN_IMAGE]
1152 >> METIS_TAC [SUBSET_DEF,IN_DIFF])
1153 >> POP_ORW
1154 >> Suff `measure m (f 0 DIFF BIGUNION (IMAGE (\n. f 0 DIFF f n) UNIV)) =
1155 measure m (f 0) - measure m (BIGUNION (IMAGE (\n. f 0 DIFF f n) UNIV))`
1156 >- METIS_TAC [eq_sub_switch]
1157 >> MATCH_MP_TAC MEASURE_SPACE_FINITE_DIFF_SUBSET
1158 >> RW_TAC std_ss []
1159 >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION
1160 >> METIS_TAC [MEASURE_SPACE_DIFF])
1161 >> RW_TAC std_ss [BIGUNION_SUBSET,IN_IMAGE,IN_UNIV]
1162 >> METIS_TAC [DIFF_SUBSET]
1163QED
1164
1165Theorem MONOTONE_CONVERGENCE_BIGINTER2:
1166 !m f. measure_space m /\ f IN (UNIV -> measurable_sets m) /\
1167 (!n. measure m (f n) <> PosInf) /\
1168 (!n. f (SUC n) SUBSET f n) ==>
1169 (inf (IMAGE (measure m o f) univ(:num)) = measure m (BIGINTER (IMAGE f UNIV)))
1170Proof
1171 METIS_TAC [MONOTONE_CONVERGENCE_BIGINTER]
1172QED
1173
1174Theorem MEASURABLE_SETS_SUBSET_SPACE = MEASURE_SPACE_SUBSET_MSPACE
1175
1176Theorem IN_MEASURE_PRESERVING:
1177 !m1 m2 f.
1178 f IN measure_preserving m1 m2 <=>
1179 f IN measurable (m_space m1, measurable_sets m1) (m_space m2, measurable_sets m2) /\
1180 !s.
1181 s IN measurable_sets m2 ==>
1182 (measure m1 ((PREIMAGE f s)INTER(m_space m1)) = measure m2 s)
1183Proof
1184 RW_TAC std_ss [measure_preserving_def, GSPECIFICATION]
1185QED
1186
1187(* The old definition of `measure_preserving m1 m2` requires that both
1188 `m1` and `m2` must be measure_space. Now they're removed, and we must add
1189 `measure_space (m_space m2,a,measure m2)` into the antecedents, which cannot
1190 be derived from other conditions, since we don't know if `a` (for sure
1191 smaller than `measurable_sets m2`, as a generator) is countably_additive.
1192
1193 Furthermore, due to the changes to [0,+inf]-measure, now the theorem requires
1194 that both m1 and m2 are finite measure spaces.
1195 *)
1196Theorem MEASURE_PRESERVING_LIFT :
1197 !m1 m2 a f.
1198 measure_space m1 /\ measure_space m2 /\
1199 measure_space (m_space m2,a,measure m2) /\
1200 measure m1 (m_space m1) <> PosInf /\
1201 measure m2 (m_space m2) <> PosInf /\
1202 (measurable_sets m2 = subsets (sigma (m_space m2) a)) /\
1203 f IN measure_preserving m1 (m_space m2,a,measure m2) ==>
1204 f IN measure_preserving m1 m2
1205Proof
1206 RW_TAC std_ss []
1207 >> reverse (Cases_on `algebra (m_space m2,a)`)
1208 >- fs [IN_MEASURE_PRESERVING, IN_MEASURABLE, m_space_def,
1209 measurable_sets_def, sigma_algebra_def, measure_space_def]
1210 >> Suff `f IN measure_preserving m1 (m_space m2,measurable_sets m2,measure m2)`
1211 >- RW_TAC std_ss [MEASURE_SPACE_REDUCE]
1212 >> ASM_REWRITE_TAC [] (* for ‘measurable_sets m2’ *)
1213 >> Q.PAT_X_ASSUM `f IN X` MP_TAC
1214 >> REWRITE_TAC [IN_MEASURE_PRESERVING, measurable_sets_def, measure_def, m_space_def]
1215 >> STRIP_TAC
1216 >> STRONG_CONJ_TAC
1217 >- (Know `(m_space m2,subsets (sigma (m_space m2) a)) = sigma (m_space m2) a`
1218 >- (Q.ABBREV_TAC `Q = (m_space m2,subsets (sigma (m_space m2) a))`
1219 >> Know `sigma (m_space m2) a = (space (sigma (m_space m2) a),
1220 subsets (sigma (m_space m2) a))`
1221 >- RW_TAC std_ss [SPACE]
1222 >> STRIP_TAC >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
1223 >> Q.UNABBREV_TAC `Q`
1224 >> RW_TAC std_ss [PAIR_EQ, sigma_def, space_def])
1225 >> Rewr'
1226 >> Know `(sigma (m_space m2) a) = sigma (space (m_space m2, a)) (subsets (m_space m2, a))`
1227 >- RW_TAC std_ss [space_def, subsets_def] >> Rewr'
1228 >> MATCH_MP_TAC MEASURABLE_LIFT >> art []
1229 >> Q.PAT_X_ASSUM ‘measure_space m1’ MP_TAC
1230 >> Q.PAT_X_ASSUM ‘algebra (mpace m2,a)’ MP_TAC
1231 >> rw [measure_space_def, algebra_def, subset_class_def])
1232 >> Q.PAT_X_ASSUM `f IN X` K_TAC
1233 >> REWRITE_TAC [IN_MEASURABLE, space_def, subsets_def]
1234 >> STRIP_TAC
1235 (* stage work *)
1236 >> Suff `subsets (sigma (m_space m2) a) SUBSET
1237 {s | measure m1 ((PREIMAGE f s) INTER (m_space m1)) = measure m2 s}`
1238 >- RW_TAC std_ss [SUBSET_DEF, GSPECIFICATION]
1239 >> MATCH_MP_TAC SIGMA_PROPERTY_DISJOINT
1240 >> Know `!s. s IN subsets (sigma (m_space m2) a) ==> measure m2 s <> PosInf`
1241 >- (NTAC 2 STRIP_TAC \\
1242 `s IN measurable_sets m2` by PROVE_TAC [] \\
1243 MATCH_MP_TAC MEASURE_SPACE_FINITE_MEASURE >> art [])
1244 >> RW_TAC std_ss [GSPECIFICATION, SUBSET_DEF, IN_INTER, IN_FUNSET,
1245 IN_UNIV, PREIMAGE_COMPL, PREIMAGE_BIGUNION, IMAGE_IMAGE,
1246 MEASURE_SPACE_FINITE_DIFF] (* 3 subgoals *)
1247 >| [ (* goal 1 (of 3) *)
1248 Q.PAT_X_ASSUM `measure m1 (PREIMAGE f s INTER m_space m1) = measure m2 s`
1249 (fn thm => ONCE_REWRITE_TAC [GSYM thm]) \\
1250 Know `m_space m2 IN a` >- PROVE_TAC [ALGEBRA_SPACE, subsets_def, space_def] \\
1251 STRIP_TAC \\
1252 Q.PAT_X_ASSUM `!s. s IN a ==> (measure m1 (PREIMAGE f s INTER m_space m1) = measure m2 s)`
1253 ((fn thm => ONCE_REWRITE_TAC [GSYM thm]) o UNDISCH o Q.SPEC `m_space m2`) \\
1254 Know `PREIMAGE f (m_space m2) INTER m_space m1 = m_space m1`
1255 >- (FULL_SIMP_TAC std_ss [Once EXTENSION, IN_INTER, IN_PREIMAGE, IN_FUNSET] \\
1256 METIS_TAC []) \\
1257 RW_TAC std_ss [PREIMAGE_DIFF] \\
1258 `(PREIMAGE f (m_space m2) DIFF PREIMAGE f s) INTER m_space m1 =
1259 (PREIMAGE f (m_space m2) INTER m_space m1) DIFF (PREIMAGE f s INTER m_space m1)`
1260 by (RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_DIFF, IN_PREIMAGE] \\
1261 DECIDE_TAC) >> POP_ORW \\
1262 POP_ORW \\
1263 `measure m1 (PREIMAGE f s INTER m_space m1) <> PosInf`
1264 by METIS_TAC [MEASURE_SPACE_FINITE_MEASURE] \\
1265 RW_TAC std_ss [MEASURE_SPACE_FINITE_DIFF],
1266 (* goal 2 (of 3) *)
1267 `BIGUNION (IMAGE (PREIMAGE f o f') UNIV) INTER m_space m1 =
1268 BIGUNION (IMAGE (\x:num. (PREIMAGE f o f') x INTER m_space m1) UNIV)`
1269 by (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, IN_INTER, IN_IMAGE, IN_UNIV] \\
1270 FULL_SIMP_TAC std_ss [IN_FUNSET] \\
1271 EQ_TAC
1272 >- (RW_TAC std_ss [] \\
1273 Q.EXISTS_TAC `PREIMAGE f (f' x') INTER m_space m1` \\
1274 ASM_REWRITE_TAC [IN_INTER] \\
1275 Q.EXISTS_TAC `x'` >> RW_TAC std_ss []) \\
1276 RW_TAC std_ss [] >> METIS_TAC [IN_PREIMAGE, IN_INTER]) \\
1277 POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]) \\
1278 Suff
1279 `sup (IMAGE (measure m2 o f') univ(:num)) = measure m2 (BIGUNION (IMAGE f' UNIV)) /\
1280 sup (IMAGE (measure m2 o f') univ(:num)) =
1281 measure m1 (BIGUNION (IMAGE (\x. (PREIMAGE f o f') x INTER m_space m1) UNIV))`
1282 >- PROVE_TAC [] \\
1283 CONJ_TAC >- (MATCH_MP_TAC MEASURE_COUNTABLE_INCREASING \\
1284 RW_TAC std_ss [IN_FUNSET, IN_UNIV, SUBSET_DEF]) \\
1285 Know `measure m2 o f' = measure m1 o (\x. (PREIMAGE f o f') x INTER m_space m1)`
1286 >- (RW_TAC std_ss [FUN_EQ_THM] >> RW_TAC std_ss [o_THM]) \\
1287 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
1288 MATCH_MP_TAC MEASURE_COUNTABLE_INCREASING \\
1289 RW_TAC std_ss [IN_FUNSET, IN_UNIV, o_THM, PREIMAGE_EMPTY, INTER_EMPTY] \\
1290 Suff `PREIMAGE f (f' n) SUBSET PREIMAGE f (f' (SUC n))`
1291 >- RW_TAC std_ss [SUBSET_DEF, IN_INTER] \\
1292 MATCH_MP_TAC PREIMAGE_SUBSET \\
1293 RW_TAC std_ss [SUBSET_DEF],
1294 (* goal 3 of 3 *)
1295 `BIGUNION (IMAGE (PREIMAGE f o f') UNIV) INTER m_space m1 =
1296 BIGUNION (IMAGE (\x:num. (PREIMAGE f o f') x INTER m_space m1) UNIV)`
1297 by (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, IN_INTER, IN_IMAGE, IN_UNIV]
1298 >> FULL_SIMP_TAC std_ss [IN_FUNSET]
1299 >> EQ_TAC
1300 >- (RW_TAC std_ss [] >> Q.EXISTS_TAC `PREIMAGE f (f' x') INTER m_space m1`
1301 >> ASM_REWRITE_TAC [IN_INTER] >> Q.EXISTS_TAC `x'` >> RW_TAC std_ss [])
1302 >> RW_TAC std_ss [] >> METIS_TAC [IN_PREIMAGE, IN_INTER]) \\
1303 POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]) \\
1304 Suff
1305 `suminf (measure m2 o f') = measure m2 (BIGUNION (IMAGE f' UNIV)) /\
1306 suminf (measure m2 o f') =
1307 measure m1 (BIGUNION (IMAGE (\x. (PREIMAGE f o f') x INTER m_space m1) UNIV))`
1308 >- PROVE_TAC [] \\
1309 CONJ_TAC >- (MATCH_MP_TAC MEASURE_COUNTABLY_ADDITIVE \\
1310 RW_TAC std_ss [IN_FUNSET, IN_UNIV]) \\
1311 Know `measure m2 o f' = measure m1 o (\x. (PREIMAGE f o f') x INTER m_space m1)`
1312 >- (RW_TAC std_ss [FUN_EQ_THM] >> RW_TAC std_ss [o_THM]) \\
1313 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
1314 MATCH_MP_TAC MEASURE_COUNTABLY_ADDITIVE \\
1315 RW_TAC std_ss [IN_FUNSET, IN_UNIV, o_THM, IN_DISJOINT, PREIMAGE_DISJOINT, IN_INTER] \\
1316 METIS_TAC [IN_DISJOINT, PREIMAGE_DISJOINT] ]
1317QED
1318
1319(* added the same more requirements as for MEASURE_PRESERVING_LIFT *)
1320Theorem MEASURE_PRESERVING_SUBSET:
1321 !m1 m2 a.
1322 measure_space m1 /\ measure_space m2 /\
1323 measure_space (m_space m2,a,measure m2) /\
1324 measure m1 (m_space m1) <> PosInf /\
1325 measure m2 (m_space m2) <> PosInf /\
1326 (measurable_sets m2 = subsets (sigma (m_space m2) a)) ==>
1327 measure_preserving m1 (m_space m2, a, measure m2) SUBSET
1328 measure_preserving m1 m2
1329Proof
1330 RW_TAC std_ss [SUBSET_DEF]
1331 >> MATCH_MP_TAC MEASURE_PRESERVING_LIFT
1332 >> PROVE_TAC []
1333QED
1334
1335(* fewer antecedents *)
1336Theorem MEASURE_PRESERVING_UP_LIFT:
1337 !m1 m2 f a.
1338 f IN measure_preserving (m_space m1, a, measure m1) m2 /\
1339 sigma_algebra (m_space m1, measurable_sets m1) /\
1340 a SUBSET measurable_sets m1 ==>
1341 f IN measure_preserving m1 m2
1342Proof
1343 RW_TAC std_ss [measure_preserving_def, GSPECIFICATION, SUBSET_DEF,
1344 measure_def, measurable_sets_def, m_space_def, SPACE]
1345 >> MATCH_MP_TAC MEASURABLE_UP_LIFT
1346 >> Q.EXISTS_TAC `a`
1347 >> RW_TAC std_ss [SUBSET_DEF]
1348QED
1349
1350(* fewer antecedents *)
1351Theorem MEASURE_PRESERVING_UP_SUBSET:
1352 !m1 m2 a.
1353 a SUBSET measurable_sets m1 /\
1354 sigma_algebra (m_space m1, measurable_sets m1) ==>
1355 measure_preserving (m_space m1, a, measure m1) m2 SUBSET measure_preserving m1 m2
1356Proof
1357 RW_TAC std_ss [MEASURE_PRESERVING_UP_LIFT, SUBSET_DEF]
1358 >> MATCH_MP_TAC MEASURE_PRESERVING_UP_LIFT
1359 >> PROVE_TAC [SUBSET_DEF]
1360QED
1361
1362(* NOTE: added ‘subset_class (m_space m1) a’ due to changes in ‘measurable’.
1363
1364 This requirement is very basic, just to make ‘sigma (m_space m1) a’ meaningful.
1365 *)
1366Theorem MEASURE_PRESERVING_UP_SIGMA :
1367 !m1 m2 a. subset_class (m_space m1) a /\
1368 (measurable_sets m1 = subsets (sigma (m_space m1) a)) ==>
1369 measure_preserving (m_space m1, a, measure m1) m2 SUBSET measure_preserving m1 m2
1370Proof
1371 RW_TAC std_ss [MEASURE_PRESERVING_UP_LIFT, SUBSET_DEF]
1372 >> MATCH_MP_TAC MEASURE_PRESERVING_UP_LIFT
1373 >> Q.EXISTS_TAC `a`
1374 >> ASM_REWRITE_TAC [SIGMA_SUBSET_SUBSETS, SIGMA_REDUCE]
1375 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA >> art []
1376QED
1377
1378(* ****************** *)
1379
1380Theorem MEASURABLE_RANGE_REDUCE:
1381 !m f s. measure_space m /\
1382 f IN measurable (m_space m, measurable_sets m) (s, POW s) /\
1383 (~(s = {})) ==>
1384 f IN measurable (m_space m, measurable_sets m)
1385 (s INTER (IMAGE f (m_space m)), POW (s INTER (IMAGE f (m_space m))))
1386Proof
1387 RW_TAC std_ss [IN_MEASURABLE, POW_SIGMA_ALGEBRA, subsets_def, space_def, IN_FUNSET,
1388 IN_INTER, IN_IMAGE, IN_POW, SUBSET_INTER,
1389 MEASURABLE_SETS_SUBSET_SPACE, INTER_SUBSET]
1390 >> METIS_TAC []
1391QED
1392
1393Theorem MEASURABLE_POW_TO_POW:
1394 !m f.
1395 measure_space m /\
1396 (measurable_sets m = POW (m_space m)) ==>
1397 f IN measurable (m_space m, measurable_sets m) (UNIV, POW(UNIV))
1398Proof
1399 RW_TAC std_ss [IN_MEASURABLE, IN_POW, IN_UNIV, POW_SIGMA_ALGEBRA, subsets_def, space_def,
1400 IN_FUNSET, PREIMAGE_UNIV, SUBSET_UNIV, measure_space_def, SUBSET_DEF,
1401 IN_INTER]
1402QED
1403
1404Theorem MEASURABLE_POW_TO_POW_IMAGE:
1405 !m f.
1406 measure_space m /\
1407 (measurable_sets m = POW (m_space m)) ==>
1408 f IN measurable (m_space m, measurable_sets m)
1409 (IMAGE f (m_space m), POW(IMAGE f (m_space m)))
1410Proof
1411 rpt STRIP_TAC
1412 >> (MP_TAC o Q.SPECL [`m`,`f`,`UNIV`]) MEASURABLE_RANGE_REDUCE
1413 >> ASM_SIMP_TAC std_ss [UNIV_NOT_EMPTY, INTER_UNIV, MEASURABLE_POW_TO_POW]
1414QED
1415
1416Theorem MEASURE_SPACE_SUBSET:
1417 !s s' m. s' SUBSET s /\ measure_space (s,POW s, m) ==>
1418 measure_space (s',POW s', m)
1419Proof
1420 RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def, POW_SIGMA_ALGEBRA,
1421 positive_def, measure_def, IN_POW, countably_additive_def, IN_FUNSET, IN_POW]
1422 >> METIS_TAC [SUBSET_TRANS, SUBSET_REFL]
1423QED
1424
1425Theorem STRONG_MEASURE_SPACE_SUBSET:
1426 !s s'. s' SUBSET m_space s /\ measure_space s /\ POW s' SUBSET measurable_sets s ==>
1427 measure_space (s',POW s', measure s)
1428Proof
1429 rpt STRIP_TAC >> MATCH_MP_TAC MEASURE_DOWN
1430 >> Q.EXISTS_TAC `s`
1431 >> RW_TAC std_ss [measure_def, m_space_def, measurable_sets_def, POW_SIGMA_ALGEBRA]
1432QED
1433
1434Theorem MEASURE_EXTREAL_SUM_IMAGE:
1435 !m s. measure_space m /\ s IN measurable_sets m /\
1436 (!x. x IN s ==> {x} IN measurable_sets m) /\ FINITE s ==>
1437 (measure m s = SIGMA (\x. measure m {x}) s)
1438Proof
1439 Suff `!s. FINITE s ==>
1440 (\s. !m. measure_space m /\ s IN measurable_sets m /\
1441 (!x. x IN s ==> {x} IN measurable_sets m) ==>
1442 (measure m s = SIGMA (\x. measure m {x}) s)) s`
1443 >- METIS_TAC []
1444 >> MATCH_MP_TAC FINITE_INDUCT
1445 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_EMPTY, MEASURE_EMPTY, DELETE_NON_ELEMENT, IN_INSERT]
1446 >> `!x. x IN e INSERT s ==> (\x. measure m {x}) x <> NegInf`
1447 by METIS_TAC [IN_INSERT,measure_space_def,positive_not_infty]
1448 >> FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY, DELETE_NON_ELEMENT]
1449 >> Q.PAT_X_ASSUM `!m. a /\ b /\ c ==> d` (MP_TAC o GSYM o Q.SPEC `m`)
1450 >> `s IN measurable_sets m`
1451 by (`s = (e INSERT s) DIFF {e}`
1452 by (RW_TAC std_ss [EXTENSION, IN_INSERT, IN_DIFF, IN_SING]
1453 >> METIS_TAC [GSYM DELETE_NON_ELEMENT])
1454 >> POP_ORW
1455 >> FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def]
1456 >> METIS_TAC [space_def, subsets_def, ALGEBRA_DIFF])
1457 >> RW_TAC std_ss []
1458 >> MATCH_MP_TAC MEASURE_ADDITIVE
1459 >> RW_TAC std_ss [IN_DISJOINT, IN_SING, Once INSERT_SING_UNION]
1460 >> FULL_SIMP_TAC std_ss [GSYM DELETE_NON_ELEMENT]
1461QED
1462
1463Theorem finite_additivity_sufficient_for_finite_spaces :
1464 !s m. sigma_algebra s /\ FINITE (space s) /\
1465 positive (space s, subsets s, m) /\
1466 additive (space s, subsets s, m) ==>
1467 measure_space (space s, subsets s, m)
1468Proof
1469 RW_TAC std_ss [countably_additive_def, additive_def, measurable_sets_def,
1470 measure_def, IN_FUNSET, IN_UNIV, measure_space_def, m_space_def, SPACE]
1471 >> `FINITE (subsets s)`
1472 by (Suff `subsets s SUBSET (POW (space s))`
1473 >- METIS_TAC [SUBSET_FINITE, FINITE_POW]
1474 >> FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, subset_class_def, SUBSET_DEF, IN_POW]
1475 >> METIS_TAC [])
1476 >> `?N. !n. n >= N ==> (f n = {})`
1477 by METIS_TAC [finite_enumeration_of_sets_has_max_non_empty]
1478 >> FULL_SIMP_TAC std_ss [GREATER_EQ]
1479 >> `BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE f (count N))`
1480 by METIS_TAC [BIGUNION_IMAGE_UNIV]
1481 (* stage work *)
1482 >> Know `!n. 0 <= (m o f) n`
1483 >- fs [positive_def, measure_def, measurable_sets_def]
1484 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr'
1485 >> RW_TAC std_ss [sup_eq', IN_IMAGE, IN_UNIV]
1486 >- (Cases_on `N <= n`
1487 >- (`count n = (count N) UNION (count n DIFF count N)`
1488 by METIS_TAC [UNION_DIFF,SUBSET_DEF,IN_COUNT,SUBSET_DEF,IN_COUNT,LESS_EQ_TRANS,LESS_EQ]
1489 >> POP_ORW
1490 >> `FINITE (count N) /\ FINITE (count n DIFF count N)`
1491 by RW_TAC std_ss [FINITE_COUNT,FINITE_DIFF]
1492 >> `DISJOINT (count N) (count n DIFF count N)`
1493 by METIS_TAC [EXTENSION,IN_DISJOINT,IN_COUNT,IN_DIFF,IN_INTER,NOT_IN_EMPTY]
1494 >> `!x. (m o f) x <> NegInf`
1495 by METIS_TAC [positive_not_infty,measurable_sets_def,subsets_def,measure_def,o_DEF]
1496 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_DISJOINT_UNION]
1497 >> (MP_TAC o Q.SPEC `(m :('a -> bool) -> extreal) o f` o UNDISCH o
1498 (Q.SPEC `count n DIFF count N`) o INST_TYPE [alpha |-> ``:num``]) EXTREAL_SUM_IMAGE_IN_IF
1499 >> RW_TAC std_ss []
1500 >> `(\x. if x IN count n DIFF count N then m (f x) else 0) = (\x. 0)`
1501 by (FUN_EQ_TAC
1502 >> RW_TAC std_ss [IN_COUNT,IN_DIFF,NOT_LESS]
1503 >> FULL_SIMP_TAC std_ss [positive_def,measure_def])
1504 >> POP_ORW
1505 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_ZERO,add_rzero]
1506 >> Suff `SIGMA (m o f) (count N) = m (BIGUNION (IMAGE f (count N)))`
1507 >- RW_TAC std_ss [le_refl]
1508 >> (MATCH_MP_TAC o REWRITE_RULE [m_space_def,measurable_sets_def,measure_def] o
1509 Q.SPECL [`(space s,subsets s, m)`,`f`,`N`]) ADDITIVE_SUM
1510 >> FULL_SIMP_TAC std_ss [IN_FUNSET,IN_UNIV,SPACE,sigma_algebra_def]
1511 >> METIS_TAC [additive_def,measure_def,measurable_sets_def,m_space_def])
1512 >> FULL_SIMP_TAC std_ss [NOT_LESS_EQUAL]
1513 >> `SIGMA (m o f) (count n) = m (BIGUNION (IMAGE f (count n)))`
1514 by ((MATCH_MP_TAC o REWRITE_RULE [m_space_def,measurable_sets_def,measure_def] o
1515 Q.SPECL [`(space s,subsets s, m)`,`f`,`n`]) ADDITIVE_SUM
1516 >> RW_TAC std_ss [IN_FUNSET,IN_UNIV]
1517 >- FULL_SIMP_TAC std_ss [sigma_algebra_def,SPACE]
1518 >> METIS_TAC [additive_def,measure_def,measurable_sets_def,m_space_def])
1519 >> POP_ORW
1520 >> (MATCH_MP_TAC o REWRITE_RULE [measurable_sets_def,subsets_def,measure_def] o
1521 Q.SPECL [`(space s,subsets s,m)`,
1522 `BIGUNION (IMAGE f (count n))`,
1523 `BIGUNION (IMAGE f (count N))`]) INCREASING
1524 >> CONJ_TAC
1525 >- (MATCH_MP_TAC ADDITIVE_INCREASING
1526 >> FULL_SIMP_TAC std_ss [m_space_def,measurable_sets_def,sigma_algebra_def,SPACE]
1527 >> METIS_TAC [additive_def,measure_def,m_space_def,measurable_sets_def])
1528 >> RW_TAC std_ss [SUBSET_DEF,IN_BIGUNION_IMAGE,IN_COUNT]
1529 >- METIS_TAC [LESS_TRANS]
1530 >> FULL_SIMP_TAC std_ss [sigma_algebra_def]
1531 >> Q.PAT_X_ASSUM ` !c. P c /\ Q c ==> BIGUNION c IN subsets s` MATCH_MP_TAC
1532 >> RW_TAC std_ss [COUNTABLE_IMAGE_NUM,SUBSET_DEF,IN_IMAGE,IN_COUNT]
1533 >> METIS_TAC [])
1534 >> POP_ASSUM MATCH_MP_TAC
1535 >> Q.EXISTS_TAC `N`
1536 >> (MATCH_MP_TAC o GSYM o REWRITE_RULE [m_space_def,measurable_sets_def,measure_def] o
1537 Q.SPECL [`(space s,subsets s, m)`,`f`,`N`]) ADDITIVE_SUM
1538 >> RW_TAC std_ss [IN_FUNSET,IN_UNIV]
1539 >- FULL_SIMP_TAC std_ss [sigma_algebra_def,SPACE]
1540 >> METIS_TAC [additive_def,measure_def,measurable_sets_def,m_space_def]
1541QED
1542
1543Theorem finite_additivity_sufficient_for_finite_spaces2:
1544 !m. sigma_algebra (m_space m, measurable_sets m) /\ FINITE (m_space m) /\
1545 positive m /\ additive m ==> measure_space m
1546Proof
1547 rpt STRIP_TAC
1548 >> Suff `measure_space (space (m_space m, measurable_sets m),
1549 subsets (m_space m, measurable_sets m), measure m)`
1550 >- RW_TAC std_ss [space_def, subsets_def, MEASURE_SPACE_REDUCE]
1551 >> MATCH_MP_TAC finite_additivity_sufficient_for_finite_spaces
1552 >> RW_TAC std_ss [space_def, subsets_def, MEASURE_SPACE_REDUCE]
1553QED
1554
1555(* added ``measure m t < PosInf`` into antecedents, cf. MEASURE_SPACE_FINITE_DIFF_SUBSET *)
1556Theorem MEASURE_DIFF_SUBSET:
1557 !m s t.
1558 measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
1559 (t SUBSET s) /\ measure m t < PosInf ==>
1560 (measure m (s DIFF t) = measure m s - measure m t)
1561Proof
1562 RW_TAC std_ss []
1563 >> Know `(measure m (s DIFF t) = measure m s - measure m t) <=>
1564 (measure m (s DIFF t) + measure m t = measure m s)`
1565 >- (MATCH_MP_TAC eq_sub_ladd \\
1566 `positive m` by PROVE_TAC [measure_space_def] \\
1567 PROVE_TAC [positive_not_infty, lt_infty])
1568 >> DISCH_THEN (REWRITE_TAC o wrap)
1569 >> MATCH_MP_TAC EQ_SYM
1570 >> MATCH_MP_TAC ADDITIVE
1571 >> Q.PAT_X_ASSUM `measure_space m` MP_TAC
1572 >> RW_TAC std_ss [measure_space_def, sigma_algebra_def, DISJOINT_DEF,
1573 EXTENSION, IN_DIFF, IN_UNIV, IN_UNION, IN_INTER,
1574 NOT_IN_EMPTY]
1575 >> METIS_TAC [COUNTABLY_ADDITIVE_ADDITIVE, MEASURE_SPACE_DIFF, measure_space_def,
1576 sigma_algebra_def, SUBSET_DEF, ALGEBRA_EMPTY, subsets_def, positive_def]
1577QED
1578
1579Theorem MEASURE_COMPL_SUBSET = MEASURE_DIFF_SUBSET;
1580
1581(* cf. MEASURE_SPACE_RESTRICTION *)
1582Theorem MEASURE_SPACE_RESTRICTED :
1583 !m s. measure_space m /\ s IN measurable_sets m ==>
1584 measure_space (s, IMAGE (\t. s INTER t) (measurable_sets m), measure m)
1585Proof
1586 RW_TAC std_ss []
1587 >> `positive (s,IMAGE (\t. s INTER t) (measurable_sets m),measure m)`
1588 by (RW_TAC std_ss [positive_def,measure_def,measurable_sets_def,IN_IMAGE]
1589 >> METIS_TAC [MEASURE_SPACE_POSITIVE,MEASURE_SPACE_INTER,positive_def])
1590 >> `countably_additive (s,IMAGE (\t. s INTER t) (measurable_sets m),measure m)`
1591 by (RW_TAC std_ss [countably_additive_def,measure_def,measurable_sets_def,
1592 IN_IMAGE,IN_FUNSET,IN_UNIV]
1593 >> `!x. f x IN measurable_sets m` by METIS_TAC [MEASURE_SPACE_INTER]
1594 >> `BIGUNION (IMAGE f univ(:num)) IN measurable_sets m`
1595 by METIS_TAC [MEASURE_SPACE_INTER]
1596 >> `countably_additive m` by METIS_TAC [measure_space_def]
1597 >> FULL_SIMP_TAC std_ss [countably_additive_def,IN_FUNSET,IN_UNIV])
1598 >> RW_TAC std_ss [measure_space_def,sigma_algebra_def,measurable_sets_def,
1599 subsets_def, m_space_def, IN_IMAGE]
1600 >- (RW_TAC std_ss [algebra_def,space_def,subsets_def,subset_class_def,IN_IMAGE]
1601 >| [RW_TAC std_ss [INTER_SUBSET],
1602 METIS_TAC [INTER_EMPTY,MEASURE_SPACE_EMPTY_MEASURABLE],
1603 Q.EXISTS_TAC `m_space m DIFF t`
1604 >> RW_TAC std_ss [MEASURE_SPACE_DIFF,MEASURE_SPACE_MSPACE_MEASURABLE,
1605 EXTENSION, IN_DIFF,IN_INTER]
1606 >> METIS_TAC [MEASURE_SPACE_SUBSET_MSPACE,SUBSET_DEF],
1607 Q.EXISTS_TAC `t' UNION t''`
1608 >> RW_TAC std_ss [MEASURE_SPACE_UNION,UNION_OVER_INTER]])
1609 >> `BIGUNION c SUBSET s`
1610 by (RW_TAC std_ss [SUBSET_DEF,IN_BIGUNION]
1611 >> FULL_SIMP_TAC std_ss [SUBSET_DEF,IN_IMAGE]
1612 >> `?t. (s' = s INTER t) /\ t IN measurable_sets m` by METIS_TAC []
1613 >> METIS_TAC [IN_INTER])
1614 >> Q.EXISTS_TAC `BIGUNION c`
1615 >> RW_TAC std_ss [SUBSET_INTER2]
1616 >> Suff `BIGUNION c IN subsets (m_space m, measurable_sets m)`
1617 >- RW_TAC std_ss [subsets_def]
1618 >> MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION
1619 >> RW_TAC std_ss [subsets_def]
1620 >- FULL_SIMP_TAC std_ss [measure_space_def]
1621 >> FULL_SIMP_TAC std_ss [SUBSET_DEF,IN_IMAGE]
1622 >> METIS_TAC [MEASURE_SPACE_INTER]
1623QED
1624
1625(* from HVG's normal_rvScript.sml *)
1626Definition restrict_space :
1627 restrict_space M sp =
1628 (sp INTER m_space M,
1629 IMAGE (\a. a INTER sp) (measurable_sets M),
1630 measure M)
1631End
1632
1633Theorem measure_restrict_space[simp] :
1634 measure (restrict_space M sp) = measure M
1635Proof
1636 rw [restrict_space, measure_def]
1637QED
1638
1639Theorem space_restrict_space :
1640 !M sp. m_space (restrict_space M sp) = (sp INTER m_space M)
1641Proof
1642 SIMP_TAC std_ss [restrict_space, m_space_def]
1643QED
1644
1645Theorem space_restrict_space2 :
1646 !M sp. measure_space M /\ sp IN measurable_sets M ==>
1647 (m_space (restrict_space M sp) = sp)
1648Proof
1649 RW_TAC std_ss [restrict_space, m_space_def] THEN
1650 `sp SUBSET m_space M` by METIS_TAC [MEASURABLE_SETS_SUBSET_SPACE] THEN
1651 ASM_SET_TAC []
1652QED
1653
1654Theorem sets_restrict_space :
1655 !M sp. measurable_sets (restrict_space M sp) =
1656 IMAGE (\a. a INTER sp) (measurable_sets M)
1657Proof
1658 RW_TAC std_ss [restrict_space, measurable_sets_def]
1659QED
1660
1661Theorem measure_space_restrict_space :
1662 !M sp. measure_space M /\ sp IN measurable_sets M ==>
1663 measure_space (restrict_space M sp)
1664Proof
1665 RW_TAC std_ss [restrict_space]
1666 >> ‘sp SUBSET m_space M’
1667 by fs [measure_space_def, sigma_algebra_def, algebra_def, subset_class_def]
1668 >> ‘sp INTER m_space M = sp’ by ASM_SET_TAC [] >> POP_ORW
1669 >> ONCE_REWRITE_TAC [INTER_COMM]
1670 >> MATCH_MP_TAC MEASURE_SPACE_RESTRICTED >> art []
1671QED
1672
1673(* connection between ‘restrict_space’ and ‘restrict_algebra’ *)
1674Theorem restrict_space_def :
1675 !M sp. restrict_space M sp =
1676 (space (restrict_algebra (measurable_space M) sp),
1677 subsets (restrict_algebra (measurable_space M) sp),
1678 measure M)
1679Proof
1680 rw [restrict_algebra_def, restrict_space]
1681QED
1682
1683Theorem restrict_space_SUBSET :
1684 !M sp. measure_space M /\ sp IN measurable_sets M ==>
1685 measurable_sets (restrict_space M sp) SUBSET measurable_sets M
1686Proof
1687 rw [restrict_space_def]
1688 >> ‘sigma_algebra (measurable_space M)’ by fs [measure_space_def]
1689 >> qabbrev_tac ‘A = measurable_space M’
1690 >> ‘measurable_sets M = subsets A’ by rw [subsets_def, Abbr ‘A’]
1691 >> fs []
1692 >> MATCH_MP_TAC restrict_algebra_SUBSET >> art []
1693QED
1694
1695(* Another way to restrict a measure space *)
1696Theorem MEASURE_SPACE_RESTRICTED_MEASURE :
1697 !m s. measure_space m /\ s IN measurable_sets m ==>
1698 measure_space (m_space m,measurable_sets m,(\a. measure m (s INTER a)))
1699Proof
1700 RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def,
1701 measure_def, positive_def, INTER_EMPTY]
1702 >- (FIRST_ASSUM MATCH_MP_TAC \\
1703 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
1704 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER)) \\
1705 fs [sigma_algebra_def])
1706 >> fs [countably_additive_def, measurable_sets_def, measure_def, m_space_def,
1707 IN_FUNSET, IN_UNIV]
1708 >> RW_TAC std_ss [o_DEF]
1709 >> Know `(\x. measure m (s INTER f x)) = measure m o (\x. s INTER f x)`
1710 >- (FUN_EQ_TAC >> SIMP_TAC std_ss [o_DEF]) >> Rewr'
1711 >> REWRITE_TAC [BIGUNION_OVER_INTER_R]
1712 >> FIRST_X_ASSUM MATCH_MP_TAC
1713 >> RW_TAC std_ss [o_DEF, GSYM BIGUNION_OVER_INTER_R] (* 3 subgoals *)
1714 >| [ (* goal 1 (of 3) *)
1715 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
1716 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER)) \\
1717 fs [sigma_algebra_def],
1718 (* goal 2 (of 3) *)
1719 MATCH_MP_TAC DISJOINT_RESTRICT_R \\
1720 FIRST_X_ASSUM MATCH_MP_TAC >> art [],
1721 (* goal 3 (of 3) *)
1722 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
1723 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_INTER)) \\
1724 fs [sigma_algebra_def] ]
1725QED
1726
1727Theorem MEASURE_SPACE_CMUL:
1728 !m c. measure_space m /\ 0 <= c ==>
1729 measure_space (m_space m, measurable_sets m, (\a. Normal c * measure m a))
1730Proof
1731 RW_TAC std_ss [measure_space_def,m_space_def,measurable_sets_def,measure_def,
1732 positive_def,mul_rzero]
1733 >- METIS_TAC [extreal_le_def,le_mul,extreal_of_num_def]
1734 >> RW_TAC std_ss [countably_additive_def,measure_def,measurable_sets_def,o_DEF]
1735 >> `measure m (BIGUNION (IMAGE f univ(:num))) = suminf (measure m o f)`
1736 by METIS_TAC [countably_additive_def]
1737 >> `suminf (\x. Normal c * measure m (f x)) = suminf (\x. Normal c * (\x. measure m (f x)) x)`
1738 by METIS_TAC []
1739 >> POP_ORW
1740 >> Suff `suminf (\x. Normal c * (\x. measure m (f x)) x) = Normal c * suminf (\x. measure m (f x))`
1741 >- METIS_TAC []
1742 >> MATCH_MP_TAC ext_suminf_cmul
1743 >> METIS_TAC [IN_UNIV,IN_FUNSET,extreal_le_def,extreal_of_num_def]
1744QED
1745
1746Theorem BIGUNION_IMAGE_Q:
1747 !a f: extreal -> 'a -> bool. sigma_algebra a /\ f IN (Q_set -> subsets a)
1748 ==> BIGUNION (IMAGE f Q_set) IN subsets a
1749Proof
1750 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, IN_UNIV, SUBSET_DEF]
1751 >> Q.PAT_X_ASSUM `!c. countable c /\ P c ==> Q c` MATCH_MP_TAC
1752 >> RW_TAC std_ss [image_countable, IN_IMAGE, Q_COUNTABLE]
1753 >> METIS_TAC []
1754QED
1755
1756Theorem measure_split:
1757 !(r :num -> bool) (b :num -> ('a -> bool)) m.
1758 measure_space m /\ FINITE r /\
1759 (BIGUNION (IMAGE b r) = m_space m) /\
1760 (!i j. i IN r /\ j IN r /\ (~(i = j)) ==> DISJOINT (b i) (b j)) /\
1761 (!i. i IN r ==> b i IN measurable_sets m) ==>
1762 !a. a IN measurable_sets m ==>
1763 ((measure m) a = SIGMA (\i. (measure m) (a INTER (b i))) r)
1764Proof
1765 Suff `!r. FINITE r ==>
1766 (\r. !(b :num -> ('a -> bool)) m.
1767 measure_space m /\
1768 (BIGUNION (IMAGE b r) = m_space m) /\
1769 (!i j. i IN r /\ j IN r /\ (~(i=j)) ==> DISJOINT (b i) (b j)) /\
1770 (!i. i IN r ==> b i IN measurable_sets m) ==>
1771 !a. a IN measurable_sets m ==>
1772 ((measure m) a = SIGMA (\i. (measure m) (a INTER (b i))) r)) r`
1773 >- RW_TAC std_ss []
1774 >> MATCH_MP_TAC FINITE_INDUCT
1775 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_EMPTY, IMAGE_EMPTY, BIGUNION_EMPTY, DELETE_NON_ELEMENT,
1776 IN_INSERT, NOT_IN_EMPTY]
1777 >- METIS_TAC [MEASURE_SPACE_SUBSET_MSPACE,SUBSET_EMPTY,MEASURE_EMPTY]
1778 >> `!i. i IN e INSERT s ==> (\i. measure m (a INTER b i)) i <> NegInf`
1779 by METIS_TAC [measure_space_def,positive_not_infty,MEASURE_SPACE_INTER,IN_INSERT]
1780 >> Cases_on `s = {}`
1781 >- (FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY, IMAGE_DEF, IN_SING, BIGUNION,
1782 GSPECIFICATION, GSPEC_ID, SUBSET_DEF, add_rzero,
1783 EXTREAL_SUM_IMAGE_SING]
1784 >> METIS_TAC [SUBSET_INTER1,MEASURE_SPACE_SUBSET_MSPACE])
1785 >> `?x s'. (s = x INSERT s') /\ ~(x IN s')` by METIS_TAC [SET_CASES]
1786 >> FULL_SIMP_TAC std_ss [GSYM DELETE_NON_ELEMENT, IN_INSERT]
1787 >> Q.PAT_X_ASSUM `!b' m'. P ==> !a'. Q ==> (f = g)`
1788 (MP_TAC o Q.ISPECL [`(\i:num. if i = x then b x UNION b e else b i)`,
1789 `(m :('a -> bool) # (('a -> bool) -> bool) # (('a -> bool) -> extreal))`])
1790 >> `IMAGE (\i. (if i = x then b x UNION b e else b i)) s' = IMAGE b s'`
1791 by (RW_TAC std_ss [Once EXTENSION, IN_IMAGE]
1792 >> EQ_TAC
1793 >- (RW_TAC std_ss [] >> Q.EXISTS_TAC `i` >> METIS_TAC [])
1794 >> RW_TAC std_ss [] >> Q.EXISTS_TAC `x''` >> METIS_TAC [])
1795 >> FULL_SIMP_TAC std_ss [IMAGE_INSERT, BIGUNION_INSERT, UNION_ASSOC]
1796 >> POP_ASSUM (K ALL_TAC)
1797 >> `(b x UNION (b e UNION BIGUNION (IMAGE b s')) = m_space m)`
1798 by METIS_TAC [UNION_COMM,UNION_ASSOC]
1799 >> ASM_REWRITE_TAC []
1800 >> `(!i j. ((i = x) \/ i IN s') /\ ((j = x) \/ j IN s') /\ ~(i = j) ==>
1801 DISJOINT (if i = x then b x UNION b e else b i)
1802 (if j = x then b x UNION b e else b j))`
1803 by (FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, GSPECIFICATION, IN_INSERT,
1804 IN_INTER, NOT_IN_EMPTY]
1805 >> METIS_TAC [IN_UNION])
1806 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC)
1807 >> `(!i.
1808 (i = x) \/ i IN s' ==>
1809 (if i = x then b x UNION b e else b i) IN measurable_sets m)`
1810 by METIS_TAC [ALGEBRA_UNION, sigma_algebra_def, measure_space_def, subsets_def]
1811 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC)
1812 >> STRIP_TAC
1813 >> FULL_SIMP_TAC std_ss [UNION_ASSOC]
1814 >> POP_ASSUM MP_TAC >> ASM_REWRITE_TAC []
1815 >> DISCH_THEN (MP_TAC o Q.SPEC `a`) >> ASM_REWRITE_TAC []
1816 >> DISCH_TAC
1817 >> `!i. i IN x INSERT s' ==>
1818 (\i. measure m (a INTER if i = x then b x UNION b e else b i)) i <> NegInf`
1819 by (RW_TAC std_ss []
1820 >- (`a INTER (b i UNION b e) IN measurable_sets m`
1821 by METIS_TAC [MEASURE_SPACE_INTER,MEASURE_SPACE_UNION]
1822 >> METIS_TAC [measure_space_def,positive_not_infty])
1823 >> METIS_TAC [IN_INSERT])
1824 >> `!i. i IN (e INSERT x INSERT s') ==> (\i. measure m (a INTER b i)) i <> NegInf`
1825 by METIS_TAC [IN_INSERT]
1826 >> `!i. i IN (x INSERT s') ==> (\i. measure m (a INTER b i)) i <> NegInf`
1827 by METIS_TAC [IN_INSERT]
1828 >> `(x INSERT s') DELETE e = x INSERT s'` by METIS_TAC [EXTENSION,IN_DELETE,IN_INSERT]
1829 >> FULL_SIMP_TAC real_ss [FINITE_INSERT, EXTREAL_SUM_IMAGE_PROPERTY, DELETE_NON_ELEMENT]
1830 >> Suff `(measure m (a INTER (b x UNION b e)) =
1831 measure m (a INTER b e) + measure m (a INTER b x)) /\
1832 (SIGMA (\i. measure m (a INTER
1833 (if i = x then b x UNION b e else b i))) s' =
1834 SIGMA (\i. measure m (a INTER b i)) s')`
1835 >- (`measure m (a INTER (b x UNION b e)) <> NegInf`
1836 by METIS_TAC [MEASURE_SPACE_POSITIVE,positive_not_infty,MEASURE_SPACE_INTER,
1837 MEASURE_SPACE_UNION]
1838 >> `SIGMA (\i. measure m (a INTER if i = x then b x UNION b e else b i)) s' <> NegInf`
1839 by FULL_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_NOT_INFTY,IN_INSERT]
1840 >> METIS_TAC [add_assoc,IN_INSERT,EXTREAL_SUM_IMAGE_NOT_INFTY,add_not_infty,
1841 MEASURE_SPACE_POSITIVE,positive_not_infty,MEASURE_SPACE_INTER,
1842 MEASURE_SPACE_UNION])
1843 >> CONJ_TAC
1844 >- (`a INTER (b x UNION b e) = (a INTER b e) UNION (a INTER b x)`
1845 by (FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, GSPECIFICATION,
1846 NOT_IN_EMPTY, IN_INTER, IN_UNION]
1847 >> METIS_TAC [])
1848 >> POP_ORW
1849 >> (MATCH_MP_TAC o REWRITE_RULE [additive_def] o UNDISCH o Q.SPEC `m`)
1850 MEASURE_SPACE_ADDITIVE
1851 >> STRONG_CONJ_TAC
1852 >- METIS_TAC [ALGEBRA_INTER, sigma_algebra_def, measure_space_def, subsets_def]
1853 >> DISCH_TAC
1854 >> STRONG_CONJ_TAC
1855 >- METIS_TAC [ALGEBRA_INTER, sigma_algebra_def, measure_space_def, subsets_def]
1856 >> DISCH_TAC
1857 >> CONJ_TAC
1858 >- (FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] \\
1859 METIS_TAC [])
1860 >> METIS_TAC [ALGEBRA_UNION, sigma_algebra_def, measure_space_def, subsets_def])
1861 >> FULL_SIMP_TAC std_ss [(Once o UNDISCH o Q.ISPEC `(s' :num -> bool)`)
1862 EXTREAL_SUM_IMAGE_IN_IF, IN_INSERT]
1863 >> (MP_TAC o Q.SPEC `(\i. measure m (a INTER b i))` o UNDISCH o
1864 Q.ISPEC `(s' :num -> bool)`) EXTREAL_SUM_IMAGE_IN_IF
1865 >> RW_TAC std_ss []
1866 >> MATCH_MP_TAC (METIS_PROVE [] ``!f x y z. (x = y) ==> (f x z = f y z)``)
1867 >> RW_TAC std_ss [FUN_EQ_THM]
1868 >> RW_TAC std_ss []
1869 >> FULL_SIMP_TAC std_ss [GSYM DELETE_NON_ELEMENT]
1870QED
1871
1872(* ------------------------------------------------------------------------- *)
1873(* Uniqueness of Measure - Dynkin system [3] *)
1874(* ------------------------------------------------------------------------- *)
1875
1876(* `sigma-finite` is a property of measure space but sigma algebra.
1877
1878 The new definition based on ‘exhausting_sequence’ (was in martingaleTheory):
1879 *)
1880Definition sigma_finite :
1881 sigma_finite m = ?f. exhausting_sequence (m_space m,measurable_sets m) f /\
1882 !n. measure m (f n) < PosInf
1883End
1884(* another characterisation again appears much later with name "sigma_finite" *)
1885
1886(* The old definition now becomes an equivalent theorem: *)
1887Theorem sigma_finite_def :
1888 !m. sigma_finite m <=>
1889 ?f :num -> 'a set.
1890 f IN (UNIV -> measurable_sets m) /\
1891 (!n. f n SUBSET f (SUC n)) /\
1892 (BIGUNION (IMAGE f UNIV) = m_space m) /\
1893 (!n. measure m (f n) < PosInf)
1894Proof
1895 rw [sigma_finite, exhausting_sequence_def]
1896 >> METIS_TAC []
1897QED
1898
1899(* This definition is sometimes useful for not repeating ‘m’ *)
1900Definition sigma_finite_measure_space_def :
1901 sigma_finite_measure_space m = (measure_space m /\ sigma_finite m)
1902End
1903
1904(* NOTE: this definition should always be used together with a system of sets,
1905 e.g. algebra, ring, semiring, ... because by itself `m` is not meaningful. *)
1906Definition premeasure_def:
1907 premeasure m <=> positive m /\ countably_additive m
1908End
1909
1910(* connection with ‘sigma_finite’ *)
1911Theorem sigma_finite_has_exhausting_sequence :
1912 !sp sts u. sigma_finite (sp,sts,u) ==> has_exhausting_sequence (sp,sts)
1913Proof
1914 RW_TAC std_ss [sigma_finite_def, has_exhausting_sequence_def,
1915 m_space_def, measurable_sets_def, space_def, subsets_def]
1916 >> Q.EXISTS_TAC ‘f’ >> rw []
1917QED
1918
1919(* alternative definition of ‘sigma_finite’ *)
1920Theorem sigma_finite_alt_exhausting_sequence :
1921 !m. sigma_finite m <=>
1922 ?f. exhausting_sequence (m_space m,measurable_sets m) f /\
1923 !n. measure m (f n) < PosInf
1924Proof
1925 RW_TAC std_ss [sigma_finite_def, exhausting_sequence_def,
1926 space_def, subsets_def]
1927 >> EQ_TAC >> RW_TAC std_ss []
1928 >> Q.EXISTS_TAC ‘f’ >> art []
1929QED
1930
1931(* |- !m. sigma_finite m <=>
1932 ?f. (f IN (univ(:num) -> measurable_sets m) /\
1933 (!m n. m <= n ==> f m SUBSET f n) /\
1934 BIGUNION (IMAGE f univ(:num)) = m_space m) /\
1935 !n. measure m (f n) < PosInf
1936 *)
1937Theorem sigma_finite_alt =
1938 REWRITE_RULE [exhausting_sequence_alt, subsets_def, space_def]
1939 sigma_finite_alt_exhausting_sequence;
1940
1941(*****************************************************************************)
1942(* Premeasure properties of various systems of sets *)
1943(* ========================================================================= *)
1944(* Property name SEMIRING DYNKIN RING ALGEBRA MEASURE *)
1945(* ========================================================================= *)
1946(* INCREASING (MONOTONE) YES* YES YES YES YES *)
1947(* ADDITIVE YES YES YES YES YES *)
1948(* FINITE_ADDITIVE YES* YES YES YES YES *)
1949(* STRONG_ADDITIVE NO ? YES YES YES *)
1950(* SUBADDITIVE NO ? YES+ YES YES *)
1951(* FINITE_SUBADDIIVE NO ? YES+ YES YES *)
1952(* COUNTABLY_SUBADDITIVE NO ? YES* YES YES *)
1953(* COUNTABLE_INCREASING NO ? YES+ YES YES *)
1954(* COMPL_SUBSET NO YES? YES YES YES *)
1955(* COMPL NO YES? NO YES YES *)
1956(* ========================================================================= *)
1957(* [*] directly used in the proof of CARATHEODORY_SEMIRING *)
1958(* [+] indirectly used in the proof of CARATHEODORY_SEMIRING *)
1959(*****************************************************************************)
1960
1961Theorem ALGEBRA_PREMEASURE_ADDITIVE:
1962 !m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> additive m
1963Proof
1964 RW_TAC std_ss [premeasure_def]
1965 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE
1966 >> PROVE_TAC [ALGEBRA_EMPTY, subsets_def]
1967QED
1968
1969(* |- !m. algebra (m_space m,measurable_sets m) /\ positive m /\
1970 countably_additive m ==> additive m
1971 old name: COUNTABLY_ADDITIVE_ADDITIVE *)
1972Theorem ALGEBRA_COUNTABLY_ADDITIVE_ADDITIVE =
1973 REWRITE_RULE [premeasure_def] ALGEBRA_PREMEASURE_ADDITIVE;
1974
1975Theorem ALGEBRA_PREMEASURE_FINITE_ADDITIVE:
1976 !m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> finite_additive m
1977Proof
1978 RW_TAC std_ss [premeasure_def]
1979 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE
1980 >> PROVE_TAC [ALGEBRA_EMPTY, subsets_def]
1981QED
1982
1983Theorem MEASURE_FINITE_ADDITIVE:
1984 !m. measure_space m ==> finite_additive m
1985Proof
1986 RW_TAC std_ss [measure_space_def]
1987 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_FINITE_ADDITIVE >> art []
1988 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]
1989QED
1990
1991(*****************************************************************************)
1992
1993Theorem DYNKIN_SYSTEM_PREMEASURE_ADDITIVE:
1994 !m. dynkin_system (m_space m, measurable_sets m) /\ premeasure m ==> additive m
1995Proof
1996 RW_TAC std_ss [premeasure_def]
1997 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE
1998 >> PROVE_TAC [DYNKIN_SYSTEM_EMPTY, subsets_def]
1999QED
2000
2001Theorem DYNKIN_SYSTEM_PREMEASURE_FINITE_ADDITIVE:
2002 !m. dynkin_system (m_space m, measurable_sets m) /\ premeasure m ==> finite_additive m
2003Proof
2004 RW_TAC std_ss [premeasure_def]
2005 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE
2006 >> PROVE_TAC [DYNKIN_SYSTEM_EMPTY, subsets_def]
2007QED
2008
2009(*****************************************************************************)
2010
2011
2012(* Assume that (sp, A) is a measurable space and that (A = sigma sp sts) is generated by
2013 a family `sts` such that
2014
2015 - `sts` is stable under finite intersections: G,H IN sts ==> G INTER H IN sts;
2016 - there exists an exhausting sequence (f n) SUBSET g with (f n) --> X.
2017
2018 Any two measures u, v that coincide on sts and are finite for all members of the
2019 exhausting sequence u(f n) = v(f n) < Inf, are equal on sts, i.e. u(s) = v(s) for
2020 all s IN A.
2021 *)
2022Theorem UNIQUENESS_OF_MEASURE:
2023 !sp sts u v.
2024 subset_class sp sts /\
2025 (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\
2026 sigma_finite (sp,sts,u) /\
2027 measure_space (sp,subsets (sigma sp sts),u) /\
2028 measure_space (sp,subsets (sigma sp sts),v) /\
2029 (!s. s IN sts ==> (u s = v s))
2030 ==>
2031 (!s. s IN subsets (sigma sp sts) ==> (u s = v s))
2032Proof
2033 (* proof: expand `sigma_finite` first *)
2034 REWRITE_TAC [sigma_finite_def, space_def, subsets_def, m_space_def,
2035 measurable_sets_def, measure_def]
2036 >> rpt STRIP_TAC
2037 >> IMP_RES_TAC SIGMA_ALGEBRA_SIGMA
2038 >> Q.ABBREV_TAC `A = subsets (sigma sp sts)`
2039 >> Q.ABBREV_TAC `D = \j. (sp, {q | q IN A /\ (u (f j INTER q) = v (f j INTER q))})`
2040 >> `!j. space (D j) = sp` by METIS_TAC [space_def]
2041 >> IMP_RES_TAC DYNKIN_THM
2042 >> Know `!j. sts SUBSET subsets (D j)`
2043 >- (GEN_TAC >> REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\
2044 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2045 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2046 CONJ_TAC >- PROVE_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF] \\
2047 fs [IN_FUNSET, IN_UNIV])
2048 >> DISCH_TAC
2049 (* Part 1: u (f j INTER a) < PosInf *)
2050 >> Know `!n. v (f n) < PosInf`
2051 >- (GEN_TAC >> `f n IN sts` by PROVE_TAC [IN_UNIV, IN_FUNSET] \\
2052 PROVE_TAC [])
2053 >> DISCH_TAC
2054 >> Know `!j a. a IN A ==> u (f j INTER a) < PosInf`
2055 >- (rpt STRIP_TAC \\
2056 MATCH_MP_TAC let_trans \\
2057 Q.EXISTS_TAC `u (f j)` >> ASM_REWRITE_TAC [] \\
2058 `u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\
2059 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2060 MATCH_MP_TAC INCREASING \\
2061 CONJ_TAC >- IMP_RES_TAC MEASURE_SPACE_INCREASING \\
2062 CONJ_TAC >- REWRITE_TAC [INTER_SUBSET] \\
2063 REWRITE_TAC [measurable_sets_def, Once CONJ_COMM] \\
2064 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2065 STRONG_CONJ_TAC >- PROVE_TAC [IN_UNIV, IN_FUNSET, SUBSET_DEF] \\
2066 DISCH_TAC \\
2067 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\
2068 fs [sigma_algebra_def])
2069 >> DISCH_TAC
2070 >> Know `!j a. a IN A ==> v (f j INTER a) < PosInf`
2071 >- (rpt STRIP_TAC \\
2072 MATCH_MP_TAC let_trans \\
2073 Q.EXISTS_TAC `v (f j)` >> ASM_REWRITE_TAC [] \\
2074 `v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\
2075 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2076 MATCH_MP_TAC INCREASING \\
2077 CONJ_TAC >- IMP_RES_TAC MEASURE_SPACE_INCREASING \\
2078 CONJ_TAC >- REWRITE_TAC [INTER_SUBSET] \\
2079 REWRITE_TAC [measurable_sets_def, Once CONJ_COMM] \\
2080 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2081 STRONG_CONJ_TAC >- PROVE_TAC [IN_UNIV, IN_FUNSET, SUBSET_DEF] \\
2082 DISCH_TAC \\
2083 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\
2084 fs [sigma_algebra_def])
2085 >> DISCH_TAC
2086 (* Part 2: (D j) is dynkin system *)
2087 >> Know `!j. dynkin_system (D j)`
2088 >- (GEN_TAC >> REWRITE_TAC [dynkin_system_def] \\
2089 CONJ_TAC (* subset_class (space (D j)) (subsets (D j)) *)
2090 >- (Q.PAT_X_ASSUM `!j. space (D j) = sp` (REWRITE_TAC o wrap) \\
2091 REWRITE_TAC [subset_class_def] >> GEN_TAC \\
2092 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2093 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2094 `subset_class sp A` by PROVE_TAC [SPACE_SIGMA, sigma_algebra_def, algebra_def] \\
2095 STRIP_TAC >> PROVE_TAC [subset_class_def]) \\
2096 CONJ_TAC (* space (D j) IN subsets (D j) *)
2097 >- (ASM_REWRITE_TAC [] \\
2098 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2099 `!n. f n SUBSET sp` by PROVE_TAC [IN_UNIV, IN_FUNSET, subset_class_def] \\
2100 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2101 CONJ_TAC (* sp IN A *)
2102 >- (Q.UNABBREV_TAC `A` \\
2103 Suff `space (sigma sp sts) IN subsets (sigma sp sts)` >- PROVE_TAC [SPACE_SIGMA] \\
2104 MATCH_MP_TAC (Q.SPEC `sigma sp sts` ALGEBRA_SPACE) \\
2105 PROVE_TAC [sigma_algebra_def]) \\
2106 (* u (f j INTER sp) = v (f j INTER sp) *)
2107 `f j INTER sp = f j` by PROVE_TAC [INTER_SUBSET_EQN] \\
2108 POP_ASSUM (REWRITE_TAC o wrap) \\
2109 PROVE_TAC [IN_FUNSET, IN_UNIV]) \\
2110 CONJ_TAC (* under COMPL *)
2111 >- (Q.X_GEN_TAC `a` >> ONCE_ASM_REWRITE_TAC [] \\
2112 Q.UNABBREV_TAC `D` >> BETA_TAC >> SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2113 STRIP_TAC >> CONJ_TAC
2114 >- (Q.UNABBREV_TAC `A` \\
2115 `sp DIFF a = space (sigma sp sts) DIFF a` by PROVE_TAC [SPACE_SIGMA] \\
2116 POP_ASSUM (REWRITE_TAC o wrap) \\
2117 MATCH_MP_TAC ALGEBRA_COMPL \\
2118 PROVE_TAC [sigma_algebra_def]) \\
2119 `!n. f n SUBSET sp` by PROVE_TAC [IN_UNIV, IN_FUNSET, subset_class_def] \\
2120 `f j INTER (sp DIFF a) = f j DIFF (f j INTER a)` by ASM_SET_TAC [] \\
2121 POP_ASSUM (REWRITE_TAC o wrap) \\
2122 `(f j INTER a) SUBSET f j` by ASM_SET_TAC [] \\
2123 Know `u (f j DIFF (f j INTER a)) = u (f j) - u (f j INTER a)`
2124 >- (`u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\
2125 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2126 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\
2127 ASM_REWRITE_TAC [measurable_sets_def, measure_def] \\
2128 STRONG_CONJ_TAC (* f j IN A *)
2129 >- (Q.UNABBREV_TAC `A` \\
2130 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2131 PROVE_TAC [SUBSET_DEF, IN_FUNSET, IN_UNIV]) \\
2132 DISCH_TAC >> CONJ_TAC
2133 >- (Q.UNABBREV_TAC `A` \\
2134 MATCH_MP_TAC ALGEBRA_INTER >> PROVE_TAC [sigma_algebra_def]) \\
2135 PROVE_TAC []) \\
2136 DISCH_TAC \\
2137 Know `v (f j DIFF (f j INTER a)) = v (f j) - v (f j INTER a)`
2138 >- (`v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\
2139 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2140 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\
2141 ASM_REWRITE_TAC [measurable_sets_def, measure_def] \\
2142 STRONG_CONJ_TAC (* f j IN A *)
2143 >- (Q.UNABBREV_TAC `A` \\
2144 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2145 PROVE_TAC [SUBSET_DEF, IN_FUNSET, IN_UNIV]) \\
2146 DISCH_TAC >> CONJ_TAC
2147 >- (Q.UNABBREV_TAC `A` \\
2148 MATCH_MP_TAC ALGEBRA_INTER >> PROVE_TAC [sigma_algebra_def]) \\
2149 PROVE_TAC []) \\
2150 DISCH_TAC \\
2151 NTAC 2 (POP_ASSUM (ONCE_REWRITE_TAC o wrap)) \\
2152 fs [IN_UNIV, IN_FUNSET]) \\
2153 (* 4. under COUNTABLE DIJOINT UNION *)
2154 Q.X_GEN_TAC `g` >> rpt STRIP_TAC \\
2155 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2156 Q.PAT_X_ASSUM `g IN X` MP_TAC \\
2157 SIMP_TAC std_ss [subsets_def, GSPECIFICATION, IN_UNIV, IN_FUNSET] \\
2158 STRIP_TAC \\
2159 CONJ_TAC (* BIGUNION (IMAGE g univ(:num)) IN A *)
2160 >- (Q.UNABBREV_TAC `A` \\
2161 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT]
2162 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\
2163 POP_ASSUM MATCH_MP_TAC \\
2164 fs [IN_FUNSET, IN_UNIV]) \\
2165 REWRITE_TAC [ONCE_REWRITE_RULE [INTER_COMM] BIGUNION_OVER_INTER_L] \\
2166 Know `u (BIGUNION (IMAGE (\i. f j INTER g i) univ(:num))) = suminf (u o (\i. f j INTER g i))`
2167 >- (`countably_additive (sp,A,u)` by PROVE_TAC [measure_space_def] \\
2168 POP_ASSUM (MATCH_MP_TAC o
2169 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\
2170 CONJ_TAC
2171 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> BETA_TAC \\
2172 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\
2173 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\
2174 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2175 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\
2176 METIS_TAC []) \\
2177 CONJ_TAC (* disjoint *)
2178 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC \\
2179 BETA_TAC >> ASM_SET_TAC []) \\
2180 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT]
2181 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\
2182 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\
2183 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] \\
2184 GEN_TAC >> MATCH_MP_TAC ALGEBRA_INTER \\
2185 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2186 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2187 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\
2188 METIS_TAC []) \\
2189 DISCH_THEN (REWRITE_TAC o wrap) \\
2190 Know `v (BIGUNION (IMAGE (\i. f j INTER g i) univ(:num))) = suminf (v o (\i. f j INTER g i))`
2191 >- (`countably_additive (sp,A,v)` by PROVE_TAC [measure_space_def] \\
2192 POP_ASSUM (MATCH_MP_TAC o
2193 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\
2194 CONJ_TAC
2195 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> BETA_TAC \\
2196 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\
2197 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\
2198 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2199 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\
2200 METIS_TAC []) \\
2201 CONJ_TAC (* disjoint *)
2202 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC \\
2203 BETA_TAC >> ASM_SET_TAC []) \\
2204 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT]
2205 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\
2206 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\
2207 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] \\
2208 GEN_TAC >> MATCH_MP_TAC ALGEBRA_INTER \\
2209 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2210 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2211 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\
2212 METIS_TAC []) \\
2213 DISCH_THEN (REWRITE_TAC o wrap) \\
2214 `u o (\i. f j INTER g i) = \i. u (f j INTER g i)` by METIS_TAC [o_DEF] \\
2215 POP_ASSUM (REWRITE_TAC o wrap) \\
2216 `v o (\i. f j INTER g i) = \i. v (f j INTER g i)` by METIS_TAC [o_DEF] \\
2217 POP_ASSUM (REWRITE_TAC o wrap) \\
2218 Know `(\i. u (f j INTER g i)) = (\i. v (f j INTER g i))`
2219 >- (FUN_EQ_TAC >> GEN_TAC >> BETA_TAC >> METIS_TAC []) \\
2220 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
2221 KILL_TAC >> METIS_TAC [])
2222 >> DISCH_TAC
2223 (* Part 3: the main proof *)
2224 >> Know `!j. subsets (sigma sp sts) SUBSET subsets (D j)`
2225 >- (Q.PAT_ASSUM `dynkin sp sts = sigma sp sts` (ONCE_REWRITE_TAC o wrap o SYM) \\
2226 GEN_TAC >> `sts SUBSET subsets (D j)` by PROVE_TAC [] \\
2227 POP_ASSUM (MP_TAC o (MATCH_MP (Q.SPECL [`sp`, `sts`, `subsets (D j)`] DYNKIN_MONOTONE))) \\
2228 METIS_TAC [(Q.SPEC `D j` DYNKIN_STABLE)])
2229 >> DISCH_TAC
2230 >> Know `!j. A = subsets (D j)`
2231 >- (GEN_TAC >> REWRITE_TAC [SET_EQ_SUBSET] \\
2232 CONJ_TAC >- PROVE_TAC [] \\
2233 REWRITE_TAC [SUBSET_DEF] \\
2234 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2235 SIMP_TAC std_ss [subsets_def, GSPECIFICATION])
2236 >> DISCH_TAC
2237 >> Know `!j a. a IN A ==> (u (f j INTER a) = v (f j INTER a))`
2238 >- (ASM_REWRITE_TAC [] >> rpt GEN_TAC \\
2239 Q.UNABBREV_TAC `D` >> KILL_TAC >> BETA_TAC \\
2240 SIMP_TAC std_ss [subsets_def, GSPECIFICATION])
2241 >> DISCH_TAC
2242 >> Know `!a. a IN A ==> (u a = sup (IMAGE (u o (\i. (f i) INTER a)) UNIV))`
2243 >- (rpt STRIP_TAC \\
2244 Q.ABBREV_TAC `g = \i. f i INTER a` \\
2245 MATCH_MP_TAC EQ_SYM \\
2246 `u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\
2247 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2248 MATCH_MP_TAC MONOTONE_CONVERGENCE \\ (* the "sup" is removed here! *)
2249 REWRITE_TAC [measurable_sets_def] \\
2250 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2251 CONJ_TAC
2252 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] \\
2253 GEN_TAC >> Q.UNABBREV_TAC `g` >> BETA_TAC \\
2254 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\
2255 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\
2256 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2257 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\
2258 ASM_REWRITE_TAC []) \\
2259 CONJ_TAC (* !n. g n SUBSET g (SUC n) *)
2260 >- (Q.UNABBREV_TAC `g` >> BETA_TAC \\
2261 GEN_TAC >> ASM_SET_TAC []) \\
2262 (* a = BIGUNION (IMAGE g univ(:num)) *)
2263 Q.UNABBREV_TAC `g` >> BETA_TAC \\
2264 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L] \\
2265 Suff `a SUBSET sp` >- PROVE_TAC [INTER_SUBSET_EQN] \\
2266 Q.UNABBREV_TAC `A` \\
2267 `subset_class sp (subsets (sigma sp sts))`
2268 by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\
2269 PROVE_TAC [subset_class_def])
2270 >> DISCH_TAC
2271 >> Know `!a. a IN subsets (sigma sp sts) ==>
2272 (v a = sup (IMAGE (v o (\i. (f i) INTER a)) UNIV))`
2273 >- (rpt STRIP_TAC \\
2274 Q.ABBREV_TAC `g = \i. f i INTER a` \\
2275 MATCH_MP_TAC EQ_SYM \\
2276 `v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\
2277 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2278 MATCH_MP_TAC MONOTONE_CONVERGENCE \\ (* the "sup" is removed here! *)
2279 REWRITE_TAC [measurable_sets_def] \\
2280 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2281 CONJ_TAC
2282 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] \\
2283 GEN_TAC >> Q.UNABBREV_TAC `g` >> BETA_TAC \\
2284 Q.UNABBREV_TAC `A` >> MATCH_MP_TAC ALGEBRA_INTER \\
2285 CONJ_TAC >- PROVE_TAC [sigma_algebra_def] \\
2286 ASSUME_TAC (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS) \\
2287 CONJ_TAC >- PROVE_TAC [subset_class_def, IN_FUNSET, IN_UNIV, SUBSET_DEF] \\
2288 ASM_REWRITE_TAC []) \\
2289 CONJ_TAC (* !n. g n SUBSET g (SUC n) *)
2290 >- (Q.UNABBREV_TAC `g` >> BETA_TAC \\
2291 GEN_TAC >> ASM_SET_TAC []) \\
2292 (* a = BIGUNION (IMAGE g univ(:num)) *)
2293 Q.UNABBREV_TAC `g` >> BETA_TAC \\
2294 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L] \\
2295 Suff `a SUBSET sp` >- PROVE_TAC [INTER_SUBSET_EQN] \\
2296 Q.UNABBREV_TAC `A` \\
2297 `subset_class sp (subsets (sigma sp sts))`
2298 by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\
2299 PROVE_TAC [subset_class_def])
2300 >> DISCH_TAC >> RES_TAC >> fs [o_DEF]
2301QED
2302
2303(* In this version, added assums: `(u sp = v sp) /\ (u sp < PosInf)`
2304 removed assums: `sigma_finite (sp,sts,u)`
2305
2306 see https://en.wikipedia.org/wiki/Pi-system
2307 *)
2308Theorem UNIQUENESS_OF_MEASURE_FINITE:
2309 !sp sts u v.
2310 subset_class sp sts /\
2311 (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\
2312 measure_space (sp,subsets (sigma sp sts),u) /\
2313 measure_space (sp,subsets (sigma sp sts),v) /\
2314 (u sp = v sp) /\ (u sp < PosInf) /\ (!s. s IN sts ==> (u s = v s))
2315 ==>
2316 (!s. s IN subsets (sigma sp sts) ==> (u s = v s))
2317Proof
2318 rpt STRIP_TAC
2319 (* Part 1: some common facts *)
2320 >> IMP_RES_TAC SIGMA_ALGEBRA_SIGMA
2321 >> Q.ABBREV_TAC `A = subsets (sigma sp sts)`
2322 >> Q.ABBREV_TAC `D = (sp, {q | q IN A /\ (u q = v q)})`
2323 >> `space D = sp` by METIS_TAC [space_def]
2324 >> IMP_RES_TAC DYNKIN_THM
2325 >> Know `sts SUBSET subsets D`
2326 >- (REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\
2327 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2328 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2329 CONJ_TAC >- PROVE_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF] >> fs [])
2330 >> DISCH_TAC
2331 (* Part 2: D is dynkin system *)
2332 >> Know `dynkin_system D`
2333 >- (REWRITE_TAC [dynkin_system_def] \\
2334 CONJ_TAC (* subset_class (space D) (subsets D) *)
2335 >- (Q.PAT_X_ASSUM `space D = sp` (REWRITE_TAC o wrap) \\
2336 REWRITE_TAC [subset_class_def] >> GEN_TAC \\
2337 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2338 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2339 `subset_class sp A` by PROVE_TAC [SPACE_SIGMA, sigma_algebra_def, algebra_def] \\
2340 STRIP_TAC >> PROVE_TAC [subset_class_def]) \\
2341 CONJ_TAC (* space D IN subsets D *)
2342 >- (ASM_REWRITE_TAC [] \\
2343 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2344 SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2345 CONJ_TAC (* sp IN A *)
2346 >- (Q.UNABBREV_TAC `A` \\
2347 Suff `space (sigma sp sts) IN subsets (sigma sp sts)` >- PROVE_TAC [SPACE_SIGMA] \\
2348 MATCH_MP_TAC (Q.SPEC `sigma sp sts` ALGEBRA_SPACE) \\
2349 PROVE_TAC [sigma_algebra_def]) \\
2350 ASM_REWRITE_TAC []) \\
2351 CONJ_TAC (* under COMPL *)
2352 >- (Q.X_GEN_TAC `a` >> ONCE_ASM_REWRITE_TAC [] \\
2353 Q.UNABBREV_TAC `D` >> BETA_TAC >> SIMP_TAC std_ss [subsets_def, GSPECIFICATION] \\
2354 STRIP_TAC >> CONJ_TAC (* sp DIFF a IN A *)
2355 >- (Q.UNABBREV_TAC `A` \\
2356 `sp DIFF a = space (sigma sp sts) DIFF a` by PROVE_TAC [SPACE_SIGMA] \\
2357 POP_ASSUM (REWRITE_TAC o wrap) \\
2358 MATCH_MP_TAC ALGEBRA_COMPL \\
2359 PROVE_TAC [sigma_algebra_def]) \\
2360 Know `u (sp DIFF a) = u sp - u a`
2361 >- (`u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\
2362 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2363 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\
2364 REWRITE_TAC [measurable_sets_def, measure_def] \\
2365 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2366 STRONG_CONJ_TAC >- PROVE_TAC [sigma_algebra_def, ALGEBRA_SPACE, SPACE_SIGMA] \\
2367 DISCH_TAC \\
2368 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2369 STRONG_CONJ_TAC (* a SUBSET sp *)
2370 >- (`subset_class sp A` by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\
2371 PROVE_TAC [subset_class_def]) \\
2372 DISCH_TAC \\
2373 MATCH_MP_TAC let_trans \\
2374 Q.EXISTS_TAC `u sp` \\
2375 reverse CONJ_TAC >- ASM_REWRITE_TAC [] \\
2376 (* u a <= u sp *)
2377 `u = measure (sp,A,u)` by PROVE_TAC [measure_def] \\
2378 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2379 MATCH_MP_TAC INCREASING \\
2380 CONJ_TAC >- PROVE_TAC [MEASURE_SPACE_INCREASING] \\
2381 ASM_REWRITE_TAC [measurable_sets_def]) \\
2382 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
2383 Know `v (sp DIFF a) = v sp - v a`
2384 >- (`v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\
2385 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2386 MATCH_MP_TAC MEASURE_DIFF_SUBSET \\
2387 REWRITE_TAC [measurable_sets_def, measure_def] \\
2388 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2389 STRONG_CONJ_TAC >- PROVE_TAC [sigma_algebra_def, ALGEBRA_SPACE, SPACE_SIGMA] \\
2390 DISCH_TAC \\
2391 CONJ_TAC >- ASM_REWRITE_TAC [] \\
2392 STRONG_CONJ_TAC (* a SUBSET sp *)
2393 >- (`subset_class sp A` by PROVE_TAC [sigma_algebra_def, algebra_def, SPACE_SIGMA] \\
2394 PROVE_TAC [subset_class_def]) \\
2395 DISCH_TAC \\
2396 MATCH_MP_TAC let_trans \\
2397 Q.EXISTS_TAC `v sp` \\
2398 reverse CONJ_TAC >- PROVE_TAC [] \\
2399 (* v a <= v sp *)
2400 `v = measure (sp,A,v)` by PROVE_TAC [measure_def] \\
2401 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
2402 MATCH_MP_TAC INCREASING \\
2403 CONJ_TAC >- PROVE_TAC [MEASURE_SPACE_INCREASING] \\
2404 ASM_REWRITE_TAC [measurable_sets_def]) \\
2405 DISCH_THEN (ONCE_REWRITE_TAC o wrap) >> fs []) \\
2406 (* under COUNTABLE UNION *)
2407 Q.X_GEN_TAC `g` >> rpt STRIP_TAC \\
2408 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2409 Q.PAT_X_ASSUM `g IN X` MP_TAC \\
2410 SIMP_TAC std_ss [subsets_def, GSPECIFICATION, IN_UNIV, IN_FUNSET] \\
2411 STRIP_TAC >> CONJ_TAC
2412 (* BIGUNION (IMAGE g univ(:num)) IN A *)
2413 >- (Q.UNABBREV_TAC `A` \\
2414 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT]
2415 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\
2416 POP_ASSUM MATCH_MP_TAC \\
2417 fs [IN_FUNSET, IN_UNIV]) \\
2418 (* u (BIGUNION (IMAGE g univ(:num))) = v (BIGUNION (IMAGE g univ(:num))) *)
2419 Know `u (BIGUNION (IMAGE g univ(:num))) = suminf (u o g)`
2420 >- (`countably_additive (sp,A,u)` by PROVE_TAC [measure_space_def] \\
2421 POP_ASSUM (MATCH_MP_TAC o
2422 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\
2423 CONJ_TAC
2424 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> METIS_TAC []) \\
2425 CONJ_TAC (* disjoint *)
2426 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC >> METIS_TAC []) \\
2427 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT]
2428 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\
2429 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\
2430 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] >> METIS_TAC []) \\
2431 DISCH_THEN (REWRITE_TAC o wrap) \\
2432 Know `v (BIGUNION (IMAGE g univ(:num))) = suminf (v o g)`
2433 >- (`countably_additive (sp,A,v)` by PROVE_TAC [measure_space_def] \\
2434 POP_ASSUM (MATCH_MP_TAC o
2435 (REWRITE_RULE [countably_additive_def, measurable_sets_def, measure_def])) \\
2436 CONJ_TAC
2437 >- (REWRITE_TAC [IN_UNIV, IN_FUNSET] >> GEN_TAC >> METIS_TAC []) \\
2438 CONJ_TAC (* disjoint *)
2439 >- (Q.X_GEN_TAC `k` >> Q.X_GEN_TAC `l` >> DISCH_TAC >> METIS_TAC []) \\
2440 STRIP_ASSUME_TAC (REWRITE_RULE [SIGMA_ALGEBRA_ALT]
2441 (ASSUME ``sigma_algebra (sigma sp sts)``)) \\
2442 Q.UNABBREV_TAC `A` >> POP_ASSUM MATCH_MP_TAC \\
2443 SIMP_TAC std_ss [IN_UNIV, IN_FUNSET] >> METIS_TAC []) \\
2444 DISCH_THEN (REWRITE_TAC o wrap) \\
2445 `u o g = \i. u (g i)` by METIS_TAC [o_DEF] \\
2446 POP_ASSUM (REWRITE_TAC o wrap) \\
2447 `v o g = \i. v (g i)` by METIS_TAC [o_DEF] \\
2448 POP_ASSUM (REWRITE_TAC o wrap) \\
2449 Know `(\i. u (g i)) = (\i. v (g i))`
2450 >- (FUN_EQ_TAC >> GEN_TAC >> BETA_TAC >> METIS_TAC []) \\
2451 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
2452 KILL_TAC >> METIS_TAC [])
2453 >> DISCH_TAC
2454 (* Part 3: the main proof, much easier than those in UNIQUENESS_OF_MEASURE *)
2455 >> Know `subsets (sigma sp sts) SUBSET subsets D`
2456 >- (Q.PAT_ASSUM `dynkin sp sts = sigma sp sts` (ONCE_REWRITE_TAC o wrap o SYM) \\
2457 Q.PAT_ASSUM `sts SUBSET subsets D`
2458 (MP_TAC o (MATCH_MP (Q.SPECL [`sp`, `sts`, `subsets D`] DYNKIN_MONOTONE))) \\
2459 METIS_TAC [Q.SPEC `D` DYNKIN_STABLE])
2460 >> DISCH_TAC
2461 >> Know `A = subsets D`
2462 >- (REWRITE_TAC [SET_EQ_SUBSET] \\
2463 CONJ_TAC >- PROVE_TAC [] \\
2464 REWRITE_TAC [SUBSET_DEF] \\
2465 Q.UNABBREV_TAC `D` >> BETA_TAC \\
2466 SIMP_TAC std_ss [subsets_def, GSPECIFICATION])
2467 >> DISCH_TAC
2468 >> Know `!a. a IN A ==> (u a = v a)`
2469 >- (ASM_REWRITE_TAC [] >> rpt GEN_TAC \\
2470 Q.UNABBREV_TAC `D` >> KILL_TAC >> BETA_TAC \\
2471 SIMP_TAC std_ss [subsets_def, GSPECIFICATION])
2472 >> DISCH_TAC >> RES_TAC
2473QED
2474
2475(* Dynkin system is closed under subset diff, a little surprised *)
2476Theorem DYNKIN_SYSTEM_DIFF_SUBSET:
2477 !d s t. dynkin_system d /\ s IN subsets d /\ t IN subsets d /\ s SUBSET t ==>
2478 t DIFF s IN subsets d
2479Proof
2480 rpt STRIP_TAC
2481 >> `subset_class (space d) (subsets d)` by PROVE_TAC [dynkin_system_def]
2482 >> `t DIFF s = space d DIFF ((space d DIFF t) UNION s)` by ASM_SET_TAC [subset_class_def]
2483 >> POP_ORW
2484 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL >> art []
2485 >> `DISJOINT (space d DIFF t) s` by ASM_SET_TAC [DISJOINT_DEF, subset_class_def]
2486 >> MATCH_MP_TAC DYNKIN_SYSTEM_DUNION >> art []
2487 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL >> art []
2488QED
2489
2490Theorem DYNKIN_SYSTEM_PREMEASURE_INCREASING:
2491 !m. dynkin_system (m_space m, measurable_sets m) /\ premeasure m ==> increasing m
2492Proof
2493 rpt STRIP_TAC
2494 >> `additive m` by PROVE_TAC [DYNKIN_SYSTEM_PREMEASURE_ADDITIVE]
2495 >> fs [premeasure_def, increasing_def, positive_def]
2496 >> rpt STRIP_TAC
2497 >> `t = s UNION (t DIFF s)` by PROVE_TAC [UNION_DIFF] >> POP_ORW
2498 >> `DISJOINT s (t DIFF s)` by SET_TAC [DISJOINT_DEF]
2499 >> `t DIFF s IN measurable_sets m` by PROVE_TAC [DYNKIN_SYSTEM_DIFF_SUBSET, subsets_def]
2500 >> Know `measure m (s UNION (t DIFF s)) = measure m s + measure m (t DIFF s)`
2501 >- (MATCH_MP_TAC ADDITIVE >> art [] \\
2502 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
2503 (Q.SPEC `(m_space m,measurable_sets m)` DYNKIN_SYSTEM_DUNION)) \\
2504 ASM_REWRITE_TAC []) >> Rewr'
2505 >> MATCH_MP_TAC le_addr_imp >> PROVE_TAC []
2506QED
2507
2508(* ------------------------------------------------------------------------- *)
2509(* Existence of Measure - Caratheodory's celebrated extension theorem *)
2510(* ------------------------------------------------------------------------- *)
2511
2512(* (measure m) is an outer measure in (m_space m, measurable_sets m), which may
2513 not even be an algebra but at least `{} IN measurable_sets m` should hold. *)
2514Definition outer_measure_space_def:
2515 outer_measure_space m <=>
2516 subset_class (m_space m) (measurable_sets m) /\
2517 {} IN (measurable_sets m) /\
2518 positive m /\ increasing m /\ countably_subadditive m
2519End
2520
2521(* Definition 18.1 [1, p.198] (countable S-covers with a diameter)
2522
2523 Notice that `BIGUNION (IMAGE f UNIV)` needs not be disjoint or in `sts`.
2524 *)
2525Definition metric_countable_covers_def :
2526 metric_countable_covers (d :'a metric) (e :extreal) (sts :'a set set) =
2527 \a. {f | f IN (univ(:num) -> sts) /\ a SUBSET (BIGUNION (IMAGE f UNIV)) /\
2528 !i. Normal (set_diameter d (f i)) <= e}
2529End
2530
2531Overload countable_covers = “metric_countable_covers ARB PosInf”
2532
2533Theorem countable_covers_def :
2534 !sts. countable_covers (sts :'a set set) =
2535 \a. {f | f IN (univ(:num) -> sts) /\ a SUBSET (BIGUNION (IMAGE f UNIV))}
2536Proof
2537 RW_TAC std_ss [metric_countable_covers_def, le_infty]
2538QED
2539
2540(* Defition 18.1 of [1]: outer measure of the set-function m for C (covering),
2541 which could be `coutable_covers sts`. *)
2542Definition outer_measure_def:
2543 outer_measure (m :'a measure) (C :('a set) -> (num -> 'a set) set) =
2544 \a. inf {r | ?f. f IN (C a) /\ (suminf (m o f) = r)}
2545End
2546
2547(* Defition 18.1 of [1]: m-measurable sets (caratheodory sets) of m *)
2548Definition caratheodory_sets_def:
2549 caratheodory_sets (sp :'a set) (m :'a measure) =
2550 {a | a SUBSET sp /\ !q. q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a))}
2551End
2552
2553(* premeasure ==> countably_additive ==> additive *)
2554Theorem SEMIRING_PREMEASURE_ADDITIVE:
2555 !m. semiring (m_space m, measurable_sets m) /\ premeasure m ==> additive m
2556Proof
2557 RW_TAC std_ss [premeasure_def]
2558 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE
2559 >> PROVE_TAC [SEMIRING_EMPTY, subsets_def]
2560QED
2561
2562(* premeasure ==> countably_additive ==> finite_additive *)
2563Theorem SEMIRING_PREMEASURE_FINITE_ADDITIVE:
2564 !m. semiring (m_space m, measurable_sets m) /\ premeasure m ==>
2565 finite_additive m
2566Proof
2567 rpt STRIP_TAC
2568 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE
2569 >> PROVE_TAC [SEMIRING_EMPTY, subsets_def, premeasure_def]
2570QED
2571
2572Theorem SEMIRING_PREMEASURE_INCREASING :
2573 !m. semiring (m_space m, measurable_sets m) /\ premeasure m ==> increasing m
2574Proof
2575 rpt STRIP_TAC
2576 >> IMP_RES_TAC SEMIRING_PREMEASURE_FINITE_ADDITIVE
2577 >> fs [increasing_def, positive_def, premeasure_def]
2578 >> rpt STRIP_TAC
2579 >> `t = s UNION (t DIFF s)` by PROVE_TAC [UNION_DIFF] >> POP_ORW
2580 >> `DISJOINT s (t DIFF s)` by SET_TAC [DISJOINT_DEF]
2581 >> fs [semiring_def, space_def, subsets_def,Excl"UNION_DIFF_EQ"]
2582 >> `?c. c SUBSET measurable_sets m /\ FINITE c /\ disjoint c /\ (t DIFF s = BIGUNION c)`
2583 by PROVE_TAC [] >> art []
2584 >> REWRITE_TAC [GSYM BIGUNION_INSERT]
2585 >> Know `FINITE (s INSERT c) /\ disjoint (s INSERT c)`
2586 >- (CONJ_TAC >- PROVE_TAC [FINITE_INSERT] \\
2587 ONCE_REWRITE_TAC [INSERT_SING_UNION] \\
2588 MATCH_MP_TAC disjoint_union >> art [disjoint_sing, BIGUNION_SING] \\
2589 PROVE_TAC [DISJOINT_DEF])
2590 >> DISCH_THEN (STRIP_ASSUME_TAC o (MATCH_MP finite_disjoint_decomposition))
2591 >> ASM_REWRITE_TAC []
2592 >> Know `measure m (BIGUNION (IMAGE f (count n))) = SIGMA (measure m o f) (count n)`
2593 >- (fs [finite_additive_def] \\
2594 FIRST_X_ASSUM MATCH_MP_TAC \\
2595 RW_TAC std_ss [] >- PROVE_TAC [SUBSET_DEF] \\
2596 Q.PAT_X_ASSUM `s INSERT c = IMAGE f (count n)` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\
2597 REWRITE_TAC [BIGUNION_INSERT] \\
2598 Q.PAT_X_ASSUM `t DIFF s = BIGUNION c` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\
2599 `s UNION (t DIFF s) = t` by PROVE_TAC [UNION_DIFF] \\
2600 POP_ASSUM (ASM_REWRITE_TAC o wrap))
2601 >> Rewr
2602 >> Know `SIGMA (measure m o f) (count n) = SIGMA (measure m) (IMAGE f (count n))`
2603 >- (MATCH_MP_TAC EQ_SYM >> irule EXTREAL_SUM_IMAGE_IMAGE \\
2604 REWRITE_TAC [FINITE_COUNT, IN_IMAGE, IN_COUNT] \\
2605 CONJ_TAC >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\
2606 MATCH_MP_TAC pos_not_neginf >> art [] \\
2607 fs [IN_INSERT] >> METIS_TAC [SUBSET_DEF]) \\
2608 MATCH_MP_TAC INJ_IMAGE \\
2609 Q.EXISTS_TAC `s INSERT c` \\
2610 RW_TAC std_ss [INJ_DEF, IN_COUNT] >> METIS_TAC [])
2611 >> Rewr'
2612 >> Q.PAT_X_ASSUM `s INSERT c = IMAGE f (count n)` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM))
2613 >> Know `SIGMA (measure m) (s INSERT c) = measure m s + SIGMA (measure m) (c DELETE s)`
2614 >- (STRIP_ASSUME_TAC (Q.ISPEC `measure m` EXTREAL_SUM_IMAGE_THM) \\
2615 POP_ASSUM MATCH_MP_TAC >> art [] \\
2616 DISJ2_TAC >> GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\
2617 FIRST_X_ASSUM MATCH_MP_TAC >> fs [IN_INSERT] >> PROVE_TAC [SUBSET_DEF])
2618 >> Rewr
2619 >> MATCH_MP_TAC le_addr_imp
2620 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS
2621 >> RW_TAC std_ss [FINITE_DELETE, IN_DELETE]
2622 >> PROVE_TAC [SUBSET_DEF]
2623QED
2624
2625Theorem RING_PREMEASURE_INCREASING:
2626 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==> increasing m
2627Proof
2628 rpt STRIP_TAC
2629 >> MATCH_MP_TAC SEMIRING_PREMEASURE_INCREASING >> art []
2630 >> IMP_RES_TAC RING_IMP_SEMIRING
2631QED
2632
2633Theorem ALGEBRA_PREMEASURE_INCREASING:
2634 !m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> increasing m
2635Proof
2636 rpt STRIP_TAC
2637 >> MATCH_MP_TAC RING_PREMEASURE_INCREASING >> art []
2638 >> IMP_RES_TAC ALGEBRA_IMP_RING
2639QED
2640
2641Theorem RING_PREMEASURE_ADDITIVE:
2642 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==> additive m
2643Proof
2644 RW_TAC std_ss [premeasure_def]
2645 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE
2646 >> PROVE_TAC [RING_EMPTY, subsets_def]
2647QED
2648
2649Theorem RING_PREMEASURE_FINITE_ADDITIVE:
2650 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==> finite_additive m
2651Proof
2652 RW_TAC std_ss [premeasure_def]
2653 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_FINITE_ADDITIVE
2654 >> PROVE_TAC [RING_EMPTY, subsets_def]
2655QED
2656
2657Theorem RING_PREMEASURE_DIFF_SUBSET:
2658 !m s t. ring (m_space m, measurable_sets m) /\ premeasure m /\
2659 s IN measurable_sets m /\ t IN measurable_sets m /\ s SUBSET t /\
2660 measure m s < PosInf ==> (measure m (t DIFF s) = measure m t - measure m s)
2661Proof
2662 rpt STRIP_TAC
2663 >> `additive m` by PROVE_TAC [RING_PREMEASURE_ADDITIVE]
2664 >> Know `measure m s <> NegInf /\ measure m s <> PosInf`
2665 >- (CONJ_TAC >- PROVE_TAC [positive_not_infty, premeasure_def] \\
2666 art [lt_infty])
2667 >> DISCH_TAC
2668 >> Suff `measure m (t DIFF s) + measure m s = measure m t - measure m s + measure m s`
2669 >- (POP_ASSUM (STRIP_ASSUME_TAC o (MATCH_MP EXTREAL_EQ_RADD)) \\
2670 PROVE_TAC [])
2671 >> POP_ASSUM (STRIP_ASSUME_TAC o (MATCH_MP sub_add)) >> POP_ORW
2672 >> MATCH_MP_TAC EQ_SYM
2673 >> MATCH_MP_TAC ADDITIVE >> art []
2674 >> CONJ_TAC >- (MATCH_MP_TAC (((REWRITE_RULE [subsets_def]) o
2675 (Q.SPEC `(m_space m, measurable_sets m)`)) RING_DIFF) \\
2676 ASM_REWRITE_TAC [])
2677 >> ASM_SET_TAC [DISJOINT_DEF]
2678QED
2679
2680Theorem ALGEBRA_PREMEASURE_DIFF_SUBSET:
2681 !m s t. algebra (m_space m, measurable_sets m) /\ premeasure m /\
2682 s IN measurable_sets m /\ t IN measurable_sets m /\ s SUBSET t /\
2683 measure m s < PosInf ==> (measure m (t DIFF s) = measure m t - measure m s)
2684Proof
2685 rpt STRIP_TAC
2686 >> MATCH_MP_TAC RING_PREMEASURE_DIFF_SUBSET >> art []
2687 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
2688QED
2689
2690Theorem ALGEBRA_PREMEASURE_COMPL:
2691 !m s. algebra (m_space m, measurable_sets m) /\ premeasure m /\
2692 s IN measurable_sets m /\ measure m s < PosInf ==>
2693 (measure m (m_space m DIFF s) = measure m (m_space m) - measure m s)
2694Proof
2695 rpt STRIP_TAC
2696 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_DIFF_SUBSET >> art []
2697 >> CONJ_TAC >- PROVE_TAC [ALGEBRA_SPACE, space_def, subsets_def]
2698 >> fs [algebra_def, subset_class_def, space_def, subsets_def]
2699QED
2700
2701Theorem RING_ADDITIVE_STRONG_ADDITIVE :
2702 !m s t. ring (m_space m, measurable_sets m) /\ additive m /\ positive m /\
2703 s IN measurable_sets m /\ t IN measurable_sets m ==>
2704 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)
2705Proof
2706 rpt STRIP_TAC
2707 >> `s UNION t = s UNION (t DIFF s)` by SET_TAC [] >> POP_ORW
2708 >> `s INTER t IN measurable_sets m` by PROVE_TAC [RING_INTER, subsets_def]
2709 >> `t DIFF s IN measurable_sets m` by PROVE_TAC [RING_DIFF, subsets_def]
2710 >> Know `measure m (s UNION (t DIFF s)) = measure m s + measure m (t DIFF s)`
2711 >- (MATCH_MP_TAC ADDITIVE >> art [] \\
2712 CONJ_TAC >- SET_TAC [DISJOINT_DEF] \\
2713 PROVE_TAC [RING_UNION, subsets_def])
2714 >> Rewr'
2715 >> Know `measure m s + measure m (t DIFF s) + measure m (s INTER t) =
2716 measure m s + (measure m (t DIFF s) + measure m (s INTER t))`
2717 >- (MATCH_MP_TAC EQ_SYM \\
2718 MATCH_MP_TAC add_assoc >> DISJ1_TAC \\
2719 RW_TAC std_ss [] \\ (* 3 subgoals, same tactics *)
2720 MATCH_MP_TAC pos_not_neginf >> PROVE_TAC [positive_def])
2721 >> Rewr'
2722 >> Know `measure m (t DIFF s) + measure m (s INTER t) = measure m t`
2723 >- (MATCH_MP_TAC EQ_SYM \\
2724 MATCH_MP_TAC ADDITIVE >> art [] \\
2725 SET_TAC [DISJOINT_DEF])
2726 >> Rewr
2727QED
2728
2729Theorem RING_PREMEASURE_STRONG_ADDITIVE:
2730 !m s t. ring (m_space m, measurable_sets m) /\ premeasure m /\
2731 s IN measurable_sets m /\ t IN measurable_sets m ==>
2732 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)
2733Proof
2734 rpt STRIP_TAC
2735 >> MATCH_MP_TAC RING_ADDITIVE_STRONG_ADDITIVE
2736 >> fs [premeasure_def]
2737 >> MATCH_MP_TAC COUNTABLY_ADDITIVE_ADDITIVE
2738 >> fs [positive_def, ring_def, subsets_def]
2739QED
2740
2741Theorem ALGEBRA_PREMEASURE_STRONG_ADDITIVE:
2742 !m s t. algebra (m_space m, measurable_sets m) /\ premeasure m /\
2743 s IN measurable_sets m /\ t IN measurable_sets m ==>
2744 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)
2745Proof
2746 rpt STRIP_TAC
2747 >> MATCH_MP_TAC RING_PREMEASURE_STRONG_ADDITIVE >> art []
2748 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
2749QED
2750
2751Theorem MEASURE_SPACE_STRONG_ADDITIVE:
2752 !m s t. measure_space m /\
2753 s IN measurable_sets m /\ t IN measurable_sets m ==>
2754 (measure m (s UNION t) + measure m (s INTER t) = measure m s + measure m t)
2755Proof
2756 RW_TAC std_ss [measure_space_def]
2757 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_STRONG_ADDITIVE >> art []
2758 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]
2759QED
2760
2761(* This is a more general version of MEASURE_COUNTABLE_INCREASING,
2762 `s IN measurable_sets m` must be added into antecedents. *)
2763Theorem RING_PREMEASURE_COUNTABLE_INCREASING :
2764 !m s f.
2765 ring (m_space m, measurable_sets m) /\ premeasure m /\
2766 f IN (UNIV -> measurable_sets m) /\
2767 (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) /\
2768 (s = BIGUNION (IMAGE f UNIV)) /\ s IN measurable_sets m ==>
2769 (sup (IMAGE (measure m o f) UNIV) = measure m s)
2770Proof
2771 RW_TAC std_ss [IN_FUNSET, IN_UNIV, premeasure_def]
2772 >> Know `measure m o f = (\n. SIGMA (measure m o (\m. f (SUC m) DIFF f m)) (count n))`
2773 >- (FUN_EQ_TAC \\
2774 Induct >- (RW_TAC std_ss [o_THM, RING_EMPTY, subsets_def, COUNT_ZERO,
2775 EXTREAL_SUM_IMAGE_EMPTY] >> PROVE_TAC [positive_def]) \\
2776 POP_ASSUM (MP_TAC o SYM) \\
2777 RW_TAC arith_ss [o_THM, COUNT_SUC] \\
2778 Know `!n. (measure m o (\m. f (SUC m) DIFF f m)) n <> NegInf`
2779 >- (RW_TAC std_ss [] \\
2780 `f (SUC n) DIFF f n IN measurable_sets m` by METIS_TAC [RING_DIFF, subsets_def] \\
2781 METIS_TAC [positive_def, positive_not_infty, o_DEF]) >> DISCH_TAC \\
2782 `FINITE (count x)` by RW_TAC std_ss [FINITE_COUNT] \\
2783 `count x DELETE x = count x`
2784 by METIS_TAC [IN_COUNT, DELETE_NON_ELEMENT, LESS_REFL] \\
2785 RW_TAC std_ss [EXTREAL_SUM_IMAGE_PROPERTY] \\
2786 `additive m` by PROVE_TAC [RING_PREMEASURE_ADDITIVE, premeasure_def] \\
2787 MATCH_MP_TAC ADDITIVE \\
2788 FULL_SIMP_TAC arith_ss [EXTENSION, IN_UNION, IN_DIFF, DISJOINT_DEF, NOT_IN_EMPTY,
2789 IN_INTER, SUBSET_DEF, IN_COUNT, IN_DELETE] \\
2790 (MP_TAC o REWRITE_RULE [subsets_def, space_def] o
2791 (Q.SPEC `(m_space m, measurable_sets m)`)) RING_DIFF >> PROVE_TAC [])
2792 >> Rewr'
2793 >> Know `!n. 0 <= (measure m o (\m. f (SUC m) DIFF f m)) n`
2794 >- (RW_TAC std_ss [o_DEF] \\
2795 fs [positive_def] >> FIRST_X_ASSUM MATCH_MP_TAC \\
2796 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
2797 (Q.SPEC `(m_space m,measurable_sets m)` RING_DIFF)) >> art [])
2798 >> DISCH_THEN (MP_TAC o SYM o (MATCH_MP ext_suminf_def)) >> Rewr'
2799 >> MATCH_MP_TAC COUNTABLY_ADDITIVE >> art []
2800 >> CONJ_TAC
2801 >- (RW_TAC std_ss [IN_UNIV, IN_FUNSET] \\
2802 (MATCH_MP_TAC o REWRITE_RULE [subsets_def, space_def] o
2803 (Q.SPEC `(m_space m, measurable_sets m)`)) RING_DIFF \\
2804 FULL_SIMP_TAC std_ss [])
2805 >> CONJ_TAC
2806 >- (rpt STRIP_TAC \\
2807 MATCH_MP_TAC DISJOINT_DIFFS \\
2808 Q.EXISTS_TAC `f` >> RW_TAC std_ss [])
2809 >> RW_TAC std_ss [IN_BIGUNION_IMAGE,IN_DIFF,IN_UNIV,EXTENSION]
2810 >> reverse EQ_TAC >> RW_TAC std_ss [] >- METIS_TAC []
2811 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY]
2812 >> METIS_TAC []
2813QED
2814
2815Theorem ALGEBRA_PREMEASURE_COUNTABLE_INCREASING:
2816 !m s f.
2817 algebra (m_space m, measurable_sets m) /\ premeasure m /\
2818 f IN (UNIV -> measurable_sets m) /\
2819 (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) /\
2820 (s = BIGUNION (IMAGE f UNIV)) /\ s IN measurable_sets m ==>
2821 (sup (IMAGE (measure m o f) UNIV) = measure m s)
2822Proof
2823 rpt STRIP_TAC
2824 >> MATCH_MP_TAC RING_PREMEASURE_COUNTABLE_INCREASING >> art []
2825 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
2826QED
2827
2828Theorem RING_ADDITIVE_SUBADDITIVE :
2829 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==>
2830 subadditive m
2831Proof
2832 RW_TAC std_ss [subadditive_def]
2833 >> `measure m s + measure m t = measure m (s UNION t) + measure m (s INTER t)`
2834 by PROVE_TAC [RING_ADDITIVE_STRONG_ADDITIVE]
2835 >> POP_ORW
2836 >> MATCH_MP_TAC le_addr_imp
2837 >> `s INTER t IN measurable_sets m` by PROVE_TAC [RING_INTER, subsets_def]
2838 >> PROVE_TAC [positive_def]
2839QED
2840
2841Theorem RING_ADDITIVE_FINITE_ADDITIVE :
2842 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==>
2843 finite_additive m
2844Proof
2845 RW_TAC std_ss [additive_def, finite_additive_def]
2846 >> Induct_on `n`
2847 >- fs [COUNT_ZERO, positive_def, ring_def, subsets_def, EXTREAL_SUM_IMAGE_EMPTY]
2848 >> RW_TAC std_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT,
2849 EXTREAL_SUM_IMAGE_THM]
2850 >> Know `SIGMA (measure m o f) (n INSERT count n) =
2851 (measure m o f) n + SIGMA (measure m o f) ((count n) DELETE n)`
2852 >- (irule EXTREAL_SUM_IMAGE_PROPERTY_NEG \\
2853 RW_TAC std_ss [FINITE_COUNT, GSYM COUNT_SUC, IN_COUNT, o_DEF] \\
2854 MATCH_MP_TAC pos_not_neginf \\
2855 fs [positive_def]) >> Rewr'
2856 >> REWRITE_TAC [COUNT_DELETE]
2857 >> Q.ABBREV_TAC `A = BIGUNION (IMAGE f (count n))`
2858 >> Know `DISJOINT A (f n)`
2859 >- (Q.UNABBREV_TAC `A` \\
2860 RW_TAC set_ss [List.nth (CONJUNCTS DISJOINT_BIGUNION, 0)] \\
2861 FIRST_X_ASSUM MATCH_MP_TAC >> rw [])
2862 >> DISCH_TAC
2863 >> Know `A IN measurable_sets m`
2864 >- (Suff `A = (f n UNION A) DIFF (f n)`
2865 >- (Rewr' \\
2866 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
2867 (Q.SPEC `(m_space m,measurable_sets m)`
2868 RING_DIFF)) >> rw []) \\
2869 POP_ASSUM MP_TAC >> SET_TAC [])
2870 >> DISCH_TAC
2871 >> Know `SIGMA (measure m o f) (count n) = measure m A`
2872 >- (MATCH_MP_TAC EQ_SYM \\
2873 FIRST_X_ASSUM irule >> rw []) >> Rewr'
2874 >> SIMP_TAC std_ss [o_DEF]
2875 >> FIRST_X_ASSUM MATCH_MP_TAC >> rw [DISJOINT_SYM]
2876QED
2877
2878Theorem RING_SUBADDITIVE_FINITE_SUBADDITIVE :
2879 !m. ring (m_space m, measurable_sets m) /\ positive m /\
2880 subadditive m ==> finite_subadditive m
2881Proof
2882 RW_TAC std_ss [subadditive_def, finite_subadditive_def]
2883 >> Induct_on `n`
2884 >- fs [COUNT_ZERO, positive_def, ring_def, subsets_def,
2885 EXTREAL_SUM_IMAGE_EMPTY, le_refl]
2886 >> RW_TAC std_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT,
2887 EXTREAL_SUM_IMAGE_THM]
2888 >> Know `SIGMA (measure m o f) (n INSERT count n) =
2889 (measure m o f) n + SIGMA (measure m o f) ((count n) DELETE n)`
2890 >- (irule EXTREAL_SUM_IMAGE_PROPERTY_NEG \\
2891 RW_TAC std_ss [FINITE_COUNT, GSYM COUNT_SUC, IN_COUNT, o_DEF] \\
2892 MATCH_MP_TAC pos_not_neginf \\
2893 fs [positive_def]) >> Rewr'
2894 >> REWRITE_TAC [COUNT_DELETE]
2895 >> Q.ABBREV_TAC `A = BIGUNION (IMAGE f (count n))`
2896 >> Know `A IN measurable_sets m`
2897 >- (Q.UNABBREV_TAC `A` \\
2898 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
2899 (Q.SPEC `(m_space m,measurable_sets m)`
2900 RING_FINITE_UNION)) \\
2901 rw [FINITE_COUNT, IMAGE_FINITE] \\
2902 rw [SUBSET_DEF, IN_IMAGE] \\
2903 FIRST_X_ASSUM MATCH_MP_TAC >> rw []) >> DISCH_TAC
2904 >> MATCH_MP_TAC le_trans
2905 >> Q.EXISTS_TAC `(measure m o f) n + measure m A`
2906 >> CONJ_TAC
2907 >- (SIMP_TAC std_ss [o_DEF] \\
2908 FIRST_X_ASSUM MATCH_MP_TAC >> rw [])
2909 >> Q.ABBREV_TAC `x = (measure m o f) n`
2910 >> Cases_on `x = PosInf`
2911 >- (POP_ORW \\
2912 Know `measure m A <> NegInf`
2913 >- (MATCH_MP_TAC pos_not_neginf >> fs [positive_def]) \\
2914 Know `SIGMA (measure m o f) (count n) <> NegInf`
2915 >- (MATCH_MP_TAC pos_not_neginf \\
2916 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
2917 rw [FINITE_COUNT, IN_COUNT, o_DEF] \\
2918 fs [positive_def]) \\
2919 rw [add_infty, le_refl])
2920 >> Know `x <> NegInf`
2921 >- (MATCH_MP_TAC pos_not_neginf \\
2922 Q.UNABBREV_TAC `x` >> SIMP_TAC std_ss [o_DEF] \\
2923 fs [positive_def])
2924 >> rw [le_ladd]
2925QED
2926
2927Theorem RING_PREMEASURE_SUBADDITIVE:
2928 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==> subadditive m
2929Proof
2930 RW_TAC std_ss [subadditive_def]
2931 >> `measure m s + measure m t = measure m (s UNION t) + measure m (s INTER t)`
2932 by PROVE_TAC [RING_PREMEASURE_STRONG_ADDITIVE]
2933 >> POP_ORW
2934 >> MATCH_MP_TAC le_addr_imp
2935 >> `s INTER t IN measurable_sets m` by PROVE_TAC [RING_INTER, subsets_def]
2936 >> PROVE_TAC [premeasure_def, positive_def]
2937QED
2938
2939Theorem ALGEBRA_PREMEASURE_SUBADDITIVE:
2940 !m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> subadditive m
2941Proof
2942 rpt STRIP_TAC
2943 >> MATCH_MP_TAC RING_PREMEASURE_SUBADDITIVE >> art []
2944 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
2945QED
2946
2947Theorem MEASURE_SPACE_SUBADDITIVE:
2948 !m. measure_space m ==> subadditive m
2949Proof
2950 RW_TAC std_ss [measure_space_def]
2951 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_SUBADDITIVE >> art []
2952 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]
2953QED
2954
2955Theorem MEASURE_SUBADDITIVE :
2956 !m s t u. measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
2957 u = s UNION t ==> measure m u <= measure m s + measure m t
2958Proof
2959 RW_TAC std_ss []
2960 >> MATCH_MP_TAC SUBADDITIVE
2961 >> RW_TAC std_ss [MEASURE_SPACE_SUBADDITIVE]
2962 >> MATCH_MP_TAC MEASURE_SPACE_UNION >> art []
2963QED
2964
2965(* NOTE: t is neither subset nor disjoint with s but it contributes no
2966 additional measure in “measure m (s UNION t)”.
2967 *)
2968Theorem MEASURE_ADD_ABSORB :
2969 !m s t. measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
2970 measure m t = 0 ==> measure m (s UNION t) = measure m s
2971Proof
2972 rpt STRIP_TAC
2973 >> reverse (rw [GSYM le_antisym])
2974 >- (MATCH_MP_TAC MEASURE_INCREASING >> simp [] \\
2975 MATCH_MP_TAC MEASURE_SPACE_UNION >> art [])
2976 >> ‘measure m s = measure m s + measure m t’ by simp []
2977 >> POP_ORW
2978 >> MATCH_MP_TAC MEASURE_SUBADDITIVE >> art []
2979QED
2980
2981(* NOTE: t is neither subset nor disjoint with s *)
2982Theorem MEASURE_SUB_ABSORB :
2983 !m s t. measure_space m /\ s IN measurable_sets m /\ t IN measurable_sets m /\
2984 measure m t = 0 ==> measure m (s DIFF t) = measure m s
2985Proof
2986 rpt STRIP_TAC
2987 >> Know ‘measure m s = measure m ((s DIFF t) UNION (s INTER t))’
2988 >- (AP_TERM_TAC >> SET_TAC [])
2989 >> Rewr'
2990 >> qmatch_abbrev_tac ‘_ = measure m (A UNION B)’
2991 >> ‘DISJOINT A B’ by ASM_SET_TAC []
2992 >> ‘A IN measurable_sets m’ by METIS_TAC [MEASURE_SPACE_DIFF]
2993 >> ‘B IN measurable_sets m’ by METIS_TAC [MEASURE_SPACE_INTER]
2994 >> Know ‘measure m (A UNION B) = measure m A + measure m B’
2995 >- (MATCH_MP_TAC MEASURE_ADDITIVE >> art [])
2996 >> Rewr'
2997 >> Suff ‘measure m B = 0’ >- simp []
2998 >> reverse (rw [GSYM le_antisym])
2999 >- (MATCH_MP_TAC MEASURE_POSITIVE >> art [])
3000 >> Q.PAT_X_ASSUM ‘measure m t = 0’ (REWRITE_TAC o wrap o SYM)
3001 >> MATCH_MP_TAC MEASURE_INCREASING >> art []
3002 >> simp [Abbr ‘B’]
3003QED
3004
3005Theorem RING_PREMEASURE_FINITE_SUBADDITIVE:
3006 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==> finite_subadditive m
3007Proof
3008 rpt STRIP_TAC
3009 >> `subadditive m` by PROVE_TAC [RING_PREMEASURE_SUBADDITIVE]
3010 >> fs [premeasure_def, finite_subadditive_def]
3011 >> GEN_TAC >> Induct_on `n`
3012 >- (RW_TAC arith_ss [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, EXTREAL_SUM_IMAGE_EMPTY] \\
3013 PROVE_TAC [le_refl, positive_def])
3014 >> RW_TAC arith_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT]
3015 >> `!i. i < n ==> f i IN measurable_sets m` by RW_TAC arith_ss []
3016 >> Know `BIGUNION (IMAGE f (count n)) IN measurable_sets m`
3017 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3018 (Q.SPEC `(m_space m,measurable_sets m)` RING_FINITE_UNION_ALT)) \\
3019 ASM_REWRITE_TAC [])
3020 >> DISCH_TAC
3021 >> Q.PAT_X_ASSUM `X ==> measure m (BIGUNION (IMAGE f (count n))) <=
3022 SIGMA (measure m o f) (count n)` MP_TAC
3023 >> RW_TAC std_ss []
3024 >> Know `SIGMA (measure m o f) (n INSERT count n) =
3025 (measure m o f) n + SIGMA (measure m o f) ((count n) DELETE n)`
3026 >- (irule EXTREAL_SUM_IMAGE_PROPERTY \\
3027 SIMP_TAC std_ss [FINITE_COUNT, IN_INSERT, IN_COUNT] \\
3028 DISJ1_TAC >> GEN_TAC >> DISCH_TAC \\
3029 MATCH_MP_TAC pos_not_neginf \\
3030 METIS_TAC [positive_def, LESS_SUC_REFL]) >> Rewr'
3031 >> Know `count n DELETE n = count n`
3032 >- (REWRITE_TAC [EXTENSION] \\
3033 GEN_TAC >> REWRITE_TAC [IN_DELETE, IN_COUNT] \\
3034 RW_TAC arith_ss []) >> Rewr'
3035 >> MATCH_MP_TAC le_trans
3036 >> Q.EXISTS_TAC `measure m (f n) + measure m (BIGUNION (IMAGE f (count n)))`
3037 >> CONJ_TAC
3038 >- (MATCH_MP_TAC SUBADDITIVE >> art [] \\
3039 PROVE_TAC [positive_def, LESS_SUC_REFL])
3040 >> fs [o_DEF] >> MATCH_MP_TAC le_ladd_imp >> art []
3041QED
3042
3043Theorem ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE:
3044 !m. algebra (m_space m, measurable_sets m) /\ premeasure m ==> finite_subadditive m
3045Proof
3046 rpt STRIP_TAC
3047 >> MATCH_MP_TAC RING_PREMEASURE_FINITE_SUBADDITIVE >> art []
3048 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
3049QED
3050
3051Theorem MEASURE_SPACE_FINITE_SUBADDITIVE:
3052 !m. measure_space m ==> finite_subadditive m
3053Proof
3054 RW_TAC std_ss [measure_space_def]
3055 >> MATCH_MP_TAC ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE >> art []
3056 >> PROVE_TAC [SIGMA_ALGEBRA_ALGEBRA, premeasure_def]
3057QED
3058
3059(* This non-trivial result is needed by CARATHEODORY_SEMIRING *)
3060Theorem RING_PREMEASURE_COUNTABLY_SUBADDITIVE :
3061 !m. ring (m_space m, measurable_sets m) /\ premeasure m ==>
3062 countably_subadditive m
3063Proof
3064 RW_TAC std_ss [countably_subadditive_def, premeasure_def]
3065 >> STRIP_ASSUME_TAC (Q.SPEC `f` SETS_TO_INCREASING_SETS') >> art []
3066 >> Know `g IN (univ(:num) -> measurable_sets m)`
3067 >- (REWRITE_TAC [IN_FUNSET, IN_UNIV] \\
3068 GEN_TAC >> art [] \\
3069 MATCH_MP_TAC (((REWRITE_RULE [subsets_def]) o
3070 (Q.SPEC `(m_space m,measurable_sets m)`)) RING_FINITE_UNION_ALT) \\
3071 RW_TAC std_ss [] >> PROVE_TAC [IN_FUNSET, IN_UNIV])
3072 >> DISCH_TAC
3073 >> Know `measure m (BIGUNION (IMAGE g univ(:num))) = sup (IMAGE (measure m o g) UNIV)`
3074 >- (MATCH_MP_TAC EQ_SYM \\
3075 MATCH_MP_TAC RING_PREMEASURE_COUNTABLE_INCREASING >> art [premeasure_def] \\
3076 PROVE_TAC []) >> Rewr'
3077 (* stage work *)
3078 >> Know `!n. 0 <= (measure m o f) n`
3079 >- (RW_TAC std_ss [o_DEF] \\
3080 fs [positive_def] >> FIRST_X_ASSUM MATCH_MP_TAC \\
3081 fs [IN_FUNSET, IN_UNIV])
3082 >> DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr'
3083 >> MATCH_MP_TAC sup_mono
3084 >> GEN_TAC
3085 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [o_DEF]
3086 >> BETA_TAC >> art []
3087 >> MATCH_MP_TAC FINITE_SUBADDITIVE >> art []
3088 >> fs [IN_FUNSET, IN_UNIV]
3089 >> CONJ_TAC
3090 >- (MATCH_MP_TAC RING_PREMEASURE_FINITE_SUBADDITIVE >> art [premeasure_def])
3091 >> MATCH_MP_TAC (((REWRITE_RULE [subsets_def]) o
3092 (Q.SPEC `(m_space m,measurable_sets m)`)) RING_FINITE_UNION_ALT)
3093 >> ASM_REWRITE_TAC []
3094QED
3095
3096Theorem ALGEBRA_PREMEASURE_COUNTABLY_SUBADDITIVE:
3097 !m. algebra (m_space m, measurable_sets m) /\ premeasure m ==>
3098 countably_subadditive m
3099Proof
3100 rpt STRIP_TAC
3101 >> MATCH_MP_TAC RING_PREMEASURE_COUNTABLY_SUBADDITIVE >> art []
3102 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
3103QED
3104
3105(* Proposition 4.3 (viii) [1] *)
3106Theorem MEASURE_SPACE_COUNTABLY_SUBADDITIVE:
3107 !m. measure_space m ==> countably_subadditive m
3108Proof
3109 RW_TAC std_ss [measure_space_def, sigma_algebra_def]
3110 >> MATCH_MP_TAC RING_PREMEASURE_COUNTABLY_SUBADDITIVE
3111 >> ASM_REWRITE_TAC [premeasure_def]
3112 >> MATCH_MP_TAC ALGEBRA_IMP_RING >> art []
3113QED
3114
3115Theorem MEASURE_COUNTABLY_SUBADDITIVE :
3116 !m f s. measure_space m /\ f IN (univ(:num) -> measurable_sets m) /\
3117 s = BIGUNION (IMAGE f univ(:num)) ==>
3118 measure m s <= suminf (measure m o f)
3119Proof
3120 rpt STRIP_TAC
3121 >> MATCH_MP_TAC COUNTABLY_SUBADDITIVE
3122 >> RW_TAC std_ss [MEASURE_SPACE_COUNTABLY_SUBADDITIVE]
3123 >> MATCH_MP_TAC MEASURE_SPACE_BIGUNION
3124 >> fs [IN_FUNSET]
3125QED
3126
3127Theorem RING_ADDITIVE_INCREASING :
3128 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==>
3129 increasing m
3130Proof
3131 RW_TAC std_ss [increasing_def, positive_def]
3132 >> Suff
3133 `?u. u IN measurable_sets m /\ (measure m t = measure m s + measure m u)`
3134 >- METIS_TAC [le_addr_imp]
3135 >> Q.EXISTS_TAC `t DIFF s`
3136 >> STRONG_CONJ_TAC >- PROVE_TAC [RING_DIFF, subsets_def]
3137 >> RW_TAC std_ss []
3138 >> MATCH_MP_TAC ADDITIVE
3139 >> ASM_SET_TAC []
3140QED
3141
3142Theorem RING_ADDITIVE_EVERYTHING :
3143 !m. ring (m_space m, measurable_sets m) /\ positive m /\ additive m ==>
3144 finite_additive m /\ increasing m /\
3145 subadditive m /\ finite_subadditive m
3146Proof
3147 GEN_TAC >> STRIP_TAC
3148 >> CONJ_TAC >- PROVE_TAC [RING_ADDITIVE_FINITE_ADDITIVE]
3149 >> CONJ_TAC >- PROVE_TAC [RING_ADDITIVE_INCREASING]
3150 >> STRONG_CONJ_TAC >- PROVE_TAC [RING_ADDITIVE_SUBADDITIVE]
3151 >> DISCH_TAC
3152 >> PROVE_TAC [RING_SUBADDITIVE_FINITE_SUBADDITIVE]
3153QED
3154
3155Theorem OUTER_MEASURE_SPACE_POSITIVE:
3156 !m. outer_measure_space m ==> positive m
3157Proof
3158 PROVE_TAC [outer_measure_space_def]
3159QED
3160
3161Theorem OUTER_MEASURE_SPACE_SUBADDITIVE:
3162 !m. outer_measure_space m ==> subadditive m
3163Proof
3164 RW_TAC std_ss [outer_measure_space_def]
3165 >> MATCH_MP_TAC COUNTABLY_SUBADDITIVE_SUBADDITIVE
3166 >> ASM_REWRITE_TAC []
3167QED
3168
3169Theorem OUTER_MEASURE_SPACE_FINITE_SUBADDITIVE:
3170 !m. outer_measure_space m ==> finite_subadditive m
3171Proof
3172 RW_TAC std_ss [outer_measure_space_def]
3173 >> MATCH_MP_TAC COUNTABLY_SUBADDITIVE_FINITE_SUBADDITIVE
3174 >> ASM_REWRITE_TAC []
3175QED
3176
3177(* cf. MEASURE_SPACE_RESTRICTED *)
3178Theorem MEASURE_SPACE_RESTRICTION :
3179 !sp sts m sub. measure_space (sp,sts,m) /\ sub SUBSET sts /\ sigma_algebra (sp,sub) ==>
3180 measure_space (sp,sub,m)
3181Proof
3182 RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def]
3183 >- (REWRITE_TAC [positive_def, measure_def, measurable_sets_def] \\
3184 CONJ_TAC >- PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\
3185 rpt STRIP_TAC >> fs [positive_def, measure_def, measurable_sets_def] \\
3186 FIRST_X_ASSUM MATCH_MP_TAC >> PROVE_TAC [SUBSET_DEF])
3187 >> fs [countably_additive_def, IN_FUNSET, IN_UNIV, measurable_sets_def, measure_def]
3188 >> RW_TAC std_ss []
3189 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
3190 >> PROVE_TAC [SUBSET_DEF]
3191QED
3192
3193(* Any sub-sigma-algebra in a measurable space forms a measurable space
3194 cf. martingaleTheory.measure_space_from_sub_sigma_algebra
3195 *)
3196Theorem MEASURE_SPACE_RESTRICTION':
3197 !m sts. measure_space m /\ sts SUBSET (measurable_sets m) /\
3198 sigma_algebra (m_space m,sts) ==>
3199 measure_space (m_space m,sts,measure m)
3200Proof
3201 rpt STRIP_TAC
3202 >> MATCH_MP_TAC MEASURE_SPACE_RESTRICTION
3203 >> Q.EXISTS_TAC ‘measurable_sets m’
3204 >> rw [MEASURE_SPACE_REDUCE]
3205QED
3206
3207(* Theorem 18.2 of [1]. Given (sp,sts,m) and u = outer_measure m (countable_covers sts):
3208
3209 (*1*) u is an outer measure such that u(x) <= m(x) for all x IN sts;
3210 (*2*) A (caratheodory_sets sp u) is a sigma-algebra and u|A is a measure;
3211 (*3*) u is maximal: if v is another outer measure such that v(x) <= mu(x)
3212 for all x IN sts, then v(x) <= m(x) for all x SUBSET sp.
3213
3214 NOTE: there's no structual requirements on `sts` and `mu` (except for `{} IN sts`);
3215 and (*3*) is not needed by CARATHEODORY_SEMIRING.
3216 *)
3217Theorem OUTER_MEASURE_CONSTRUCTION :
3218 !sp sts m u. subset_class sp sts /\ {} IN sts /\ positive (sp,sts,m) /\
3219 (u = outer_measure m (countable_covers sts)) ==>
3220 outer_measure_space (sp,POW sp,u) /\ (!x. x IN sts ==> u x <= m x) /\
3221 measure_space (sp,caratheodory_sets sp u,u) /\
3222 !v. outer_measure_space (sp,POW sp,v) /\ (!x. x IN sts ==> v x <= m x) ==>
3223 !x. x SUBSET sp ==> v x <= u x
3224Proof
3225 rpt GEN_TAC >> STRIP_TAC
3226 >> rename1 `positive (sp,sts,mu)` (* m -> mu *)
3227 >> rename1 `m = outer_measure mu (countable_covers sts)` (* u -> m *)
3228 >> Q.ABBREV_TAC `C = countable_covers sts`
3229 >> Q.ABBREV_TAC `A = caratheodory_sets sp m`
3230 >> STRONG_CONJ_TAC (* outer_measure_space (sp,POW sp,m) *)
3231 >- (REWRITE_TAC [outer_measure_space_def, m_space_def, measurable_sets_def,
3232 subset_class_POW, EMPTY_IN_POW] \\
3233 fs [countable_covers_def, outer_measure_def] \\
3234 Q.PAT_ASSUM `m = _` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ (* recover `m` *)
3235 (* C is anti-monotone (or antitone) *)
3236 Know `!a b. a SUBSET b ==> (C b) SUBSET (C a)`
3237 >- (rpt STRIP_TAC \\
3238 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3239 ONCE_REWRITE_TAC [SUBSET_DEF] \\
3240 SET_SPEC_TAC [IN_FUNSET, IN_UNIV] \\
3241 RW_TAC std_ss [] >> PROVE_TAC [SUBSET_TRANS]) >> DISCH_TAC \\
3242 (* m is positive *)
3243 Know `!s. s SUBSET sp ==> 0 <= m s`
3244 >- (Q.PAT_X_ASSUM `m = _` ((SIMP_TAC std_ss) o wrap) \\
3245 rpt STRIP_TAC >> REWRITE_TAC [le_inf'] \\
3246 GEN_TAC >> RW_TAC std_ss [GSPECIFICATION] \\
3247 MATCH_MP_TAC ext_suminf_pos \\
3248 GEN_TAC >> SIMP_TAC std_ss [o_DEF] \\
3249 fs [positive_def, measure_def, measurable_sets_def] \\
3250 FIRST_X_ASSUM MATCH_MP_TAC \\
3251 POP_ASSUM MP_TAC \\
3252 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3253 RW_TAC std_ss [GSPECIFICATION, IN_FUNSET, IN_UNIV]) >> DISCH_TAC \\
3254 (* joint-property I of C and m *)
3255 Know `!a. m a < PosInf ==> (C a) <> EMPTY`
3256 >- (GEN_TAC >> REWRITE_TAC [GSYM lt_infty] \\
3257 MATCH_MP_TAC MONO_NOT \\
3258 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3259 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\
3260 SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] >> DISCH_TAC \\
3261 Know `!r. (?f. f IN (univ(:num) -> sts) /\ a SUBSET BIGUNION (IMAGE f univ(:num)) /\
3262 (suminf (mu o f) = r)) = F`
3263 >- (GEN_TAC >> MATCH_MP_TAC NOT_F >> SIMP_TAC bool_ss [] \\
3264 GEN_TAC >> POP_ASSUM MP_TAC \\
3265 SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] \\
3266 METIS_TAC []) >> DISCH_TAC \\
3267 Know `{r | ?f. (f IN (univ(:num) -> sts) /\ a SUBSET BIGUNION (IMAGE f univ(:num))) /\
3268 (suminf (mu o f) = r)} = EMPTY`
3269 >- ASM_SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] \\
3270 DISCH_THEN (ONCE_REWRITE_TAC o wrap) >> KILL_TAC \\
3271 ACCEPT_TAC inf_empty) >> DISCH_TAC \\
3272 (* joint-property II of C and m *)
3273 Know `!a. m a < PosInf ==> ?f. f IN (C a) /\ suminf (mu o f) <> PosInf`
3274 >- (GEN_TAC \\
3275 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\
3276 REWRITE_TAC [Q.SPECL [`{r | ?f. f IN (C :('a set)->(num->'a set)->bool) (a :'a set) /\
3277 (suminf (mu o f) = r)}`, `PosInf`] (GSYM inf_lt')] \\
3278 RW_TAC std_ss [GSPECIFICATION] \\
3279 Q.EXISTS_TAC `f` >> PROVE_TAC [lt_infty]) >> DISCH_TAC \\
3280 (* joint-property III of C and m *)
3281 Know `!a e. a SUBSET sp /\ 0 < e /\ m a < PosInf ==>
3282 ?f. f IN (C a) /\ suminf (mu o f) <= m a + e`
3283 >- (rpt STRIP_TAC \\
3284 MP_TAC (Q.SPEC `{r | ?f. f IN ((C :('a->bool)->(num->'a->bool)->bool) (a :'a->bool)) /\
3285 (suminf (mu o f) = r)}` le_inf_epsilon_set) \\
3286 `inf {r | ?f. f IN (C a) /\ (suminf (mu o f) = r)} = m a` by METIS_TAC [] \\
3287 POP_ASSUM (REWRITE_TAC o wrap) \\
3288 SIMP_TAC std_ss [GSPECIFICATION] \\
3289 DISCH_THEN (MP_TAC o (Q.SPEC `e`)) \\
3290 `(?x. (?f. f IN C a /\ (suminf (mu o f) = x)) /\ x <= m a + e) =
3291 (?f. f IN C a /\ suminf (mu o f) <= m a + e)` by METIS_TAC [] \\
3292 POP_ASSUM (REWRITE_TAC o wrap) \\
3293 `(?x. (?f. f IN C a /\ (suminf (mu o f) = x)) /\ x <> PosInf) =
3294 (?f. f IN C a /\ (suminf (mu o f) <> PosInf))` by METIS_TAC [] \\
3295 POP_ASSUM (REWRITE_TAC o wrap) \\
3296 DISCH_THEN MATCH_MP_TAC \\
3297 ASM_REWRITE_TAC [] \\
3298 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC >> ASM_REWRITE_TAC []) \\
3299 METIS_TAC [lt_infty, extreal_of_num_def, extreal_not_infty, lte_trans]) >> DISCH_TAC \\
3300 (* joint-property IV of C and m *)
3301 Know `!a f. f IN (univ(:num) -> sts) /\ a SUBSET BIGUNION (IMAGE f univ(:num)) ==>
3302 m a <= suminf (mu o f)`
3303 >- (rpt STRIP_TAC \\
3304 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\
3305 MATCH_MP_TAC inf_le_imp' >> SET_SPEC_TAC [] \\
3306 Q.EXISTS_TAC `f` >> REWRITE_TAC [] \\
3307 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3308 ASM_SIMP_TAC std_ss [GSPECIFICATION]) >> DISCH_TAC \\
3309 (* OM1. positive (sp, POW sp, m) *)
3310 STRONG_CONJ_TAC
3311 >- (REWRITE_TAC [positive_def, measure_def, measurable_sets_def, IN_POW] \\
3312 reverse CONJ_TAC >- art [] \\
3313 Q.PAT_X_ASSUM `m = _` (fs o wrap) \\
3314 ONCE_REWRITE_TAC [GSYM le_antisym] \\
3315 reverse CONJ_TAC
3316 >- (REWRITE_TAC [le_inf'] \\
3317 RW_TAC std_ss [GSPECIFICATION] \\
3318 Know `!n. 0 <= (mu o f) n`
3319 >- (Q.UNABBREV_TAC `C` \\
3320 FULL_SIMP_TAC std_ss [positive_def, measure_def,
3321 GSPECIFICATION, IN_FUNSET,
3322 IN_UNIV, measurable_sets_def]) \\
3323 DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' \\
3324 MATCH_MP_TAC le_sup_imp' \\
3325 REWRITE_TAC [IN_IMAGE, IN_UNIV] \\
3326 Q.EXISTS_TAC `0` >> BETA_TAC \\
3327 REWRITE_TAC [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY]) \\
3328 MATCH_MP_TAC inf_le_imp' \\
3329 RW_TAC std_ss [GSPECIFICATION] \\
3330 Q.EXISTS_TAC `\n. EMPTY` \\
3331 REWRITE_TAC [o_DEF] \\
3332 reverse CONJ_TAC >- (MATCH_MP_TAC ext_suminf_zero >> GEN_TAC >> BETA_TAC \\
3333 PROVE_TAC [positive_def, measure_def]) \\
3334 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3335 RW_TAC std_ss [EMPTY_SUBSET, GSPECIFICATION, IN_FUNSET, IN_UNIV]) >> DISCH_TAC \\
3336 (* OM2. increasing (sp, POW sp, m) *)
3337 STRONG_CONJ_TAC
3338 >- (RW_TAC std_ss [increasing_def, measurable_sets_def, measure_def, IN_POW] \\
3339 (* equivalent definition of `m` in IMAGE, use when needed *)
3340 Know `!S. {r | ?f. f IN S /\ (suminf (mu o f) = r)} = IMAGE (\f. (suminf (mu o f))) S`
3341 >- (GEN_TAC >> RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE, o_DEF] \\
3342 METIS_TAC []) \\
3343 DISCH_THEN (REWRITE_TAC o wrap) \\
3344 MATCH_MP_TAC inf_mono_subset \\
3345 PROVE_TAC [IMAGE_SUBSET]) >> DISCH_TAC \\
3346 (* OM3. countably_subadditive (sp, POW sp, m) *)
3347 SIMP_TAC std_ss [countably_subadditive_def, measure_def, measurable_sets_def,
3348 IN_FUNSET, IN_UNIV, IN_POW] \\
3349 rpt STRIP_TAC \\
3350 (* assume wlog: !x. m (f x) < PosInf *)
3351 reverse (Cases_on `!x. m (f x) < PosInf`)
3352 >- (REWRITE_TAC [o_DEF] \\
3353 POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE std_ss [GSYM lt_infty])) \\
3354 Suff `suminf (\x. m (f x)) = PosInf`
3355 >- (DISCH_THEN (ONCE_REWRITE_TAC o wrap) >> REWRITE_TAC [le_infty]) \\
3356 MATCH_MP_TAC ext_suminf_posinf >> BETA_TAC \\
3357 CONJ_TAC >- PROVE_TAC [positive_def, measurable_sets_def, measure_def, IN_POW] \\
3358 Q.EXISTS_TAC `x` >> art []) \\
3359 (* assume wlog: suminf (m o f) < PosInf *)
3360 reverse (Cases_on `suminf (m o f) < PosInf`)
3361 >- (fs [GSYM lt_infty] >> REWRITE_TAC [le_infty]) \\
3362 (* m (BIGUNION (IMAGE f univ(:num))) <= suminf (m o f) *)
3363 MATCH_MP_TAC le_epsilon >> rpt STRIP_TAC \\
3364 IMP_RES_TAC pow_half_ser_by_e \\
3365 Q.PAT_ASSUM `e = _` (ONCE_REWRITE_TAC o wrap) \\
3366 (* m (BIGUNION (IMAGE f univ(:num))) <= suminf (m o f) + suminf (\n. e * (1 / 2) pow (n + 1)) *)
3367 MATCH_MP_TAC le_trans \\
3368 Q.PAT_X_ASSUM `!a e. X ==> ?f. P`
3369 (STRIP_ASSUME_TAC o (Q.GEN `n`) o
3370 (Q.SPECL [`(f :num->'a->bool) n`, `e * (1 / 2) pow (n + 1)`])) \\
3371 `!n. 0 < e * (1 / 2) pow (n + 1)` by PROVE_TAC [lt_mul, pow_half_pos_lt] \\
3372 `!n. ?g. g IN C (f n) /\ suminf (mu o g) <= (m o f) n + e * (1 / 2) pow (n + 1)`
3373 by METIS_TAC [o_DEF] \\
3374 Q.PAT_X_ASSUM `!n. X => ?f'. Y` K_TAC (* cleanup *) \\
3375 POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE bool_ss [SKOLEM_THM])) \\ (* f' is a cover for each f *)
3376 Q.EXISTS_TAC `suminf (\n. suminf (mu o f' n))` \\
3377 ONCE_REWRITE_TAC [CONJ_COMM] \\
3378 STRONG_CONJ_TAC
3379 >- (Know `suminf (m o f) + suminf (\n. e * (1 / 2) pow (n + 1)) =
3380 suminf (\n. (m o f) n + (\n. e * (1 / 2) pow (n + 1)) n)`
3381 >- (MATCH_MP_TAC EQ_SYM \\
3382 MATCH_MP_TAC ext_suminf_add >> BETA_TAC \\
3383 GEN_TAC >> reverse CONJ_TAC >- PROVE_TAC [le_mul, lt_le, pow_half_pos_le] \\
3384 SIMP_TAC std_ss [o_DEF] \\
3385 fs [positive_def]) >> Rewr' \\
3386 MATCH_MP_TAC ext_suminf_mono >> BETA_TAC \\
3387 reverse CONJ_TAC >- METIS_TAC [] \\
3388 GEN_TAC >> MATCH_MP_TAC ext_suminf_pos \\
3389 GEN_TAC >> REWRITE_TAC [o_DEF] >> BETA_TAC \\
3390 Suff `f' n n' IN sts` >- PROVE_TAC [positive_def, measurable_sets_def, measure_def] \\
3391 `f' n IN C (f n)` by METIS_TAC [] >> POP_ASSUM MP_TAC \\
3392 Q.ABBREV_TAC `g = f' n` \\
3393 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3394 SIMP_TAC std_ss [GSPECIFICATION, IN_FUNSET, IN_UNIV]) \\
3395 Q.PAT_X_ASSUM `e = _` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\
3396 DISCH_TAC \\
3397 Know `suminf (\n. suminf (mu o f' n)) < PosInf`
3398 >- (MATCH_MP_TAC let_trans >> Q.EXISTS_TAC `suminf (m o f) + e` \\
3399 PROVE_TAC [lt_infty, add_not_infty]) >> DISCH_TAC \\
3400 `!n. f' n IN C (f n)` by METIS_TAC [] \\
3401 rename1 `!n. g n IN C (f n)` \\
3402 Q.PAT_X_ASSUM `!n. g n IN C (f n) /\ X` K_TAC \\ (* cleanup *)
3403 (* m (BIGUNION (IMAGE f univ(:num))) <= suminf (\n. suminf (mu o g n)) *)
3404 Know `!n. (g n) IN (univ(:num) -> sts) /\ (f n) SUBSET BIGUNION (IMAGE (g n) univ(:num))`
3405 >- (GEN_TAC >> POP_ASSUM (MP_TAC o (Q.SPEC `n`)) \\
3406 Q.UNABBREV_TAC `C` >> SET_SPEC_TAC []) >> DISCH_TAC \\
3407 (* `!n. m (f n) <= suminf (mu o g n)` by METIS_TAC [] \\ *)
3408 Know `BIGUNION (IMAGE f univ(:num)) SUBSET
3409 BIGUNION (IMAGE (\n. BIGUNION (IMAGE (g n) univ(:num))) univ(:num))`
3410 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_IMAGE, IN_UNIV] \\
3411 rename1 `x IN f n` \\
3412 Q.EXISTS_TAC `BIGUNION (IMAGE (g n) univ(:num))` \\
3413 reverse CONJ_TAC >- (Q.EXISTS_TAC `n` >> REWRITE_TAC []) \\
3414 PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC \\
3415 (* merge two nesting BIGUNIONs into one BIGUNION *)
3416 `!i j. g i j IN sts` by PROVE_TAC [IN_FUNSET, IN_UNIV] \\
3417 (* UPDATE: new proof steps without using numpairTheory *)
3418 Q.X_CHOOSE_THEN ‘h’ STRIP_ASSUME_TAC NUM_2D_BIJ_INV \\
3419 Q.X_CHOOSE_THEN ‘h2’ STRIP_ASSUME_TAC
3420 (SIMP_RULE (srw_ss()) []
3421 (MATCH_MP BIJ_INV (ASSUME “BIJ h univ(:num) (univ(:num) CROSS univ(:num))”))) \\
3422 Q.ABBREV_TAC ‘ff = (UNCURRY g) o h’ \\
3423 `ff IN (univ(:num) -> sts)` by rw [Abbr ‘ff’, o_DEF, IN_FUNSET, UNCURRY] \\
3424 Know `BIGUNION (IMAGE (\n. BIGUNION (IMAGE (g n) univ(:num))) univ(:num)) =
3425 BIGUNION (IMAGE ff (univ(:num)))`
3426 >- (rw [SET_EQ_SUBSET, SUBSET_DEF, IN_BIGUNION_IMAGE, Abbr ‘ff’, UNCURRY] >| (* 2 subgoals *)
3427 [ (* goal 1 (of 2) *)
3428 rename1 ‘x IN g i j’ \\
3429 Q.EXISTS_TAC ‘h2 (i,j)’ >> rw [],
3430 (* goal 2 (of 2) *)
3431 rename1 ‘x IN g (FST (h n)) (SND (h n))’ (* last assum *) \\
3432 qexistsl_tac [‘FST (h n)’, ‘SND (h n)’] >> art [] ]) >> DISCH_TAC \\
3433 Q.PAT_X_ASSUM `BIGUNION (IMAGE f UNIV) SUBSET X` MP_TAC \\
3434 POP_ORW >> DISCH_TAC \\
3435 Suff `suminf (\n. suminf (mu o g n)) = suminf (mu o ff)`
3436 >- (DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
3437 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_REWRITE_TAC []) \\
3438 Q.UNABBREV_TAC `ff` \\
3439 (* prepare for applying "ext_suminf_2d" *)
3440 ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
3441 Q.ABBREV_TAC `ff = \m n. mu (g m n)` \\
3442 Know `mu o UNCURRY g o h = UNCURRY ff o h`
3443 >- (SIMP_TAC std_ss [o_DEF, FUN_EQ_THM, UNCURRY, Abbr ‘ff’]) >> Rewr \\
3444 (* finally, apply "ext_suminf_2d", cleaning up easy goals *)
3445 MATCH_MP_TAC ext_suminf_2d \\
3446 `!n. suminf (ff n) = (\n. suminf (mu o g n)) n` by METIS_TAC [o_DEF] \\
3447 POP_ASSUM ((ASM_SIMP_TAC std_ss) o wrap) \\
3448 (* !m n. 0 <= ff m n *)
3449 Q.UNABBREV_TAC `ff` >> BETA_TAC \\
3450 PROVE_TAC [positive_def, measure_def, measurable_sets_def])
3451 (* Part II *)
3452 >> DISCH_TAC >> STRONG_CONJ_TAC
3453 >- (rpt STRIP_TAC >> fs [countable_covers_def, outer_measure_def] \\
3454 MATCH_MP_TAC inf_le_imp \\
3455 SIMP_TAC std_ss [GSPECIFICATION, Once (GSYM IN_APP)] \\
3456 Q.EXISTS_TAC `\n. if n = 0 then x else EMPTY` \\
3457 Know `mu o (\n :num. if n = 0 then x else EMPTY) = (\n. if n = 0 then mu x else 0)`
3458 >- (RW_TAC arith_ss [o_DEF, FUN_EQ_THM] \\
3459 Cases_on `n = 0` >- METIS_TAC [] \\
3460 PROVE_TAC [positive_def, measure_def]) >> Rewr' \\
3461 `0 <= mu x` by PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\
3462 POP_ASSUM (fn th => REWRITE_TAC [MATCH_MP ext_suminf_sing th]) \\
3463 Q.UNABBREV_TAC `C` >> BETA_TAC \\
3464 SIMP_TAC std_ss [GSPECIFICATION] \\
3465 CONJ_TAC >- (SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\
3466 GEN_TAC >> Cases_on `n = 0` >- METIS_TAC [] \\
3467 METIS_TAC [semiring_def, subsets_def]) \\
3468 SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] \\
3469 rpt STRIP_TAC >> Q.EXISTS_TAC `0` >> METIS_TAC [])
3470 >> DISCH_TAC >> STRONG_CONJ_TAC
3471 (* Part III: measure_space (sp,A,m) *)
3472 >- (fs [countable_covers_def, outer_measure_def, caratheodory_sets_def] \\
3473 Q.PAT_ASSUM `m = _` (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\ (* recover `m` *)
3474 REWRITE_TAC [measure_space_def, m_space_def, measurable_sets_def, measure_def] \\
3475 `increasing (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\
3476 `subset_class sp sts` by PROVE_TAC [semiring_def, space_def, subsets_def] \\
3477 `positive (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\
3478 `!s. s SUBSET sp ==> 0 <= m s`
3479 by PROVE_TAC [positive_def, measure_def, measurable_sets_def, IN_POW] \\
3480 Know `positive (sp,A,m)`
3481 >- (REWRITE_TAC [positive_def, measure_def, measurable_sets_def] \\
3482 CONJ_TAC >- PROVE_TAC [positive_def, measure_def] \\
3483 GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\
3484 METIS_TAC []) >> DISCH_TAC \\
3485 ONCE_REWRITE_TAC [DECIDE ``A /\ B /\ C <=> B /\ (A /\ C)``] \\
3486 CONJ_TAC >- art [] \\
3487 (* Dynkin's lemma is used here *)
3488 REWRITE_TAC [GSYM DYNKIN_LEMMA, subsets_def] \\
3489 REWRITE_TAC [dynkin_system_def, space_def, subsets_def, GSYM CONJ_ASSOC] \\
3490 STRONG_CONJ_TAC
3491 >- (REWRITE_TAC [subset_class_def] \\
3492 GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC []) >> DISCH_TAC \\
3493 MATCH_MP_TAC (prove (``!a b c. b /\ a /\ c ==> a /\ b /\ c``, PROVE_TAC [])) \\
3494 STRONG_CONJ_TAC
3495 >- (GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\
3496 rpt STRIP_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> REWRITE_TAC [SUBSET_REFL]) \\
3497 `q INTER (sp DIFF s) = q DIFF s` by ASM_SET_TAC [] >> POP_ORW \\
3498 `q DIFF (sp DIFF s) = q INTER s` by ASM_SET_TAC [] >> POP_ORW \\
3499 MATCH_MP_TAC add_comm >> DISJ1_TAC \\
3500 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf \\
3501 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) \\
3502 MATCH_MP_TAC pos_not_neginf \\
3503 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) >> DISCH_TAC \\
3504 Know `{} IN A`
3505 >- (Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\
3506 REWRITE_TAC [EMPTY_SUBSET, INTER_EMPTY, DIFF_EMPTY] >> rpt STRIP_TAC \\
3507 `m {} = 0` by PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\
3508 POP_ORW >> REWRITE_TAC [add_lzero]) >> DISCH_TAC \\
3509 STRONG_CONJ_TAC >- METIS_TAC [DIFF_EMPTY] >> DISCH_TAC \\
3510 SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\
3511 `subadditive (sp,POW sp,m)` by PROVE_TAC [OUTER_MEASURE_SPACE_SUBADDITIVE] \\
3512 Know `!a q. a IN A /\ q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a))`
3513 >- (rpt GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC [] \\
3514 rpt STRIP_TAC >> PROVE_TAC []) >> DISCH_TAC \\
3515 (* A is stable under union *)
3516 Know `!s t. s IN A /\ t IN A ==> s UNION t IN A`
3517 >- (rpt STRIP_TAC \\
3518 Suff `s UNION t IN {a | a SUBSET sp /\
3519 !q. q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a))}`
3520 >- METIS_TAC [] \\
3521 SET_SPEC_TAC [] \\
3522 CONJ_TAC >- PROVE_TAC [UNION_SUBSET, subset_class_def] \\
3523 rpt STRIP_TAC >> rename1 `p SUBSET sp` \\
3524 REWRITE_TAC [GSYM le_antisym] \\
3525 CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
3526 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\
3527 ASM_SET_TAC [IN_POW]) \\
3528 `p INTER (s UNION t) = p INTER (s UNION (t DIFF s))` by SET_TAC [] >> POP_ORW \\
3529 REWRITE_TAC [UNION_OVER_INTER] \\
3530 MATCH_MP_TAC le_trans \\
3531 Q.EXISTS_TAC `m (p INTER s) + m (p INTER (t DIFF s)) + m (p DIFF (s UNION t))` \\
3532 CONJ_TAC >- (MATCH_MP_TAC le_radd_imp \\
3533 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
3534 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\
3535 ASM_SET_TAC [IN_POW]) \\
3536 `p INTER (t DIFF s) = (p DIFF s) INTER t` by SET_TAC [] >> POP_ORW \\
3537 `p DIFF (s UNION t) = (p DIFF s) DIFF t` by SET_TAC [] >> POP_ORW \\
3538 Know `m (p INTER s) + m ((p DIFF s) INTER t) + m (p DIFF s DIFF t) =
3539 m (p INTER s) + (m ((p DIFF s) INTER t) + m (p DIFF s DIFF t))`
3540 >- (MATCH_MP_TAC EQ_SYM >> MATCH_MP_TAC add_assoc \\
3541 DISJ1_TAC \\
3542 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf >> FIRST_X_ASSUM MATCH_MP_TAC \\
3543 ASM_SET_TAC []) \\
3544 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf >> FIRST_X_ASSUM MATCH_MP_TAC \\
3545 ASM_SET_TAC []) \\
3546 MATCH_MP_TAC pos_not_neginf \\
3547 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) >> Rewr' \\
3548 Know `m ((p DIFF s) INTER t) + m (p DIFF s DIFF t) = m (p DIFF s)`
3549 >- (MATCH_MP_TAC EQ_SYM \\
3550 FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
3551 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) >> Rewr' \\
3552 Know `m (p INTER s) + m (p DIFF s) = m p`
3553 >- (MATCH_MP_TAC EQ_SYM >> FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr' \\
3554 REWRITE_TAC [le_refl]) >> DISCH_TAC \\
3555 (* A is stable under finite union *)
3556 Know `!f n. (!i. i < n ==> f i IN A) ==> BIGUNION (IMAGE f (count n)) IN A`
3557 >- (GEN_TAC >> Induct_on `n`
3558 >- ASM_SIMP_TAC arith_ss [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\
3559 RW_TAC arith_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT]) >> DISCH_TAC \\
3560 Know `!q s t. q SUBSET sp /\ s IN A /\ t IN A /\ DISJOINT s t ==>
3561 (m (q INTER (s UNION t)) = m (q INTER s) + m (q INTER t))`
3562 >- (rpt STRIP_TAC \\
3563 `q INTER s = (q INTER (s UNION t)) INTER s` by SET_TAC [] >> POP_ORW \\
3564 `q INTER t = (q INTER (s UNION t)) DIFF s`
3565 by ASM_SET_TAC [DISJOINT_DEF] >> POP_ORW \\
3566 FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) >> DISCH_TAC \\
3567 Know `!q f. q SUBSET sp ==>
3568 !n. (!i. i < n ==> f i IN A) /\
3569 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) ==>
3570 (m (q INTER (BIGUNION (IMAGE f (count n)))) =
3571 SIGMA (\i. m (q INTER f i)) (count n))`
3572 >- (rpt GEN_TAC >> DISCH_TAC \\
3573 Induct_on `n` >- (SIMP_TAC arith_ss [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY,
3574 EXTREAL_SUM_IMAGE_EMPTY, INTER_EMPTY] \\
3575 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) \\
3576 SIMP_TAC arith_ss [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT] \\
3577 STRIP_TAC \\
3578 Know `DISJOINT (f n) (BIGUNION (IMAGE f (count n)))`
3579 >- (REWRITE_TAC [DISJOINT_BIGUNION] \\
3580 RW_TAC std_ss [IN_IMAGE, IN_COUNT] \\
3581 FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) >> DISCH_TAC \\
3582 Know `m (q INTER (f n UNION BIGUNION (IMAGE f (count n)))) =
3583 m (q INTER f n) + m (q INTER BIGUNION (IMAGE f (count n)))`
3584 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
3585 CONJ_TAC >- PROVE_TAC [LESS_SUC_REFL] \\
3586 FIRST_X_ASSUM MATCH_MP_TAC \\
3587 rpt STRIP_TAC >> PROVE_TAC [LESS_SUC]) >> Rewr' \\
3588 Know `SIGMA (\i. m (q INTER f i)) (n INSERT count n) =
3589 (\i. m (q INTER f i)) n + SIGMA (\i. m (q INTER f i)) (count n DELETE n)`
3590 >- (irule EXTREAL_SUM_IMAGE_PROPERTY \\
3591 REWRITE_TAC [FINITE_COUNT, IN_INSERT, IN_COUNT] \\
3592 DISJ1_TAC >> GEN_TAC >> DISCH_TAC >> BETA_TAC \\
3593 MATCH_MP_TAC pos_not_neginf \\
3594 FIRST_X_ASSUM MATCH_MP_TAC \\
3595 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) >> Rewr' \\
3596 `count n DELETE n = count n` by REWRITE_TAC [COUNT_DELETE] >> POP_ORW \\
3597 BETA_TAC \\
3598 (* m (q INTER f n) + m (q INTER BIGUNION (IMAGE f (count n))) =
3599 m (q INTER f n) + SIGMA (\i. m (q INTER f i)) (count n) *)
3600 Cases_on `m (q INTER f n) = PosInf` >- fs [positive_def] \\
3601 Know `m (q INTER f n) <> NegInf /\ m (q INTER f n) <> PosInf`
3602 >- (POP_ASSUM (REWRITE_TAC o wrap) \\
3603 MATCH_MP_TAC pos_not_neginf \\
3604 FIRST_X_ASSUM MATCH_MP_TAC \\
3605 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\
3606 DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP EXTREAL_EQ_LADD)) \\
3607 FIRST_X_ASSUM MATCH_MP_TAC \\
3608 RW_TAC arith_ss []) >> DISCH_TAC \\
3609 (* now prove that A is stable under countably disjoint unions *)
3610 STRONG_CONJ_TAC
3611 >- (rpt STRIP_TAC \\ (* goal: BIGUNION (IMAGE f univ(:num)) IN A *)
3612 Know `!a. a IN A <=> (a SUBSET sp /\
3613 !q. q SUBSET sp ==> (m q = m (q INTER a) + m (q DIFF a)))`
3614 >- (GEN_TAC >> Q.UNABBREV_TAC `A` >> SET_SPEC_TAC []) >> Rewr' \\
3615 STRONG_CONJ_TAC >- (RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
3616 PROVE_TAC [subset_class_def]) >> DISCH_TAC \\
3617 rpt STRIP_TAC >> REWRITE_TAC [GSYM le_antisym] \\
3618 CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW]
3619 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\
3620 art [] >> ASM_SET_TAC []) \\
3621 REWRITE_TAC [BIGUNION_OVER_INTER_R] \\
3622 MATCH_MP_TAC le_trans \\
3623 Q.EXISTS_TAC `suminf (m o (\i. q INTER f i)) + m (q DIFF BIGUNION (IMAGE f univ(:num)))` \\
3624 CONJ_TAC >- (MATCH_MP_TAC le_radd_imp \\
3625 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW]
3626 (Q.SPEC `(sp,POW sp,m)` COUNTABLY_SUBADDITIVE)) \\
3627 REWRITE_TAC [] \\
3628 CONJ_TAC >- PROVE_TAC [outer_measure_space_def] \\
3629 SIMP_TAC std_ss [IN_FUNSET, IN_UNIV, IN_POW] \\
3630 CONJ_TAC >- (GEN_TAC >> MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\
3631 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
3632 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\
3633 (* preparing for applying le_sub_eq2 *)
3634 Cases_on `m q = PosInf` >- METIS_TAC [le_infty] \\
3635 Know `m q <> NegInf`
3636 >- (MATCH_MP_TAC pos_not_neginf \\
3637 FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC \\
3638 Know `suminf (m o (\i. q INTER f i)) <> NegInf`
3639 >- (MATCH_MP_TAC pos_not_neginf \\
3640 MATCH_MP_TAC ext_suminf_pos >> SIMP_TAC std_ss [o_DEF] \\
3641 GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
3642 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) >> DISCH_TAC \\
3643 Know `m (q DIFF BIGUNION (IMAGE f univ(:num))) <> NegInf`
3644 >- (MATCH_MP_TAC pos_not_neginf \\
3645 FIRST_X_ASSUM MATCH_MP_TAC \\
3646 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) >> DISCH_TAC \\
3647 Know `(* z *) m q <> NegInf /\ m q <> PosInf /\
3648 (* x *) m (q DIFF BIGUNION (IMAGE f univ(:num))) <> NegInf /\
3649 (* y *) suminf (m o (\i. q INTER f i)) <> NegInf` >- art [] \\
3650 DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP EQ_SYM) o (MATCH_MP le_sub_eq2)) \\
3651 (* suminf (m o (\i. q INTER f i)) <= m q - m (q DIFF BIGUNION (IMAGE f univ(:num))) *)
3652 Know `!n. 0 <= (m o (\i. q INTER f i)) n`
3653 >- (GEN_TAC >> SIMP_TAC std_ss [o_DEF] \\
3654 FIRST_X_ASSUM MATCH_MP_TAC \\
3655 ASM_SET_TAC []) \\
3656 DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' \\
3657 REWRITE_TAC [sup_le'] >> GEN_TAC \\
3658 SIMP_TAC std_ss [IN_IMAGE, IN_UNIV, IN_COUNT] >> STRIP_TAC \\
3659 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
3660 (* preparing for applying le_sub_eq2 again *)
3661 Know `SIGMA (m o (\i. q INTER f i)) (count n) <> NegInf`
3662 >- (MATCH_MP_TAC pos_not_neginf \\
3663 irule EXTREAL_SUM_IMAGE_POS \\
3664 SIMP_TAC std_ss [o_DEF, IN_COUNT, FINITE_COUNT] >> rpt STRIP_TAC \\
3665 FIRST_X_ASSUM MATCH_MP_TAC \\
3666 MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) >> DISCH_TAC \\
3667 Know `(* z *) m q <> NegInf /\ m q <> PosInf /\
3668 (* x *) m (q DIFF BIGUNION (IMAGE f univ(:num))) <> NegInf /\
3669 (* y *) SIGMA (m o (\i. q INTER f i)) (count n) <> NegInf` >- art [] \\
3670 DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP le_sub_eq2)) \\
3671 SIMP_TAC std_ss [o_DEF] \\
3672 (* SIGMA (\i. m (q INTER f i)) (count n) + m (q DIFF BIGUNION (IMAGE f univ(:num))) <= m q *)
3673 Know `SIGMA (\i. m (q INTER f i)) (count n) = m (q INTER BIGUNION (IMAGE f (count n)))`
3674 >- (MATCH_MP_TAC EQ_SYM >> FIRST_X_ASSUM irule >> PROVE_TAC []) >> Rewr' \\
3675 Know `m q = m (q INTER BIGUNION (IMAGE f (count n))) +
3676 m (q DIFF BIGUNION (IMAGE f (count n)))`
3677 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
3678 FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC std_ss []) >> Rewr' \\
3679 MATCH_MP_TAC le_ladd_imp \\
3680 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW]
3681 (Q.SPEC `(sp,POW sp,m)` INCREASING)) \\
3682 ASM_REWRITE_TAC [] \\
3683 MATCH_MP_TAC (prove (``!a b c. b /\ c /\ a ==> a /\ b /\ c``, PROVE_TAC [])) \\
3684 CONJ_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) \\
3685 CONJ_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) \\
3686 (* q DIFF BIGUNION (IMAGE f univ(:num)) SUBSET q DIFF BIGUNION (IMAGE f (count n)) *)
3687 MATCH_MP_TAC SUBSET_RESTRICT_DIFF \\
3688 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV] \\
3689 Q.EXISTS_TAC `x'` >> art []) >> DISCH_TAC \\
3690 (* !s t. s IN A /\ t IN A ==> s INTER t IN A *)
3691 STRONG_CONJ_TAC
3692 >- (rpt STRIP_TAC \\
3693 `s INTER t = sp DIFF ((sp DIFF s) UNION (sp DIFF t))` by ASM_SET_TAC [] >> POP_ORW \\
3694 FIRST_ASSUM MATCH_MP_TAC \\ (* removed one (sp DIFF ...) *)
3695 FIRST_ASSUM MATCH_MP_TAC \\ (* removed one (... UNION ...) *)
3696 CONJ_TAC >- (FIRST_ASSUM MATCH_MP_TAC >> art []) \\
3697 FIRST_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC \\
3698 (* countably_additive (sp,A,m) *)
3699 SIMP_TAC std_ss [countably_additive_def, measurable_sets_def, measure_def,
3700 IN_FUNSET, IN_UNIV] \\
3701 rpt STRIP_TAC \\
3702 REWRITE_TAC [GSYM le_antisym] \\
3703 CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW]
3704 (Q.SPEC `(sp,POW sp,m)` COUNTABLY_SUBADDITIVE)) \\
3705 REWRITE_TAC [IN_FUNSET, IN_UNIV, IN_POW] \\
3706 CONJ_TAC >- PROVE_TAC [outer_measure_space_def] \\
3707 CONJ_TAC >- PROVE_TAC [subset_class_def] \\
3708 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
3709 PROVE_TAC [subset_class_def]) \\
3710 Know `!n. 0 <= (m o f) n`
3711 >- (GEN_TAC >> SIMP_TAC std_ss [o_DEF] \\
3712 FIRST_X_ASSUM MATCH_MP_TAC \\
3713 FULL_SIMP_TAC std_ss [subset_class_def]) \\
3714 DISCH_THEN (MP_TAC o (MATCH_MP ext_suminf_def)) >> Rewr' \\
3715 REWRITE_TAC [sup_le'] >> GEN_TAC \\
3716 SIMP_TAC std_ss [IN_IMAGE, IN_UNIV, IN_COUNT] \\
3717 STRIP_TAC >> POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
3718 MATCH_MP_TAC le_trans >> Q.EXISTS_TAC `m (BIGUNION (IMAGE f (count n)))` \\
3719 reverse CONJ_TAC
3720 >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def, IN_POW]
3721 (Q.SPEC `(sp,POW sp,m)` INCREASING)) \\
3722 CONJ_TAC >- art [] \\
3723 MATCH_MP_TAC (prove (``!a b c. b /\ c /\ a ==> a /\ b /\ c``, PROVE_TAC [])) \\
3724 CONJ_TAC >- (RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_COUNT] \\
3725 PROVE_TAC [subset_class_def]) \\
3726 CONJ_TAC >- (RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
3727 PROVE_TAC [subset_class_def]) \\
3728 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV] \\
3729 Q.EXISTS_TAC `x'` >> art []) \\
3730 `BIGUNION (IMAGE f univ(:num)) SUBSET sp` by PROVE_TAC [subset_class_def] \\
3731 Q.PAT_X_ASSUM `!q f. q SUBSET sp ==> X`
3732 (fn th => MP_TAC (Q.SPECL [`f`, `n`]
3733 (MATCH_MP th (ASSUME ``BIGUNION (IMAGE f univ(:num)) SUBSET sp``)))) \\
3734 Know `BIGUNION (IMAGE f univ(:num)) INTER BIGUNION (IMAGE f (count n)) =
3735 BIGUNION (IMAGE f (count n))`
3736 >- (MATCH_MP_TAC SUBSET_INTER2 \\
3737 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV] \\
3738 Q.EXISTS_TAC `x'` >> art []) >> Rewr' \\
3739 Know `(\i. m (BIGUNION (IMAGE f univ(:num)) INTER f i)) = (m o f)`
3740 >- (REWRITE_TAC [o_DEF] >> FUN_EQ_TAC >> GEN_TAC >> BETA_TAC \\
3741 Suff `BIGUNION (IMAGE f univ(:num)) INTER f x = f x` >- PROVE_TAC [] \\
3742 MATCH_MP_TAC SUBSET_INTER2 \\
3743 MATCH_MP_TAC SUBSET_BIGUNION_I \\
3744 RW_TAC std_ss [IN_IMAGE, IN_UNIV] \\
3745 Q.EXISTS_TAC `x` >> REWRITE_TAC []) >> Rewr \\
3746 METIS_TAC [le_refl]) >> rpt STRIP_TAC
3747 >> fs [outer_measure_def]
3748 >> RW_TAC std_ss [le_inf', GSPECIFICATION]
3749 >> Know `!x. f x IN sts`
3750 >- (GEN_TAC \\
3751 Q.UNABBREV_TAC `C` >> fs [countable_covers_def, IN_FUNSET, IN_UNIV]) >> DISCH_TAC
3752 >> MATCH_MP_TAC le_trans
3753 >> Q.EXISTS_TAC `suminf (v o f)`
3754 >> reverse CONJ_TAC
3755 >- (MATCH_MP_TAC ext_suminf_mono \\
3756 RW_TAC std_ss [o_DEF] \\
3757 `positive (sp,POW sp,v)` by PROVE_TAC [outer_measure_space_def] \\
3758 METIS_TAC [positive_def, measurable_sets_def, measure_def, subset_class_def, IN_POW])
3759 >> MATCH_MP_TAC le_trans
3760 >> Q.EXISTS_TAC `v (BIGUNION (IMAGE f univ(:num)))`
3761 >> reverse CONJ_TAC
3762 >- (`countably_subadditive (sp,POW sp,v)` by PROVE_TAC [outer_measure_space_def] \\
3763 MATCH_MP_TAC (REWRITE_RULE [measurable_sets_def, measure_def]
3764 (Q.SPEC `(sp,POW sp,v)` COUNTABLY_SUBADDITIVE)) \\
3765 RW_TAC std_ss [IN_POW, IN_FUNSET, IN_UNIV, BIGUNION_SUBSET, IN_IMAGE] \\
3766 METIS_TAC [subset_class_def])
3767 >> Know `x SUBSET (BIGUNION (IMAGE f univ(:num)))`
3768 >- (Q.UNABBREV_TAC `C` >> fs [countable_covers_def, IN_FUNSET, IN_UNIV]) >> DISCH_TAC
3769 >> `increasing (sp,POW sp,v)` by PROVE_TAC [outer_measure_space_def]
3770 >> MATCH_MP_TAC (REWRITE_RULE [measurable_sets_def, measure_def]
3771 (Q.SPEC `(sp,POW sp,v)` INCREASING))
3772 >> RW_TAC std_ss [IN_POW, BIGUNION_SUBSET, IN_IMAGE]
3773 >> METIS_TAC [subset_class_def]
3774QED
3775
3776(* extracted from CARATHEODORY_SEMIRING for `lborel` construction *)
3777Theorem SEMIRING_FINITE_ADDITIVE_EXTENSION :
3778 !m0. semiring (m_space m0, measurable_sets m0) /\
3779 positive m0 /\ finite_additive m0 ==>
3780 ?m. ((m_space m, measurable_sets m) =
3781 smallest_ring (m_space m0) (measurable_sets m0)) /\
3782 (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\
3783 positive m /\ additive m
3784Proof
3785 rpt STRIP_TAC >> Cases_on `m0` >> Cases_on `r`
3786 >> fs [m_space_def, measurable_sets_def, measure_def]
3787 >> rename1 `positive (sp,sts,mu)` (* m0 now disappeared *)
3788 >> Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}`
3789 >> Know `sts SUBSET S /\ ring (sp,S)`
3790 >- (Know `S = subsets (smallest_ring sp sts)`
3791 >- (Q.UNABBREV_TAC `S` \\
3792 MATCH_MP_TAC EQ_SYM \\
3793 MATCH_MP_TAC SMALLEST_RING_OF_SEMIRING >> art []) >> Rewr' \\
3794 CONJ_TAC >- REWRITE_TAC [SMALLEST_RING_SUBSET_SUBSETS] \\
3795 fs [semiring_def, space_def, subsets_def] \\
3796 METIS_TAC [SPACE, SPACE_SMALLEST_RING, SMALLEST_RING])
3797 >> STRIP_TAC
3798 >> Q.ABBREV_TAC `M = \a. {r | ?c. c SUBSET sts /\ FINITE c /\ disjoint c /\
3799 (a = BIGUNION c) /\ (r = SIGMA mu c)}`
3800 >> Know `!a s t. s IN (M a) /\ t IN (M a) ==> (s = t)`
3801 >- (rpt GEN_TAC >> Q.UNABBREV_TAC `M` >> RW_TAC std_ss [GSPECIFICATION] \\
3802 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
3803 (CONJ (ASSUME ``FINITE (c :'a set set)``)
3804 (ASSUME ``disjoint (c :'a set set)``))) \\
3805 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
3806 (CONJ (ASSUME ``FINITE (c' :'a set set)``)
3807 (ASSUME ``disjoint (c' :'a set set)``))) \\
3808 Q.PAT_X_ASSUM `BIGUNION c' = BIGUNION c` MP_TAC >> art [] \\
3809 DISCH_TAC \\
3810 Know `!i. i < n ==> (f i = f i INTER BIGUNION (IMAGE f' (count n')))`
3811 >- (POP_ORW >> rpt STRIP_TAC \\
3812 MATCH_MP_TAC EQ_SYM >> REWRITE_TAC [INTER_SUBSET_EQN] \\
3813 MATCH_MP_TAC SUBSET_BIGUNION_I \\
3814 PROVE_TAC [IN_IMAGE, IN_COUNT]) >> DISCH_TAC \\
3815 Know `IMAGE f (count n) =
3816 IMAGE (\i. f i INTER BIGUNION (IMAGE f' (count n'))) (count n)`
3817 >- (MATCH_MP_TAC SUBSET_ANTISYM \\
3818 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
3819 rpt STRIP_TAC >- (Q.EXISTS_TAC `x'` >> METIS_TAC []) \\
3820 Q.EXISTS_TAC `i` >> METIS_TAC []) >> Rewr \\
3821 Know `!i. i < n' ==> (f' i = f' i INTER BIGUNION (IMAGE f (count n)))`
3822 >- (Q.PAT_X_ASSUM `BIGUNION (IMAGE f' (count n')) = BIGUNION (IMAGE f (count n))`
3823 (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) >> rpt STRIP_TAC \\
3824 MATCH_MP_TAC EQ_SYM >> REWRITE_TAC [INTER_SUBSET_EQN] \\
3825 MATCH_MP_TAC SUBSET_BIGUNION_I \\
3826 PROVE_TAC [IN_IMAGE, IN_COUNT]) >> DISCH_TAC \\
3827 Know `IMAGE f' (count n') =
3828 IMAGE (\i. f' i INTER BIGUNION (IMAGE f (count n))) (count n')`
3829 >- (MATCH_MP_TAC SUBSET_ANTISYM \\
3830 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
3831 rpt STRIP_TAC >- (Q.EXISTS_TAC `x'` >> METIS_TAC []) \\
3832 Q.EXISTS_TAC `i` >> METIS_TAC []) \\
3833 DISCH_THEN
3834 ((GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap) \\
3835 Know `SIGMA mu (IMAGE (\i. f i INTER BIGUNION (IMAGE f' (count n'))) (count n)) =
3836 SIGMA (mu o (\i. f i INTER BIGUNION (IMAGE f' (count n')))) (count n)`
3837 >- (irule EXTREAL_SUM_IMAGE_IMAGE \\
3838 REWRITE_TAC [FINITE_COUNT] >> CONJ_TAC
3839 >- (DISJ1_TAC >> GEN_TAC >> RW_TAC std_ss [IN_IMAGE, IN_COUNT] \\
3840 Suff `0 <= mu (f i)` >- METIS_TAC [le_not_infty] \\
3841 METIS_TAC [SUBSET_DEF, positive_def, measure_def, measurable_sets_def]) \\
3842 MATCH_MP_TAC INJ_IMAGE \\
3843 Q.EXISTS_TAC `c` >> REWRITE_TAC [INJ_DEF, IN_COUNT] >> BETA_TAC \\
3844 METIS_TAC []) >> Rewr' \\
3845 Know `SIGMA mu (IMAGE (\i. f' i INTER BIGUNION (IMAGE f (count n))) (count n')) =
3846 SIGMA (mu o (\i. f' i INTER BIGUNION (IMAGE f (count n)))) (count n')`
3847 >- (irule EXTREAL_SUM_IMAGE_IMAGE \\
3848 REWRITE_TAC [FINITE_COUNT] >> CONJ_TAC
3849 >- (DISJ1_TAC >> GEN_TAC >> RW_TAC std_ss [IN_IMAGE, IN_COUNT] \\
3850 Suff `0 <= mu (f' i)` >- METIS_TAC [le_not_infty] \\
3851 METIS_TAC [SUBSET_DEF, positive_def, measure_def, measurable_sets_def]) \\
3852 MATCH_MP_TAC INJ_IMAGE \\
3853 Q.EXISTS_TAC `c'` >> REWRITE_TAC [INJ_DEF, IN_COUNT] >> BETA_TAC \\
3854 METIS_TAC []) >> Rewr' \\
3855 SIMP_TAC std_ss [BIGUNION_OVER_INTER_R, o_DEF] \\
3856 (* applying FINITE_ADDITIVE and EXTREAL_SUM_IMAGE_EQ *)
3857 Know `SIGMA (\i. mu (BIGUNION (IMAGE (\i'. f i INTER f' i') (count n')))) (count n) =
3858 SIGMA (\i. SIGMA (mu o (\i'. f i INTER f' i')) (count n')) (count n)`
3859 >- (irule EXTREAL_SUM_IMAGE_EQ \\
3860 SIMP_TAC std_ss [o_DEF, FINITE_COUNT, IN_COUNT] \\
3861 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\
3862 STRONG_CONJ_TAC
3863 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC
3864 (* mu (BIGUNION (IMAGE (\i'. f x' INTER f' i') (count n'))) <> NegInf *)
3865 >- (MATCH_MP_TAC pos_not_neginf \\
3866 fs [positive_def, measure_def, measurable_sets_def] \\
3867 Q.PAT_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3868 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_R] \\
3869 `f x INTER BIGUNION (IMAGE f' (count n')) = f x` by PROVE_TAC [] \\
3870 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) \\
3871 (* SIGMA (\i'. mu (f x' INTER f' i')) (count n') <> NegInf *)
3872 MATCH_MP_TAC pos_not_neginf \\
3873 irule EXTREAL_SUM_IMAGE_POS >> RW_TAC std_ss [IN_COUNT, FINITE_COUNT] \\
3874 fs [positive_def, measure_def, measurable_sets_def] \\
3875 Q.PAT_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3876 MATCH_MP_TAC
3877 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3878 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\
3879 rpt STRIP_TAC \\
3880 (* applying FINITE_ADDITIVE on (sp,sts,mu) *)
3881 Suff `SIGMA (mu o (\i'. f x INTER f' i')) (count n') =
3882 mu (BIGUNION (IMAGE (\i'. f x INTER f' i') (count n')))` >- METIS_TAC [o_DEF] \\
3883 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
3884 (Q.SPEC `(sp,sts,mu)` FINITE_ADDITIVE)) \\
3885 ASM_SIMP_TAC std_ss [] \\
3886 CONJ_TAC >- (rpt STRIP_TAC \\
3887 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3888 (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3889 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\
3890 CONJ_TAC >- (rpt STRIP_TAC \\
3891 MATCH_MP_TAC DISJOINT_RESTRICT_R >> PROVE_TAC []) \\
3892 (* `BIGUNION (IMAGE (\i'. f x' INTER f' i') (count n')) IN sts` *)
3893 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_R] \\
3894 `f x INTER BIGUNION (IMAGE f' (count n')) = f x` by PROVE_TAC [] \\
3895 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> Rewr' \\
3896 (* symmetric with previous known *)
3897 Know `SIGMA (\i. mu (BIGUNION (IMAGE (\i'. f' i INTER f i') (count n)))) (count n') =
3898 SIGMA (\i. SIGMA (mu o (\i'. f' i INTER f i')) (count n)) (count n')`
3899 >- (irule EXTREAL_SUM_IMAGE_EQ \\
3900 SIMP_TAC std_ss [o_DEF, FINITE_COUNT, IN_COUNT] \\
3901 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\
3902 STRONG_CONJ_TAC
3903 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC
3904 (* mu (BIGUNION (IMAGE (\i'. f' x' INTER f i') (count n))) <> NegInf *)
3905 >- (MATCH_MP_TAC pos_not_neginf \\
3906 fs [positive_def, measure_def, measurable_sets_def] \\
3907 Q.PAT_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3908 (* BIGUNION (IMAGE (\i'. f' x' INTER f i') (count n)) IN sts *)
3909 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_R] \\
3910 `f' x INTER BIGUNION (IMAGE f (count n)) = f' x` by PROVE_TAC [] \\
3911 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) \\
3912 (* SIGMA (\i'. mu (f' x' INTER f i')) (count n) <> NegInf *)
3913 MATCH_MP_TAC pos_not_neginf \\
3914 irule EXTREAL_SUM_IMAGE_POS >> RW_TAC std_ss [IN_COUNT, FINITE_COUNT] \\
3915 fs [positive_def, measure_def, measurable_sets_def] \\
3916 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3917 MATCH_MP_TAC
3918 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3919 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\
3920 rpt STRIP_TAC \\
3921 (* applying FINITE_ADDITIVE on (sp,sts,mu) *)
3922 Suff `SIGMA (mu o (\i'. f' x INTER f i')) (count n) =
3923 mu (BIGUNION (IMAGE (\i'. f' x INTER f i') (count n)))` >- METIS_TAC [o_DEF] \\
3924 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
3925 (Q.SPEC `(sp,sts,mu)` FINITE_ADDITIVE)) \\
3926 ASM_SIMP_TAC std_ss [] \\
3927 CONJ_TAC >- (rpt STRIP_TAC \\
3928 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3929 (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3930 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\
3931 CONJ_TAC >- (rpt STRIP_TAC \\
3932 MATCH_MP_TAC DISJOINT_RESTRICT_R >> PROVE_TAC []) \\
3933 (* `BIGUNION (IMAGE (\i'. f' x' INTER f i') (count n)) IN sts` *)
3934 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_R] \\
3935 `f' x INTER BIGUNION (IMAGE f (count n)) = f' x` by PROVE_TAC [] \\
3936 POP_ORW >> METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> Rewr' \\
3937 SIMP_TAC std_ss [o_DEF] \\
3938 (* applying NESTED_EXTREAL_SUM_IMAGE_REVERSE, swapping the two SIGMAs *)
3939 Know `!i. (\i'. mu (f i INTER f' i')) = (\i i'. mu (f i INTER f' i')) i`
3940 >- PROVE_TAC [] >> Rewr' \\
3941 Know `!i. (\i'. mu (f' i INTER f i')) = (\i i'. mu (f' i INTER f i')) i`
3942 >- PROVE_TAC [] >> Rewr' \\
3943 Know `SIGMA (\i. SIGMA ((\i i'. mu (f' i INTER f i')) i) (count n)) (count n') =
3944 SIGMA (\i. SIGMA (\y. (\i i'. mu (f' i INTER f i')) y i) (count n')) (count n)`
3945 >- (MATCH_MP_TAC NESTED_EXTREAL_SUM_IMAGE_REVERSE \\
3946 RW_TAC std_ss [FINITE_COUNT, IN_COUNT] \\
3947 MATCH_MP_TAC pos_not_neginf \\
3948 fs [positive_def, measure_def, measurable_sets_def] \\
3949 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3950 MATCH_MP_TAC
3951 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3952 METIS_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) >> Rewr' \\
3953 (* reduce one level of SIGMA *)
3954 irule EXTREAL_SUM_IMAGE_EQ \\
3955 SIMP_TAC std_ss [IN_COUNT, FINITE_COUNT] \\
3956 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\
3957 STRONG_CONJ_TAC
3958 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC \\ (* 2 subgoals, same tactics *)
3959 MATCH_MP_TAC pos_not_neginf \\
3960 irule EXTREAL_SUM_IMAGE_POS >> RW_TAC std_ss [IN_COUNT, FINITE_COUNT] \\
3961 fs [positive_def, measure_def, measurable_sets_def] \\
3962 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3963 MATCH_MP_TAC
3964 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3965 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\
3966 rpt STRIP_TAC \\
3967 (* reduce another level of SIGMA *)
3968 irule EXTREAL_SUM_IMAGE_EQ \\
3969 SIMP_TAC std_ss [IN_COUNT, FINITE_COUNT] \\
3970 MATCH_MP_TAC (prove (``!a b c. b /\ a ==> a /\ (b \/ c)``, PROVE_TAC [])) \\
3971 STRONG_CONJ_TAC
3972 >- (GEN_TAC >> DISCH_TAC >> CONJ_TAC \\ (* 2 subgoals, same tactics *)
3973 MATCH_MP_TAC pos_not_neginf \\
3974 fs [positive_def, measure_def, measurable_sets_def] \\
3975 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
3976 MATCH_MP_TAC
3977 (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
3978 PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) \\
3979 rpt STRIP_TAC \\
3980 PROVE_TAC [INTER_COMM])
3981 >> DISCH_TAC
3982 (* m' is the inf (or sup) of M, which is either empty or a singleton *)
3983 >> Q.ABBREV_TAC `(m' :'a measure) = inf o M`
3984 (* we prove that the "inf" can be eliminated given one element in (M a) *)
3985 >> Know `!a r. r IN (M a) ==> (m' a = r)`
3986 >- (rpt STRIP_TAC \\
3987 Q.UNABBREV_TAC `m'` >> SIMP_TAC std_ss [GSPECIFICATION] \\
3988 MATCH_MP_TAC inf_const_alt \\
3989 CONJ_TAC >- (Q.EXISTS_TAC `r` >> PROVE_TAC [IN_APP]) \\
3990 METIS_TAC [IN_APP]) >> DISCH_TAC
3991 (* now we can prove (6.3) as a property of m', easily. *)
3992 >> Know `!c. c SUBSET sts /\ FINITE c /\ disjoint c ==> (m' (BIGUNION c) = SIGMA mu c)`
3993 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
3994 Q.UNABBREV_TAC `M` >> SIMP_TAC std_ss [GSPECIFICATION] \\
3995 Q.EXISTS_TAC `c` >> art []) >> DISCH_TAC
3996 >> Q.EXISTS_TAC `(sp,S,m')`
3997 >> REWRITE_TAC [m_space_def, measurable_sets_def, measure_def]
3998 (* (sp,S) = smallest_ring sp sts *)
3999 >> CONJ_TAC
4000 >- (Q.UNABBREV_TAC `S` \\
4001 METIS_TAC [SPACE, SPACE_SMALLEST_RING, SMALLEST_RING_OF_SEMIRING,
4002 space_def, subsets_def])
4003 (* m' extends mu on sts *)
4004 >> STRONG_CONJ_TAC
4005 >- (rpt STRIP_TAC \\
4006 `m' s = m' (BIGUNION {s})` by PROVE_TAC [BIGUNION_SING] >> POP_ORW \\
4007 Know `m' (BIGUNION {s}) = SIGMA mu {s}`
4008 >- (FIRST_X_ASSUM MATCH_MP_TAC >> REWRITE_TAC [FINITE_SING, disjoint_sing] \\
4009 PROVE_TAC [SUBSET_DEF, IN_SING]) >> Rewr' \\
4010 REWRITE_TAC [EXTREAL_SUM_IMAGE_SING]) >> DISCH_TAC
4011 (* positive (sp,S,m') *)
4012 >> STRONG_CONJ_TAC
4013 >- (RW_TAC std_ss [positive_def, measure_def] >| (* 2 subgoals *)
4014 [ (* goal 1 (of 2): m' {} = 0 *)
4015 FIRST_X_ASSUM MATCH_MP_TAC \\
4016 Q.UNABBREV_TAC `M` >> SIMP_TAC std_ss [GSPECIFICATION] \\
4017 Q.EXISTS_TAC `{}` \\
4018 REWRITE_TAC [EMPTY_SUBSET, FINITE_EMPTY, disjoint_empty, BIGUNION_EMPTY,
4019 EXTREAL_SUM_IMAGE_EMPTY],
4020 (* goal 2 (of 2): 0 <= m' s *)
4021 Q.UNABBREV_TAC `m'` >> SIMP_TAC std_ss [GSPECIFICATION] \\
4022 REWRITE_TAC [le_inf] >> GEN_TAC \\
4023 Suff `y IN (M s) ==> 0 <= y` >- PROVE_TAC [IN_APP] \\
4024 Q.UNABBREV_TAC `M` >> SIMP_TAC std_ss [GSPECIFICATION] \\
4025 rpt STRIP_TAC >> POP_ORW \\
4026 (* 0 <= SIGMA mu c *)
4027 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> art [] \\
4028 rpt STRIP_TAC \\
4029 fs [positive_def, measure_def, measurable_sets_def] \\
4030 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
4031 PROVE_TAC [SUBSET_DEF] ]) >> DISCH_TAC
4032 (* additive (sp,S,m') *)
4033 >> RW_TAC std_ss [additive_def, measurable_sets_def, measure_def]
4034 (* m' (s UNION t) = m' s + m' t *)
4035 >> Q.UNABBREV_TAC `S` >> fs []
4036 (* NOTE: `DISJOINT c c'` doesn't hold *)
4037 >> Know `DISJOINT (c DELETE {}) (c' DELETE {})`
4038 >- (RW_TAC std_ss [DISJOINT_DEF, INTER_DEF, NOT_IN_EMPTY, Once EXTENSION,
4039 GSPECIFICATION, IN_DELETE] \\
4040 STRONG_DISJ_TAC >> DISJ2_TAC \\
4041 STRONG_DISJ_TAC >> ASM_SET_TAC [])
4042 >> DISCH_TAC
4043 >> Know `(SIGMA mu c = SIGMA mu (c DELETE {})) /\
4044 (SIGMA mu c' = SIGMA mu (c' DELETE {})) /\
4045 (SIGMA mu c'' = SIGMA mu (c'' DELETE {}))`
4046 >- (rpt STRIP_TAC \\ (* 3 subgoals, same tactics *)
4047 (rename1 `SIGMA mu d = SIGMA mu (d DELETE {})` \\
4048 reverse (Cases_on `{} IN d`)
4049 >- (`d DELETE {} = d` by PROVE_TAC [DELETE_NON_ELEMENT] >> art []) \\
4050 `d = {} INSERT d` by ASM_SET_TAC [] \\
4051 POP_ASSUM (* only rewrite LHS *)
4052 ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap) \\
4053 Know `SIGMA mu (d DELETE {}) = mu {} + SIGMA mu (d DELETE {})`
4054 >- fs [positive_def, measure_def, add_lzero] >> Rewr' \\
4055 irule EXTREAL_SUM_IMAGE_PROPERTY_NEG >> RW_TAC std_ss [] \\
4056 MATCH_MP_TAC (MATCH_MP (REWRITE_RULE [measure_def, measurable_sets_def]
4057 (Q.SPEC `(sp,sts,mu)` positive_not_infty))
4058 (ASSUME ``positive (sp,sts,mu)``)) \\
4059 ASM_SET_TAC [])) >> Rewr'
4060 >> Know `SIGMA mu (c DELETE {}) + SIGMA mu (c' DELETE {}) =
4061 SIGMA mu ((c DELETE {}) UNION (c' DELETE {}))`
4062 >- (MATCH_MP_TAC EQ_SYM >> irule EXTREAL_SUM_IMAGE_DISJOINT_UNION \\
4063 rw [FINITE_DELETE] >> DISJ1_TAC >> RW_TAC std_ss [] \\
4064 MATCH_MP_TAC (MATCH_MP (REWRITE_RULE [measure_def, measurable_sets_def]
4065 (Q.SPEC `(sp,sts,mu)` positive_not_infty))
4066 (ASSUME ``positive (sp,sts,mu)``)) \\
4067 ASM_SET_TAC []) >> Rewr'
4068 >> `((c DELETE {}) UNION (c' DELETE {})) = (c UNION c') DELETE {}` by SET_TAC []
4069 >> POP_ORW
4070 >> Q.PAT_X_ASSUM `!a s t. s IN (M a) /\ t IN (M a) ==> (s = t)` MATCH_MP_TAC
4071 >> Q.EXISTS_TAC `BIGUNION (c'' DELETE {})`
4072 >> Q.PAT_X_ASSUM `!a r. r IN M a ==> m' a = r` K_TAC
4073 >> Q.UNABBREV_TAC `M`
4074 >> RW_TAC std_ss [GSPECIFICATION]
4075 >- (Q.EXISTS_TAC `c'' DELETE {}` \\
4076 rw [FINITE_DELETE] >- ASM_SET_TAC [] \\
4077 ASM_SET_TAC [disjoint_def])
4078 >> Q.EXISTS_TAC `c UNION c' DELETE {}` >> rw [FINITE_DELETE]
4079 >- ASM_SET_TAC []
4080 >- ASM_SET_TAC [disjoint_def]
4081 >> Q.PAT_X_ASSUM `BIGUNION c UNION BIGUNION c' = BIGUNION c''` MP_TAC
4082 >> RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_UNION, IN_DELETE,
4083 NOT_IN_EMPTY]
4084 >> EQ_TAC >> rpt STRIP_TAC >> METIS_TAC []
4085QED
4086
4087(* extracted from CARATHEODORY_SEMIRING *)
4088Theorem SEMIRING_PREMEASURE_EXTENSION :
4089 !m0. semiring (m_space m0, measurable_sets m0) /\ premeasure m0 ==>
4090 ?m. ((m_space m, measurable_sets m) =
4091 smallest_ring (m_space m0) (measurable_sets m0)) /\
4092 (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\
4093 premeasure m
4094Proof
4095 rpt STRIP_TAC
4096 >> `finite_additive m0` by PROVE_TAC [SEMIRING_PREMEASURE_FINITE_ADDITIVE]
4097 >> fs [premeasure_def]
4098 >> `?m. ((m_space m,measurable_sets m) =
4099 smallest_ring (m_space m0) (measurable_sets m0)) /\
4100 (!s. s IN measurable_sets m0 ==> measure m s = measure m0 s) /\
4101 positive m /\ additive m`
4102 by METIS_TAC [Q.SPEC `m0` SEMIRING_FINITE_ADDITIVE_EXTENSION]
4103 >> Know `ring (m_space m,measurable_sets m)`
4104 >- (art [] >> MATCH_MP_TAC SMALLEST_RING \\
4105 fs [semiring_def, space_def, subsets_def]) >> DISCH_TAC
4106 >> `finite_additive m` by PROVE_TAC [RING_ADDITIVE_FINITE_ADDITIVE]
4107 (* cleanup the goal *)
4108 >> Q.EXISTS_TAC `m` >> rw []
4109 >> Cases_on `m0` >> Cases_on `r`
4110 >> fs [m_space_def, measurable_sets_def, measure_def]
4111 >> rename1 `positive (sp,sts,mu)` (* m0 disappears *)
4112 >> Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}`
4113 >> Cases_on `m` >> Cases_on `r`
4114 >> fs [m_space_def, measurable_sets_def, measure_def]
4115 >> rename1 `positive (sp',S',m')` (* m disappears *)
4116 >> `sp' = sp` by PROVE_TAC [SPACE_SMALLEST_RING, SPACE, space_def, subsets_def]
4117 >> Know `S' = S`
4118 >- (Q.UNABBREV_TAC `S` \\
4119 METIS_TAC [SMALLEST_RING_OF_SEMIRING, SPACE, space_def, subsets_def])
4120 >> DISCH_TAC >> fs []
4121 >> NTAC 2 (POP_ASSUM K_TAC) (* sp' and S' disappear *)
4122 >> `sts SUBSET S` by PROVE_TAC [SMALLEST_RING_SUBSET_SUBSETS, subsets_def]
4123 >> Q.PAT_X_ASSUM `(sp,S) = smallest_ring sp sts` K_TAC
4124 (* recover the original definition of m' *)
4125 >> Know `!c. c SUBSET sts /\ FINITE c /\ disjoint c ==> (m' (BIGUNION c) = SIGMA mu c)`
4126 >- (rpt STRIP_TAC \\
4127 MATCH_MP_TAC EQ_TRANS >> Q.EXISTS_TAC `SIGMA m' c` \\
4128 reverse CONJ_TAC
4129 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\
4130 STRONG_CONJ_TAC (* !x. x IN c ==> m' x = mu x *)
4131 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
4132 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\
4133 RW_TAC std_ss [] >> DISJ1_TAC \\
4134 GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\
4135 fs [positive_def, measure_def, measurable_sets_def] \\
4136 FIRST_X_ASSUM MATCH_MP_TAC \\
4137 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\
4138 MATCH_MP_TAC EQ_SYM \\
4139 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4140 (Q.SPEC `(sp,S,m')` FINITE_ADDITIVE_ALT)) \\
4141 rw [] >> ASM_SET_TAC []) >> DISCH_TAC
4142 (* countably_additive (sp,S,m') *)
4143 >> RW_TAC std_ss [countably_additive_def, measure_def, measurable_sets_def,
4144 IN_FUNSET, IN_UNIV]
4145 >> Know `!x. ?c. (f x = BIGUNION c) /\ c SUBSET sts /\ FINITE c /\ disjoint c`
4146 >- (Q.X_GEN_TAC `x` \\
4147 Q.PAT_X_ASSUM `!x. f x IN S` (MP_TAC o (Q.SPEC `x`)) \\
4148 Q.UNABBREV_TAC `S` >> SIMP_TAC std_ss [GSPECIFICATION])
4149 >> SIMP_TAC std_ss [SKOLEM_THM] >> STRIP_TAC (* skolemization here *)
4150 (* g is a finite disjoint union of (f n) *)
4151 >> `!n. f n = BIGUNION (f' n)`
4152 by PROVE_TAC [] >> rename1 `!n. f n = BIGUNION (g n)`
4153 >> `!n. g n SUBSET sts` by PROVE_TAC []
4154 >> `!n. FINITE (g n)` by PROVE_TAC []
4155 >> `!n. disjoint (g n)` by PROVE_TAC []
4156 >> Q.PAT_X_ASSUM `!x. (f x = BIGUNION (g x)) /\ P` K_TAC
4157 (* applying finite_disjoint_decomposition' *)
4158 >> Know `!x. ?h n. (!i. i < n ==> h i IN (g x)) /\ (!i. n <= i ==> (h i = {})) /\
4159 (g x = IMAGE h (count n)) /\
4160 (BIGUNION (g x) = BIGUNION (IMAGE h univ(:num))) /\
4161 (!i j. i < n /\ j < n /\ i <> j ==> h i <> h j) /\
4162 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (h i) (h j))`
4163 >- (Q.X_GEN_TAC `n` \\
4164 Know `FINITE (g n) /\ disjoint (g n)` >- PROVE_TAC [] \\
4165 DISCH_THEN (STRIP_ASSUME_TAC o (MATCH_MP finite_disjoint_decomposition')) \\
4166 Q.EXISTS_TAC `f'` >> Q.EXISTS_TAC `n'` >> art [])
4167 >> SIMP_TAC std_ss [SKOLEM_THM] >> STRIP_TAC (* skolemization here *)
4168 >> `!n i. i < f'' n ==> f' n i IN g n` by PROVE_TAC []
4169 >> rename1 `!n i. i < p n ==> s n i IN g n`
4170 >> `!n i. p n <= i ==> (s n i = {})` by PROVE_TAC []
4171 >> `!n. g n = IMAGE (s n) (count (p n))` by PROVE_TAC []
4172 >> `!n. BIGUNION (g n) = BIGUNION (IMAGE (s n) univ(:num))` by PROVE_TAC []
4173 >> `!n i j. i < p n /\ j < p n /\ i <> j ==> s n i <> s n j` by PROVE_TAC []
4174 >> `!n i j. i < p n /\ j < p n /\ i <> j ==>
4175 DISJOINT (s n i) (s n j)` by PROVE_TAC []
4176 >> Q.PAT_X_ASSUM `!x. (!i. i < p x ==> s x i IN g x) /\ X` K_TAC
4177 (* properties of 2-dimension sets s(n,i), p(n) is the length of each f(n) *)
4178 >> Know `!n i. s n i IN sts`
4179 >- (rpt GEN_TAC >> Cases_on `p n <= i` (* easy case *)
4180 >- (`s n i = {}` by PROVE_TAC [] >> art [] \\
4181 PROVE_TAC [semiring_def, subsets_def]) \\
4182 POP_ASSUM (STRIP_ASSUME_TAC o (REWRITE_RULE [GSYM NOT_LESS])) \\
4183 `s n i IN g n` by PROVE_TAC [] \\
4184 PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC
4185 >> STRIP_ASSUME_TAC NUM_2D_BIJ_INV
4186 >> rename1 `BIJ h univ(:num) (univ(:num) CROSS univ(:num))`
4187 >> Know `BIGUNION (IMAGE f univ(:num)) =
4188 BIGUNION (IMAGE (\n. BIGUNION (IMAGE (s n) univ(:num))) univ(:num))`
4189 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV]) >> DISCH_TAC
4190 >> STRIP_ASSUME_TAC (Q.SPEC `s` BIGUNION_IMAGE_BIGUNION_IMAGE_UNIV)
4191 >> STRIP_ASSUME_TAC (MATCH_MP (Q.SPEC `s` BIGUNION_IMAGE_UNIV_CROSS_UNIV)
4192 (ASSUME ``BIJ h univ(:num) (univ(:num) CROSS univ(:num))``))
4193 >> Know `BIGUNION (IMAGE f univ(:num)) = BIGUNION (IMAGE (UNCURRY s o h) univ(:num))`
4194 >- METIS_TAC [] >> NTAC 3 (POP_ASSUM K_TAC) >> DISCH_TAC >> art []
4195 (* now we show that `z` is a countable disjoint union of sets in sts, constructed by
4196 compressing f and g together. Once the properties of z were established, we don't
4197 need to uncompress it back any more, nor needed properties of f and g. *)
4198 >> Q.ABBREV_TAC `z = UNCURRY s o h`
4199 >> Know `!n. (z n) IN sts`
4200 >- (Q.UNABBREV_TAC `z` >> RW_TAC std_ss [UNCURRY, o_DEF]) >> DISCH_TAC
4201 >> Know `BIGUNION (IMAGE z univ(:num)) IN S`
4202 >- (Q.UNABBREV_TAC `z` >> METIS_TAC []) >> DISCH_TAC
4203 (* disjointness of z *)
4204 >> Know `!i j k l. i <> j ==> DISJOINT (s i k) (s j l)`
4205 >- (rpt STRIP_TAC \\
4206 Cases_on `p i <= k` >- METIS_TAC [DISJOINT_EMPTY] \\
4207 Cases_on `p j <= l` >- METIS_TAC [DISJOINT_EMPTY] \\
4208 `DISJOINT (BIGUNION (g i)) (BIGUNION (g j))` by PROVE_TAC [] \\
4209 POP_ASSUM (irule o (REWRITE_RULE [DISJOINT_BIGUNION])) \\
4210 fs [NOT_LESS_EQUAL]) >> DISCH_TAC
4211 >> Know `!i j. i <> j ==> DISJOINT (z i) (z j)`
4212 >- (rpt STRIP_TAC \\
4213 Q.UNABBREV_TAC `z` >> SIMP_TAC std_ss [o_DEF, UNCURRY] \\
4214 Cases_on `FST (h i) = FST (h j)`
4215 >- (Cases_on `p (FST (h i)) <= SND (h i)` >- METIS_TAC [DISJOINT_EMPTY] \\
4216 Cases_on `p (FST (h j)) <= SND (h j)` >- METIS_TAC [DISJOINT_EMPTY] \\
4217 fs [NOT_LESS_EQUAL] \\
4218 LAST_X_ASSUM MATCH_MP_TAC >> rfs [] \\
4219 CCONTR_TAC >> fs [] \\
4220 `h i = h j` by PROVE_TAC [PAIR_FST_SND_EQ] \\
4221 METIS_TAC [BIJ_DEF, INJ_DEF, IN_UNIV, IN_CROSS]) \\
4222 FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC
4223 (* construct another finite disjoint union such that BIGUNION c = Z *)
4224 >> Q.ABBREV_TAC `Z = BIGUNION (IMAGE z univ(:num))`
4225 >> Know `?c. (Z = BIGUNION c) /\ c SUBSET sts /\ FINITE c /\ disjoint c`
4226 >- (Q.PAT_X_ASSUM `Z IN S` MP_TAC \\
4227 Q.UNABBREV_TAC `S` >> SET_SPEC_TAC [] >> STRIP_TAC \\
4228 Q.EXISTS_TAC `c` >> art []) >> STRIP_TAC
4229 >> PURE_ASM_REWRITE_TAC []
4230 >> Know `m' (BIGUNION c) = SIGMA mu c`
4231 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr'
4232 (* convert c into a disjoint sequence f' of sets *)
4233 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
4234 (CONJ (ASSUME ``FINITE (c :'a set set)``)
4235 (ASSUME ``disjoint (c :'a set set)``)))
4236 >> PURE_ASM_REWRITE_TAC []
4237 (* SIGMA mu (IMAGE f' (count n)) = suminf (m' o f) *)
4238 >> Know `!i. i < n ==> (f' i = (f' i) INTER BIGUNION (IMAGE z univ(:num)))`
4239 >- (rpt STRIP_TAC \\
4240 MATCH_MP_TAC EQ_SYM >> REWRITE_TAC [INTER_SUBSET_EQN] \\
4241 `BIGUNION (IMAGE z univ(:num)) = BIGUNION (IMAGE f' (count n))` by PROVE_TAC [] \\
4242 POP_ORW >> MATCH_MP_TAC SUBSET_BIGUNION_I \\
4243 RW_TAC std_ss [IN_IMAGE, IN_COUNT]) >> DISCH_TAC
4244 (* LHS reductions *)
4245 >> Know `SIGMA mu (IMAGE f' (count n)) = SIGMA (mu o f') (count n)`
4246 >- (irule EXTREAL_SUM_IMAGE_IMAGE \\
4247 RW_TAC std_ss [FINITE_COUNT, IN_IMAGE, IN_COUNT] >| (* 2 subgoals *)
4248 [ (* goal 1 (of 2) *)
4249 DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> art [] \\
4250 MATCH_MP_TAC pos_not_neginf \\
4251 `f' x' IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
4252 METIS_TAC [positive_def, measure_def, measurable_sets_def],
4253 (* goal 2 (of 2) *)
4254 MATCH_MP_TAC INJ_IMAGE >> Q.EXISTS_TAC `sts` \\
4255 RW_TAC std_ss [INJ_DEF, IN_COUNT] >- PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
4256 CCONTR_TAC >> PROVE_TAC [] ]) >> Rewr'
4257 >> Know `SIGMA (mu o f') (count n) =
4258 SIGMA (mu o (\i. (f' i) INTER BIGUNION (IMAGE z univ(:num)))) (count n)`
4259 >- (irule EXTREAL_SUM_IMAGE_EQ \\
4260 SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT, o_DEF] \\
4261 CONJ_TAC >- (rpt STRIP_TAC >> METIS_TAC []) \\
4262 DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\
4263 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf \\
4264 `f' x IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
4265 METIS_TAC [positive_def, measure_def, measurable_sets_def]) \\
4266 `f' x INTER BIGUNION (IMAGE z univ(:num)) = f' x` by METIS_TAC [] >> POP_ORW \\
4267 MATCH_MP_TAC pos_not_neginf \\
4268 `f' x IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
4269 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr'
4270 >> `!i. f' i INTER BIGUNION (IMAGE z univ(:num)) =
4271 BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num))`
4272 by REWRITE_TAC [BIGUNION_OVER_INTER_R] >> art []
4273 >> Know `!i. i < n ==> BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num)) IN sts`
4274 >- (rpt STRIP_TAC \\
4275 FIRST_X_ASSUM (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM) o (Q.SPEC `i`)) \\
4276 Q.PAT_X_ASSUM `!i. i < n ==> X`
4277 (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM) o
4278 (fn th => (MATCH_MP th (ASSUME ``(i :num) < n``)))) \\
4279 PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> DISCH_TAC
4280 >> Know `!i j. i < n ==> (f' i INTER z j) IN sts`
4281 >- (rpt STRIP_TAC \\
4282 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
4283 art [] >> PROVE_TAC [SUBSET_DEF, IN_COUNT, IN_IMAGE]) >> DISCH_TAC
4284 >> Know `!i. i < n ==> (mu (BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num))) =
4285 suminf (mu o (\n. f' i INTER z n)))`
4286 >- (rpt STRIP_TAC >> MATCH_MP_TAC EQ_SYM \\
4287 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4288 (Q.SPEC `(sp,sts,mu)` COUNTABLY_ADDITIVE)) \\
4289 ASM_SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\
4290 Q.X_GEN_TAC `a` >> Q.X_GEN_TAC `b` >> DISCH_TAC \\
4291 MATCH_MP_TAC DISJOINT_RESTRICT_R \\
4292 FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC
4293 (* only rewrite LHS *)
4294 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [o_DEF]
4295 >> BETA_TAC
4296 >> Know `SIGMA (\i. mu (BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num)))) (count n) =
4297 SIGMA (\i. suminf (mu o (\n. f' i INTER z n))) (count n)`
4298 >- (irule EXTREAL_SUM_IMAGE_EQ \\
4299 SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT] \\
4300 CONJ_TAC >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
4301 DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\
4302 CONJ_TAC >- (MATCH_MP_TAC pos_not_neginf \\
4303 METIS_TAC [positive_def, measure_def, measurable_sets_def]) \\
4304 MATCH_MP_TAC pos_not_neginf \\
4305 MATCH_MP_TAC ext_suminf_pos >> RW_TAC std_ss [o_DEF] \\
4306 Know `(f' x INTER z n') IN sts`
4307 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
4308 art [] >> PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT]) >> DISCH_TAC \\
4309 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr'
4310 (* only rewrite LHS *)
4311 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [o_DEF]
4312 >> BETA_TAC
4313 (* clean up useless assums *)
4314 >> POP_ASSUM K_TAC
4315 >> Q.PAT_X_ASSUM `!i. f' i INTER BIGUNION (IMAGE z univ(:num)) = X` K_TAC
4316 >> Q.PAT_X_ASSUM `!i. i < n ==> (f' i = f' i INTER BIGUNION (IMAGE z univ(:num)))` K_TAC
4317 >> Q.PAT_X_ASSUM `!i. i < n ==> BIGUNION (IMAGE (\n. f' i INTER z n) univ(:num)) IN sts` K_TAC
4318 (* stage: SIGMA (\i. suminf (\x. mu (f' i INTER z x))) (count n) = suminf (m' o f) *)
4319 >> Know `(\i. suminf (\x. mu (f' i INTER z x))) = (suminf o (\i x. mu (f' i INTER z x)))`
4320 >- (FUN_EQ_TAC >> Q.X_GEN_TAC `i` >> REWRITE_TAC [o_DEF] \\
4321 BETA_TAC >> REWRITE_TAC []) >> Rewr'
4322 >> Know `SIGMA (suminf o (\i x. mu (f' i INTER z x))) (count n) =
4323 suminf (\x. SIGMA (\i. (\i x. mu (f' i INTER z x)) i x) (count n))`
4324 >- (MATCH_MP_TAC ext_suminf_sigma >> BETA_TAC >> rpt STRIP_TAC \\
4325 Know `f' i INTER z x IN sts`
4326 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
4327 art [] >> PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC \\
4328 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr'
4329 >> BETA_TAC
4330 (* suminf (\x. SIGMA (\i. mu (f' i INTER z x)) (count n)) = suminf (m' o f) *)
4331 >> Know `!x. (\i. mu (f' i INTER z x)) = mu o (\i. f' i INTER z x)`
4332 >- (REWRITE_TAC [o_DEF] >> BETA_TAC >> GEN_TAC >> FUN_EQ_TAC \\
4333 BETA_TAC >> GEN_TAC >> REWRITE_TAC []) >> Rewr'
4334 >> Know `!x. SIGMA (mu o (\i. f' i INTER z x)) (count n) =
4335 SIGMA mu (IMAGE (\i. f' i INTER z x) (count n))`
4336 >- (Q.X_GEN_TAC `j` \\
4337 NTAC 3 (POP_ASSUM MP_TAC) \\
4338 POP_ASSUM K_TAC \\ (* c = IMAGE f' (count n) *)
4339 POP_ASSUM MP_TAC \\
4340 Q.SPEC_TAC (`n`, `n`) \\
4341 Induct_on `n` >- (RW_TAC arith_ss [] \\
4342 art [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY, IMAGE_EMPTY]) \\
4343 rpt STRIP_TAC \\
4344 `mu {} = 0` by PROVE_TAC [positive_def, measure_def, measurable_sets_def] \\
4345 REWRITE_TAC [COUNT_SUC, IMAGE_INSERT] \\
4346 Know `SIGMA (mu o (\i. f' i INTER z j)) (n INSERT count n) =
4347 (mu o (\i. f' i INTER z j)) n + SIGMA (mu o (\i. f' i INTER z j)) (count n DELETE n)`
4348 >- (irule EXTREAL_SUM_IMAGE_PROPERTY >> art [FINITE_COUNT] \\
4349 DISJ1_TAC >> SIMP_TAC std_ss [IN_INSERT, IN_COUNT, o_DEF] \\
4350 GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\
4351 `x < SUC n` by RW_TAC arith_ss [] \\
4352 `f' x INTER z j IN sts` by PROVE_TAC [] \\
4353 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' \\
4354 SIMP_TAC std_ss [COUNT_DELETE] \\
4355 Know `SIGMA mu (f' n INTER z j INSERT IMAGE (\i. f' i INTER z j) (count n)) =
4356 mu (f' n INTER z j) +
4357 SIGMA mu ((IMAGE (\i. f' i INTER z j) (count n)) DELETE (f' n INTER z j))`
4358 >- (irule EXTREAL_SUM_IMAGE_PROPERTY \\
4359 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
4360 DISJ1_TAC >> GEN_TAC >> SIMP_TAC std_ss [IN_INSERT, IN_IMAGE, IN_COUNT] \\
4361 STRIP_TAC
4362 >- (art [] >> MATCH_MP_TAC pos_not_neginf \\
4363 `f' n INTER z j IN sts` by RW_TAC std_ss [] \\
4364 METIS_TAC [positive_def, measure_def, measurable_sets_def]) \\
4365 art [] >> MATCH_MP_TAC pos_not_neginf \\
4366 `f' i INTER z j IN sts` by RW_TAC arith_ss [] \\
4367 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' \\
4368 Know `SIGMA mu (IMAGE (\i. f' i INTER z j) (count n) DELETE f' n INTER z j) =
4369 SIGMA mu (IMAGE (\i. f' i INTER z j) (count n))`
4370 >- (Cases_on `(f' n INTER z j) NOTIN (IMAGE (\i. f' i INTER z j) (count n))`
4371 >- METIS_TAC [DELETE_NON_ELEMENT] \\
4372 POP_ASSUM MP_TAC >> SIMP_TAC arith_ss [IN_IMAGE, IN_COUNT] \\
4373 (* ?i. (f' n INTER z j = f' i INTER z j) /\ i < n *)
4374 STRIP_TAC \\
4375 `n < SUC n /\ i < SUC n /\ n <> i` by RW_TAC arith_ss [] \\
4376 `DISJOINT (f' n INTER z j) (f' i INTER z j)` by PROVE_TAC [DISJOINT_RESTRICT_L] \\
4377 `(f' n INTER z j = {}) /\ (f' i INTER z j = {})` by PROVE_TAC [DISJOINT_EMPTY_REFL] \\
4378 art [DELETE_DEF] >> MATCH_MP_TAC EQ_SYM \\
4379 irule EXTREAL_SUM_IMAGE_ZERO_DIFF \\
4380 ASM_SIMP_TAC std_ss [IN_SING, IN_IMAGE, IN_COUNT] \\
4381 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
4382 DISJ1_TAC >> GEN_TAC >> STRIP_TAC >> art [] \\
4383 MATCH_MP_TAC pos_not_neginf \\
4384 `f' i' INTER z j IN sts` by RW_TAC arith_ss [] \\
4385 METIS_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr' \\
4386 `!i. i < n ==> f' i IN c` by RW_TAC arith_ss [] \\
4387 `!i j. i < n /\ j < n /\ i <> j ==> f' i <> f' j` by RW_TAC arith_ss [] \\
4388 `!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f' i) (f' j)` by RW_TAC arith_ss [] \\
4389 `!i j. i < n ==> f' i INTER z j IN sts` by RW_TAC arith_ss [] \\
4390 `SIGMA (mu o (\i. f' i INTER z j)) (count n) =
4391 SIGMA mu (IMAGE (\i. f' i INTER z j) (count n))` by PROVE_TAC [] \\
4392 Q.PAT_X_ASSUM `(!i. i < n ==> f' i IN c) ==> X` K_TAC \\
4393 ASM_REWRITE_TAC []) >> Rewr'
4394 (* suminf (\x. SIGMA mu (IMAGE (\i. f' i INTER z x) (count n))) = suminf (m' o f) *)
4395 >> Know `!x. SIGMA mu (IMAGE (\i. f' i INTER z x) (count n)) =
4396 m' (BIGUNION (IMAGE (\i. f' i INTER z x) (count n)))`
4397 >- (Q.X_GEN_TAC `y` >> MATCH_MP_TAC EQ_SYM \\
4398 FIRST_X_ASSUM MATCH_MP_TAC \\
4399 CONJ_TAC >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] >> PROVE_TAC []) \\
4400 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
4401 RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT] \\
4402 Cases_on `i = i'` >- METIS_TAC [] \\
4403 MATCH_MP_TAC DISJOINT_RESTRICT_L >> PROVE_TAC []) >> Rewr'
4404 >> REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L]
4405 >> `BIGUNION (IMAGE f' (count n)) = BIGUNION (IMAGE z univ(:num))` by PROVE_TAC []
4406 >> POP_ORW
4407 >> Know `!x. BIGUNION (IMAGE z univ(:num)) INTER z x = z x`
4408 >- (GEN_TAC >> REWRITE_TAC [INTER_SUBSET_EQN] \\
4409 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] \\
4410 Q.EXISTS_TAC `x` >> art []) >> Rewr'
4411 (* RHS reductions: *)
4412 >> `f = \n. BIGUNION (IMAGE (s n) (count (p n)))` by METIS_TAC [] >> POP_ORW
4413 >> SIMP_TAC std_ss [o_DEF]
4414 >> Know `!n. m' (BIGUNION (IMAGE (s n) (count (p n)))) =
4415 SIGMA mu (IMAGE (s n) (count (p n)))`
4416 >- (GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
4417 CONJ_TAC >- METIS_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
4418 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
4419 RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT] \\
4420 LAST_X_ASSUM MATCH_MP_TAC >> art [] >> PROVE_TAC []) >> Rewr'
4421 >> Know `!n. SIGMA mu (IMAGE (s n) (count (p n))) = SIGMA (mu o (s n)) (count (p n))`
4422 >- (GEN_TAC >> irule EXTREAL_SUM_IMAGE_IMAGE \\
4423 art [FINITE_COUNT, IN_IMAGE, IN_COUNT] >> CONJ_TAC
4424 >- (DISJ1_TAC >> GEN_TAC >> STRIP_TAC \\
4425 MATCH_MP_TAC pos_not_neginf >> art [] \\
4426 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) \\
4427 MATCH_MP_TAC INJ_IMAGE >> Q.EXISTS_TAC `sts` \\
4428 RW_TAC std_ss [INJ_DEF, IN_COUNT] >> PROVE_TAC []) >> Rewr'
4429 >> Know `!n. SIGMA (mu o s n) (count (p n)) = suminf (mu o s n)`
4430 >- (GEN_TAC >> MATCH_MP_TAC EQ_SYM \\
4431 MATCH_MP_TAC ext_suminf_sum >> SIMP_TAC std_ss [o_DEF] \\
4432 CONJ_TAC >- (GEN_TAC >> PROVE_TAC [positive_def, measure_def, measurable_sets_def]) \\
4433 RW_TAC std_ss [] \\
4434 PROVE_TAC [positive_def, measure_def, measurable_sets_def]) >> Rewr'
4435 >> Know `!x. m' (z x) = mu (z x)` >- METIS_TAC [] >> Rewr'
4436 (* suminf (\x. mu (z x)) = suminf (\n. suminf (mu o s n)) *)
4437 >> Q.UNABBREV_TAC `z` >> SIMP_TAC std_ss [o_DEF, UNCURRY]
4438 (* preparing for applying ext_suminf_2d *)
4439 >> Q.ABBREV_TAC `ms = \x y. mu (s x y)`
4440 >> `!x. mu (s (FST (h x)) (SND (h x))) = ms (FST (h x)) (SND (h x))`
4441 by METIS_TAC [] >> POP_ORW
4442 >> `!n x. mu (s n x) = ms n x` by METIS_TAC [] >> POP_ORW
4443 >> `(\x. ms (FST (h x)) (SND (h x))) = UNCURRY ms o h`
4444 by METIS_TAC [o_DEF, UNCURRY] >> POP_ORW
4445 (* suminf (UNCURRY ms o h) = suminf (\n. suminf (\x. ms n x)) *)
4446 >> MATCH_MP_TAC ext_suminf_2d_full
4447 >> Q.UNABBREV_TAC `ms` >> ASM_SIMP_TAC std_ss []
4448 >> rpt GEN_TAC
4449 >> PROVE_TAC [positive_def, measure_def, measurable_sets_def]
4450QED
4451
4452(* The "semiring" version of Caratheodory's Extension Theorem
4453 (Theorem 6.1 of [1, p.38-45])
4454
4455 named after Constantin Caratheodory, a Greek mathematician who spent most
4456 of his professional career in Germany. [9]
4457 *)
4458Theorem CARATHEODORY_SEMIRING :
4459 !m0. semiring (m_space m0, measurable_sets m0) /\ premeasure m0 ==>
4460 ?m. (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\
4461 ((m_space m, measurable_sets m) =
4462 sigma (m_space m0) (measurable_sets m0)) /\ measure_space m
4463Proof
4464 rpt STRIP_TAC >> Cases_on `m0` >> Cases_on `r`
4465 >> fs [m_space_def, measurable_sets_def, measure_def, premeasure_def]
4466 >> rename1 `positive (sp,sts,mu)`
4467 (* Step 1: m is an outer measure, which will eventually extend mu *)
4468 >> Q.ABBREV_TAC `C = countable_covers sts`
4469 >> Q.ABBREV_TAC `m = outer_measure mu C`
4470 >> Q.ABBREV_TAC `A' = caratheodory_sets sp m`
4471 >> fs [countable_covers_def, outer_measure_def, caratheodory_sets_def]
4472 >> Know `outer_measure_space (sp, POW sp, m) /\
4473 (!x. x IN sts ==> m x <= mu x) /\ measure_space (sp,A',m)`
4474 >- (`subset_class sp sts /\ {} IN sts`
4475 by PROVE_TAC [semiring_def, space_def, subsets_def] \\
4476 METIS_TAC [OUTER_MEASURE_CONSTRUCTION,
4477 outer_measure_def, countable_covers_def, caratheodory_sets_def])
4478 >> STRIP_TAC
4479 (* Step 2a. Extend the measure from semi-ring (mu) to ring (m') *)
4480 >> Know `!x. x IN sts ==> (m x = mu x)`
4481 >- (rpt STRIP_TAC >> REWRITE_TAC [GSYM le_antisym] \\
4482 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
4483 `?m1. ((m_space m1,measurable_sets m1) = smallest_ring sp sts) /\
4484 (!s. s IN sts ==> measure m1 s = mu s) /\ premeasure m1`
4485 by METIS_TAC [premeasure_def,
4486 REWRITE_RULE [m_space_def, measurable_sets_def, measure_def,
4487 premeasure_def]
4488 (Q.SPEC `(sp,sts,mu)` SEMIRING_PREMEASURE_EXTENSION)] \\
4489 Know `ring (m_space m1,measurable_sets m1)`
4490 >- (art [] >> MATCH_MP_TAC SMALLEST_RING \\
4491 fs [semiring_def, space_def, subsets_def]) >> DISCH_TAC \\
4492 `finite_additive m1 /\ countably_subadditive m1`
4493 by PROVE_TAC [RING_PREMEASURE_FINITE_ADDITIVE,
4494 RING_PREMEASURE_COUNTABLY_SUBADDITIVE] \\
4495 (* now `mu x <= m x`, S is the set of finite unions of disjoint sets from sts. *)
4496 Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}` \\
4497 Cases_on `m1` >> Cases_on `r` \\
4498 fs [m_space_def, measurable_sets_def, measure_def] \\
4499 rename1 `premeasure (sp',S',m')` (* m1 disappears *) \\
4500 `sp' = sp` by PROVE_TAC [SPACE_SMALLEST_RING, SPACE, space_def, subsets_def] \\
4501 Know `S' = S`
4502 >- (Q.UNABBREV_TAC `S` \\
4503 METIS_TAC [SMALLEST_RING_OF_SEMIRING, SPACE, space_def, subsets_def]) \\
4504 DISCH_TAC >> fs [] \\
4505 NTAC 2 (POP_ASSUM K_TAC) (* sp' and S' disappear *) \\
4506 `sts SUBSET S` by PROVE_TAC [SMALLEST_RING_SUBSET_SUBSETS, subsets_def] \\
4507 (* Step 2b. Claim: m extends mu, i.e. m(x) = mu(x), !x IN sts" *)
4508 Know `!c. c SUBSET sts /\ FINITE c /\ disjoint c ==> (m' (BIGUNION c) = SIGMA mu c)`
4509 >- (rpt STRIP_TAC \\
4510 MATCH_MP_TAC EQ_TRANS >> Q.EXISTS_TAC `SIGMA m' c` \\
4511 reverse CONJ_TAC
4512 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\
4513 STRONG_CONJ_TAC (* !x. x IN c ==> m' x = mu x *)
4514 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
4515 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\
4516 RW_TAC std_ss [] >> DISJ1_TAC \\
4517 GEN_TAC >> DISCH_TAC >> MATCH_MP_TAC pos_not_neginf \\
4518 fs [positive_def, measure_def, measurable_sets_def] \\
4519 FIRST_X_ASSUM MATCH_MP_TAC \\
4520 POP_ASSUM MP_TAC >> fs [SUBSET_DEF]) \\
4521 MATCH_MP_TAC EQ_SYM \\
4522 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4523 (Q.SPEC `(sp,S,m')` FINITE_ADDITIVE_ALT)) \\
4524 fs [premeasure_def] >> ASM_SET_TAC []) >> DISCH_TAC \\
4525 (* mu x <= m x *)
4526 `mu x = m' x` by PROVE_TAC [] >> POP_ORW \\
4527 Q.PAT_X_ASSUM `outer_measure_space (sp,POW sp,m)` K_TAC \\
4528 (* m' x <= m x *)
4529 Q.UNABBREV_TAC `A'` (* this just removes it *) \\
4530 Q.PAT_X_ASSUM `measure_space (sp,_,m)` K_TAC \\
4531 Q.UNABBREV_TAC `m` >> BETA_TAC \\
4532 SET_SPEC_TAC [le_inf'] >> rpt STRIP_TAC \\
4533 POP_ASSUM (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\
4534 (* m' x <= suminf (mu o f) *)
4535 POP_ASSUM MP_TAC (* f IN C x *) \\
4536 Q.UNABBREV_TAC `C` >> SIMP_TAC std_ss [GSPECIFICATION, IN_FUNSET, IN_UNIV] \\
4537 rpt STRIP_TAC \\
4538 `m' x = m' (BIGUNION (IMAGE f univ(:num)) INTER x)`
4539 by PROVE_TAC [SUBSET_INTER2] >> POP_ORW \\
4540 REWRITE_TAC [BIGUNION_OVER_INTER_L] \\
4541 MATCH_MP_TAC le_trans \\
4542 Q.EXISTS_TAC `suminf (m' o (\i. f i INTER x))` \\
4543 CONJ_TAC
4544 >- (fs [countably_subadditive_def, measure_def, measurable_sets_def, IN_FUNSET, IN_UNIV] \\
4545 FIRST_X_ASSUM MATCH_MP_TAC >> BETA_TAC \\
4546 STRONG_CONJ_TAC (* !x'. f x' INTER x IN S *)
4547 >- (GEN_TAC >> MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,S)` RING_INTER)) \\
4548 PROVE_TAC [SUBSET_DEF]) >> DISCH_TAC \\
4549 (* BIGUNION (IMAGE (\i. f i INTER x) univ(:num)) IN S *)
4550 REWRITE_TAC [GSYM BIGUNION_OVER_INTER_L] \\
4551 PROVE_TAC [SUBSET_INTER2, SUBSET_DEF]) \\
4552 Know `m' o (\i. f i INTER x) = mu o (\i. f i INTER x)`
4553 >- (SIMP_TAC std_ss [o_DEF] >> FUN_EQ_TAC >> GEN_TAC >> BETA_TAC \\
4554 FIRST_X_ASSUM MATCH_MP_TAC \\
4555 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
4556 art []) >> Rewr' \\
4557 (* suminf (mu o (\i. f i INTER x)) <= suminf (mu o f) *)
4558 MATCH_MP_TAC ext_suminf_mono >> SIMP_TAC std_ss [o_DEF] \\
4559 STRONG_CONJ_TAC
4560 >- (GEN_TAC >> fs [positive_def, measure_def, measurable_sets_def] \\
4561 Q.PAT_X_ASSUM `!s. s IN sts ==> 0 <= mu s` MATCH_MP_TAC \\
4562 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
4563 METIS_TAC [SUBSET_DEF]) >> DISCH_TAC \\
4564 GEN_TAC \\
4565 `increasing (sp,sts,mu)`
4566 by PROVE_TAC [SEMIRING_PREMEASURE_INCREASING,
4567 premeasure_def, m_space_def, measurable_sets_def] \\
4568 fs [increasing_def, measure_def, measurable_sets_def] \\
4569 FIRST_X_ASSUM MATCH_MP_TAC >> art [INTER_SUBSET] \\
4570 MATCH_MP_TAC (REWRITE_RULE [subsets_def] (Q.SPEC `(sp,sts)` SEMIRING_INTER)) \\
4571 PROVE_TAC [SUBSET_DEF])
4572 >> DISCH_TAC
4573 (* Step 3. Claim: sts SUBSET A, where A is m-measurable sets *)
4574 >> Know `!s t. s IN sts /\ t IN sts ==> m (s INTER t) + m (s DIFF t) <= m s`
4575 >- (rpt STRIP_TAC \\
4576 `s INTER t IN sts` by PROVE_TAC [SEMIRING_INTER, subsets_def] \\
4577 (* special case *)
4578 Cases_on `s INTER t = {}`
4579 >- (`s DIFF t = s` by ASM_SET_TAC [] \\
4580 `mu {} = 0` by PROVE_TAC [positive_def, semiring_def, measure_def, subsets_def,
4581 measurable_sets_def] \\
4582 `{} IN sts` by PROVE_TAC [semiring_def, subsets_def] \\
4583 `m {} = 0` by PROVE_TAC [] \\
4584 art [add_lzero, le_refl]) \\
4585 (* general case *)
4586 MP_TAC (REWRITE_RULE [subsets_def]
4587 (Q.SPECL [`(sp,sts)`, `s`, `t`] SEMIRING_DIFF)) \\
4588 RW_TAC std_ss [] \\
4589 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
4590 (CONJ (ASSUME ``FINITE (c :'a set set)``)
4591 (ASSUME ``disjoint (c :'a set set)``))) \\
4592 `((s INTER t) UNION (s DIFF t) = s) /\
4593 DISJOINT (s INTER t) (s DIFF t)` by SET_TAC [DISJOINT_DEF] \\
4594 `mu ((s INTER t) UNION (s DIFF t)) = mu s` by PROVE_TAC [] \\
4595 (* IMPORTANT: (s INTER t) is disjoint with all (f i), i < n *)
4596 Know `!i. i < n ==> DISJOINT (s INTER t) (f i)`
4597 >- (rpt STRIP_TAC \\
4598 `DISJOINT (s INTER t) (BIGUNION (IMAGE f (count n)))` by PROVE_TAC [] \\
4599 POP_ASSUM MP_TAC \\
4600 REWRITE_TAC [DISJOINT_ALT, IN_BIGUNION_IMAGE, IN_COUNT] \\
4601 METIS_TAC []) >> DISCH_TAC \\
4602 Know `mu ((s INTER t) UNION (BIGUNION c)) = mu s` >- PROVE_TAC [] \\
4603 REWRITE_TAC [GSYM BIGUNION_INSERT] >> DISCH_TAC \\
4604 Know `disjoint ((s INTER t) INSERT c)`
4605 >- (`(s INTER t) INSERT c =
4606 {s INTER t} UNION c` by SET_TAC [] >> POP_ORW \\
4607 MATCH_MP_TAC disjoint_union >> art [disjoint_sing] \\
4608 ASM_SET_TAC [BIGUNION_SING, disjoint_def, IN_BIGUNION_IMAGE, IN_COUNT]) \\
4609 DISCH_TAC \\
4610 Know `mu (BIGUNION (s INTER t INSERT c)) = SIGMA mu (s INTER t INSERT c)`
4611 >- (MATCH_MP_TAC EQ_SYM \\
4612 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4613 (Q.SPEC `(sp,sts,mu)` FINITE_ADDITIVE_ALT)) \\
4614 `finite_additive (sp,sts,mu)`
4615 by PROVE_TAC [SEMIRING_PREMEASURE_FINITE_ADDITIVE,
4616 premeasure_def, m_space_def, measurable_sets_def] \\
4617 Know `BIGUNION ((s INTER t) INSERT c) = s`
4618 >- (REWRITE_TAC [BIGUNION_INSERT] \\
4619 Q.PAT_X_ASSUM `s DIFF t = BIGUNION c` (ONCE_REWRITE_TAC o wrap o (MATCH_MP EQ_SYM)) \\
4620 SET_TAC []) \\
4621 Rewr' >> art [FINITE_INSERT, INSERT_SUBSET]) >> DISCH_TAC \\
4622 `(s INTER t) INSERT c = {s INTER t} UNION c` by SET_TAC [] \\
4623 Know `c DELETE (s INTER t) = c`
4624 >- (MATCH_MP_TAC DELETE_NON_ELEMENT_RWT \\
4625 CCONTR_TAC >> rfs [] \\
4626 `DISJOINT (s INTER t) (f x)` by PROVE_TAC [] \\
4627 PROVE_TAC [DISJOINT_EMPTY_REFL_RWT]) >> DISCH_TAC \\
4628 Know `SIGMA mu (s INTER t INSERT c) = mu (s INTER t) + SIGMA mu (c DELETE s INTER t)`
4629 >- (irule EXTREAL_SUM_IMAGE_PROPERTY >> art [] \\
4630 DISJ1_TAC \\
4631 RW_TAC std_ss [IN_UNION, IN_IMAGE, IN_COUNT, IN_SING] >| (* 2 subgoals *)
4632 [ (* goal 1 (of 2) *)
4633 MATCH_MP_TAC pos_not_neginf \\
4634 PROVE_TAC [positive_def, measure_def, measurable_sets_def],
4635 (* goal 2 (of 2) *)
4636 MATCH_MP_TAC pos_not_neginf \\
4637 `f x' IN sts` by PROVE_TAC [SUBSET_DEF] \\
4638 PROVE_TAC [positive_def, measure_def, measurable_sets_def] ]) >> DISCH_TAC \\
4639 Know `m (BIGUNION c) <= SIGMA m c`
4640 >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4641 (Q.SPECL [`(sp,POW sp,m)`, `c`] FINITE_SUBADDITIVE_ALT)) \\
4642 `finite_subadditive (sp,POW sp,m)`
4643 by PROVE_TAC [OUTER_MEASURE_SPACE_FINITE_SUBADDITIVE] \\
4644 fs [outer_measure_space_def] \\
4645 `subset_class sp sts` by PROVE_TAC [semiring_def, space_def, subsets_def] \\
4646 RW_TAC std_ss [SUBSET_DEF, IN_POW, IN_BIGUNION] \\ (* 2 subgoals, same tactics *)
4647 ASM_SET_TAC [subset_class_def]) >> DISCH_TAC \\
4648 Know `SIGMA mu c = SIGMA m c`
4649 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\
4650 CONJ_TAC >- (rpt STRIP_TAC >> PROVE_TAC [SUBSET_DEF]) \\
4651 DISJ1_TAC >> RW_TAC std_ss [IN_IMAGE, IN_COUNT] >| (* 2 subgoals *)
4652 [ (* goal 1 (of 2) *)
4653 MATCH_MP_TAC pos_not_neginf \\
4654 `f x' IN sts` by PROVE_TAC [SUBSET_DEF] \\
4655 PROVE_TAC [positive_def, measure_def, measurable_sets_def],
4656 (* goal 2 (of 2) *)
4657 MATCH_MP_TAC pos_not_neginf \\
4658 `f x' IN sts` by PROVE_TAC [SUBSET_DEF] \\
4659 PROVE_TAC [positive_def, measure_def, measurable_sets_def] ]) >> DISCH_TAC \\
4660 Know `mu s = m (s INTER t) + SIGMA m c` >- PROVE_TAC [] >> Rewr' \\
4661 Know `m (s DIFF t) = m (BIGUNION c)` >- PROVE_TAC [] >> Rewr' \\
4662 Know `mu (s INTER t) = m (s INTER t)` >- PROVE_TAC [] >> Rewr' \\
4663 MATCH_MP_TAC le_ladd_imp >> art [])
4664 >> DISCH_TAC
4665 >> Know `!b s f. s IN sts /\ b SUBSET sp /\ f IN (C b) ==>
4666 m (b INTER s) + m (b DIFF s) <= suminf (mu o f)`
4667 >- (rpt GEN_TAC \\
4668 Q.PAT_X_ASSUM `Abbrev (m = X)` K_TAC \\ (* useless here *)
4669 Q.UNABBREV_TAC `C` >> SET_SPEC_TAC [IN_FUNSET, IN_UNIV] >> STRIP_TAC \\
4670 MATCH_MP_TAC le_trans \\
4671 Q.EXISTS_TAC `m (BIGUNION (IMAGE f univ(:num)) INTER s) + m (BIGUNION (IMAGE f univ(:num)) DIFF s)` \\
4672 `increasing (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\
4673 `subset_class sp sts` by PROVE_TAC [semiring_def, space_def, subsets_def] \\
4674 `positive (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\
4675 `!s. s SUBSET sp ==> 0 <= m s`
4676 by PROVE_TAC [positive_def, measure_def, measurable_sets_def, IN_POW] \\
4677 `countably_subadditive (sp,POW sp,m)` by PROVE_TAC [outer_measure_space_def] \\
4678 `subadditive (sp,POW sp,m)` by PROVE_TAC [OUTER_MEASURE_SPACE_SUBADDITIVE] \\
4679 CONJ_TAC (* m (b INTER s) + m (b DIFF s) <= ... *)
4680 >- (MATCH_MP_TAC le_add2 >> STRIP_TAC >|
4681 [ (* goal 1 (of 2) *)
4682 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4683 (Q.SPEC `(sp,POW sp,m)` INCREASING)) >> art [IN_POW] \\
4684 CONJ_TAC >- (MATCH_MP_TAC SUBSET_RESTRICT_L >> art []) \\
4685 CONJ_TAC >- (MATCH_MP_TAC SUBSET_INTER_SUBSET_L >> art []) \\
4686 MATCH_MP_TAC SUBSET_INTER_SUBSET_L \\
4687 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
4688 PROVE_TAC [subset_class_def],
4689 (* goal 2 (of 2) *)
4690 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4691 (Q.SPEC `(sp,POW sp,m)` INCREASING)) >> art [IN_POW] \\
4692 CONJ_TAC >- (MATCH_MP_TAC SUBSET_MONO_DIFF >> art []) \\
4693 CONJ_TAC >- (MATCH_MP_TAC SUBSET_DIFF_SUBSET >> art []) \\
4694 MATCH_MP_TAC SUBSET_DIFF_SUBSET \\
4695 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
4696 PROVE_TAC [subset_class_def] ]) \\
4697 Know `suminf (mu o f) = suminf (m o f)`
4698 >- (MATCH_MP_TAC ext_suminf_eq >> SIMP_TAC std_ss [o_DEF] \\
4699 GEN_TAC >> METIS_TAC []) >> Rewr' \\
4700 REWRITE_TAC [BIGUNION_OVER_INTER_L, BIGUNION_OVER_DIFF] \\
4701 (* m (BIGUNION (IMAGE (\i. f i INTER s) univ(:num))) + ... <= suminf (m o f) *)
4702 MATCH_MP_TAC le_trans \\
4703 Q.EXISTS_TAC `suminf (m o (\i. f i INTER s)) + suminf (m o (\i. f i DIFF s))` \\
4704 CONJ_TAC
4705 >- (MATCH_MP_TAC le_add2 >> STRIP_TAC >| (* 2 subgoals *)
4706 [ (* goal 1 (of 2) *)
4707 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4708 (Q.SPECL [`(sp,POW sp,m)`, `c`] COUNTABLY_SUBADDITIVE)) \\
4709 art [IN_POW, IN_FUNSET, IN_UNIV] >> BETA_TAC \\
4710 CONJ_TAC >- (GEN_TAC >> MATCH_MP_TAC SUBSET_INTER_SUBSET_R \\
4711 PROVE_TAC [subset_class_def]) \\
4712 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
4713 MATCH_MP_TAC SUBSET_INTER_SUBSET_R >> PROVE_TAC [subset_class_def],
4714 (* goal 2 (of 2) *)
4715 MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4716 (Q.SPECL [`(sp,POW sp,m)`, `c`] COUNTABLY_SUBADDITIVE)) \\
4717 art [IN_POW, IN_FUNSET, IN_UNIV] >> BETA_TAC \\
4718 CONJ_TAC >- (GEN_TAC >> MATCH_MP_TAC SUBSET_DIFF_SUBSET \\
4719 PROVE_TAC [subset_class_def]) \\
4720 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE, IN_UNIV] \\
4721 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> PROVE_TAC [subset_class_def] ]) \\
4722 (* suminf (m o (\i. f i INTER s)) + suminf (m o (\i. f i DIFF s)) <= suminf (m o f) *)
4723 Know `suminf (m o (\i. f i INTER s)) + suminf (m o (\i. f i DIFF s)) =
4724 suminf (\n. (m o (\i. f i INTER s)) n + (m o (\i. f i DIFF s)) n)`
4725 >- (MATCH_MP_TAC EQ_SYM >> MATCH_MP_TAC ext_suminf_add \\
4726 RW_TAC std_ss [o_DEF]
4727 >- (FIRST_X_ASSUM MATCH_MP_TAC \\
4728 MATCH_MP_TAC SUBSET_INTER_SUBSET_R >> PROVE_TAC [subset_class_def]) \\
4729 FIRST_X_ASSUM MATCH_MP_TAC \\
4730 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> PROVE_TAC [subset_class_def]) >> Rewr' \\
4731 (* suminf (\n. (m o (\i. f i INTER s)) n + (m o (\i. f i DIFF s)) n) <= suminf (m o f) *)
4732 MATCH_MP_TAC ext_suminf_mono \\
4733 SIMP_TAC std_ss [o_DEF] \\
4734 reverse CONJ_TAC >- PROVE_TAC [] \\
4735 GEN_TAC >> MATCH_MP_TAC le_add \\
4736 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC \\
4737 MATCH_MP_TAC SUBSET_INTER_SUBSET_R >> PROVE_TAC [subset_class_def]) \\
4738 FIRST_X_ASSUM MATCH_MP_TAC \\
4739 MATCH_MP_TAC SUBSET_DIFF_SUBSET >> PROVE_TAC [subset_class_def])
4740 >> DISCH_TAC
4741 (* core definition: m-measurable sets *)
4742 >> Know `sts SUBSET A'` (* this doesn't hold is `sts` is not semiring *)
4743 >- (REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\
4744 rename1 `s IN A'` \\
4745 Q.UNABBREV_TAC `A'` >> SET_SPEC_TAC [] \\
4746 CONJ_TAC >- PROVE_TAC [semiring_def, subset_class_def, space_def, subsets_def] \\
4747 Q.X_GEN_TAC `b` >> DISCH_TAC \\
4748 `subadditive (sp,POW sp,m)` by PROVE_TAC [OUTER_MEASURE_SPACE_SUBADDITIVE] \\
4749 (* m b = m (b INTER s) + m (b DIFF s) *)
4750 REWRITE_TAC [GSYM le_antisym] >> CONJ_TAC
4751 >- (MATCH_MP_TAC (REWRITE_RULE [measure_def, measurable_sets_def]
4752 (Q.SPEC `(sp,POW sp,m)` SUBADDITIVE)) \\
4753 ASM_SIMP_TAC std_ss [IN_POW] >> ASM_SET_TAC []) \\
4754 (* m (b INTER s) + m (b DIFF s) <= m b *)
4755 `m b = inf {r | (?f. f IN C b /\ (suminf (mu o f) = r))}` by METIS_TAC [] \\
4756 POP_ORW >> REWRITE_TAC [le_inf'] >> GEN_TAC \\
4757 SET_SPEC_TAC [] >> STRIP_TAC >> PROVE_TAC []) >> DISCH_TAC
4758 >> Q.PAT_X_ASSUM `!s t. s IN sts /\ t IN sts ==> X` K_TAC
4759 >> Q.PAT_X_ASSUM `!b s f. s IN sts /\ b SUBSET sp /\ f IN C b ==> X` K_TAC
4760 (* Step 4. Claim: A' is sigma-algebra and m is measure on (sp,A') *)
4761 >> `sigma_algebra (sp,A')`
4762 by PROVE_TAC [measure_space_def, m_space_def, measurable_sets_def]
4763 (* Step 5. Claim: m is mseaure on (sigma sp sts) which extends mu *)
4764 >> Q.EXISTS_TAC `(sp,subsets (sigma sp sts),m)`
4765 >> art [m_space_def, measurable_sets_def, measure_def]
4766 (* measure_space (sp,subsets (sigma sp sts),m) *)
4767 >> reverse CONJ_TAC
4768 >- (`(subsets (sigma sp sts)) SUBSET (subsets (sigma sp A'))`
4769 by PROVE_TAC [SIGMA_MONOTONE] \\
4770 `sigma sp A' = (sp,A')` by PROVE_TAC [SIGMA_STABLE_LEMMA] \\
4771 `sigma_algebra (sigma sp sts)`
4772 by PROVE_TAC [SIGMA_ALGEBRA_SIGMA, semiring_def, space_def, subsets_def] \\
4773 `(subsets (sigma sp sts)) SUBSET A'` by PROVE_TAC [subsets_def] \\
4774 MATCH_MP_TAC MEASURE_SPACE_RESTRICTION \\
4775 Q.EXISTS_TAC `A'` >> art [] \\
4776 `(sp,subsets (sigma sp sts)) = sigma sp sts`
4777 by METIS_TAC [SPACE_SIGMA, SPACE, space_def, subsets_def] >> POP_ORW \\
4778 MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\
4779 PROVE_TAC [semiring_def, space_def, subsets_def])
4780 >> METIS_TAC [SPACE_SIGMA, SPACE, space_def, subsets_def]
4781QED
4782
4783(* The "ring" version (weaker) of Caratheodory theorem *)
4784Theorem CARATHEODORY_RING :
4785 !m0. ring (m_space m0, measurable_sets m0) /\
4786 positive m0 /\ countably_additive m0 ==>
4787 ?m. (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\
4788 ((m_space m, measurable_sets m) =
4789 sigma (m_space m0) (measurable_sets m0)) /\ measure_space m
4790Proof
4791 GEN_TAC >> STRIP_TAC
4792 >> MATCH_MP_TAC CARATHEODORY_SEMIRING
4793 >> IMP_RES_TAC RING_IMP_SEMIRING >> art [premeasure_def]
4794 >> fs [algebra_def, space_def, subsets_def]
4795QED
4796
4797(* The "algebra" version (weakest) of Caratheodory theorem
4798 cf. real_measureTheory.CARATHEODORY *)
4799Theorem CARATHEODORY :
4800 !m0. algebra (m_space m0, measurable_sets m0) /\
4801 positive m0 /\ countably_additive m0 ==>
4802 ?m. (!s. s IN measurable_sets m0 ==> (measure m s = measure m0 s)) /\
4803 ((m_space m, measurable_sets m) =
4804 sigma (m_space m0) (measurable_sets m0)) /\ measure_space m
4805Proof
4806 GEN_TAC >> STRIP_TAC
4807 >> MATCH_MP_TAC CARATHEODORY_SEMIRING
4808 >> IMP_RES_TAC ALGEBRA_IMP_SEMIRING >> art [premeasure_def]
4809 >> fs [algebra_def, space_def, subsets_def]
4810QED
4811
4812Theorem measure_space_add :
4813 !sp sts u v. measure_space (sp,sts,u) /\ measure_space (sp,sts,v) ==>
4814 measure_space (sp,sts,\s. u s + v s)
4815Proof
4816 rw [measure_space_def]
4817 >- (fs [positive_def] >> rpt STRIP_TAC \\
4818 MATCH_MP_TAC le_add >> rw [])
4819 >> fs [countably_additive_def, IN_FUNSET]
4820 >> rw [o_DEF]
4821 (* applying ext_suminf_add *)
4822 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
4823 >> Know ‘suminf (\n. (\x. u (f x)) n + (\x. v (f x)) n) =
4824 suminf (\x. u (f x)) + suminf (\x. v (f x))’
4825 >- (MATCH_MP_TAC ext_suminf_add >> fs [positive_def])
4826 >> rw []
4827QED
4828
4829(* Lemma 16.6 [1, p.167] (cf. UNIQUENESS_OF_MEASURE, where ‘<=’ becomes ‘=’)
4830
4831 This theorem is used by sub|super_martingale_alt_generator (martingaleTheory).
4832 It's also a nice application of CARATHEODORY_SEMIRING + UNIQUENESS_OF_MEASURE.
4833 *)
4834Theorem SEMIRING_SIGMA_MONOTONE :
4835 !sp sts u v. semiring (sp,sts) /\ has_exhausting_sequence (sp,sts) /\
4836 measure_space (sp,subsets (sigma sp sts),u) /\
4837 measure_space (sp,subsets (sigma sp sts),v) /\
4838 (!s. s IN sts ==> u s <= v s /\ v s < PosInf) ==>
4839 (!s. s IN subsets (sigma sp sts) ==> (u s <= v s))
4840Proof
4841 rpt STRIP_TAC
4842 >> Know ‘!s. s IN sts ==> u s < PosInf’
4843 >- (Q.X_GEN_TAC ‘t’ >> STRIP_TAC \\
4844 MATCH_MP_TAC let_trans >> Q.EXISTS_TAC ‘v t’ >> rw [])
4845 >> DISCH_TAC
4846 >> Know ‘!s. s IN sts ==> 0 <= u s’
4847 >- (Know ‘positive (sp,subsets (sigma sp sts),u)’
4848 >- PROVE_TAC [measure_space_def] \\
4849 simp [positive_def] >> STRIP_TAC \\
4850 Q.X_GEN_TAC ‘t’ >> STRIP_TAC \\
4851 FIRST_X_ASSUM MATCH_MP_TAC \\
4852 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4853 REWRITE_TAC [SIGMA_SUBSET_SUBSETS])
4854 >> DISCH_TAC
4855 >> Know ‘!s. s IN sts ==> 0 <= v s’
4856 >- (Know ‘positive (sp,subsets (sigma sp sts),v)’
4857 >- PROVE_TAC [measure_space_def] \\
4858 simp [positive_def] >> STRIP_TAC \\
4859 Q.X_GEN_TAC ‘t’ >> STRIP_TAC \\
4860 FIRST_X_ASSUM MATCH_MP_TAC \\
4861 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4862 REWRITE_TAC [SIGMA_SUBSET_SUBSETS])
4863 >> DISCH_TAC
4864 >> Q.ABBREV_TAC ‘r = \s. v s - u s’
4865 (* preparing for CARATHEODORY_SEMIRING *)
4866 >> Know ‘premeasure (sp,sts,r)’
4867 >- (REWRITE_TAC [premeasure_def] \\
4868 STRONG_CONJ_TAC (* positive *)
4869 >- (simp [positive_def, Abbr ‘r’] \\
4870 ‘positive (sp,subsets (sigma sp sts),u) /\
4871 positive (sp,subsets (sigma sp sts),v)’ by PROVE_TAC [measure_space_def] \\
4872 fs [positive_def, sub_rzero] \\
4873 Q.X_GEN_TAC ‘t’ >> STRIP_TAC \\
4874 Suff ‘0 <= v t - u t <=> u t <= v t’ >- (Rewr' >> PROVE_TAC []) \\
4875 ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
4876 MATCH_MP_TAC sub_zero_le \\
4877 reverse CONJ_TAC >- (REWRITE_TAC [lt_infty] \\
4878 FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
4879 MATCH_MP_TAC pos_not_neginf \\
4880 FIRST_X_ASSUM MATCH_MP_TAC \\
4881 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4882 REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) >> DISCH_TAC \\
4883 rw [countably_additive_def, Abbr ‘r’, o_DEF, IN_FUNSET] \\
4884 (* applying ext_suminf_sub *)
4885 Know ‘suminf (\x. (v o f) x - (u o f) x) = suminf (v o f) - suminf (u o f)’
4886 >- (MATCH_MP_TAC ext_suminf_sub >> rw [o_DEF] \\
4887 Know ‘suminf (measure (sp,subsets (sigma sp sts),v) o f) =
4888 measure (sp,subsets (sigma sp sts),v) (BIGUNION (IMAGE f UNIV))’
4889 >- (MATCH_MP_TAC COUNTABLY_ADDITIVE >> simp [IN_FUNSET] \\
4890 CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def] \\
4891 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4892 REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) \\
4893 rw [o_DEF, lt_infty]) \\
4894 rw [o_DEF] \\
4895 Know ‘suminf (measure (sp,subsets (sigma sp sts),v) o f) =
4896 measure (sp,subsets (sigma sp sts),v) (BIGUNION (IMAGE f UNIV))’
4897 >- (MATCH_MP_TAC COUNTABLY_ADDITIVE >> simp [IN_FUNSET] \\
4898 CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def] \\
4899 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4900 REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) \\
4901 Know ‘suminf (measure (sp,subsets (sigma sp sts),u) o f) =
4902 measure (sp,subsets (sigma sp sts),u) (BIGUNION (IMAGE f UNIV))’
4903 >- (MATCH_MP_TAC COUNTABLY_ADDITIVE >> simp [IN_FUNSET] \\
4904 CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def] \\
4905 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4906 REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) \\
4907 rw [o_DEF])
4908 >> DISCH_TAC
4909 (* applying CARATHEODORY_SEMIRING, this asserts ‘measure_space m’ *)
4910 >> MP_TAC (Q.SPEC ‘(sp,sts,r)’ CARATHEODORY_SEMIRING) >> rw []
4911 (* stage work *)
4912 >> Know ‘!s. s IN sts ==> v s = r s + u s’
4913 >- (Q.X_GEN_TAC ‘t’ >> rw [Abbr ‘r’, Once EQ_SYM_EQ] \\
4914 MATCH_MP_TAC sub_add \\
4915 reverse CONJ_TAC >- rw [lt_infty] \\
4916 MATCH_MP_TAC pos_not_neginf >> rw [])
4917 >> DISCH_TAC
4918 >> Q.ABBREV_TAC ‘v' = \s. r s + u s’
4919 >> Know ‘premeasure (sp,sts,v')’
4920 >- (REWRITE_TAC [premeasure_def] \\
4921 STRONG_CONJ_TAC (* positive *)
4922 >- (simp [positive_def, Abbr ‘v'’] \\
4923 ‘positive (sp,subsets (sigma sp sts),u)’ by PROVE_TAC [measure_space_def] \\
4924 ‘positive (sp,sts,r)’ by PROVE_TAC [premeasure_def] \\
4925 fs [positive_def, sub_rzero]) >> DISCH_TAC \\
4926 rw [countably_additive_def, Abbr ‘v'’, o_DEF, IN_FUNSET] \\
4927 (* applying ext_suminf_sub *)
4928 Know ‘suminf (\x. (r o f) x + (u o f) x) = suminf (r o f) + suminf (u o f)’
4929 >- (MATCH_MP_TAC ext_suminf_add >> rw [o_DEF] \\
4930 ‘positive (sp,sts,r)’ by PROVE_TAC [premeasure_def] \\
4931 fs [positive_def]) \\
4932 rw [o_DEF] \\
4933 Know ‘suminf (measure (sp,sts,r) o f) =
4934 measure (sp,sts,r) (BIGUNION (IMAGE f UNIV))’
4935 >- (MATCH_MP_TAC COUNTABLY_ADDITIVE >> simp [IN_FUNSET] \\
4936 FULL_SIMP_TAC std_ss [premeasure_def]) \\
4937 Know ‘suminf (measure (sp,subsets (sigma sp sts),u) o f) =
4938 measure (sp,subsets (sigma sp sts),u) (BIGUNION (IMAGE f UNIV))’
4939 >- (MATCH_MP_TAC COUNTABLY_ADDITIVE >> simp [IN_FUNSET] \\
4940 CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def] \\
4941 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4942 REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) \\
4943 rw [o_DEF])
4944 >> DISCH_TAC
4945 (* applying CARATHEODORY_SEMIRING, this asserts ‘measure_space m'’ *)
4946 >> MP_TAC (Q.SPEC ‘(sp,sts,v')’ CARATHEODORY_SEMIRING) >> rw []
4947 (* preparing for UNIQUENESS_OF_MEASURE *)
4948 >> Q.ABBREV_TAC ‘v'' = \s. measure m s + u s’
4949 (* applying UNIQUENESS_OF_MEASURE *)
4950 >> Know ‘!s. s IN subsets (sigma sp sts) ==> v s = v'' s’
4951 >- (‘!s. s IN sts ==> v s = v'' s’ by METIS_TAC [] \\
4952 MATCH_MP_TAC UNIQUENESS_OF_MEASURE >> simp [sigma_finite] \\
4953 fs [semiring_def, has_exhausting_sequence] \\
4954 CONJ_TAC >- (Q.EXISTS_TAC ‘f’ >> art [] \\
4955 fs [exhausting_sequence_def, IN_FUNSET]) \\
4956 Q.UNABBREV_TAC ‘v''’ \\
4957 MATCH_MP_TAC measure_space_add >> art [] \\
4958 ‘subsets (sigma sp sts) = measurable_sets m’ by METIS_TAC [subsets_def] \\
4959 POP_ORW \\
4960 ‘sp = m_space m’ by METIS_TAC [SPACE_SIGMA, space_def] >> POP_ORW \\
4961 rw [MEASURE_SPACE_REDUCE])
4962 >> rw [Abbr ‘v''’]
4963 >> MATCH_MP_TAC le_addl_imp
4964 >> ‘s IN measurable_sets m’ by METIS_TAC [subsets_def]
4965 >> Suff ‘positive m’ >- rw [positive_def]
4966 >> PROVE_TAC [MEASURE_SPACE_POSITIVE]
4967QED
4968
4969(* ------------------------------------------------------------------------- *)
4970(* Completeness of Measure - Null sets *)
4971(* ------------------------------------------------------------------------- *)
4972
4973(* s is a null set on measure sapce m, see [1] (p.29) *)
4974Definition null_set_def:
4975 null_set m s <=> s IN measurable_sets m /\ (measure m s = 0)
4976End
4977
4978(* NOTE: the type of ‘completion m’ is “:'a algebra” *)
4979Definition completion_def :
4980 completion (m :'a m_space) =
4981 (m_space m, {s UNION n | s IN measurable_sets m /\
4982 ?t. n SUBSET t /\ null_set m t})
4983End
4984
4985(* the measure space m is called complete iff any subset of a null set is again
4986 in `subsets m` (thus also a null set) see [1] (p.29], [5] (p.382) *)
4987Definition complete_measure_space_def:
4988 complete_measure_space m <=>
4989 measure_space m /\
4990 !s. null_set m s ==> !t. t SUBSET s ==> t IN measurable_sets m
4991End
4992
4993Theorem IN_NULL_SET: !m s. s IN null_set m <=> null_set m s
4994Proof
4995 GEN_TAC >> SIMP_TAC std_ss [IN_APP]
4996QED
4997
4998(* This is HVG's original definition of "null_sets" *)
4999Theorem null_sets :
5000 null_set M = {N | N IN measurable_sets M /\ (measure M N = 0)}
5001Proof
5002 RW_TAC std_ss [Once EXTENSION, GSPECIFICATION, IN_NULL_SET, null_set_def]
5003QED
5004
5005Theorem NULL_SET_EMPTY: !m. measure_space m ==> null_set m {}
5006Proof
5007 RW_TAC std_ss [measure_space_def, positive_def, null_set_def]
5008 >> PROVE_TAC [sigma_algebra_def, ALGEBRA_EMPTY, space_def, subsets_def]
5009QED
5010
5011(* properties of the set of m-null sets, see [1] (p.29, Problem 4.10) *)
5012Theorem NULL_SET_THM:
5013 !m s t. measure_space m ==>
5014 {} IN null_set m /\
5015 (t IN null_set m /\ s IN measurable_sets m /\ s SUBSET t ==> s IN null_set m) /\
5016 !f. f IN (univ(:num) -> null_set m) ==>
5017 BIGUNION (IMAGE f univ(:num)) IN null_set m
5018Proof
5019 rpt GEN_TAC >> DISCH_TAC
5020 >> SIMP_TAC std_ss [IN_NULL_SET, null_set_def]
5021 >> CONJ_TAC >- (PROVE_TAC [MEASURE_SPACE_EMPTY_MEASURABLE, MEASURE_EMPTY])
5022 >> CONJ_TAC >- (rpt STRIP_TAC \\
5023 Suff `measure m s <= measure m t`
5024 >- (DISCH_TAC >> REWRITE_TAC [GSYM le_antisym] \\
5025 CONJ_TAC >- PROVE_TAC [] \\
5026 fs [measure_space_def, positive_def]) \\
5027 MATCH_MP_TAC INCREASING >> art [] \\
5028 IMP_RES_TAC MEASURE_SPACE_INCREASING)
5029 >> GEN_TAC >> REWRITE_TAC [IN_FUNSET, IN_UNIV, IN_NULL_SET, null_set_def]
5030 >> STRIP_TAC >> STRONG_CONJ_TAC
5031 >- (fs [measure_space_def, sigma_algebra_def, subsets_def] \\
5032 FIRST_X_ASSUM MATCH_MP_TAC \\
5033 REWRITE_TAC [COUNTABLE_IMAGE_NUM] \\
5034 fs [SUBSET_DEF, IN_FUNSET, IN_UNIV, IN_NULL_SET, null_set_def] \\
5035 PROVE_TAC []) >> DISCH_TAC
5036 >> IMP_RES_TAC MEASURE_SPACE_COUNTABLY_SUBADDITIVE
5037 >> fs [countably_subadditive_def]
5038 >> Know `measure m (BIGUNION (IMAGE f univ(:num))) <= suminf (measure m o f)`
5039 >- (FIRST_X_ASSUM MATCH_MP_TAC >> PROVE_TAC [IN_FUNSET, IN_UNIV]) >> DISCH_TAC
5040 >> Suff `suminf (measure m o f) = 0`
5041 >- (DISCH_TAC >> fs [] >> REWRITE_TAC [GSYM le_antisym] >> art [] \\
5042 fs [measure_space_def, positive_def])
5043 >> MATCH_MP_TAC ext_suminf_zero >> METIS_TAC [o_DEF]
5044QED
5045
5046(* |- !m s t.
5047 measure_space m ==>
5048 t IN null_set m /\ s IN measurable_sets m /\ s SUBSET t ==>
5049 s IN null_set m
5050 *)
5051Theorem NULL_SET_MONO = cj 2 NULL_SET_THM
5052
5053(* in complete measure space, the subset of a null set is still a null set. *)
5054Theorem COMPLETE_MEASURE_THM:
5055 !m s t. complete_measure_space m /\ t IN null_set m /\ s SUBSET t ==> s IN null_set m
5056Proof
5057 RW_TAC std_ss [complete_measure_space_def]
5058 >> PROVE_TAC [NULL_SET_THM, IN_NULL_SET]
5059QED
5060
5061Theorem NULL_SET_UNION :
5062 !m N1 N2. measure_space m /\ N1 IN null_set m /\ N2 IN null_set m ==>
5063 (N1 UNION N2) IN null_set m
5064Proof
5065 rpt GEN_TAC
5066 >> SIMP_TAC std_ss [IN_NULL_SET, null_set_def]
5067 >> STRIP_TAC
5068 >> STRONG_CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_UNION >> art [])
5069 >> DISCH_TAC
5070 >> REWRITE_TAC [GSYM le_antisym]
5071 >> reverse CONJ_TAC
5072 >- (IMP_RES_TAC MEASURE_SPACE_POSITIVE >> fs [positive_def])
5073 >> `0 = measure m N1 + measure m N2` by METIS_TAC [add_rzero]
5074 >> POP_ORW
5075 >> MATCH_MP_TAC SUBADDITIVE >> art []
5076 >> IMP_RES_TAC MEASURE_SPACE_SUBADDITIVE
5077QED
5078Theorem NULL_SET_UNION' = REWRITE_RULE [IN_NULL_SET] NULL_SET_UNION
5079
5080Theorem NULL_SET_INTER :
5081 !m N1 N2. measure_space m /\ N1 IN null_set m /\ N2 IN null_set m ==>
5082 (N1 INTER N2) IN null_set m
5083Proof
5084 rpt GEN_TAC
5085 >> SIMP_TAC std_ss [IN_NULL_SET, null_set_def]
5086 >> STRIP_TAC
5087 >> STRONG_CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_INTER >> art [])
5088 >> DISCH_TAC
5089 >> REWRITE_TAC [GSYM le_antisym]
5090 >> reverse CONJ_TAC
5091 >- (IMP_RES_TAC MEASURE_SPACE_POSITIVE >> fs [positive_def])
5092 >> Q.PAT_X_ASSUM `measure m N1 = 0` (ONCE_REWRITE_TAC o wrap o SYM)
5093 >> MATCH_MP_TAC INCREASING >> art []
5094 >> reverse CONJ_TAC >- SET_TAC []
5095 >> IMP_RES_TAC MEASURE_SPACE_INCREASING
5096QED
5097Theorem NULL_SET_INTER' = REWRITE_RULE [IN_NULL_SET] NULL_SET_INTER
5098
5099Theorem NULL_SET_BIGUNION :
5100 !m f. measure_space m /\ (!n. f n IN null_set m) ==>
5101 BIGUNION (IMAGE f univ(:num)) IN null_set m
5102Proof
5103 rpt GEN_TAC
5104 >> simp [IN_NULL_SET, null_set_def]
5105 >> STRIP_TAC
5106 >> STRONG_CONJ_TAC
5107 >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION >> art [])
5108 >> DISCH_TAC
5109 >> REWRITE_TAC [GSYM le_antisym]
5110 >> reverse CONJ_TAC
5111 >- (IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
5112 fs [positive_def])
5113 >> Know ‘suminf (measure m o f) = 0’
5114 >- (MATCH_MP_TAC ext_suminf_zero >> rw [o_DEF])
5115 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap o SYM)
5116 >> IMP_RES_TAC MEASURE_SPACE_COUNTABLY_SUBADDITIVE
5117 >> MATCH_MP_TAC COUNTABLY_SUBADDITIVE
5118 >> rw [IN_FUNSET]
5119QED
5120Theorem NULL_SET_BIGUNION' = REWRITE_RULE [IN_NULL_SET] NULL_SET_BIGUNION
5121
5122Theorem SIGMA_ALGEBRA_COMPLETION :
5123 !m. measure_space m ==> sigma_algebra (completion m)
5124Proof
5125 rw [completion_def, sigma_algebra_alt_pow]
5126 >| [ (* goal 1 (of 5) *)
5127 rw [SUBSET_DEF, IN_POW] \\
5128 rename1 ‘y IN s UNION n’ \\
5129 fs [IN_UNION] >| (* 2 subgoal *)
5130 [ (* goal 1.1 (of 2) *)
5131 POP_ASSUM MP_TAC \\
5132 Q.SPEC_TAC (‘y’, ‘y’) >> REWRITE_TAC [GSYM SUBSET_DEF] \\
5133 fs [measure_space_def, sigma_algebra_def, algebra_def, subset_class_def],
5134 (* goal 1.2 (of 2) *)
5135 Know ‘y IN t’ >- PROVE_TAC [] \\
5136 Q.SPEC_TAC (‘y’, ‘y’) >> REWRITE_TAC [GSYM SUBSET_DEF] \\
5137 fs [measure_space_def, sigma_algebra_def, algebra_def, subset_class_def,
5138 null_set_def] ],
5139 (* goal 2 (of 5) *)
5140 MATCH_MP_TAC MEASURE_SPACE_EMPTY_MEASURABLE >> art [],
5141 (* goal 3 (of 5) *)
5142 Q.EXISTS_TAC ‘{}’ >> rw [null_set_def, MEASURE_EMPTY] \\
5143 MATCH_MP_TAC MEASURE_SPACE_EMPTY_MEASURABLE >> art [],
5144 (* goal 4 (of 5) *)
5145 rename1 ‘s IN measurable_sets m’ \\
5146 qexistsl_tac [‘m_space m DIFF (s UNION t)’, ‘t DIFF (s UNION n)’] \\
5147 CONJ_TAC
5148 >- (rw [Once EXTENSION] \\
5149 fs [measure_space_def, sigma_algebra_def, algebra_def, subset_class_def,
5150 null_set_def] \\
5151 EQ_TAC >> rpt STRIP_TAC >> rw [] >| (* 2 subgoals *)
5152 [ (* goal 4.1 (of 2) *)
5153 METIS_TAC [SUBSET_DEF],
5154 (* goal 4.2 (of 2) *)
5155 METIS_TAC [SUBSET_DEF] ]) \\
5156 CONJ_TAC
5157 >- (MATCH_MP_TAC MEASURE_SPACE_COMPL >> art [] \\
5158 MATCH_MP_TAC MEASURE_SPACE_UNION >> art [] \\
5159 fs [null_set_def]) \\
5160 Q.EXISTS_TAC ‘t’ >> art [] \\
5161 SET_TAC [],
5162 (* goal 5 (of 5) *)
5163 fs [Once SUBSET_DEF, IN_IMAGE] \\
5164 Know ‘!n. ?P. A n = (FST P) UNION (SND P) /\ (FST P) IN measurable_sets m /\
5165 ?t. (SND P) SUBSET t /\ null_set m t’
5166 >- (Q.X_GEN_TAC ‘n’ \\
5167 POP_ASSUM (MP_TAC o (Q.SPEC ‘A (n :num)’)) \\
5168 Know ‘?x. A n = A x’ >- (Q.EXISTS_TAC ‘n’ >> rw []) \\
5169 RW_TAC std_ss [] >> rename1 ‘A n = a UNION b’ \\
5170 Q.EXISTS_TAC ‘(a,b)’ >> rw [] \\
5171 Q.EXISTS_TAC ‘t’ >> art []) \\
5172 POP_ASSUM K_TAC \\
5173 DISCH_TAC >> fs [SKOLEM_THM] (* this asserts ‘f’ *) \\
5174 qexistsl_tac [‘BIGUNION (IMAGE (FST o f) UNIV)’,
5175 ‘BIGUNION (IMAGE (SND o f) UNIV)’] \\
5176 CONJ_TAC >- (rw [Once EXTENSION, IN_BIGUNION_IMAGE] \\
5177 EQ_TAC >> rw [] >| (* 3 subgoals *)
5178 [ (* goal 1 (of 3) *)
5179 fs [IN_UNION] >| (* 2 subgoals *)
5180 [ DISJ1_TAC >> Q.EXISTS_TAC ‘i’ >> art [],
5181 DISJ2_TAC >> Q.EXISTS_TAC ‘i’ >> art [] ],
5182 (* goal 2 (of 3) *)
5183 rename1 ‘x IN FST (f i)’ \\
5184 Q.EXISTS_TAC ‘FST (f i) UNION SND (f i)’ \\
5185 reverse CONJ_TAC >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5186 rw [IN_UNION],
5187 (* goal 2 (of 3) *)
5188 rename1 ‘x IN SND (f i)’ \\
5189 Q.EXISTS_TAC ‘FST (f i) UNION SND (f i)’ \\
5190 reverse CONJ_TAC >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5191 rw [IN_UNION] ]) \\
5192 CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION >> rw [o_DEF]) \\
5193 ‘!n. ?t. SND (f n) SUBSET t /\ null_set m t’ by PROVE_TAC [] \\
5194 FULL_SIMP_TAC std_ss [SKOLEM_THM] \\
5195 rename1 ‘!n. SND (f n) SUBSET g n /\ null_set m (g n)’ \\
5196 Q.EXISTS_TAC ‘BIGUNION (IMAGE g UNIV)’ \\
5197 reverse CONJ_TAC
5198 >- (MATCH_MP_TAC (REWRITE_RULE [IN_NULL_SET] NULL_SET_BIGUNION) >> art []) \\
5199 rw [o_DEF, IN_BIGUNION_IMAGE] \\
5200 rename1 ‘x IN SND (f i)’ \\
5201 Q.EXISTS_TAC ‘i’ >> METIS_TAC [SUBSET_DEF] ]
5202QED
5203
5204Theorem COMPLETION_SUBSET_SUBSETS :
5205 !m. measure_space m ==> measurable_sets m SUBSET subsets (completion m)
5206Proof
5207 rw [completion_def, SUBSET_DEF]
5208 >> qexistsl_tac [‘x’, ‘{}’] >> rw []
5209 >> Q.EXISTS_TAC ‘{}’ >> rw [NULL_SET_EMPTY]
5210QED
5211
5212(* ‘completion’ is stable for complete measure spaces *)
5213Theorem COMPLETION_STABLE :
5214 !m. complete_measure_space m ==> space (completion m) = m_space m /\
5215 subsets (completion m) = measurable_sets m
5216Proof
5217 rpt STRIP_TAC
5218 >- rw [completion_def]
5219 >> reverse (rw [GSYM SUBSET_ANTISYM_EQ])
5220 >- (MATCH_MP_TAC COMPLETION_SUBSET_SUBSETS \\
5221 fs [complete_measure_space_def])
5222 >> fs [complete_measure_space_def, completion_def]
5223 >> rw [Once SUBSET_DEF]
5224 >> MATCH_MP_TAC MEASURE_SPACE_UNION >> art []
5225 >> FIRST_X_ASSUM irule >> Q.EXISTS_TAC ‘t’ >> art []
5226QED
5227
5228Theorem COMPLETION_STABLE' :
5229 !m. complete_measure_space m ==> completion m = measurable_space m
5230Proof
5231 PROVE_TAC [SPACE, COMPLETION_STABLE]
5232QED
5233
5234(* ------------------------------------------------------------------------- *)
5235(* Alternative definitions of `sigma_finite` *)
5236(* ------------------------------------------------------------------------- *)
5237
5238Theorem FINITE_IMP_SIGMA_FINITE :
5239 !m. measure_space m /\ measure m (m_space m) <> PosInf ==> sigma_finite m
5240Proof
5241 RW_TAC std_ss [sigma_finite_def]
5242 >> Q.EXISTS_TAC `\n. m_space m`
5243 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV, GSYM lt_infty, SUBSET_REFL,
5244 MEASURE_SPACE_MSPACE_MEASURABLE]
5245 >> RW_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV]
5246QED
5247
5248(* The increasing sequence in "sigma_finite_def" is not required *)
5249Theorem SIGMA_FINITE_ALT:
5250 !m. measure_space m ==>
5251 (sigma_finite m <=> ?f :num -> 'a set.
5252 f IN (UNIV -> measurable_sets m) /\
5253 (BIGUNION (IMAGE f UNIV) = m_space m) /\
5254 (!n. measure m (f n) < PosInf))
5255Proof
5256 GEN_TAC >> DISCH_TAC
5257 >> REWRITE_TAC [sigma_finite_def]
5258 >> EQ_TAC >> rpt STRIP_TAC
5259 >- (Q.EXISTS_TAC `f` >> art [])
5260 >> STRIP_ASSUME_TAC (Q.SPEC `f` SETS_TO_INCREASING_SETS)
5261 >> Q.EXISTS_TAC `g`
5262 >> fs [IN_FUNSET, IN_UNIV, measure_space_def]
5263 >> CONJ_TAC
5264 >- (GEN_TAC \\
5265 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
5266 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_FINITE_UNION)) \\
5267 CONJ_TAC >- fs [sigma_algebra_def] \\
5268 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
5269 RW_TAC arith_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] >> art [])
5270 >> GEN_TAC
5271 >> MATCH_MP_TAC let_trans
5272 >> Q.EXISTS_TAC `SIGMA (measure m o f) (count (SUC n))`
5273 >> CONJ_TAC
5274 >- (MATCH_MP_TAC FINITE_SUBADDITIVE >> art [] \\
5275 CONJ_TAC >- (MATCH_MP_TAC ALGEBRA_PREMEASURE_FINITE_SUBADDITIVE \\
5276 fs [sigma_algebra_def, premeasure_def]) \\
5277 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
5278 (Q.SPEC `(m_space m,measurable_sets m)` ALGEBRA_FINITE_UNION)) \\
5279 CONJ_TAC >- fs [sigma_algebra_def] \\
5280 CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
5281 RW_TAC arith_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] >> art [])
5282 >> REWRITE_TAC [GSYM lt_infty]
5283 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_NOT_POSINF
5284 >> CONJ_TAC >- REWRITE_TAC [FINITE_COUNT]
5285 >> RW_TAC std_ss [o_DEF, lt_infty]
5286QED
5287
5288Theorem SIGMA_FINITE_ALT2 : (* was: sigma_finite_measure (HVG) *)
5289 !m. measure_space m ==>
5290 (sigma_finite m <=> ?A. countable A /\ A SUBSET measurable_sets m /\
5291 (BIGUNION A = m_space m) /\
5292 (!a. a IN A ==> measure m a <> PosInf))
5293Proof
5294 GEN_TAC >> DISCH_TAC
5295 >> EQ_TAC >> rpt STRIP_TAC
5296 >- (fs [sigma_finite_def] \\
5297 Q.EXISTS_TAC `IMAGE f univ(:num)` >> art [] \\
5298 CONJ_TAC >- REWRITE_TAC [countable_image_nats] \\
5299 CONJ_TAC >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV] \\
5300 fs [IN_FUNSET, IN_UNIV]) \\
5301 RW_TAC std_ss [IN_IMAGE, lt_infty] >> art [])
5302 >> fs [COUNTABLE_ENUM]
5303 >| [ (* goal 1 (of 2) *)
5304 REWRITE_TAC [sigma_finite_def] \\
5305 Q.EXISTS_TAC `\n. {}` \\
5306 CONJ_TAC >- (RW_TAC std_ss [IN_FUNSET, IN_UNIV] \\
5307 METIS_TAC [measure_space_def, sigma_algebra_def, ALGEBRA_EMPTY, ALGEBRA_SPACE,
5308 space_def, subsets_def]) \\
5309 CONJ_TAC >- RW_TAC std_ss [SUBSET_REFL] \\
5310 CONJ_TAC >- (Suff `BIGUNION (IMAGE (\n. {}) univ(:num)) = BIGUNION {}` >- METIS_TAC [] \\
5311 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_BIGUNION, IN_UNIV,
5312 NOT_IN_EMPTY]) \\
5313 GEN_TAC >> BETA_TAC \\
5314 fs [measure_space_def, positive_def] \\
5315 REWRITE_TAC [extreal_of_num_def, lt_infty],
5316 (* goal 2 (of 2) *)
5317 RW_TAC std_ss [SIGMA_FINITE_ALT] \\
5318 Q.EXISTS_TAC `f` >> art [] \\
5319 CONJ_TAC >- (fs [IN_FUNSET, IN_UNIV, SUBSET_DEF, IN_IMAGE] \\
5320 GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
5321 Q.EXISTS_TAC `x` >> REWRITE_TAC []) \\
5322 GEN_TAC >> REWRITE_TAC [GSYM lt_infty] \\
5323 FIRST_X_ASSUM MATCH_MP_TAC \\
5324 REWRITE_TAC [IN_IMAGE, IN_UNIV] \\
5325 Q.EXISTS_TAC `n` >> REWRITE_TAC [] ]
5326QED
5327
5328(* NOTE: was ‘sigma_finite’ (name conflicted with its original definition) *)
5329Theorem sigma_finite_thm :
5330 !m. measure_space m /\ sigma_finite m ==>
5331 ?A. IMAGE A UNIV SUBSET measurable_sets m /\
5332 (BIGUNION {A i | i IN UNIV} = m_space m) /\
5333 (!i:num. measure m (A i) <> PosInf)
5334Proof
5335 rpt STRIP_TAC
5336 >> fs [MATCH_MP SIGMA_FINITE_ALT2 (ASSUME ``measure_space m``)]
5337 >> Cases_on `A = {}`
5338 >- (FULL_SIMP_TAC std_ss [NOT_IN_EMPTY, BIGUNION_EMPTY] \\
5339 Q.EXISTS_TAC `\n. {}` \\
5340 SIMP_TAC std_ss [IMAGE_DEF, SUBSET_DEF] \\
5341 REWRITE_TAC [SET_RULE ``{{} | i IN univ(:num)} = {{}}``] \\
5342 ASM_SIMP_TAC std_ss [BIGUNION_SING, IN_SING] \\
5343 ASM_SIMP_TAC std_ss [MEASURE_SPACE_MSPACE_MEASURABLE] \\
5344 CONJ_TAC >- (SET_TAC []) \\
5345 METIS_TAC [MEASURE_EMPTY, num_not_infty])
5346 >> Q.PAT_X_ASSUM `COUNTABLE A` (STRIP_ASSUME_TAC o (REWRITE_RULE [COUNTABLE_ENUM]))
5347 >> Q.EXISTS_TAC `f` >> rw []
5348 >> Q.PAT_X_ASSUM `_ = m_space m` (ONCE_REWRITE_TAC o wrap o SYM)
5349 >> SET_TAC []
5350QED
5351
5352Theorem sigma_finite_disjoint :
5353 !m. measure_space m /\ sigma_finite m ==>
5354 ?A. IMAGE A UNIV SUBSET measurable_sets m /\
5355 (BIGUNION {A i | i IN UNIV} = m_space m) /\
5356 (!i:num. measure m (A i) <> PosInf) /\ disjoint_family A
5357Proof
5358 RW_TAC std_ss []
5359 >> `?A. IMAGE A univ(:num) SUBSET measurable_sets m /\
5360 (BIGUNION {A i | i IN univ(:num)} = m_space m) /\
5361 !i. measure m (A i) <> PosInf` by METIS_TAC [sigma_finite_thm]
5362 >> Know `!i. measure m (disjointed A i) <= measure m (A i)`
5363 >- (GEN_TAC THEN
5364 MATCH_MP_TAC INCREASING THEN SIMP_TAC std_ss [disjointed_subset] \\
5365 reverse CONJ_TAC
5366 >- (reverse CONJ_TAC >- ASM_SET_TAC [] \\
5367 `IMAGE (\n. disjointed A n) UNIV SUBSET measurable_sets m`
5368 by METIS_TAC [measure_space_def, sigma_algebra_alt_eq, algebra_alt,
5369 ring_disjointed_sets] \\
5370 ASM_SET_TAC []) \\
5371 FULL_SIMP_TAC std_ss [MEASURE_SPACE_INCREASING])
5372 >> DISCH_TAC
5373 >> Know `!i. measure m (disjointed A i) <> PosInf`
5374 >- (FULL_SIMP_TAC std_ss [lt_infty] >> METIS_TAC [let_trans])
5375 >> DISCH_TAC
5376 >> Q.EXISTS_TAC `\n. disjointed A n` >> RW_TAC std_ss []
5377 >| [ (* goal 1 (of 3) *)
5378 MATCH_MP_TAC ring_disjointed_sets THEN Q.EXISTS_TAC `m_space m` THEN
5379 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_alt_eq, algebra_alt],
5380 (* goal 2 (of 3) *)
5381 ASM_SIMP_TAC std_ss [BIGUNION_disjointed],
5382 (* goal 3 (of 3) *)
5383 METIS_TAC [disjoint_family_disjoint, ETA_THM] ]
5384QED
5385
5386(* NOTE: added ‘sigma_algebra (m_space N, measurable_sets N)’ into antecedents
5387 due to changes in ‘measurable’.
5388 *)
5389Theorem MEASURABLE_IF : (* was: measurable_If *)
5390 !f g M N P. f IN measurable (m_space M, measurable_sets M)
5391 (m_space N, measurable_sets N) /\
5392 g IN measurable (m_space M, measurable_sets M)
5393 (m_space N, measurable_sets N) /\
5394 {x | x IN m_space M /\ P x} IN measurable_sets M /\
5395 measure_space M /\
5396 sigma_algebra (m_space N, measurable_sets N)
5397 ==> (\x. if P x then f x else g x) IN
5398 measurable (m_space M, measurable_sets M)
5399 (m_space N, measurable_sets N)
5400Proof
5401 RW_TAC std_ss [measurable_def, IN_MEASURABLE, space_def, subsets_def]
5402 >- (FULL_SIMP_TAC std_ss [IN_FUNSET] THEN METIS_TAC [])
5403 >> KNOW_TAC ``PREIMAGE (\x. if P x then f x else g x) s INTER m_space M =
5404 (((PREIMAGE f s) INTER m_space M) INTER {x | x IN m_space M /\ P x}) UNION
5405 (((PREIMAGE g s) INTER m_space M) INTER
5406 (m_space M DIFF {x | x IN m_space M /\ P x}))``
5407 >- (SIMP_TAC std_ss [PREIMAGE_def] THEN SET_TAC [])
5408 >> ‘sigma_algebra (measurable_space M)’ by PROVE_TAC [measure_space_def]
5409 >> ONCE_REWRITE_TAC [METIS [subsets_def] ``measurable_sets M =
5410 subsets (m_space M, measurable_sets M)``] THEN
5411 SIMP_TAC std_ss [] THEN DISC_RW_KILL THEN
5412 MATCH_MP_TAC ALGEBRA_UNION THEN
5413 FULL_SIMP_TAC std_ss [sigma_algebra_def] THEN
5414 CONJ_TAC THEN MATCH_MP_TAC ALGEBRA_INTER THEN
5415 FULL_SIMP_TAC std_ss [] THENL
5416 [METIS_TAC [subsets_def], ALL_TAC] THEN
5417 CONJ_TAC THENL [METIS_TAC [subsets_def], ALL_TAC] THEN
5418 MATCH_MP_TAC ALGEBRA_DIFF THEN FULL_SIMP_TAC std_ss [subsets_def] THEN
5419 MATCH_MP_TAC MEASURE_SPACE_MSPACE_MEASURABLE THEN ASM_REWRITE_TAC []
5420QED
5421
5422(* NOTE: added ‘sigma_algebra (m_space N, measurable_sets N)’ into antecedents
5423 due to changes in ‘measurable’.
5424 *)
5425Theorem MEASURABLE_IF_SET : (* was: measurable_If_set *)
5426 !f g M N A. f IN measurable (m_space M, measurable_sets M)
5427 (m_space N, measurable_sets N) /\
5428 g IN measurable (m_space M, measurable_sets M)
5429 (m_space N, measurable_sets N) /\
5430 A INTER m_space M IN measurable_sets M /\
5431 measure_space M /\
5432 sigma_algebra (m_space N, measurable_sets N)
5433 ==> (\x. if x IN A then f x else g x) IN
5434 measurable (m_space M, measurable_sets M)
5435 (m_space N, measurable_sets N)
5436Proof
5437 RW_TAC std_ss [] THEN
5438 ONCE_REWRITE_TAC [METIS [] ``(\x. if x IN A then f x else g x) =
5439 (\x. if (\x. x IN A) x then f x else g x)``] THEN
5440 MATCH_MP_TAC MEASURABLE_IF THEN ASM_SIMP_TAC std_ss [] THEN
5441 ONCE_REWRITE_TAC [SET_RULE ``{x | x IN m_space M /\ x IN A} =
5442 A INTER m_space M``] THEN
5443 ASM_SIMP_TAC std_ss []
5444QED
5445
5446Theorem lemma1[local]:
5447 !A sp M u. A IN (univ(:num) -> measurable_sets (sp,M,u)) <=>
5448 IMAGE A UNIV SUBSET M
5449Proof
5450 REPEAT STRIP_TAC THEN SIMP_TAC std_ss [measurable_sets_def] THEN
5451 EVAL_TAC THEN SRW_TAC[] [IN_FUNSET,IN_UNIV,SUBSET_DEF,IMAGE_DEF] THEN METIS_TAC[]
5452QED
5453
5454Theorem lemma2[local]:
5455 !A. (!m n. m <> n ==> DISJOINT (A m) (A n)) <=> disjoint_family A
5456Proof
5457 STRIP_TAC THEN SIMP_TAC std_ss [disjoint_family_on] THEN
5458 SET_TAC []
5459QED
5460
5461Theorem lemma3[local]:
5462 !A sp M u. BIGUNION (IMAGE A univ(:num)) IN measurable_sets (sp,M,u) <=>
5463 BIGUNION {A i | i IN UNIV} IN M
5464Proof
5465 REPEAT STRIP_TAC THEN SIMP_TAC std_ss [measurable_sets_def, IMAGE_DEF]
5466QED
5467
5468Theorem countably_additive_alt_eq :
5469 !sp M u. countably_additive (sp,M,u) <=>
5470 !A. IMAGE A UNIV SUBSET M ==> disjoint_family A ==>
5471 BIGUNION {A i | i IN UNIV} IN M ==>
5472 (u (BIGUNION {A i | i IN univ(:num)}) = suminf (u o A))
5473Proof
5474 SIMP_TAC std_ss [countably_additive_def] THEN REPEAT STRIP_TAC THEN
5475 SIMP_TAC std_ss [measure_def, o_DEF, lemma2, lemma3] THEN
5476 SIMP_TAC std_ss [GSYM IMAGE_DEF, SUBSET_DEF, measurable_sets_def] THEN
5477 EQ_TAC THEN RW_TAC std_ss [] THENL
5478 [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
5479 EVAL_TAC THEN ASM_SET_TAC [IN_IMAGE,IN_FUNSET], ALL_TAC] THEN
5480 FIRST_X_ASSUM (MP_TAC o Q.SPEC `f`) THEN RW_TAC std_ss [] THEN
5481 POP_ASSUM MATCH_MP_TAC THEN
5482 fs [IN_IMAGE, IN_UNIV, IN_FUNSET] >> RW_TAC std_ss [] >> art []
5483QED
5484
5485(* ------------------------------------------------------------------------- *)
5486(* Measure type (from HVG's legesgue_measure_hvgTheory) *)
5487(* ------------------------------------------------------------------------- *)
5488
5489(* NOTE: According to [countably_additive_alt_eq], ‘countably_additive (sp,M,u)’
5490 doesn't use sp. This alternative definition ‘countably_additive_alt’ involves
5491 only M and u. (Ported from HVG's legesgue_measure_hvgTheory.)
5492 *)
5493Definition countably_additive_alt :
5494 countably_additive_alt M (u:('a->bool)->extreal) <=>
5495 !A. IMAGE A UNIV SUBSET M ==> disjoint_family A ==>
5496 BIGUNION {A i | i IN UNIV} IN M ==>
5497 u (BIGUNION {A i | i IN univ(:num)}) = suminf (u o A)
5498End
5499
5500(* connection between ‘countably_additive’ and ‘countably_additive_alt’ *)
5501Theorem countably_additive_eq_alt :
5502 !sp M u. countably_additive (sp,M,u) <=> countably_additive_alt M u
5503Proof
5504 REWRITE_TAC [countably_additive_alt, countably_additive_alt_eq]
5505QED
5506
5507Definition positive_alt :
5508 positive_alt M u <=> (u {} = 0:extreal) /\ !a. a IN M ==> 0 <= u a
5509End
5510
5511Theorem positive_eq_alt :
5512 !sp M u. positive (sp,M,u) <=> positive_alt M u
5513Proof
5514 rw [positive_def, positive_alt]
5515QED
5516
5517Theorem positive_alt_eq :
5518 !sp M u. positive (sp,M,u) <=> u {} = 0 /\ !a. a IN M ==> 0 <= u a
5519Proof
5520 REWRITE_TAC [positive_eq_alt, positive_alt]
5521QED
5522
5523Definition measure_space_alt :
5524 measure_space_alt sp A u <=> sigma_algebra_alt sp A /\ positive_alt A u /\
5525 countably_additive_alt A u
5526End
5527
5528Theorem measure_space_alt_eq :
5529 !sp M u. measure_space (sp,M,u) <=>
5530 sigma_algebra_alt sp M /\ positive_alt M u /\
5531 countably_additive_alt M u
5532Proof
5533 SIMP_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def] THEN
5534 SIMP_TAC std_ss [sigma_algebra_alt_eq, sigma_algebra_alt] THEN
5535 SIMP_TAC std_ss [positive_alt_eq, positive_alt] THEN
5536 SIMP_TAC std_ss [countably_additive_alt_eq, countably_additive_alt]
5537QED
5538
5539(* NOTE: ‘measure_of’ takes a space, a generator and a measure, and returns a
5540 measure space with a total-version of the measure function, returning 0 on
5541 non-measurable sets. (cf. sigma_sets_sigma)
5542 *)
5543Definition measure_of :
5544 measure_of (sp,A,u) = (sp,
5545 (if A SUBSET POW sp then (sigma_sets sp A) else {{};sp}),
5546 (\a. if a IN sigma_sets sp A /\ measure_space (sp, sigma_sets sp A, u)
5547 then u a else 0))
5548End
5549
5550Theorem measure_of_def =
5551 measure_of |> Q.SPECL [‘m_space m’, ‘measurable_sets m’, ‘measure m’]
5552 |> REWRITE_RULE [MEASURE_SPACE_REDUCE]
5553
5554Theorem measure_of_measure_space :
5555 !m. measure_space m ==> measure_space (measure_of m)
5556Proof
5557 rpt STRIP_TAC
5558 >> simp [measure_of_def]
5559 >> Know ‘measurable_sets m SUBSET POW (m_space m)’
5560 >- FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_iff2]
5561 >> DISCH_TAC
5562 >> ‘sigma_sets (m_space m) (measurable_sets m) = measurable_sets m’
5563 by METIS_TAC [sigma_sets_eq, measure_space_def]
5564 >> simp []
5565 >> MATCH_MP_TAC measure_space_eq
5566 >> Q.EXISTS_TAC ‘m’ >> simp []
5567QED
5568
5569Theorem measure_of_reduce :
5570 !M. measure_of M = measure_of (m_space M, measurable_sets M, measure M)
5571Proof
5572 SIMP_TAC std_ss [MEASURE_SPACE_REDUCE]
5573QED
5574
5575Theorem measure_space_eq_sym_eq :
5576 !M N. measure_space_eq M N <=> measure_space_eq N M
5577Proof
5578 METIS_TAC [measure_space_eq_comm]
5579QED
5580
5581Theorem measure_space_eq_measure_of :
5582 !m. measure_space m ==> measure_space_eq m (measure_of m)
5583Proof
5584 rpt STRIP_TAC
5585 >> simp [measure_space_eq_def, measure_of_def]
5586 >> Know ‘measurable_sets m SUBSET POW (m_space m)’
5587 >- FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_iff2]
5588 >> DISCH_TAC
5589 >> ‘sigma_sets (m_space m) (measurable_sets m) = measurable_sets m’
5590 by METIS_TAC [sigma_sets_eq, measure_space_def]
5591 >> simp []
5592QED
5593
5594(* |- !m. measure_space m ==> measure_space_eq (measure_of m) m *)
5595Theorem measure_space_eq_measure_of' =
5596 measure_space_eq_measure_of |> ONCE_REWRITE_RULE [measure_space_eq_sym_eq]
5597
5598Theorem sets_eq_imp_space_eq :
5599 !M M'. measure_space M /\ measure_space M' /\
5600 (measurable_sets M = measurable_sets M') ==> (m_space M = m_space M')
5601Proof
5602 REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN
5603 FIRST_ASSUM (MP_TAC o MATCH_MP MEASURE_SPACE_MSPACE_MEASURABLE) THEN
5604 POP_ASSUM (MP_TAC o REWRITE_RULE [measure_space_def, sigma_algebra_alt_pow]) THEN
5605 FIRST_ASSUM (MP_TAC o MATCH_MP MEASURE_SPACE_MSPACE_MEASURABLE) THEN
5606 POP_ASSUM (MP_TAC o REWRITE_RULE [measure_space_def, sigma_algebra_alt_pow]) THEN
5607 REPEAT STRIP_TAC THEN FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_POW] THEN
5608 ASM_SET_TAC []
5609QED
5610
5611(* Any sigma-algebra induce a trivial (sigma-finite) measure space with (\s. 0) *)
5612Theorem measure_space_trivial :
5613 !a. sigma_algebra a ==> sigma_finite_measure_space (space a,subsets a,(\s. 0))
5614Proof
5615 rpt STRIP_TAC
5616 >> simp [sigma_finite_measure_space_def]
5617 >> STRONG_CONJ_TAC
5618 >- (rw [measure_space_def] >| (* 2 subgoals *)
5619 [ (* goal 1 (of 2) *)
5620 rw [positive_def],
5621 (* goal 2 (of 2) *)
5622 rw [countably_additive_def, o_DEF, ext_suminf_0] ])
5623 >> DISCH_TAC
5624 >> MATCH_MP_TAC FINITE_IMP_SIGMA_FINITE
5625 >> rw [extreal_of_num_def, extreal_not_infty]
5626QED
5627
5628Theorem measure_space_trivial' :
5629 !a. sigma_algebra a ==> measure_space (space a,subsets a,(\s. 0))
5630Proof
5631 rpt STRIP_TAC
5632 >> drule measure_space_trivial
5633 >> rw [sigma_finite_measure_space_def]
5634QED
5635
5636(* NOTE: added `measure p (BIGUNION (IMAGE A UNIV)) < PosInf` into antecendents,
5637 this is weaker than `measure p (m_space p) < PosInf` *)
5638Theorem measure_limsup :
5639 !p A. measure_space p /\ measure p (BIGUNION (IMAGE A UNIV)) < PosInf /\
5640 (!n. A n IN measurable_sets p) ==>
5641 (measure p (limsup A) =
5642 inf (IMAGE (\m. measure p (BIGUNION {A n | m <= n})) UNIV))
5643Proof
5644 RW_TAC std_ss []
5645 >> Know `(\m. measure p (BIGUNION {A n | m <= n})) =
5646 measure p o (\m. BIGUNION {A n | m <= n})`
5647 >- (FUN_EQ_TAC >> RW_TAC std_ss [o_DEF])
5648 >> Rewr'
5649 >> Suff `inf (IMAGE (measure p o (\m. BIGUNION {A n | m <= n})) UNIV) =
5650 measure p (BIGINTER (IMAGE (\m. BIGUNION {A n | m <= n}) UNIV))`
5651 >- (Rewr' >> REWRITE_TAC [set_limsup_def])
5652 >> MATCH_MP_TAC MONOTONE_CONVERGENCE_BIGINTER2
5653 >> Know `!m. BIGUNION {A n | m <= n} IN measurable_sets p`
5654 >- (GEN_TAC \\
5655 fs [measure_space_def, sigma_algebra_def, space_def, subsets_def] \\
5656 FIRST_X_ASSUM MATCH_MP_TAC \\
5657 RW_TAC std_ss [tail_countable, SUBSET_DEF, GSPECIFICATION] >> art [])
5658 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV] (* 2 subgoals *)
5659 >| [ (* goal 1 (of 2) *)
5660 REWRITE_TAC [lt_infty] \\
5661 MATCH_MP_TAC let_trans \\
5662 Q.EXISTS_TAC `measure p (BIGUNION (IMAGE A UNIV))` >> art [] \\
5663 MATCH_MP_TAC INCREASING >> art [] \\
5664 CONJ_TAC >- PROVE_TAC [MEASURE_SPACE_INCREASING] \\
5665 CONJ_TAC
5666 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV, IN_BIGUNION,
5667 GSPECIFICATION] \\
5668 Q.EXISTS_TAC `n'` >> art []) \\
5669 POP_ASSUM (ASSUME_TAC o (Q.SPEC `0`)) \\
5670 Suff `BIGUNION (IMAGE A UNIV) = BIGUNION {A n | 0 <= n}`
5671 >- DISCH_THEN (ASM_REWRITE_TAC o wrap) \\
5672 RW_TAC arith_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV, IN_BIGUNION,
5673 GSPECIFICATION] \\
5674 EQ_TAC >> RW_TAC std_ss [] >| (* 3 subgoals *)
5675 [ Q.EXISTS_TAC `A x'` >> art [] \\
5676 Q.EXISTS_TAC `x'` >> REWRITE_TAC [],
5677 Q.EXISTS_TAC `n` >> art [] ],
5678 (* goal 2 (of 2) *)
5679 RW_TAC arith_ss [SUBSET_DEF, IN_BIGUNION, GSPECIFICATION] \\
5680 Q.EXISTS_TAC `A n'` >> art [] \\
5681 Q.EXISTS_TAC `n'` >> RW_TAC arith_ss [] ]
5682QED
5683
5684Theorem measure_limsup_finite :
5685 !p A. measure_space p /\ measure p (m_space p) < PosInf /\
5686 (!n. A n IN measurable_sets p) ==>
5687 measure p (limsup A) =
5688 inf (IMAGE (\m. measure p (BIGUNION {A n | m <= n})) UNIV)
5689Proof
5690 RW_TAC std_ss []
5691 >> Know `(\m. measure p (BIGUNION {A n | m <= n})) =
5692 measure p o (\m. BIGUNION {A n | m <= n})`
5693 >- (FUN_EQ_TAC >> RW_TAC std_ss [o_DEF])
5694 >> Rewr'
5695 >> Suff `inf (IMAGE (measure p o (\m. BIGUNION {A n | m <= n})) UNIV) =
5696 measure p (BIGINTER (IMAGE (\m. BIGUNION {A n | m <= n}) UNIV))`
5697 >- (Rewr' >> REWRITE_TAC [set_limsup_def])
5698 >> MATCH_MP_TAC MONOTONE_CONVERGENCE_BIGINTER2
5699 >> Know `!m. BIGUNION {A n | m <= n} IN measurable_sets p`
5700 >- (GEN_TAC \\
5701 fs [measure_space_def, sigma_algebra_def, space_def, subsets_def] \\
5702 FIRST_X_ASSUM MATCH_MP_TAC \\
5703 RW_TAC std_ss [tail_countable, SUBSET_DEF, GSPECIFICATION] >> art [])
5704 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV] (* 2 subgoals *)
5705 >| [ (* goal 1 (of 2) *)
5706 REWRITE_TAC [lt_infty] \\
5707 MATCH_MP_TAC let_trans >> Q.EXISTS_TAC `measure p (m_space p)` \\
5708 reverse CONJ_TAC >- art [] \\
5709 MATCH_MP_TAC INCREASING >> art [] \\
5710 CONJ_TAC >- PROVE_TAC [MEASURE_SPACE_INCREASING] \\
5711 fs [measure_space_def, sigma_algebra_def, space_def, subsets_def] \\
5712 reverse CONJ_TAC >- PROVE_TAC [ALGEBRA_SPACE, space_def, subsets_def] \\
5713 METIS_TAC [algebra_def, subset_class_def, space_def, subsets_def],
5714 (* goal 2 (of 2) *)
5715 RW_TAC arith_ss [SUBSET_DEF, IN_BIGUNION, GSPECIFICATION] \\
5716 Q.EXISTS_TAC `A n'` >> art [] \\
5717 Q.EXISTS_TAC `n'` >> RW_TAC arith_ss [] ]
5718QED
5719
5720Theorem measure_liminf :
5721 !p A. measure_space p /\ (!n. A n IN measurable_sets p) ==>
5722 measure p (liminf A) =
5723 sup (IMAGE (\m. measure p (BIGINTER {A n | m <= n})) UNIV)
5724Proof
5725 RW_TAC std_ss []
5726 >> Know `(\m. measure p (BIGINTER {A n | m <= n})) =
5727 measure p o (\m. BIGINTER {A n | m <= n})`
5728 >- (FUN_EQ_TAC >> RW_TAC std_ss [o_DEF]) >> Rewr'
5729 >> Suff `sup (IMAGE (measure p o (\m. BIGINTER {A n | m <= n})) UNIV) =
5730 measure p (BIGUNION (IMAGE (\m. BIGINTER {A n | m <= n}) UNIV))`
5731 >- (Rewr' >> REWRITE_TAC [set_liminf_def])
5732 >> MATCH_MP_TAC MONOTONE_CONVERGENCE2
5733 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV] (* 2 subgoals *)
5734 >| [ (* goal 1 (of 2) *)
5735 Know `{A n | m <= n} <> {}` >- METIS_TAC [tail_not_empty] \\
5736 Know `countable {A n | m <= n}` >- METIS_TAC [tail_countable] \\
5737 RW_TAC std_ss [COUNTABLE_ENUM] >> art [] \\
5738 MATCH_MP_TAC MEASURE_SPACE_BIGINTER >> art [] \\
5739 Q.PAT_X_ASSUM `{A n | m <= n} = X` (MP_TAC o (MATCH_MP EQ_SYM)) \\
5740 RW_TAC std_ss [Once EXTENSION, IN_IMAGE, IN_UNIV, GSPECIFICATION] \\
5741 POP_ASSUM (STRIP_ASSUME_TAC o (Q.SPEC `f (n :num)`)) \\
5742 Know `?x'. f n = f x'` >- (Q.EXISTS_TAC `n` >> REWRITE_TAC []) \\
5743 RW_TAC std_ss [] >> PROVE_TAC [],
5744 (* goal 2 (of 2) *)
5745 RW_TAC arith_ss [SUBSET_DEF, IN_BIGINTER, GSPECIFICATION] \\
5746 FIRST_X_ASSUM MATCH_MP_TAC \\
5747 Q.EXISTS_TAC `n'` >> RW_TAC arith_ss [] ]
5748QED
5749
5750(* An extended version of `limsup_suminf_indicator` (now removed) with spaces *)
5751Theorem limsup_suminf_indicator_space :
5752 !a A. sigma_algebra a /\ (!n. A n IN subsets a) ==>
5753 limsup A =
5754 {x | x IN space a /\ (suminf (\n. indicator_fn (A n) x) = PosInf)}
5755Proof
5756 RW_TAC std_ss [EXTENSION, IN_LIMSUP, GSPECIFICATION, indicator_fn_def]
5757 >> `(?N. INFINITE N /\ !n. n IN N ==> x IN A n) = ~(?m. !n. m <= n ==> x NOTIN A n)`
5758 by METIS_TAC [Q.SPEC `\n. x IN A n` infinitely_often_lemma]
5759 >> POP_ORW
5760 >> Suff `(?m. !n. m <= n ==> x NOTIN A n) <=>
5761 (x IN space a ==> suminf (\n. if x IN A n then 1 else 0) <> PosInf)`
5762 >- METIS_TAC []
5763 >> EQ_TAC (* 2 subgoals *)
5764 >| [ (* goal 1 (of 2) *)
5765 NTAC 2 STRIP_TAC \\
5766 Know `suminf (\n. if x IN A n then 1 else 0) =
5767 SIGMA (\n. if x IN A n then 1 else 0) (count m)`
5768 >- (MATCH_MP_TAC ext_suminf_sum \\
5769 RW_TAC std_ss [le_01, le_refl]) >> Rewr' \\
5770 MATCH_MP_TAC EXTREAL_SUM_IMAGE_NOT_POSINF \\
5771 RW_TAC std_ss [FINITE_COUNT, IN_COUNT, extreal_of_num_def, extreal_not_infty],
5772 (* goal 2 (of 2) *)
5773 Suff `~(?m. !n. m <= n ==> x NOTIN A n) ==>
5774 (x IN space a /\ (suminf (\n. if x IN A n then 1 else 0) = PosInf))`
5775 >- METIS_TAC [] \\
5776 DISCH_TAC \\
5777 CONJ_TAC
5778 >- (fs [SKOLEM_THM, sigma_algebra_def, algebra_def, subset_class_def] \\
5779 PROVE_TAC [SUBSET_DEF]) \\
5780 MATCH_MP_TAC ext_suminf_eq_infty \\
5781 CONJ_TAC >- RW_TAC std_ss [le_01, le_refl] \\
5782 RW_TAC std_ss [] >> fs [] \\
5783 Cases_on `e <= 0`
5784 >- (Q.EXISTS_TAC `0` \\
5785 ASM_SIMP_TAC std_ss [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY]) \\
5786 fs [GSYM extreal_lt_def] \\
5787 `e <> NegInf /\ e <> PosInf`
5788 by PROVE_TAC [lt_imp_le, pos_not_neginf, lt_infty] \\
5789 `?r. Normal r = e` by PROVE_TAC [extreal_cases] \\
5790 fs [SKOLEM_THM] \\ (* n = f m *)
5791 STRIP_ASSUME_TAC (Q.SPEC `r` SIMP_REAL_ARCH) \\
5792 `e <= Normal (&n)` by PROVE_TAC [extreal_le_eq] \\
5793 fs [GSYM extreal_of_num_def] \\
5794 Know `!N. ?n. &N <= SIGMA (\n. if x IN A n then 1 else 0) (count n)`
5795 >- (Induct
5796 >- (Q.EXISTS_TAC `0` \\
5797 SIMP_TAC std_ss [COUNT_ZERO, EXTREAL_SUM_IMAGE_EMPTY, le_refl]) \\
5798 POP_ASSUM STRIP_ASSUME_TAC \\
5799 `n' <= f n' /\ x IN A (f n')` by PROVE_TAC [] \\
5800 `0 <= f n' - n'` by RW_TAC arith_ss [] \\
5801 Q.EXISTS_TAC `SUC (f n')` \\
5802 Know `count (SUC (f n')) = count n' UNION {x | n' <= x /\ x <= f n'}`
5803 >- (RW_TAC arith_ss [EXTENSION, IN_COUNT, IN_UNION, GSPECIFICATION]) \\
5804 Rewr' \\
5805 Know `DISJOINT (count n') {x | n' <= x /\ x <= f n'}`
5806 >- (RW_TAC arith_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_COUNT,
5807 GSPECIFICATION, IN_INTER]) >> DISCH_TAC \\
5808 Know `SIGMA (\n. if x IN A n then 1 else 0)
5809 (count n' UNION {x | n' <= x /\ x <= f n'}) =
5810 SIGMA (\n. if x IN A n then 1 else 0) (count n') +
5811 SIGMA (\n. if x IN A n then 1 else 0) {x | n' <= x /\ x <= f n'}`
5812 >- (irule EXTREAL_SUM_IMAGE_DISJOINT_UNION >> art [FINITE_COUNT] \\
5813 CONJ_TAC >- (MATCH_MP_TAC SUBSET_FINITE_I \\
5814 Q.EXISTS_TAC `count (SUC (f n'))` >> art [FINITE_COUNT] \\
5815 RW_TAC arith_ss [SUBSET_DEF, IN_COUNT, GSPECIFICATION]) \\
5816 DISJ2_TAC \\
5817 RW_TAC std_ss [extreal_of_num_def, extreal_not_infty]) >> Rewr' \\
5818 Know `&SUC N = &N + &1`
5819 >- (SIMP_TAC real_ss [extreal_of_num_def, extreal_add_def, extreal_11]) \\
5820 Rewr' \\
5821 MATCH_MP_TAC le_add2 >> art [] \\
5822 Know `{f n'} SUBSET {x | n' <= x /\ x <= f n'}`
5823 >- (RW_TAC arith_ss [SUBSET_DEF, IN_SING, GSPECIFICATION]) >> DISCH_TAC \\
5824 Know `SIGMA (\n. if x IN A n then 1 else 0) {f n'} = 1`
5825 >- (ASM_SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_SING]) \\
5826 DISCH_THEN
5827 ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites)
5828 o wrap o SYM) \\
5829 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET \\
5830 RW_TAC std_ss [FINITE_SING, le_01, le_refl] \\
5831 MATCH_MP_TAC SUBSET_FINITE_I \\
5832 Q.EXISTS_TAC `count (SUC (f n'))` >> art [FINITE_COUNT] \\
5833 RW_TAC arith_ss [SUBSET_DEF, IN_COUNT, GSPECIFICATION]) \\
5834 DISCH_THEN (STRIP_ASSUME_TAC o (Q.SPEC `n`)) \\
5835 Q.EXISTS_TAC `n'` \\
5836 MATCH_MP_TAC le_trans >> Q.EXISTS_TAC `&n` >> art [] ]
5837QED
5838
5839(* ------------------------------------------------------------------------- *)
5840(* Radon-Nikodym Related Definitions *)
5841(* ------------------------------------------------------------------------- *)
5842
5843(* v is absolutely continuous w.r.t. m, denoted by ``v << m``
5844
5845 NOTE: the type of `v` is not `:'a m_space` but `:'a measure`, to simplify
5846 the statements of Radon-Nikodym theorems as much as possible.
5847 *)
5848Definition measure_absolutely_continuous_def:
5849 measure_absolutely_continuous v m =
5850 !s. s IN measurable_sets m /\ (measure m s = 0) ==> (v s = 0)
5851End
5852
5853(* "<<" is already used in "src/n-bit/wordsScript.sml", same priority here *)
5854val _ = set_fixity "<<" (Infixl 680);
5855val _ = Unicode.unicode_version {u = Unicode.UChar.lsl, tmnm = "<<"};
5856
5857(* aligned with wordsTheory *)
5858val _ = TeX_notation {hol = "<<", TeX = ("\\HOLTokenLsl{}", 2)};
5859val _ = TeX_notation {hol = Unicode.UChar.lsl, TeX = ("\\HOLTokenLsl{}", 2)};
5860
5861Overload "<<" = ``measure_absolutely_continuous``
5862
5863(* backward compatible with HVG's original definition, see also RN_deriv' *)
5864Overload measure_absolutely_continuous' = “\N M. measure N << M”
5865
5866(* NOTE: changed the universal quantifier ‘I’ to ‘J’ *)
5867Theorem measure_subadditive_finite :
5868 !J A M. measure_space M /\ FINITE J /\
5869 IMAGE A J SUBSET measurable_sets M ==>
5870 measure M (BIGUNION {A i | (i:num) IN J}) <=
5871 SIGMA (\i. measure M (A i)) J
5872Proof
5873 RW_TAC std_ss [] THEN NTAC 2 (POP_ASSUM MP_TAC) THEN
5874 qid_spec_tac ‘J’ THEN SET_INDUCT_TAC THEN1
5875 (SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_EMPTY, NOT_IN_EMPTY] THEN
5876 REWRITE_TAC [SET_RULE ``{A i | i | F} = {}``] THEN
5877 FULL_SIMP_TAC std_ss [BIGUNION_EMPTY, measure_space_def, positive_def] THEN
5878 SIMP_TAC std_ss [le_refl]) THEN
5879 REWRITE_TAC [SET_RULE ``BIGUNION {A i | i IN e INSERT s} =
5880 BIGUNION {A i | i IN s} UNION A e``] THEN
5881 DISCH_TAC THEN MATCH_MP_TAC le_trans THEN
5882 Q.EXISTS_TAC `measure M (BIGUNION {A i | i IN s}) + measure M (A e)` THEN
5883 CONJ_TAC THEN1
5884 (Know `measure M (BIGUNION {A i | i IN s} UNION A e) =
5885 measure M (BIGUNION {A i | i IN s}) +
5886 measure M (A e DIFF BIGUNION {A i | i IN s})` THEN1
5887 (MATCH_MP_TAC ADDITIVE THEN
5888 ASM_SIMP_TAC std_ss [MEASURE_SPACE_ADDITIVE] THEN
5889 REPEAT CONJ_TAC THENL (* 5 subgoals *)
5890 [(* goal 1 (of 5) *)
5891 ONCE_REWRITE_TAC [METIS [subsets_def]
5892 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
5893 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
5894 FULL_SIMP_TAC std_ss [measure_space_def] THEN
5895 CONJ_TAC >- (SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
5896 MATCH_MP_TAC image_countable THEN
5897 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM]) THEN
5898 SIMP_TAC std_ss [GSYM IMAGE_DEF, SUBSET_DEF, IN_IMAGE, subsets_def,
5899 GSPECIFICATION] THEN
5900 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN ASM_SET_TAC [],
5901 (* goal 2 (of 5) *)
5902 ONCE_REWRITE_TAC [METIS [subsets_def]
5903 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
5904 MATCH_MP_TAC ALGEBRA_DIFF THEN
5905 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def] THEN
5906 SIMP_TAC std_ss [subsets_def] THEN CONJ_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
5907 ONCE_REWRITE_TAC [METIS [subsets_def]
5908 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
5909 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
5910 FULL_SIMP_TAC std_ss [sigma_algebra_def] THEN
5911 CONJ_TAC THENL [SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
5912 MATCH_MP_TAC image_countable THEN
5913 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM], ALL_TAC] THEN
5914 SIMP_TAC std_ss [GSYM IMAGE_DEF, SUBSET_DEF, IN_IMAGE, subsets_def,
5915 GSPECIFICATION] THEN
5916 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN ASM_SET_TAC [],
5917 (* goal 3 of 5) *)
5918 ASM_SIMP_TAC std_ss [DISJOINT_DEF] THEN SET_TAC [],
5919 (* goal 4 of 5) *)
5920 FULL_SIMP_TAC std_ss [IMAGE_INSERT] \\
5921 `A e IN measurable_sets M` by ASM_SET_TAC [] \\
5922 `IMAGE A s SUBSET measurable_sets M` by ASM_SET_TAC [] \\
5923 ONCE_REWRITE_TAC [METIS [subsets_def]
5924 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] \\
5925 MATCH_MP_TAC ALGEBRA_UNION \\
5926 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def] \\
5927 `{A i | i IN s} = IMAGE A s` by SET_TAC [] >> POP_ORW \\
5928 reverse CONJ_TAC >- FULL_SIMP_TAC std_ss [subsets_def] \\
5929 MATCH_MP_TAC ALGEBRA_FINITE_UNION \\
5930 FULL_SIMP_TAC std_ss [IMAGE_FINITE, subsets_def],
5931 (* goal 5 of 5) *)
5932 SET_TAC [] ]) THEN DISC_RW_KILL THEN
5933 MATCH_MP_TAC le_ladd_imp THEN MATCH_MP_TAC INCREASING THEN
5934 ASM_SIMP_TAC std_ss [MEASURE_SPACE_INCREASING] THEN
5935 CONJ_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
5936 CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC []] THEN
5937 ONCE_REWRITE_TAC [METIS [subsets_def]
5938 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
5939 MATCH_MP_TAC ALGEBRA_DIFF THEN
5940 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def] THEN
5941 CONJ_TAC THENL [ASM_SET_TAC [subsets_def], ALL_TAC] THEN
5942 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
5943 FULL_SIMP_TAC std_ss [sigma_algebra_def] THEN
5944 CONJ_TAC THENL [SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
5945 MATCH_MP_TAC image_countable THEN
5946 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM], ALL_TAC] THEN
5947 SIMP_TAC std_ss [GSYM IMAGE_DEF, SUBSET_DEF, IN_IMAGE, subsets_def,
5948 GSPECIFICATION] THEN
5949 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN ASM_SET_TAC [] ) THEN
5950 Suff `SIGMA (\i. measure M (A i)) (e INSERT s) =
5951 SIGMA (\i. measure M (A i)) (s DELETE e) + (\i. measure M (A i)) e` THENL
5952 [DISC_RW_KILL THEN SIMP_TAC std_ss [] THEN MATCH_MP_TAC le_radd_imp THEN
5953 ASM_SIMP_TAC std_ss [SET_RULE ``e NOTIN s ==> (s DELETE e = s)``] THEN
5954 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SET_TAC [],
5955 ALL_TAC] THEN
5956 ASM_CASES_TAC ``!x:num. x IN e INSERT s ==>
5957 ((\i. measure M (A i)) x <> PosInf)`` THENL
5958 [`(\i. measure M (A i)) e <> PosInf`
5959 by (FIRST_ASSUM MATCH_MP_TAC THEN ASM_SET_TAC []) THEN
5960 `SIGMA (\i. measure M (A i)) (s DELETE e) <> PosInf`
5961 by (MATCH_MP_TAC EXTREAL_SUM_IMAGE_NOT_POSINF THEN
5962 ASM_SIMP_TAC std_ss [SET_RULE ``e NOTIN s ==> (s DELETE e = s)``] THEN
5963 ASM_SET_TAC []) THEN
5964 `SIGMA (\i. measure M (A i)) (s DELETE e) + (\i. measure M (A i)) e =
5965 (\i. measure M (A i)) e + SIGMA (\i. measure M (A i)) (s DELETE e)`
5966 by METIS_TAC [add_comm] THEN ONCE_ASM_REWRITE_TAC [] THEN
5967 FIRST_ASSUM (ASSUME_TAC o MATCH_MP EXTREAL_SUM_IMAGE_PROPERTY_POS) THEN
5968 POP_ASSUM MATCH_MP_TAC THEN FULL_SIMP_TAC std_ss [],
5969 ALL_TAC] THEN FULL_SIMP_TAC std_ss [] THEN
5970 Suff `!x. x IN s ==>
5971 (\i. measure M (A i)) x <= SIGMA (\i. measure M (A i)) s` THENL
5972 [DISCH_TAC,
5973 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS_MEM_LE THEN RW_TAC std_ss [] THEN
5974 FIRST_ASSUM (ASSUME_TAC o MATCH_MP MEASURE_SPACE_POSITIVE) THEN
5975 FULL_SIMP_TAC std_ss [positive_def] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5976 ASM_SET_TAC []] THEN
5977 Suff `!x. x IN (e INSERT s) ==>
5978 (\i. measure M (A i)) x <= SIGMA (\i. measure M (A i)) (e INSERT s)` THENL
5979 [DISCH_TAC,
5980 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS_MEM_LE THEN RW_TAC std_ss [FINITE_INSERT] THEN
5981 FIRST_ASSUM (ASSUME_TAC o MATCH_MP MEASURE_SPACE_POSITIVE) THEN
5982 FULL_SIMP_TAC std_ss [positive_def] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5983 ASM_SET_TAC []] THEN
5984 POP_ASSUM (MP_TAC o Q.SPEC `x`) THEN ASM_SIMP_TAC std_ss [le_infty] THEN
5985 DISCH_TAC THEN UNDISCH_TAC ``(x:num) IN e INSERT s`` THEN
5986 Suff `SIGMA (\i. measure M (A i)) (s DELETE e) <> NegInf` THENL
5987 [DISCH_TAC,
5988 MATCH_MP_TAC EXTREAL_SUM_IMAGE_NOT_NEGINF THEN
5989 ASM_SIMP_TAC std_ss [SET_RULE ``e NOTIN s ==> (s DELETE e = s)``] THEN
5990 RW_TAC std_ss [lt_infty] THEN MATCH_MP_TAC lte_trans THEN
5991 Q.EXISTS_TAC `0` THEN SIMP_TAC std_ss [GSYM lt_infty, num_not_infty] THEN
5992 FIRST_ASSUM (ASSUME_TAC o MATCH_MP MEASURE_SPACE_POSITIVE) THEN
5993 FULL_SIMP_TAC std_ss [positive_def] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5994 ASM_SET_TAC []] THEN
5995 RW_TAC std_ss [INSERT_DEF, GSPECIFICATION] THENL
5996 [ASM_REWRITE_TAC [] THEN
5997 ASM_CASES_TAC ``SIGMA (\i:num. measure M (A i)) (s DELETE e) = PosInf`` THENL
5998 [FULL_SIMP_TAC std_ss [extreal_add_def], ALL_TAC] THEN
5999 METIS_TAC [normal_real, extreal_add_def],
6000 ALL_TAC] THEN
6001 FIRST_X_ASSUM (MP_TAC o Q.SPEC `x`) THEN ASM_SIMP_TAC std_ss [le_infty] THEN
6002 ASM_SIMP_TAC std_ss [SET_RULE ``e NOTIN s ==> (s DELETE e = s)``] THEN
6003 DISCH_TAC THEN Suff `measure M (A e) <> NegInf` THENL
6004 [DISCH_TAC,
6005 RW_TAC std_ss [lt_infty] THEN MATCH_MP_TAC lte_trans THEN
6006 Q.EXISTS_TAC `0` THEN SIMP_TAC std_ss [GSYM lt_infty, num_not_infty] THEN
6007 FIRST_ASSUM (ASSUME_TAC o MATCH_MP MEASURE_SPACE_POSITIVE) THEN
6008 FULL_SIMP_TAC std_ss [positive_def] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6009 ASM_SET_TAC []] THEN
6010 ASM_CASES_TAC ``measure M (A (e:num)) = PosInf`` THENL
6011 [FULL_SIMP_TAC std_ss [extreal_add_def], ALL_TAC] THEN
6012 METIS_TAC [normal_real, extreal_add_def]
6013QED
6014
6015(* A0 and B (all djsjoint) are in measurable_sets M, together `m_space M`.
6016
6017 `measure N (B i) <> PosInf` although `measure N (m_space M) = PosInf`,
6018 i.e. `m_space M` is splited with all infinite measures only in A0.
6019 *)
6020Theorem split_space_into_finite_sets_and_rest :
6021 !M N. measure_space M /\ measure_space N /\
6022 m_space M = m_space N /\
6023 measurable_sets M = measurable_sets N /\
6024 measure M (m_space M) <> PosInf /\
6025 measure_absolutely_continuous (measure N) M ==>
6026 ?A0 B. A0 IN measurable_sets M /\ disjoint_family B /\
6027 IMAGE B univ(:num) SUBSET measurable_sets M /\
6028 (A0 = m_space M DIFF BIGUNION {B i | i IN UNIV}) /\
6029 (!A. A IN measurable_sets M /\ A SUBSET A0 ==>
6030 (((measure M A = 0) /\ (measure N A = 0)) \/
6031 (0 < measure M A /\ (measure N A = PosInf)))) /\
6032 (!i. measure N (B i) <> PosInf)
6033Proof
6034 RW_TAC std_ss [] THEN
6035 Q.ABBREV_TAC `Q = {x | x IN measurable_sets M /\ (measure N x <> PosInf)}` THEN
6036 Q.ABBREV_TAC `a = sup {measure M x | x IN Q}` THEN
6037 Know `{} IN Q`
6038 >- (Q.UNABBREV_TAC `Q` >> RW_TAC std_ss [GSPECIFICATION] \\
6039 FULL_SIMP_TAC std_ss [measure_space_def, positive_def, num_not_infty,
6040 sigma_algebra_alt_pow]) >> DISCH_TAC \\
6041 `Q <> {}` by ASM_SET_TAC [] THEN
6042 Know `a <= measure M (m_space M)`
6043 >- (Q.UNABBREV_TAC `a` THEN REWRITE_TAC [sup_le'] THEN GEN_TAC THEN
6044 SIMP_TAC std_ss [GSPECIFICATION] THEN RW_TAC std_ss [] THEN
6045 MATCH_MP_TAC INCREASING THEN
6046 ASM_SIMP_TAC std_ss [MEASURE_SPACE_MSPACE_MEASURABLE, MEASURE_SPACE_INCREASING] THEN
6047 Q.UNABBREV_TAC `Q` THEN
6048 REV_FULL_SIMP_TAC std_ss [GSPECIFICATION, MEASURE_SPACE_SUBSET_MSPACE])
6049 THEN DISCH_TAC THEN
6050 Know `a <> PosInf`
6051 >- (Q.UNABBREV_TAC `a` THEN FULL_SIMP_TAC std_ss [lt_infty] THEN
6052 MATCH_MP_TAC let_trans THEN Q.EXISTS_TAC `measure M (m_space M)` THEN
6053 ASM_SIMP_TAC std_ss []) THEN DISCH_TAC THEN
6054 Know `?Q''. IMAGE Q'' UNIV SUBSET IMAGE (measure M) Q /\
6055 (a = sup {Q'' i | i IN univ(:num)})`
6056 >- (FIRST_ASSUM (ASSUME_TAC o MATCH_MP sup_seq_countable_seq) THEN
6057 POP_ASSUM (MP_TAC o Q.SPEC `(\x. measure M x)`) THEN STRIP_TAC THEN
6058 Q.EXISTS_TAC `f` THEN METIS_TAC []) THEN STRIP_TAC THEN
6059 Know `!i. ?Q'. (Q'' i = measure M Q') /\ Q' IN Q`
6060 >- (ASM_SET_TAC []) THEN STRIP_TAC THEN
6061 Know `?Q'. !i. (Q'' i = measure M (Q' i)) /\ Q' i IN Q`
6062 >- (METIS_TAC []) THEN STRIP_TAC THEN
6063 Know `a = sup {measure M (Q' i) | i IN univ(:num)}`
6064 >- (FULL_SIMP_TAC std_ss []) THEN DISCH_TAC THEN
6065 Q.ABBREV_TAC `D = (\n. BIGUNION {Q' i | i <= n:num})` THEN
6066 Know `sup {measure M (D i) | i IN univ(:num)} =
6067 measure M (BIGUNION {D i | i IN univ(:num)})` >-
6068 (SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
6069 MATCH_MP_TAC (REWRITE_RULE [o_DEF] MONOTONE_CONVERGENCE2) THEN
6070 ASM_REWRITE_TAC [] THEN CONJ_TAC >-
6071 (Q.UNABBREV_TAC `D` THEN SRW_TAC[] [IN_DEF, IN_FUNSET] THEN
6072 ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN RW_TAC std_ss [] THEN
6073 ONCE_REWRITE_TAC [SET_RULE ``{Q' i' | i' <= i} =
6074 IMAGE (\i':num. Q' i') {i' | i' <= i}``] THEN
6075 ONCE_REWRITE_TAC [METIS [subsets_def]
6076 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6077 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
6078 FULL_SIMP_TAC std_ss [measure_space_def] THEN
6079 CONJ_TAC >- (MATCH_MP_TAC image_countable THEN
6080 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM]) THEN
6081 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, subsets_def, GSPECIFICATION] THEN
6082 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN
6083 FIRST_X_ASSUM (MP_TAC o Q.SPEC `i'`) THEN
6084 Q.UNABBREV_TAC `Q` THEN SIMP_TAC std_ss [GSPECIFICATION] THEN METIS_TAC []) THEN
6085 Q.UNABBREV_TAC `D` THEN
6086 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION, GSPECIFICATION] THEN
6087 Q.EXISTS_TAC `Q' i` THEN ASM_REWRITE_TAC [] THEN
6088 Q.EXISTS_TAC `i` THEN ASM_SIMP_TAC arith_ss [] ) THEN DISCH_TAC THEN
6089 Know `!i. Q' i IN measurable_sets M`
6090 >- (GEN_TAC THEN FIRST_X_ASSUM (MP_TAC o Q.SPEC `i`) THEN
6091 Q.UNABBREV_TAC `Q` THEN
6092 RW_TAC std_ss [GSPECIFICATION] THEN METIS_TAC []) THEN DISCH_TAC THEN
6093 Know `!i. D i IN measurable_sets M`
6094 >- (Q.UNABBREV_TAC `D` THEN RW_TAC std_ss [] THEN
6095 ONCE_REWRITE_TAC [SET_RULE ``{Q' i' | i' <= i} =
6096 IMAGE (\i':num. Q' i') {i' | i' <= i}``] THEN
6097 ONCE_REWRITE_TAC [METIS [subsets_def]
6098 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6099 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
6100 FULL_SIMP_TAC std_ss [measure_space_def] THEN
6101 CONJ_TAC >- (MATCH_MP_TAC image_countable THEN
6102 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM]) THEN
6103 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, subsets_def, GSPECIFICATION] THEN
6104 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN METIS_TAC []) THEN
6105 DISCH_TAC THEN
6106 Know `!i. D i IN Q`
6107 >- (Know `!i. IMAGE Q' {x | x <= i} SUBSET measurable_sets M`
6108 >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE] THEN METIS_TAC []) THEN
6109 DISCH_TAC THEN
6110 Suff `!i. measure N (D i) <= SIGMA (\i. measure N (Q' i)) {x | x <= i}`
6111 >- (DISCH_TAC THEN GEN_TAC THEN qunabbrevl_tac [`D`, `Q`] THEN
6112 FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN CONJ_TAC THENL
6113 [METIS_TAC [], ALL_TAC] THEN
6114 REWRITE_TAC [lt_infty] THEN MATCH_MP_TAC let_trans THEN
6115 Q.EXISTS_TAC `SIGMA (\i. measure N (Q' i)) {x | x <= i}` THEN
6116 ASM_REWRITE_TAC [GSYM lt_infty] THEN
6117 MATCH_MP_TAC EXTREAL_SUM_IMAGE_NOT_POSINF THEN
6118 SIMP_TAC std_ss [FINITE_NUMSEG_LE, GSPECIFICATION] THEN
6119 GEN_TAC THEN DISCH_TAC THEN
6120 Q.PAT_X_ASSUM `!i. (Q'' i = measure M (Q' i)) /\ _` MP_TAC THEN
6121 DISCH_THEN (MP_TAC o Q.SPEC `x`) THEN SIMP_TAC std_ss []) THEN
6122 GEN_TAC THEN Q.UNABBREV_TAC `D` THEN BETA_TAC THEN
6123 ONCE_REWRITE_TAC [SET_RULE ``(BIGUNION {Q' i' | i' <= i:num}) =
6124 (BIGUNION {Q' i' | i' IN {x | x <= i}})``] THEN
6125 MATCH_MP_TAC measure_subadditive_finite THEN
6126 ASM_SIMP_TAC std_ss [FINITE_NUMSEG_LE] THEN METIS_TAC []) THEN DISCH_TAC THEN
6127 Know `!n. D n SUBSET D (SUC n)`
6128 >- (Q.UNABBREV_TAC `D` THEN
6129 GEN_TAC THEN SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION] THEN
6130 GEN_TAC THEN SIMP_TAC std_ss [GSPECIFICATION] THEN STRIP_TAC THEN
6131 Q.EXISTS_TAC `Q' i` THEN FULL_SIMP_TAC std_ss [] THEN
6132 Q.EXISTS_TAC `i` THEN FULL_SIMP_TAC arith_ss []) THEN DISCH_TAC THEN
6133 Know `a = measure M (BIGUNION {D i | i IN univ(:num)})`
6134 >- (REWRITE_TAC [GSYM le_antisym] THEN CONJ_TAC >-
6135 (ASM_REWRITE_TAC [sup_le'] THEN GEN_TAC THEN
6136 SIMP_TAC std_ss [GSPECIFICATION] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN
6137 MATCH_MP_TAC INCREASING THEN ASM_SIMP_TAC std_ss [MEASURE_SPACE_INCREASING] THEN
6138 reverse CONJ_TAC
6139 >- (ONCE_REWRITE_TAC [METIS [subsets_def]
6140 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6141 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
6142 FULL_SIMP_TAC std_ss [measure_space_def, GSYM IMAGE_DEF] THEN
6143 CONJ_TAC THENL [MATCH_MP_TAC image_countable THEN
6144 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM], ALL_TAC] THEN
6145 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, subsets_def, GSPECIFICATION] THEN
6146 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN METIS_TAC []) \\
6147 Q.UNABBREV_TAC `D` THEN
6148 SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, GSPECIFICATION] THEN
6149 GEN_TAC THEN STRIP_TAC THEN
6150 Q.EXISTS_TAC `BIGUNION {Q' x | x <= i}` THEN
6151 CONJ_TAC THENL [ALL_TAC, METIS_TAC [IN_UNIV]] THEN
6152 ASM_SIMP_TAC arith_ss [IN_BIGUNION, GSPECIFICATION] THEN
6153 Q.EXISTS_TAC `Q' i` THEN METIS_TAC [LESS_OR_EQ]) THEN
6154 UNDISCH_TAC ``sup {measure M (D i) | i IN univ(:num)} =
6155 measure M (BIGUNION {D i | i IN univ(:num)})`` THEN
6156 GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN SIMP_TAC std_ss [] THEN DISCH_TAC THEN
6157 Suff `!n. BIGUNION {Q' i | i <= n} = D n` THENL
6158 [DISCH_TAC, METIS_TAC []] THEN
6159 Suff `!n. ?x. x IN Q /\ measure M (BIGUNION {Q' i | i <= n}) <= measure M x` THENL
6160 [DISCH_TAC,
6161 GEN_TAC THEN Q.EXISTS_TAC `D n` THEN ASM_SIMP_TAC std_ss [le_refl]] THEN
6162 Q.UNABBREV_TAC `a` THEN SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
6163 MATCH_MP_TAC sup_le_sup_imp THEN GEN_TAC THEN
6164 GEN_REWR_TAC LAND_CONV [GSYM SPECIFICATION] THEN
6165 SIMP_TAC std_ss [IN_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN
6166 FIRST_X_ASSUM (MP_TAC o Q.SPEC `i`) THEN STRIP_TAC THEN
6167 Q.EXISTS_TAC `measure M x'` THEN
6168 Q.UNABBREV_TAC `D` THEN BETA_TAC THEN ASM_REWRITE_TAC [] THEN
6169 ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN SIMP_TAC std_ss [IN_IMAGE] THEN
6170 METIS_TAC [] ) THEN DISCH_TAC THEN
6171 Q.ABBREV_TAC `O_o = BIGUNION {(D:num->'a->bool) i | i IN UNIV}` THEN
6172 Know `O_o IN measurable_sets M`
6173 >- (Q.UNABBREV_TAC `O_o` THEN
6174 ONCE_REWRITE_TAC [METIS [subsets_def]
6175 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6176 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
6177 FULL_SIMP_TAC std_ss [measure_space_def, GSYM IMAGE_DEF] THEN
6178 CONJ_TAC THENL [MATCH_MP_TAC image_countable THEN
6179 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM], ALL_TAC] THEN
6180 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, subsets_def, GSPECIFICATION] THEN
6181 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN METIS_TAC []) THEN
6182 DISCH_TAC THEN
6183 Q.ABBREV_TAC `(QQ) = (\i. if i = 0 then (Q':num->'a->bool) 0
6184 else D i DIFF (D:num->'a->bool) (i - 1))` THEN
6185 Know `!i. QQ i IN measurable_sets M`
6186 >- (GEN_TAC THEN ASM_CASES_TAC ``i = 0:num``
6187 >- (Q.UNABBREV_TAC `QQ` THEN ASM_SIMP_TAC std_ss [] THEN
6188 METIS_TAC []) THEN
6189 Know `?n. i = SUC n`
6190 >- (Q.EXISTS_TAC `PRE i` THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
6191 REWRITE_TAC [GSYM SUC_PRE] THEN ASM_SIMP_TAC arith_ss []) THEN
6192 STRIP_TAC THEN ASM_REWRITE_TAC [] THEN
6193 Q.UNABBREV_TAC `QQ` THEN ASM_SIMP_TAC arith_ss [] THEN
6194 ONCE_REWRITE_TAC [METIS [subsets_def]
6195 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6196 MATCH_MP_TAC ALGEBRA_DIFF THEN SIMP_TAC std_ss [subsets_def] THEN
6197 CONJ_TAC THENL [ALL_TAC, METIS_TAC []] THEN
6198 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def]) THEN
6199 DISCH_TAC THEN
6200 Q.EXISTS_TAC `QQ` THEN CONJ_TAC THENL
6201 [ONCE_REWRITE_TAC [METIS [subsets_def]
6202 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6203 MATCH_MP_TAC ALGEBRA_DIFF THEN CONJ_TAC THENL
6204 [FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def],
6205 ALL_TAC] THEN CONJ_TAC THENL
6206 [METIS_TAC [MEASURE_SPACE_MSPACE_MEASURABLE, subsets_def],
6207 ALL_TAC] THEN
6208 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION THEN
6209 FULL_SIMP_TAC std_ss [measure_space_def, GSYM IMAGE_DEF] THEN
6210 CONJ_TAC THENL [MATCH_MP_TAC image_countable THEN
6211 SIMP_TAC std_ss [pred_setTheory.COUNTABLE_NUM], ALL_TAC] THEN
6212 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, subsets_def, GSPECIFICATION] THEN
6213 GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THEN METIS_TAC [], ALL_TAC] THEN
6214 CONJ_TAC THENL
6215 [SIMP_TAC std_ss [disjoint_family_on, IN_UNIV] THEN
6216 REPEAT STRIP_TAC THEN Q.UNABBREV_TAC `QQ` THEN BETA_TAC THEN
6217 SIMP_TAC std_ss [INTER_DEF, EXTENSION, NOT_IN_EMPTY, GSPECIFICATION] THEN
6218 GEN_TAC THEN REPEAT COND_CASES_TAC THENL (* 4 subgoals *)
6219 [(* goal 1 (of 4) *)
6220 FULL_SIMP_TAC arith_ss [],
6221 (* goal 2 (of 4) *)
6222 ASM_CASES_TAC ``(x:'a) NOTIN Q' (0:num)`` THEN FULL_SIMP_TAC std_ss [] THEN
6223 `1 <= n` by ASM_SIMP_TAC arith_ss [] THEN
6224 SIMP_TAC std_ss [Abbr ‘D’, IN_DIFF, IN_BIGUNION, GSPECIFICATION] \\
6225 Cases_on `!s. x NOTIN s \/ !i. s = Q' i ==> ~(i <= n)` >- art [] \\
6226 DISJ2_TAC \\
6227 Q.EXISTS_TAC `Q' 0` >> ASM_SIMP_TAC std_ss [] \\
6228 Q.EXISTS_TAC `0` >> SIMP_TAC arith_ss [],
6229 (* goal 3 (of 4) *)
6230 ASM_CASES_TAC ``(x:'a) NOTIN Q' (0:num)`` THEN FULL_SIMP_TAC std_ss [] THEN
6231 `1 <= m` by ASM_SIMP_TAC arith_ss [] THEN
6232 SIMP_TAC std_ss [Abbr ‘D’, IN_DIFF, IN_BIGUNION, GSPECIFICATION] \\
6233 Cases_on `!s. x NOTIN s \/ !i. s = Q' i ==> ~(i <= m)` >- art [] \\
6234 DISJ2_TAC \\
6235 Q.EXISTS_TAC `Q' 0` >> ASM_SIMP_TAC std_ss [] \\
6236 Q.EXISTS_TAC `0` >> SIMP_TAC arith_ss [],
6237 (* goal 4 (of 4) *)
6238 ALL_TAC] THEN
6239 ASM_CASES_TAC ``x NOTIN (D:num->'a->bool) m DIFF D (m - 1)`` THEN
6240 FULL_SIMP_TAC std_ss [IN_DIFF] THEN
6241 ASM_CASES_TAC ``m < n:num`` THENL
6242 [ASM_CASES_TAC ``x NOTIN (D:num->'a->bool) n`` THEN ASM_SIMP_TAC std_ss [] THEN
6243 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
6244 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
6245 Q.UNABBREV_TAC `D` THEN BETA_TAC THEN
6246 SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION] THEN REPEAT STRIP_TAC THEN
6247 Q.EXISTS_TAC `s` THEN ASM_REWRITE_TAC [] THEN Q.EXISTS_TAC `i` THEN
6248 ASM_SIMP_TAC arith_ss [], ALL_TAC] THEN
6249 ASM_CASES_TAC ``x IN (D:num->'a->bool) (n - 1)`` THEN ASM_SIMP_TAC std_ss [] THEN
6250 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
6251 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
6252 SIMP_TAC std_ss [Abbr ‘D’, IN_BIGUNION, GSPECIFICATION] \\
6253 rpt STRIP_TAC \\
6254 `n < m` by FULL_SIMP_TAC arith_ss [] \\
6255 NTAC 2 (POP_ASSUM MP_TAC) \\
6256 FIRST_X_ASSUM (MP_TAC o Q.SPEC `s'`) THEN REPEAT STRIP_TAC THEN
6257 ASM_REWRITE_TAC [] THEN DISJ2_TAC THEN GEN_TAC THEN
6258 FIRST_X_ASSUM (MP_TAC o Q.SPEC `i':num`) THEN STRIP_TAC THEN
6259 ASM_REWRITE_TAC [] THEN STRIP_TAC \\
6260 FULL_SIMP_TAC arith_ss [NOT_LESS_EQUAL], ALL_TAC] THEN
6261 CONJ_TAC >- ASM_SET_TAC [] THEN
6262 reverse CONJ_TAC >-
6263 (GEN_TAC THEN Q.UNABBREV_TAC `QQ` THEN BETA_TAC THEN
6264 ASM_CASES_TAC ``i = 0:num`` THEN ASM_SIMP_TAC std_ss [] THENL
6265 [ASM_SET_TAC [], ALL_TAC] THEN
6266 SIMP_TAC std_ss [lt_infty] THEN MATCH_MP_TAC let_trans THEN
6267 Q.EXISTS_TAC `measure N (D i) - measure N (D (i - 1))` THEN
6268 CONJ_TAC THENL
6269 [SIMP_TAC std_ss [le_lt] THEN DISJ2_TAC THEN
6270 MATCH_MP_TAC MEASURE_SPACE_FINITE_DIFF_SUBSET THEN
6271 ASM_SIMP_TAC std_ss [] THEN REPEAT (CONJ_TAC THENL [ASM_SET_TAC [], ALL_TAC]) THEN
6272 CONJ_TAC THENL [METIS_TAC [ARITH_PROVE ``i <> 0 ==> (i = SUC (i - 1))``], ALL_TAC] THEN
6273 ASM_SET_TAC [], ALL_TAC] THEN
6274 REWRITE_TAC [GSYM lt_infty] THEN MATCH_MP_TAC (METIS [sub_not_infty]
6275 ``x <> PosInf /\ y <> NegInf ==> x - y <> PosInf``) THEN
6276 CONJ_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
6277 `positive N` by METIS_TAC [MEASURE_SPACE_POSITIVE] THEN
6278 FULL_SIMP_TAC std_ss [positive_def, lt_infty] THEN
6279 MATCH_MP_TAC lte_trans THEN Q.EXISTS_TAC `0` THEN
6280 SIMP_TAC std_ss [GSYM lt_infty, num_not_infty] THEN
6281 FIRST_ASSUM MATCH_MP_TAC THEN METIS_TAC [] ) THEN
6282 GEN_TAC THEN STRIP_TAC THEN
6283 ASM_CASES_TAC ``0 < measure M A ==> (measure N (A:'a->bool) <> PosInf)`` THENL
6284 [ALL_TAC, FULL_SIMP_TAC std_ss []] THEN
6285 ASM_CASES_TAC ``measure M (A:'a->bool) = 0`` THENL
6286 [FULL_SIMP_TAC std_ss [measure_absolutely_continuous_def], ALL_TAC] THEN
6287 `positive M` by METIS_TAC [MEASURE_SPACE_POSITIVE] THEN
6288 POP_ASSUM (STRIP_ASSUME_TAC o (REWRITE_RULE [positive_def])) THEN
6289 POP_ASSUM (MP_TAC o Q.SPEC `A`) THEN
6290 ASM_REWRITE_TAC [le_lt] THEN STRIP_TAC THENL [ALL_TAC, METIS_TAC []] THEN
6291 ASM_REWRITE_TAC [] THEN UNDISCH_TAC ``0 < measure M A ==> measure N A <> PosInf`` THEN
6292 ASM_REWRITE_TAC [] THEN DISCH_TAC THEN
6293 Know `measure M O_o + measure M A = measure M (O_o UNION A)` >-
6294 (ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC ADDITIVE THEN
6295 ASM_SIMP_TAC std_ss [MEASURE_SPACE_ADDITIVE, DISJOINT_DEF] THEN
6296 reverse CONJ_TAC
6297 >- (MATCH_MP_TAC MEASURE_SPACE_UNION >> rfs []) THEN
6298 Q.PAT_X_ASSUM `A SUBSET m_space N DIFF BIGUNION {QQ i | i IN univ(:num)}` MP_TAC THEN
6299 qunabbrevl_tac [`QQ`, `O_o`] THEN BETA_TAC THEN
6300 Suff `BIGUNION {D i | i IN univ(:num)} =
6301 BIGUNION {if i = 0 then Q' 0 else D i DIFF D (i - 1) | i IN univ(:num)}`
6302 >- (Rewr' >> SET_TAC []) THEN
6303 SIMP_TAC std_ss [EXTENSION, IN_BIGUNION, GSPECIFICATION, IN_UNIV] THEN
6304 GEN_TAC THEN EQ_TAC THEN STRIP_TAC
6305 >- (FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
6306 ASM_CASES_TAC ``x IN (D:num->'a->bool) 0``
6307 >- (Q.EXISTS_TAC `D 0` THEN FULL_SIMP_TAC std_ss [] THEN
6308 Q.EXISTS_TAC `0` THEN
6309 Q.UNABBREV_TAC `D` THEN SIMP_TAC std_ss [] THEN
6310 SET_TAC []) THEN
6311 Suff `?i. i <> 0 /\ x IN D i DIFF D (i - 1)` THENL
6312 [STRIP_TAC THEN Q.EXISTS_TAC `D i' DIFF D (i' - 1)` THEN
6313 ASM_REWRITE_TAC [] THEN METIS_TAC [], ALL_TAC] THEN
6314 Induct_on `i` THENL [METIS_TAC [], ALL_TAC] THEN
6315 DISCH_TAC THEN ASM_CASES_TAC ``x IN D (SUC i) DIFF ((D:num->'a->bool) i)`` THENL
6316 [Q.EXISTS_TAC `SUC i` THEN ASM_SIMP_TAC arith_ss [], ALL_TAC] THEN
6317 ASM_SET_TAC []) THEN
6318 FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
6319 ASM_CASES_TAC ``i = 0:num``
6320 >- (Q.EXISTS_TAC `Q' 0` THEN FULL_SIMP_TAC std_ss [] THEN
6321 Q.UNABBREV_TAC `D` THEN Q.EXISTS_TAC `0` THEN
6322 BETA_TAC THEN SET_TAC []) THEN
6323 FULL_SIMP_TAC std_ss [] THEN Q.EXISTS_TAC `D i` THEN CONJ_TAC THENL
6324 [ALL_TAC, METIS_TAC []] THEN
6325 ASM_SET_TAC [] ) THEN DISCH_TAC THEN
6326 Know `measure M (BIGUNION {D i | i IN univ(:num)} UNION A) =
6327 sup {measure M ((D i) UNION A) | i IN univ(:num)}` >-
6328 (SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
6329 `(\i. measure M (D i UNION A)) = measure M o (\i. (D:num->'a->bool) i UNION A)`
6330 by SIMP_TAC std_ss [o_DEF] THEN
6331 FIRST_X_ASSUM (fn th => ONCE_REWRITE_TAC [th]) THEN
6332 ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC MONOTONE_CONVERGENCE THEN
6333 ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
6334 [EVAL_TAC THEN SRW_TAC[][IN_DEF,IN_FUNSET] THEN
6335 ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN
6336 ONCE_REWRITE_TAC [METIS [subsets_def]
6337 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6338 MATCH_MP_TAC ALGEBRA_UNION THEN
6339 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def] THEN
6340 METIS_TAC [subsets_def], ALL_TAC] THEN
6341 CONJ_TAC THENL
6342 [GEN_TAC THEN MATCH_MP_TAC (SET_RULE ``a SUBSET c /\ b SUBSET d ==>
6343 a UNION b SUBSET c UNION d``) THEN
6344 ASM_SIMP_TAC std_ss [SUBSET_REFL], ALL_TAC] THEN
6345 GEN_REWR_TAC (LAND_CONV o RAND_CONV) [SET_RULE ``A = BIGUNION {A}``] THEN
6346 REWRITE_TAC [GSYM BIGUNION_UNION] THEN
6347 SIMP_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, GSPECIFICATION, IN_UNION] THEN
6348 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
6349 [Q.EXISTS_TAC `D x' UNION A` THEN ASM_SET_TAC [],
6350 Q.EXISTS_TAC `D x' UNION A` THEN ASM_SET_TAC [],
6351 ASM_SET_TAC []] ) THEN DISCH_TAC THEN
6352 Know `sup {measure M ((D i) UNION A) | i IN univ(:num)} <= a` THEN1
6353 (REWRITE_TAC [sup_le'] THEN GEN_TAC THEN
6354 SIMP_TAC std_ss [GSPECIFICATION] THEN STRIP_TAC THEN
6355 Q.PAT_X_ASSUM `y = _` (ONCE_REWRITE_TAC o wrap) THEN
6356 Know `a = sup {measure M x | x IN Q}` >- METIS_TAC [] THEN Rewr' THEN
6357 Know `!i. D i UNION A IN Q` >-
6358 (Know `!i. D i UNION A IN measurable_sets M`
6359 >- (GEN_TAC THEN ONCE_REWRITE_TAC [METIS [subsets_def]
6360 ``measurable_sets m = subsets (m_space m, measurable_sets m)``] THEN
6361 MATCH_MP_TAC ALGEBRA_UNION THEN
6362 FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def] THEN
6363 METIS_TAC [subsets_def]) THEN DISCH_TAC THEN
6364 GEN_TAC THEN
6365 Know `Q = {x | x IN measurable_sets M /\ measure N x <> PosInf}`
6366 >- (Q.UNABBREV_TAC `Q` >> REWRITE_TAC []) >> Rewr' THEN
6367 ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN
6368 CONJ_TAC THENL [METIS_TAC [], ALL_TAC] THEN
6369 SIMP_TAC std_ss [lt_infty] THEN MATCH_MP_TAC let_trans THEN
6370 Q.EXISTS_TAC `measure N (D i') + measure N A` THEN
6371 reverse CONJ_TAC
6372 >- (SIMP_TAC std_ss [GSYM lt_infty] THEN
6373 MATCH_MP_TAC (METIS [add_not_infty]
6374 ``x <> PosInf /\ y <> PosInf ==> x + y <> PosInf``) THEN
6375 ASM_SIMP_TAC std_ss [] THEN
6376 `D i' IN Q` by METIS_TAC [] THEN POP_ASSUM MP_TAC THEN
6377 Q.UNABBREV_TAC `Q` THEN SIMP_TAC std_ss [GSPECIFICATION]) THEN
6378 REWRITE_TAC [le_lt] THEN DISJ2_TAC THEN MATCH_MP_TAC ADDITIVE THEN
6379 REV_FULL_SIMP_TAC std_ss [MEASURE_SPACE_ADDITIVE] THEN
6380 SIMP_TAC std_ss [DISJOINT_DEF] THEN
6381 ASM_SIMP_TAC std_ss [EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN
6382 GEN_TAC THEN ASM_CASES_TAC ``(x:'a) NOTIN A`` THEN
6383 FULL_SIMP_TAC std_ss [] THEN
6384 UNDISCH_TAC ``(A:'a->bool) SUBSET m_space N DIFF BIGUNION {QQ i | i IN univ(:num)}`` THEN
6385 Q.UNABBREV_TAC `QQ` THEN FULL_SIMP_TAC bool_ss [] THEN
6386 Suff `BIGUNION {D i | i IN univ(:num)} =
6387 BIGUNION {if i = 0 then Q' 0 else D i DIFF D (i - 1) | i IN univ(:num)}`
6388 >- (GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISC_RW_KILL THEN
6389 SIMP_TAC std_ss [SUBSET_DEF] THEN DISCH_THEN (MP_TAC o Q.SPEC `x`) THEN
6390 ASM_REWRITE_TAC [] THEN ASM_SET_TAC []) THEN
6391 SIMP_TAC std_ss [EXTENSION, IN_BIGUNION, GSPECIFICATION, IN_UNIV] THEN
6392 GEN_TAC THEN EQ_TAC THEN STRIP_TAC
6393 >- (FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
6394 ASM_CASES_TAC ``x' IN (D:num->'a->bool) 0``
6395 >- (Q.EXISTS_TAC `D 0` THEN FULL_SIMP_TAC std_ss [] THEN
6396 Q.EXISTS_TAC `0` THEN
6397 Q.UNABBREV_TAC `D` THEN SIMP_TAC std_ss [] THEN
6398 SET_TAC []) THEN
6399 Suff `?i. i <> 0 /\ x' IN D i DIFF D (i - 1)` THENL
6400 [STRIP_TAC THEN Q.EXISTS_TAC `D i'' DIFF D (i'' - 1)` THEN
6401 ASM_REWRITE_TAC [] THEN METIS_TAC [], ALL_TAC] THEN
6402 Induct_on `i'` THENL [METIS_TAC [], ALL_TAC] THEN
6403 DISCH_TAC THEN ASM_CASES_TAC ``x' IN D (SUC i') DIFF ((D:num->'a->bool) i')`` THENL
6404 [Q.EXISTS_TAC `SUC i'` THEN ASM_SIMP_TAC arith_ss [], ALL_TAC] THEN
6405 ASM_SET_TAC []) THEN
6406 FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
6407 ASM_CASES_TAC ``i' = 0:num``
6408 >- (Q.EXISTS_TAC `Q' 0` THEN FULL_SIMP_TAC std_ss [] THEN
6409 Q.UNABBREV_TAC `D` THEN BETA_TAC THEN
6410 Q.EXISTS_TAC `0` THEN SET_TAC []) THEN
6411 FULL_SIMP_TAC std_ss [] THEN Q.EXISTS_TAC `D i'` THEN CONJ_TAC THENL
6412 [ALL_TAC, METIS_TAC []] THEN
6413 ASM_SET_TAC [] ) THEN DISCH_TAC THEN
6414 MATCH_MP_TAC le_sup_imp' THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
6415 METIS_TAC [] ) THEN DISCH_TAC THEN
6416 POP_ASSUM MP_TAC THEN
6417 SIMP_TAC std_ss [GSYM extreal_lt_def] THEN
6418 POP_ASSUM (ONCE_REWRITE_TAC o wrap o SYM) THEN
6419 `BIGUNION {D i | i IN univ(:num)} = O_o` by METIS_TAC [] THEN POP_ORW THEN
6420 POP_ASSUM (ONCE_REWRITE_TAC o wrap o SYM) THEN
6421 Know `a = measure M O_o` >- METIS_TAC [] THEN Rewr' THEN DISCH_TAC THEN
6422 Know `measure M O_o <> NegInf`
6423 >- (MATCH_MP_TAC pos_not_neginf THEN
6424 `positive M` by PROVE_TAC [MEASURE_SPACE_POSITIVE] THEN
6425 fs [positive_def, measurable_sets_def, measure_def]) THEN DISCH_TAC THEN
6426 `measure M O_o <> PosInf` by PROVE_TAC [] THEN
6427 `measure M A <= 0`
6428 by PROVE_TAC [REWRITE_RULE [add_rzero]
6429 (Q.SPECL [`measure M O_o`, `measure M A`, `0`] le_ladd)] THEN
6430 PROVE_TAC [let_antisym]
6431QED
6432
6433(**********************************************************)
6434(* Existence of convergent sequence (fn_seq) *)
6435(**********************************************************)
6436
6437(**** Define the sequence ****)
6438Definition fn_seq_def :
6439 fn_seq m f =
6440 (\n x. SIGMA
6441 (\k. &k / 2 pow n *
6442 indicator_fn
6443 {x | x IN m_space m /\ &k / 2 pow n <= f x /\
6444 f x < (&k + 1) / 2 pow n} x) (count (4 ** n)) +
6445 2 pow n * indicator_fn {x | x IN m_space m /\ 2 pow n <= f x} x)
6446End
6447
6448(* f_n(x) = &k / 2 pow n in the k^th interval *)
6449Theorem lemma_fn_1 :
6450 !m f n x k. x IN m_space m /\ k IN count (4 ** n) /\ &k / 2 pow n <= f x /\
6451 f x < (&k + 1) / 2 pow n
6452 ==> (fn_seq m f n x = &k / 2 pow n)
6453Proof
6454 RW_TAC std_ss []
6455 >> `0:real < 2 pow n` by RW_TAC real_ss [REAL_POW_LT]
6456 >> `0:real <> 2 pow n` by RW_TAC real_ss [REAL_LT_IMP_NE]
6457 >> FULL_SIMP_TAC real_ss [fn_seq_def, indicator_fn_def, GSPECIFICATION, IN_COUNT,
6458 mul_rone, mul_rzero, extreal_of_num_def, extreal_pow_def,
6459 extreal_div_eq, extreal_add_def]
6460 >> `f x <> PosInf` by METIS_TAC [lt_infty,lt_trans]
6461 >> `f x <> NegInf` by METIS_TAC [lt_infty,lte_trans]
6462 >> `?r. f x = Normal r` by METIS_TAC [extreal_cases]
6463 >> FULL_SIMP_TAC std_ss [extreal_lt_eq,extreal_le_def]
6464 >> `(\k'. Normal (&k' / 2 pow n) * if &k' / 2 pow n <= r /\ r < &(k' + 1) / 2 pow n then Normal 1 else Normal 0) =
6465 (\k'. Normal((&k' / 2 pow n) * if &k' / 2 pow n <= r /\ r < &(k' + 1) / 2 pow n then 1 else 0))`
6466 by (RW_TAC std_ss [FUN_EQ_THM] >> METIS_TAC [extreal_add_def,extreal_mul_def])
6467 >> POP_ORW
6468 >> `FINITE (count (4 ** n))` by RW_TAC std_ss [FINITE_COUNT]
6469 >> RW_TAC real_ss [EXTREAL_SUM_IMAGE_NORMAL, extreal_11, extreal_mul_def,
6470 extreal_add_def]
6471 >- (`k + 1 <= 4 ** n` by RW_TAC real_ss [LESS_EQ]
6472 >> `&(k + 1) <= (4:real) pow n` by RW_TAC real_ss [REAL_OF_NUM_POW]
6473 >> FULL_SIMP_TAC real_ss [REAL_LT_RDIV_EQ]
6474 >> `r * 2 pow n < 4 pow n` by METIS_TAC [REAL_LTE_TRANS]
6475 >> METIS_TAC [REAL_LT_RDIV_EQ,REAL_POW_DIV,EVAL ``4/2:real``,real_lte])
6476 >> FULL_SIMP_TAC real_ss [GSYM real_lt]
6477 >> (MP_TAC o UNDISCH o Q.SPECL [`k`,`count (4 ** n)`] o CONJUNCT2 o Q.SPEC `(\k'. &k' / 2 pow n *
6478 if &k' / 2 pow n <= r:real /\ r < &(k' + 1) / 2 pow n then 1 else 0)`) (INST_TYPE [alpha |-> ``:num``] REAL_SUM_IMAGE_THM)
6479 >> RW_TAC real_ss []
6480 >> `count (4 ** n) = k INSERT (count (4 ** n))` by RW_TAC std_ss [GSYM ABSORPTION,IN_COUNT]
6481 >> POP_ORW
6482 >> RW_TAC std_ss [REAL_SUM_IMAGE_THM]
6483 >> Suff `SIGMA (\k'. &k' / 2 pow n * if &k' / 2 pow n <= r /\ r < &(k' + 1) / 2 pow n then 1 else 0)
6484 (count (4 ** n) DELETE k) = 0:real`
6485 >- RW_TAC real_ss []
6486 >> `FINITE (count (4 ** n) DELETE k)` by RW_TAC std_ss [FINITE_COUNT,FINITE_DELETE]
6487 >> ONCE_REWRITE_TAC [(UNDISCH o Q.SPEC `count (4 ** n) DELETE k` o INST_TYPE [alpha |-> ``:num``]) REAL_SUM_IMAGE_IN_IF]
6488 >> Suff `(\x. if x IN count (4 ** n) DELETE k then (\k'. &k' / 2 pow n *
6489 if &k' / 2 pow n <= r:real /\ r < &(k' + 1) / 2 pow n then
6490 1 else 0) x else 0) = (\x:num. 0:real)`
6491 >- FULL_SIMP_TAC real_ss [REAL_SUM_IMAGE_0]
6492 >> RW_TAC real_ss [FUN_EQ_THM,IN_COUNT,IN_DELETE]
6493 >> RW_TAC real_ss [COND_EXPAND]
6494 >> Cases_on `&x'<=((&k):real)`
6495 >- (`&(x'+1)<=(&k):real` by FULL_SIMP_TAC real_ss [LESS_EQ,REAL_LE_LT]
6496 >> `r * 2 pow n < &(x' + 1)` by METIS_TAC [REAL_LT_RDIV_EQ]
6497 >> `r:real * 2 pow n < &k` by METIS_TAC [REAL_LTE_TRANS]
6498 >> METIS_TAC [REAL_LT_RDIV_EQ,real_lte])
6499 >> FULL_SIMP_TAC std_ss [GSYM real_lt]
6500 >> `&(k+1)<=(&x'):real` by FULL_SIMP_TAC real_ss [LESS_EQ,REAL_LE_LT]
6501 >> `&x' <= r * 2 pow n` by METIS_TAC [REAL_LE_LDIV_EQ]
6502 >> `&(k+1) <= r * 2 pow n` by METIS_TAC [REAL_LE_TRANS]
6503 >> METIS_TAC [REAL_LE_LDIV_EQ,real_lte]
6504QED
6505
6506(* f_n(x) = 2 pow n if 2 pow n <= f x *)
6507Theorem lemma_fn_2 :
6508 !m f n x. x IN m_space m /\ 2 pow n <= f x ==> (fn_seq m f n x = 2 pow n)
6509Proof
6510 RW_TAC real_ss [fn_seq_def,indicator_fn_def,GSPECIFICATION,mul_rone]
6511 >> `FINITE (count (4 ** n))` by RW_TAC std_ss [FINITE_COUNT]
6512 >> `0:real < 2 pow n` by RW_TAC real_ss [REAL_POW_LT]
6513 >> `0:real <> 2 pow n` by RW_TAC real_ss [REAL_LT_IMP_NE]
6514 >> Suff `SIGMA (\k. &k / 2 pow n *
6515 if &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n
6516 then 1 else 0)
6517 (count (4 ** n)) = 0`
6518 >- RW_TAC real_ss [add_lzero]
6519 >> (MP_TAC o
6520 Q.SPEC `(\k. &k / 2 pow n *
6521 if &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n
6522 then 1 else 0)` o
6523 UNDISCH o Q.SPEC `count (4 ** n)` o
6524 INST_TYPE [alpha |-> ``:num``]) EXTREAL_SUM_IMAGE_IN_IF
6525 >> `!x'. (\k. &k / 2 pow n *
6526 if &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n
6527 then 1 else 0) x' <> NegInf`
6528 by (RW_TAC std_ss [mul_rone, mul_rzero] \\
6529 RW_TAC std_ss [extreal_of_num_def, extreal_pow_def, extreal_mul_def,
6530 extreal_div_eq, extreal_not_infty])
6531 >> Suff `(\x'. if x' IN count (4 ** n) then
6532 &x' / 2 pow n *
6533 (if &x' / 2 pow n <= f x /\ f x < (&x' + 1) / 2 pow n
6534 then 1 else 0)
6535 else 0) = (\x. 0)`
6536 >- RW_TAC std_ss [EXTREAL_SUM_IMAGE_ZERO]
6537 >> RW_TAC real_ss [FUN_EQ_THM,IN_COUNT]
6538 >> RW_TAC real_ss [COND_EXPAND,mul_rzero,mul_rone]
6539 >> `&(x' + 1):real <= 4 pow n` by RW_TAC real_ss [LESS_EQ,REAL_OF_NUM_POW]
6540 >> `&(x' + 1):real / 2 pow n <= 4 pow n / 2 pow n`
6541 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_POS_NZ,REAL_DIV_RMUL]
6542 >> `(&x' + 1) / 2 pow n <= 4 pow n / 2 pow n`
6543 by RW_TAC real_ss [extreal_div_eq, extreal_pow_def, extreal_add_def,
6544 extreal_of_num_def, extreal_le_def]
6545 >> `f x < 4 pow n / 2 pow n` by METIS_TAC [lte_trans]
6546 >> `4 pow n / 2 pow n = 2 pow n`
6547 by RW_TAC std_ss [extreal_pow_def, extreal_div_eq, extreal_of_num_def,
6548 GSYM REAL_POW_DIV, EVAL ``4/2:real``]
6549 >> METIS_TAC [extreal_lt_def]
6550QED
6551
6552(* f(x) is either larger than 2 pow n or is inside some k interval
6553
6554 NOTE: &(2 ** n) / 2 pow n = 1, &(4 ** n) / 2 pow n = 2 pow n.
6555 *)
6556Theorem lemma_fn_3 :
6557 !m f n x. x IN m_space m /\ 0 <= f x ==>
6558 (2 pow n <= f x) \/
6559 ?k. k IN count (4 ** n) /\ &k / 2 pow n <= f x /\
6560 f x < (&k + 1) / 2 pow n
6561Proof
6562 RW_TAC real_ss [IN_COUNT]
6563 >> Cases_on `2 pow n <= f x`
6564 >- RW_TAC std_ss []
6565 >> `f x < 2 pow n` by FULL_SIMP_TAC std_ss [extreal_lt_def]
6566 >> `f x <> PosInf`
6567 by METIS_TAC [extreal_of_num_def, extreal_pow_def, extreal_not_infty,
6568 lt_infty, lt_trans]
6569 >> `f x <> NegInf`
6570 by METIS_TAC [lt_infty, lte_trans, extreal_of_num_def, extreal_not_infty]
6571 >> `?r. f x = Normal r` by METIS_TAC [extreal_cases]
6572 >> `0:real < 2 pow n` by RW_TAC real_ss [REAL_POW_LT]
6573 >> `0:real <> 2 pow n` by RW_TAC real_ss [REAL_LT_IMP_NE]
6574 >> FULL_SIMP_TAC real_ss [extreal_of_num_def, extreal_pow_def, extreal_le_def,
6575 extreal_lt_eq, extreal_div_eq, extreal_add_def]
6576 >> Q.EXISTS_TAC `flr (2 pow n * r)`
6577 >> CONJ_TAC
6578 >- (`2 pow n * r < 2 pow n * 2 pow n` by RW_TAC real_ss [REAL_LT_LMUL]
6579 >> `2 pow n * 2 pow n = 4:real pow n` by RW_TAC real_ss [GSYM POW_MUL]
6580 >> `0 <= 2 pow n * r` by RW_TAC real_ss [REAL_LT_LE_MUL]
6581 >> `&(4 ** n) = 4:real pow n` by RW_TAC real_ss [GSYM REAL_OF_NUM_POW]
6582 >> FULL_SIMP_TAC real_ss []
6583 >> `&flr (2 pow n * r) <= 2 pow n * r` by RW_TAC real_ss [NUM_FLOOR_LE]
6584 >> `&flr (2 pow n * r) < 4:real pow n` by METIS_TAC [REAL_LET_TRANS]
6585 >> METIS_TAC [REAL_LT])
6586 >> CONJ_TAC
6587 >- (`0 <= 2 pow n * r` by RW_TAC real_ss [REAL_LT_LE_MUL]
6588 >> `&flr (2 pow n * r) <= 2 pow n * r` by RW_TAC real_ss [NUM_FLOOR_LE]
6589 >> `&flr (2 pow n * r) / 2 pow n <= 2 pow n * r / 2 pow n`
6590 by RW_TAC real_ss [REAL_LE_LDIV_EQ,REAL_POS_NZ,REAL_DIV_RMUL]
6591 >> METIS_TAC [REAL_EQ_LDIV_EQ,REAL_MUL_COMM])
6592 >> `0 <= 2 pow n * r` by RW_TAC real_ss [REAL_LT_LE_MUL]
6593 >> `2 pow n * r < &(flr (2 pow n * r) + 1)`
6594 by METIS_TAC [NUM_FLOOR_DIV_LOWERBOUND, REAL_LT_01, REAL_OVER1, REAL_MUL_RID]
6595 >> `2 pow n * r / 2 pow n < &(flr (2 pow n * r) + 1) / 2 pow n`
6596 by RW_TAC real_ss [REAL_LT_LDIV_EQ,REAL_POS_NZ,REAL_DIV_RMUL]
6597 >> METIS_TAC [REAL_EQ_LDIV_EQ,REAL_MUL_COMM]
6598QED
6599
6600(* f_n(x) = 0 outside m_space *)
6601Theorem lemma_fn_4 :
6602 !m f n x. ~(x IN m_space m) ==> (fn_seq m f n x = 0)
6603Proof
6604 RW_TAC real_ss [fn_seq_def,indicator_fn_def,GSPECIFICATION,mul_rzero,add_rzero]
6605 >> METIS_TAC [FINITE_COUNT,EXTREAL_SUM_IMAGE_ZERO]
6606QED
6607
6608(* f_n(x) positive *)
6609Theorem lemma_fn_seq_positive' :
6610 !m f n x. x IN m_space m /\ 0 <= f x ==> 0 <= fn_seq m f n x
6611Proof
6612 RW_TAC real_ss []
6613 >> `0:real < 2 pow n` by RW_TAC real_ss [REAL_POW_LT]
6614 >> `0:real <> 2 pow n` by RW_TAC real_ss [REAL_LT_IMP_NE]
6615 >> `0 < 2 pow n` by METIS_TAC [extreal_of_num_def,extreal_pow_def,extreal_lt_eq]
6616 >> (MP_TAC o Q.SPECL [`m`,`f`,`n`,`x`]) lemma_fn_3
6617 >> RW_TAC real_ss []
6618 >- RW_TAC real_ss [lt_imp_le,lemma_fn_2]
6619 >> `fn_seq m f n x = &k / 2 pow n` by RW_TAC real_ss [lemma_fn_1]
6620 >> ASM_SIMP_TAC std_ss []
6621 >> RW_TAC std_ss [extreal_of_num_def,extreal_pow_def,extreal_div_eq,extreal_le_def]
6622 >> MATCH_MP_TAC REAL_LE_DIV
6623 >> RW_TAC real_ss [REAL_POW_LT,REAL_LT_IMP_LE]
6624QED
6625
6626Theorem lemma_fn_seq_positive :
6627 !m f n x. 0 <= f x ==> 0 <= fn_seq m f n x
6628Proof
6629 rpt STRIP_TAC
6630 >> Cases_on `~(x IN m_space m)`
6631 >- RW_TAC std_ss [lemma_fn_4,le_refl]
6632 >> FULL_SIMP_TAC std_ss []
6633 >> MATCH_MP_TAC lemma_fn_seq_positive' >> art []
6634QED
6635
6636(* MONOTONICALLY INCREASING *)
6637Theorem lemma_fn_seq_mono_increasing :
6638 !m f x. 0 <= f x ==> mono_increasing (\n. fn_seq m f n x)
6639Proof
6640 RW_TAC std_ss [ext_mono_increasing_suc,ADD1]
6641 >> Cases_on `~(x IN m_space m)`
6642 >- RW_TAC real_ss [lemma_fn_4, le_refl]
6643 >> FULL_SIMP_TAC std_ss []
6644 >> `!n x k. x IN m_space m /\ (k IN count (4 ** n)) /\
6645 (&k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n) ==>
6646 (fn_seq m f n x = &k / 2 pow n)`
6647 by RW_TAC std_ss [lemma_fn_1]
6648 >> `!n x. x IN m_space m /\ 2 pow n <= f x ==> (fn_seq m f n x = 2 pow n)`
6649 by RW_TAC std_ss [lemma_fn_2]
6650 >> `!n. 0:real < 2 pow n` by RW_TAC real_ss [REAL_POW_LT]
6651 >> `!n. 0:real <> 2 pow n` by RW_TAC real_ss [REAL_LT_IMP_NE]
6652 >> `!n k. k IN count (4 ** (n + 1)) /\
6653 (&k / 2 pow (n + 1) <= f x /\ f x < (&k + 1) / 2 pow (n + 1)) ==>
6654 (fn_seq m f n x <= fn_seq m f (n + 1) x)`
6655 by (RW_TAC real_ss [] \\
6656 `fn_seq m f (n + 1) x = &k / (2 pow (n + 1))` by RW_TAC real_ss [] \\
6657 `f x <> NegInf` by METIS_TAC [lt_infty, lte_trans, extreal_of_num_def, extreal_not_infty] \\
6658 `f x <> PosInf` by METIS_TAC [extreal_of_num_def, extreal_pow_def, extreal_not_infty,
6659 lt_infty, lt_trans] \\
6660 `?r. f x = Normal r` by METIS_TAC [extreal_cases] \\
6661 `0:real <> 2 pow (n + 1)` by RW_TAC real_ss [] \\
6662 FULL_SIMP_TAC std_ss [extreal_of_num_def, extreal_pow_def, extreal_div_eq, extreal_add_def,
6663 extreal_mul_def, extreal_le_def, extreal_lt_eq] \\
6664 `&(k + 1) / (2 pow (n + 1)):real = (&(k + 1) / 2) / (2 pow (n + 1) / 2)`
6665 by RW_TAC real_ss [REAL_DIV_DENOM_CANCEL] \\
6666 `2 pow (n + 1) / 2 = (2 pow n):real`
6667 by (RW_TAC std_ss [GSYM ADD1, pow] \\
6668 RW_TAC real_ss [REAL_EQ_LDIV_EQ, REAL_MUL_COMM]) \\
6669 `&k / 2 pow (n + 1) = (&k / 2) / (2 pow (n + 1) / 2):real`
6670 by RW_TAC real_ss [REAL_DIV_DENOM_CANCEL] \\
6671 FULL_SIMP_TAC std_ss [] \\
6672 STRUCT_CASES_TAC (Q.SPEC `k` EVEN_OR_ODD)
6673 >- (FULL_SIMP_TAC std_ss [EVEN_EXISTS] \\
6674 FULL_SIMP_TAC real_ss [] \\
6675 `&k / 2:real = &m'` by RW_TAC real_ss [REAL_EQ_LDIV_EQ] \\
6676 `&(2 * m' + 1):real < &(2 * m' + 2)` by RW_TAC real_ss [] \\
6677 `&(2 * m' + 1) / 2:real < &(2 * m' + 2) / 2` by RW_TAC real_ss [REAL_LT_RDIV] \\
6678 `&(2 * m' + 1) / 2 / (2 pow n):real < &(2 * m' + 2) / 2 / 2 pow n`
6679 by RW_TAC real_ss [REAL_LT_RDIV] \\
6680 `&(2 * m' + 2) / 2 = &(m'+1):real`
6681 by RW_TAC real_ss [REAL_EQ_LDIV_EQ, REAL_ADD_LDISTRIB] \\
6682 `r < &(m' + 1) / 2 pow n` by METIS_TAC [REAL_LT_TRANS] \\
6683 `&(2 * m') / 2 / 2 pow n = &m' / (2 pow n):real` by METIS_TAC [] \\
6684 FULL_SIMP_TAC real_ss [] \\
6685 Cases_on `m' IN count (4 ** n)`
6686 >- (`fn_seq m f n x = Normal (&m' / 2 pow n)`
6687 by METIS_TAC [extreal_le_def, extreal_lt_eq] \\
6688 RW_TAC std_ss [le_refl]) \\
6689 FULL_SIMP_TAC real_ss [IN_COUNT, NOT_LESS] \\
6690 `4:real pow n <= &m'` by RW_TAC real_ss [REAL_OF_NUM_POW] \\
6691 `4:real pow n / 2 pow n <= &m' / 2 pow n`
6692 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_POS_NZ, REAL_DIV_RMUL] \\
6693 `2 pow n <= r` by METIS_TAC [REAL_LE_TRANS, REAL_POW_DIV, EVAL ``4/2:real``] \\
6694 `fn_seq m f n x = Normal (2 pow n)` by METIS_TAC [extreal_le_def, extreal_lt_eq] \\
6695 `(2 pow n):real <= &m' / 2 pow n` by METIS_TAC [REAL_POW_DIV,EVAL ``4/2:real``] \\
6696 `&(2*m')/2 = &m':real` by RW_TAC real_ss [] \\
6697 RW_TAC std_ss [extreal_le_def]) \\
6698 FULL_SIMP_TAC std_ss [ODD_EXISTS] \\
6699 `(k - 1) < k` by RW_TAC real_ss [] \\
6700 `&(k - 1) / 2 < (&k) / 2:real` by RW_TAC real_ss [REAL_LT_LDIV_EQ, REAL_DIV_RMUL] \\
6701 `&(k - 1) / 2 / 2 pow n < (&k) / 2 / (2 pow n):real`
6702 by RW_TAC real_ss [REAL_LT_LDIV_EQ, REAL_DIV_RMUL, REAL_POS_NZ] \\
6703 `&(k - 1) / 2 / 2 pow n <= r` by METIS_TAC [REAL_LTE_TRANS, REAL_LT_IMP_LE] \\
6704 `&(k - 1):real = 2 * &m'` by RW_TAC real_ss [] \\
6705 `!x. 2 * x / 2 = x:real` by RW_TAC real_ss [REAL_EQ_LDIV_EQ, REAL_MUL_COMM] \\
6706 `&m' / (2 pow n) <= r` by METIS_TAC [REAL_MUL] \\
6707 `&(k + 1):real = 2 * (&m' + 1)` by RW_TAC real_ss [] \\
6708 FULL_SIMP_TAC real_ss [] \\
6709 `r < &(m' + 1) / (2 pow n)` by METIS_TAC [REAL_MUL, REAL_ADD] \\
6710 Cases_on `m' IN count (4 ** n)`
6711 >- (Q.PAT_X_ASSUM `!n x k. Q` (MP_TAC o Q.SPECL [`n`,`x`, `m'`]) \\
6712 RW_TAC std_ss [extreal_le_def, extreal_lt_eq] \\
6713 `&(2 * m'):real <= &SUC (2*m')` by RW_TAC real_ss [] \\
6714 `&(2 * m') / 2:real <= &SUC (2 * m') / 2`
6715 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_DIV_RMUL] \\
6716 `&(2 * m') / 2 / 2 pow n <= &SUC (2 * m') / 2 / (2 pow n):real`
6717 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_DIV_RMUL, REAL_POS_NZ] \\
6718 `&(2 * m') / 2:real = &m'` by RW_TAC real_ss [REAL_EQ_LDIV_EQ] \\
6719 FULL_SIMP_TAC real_ss [REAL_LE_TRANS]) \\
6720 FULL_SIMP_TAC real_ss [IN_COUNT, NOT_LESS] \\
6721 `4 pow n <= &m':real` by RW_TAC real_ss [REAL_OF_NUM_POW] \\
6722 `4:real pow n / 2 pow n <= &m' / 2 pow n`
6723 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_POS_NZ, REAL_DIV_RMUL] \\
6724 `&(k - 1):real = 2 * &m'` by RW_TAC real_ss [] \\
6725 `&m' < &k / 2:real` by METIS_TAC [] \\
6726 `&m' / (2 pow n):real < &k / 2 / 2 pow n`
6727 by RW_TAC real_ss [REAL_LT_LDIV_EQ, REAL_POS_NZ, REAL_DIV_RMUL] \\
6728 `2 pow n <= r`
6729 by METIS_TAC [REAL_POW_DIV, EVAL ``4/2:real``, REAL_LET_TRANS,
6730 REAL_LTE_TRANS, REAL_LT_IMP_LE] \\
6731 `fn_seq m f n x = Normal (2 pow n)` by METIS_TAC [extreal_le_def, extreal_lt_eq] \\
6732 `2 pow n <= &m' / (2 pow n):real` by METIS_TAC [REAL_POW_DIV, EVAL ``4/2:real``] \\
6733 `&(2 * m'):real <= &SUC (2 * m')` by RW_TAC real_ss [] \\
6734 `&(2 * m') / 2:real <= &SUC (2 * m') / 2`
6735 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_DIV_RMUL] \\
6736 `&(2 * m') / 2 / 2 pow n <= &SUC (2 * m') / 2 / (2 pow n):real`
6737 by RW_TAC real_ss [REAL_LE_LDIV_EQ, REAL_DIV_RMUL, REAL_POS_NZ] \\
6738 `&(2 * m') / 2:real = &m'` by RW_TAC real_ss [REAL_EQ_LDIV_EQ] \\
6739 METIS_TAC [REAL_LE_TRANS, extreal_le_def])
6740 >> `!n. 2 pow (n + 1) <= f x ==> (fn_seq m f n x <= fn_seq m f (n + 1) x)`
6741 by (RW_TAC real_ss [] \\
6742 `2:real pow n < 2 pow (n + 1)` by RW_TAC real_ss [REAL_POW_MONO_LT] \\
6743 `2 pow n < 2 pow (n + 1)`
6744 by METIS_TAC [extreal_pow_def, extreal_of_num_def, extreal_lt_eq] \\
6745 METIS_TAC [extreal_le_def, extreal_lt_eq, lte_trans, lt_imp_le])
6746 >> (MP_TAC o Q.SPECL [`m`,`f`,`n + 1`,`x`]) lemma_fn_3
6747 >> RW_TAC std_ss []
6748 >- RW_TAC std_ss []
6749 >> METIS_TAC []
6750QED
6751
6752(* UPPER BOUNDED BY f *)
6753Theorem lemma_fn_seq_upper_bounded' :
6754 !m f n x. x IN m_space m /\ 0 <= f x ==> fn_seq m f n x <= f x
6755Proof
6756 RW_TAC std_ss []
6757 >> (MP_TAC o Q.SPECL [`m`,`f`,`n`,`x`]) lemma_fn_3
6758 >> RW_TAC real_ss []
6759 >- METIS_TAC [lemma_fn_2,le_refl]
6760 >> `fn_seq m f n x = &k / 2 pow n` by RW_TAC real_ss [lemma_fn_1]
6761 >> RW_TAC std_ss []
6762QED
6763
6764Theorem lemma_fn_seq_upper_bounded :
6765 !m f n x. 0 <= f x ==> fn_seq m f n x <= f x
6766Proof
6767 rpt STRIP_TAC
6768 >> Cases_on `~(x IN m_space m)` >- RW_TAC real_ss [lemma_fn_4]
6769 >> FULL_SIMP_TAC std_ss []
6770 >> MATCH_MP_TAC lemma_fn_seq_upper_bounded' >> art []
6771QED
6772
6773(* f Supremum of fn_seq *)
6774Theorem lemma_fn_seq_sup :
6775 !m f x. x IN m_space m /\ 0 <= f x ==>
6776 sup (IMAGE (\n. fn_seq m f n x) UNIV) = f x
6777Proof
6778 RW_TAC std_ss []
6779 >> Cases_on `f x = PosInf`
6780 >- (`!n:num. fn_seq m f n x = 2 pow n` by METIS_TAC [le_infty,lemma_fn_2]
6781 >> RW_TAC std_ss [sup_eq,le_infty]
6782 >> `!n. 2 pow n <= y`
6783 by (RW_TAC std_ss []
6784 >> POP_ASSUM MATCH_MP_TAC
6785 >> ONCE_REWRITE_TAC [GSYM SPECIFICATION]
6786 >> RW_TAC std_ss [IN_IMAGE,IN_UNIV]
6787 >> METIS_TAC [])
6788 >> SPOSE_NOT_THEN ASSUME_TAC
6789 >> METIS_TAC [EXTREAL_ARCH_POW2, extreal_lt_def])
6790 >> `!n. fn_seq m f n x <= f x` by METIS_TAC [lemma_fn_seq_upper_bounded]
6791 >> `?r. f x = Normal r` by METIS_TAC [extreal_cases,lt_infty,lte_trans,extreal_of_num_def]
6792 >> `!n. fn_seq m f n x <> PosInf` by METIS_TAC [lt_infty,let_trans]
6793 >> `!n. fn_seq m f n x <> NegInf`
6794 by METIS_TAC [lt_infty,lte_trans,lemma_fn_seq_positive,extreal_of_num_def]
6795 >> `?r. !n. fn_seq m f n x = Normal (r n)`
6796 by (Q.EXISTS_TAC `\n. @r. fn_seq m f n x = Normal r`
6797 >> GEN_TAC >> RW_TAC std_ss []
6798 >> SELECT_ELIM_TAC
6799 >> RW_TAC std_ss []
6800 >> METIS_TAC [extreal_cases])
6801 >> `?N. f x < 2 pow N` by RW_TAC std_ss [EXTREAL_ARCH_POW2]
6802 >> `!p n. p <= n ==> 2 pow p <= 2 pow n` by METIS_TAC [pow_le_mono,EVAL ``1<=2``]
6803 >> `!n. N <= n ==> f x < 2 pow n` by METIS_TAC [lte_trans]
6804 >> `!n. N <= n ==> ?k. k IN count (4 ** n) /\ &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n`
6805 by METIS_TAC [lemma_fn_3,extreal_lt_def]
6806 >> `!n. 0:real < 2 pow n` by RW_TAC real_ss [REAL_POW_LT]
6807 >> `!n. 0:real <> 2 pow n` by RW_TAC real_ss [REAL_LT_IMP_NE]
6808 >> `!n k. &k / 2 pow n = Normal (&k / 2 pow n)`
6809 by METIS_TAC [extreal_of_num_def,extreal_pow_def,extreal_div_eq]
6810 >> `!n z. Normal z / 2 pow n = Normal (z / 2 pow n)`
6811 by METIS_TAC [extreal_pow_def,extreal_div_eq,extreal_of_num_def]
6812 >> `!n. N <= n ==> (f x - 1 / 2 pow n < fn_seq m f n x)`
6813 by (RW_TAC real_ss []
6814 >> `?k. k IN count (4 ** n) /\ &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n` by METIS_TAC []
6815 >> `fn_seq m f n x = &k / 2 pow n` by METIS_TAC [lemma_fn_1]
6816 >> `Normal (&k + 1) / Normal (2 pow n) = Normal ((&k + 1) / (2 pow n))`
6817 by METIS_TAC [extreal_div_eq]
6818 >> `Normal r < Normal ((&k + 1) / (2 pow n))`
6819 by METIS_TAC [extreal_pow_def,extreal_of_num_def,extreal_add_def]
6820 >> FULL_SIMP_TAC std_ss [extreal_lt_eq,GSYM REAL_DIV_ADD,extreal_pow_def,extreal_sub_def,
6821 extreal_of_num_def,extreal_div_eq,extreal_lt_eq,REAL_LT_SUB_RADD]
6822 >> `r' n = &k / 2 pow n` by METIS_TAC [extreal_div_eq,extreal_11]
6823 >> FULL_SIMP_TAC std_ss [])
6824 >> FULL_SIMP_TAC std_ss []
6825 >> `!n. N <= n ==> (r - 1 / 2 pow n < r' n)`
6826 by (FULL_SIMP_TAC std_ss [extreal_le_def,extreal_lt_eq,extreal_of_num_def,extreal_pow_def,
6827 extreal_div_eq,extreal_add_def]
6828 >> RW_TAC std_ss []
6829 >> METIS_TAC [extreal_sub_def,extreal_lt_eq])
6830 >> `mono_increasing (\n. fn_seq m f n x)` by METIS_TAC [lemma_fn_seq_mono_increasing]
6831 >> `mono_increasing r'`
6832 by (FULL_SIMP_TAC std_ss [ext_mono_increasing_def,mono_increasing_def] \\
6833 METIS_TAC [extreal_le_def])
6834 >> FULL_SIMP_TAC std_ss [extreal_le_def,extreal_lt_eq,extreal_of_num_def,extreal_pow_def,
6835 extreal_div_eq,extreal_add_def,extreal_sub_def,extreal_not_infty]
6836 >> RW_TAC std_ss [GSYM sup_seq,SEQ,GREATER_EQ]
6837 >> `!n. 1:real / 2 pow n = (1 / 2) pow n` by RW_TAC real_ss [POW_ONE,REAL_POW_DIV]
6838 >> `!n. r' n < r + 1 / 2 pow n`
6839 by METIS_TAC [POW_HALF_POS,REAL_LT_ADDR,REAL_LET_TRANS,REAL_LT_IMP_LE]
6840 >> `!n. N <= n ==> (abs (r' n - r) < 1 / 2 pow n)` by METIS_TAC [ABS_BETWEEN,POW_HALF_POS]
6841 >> `?N1. (1 / 2) pow N1 < e:real` by RW_TAC std_ss [POW_HALF_SMALL]
6842 >> `!n. N1 <= n ==> ((1 / 2:real) pow n <= (1 / 2) pow N1)` by RW_TAC std_ss [POW_HALF_MONO]
6843 >> `!n. N1 <= n ==> ((1 / 2:real) pow n < e)` by METIS_TAC [REAL_LET_TRANS]
6844 >> Q.EXISTS_TAC `N + N1`
6845 >> RW_TAC real_ss []
6846 >> `N <= N + N1` by RW_TAC std_ss [LESS_EQ_ADD]
6847 >> `N1 <= N + N1` by RW_TAC std_ss [LESS_EQ_ADD]
6848 >> `N <= n /\ N1 <= n` by METIS_TAC [LESS_EQ_TRANS]
6849 >> METIS_TAC [REAL_LT_TRANS]
6850QED
6851
6852(***********************)
6853(* Further Results *)
6854(***********************)
6855
6856(* These do not require addition simplifier manipulations on my part. It would
6857 probably be more appropriate to add these in the proper places above.
6858 - Jared Yeager
6859 *)
6860
6861val _ = reveal "C";
6862
6863(*** measure_space Theorems ***)
6864
6865Theorem measure_space_measure_eq :
6866 !sp sts u v. measure_space (sp,sts,u) /\ (!s. s IN sts ==> u s = v s) ==>
6867 measure_space (sp,sts,v)
6868Proof
6869 rpt STRIP_TAC
6870 >> MP_TAC (Q.SPECL [‘(sp,sts,u)’, ‘(sp,sts,v)’] measure_space_eq)
6871 >> rw []
6872QED
6873
6874Theorem measure_space_cong:
6875 !sp sts u v. (!s. s IN sts ==> u s = v s) ==>
6876 (measure_space (sp,sts,u) <=> measure_space (sp,sts,v))
6877Proof
6878 rw[] >> eq_tac >> rw[]
6879 >> dxrule_at_then (Pos $ el 1) irule measure_space_measure_eq >> simp[]
6880QED
6881
6882Theorem measure_space_add':
6883 !a mu nu p. measure_space (space a,subsets a,mu) /\
6884 measure_space (space a,subsets a,nu) /\
6885 (!s. s IN subsets a ==> p s = mu s + nu s) ==>
6886 measure_space (space a,subsets a,p)
6887Proof
6888 rw [measure_space_def, positive_def, countably_additive_def,
6889 m_space_def, measurable_sets_def, measure_def]
6890 >- (dxrule_then assume_tac $ SIGMA_ALGEBRA_EMPTY >> fs[])
6891 >- (irule le_add >> fs[])
6892 >> (qspecl_then [‘mu o f’,‘nu o f’] assume_tac) ext_suminf_add
6893 >> rfs[o_DEF,FUNSET]
6894QED
6895
6896Theorem measure_space_sum:
6897 !a f m s. FINITE s /\ sigma_algebra a /\
6898 (!i. i IN s ==> measure_space (space a,subsets a,f i)) /\
6899 (!t. t IN subsets a ==> m t = EXTREAL_SUM_IMAGE (C f t) s) ==>
6900 measure_space (space a,subsets a,m)
6901Proof
6902 ‘!(s:'b->bool). FINITE s ==> !(a:'a algebra) f m. sigma_algebra a /\
6903 (!i. i IN s ==> measure_space (space a,subsets a,f i)) /\
6904 (!t. t IN subsets a ==> m t = EXTREAL_SUM_IMAGE (C f t) s) ==>
6905 measure_space (space a,subsets a,m)’ suffices_by (rw[] >>
6906 last_x_assum $ drule_then assume_tac >> pop_assum $ drule_all_then assume_tac >> simp[]) >>
6907 Induct_on ‘s’ >> rw[]
6908 >- (fs[EXTREAL_SUM_IMAGE_EMPTY] >> irule measure_space_measure_eq \\
6909 qexists_tac ‘K 0’ >> simp[] >> dxrule_then assume_tac measure_space_trivial >>
6910 fs[sigma_finite_measure_space_def,K_DEF]) >>
6911 last_x_assum $ qspecl_then [‘a’,‘f’,‘\t. EXTREAL_SUM_IMAGE (C f t) s’] assume_tac >> rfs[] >>
6912 irule measure_space_add' >>
6913 qexistsl_tac [‘f e’,‘(\t. EXTREAL_SUM_IMAGE (C f t) s)’] >>
6914 simp[] >> qx_gen_tac ‘t’ >> rw[] >>
6915 qspecl_then [‘C f t’,‘s’,‘e’]
6916 (fn th => assume_tac th >> rfs[DELETE_NON_ELEMENT_RWT] >> pop_assum irule) $
6917 SIMP_RULE bool_ss [GSYM RIGHT_FORALL_IMP_THM] EXTREAL_SUM_IMAGE_PROPERTY >>
6918 DISJ1_TAC >> rw[] >> irule pos_not_neginf >> fs[measure_space_def,positive_def]
6919QED
6920
6921Theorem measure_space_suminf:
6922 !a g m. (!n. measure_space (space a,subsets a,g n)) /\
6923 (!s. s IN subsets a ==> m s = suminf (C g s)) ==>
6924 measure_space (space a,subsets a,m)
6925Proof
6926 rw [measure_space_def,positive_def,countably_additive_def]
6927 >> fs[GSYM RIGHT_AND_FORALL_THM]
6928 >- (dxrule_then assume_tac $ SIGMA_ALGEBRA_EMPTY >> simp[ext_suminf_0,C_DEF])
6929 >- (irule ext_suminf_pos >> rw[])
6930 >> ‘suminf (m o f) = suminf (\i. suminf (C g (f i)))’
6931 by (irule ext_suminf_eq >> rw[] >> rfs[FUNSET])
6932 >> pop_assum SUBST1_TAC >> simp[C_DEF,o_DEF]
6933 >> qspec_then ‘C g o f’ (irule o SIMP_RULE (srw_ss ()) []) ext_suminf_nested
6934 >> rw [] >> last_x_assum $ irule o cj 2
6935 >> fs[FUNSET]
6936QED
6937
6938Theorem measure_space_cmul:
6939 !a u v c. measure_space (space a,subsets a,u) /\ 0 <= c /\
6940 (!s. s IN subsets a ==> v s = c * u s) ==>
6941 measure_space (space a,subsets a,v)
6942Proof
6943 rw[measure_space_def,positive_def,countably_additive_def]
6944 >- (dxrule_then assume_tac $ SIGMA_ALGEBRA_EMPTY >> fs[])
6945 >- (irule le_mul >> fs[])
6946 >> (qspecl_then [‘u o f’,‘c’] assume_tac) ext_suminf_cmul
6947 >> rfs[o_DEF,FUNSET]
6948QED
6949
6950Theorem measure_space_dirac_measure:
6951 !a x. sigma_algebra a ==> measure_space (space a,subsets a,C indicator_fn x)
6952Proof
6953 simp[measure_space_def,positive_def,countably_additive_def,indicator_fn_def]
6954 >> rw[] >> rw[] >> fs[]
6955 >- (rename [‘x IN f n’] >>
6956 ‘(C indicator_fn x o f) = (\i. if i = n then 1 else 0:extreal)’
6957 suffices_by rw[ext_suminf_sing_general] \\
6958 rw[FUN_EQ_THM,o_DEF,indicator_fn_def] >> Cases_on ‘i = n’ >> simp[] >>
6959 last_x_assum (qspecl_then [‘i’,‘n’] assume_tac) >> rfs[DISJOINT_DEF,EXTENSION] >>
6960 pop_assum $ qspec_then ‘x’ assume_tac >> rfs[])
6961 >> irule ext_suminf_zero >> rw[indicator_fn_def]
6962 >> first_x_assum $ qspec_then ‘f n’ assume_tac
6963 >> rfs[] >> first_x_assum $ qspec_then ‘n’ assume_tac >> fs[]
6964QED
6965
6966Theorem MEASURE_SPACE_SIGMA_ALGEBRA[simp]:
6967 !m. measure_space m ==> sigma_algebra (measurable_space m)
6968Proof
6969 simp[measure_space_def]
6970QED
6971
6972Theorem ext_suminf_cmult_indicator :
6973 !A f x i. disjoint_family A /\ x IN A i /\ (!i. 0 <= f i) ==>
6974 (suminf (\n. f n * indicator_fn (A n) x) = f i)
6975Proof
6976 RW_TAC std_ss [disjoint_family_on, IN_UNIV] THEN
6977 Suff `!n. f n * indicator_fn (A n) x = if n = i then f n else 0` THENL
6978 [DISCH_TAC,
6979 RW_TAC std_ss [indicator_fn_def, mul_rone, mul_rzero] THEN
6980 ASM_SET_TAC []] THEN
6981 Suff `f i = SIGMA (\i. f i * indicator_fn (A i) x) (count (SUC i))` THENL
6982 [DISCH_THEN (fn th => ONCE_REWRITE_TAC [th]) THEN MATCH_MP_TAC ext_suminf_sum THEN
6983 RW_TAC std_ss [le_refl] THEN POP_ASSUM MP_TAC THEN ASM_SIMP_TAC arith_ss [ADD1],
6984 ASM_SIMP_TAC std_ss []] THEN
6985 `count (SUC i) <> {}` by (SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY] THEN
6986 Q.EXISTS_TAC `i` THEN SIMP_TAC arith_ss [GSPECIFICATION, count_def]) THEN
6987 Suff `count (SUC i) = count i UNION {i}` THENL
6988 [RW_TAC std_ss [],
6989 SIMP_TAC arith_ss [count_def, EXTENSION, IN_UNION, GSPECIFICATION, IN_SING]] THEN
6990 Suff `SIGMA (\i'. if i' = i then f i else 0) (count i UNION {i}) =
6991 SIGMA (\i'. if i' = i then f i else 0) (count i) +
6992 SIGMA (\i'. if i' = i then f i else 0) ({i})` THENL
6993 [RW_TAC std_ss [],
6994 ABBREV_TAC ``g = (\i'. if i' = i then (f:num->extreal) i else 0)`` THEN
6995 Suff `(!x. x IN (count i UNION {i}) ==> g x <> NegInf) \/
6996 (!x. x IN (count i UNION {i}) ==> g x <> PosInf)` THENL
6997 [Q.SPEC_TAC (`g`,`g`) THEN MATCH_MP_TAC EXTREAL_SUM_IMAGE_DISJOINT_UNION THEN
6998 SIMP_TAC std_ss [FINITE_COUNT, FINITE_SING, DISJOINT_DEF] THEN
6999 SIMP_TAC std_ss [EXTENSION, IN_INTER, IN_SING, NOT_IN_EMPTY, count_def] THEN
7000 SIMP_TAC arith_ss [GSPECIFICATION],
7001 DISJ1_TAC] THEN
7002 EXPAND_TAC "g" THEN POP_ASSUM K_TAC THEN RW_TAC std_ss [lt_infty] THENL
7003 [ALL_TAC, METIS_TAC [lt_infty, num_not_infty]] THEN
7004 MATCH_MP_TAC lte_trans THEN Q.EXISTS_TAC `0` THEN ASM_REWRITE_TAC [] THEN
7005 METIS_TAC [lt_infty, num_not_infty]] THEN
7006 SIMP_TAC std_ss [EXTREAL_SUM_IMAGE_SING] THEN
7007 Suff `SIGMA (\i'. if i' = i then f i else 0) (count i) = 0` THENL
7008 [SIMP_TAC std_ss [add_lzero],
7009 MATCH_MP_TAC EXTREAL_SUM_IMAGE_0] THEN
7010 RW_TAC std_ss [FINITE_COUNT] THEN POP_ASSUM MP_TAC THEN
7011 ONCE_REWRITE_TAC [MONO_NOT_EQ] THEN RW_TAC std_ss [] THEN
7012 SIMP_TAC arith_ss [count_def, GSPECIFICATION]
7013QED
7014
7015Definition finite_measure_space_def :
7016 finite_measure_space m <=> measure_space m /\ measure m (m_space m) <> PosInf
7017End
7018
7019Theorem finite_measure_space_thm :
7020 !m. finite_measure_space m <=>
7021 measure_space m /\
7022 !s. s IN measurable_sets m ==>
7023 measure m s <> NegInf /\ measure m s <> PosInf
7024Proof
7025 RW_TAC std_ss [finite_measure_space_def]
7026 >> reverse EQ_TAC >> rw []
7027 >- (POP_ASSUM (MATCH_MP_TAC o cj 2) \\
7028 MATCH_MP_TAC MEASURE_SPACE_SPACE >> art [])
7029 >- (MATCH_MP_TAC pos_not_neginf \\
7030 Know ‘positive m’ >- rw [MEASURE_SPACE_POSITIVE] \\
7031 rw [positive_def])
7032 >> fs [lt_infty]
7033 >> Q_TAC (TRANS_TAC let_trans) ‘measure m (m_space m)’ >> art []
7034 >> Know ‘increasing m’ >- rw [MEASURE_SPACE_INCREASING]
7035 >> rw [increasing_def]
7036 >> POP_ASSUM MATCH_MP_TAC >> art []
7037 >> CONJ_TAC
7038 >- (MATCH_MP_TAC MEASURE_SPACE_SPACE >> art [])
7039 >> MATCH_MP_TAC MEASURABLE_SETS_SUBSET_SPACE >> art []
7040QED
7041
7042(* NOTE: The antecedent ‘ring (sp,M)’ (can be weaken to ‘semiring (sp,M)’) is
7043 to make sure ‘{} IN M’.
7044 *)
7045Theorem positive_cong_eq :
7046 !sp M u u'. ring (sp,M) /\ (!a. a IN M ==> u' a = u a) ==>
7047 positive (sp,M,u) = positive (sp,M,u')
7048Proof
7049 SIMP_TAC std_ss [positive_def, measure_def, measurable_sets_def] THEN
7050 RW_TAC std_ss [ring_alt, subset_class_def]
7051QED
7052
7053Theorem countably_additive_eq :
7054 !sp M u u'. (!a. a IN M ==> u' a = u a) ==>
7055 countably_additive (sp,M,u') = countably_additive (sp,M,u)
7056Proof
7057 SIMP_TAC std_ss [countably_additive_def, IN_FUNSET, IN_UNIV] THEN
7058 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN
7059 FIRST_X_ASSUM (MP_TAC o SPEC ``f:num->'a->bool``) THEN
7060 FULL_SIMP_TAC std_ss [measurable_sets_def, measure_def, o_DEF]
7061QED
7062
7063Theorem measure_space_sigma_sets_eq : (* was: measure_space_eq *)
7064 !sp A u u'. A SUBSET POW sp /\
7065 (!a. a IN sigma_sets sp A ==> u a = u' a) ==>
7066 measure_space (sp, (sigma_sets sp A), u) =
7067 measure_space (sp, (sigma_sets sp A), u')
7068Proof
7069 REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN FIRST_X_ASSUM MP_TAC THEN
7070 DISCH_THEN (MP_TAC o MATCH_MP sigma_algebra_sigma_sets) THEN
7071 SIMP_TAC std_ss [measure_space_def] THEN REPEAT STRIP_TAC THEN
7072 SIMP_TAC std_ss [measurable_sets_def, m_space_def] THEN AP_TERM_TAC THEN
7073 MATCH_MP_TAC (TAUT `(a = b) /\ (c = d) ==>
7074 ((a /\ c) <=> (b /\ d))`) THEN CONJ_TAC THENL
7075 [MATCH_MP_TAC positive_cong_eq THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
7076 FULL_SIMP_TAC std_ss [sigma_algebra_alt_eq, ALGEBRA_IMP_RING],
7077 MATCH_MP_TAC countably_additive_eq THEN ASM_REWRITE_TAC []]
7078QED
7079
7080Theorem measure_of_eq :
7081 !sp A u u'. A SUBSET POW sp /\ (!a. a IN sigma_sets sp A ==> (u a = u' a)) ==>
7082 (measure_of (sp,A,u) = measure_of (sp,A,u'))
7083Proof
7084 REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MP_TAC THEN
7085 DISCH_THEN (MP_TAC o MATCH_MP measure_space_sigma_sets_eq) THEN
7086 SIMP_TAC std_ss [measure_of] THEN DISCH_TAC THEN
7087 ABS_TAC THEN COND_CASES_TAC THEN FULL_SIMP_TAC std_ss []
7088QED
7089
7090Theorem measure_of_eq' : (* was: measure_eqI *)
7091 !M N. measure_space M /\ measure_space N /\
7092 measurable_sets M = measurable_sets N /\
7093 (!A. A IN measurable_sets M ==> measure M A = measure N A) ==>
7094 measure_of M = measure_of N
7095Proof
7096 RW_TAC std_ss [] THEN ONCE_REWRITE_TAC [measure_of_reduce] THEN
7097 KNOW_TAC ``m_space M = m_space N`` THENL
7098 [METIS_TAC [sets_eq_imp_space_eq], DISCH_TAC] THEN
7099 ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC measure_of_eq THEN
7100 FULL_SIMP_TAC std_ss [measure_space_def] THEN
7101 FULL_SIMP_TAC std_ss [sigma_sets_eq, sigma_algebra_iff2]
7102QED
7103
7104(* This is HVG's original definition, ‘sigma_finite’ is unnecessary *)
7105Theorem finite_measure_space :
7106 !m. finite_measure_space m <=> sigma_finite_measure_space m /\
7107 measure m (m_space m) <> PosInf
7108Proof
7109 rw [finite_measure_space_def, sigma_finite_measure_space_def]
7110 >> EQ_TAC >> rw []
7111 >> MATCH_MP_TAC FINITE_IMP_SIGMA_FINITE >> art []
7112QED
7113
7114(* Helper lemmas for later results *)
7115
7116Theorem measure_absolutely_continuous_self:
7117 ∀m. measure m ≪ m
7118Proof
7119 simp[measure_absolutely_continuous_def]
7120QED
7121
7122Theorem measure_absolutely_continuous_trans:
7123 ∀m u v. u << m ∧ v << (m_space m,measurable_sets m,u) ⇒ v << m
7124Proof
7125 simp[measure_absolutely_continuous_def]
7126QED
7127
7128Theorem sigma_finite_measure_space_measure_space:
7129 ∀m. sigma_finite_measure_space m ⇒ measure_space m
7130Proof
7131 simp[sigma_finite_measure_space_def]
7132QED
7133
7134(* References:
7135
7136 [1] Schilling, R.L.: Measures, Integrals and Martingales (Second Edition).
7137 Cambridge University Press (2017).
7138 [2] Mhamdi, T., Hasan, O., Tahar, S.: Formalization of Measure Theory and Lebesgue
7139 Integration for Probabilistic Analysis in HOL. ACM Trans. Embedded Comput.
7140 Syst. 12, 1--23 (2013).
7141 [4] Hurd, J.: Formal verification of probabilistic algorithms. University of
7142 Cambridge (2001).
7143 [5] Chung, K.L.: A Course in Probability Theory, Third Edition. Academic Press
7144 (2001).
7145 [7] Coble, A.R.: Anonymity, information, and machine-assisted proof. University
7146 of Cambridge (2010).
7147 [9] Wikipedia: https://en.wikipedia.org/wiki/Constantin_Carath%C3%A9odory
7148
7149 *)