sigma_algebraScript.sml
1(* ------------------------------------------------------------------------- *)
2(* The (shared) theory of sigma-algebra and other systems of sets (ring, *)
3(* semiring, and dynkin system) used in measureTheory/real_measureTheory *)
4(* *)
5(* Author: Chun Tian (2018 - 2025) *)
6(* ------------------------------------------------------------------------- *)
7(* Based on the work of Tarek Mhamdi, Osman Hasan, Sofiene Tahar [3] *)
8(* HVG Group, Concordia University, Montreal (2013, 2015) *)
9(* *)
10(* With some further additions by M. Qasim & W. Ahmed (2019) *)
11(* ------------------------------------------------------------------------- *)
12(* Based on the work of Joe Hurd [1] (2001) and Aaron Coble [2] (2010) *)
13(* Cambridge University. *)
14(* ------------------------------------------------------------------------- *)
15Theory sigma_algebra
16Ancestors
17 arithmetic option pair combin pred_set topology iterate
18 prim_rec metric real
19Libs
20 pred_setLib numLib hurdUtils jrhUtils res_quanTools
21
22
23val DISC_RW_KILL = DISCH_TAC >> ONCE_ASM_REWRITE_TAC [] >> POP_ASSUM K_TAC;
24fun METIS ths tm = prove(tm, METIS_TAC ths);
25val set_ss = std_ss ++ PRED_SET_ss;
26val std_ss' = std_ss ++ boolSimps.ETA_ss;
27val S_TAC = rpt (POP_ASSUM MP_TAC) >> rpt RESQ_STRIP_TAC;
28val Strip = S_TAC;
29
30val _ = hide "S";
31
32(* ------------------------------------------------------------------------- *)
33
34val _ = set_fixity "->" (Infixr 250);
35Overload "->" = “FUNSET :'a set -> 'b set -> ('a -> 'b) set”
36
37(* NOTE: this is "Pi" in Isabelle's FuncSet.thy *)
38Overload "-->" = “DFUNSET :'a set -> ('a -> 'b set) -> ('a -> 'b) set”
39
40(* RIGHTWARDS ARROW *)
41val _ = Unicode.unicode_version {u = UTF8.chr 0x2192, tmnm = "->"};
42
43(* LONG RIGHTWARDS ARROW *)
44val _ = Unicode.unicode_version {u = UTF8.chr 0x27F6, tmnm = "-->"};
45
46val _ = TeX_notation {hol = "->", TeX = ("\\HOLTokenMap{}", 1)};
47val _ = TeX_notation {hol = UTF8.chr 0x2192, TeX = ("\\HOLTokenMap{}", 1)};
48val _ = TeX_notation {hol = "-->", TeX = ("\\HOLTokenLongmap{}", 1)};
49val _ = TeX_notation {hol = UTF8.chr 0x27F6, TeX = ("\\HOLTokenLongmap{}", 1)};
50
51Definition prod_sets_def :
52 prod_sets a b = {s CROSS t | s IN a /\ t IN b}
53End
54
55Theorem IN_PROD_SETS[simp] :
56 !s a b. s IN prod_sets a b <=> ?t u. (s = t CROSS u) /\ t IN a /\ u IN b
57Proof
58 RW_TAC std_ss [prod_sets_def, GSPECIFICATION, UNCURRY]
59 >> EQ_TAC >- PROVE_TAC []
60 >> RW_TAC std_ss []
61 >> Q.EXISTS_TAC `(t,u)`
62 >> RW_TAC std_ss []
63QED
64
65Theorem finite_enumeration_of_sets_has_max_non_empty :
66 !f s. FINITE s /\ (!x. f x IN s) /\
67 (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
68 ?N. !(n :num). n >= N ==> (f n = {})
69Proof
70 Suff
71 `!s. FINITE s ==>
72 (\s. !f. (!x. f x IN {} INSERT s) /\
73 (~({} IN s)) /\
74 (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
75 ?N. !n:num. n >= N ==> (f n = {})) s`
76 >- (rpt STRIP_TAC \\
77 Cases_on `{} IN s`
78 >- (Q.PAT_X_ASSUM `!s. FINITE s ==> P` (MP_TAC o Q.SPEC `s DELETE {}`) \\
79 RW_TAC std_ss [FINITE_DELETE, IN_INSERT, IN_DELETE]) \\
80 METIS_TAC [IN_INSERT])
81 >> MATCH_MP_TAC FINITE_INDUCT
82 >> RW_TAC std_ss [NOT_IN_EMPTY, IN_INSERT]
83 >> Q.PAT_X_ASSUM `!f. (!x. (f x = {}) \/ f x IN s) /\ ~({} IN s) /\
84 (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
85 ?N:num. !n. n >= N ==> (f n = {})`
86 (MP_TAC o Q.SPEC `(\x. if f x = e then {} else f x)`)
87 >> `(!x. ((\x. (if f x = e then {} else f x)) x = {}) \/
88 (\x. (if f x = e then {} else f x)) x IN s) /\ ~({} IN s)`
89 by METIS_TAC []
90 >> ASM_SIMP_TAC std_ss []
91 >> `(!m n. ~(m = n) ==> DISJOINT (if f m = e then {} else f m)
92 (if f n = e then {} else f n))`
93 by (RW_TAC std_ss [IN_DISJOINT, NOT_IN_EMPTY] \\
94 METIS_TAC [IN_DISJOINT])
95 >> ASM_SIMP_TAC std_ss []
96 >> RW_TAC std_ss []
97 >> Cases_on `?n. f n = e`
98 >- (FULL_SIMP_TAC std_ss [] \\
99 Cases_on `n < N`
100 >- (Q.EXISTS_TAC `N` \\
101 RW_TAC std_ss [GREATER_EQ] \\
102 `~(n' = n)` by METIS_TAC [LESS_LESS_EQ_TRANS,
103 DECIDE ``!m (n:num). m < n ==> ~(m=n)``] \\
104 Cases_on `f n' = f n`
105 >- (`DISJOINT (f n') (f n)` by METIS_TAC [] \\
106 FULL_SIMP_TAC std_ss [IN_DISJOINT, EXTENSION, NOT_IN_EMPTY] \\
107 METIS_TAC []) \\
108 Q.PAT_X_ASSUM `!n'. n' >= N ==> ((if f n' = f n then {} else f n') = {})`
109 (MP_TAC o Q.SPEC `n'`) \\
110 ASM_SIMP_TAC std_ss [GREATER_EQ]) \\
111 Q.EXISTS_TAC `SUC n` \\
112 RW_TAC std_ss [GREATER_EQ] \\
113 FULL_SIMP_TAC std_ss [NOT_LESS] \\
114 `~(n' = n)` by METIS_TAC [LESS_LESS_EQ_TRANS, DECIDE ``!n:num. n < SUC n``,
115 DECIDE ``!m (n:num). m < n ==> ~(m=n)``] \\
116 Cases_on `f n' = f n`
117 >- (`DISJOINT (f n') (f n)` by METIS_TAC [] \\
118 FULL_SIMP_TAC std_ss [IN_DISJOINT, EXTENSION, NOT_IN_EMPTY] \\
119 METIS_TAC []) \\
120 `N <= n'` by METIS_TAC [LESS_EQ_IMP_LESS_SUC, LESS_LESS_EQ_TRANS,
121 LESS_IMP_LESS_OR_EQ] \\
122 Q.PAT_X_ASSUM `!n'. n' >= N ==> ((if f n' = f n then {} else f n') = {})`
123 (MP_TAC o Q.SPEC `n'`) \\
124 ASM_SIMP_TAC std_ss [GREATER_EQ])
125 >> METIS_TAC []
126QED
127
128Theorem GBIGUNION_IMAGE:
129 !s p n. {s | ?n. p s n} = BIGUNION (IMAGE (\n. {s | p s n}) UNIV)
130Proof
131 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_BIGUNION_IMAGE, IN_UNIV]
132QED
133
134Theorem DISJOINT_RESTRICT_L :
135 !s t c. DISJOINT s t ==> DISJOINT (s INTER c) (t INTER c)
136Proof SET_TAC []
137QED
138
139Theorem DISJOINT_RESTRICT_R :
140 !s t c. DISJOINT s t ==> DISJOINT (c INTER s) (c INTER t)
141Proof SET_TAC []
142QED
143
144Theorem DISJOINT_CROSS_L :
145 !s t c. DISJOINT s t ==> DISJOINT (s CROSS c) (t CROSS c)
146Proof
147 RW_TAC std_ss [DISJOINT_ALT, CROSS_DEF, Once EXTENSION, IN_INTER,
148 NOT_IN_EMPTY, GSPECIFICATION]
149QED
150
151Theorem DISJOINT_CROSS_R :
152 !s t c. DISJOINT s t ==> DISJOINT (c CROSS s) (c CROSS t)
153Proof
154 RW_TAC std_ss [DISJOINT_ALT, CROSS_DEF, Once EXTENSION, IN_INTER,
155 NOT_IN_EMPTY, GSPECIFICATION]
156QED
157
158Theorem SUBSET_RESTRICT_L :
159 !r s t. s SUBSET t ==> (s INTER r) SUBSET (t INTER r)
160Proof SET_TAC []
161QED
162
163Theorem SUBSET_RESTRICT_R :
164 !r s t. s SUBSET t ==> (r INTER s) SUBSET (r INTER t)
165Proof SET_TAC []
166QED
167
168Theorem SUBSET_RESTRICT_DIFF :
169 !r s t. s SUBSET t ==> (r DIFF t) SUBSET (r DIFF s)
170Proof SET_TAC []
171QED
172
173Theorem SUBSET_INTER_SUBSET_L :
174 !r s t. s SUBSET t ==> (s INTER r) SUBSET t
175Proof SET_TAC []
176QED
177
178Theorem SUBSET_INTER_SUBSET_R :
179 !r s t. s SUBSET t ==> (r INTER s) SUBSET t
180Proof SET_TAC []
181QED
182
183Theorem SUBSET_MONO_DIFF :
184 !r s t. s SUBSET t ==> (s DIFF r) SUBSET (t DIFF r)
185Proof SET_TAC []
186QED
187
188Theorem SUBSET_DIFF_SUBSET :
189 !r s t. s SUBSET t ==> (s DIFF r) SUBSET t
190Proof SET_TAC []
191QED
192
193Theorem SUBSET_DIFF_DISJOINT :
194 !s1 s2 s3. (s1 SUBSET (s2 DIFF s3)) ==> DISJOINT s1 s3
195Proof
196 PROVE_TAC [SUBSET_DIFF]
197QED
198
199(* ------------------------------------------------------------------------- *)
200(* Binary Unions *)
201(* ------------------------------------------------------------------------- *)
202
203Definition binary_def :
204 binary a b = (\x:num. if x = 0 then a else b)
205End
206
207Theorem BINARY_RANGE : (* was: range_binary_eq *)
208 !a b. IMAGE (binary a b) UNIV = {a;b}
209Proof
210 RW_TAC std_ss [IMAGE_DEF, binary_def] THEN
211 SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, SET_RULE
212 ``x IN {a;b} <=> (x = a) \/ (x = b)``] THEN
213 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
214 [METIS_TAC [], METIS_TAC [IN_UNIV],
215 EXISTS_TAC ``1:num`` THEN ASM_SIMP_TAC arith_ss [IN_UNIV]]
216QED
217
218Theorem UNION_BINARY : (* was: Un_range_binary *)
219 !a b. a UNION b = BIGUNION {binary a b i | i IN UNIV}
220Proof
221 SIMP_TAC arith_ss [GSYM IMAGE_DEF] THEN
222 REWRITE_TAC [METIS [ETA_AX] ``(\i. binary a b i) = binary a b``] THEN
223 SIMP_TAC std_ss [BINARY_RANGE] THEN SET_TAC []
224QED
225
226Theorem INTER_BINARY : (* was: Int_range_binary *)
227 !a b. a INTER b = BIGINTER {binary a b i | i IN UNIV}
228Proof
229 SIMP_TAC arith_ss [GSYM IMAGE_DEF] THEN
230 REWRITE_TAC [METIS [ETA_AX] ``(\i. binary a b i) = binary a b``] THEN
231 SIMP_TAC std_ss [BINARY_RANGE] THEN SET_TAC []
232QED
233
234Theorem FINITE_TWO :
235 !s t. FINITE {s; t}
236Proof
237 PROVE_TAC [FINITE_INSERT, FINITE_SING]
238QED
239
240Theorem SUBSET_TWO :
241 !N s t. N SUBSET {s; t} /\ N <> {} ==> N = {s} \/ N = {t} \/ N = {s; t}
242Proof
243 rpt GEN_TAC >> SET_TAC []
244QED
245
246(* ------------------------------------------------------------------------- *)
247(* Some lemmas needed by CARATHEODORY in measureTheory *)
248(* ------------------------------------------------------------------------- *)
249
250Theorem DINTER_IMP_FINITE_INTER:
251 !sts f. (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\
252 f IN (UNIV -> sts)
253 ==> !n. 0 < n ==> BIGINTER (IMAGE f (count n)) IN sts
254Proof
255 rpt GEN_TAC
256 >> STRIP_TAC
257 >> Induct_on `n`
258 >> RW_TAC arith_ss []
259 >> fs [IN_FUNSET, IN_UNIV]
260 >> STRIP_ASSUME_TAC (Q.SPEC `n` LESS_0_CASES)
261 >- RW_TAC std_ss [COUNT_SUC, COUNT_ZERO, IMAGE_INSERT, IMAGE_EMPTY,
262 BIGINTER_INSERT, IMAGE_EMPTY, BIGINTER_EMPTY, INTER_UNIV]
263 >> fs [COUNT_SUC]
264QED
265
266(* Dual lemma of above, used in "ring_and_semiring" *)
267Theorem DUNION_IMP_FINITE_UNION:
268 !sts f. (!s t. s IN sts /\ t IN sts ==> s UNION t IN sts) ==>
269 !n. 0 < n /\ (!i. i < n ==> f i IN sts) ==>
270 BIGUNION (IMAGE f (count n)) IN sts
271Proof
272 rpt GEN_TAC
273 >> STRIP_TAC
274 >> Induct_on `n`
275 >> RW_TAC arith_ss []
276 >> fs [IN_FUNSET, IN_UNIV]
277 >> STRIP_ASSUME_TAC (Q.SPEC `n` LESS_0_CASES)
278 >- RW_TAC std_ss [COUNT_SUC, COUNT_ZERO, IMAGE_INSERT, IMAGE_EMPTY,
279 BIGUNION_INSERT, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY]
280 >> fs [COUNT_SUC]
281QED
282
283Theorem GEN_DIFF_INTER:
284 !sp s t. s SUBSET sp /\ t SUBSET sp ==> (s DIFF t = s INTER (sp DIFF t))
285Proof
286 rpt STRIP_TAC
287 >> ASM_SET_TAC []
288QED
289
290Theorem GEN_COMPL_UNION:
291 !sp s t. s SUBSET sp /\ t SUBSET sp ==>
292 (sp DIFF (s UNION t) = (sp DIFF s) INTER (sp DIFF t))
293Proof
294 rpt STRIP_TAC
295 >> ASM_SET_TAC []
296QED
297
298Theorem GEN_COMPL_INTER:
299 !sp s t. s SUBSET sp /\ t SUBSET sp ==>
300 (sp DIFF (s INTER t) = (sp DIFF s) UNION (sp DIFF t))
301Proof
302 rpt STRIP_TAC
303 >> ASM_SET_TAC []
304QED
305
306Theorem COMPL_BIGINTER_IMAGE :
307 !f. COMPL (BIGINTER (IMAGE f univ(:num))) =
308 BIGUNION (IMAGE (COMPL o f) univ(:num))
309Proof
310 RW_TAC std_ss [EXTENSION, IN_COMPL, IN_BIGINTER_IMAGE,
311 IN_BIGUNION_IMAGE, IN_UNIV]
312QED
313
314Theorem COMPL_BIGUNION_IMAGE :
315 !f. COMPL (BIGUNION (IMAGE f univ(:num))) =
316 BIGINTER (IMAGE (COMPL o f) univ(:num))
317Proof
318 RW_TAC std_ss [EXTENSION, IN_COMPL, IN_BIGINTER_IMAGE,
319 IN_BIGUNION_IMAGE, IN_UNIV]
320QED
321
322Theorem GEN_COMPL_BIGINTER_IMAGE:
323 !sp f. (!n. f n SUBSET sp) ==>
324 (sp DIFF (BIGINTER (IMAGE f univ(:num))) =
325 BIGUNION (IMAGE (\n. sp DIFF (f n)) univ(:num)))
326Proof
327 RW_TAC std_ss [EXTENSION, IN_DIFF, IN_BIGINTER_IMAGE, IN_BIGUNION_IMAGE, IN_UNIV]
328 >> EQ_TAC >> rpt STRIP_TAC >> art []
329 >- (Q.EXISTS_TAC `y` >> art [])
330 >> Q.EXISTS_TAC `n` >> art []
331QED
332
333Theorem GEN_COMPL_BIGUNION_IMAGE:
334 !sp f. (!n. f n SUBSET sp) ==>
335 (sp DIFF (BIGUNION (IMAGE f univ(:num))) =
336 BIGINTER (IMAGE (\n. sp DIFF (f n)) univ(:num)))
337Proof
338 RW_TAC std_ss [EXTENSION, IN_DIFF, IN_BIGINTER_IMAGE, IN_BIGUNION_IMAGE, IN_UNIV]
339 >> EQ_TAC >> rpt STRIP_TAC >> art []
340 >> METIS_TAC []
341QED
342
343Theorem COMPL_BIGINTER:
344 !c. COMPL (BIGINTER c) = BIGUNION (IMAGE COMPL c)
345Proof
346 RW_TAC std_ss [EXTENSION, IN_COMPL, IN_BIGINTER, IN_BIGUNION_IMAGE]
347QED
348
349Theorem COMPL_BIGUNION:
350 !c. c <> {} ==> (COMPL (BIGUNION c) = BIGINTER (IMAGE COMPL c))
351Proof
352 RW_TAC std_ss [NOT_IN_EMPTY, EXTENSION, IN_COMPL, IN_BIGUNION, IN_BIGINTER_IMAGE]
353 >> EQ_TAC >> rpt STRIP_TAC
354 >> PROVE_TAC []
355QED
356
357Theorem GEN_COMPL_BIGINTER:
358 !sp c. (!x. x IN c ==> x SUBSET sp) ==>
359 (sp DIFF (BIGINTER c) = BIGUNION (IMAGE (\x. sp DIFF x) c))
360Proof
361 RW_TAC std_ss [EXTENSION, IN_DIFF, IN_BIGINTER, IN_BIGUNION_IMAGE]
362 >> EQ_TAC >> rpt STRIP_TAC >> art []
363 >- (Q.EXISTS_TAC `P` >> art [])
364 >> Q.EXISTS_TAC `x'` >> art []
365QED
366
367Theorem GEN_COMPL_BIGUNION:
368 !sp c. c <> {} /\ (!x. x IN c ==> x SUBSET sp) ==>
369 (sp DIFF (BIGUNION c) = BIGINTER (IMAGE (\x. sp DIFF x) c))
370Proof
371 RW_TAC std_ss [EXTENSION, IN_DIFF, IN_BIGINTER, IN_BIGUNION, IN_BIGINTER_IMAGE,
372 NOT_IN_EMPTY]
373 >> EQ_TAC >> rpt STRIP_TAC >> art []
374 >> METIS_TAC []
375QED
376
377Theorem GEN_COMPL_FINITE_UNION :
378 !sp f n. 0 < n ==> sp DIFF BIGUNION (IMAGE f (count n)) =
379 BIGINTER (IMAGE (\i. sp DIFF f i) (count n))
380Proof
381 NTAC 2 GEN_TAC
382 >> Induct_on `n`
383 >> RW_TAC arith_ss []
384 >> STRIP_ASSUME_TAC (Q.SPEC `n` LESS_0_CASES)
385 >- RW_TAC std_ss [COUNT_SUC, COUNT_ZERO, IMAGE_INSERT, IMAGE_EMPTY, BIGINTER_SING,
386 BIGUNION_INSERT, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY]
387 >> fs [COUNT_SUC]
388 >> ONCE_REWRITE_TAC [UNION_COMM]
389 >> ASM_REWRITE_TAC [DIFF_UNION]
390 >> REWRITE_TAC [DIFF_INTER]
391 >> Suff `(BIGINTER (IMAGE (\i. sp DIFF f i) (count n)) DIFF f n) SUBSET sp`
392 >- (KILL_TAC \\
393 DISCH_THEN (ASSUME_TAC o (MATCH_MP SUBSET_INTER2)) >> ASM_SET_TAC [])
394 >> MATCH_MP_TAC SUBSET_TRANS
395 >> Q.EXISTS_TAC `BIGINTER (IMAGE (\i. sp DIFF f i) (count n))`
396 >> REWRITE_TAC [DIFF_SUBSET]
397 >> REWRITE_TAC [SUBSET_DEF, IN_BIGINTER_IMAGE, IN_COUNT] >> BETA_TAC
398 >> RW_TAC std_ss [IN_DIFF]
399 >> PROVE_TAC []
400QED
401
402Theorem BIGINTER_PAIR:
403 !s t. BIGINTER {s; t} = s INTER t
404Proof
405 RW_TAC std_ss [EXTENSION, IN_BIGINTER, IN_INTER, IN_INSERT, NOT_IN_EMPTY]
406 >> PROVE_TAC []
407QED
408
409Theorem DIFF_INTER_PAIR :
410 !sp x y. sp DIFF (x INTER y) = (sp DIFF x) UNION (sp DIFF y)
411Proof
412 rpt GEN_TAC
413 >> REWRITE_TAC [REWRITE_RULE [BIGINTER_PAIR]
414 (Q.SPECL [`sp`, `{x; y}`] DIFF_BIGINTER1)]
415 >> REWRITE_TAC [EXTENSION, IN_UNION, IN_BIGUNION_IMAGE]
416 >> BETA_TAC
417 >> GEN_TAC >> EQ_TAC >> rpt STRIP_TAC
418 >| [ fs [IN_INSERT] >> PROVE_TAC [],
419 Q.EXISTS_TAC `x` >> ASM_REWRITE_TAC [IN_INSERT],
420 Q.EXISTS_TAC `y` >> ASM_REWRITE_TAC [IN_INSERT] ]
421QED
422
423Theorem GEN_COMPL_FINITE_INTER:
424 !sp f n. 0 < n ==> (sp DIFF BIGINTER (IMAGE f (count n)) =
425 BIGUNION (IMAGE (\i. sp DIFF f i) (count n)))
426Proof
427 NTAC 2 GEN_TAC
428 >> Induct_on `n`
429 >> RW_TAC arith_ss []
430 >> STRIP_ASSUME_TAC (Q.SPEC `n` LESS_0_CASES)
431 >- RW_TAC std_ss [COUNT_SUC, COUNT_ZERO, IMAGE_INSERT, IMAGE_EMPTY, BIGINTER_SING,
432 BIGUNION_INSERT, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY]
433 >> fs [COUNT_SUC]
434 >> ASM_REWRITE_TAC [DIFF_INTER_PAIR]
435QED
436
437(* This proof is provided by Thomas Tuerk, needed by SETS_TO_DISJOINT_SETS *)
438Theorem BIGUNION_IMAGE_COUNT_IMP_UNIV :
439 !f g. (!n. BIGUNION (IMAGE g (count n)) = BIGUNION (IMAGE f (count n))) ==>
440 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
441Proof
442 `!f g. (!n. BIGUNION (IMAGE g (count n)) = BIGUNION (IMAGE f (count n))) ==>
443 (BIGUNION (IMAGE f UNIV) SUBSET BIGUNION (IMAGE g UNIV))`
444 suffices_by PROVE_TAC [SUBSET_ANTISYM]
445 >> REWRITE_TAC [SUBSET_DEF]
446 >> REPEAT STRIP_TAC
447 >> rename1 `e IN BIGUNION _`
448 >> Know `?n. e IN BIGUNION (IMAGE f (count n))`
449 >- (FULL_SIMP_TAC std_ss [IN_BIGUNION, IN_IMAGE, PULL_EXISTS, IN_COUNT] \\
450 rename1 `e IN f n'` \\
451 Q.EXISTS_TAC `SUC n'` \\
452 Q.EXISTS_TAC `n'` \\
453 ASM_SIMP_TAC arith_ss [])
454 >> STRIP_TAC
455 >> `e IN BIGUNION (IMAGE g (count n))` by PROVE_TAC []
456 >> FULL_SIMP_TAC std_ss [IN_BIGUNION, IN_IMAGE, PULL_EXISTS, IN_UNIV]
457 >> METIS_TAC []
458QED
459
460Theorem BIGUNION_OVER_INTER_L :
461 !f s d. BIGUNION (IMAGE f s) INTER d = BIGUNION (IMAGE (\i. f i INTER d) s)
462Proof
463 rw [Once EXTENSION]
464 >> EQ_TAC >> rw []
465 >| [ (* goal 1 (of 3) *)
466 rename1 ‘y IN s’ \\
467 Q.EXISTS_TAC ‘f y INTER d’ >> rw [] \\
468 Q.EXISTS_TAC ‘y’ >> rw [],
469 (* goal 2 (of 3) *)
470 fs [] \\
471 Q.EXISTS_TAC ‘f i’ >> rw [] \\
472 Q.EXISTS_TAC ‘i’ >> rw [],
473 (* goal 3 (of 3) *)
474 fs [] ]
475QED
476
477(* |- !f s d. d INTER BIGUNION (IMAGE f s) = BIGUNION (IMAGE (\i. d INTER f i) s) *)
478Theorem BIGUNION_OVER_INTER_R = ONCE_REWRITE_RULE [INTER_COMM] BIGUNION_OVER_INTER_L
479
480Theorem BIGUNION_OVER_DIFF :
481 !f s d. BIGUNION (IMAGE f s) DIFF d = BIGUNION (IMAGE (\i. f i DIFF d) s)
482Proof
483 rw [Once EXTENSION]
484 >> EQ_TAC >> rw []
485 >| [ (* goal 1 (of 3) *)
486 rename1 ‘y IN s’ \\
487 Q.EXISTS_TAC ‘f y DIFF d’ >> rw [] \\
488 Q.EXISTS_TAC ‘y’ >> rw [],
489 (* goal 2 (of 3) *)
490 fs [] \\
491 Q.EXISTS_TAC ‘f i’ >> art [] \\
492 Q.EXISTS_TAC ‘i’ >> art [],
493 (* goal 3 (of 3) *)
494 fs [] ]
495QED
496
497Theorem BIGUNION_IMAGE_UNION :
498 !f g s. BIGUNION (IMAGE f s) UNION BIGUNION (IMAGE g s) =
499 BIGUNION (IMAGE (\i. f i UNION g i) s)
500Proof
501 rw [Once EXTENSION, IN_BIGUNION_IMAGE]
502 >> EQ_TAC >> rw [] (* 4 subgoals *)
503 >| [ (* goal 1 (of 4) *)
504 rename1 ‘x IN f n’ \\
505 Q.EXISTS_TAC ‘n’ >> art [],
506 (* goal 2 (of 4) *)
507 rename1 ‘x IN g n’ \\
508 Q.EXISTS_TAC ‘n’ >> art [],
509 (* goal 3 (of 4) *)
510 DISJ1_TAC >> Q.EXISTS_TAC ‘i’ >> art [],
511 (* goal 4 (of 4) *)
512 DISJ2_TAC >> Q.EXISTS_TAC ‘i’ >> art [] ]
513QED
514
515Theorem BIGINTER_OVER_INTER_L :
516 !f s d. s <> {} ==> (BIGINTER (IMAGE f s) INTER d =
517 BIGINTER (IMAGE (\i. f i INTER d) s))
518Proof
519 rpt STRIP_TAC
520 >> rw [Once EXTENSION]
521 >> EQ_TAC >> rw []
522 >| [ (* goal 1 (of 3) *)
523 rw [] >> FIRST_X_ASSUM MATCH_MP_TAC \\
524 Q.EXISTS_TAC ‘i’ >> rw [],
525 (* goal 2 (of 3) *)
526 rename1 ‘y IN s’ \\
527 Suff ‘x IN (f y INTER d)’ >- rw [] \\
528 FIRST_X_ASSUM MATCH_MP_TAC \\
529 Q.EXISTS_TAC ‘y’ >> rw [],
530 (* goal 3 (of 3) *)
531 fs [GSYM MEMBER_NOT_EMPTY] \\
532 rename1 ‘i IN s’ \\
533 Suff ‘x IN f i INTER d’ >- rw [] \\
534 FIRST_X_ASSUM MATCH_MP_TAC \\
535 Q.EXISTS_TAC ‘i’ >> rw [] ]
536QED
537
538(* |- !f s d. s <> {} ==>
539 d INTER BIGINTER (IMAGE f s) = BIGINTER (IMAGE (\i. d INTER f i) s)
540 *)
541Theorem BIGINTER_OVER_INTER_R = ONCE_REWRITE_RULE [INTER_COMM] BIGINTER_OVER_INTER_L
542
543(* any finite set can be decomposed into a finite sequence of sets *)
544Theorem finite_decomposition_simple:
545 !c. FINITE c ==> ?f n. (!x. x < n ==> f x IN c) /\ (c = IMAGE f (count n))
546Proof
547 GEN_TAC
548 >> REWRITE_TAC [FINITE_BIJ_COUNT_EQ]
549 >> rpt STRIP_TAC
550 >> rename1 `BIJ f (count n) c`
551 >> Q.EXISTS_TAC `f`
552 >> Q.EXISTS_TAC `n`
553 >> CONJ_TAC >- (rpt STRIP_TAC >> PROVE_TAC [BIJ_DEF, INJ_DEF, IN_COUNT])
554 >> PROVE_TAC [BIJ_IMAGE]
555QED
556
557(* any finite set can be decomposed into a finite (non-repeated) sequence of sets *)
558Theorem finite_decomposition :
559 !c. FINITE c ==>
560 ?f n. (!x. x < n ==> f x IN c) /\ (c = IMAGE f (count n)) /\
561 (!i j. i < n /\ j < n /\ i <> j ==> f i <> f j)
562Proof
563 GEN_TAC
564 >> REWRITE_TAC [FINITE_BIJ_COUNT_EQ]
565 >> rpt STRIP_TAC
566 >> rename1 `BIJ f (count n) c`
567 >> Q.EXISTS_TAC `f`
568 >> Q.EXISTS_TAC `n`
569 >> CONJ_TAC >- (rpt STRIP_TAC >> PROVE_TAC [BIJ_DEF, INJ_DEF, IN_COUNT])
570 >> CONJ_TAC >- PROVE_TAC [BIJ_IMAGE]
571 >> rpt STRIP_TAC
572 >> fs [BIJ_ALT, IN_FUNSET, IN_COUNT]
573 >> METIS_TAC []
574QED
575
576(* any finite disjoint set can be decomposed into a finite pair-wise
577 disjoint sequence of sets *)
578Theorem finite_disjoint_decomposition :
579 !c. FINITE c /\ disjoint c ==>
580 ?f n. (!i. i < n ==> f i IN c) /\ (c = IMAGE f (count n)) /\
581 (!i j. i < n /\ j < n /\ i <> j ==> f i <> f j) /\
582 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j))
583Proof
584 GEN_TAC
585 >> REWRITE_TAC [FINITE_BIJ_COUNT_EQ]
586 >> rpt STRIP_TAC
587 >> rename1 `BIJ f (count n) c`
588 >> Q.EXISTS_TAC `f`
589 >> Q.EXISTS_TAC `n`
590 >> STRONG_CONJ_TAC
591 >- (rpt STRIP_TAC >> PROVE_TAC [BIJ_DEF, INJ_DEF, IN_COUNT])
592 >> DISCH_TAC
593 >> CONJ_TAC >- PROVE_TAC [BIJ_IMAGE]
594 >> STRONG_CONJ_TAC
595 >- (rpt STRIP_TAC \\
596 fs [BIJ_ALT, IN_FUNSET, IN_COUNT] >> METIS_TAC [])
597 >> rpt STRIP_TAC
598 >> fs [disjoint_def]
599 >> FIRST_X_ASSUM MATCH_MP_TAC
600 >> METIS_TAC []
601QED
602
603(* cf. cardinalTheory. disjoint_countable_decomposition *)
604Theorem finite_disjoint_decomposition' :
605 !c. FINITE c /\ disjoint c ==>
606 ?f n. (!i. i < n ==> f i IN c) /\ (!i. n <= i ==> (f i = {})) /\
607 (c = IMAGE f (count n)) /\
608 (BIGUNION c = BIGUNION (IMAGE f univ(:num))) /\
609 (!i j. i < n /\ j < n /\ i <> j ==> f i <> f j) /\
610 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j))
611Proof
612 rpt STRIP_TAC
613 >> STRIP_ASSUME_TAC
614 (MATCH_MP finite_disjoint_decomposition
615 (CONJ (ASSUME ``FINITE (c :'a set set)``)
616 (ASSUME ``disjoint (c :'a set set)``)))
617 >> Q.EXISTS_TAC `\i. if i < n then f i else {}`
618 >> Q.EXISTS_TAC `n`
619 >> BETA_TAC
620 >> CONJ_TAC >- METIS_TAC []
621 >> CONJ_TAC >- METIS_TAC [NOT_LESS]
622 >> CONJ_TAC
623 >- (art [] >> MATCH_MP_TAC IMAGE_CONG >> RW_TAC std_ss [IN_COUNT])
624 >> reverse CONJ_TAC >- METIS_TAC []
625 >> art [] >> KILL_TAC
626 >> SIMP_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_COUNT, IN_UNIV]
627 >> GEN_TAC >> EQ_TAC >> rpt STRIP_TAC
628 >| [ Q.EXISTS_TAC `x'` >> METIS_TAC [],
629 Cases_on `i < n` >- (Q.EXISTS_TAC `i` >> METIS_TAC []) \\
630 fs [NOT_IN_EMPTY] ]
631QED
632
633(* any union of two sets can be decomposed into 3 disjoint unions *)
634Theorem UNION_TO_3_DISJOINT_UNIONS:
635 !s t. (s UNION t = (s DIFF t) UNION (s INTER t) UNION (t DIFF s)) /\
636 disjoint {(s DIFF t); (s INTER t); (t DIFF s)}
637Proof
638 NTAC 2 GEN_TAC
639 >> CONJ_TAC >- SET_TAC []
640 >> REWRITE_TAC [disjoint_def, DISJOINT_DEF]
641 >> RW_TAC std_ss [IN_INSERT]
642 >> ASM_SET_TAC []
643QED
644
645Theorem BIGUNION_IMAGE_BIGUNION_IMAGE_UNIV:
646 !f. BIGUNION (IMAGE (\n. BIGUNION (IMAGE (f n) univ(:num))) univ(:num)) =
647 BIGUNION (IMAGE (UNCURRY f) univ(:num # num))
648Proof
649 GEN_TAC
650 >> RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV, IN_CROSS, UNCURRY]
651 >> EQ_TAC >> STRIP_TAC
652 >- (Q.EXISTS_TAC `(n, x')` >> art [FST, SND])
653 >> Q.EXISTS_TAC `FST x'`
654 >> Q.EXISTS_TAC `SND x'` >> art []
655QED
656
657Theorem BIGUNION_IMAGE_UNIV_CROSS_UNIV:
658 !f (h :num -> num # num). BIJ h UNIV (UNIV CROSS UNIV) ==>
659 (BIGUNION (IMAGE (UNCURRY f) univ(:num # num)) =
660 BIGUNION (IMAGE (UNCURRY f o h) univ(:num)))
661Proof
662 rpt STRIP_TAC
663 >> RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV, IN_CROSS, UNCURRY, o_DEF]
664 >> fs [BIJ_ALT, IN_FUNSET, IN_UNIV]
665 >> EQ_TAC >> STRIP_TAC
666 >- (Q.PAT_X_ASSUM `!y. ?!x. y = h x` (MP_TAC o (Q.SPEC `x'`)) >> METIS_TAC [])
667 >> Q.EXISTS_TAC `h x'` >> art []
668QED
669
670(* ------------------------------------------------------------------------- *)
671(* Three series of lemmas on bigunion-equivalent sequences of sets *)
672(* ------------------------------------------------------------------------- *)
673
674(* 1. for any set sequence there's increasing sequence of the same bigunion. *)
675Theorem SETS_TO_INCREASING_SETS :
676 !f :num->'a set.
677 ?g. (g 0 = f 0) /\ (!n. g n = BIGUNION (IMAGE f (count (SUC n)))) /\
678 (!n. g n SUBSET g (SUC n)) /\
679 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
680Proof
681 rpt STRIP_TAC
682 >> Q.EXISTS_TAC `\n. BIGUNION (IMAGE f (count (SUC n)))`
683 >> BETA_TAC
684 >> RW_TAC bool_ss []
685 >| [ (* goal 1 (of 3) *)
686 REWRITE_TAC [COUNT_SUC, COUNT_ZERO, IMAGE_SING, BIGUNION_SING],
687 (* goal 2 (of 3) *)
688 `count (SUC (SUC n)) = (SUC n) INSERT (count (SUC n))`
689 by PROVE_TAC [COUNT_SUC] >> POP_ORW \\
690 REWRITE_TAC [IMAGE_INSERT, BIGUNION_INSERT] \\
691 REWRITE_TAC [SUBSET_UNION],
692 (* goal 3 (of 3) *)
693 MATCH_MP_TAC BIGUNION_IMAGE_COUNT_IMP_UNIV \\
694 Induct_on `n` >- REWRITE_TAC [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\
695 `count (SUC n) = n INSERT (count n)` by PROVE_TAC [COUNT_SUC] \\
696 POP_ORW >> REWRITE_TAC [IMAGE_INSERT, BIGUNION_INSERT] \\
697 POP_ASSUM (REWRITE_TAC o wrap) \\
698 BETA_TAC \\
699 Cases_on `n = 0` >> fs [COUNT_SUC, COUNT_ZERO, IMAGE_SING, BIGUNION_SING] \\
700 REWRITE_TAC [GSYM UNION_ASSOC, UNION_IDEMPOT] ]
701QED
702
703(* another version with `g 0 = {}` *)
704Theorem SETS_TO_INCREASING_SETS' :
705 !f :num -> 'a set.
706 ?g. (g 0 = {}) /\ (!n. g n = BIGUNION (IMAGE f (count n))) /\
707 (!n. g n SUBSET g (SUC n)) /\
708 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
709Proof
710 rpt STRIP_TAC
711 >> Q.EXISTS_TAC `\n. BIGUNION (IMAGE f (count n))`
712 >> BETA_TAC
713 >> RW_TAC bool_ss []
714 >| [ (* goal 1 (of 3) *)
715 REWRITE_TAC [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY],
716 (* goal 2 (of 3) *)
717 `count (SUC n) = n INSERT (count n)` by PROVE_TAC [COUNT_SUC] \\
718 POP_ORW >> REWRITE_TAC [IMAGE_INSERT, BIGUNION_INSERT] \\
719 REWRITE_TAC [SUBSET_UNION],
720 (* goal 3 (of 3) *)
721 REWRITE_TAC [EXTENSION] \\
722 GEN_TAC >> SIMP_TAC std_ss [IN_BIGUNION_IMAGE, IN_UNIV, IN_COUNT] \\
723 EQ_TAC >> RW_TAC std_ss [] >|
724 [ Q.EXISTS_TAC `SUC x'` \\
725 Q.EXISTS_TAC `x'` >> ASM_SIMP_TAC arith_ss [],
726 Q.EXISTS_TAC `x'` >> art [] ] ]
727QED
728
729(* 2. (hard) for any sequence of sets in a space, there is a disjoint family with
730 the same bigunion. This lemma is needed by DYNKIN_LEMMA.
731 *)
732Theorem SETS_TO_DISJOINT_SETS :
733 !sp sts f. (!s. s IN sts ==> s SUBSET sp) /\ (!n. f n IN sts) ==>
734 ?g. (g 0 = f 0) /\
735 (!n. 0 < n ==>
736 g n = f n INTER (BIGINTER (IMAGE (\i. sp DIFF f i) (count n)))) /\
737 (!i j :num. i <> j ==> DISJOINT (g i) (g j)) /\
738 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
739Proof
740 rpt STRIP_TAC
741 >> Q.EXISTS_TAC `\n. if n = 0:num then f n
742 else f n INTER (BIGINTER (IMAGE (\i. sp DIFF f i) (count n)))`
743 >> BETA_TAC >> SIMP_TAC arith_ss []
744 >> CONJ_TAC >> RW_TAC arith_ss []
745 >| [ (* goal 1 (of 4)
746 `DISJOINT (f 0) (f j INTER BIGINTER (IMAGE (\i. sp DIFF f i) (count j)))` *)
747 `0 IN (count j)` by PROVE_TAC [NOT_ZERO_LT_ZERO, IN_COUNT] \\
748 POP_ASSUM (MP_TAC o SYM o (MATCH_MP INSERT_DELETE)) \\
749 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
750 REWRITE_TAC [IMAGE_INSERT, BIGINTER_INSERT] >> BETA_TAC \\
751 REWRITE_TAC [INTER_ASSOC] \\
752 `f j INTER (sp DIFF f 0) = (sp DIFF f 0) INTER f j` by PROVE_TAC [INTER_COMM] \\
753 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
754 REWRITE_TAC [DIFF_INTER, DISJOINT_DIFF],
755 (* goal 2 (of 4),
756 `DISJOINT (f i INTER BIGINTER (IMAGE (\i. sp DIFF f i) (count i))) (f 0)` *)
757 `0 IN (count i)` by PROVE_TAC [NOT_ZERO_LT_ZERO, IN_COUNT] \\
758 POP_ASSUM (MP_TAC o SYM o (MATCH_MP INSERT_DELETE)) \\
759 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
760 REWRITE_TAC [IMAGE_INSERT, BIGINTER_INSERT] >> BETA_TAC \\
761 REWRITE_TAC [INTER_ASSOC] \\
762 `f i INTER (sp DIFF f 0) = (sp DIFF f 0) INTER f i` by PROVE_TAC [INTER_COMM] \\
763 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
764 REWRITE_TAC [DIFF_INTER, DISJOINT_DIFF],
765 (* goal 3 (of 4),
766 `DISJOINT (f i INTER BIGINTER (IMAGE (\i. sp DIFF f i) (count i)))
767 (f j INTER BIGINTER (IMAGE (\i. sp DIFF f i) (count j)))` *)
768 STRIP_ASSUME_TAC (Q.SPECL [`i`, `j`] LESS_LESS_CASES) >| (* 2 subgoals *)
769 [ (* goal 3.1 (of 2) *)
770 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
771 MATCH_MP_TAC DISJOINT_SUBSET \\
772 Q.EXISTS_TAC `f i` >> REWRITE_TAC [INTER_SUBSET] \\
773 `i IN (count j)` by PROVE_TAC [IN_COUNT] \\
774 POP_ASSUM (MP_TAC o SYM o (MATCH_MP INSERT_DELETE)) \\
775 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
776 REWRITE_TAC [IMAGE_INSERT, BIGINTER_INSERT] >> BETA_TAC \\
777 REWRITE_TAC [INTER_ASSOC] \\
778 `f j INTER (sp DIFF f i) = (sp DIFF f i) INTER f j` by PROVE_TAC [INTER_COMM] \\
779 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
780 REWRITE_TAC [DIFF_INTER, DISJOINT_DIFF],
781 (* goal 3.2 (of 2) *)
782 MATCH_MP_TAC DISJOINT_SUBSET \\
783 Q.EXISTS_TAC `f j` >> REWRITE_TAC [INTER_SUBSET] \\
784 `j IN (count i)` by PROVE_TAC [IN_COUNT] \\
785 POP_ASSUM (MP_TAC o SYM o (MATCH_MP INSERT_DELETE)) \\
786 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
787 REWRITE_TAC [IMAGE_INSERT, BIGINTER_INSERT] >> BETA_TAC \\
788 REWRITE_TAC [INTER_ASSOC] \\
789 `f i INTER (sp DIFF f j) = (sp DIFF f j) INTER f i` by PROVE_TAC [INTER_COMM] \\
790 POP_ASSUM (ONCE_REWRITE_TAC o wrap) \\
791 REWRITE_TAC [DIFF_INTER, DISJOINT_DIFF] ],
792 (* goal 4 (of 4) *)
793 MATCH_MP_TAC BIGUNION_IMAGE_COUNT_IMP_UNIV \\
794 Induct_on `n` >- REWRITE_TAC [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\
795 REWRITE_TAC [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT] \\
796 POP_ASSUM (REWRITE_TAC o wrap) >> BETA_TAC \\
797 Cases_on `n = 0` >> fs [] (* now ``n <> 0`` *) \\
798 REWRITE_TAC [Once UNION_COMM, INTER_OVER_UNION] \\
799 GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites [UNION_COMM] \\
800 Suff `BIGUNION (IMAGE f (count n)) UNION
801 (BIGINTER (IMAGE (\i. sp DIFF f i) (count n))) = sp`
802 >- (DISCH_THEN (REWRITE_TAC o wrap) \\
803 REWRITE_TAC [INTER_SUBSET_EQN, UNION_SUBSET] \\
804 reverse CONJ_TAC >- PROVE_TAC [] \\
805 REWRITE_TAC [BIGUNION_SUBSET, IN_IMAGE] >> PROVE_TAC []) \\
806 (* BIGUNION (IMAGE f (count n)) UNION
807 BIGINTER (IMAGE (\i. sp DIFF f i) (count n)) = sp *)
808 `0 < n` by PROVE_TAC [NOT_ZERO_LT_ZERO] \\
809 POP_ASSUM (REWRITE_TAC o wrap o GSYM o (MATCH_MP GEN_COMPL_FINITE_UNION)) \\
810 Suff `BIGUNION (IMAGE f (count n)) SUBSET sp` >- ASM_SET_TAC [] \\
811 REWRITE_TAC [BIGUNION_SUBSET, IN_IMAGE] >> PROVE_TAC [] ]
812QED
813
814(* A specific version without sts and sp *)
815Theorem SETS_TO_DISJOINT_SETS' :
816 !f. ?g. (g 0 = f 0) /\
817 (!n. 0 < n ==>
818 g n = f n INTER (BIGINTER (IMAGE (COMPL o f) (count n)))) /\
819 (!i j :num. i <> j ==> DISJOINT (g i) (g j)) /\
820 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
821Proof
822 GEN_TAC
823 >> STRIP_ASSUME_TAC (Q.SPECL [`UNIV`, `UNIV`, `f`] SETS_TO_DISJOINT_SETS)
824 >> fs [SUBSET_UNIV, o_DEF, COMPL_DEF]
825 >> Q.EXISTS_TAC `g` >> art []
826QED
827
828(* 3. (hard) for any sequence of (straightly) increasing sets, there is a disjoint
829 family with the same bigunion.
830 *)
831Theorem INCREASING_TO_DISJOINT_SETS :
832 !f :num -> 'a set. (!n. f n SUBSET f (SUC n)) ==>
833 ?g. (g 0 = f 0) /\ (!n. 0 < n ==> (g n = f n DIFF f (PRE n))) /\
834 (!i j :num. i <> j ==> DISJOINT (g i) (g j)) /\
835 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
836Proof
837 rpt STRIP_TAC
838 >> Q.EXISTS_TAC `\n. if n = (0 :num) then f n else f n DIFF f (PRE n)`
839 >> BETA_TAC
840 (* preliminaries *)
841 >> Know `!n. 0 < n ==> f 0 SUBSET (f n)`
842 >- (Induct_on `n` >- RW_TAC arith_ss [] \\
843 RW_TAC arith_ss [] \\
844 Cases_on `n = 0` >- art [] \\
845 IMP_RES_TAC NOT_ZERO_LT_ZERO >> RES_TAC \\
846 MATCH_MP_TAC SUBSET_TRANS >> Q.EXISTS_TAC `f n` >> art [])
847 >> DISCH_TAC
848 >> Know `!n. 0 < n ==> f 0 SUBSET (f (PRE n))`
849 >- (Induct_on `n` >- RW_TAC arith_ss [] \\
850 RW_TAC arith_ss [] \\
851 Cases_on `n = 0` >- art [SUBSET_REFL] \\
852 IMP_RES_TAC NOT_ZERO_LT_ZERO >> RES_TAC)
853 >> DISCH_TAC
854 >> Know `!i j. i < j ==> f (SUC i) SUBSET (f j)`
855 >- (GEN_TAC >> Induct_on `j` >- RW_TAC arith_ss [] \\
856 STRIP_TAC \\
857 fs [GSYM LESS_EQ_IFF_LESS_SUC, LESS_OR_EQ] \\
858 MATCH_MP_TAC SUBSET_TRANS >> Q.EXISTS_TAC `f j` \\
859 CONJ_TAC >- RES_TAC >> art [])
860 >> DISCH_TAC
861 >> Know `!n. 0 < n ==> f (PRE n) SUBSET f n`
862 >- (rpt STRIP_TAC \\
863 Q.PAT_X_ASSUM `!n. f n SUBSET f (SUC n)` (STRIP_ASSUME_TAC o (Q.SPEC `PRE n`)) \\
864 PROVE_TAC [SUC_PRE])
865 >> DISCH_TAC
866 >> Know `!i j. i < j ==> f i SUBSET f (PRE j)`
867 >- (GEN_TAC >> Induct_on `j` >- RW_TAC arith_ss [] \\
868 STRIP_TAC \\
869 fs [GSYM LESS_EQ_IFF_LESS_SUC, LESS_OR_EQ] \\
870 MATCH_MP_TAC SUBSET_TRANS >> Q.EXISTS_TAC `f (PRE j)` \\
871 CONJ_TAC >- RES_TAC \\
872 Cases_on `j = 0` >- (RW_TAC arith_ss [SUBSET_REFL]) \\
873 IMP_RES_TAC NOT_ZERO_LT_ZERO >> RES_TAC)
874 >> DISCH_TAC
875 >> RW_TAC arith_ss []
876 >| [ (* goal 1 (of 4): DISJOINT (f 0) (f (SUC j) DIFF f j) *)
877 MATCH_MP_TAC SUBSET_DIFF_DISJOINT \\
878 Q.EXISTS_TAC `f j` \\
879 IMP_RES_TAC NOT_ZERO_LT_ZERO \\
880 `f j DIFF (f j DIFF f (PRE j)) = f (PRE j)`
881 by PROVE_TAC [DIFF_DIFF_SUBSET] >> POP_ORW >> RES_TAC,
882 (* goal 2 (of 4): DISJOINT (f (SUC i) DIFF f i) (f 0) *)
883 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
884 MATCH_MP_TAC SUBSET_DIFF_DISJOINT \\
885 Q.EXISTS_TAC `f i` \\
886 IMP_RES_TAC NOT_ZERO_LT_ZERO \\
887 `f i DIFF (f i DIFF f (PRE i)) = f (PRE i)`
888 by PROVE_TAC [DIFF_DIFF_SUBSET] >> POP_ORW \\
889 IMP_RES_TAC NOT_ZERO_LT_ZERO >> RES_TAC,
890 (* goal 3 (of 4): DISJOINT (f (SUC i) DIFF f i) (f (SUC j) DIFF f j) *)
891 STRIP_ASSUME_TAC (Q.SPECL [`i`, `j`] LESS_LESS_CASES) >| (* 2 subgoals *)
892 [ (* goal 3.1 (of 2) *)
893 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
894 MATCH_MP_TAC DISJOINT_SUBSET \\
895 Q.EXISTS_TAC `f i` >> REWRITE_TAC [DIFF_SUBSET] \\
896 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
897 MATCH_MP_TAC SUBSET_DIFF_DISJOINT \\
898 Q.EXISTS_TAC `f j` \\
899 IMP_RES_TAC NOT_ZERO_LT_ZERO \\
900 `f j DIFF (f j DIFF f (PRE j)) = f (PRE j)`
901 by PROVE_TAC [DIFF_DIFF_SUBSET] >> POP_ORW >> RES_TAC,
902 (* goal 3.2 (of 2) *)
903 MATCH_MP_TAC DISJOINT_SUBSET \\
904 Q.EXISTS_TAC `f j` >> REWRITE_TAC [DIFF_SUBSET] \\
905 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
906 MATCH_MP_TAC SUBSET_DIFF_DISJOINT \\
907 Q.EXISTS_TAC `f i` \\
908 IMP_RES_TAC NOT_ZERO_LT_ZERO \\
909 `f i DIFF (f i DIFF f (PRE i)) = f (PRE i)`
910 by PROVE_TAC [DIFF_DIFF_SUBSET] >> POP_ORW >> RES_TAC ],
911 (* goal 4 (of 4): BIGUNION (IMAGE f univ(:num)) = ... *)
912 MATCH_MP_TAC BIGUNION_IMAGE_COUNT_IMP_UNIV \\
913 Induct_on `n` >- REWRITE_TAC [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\
914 REWRITE_TAC [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT] \\
915 POP_ASSUM (REWRITE_TAC o wrap) >> BETA_TAC \\
916 Cases_on `n = 0` >> fs [] (* now ``n <> 0`` *) \\
917 RW_TAC arith_ss [EXTENSION, IN_UNION, IN_BIGUNION_IMAGE, IN_COUNT, IN_DIFF] \\
918 EQ_TAC >> rpt STRIP_TAC >| (* 4 subgoals *)
919 [ DISJ1_TAC >> art [],
920 DISJ2_TAC >> Q.EXISTS_TAC `x'` >> art [],
921 Cases_on `x IN f (PRE n)` >- (DISJ2_TAC >> Q.EXISTS_TAC `PRE n` \\
922 ASM_SIMP_TAC arith_ss []) \\
923 DISJ1_TAC >> art [],
924 DISJ2_TAC >> Q.EXISTS_TAC `x'` >> art [] ] ]
925QED
926
927(* Surprisingly, this variant of INCREASING_TO_DISJOINT_SETS cannot be
928 easily proved without using the non-trivial SETS_TO_DISJOINT_SETS
929 *)
930Theorem INCREASING_TO_DISJOINT_SETS' :
931 !f :num -> 'a set. (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) ==>
932 ?g. (!n. g n = f (SUC n) DIFF f n) /\
933 (!i j :num. i <> j ==> DISJOINT (g i) (g j)) /\
934 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE g UNIV))
935Proof
936 rpt STRIP_TAC
937 >> Q.EXISTS_TAC `\n. f (SUC n) DIFF f n`
938 >> BETA_TAC
939 (* preliminaries *)
940 >> Know `!i j. i < j ==> f i SUBSET f j`
941 >- (GEN_TAC >> Induct_on `j` >- RW_TAC arith_ss [] \\
942 STRIP_TAC \\
943 MATCH_MP_TAC SUBSET_TRANS >> Q.EXISTS_TAC `f j` >> art [] \\
944 fs [GSYM LESS_EQ_IFF_LESS_SUC, LESS_OR_EQ])
945 >> DISCH_TAC
946 >> Know `!i j. i < j ==> f (SUC i) SUBSET f j`
947 >- (GEN_TAC >> Induct_on `j` >- RW_TAC arith_ss [] \\
948 STRIP_TAC \\
949 Cases_on `i = j` >- PROVE_TAC [SUBSET_REFL] \\
950 MATCH_MP_TAC SUBSET_TRANS >> Q.EXISTS_TAC `f j` >> art [] \\
951 fs [GSYM LESS_EQ_IFF_LESS_SUC, LESS_OR_EQ])
952 >> DISCH_TAC
953 >> RW_TAC arith_ss [] (* 2 subgoals *)
954 >| [ (* goal 1 (of 2): DISJOINT (f (SUC i) DIFF f i) (f (SUC j) DIFF f j) *)
955 STRIP_ASSUME_TAC (Q.SPECL [`i`, `j`] LESS_LESS_CASES) >| (* 2 subgoals *)
956 [ (* goal 1.1 (of 2) *)
957 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
958 MATCH_MP_TAC DISJOINT_SUBSET \\
959 Q.EXISTS_TAC `f (SUC i)` >> REWRITE_TAC [DIFF_SUBSET] \\
960 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
961 MATCH_MP_TAC SUBSET_DIFF_DISJOINT \\
962 Q.EXISTS_TAC `f (SUC j)` \\
963 `f (SUC j) DIFF (f (SUC j) DIFF f j) = f j`
964 by PROVE_TAC [DIFF_DIFF_SUBSET] >> POP_ORW >> RES_TAC,
965 (* goal 1.2 (of 2) *)
966 MATCH_MP_TAC DISJOINT_SUBSET \\
967 Q.EXISTS_TAC `f (SUC j)` >> REWRITE_TAC [DIFF_SUBSET] \\
968 ONCE_REWRITE_TAC [DISJOINT_SYM] \\
969 MATCH_MP_TAC SUBSET_DIFF_DISJOINT \\
970 Q.EXISTS_TAC `f (SUC i)` \\
971 `f (SUC i) DIFF (f (SUC i) DIFF f i) = f i`
972 by PROVE_TAC [DIFF_DIFF_SUBSET] >> POP_ORW >> RES_TAC ],
973 (* goal 2 (of 2): BIGUNION (IMAGE f univ(:num)) = ... *)
974 STRIP_ASSUME_TAC (Q.SPEC `f` SETS_TO_DISJOINT_SETS') >> art [] \\
975 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_UNIV, IN_DIFF] \\
976 EQ_TAC >> rpt STRIP_TAC >| (* 2 subgoals *)
977 [ (* goal 2.1 (of 2) *)
978 Cases_on `x' = 0` >- PROVE_TAC [NOT_IN_EMPTY] \\
979 IMP_RES_TAC NOT_ZERO_LT_ZERO \\
980 Q.EXISTS_TAC `PRE x'` \\
981 `SUC (PRE x') = x'` by PROVE_TAC [SUC_PRE] >> POP_ORW \\
982 Q.PAT_X_ASSUM `x IN g x'` MP_TAC \\
983 Q.PAT_X_ASSUM `!n. 0 < n ==> X`
984 (fn th => REWRITE_TAC [MATCH_MP th (ASSUME ``0:num < x'``)]) \\
985 RW_TAC std_ss [IN_INTER, IN_BIGINTER_IMAGE, IN_COUNT, o_DEF, IN_COMPL] \\
986 FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss [],
987 (* goal 2.2 (of 2) *)
988 Q.EXISTS_TAC `SUC n` \\
989 `0 < SUC n` by REWRITE_TAC [LESS_0] \\
990 Q.PAT_X_ASSUM `!n. 0 < n ==> X`
991 (fn th => REWRITE_TAC [MATCH_MP th (ASSUME ``0:num < SUC n``)]) \\
992 RW_TAC std_ss [IN_INTER, IN_BIGINTER_IMAGE, IN_COUNT, o_DEF, IN_COMPL] \\
993 fs [GSYM LESS_EQ_IFF_LESS_SUC, LESS_OR_EQ] \\
994 CCONTR_TAC >> fs [] \\
995 `x IN f n` by PROVE_TAC [SUBSET_DEF] ] ]
996QED
997
998(* ------------------------------------------------------------------------- *)
999(* Other types of disjointness definitions (from Concordia HVG) *)
1000(* ------------------------------------------------------------------------- *)
1001
1002Definition disjoint_family_on :
1003 disjoint_family_on a s =
1004 (!m n. m IN s /\ n IN s /\ (m <> n) ==> (a m INTER a n = {}))
1005End
1006
1007Theorem disjoint_family_on_imp_disjoint :
1008 !a s. disjoint_family_on a s ==> disjoint (IMAGE a s)
1009Proof
1010 rw [disjoint_family_on, disjoint_def, DISJOINT_DEF]
1011 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
1012 >> CCONTR_TAC >> fs []
1013QED
1014
1015Theorem disjoint_family_on_iff_disjoint :
1016 !a s. INJ a s (IMAGE a s) ==>
1017 (disjoint_family_on a s <=> disjoint (IMAGE a s))
1018Proof
1019 rpt STRIP_TAC
1020 >> EQ_TAC >- REWRITE_TAC [disjoint_family_on_imp_disjoint]
1021 >> rw [disjoint_family_on, disjoint_def, DISJOINT_DEF]
1022 >> FIRST_X_ASSUM MATCH_MP_TAC
1023 >> CONJ_TAC >- (Q.EXISTS_TAC ‘m’ >> art [])
1024 >> CONJ_TAC >- (Q.EXISTS_TAC ‘n’ >> art [])
1025 >> fs [INJ_DEF]
1026 >> METIS_TAC []
1027QED
1028
1029(* A new, equivalent definition based on DISJOINT *)
1030Theorem disjoint_family_on_def :
1031 !A J. disjoint_family_on A (J :'index set) <=>
1032 (!i j. i IN J /\ j IN J /\ (i <> j) ==> DISJOINT (A i) (A j))
1033Proof
1034 rw [DISJOINT_DEF, disjoint_family_on]
1035QED
1036
1037Overload disjoint_family = “\A. disjoint_family_on A UNIV”
1038
1039(* A new, equivalent definition based on DISJOINT *)
1040Theorem disjoint_family_def :
1041 !A. disjoint_family (A :'index -> 'a set) <=>
1042 !i j. i <> j ==> DISJOINT (A i) (A j)
1043Proof
1044 rw [disjoint_family_on_def]
1045QED
1046
1047(* This is the way to convert a family of sets into a disjoint family
1048 of sets, cf. SETS_TO_DISJOINT_SETS -- Chun Tian
1049 *)
1050Definition disjointed :
1051 disjointed A n = A n DIFF BIGUNION {A i | i IN {x:num | 0 <= x /\ x < n}}
1052End
1053
1054Theorem disjointed_subset:
1055 !A n. disjointed A n SUBSET A n
1056Proof
1057 RW_TAC std_ss [disjointed] THEN ASM_SET_TAC []
1058QED
1059
1060Theorem disjoint_family_disjoint :
1061 !A. disjoint_family (disjointed A)
1062Proof
1063 SIMP_TAC std_ss [disjoint_family_on, IN_UNIV] THEN
1064 RW_TAC std_ss [disjointed, EXTENSION, GSPECIFICATION, IN_INTER] THEN
1065 SIMP_TAC std_ss [NOT_IN_EMPTY, IN_DIFF, IN_BIGUNION] THEN
1066 ASM_CASES_TAC ``(x NOTIN A (m:num) \/ ?s. x IN s /\ s IN {A i | i < m})`` THEN
1067 ASM_REWRITE_TAC [] THEN RW_TAC std_ss [] THEN
1068 ASM_CASES_TAC ``x NOTIN A (n:num)`` THEN FULL_SIMP_TAC std_ss [] THEN
1069 FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN
1070 ASM_CASES_TAC ``m < n:num`` THENL [METIS_TAC [], ALL_TAC] THEN
1071 `n < m:num` by ASM_SIMP_TAC arith_ss [] THEN METIS_TAC []
1072QED
1073
1074Theorem finite_UN_disjointed_eq[local]:
1075 !A n. BIGUNION {disjointed A i | i IN {x | 0 <= x /\ x < n}} =
1076 BIGUNION {A i | i IN {x | 0 <= x /\ x < n}}
1077Proof
1078 GEN_TAC THEN INDUCT_TAC THENL
1079 [FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN SET_TAC [], ALL_TAC] THEN
1080 FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN
1081 GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV)
1082 [ARITH_PROVE ``i < SUC n <=> i < n \/ (i = n)``] THEN
1083 REWRITE_TAC [SET_RULE ``BIGUNION {(A:num->'a->bool) i | i < n \/ (i = n)} =
1084 BIGUNION {A i | i < n} UNION A n``] THEN
1085 ASM_REWRITE_TAC [disjointed] THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
1086 SIMP_TAC std_ss [UNION_DEF] THEN
1087 REWRITE_TAC [ARITH_PROVE ``i < SUC n <=> i < n \/ (i = n)``] THEN
1088 REWRITE_TAC [SET_RULE ``BIGUNION {(A:num->'a->bool) i | i < n \/ (i = n)} =
1089 BIGUNION {A i | i < n} UNION A n``] THEN
1090 SET_TAC []
1091QED
1092
1093Theorem atLeast0LessThan[local]:
1094 {x:num | 0 <= x /\ x < n} = {x | x < n}
1095Proof
1096 SIMP_TAC arith_ss [EXTENSION, GSPECIFICATION]
1097QED
1098
1099Theorem UN_UN_finite_eq[local]:
1100 !A.
1101 BIGUNION {BIGUNION {A i | i IN {x | 0 <= x /\ x < n}} | n IN univ(:num)} =
1102 BIGUNION {A n | n IN UNIV}
1103Proof
1104 SIMP_TAC std_ss [atLeast0LessThan] THEN
1105 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_BIGUNION, IN_UNIV] THEN
1106 EQ_TAC THEN RW_TAC std_ss [] THENL
1107 [POP_ASSUM (MP_TAC o Q.SPEC `x`) THEN ASM_REWRITE_TAC [] THEN
1108 RW_TAC std_ss [] THEN METIS_TAC [], ALL_TAC] THEN
1109 Q.EXISTS_TAC `BIGUNION {A i | i IN {x | 0 <= x /\ x < SUC n}}` THEN
1110 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_BIGUNION, IN_UNIV] THENL
1111 [ALL_TAC, METIS_TAC []] THEN Q.EXISTS_TAC `A n` THEN
1112 FULL_SIMP_TAC std_ss [] THEN Q.EXISTS_TAC `n` THEN
1113 SIMP_TAC arith_ss []
1114QED
1115
1116Theorem UN_finite_subset[local]:
1117 !A C. (!n. BIGUNION {A i | i IN {x | 0 <= x /\ x < n}} SUBSET C) ==>
1118 BIGUNION {A n | n IN univ(:num)} SUBSET C
1119Proof
1120 RW_TAC std_ss [] THEN ONCE_REWRITE_TAC [GSYM UN_UN_finite_eq] THEN
1121 FULL_SIMP_TAC std_ss [SUBSET_DEF] THEN RW_TAC std_ss [] THEN
1122 FIRST_X_ASSUM MATCH_MP_TAC THEN
1123 FULL_SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_BIGUNION, IN_UNIV] THEN
1124 POP_ASSUM (MP_TAC o Q.SPEC `x`) THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN
1125 Q.EXISTS_TAC `n` THEN Q.EXISTS_TAC `s'` THEN METIS_TAC []
1126QED
1127
1128Theorem UN_finite2_subset[local]:
1129 !A B n k.
1130 (!n. BIGUNION {A i | i IN {x | 0 <= x /\ x < n}} SUBSET
1131 BIGUNION {B i | i IN {x | 0 <= x /\ x < n + k}}) ==>
1132 BIGUNION {A n | n IN univ(:num)} SUBSET BIGUNION {B n | n IN univ(:num)}
1133Proof
1134 RW_TAC std_ss [] THEN MATCH_MP_TAC UN_finite_subset THEN
1135 ONCE_REWRITE_TAC [GSYM UN_UN_finite_eq] THEN
1136 FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, GSPECIFICATION, IN_UNIV] THEN
1137 RW_TAC std_ss [] THEN FIRST_X_ASSUM (MP_TAC o Q.SPECL [`n`,`x`]) THEN
1138 Q_TAC SUFF_TAC `(?s. x IN s /\ ?i. (s = A i) /\ i < n)` THENL
1139 [ALL_TAC, METIS_TAC []] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
1140 STRIP_TAC THEN Q.EXISTS_TAC `BIGUNION {B i | i < n + k}` THEN
1141 CONJ_TAC THENL [ALL_TAC, METIS_TAC []] THEN
1142 SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION] THEN METIS_TAC []
1143QED
1144
1145Theorem UN_finite2_eq[local]:
1146 !A B k.
1147 (!n. BIGUNION {A i | i IN {x | 0 <= x /\ x < n}} =
1148 BIGUNION {B i | i IN {x | 0 <= x /\ x < n + k}}) ==>
1149 (BIGUNION {A n | n IN univ(:num)} = BIGUNION {B n | n IN univ(:num)})
1150Proof
1151 RW_TAC std_ss [] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
1152 [MATCH_MP_TAC UN_finite2_subset THEN REWRITE_TAC [atLeast0LessThan] THEN
1153 METIS_TAC [SUBSET_REFL], ALL_TAC] THEN
1154 FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_UNIV, GSPECIFICATION] THEN
1155 RW_TAC std_ss [] THEN FIRST_X_ASSUM (MP_TAC o Q.SPEC `SUC n`) THEN
1156 GEN_REWR_TAC LAND_CONV [EXTENSION] THEN
1157 DISCH_THEN (MP_TAC o Q.SPEC `x`) THEN
1158 SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_UNIV, GSPECIFICATION] THEN
1159 Q_TAC SUFF_TAC `?s. x IN s /\ ?i. (s = B i) /\ i < SUC n + k` THENL
1160 [ALL_TAC,
1161 Q.EXISTS_TAC `B n` THEN ASM_REWRITE_TAC [] THEN
1162 Q.EXISTS_TAC `n` THEN SIMP_TAC arith_ss []] THEN
1163 DISCH_TAC THEN ASM_REWRITE_TAC [] THEN RW_TAC std_ss [] THEN
1164 METIS_TAC []
1165QED
1166
1167Theorem BIGUNION_disjointed : (* was: UN_disjointed_eq *)
1168 !A. BIGUNION {disjointed A i | i IN UNIV} = BIGUNION {A i | i IN UNIV}
1169Proof
1170 GEN_TAC THEN MATCH_MP_TAC UN_finite2_eq THEN
1171 Q.EXISTS_TAC `0` THEN RW_TAC arith_ss [GSPECIFICATION] THEN
1172 ASSUME_TAC finite_UN_disjointed_eq THEN
1173 FULL_SIMP_TAC arith_ss [GSPECIFICATION]
1174QED
1175
1176(******************************************************************************)
1177(* liminf and limsup [1, p.74] [2, p.76] - the set-theoretic version *)
1178(******************************************************************************)
1179
1180val set_ss' = arith_ss ++ PRED_SET_ss;
1181
1182(* This lemma is provided by Konrad Slind *)
1183Theorem lemma[local]:
1184 !P. ~(?N. INFINITE N /\ !n. N n ==> P n) <=> !N. N SUBSET P ==> FINITE N
1185Proof
1186 rw_tac set_ss' [EQ_IMP_THM, SUBSET_DEF, IN_DEF]
1187 >- (`FINITE P \/ ?n. P n /\ ~P n` by metis_tac []
1188 >> imp_res_tac SUBSET_FINITE
1189 >> full_simp_tac std_ss [SUBSET_DEF, IN_DEF])
1190 >- metis_tac[]
1191QED
1192
1193(* "From this and the original assumption, you should be able to get that P is finite,
1194 so has a maximum element." -- Konrad Slind, Feb 17, 2019.
1195 *)
1196Theorem infinitely_often_lemma :
1197 !P. ~(?N. INFINITE N /\ !n:num. n IN N ==> P n) <=> ?m. !n. m <= n ==> ~(P n)
1198Proof
1199 Q.X_GEN_TAC ‘P’
1200 >> `!N. (!n. n IN N ==> P n) <=> !n. N n ==> P n` by PROVE_TAC [SUBSET_DEF, IN_APP]
1201 >> POP_ORW
1202 >> REWRITE_TAC [lemma]
1203 >> reverse EQ_TAC >> rpt STRIP_TAC
1204 >| [ (* goal 1 (of 2) *)
1205 Suff ‘FINITE P’ >- PROVE_TAC [SUBSET_FINITE_I] \\
1206 Know ‘P SUBSET (count m)’
1207 >- (REWRITE_TAC [count_def, GSYM NOT_LESS_EQUAL] \\
1208 ASM_SET_TAC []) \\
1209 DISCH_TAC \\
1210 MATCH_MP_TAC SUBSET_FINITE_I \\
1211 Q.EXISTS_TAC ‘count m’ >> art [FINITE_COUNT],
1212 (* goal 2 (of 2) *)
1213 POP_ASSUM (MP_TAC o (Q.SPEC `P`)) \\
1214 RW_TAC std_ss [SUBSET_REFL] \\
1215 Cases_on ‘P = {}’ >- rw [] \\
1216 MP_TAC (FINITE_is_measure_maximal |> INST_TYPE [“:'a” |-> “:num”]
1217 |> Q.SPECL [‘I’, ‘P’]) \\
1218 rw [is_measure_maximal_def, IN_APP] \\
1219 Q.EXISTS_TAC ‘SUC x’ >> rw [] \\
1220 CCONTR_TAC >> fs [] \\
1221 ‘x < n’ by rw [] \\
1222 ‘n <= x’ by PROVE_TAC [] \\
1223 METIS_TAC [LESS_EQ_ANTISYM] ]
1224QED
1225
1226(* This proof is provided by Konrad Slind. *)
1227Theorem infinity_bound_lemma :
1228 !N m. INFINITE N ==> ?n:num. m <= n /\ n IN N
1229Proof
1230 spose_not_then strip_assume_tac
1231 >> `FINITE (count m)` by metis_tac [FINITE_COUNT]
1232 >> `N SUBSET (count m)`
1233 by (rw_tac set_ss' [SUBSET_DEF]
1234 >> `~(m <= x)` by metis_tac []
1235 >> decide_tac)
1236 >> metis_tac [SUBSET_FINITE]
1237QED
1238
1239(* TODO: restate this lemma by real_topologyTheory.from *)
1240Theorem tail_not_empty: !A m:num. {A n | m <= n} <> {}
1241Proof
1242 RW_TAC std_ss [Once EXTENSION, NOT_IN_EMPTY, GSPECIFICATION]
1243 >> Q.EXISTS_TAC `(SUC m)` >> RW_TAC arith_ss []
1244QED
1245
1246Theorem tail_countable: !A m:num. countable {A n | m <= n}
1247Proof
1248 rpt GEN_TAC
1249 >> Suff `{A n | m <= n} = IMAGE A {n | m <= n}`
1250 >- PROVE_TAC [COUNTABLE_IMAGE_NUM]
1251 >> RW_TAC std_ss [EXTENSION, IN_IMAGE, GSPECIFICATION]
1252QED
1253
1254Definition set_limsup_def: (* "infinitely often" *)
1255 set_limsup (E :num -> 'a set) =
1256 BIGINTER (IMAGE (\m. BIGUNION {E n | m <= n}) UNIV)
1257End
1258
1259Definition set_liminf_def: (* "almost always" *)
1260 set_liminf (E :num -> 'a set) =
1261 BIGUNION (IMAGE (\m. BIGINTER {E n | m <= n}) UNIV)
1262End
1263
1264Overload limsup = ``set_limsup``
1265Overload liminf = ``set_liminf``
1266
1267(* alternative definition of `limsup` using `from` *)
1268Theorem set_limsup_alt:
1269 !E. set_limsup E = BIGINTER (IMAGE (\n. BIGUNION (IMAGE E (from n))) UNIV)
1270Proof
1271 GEN_TAC >> REWRITE_TAC [set_limsup_def]
1272 >> Suff `!m. BIGUNION (IMAGE E (from m)) = BIGUNION {E n | m <= n}`
1273 >- (Rewr' >> REWRITE_TAC [])
1274 >> RW_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_BIGUNION,
1275 GSPECIFICATION, from_def]
1276 >> EQ_TAC >> rpt STRIP_TAC
1277 >- (Q.EXISTS_TAC `E x'` >> art [] \\
1278 Q.EXISTS_TAC `x'` >> art [])
1279 >> Q.EXISTS_TAC `n` >> PROVE_TAC []
1280QED
1281
1282Theorem LIMSUP_COMPL : (* was: liminf_limsup *)
1283 !(E :num -> 'a set). COMPL (liminf E) = limsup (COMPL o E)
1284Proof
1285 RW_TAC std_ss [set_limsup_def, set_liminf_def]
1286 >> SIMP_TAC std_ss [COMPL_BIGUNION_IMAGE, o_DEF]
1287 >> Suff `!m. COMPL (BIGINTER {E n | m <= n}) =
1288 BIGUNION {COMPL (E n) | m <= n}` >- Rewr
1289 >> GEN_TAC >> REWRITE_TAC [COMPL_BIGINTER]
1290 >> Suff `IMAGE COMPL {E n | m <= n} = {COMPL (E n) | m <= n}` >- Rewr
1291 >> SIMP_TAC std_ss [IMAGE_DEF, IN_COMPL, Once GSPECIFICATION]
1292 >> RW_TAC std_ss [Once EXTENSION, GSPECIFICATION, IN_COMPL]
1293 >> EQ_TAC >> rpt STRIP_TAC
1294 >- (fs [COMPL_COMPL] >> Q.EXISTS_TAC `n` >> art [])
1295 >> fs []
1296 >> Q.EXISTS_TAC `E n` >> art []
1297 >> Q.EXISTS_TAC `n` >> art []
1298QED
1299
1300Theorem LIMSUP_DIFF : (* was: liminf_limsup_sp *)
1301 !sp E. (!n. E n SUBSET sp) ==> (sp DIFF (liminf E) = limsup (\n. sp DIFF (E n)))
1302Proof
1303 RW_TAC std_ss [set_limsup_def, set_liminf_def]
1304 >> Q.ABBREV_TAC `f = (\m. BIGINTER {E n | m <= n})`
1305 >> Know `!m. f m SUBSET sp`
1306 >- (GEN_TAC >> Q.UNABBREV_TAC `f` >> BETA_TAC \\
1307 RW_TAC std_ss [SUBSET_DEF, IN_BIGINTER, GSPECIFICATION] \\
1308 fs [SUBSET_DEF] >> LAST_X_ASSUM MATCH_MP_TAC \\
1309 Q.EXISTS_TAC `SUC m` \\
1310 POP_ASSUM (STRIP_ASSUME_TAC o (Q.SPEC `E (SUC m)`)) \\
1311 POP_ASSUM MATCH_MP_TAC \\
1312 Q.EXISTS_TAC `SUC m` >> RW_TAC arith_ss [])
1313 >> DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP GEN_COMPL_BIGUNION_IMAGE))
1314 >> Suff `!m. sp DIFF f m = BIGUNION {sp DIFF E n | m <= n}` >- Rewr
1315 >> GEN_TAC >> Q.UNABBREV_TAC `f` >> BETA_TAC
1316 >> Know `!x. x IN {E n | m <= n} ==> x SUBSET sp`
1317 >- (RW_TAC std_ss [GSPECIFICATION] >> art [])
1318 >> DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP GEN_COMPL_BIGINTER))
1319 >> Suff `(IMAGE (\x. sp DIFF x) {E n | m <= n}) = {sp DIFF E n | m <= n}` >- Rewr
1320 >> RW_TAC std_ss [Once EXTENSION, IMAGE_DEF, IN_DIFF, GSPECIFICATION]
1321 >> EQ_TAC >> rpt STRIP_TAC
1322 >- (Q.EXISTS_TAC `n` >> METIS_TAC [])
1323 >> Q.EXISTS_TAC `E n` >> art []
1324 >> Q.EXISTS_TAC `n` >> art []
1325QED
1326
1327(* A point belongs to `limsup E` if and only if it belongs to infinitely
1328 many terms of the sequence E. [2, p.76]
1329 *)
1330Theorem IN_LIMSUP :
1331 !A x. x IN limsup A <=> ?N. INFINITE N /\ !n. n IN N ==> x IN (A n)
1332Proof
1333 rpt GEN_TAC >> EQ_TAC
1334 >> RW_TAC std_ss [set_limsup_def, IN_BIGINTER_IMAGE, IN_UNIV]
1335 >| [ (* goal 1 (of 2) *)
1336 Q.ABBREV_TAC `P = \n. x IN (A n)` \\
1337 `!n. x IN (A n) <=> P n` by PROVE_TAC [] >> POP_ORW \\
1338 CCONTR_TAC \\
1339 `?m. !n. m <= n ==> ~(P n)` by PROVE_TAC [infinitely_often_lemma] \\
1340 Q.UNABBREV_TAC `P` >> FULL_SIMP_TAC bool_ss [] \\
1341 Know `x NOTIN BIGUNION {A n | m <= n}`
1342 >- (SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION] \\
1343 CCONTR_TAC >> FULL_SIMP_TAC bool_ss [] >> METIS_TAC []) \\
1344 DISCH_TAC >> METIS_TAC [],
1345 (* goal 2 (of 2) *)
1346 SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION] \\
1347 IMP_RES_TAC infinity_bound_lemma \\
1348 POP_ASSUM (STRIP_ASSUME_TAC o (Q.SPEC `m`)) \\
1349 Q.EXISTS_TAC `A n` >> CONJ_TAC >- PROVE_TAC [] \\
1350 Q.EXISTS_TAC `n` >> art [] ]
1351QED
1352
1353(* A point belongs to `liminf E` if and only if it belongs to all terms
1354 of the sequence from a certain term on. [2, p.76]
1355 *)
1356Theorem IN_LIMINF :
1357 !A x. x IN liminf A <=> ?m. !n. m <= n ==> x IN (A n)
1358Proof
1359 rpt GEN_TAC
1360 >> ASSUME_TAC (SIMP_RULE std_ss [GSYM LIMSUP_COMPL, IN_COMPL, o_DEF]
1361 (Q.SPECL [`COMPL o A`, `x`] IN_LIMSUP))
1362 >> `x IN liminf A <=> ~(?N. INFINITE N /\ !n. n IN N ==> x NOTIN A n)`
1363 by PROVE_TAC []
1364 >> fs [infinitely_often_lemma]
1365QED
1366
1367(* This version of LIMSUP_MONO is used in large_numberTheory.SLLN_IID_diverge *)
1368Theorem LIMSUP_MONO_STRONGER :
1369 !A B. (?d. !y n. y IN A n ==> ?m. n - d <= m /\ y IN B m) ==>
1370 limsup A SUBSET limsup B
1371Proof
1372 RW_TAC std_ss [set_limsup_alt]
1373 >> RW_TAC std_ss [IN_BIGINTER_IMAGE, IN_BIGUNION_IMAGE, SUBSET_DEF, IN_UNIV, IN_FROM]
1374 >> POP_ASSUM ((Q.X_CHOOSE_THEN ‘N’ STRIP_ASSUME_TAC) o (Q.SPEC ‘d + n’))
1375 >> Q.PAT_X_ASSUM ‘!y n. y IN A n ==> _’ (MP_TAC o (Q.SPECL [‘x’, ‘N’]))
1376 >> RW_TAC std_ss []
1377 >> Q.EXISTS_TAC ‘m’
1378 >> FULL_SIMP_TAC arith_ss []
1379QED
1380
1381Theorem LIMSUP_MONO_STRONG :
1382 !A B. (!y n. y IN A n ==> ?m. n <= m /\ y IN B m) ==> limsup A SUBSET limsup B
1383Proof
1384 rpt STRIP_TAC
1385 >> MATCH_MP_TAC LIMSUP_MONO_STRONGER
1386 >> Q.EXISTS_TAC ‘0’ >> rw []
1387QED
1388
1389Theorem LIMSUP_MONO_WEAK :
1390 !A B. (!n. A n SUBSET B n) ==> limsup A SUBSET limsup B
1391Proof
1392 rpt STRIP_TAC
1393 >> MATCH_MP_TAC LIMSUP_MONO_STRONG
1394 >> qx_genl_tac [‘x’, ‘n’]
1395 >> DISCH_TAC
1396 >> FULL_SIMP_TAC std_ss [SUBSET_DEF]
1397 >> Q.EXISTS_TAC ‘n’ >> fs []
1398QED
1399
1400(* ‘count1 n’ (inclusive ‘count’) returns the set of integers from 0 to n *)
1401Overload count1 = “\n. count (SUC n)”;
1402
1403(* A fake definition in case a user wants to check its definition by guess *)
1404Theorem count1_def :
1405 !n. count1 n = {m | m <= n}
1406Proof
1407 rw [Once EXTENSION, LT_SUC_LE]
1408QED
1409
1410(* ‘count n’ re-expressed by numseg *)
1411Theorem count1_numseg :
1412 !n. count1 n = {0..n}
1413Proof
1414 rw [Once EXTENSION]
1415QED
1416
1417(* ------------------------------------------------------------------------- *)
1418(* Basic definitions. *)
1419(* ------------------------------------------------------------------------- *)
1420
1421Type algebra[pp] = ``:('a set) # ('a set set)``
1422
1423Definition space_def[simp]:
1424 space (x :'a set, y :('a set) set) = x
1425End
1426
1427Definition subsets_def[simp]:
1428 subsets (x :'a set, y :('a set) set) = y
1429End
1430
1431Definition subset_class_def:
1432 subset_class sp sts = !x. x IN sts ==> x SUBSET sp
1433End
1434
1435Definition algebra_def :
1436 algebra a =
1437 (subset_class (space a) (subsets a) /\
1438 {} IN subsets a /\
1439 (!s. s IN subsets a ==> space a DIFF s IN subsets a) /\
1440 (!s t. s IN subsets a /\ t IN subsets a ==> s UNION t IN subsets a))
1441End
1442
1443Definition sigma_algebra_def :
1444 sigma_algebra a =
1445 (algebra a /\
1446 !c. countable c /\ c SUBSET (subsets a) ==> BIGUNION c IN (subsets a))
1447End
1448
1449(* The set of measurable mappings, each (f :'a -> 'b) is called A/B-measurable
1450
1451 NOTE: The requirement ‘sigma_algebra a /\ sigma_algebra b’ has been removed
1452 so that ‘measurable’ can be used in other system of sets.
1453 (cf. MEASURABLE_LIFT for a major related results.)
1454 *)
1455Definition measurable_def:
1456 measurable a b = {f | f IN (space a -> space b) /\
1457 !s. s IN subsets b ==>
1458 ((PREIMAGE f s) INTER space a) IN subsets a}
1459End
1460
1461(* the smallest sigma algebra generated from a set of sets *)
1462Definition sigma_def:
1463 sigma sp sts = (sp, BIGINTER {s | sts SUBSET s /\ sigma_algebra (sp, s)})
1464End
1465
1466Definition semiring_def : (* [7, p.39] *)
1467 semiring r =
1468 (subset_class (space r) (subsets r) /\
1469 {} IN (subsets r) /\
1470 (!s t. s IN (subsets r) /\ t IN (subsets r) ==> s INTER t IN (subsets r)) /\
1471 (!s t. s IN (subsets r) /\ t IN (subsets r) ==>
1472 ?c. c SUBSET (subsets r) /\ FINITE c /\ disjoint c /\
1473 (s DIFF t = BIGUNION c)))
1474End
1475
1476Definition ring_def : (* see [4] *)
1477 ring r =
1478 (subset_class (space r) (subsets r) /\
1479 {} IN (subsets r) /\
1480 (!s t. s IN (subsets r) /\ t IN (subsets r) ==> s UNION t IN (subsets r)) /\
1481 (!s t. s IN (subsets r) /\ t IN (subsets r) ==> s DIFF t IN (subsets r)))
1482End
1483
1484(* The smallest ring generated from a set of sets (usually a semiring) *)
1485Definition smallest_ring_def:
1486 smallest_ring sp sts = (sp, BIGINTER {s | sts SUBSET s /\ ring (sp, s)})
1487End
1488
1489(* After Eugene B. Dynkin (1924-2014), a Soviet and American mathematician [5] *)
1490Definition dynkin_system_def :
1491 dynkin_system d =
1492 (subset_class (space d) (subsets d) /\
1493 (space d) IN (subsets d) /\
1494 (!s. s IN (subsets d) ==> (space d DIFF s) IN (subsets d)) /\
1495 (!f :num -> 'a set.
1496 f IN (UNIV -> (subsets d)) /\ (!i j. i <> j ==> DISJOINT (f i) (f j))
1497 ==> BIGUNION (IMAGE f UNIV) IN (subsets d)))
1498End
1499
1500(* The smallest dynkin system generated from a set of sets, cf. "sigma_def" *)
1501Definition dynkin_def:
1502 dynkin sp sts = (sp, BIGINTER {d | sts SUBSET d /\ dynkin_system (sp, d)})
1503End
1504
1505(* ------------------------------------------------------------------------- *)
1506(* Basic theorems *)
1507(* ------------------------------------------------------------------------- *)
1508
1509Theorem SPACE[simp] :
1510 !a. (space a, subsets a) = a
1511Proof
1512 GEN_TAC >> Cases_on ‘a’ >> rw []
1513QED
1514
1515Theorem ALGEBRA_ALT_INTER:
1516 !a.
1517 algebra a <=>
1518 subset_class (space a) (subsets a) /\
1519 {} IN (subsets a) /\ (!s. s IN (subsets a) ==> (space a DIFF s) IN (subsets a)) /\
1520 !s t. s IN (subsets a) /\ t IN (subsets a) ==> s INTER t IN (subsets a)
1521Proof
1522 RW_TAC std_ss [algebra_def, subset_class_def]
1523 >> EQ_TAC >|
1524 [RW_TAC std_ss []
1525 >> Know `s INTER t = space a DIFF ((space a DIFF s) UNION (space a DIFF t))`
1526 >- (RW_TAC std_ss [EXTENSION, IN_INTER, IN_DIFF, IN_UNION]
1527 >> EQ_TAC
1528 >- (RW_TAC std_ss [] >> FULL_SIMP_TAC std_ss [SUBSET_DEF] >> PROVE_TAC [])
1529 >> RW_TAC std_ss [] >> ASM_REWRITE_TAC [])
1530 >> RW_TAC std_ss [],
1531 RW_TAC std_ss []
1532 >> Know `s UNION t = space a DIFF ((space a DIFF s) INTER (space a DIFF t))`
1533 >- (RW_TAC std_ss [EXTENSION, IN_INTER, IN_DIFF, IN_UNION]
1534 >> EQ_TAC
1535 >- (RW_TAC std_ss [] >> FULL_SIMP_TAC std_ss [SUBSET_DEF] >> PROVE_TAC [])
1536 >> RW_TAC std_ss [] >> ASM_REWRITE_TAC [])
1537 >> RW_TAC std_ss []]
1538QED
1539
1540Theorem ALGEBRA_EMPTY:
1541 !a. algebra a ==> {} IN (subsets a)
1542Proof
1543 RW_TAC std_ss [algebra_def]
1544QED
1545
1546Theorem ALGEBRA_SPACE:
1547 !a. algebra a ==> (space a) IN (subsets a)
1548Proof
1549 RW_TAC std_ss [algebra_def]
1550 >> PROVE_TAC [DIFF_EMPTY]
1551QED
1552
1553Theorem ALGEBRA_COMPL:
1554 !a s. algebra a /\ s IN (subsets a) ==> (space a DIFF s) IN (subsets a)
1555Proof
1556 RW_TAC std_ss [algebra_def]
1557QED
1558
1559Theorem ALGEBRA_UNION :
1560 !a s t. algebra a /\ s IN (subsets a) /\ t IN (subsets a) ==>
1561 s UNION t IN (subsets a)
1562Proof
1563 RW_TAC std_ss [algebra_def]
1564QED
1565
1566Theorem ALGEBRA_INTER :
1567 !a s t. algebra a /\ s IN (subsets a) /\ t IN (subsets a) ==>
1568 s INTER t IN (subsets a)
1569Proof
1570 RW_TAC std_ss [ALGEBRA_ALT_INTER]
1571QED
1572
1573Theorem ALGEBRA_DIFF :
1574 !a s t. algebra a /\ s IN (subsets a) /\ t IN (subsets a) ==>
1575 s DIFF t IN (subsets a)
1576Proof
1577 rpt STRIP_TAC
1578 >> Know `s DIFF t = s INTER (space a DIFF t)`
1579 >- (RW_TAC std_ss [EXTENSION, IN_DIFF, IN_INTER] \\
1580 FULL_SIMP_TAC std_ss [algebra_def, SUBSET_DEF, subset_class_def] \\
1581 PROVE_TAC [])
1582 >> RW_TAC std_ss [ALGEBRA_INTER, ALGEBRA_COMPL]
1583QED
1584
1585Theorem ALGEBRA_FINITE_UNION :
1586 !a c. algebra a /\ FINITE c /\ c SUBSET (subsets a) ==>
1587 BIGUNION c IN (subsets a)
1588Proof
1589 RW_TAC std_ss [algebra_def]
1590 >> NTAC 2 (POP_ASSUM MP_TAC)
1591 >> Q.SPEC_TAC (`c`, `c`)
1592 >> HO_MATCH_MP_TAC FINITE_INDUCT
1593 >> RW_TAC std_ss [BIGUNION_EMPTY, BIGUNION_INSERT, INSERT_SUBSET]
1594QED
1595
1596(* prove "*_FINITE_INTER" from "*_INTER" *)
1597fun prove_finite_inter tm thm =
1598 Q.X_GEN_TAC `r`
1599 >> Suff `^tm r ==>
1600 !f n. 0 < n ==> (!i. i < n ==> f i IN (subsets r)) ==>
1601 BIGINTER (IMAGE f (count n)) IN (subsets r)`
1602 >- METIS_TAC []
1603 >> DISCH_TAC
1604 >> Q.X_GEN_TAC ‘f’
1605 >> Induct_on `n` >- RW_TAC arith_ss []
1606 >> RW_TAC arith_ss []
1607 >> Cases_on `n = 0` >- fs [COUNT_SUC, COUNT_ZERO, IMAGE_INSERT, IMAGE_EMPTY,
1608 BIGINTER_INSERT]
1609 >> `0 < n` by RW_TAC arith_ss []
1610 >> REWRITE_TAC [COUNT_SUC, IMAGE_INSERT, BIGINTER_INSERT]
1611 >> `!s t. s IN (subsets r) /\ t IN (subsets r) ==> s INTER t IN (subsets r)`
1612 by PROVE_TAC [thm] (* thm is used here *)
1613 >> POP_ASSUM MATCH_MP_TAC
1614 >> STRONG_CONJ_TAC
1615 >- (Q.PAT_X_ASSUM `!i. i < SUC n ==> f i IN X` (MP_TAC o (Q.SPEC `n`)) \\
1616 RW_TAC arith_ss [])
1617 >> DISCH_TAC
1618 >> FIRST_X_ASSUM irule >> art []
1619 >> rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC
1620 >> RW_TAC arith_ss [];
1621
1622(* This version is more applicable than ALGEBRA_FINITE_INTER' *)
1623Theorem ALGEBRA_FINITE_INTER :
1624 !a f n. algebra a /\ 0 < n /\ (!i. i < n ==> f i IN (subsets a)) ==>
1625 BIGINTER (IMAGE f (count n)) IN (subsets a)
1626Proof
1627 prove_finite_inter “algebra” ALGEBRA_INTER
1628QED
1629
1630(* prove "*_FINITE_INTER'" from "*_INTER" *)
1631fun prove_finite_inter' thm =
1632 rpt STRIP_TAC
1633 >> NTAC 3 (POP_ASSUM MP_TAC)
1634 >> Q.SPEC_TAC (`c`, `c`)
1635 >> HO_MATCH_MP_TAC FINITE_INDUCT
1636 >> RW_TAC std_ss [BIGINTER_EMPTY, BIGINTER_INSERT, INSERT_SUBSET]
1637 >> Cases_on ‘c = {}’ >- rw []
1638 >> MATCH_MP_TAC thm (* used here *) >> art []
1639 >> FIRST_X_ASSUM irule >> art [];
1640
1641(* ‘c <> {}’ is necessary, otherwise ‘UNIV IN subset a’ does not hold. *)
1642Theorem ALGEBRA_FINITE_INTER' :
1643 !a c. algebra a /\ FINITE c /\ c SUBSET (subsets a) /\ c <> {} ==>
1644 BIGINTER c IN (subsets a)
1645Proof
1646 prove_finite_inter' ALGEBRA_INTER
1647QED
1648
1649Theorem ALGEBRA_INTER_SPACE :
1650 !a s. algebra a /\ s IN subsets a ==> space a INTER s = s /\ s INTER space a = s
1651Proof
1652 RW_TAC std_ss [algebra_def, SUBSET_DEF, IN_INTER, EXTENSION, subset_class_def]
1653 >> PROVE_TAC []
1654QED
1655
1656fun shared_tactics tm =
1657 rpt STRIP_TAC >> MATCH_MP_TAC tm >> fs [sigma_algebra_def];
1658
1659Theorem SIGMA_ALGEBRA_EMPTY :
1660 !a. sigma_algebra a ==> {} IN (subsets a)
1661Proof
1662 shared_tactics ALGEBRA_EMPTY
1663QED
1664
1665Theorem SIGMA_ALGEBRA_SPACE :
1666 !a. sigma_algebra a ==> (space a) IN (subsets a)
1667Proof
1668 shared_tactics ALGEBRA_SPACE
1669QED
1670
1671Theorem SIGMA_ALGEBRA_COMPL :
1672 !a s. sigma_algebra a /\ s IN (subsets a) ==> (space a DIFF s) IN (subsets a)
1673Proof
1674 shared_tactics ALGEBRA_COMPL
1675QED
1676
1677Theorem SIGMA_ALGEBRA_UNION :
1678 !a s t. sigma_algebra a /\ s IN (subsets a) /\ t IN (subsets a) ==>
1679 s UNION t IN (subsets a)
1680Proof
1681 shared_tactics ALGEBRA_UNION
1682QED
1683
1684Theorem SIGMA_ALGEBRA_INTER :
1685 !a s t. sigma_algebra a /\ s IN (subsets a) /\ t IN (subsets a) ==>
1686 s INTER t IN (subsets a)
1687Proof
1688 shared_tactics ALGEBRA_INTER
1689QED
1690
1691Theorem SIGMA_ALGEBRA_DIFF :
1692 !a s t. sigma_algebra a /\ s IN (subsets a) /\ t IN (subsets a) ==>
1693 s DIFF t IN (subsets a)
1694Proof
1695 shared_tactics ALGEBRA_DIFF
1696QED
1697
1698Theorem SIGMA_ALGEBRA_FINITE_UNION :
1699 !a c. sigma_algebra a /\ FINITE c /\ c SUBSET (subsets a) ==>
1700 BIGUNION c IN (subsets a)
1701Proof
1702 shared_tactics ALGEBRA_FINITE_UNION
1703QED
1704
1705Theorem SIGMA_ALGEBRA_FINITE_INTER :
1706 !a f n. sigma_algebra a /\ 0 < n /\ (!i. i < n ==> f i IN (subsets a)) ==>
1707 BIGINTER (IMAGE f (count n)) IN (subsets a)
1708Proof
1709 shared_tactics ALGEBRA_FINITE_INTER
1710QED
1711
1712Theorem SIGMA_ALGEBRA_FINITE_INTER' :
1713 !a c. sigma_algebra a /\ FINITE c /\ c SUBSET (subsets a) /\ c <> {} ==>
1714 BIGINTER c IN (subsets a)
1715Proof
1716 shared_tactics ALGEBRA_FINITE_INTER'
1717QED
1718
1719Theorem SIGMA_ALGEBRA_ALT:
1720 !a.
1721 sigma_algebra a <=>
1722 algebra a /\
1723 (!f : num -> 'a -> bool.
1724 f IN (UNIV -> (subsets a)) ==> BIGUNION (IMAGE f UNIV) IN (subsets a))
1725Proof
1726 RW_TAC std_ss [sigma_algebra_def]
1727 >> EQ_TAC
1728 >- (RW_TAC std_ss [COUNTABLE_ALT, IN_FUNSET, IN_UNIV]
1729 >> Q.PAT_X_ASSUM `!c. P c ==> Q c` MATCH_MP_TAC
1730 >> reverse (RW_TAC std_ss [IN_IMAGE, SUBSET_DEF, IN_UNIV])
1731 >- PROVE_TAC []
1732 >> Q.EXISTS_TAC `f`
1733 >> RW_TAC std_ss []
1734 >> PROVE_TAC [])
1735 >> RW_TAC std_ss [COUNTABLE_ALT_BIJ]
1736 >- PROVE_TAC [ALGEBRA_FINITE_UNION]
1737 >> Q.PAT_X_ASSUM `!f. P f` (MP_TAC o Q.SPEC `\n. enumerate c n`)
1738 >> RW_TAC std_ss' [IN_UNIV, IN_FUNSET]
1739 >> Know `BIGUNION c = BIGUNION (IMAGE (enumerate c) UNIV)`
1740 >- (RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV]
1741 >> Suff `!s. s IN c <=> ?n. (enumerate c n = s)` >- PROVE_TAC []
1742 >> Q.PAT_X_ASSUM `BIJ x y z` MP_TAC
1743 >> RW_TAC std_ss [BIJ_DEF, SURJ_DEF, IN_UNIV]
1744 >> PROVE_TAC [])
1745 >> DISCH_THEN (REWRITE_TAC o wrap)
1746 >> POP_ASSUM MATCH_MP_TAC
1747 >> Strip
1748 >> Suff `enumerate c n IN c` >- PROVE_TAC [SUBSET_DEF]
1749 >> Q.PAT_X_ASSUM `BIJ i j k` MP_TAC
1750 >> RW_TAC std_ss [BIJ_DEF, SURJ_DEF, IN_UNIV]
1751QED
1752
1753Theorem SIGMA_ALGEBRA_BIGUNION :
1754 !a f. sigma_algebra a /\ (!n. f n IN subsets a) ==>
1755 BIGUNION (IMAGE f univ(:num)) IN subsets a
1756Proof
1757 rw [SIGMA_ALGEBRA_ALT, IN_FUNSET]
1758QED
1759
1760Theorem SIGMA_ALGEBRA_ALT_MONO:
1761 !a.
1762 sigma_algebra a <=>
1763 algebra a /\
1764 (!f : num -> 'a -> bool.
1765 f IN (UNIV -> (subsets a)) /\ (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) ==>
1766 BIGUNION (IMAGE f UNIV) IN (subsets a))
1767Proof
1768 RW_TAC std_ss [SIGMA_ALGEBRA_ALT]
1769 >> EQ_TAC >- PROVE_TAC []
1770 >> RW_TAC std_ss []
1771 >> Q.PAT_X_ASSUM `!f. P f`
1772 (MP_TAC o Q.SPEC `\n. BIGUNION (IMAGE f (count n))`)
1773 >> RW_TAC std_ss [IN_UNIV, IN_FUNSET]
1774 >> Know `BIGUNION (IMAGE f UNIV) =
1775 BIGUNION (IMAGE (\n. BIGUNION (IMAGE f (count n))) UNIV)`
1776 >- (KILL_TAC
1777 >> ONCE_REWRITE_TAC [EXTENSION]
1778 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_UNIV]
1779 >> EQ_TAC
1780 >- (RW_TAC std_ss []
1781 >> Q.EXISTS_TAC `BIGUNION (IMAGE f (count (SUC x')))`
1782 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_COUNT]
1783 >> PROVE_TAC [LESS_SUC_REFL])
1784 >> RW_TAC std_ss []
1785 >> POP_ASSUM MP_TAC
1786 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_COUNT]
1787 >> PROVE_TAC [])
1788 >> DISCH_THEN (REWRITE_TAC o wrap)
1789 >> POP_ASSUM MATCH_MP_TAC
1790 >> reverse (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_COUNT, IN_IMAGE,
1791 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY])
1792 >- (Q.EXISTS_TAC `f x'`
1793 >> RW_TAC std_ss []
1794 >> Q.EXISTS_TAC `x'`
1795 >> DECIDE_TAC)
1796 >> MATCH_MP_TAC ALGEBRA_FINITE_UNION
1797 >> POP_ASSUM MP_TAC
1798 >> reverse (RW_TAC std_ss [IN_FUNSET, IN_UNIV, SUBSET_DEF, IN_IMAGE])
1799 >- PROVE_TAC []
1800 >> MATCH_MP_TAC IMAGE_FINITE
1801 >> RW_TAC std_ss [FINITE_COUNT]
1802QED
1803
1804Theorem SIGMA_ALGEBRA_ALT_DISJOINT:
1805 !a.
1806 sigma_algebra a <=>
1807 algebra a /\
1808 (!f.
1809 f IN (UNIV -> (subsets a)) /\
1810 (!m n : num. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
1811 BIGUNION (IMAGE f UNIV) IN (subsets a))
1812Proof
1813 Strip
1814 >> EQ_TAC >- RW_TAC std_ss [SIGMA_ALGEBRA_ALT]
1815 >> RW_TAC std_ss [SIGMA_ALGEBRA_ALT_MONO, IN_FUNSET, IN_UNIV]
1816 >> Q.PAT_X_ASSUM `!f. P f ==> Q f` (MP_TAC o Q.SPEC `\n. f (SUC n) DIFF f n`)
1817 >> RW_TAC std_ss []
1818 >> Know
1819 `BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE (\n. f (SUC n) DIFF f n) UNIV)`
1820 >- (POP_ASSUM K_TAC
1821 >> ONCE_REWRITE_TAC [EXTENSION]
1822 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_DIFF]
1823 >> reverse EQ_TAC
1824 >- (RW_TAC std_ss []
1825 >> POP_ASSUM MP_TAC
1826 >> RW_TAC std_ss [IN_DIFF]
1827 >> PROVE_TAC [])
1828 >> RW_TAC std_ss []
1829 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY]
1830 >> RW_TAC std_ss []
1831 >> Cases_on `x IN f x'` >- PROVE_TAC []
1832 >> Q.EXISTS_TAC `f (SUC x') DIFF f x'`
1833 >> RW_TAC std_ss [EXTENSION, IN_DIFF]
1834 >> PROVE_TAC [])
1835 >> DISCH_THEN (REWRITE_TAC o wrap)
1836 >> POP_ASSUM MATCH_MP_TAC
1837 >> CONJ_TAC >- RW_TAC std_ss [ALGEBRA_DIFF]
1838 >> HO_MATCH_MP_TAC TRANSFORM_2D_NUM
1839 >> CONJ_TAC >- PROVE_TAC [DISJOINT_SYM]
1840 >> RW_TAC arith_ss []
1841 >> Suff `f (SUC m) SUBSET f (m + n)`
1842 >- (RW_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY,
1843 IN_INTER, IN_DIFF, SUBSET_DEF]
1844 >> PROVE_TAC [])
1845 >> Cases_on `n` >- PROVE_TAC [ADD_CLAUSES]
1846 >> POP_ASSUM K_TAC
1847 >> Know `m + SUC n' = SUC m + n'` >- DECIDE_TAC
1848 >> DISCH_THEN (REWRITE_TAC o wrap)
1849 >> Induct_on `n'` >- RW_TAC arith_ss [SUBSET_REFL]
1850 >> MATCH_MP_TAC SUBSET_TRANS
1851 >> Q.EXISTS_TAC `f (SUC m + n')`
1852 >> PROVE_TAC [ADD_CLAUSES]
1853QED
1854
1855(* Definition 3.1 of [7, p.16] *)
1856Theorem SIGMA_ALGEBRA_ALT_SPACE :
1857 !a. sigma_algebra a <=>
1858 subset_class (space a) (subsets a) /\
1859 space a IN subsets a /\
1860 (!s. s IN subsets a ==> space a DIFF s IN subsets a) /\
1861 (!f :num -> 'a -> bool.
1862 f IN (UNIV -> (subsets a)) ==> BIGUNION (IMAGE f UNIV) IN (subsets a))
1863Proof
1864 RW_TAC std_ss [SIGMA_ALGEBRA_ALT]
1865 >> EQ_TAC >> RW_TAC std_ss [] (* 4 subgoals *)
1866 >- fs [algebra_def]
1867 >- (MATCH_MP_TAC ALGEBRA_SPACE >> art [])
1868 >- (MATCH_MP_TAC ALGEBRA_DIFF >> art [] \\
1869 MATCH_MP_TAC ALGEBRA_SPACE >> art [])
1870 >> RW_TAC std_ss [algebra_def]
1871 >- (‘{} = space a DIFF space a’ by SET_TAC [] >> POP_ORW \\
1872 FIRST_X_ASSUM MATCH_MP_TAC >> art [])
1873 >> Q.PAT_X_ASSUM ‘!f. P ==> BIGUNION (IMAGE f univ(:num)) IN subsets a’
1874 (MP_TAC o (Q.SPEC ‘\n. if n = 0 then s else if n = 1 then t else {}’))
1875 >> simp [IN_FUNSET, IN_UNIV]
1876 >> Know ‘!n :num. (if n = 0 then s else if n = 1 then t else {}) IN subsets a’
1877 >- (GEN_TAC \\
1878 Cases_on ‘n = 0’ >- rw [] \\
1879 Cases_on ‘n = 1’ >- rw [] \\
1880 rw [] >> ‘{} = space a DIFF space a’ by SET_TAC [] >> POP_ORW \\
1881 FIRST_X_ASSUM MATCH_MP_TAC >> art [])
1882 >> RW_TAC std_ss []
1883 >> Suff ‘s UNION t =
1884 BIGUNION (IMAGE (\n. if n = 0 then s else if n = 1 then t else {})
1885 univ(:num))’ >- rw []
1886 >> RW_TAC std_ss [Once EXTENSION, IN_UNION, IN_BIGUNION_IMAGE, IN_UNIV]
1887 >> EQ_TAC >> RW_TAC std_ss [NOT_IN_EMPTY] (* 3 subgoals *)
1888 >- (Q.EXISTS_TAC ‘0’ >> rw [])
1889 >- (Q.EXISTS_TAC ‘1’ >> rw [])
1890 >> Cases_on ‘n = 0’ >- (DISJ1_TAC >> fs [])
1891 >> Cases_on ‘n = 1’ >- (DISJ2_TAC >> fs [])
1892 >> fs [NOT_IN_EMPTY]
1893QED
1894
1895Theorem SIGMA_ALGEBRA_ALGEBRA:
1896 !a. sigma_algebra a ==> algebra a
1897Proof
1898 PROVE_TAC [sigma_algebra_def]
1899QED
1900
1901Theorem SIGMA_ALGEBRA_SIGMA:
1902 !sp sts. subset_class sp sts ==> sigma_algebra (sigma sp sts)
1903Proof
1904 SIMP_TAC std_ss [subset_class_def]
1905 >> NTAC 3 STRIP_TAC
1906 >> RW_TAC std_ss [sigma_def, sigma_algebra_def, algebra_def,
1907 subsets_def, space_def, IN_BIGINTER,
1908 GSPECIFICATION, subset_class_def]
1909 >- (POP_ASSUM (MATCH_MP_TAC o
1910 REWRITE_RULE [IN_POW, DIFF_SUBSET, UNION_SUBSET, EMPTY_SUBSET] o
1911 Q.ISPEC `POW (sp :'a -> bool)`)
1912 >> RW_TAC std_ss [SUBSET_DEF, IN_POW, IN_BIGUNION]
1913 >> PROVE_TAC [])
1914 >> POP_ASSUM (fn th => MATCH_MP_TAC th >> ASSUME_TAC th)
1915 >> RW_TAC std_ss [SUBSET_DEF]
1916 >> Q.PAT_X_ASSUM `c SUBSET PP` MP_TAC
1917 >> CONV_TAC (LAND_CONV (SIMP_CONV (srw_ss()) [SUBSET_DEF]))
1918 >> DISCH_THEN (MP_TAC o Q.SPEC `x`)
1919 >> ASM_REWRITE_TAC []
1920 >> DISCH_THEN MATCH_MP_TAC
1921 >> RW_TAC std_ss []
1922 >> PROVE_TAC [SUBSET_DEF]
1923QED
1924
1925Theorem SIGMA_ALGEBRA_SIGMA_UNIV :
1926 !sts. sigma_algebra (sigma UNIV sts)
1927Proof
1928 Q.X_GEN_TAC ‘sts’
1929 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA
1930 >> rw [subset_class_def]
1931QED
1932
1933(* power set of any space gives the largest possible algebra and sigma-algebra *)
1934Theorem POW_ALGEBRA: !sp. algebra (sp, POW sp)
1935Proof
1936 RW_TAC std_ss [algebra_def, IN_POW, space_def, subsets_def, subset_class_def,
1937 EMPTY_SUBSET, DIFF_SUBSET, UNION_SUBSET]
1938QED
1939
1940Theorem POW_SIGMA_ALGEBRA: !sp. sigma_algebra (sp, POW sp)
1941Proof
1942 RW_TAC std_ss [sigma_algebra_def, IN_POW, space_def, subsets_def,
1943 POW_ALGEBRA, SUBSET_DEF, IN_BIGUNION]
1944 >> PROVE_TAC []
1945QED
1946
1947Theorem SIGMA_POW:
1948 !s. sigma s (POW s) = (s,POW s)
1949Proof
1950 RW_TAC std_ss [sigma_def, PAIR_EQ, EXTENSION, IN_BIGINTER, IN_POW, GSPECIFICATION]
1951 >> EQ_TAC
1952 >- (RW_TAC std_ss [] >> POP_ASSUM (MP_TAC o Q.SPEC `POW s`)
1953 >> METIS_TAC [IN_POW, POW_SIGMA_ALGEBRA, SUBSET_REFL])
1954 >> RW_TAC std_ss [SUBSET_DEF, IN_POW] >> METIS_TAC []
1955QED
1956
1957Theorem UNIV_SIGMA_ALGEBRA:
1958 sigma_algebra ((UNIV :'a -> bool),(UNIV :('a -> bool) -> bool))
1959Proof
1960 Know `(UNIV :('a -> bool) -> bool) = POW (UNIV :'a -> bool)`
1961 >- RW_TAC std_ss [EXTENSION, IN_POW, IN_UNIV, SUBSET_UNIV]
1962 >> RW_TAC std_ss [POW_SIGMA_ALGEBRA]
1963QED
1964
1965Theorem SIGMA_SUBSET :
1966 !a b. sigma_algebra b /\ a SUBSET (subsets b) ==>
1967 subsets (sigma (space b) a) SUBSET (subsets b)
1968Proof
1969 RW_TAC std_ss [sigma_def, SUBSET_DEF, IN_BIGINTER, GSPECIFICATION, subsets_def]
1970 >> POP_ASSUM (MATCH_MP_TAC o Q.SPEC `subsets b`)
1971 >> RW_TAC std_ss [SPACE]
1972QED
1973
1974Theorem SIGMA_SUBSET_SUBSETS: !sp a. a SUBSET subsets (sigma sp a)
1975Proof
1976 RW_TAC std_ss [sigma_def, IN_BIGINTER, SUBSET_DEF, GSPECIFICATION, subsets_def]
1977QED
1978
1979Theorem IN_SIGMA: !sp a x. x IN a ==> x IN subsets (sigma sp a)
1980Proof
1981 MP_TAC SIGMA_SUBSET_SUBSETS
1982 >> RW_TAC std_ss [SUBSET_DEF]
1983QED
1984
1985(* the proof is fully syntactical, `subset_class sp a` (or b) is not needed *)
1986Theorem SIGMA_MONOTONE:
1987 !sp a b. a SUBSET b ==> (subsets (sigma sp a)) SUBSET (subsets (sigma sp b))
1988Proof
1989 RW_TAC std_ss [sigma_def, SUBSET_DEF, IN_BIGINTER, GSPECIFICATION, subsets_def]
1990QED
1991
1992(* the sigma of sigma-algebra is itself (stable) *)
1993Theorem SIGMA_STABLE_LEMMA:
1994 !sp sts. sigma_algebra (sp,sts) ==> (sigma sp sts = (sp,sts))
1995Proof
1996 RW_TAC std_ss [sigma_def, GSPECIFICATION, space_def, subsets_def]
1997 >> ASM_SET_TAC []
1998QED
1999
2000(* |- !a. sigma_algebra a ==> (sigma (space a) (subsets a) = a) *)
2001Theorem SIGMA_STABLE =
2002 GEN_ALL (REWRITE_RULE [SPACE]
2003 (Q.SPECL [`space a`, `subsets a`] SIGMA_STABLE_LEMMA));
2004
2005(* This is why ‘sigma sp sts’ is "smallest": any sigma-algebra in the middle
2006 coincides with it. *)
2007Theorem SIGMA_SMALLEST :
2008 !sp sts A. sts SUBSET A /\ A SUBSET subsets (sigma sp sts) /\
2009 sigma_algebra (sp,A) ==> (A = subsets (sigma sp sts))
2010Proof
2011 RW_TAC std_ss [SET_EQ_SUBSET]
2012 >> IMP_RES_TAC SIGMA_STABLE_LEMMA
2013 >> ‘A = subsets (sigma sp A)’ by PROVE_TAC [subsets_def]
2014 >> POP_ORW
2015 >> MATCH_MP_TAC SIGMA_MONOTONE >> art []
2016QED
2017
2018Theorem SIGMA_ALGEBRA :
2019 !p. sigma_algebra p <=>
2020 subset_class (space p) (subsets p) /\
2021 {} IN subsets p /\ (!s. s IN subsets p ==> (space p DIFF s) IN subsets p) /\
2022 !c. countable c /\ c SUBSET subsets p ==> BIGUNION c IN subsets p
2023Proof
2024 RW_TAC std_ss [sigma_algebra_def, algebra_def]
2025 >> EQ_TAC >- PROVE_TAC []
2026 >> RW_TAC std_ss []
2027 >> Q.PAT_X_ASSUM `!c. P c` (MP_TAC o Q.SPEC `{s; t}`)
2028 >> RW_TAC std_ss [COUNTABLE_ALT_BIJ, FINITE_INSERT, FINITE_EMPTY, SUBSET_DEF,
2029 BIGUNION_PAIR, IN_INSERT, NOT_IN_EMPTY]
2030 >> PROVE_TAC []
2031QED
2032
2033Theorem SIGMA_ALGEBRA_COUNTABLE_UNION:
2034 !a c. sigma_algebra a /\ countable c /\ c SUBSET subsets a ==>
2035 BIGUNION c IN subsets a
2036Proof
2037 PROVE_TAC [sigma_algebra_def]
2038QED
2039
2040Theorem SIGMA_ALGEBRA_ENUM :
2041 !a (f : num -> ('a -> bool)).
2042 sigma_algebra a /\ f IN (UNIV -> subsets a) ==>
2043 BIGUNION (IMAGE f UNIV) IN subsets a
2044Proof
2045 RW_TAC std_ss [SIGMA_ALGEBRA_ALT]
2046QED
2047
2048Theorem SIGMA_PROPERTY :
2049 !sp p a.
2050 subset_class sp p /\ {} IN p /\ a SUBSET p /\
2051 (!s. s IN (p INTER subsets (sigma sp a)) ==> (sp DIFF s) IN p) /\
2052 (!c. countable c /\ c SUBSET (p INTER subsets (sigma sp a)) ==>
2053 BIGUNION c IN p) ==> subsets (sigma sp a) SUBSET p
2054Proof
2055 RW_TAC std_ss []
2056 >> Suff `subsets (sigma sp a) SUBSET p INTER subsets (sigma sp a)`
2057 >- SIMP_TAC std_ss [SUBSET_INTER]
2058 >> Suff `p INTER subsets (sigma sp a) IN {b | a SUBSET b /\ sigma_algebra (sp,b)}`
2059 >- (KILL_TAC \\
2060 RW_TAC std_ss [sigma_def, GSPECIFICATION, SUBSET_DEF, INTER_DEF, BIGINTER,
2061 subsets_def])
2062 >> RW_TAC std_ss [GSPECIFICATION]
2063 >- PROVE_TAC [SUBSET_DEF, IN_INTER, IN_SIGMA]
2064 >> Know `subset_class sp a` >- PROVE_TAC [subset_class_def, SUBSET_DEF]
2065 >> STRIP_TAC
2066 >> Know `sigma_algebra (sigma sp a)`
2067 >- PROVE_TAC [subset_class_def, SUBSET_DEF, SIGMA_ALGEBRA_SIGMA]
2068 >> STRIP_TAC
2069 >> RW_TAC std_ss [SIGMA_ALGEBRA, IN_INTER, space_def, subsets_def,
2070 SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY]
2071 >| [ (* goal 1 (of 3) *)
2072 PROVE_TAC [subset_class_def, IN_INTER, SUBSET_DEF],
2073 (* goal 2 (of 3) *)
2074 (MATCH_MP_TAC o REWRITE_RULE [space_def, subsets_def] o
2075 Q.SPEC `(sp, subsets (sigma sp a))`) ALGEBRA_COMPL \\
2076 FULL_SIMP_TAC std_ss [sigma_def, sigma_algebra_def, subsets_def],
2077 (* goal 3 (of 3 *)
2078 FULL_SIMP_TAC std_ss [sigma_algebra_def] \\
2079 Q.PAT_X_ASSUM `!c. P c ==> BIGUNION c IN subsets (sigma sp a)` MATCH_MP_TAC \\
2080 FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_INTER] ]
2081QED
2082
2083Theorem SIGMA_ALGEBRA_FN:
2084 !a.
2085 sigma_algebra a <=>
2086 subset_class (space a) (subsets a) /\
2087 {} IN subsets a /\ (!s. s IN subsets a ==> (space a DIFF s) IN subsets a) /\
2088 (!f : num -> 'a -> bool.
2089 f IN (UNIV -> subsets a) ==> BIGUNION (IMAGE f UNIV) IN subsets a)
2090Proof
2091 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, IN_UNIV, SUBSET_DEF]
2092 >> EQ_TAC
2093 >- (RW_TAC std_ss []
2094 >> Q.PAT_X_ASSUM `!c. P c ==> Q c` MATCH_MP_TAC
2095 >> RW_TAC std_ss [COUNTABLE_IMAGE_NUM, IN_IMAGE]
2096 >> PROVE_TAC [])
2097 >> RW_TAC std_ss [COUNTABLE_ENUM]
2098 >- RW_TAC std_ss [BIGUNION_EMPTY]
2099 >> Q.PAT_X_ASSUM `!f. (!x. P x f) ==> Q f` MATCH_MP_TAC
2100 >> POP_ASSUM MP_TAC
2101 >> RW_TAC std_ss [IN_IMAGE, IN_UNIV]
2102 >> PROVE_TAC []
2103QED
2104
2105Theorem SIGMA_ALGEBRA_FN_BIGINTER :
2106 !a. sigma_algebra a ==>
2107 subset_class (space a) (subsets a) /\
2108 {} IN subsets a /\
2109 (!s. s IN subsets a ==> (space a DIFF s) IN subsets a) /\
2110 (!f :num -> 'a -> bool. f IN (UNIV -> subsets a) ==>
2111 BIGINTER (IMAGE f UNIV) IN subsets a)
2112Proof
2113 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, IN_UNIV, SUBSET_DEF]
2114 >> ASSUME_TAC (Q.SPECL [`space a`,`(IMAGE (f:num -> 'a -> bool) UNIV)`]
2115 DIFF_BIGINTER)
2116 >> `!t. t IN IMAGE f UNIV ==> t SUBSET space a`
2117 by (FULL_SIMP_TAC std_ss [IN_IMAGE,sigma_algebra_def,algebra_def,subsets_def,
2118 space_def,subset_class_def,IN_UNIV] \\
2119 RW_TAC std_ss [] >> METIS_TAC [])
2120 >> `IMAGE f UNIV <> {}` by RW_TAC std_ss [IMAGE_EQ_EMPTY,UNIV_NOT_EMPTY]
2121 >> FULL_SIMP_TAC std_ss []
2122 >> `BIGUNION (IMAGE (\u. space a DIFF u) (IMAGE f UNIV)) IN subsets a`
2123 by (Q.PAT_ASSUM `!c. M ==> BIGUNION c IN subsets a` (MATCH_MP_TAC) \\
2124 RW_TAC std_ss []
2125 >- (MATCH_MP_TAC image_countable \\
2126 RW_TAC std_ss [COUNTABLE_ENUM] \\
2127 Q.EXISTS_TAC `f` >> RW_TAC std_ss [])
2128 >> FULL_SIMP_TAC std_ss [IN_IMAGE])
2129 >> METIS_TAC []
2130QED
2131
2132Theorem SIGMA_ALGEBRA_FN_DISJOINT:
2133 !a.
2134 sigma_algebra a <=>
2135 subset_class (space a) (subsets a) /\
2136 {} IN subsets a /\ (!s. s IN subsets a ==> (space a DIFF s) IN subsets a) /\
2137 (!s t. s IN subsets a /\ t IN subsets a ==> s UNION t IN subsets a) /\
2138 (!f : num -> 'a -> bool.
2139 f IN (UNIV -> subsets a) /\ (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
2140 BIGUNION (IMAGE f UNIV) IN subsets a)
2141Proof
2142 RW_TAC std_ss [SIGMA_ALGEBRA_ALT_DISJOINT, algebra_def]
2143 >> EQ_TAC
2144 >> RW_TAC std_ss []
2145QED
2146
2147(* [7, p.16] or Theorem 3.1.1 [8, p.35], f is not necessary measurable *)
2148Theorem PREIMAGE_SIGMA_ALGEBRA :
2149 !sp A f. sigma_algebra A /\ f IN (sp -> space A) ==>
2150 sigma_algebra (sp,IMAGE (\s. PREIMAGE f s INTER sp) (subsets A))
2151Proof
2152 rpt STRIP_TAC
2153 >> RW_TAC std_ss [SIGMA_ALGEBRA_ALT, space_def, subsets_def, algebra_def,
2154 subset_class_def]
2155 >| [ (* goal 1 (of 5) *)
2156 fs [IN_IMAGE, IN_FUNSET],
2157 (* goal 2 (of 5) *)
2158 fs [IN_IMAGE, IN_FUNSET] \\
2159 Q.EXISTS_TAC `{}` >> REWRITE_TAC [PREIMAGE_EMPTY, INTER_EMPTY] \\
2160 fs [sigma_algebra_def, ALGEBRA_EMPTY],
2161 (* goal 3 (of 5) *)
2162 fs [IN_IMAGE, IN_FUNSET] \\
2163 Q.EXISTS_TAC `space A DIFF s'` \\
2164 reverse CONJ_TAC
2165 >- (MATCH_MP_TAC ALGEBRA_COMPL >> fs [sigma_algebra_def]) \\
2166 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_DIFF, IN_INTER] \\
2167 EQ_TAC >> RW_TAC std_ss [],
2168 (* goal 4 (of 5) *)
2169 fs [IN_IMAGE, IN_FUNSET] \\
2170 rename1 ‘t = PREIMAGE f t' INTER sp’ \\
2171 Q.EXISTS_TAC `s' UNION t'` \\
2172 reverse CONJ_TAC
2173 >- (MATCH_MP_TAC ALGEBRA_UNION >> fs [sigma_algebra_def]) \\
2174 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_UNION, IN_INTER] \\
2175 EQ_TAC >> RW_TAC std_ss [] >> art [],
2176 (* goal 5 (of 5) *)
2177 fs [IN_IMAGE, IN_FUNSET, IN_UNIV, SKOLEM_THM] \\
2178 rename1 ‘!x. f' x = PREIMAGE f (g x) INTER sp /\ g x IN subsets A’ \\
2179 `f' = \x. PREIMAGE f (g x) INTER sp` by PROVE_TAC [] >> POP_ORW \\
2180 `!x. g x IN subsets A` by PROVE_TAC [] \\
2181 Q.EXISTS_TAC `BIGUNION (IMAGE g UNIV)` \\
2182 reverse CONJ_TAC
2183 >- (fs [SIGMA_ALGEBRA_FN] \\
2184 FIRST_X_ASSUM MATCH_MP_TAC >> art [IN_FUNSET, IN_UNIV]) \\
2185 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_PREIMAGE, IN_UNIV, IN_INTER] \\
2186 EQ_TAC >> RW_TAC std_ss [] >> art [] \\
2187 rename1 ‘f x IN g n’ \\
2188 Q.EXISTS_TAC `n` >> art [] ]
2189QED
2190
2191Theorem SIGMA_PROPERTY_ALT :
2192 !sp p a.
2193 subset_class sp p /\
2194 {} IN p /\ a SUBSET p /\
2195 (!s. s IN (p INTER subsets (sigma sp a)) ==> sp DIFF s IN p) /\
2196 (!f : num -> 'a -> bool.
2197 f IN (UNIV -> p INTER subsets (sigma sp a)) ==>
2198 BIGUNION (IMAGE f UNIV) IN p) ==>
2199 subsets (sigma sp a) SUBSET p
2200Proof
2201 RW_TAC std_ss []
2202 >> Suff `subsets (sigma sp a) SUBSET p INTER subsets (sigma sp a)`
2203 >- SIMP_TAC std_ss [SUBSET_INTER]
2204 >> Suff `p INTER subsets (sigma sp a) IN {b | a SUBSET b /\ sigma_algebra (sp, b)}`
2205 >- (KILL_TAC \\
2206 RW_TAC std_ss [sigma_def, GSPECIFICATION, SUBSET_DEF, INTER_DEF,
2207 BIGINTER, subsets_def])
2208 >> RW_TAC std_ss [GSPECIFICATION]
2209 >- PROVE_TAC [SUBSET_DEF, IN_INTER, IN_SIGMA]
2210 >> POP_ASSUM MP_TAC
2211 >> Know `sigma_algebra (sigma sp a)`
2212 >- PROVE_TAC [subset_class_def, SUBSET_DEF, SIGMA_ALGEBRA_SIGMA]
2213 >> STRIP_TAC
2214 >> RW_TAC std_ss [SIGMA_ALGEBRA_FN, IN_INTER, FUNSET_INTER, subsets_def, space_def,
2215 SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY]
2216 >| [ (* goal 1 (of 3) *)
2217 PROVE_TAC [subset_class_def, IN_INTER, SUBSET_DEF],
2218 (* goal 2 (of 3) *)
2219 (MATCH_MP_TAC o REWRITE_RULE [space_def, subsets_def] o
2220 Q.SPEC `(sp, subsets (sigma sp a))`) ALGEBRA_COMPL \\
2221 FULL_SIMP_TAC std_ss [sigma_def, sigma_algebra_def, subsets_def],
2222 (* goal 3 (of 3) *)
2223 FULL_SIMP_TAC std_ss [(Q.SPEC `(sigma sp a)`) SIGMA_ALGEBRA_FN] ]
2224QED
2225
2226(* see SIGMA_PROPERTY_DISJOINT_WEAK_ALT for another version *)
2227Theorem SIGMA_PROPERTY_DISJOINT_WEAK:
2228 !sp p a.
2229 subset_class sp p /\
2230 {} IN p /\ a SUBSET p /\
2231 (!s. s IN (p INTER subsets (sigma sp a)) ==> (sp DIFF s) IN p) /\
2232 (!s t. s IN p /\ t IN p ==> s UNION t IN p) /\
2233 (!f : num -> 'a -> bool.
2234 f IN (UNIV -> p INTER subsets (sigma sp a)) /\
2235 (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
2236 BIGUNION (IMAGE f UNIV) IN p) ==>
2237 subsets (sigma sp a) SUBSET p
2238Proof
2239 RW_TAC std_ss []
2240 >> Suff `subsets (sigma sp a) SUBSET p INTER subsets (sigma sp a)`
2241 >- SIMP_TAC std_ss [SUBSET_INTER]
2242 >> Suff `p INTER subsets (sigma sp a) IN {b | a SUBSET b /\ sigma_algebra (sp, b)}`
2243 >- (KILL_TAC
2244 >> RW_TAC std_ss [sigma_def, GSPECIFICATION, SUBSET_DEF, INTER_DEF, BIGINTER, subsets_def, space_def])
2245 >> RW_TAC std_ss [GSPECIFICATION]
2246 >- PROVE_TAC [SUBSET_DEF, IN_INTER, IN_SIGMA]
2247 >> POP_ASSUM MP_TAC
2248 >> Know `sigma_algebra (sigma sp a)` >- PROVE_TAC [subset_class_def, SUBSET_DEF,
2249 SIGMA_ALGEBRA_SIGMA]
2250 >> STRIP_TAC
2251 >> RW_TAC std_ss [SIGMA_ALGEBRA_FN_DISJOINT, IN_INTER, FUNSET_INTER, subsets_def, space_def,
2252 SIGMA_ALGEBRA_ALGEBRA, ALGEBRA_EMPTY]
2253 >| [PROVE_TAC [subset_class_def, IN_INTER, SUBSET_DEF],
2254 (MATCH_MP_TAC o REWRITE_RULE [space_def, subsets_def] o
2255 Q.SPEC `(sp, subsets (sigma sp a))`) ALGEBRA_COMPL
2256 >> FULL_SIMP_TAC std_ss [sigma_def, sigma_algebra_def, subsets_def],
2257 (MATCH_MP_TAC o REWRITE_RULE [space_def, subsets_def] o
2258 Q.SPEC `(sp, subsets (sigma sp a))`) ALGEBRA_UNION
2259 >> FULL_SIMP_TAC std_ss [sigma_def, sigma_algebra_def, subsets_def],
2260 FULL_SIMP_TAC std_ss [(Q.SPEC `(sigma sp a)`) SIGMA_ALGEBRA_FN_DISJOINT]]
2261QED
2262
2263Theorem SPACE_SIGMA: !sp a. space (sigma sp a) = sp
2264Proof
2265 RW_TAC std_ss [sigma_def, space_def]
2266QED
2267
2268Theorem SIGMA_REDUCE: !sp a. (sp, subsets (sigma sp a)) = sigma sp a
2269Proof
2270 PROVE_TAC [SPACE_SIGMA, SPACE]
2271QED
2272
2273Theorem SIGMA_CONG :
2274 !sp a b. (subsets (sigma sp a) = subsets (sigma sp b)) ==>
2275 (sigma sp a = sigma sp b)
2276Proof
2277 METIS_TAC [SPACE_SIGMA, SPACE]
2278QED
2279
2280(* note: SEMIRING_SPACE doesn't hold *)
2281Theorem SEMIRING_EMPTY: !r. semiring r ==> {} IN (subsets r)
2282Proof
2283 RW_TAC std_ss [semiring_def]
2284QED
2285
2286Theorem SEMIRING_INTER:
2287 !r s t. semiring r /\ s IN (subsets r) /\ t IN (subsets r) ==>
2288 s INTER t IN (subsets r)
2289Proof
2290 RW_TAC std_ss [semiring_def]
2291QED
2292
2293Theorem SEMIRING_DIFF:
2294 !r s t. semiring r /\ s IN (subsets r) /\ t IN (subsets r) ==>
2295 ?c. c SUBSET (subsets r) /\ FINITE c /\ disjoint c /\
2296 (s DIFF t = BIGUNION c)
2297Proof
2298 RW_TAC std_ss [semiring_def]
2299QED
2300
2301Theorem SEMIRING_DIFF_ALT:
2302 !r s t. semiring r /\ s IN (subsets r) /\ t IN (subsets r) ==>
2303 ?f n. (!i. i < n ==> f i IN subsets r) /\
2304 (!i j. i < n /\ j < n /\ i <> j ==> DISJOINT (f i) (f j)) /\
2305 (s DIFF t = BIGUNION (IMAGE f (count n)))
2306Proof
2307 rpt STRIP_TAC
2308 >> MP_TAC (Q.SPECL [`r`, `s`, `t`] SEMIRING_DIFF)
2309 >> RW_TAC std_ss []
2310 >> STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
2311 (CONJ (ASSUME ``FINITE (c :'a set set)``)
2312 (ASSUME ``disjoint (c :'a set set)``)))
2313 >> qexistsl_tac [`f`, `n`]
2314 >> RW_TAC std_ss []
2315 >> PROVE_TAC [SUBSET_DEF]
2316QED
2317
2318Theorem SEMIRING_FINITE_INTER :
2319 !r f n. semiring r /\ 0 < n /\ (!i. i < n ==> f i IN (subsets r)) ==>
2320 BIGINTER (IMAGE f (count n)) IN (subsets r)
2321Proof
2322 prove_finite_inter “semiring” SEMIRING_INTER
2323QED
2324
2325(* ‘c <> {}’ is necessary, otherwise ‘UNIV IN subset a’ does not hold. *)
2326Theorem SEMIRING_FINITE_INTER' :
2327 !r c. semiring r /\ FINITE c /\ c SUBSET (subsets r) /\ c <> {} ==>
2328 BIGINTER c IN (subsets r)
2329Proof
2330 prove_finite_inter' SEMIRING_INTER
2331QED
2332
2333Theorem RING_EMPTY: !r. ring r ==> {} IN (subsets r)
2334Proof
2335 RW_TAC std_ss [ring_def]
2336QED
2337
2338Theorem RING_UNION:
2339 !r s t. ring r /\ s IN (subsets r) /\ t IN (subsets r) ==>
2340 s UNION t IN (subsets r)
2341Proof
2342 RW_TAC std_ss [ring_def]
2343QED
2344
2345Theorem RING_FINITE_UNION:
2346 !r c. ring r /\ c SUBSET (subsets r) /\ FINITE c ==> BIGUNION c IN (subsets r)
2347Proof
2348 GEN_TAC
2349 >> Suff `ring r ==>
2350 !c. FINITE c ==> c SUBSET (subsets r) /\ FINITE c ==>
2351 BIGUNION c IN (subsets r)`
2352 >- METIS_TAC []
2353 >> DISCH_TAC
2354 >> HO_MATCH_MP_TAC FINITE_INDUCT
2355 >> CONJ_TAC
2356 >- (RW_TAC std_ss [] >> PROVE_TAC [BIGUNION_EMPTY, RING_EMPTY])
2357 >> rpt STRIP_TAC
2358 >> REWRITE_TAC [BIGUNION_INSERT]
2359 >> fs [ring_def]
2360QED
2361
2362Theorem RING_FINITE_UNION_ALT:
2363 !r f n. ring r /\ (!i. i < n ==> f i IN subsets r) ==>
2364 BIGUNION (IMAGE f (count n)) IN (subsets r)
2365Proof
2366 rpt STRIP_TAC
2367 >> MATCH_MP_TAC RING_FINITE_UNION
2368 >> ASM_SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT]
2369 >> CONJ_TAC >- METIS_TAC []
2370 >> MATCH_MP_TAC IMAGE_FINITE
2371 >> REWRITE_TAC [FINITE_COUNT]
2372QED
2373
2374(* NOTE: RING_COMPL doesn't hold because RING_SPACE doesn't hold *)
2375Theorem RING_DIFF:
2376 !r s t. ring r /\ s IN (subsets r) /\ t IN (subsets r) ==>
2377 s DIFF t IN (subsets r)
2378Proof
2379 RW_TAC std_ss [ring_def]
2380QED
2381
2382Theorem RING_INTER:
2383 !r s t. ring r /\ s IN (subsets r) /\ t IN (subsets r) ==>
2384 s INTER t IN (subsets r)
2385Proof
2386 RW_TAC std_ss [ring_def]
2387 >> `s INTER t = s DIFF (s DIFF t)` by SET_TAC [] >> POP_ORW
2388 >> Q.PAT_ASSUM `!s t. X ==> s DIFF t IN subsets r` MATCH_MP_TAC >> art []
2389 >> Q.PAT_ASSUM `!s t. X ==> s DIFF t IN subsets r` MATCH_MP_TAC >> art []
2390QED
2391
2392Theorem RING_FINITE_INTER :
2393 !r f n. ring r /\ 0 < n /\ (!i. i < n ==> f i IN (subsets r)) ==>
2394 BIGINTER (IMAGE f (count n)) IN (subsets r)
2395Proof
2396 prove_finite_inter “ring” RING_INTER
2397QED
2398
2399(* ‘c <> {}’ is necessary, otherwise ‘UNIV IN subset a’ does not hold. *)
2400Theorem RING_FINITE_INTER' :
2401 !r c. ring r /\ FINITE c /\ c SUBSET (subsets r) /\ c <> {} ==>
2402 BIGINTER c IN (subsets r)
2403Proof
2404 prove_finite_inter' RING_INTER
2405QED
2406
2407(* a ring is also a semiring (but not vice versa) *)
2408Theorem RING_IMP_SEMIRING: !r. ring r ==> semiring r
2409Proof
2410 RW_TAC std_ss [semiring_def]
2411 >- PROVE_TAC [ring_def]
2412 >- (MATCH_MP_TAC RING_EMPTY >> art [])
2413 >- (MATCH_MP_TAC RING_INTER >> art [])
2414 >> Q.EXISTS_TAC `{s DIFF t}`
2415 >> `s DIFF t IN subsets r` by PROVE_TAC [RING_DIFF]
2416 >> SIMP_TAC std_ss [disjoint_sing, BIGUNION_SING, FINITE_SING]
2417 >> ASM_SET_TAC []
2418QED
2419
2420(* thus: algebra ==> ring ==> semiring *)
2421Theorem ALGEBRA_IMP_RING: !a. algebra a ==> ring a
2422Proof
2423 RW_TAC std_ss [ring_def]
2424 >- PROVE_TAC [algebra_def]
2425 >- (MATCH_MP_TAC ALGEBRA_EMPTY >> art [])
2426 >- (MATCH_MP_TAC ALGEBRA_UNION >> art [])
2427 >> MATCH_MP_TAC ALGEBRA_DIFF >> art []
2428QED
2429
2430(* an algebra is also a semiring (but not vice versa) *)
2431Theorem ALGEBRA_IMP_SEMIRING: !a. algebra a ==> semiring a
2432Proof
2433 rpt STRIP_TAC
2434 >> MATCH_MP_TAC RING_IMP_SEMIRING
2435 >> MATCH_MP_TAC ALGEBRA_IMP_RING
2436 >> ASM_REWRITE_TAC []
2437QED
2438
2439(* if the whole space is in the ring, the ring becomes algebra (thus also semiring) *)
2440Theorem RING_SPACE_IMP_ALGEBRA:
2441 !r. ring r /\ (space r) IN (subsets r) ==> algebra r
2442Proof
2443 RW_TAC std_ss [algebra_def, ring_def, subset_class_def]
2444QED
2445
2446(* thus (smallest_ring sp sts) is really a ring, as `POW sp` is a ring. *)
2447Theorem SMALLEST_RING:
2448 !sp sts. subset_class sp sts ==> ring (smallest_ring sp sts)
2449Proof
2450 SIMP_TAC std_ss [subset_class_def]
2451 >> rpt STRIP_TAC
2452 >> RW_TAC std_ss [smallest_ring_def, ring_def, subsets_def, space_def, IN_BIGINTER,
2453 GSPECIFICATION, subset_class_def]
2454 >> POP_ASSUM (MATCH_MP_TAC o
2455 REWRITE_RULE [IN_POW, DIFF_SUBSET, UNION_SUBSET, EMPTY_SUBSET] o
2456 (Q.ISPEC `POW (sp :'a -> bool)`))
2457 >> RW_TAC std_ss [SUBSET_DEF, IN_POW, IN_BIGUNION, IN_DIFF, IN_INTER]
2458QED
2459
2460Theorem SPACE_SMALLEST_RING :
2461 !sp sts. space (smallest_ring sp sts) = sp
2462Proof
2463 RW_TAC std_ss [smallest_ring_def, space_def]
2464QED
2465
2466Theorem SMALLEST_RING_SUBSET_SUBSETS :
2467 !sp a. a SUBSET subsets (smallest_ring sp a)
2468Proof
2469 RW_TAC std_ss [smallest_ring_def, subsets_def,
2470 IN_BIGINTER, SUBSET_DEF, GSPECIFICATION]
2471QED
2472
2473(* extracted from CARATHEODORY_SEMIRING for `lborel` construction *)
2474Theorem SMALLEST_RING_OF_SEMIRING :
2475 !sp sts. semiring (sp,sts) ==>
2476 subsets (smallest_ring sp sts) =
2477 {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}
2478Proof
2479 RW_TAC std_ss [smallest_ring_def, subsets_def]
2480 >> RW_TAC std_ss [Once EXTENSION, GSPECIFICATION, IN_BIGINTER]
2481 >> reverse EQ_TAC >> RW_TAC std_ss []
2482 >- (MATCH_MP_TAC (REWRITE_RULE [subsets_def]
2483 (Q.SPEC `(sp,P)` RING_FINITE_UNION)) >> art [] \\
2484 MATCH_MP_TAC SUBSET_TRANS \\
2485 Q.EXISTS_TAC `sts` >> art [])
2486 >> POP_ASSUM (MP_TAC o
2487 (Q.SPEC `{BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}`))
2488 >> Know `sts SUBSET {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}`
2489 >- (RW_TAC set_ss [SUBSET_DEF] \\
2490 Q.EXISTS_TAC `{x}` >> rw [disjoint_sing])
2491 >> Suff `ring (sp,{BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c})` >- rw []
2492 >> Q.ABBREV_TAC `S = {BIGUNION c | c SUBSET sts /\ FINITE c /\ disjoint c}`
2493 >> Know `{} IN S`
2494 >- (Q.UNABBREV_TAC `S` >> RW_TAC std_ss [GSPECIFICATION] \\
2495 Q.EXISTS_TAC `EMPTY` \\
2496 REWRITE_TAC [BIGUNION_EMPTY, EMPTY_SUBSET, FINITE_EMPTY, disjoint_empty])
2497 >> DISCH_TAC
2498 >> Know `sts SUBSET S`
2499 >- (RW_TAC std_ss [SUBSET_DEF] \\
2500 Q.UNABBREV_TAC `S` >> SIMP_TAC std_ss [GSPECIFICATION] \\
2501 Q.EXISTS_TAC `{x}` \\
2502 REWRITE_TAC [BIGUNION_SING, FINITE_SING, disjoint_sing] \\
2503 ASM_SET_TAC [])
2504 >> DISCH_TAC
2505 (* S is stable under disjoint unions *)
2506 >> Know `!s t. s IN S /\ t IN S /\ DISJOINT s t ==> s UNION t IN S`
2507 >- (Q.UNABBREV_TAC `S` >> RW_TAC std_ss [GSPECIFICATION] \\
2508 Q.EXISTS_TAC `c UNION c'` >> REWRITE_TAC [BIGUNION_UNION] \\
2509 CONJ_TAC >- PROVE_TAC [UNION_SUBSET] \\
2510 CONJ_TAC >- PROVE_TAC [FINITE_UNION] \\
2511 MATCH_MP_TAC disjoint_union >> art [] \\
2512 METIS_TAC [DISJOINT_DEF])
2513 >> DISCH_TAC
2514 (* S is stable under finite disjoint unions (not that easy!) *)
2515 >> Know `!c. c SUBSET S /\ FINITE c /\ disjoint c ==> BIGUNION c IN S`
2516 >- (Suff `!c. FINITE c ==> c SUBSET S /\ disjoint c ==> BIGUNION c IN S`
2517 >- METIS_TAC [] \\
2518 HO_MATCH_MP_TAC FINITE_INDUCT \\
2519 CONJ_TAC >- (RW_TAC std_ss [] >> ASM_REWRITE_TAC [BIGUNION_EMPTY]) \\
2520 rpt STRIP_TAC \\
2521 (* BIGUNION (e INSERT c) IN S *)
2522 REWRITE_TAC [BIGUNION_INSERT] \\
2523 FIRST_X_ASSUM MATCH_MP_TAC \\
2524 CONJ_TAC >- PROVE_TAC [INSERT_SUBSET] \\
2525 CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC \\
2526 CONJ_TAC >- PROVE_TAC [INSERT_SUBSET] \\
2527 PROVE_TAC [disjoint_insert_imp]) \\
2528 (* DISJOINT e (BIGUNION c) *)
2529 `?f n. (!x. x < n ==> f x IN c) /\ (c = IMAGE f (count n))`
2530 by PROVE_TAC [finite_decomposition] \\
2531 ASM_REWRITE_TAC [DISJOINT_DEF] \\
2532 REWRITE_TAC [BIGUNION_OVER_INTER_R] \\
2533 REWRITE_TAC [BIGUNION_EQ_EMPTY] \\
2534 Cases_on `n = 0` >- (DISJ1_TAC >> PROVE_TAC [COUNT_ZERO, IMAGE_EMPTY]) \\
2535 DISJ2_TAC >> REWRITE_TAC [EXTENSION] \\
2536 GEN_TAC >> EQ_TAC >| (* 2 subgoals *)
2537 [ (* goal (1 of 2) *)
2538 RW_TAC std_ss [IN_IMAGE, IN_COUNT, IN_SING] \\
2539 METIS_TAC [disjoint_insert_notin, DISJOINT_DEF],
2540 (* goal (2 of 2) *)
2541 RW_TAC std_ss [IN_IMAGE, IN_COUNT, IN_SING] \\
2542 Q.EXISTS_TAC `0` >> RW_TAC arith_ss [] \\
2543 `f 0 IN IMAGE f (count n)`
2544 by (FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) \\
2545 METIS_TAC [disjoint_insert_notin, DISJOINT_DEF] ])
2546 >> DISCH_TAC
2547 (* S is stable under finite intersection (semiring is used) *)
2548 >> Know `!s t. s IN S /\ t IN S ==> s INTER t IN S`
2549 >- (rpt STRIP_TAC \\
2550 Know `?A. A SUBSET sts /\ FINITE A /\ disjoint A /\ (s = BIGUNION A)`
2551 >- (Q.PAT_X_ASSUM `s IN S` MP_TAC \\
2552 Q.UNABBREV_TAC `S` >> RW_TAC std_ss [GSPECIFICATION] \\
2553 Q.EXISTS_TAC `c` >> art []) >> STRIP_TAC \\
2554 Know `?B. B SUBSET sts /\ FINITE B /\ disjoint B /\ (t = BIGUNION B)`
2555 >- (Q.PAT_X_ASSUM `t IN S` MP_TAC \\
2556 Q.UNABBREV_TAC `S` >> RW_TAC std_ss [GSPECIFICATION] \\
2557 Q.EXISTS_TAC `c` >> art []) >> STRIP_TAC \\
2558 ASM_REWRITE_TAC [] \\
2559 Q.PAT_X_ASSUM `FINITE A` (STRIP_ASSUME_TAC o (MATCH_MP finite_decomposition)) \\
2560 Q.PAT_X_ASSUM `FINITE B` (STRIP_ASSUME_TAC o (MATCH_MP finite_decomposition)) \\
2561 ASM_REWRITE_TAC [BIGUNION_OVER_INTER_L] \\
2562 REWRITE_TAC [BIGUNION_OVER_INTER_R] \\
2563 FIRST_ASSUM MATCH_MP_TAC \\
2564 reverse CONJ_TAC (* some easy goals *)
2565 >- (CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
2566 MATCH_MP_TAC disjointI \\
2567 NTAC 2 GEN_TAC >> SIMP_TAC std_ss [IN_IMAGE, IN_COUNT] \\
2568 rpt STRIP_TAC \\
2569 Cases_on `i = i'` >- (`a = b` by METIS_TAC []) \\
2570 ASM_REWRITE_TAC [DISJOINT_ALT] \\
2571 GEN_TAC >> SIMP_TAC std_ss [IN_BIGUNION_IMAGE, IN_COUNT, IN_INTER] \\
2572 rpt STRIP_TAC \\
2573 DISJ2_TAC >> DISJ1_TAC >> CCONTR_TAC >> fs [] \\
2574 `x IN f i INTER f i'` by METIS_TAC [IN_INTER] \\
2575 `~DISJOINT (f i) (f i')` by ASM_SET_TAC [DISJOINT_DEF] \\
2576 Q.PAT_X_ASSUM `disjoint (IMAGE f (count n))` MP_TAC \\
2577 RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT] \\
2578 Q.EXISTS_TAC `f i` >> Q.EXISTS_TAC `f i'` >> art [] \\
2579 METIS_TAC []) \\
2580 (* IMAGE (\i. BIGUNION (IMAGE (\i'. f i INTER f' i') (count n'))) (count n)
2581 SUBSET S *)
2582 RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2583 FIRST_ASSUM MATCH_MP_TAC \\
2584 reverse CONJ_TAC (* some easy goals *)
2585 >- (CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
2586 MATCH_MP_TAC disjointI \\
2587 NTAC 2 GEN_TAC >> SIMP_TAC std_ss [IN_IMAGE, IN_COUNT] \\
2588 rpt STRIP_TAC \\
2589 rename [‘a <> b’, ‘a = f i INTER f' i1’, ‘b = f i INTER f' i2’] \\
2590 Cases_on `i1 = i2` >- (`a = b` by METIS_TAC []) \\
2591 ASM_REWRITE_TAC [DISJOINT_ALT] \\
2592 RW_TAC std_ss [IN_INTER] \\
2593 CCONTR_TAC >> fs [] \\
2594 `x IN f' i1 INTER f' i2` by PROVE_TAC [IN_INTER] \\
2595 `~DISJOINT (f' i1) (f' i2)` by ASM_SET_TAC [DISJOINT_DEF] \\
2596 Q.PAT_X_ASSUM `disjoint (IMAGE f' (count n'))` MP_TAC \\
2597 RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT] \\
2598 Q.EXISTS_TAC `f' i1` >> Q.EXISTS_TAC `f' i2` >> art [] \\
2599 METIS_TAC []) \\
2600 RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2601 (* f i INTER f' i' IN S *)
2602 rename [‘f i INTER g j IN S’] >>
2603 Know `(IMAGE f (count n)) SUBSET sts`
2604 >- (Q.PAT_X_ASSUM `BIGUNION (IMAGE f (count n)) IN S` MP_TAC \\
2605 Q.UNABBREV_TAC `S` >> SIMP_TAC std_ss [GSPECIFICATION] >> METIS_TAC []) \\
2606 DISCH_TAC \\
2607 Know `(IMAGE g (count n')) SUBSET sts`
2608 >- (Q.PAT_X_ASSUM `BIGUNION (IMAGE g (count n')) IN S` MP_TAC \\
2609 Q.UNABBREV_TAC `S` >> SIMP_TAC std_ss [GSPECIFICATION] >> METIS_TAC []) \\
2610 DISCH_TAC \\
2611 `f i IN sts /\ g j IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2612 fs [semiring_def, space_def, subsets_def] \\
2613 `f i INTER g j IN sts` by PROVE_TAC [] \\
2614 METIS_TAC [SUBSET_DEF])
2615 >> DISCH_TAC
2616 (* S is stable under (more) finite intersection *)
2617 >> Know `!f n. 0 < n ==> (!i. i < n ==> f i IN S) ==>
2618 BIGINTER (IMAGE f (count n)) IN S`
2619 >- (GEN_TAC >> Induct_on `n` >- RW_TAC arith_ss [] \\
2620 RW_TAC arith_ss [] \\
2621 Cases_on `n = 0` >- fs [COUNT_SUC, COUNT_ZERO, IMAGE_INSERT, IMAGE_EMPTY,
2622 BIGINTER_INSERT] \\
2623 `0 < n` by RW_TAC arith_ss [] \\
2624 REWRITE_TAC [COUNT_SUC, IMAGE_INSERT, BIGINTER_INSERT] \\
2625 FIRST_X_ASSUM MATCH_MP_TAC \\
2626 STRONG_CONJ_TAC
2627 >- (Q.PAT_X_ASSUM `!i. i < SUC n ==> f i IN S` (MP_TAC o (Q.SPEC `n`)) \\
2628 RW_TAC arith_ss []) >> DISCH_TAC \\
2629 FIRST_X_ASSUM irule >> art [] \\
2630 rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
2631 RW_TAC arith_ss [])
2632 >> DISCH_TAC
2633 (* DIFF of sts is in S (semiring is used) *)
2634 >> Know `!s t. s IN sts /\ t IN sts ==> s DIFF t IN S`
2635 >- (rpt STRIP_TAC \\
2636 fs [semiring_def, subset_class_def, space_def, subsets_def] \\
2637 `?c. c SUBSET sts /\ FINITE c /\ disjoint c /\ (s DIFF t = BIGUNION c)`
2638 by PROVE_TAC [] \\
2639 Q.UNABBREV_TAC `S` >> SIMP_TAC std_ss [GSPECIFICATION] \\
2640 Q.EXISTS_TAC `c` >> art [])
2641 >> DISCH_TAC
2642 (* S is stable under diff (semiring is used) *)
2643 >> Know `!s t. s IN S /\ t IN S ==> s DIFF t IN S`
2644 >- (rpt STRIP_TAC \\
2645 (* assert two finite disjoint sets from s and t *)
2646 Know `?A. A SUBSET sts /\ FINITE A /\ disjoint A /\ (s = BIGUNION A)`
2647 >- (Q.PAT_X_ASSUM `s IN S` MP_TAC \\
2648 Q.UNABBREV_TAC `S` >> RW_TAC std_ss [GSPECIFICATION] \\
2649 Q.EXISTS_TAC `c` >> art []) >> STRIP_TAC \\
2650 Know `?B. B SUBSET sts /\ FINITE B /\ disjoint B /\ (t = BIGUNION B)`
2651 >- (Q.PAT_X_ASSUM `t IN S` MP_TAC \\
2652 Q.UNABBREV_TAC `S` >> RW_TAC std_ss [GSPECIFICATION] \\
2653 Q.EXISTS_TAC `c` >> art []) >> STRIP_TAC \\
2654 ASM_REWRITE_TAC [] \\
2655 (* decomposite the two sets into two sequences of sets *)
2656 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
2657 (CONJ (ASSUME ``FINITE (A :'a set set)``)
2658 (ASSUME ``disjoint (A :'a set set)``))) \\
2659 STRIP_ASSUME_TAC (MATCH_MP finite_disjoint_decomposition
2660 (CONJ (ASSUME ``FINITE (B :'a set set)``)
2661 (ASSUME ``disjoint (B :'a set set)``))) \\
2662 ASM_REWRITE_TAC [] \\
2663 Know `BIGUNION (IMAGE f (count n)) SUBSET sp`
2664 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT] \\
2665 Suff `f x' SUBSET sp` >- PROVE_TAC [SUBSET_DEF] \\
2666 fs [semiring_def, subset_class_def, space_def, subsets_def] \\
2667 `f x' IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2668 METIS_TAC []) >> DISCH_TAC \\
2669 Know `BIGUNION (IMAGE f' (count n')) SUBSET sp`
2670 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_COUNT] \\
2671 Suff `f' x' SUBSET sp` >- PROVE_TAC [SUBSET_DEF] \\
2672 fs [semiring_def, subset_class_def, space_def, subsets_def] \\
2673 `f' x' IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2674 METIS_TAC []) >> DISCH_TAC \\
2675 Cases_on `n = 0`
2676 >- (METIS_TAC [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, EMPTY_DIFF]) \\
2677 Cases_on `n' = 0`
2678 >- (ASM_REWRITE_TAC [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, DIFF_EMPTY] \\
2679 METIS_TAC []) \\
2680 `0 < n /\ 0 < n'` by RW_TAC arith_ss [] \\
2681 REWRITE_TAC
2682 [MATCH_MP GEN_DIFF_INTER
2683 (CONJ (ASSUME ``BIGUNION (IMAGE f (count n)) SUBSET sp``)
2684 (ASSUME ``BIGUNION (IMAGE f' (count n')) SUBSET sp``))] \\
2685 REWRITE_TAC [MATCH_MP GEN_COMPL_FINITE_UNION (ASSUME ``0:num < n'``)] \\
2686 REWRITE_TAC [BIGUNION_OVER_INTER_L] \\
2687 ‘count n' <> {}’ by PROVE_TAC [COUNT_NOT_EMPTY] \\
2688 REWRITE_TAC [MATCH_MP BIGINTER_OVER_INTER_R (ASSUME ``count n' <> {}``)] \\
2689 BETA_TAC >> FIRST_ASSUM MATCH_MP_TAC \\
2690 reverse CONJ_TAC (* some easy goals *)
2691 >- (CONJ_TAC >- (MATCH_MP_TAC IMAGE_FINITE >> REWRITE_TAC [FINITE_COUNT]) \\
2692 MATCH_MP_TAC disjointI \\
2693 NTAC 2 GEN_TAC >> SIMP_TAC std_ss [IN_IMAGE, IN_COUNT] \\
2694 rpt STRIP_TAC \\
2695 Cases_on `i = i'` >- (`a = b` by METIS_TAC []) \\
2696 ASM_REWRITE_TAC [DISJOINT_ALT] \\
2697 GEN_TAC >> SIMP_TAC std_ss [IN_BIGINTER_IMAGE, IN_COUNT] \\
2698 rpt STRIP_TAC \\
2699 POP_ASSUM (STRIP_ASSUME_TAC o
2700 (fn th => MATCH_MP th (ASSUME ``0:num < n'``))) \\
2701 Q.EXISTS_TAC `0` >> art [] \\
2702 SIMP_TAC std_ss [IN_INTER] \\
2703 DISJ1_TAC >> CCONTR_TAC \\
2704 fs [IN_INTER] \\
2705 `x IN f i INTER f i'` by PROVE_TAC [IN_INTER] \\
2706 ASM_SET_TAC [DISJOINT_DEF]) \\ (* TODO: optimize this last step *)
2707 RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2708 (* BIGINTER (IMAGE (\i'. f i INTER (sp DIFF f' i')) (count n')) IN S *)
2709 FIRST_X_ASSUM irule >> art [] \\
2710 rpt STRIP_TAC >> BETA_TAC \\
2711 `f i IN sts /\ f' i' IN sts` by PROVE_TAC [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
2712 Know `f i INTER (sp DIFF f' i') = f i DIFF f' i'`
2713 >- (MATCH_MP_TAC EQ_SYM \\
2714 MATCH_MP_TAC GEN_DIFF_INTER \\
2715 fs [semiring_def, subset_class_def, space_def, subsets_def]) \\
2716 Rewr >> FIRST_X_ASSUM MATCH_MP_TAC >> art [])
2717 >> DISCH_TAC
2718 (* S is stable under finite union (but is still NOT an algebra) *)
2719 >> Know `!s t. s IN S /\ t IN S ==> s UNION t IN S`
2720 >- (rpt STRIP_TAC \\
2721 STRIP_ASSUME_TAC (Q.SPECL [`s`, `t`] UNION_TO_3_DISJOINT_UNIONS) >> art [] \\
2722 FIRST_ASSUM MATCH_MP_TAC \\
2723 CONJ_TAC >| (* 2 subgoals *)
2724 [ (* goal 1 (of 2) *)
2725 FIRST_X_ASSUM MATCH_MP_TAC \\
2726 CONJ_TAC >- PROVE_TAC [] \\
2727 CONJ_TAC >- PROVE_TAC [] \\
2728 ASM_SET_TAC [disjoint_def, DISJOINT_DEF],
2729 (* goal 2 (of 2) *)
2730 CONJ_TAC >- PROVE_TAC [] \\
2731 ASM_SET_TAC [disjoint_def, DISJOINT_DEF] ])
2732 >> DISCH_TAC
2733 >> RW_TAC std_ss [ring_def, subset_class_def, space_def, subsets_def]
2734 >> POP_ASSUM MP_TAC >> Q.UNABBREV_TAC `S`
2735 >> RW_TAC std_ss [GSPECIFICATION]
2736 >> RW_TAC std_ss [BIGUNION_SUBSET]
2737 >> `Y IN sts` by METIS_TAC [SUBSET_DEF]
2738 >> METIS_TAC [semiring_def, subset_class_def, space_def, subsets_def]
2739QED
2740
2741Theorem subset_class_POW: !sp. subset_class sp (POW sp)
2742Proof
2743 RW_TAC std_ss [subset_class_def, IN_POW]
2744QED
2745
2746Theorem DYNKIN_SYSTEM_COMPL:
2747 !d s. dynkin_system d /\ s IN subsets d ==> space d DIFF s IN subsets d
2748Proof
2749 RW_TAC std_ss [dynkin_system_def]
2750QED
2751
2752Theorem DYNKIN_SYSTEM_SPACE:
2753 !d. dynkin_system d ==> (space d) IN subsets d
2754Proof
2755 PROVE_TAC [dynkin_system_def]
2756QED
2757
2758Theorem DYNKIN_SYSTEM_EMPTY:
2759 !d. dynkin_system d ==> {} IN subsets d
2760Proof
2761 rpt STRIP_TAC
2762 >> REWRITE_TAC [SYM (Q.SPEC `space d` DIFF_EQ_EMPTY)]
2763 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL >> art []
2764 >> PROVE_TAC [dynkin_system_def]
2765QED
2766
2767Theorem DYNKIN_SYSTEM_DUNION:
2768 !d s t. dynkin_system d /\ s IN subsets d /\ t IN subsets d /\ DISJOINT s t
2769 ==> s UNION t IN subsets d
2770Proof
2771 rpt STRIP_TAC
2772 >> IMP_RES_TAC DYNKIN_SYSTEM_EMPTY
2773 >> fs [dynkin_system_def]
2774 >> Q.PAT_X_ASSUM `!f. P f`
2775 (MP_TAC o Q.SPEC `\n. if n = 0 then s else if n = 1 then t else {}`)
2776 >> Know
2777 `BIGUNION
2778 (IMAGE (\n : num. (if n = 0 then s else (if n = 1 then t else {})))
2779 UNIV) =
2780 BIGUNION
2781 (IMAGE (\n : num. (if n = 0 then s else (if n = 1 then t else {})))
2782 (count 2))`
2783 >- (MATCH_MP_TAC BIGUNION_IMAGE_UNIV >> RW_TAC arith_ss [])
2784 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
2785 >> RW_TAC bool_ss [COUNT_SUC, IMAGE_INSERT, TWO, ONE, BIGUNION_INSERT,
2786 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY]
2787 >> ONCE_REWRITE_TAC [UNION_COMM]
2788 >> POP_ASSUM MATCH_MP_TAC
2789 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV, DISJOINT_EMPTY]
2790 >- (rpt COND_CASES_TAC >> art [])
2791 >> ASM_REWRITE_TAC [DISJOINT_SYM]
2792QED
2793
2794Theorem DYNKIN_SYSTEM_COUNTABLY_DUNION:
2795 !d f.
2796 dynkin_system d /\ f IN (UNIV -> subsets d) /\
2797 (!i j :num. i <> j ==> DISJOINT (f i) (f j)) ==>
2798 BIGUNION (IMAGE f UNIV) IN subsets d
2799Proof
2800 RW_TAC std_ss [dynkin_system_def]
2801QED
2802
2803(* Alternative definition of Dynkin system [6], this equivalence proof is not easy *)
2804Theorem DYNKIN_SYSTEM_ALT_MONO:
2805 !d. dynkin_system d <=>
2806 subset_class (space d) (subsets d) /\
2807 (space d) IN (subsets d) /\
2808 (!s t. s IN (subsets d) /\ t IN (subsets d) /\ s SUBSET t ==> (t DIFF s) IN (subsets d)) /\
2809 (!f :num -> 'a set.
2810 f IN (UNIV -> subsets d) /\ (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) ==>
2811 BIGUNION (IMAGE f UNIV) IN (subsets d))
2812Proof
2813 RW_TAC std_ss [dynkin_system_def]
2814 >> EQ_TAC (* 2 subgoals *)
2815 >| [ (* goal 1 (of 2) *)
2816 RW_TAC std_ss [IN_FUNSET, IN_UNIV] >|
2817 [ (* goal 1.1 (of 2), `t DIFF s IN subsets d` *)
2818 `DISJOINT s (space d DIFF t)` by ASM_SET_TAC [] \\
2819 Q.PAT_X_ASSUM `!f. P f`
2820 (MP_TAC o Q.SPEC `\n. if n = 0 then s else
2821 if n = 1 then (space d DIFF t) else {}`) \\
2822 Know `BIGUNION
2823 (IMAGE (\n :num. if n = 0 then s else
2824 if n = 1 then (space d DIFF t) else {}) UNIV) =
2825 BIGUNION
2826 (IMAGE (\n :num. if n = 0 then s else
2827 if n = 1 then (space d DIFF t) else {}) (count 2))`
2828 >- (MATCH_MP_TAC BIGUNION_IMAGE_UNIV >> RW_TAC arith_ss [])
2829 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
2830 >> RW_TAC bool_ss [COUNT_SUC, IMAGE_INSERT, TWO, ONE, BIGUNION_INSERT,
2831 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY] \\
2832 Know `t DIFF s = (space d) DIFF ((space d DIFF t) UNION s)`
2833 >- (`s SUBSET space d /\ t SUBSET space d` by PROVE_TAC [subset_class_def]
2834 >> ASM_SET_TAC [])
2835 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
2836 Q.PAT_ASSUM `!s. s IN subsets d ==> P` MATCH_MP_TAC \\
2837 POP_ASSUM MATCH_MP_TAC \\
2838 CONJ_TAC >> rpt STRIP_TAC
2839 >- (rpt COND_CASES_TAC >> PROVE_TAC [DIFF_EQ_EMPTY])
2840 >> rpt COND_CASES_TAC >> fs [DISJOINT_SYM],
2841 (* goal 1.2 (of 2), `BIGUNION (IMAGE f univ(:num)) IN subsets d` *)
2842 Q.PAT_ASSUM `!f. P f ==> Q f` (MP_TAC o Q.SPEC `\n. f (SUC n) DIFF f n`) \\
2843 BETA_TAC >> STRIP_TAC \\
2844 Know `BIGUNION (IMAGE f UNIV) =
2845 BIGUNION (IMAGE (\n. f (SUC n) DIFF f n) UNIV)`
2846 >- (POP_ASSUM K_TAC
2847 >> ONCE_REWRITE_TAC [EXTENSION]
2848 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_DIFF]
2849 >> reverse EQ_TAC
2850 >- (RW_TAC std_ss []
2851 >> POP_ASSUM MP_TAC
2852 >> RW_TAC std_ss [IN_DIFF]
2853 >> PROVE_TAC [])
2854 >> RW_TAC std_ss []
2855 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY]
2856 >> RW_TAC std_ss []
2857 >> Cases_on `x IN f x'` >- PROVE_TAC []
2858 >> Q.EXISTS_TAC `f (SUC x') DIFF f x'`
2859 >> RW_TAC std_ss [EXTENSION, IN_DIFF]
2860 >> PROVE_TAC [])
2861 >> DISCH_THEN (REWRITE_TAC o wrap) \\
2862 POP_ASSUM MATCH_MP_TAC \\
2863 CONJ_TAC >| (* 2 subgoals *)
2864 [ (* goal 1.2.1 (of 2) *)
2865 GEN_TAC \\
2866 Know `f (SUC x) DIFF f x =
2867 (space d) DIFF ((space d DIFF f (SUC x)) UNION f x)`
2868 >- (`f x SUBSET space d /\ f (SUC x) SUBSET space d`
2869 by PROVE_TAC [subset_class_def] \\
2870 ASM_SET_TAC [])
2871 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
2872 Q.PAT_ASSUM `!s. s IN subsets d ==> P` MATCH_MP_TAC \\
2873 `space d DIFF f (SUC x) IN subsets d` by PROVE_TAC [] \\
2874 `DISJOINT (space d DIFF f (SUC x)) (f x)` by ASM_SET_TAC [] \\
2875 Q.PAT_X_ASSUM `!f. P f`
2876 (MP_TAC o
2877 Q.SPEC `\n. if n = 0 then (f x) else
2878 if n = 1 then (space d DIFF f (SUC x)) else {}`) \\
2879 Know `BIGUNION
2880 (IMAGE (\n:num. if n = 0 then (f x) else
2881 if n = 1 then (space d DIFF f (SUC x)) else {})
2882 UNIV) =
2883 BIGUNION
2884 (IMAGE (\n:num. if n = 0 then (f x) else
2885 if n = 1 then (space d DIFF f (SUC x)) else {})
2886 (count 2))`
2887 >- (MATCH_MP_TAC BIGUNION_IMAGE_UNIV >> RW_TAC arith_ss [])
2888 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
2889 >> RW_TAC bool_ss [COUNT_SUC, IMAGE_INSERT, TWO, ONE, BIGUNION_INSERT,
2890 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY] \\
2891 POP_ASSUM MATCH_MP_TAC \\
2892 CONJ_TAC >- PROVE_TAC [] \\
2893 rpt GEN_TAC >> PROVE_TAC [DISJOINT_SYM, DISJOINT_EMPTY],
2894 (* goal 1.2.2 (of 2) *)
2895 HO_MATCH_MP_TAC TRANSFORM_2D_NUM \\
2896 CONJ_TAC >- PROVE_TAC [DISJOINT_SYM] \\
2897 RW_TAC arith_ss [] \\
2898 Suff `f (SUC i) SUBSET f (i + j)`
2899 >- (RW_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY,
2900 IN_INTER, IN_DIFF, SUBSET_DEF]
2901 >> PROVE_TAC [])
2902 >> Cases_on `j` >- PROVE_TAC [ADD_CLAUSES]
2903 >> POP_ASSUM K_TAC
2904 >> Know `i + SUC n = SUC i + n` >- DECIDE_TAC
2905 >> DISCH_THEN (REWRITE_TAC o wrap)
2906 >> Induct_on `n` >- RW_TAC arith_ss [SUBSET_REFL]
2907 >> MATCH_MP_TAC SUBSET_TRANS
2908 >> Q.EXISTS_TAC `f (SUC i + n)`
2909 >> PROVE_TAC [ADD_CLAUSES] ] ],
2910 (* goal 2 (of 2) *)
2911 RW_TAC std_ss [IN_UNIV, IN_FUNSET] >- PROVE_TAC [subset_class_def] \\
2912 Q.PAT_X_ASSUM `!f. P f`
2913 (MP_TAC o Q.SPEC `\n. BIGUNION (IMAGE f (count n))`) \\
2914 BETA_TAC >> STRIP_TAC \\
2915 Know `BIGUNION (IMAGE f UNIV) =
2916 BIGUNION (IMAGE (\n. BIGUNION (IMAGE f (count n))) UNIV)`
2917 >- ( KILL_TAC
2918 >> ONCE_REWRITE_TAC [EXTENSION]
2919 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_UNIV]
2920 >> EQ_TAC
2921 >- (RW_TAC std_ss []
2922 >> Q.EXISTS_TAC `BIGUNION (IMAGE f (count (SUC x')))`
2923 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_COUNT]
2924 >> PROVE_TAC [LESS_SUC_REFL])
2925 >> RW_TAC std_ss []
2926 >> POP_ASSUM MP_TAC
2927 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_COUNT]
2928 >> PROVE_TAC [] )
2929 >> DISCH_THEN (REWRITE_TAC o wrap) \\
2930 POP_ASSUM MATCH_MP_TAC \\
2931 SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_COUNT, IN_IMAGE,
2932 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\
2933 reverse CONJ_TAC
2934 >- (RW_TAC std_ss [] \\
2935 Q.EXISTS_TAC `f x'` >> RW_TAC std_ss [] \\
2936 Q.EXISTS_TAC `x'` >> DECIDE_TAC) \\
2937 (* !x. BIGUNION (IMAGE f (count x)) IN subsets d *)
2938 Induct_on `x`
2939 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_COUNT, IN_IMAGE,
2940 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY] \\
2941 REWRITE_TAC [Q.SPEC `space d` (GSYM DIFF_EQ_EMPTY)] \\
2942 Q.PAT_X_ASSUM `!s t. X ==> t DIFF s IN subsets d` MATCH_MP_TAC \\
2943 ASM_REWRITE_TAC [SUBSET_REFL]) \\
2944 (* BIGUNION (IMAGE f (count (SUC x))) IN subsets d *)
2945 REWRITE_TAC [COUNT_SUC, IMAGE_INSERT, BIGUNION_INSERT] \\
2946 `f x SUBSET space d` by PROVE_TAC [subset_class_def] \\
2947 Know `BIGUNION (IMAGE f (count x)) SUBSET space d`
2948 >- (REWRITE_TAC [BIGUNION_SUBSET] >> GEN_TAC \\
2949 RW_TAC std_ss [IN_IMAGE] >> PROVE_TAC [subset_class_def]) \\
2950 DISCH_TAC \\
2951 `f x UNION (BIGUNION (IMAGE f (count x))) SUBSET space d`
2952 by PROVE_TAC [UNION_SUBSET] \\
2953 POP_ASSUM (MP_TAC o SYM o (MATCH_MP DIFF_DIFF_SUBSET)) \\
2954 ONCE_REWRITE_TAC [DIFF_UNION] \\
2955 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
2956 Q.PAT_ASSUM `!s t. X ==> t DIFF s IN subsets d` MATCH_MP_TAC \\
2957 ASM_REWRITE_TAC [DIFF_SUBSET] \\
2958 reverse CONJ_TAC >- ASM_SET_TAC [] \\
2959 Q.PAT_ASSUM `!s t. X ==> t DIFF s IN subsets d` MATCH_MP_TAC >> art [] \\
2960 CONJ_TAC (* 2 subgoals *)
2961 >- (Q.PAT_ASSUM `!s t. X ==> t DIFF s IN subsets d` MATCH_MP_TAC >> art []) \\
2962 REWRITE_TAC [SUBSET_DIFF] >> art [] \\
2963 REWRITE_TAC [DISJOINT_BIGUNION] >> RW_TAC std_ss [IN_IMAGE] \\
2964 fs [IN_COUNT] ]
2965QED
2966
2967Theorem DYNKIN_SYSTEM_INCREASING:
2968 !p f.
2969 dynkin_system p /\ f IN (UNIV -> subsets p) /\ (f 0 = {}) /\
2970 (!n. f n SUBSET f (SUC n)) ==>
2971 BIGUNION (IMAGE f UNIV) IN subsets p
2972Proof
2973 RW_TAC std_ss [DYNKIN_SYSTEM_ALT_MONO]
2974QED
2975
2976(* The original definition of `closed_cdi`, plus `(space d) IN (subsets d)` *)
2977Theorem DYNKIN_SYSTEM_ALT:
2978 !d. dynkin_system d <=>
2979 subset_class (space d) (subsets d) /\
2980 (space d) IN (subsets d) /\
2981 (!s. s IN (subsets d) ==> (space d DIFF s) IN (subsets d)) /\
2982 (!f :num -> 'a set.
2983 f IN (UNIV -> subsets d) /\ (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) ==>
2984 BIGUNION (IMAGE f UNIV) IN (subsets d)) /\
2985 (!f :num -> 'a set.
2986 f IN (UNIV -> (subsets d)) /\ (!i j. i <> j ==> DISJOINT (f i) (f j)) ==>
2987 BIGUNION (IMAGE f UNIV) IN (subsets d))
2988Proof
2989 GEN_TAC >> EQ_TAC
2990 >> REWRITE_TAC [dynkin_system_def] >> RW_TAC std_ss [IN_UNIV, IN_FUNSET]
2991 >> Q.PAT_ASSUM `!f. P f ==> Q f` (MP_TAC o Q.SPEC `\n. f (SUC n) DIFF f n`)
2992 >> BETA_TAC >> STRIP_TAC
2993 >> Know `BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE (\n. f (SUC n) DIFF f n) UNIV)`
2994 >- (POP_ASSUM K_TAC
2995 >> ONCE_REWRITE_TAC [EXTENSION]
2996 >> RW_TAC std_ss [IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_DIFF]
2997 >> reverse EQ_TAC
2998 >- (RW_TAC std_ss []
2999 >> POP_ASSUM MP_TAC
3000 >> RW_TAC std_ss [IN_DIFF]
3001 >> PROVE_TAC [])
3002 >> RW_TAC std_ss []
3003 >> Induct_on `x'` >- RW_TAC std_ss [NOT_IN_EMPTY]
3004 >> RW_TAC std_ss []
3005 >> Cases_on `x IN f x'` >- PROVE_TAC []
3006 >> Q.EXISTS_TAC `f (SUC x') DIFF f x'`
3007 >> RW_TAC std_ss [EXTENSION, IN_DIFF]
3008 >> PROVE_TAC [])
3009 >> DISCH_THEN (REWRITE_TAC o wrap)
3010 >> POP_ASSUM MATCH_MP_TAC
3011 >> CONJ_TAC (* 2 subgoals *)
3012 >| [ (* goal 1 (of 2) *)
3013 GEN_TAC \\
3014 Know `f (SUC x) DIFF f x = (space d) DIFF ((space d DIFF f (SUC x)) UNION f x)`
3015 >- (`f x SUBSET space d /\ f (SUC x) SUBSET space d`
3016 by PROVE_TAC [subset_class_def] \\
3017 ASM_SET_TAC []) \\
3018 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
3019 Q.PAT_ASSUM `!s. s IN subsets d ==> P` MATCH_MP_TAC \\
3020 `space d DIFF f (SUC x) IN subsets d` by PROVE_TAC [] \\
3021 `DISJOINT (space d DIFF f (SUC x)) (f x)` by ASM_SET_TAC [] \\
3022 Q.PAT_X_ASSUM `!f. P f`
3023 (MP_TAC o
3024 Q.SPEC `\n. if n = 0 then (f x) else
3025 if n = 1 then (space d DIFF f (SUC x)) else {}`) \\
3026 Know `BIGUNION (IMAGE (\n:num. if n = 0 then (f x) else
3027 if n = 1 then (space d DIFF f (SUC x)) else {})
3028 UNIV) =
3029 BIGUNION (IMAGE (\n:num. if n = 0 then (f x) else
3030 if n = 1 then (space d DIFF f (SUC x)) else {})
3031 (count 2))`
3032 >- (MATCH_MP_TAC BIGUNION_IMAGE_UNIV >> RW_TAC arith_ss []) \\
3033 DISCH_THEN (ONCE_REWRITE_TAC o wrap) \\
3034 RW_TAC bool_ss [COUNT_SUC, IMAGE_INSERT, TWO, ONE, BIGUNION_INSERT,
3035 COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY, UNION_EMPTY] \\
3036 POP_ASSUM MATCH_MP_TAC \\
3037 CONJ_TAC >- PROVE_TAC [] \\
3038 rpt GEN_TAC >> PROVE_TAC [DISJOINT_SYM, DISJOINT_EMPTY],
3039 (* goal 2 (of 2) *)
3040 HO_MATCH_MP_TAC TRANSFORM_2D_NUM \\
3041 CONJ_TAC >- PROVE_TAC [DISJOINT_SYM] \\
3042 RW_TAC arith_ss [] \\
3043 Suff `f (SUC i) SUBSET f (i + j)`
3044 >- (RW_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY,
3045 IN_INTER, IN_DIFF, SUBSET_DEF]
3046 >> PROVE_TAC []) \\
3047 Cases_on `j` >- PROVE_TAC [ADD_CLAUSES] \\
3048 POP_ASSUM K_TAC \\
3049 Know `i + SUC n = SUC i + n` >- DECIDE_TAC \\
3050 DISCH_THEN (REWRITE_TAC o wrap) \\
3051 Induct_on `n` >- RW_TAC arith_ss [SUBSET_REFL] \\
3052 MATCH_MP_TAC SUBSET_TRANS \\
3053 Q.EXISTS_TAC `f (SUC i + n)` \\
3054 PROVE_TAC [ADD_CLAUSES] ]
3055QED
3056
3057Theorem SPACE_DYNKIN: !sp sts. space (dynkin sp sts) = sp
3058Proof
3059 RW_TAC std_ss [dynkin_def, space_def]
3060QED
3061
3062Theorem DYNKIN_SUBSET:
3063 !a b. dynkin_system b /\ a SUBSET (subsets b) ==>
3064 subsets (dynkin (space b) a) SUBSET (subsets b)
3065Proof
3066 RW_TAC std_ss [dynkin_def, SUBSET_DEF, IN_BIGINTER, GSPECIFICATION, subsets_def]
3067 >> POP_ASSUM (MATCH_MP_TAC o Q.SPEC `subsets b`)
3068 >> RW_TAC std_ss [SPACE]
3069QED
3070
3071Theorem DYNKIN_SUBSET_SUBSETS:
3072 !sp a. a SUBSET subsets (dynkin sp a)
3073Proof
3074 RW_TAC std_ss [dynkin_def, IN_BIGINTER, SUBSET_DEF, GSPECIFICATION, subsets_def]
3075QED
3076
3077Theorem IN_DYNKIN:
3078 !sp a x. x IN a ==> x IN subsets (dynkin sp a)
3079Proof
3080 MP_TAC DYNKIN_SUBSET_SUBSETS
3081 >> RW_TAC std_ss [SUBSET_DEF]
3082QED
3083
3084Theorem DYNKIN_MONOTONE:
3085 !sp a b. a SUBSET b ==> (subsets (dynkin sp a)) SUBSET (subsets (dynkin sp b))
3086Proof
3087 RW_TAC std_ss [dynkin_def, SUBSET_DEF, IN_BIGINTER, GSPECIFICATION, subsets_def]
3088QED
3089
3090Theorem DYNKIN_STABLE_LEMMA :
3091 !sp sts. dynkin_system (sp,sts) ==> (dynkin sp sts = (sp,sts))
3092Proof
3093 RW_TAC std_ss [dynkin_def, GSPECIFICATION, space_def, subsets_def]
3094 >> ASM_SET_TAC []
3095QED
3096
3097(* |- !d. dynkin_system d ==> (dynkin (space d) (subsets d) = d) *)
3098Theorem DYNKIN_STABLE =
3099 GEN_ALL (REWRITE_RULE [SPACE]
3100 (Q.SPECL [`space d`, `subsets d`] DYNKIN_STABLE_LEMMA));
3101
3102Theorem DYNKIN_SMALLEST :
3103 !sp sts D. sts SUBSET D /\ D SUBSET subsets (dynkin sp sts) /\
3104 dynkin_system (sp,D) ==> (D = subsets (dynkin sp sts))
3105Proof
3106 RW_TAC std_ss [SET_EQ_SUBSET]
3107 >> IMP_RES_TAC DYNKIN_STABLE_LEMMA
3108 >> ‘D = subsets (dynkin sp D)’ by PROVE_TAC [subsets_def]
3109 >> POP_ORW
3110 >> MATCH_MP_TAC DYNKIN_MONOTONE >> art []
3111QED
3112
3113Theorem DYNKIN:
3114 !sp sts. subset_class sp sts ==>
3115 sts SUBSET subsets (dynkin sp sts) /\
3116 dynkin_system (dynkin sp sts) /\
3117 subset_class sp (subsets (dynkin sp sts))
3118Proof
3119 rpt GEN_TAC
3120 >> Know `!sp sts. subset_class sp sts ==> sts SUBSET subsets (dynkin sp sts) /\
3121 dynkin_system (dynkin sp sts)`
3122 >- ( RW_TAC std_ss [dynkin_def, GSPECIFICATION, SUBSET_DEF, INTER_DEF, BIGINTER,
3123 subset_class_def, subsets_def, space_def] \\
3124 RW_TAC std_ss [dynkin_system_def, GSPECIFICATION, IN_BIGINTER, IN_FUNSET,
3125 IN_UNIV, subsets_def, space_def, subset_class_def] \\
3126 POP_ASSUM (MP_TAC o Q.SPEC `{x | x SUBSET sp}`) \\
3127 RW_TAC std_ss [GSPECIFICATION] \\
3128 POP_ASSUM MATCH_MP_TAC \\
3129 RW_TAC std_ss [SUBSET_DEF] \\
3130 PROVE_TAC [IN_DIFF, IN_BIGUNION, IN_IMAGE, IN_UNIV] )
3131 >> SIMP_TAC std_ss []
3132 >> RW_TAC std_ss [dynkin_system_def, SPACE_DYNKIN]
3133QED
3134
3135Theorem SIGMA_PROPERTY_DISJOINT_LEMMA1:
3136 !sp sts.
3137 algebra (sp,sts) ==>
3138 (!s t.
3139 s IN sts /\ t IN subsets (dynkin sp sts) ==>
3140 s INTER t IN subsets (dynkin sp sts))
3141Proof
3142 RW_TAC std_ss [IN_BIGINTER, GSPECIFICATION, dynkin_def, subsets_def]
3143 >> Suff
3144 `t IN
3145 {b | b IN subsets (dynkin sp sts) /\ s INTER b IN subsets (dynkin sp sts)}`
3146 >- RW_TAC std_ss [GSPECIFICATION, IN_BIGINTER, dynkin_def, subsets_def]
3147 >> first_x_assum MATCH_MP_TAC
3148 >> STRONG_CONJ_TAC
3149 >- (RW_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_BIGINTER,
3150 dynkin_def, subsets_def] \\
3151 first_x_assum MATCH_MP_TAC \\
3152 PROVE_TAC [subsets_def, ALGEBRA_INTER])
3153 >> `subset_class sp sts` by PROVE_TAC [algebra_def, space_def, subsets_def]
3154 >> RW_TAC std_ss [GSPECIFICATION, SUBSET_DEF, dynkin_system_def, space_def,
3155 subsets_def]
3156 >| (* 7 subgoals *)
3157 [ (* goal 1 (of 7) *)
3158 MP_TAC (UNDISCH (Q.SPECL [`sp`, `sts`] DYNKIN))
3159 >> RW_TAC std_ss [subset_class_def, SUBSET_DEF, GSPECIFICATION]
3160 >> PROVE_TAC [algebra_def, subset_class_def, SUBSET_DEF],
3161 (* goal 2 (of 7) *)
3162 PROVE_TAC [dynkin_system_def, DYNKIN, SPACE_DYNKIN],
3163 (* goal 3 (of 7) *)
3164 `sp IN sts` by PROVE_TAC [ALGEBRA_SPACE, space_def, subsets_def] >> RES_TAC,
3165 (* goal 4 (of 7) *)
3166 Know `(sp DIFF s') = space (dynkin sp sts) DIFF s'`
3167 >- (RW_TAC std_ss [EXTENSION, INTER_DEF, COMPL_DEF, UNION_DEF, GSPECIFICATION,
3168 IN_UNIV, IN_DIFF] \\
3169 PROVE_TAC [SPACE_DYNKIN])
3170 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
3171 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL
3172 >> RW_TAC std_ss [DYNKIN],
3173 (* goal 5 (of 7) *)
3174 Know `s INTER (sp DIFF s') =
3175 space (dynkin sp sts) DIFF
3176 (space (dynkin sp sts) DIFF s UNION (s INTER s'))`
3177 >- (RW_TAC std_ss [EXTENSION, INTER_DEF, COMPL_DEF, UNION_DEF, GSPECIFICATION,
3178 IN_UNIV, IN_DIFF] \\
3179 PROVE_TAC [SPACE_DYNKIN])
3180 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
3181 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL
3182 >> FULL_SIMP_TAC bool_ss [algebra_def, space_def, subsets_def]
3183 >> RW_TAC std_ss [DYNKIN]
3184 >> MATCH_MP_TAC DYNKIN_SYSTEM_DUNION
3185 >> CONJ_TAC
3186 >- PROVE_TAC [ALGEBRA_EMPTY, DYNKIN, SUBSET_DEF]
3187 >> CONJ_TAC
3188 >- (MATCH_MP_TAC DYNKIN_SYSTEM_COMPL
3189 >> RW_TAC std_ss [DYNKIN])
3190 >> ASM_REWRITE_TAC []
3191 >> RW_TAC std_ss [DISJOINT_DEF, COMPL_DEF, INTER_DEF, IN_DIFF, IN_UNIV,
3192 GSPECIFICATION, EXTENSION, NOT_IN_EMPTY]
3193 >> DECIDE_TAC,
3194 (* goal 6 (of 7) *)
3195 Q.PAT_X_ASSUM `f IN x` MP_TAC
3196 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV, GSPECIFICATION]
3197 >> MATCH_MP_TAC DYNKIN_SYSTEM_COUNTABLY_DUNION
3198 >> RW_TAC std_ss [DYNKIN, IN_FUNSET, SUBSET_DEF],
3199 (* goal 7 (of 7) *)
3200 Know `s INTER BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE (\n. s INTER f n) UNIV)`
3201 >- (KILL_TAC \\
3202 RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, GSPECIFICATION, IN_IMAGE, IN_UNIV,
3203 IN_INTER] \\
3204 EQ_TAC >> RW_TAC std_ss [] >|
3205 [Q.EXISTS_TAC `s INTER f x'`
3206 >> RW_TAC std_ss [IN_INTER]
3207 >> Q.EXISTS_TAC `x'`
3208 >> RW_TAC arith_ss [IN_INTER],
3209 POP_ASSUM (MP_TAC)
3210 >> RW_TAC arith_ss [IN_INTER],
3211 POP_ASSUM (MP_TAC)
3212 >> RW_TAC arith_ss [IN_INTER]
3213 >> Q.EXISTS_TAC `f n`
3214 >> RW_TAC std_ss []
3215 >> PROVE_TAC []])
3216 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
3217 >> MATCH_MP_TAC DYNKIN_SYSTEM_COUNTABLY_DUNION
3218 >> Q.PAT_X_ASSUM `f IN X` MP_TAC
3219 >> RW_TAC std_ss [DYNKIN, IN_FUNSET, IN_UNIV, GSPECIFICATION]
3220 >> Q.PAT_X_ASSUM `!i j. X i j` (MP_TAC o Q.SPECL [`i`, `j`])
3221 >> RW_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY]
3222 >> PROVE_TAC [] ]
3223QED
3224
3225(* The smallest dynkin system generated from an algebra is stable under finite
3226 intersection. *)
3227Theorem SIGMA_PROPERTY_DISJOINT_LEMMA2:
3228 !sp sts.
3229 algebra (sp,sts) ==>
3230 (!s t.
3231 s IN subsets (dynkin sp sts) /\ t IN subsets (dynkin sp sts) ==>
3232 s INTER t IN subsets (dynkin sp sts))
3233Proof
3234 RW_TAC std_ss []
3235 >> POP_ASSUM MP_TAC
3236 >> SIMP_TAC std_ss [dynkin_def, IN_BIGINTER, GSPECIFICATION, subsets_def]
3237 >> STRIP_TAC >> Q.X_GEN_TAC `P`
3238 >> Suff
3239 `t IN
3240 {b | b IN subsets (dynkin sp sts) /\ s INTER b IN subsets (dynkin sp sts)}`
3241 >- RW_TAC std_ss [GSPECIFICATION, IN_BIGINTER, dynkin_def, subsets_def]
3242 >> `subset_class sp sts` by PROVE_TAC [algebra_def, space_def, subsets_def]
3243 >> Q.PAT_X_ASSUM `!s. P s` MATCH_MP_TAC
3244 >> STRONG_CONJ_TAC
3245 >- (RW_TAC std_ss [SUBSET_DEF, GSPECIFICATION] >|
3246 [PROVE_TAC [DYNKIN, SUBSET_DEF],
3247 PROVE_TAC [SIGMA_PROPERTY_DISJOINT_LEMMA1, INTER_COMM]])
3248 >> SIMP_TAC std_ss [GSPECIFICATION, SUBSET_DEF, dynkin_system_def, space_def,
3249 subsets_def]
3250 >> STRIP_TAC >> rpt CONJ_TAC
3251 >| (* 5 subgoals *)
3252 [ (* goal 1 (of 5) *)
3253 (MP_TAC o UNDISCH o Q.SPECL [`sp`, `sts`]) DYNKIN
3254 >> RW_TAC std_ss [subset_class_def, SUBSET_DEF, GSPECIFICATION]
3255 >> PROVE_TAC [algebra_def, subset_class_def, SUBSET_DEF],
3256 (* goal 2 (of 5) *)
3257 PROVE_TAC [dynkin_system_def, DYNKIN, SPACE_DYNKIN],
3258 (* goal 3 (of 5) *)
3259 `sp IN sts` by PROVE_TAC [ALGEBRA_SPACE, space_def, subsets_def] >> RES_TAC,
3260 (* goal 4 (of 5) *)
3261 Q.X_GEN_TAC `s'`
3262 >> rpt STRIP_TAC
3263 >- PROVE_TAC [dynkin_system_def, DYNKIN, SPACE_DYNKIN]
3264 >> Know `s INTER (sp DIFF s') =
3265 space (dynkin sp sts) DIFF
3266 (space (dynkin sp sts) DIFF s UNION (s INTER s'))`
3267 >- (RW_TAC std_ss [EXTENSION, INTER_DEF, COMPL_DEF, UNION_DEF, GSPECIFICATION,
3268 IN_UNIV, IN_DIFF, SPACE_DYNKIN] \\
3269 DECIDE_TAC)
3270 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
3271 >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL
3272 >> RW_TAC std_ss [DYNKIN]
3273 >> MATCH_MP_TAC DYNKIN_SYSTEM_DUNION
3274 >> CONJ_TAC
3275 >- PROVE_TAC [ALGEBRA_EMPTY, DYNKIN, SUBSET_DEF]
3276 >> CONJ_TAC
3277 >- (MATCH_MP_TAC DYNKIN_SYSTEM_COMPL
3278 >> RW_TAC std_ss [DYNKIN])
3279 >> ASM_REWRITE_TAC []
3280 >> RW_TAC std_ss [DISJOINT_DEF, COMPL_DEF, INTER_DEF, IN_DIFF, IN_UNIV,
3281 GSPECIFICATION, EXTENSION, NOT_IN_EMPTY]
3282 >> DECIDE_TAC,
3283 (* goal 5 (of 5) *)
3284 Q.X_GEN_TAC `f` >> rpt STRIP_TAC
3285 >- (Q.PAT_X_ASSUM `f IN x` MP_TAC
3286 >> RW_TAC std_ss [IN_FUNSET, IN_UNIV, GSPECIFICATION]
3287 >> MATCH_MP_TAC DYNKIN_SYSTEM_COUNTABLY_DUNION
3288 >> RW_TAC std_ss [DYNKIN, IN_FUNSET, SUBSET_DEF])
3289 >> Know
3290 `s INTER BIGUNION (IMAGE f UNIV) =
3291 BIGUNION (IMAGE (\n. s INTER f n) UNIV)`
3292 >- (KILL_TAC \\
3293 RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, GSPECIFICATION, IN_IMAGE, IN_UNIV,
3294 IN_INTER] \\
3295 EQ_TAC >> RW_TAC std_ss [] >|
3296 [Q.EXISTS_TAC `s INTER f x'`
3297 >> RW_TAC std_ss [IN_INTER]
3298 >> Q.EXISTS_TAC `x'`
3299 >> RW_TAC arith_ss [IN_INTER],
3300 POP_ASSUM (MP_TAC)
3301 >> RW_TAC arith_ss [IN_INTER],
3302 POP_ASSUM (MP_TAC)
3303 >> RW_TAC arith_ss [IN_INTER]
3304 >> Q.EXISTS_TAC `f n`
3305 >> RW_TAC std_ss []
3306 >> PROVE_TAC []])
3307 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
3308 >> MATCH_MP_TAC DYNKIN_SYSTEM_COUNTABLY_DUNION
3309 >> Q.PAT_X_ASSUM `f IN X` MP_TAC
3310 >> RW_TAC std_ss [DYNKIN, IN_FUNSET, IN_UNIV, GSPECIFICATION]
3311 >> Q.PAT_X_ASSUM `!i j. X i j` (MP_TAC o Q.SPECL [`i`, `j`])
3312 >> RW_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY]
3313 >> PROVE_TAC [] ]
3314QED
3315
3316(* If an algebra is contained in a dynkin system, then the smallest sigma-algebra
3317 generated from it is also contained in the dynkin system.
3318 *)
3319Theorem SIGMA_PROPERTY_DISJOINT_LEMMA:
3320 !sp a d. algebra (sp,a) /\ a SUBSET d /\ dynkin_system (sp,d)
3321 ==> subsets (sigma sp a) SUBSET d
3322Proof
3323 RW_TAC std_ss []
3324 >> MATCH_MP_TAC SUBSET_TRANS
3325 >> Q.EXISTS_TAC `subsets (dynkin sp a)`
3326 >> reverse CONJ_TAC
3327 >- (RW_TAC std_ss [SUBSET_DEF, dynkin_def, IN_BIGINTER,
3328 GSPECIFICATION, subsets_def, space_def]
3329 >> PROVE_TAC [SUBSET_DEF])
3330 >> NTAC 2 (POP_ASSUM K_TAC)
3331 >> Suff `subsets (dynkin sp a) IN {b | a SUBSET b /\ sigma_algebra (sp,b)}`
3332 >- (KILL_TAC \\
3333 RW_TAC std_ss [sigma_def, BIGINTER, SUBSET_DEF, GSPECIFICATION, subsets_def])
3334 >> `subset_class sp a` by PROVE_TAC [algebra_def, space_def, subsets_def]
3335 >> RW_TAC std_ss [GSPECIFICATION, SIGMA_ALGEBRA_ALT_DISJOINT,
3336 ALGEBRA_ALT_INTER, space_def, subsets_def] >|
3337 [PROVE_TAC [DYNKIN, subsets_def],
3338 PROVE_TAC [DYNKIN, space_def],
3339 PROVE_TAC [ALGEBRA_EMPTY, SUBSET_DEF, DYNKIN, space_def, subsets_def],
3340 PROVE_TAC [DYNKIN, DYNKIN_SYSTEM_COMPL, space_def, SPACE_DYNKIN],
3341 PROVE_TAC [SIGMA_PROPERTY_DISJOINT_LEMMA2],
3342 PROVE_TAC [DYNKIN, DYNKIN_SYSTEM_COUNTABLY_DUNION]]
3343QED
3344
3345Theorem SIGMA_PROPERTY_DISJOINT_WEAK_ALT:
3346 !sp p a.
3347 algebra (sp, a) /\ a SUBSET p /\
3348 subset_class sp p /\
3349 (!s. s IN p ==> sp DIFF s IN p) /\
3350 (!f : num -> 'a -> bool.
3351 f IN (UNIV -> p) /\ (f 0 = {}) /\ (!n. f n SUBSET f (SUC n)) ==>
3352 BIGUNION (IMAGE f UNIV) IN p) /\
3353 (!f : num -> 'a -> bool.
3354 f IN (UNIV -> p) /\ (!m n. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
3355 BIGUNION (IMAGE f UNIV) IN p) ==>
3356 subsets (sigma sp a) SUBSET p
3357Proof
3358 RW_TAC std_ss []
3359 >> MATCH_MP_TAC (Q.SPECL [`sp`, `a`, `p`] SIGMA_PROPERTY_DISJOINT_LEMMA)
3360 >> RW_TAC std_ss [dynkin_system_def, space_def, subsets_def]
3361 >> `sp IN a` by PROVE_TAC [ALGEBRA_SPACE, space_def, subsets_def]
3362 >> PROVE_TAC [SUBSET_DEF]
3363QED
3364
3365Theorem SIGMA_PROPERTY_DISJOINT:
3366 !sp p a.
3367 algebra (sp,a) /\ a SUBSET p /\
3368 (!s. s IN (p INTER subsets (sigma sp a)) ==> sp DIFF s IN p) /\
3369 (!f : num -> 'a -> bool.
3370 f IN (UNIV -> p INTER subsets (sigma sp a)) /\ (f 0 = {}) /\
3371 (!n. f n SUBSET f (SUC n)) ==>
3372 BIGUNION (IMAGE f UNIV) IN p) /\
3373 (!f : num -> 'a -> bool.
3374 f IN (UNIV -> p INTER subsets (sigma sp a)) /\
3375 (!i j. i <> j ==> DISJOINT (f i) (f j)) ==>
3376 BIGUNION (IMAGE f UNIV) IN p) ==>
3377 subsets (sigma sp a) SUBSET p
3378Proof
3379 RW_TAC std_ss [IN_FUNSET, IN_UNIV, IN_INTER]
3380 >> Suff `subsets (sigma sp a) SUBSET p INTER subsets (sigma sp a)`
3381 >- (KILL_TAC
3382 >> SIMP_TAC std_ss [SUBSET_INTER])
3383 >> MATCH_MP_TAC
3384 (Q.SPECL [`sp`, `p INTER subsets (sigma sp a)`, `a`]
3385 SIGMA_PROPERTY_DISJOINT_WEAK_ALT)
3386 >> RW_TAC std_ss [SUBSET_INTER, IN_INTER, IN_FUNSET, IN_UNIV]
3387 >| (* 5 subgoals *)
3388 [ (* goal 1 (of 5) *)
3389 REWRITE_TAC [SIGMA_SUBSET_SUBSETS],
3390 (* goal 2 (of 5) *)
3391 REWRITE_TAC [subset_class_def] \\
3392 RW_TAC std_ss [IN_INTER] \\
3393 `subset_class sp a` by PROVE_TAC [algebra_def, space_def, subsets_def] \\
3394 POP_ASSUM (MP_TAC o (MATCH_MP SIGMA_ALGEBRA_SIGMA)) \\
3395 RW_TAC std_ss [sigma_algebra_def, algebra_def, space_def, subsets_def,
3396 SPACE_SIGMA] \\
3397 fs [subset_class_def],
3398 (* goal (3 of 5) *)
3399 (MP_TAC o Q.SPECL [`sp`,`a`]) SIGMA_ALGEBRA_SIGMA
3400 >> Q.PAT_X_ASSUM `algebra (sp,a)` MP_TAC
3401 >> RW_TAC std_ss [algebra_def, space_def, subsets_def]
3402 >> POP_ASSUM MP_TAC
3403 >> NTAC 3 (POP_ASSUM (K ALL_TAC))
3404 >> Know `space (sigma sp a) = sp` >- RW_TAC std_ss [sigma_def, space_def]
3405 >> RW_TAC std_ss [SIGMA_ALGEBRA, algebra_def, subsets_def, space_def],
3406 (* goal 4 (of 5) *)
3407 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION
3408 >> Q.PAT_X_ASSUM `algebra (sp,a)` MP_TAC
3409 >> RW_TAC std_ss [SIGMA_ALGEBRA_SIGMA, COUNTABLE_IMAGE_NUM, SUBSET_DEF,
3410 IN_IMAGE, IN_UNIV, algebra_def, subsets_def, space_def]
3411 >> PROVE_TAC [],
3412 (* goal 5 (of 5) *)
3413 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UNION
3414 >> Q.PAT_X_ASSUM `algebra (sp,a)` MP_TAC
3415 >> RW_TAC std_ss [SIGMA_ALGEBRA_SIGMA, COUNTABLE_IMAGE_NUM, SUBSET_DEF,
3416 IN_IMAGE, IN_UNIV, algebra_def, subsets_def, space_def]
3417 >> PROVE_TAC [] ]
3418QED
3419
3420(* Every sigma-algebra is a Dynkin system *)
3421Theorem SIGMA_ALGEBRA_IMP_DYNKIN_SYSTEM: !a. sigma_algebra a ==> dynkin_system a
3422Proof
3423 rpt STRIP_TAC
3424 >> REWRITE_TAC [dynkin_system_def]
3425 >> CONJ_TAC >- PROVE_TAC [SIGMA_ALGEBRA]
3426 >> CONJ_TAC >- PROVE_TAC [sigma_algebra_def, ALGEBRA_SPACE]
3427 >> CONJ_TAC >- PROVE_TAC [SIGMA_ALGEBRA]
3428 >> PROVE_TAC [SIGMA_ALGEBRA_ALT]
3429QED
3430
3431(* A Dynkin system d is a sigma-algebra iff it is stable under finite intersections *)
3432Theorem DYNKIN_LEMMA:
3433 !d. dynkin_system d /\
3434 (!s t. s IN subsets d /\ t IN subsets d ==> s INTER t IN subsets d)
3435 <=> sigma_algebra d
3436Proof
3437 GEN_TAC >> reverse EQ_TAC
3438 >- (rpt STRIP_TAC >- IMP_RES_TAC SIGMA_ALGEBRA_IMP_DYNKIN_SYSTEM \\
3439 MATCH_MP_TAC ALGEBRA_INTER >> PROVE_TAC [sigma_algebra_def])
3440 >> rpt STRIP_TAC
3441 (* it remains to show that a INTER-stable Dynkin system is sigma-algebra *)
3442 >> REWRITE_TAC [SIGMA_ALGEBRA_ALT, ALGEBRA_ALT_INTER]
3443 >> rpt CONJ_TAC >- PROVE_TAC [dynkin_system_def]
3444 >- PROVE_TAC [DYNKIN_SYSTEM_EMPTY]
3445 >- PROVE_TAC [dynkin_system_def]
3446 >- ASM_REWRITE_TAC []
3447 (* now the last hard part *)
3448 >> rpt STRIP_TAC
3449 >> `subset_class (space d) (subsets d)` by PROVE_TAC [dynkin_system_def]
3450 >> fs [subset_class_def, IN_FUNSET, IN_UNIV]
3451 >> MP_TAC (Q.SPECL [`space d`, `subsets d`, `f`] SETS_TO_DISJOINT_SETS)
3452 >> RW_TAC std_ss []
3453 >> POP_ASSUM (REWRITE_TAC o wrap)
3454 >> MATCH_MP_TAC DYNKIN_SYSTEM_COUNTABLY_DUNION
3455 >> fs [IN_FUNSET, IN_UNIV]
3456(* !x. g x IN subsets d *)
3457 >> MP_TAC (Q.SPECL [`subsets d`, `\i. space d DIFF f i`] DINTER_IMP_FINITE_INTER)
3458 >> Know `(\i. space d DIFF f i) IN (UNIV -> subsets d)`
3459 >- (SIMP_TAC std_ss [IN_FUNSET, IN_UNIV] \\
3460 GEN_TAC >> MATCH_MP_TAC DYNKIN_SYSTEM_COMPL >> art [])
3461 >> RW_TAC std_ss []
3462 >> STRIP_ASSUME_TAC (Q.SPEC `x` LESS_0_CASES) >- fs []
3463 >> Q.PAT_X_ASSUM `!n. 0 < n ==> (g n = X)`
3464 (fn th => MP_TAC (MATCH_MP th (ASSUME ``0 < x:num``)))
3465 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap)
3466 >> PROVE_TAC []
3467QED
3468
3469Theorem DYNKIN_SUBSET_SIGMA:
3470 !sp sts. subset_class sp sts ==>
3471 subsets (dynkin sp sts) SUBSET subsets (sigma sp sts)
3472Proof
3473 rpt STRIP_TAC
3474 >> ASSUME_TAC
3475 (Q.SPEC `sp` (MATCH_MP DYNKIN_MONOTONE
3476 (Q.SPECL [`sp`, `sts`] SIGMA_SUBSET_SUBSETS)))
3477 >> Suff `subsets (dynkin sp (subsets (sigma sp sts))) = subsets (sigma sp sts)`
3478 >- PROVE_TAC []
3479 >> IMP_RES_TAC SIGMA_ALGEBRA_SIGMA
3480 >> IMP_RES_TAC SIGMA_ALGEBRA_IMP_DYNKIN_SYSTEM
3481 >> POP_ASSUM (MP_TAC o (MATCH_MP DYNKIN_STABLE))
3482 >> REWRITE_TAC [SPACE_SIGMA]
3483 >> DISCH_THEN (ASM_REWRITE_TAC o wrap)
3484QED
3485
3486(* if generator is stable under finite intersections, then dynkin(g) = sigma(g) *)
3487Theorem DYNKIN_THM:
3488 !sp sts. subset_class sp sts /\ (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts)
3489 ==> (dynkin sp sts = sigma sp sts)
3490Proof
3491 rpt STRIP_TAC
3492 >> ONCE_REWRITE_TAC [SYM (Q.SPEC `dynkin sp sts` SPACE),
3493 SYM (Q.SPEC `sigma sp sts` SPACE)]
3494 >> REWRITE_TAC [SPACE_DYNKIN, SPACE_SIGMA]
3495 >> SIMP_TAC std_ss []
3496 >> REWRITE_TAC [SET_EQ_SUBSET]
3497 >> CONJ_TAC >- IMP_RES_TAC DYNKIN_SUBSET_SIGMA
3498 (* goal: subsets (sigma sp sts) SUBSET subsets (dynkin sp sts) *)
3499 >> Suff `sigma_algebra (dynkin sp sts)`
3500 >- (DISCH_TAC \\
3501 ASSUME_TAC (Q.SPECL [`sp`, `sts`] DYNKIN_SUBSET_SUBSETS) \\
3502 POP_ASSUM (ASSUME_TAC o (Q.SPEC `sp`) o (MATCH_MP SIGMA_MONOTONE)) \\
3503 IMP_RES_TAC SIGMA_STABLE \\
3504 fs [SPACE_DYNKIN])
3505 (* goal: sigma_algebra (dynkin sp sts) *)
3506 >> REWRITE_TAC [GSYM DYNKIN_LEMMA]
3507 >> CONJ_TAC >- PROVE_TAC [DYNKIN]
3508 (* goal: (dynkin sp sts) is INTER-stable *)
3509 >> Q.ABBREV_TAC
3510 `D = \d. (sp, {q | q SUBSET sp /\ q INTER d IN (subsets (dynkin sp sts))})`
3511 >> Suff `!d. d IN subsets (dynkin sp sts) ==> dynkin_system (D d)`
3512 >- (DISCH_TAC \\
3513 ASSUME_TAC (Q.SPECL [`sp`, `sts`] DYNKIN_SUBSET_SUBSETS) \\
3514 Know `!g. g IN sts ==> sts SUBSET (subsets (D g))`
3515 >- (REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\
3516 `x INTER g IN sts` by PROVE_TAC [] \\
3517 Q.UNABBREV_TAC `D` >> BETA_TAC \\
3518 RW_TAC std_ss [subsets_def, GSPECIFICATION]
3519 >- PROVE_TAC [subset_class_def] \\
3520 PROVE_TAC [DYNKIN_SUBSET_SUBSETS, SUBSET_DEF]) >> DISCH_TAC \\
3521 Know `!g. g IN sts ==> subsets (dynkin sp sts) SUBSET subsets (D g)`
3522 >- (rpt STRIP_TAC \\
3523 `sts SUBSET subsets (D g)` by PROVE_TAC [] \\
3524 POP_ASSUM (MP_TAC o (Q.SPEC `sp`) o (MATCH_MP DYNKIN_MONOTONE)) \\
3525 `dynkin_system (D g)` by PROVE_TAC [SUBSET_DEF] \\
3526 POP_ASSUM (MP_TAC o (MATCH_MP DYNKIN_STABLE)) \\
3527 `space (D g) = sp` by METIS_TAC [space_def] \\
3528 POP_ASSUM (REWRITE_TAC o wrap) \\
3529 DISCH_THEN (ASM_REWRITE_TAC o wrap)) >> DISCH_TAC \\
3530 Know `!g d. g IN sts /\ d IN subsets (dynkin sp sts) ==>
3531 d INTER g IN subsets (dynkin sp sts)`
3532 >- (rpt STRIP_TAC \\
3533 `d IN subsets (D g)` by PROVE_TAC [SUBSET_DEF] \\
3534 POP_ASSUM MP_TAC \\
3535 Q.UNABBREV_TAC `D` >> BETA_TAC \\
3536 RW_TAC std_ss [subsets_def, GSPECIFICATION]) >> DISCH_TAC \\
3537 Know `!d. d IN subsets (dynkin sp sts) ==> sts SUBSET subsets (D d)`
3538 >- (rpt STRIP_TAC \\
3539 REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\
3540 Q.UNABBREV_TAC `D` >> BETA_TAC \\
3541 RW_TAC std_ss [subsets_def, GSPECIFICATION]
3542 >- PROVE_TAC [subset_class_def] \\
3543 ONCE_REWRITE_TAC [INTER_COMM] \\
3544 PROVE_TAC []) >> DISCH_TAC \\
3545 Know `!d. d IN subsets (dynkin sp sts) ==>
3546 subsets (dynkin sp sts) SUBSET subsets (D d)`
3547 >- (rpt STRIP_TAC \\
3548 `sts SUBSET subsets (D d)` by PROVE_TAC [] \\
3549 POP_ASSUM (MP_TAC o (Q.SPEC `sp`) o (MATCH_MP DYNKIN_MONOTONE)) \\
3550 `dynkin_system (D d)` by PROVE_TAC [SUBSET_DEF] \\
3551 POP_ASSUM (MP_TAC o (MATCH_MP DYNKIN_STABLE)) \\
3552 `space (D d) = sp` by METIS_TAC [space_def] \\
3553 POP_ASSUM (REWRITE_TAC o wrap) \\
3554 DISCH_THEN (ASM_REWRITE_TAC o wrap)) >> DISCH_TAC \\
3555 rpt STRIP_TAC \\
3556 `subsets (dynkin sp sts) SUBSET subsets (D t)` by PROVE_TAC [] \\
3557 POP_ASSUM MP_TAC \\
3558 REWRITE_TAC [SUBSET_DEF] >> rpt STRIP_TAC \\
3559 `s IN subsets (D t)` by PROVE_TAC [] \\
3560 POP_ASSUM MP_TAC \\
3561 Q.UNABBREV_TAC `D` >> BETA_TAC \\
3562 RW_TAC std_ss [subsets_def, GSPECIFICATION])
3563 (* !d. d IN subsets (dynkin sp sts) ==> dynkin_system (D d) *)
3564 >> rpt STRIP_TAC
3565 >> REWRITE_TAC [dynkin_system_def]
3566 >> STRONG_CONJ_TAC
3567 >- (FULL_SIMP_TAC std_ss [subset_class_def] \\
3568 GEN_TAC >> Q.UNABBREV_TAC `D` >> BETA_TAC \\
3569 RW_TAC std_ss [subsets_def, GSPECIFICATION, space_def])
3570 >> DISCH_TAC
3571 >> STRONG_CONJ_TAC
3572 >- (Q.UNABBREV_TAC `D` >> BETA_TAC \\
3573 RW_TAC std_ss [GSPECIFICATION, space_def, subsets_def, SUBSET_REFL] \\
3574 fs [space_def, subsets_def] \\
3575 STRIP_ASSUME_TAC (MATCH_MP DYNKIN (ASSUME ``subset_class sp sts``)) \\
3576 `d SUBSET sp` by PROVE_TAC [subset_class_def] \\
3577 `sp INTER d = d` by PROVE_TAC [INTER_SUBSET_EQN] \\
3578 POP_ASSUM (ASM_REWRITE_TAC o wrap))
3579 >> DISCH_TAC
3580 >> STRONG_CONJ_TAC
3581 >- ((* !s. s IN subsets (D d) ==> space (D d) DIFF s IN subsets (D d) *)
3582 `space (D d) = sp` by METIS_TAC [space_def]\\
3583 POP_ASSUM (fs o wrap) \\
3584 rpt STRIP_TAC \\
3585 Q.UNABBREV_TAC `D` >> fs [subsets_def] \\
3586 Know `(sp DIFF s) INTER d = sp DIFF ((s INTER d) UNION (sp DIFF d))`
3587 >- ASM_SET_TAC [] \\
3588 DISCH_THEN (REWRITE_TAC o wrap) \\
3589 `dynkin_system (dynkin sp sts)` by PROVE_TAC [DYNKIN] \\
3590 MATCH_MP_TAC (REWRITE_RULE [SPACE_DYNKIN]
3591 (Q.SPEC `dynkin sp sts` DYNKIN_SYSTEM_COMPL)) \\
3592 ASM_REWRITE_TAC [] \\
3593 `DISJOINT (s INTER d) (sp DIFF d)` by ASM_SET_TAC [] \\
3594 MATCH_MP_TAC (Q.SPEC `dynkin sp sts` DYNKIN_SYSTEM_DUNION) \\
3595 ASM_REWRITE_TAC [] \\
3596 MATCH_MP_TAC (REWRITE_RULE [SPACE_DYNKIN]
3597 (Q.SPEC `dynkin sp sts` DYNKIN_SYSTEM_COMPL)) \\
3598 ASM_REWRITE_TAC [])
3599 >> DISCH_TAC
3600 (* final goal *)
3601 >> rpt STRIP_TAC
3602 >> `!i j. i <> i ==> DISJOINT (f i INTER d) (f j INTER d)` by ASM_SET_TAC []
3603 >> Q.UNABBREV_TAC `D` >> BETA_TAC
3604 >> REWRITE_TAC [subsets_def]
3605 >> RW_TAC std_ss [GSPECIFICATION]
3606 >- (REWRITE_TAC [BIGUNION_SUBSET, IN_IMAGE] \\
3607 rpt STRIP_TAC >> fs [subsets_def, IN_FUNSET, IN_UNIV])
3608 >> fs [subsets_def, IN_FUNSET, IN_UNIV]
3609 >> REWRITE_TAC [BIGUNION_OVER_INTER_L]
3610 >> fs [space_def]
3611 >> MATCH_MP_TAC DYNKIN_SYSTEM_COUNTABLY_DUNION
3612 >> CONJ_TAC >- PROVE_TAC [DYNKIN]
3613 >> CONJ_TAC >- (REWRITE_TAC [IN_FUNSET, IN_UNIV] >> PROVE_TAC [])
3614 >> rpt STRIP_TAC
3615 >> `DISJOINT (f i) (f j)` by PROVE_TAC []
3616 >> BETA_TAC >> ASM_SET_TAC []
3617QED
3618
3619(* This theorem is a stronger version of SIGMA_PROPERTY_DISJOINT_LEMMA, requiring
3620 only closure of (finite) intersections instead of a full algebra.
3621 *)
3622Theorem SIGMA_PROPERTY_DYNKIN :
3623 !sp sts d.
3624 subset_class sp sts /\
3625 (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\
3626 sts SUBSET d /\ dynkin_system (sp,d) ==>
3627 subsets (sigma sp sts) SUBSET d
3628Proof
3629 rpt STRIP_TAC
3630 (* applying DYNKIN_THM *)
3631 >> Know ‘sigma sp sts = dynkin sp sts’
3632 >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
3633 MATCH_MP_TAC DYNKIN_THM >> art [])
3634 >> Rewr'
3635 (* applying DYNKIN_SUBSET *)
3636 >> qabbrev_tac ‘b = (sp,d)’
3637 >> ‘d = subsets b’ by rw [Abbr ‘b’] >> POP_ORW
3638 >> ‘sp = space b’ by rw [Abbr ‘b’] >> POP_ORW
3639 >> MATCH_MP_TAC DYNKIN_SUBSET
3640 >> simp [Abbr ‘b’]
3641QED
3642
3643(* ------------------------------------------------------------------------- *)
3644(* Some further additions by Concordia HVG (M. Qasim & W. Ahmed) *)
3645(* ------------------------------------------------------------------------- *)
3646
3647(* |- !sp sts.
3648 semiring (sp,sts) <=>
3649 subset_class sp sts /\ {} IN sts /\
3650 (!s t. s IN sts /\ t IN sts ==> s INTER t IN sts) /\
3651 !s t.
3652 s IN sts /\ t IN sts ==>
3653 ?c. c SUBSET sts /\ FINITE c /\ disjoint c /\ s DIFF t = BIGUNION c
3654 *)
3655Theorem semiring_alt = semiring_def |> (Q.SPEC ‘(sp,sts)’)
3656 |> REWRITE_RULE [space_def, subsets_def]
3657 |> Q.GENL [‘sp’, ‘sts’]
3658
3659Theorem INTER_SPACE_EQ1 : (* was: Int_space_eq1 *)
3660 !sp sts . subset_class sp sts ==> !x. x IN sts ==> (sp INTER x = x)
3661Proof
3662 rpt GEN_TAC THEN SET_TAC [subset_class_def]
3663QED
3664
3665Theorem INTER_SPACE_REDUCE : (* was: Int_space_eq2 *)
3666 !sp sts. subset_class sp sts ==> !x. x IN sts ==> (x INTER sp = x)
3667Proof
3668 rpt GEN_TAC THEN SET_TAC [subset_class_def]
3669QED
3670
3671Theorem SEMIRING_SETS_COLLECT : (* was: sets_Collect_conj *)
3672 !sp sts P Q. semiring (sp, sts) /\
3673 {x | x IN sp /\ P x} IN sts /\
3674 {x | x IN sp /\ Q x} IN sts ==>
3675 {x | x IN sp /\ P x /\ Q x} IN sts
3676Proof
3677 rpt GEN_TAC
3678 >> SIMP_TAC std_ss [semiring_def, space_def, subsets_def]
3679 >> rpt STRIP_TAC
3680 >> Q.PAT_X_ASSUM ‘!s t. s IN sts /\ t IN sts ==> ?c. _’ K_TAC
3681 >> FIRST_X_ASSUM (MP_TAC o Q.SPECL [‘{x | x IN sp /\ P x}’, ‘{x | x IN sp /\ Q x}’])
3682 >> ASM_SIMP_TAC std_ss [GSPECIFICATION, INTER_DEF]
3683 >> REWRITE_TAC [SET_RULE “(A /\ B) /\ A /\ C <=> A /\ B /\ C”]
3684QED
3685
3686(* |- !sp sts.
3687 ring (sp,sts) <=>
3688 subset_class sp sts /\ {} IN sts /\
3689 (!s t. s IN sts /\ t IN sts ==> s UNION t IN sts) /\
3690 !s t. s IN sts /\ t IN sts ==> s DIFF t IN sts
3691 *)
3692Theorem ring_alt = ring_def |> Q.SPEC ‘(sp,sts)’
3693 |> REWRITE_RULE [space_def, subsets_def]
3694 |> Q.GENL [‘sp’, ‘sts’]
3695
3696(* A semiring becomes a ring if it's stable under finite union *)
3697Theorem ring_and_semiring:
3698 !r. ring r <=>
3699 semiring r /\
3700 !s t. s IN (subsets r) /\ t IN (subsets r) ==> s UNION t IN (subsets r)
3701Proof
3702 GEN_TAC >> EQ_TAC >> RW_TAC std_ss []
3703 >- (MATCH_MP_TAC RING_IMP_SEMIRING >> art [])
3704 >- (MATCH_MP_TAC RING_UNION >> art [])
3705 >> RW_TAC std_ss [ring_def] >> fs [semiring_def]
3706 >> Q.PAT_X_ASSUM `!s t. s IN subsets r /\ t IN subsets r ==> ?c. X`
3707 (MP_TAC o (Q.SPECL [`s`, `t`]))
3708 >> RW_TAC std_ss []
3709 >> POP_ORW
3710 >> IMP_RES_TAC finite_decomposition_simple
3711 >> Cases_on `n = 0`
3712 >- (fs [COUNT_ZERO, IMAGE_EMPTY, BIGUNION_EMPTY])
3713 >> `0 < n` by RW_TAC arith_ss []
3714 >> fs [SUBSET_DEF, IN_IMAGE, IN_COUNT]
3715 >> irule DUNION_IMP_FINITE_UNION >> art []
3716 >> RW_TAC std_ss []
3717QED
3718
3719Theorem RING_FINITE_BIGUNION1 : (* was: finite_Union *)
3720 !X sp sts. ring (sp, sts) /\ FINITE X ==> X SUBSET sts ==> BIGUNION X IN sts
3721Proof
3722 rpt GEN_TAC THEN
3723 REWRITE_TAC [ring_def,subsets_def] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN
3724 SPEC_TAC (``X:('a->bool)->bool``,``X:('a->bool)->bool``) THEN
3725 SET_INDUCT_TAC THENL
3726 [FULL_SIMP_TAC std_ss [semiring_def, BIGUNION_EMPTY], ALL_TAC] THEN
3727 DISCH_TAC THEN REWRITE_TAC [BIGUNION_INSERT] THEN FIRST_ASSUM MATCH_MP_TAC THEN
3728 ASM_SET_TAC []
3729QED
3730
3731Theorem RING_FINITE_BIGUNION2 : (* was: finite_UN *)
3732 !A N sp sts. ring (sp, sts) /\ FINITE N /\ (!i. i IN N ==> A i IN sts) ==>
3733 BIGUNION {A i | i IN N} IN sts
3734Proof
3735 rpt GEN_TAC THEN
3736 REWRITE_TAC [ring_def,subsets_def] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN
3737 POP_ASSUM MP_TAC THEN SPEC_TAC (``N:'a->bool``,``N:'a->bool``) THEN
3738 SET_INDUCT_TAC THENL
3739 [REWRITE_TAC [SET_RULE ``{A i | i IN {}} = {}``, BIGUNION_EMPTY] THEN
3740 FULL_SIMP_TAC std_ss [semiring_def], ALL_TAC] THEN
3741 DISCH_TAC THEN REWRITE_TAC [IN_INSERT] THEN
3742 REWRITE_TAC [SET_RULE ``BIGUNION {A i | (i = e) \/ i IN s} =
3743 BIGUNION {A e} UNION BIGUNION {A i | i IN s}``] THEN
3744 FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [BIGUNION_SING] THEN
3745 ASM_SET_TAC []
3746QED
3747
3748Theorem RING_DIFF_ALT : (* was: Diff *)
3749 !a b sp sts. ring (sp, sts) /\ a IN sts /\ b IN sts ==> a DIFF b IN sts
3750Proof
3751 rpt GEN_TAC THEN REWRITE_TAC [ring_def,subsets_def, semiring_def] THEN
3752 STRIP_TAC THEN
3753 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
3754 FIRST_ASSUM (MP_TAC o SPECL [``a:'a->bool``,``b:'a->bool``]) THEN
3755 rpt STRIP_TAC THEN FULL_SIMP_TAC std_ss [] THEN
3756 UNDISCH_TAC ``c SUBSET sts:('a->bool)->bool`` THEN
3757 MATCH_MP_TAC RING_FINITE_BIGUNION1 THEN
3758 EXISTS_TAC ``sp:'a->bool`` THEN
3759 FULL_SIMP_TAC std_ss [ring_def, subsets_def, semiring_def]
3760QED
3761
3762Theorem ring_alt_pow_imp : (* was: ring_of_setsI *)
3763 !sp sts. sts SUBSET POW sp /\ {} IN sts /\
3764 (!a b. a IN sts /\ b IN sts ==> a UNION b IN sts) /\
3765 (!a b. a IN sts /\ b IN sts ==> a DIFF b IN sts) ==> ring (sp, sts)
3766Proof
3767 REWRITE_TAC [ring_def, subsets_def, semiring_def, subset_class_def, POW_DEF] THEN
3768 REWRITE_TAC [SET_RULE ``sts SUBSET {s | s SUBSET sp} <=>
3769 !x. x IN sts ==> x SUBSET sp``] THEN
3770 rpt STRIP_TAC THEN ASM_SIMP_TAC std_ss [space_def] THENL
3771 [REWRITE_TAC [SET_RULE ``s INTER t = s DIFF (s DIFF t)``] THEN
3772 ASM_SET_TAC [], ALL_TAC] THEN
3773 REWRITE_TAC [disjoint] THEN EXISTS_TAC ``{(s:'a->bool) DIFF t}`` THEN
3774 SIMP_TAC std_ss [BIGUNION_SING, FINITE_SING, IN_SING, SUBSET_DEF] THEN
3775 ASM_SET_TAC []
3776QED
3777
3778Theorem ring_alt_pow : (* was: ring_of_sets_iff *)
3779 !sp sts. ring (sp, sts) <=>
3780 sts SUBSET POW sp /\ {} IN sts /\
3781 (!s t. s IN sts /\ t IN sts ==> s UNION t IN sts) /\
3782 (!s t. s IN sts /\ t IN sts ==> s DIFF t IN sts)
3783Proof
3784 rpt GEN_TAC
3785 >> reverse EQ_TAC >- METIS_TAC [ring_alt_pow_imp]
3786 >> REWRITE_TAC [ring_def, subsets_def, space_def, semiring_def, subset_class_def,
3787 POW_DEF]
3788 >> REWRITE_TAC [SET_RULE ``sts SUBSET {s | s SUBSET sp} <=>
3789 !x. x IN sts ==> x SUBSET sp``]
3790 >> rpt STRIP_TAC
3791 >> ASM_SIMP_TAC std_ss []
3792 >> MATCH_MP_TAC RING_DIFF_ALT
3793 >> EXISTS_TAC ``sp:'a->bool``
3794 >> ASM_SIMP_TAC std_ss [ring_def, space_def, subsets_def, semiring_def,
3795 subset_class_def]
3796QED
3797
3798Theorem RING_BIGUNION : (* was: UNION_in_sets *)
3799 !sp sts (A:num->'a->bool) n.
3800 ring (sp,sts) /\ IMAGE A UNIV SUBSET sts ==>
3801 BIGUNION {A i | i < n} IN sts
3802Proof
3803 GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL
3804 [SIMP_TAC std_ss [GSPECIFICATION] THEN
3805 REWRITE_TAC [SET_RULE ``{A i | i | F} = {}``] THEN
3806 SIMP_TAC std_ss [BIGUNION_EMPTY, ring_alt, semiring_alt],
3807 ALL_TAC] THEN
3808 FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN
3809 RW_TAC std_ss [ARITH_PROVE ``i < SUC n <=> i < n \/ (i = n)``] THEN
3810 REWRITE_TAC [SET_RULE ``BIGUNION {(A:num->'a->bool) i | i < n \/ (i = n)} =
3811 BIGUNION {A i | i < n} UNION A n``] THEN
3812 FULL_SIMP_TAC std_ss [ring_alt_pow] THEN
3813 FIRST_X_ASSUM MATCH_MP_TAC THEN FULL_SIMP_TAC std_ss [SUBSET_DEF] THEN
3814 FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC []
3815QED
3816
3817Theorem ring_disjointed_sets : (* was: range_disjointed_sets *)
3818 !sp sts A. ring (sp,sts) /\ IMAGE A UNIV SUBSET sts ==>
3819 IMAGE (\n. disjointed A n) UNIV SUBSET sts
3820Proof
3821 RW_TAC std_ss [disjointed] THEN
3822 SIMP_TAC std_ss [IN_IMAGE, SUBSET_DEF, IN_UNIV] THEN
3823 FULL_SIMP_TAC std_ss [GSPECIFICATION, ring_alt_pow] THEN
3824 RW_TAC std_ss [] THEN FIRST_ASSUM MATCH_MP_TAC THEN
3825 KNOW_TAC
3826 ``BIGUNION {(A:num->'a->bool) i | i IN {x | 0 <= x /\ x < n}} IN sts`` THENL
3827 [SIMP_TAC std_ss [GSPECIFICATION] THEN
3828 MATCH_MP_TAC RING_BIGUNION THEN SIMP_TAC std_ss [ring_alt_pow] THEN
3829 METIS_TAC [], DISCH_TAC] THEN
3830 FULL_SIMP_TAC std_ss [GSPECIFICATION, SUBSET_DEF] THEN ASM_SET_TAC []
3831QED
3832
3833Theorem RING_INSERT : (* was: insert_in_sets *)
3834 !x A sp sts. ring (sp,sts) /\ {x} IN sts /\ A IN sts ==> x INSERT A IN sts
3835Proof
3836 REWRITE_TAC [ring_def, subsets_def, space_def] THEN rpt STRIP_TAC THEN
3837 ONCE_REWRITE_TAC [SET_RULE ``x INSERT A = {x} UNION A``] THEN
3838 ASM_SET_TAC []
3839QED
3840
3841Theorem RING_SETS_COLLECT_FINITE : (* was: sets_collect_finite_Ex *)
3842 !sp sts s P. ring (sp, sts) /\
3843 (!i. i IN s ==> {x | x IN sp /\ P i x} IN sts) /\ FINITE s
3844 ==> {x | x IN sp /\ (?i. i IN s /\ P i x)} IN sts
3845Proof
3846 rpt GEN_TAC THEN SIMP_TAC std_ss [ring_def, subsets_def, space_def] THEN
3847 rpt STRIP_TAC THEN
3848 KNOW_TAC ``{x | x IN sp /\ (?i. i IN s /\ P i x)} =
3849 BIGUNION {{x | x IN sp /\ P i x} | i IN s}`` THENL
3850 [SIMP_TAC std_ss [EXTENSION, BIGUNION, GSPECIFICATION] THEN
3851 GEN_TAC THEN EQ_TAC THENL [ALL_TAC, ASM_SET_TAC []] THEN
3852 STRIP_TAC THEN EXISTS_TAC ``{x | x IN sp /\ P i x}`` THEN
3853 CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC []] THEN EXISTS_TAC ``i:'b`` THEN
3854 ASM_SIMP_TAC std_ss [GSPECIFICATION], ALL_TAC] THEN
3855 DISC_RW_KILL THEN
3856 KNOW_TAC ``{{x | x IN sp /\ P i x} | i IN s} SUBSET sts`` THENL
3857 [SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN GEN_TAC THEN
3858 STRIP_TAC THEN ASM_REWRITE_TAC [] THEN FIRST_ASSUM MATCH_MP_TAC THEN
3859 ASM_REWRITE_TAC [], MATCH_MP_TAC RING_FINITE_BIGUNION1] THEN
3860 EXISTS_TAC ``sp:'a->bool`` THEN CONJ_TAC THENL
3861 [FULL_SIMP_TAC std_ss [ring_def, space_def, subsets_def], ALL_TAC] THEN
3862 ONCE_REWRITE_TAC [METIS [] ``{x | x IN sp /\ P i x} =
3863 (\i. {x | x IN sp /\ P i x}) i``] THEN
3864 ONCE_REWRITE_TAC [GSYM IMAGE_DEF] THEN METIS_TAC [IMAGE_FINITE]
3865QED
3866
3867Theorem algebra_alt : (* was: algebra_alt_eq *)
3868 !sp sts. algebra (sp, sts) <=> ring (sp, sts) /\ sp IN sts
3869Proof
3870 rw [] >> EQ_TAC
3871 >- (rw [] >> imp_res_tac ALGEBRA_SPACE \\
3872 fs [algebra_def,ring_def,space_def,subsets_def] >> rw [] \\
3873 FULL_SIMP_TAC std_ss [BIGUNION_SING, subset_class_def] \\
3874 KNOW_TAC ``s SUBSET sp /\ t SUBSET sp ==>
3875 (s DIFF t = sp DIFF ((sp DIFF s) UNION t))``
3876 >- SET_TAC [] \\
3877 FULL_SIMP_TAC std_ss [])
3878 >> metis_tac [RING_SPACE_IMP_ALGEBRA, space_def, subsets_def]
3879QED
3880
3881Theorem ALGEBRA_COMPL_SETS : (* was: compl_sets *)
3882 !sp sts a. algebra (sp,sts) /\ a IN sts ==> sp DIFF a IN sts
3883Proof
3884 REWRITE_TAC [algebra_alt, ring_def, subsets_def,space_def] THEN
3885 rpt STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
3886 POP_ASSUM MP_TAC THEN
3887 FIRST_ASSUM (MP_TAC o SPECL [``sp:'a->bool``,``a:'a->bool``]) THEN
3888 rpt STRIP_TAC THEN FULL_SIMP_TAC std_ss [] THEN
3889 UNDISCH_TAC ``c SUBSET (sts:('a->bool)->bool)`` THEN
3890 MATCH_MP_TAC RING_FINITE_BIGUNION1 THEN
3891 EXISTS_TAC ``sp:'a->bool`` THEN
3892 FULL_SIMP_TAC std_ss [ring_def, space_def, subsets_def]
3893QED
3894
3895Theorem algebra_alt_union : (* was: algebra_iff_Un *)
3896 !sp sts. algebra (sp,sts) <=>
3897 sts SUBSET (POW sp) /\ {} IN sts /\
3898 (!a. a IN sts ==> sp DIFF a IN sts) /\
3899 (!a b. a IN sts /\ b IN sts ==> a UNION b IN sts)
3900Proof
3901 rpt STRIP_TAC THEN REWRITE_TAC [algebra_def, subsets_def, space_def] THEN
3902 REWRITE_TAC [subset_class_def, POW_DEF] THEN
3903 REWRITE_TAC [SET_RULE ``sts SUBSET {s | s SUBSET sp} <=>
3904 (!x. x IN sts ==> x SUBSET sp)``]
3905QED
3906
3907Theorem algebra_alt_inter : (* was: algebra_iff_Int *)
3908 !sp sts. algebra (sp,sts) <=> sts SUBSET POW sp /\ {} IN sts /\
3909 (!a. a IN sts ==> sp DIFF a IN sts) /\
3910 (!a b. a IN sts /\ b IN sts ==> a INTER b IN sts)
3911Proof
3912 rpt STRIP_TAC THEN REWRITE_TAC [algebra_def, subsets_def, space_def] THEN
3913 REWRITE_TAC [subset_class_def, POW_DEF] THEN
3914 REWRITE_TAC [SET_RULE ``sts SUBSET {s | s SUBSET sp} <=>
3915 (!x. x IN sts ==> x SUBSET sp)``] THEN
3916 EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THENL
3917 [rpt STRIP_TAC THEN KNOW_TAC ``a SUBSET sp /\ b SUBSET sp ==>
3918 (a INTER b = sp DIFF ((sp DIFF a) UNION (sp DIFF b)))`` THENL
3919 [SET_TAC [], ALL_TAC]
3920 THEN FULL_SIMP_TAC std_ss [], ALL_TAC] THEN
3921 rpt STRIP_TAC THEN KNOW_TAC ``s SUBSET sp /\ t SUBSET sp ==>
3922 (s UNION t = sp DIFF ((sp DIFF s) INTER (sp DIFF t)))`` THENL
3923 [SET_TAC [], ALL_TAC] THEN
3924 FULL_SIMP_TAC std_ss []
3925QED
3926
3927Theorem ALGEBRA_SETS_COLLECT_NEG : (* was: sets_Collect_neg *)
3928 !sp sts P. algebra (sp,sts) /\ {x | x IN sp /\ P x} IN sts ==>
3929 {x | x IN sp /\ ~P x} IN sts
3930Proof
3931 rpt GEN_TAC THEN REWRITE_TAC [algebra_def, space_def, subsets_def] THEN
3932 RW_TAC std_ss [subset_class_def] THEN
3933 KNOW_TAC ``{x | x IN sp /\ ~P x} = sp DIFF {x | x IN sp /\ P x}`` THENL
3934 [ALL_TAC, DISC_RW_KILL THEN FULL_SIMP_TAC std_ss []] THEN SET_TAC []
3935QED
3936
3937Theorem ALGEBRA_SETS_COLLECT_IMP : (* was: sets_Collect_imp *)
3938 !sp sts P Q. algebra (sp,sts) /\ {x | x IN sp /\ P x} IN sts ==>
3939 {x | x IN sp /\ Q x} IN sts ==>
3940 {x | x IN sp /\ (Q x ==> P x)} IN sts
3941Proof
3942 rpt GEN_TAC THEN REWRITE_TAC [algebra_alt, ring_def, space_def, subsets_def] THEN
3943 rpt STRIP_TAC THEN REWRITE_TAC [IMP_DISJ_THM] THEN
3944 REWRITE_TAC [SET_RULE ``{x | x IN sp /\ (~Q x \/ P x)} =
3945 {x | x IN sp /\ ~Q x} UNION {x | x IN sp /\ P x}``] THEN
3946 FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
3947 MATCH_MP_TAC ALGEBRA_SETS_COLLECT_NEG THEN
3948 FULL_SIMP_TAC std_ss [algebra_alt, ring_def, space_def, subsets_def]
3949QED
3950
3951Theorem ALGEBRA_SETS_COLLECT_CONST : (* was: sets_Collect_const *)
3952 !sp sts P. algebra (sp,sts) ==> {x | x IN sp /\ P} IN sts
3953Proof
3954 REWRITE_TAC [algebra_alt] THEN rpt STRIP_TAC THEN
3955 Cases_on `P` THENL
3956 [REWRITE_TAC [SET_RULE ``{x | x IN sp /\ T} = sp``] THEN ASM_REWRITE_TAC [],
3957 FULL_SIMP_TAC std_ss [GSPEC_F, ring_def, subsets_def, space_def]]
3958QED
3959
3960Theorem ALGEBRA_SINGLE_SET : (* was: algebra_single_set *)
3961 !X S. X SUBSET S ==> algebra (S, {{}; X; S DIFF X; S})
3962Proof
3963 RW_TAC std_ss [algebra_def, subsets_def, space_def, subset_class_def] THEN
3964 FULL_SIMP_TAC std_ss [SET_RULE ``x IN {a;b;c;d} <=>
3965 (x = a) \/ (x = b) \/ (x = c) \/ (x = d)``] THEN TRY (ASM_SET_TAC [])
3966QED
3967
3968(* ------------------------------------------------------------------------- *)
3969(* Retricted Algebras *)
3970(* ------------------------------------------------------------------------- *)
3971
3972(* NOTE: ‘a IN sts’ is weakened to ‘a SUBSET sp’ *)
3973Theorem ALGEBRA_RESTRICT' : (* was: restricted_algebra *)
3974 !sp sts a. algebra (sp,sts) /\ a SUBSET sp ==>
3975 algebra (a,IMAGE (\s. s INTER a) sts)
3976Proof
3977 rw [algebra_alt, ring_def, space_def, subsets_def, subset_class_def]
3978 >| [ (* goal 1 (of 5) *)
3979 REWRITE_TAC [INTER_SUBSET],
3980 (* goal 2 (of 5) *)
3981 Q.EXISTS_TAC ‘{}’ >> ASM_SIMP_TAC std_ss [INTER_EMPTY],
3982 (* goal 3 (of 5) *)
3983 rename1 ‘?s. s1 INTER a UNION s2 INTER a = s INTER a /\ s IN sts’ \\
3984 Q.EXISTS_TAC ‘s1 UNION s2’ \\
3985 CONJ_TAC >- SET_TAC [] \\
3986 FULL_SIMP_TAC std_ss [],
3987 (* goal 4 (of 5) *)
3988 rename1 ‘?s. s1 INTER a DIFF s2 INTER a = s INTER a /\ s IN sts’ \\
3989 Q.EXISTS_TAC ‘s1 DIFF s2’ \\
3990 CONJ_TAC >- SET_TAC [] \\
3991 FULL_SIMP_TAC std_ss [],
3992 (* goal 5 (of 5) *)
3993 Q.EXISTS_TAC ‘sp’ >> ASM_SET_TAC [] ]
3994QED
3995
3996Theorem ALGEBRA_RESTRICT : (* was: restricted_algebra *)
3997 !sp sts a. algebra (sp,sts) /\ a IN sts ==>
3998 algebra (a,IMAGE (\s. s INTER a) sts)
3999Proof
4000 rpt STRIP_TAC
4001 >> MATCH_MP_TAC ALGEBRA_RESTRICT'
4002 >> Q.EXISTS_TAC ‘sp’ >> art []
4003 >> fs [algebra_def, subset_class_def]
4004QED
4005
4006(* NOTE: ‘a IN sts’ is weakened to ‘a SUBSET sp’ *)
4007Theorem SIGMA_ALGEBRA_RESTRICT' :
4008 !sp sts a. sigma_algebra (sp,sts) /\ a SUBSET sp ==>
4009 sigma_algebra (a,IMAGE (\s. s INTER a) sts)
4010Proof
4011 rpt STRIP_TAC
4012 >> rw [SIGMA_ALGEBRA_ALT, algebra_def, subset_class_def, IN_FUNSET]
4013 >| [ (* goal 1 (of 5) *)
4014 REWRITE_TAC [INTER_SUBSET],
4015 (* goal 2 (of 5) *)
4016 Q.EXISTS_TAC ‘{}’ >> REWRITE_TAC [INTER_EMPTY] \\
4017 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
4018 (Q.SPEC ‘(sp,sts)’ SIGMA_ALGEBRA_EMPTY)) >> art [],
4019 (* goal 3 (of 5) *)
4020 rename1 ‘s IN sts’ >> Q.EXISTS_TAC ‘sp DIFF s’ \\
4021 CONJ_TAC
4022 >- (fs [SIGMA_ALGEBRA_ALT, algebra_def, subset_class_def] \\
4023 ASM_SET_TAC []) \\
4024 MATCH_MP_TAC (REWRITE_RULE [space_def, subsets_def]
4025 (Q.SPEC ‘(sp,sts)’ SIGMA_ALGEBRA_COMPL)) >> art [],
4026 (* goal 4 (of 5) *)
4027 rename1 ‘?s. s1 INTER a UNION s2 INTER a = s INTER a /\ s IN sts’ \\
4028 Q.EXISTS_TAC ‘s1 UNION s2’ \\
4029 CONJ_TAC >- SET_TAC [] \\
4030 MATCH_MP_TAC (REWRITE_RULE [subsets_def]
4031 (Q.SPEC ‘(sp,sts)’ SIGMA_ALGEBRA_UNION)) >> art [],
4032 (* goal 5 (of 5) *)
4033 fs [SKOLEM_THM] \\
4034 rename1 ‘!x. f x = g x INTER a /\ g x IN sts’ \\
4035 Q.EXISTS_TAC ‘BIGUNION (IMAGE g UNIV)’ \\
4036 CONJ_TAC >- ASM_SET_TAC [] \\
4037 fs [SIGMA_ALGEBRA_FN, IN_FUNSET] ]
4038QED
4039
4040Theorem SIGMA_ALGEBRA_RESTRICT :
4041 !sp sts a. sigma_algebra (sp,sts) /\ a IN sts ==>
4042 sigma_algebra (a,IMAGE (\s. s INTER a) sts)
4043Proof
4044 rpt STRIP_TAC
4045 >> MATCH_MP_TAC SIGMA_ALGEBRA_RESTRICT'
4046 >> Q.EXISTS_TAC ‘sp’ >> art []
4047 >> fs [sigma_algebra_def, algebra_def, subset_class_def]
4048QED
4049
4050Definition restrict_algebra_def :
4051 restrict_algebra A sp = (sp INTER space A,IMAGE (\a. a INTER sp) (subsets A))
4052End
4053
4054Theorem restrict_algebra_reduce :
4055 !A. subset_class (space A) (subsets A) ==> restrict_algebra A (space A) = A
4056Proof
4057 rw [restrict_algebra_def, subset_class_def]
4058 >> qabbrev_tac ‘sp = space A’
4059 >> qabbrev_tac ‘sts = subsets A’
4060 >> ASSUME_TAC (SYM (Q.SPEC ‘A’ SPACE))
4061 >> POP_ORW
4062 >> simp []
4063 >> rw [Once EXTENSION]
4064 >> EQ_TAC >> rw []
4065 >- (Suff ‘a INTER sp = a’ >- rw [] \\
4066 Suff ‘a SUBSET sp’ >- SET_TAC [] \\
4067 rw [])
4068 >> Q.EXISTS_TAC ‘x’ >> art []
4069 >> Suff ‘x SUBSET sp’ >- SET_TAC []
4070 >> rw []
4071QED
4072
4073Theorem restrict_algebra_reduce' :
4074 !A. sigma_algebra A ==> restrict_algebra A (space A) = A
4075Proof
4076 rpt STRIP_TAC
4077 >> MATCH_MP_TAC restrict_algebra_reduce
4078 >> fs [sigma_algebra_def, algebra_def]
4079QED
4080
4081Theorem sigma_algebra_restrict_algebra :
4082 !A sp. sigma_algebra A /\ sp IN subsets A ==>
4083 sigma_algebra (restrict_algebra A sp)
4084Proof
4085 rw [restrict_algebra_def]
4086 >> qabbrev_tac ‘Z = space A’
4087 >> qabbrev_tac ‘sts = subsets A’
4088 >> Know ‘sp INTER Z = sp’
4089 >- (Suff ‘sp SUBSET Z’ >- SET_TAC [] \\
4090 fs [sigma_algebra_def, algebra_def, subset_class_def])
4091 >> Rewr'
4092 >> MATCH_MP_TAC SIGMA_ALGEBRA_RESTRICT >> art []
4093 >> Q.EXISTS_TAC ‘Z’
4094 >> rw [SPACE, Abbr ‘Z’, Abbr ‘sts’]
4095QED
4096
4097(* NOTE: this theorem doesn't hold if ‘a IN sts’ is weakened to ‘a SUBSET sp’ *)
4098Theorem SIGMA_ALGEBRA_RESTRICT_SUBSET :
4099 !sp sts a. sigma_algebra (sp,sts) /\ a IN sts ==>
4100 (IMAGE (\s. s INTER a) sts) SUBSET sts
4101Proof
4102 rw [SUBSET_DEF]
4103 >> MATCH_MP_TAC (REWRITE_RULE [subsets_def]
4104 (Q.SPEC ‘(sp,sts)’ SIGMA_ALGEBRA_INTER)) >> art []
4105QED
4106
4107Theorem restrict_algebra_SUBSET :
4108 !A sp. sigma_algebra A /\ sp IN subsets A ==>
4109 subsets (restrict_algebra A sp) SUBSET subsets A
4110Proof
4111 rw [restrict_algebra_def]
4112 >> MATCH_MP_TAC SIGMA_ALGEBRA_RESTRICT_SUBSET
4113 >> Q.EXISTS_TAC ‘space A’ >> rw [SPACE]
4114QED
4115
4116Theorem sigma_algebra_alt_eq :
4117 !sp sts. sigma_algebra (sp,sts) <=>
4118 algebra (sp,sts) /\
4119 !A. IMAGE A UNIV SUBSET sts ==> BIGUNION {A i | i IN univ(:num)} IN sts
4120Proof
4121 rpt GEN_TAC THEN REWRITE_TAC [SIGMA_ALGEBRA_ALT] THEN EQ_TAC THEN
4122 STRIP_TAC THEN ASM_REWRITE_TAC [] THEN X_GEN_TAC ``A:num->'a->bool`` THEN
4123 POP_ASSUM (MP_TAC o SPEC ``A:num->'a->bool``) THEN
4124 SIMP_TAC std_ss [IMAGE_DEF, subsets_def] THEN rpt STRIP_TAC THEN
4125 FIRST_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN EVAL_TAC THEN
4126 SRW_TAC[] [IN_UNIV,SUBSET_DEF,IN_FUNSET] THEN METIS_TAC[]
4127QED
4128
4129Definition sigma_algebra_alt :
4130 sigma_algebra_alt sp sts <=>
4131 algebra (sp,sts) /\
4132 !A. IMAGE A UNIV SUBSET sts ==> BIGUNION {A i | i IN univ(:num)} IN sts
4133End
4134
4135Theorem sigma_algebra_eq_alt :
4136 !sp sts. sigma_algebra (sp,sts) <=> sigma_algebra_alt sp sts
4137Proof
4138 REWRITE_TAC [sigma_algebra_alt, sigma_algebra_alt_eq]
4139QED
4140
4141Theorem sigma_algebra_alt_pow :
4142 !sp sts. sigma_algebra (sp,sts) <=>
4143 sts SUBSET POW sp /\ {} IN sts /\
4144 (!s. s IN sts ==> sp DIFF s IN sts) /\
4145 (!A. IMAGE A UNIV SUBSET sts ==>
4146 BIGUNION {(A :num->'a->bool) i | i IN UNIV} IN sts)
4147Proof
4148 SIMP_TAC std_ss [sigma_algebra_alt_eq, algebra_def, space_def, subsets_def] THEN
4149 rpt GEN_TAC THEN SIMP_TAC std_ss [subset_class_def, POW_DEF] THEN
4150 EQ_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
4151 rpt STRIP_TAC THENL [ASM_SET_TAC [], ASM_SET_TAC [], ASM_SET_TAC [],
4152 ALL_TAC, ASM_SET_TAC []] THEN
4153 SIMP_TAC std_ss [UNION_BINARY] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4154 SIMP_TAC std_ss [BINARY_RANGE] THEN ASM_SET_TAC []
4155QED
4156Theorem sigma_algebra_iff2 = sigma_algebra_alt_pow
4157
4158Theorem lemma[local]: (* was: countable_Union *)
4159 !sp sts c. sigma_algebra (sp,sts) /\ countable c /\ c SUBSET sts ==>
4160 BIGUNION c IN sts
4161Proof
4162 FULL_SIMP_TAC std_ss [sigma_algebra_def, subsets_def]
4163QED
4164
4165Theorem SIGMA_ALGEBRA_COUNTABLE_UN : (* was: countable_UN *)
4166 !sp sts A X. sigma_algebra (sp,sts) /\ IMAGE (A:num->'a->bool) X SUBSET sts ==>
4167 BIGUNION {A x | x IN X} IN sts
4168Proof
4169 REPEAT STRIP_TAC THEN
4170 KNOW_TAC
4171 ``(IMAGE (\i. if i IN X then (A:num->'a->bool) i else {}) UNIV) SUBSET sts``
4172 THENL [POP_ASSUM MP_TAC THEN
4173 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE] THEN REPEAT STRIP_TAC THEN
4174 FULL_SIMP_TAC std_ss [] THEN COND_CASES_TAC THENL [METIS_TAC [], ALL_TAC] THEN
4175 FULL_SIMP_TAC std_ss [sigma_algebra_alt_eq, algebra_def, ring_alt, semiring_alt,
4176 subsets_def], ALL_TAC] THEN DISCH_TAC THEN KNOW_TAC
4177 ``BIGUNION {(\i. if i IN X then (A:num->'a->bool) i else {}) x | x IN UNIV}
4178 IN sts``
4179 THENL [SIMP_TAC std_ss [] THEN MATCH_MP_TAC lemma THEN
4180 EXISTS_TAC ``sp:'a->bool`` THEN FULL_SIMP_TAC std_ss [] THEN
4181 CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC []] THEN
4182 SIMP_TAC arith_ss [GSYM IMAGE_DEF] THEN
4183 METIS_TAC [COUNTABLE_IMAGE_NUM], DISCH_TAC] THEN KNOW_TAC ``
4184 BIGUNION {(\i. if i IN X then (A:num->'a->bool) i else {}) x | x IN univ(:num)} =
4185 BIGUNION {A x | x IN X}`` THENL [ALL_TAC, METIS_TAC []] THEN
4186 SIMP_TAC std_ss [EXTENSION, IN_BIGUNION, GSPECIFICATION] THEN GEN_TAC THEN
4187 EQ_TAC THEN REPEAT STRIP_TAC THENL
4188 [EXISTS_TAC ``s:'a->bool`` THEN FULL_SIMP_TAC std_ss [] THEN
4189 POP_ASSUM K_TAC THEN POP_ASSUM K_TAC THEN POP_ASSUM MP_TAC THEN
4190 COND_CASES_TAC THEN ASM_SET_TAC [], ALL_TAC] THEN
4191 EXISTS_TAC ``s:'a->bool`` THEN FULL_SIMP_TAC std_ss [IN_UNIV] THEN
4192 EXISTS_TAC ``x':num`` THEN ASM_SET_TAC []
4193QED
4194
4195Theorem SIGMA_ALGEBRA_COUNTABLE_UN' : (* was: countable_UN' *)
4196 !sp sts A X. sigma_algebra (sp,sts) /\ IMAGE A X SUBSET sts /\
4197 countable X ==> BIGUNION {A x | x IN X} IN sts
4198Proof
4199 RW_TAC std_ss [] THEN
4200 KNOW_TAC ``(IMAGE (\i. if i IN X then (A:'b->'a->bool) i else {}) UNIV)
4201 SUBSET sts`` THENL
4202 [SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV] THEN RW_TAC std_ss [] THEN
4203 COND_CASES_TAC THENL
4204 [ASM_SET_TAC [], FULL_SIMP_TAC std_ss [sigma_algebra_alt_pow]],
4205 DISCH_TAC] THEN
4206 KNOW_TAC ``BIGUNION {(\i. if i IN X then A i else {}) x | x IN UNIV}
4207 IN sts`` THENL
4208 [ALL_TAC, DISCH_TAC THEN
4209 KNOW_TAC ``
4210 BIGUNION {(\i. if i IN X then (A:'b->'a->bool) i else {}) x | x IN univ(:'b)} =
4211 BIGUNION {A x | x IN X}`` THENL [ALL_TAC, METIS_TAC []] THEN
4212 SIMP_TAC std_ss [EXTENSION, IN_BIGUNION, GSPECIFICATION] THEN GEN_TAC THEN
4213 EQ_TAC THEN rpt STRIP_TAC THENL
4214 [EXISTS_TAC ``s:'a->bool`` THEN FULL_SIMP_TAC std_ss [] THEN
4215 POP_ASSUM K_TAC THEN POP_ASSUM K_TAC THEN POP_ASSUM MP_TAC THEN
4216 COND_CASES_TAC THEN ASM_SET_TAC [], ALL_TAC] THEN
4217 EXISTS_TAC ``s:'a->bool`` THEN FULL_SIMP_TAC std_ss [IN_UNIV] THEN
4218 EXISTS_TAC ``x':'b`` THEN FULL_SIMP_TAC std_ss []] THEN
4219 RULE_ASSUM_TAC (SIMP_RULE std_ss [SIGMA_ALGEBRA]) THEN
4220 rpt (POP_ASSUM MP_TAC) THEN REWRITE_TAC [subsets_def] THEN
4221 rpt STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4222 ASM_SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
4223 KNOW_TAC ``countable (IMAGE (A:'b->'a->bool) X)`` THENL
4224 [rw[image_countable], DISCH_TAC] THEN
4225 ONCE_REWRITE_TAC [SET_RULE ``IMAGE (\x. if x IN X then A x else {}) univ(:'b) =
4226 (IMAGE A X) UNION IMAGE (\x. {}) (UNIV DIFF X)``] THEN
4227 MATCH_MP_TAC union_countable THEN CONJ_TAC THENL
4228 [FULL_SIMP_TAC std_ss [COUNTABLE_ALT] THEN
4229 METIS_TAC [], ALL_TAC] THEN
4230 SIMP_TAC std_ss [COUNTABLE_ALT] THEN Q.EXISTS_TAC `(\n. {}):num->'a->bool` THEN
4231 SIMP_TAC std_ss [IN_IMAGE] THEN METIS_TAC []
4232QED
4233
4234Theorem SIGMA_ALGEBRA_COUNTABLE_INT : (* was: countable_INT *)
4235 !sp sts A X. sigma_algebra (sp,sts) /\
4236 IMAGE (A :num->'a->bool) X SUBSET sts /\ X <> {} ==>
4237 BIGINTER {(A :num->'a->bool) x | x IN X} IN sts
4238Proof
4239 REPEAT STRIP_TAC THEN FULL_SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY] THEN
4240 KNOW_TAC ``!x. x IN X ==> (A:num->'a->bool) x IN sts`` THENL
4241 [ASM_SET_TAC [], DISCH_TAC] THEN
4242 KNOW_TAC ``sp DIFF BIGUNION {sp DIFF (A:num->'a->bool) x | x IN X} IN sts`` THENL
4243 [MATCH_MP_TAC RING_DIFF_ALT THEN EXISTS_TAC ``sp:'a->bool`` THEN
4244 FULL_SIMP_TAC std_ss [sigma_algebra_alt_eq, algebra_alt] THEN
4245 ONCE_REWRITE_TAC [METIS [] ``sp DIFF A x = (\x. sp DIFF A x) x``] THEN
4246
4247 MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_UN THEN EXISTS_TAC ``sp:'a->bool`` THEN
4248 FULL_SIMP_TAC std_ss [sigma_algebra_alt_eq, algebra_alt] THEN
4249 SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE] THEN REPEAT STRIP_TAC THEN
4250 ASM_REWRITE_TAC [] THEN MATCH_MP_TAC RING_DIFF_ALT THEN
4251 EXISTS_TAC ``sp:'a->bool`` THEN
4252 ASM_SET_TAC [], DISCH_TAC] THEN
4253 KNOW_TAC ``BIGINTER {(A:num->'a->bool) x | x IN X} =
4254 sp DIFF BIGUNION {sp DIFF A x | x IN X}`` THENL
4255 [ALL_TAC, METIS_TAC []] THEN SIMP_TAC std_ss [EXTENSION] THEN GEN_TAC THEN
4256 KNOW_TAC ``sts SUBSET POW sp`` THENL
4257 [FULL_SIMP_TAC std_ss [sigma_algebra_alt_eq, algebra_alt, ring_alt, semiring_alt,
4258 subset_class_def] THEN ASM_SET_TAC [POW_DEF], RW_TAC std_ss [POW_DEF]] THEN
4259 EQ_TAC THEN REPEAT STRIP_TAC THENL
4260 [SIMP_TAC std_ss [IN_DIFF] THEN CONJ_TAC THENL [ASM_SET_TAC [], ALL_TAC] THEN
4261 FULL_SIMP_TAC std_ss [BIGINTER, BIGUNION, GSPECIFICATION] THEN GEN_TAC THEN
4262 ASM_CASES_TAC ``x' NOTIN (s:'a->bool)`` THEN ASM_REWRITE_TAC [] THEN
4263 GEN_TAC THEN ASM_CASES_TAC ``x'' NOTIN (X:num->bool)`` THEN
4264 FULL_SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN
4265 SIMP_TAC std_ss [DIFF_DEF, EXTENSION, GSPECIFICATION] THEN
4266 EXISTS_TAC ``x':'a`` THEN FULL_SIMP_TAC std_ss [] THEN
4267 ASM_CASES_TAC ``x' NOTIN (sp:'a->bool)`` THEN FULL_SIMP_TAC std_ss [] THEN
4268 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SET_TAC [], ALL_TAC] THEN
4269 SIMP_TAC std_ss [BIGINTER, GSPECIFICATION] THEN GEN_TAC THEN
4270 STRIP_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM MP_TAC THEN
4271 POP_ASSUM K_TAC THEN FULL_SIMP_TAC std_ss [IN_DIFF, BIGUNION, GSPECIFICATION] THEN
4272 STRIP_TAC THEN CCONTR_TAC THEN
4273 UNDISCH_TAC
4274 “!s. (!x. s = sp DIFF (A:num->'a->bool) x ==> x NOTIN X) \/ x' NOTIN s” THEN
4275 SIMP_TAC std_ss [] THEN EXISTS_TAC ``sp DIFF (A:num->'a->bool) x''`` THEN
4276 CONJ_TAC THENL [METIS_TAC [], ALL_TAC] THEN
4277 ASM_SIMP_TAC std_ss [IN_DIFF]
4278QED
4279
4280Theorem SIGMA_ALGEBRA_COUNTABLE_INT' : (* was: countable_INT' *)
4281 !sp sts A X. sigma_algebra (sp,sts) /\ countable X /\ (X <> {}) /\
4282 IMAGE (A:num->'a->bool) X SUBSET sts ==>
4283 BIGINTER {(A:num->'a->bool) x | x IN X} IN sts
4284Proof
4285 METIS_TAC [SIGMA_ALGEBRA_COUNTABLE_INT]
4286QED
4287
4288(* ------------------------------------------------------------------------- *)
4289(* Initial Sigma Algebra (conributed by HVG concordia) *)
4290(* ------------------------------------------------------------------------- *)
4291
4292Inductive sigma_sets :
4293 (sigma_sets sp st {}) /\
4294 (!a. st a ==> sigma_sets sp st a) /\
4295 (!a. sigma_sets sp st a ==> sigma_sets sp st (sp DIFF a)) /\
4296 (!A. (!i. sigma_sets sp st ((A :num->'a->bool) i)) ==>
4297 sigma_sets sp st (BIGUNION {A i | i IN UNIV}))
4298End
4299
4300Theorem sigma_sets_basic:
4301 !sp st a. a IN st ==> a IN sigma_sets sp st
4302Proof
4303 SIMP_TAC std_ss [SPECIFICATION, sigma_sets_rules]
4304QED
4305
4306Theorem sigma_sets_empty:
4307 !sp st. {} IN sigma_sets sp st
4308Proof
4309 SIMP_TAC std_ss [SPECIFICATION, sigma_sets_rules]
4310QED
4311
4312Theorem sigma_sets_compl:
4313 !sp st a. a IN sigma_sets sp st ==> sp DIFF a IN sigma_sets sp st
4314Proof
4315 SIMP_TAC std_ss [SPECIFICATION, sigma_sets_rules]
4316QED
4317
4318Theorem sigma_sets_BIGUNION : (* was: sigma_sets_union *)
4319 !sp st A. (!i. (A:num->'a->bool) i IN sigma_sets sp st) ==>
4320 BIGUNION {A i | i IN UNIV} IN sigma_sets sp st
4321Proof
4322 SIMP_TAC std_ss [SPECIFICATION, sigma_sets_rules]
4323QED
4324
4325Theorem sigma_sets_subset :
4326 !sp sts st. sigma_algebra (sp,sts) /\ st SUBSET sts ==>
4327 sigma_sets sp st SUBSET sts
4328Proof
4329 rpt STRIP_TAC THEN SIMP_TAC std_ss [SPECIFICATION, SUBSET_DEF] THEN
4330 HO_MATCH_MP_TAC sigma_sets_ind THEN
4331 FULL_SIMP_TAC std_ss [sigma_algebra_alt_eq,
4332 algebra_alt, ring_def, space_def, subsets_def, subset_class_def] THEN
4333 rpt STRIP_TAC THENL
4334 [ASM_SET_TAC [],
4335 ASM_SET_TAC [],
4336 ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN MATCH_MP_TAC RING_DIFF_ALT THEN
4337 FULL_SIMP_TAC std_ss [ring_def, subsets_def, space_def, subset_class_def] THEN
4338 ASM_SET_TAC [],
4339 ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4340 rpt STRIP_TAC THEN ASM_SET_TAC []]
4341QED
4342
4343Theorem sigma_sets_into_sp:
4344 !sp st. st SUBSET POW sp ==> !x. x IN sigma_sets sp st ==> x SUBSET sp
4345Proof
4346 rpt GEN_TAC THEN DISCH_TAC THEN SIMP_TAC std_ss [SPECIFICATION] THEN
4347 HO_MATCH_MP_TAC sigma_sets_ind THEN FULL_SIMP_TAC std_ss [POW_DEF] THEN
4348 rpt STRIP_TAC THEN ASM_SET_TAC []
4349QED
4350
4351Theorem sigma_algebra_sigma_sets :
4352 !sp st. st SUBSET POW sp ==> sigma_algebra (sp, sigma_sets sp st)
4353Proof
4354 RW_TAC std_ss [sigma_algebra_alt_pow] THENL
4355 [SIMP_TAC std_ss [SUBSET_DEF] THEN
4356 SIMP_TAC std_ss [POW_DEF, GSPECIFICATION] THEN
4357 METIS_TAC [sigma_sets_into_sp],
4358 METIS_TAC [sigma_sets_empty],
4359 METIS_TAC [sigma_sets_compl],
4360 MATCH_MP_TAC sigma_sets_BIGUNION THEN ASM_SET_TAC []]
4361QED
4362
4363(* NOTE: this indicates that `sigma_sets = sigma`, see next theorem *)
4364Theorem sigma_sets_least_sigma_algebra :
4365 !sp A. A SUBSET POW sp ==>
4366 (sigma_sets sp A =
4367 BIGINTER {B | A SUBSET B /\ sigma_algebra (sp,B)})
4368Proof
4369 rpt STRIP_TAC THEN
4370 KNOW_TAC ``!B X. A SUBSET B /\ sigma_algebra (sp,B) /\
4371 X IN sigma_sets sp A ==> X IN B`` THENL
4372 [rpt STRIP_TAC THEN UNDISCH_TAC ``A SUBSET (B:('a->bool)->bool)`` THEN
4373 UNDISCH_TAC ``sigma_algebra (sp, B)`` THEN REWRITE_TAC [AND_IMP_INTRO] THEN
4374 DISCH_THEN (MP_TAC o MATCH_MP sigma_sets_subset) THEN ASM_SET_TAC [],
4375 DISCH_TAC] THEN
4376 KNOW_TAC
4377 ``!X. X IN BIGINTER {B | A SUBSET B /\ sigma_algebra (sp,B)} ==>
4378 !B. A SUBSET B ==> sigma_algebra (sp,B) ==> X IN B`` THENL
4379 [STRIP_TAC THEN ASM_SIMP_TAC std_ss [IN_BIGINTER, GSPECIFICATION],
4380 DISCH_TAC] THEN
4381 SIMP_TAC std_ss [EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL
4382 [DISCH_TAC THEN SIMP_TAC std_ss [IN_BIGINTER, GSPECIFICATION] THEN
4383 rpt STRIP_TAC THEN FULL_SIMP_TAC std_ss [SUBSET_DEF], ALL_TAC] THEN
4384 DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC ``x:'a->bool``) THEN
4385 ASM_REWRITE_TAC [] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4386 rpt CONJ_TAC THENL
4387 [ASM_SIMP_TAC std_ss [SUBSET_DEF, sigma_sets_basic],
4388 ASM_SIMP_TAC std_ss [sigma_algebra_sigma_sets],
4389 ALL_TAC] THEN
4390 FULL_SIMP_TAC std_ss [AND_IMP_INTRO] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4391 ASM_SIMP_TAC std_ss [sigma_algebra_sigma_sets] THEN
4392 ASM_SIMP_TAC std_ss [SUBSET_DEF, sigma_sets_basic]
4393QED
4394
4395Theorem sigma_sets_sigma :
4396 !sp A. A SUBSET POW sp ==> sigma_sets sp A = subsets (sigma sp A)
4397Proof
4398 rw [sigma_sets_least_sigma_algebra, sigma_def]
4399QED
4400
4401Theorem sigma_sets_top:
4402 !sp A. sp IN sigma_sets sp A
4403Proof
4404 METIS_TAC [sigma_sets_compl, sigma_sets_empty, DIFF_EMPTY]
4405QED
4406
4407Theorem sigma_sets_union : (* was: sigma_sets_Un *)
4408 !sp st a b. a IN sigma_sets sp st /\ b IN sigma_sets sp st ==>
4409 a UNION b IN sigma_sets sp st
4410Proof
4411 rpt STRIP_TAC THEN REWRITE_TAC [UNION_BINARY] THEN
4412 MATCH_MP_TAC sigma_sets_BIGUNION THEN GEN_TAC THEN
4413 RW_TAC std_ss [binary_def]
4414QED
4415
4416Theorem sigma_sets_BIGINTER : (* was: sigma_sets_Inter *)
4417 !sp st A. st SUBSET POW sp ==>
4418 (!i. (A :num->'a->bool) i IN sigma_sets sp st) ==>
4419 BIGINTER {A i | i IN UNIV} IN sigma_sets sp st
4420Proof
4421 rpt STRIP_TAC THEN
4422 KNOW_TAC ``(!i:num. A i IN sigma_sets sp st) ==>
4423 (!i:num. sp DIFF A i IN sigma_sets sp st)`` THENL
4424 [METIS_TAC [sigma_sets_compl], DISCH_TAC] THEN
4425 KNOW_TAC ``BIGUNION {sp DIFF A i | (i:num) IN UNIV} IN sigma_sets sp st`` THENL
4426 [ONCE_REWRITE_TAC [METIS [] ``sp DIFF A i = (\i. sp DIFF A i) i``] THEN
4427 MATCH_MP_TAC sigma_sets_BIGUNION THEN METIS_TAC [], DISCH_TAC] THEN
4428 KNOW_TAC
4429 ``sp DIFF BIGUNION {sp DIFF A i | (i:num) IN UNIV} IN sigma_sets sp st`` THENL
4430 [MATCH_MP_TAC sigma_sets_compl THEN METIS_TAC [], DISCH_TAC] THEN
4431 KNOW_TAC ``sp DIFF BIGUNION {sp DIFF A i | i IN UNIV} =
4432 BIGINTER {A i | (i:num) IN UNIV}`` THENL
4433 [ALL_TAC, METIS_TAC[]] THEN
4434 SIMP_TAC std_ss [EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL
4435 [SIMP_TAC std_ss [IN_DIFF, IN_BIGUNION, IN_BIGINTER, GSPECIFICATION] THEN
4436 RW_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
4437 POP_ASSUM (MP_TAC o SPEC ``sp DIFF (A:num->'a->bool) i``) THEN
4438 ASM_SET_TAC [], ALL_TAC] THEN
4439 SIMP_TAC std_ss [IN_BIGINTER, IN_DIFF, IN_BIGUNION, GSPECIFICATION] THEN
4440 RW_TAC std_ss [IN_UNIV] THENL
4441 [FIRST_X_ASSUM (MP_TAC o SPEC ``(A:num->'a->bool) i``) THEN
4442 KNOW_TAC ``(?i'. A i = (A:num->'a->bool) i')`` THENL
4443 [METIS_TAC [], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
4444 SPEC_TAC (``x``,``x``) THEN REWRITE_TAC [GSYM SUBSET_DEF] THEN
4445 UNDISCH_TAC ``st SUBSET POW (sp:'a->bool)`` THEN
4446 DISCH_THEN (MP_TAC o MATCH_MP sigma_sets_into_sp) THEN
4447 METIS_TAC [], ALL_TAC] THEN
4448 ASM_CASES_TAC ``x NOTIN s`` THEN FULL_SIMP_TAC std_ss [] THEN
4449 RW_TAC std_ss [EXTENSION] THEN EXISTS_TAC ``x`` THEN
4450 ASM_SIMP_TAC std_ss [IN_DIFF] THEN DISJ2_TAC THEN
4451 FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC []
4452QED
4453
4454Theorem sigma_sets_BIGINTER2 : (* was: sigma_sets_INTER *)
4455 !sp st A N. st SUBSET POW sp /\
4456 (!i:num. i IN N ==> A i IN sigma_sets sp st) /\ N <> {} ==>
4457 BIGINTER {A i | i IN N} IN sigma_sets sp st
4458Proof
4459 rpt STRIP_TAC THEN
4460 KNOW_TAC ``!i:num. (if i IN N then A i else sp) IN sigma_sets sp st`` THENL
4461 [GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN
4462 SIMP_TAC std_ss [sigma_sets_top], DISCH_TAC] THEN
4463 KNOW_TAC ``BIGINTER {(if i IN N then (A:num->'a->bool) i else sp) | i IN UNIV} IN
4464 sigma_sets sp st`` THENL
4465 [ASM_SIMP_TAC std_ss [sigma_sets_BIGINTER], DISCH_TAC] THEN
4466 KNOW_TAC ``BIGINTER {(if i IN N then (A:num->'a->bool) i else sp) | i IN UNIV} =
4467 BIGINTER {A i | i IN N}`` THENL
4468 [ALL_TAC, METIS_TAC []] THEN
4469 UNDISCH_TAC ``st SUBSET POW (sp:'a->bool)`` THEN
4470 DISCH_THEN (MP_TAC o MATCH_MP sigma_sets_into_sp) THEN DISCH_TAC THEN
4471 ASM_SET_TAC []
4472QED
4473
4474Theorem sigma_sets_fixpoint :
4475 !sp sts. sigma_algebra (sp,sts) ==> (sigma_sets sp sts = sts)
4476Proof
4477 rpt STRIP_TAC THEN EVAL_TAC THEN CONJ_TAC THENL
4478 [MATCH_MP_TAC sigma_sets_subset THEN ASM_SIMP_TAC std_ss [SUBSET_REFL],
4479 SIMP_TAC std_ss [SUBSET_DEF, sigma_sets_basic]]
4480QED
4481Theorem sigma_sets_eq = sigma_sets_fixpoint
4482
4483Theorem sigma_sets_superset_generator :
4484 !X A. A SUBSET sigma_sets X A
4485Proof
4486 SIMP_TAC std_ss [SUBSET_DEF, sigma_sets_basic]
4487QED
4488
4489(* NOTE: ‘sigma_algebra a /\ sigma_algebra b’ has been removed due to changes
4490 in measurable_def.
4491 *)
4492Theorem IN_MEASURABLE :
4493 !a b f. f IN measurable a b <=>
4494 f IN (space a -> space b) /\
4495 (!s. s IN subsets b ==> ((PREIMAGE f s)INTER(space a)) IN subsets a)
4496Proof
4497 RW_TAC std_ss [measurable_def, GSPECIFICATION]
4498QED
4499
4500Theorem MEASURABLE_DIFF_PROPERTY:
4501 !a b f. sigma_algebra a /\ sigma_algebra b /\
4502 f IN (space a -> space b) /\
4503 (!s. s IN subsets b ==> PREIMAGE f s IN subsets a) ==>
4504 (!s. s IN subsets b ==>
4505 (PREIMAGE f (space b DIFF s) = space a DIFF PREIMAGE f s))
4506Proof
4507 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, subsets_def, space_def, GSPECIFICATION,
4508 PREIMAGE_DIFF, IN_IMAGE]
4509 >> MATCH_MP_TAC SUBSET_ANTISYM
4510 >> RW_TAC std_ss [SUBSET_DEF, IN_DIFF, IN_PREIMAGE]
4511 >> Q.PAT_X_ASSUM `!s. s IN subsets b ==> PREIMAGE f s IN subsets a`
4512 (MP_TAC o Q.SPEC `space b DIFF s`)
4513 >> Know `x IN PREIMAGE f (space b DIFF s)`
4514 >- RW_TAC std_ss [IN_PREIMAGE, IN_DIFF]
4515 >> PROVE_TAC [subset_class_def, SUBSET_DEF]
4516QED
4517
4518Theorem MEASURABLE_BIGUNION_PROPERTY:
4519 !a b f. sigma_algebra a /\ sigma_algebra b /\
4520 f IN (space a -> space b) /\
4521 (!s. s IN subsets b ==> PREIMAGE f s IN subsets a) ==>
4522 (!c. c SUBSET subsets b ==>
4523 (PREIMAGE f (BIGUNION c) = BIGUNION (IMAGE (PREIMAGE f) c)))
4524Proof
4525 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, subsets_def, space_def, GSPECIFICATION,
4526 PREIMAGE_BIGUNION, IN_IMAGE]
4527QED
4528
4529Theorem MEASUBABLE_BIGUNION_LEMMA:
4530 !a b f. sigma_algebra a /\ sigma_algebra b /\
4531 f IN (space a -> space b) /\
4532 (!s. s IN subsets b ==> PREIMAGE f s IN subsets a) ==>
4533 (!c. countable c /\ c SUBSET (IMAGE (PREIMAGE f) (subsets b)) ==>
4534 BIGUNION c IN IMAGE (PREIMAGE f) (subsets b))
4535Proof
4536 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, IN_IMAGE]
4537 >> Q.EXISTS_TAC `BIGUNION (IMAGE (\x. @x'. x' IN subsets b /\ (PREIMAGE f x' = x)) c)`
4538 >> reverse CONJ_TAC
4539 >- (Q.PAT_X_ASSUM `!c. countable c /\ c SUBSET subsets b ==> BIGUNION c IN subsets b`
4540 MATCH_MP_TAC
4541 >> RW_TAC std_ss [image_countable, SUBSET_DEF, IN_IMAGE]
4542 >> Suff `(\x''. x'' IN subsets b) (@x''. x'' IN subsets b /\ (PREIMAGE f x'' = x'))`
4543 >- RW_TAC std_ss []
4544 >> MATCH_MP_TAC SELECT_ELIM_THM
4545 >> FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE]
4546 >> PROVE_TAC [])
4547 >> RW_TAC std_ss [PREIMAGE_BIGUNION, IMAGE_IMAGE]
4548 >> RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, IN_IMAGE]
4549 >> FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE]
4550 >> EQ_TAC
4551 >- (RW_TAC std_ss [] >> Q.EXISTS_TAC `s` >> ASM_REWRITE_TAC []
4552 >> Q.PAT_X_ASSUM `!x. x IN c ==> ?x'. (x = PREIMAGE f x') /\ x' IN subsets b`
4553 (MP_TAC o Q.SPEC `s`)
4554 >> RW_TAC std_ss []
4555 >> Q.EXISTS_TAC `PREIMAGE f x'` >> ASM_REWRITE_TAC []
4556 >> Suff `(\x''. PREIMAGE f x' = PREIMAGE f x'')
4557 (@x''. x'' IN subsets b /\ (PREIMAGE f x'' = PREIMAGE f x'))`
4558 >- METIS_TAC []
4559 >> MATCH_MP_TAC SELECT_ELIM_THM
4560 >> PROVE_TAC [])
4561 >> RW_TAC std_ss []
4562 >> Q.EXISTS_TAC `x'`
4563 >> ASM_REWRITE_TAC []
4564 >> Know `(\x''. x IN PREIMAGE f x'' ==> x IN x')
4565 (@x''. x'' IN subsets b /\ (PREIMAGE f x'' = x'))`
4566 >- (MATCH_MP_TAC SELECT_ELIM_THM
4567 >> RW_TAC std_ss []
4568 >> PROVE_TAC [])
4569 >> RW_TAC std_ss []
4570QED
4571
4572Theorem MEASURABLE_SIGMA_PREIMAGES:
4573 !a b f. sigma_algebra a /\ sigma_algebra b /\
4574 f IN (space a -> space b) /\
4575 (!s. s IN subsets b ==> PREIMAGE f s IN subsets a) ==>
4576 sigma_algebra (space a, IMAGE (PREIMAGE f) (subsets b))
4577Proof
4578 RW_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET, subsets_def, space_def]
4579 >| [FULL_SIMP_TAC std_ss [subset_class_def, GSPECIFICATION, IN_IMAGE]
4580 >> PROVE_TAC [],
4581 RW_TAC std_ss [IN_IMAGE]
4582 >> Q.EXISTS_TAC `{}`
4583 >> RW_TAC std_ss [PREIMAGE_EMPTY],
4584 RW_TAC std_ss [IN_IMAGE, PREIMAGE_DIFF]
4585 >> FULL_SIMP_TAC std_ss [IN_IMAGE]
4586 >> Q.EXISTS_TAC `space b DIFF x`
4587 >> RW_TAC std_ss [PREIMAGE_DIFF]
4588 >> MATCH_MP_TAC SUBSET_ANTISYM
4589 >> RW_TAC std_ss [SUBSET_DEF, IN_DIFF, IN_PREIMAGE]
4590 >> Q.PAT_X_ASSUM `!s. s IN subsets b ==> PREIMAGE f s IN subsets a`
4591 (MP_TAC o Q.SPEC `space b DIFF x`)
4592 >> Know `x' IN PREIMAGE f (space b DIFF x)`
4593 >- RW_TAC std_ss [IN_PREIMAGE, IN_DIFF]
4594 >> PROVE_TAC [subset_class_def, SUBSET_DEF],
4595 (MP_TAC o REWRITE_RULE [IN_FUNSET, SIGMA_ALGEBRA] o Q.SPECL [`a`, `b`, `f`])
4596 MEASUBABLE_BIGUNION_LEMMA
4597 >> RW_TAC std_ss []]
4598QED
4599
4600Theorem MEASURABLE_SIGMA:
4601 !f a b sp.
4602 sigma_algebra a /\
4603 subset_class sp b /\
4604 f IN (space a -> sp) /\
4605 (!s. s IN b ==> ((PREIMAGE f s)INTER(space a)) IN subsets a)
4606 ==>
4607 f IN measurable a (sigma sp b)
4608Proof
4609 RW_TAC std_ss []
4610 >> REWRITE_TAC [IN_MEASURABLE]
4611 >> CONJ_TAC >- FULL_SIMP_TAC std_ss [sigma_def, space_def]
4612 >> RW_TAC std_ss [SIGMA_ALGEBRA_SIGMA, SPACE_SIGMA, subsets_def, GSPECIFICATION]
4613 >> Know `subsets (sigma sp b) SUBSET {x' | ((PREIMAGE f x')INTER(space a)) IN subsets a /\
4614 x' SUBSET sp}`
4615 >- (MATCH_MP_TAC SIGMA_PROPERTY
4616 >> RW_TAC std_ss [subset_class_def, GSPECIFICATION, IN_INTER, EMPTY_SUBSET,
4617 PREIMAGE_EMPTY, PREIMAGE_DIFF, SUBSET_INTER, SIGMA_ALGEBRA,
4618 DIFF_SUBSET, SUBSET_DEF, NOT_IN_EMPTY, IN_DIFF,
4619 PREIMAGE_BIGUNION, IN_BIGUNION]
4620 >| [FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, INTER_EMPTY],
4621 PROVE_TAC [subset_class_def, SUBSET_DEF],
4622 Know `(PREIMAGE f sp DIFF PREIMAGE f s') INTER space a =
4623 (PREIMAGE f sp INTER space a) DIFF (PREIMAGE f s' INTER space a)`
4624 >- (RW_TAC std_ss [Once EXTENSION, IN_DIFF, IN_INTER, IN_PREIMAGE] >> DECIDE_TAC)
4625 >> RW_TAC std_ss []
4626 >> Know `PREIMAGE f sp INTER space a = space a`
4627 >- (RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_PREIMAGE] >> METIS_TAC [IN_FUNSET])
4628 >> FULL_SIMP_TAC std_ss [sigma_algebra_def, ALGEBRA_COMPL],
4629 FULL_SIMP_TAC std_ss [sigma_algebra_def]
4630 >> `BIGUNION (IMAGE (PREIMAGE f) c) INTER space a =
4631 BIGUNION (IMAGE (\x. (PREIMAGE f x) INTER (space a)) c)`
4632 by (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION, IN_INTER, IN_IMAGE]
4633 >> FULL_SIMP_TAC std_ss [IN_FUNSET]
4634 >> EQ_TAC
4635 >- (RW_TAC std_ss []
4636 >> Q.EXISTS_TAC `PREIMAGE f x' INTER space a`
4637 >> ASM_REWRITE_TAC [IN_INTER]
4638 >> Q.EXISTS_TAC `x'` >> RW_TAC std_ss [])
4639 >> RW_TAC std_ss [] >> METIS_TAC [IN_INTER, IN_PREIMAGE])
4640 >> RW_TAC std_ss []
4641 >> Q.PAT_X_ASSUM `!c. countable c /\ c SUBSET subsets a ==>
4642 BIGUNION c IN subsets a` MATCH_MP_TAC
4643 >> RW_TAC std_ss [image_countable, SUBSET_DEF, IN_IMAGE]
4644 >> PROVE_TAC [],
4645 PROVE_TAC []])
4646 >> RW_TAC std_ss [SUBSET_DEF, GSPECIFICATION]
4647QED
4648
4649(* This is Lemma 2.4.1 of [9, p.207], re-expressing the above MEASURABLE_SIGMA as a
4650 necessary ad sufficient condition.
4651 *)
4652Theorem MEASURABLE_LEMMA :
4653 !f a b sp sts.
4654 sigma_algebra a /\ subset_class sp sts /\
4655 f IN (space a -> sp) /\ b = (sigma sp sts)
4656 ==>
4657 ((!s. s IN subsets b ==> ((PREIMAGE f s) INTER (space a)) IN subsets a)
4658 <=>
4659 (!s. s IN sts ==> ((PREIMAGE f s) INTER (space a)) IN subsets a))
4660Proof
4661 RW_TAC std_ss []
4662 >> EQ_TAC
4663 >- (rpt STRIP_TAC \\
4664 FIRST_X_ASSUM MATCH_MP_TAC \\
4665 Suff ‘sts SUBSET subsets (sigma sp sts)’ >- METIS_TAC [SUBSET_DEF] \\
4666 REWRITE_TAC [SIGMA_SUBSET_SUBSETS])
4667 >> DISCH_TAC
4668 >> Know ‘f IN measurable a (sigma sp sts)’
4669 >- (MATCH_MP_TAC MEASURABLE_SIGMA >> art [])
4670 >> rw [measurable_def]
4671QED
4672
4673(* NOTE: more antecedents are added due to changes of ‘measurable’ *)
4674Theorem MEASURABLE_SUBSET :
4675 !a b. sigma_algebra a /\ subset_class (space b) (subsets b) ==>
4676 measurable a b SUBSET measurable a (sigma (space b) (subsets b))
4677Proof
4678 RW_TAC std_ss [SUBSET_DEF]
4679 >> MATCH_MP_TAC MEASURABLE_SIGMA
4680 >> FULL_SIMP_TAC std_ss [IN_MEASURABLE, SIGMA_ALGEBRA, space_def, subsets_def]
4681QED
4682
4683(* NOTE: more antecedents are added due to changes of ‘measurable’ *)
4684Theorem MEASURABLE_LIFT :
4685 !f a b. sigma_algebra a /\ subset_class (space b) (subsets b) /\
4686 f IN measurable a b ==> f IN measurable a (sigma (space b) (subsets b))
4687Proof
4688 PROVE_TAC [MEASURABLE_SUBSET, SUBSET_DEF]
4689QED
4690
4691Theorem MEASURABLE_I:
4692 !a. sigma_algebra a ==> I IN measurable a a
4693Proof
4694 RW_TAC std_ss [IN_MEASURABLE, I_THM, PREIMAGE_I, IN_FUNSET, GSPEC_ID, SPACE, SUBSET_REFL]
4695 >> Know `s INTER space a = s`
4696 >- (FULL_SIMP_TAC std_ss [Once EXTENSION, sigma_algebra_def, algebra_def, IN_INTER,
4697 subset_class_def, SUBSET_DEF]
4698 >> METIS_TAC [])
4699 >> RW_TAC std_ss []
4700QED
4701
4702(* Theorem 7.4 [7, p.54] *)
4703Theorem MEASURABLE_COMP:
4704 !f g a b c.
4705 f IN measurable a b /\ g IN measurable b c ==>
4706 (g o f) IN measurable a c
4707Proof
4708 RW_TAC std_ss [IN_MEASURABLE, GSYM PREIMAGE_COMP, IN_FUNSET, SIGMA_ALGEBRA,
4709 space_def, subsets_def, GSPECIFICATION]
4710 >> `PREIMAGE f (PREIMAGE g s) INTER space a =
4711 PREIMAGE f (PREIMAGE g s INTER space b) INTER space a`
4712 by (RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_PREIMAGE] >> METIS_TAC [])
4713 >> METIS_TAC []
4714QED
4715
4716Theorem MEASURABLE_COMP_STRONG :
4717 !f g a b c.
4718 f IN measurable a b /\ sigma_algebra c /\ g IN (space b -> space c) /\
4719 (!x. x IN (subsets c) ==>
4720 PREIMAGE g x INTER (IMAGE f (space a)) IN subsets b) ==>
4721 (g o f) IN measurable a c
4722Proof
4723 RW_TAC bool_ss [IN_MEASURABLE]
4724 >| [FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET] >> PROVE_TAC [],
4725 RW_TAC std_ss [PREIMAGE_ALT]
4726 >> ONCE_REWRITE_TAC [o_ASSOC]
4727 >> ONCE_REWRITE_TAC [GSYM PREIMAGE_ALT]
4728 >> Know `PREIMAGE f (s o g) INTER space a =
4729 PREIMAGE f (s o g INTER (IMAGE f (space a))) INTER space a`
4730 >- (RW_TAC std_ss [GSYM PREIMAGE_ALT]
4731 >> RW_TAC std_ss [Once EXTENSION, IN_PREIMAGE, IN_INTER, IN_IMAGE]
4732 >> EQ_TAC
4733 >> RW_TAC std_ss []
4734 >> FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_PREIMAGE]
4735 >> Q.EXISTS_TAC `x`
4736 >> Know `g (f x) IN space c`
4737 >- (FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, subset_class_def, SUBSET_DEF] \\
4738 PROVE_TAC [])
4739 >> PROVE_TAC [])
4740 >> STRIP_TAC >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4741 >> FULL_SIMP_TAC std_ss [PREIMAGE_ALT]]
4742QED
4743
4744Theorem MEASURABLE_COMP_STRONGER:
4745 !f g a b c t.
4746 f IN measurable a b /\
4747 sigma_algebra c /\
4748 g IN (space b -> space c) /\
4749 (IMAGE f (space a)) SUBSET t /\
4750 (!s. s IN subsets c ==> (PREIMAGE g s INTER t) IN subsets b) ==>
4751 (g o f) IN measurable a c
4752Proof
4753 RW_TAC bool_ss [IN_MEASURABLE]
4754 >| [FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, IN_FUNSET] >> PROVE_TAC [],
4755 RW_TAC std_ss [PREIMAGE_ALT]
4756 >> ONCE_REWRITE_TAC [o_ASSOC]
4757 >> ONCE_REWRITE_TAC [GSYM PREIMAGE_ALT]
4758 >> Know `(PREIMAGE (f:'a->'b) (((s : 'c -> bool) o (g :'b -> 'c)) INTER
4759 (t :'b -> bool)) INTER space a = PREIMAGE f (s o g) INTER space a)`
4760 >- (RW_TAC std_ss [GSYM PREIMAGE_ALT]
4761 >> RW_TAC std_ss [Once EXTENSION, IN_PREIMAGE, IN_INTER, IN_IMAGE]
4762 >> EQ_TAC
4763 >> RW_TAC std_ss []
4764 >> Know `g (f x) IN space c`
4765 >- (FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, subset_class_def, SUBSET_DEF] \\
4766 PROVE_TAC [])
4767 >> STRIP_TAC
4768 >> Know `(f x) IN space b`
4769 >- FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_PREIMAGE, IN_FUNSET]
4770 >> STRIP_TAC
4771 >> Know `x IN space a`
4772 >- FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_PREIMAGE]
4773 >> STRIP_TAC
4774 >> FULL_SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE]
4775 >> Q.PAT_X_ASSUM `!x. (?x'. (x = f x') /\ x' IN space a) ==> x IN t`
4776 MATCH_MP_TAC
4777 >> Q.EXISTS_TAC `x`
4778 >> ASM_REWRITE_TAC [])
4779 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap o GSYM)
4780 >> RW_TAC std_ss [PREIMAGE_ALT]
4781 >> RW_TAC std_ss [GSYM PREIMAGE_ALT, GSYM PREIMAGE_COMP]]
4782QED
4783
4784Theorem MEASURABLE_UP_LIFT:
4785 !sp a b c f. f IN measurable (sp, a) c /\
4786 sigma_algebra (sp, b) /\ a SUBSET b ==> f IN measurable (sp,b) c
4787Proof
4788 RW_TAC std_ss [IN_MEASURABLE, GSPECIFICATION, SUBSET_DEF, IN_FUNSET,
4789 space_def, subsets_def]
4790QED
4791
4792Theorem MEASURABLE_UP_SUBSET:
4793 !sp a b c. a SUBSET b /\ sigma_algebra (sp, b)
4794 ==> measurable (sp, a) c SUBSET measurable (sp, b) c
4795Proof
4796 RW_TAC std_ss [MEASURABLE_UP_LIFT, SUBSET_DEF]
4797 >> MATCH_MP_TAC MEASURABLE_UP_LIFT
4798 >> Q.EXISTS_TAC `a`
4799 >> ASM_REWRITE_TAC [SUBSET_DEF]
4800QED
4801
4802(* NOTE: more antecedents are added due to changes of ‘measurable’ *)
4803Theorem MEASURABLE_UP_SIGMA :
4804 !a b. subset_class (space a) (subsets a) /\ sigma_algebra b ==>
4805 measurable a b SUBSET measurable (sigma (space a) (subsets a)) b
4806Proof
4807 RW_TAC std_ss [SUBSET_DEF, IN_MEASURABLE, space_def, subsets_def, SPACE_SIGMA]
4808 >> PROVE_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF]
4809QED
4810
4811(* Definition 14.2 of [1, p.137] *)
4812Definition prod_sigma_def:
4813 prod_sigma a b =
4814 sigma (space a CROSS space b) (prod_sets (subsets a) (subsets b))
4815End
4816
4817Overload CROSS = “prod_sigma”
4818
4819(* NOTE: the following easy satifsiable antecedents are added, due to changes
4820 in ‘measurable’ which previously requires that a1 and a2 are
4821 sigma-algebras:
4822
4823 subset_class (space a1) (subsets a1)
4824 subset_class (space a2) (subsets a2)
4825 *)
4826Theorem MEASURABLE_PROD_SIGMA' :
4827 !a a1 a2 f. sigma_algebra a /\
4828 subset_class (space a1) (subsets a1) /\
4829 subset_class (space a2) (subsets a2) /\
4830 (FST o f) IN measurable a a1 /\
4831 (SND o f) IN measurable a a2 ==> f IN measurable a (a1 CROSS a2)
4832Proof
4833 RW_TAC std_ss [prod_sigma_def]
4834 >> MATCH_MP_TAC MEASURABLE_SIGMA
4835 >> FULL_SIMP_TAC std_ss [IN_MEASURABLE]
4836 >> CONJ_TAC
4837 >- (RW_TAC std_ss [subset_class_def, subsets_def, space_def, IN_PROD_SETS] \\
4838 rw [CROSS_SUBSET] \\
4839 fs [subset_class_def])
4840 >> CONJ_TAC
4841 >- (RW_TAC std_ss [IN_FUNSET, SPACE_SIGMA, IN_CROSS] \\
4842 FULL_SIMP_TAC std_ss [IN_FUNSET, o_DEF])
4843 >> RW_TAC std_ss [IN_PROD_SETS]
4844 >> RW_TAC std_ss [PREIMAGE_CROSS]
4845 >> `PREIMAGE (FST o f) t INTER PREIMAGE (SND o f) u INTER space a =
4846 (PREIMAGE (FST o f) t INTER space a) INTER
4847 (PREIMAGE (SND o f) u INTER space a)`
4848 by (RW_TAC std_ss [Once EXTENSION, IN_INTER] >> DECIDE_TAC)
4849 >> PROVE_TAC [sigma_algebra_def, ALGEBRA_INTER]
4850QED
4851
4852(* |- !a a1 a2 f.
4853 sigma_algebra a /\ subset_class (space a1) (subsets a1) /\
4854 subset_class (space a2) (subsets a2) /\ FST o f IN measurable a a1 /\
4855 SND o f IN measurable a a2 ==>
4856 f IN measurable a (sigma (space a1 CROSS space a2)
4857 (prod_sets (subsets a1) (subsets a2)))
4858 *)
4859Theorem MEASURABLE_PROD_SIGMA =
4860 REWRITE_RULE [prod_sigma_def] MEASURABLE_PROD_SIGMA'
4861
4862(* prod_sigma is indeed a sigma-algebra *)
4863Theorem SIGMA_ALGEBRA_PROD_SIGMA :
4864 !a b. subset_class (space a) (subsets a) /\
4865 subset_class (space b) (subsets b) ==> sigma_algebra (prod_sigma a b)
4866Proof
4867 RW_TAC std_ss [prod_sigma_def]
4868 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA
4869 >> RW_TAC std_ss [subset_class_def, IN_PROD_SETS, GSPECIFICATION, IN_CROSS]
4870 >> fs [subset_class_def]
4871 >> RW_TAC std_ss [SUBSET_DEF, IN_CROSS]
4872 >> METIS_TAC [SUBSET_DEF]
4873QED
4874
4875(* |- !X Y A B.
4876 subset_class X A /\ subset_class Y B ==>
4877 sigma_algebra ((X,A) CROSS (Y,B))
4878 *)
4879Theorem SIGMA_ALGEBRA_PROD_SIGMA' =
4880 Q.GENL [‘X’, ‘Y’, ‘A’, ‘B’]
4881 (REWRITE_RULE [space_def, subsets_def]
4882 (Q.SPECL [‘(X,A)’, ‘(Y,B)’] SIGMA_ALGEBRA_PROD_SIGMA));
4883
4884Theorem SPACE_PROD_SIGMA :
4885 !a b. space (prod_sigma a b) = space a CROSS space b
4886Proof
4887 rw [SPACE_SIGMA, prod_sigma_def]
4888QED
4889
4890(* ------------------------------------------------------------------------- *)
4891(* sigma-algebra of functions [7, p.55] *)
4892(* ------------------------------------------------------------------------- *)
4893
4894(* The smallest sigma-algebra on `sp` that makes `f` measurable *)
4895Definition sigma_function_def :
4896 sigma_function sp A f = (sp,IMAGE (\s. PREIMAGE f s INTER sp) (subsets A))
4897End
4898
4899Overload sigma = “sigma_function”
4900
4901Theorem space_sigma_function :
4902 !sp A f. space (sigma_function sp A f) = sp
4903Proof
4904 rw [sigma_function_def]
4905QED
4906
4907(* For ‘sigma_function sp A f’ to be a sigma_algebra, A must be sigma_algebra *)
4908Theorem sigma_algebra_sigma_function :
4909 !sp A f. sigma_algebra A /\ f IN (sp -> space A) ==>
4910 sigma_algebra (sigma_function sp A f)
4911Proof
4912 rw [sigma_function_def]
4913 >> MATCH_MP_TAC PREIMAGE_SIGMA_ALGEBRA >> art []
4914QED
4915
4916Theorem sigma_function_subset :
4917 !A B f. sigma_algebra A /\ f IN measurable A B ==>
4918 subsets (sigma (space A) B f) SUBSET subsets A
4919Proof
4920 rw [sigma_function_def]
4921 >> rw [SUBSET_DEF]
4922 >> rename1 ‘t IN subsets B’
4923 >> FULL_SIMP_TAC std_ss [IN_MEASURABLE]
4924QED
4925
4926Theorem SIGMA_MEASURABLE :
4927 !sp A f. sigma_algebra A /\ f IN (sp -> space A) ==>
4928 f IN measurable (sigma sp A f) A
4929Proof
4930 RW_TAC std_ss [sigma_function_def, space_def, subsets_def,
4931 IN_FUNSET, IN_MEASURABLE, IN_IMAGE]
4932 >> Q.EXISTS_TAC `s` >> art []
4933QED
4934
4935(* Definition 7.5 of [7, p.51], The smallest sigma-algebra on `sp` that makes all `f`
4936 simultaneously measurable.
4937 *)
4938Definition sigma_functions_def :
4939 sigma_functions sp A f (J :'index set) =
4940 sigma sp (BIGUNION (IMAGE (\i. IMAGE (\s. PREIMAGE (f i) s INTER sp)
4941 (subsets (A i))) J))
4942End
4943
4944Overload sigma = “sigma_functions”
4945
4946Theorem space_sigma_functions :
4947 !sp A f (J :'index set). space (sigma_functions sp A f J) = sp
4948Proof
4949 rw [sigma_functions_def, SPACE_SIGMA]
4950QED
4951
4952Theorem sigma_algebra_sigma_functions :
4953 !sp A f (J :'index set).
4954 (!i. f i IN (sp -> space (A i))) ==>
4955 sigma_algebra (sigma_functions sp A f J)
4956Proof
4957 rw [sigma_functions_def, IN_FUNSET]
4958 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA
4959 >> rw [subset_class_def, IN_BIGUNION_IMAGE]
4960 >> rw [PREIMAGE_def]
4961QED
4962
4963(* The sigma algebra generated from A/B-measurable functions does not exceed A *)
4964Theorem sigma_functions_subset :
4965 !A B f (J :'index set). sigma_algebra A /\
4966 (!i. i IN J ==> sigma_algebra (B i)) /\
4967 (!i. i IN J ==> f i IN measurable A (B i)) ==>
4968 subsets (sigma (space A) B f J) SUBSET subsets A
4969Proof
4970 rw [sigma_functions_def]
4971 >> MATCH_MP_TAC SIGMA_SUBSET >> art []
4972 >> rw [SUBSET_DEF, IN_BIGUNION_IMAGE]
4973 >> rename1 ‘t IN subsets (B i)’
4974 >> Q.PAT_X_ASSUM ‘!i. i IN J ==> f i IN measurable A (B n)’ (MP_TAC o (Q.SPEC ‘i’))
4975 >> rw [IN_MEASURABLE]
4976QED
4977
4978(* ‘sigma_functions’ reduce to ‘sigma_function’ when there's only one function *)
4979Theorem sigma_functions_1 :
4980 !sp A f. sigma_algebra A /\ f 0 IN (sp -> space A) ==>
4981 sigma sp (\n. A) f (count 1) = sigma sp A (f 0)
4982Proof
4983 rw [sigma_functions_def]
4984 >> Know ‘BIGUNION
4985 (IMAGE (\n. IMAGE (\s. PREIMAGE (f n) s INTER sp) (subsets A)) (count 1))
4986 = IMAGE (\s. PREIMAGE (f 0) s INTER sp) (subsets A)’
4987 >- rw [Once EXTENSION, IN_BIGUNION_IMAGE]
4988 >> Rewr'
4989 >> Know ‘IMAGE (\s. PREIMAGE (f 0) s INTER sp) (subsets A) =
4990 subsets (sigma sp A (f 0))’
4991 >- rw [sigma_function_def]
4992 >> Rewr'
4993 >> Q.ABBREV_TAC ‘B = sigma sp A (f 0)’
4994 >> ‘sp = space B’ by METIS_TAC [space_sigma_function] >> POP_ORW
4995 >> MATCH_MP_TAC SIGMA_STABLE
4996 >> Q.UNABBREV_TAC ‘B’
4997 >> MATCH_MP_TAC sigma_algebra_sigma_function >> art []
4998QED
4999
5000Theorem sigma_function_alt_sigma_functions :
5001 !sp A X. sigma_algebra A /\ X IN (sp -> space A) ==>
5002 sigma sp A X = sigma sp (\n. A) (\n x. X x) (count 1)
5003Proof
5004 rpt STRIP_TAC
5005 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
5006 >> Q.ABBREV_TAC ‘f = \n:num x. X x’
5007 >> ‘X = f 0’ by METIS_TAC [] >> POP_ORW
5008 >> MATCH_MP_TAC sigma_functions_1
5009 >> rw [Abbr ‘f’, ETA_THM]
5010QED
5011
5012(* Lemma 7.5 of [7, p.51] *)
5013Theorem SIGMA_SIMULTANEOUSLY_MEASURABLE :
5014 !sp A f (J :'index set).
5015 (!i. i IN J ==> sigma_algebra (A i)) /\
5016 (!i. i IN J ==> f i IN (sp -> space (A i))) ==>
5017 !i. i IN J ==> f i IN measurable (sigma sp A f J) (A i)
5018Proof
5019 RW_TAC std_ss [IN_FUNSET, SPACE_SIGMA, sigma_functions_def, IN_MEASURABLE]
5020 >> Know `PREIMAGE (f i) s INTER sp IN
5021 (BIGUNION (IMAGE (\i. IMAGE (\s. PREIMAGE (f i) s INTER sp)
5022 (subsets (A i))) J))`
5023 >- (RW_TAC std_ss [IN_BIGUNION_IMAGE, IN_IMAGE] \\
5024 Q.EXISTS_TAC `i` >> art [] \\
5025 Q.EXISTS_TAC `s` >> art [])
5026 >> DISCH_TAC
5027 >> ASSUME_TAC
5028 (Q.SPECL [`sp`,
5029 `BIGUNION (IMAGE (\i. IMAGE (\s. PREIMAGE (f i) s INTER sp)
5030 (subsets (A i)))
5031 (J :'index set))`] SIGMA_SUBSET_SUBSETS)
5032 >> PROVE_TAC [SUBSET_DEF]
5033QED
5034
5035(* Theorem 14.17 (i): alternative definition of product sigma-algebra [7, p.149]
5036
5037 NOTE: previous antecedents ‘sigma_algebra A /\ sigma_algebra B’ has been weakened.
5038 *)
5039Theorem prod_sigma_alt_sigma_functions' :
5040 !A B. algebra A /\ algebra B ==>
5041 prod_sigma A B =
5042 sigma_functions (space A CROSS space B)
5043 (binary A B) (binary FST SND) {0; 1 :num}
5044Proof
5045 rw [sigma_functions_def, binary_def]
5046 >> Q.ABBREV_TAC ‘sts = {a CROSS space B | a IN subsets A} UNION
5047 {space A CROSS b | b IN subsets B}’
5048 >> Know ‘(IMAGE (\s. PREIMAGE FST s INTER (space A CROSS space B)) (subsets A) UNION
5049 IMAGE (\s. PREIMAGE SND s INTER (space A CROSS space B)) (subsets B)) =
5050 sts’
5051 >- (rw [Abbr ‘sts’, Once EXTENSION, PREIMAGE_def] \\
5052 EQ_TAC >> rw [] >| (* 4 subgoals *)
5053 [ (* goal 1 (of 4) *)
5054 rename1 ‘s IN subsets A’ \\
5055 DISJ1_TAC >> Q.EXISTS_TAC ‘s’ >> art [] \\
5056 rw [Once EXTENSION, IN_CROSS] \\
5057 EQ_TAC >> rw [] \\
5058 Suff ‘s SUBSET space A’ >- METIS_TAC [SUBSET_DEF] \\
5059 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def],
5060 (* goal 2 (of 4) *)
5061 rename1 ‘s IN subsets B’ \\
5062 DISJ2_TAC >> Q.EXISTS_TAC ‘s’ >> art [] \\
5063 rw [Once EXTENSION, IN_CROSS] \\
5064 EQ_TAC >> rw [] \\
5065 Suff ‘s SUBSET space B’ >- METIS_TAC [SUBSET_DEF] \\
5066 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def],
5067 (* goal 3 (of 4) *)
5068 DISJ1_TAC >> Q.EXISTS_TAC ‘a’ >> art [] \\
5069 rw [Once EXTENSION, IN_CROSS] \\
5070 EQ_TAC >> rw [] \\
5071 Suff ‘a SUBSET space A’ >- METIS_TAC [SUBSET_DEF] \\
5072 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def],
5073 (* goal 4 (of 4) *)
5074 DISJ2_TAC >> Q.EXISTS_TAC ‘b’ >> art [] \\
5075 rw [Once EXTENSION, IN_CROSS] \\
5076 EQ_TAC >> rw [] \\
5077 Suff ‘b SUBSET space B’ >- METIS_TAC [SUBSET_DEF] \\
5078 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def] ])
5079 >> Rewr'
5080 >> ‘sts SUBSET subsets (sigma (space A CROSS space B) sts)’
5081 by PROVE_TAC [SIGMA_SUBSET_SUBSETS]
5082 >> Know ‘sigma_algebra (sigma (space A CROSS space B) sts)’
5083 >- (MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\
5084 rw [Abbr ‘sts’, subset_class_def, SUBSET_DEF] \\
5085 fs [IN_CROSS] >| (* 2 subgoals *)
5086 [ (* goal 1 (of 2) *)
5087 rename1 ‘FST y IN a’ \\
5088 Suff ‘a SUBSET space A’ >- METIS_TAC [SUBSET_DEF] \\
5089 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def],
5090 (* goal 2 (of 2) *)
5091 rename1 ‘SND y IN b’ \\
5092 Suff ‘b SUBSET space B’ >- METIS_TAC [SUBSET_DEF] \\
5093 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def] ])
5094 >> DISCH_TAC
5095 >> Know ‘prod_sets (subsets A) (subsets B) SUBSET
5096 subsets (sigma (space A CROSS space B) sts)’
5097 >- (rw [SUBSET_DEF, IN_PROD_SETS] \\
5098 Know ‘t CROSS u = (t CROSS space B) INTER (space A CROSS u)’
5099 >- (rw [Once EXTENSION, IN_CROSS] \\
5100 EQ_TAC >> rw [] >| (* 2 subgoals *)
5101 [ (* goal 1 (of 2) *)
5102 Suff ‘u SUBSET space B’ >- METIS_TAC [SUBSET_DEF] \\
5103 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def],
5104 (* goal 2 (of 2) *)
5105 Suff ‘t SUBSET space A’ >- METIS_TAC [SUBSET_DEF] \\
5106 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def] ]) \\
5107 Rewr' \\
5108 MATCH_MP_TAC SIGMA_ALGEBRA_INTER \\
5109 RW_TAC std_ss [] >| (* 2 subgoals *)
5110 [ (* goal 1 (of 2) *)
5111 Suff ‘t CROSS space B IN sts’ >- METIS_TAC [SUBSET_DEF] \\
5112 Q.UNABBREV_TAC ‘sts’ >> rw [] \\
5113 DISJ1_TAC >> Q.EXISTS_TAC ‘t’ >> art [],
5114 (* goal 2 (of 2) *)
5115 Suff ‘space A CROSS u IN sts’ >- METIS_TAC [SUBSET_DEF] \\
5116 Q.UNABBREV_TAC ‘sts’ >> rw [] \\
5117 DISJ2_TAC >> Q.EXISTS_TAC ‘u’ >> art [] ])
5118 >> DISCH_TAC
5119 >> REWRITE_TAC [prod_sigma_def, Once EQ_SYM_EQ]
5120 >> Suff ‘subsets (sigma (space A CROSS space B) sts) =
5121 subsets (sigma (space A CROSS space B)
5122 (prod_sets (subsets A) (subsets B)))’
5123 >- METIS_TAC [SPACE, SPACE_SIGMA]
5124 >> MATCH_MP_TAC SIGMA_SMALLEST >> art []
5125 >> reverse CONJ_TAC
5126 >- METIS_TAC [SPACE, SPACE_SIGMA]
5127 >> MP_TAC (Q.SPECL [‘sts’, ‘(sigma (space A CROSS space B)
5128 (prod_sets (subsets A) (subsets B)))’]
5129 (INST_TYPE [“:'a” |-> “:'a # 'a”] SIGMA_SUBSET))
5130 >> REWRITE_TAC [SPACE_SIGMA]
5131 >> DISCH_THEN MATCH_MP_TAC
5132 >> CONJ_TAC
5133 >- (MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\
5134 rw [subset_class_def, IN_PROD_SETS] \\
5135 MATCH_MP_TAC SUBSET_CROSS \\
5136 FULL_SIMP_TAC std_ss [algebra_def, subset_class_def])
5137 >> MATCH_MP_TAC SUBSET_TRANS
5138 >> Q.EXISTS_TAC ‘prod_sets (subsets A) (subsets B)’
5139 >> REWRITE_TAC [SIGMA_SUBSET_SUBSETS]
5140 >> rw [Abbr ‘sts’, SUBSET_DEF, IN_PROD_SETS]
5141 >| [ (* goal 1 (of 2) *)
5142 qexistsl_tac [‘a’, ‘space B’] >> art [] \\
5143 MATCH_MP_TAC ALGEBRA_SPACE >> art [],
5144 (* goal 2 (of 2) *)
5145 qexistsl_tac [‘space A’, ‘b’] >> art [] \\
5146 MATCH_MP_TAC ALGEBRA_SPACE >> art [] ]
5147QED
5148
5149(* for compatibility purposes (and sometimes more applicable) *)
5150Theorem prod_sigma_alt_sigma_functions :
5151 !A B. sigma_algebra A /\ sigma_algebra B ==>
5152 prod_sigma A B =
5153 sigma_functions (space A CROSS space B)
5154 (binary A B) (binary FST SND) {0; 1 :num}
5155Proof
5156 rpt STRIP_TAC
5157 >> MATCH_MP_TAC prod_sigma_alt_sigma_functions'
5158 >> CONJ_TAC (* 2 subgoals, same tactics *)
5159 >> MATCH_MP_TAC SIGMA_ALGEBRA_ALGEBRA >> art []
5160QED
5161
5162(* ------------------------------------------------------------------------- *)
5163(* Pre-images (and images) of sigma generator *)
5164(* ------------------------------------------------------------------------- *)
5165
5166(* The proof is learnt from https://math.stackexchange.com/questions/1496875 *)
5167Theorem PREIMAGE_SIGMA_SUBSET[local] :
5168 !Z sp sts f. subset_class sp sts /\ f IN (Z -> sp) ==>
5169 IMAGE (\s. PREIMAGE f s INTER Z) (subsets (sigma sp sts)) SUBSET
5170 subsets (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))
5171Proof
5172 rpt STRIP_TAC
5173 (* applying PREIMAGE_SIGMA_ALGEBRA *)
5174 >> Know ‘sigma_algebra (Z,IMAGE (\s. PREIMAGE f s INTER Z) (subsets (sigma sp sts)))’
5175 >- (MATCH_MP_TAC PREIMAGE_SIGMA_ALGEBRA >> rw [SPACE_SIGMA] \\
5176 MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA >> art [])
5177 >> DISCH_TAC
5178 (* stage work *)
5179 >> rw [SUBSET_DEF]
5180 >> rename1 ‘u IN subsets (sigma sp sts)’
5181 >> Q.ABBREV_TAC ‘D = {G | G SUBSET sp /\
5182 PREIMAGE f G INTER Z IN
5183 subsets (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))}’
5184 >> Suff ‘sts SUBSET D /\ sigma_algebra (sp,D)’
5185 >- (STRIP_TAC \\
5186 Know ‘subsets (sigma (space (sp,D)) sts) SUBSET subsets (sp,D)’
5187 >- (MATCH_MP_TAC SIGMA_SUBSET >> art [subsets_def]) \\
5188 REWRITE_TAC [space_def, subsets_def] \\
5189 DISCH_TAC \\
5190 Know ‘u IN D’ >- METIS_TAC [SUBSET_DEF] \\
5191 rw [Abbr ‘D’, GSPECIFICATION])
5192 >> CONJ_TAC (* sts SUBSET D *)
5193 >- (Know ‘(IMAGE (\s. PREIMAGE f s INTER Z) sts) SUBSET
5194 subsets (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))’
5195 >- (rw [SIGMA_SUBSET_SUBSETS]) \\
5196 rw [SUBSET_DEF, Abbr ‘D’]
5197 >- (rename [‘s IN sts’, ‘x IN s’] \\
5198 METIS_TAC [subset_class_def, SUBSET_DEF]) \\
5199 FIRST_X_ASSUM MATCH_MP_TAC \\
5200 Q.EXISTS_TAC ‘x’ >> art [])
5201 (* final stage *)
5202 >> Know ‘sigma_algebra (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))’
5203 >- (MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\
5204 rw [subset_class_def] \\
5205 REWRITE_TAC [INTER_SUBSET])
5206 >> DISCH_TAC
5207 >> rw [sigma_algebra_alt_pow] (* 4 subgoals *)
5208 >| [ (* goal 1 (of 4) *)
5209 rw [SUBSET_DEF, IN_POW, Abbr ‘D’],
5210 (* goal 2 (of 4) *)
5211 rw [Abbr ‘D’] \\
5212 MATCH_MP_TAC SIGMA_ALGEBRA_EMPTY >> art [],
5213 (* goal 3 (of 4) *)
5214 fs [Abbr ‘D’] \\
5215 Know ‘PREIMAGE f (sp DIFF s) INTER Z =
5216 (space (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts)))
5217 DIFF (PREIMAGE f s INTER Z)’
5218 >- (REWRITE_TAC [SPACE_SIGMA] \\
5219 rw [Once EXTENSION, GSPECIFICATION] \\
5220 METIS_TAC [IN_FUNSET]) >> Rewr' \\
5221 MATCH_MP_TAC SIGMA_ALGEBRA_COMPL >> art [],
5222 (* goal 4 (of 4) *)
5223 POP_ASSUM MP_TAC \\
5224 rw [Abbr ‘D’, SUBSET_DEF] >- METIS_TAC [] \\
5225 Know ‘PREIMAGE f (BIGUNION {A i | i | T}) INTER Z =
5226 BIGUNION (IMAGE (\i. PREIMAGE f (A i) INTER Z) UNIV)’
5227 >- (rw [Once EXTENSION, IN_PREIMAGE, IN_BIGUNION_IMAGE] \\
5228 METIS_TAC []) >> Rewr' \\
5229 Q.PAT_X_ASSUM ‘sigma_algebra (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))’
5230 (MP_TAC o REWRITE_RULE [SIGMA_ALGEBRA_ALT]) \\
5231 rw [IN_FUNSET] \\
5232 POP_ASSUM MATCH_MP_TAC >> rw [] \\
5233 METIS_TAC [] ]
5234QED
5235
5236Theorem PREIMAGE_SIGMA :
5237 !Z sp sts f. subset_class sp sts /\ f IN (Z -> sp) ==>
5238 IMAGE (\s. PREIMAGE f s INTER Z) (subsets (sigma sp sts)) =
5239 subsets (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))
5240Proof
5241 rpt STRIP_TAC
5242 >> MATCH_MP_TAC SUBSET_ANTISYM
5243 >> CONJ_TAC
5244 >- (MATCH_MP_TAC PREIMAGE_SIGMA_SUBSET >> art [])
5245 >> fs [IN_FUNSET]
5246 >> ‘sigma_algebra (sigma sp sts)’ by PROVE_TAC [SIGMA_ALGEBRA_SIGMA]
5247 >> MATCH_MP_TAC SIGMA_PROPERTY_ALT
5248 >> rw [IN_FUNSET] (* 5 subgoals *)
5249 >| [ (* goal 1 (of 5) *)
5250 rw [subset_class_def] >> REWRITE_TAC [INTER_SUBSET],
5251 (* goal 2 (of 5) *)
5252 Q.EXISTS_TAC ‘{}’ >> rw [PREIMAGE_EMPTY] \\
5253 MATCH_MP_TAC SIGMA_ALGEBRA_EMPTY >> art [],
5254 (* goal 3 (of 5) *)
5255 rw [SUBSET_DEF] >> rename1 ‘s IN sts’ \\
5256 Q.EXISTS_TAC ‘s’ >> REWRITE_TAC [] \\
5257 METIS_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF],
5258 (* goal 4 (of 5) *)
5259 rename1 ‘s IN subsets (sigma sp sts)’ \\
5260 Q.EXISTS_TAC ‘(space (sigma sp sts)) DIFF s’ \\
5261 reverse CONJ_TAC
5262 >- (MATCH_MP_TAC SIGMA_ALGEBRA_COMPL >> art []) \\
5263 rw [Once EXTENSION, SPACE_SIGMA] >> METIS_TAC [],
5264 (* goal 5 (of 5) *)
5265 Know ‘(!x. f' x IN subsets (sigma Z (IMAGE (\s. PREIMAGE f s INTER Z) sts))) /\
5266 (!x. (?s. f' x = PREIMAGE f s INTER Z /\ s IN subsets (sigma sp sts)))’
5267 >- METIS_TAC [] \\
5268 POP_ASSUM K_TAC >> STRIP_TAC \\
5269 fs [SKOLEM_THM] \\
5270 Know ‘(!x. f' x = PREIMAGE f (f'' x) INTER Z) /\
5271 (!x. f'' x IN subsets (sigma sp sts))’ >- METIS_TAC [] \\
5272 POP_ASSUM K_TAC >> STRIP_TAC \\
5273 rename1 ‘!x. g x = PREIMAGE f (h x) INTER Z’ \\
5274 Q.EXISTS_TAC ‘BIGUNION (IMAGE h UNIV)’ \\
5275 reverse CONJ_TAC
5276 >- (Q.PAT_X_ASSUM ‘sigma_algebra (sigma sp sts)’
5277 (MP_TAC o REWRITE_RULE [SIGMA_ALGEBRA_ALT]) \\
5278 rw [IN_FUNSET]) \\
5279 rw [Once EXTENSION, IN_PREIMAGE, IN_BIGUNION_IMAGE] >> METIS_TAC [] ]
5280QED
5281
5282(* A good corollary of PREIMAGE_SIGMA *)
5283Theorem IMAGE_SIGMA :
5284 !sp sts f. subset_class sp sts /\ BIJ f sp (IMAGE f sp) ==>
5285 IMAGE (IMAGE f) (subsets (sigma sp sts)) =
5286 subsets (sigma (IMAGE f sp) (IMAGE (IMAGE f) sts))
5287Proof
5288 rpt STRIP_TAC
5289 >> MP_TAC (MATCH_MP BIJ_INV
5290 (ASSUME “BIJ (f :'a -> 'b) (sp :'a -> bool) (IMAGE f sp)”))
5291 >> rw []
5292 >> qabbrev_tac ‘Z = IMAGE f sp’
5293 >> qabbrev_tac ‘H = \s. PREIMAGE g s INTER Z’
5294 >> Know ‘IMAGE (IMAGE f) sts = IMAGE H sts’
5295 >- (rw [Abbr ‘H’, FUN_EQ_THM, Once EXTENSION, PREIMAGE_def] \\
5296 EQ_TAC >> rw [Abbr ‘Z’]
5297 >- (rename1 ‘s IN sts’ >> Q.EXISTS_TAC ‘s’ >> rw [] \\
5298 EQ_TAC >> rw [] >| (* 3 subgoals *)
5299 [ (* goal 1 (of 3) *)
5300 rename1 ‘g (f y) IN s’ \\
5301 Suff ‘g (f y) = y’ >- rw [] \\
5302 FIRST_X_ASSUM MATCH_MP_TAC \\
5303 POP_ASSUM MP_TAC \\
5304 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5305 fs [subset_class_def],
5306 (* goal 2 (of 3) *)
5307 rename1 ‘y IN s’ >> Q.EXISTS_TAC ‘y’ >> rw [] \\
5308 POP_ASSUM MP_TAC \\
5309 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5310 fs [subset_class_def],
5311 (* goal 3 (of 3) *)
5312 rename1 ‘y IN sp’ >> Q.EXISTS_TAC ‘y’ >> rw [] \\
5313 Suff ‘g (f y) = y’ >- PROVE_TAC [] \\
5314 FIRST_X_ASSUM MATCH_MP_TAC \\
5315 POP_ASSUM MP_TAC \\
5316 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5317 fs [subset_class_def] ]) \\
5318 rename1 ‘s IN sts’ \\
5319 Q.EXISTS_TAC ‘s’ >> rw [] \\
5320 EQ_TAC >> rw [] >| (* 3 subgoals *)
5321 [ (* goal 1 (of 3) *)
5322 rename1 ‘y IN sp’ >> Q.EXISTS_TAC ‘y’ >> rw [] \\
5323 Suff ‘g (f y) = y’ >- PROVE_TAC [] \\
5324 FIRST_X_ASSUM MATCH_MP_TAC \\
5325 POP_ASSUM MP_TAC \\
5326 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5327 fs [subset_class_def],
5328 (* goal 2 (of 3) *)
5329 rename1 ‘g (f y) IN s’ \\
5330 Suff ‘g (f y) = y’ >- PROVE_TAC [] \\
5331 FIRST_X_ASSUM MATCH_MP_TAC \\
5332 POP_ASSUM MP_TAC \\
5333 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5334 fs [subset_class_def],
5335 (* goal 3 (of 3) *)
5336 rename1 ‘y IN s’ >> Q.EXISTS_TAC ‘y’ >> rw [] \\
5337 POP_ASSUM MP_TAC \\
5338 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5339 fs [subset_class_def] ])
5340 >> Rewr'
5341 >> qabbrev_tac ‘a = sigma sp sts’
5342 >> ‘sigma_algebra a’ by rw [Abbr ‘a’, SIGMA_ALGEBRA_SIGMA]
5343 >> Know ‘IMAGE (IMAGE f) (subsets a) = IMAGE H (subsets a)’
5344 >- (rw [Abbr ‘H’, Once EXTENSION, PREIMAGE_def] \\
5345 EQ_TAC >> rw [Abbr ‘Z’]
5346 >- (rename1 ‘s IN subsets a’ \\
5347 Q.EXISTS_TAC ‘s’ >> art [] \\
5348 rw [Once EXTENSION] \\
5349 EQ_TAC >> rw [] >| (* 3 subgoals *)
5350 [ (* goal 1 (of 3) *)
5351 rename1 ‘g (f y) IN s’ \\
5352 Suff ‘g (f y) = y’ >- rw [] \\
5353 FIRST_X_ASSUM MATCH_MP_TAC \\
5354 POP_ASSUM MP_TAC \\
5355 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5356 ‘space a = sp’ by rw [Abbr ‘a’, SPACE_SIGMA] \\
5357 fs [sigma_algebra_def, algebra_def, subset_class_def],
5358 (* goal 2 (of 3) *)
5359 rename1 ‘y IN s’ >> Q.EXISTS_TAC ‘y’ >> rw [] \\
5360 POP_ASSUM MP_TAC \\
5361 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5362 ‘space a = sp’ by rw [Abbr ‘a’, SPACE_SIGMA] \\
5363 fs [sigma_algebra_def, algebra_def, subset_class_def],
5364 (* goal 3 (of 3) *)
5365 rename1 ‘y IN sp’ >> Q.EXISTS_TAC ‘y’ >> rw [] \\
5366 Suff ‘g (f y) = y’ >- PROVE_TAC [] \\
5367 FIRST_X_ASSUM MATCH_MP_TAC >> art [] ]) \\
5368 rename1 ‘s IN subsets a’ \\
5369 Q.EXISTS_TAC ‘s’ >> art [] \\
5370 rw [Once EXTENSION] \\
5371 EQ_TAC >> rw []
5372 >- (rename1 ‘y IN sp’ >> Q.EXISTS_TAC ‘y’ >> art [] \\
5373 Suff ‘g (f y) = y’ >- PROVE_TAC [] \\
5374 FIRST_X_ASSUM MATCH_MP_TAC >> art [])
5375 >- (rename1 ‘g (f y) IN s’ \\
5376 Suff ‘g (f y) = y’ >- rw [] \\
5377 FIRST_X_ASSUM MATCH_MP_TAC \\
5378 POP_ASSUM MP_TAC \\
5379 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5380 ‘space a = sp’ by rw [Abbr ‘a’, SPACE_SIGMA] \\
5381 fs [sigma_algebra_def, algebra_def, subset_class_def]) \\
5382 rename1 ‘y IN s’ >> Q.EXISTS_TAC ‘y’ >> art [] \\
5383 POP_ASSUM MP_TAC \\
5384 Suff ‘s SUBSET sp’ >- rw [SUBSET_DEF] \\
5385 ‘space a = sp’ by rw [Abbr ‘a’, SPACE_SIGMA] \\
5386 fs [sigma_algebra_def, algebra_def, subset_class_def])
5387 >> Rewr'
5388 >> qunabbrevl_tac [‘H’, ‘a’]
5389 >> MATCH_MP_TAC PREIMAGE_SIGMA
5390 >> rw [Abbr ‘Z’, IN_FUNSET]
5391 >> rename1 ‘g (f y) IN sp’
5392 >> Suff ‘g (f y) = y’ >- rw []
5393 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
5394QED
5395
5396Theorem IMAGE_SIGMA_ALGEBRA :
5397 !sp sts f. sigma_algebra (sp,sts) /\ BIJ f sp (IMAGE f sp) ==>
5398 sigma_algebra (IMAGE f sp,IMAGE (IMAGE f) sts)
5399Proof
5400 rw [sigma_algebra_alt_pow]
5401 >| [ (* goal 1 (of 3) *)
5402 rw [SUBSET_DEF, IN_POW] \\
5403 rename1 ‘y IN IMAGE f s’ >> fs [IN_IMAGE] \\
5404 Q.EXISTS_TAC ‘x’ >> art [] \\
5405 Q.PAT_X_ASSUM ‘sts SUBSET POW sp’ MP_TAC \\
5406 rw [SUBSET_DEF, IN_POW] \\
5407 POP_ASSUM irule \\
5408 Q.EXISTS_TAC ‘s’ >> art [],
5409 (* goal 2 (of 3) *)
5410 rename1 ‘s IN sts’ \\
5411 Q.EXISTS_TAC ‘sp DIFF s’ \\
5412 reverse CONJ_TAC >- (FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
5413 rw [Once EXTENSION] \\
5414 EQ_TAC >> rw [] >| (* 3 subgoals *)
5415 [ (* goal 2.1 (of 3) *)
5416 rename1 ‘y IN sp’ \\
5417 Q.EXISTS_TAC ‘y’ >> art [] \\
5418 POP_ASSUM MATCH_MP_TAC >> art [],
5419 (* goal 2.2 (of 3) *)
5420 rename1 ‘y IN sp’ \\
5421 Q.EXISTS_TAC ‘y’ >> art [],
5422 (* goal 2.3 (of 3) *)
5423 rename1 ‘f x = f y’ \\
5424 Q.PAT_X_ASSUM ‘BIJ f sp _’ MP_TAC \\
5425 simp [BIJ_ALT, IN_FUNSET, EXISTS_UNIQUE_ALT] \\
5426 DISCH_THEN (MP_TAC o Q.SPEC ‘f x’) \\
5427 impl_tac >- (Q.EXISTS_TAC ‘y’ >> art []) \\
5428 DISCH_THEN (Q.X_CHOOSE_THEN ‘z’ STRIP_ASSUME_TAC) \\
5429 CCONTR_TAC >> fs [] \\
5430 Suff ‘x IN sp’ >- METIS_TAC [] \\
5431 Q.PAT_X_ASSUM ‘sts SUBSET POW sp’ MP_TAC \\
5432 rw [SUBSET_DEF, IN_POW] \\
5433 POP_ASSUM irule \\
5434 Q.EXISTS_TAC ‘s’ >> art [] ],
5435 (* goal 3 (of 3) *)
5436 Know ‘BIGUNION {A i | i | T} = BIGUNION (IMAGE A UNIV)’
5437 >- (rw [Once EXTENSION, IN_BIGUNION_IMAGE] \\
5438 EQ_TAC >> rw [] >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5439 rename1 ‘x IN A i’ \\
5440 Q.EXISTS_TAC ‘A i’ >> art [] \\
5441 Q.EXISTS_TAC ‘i’ >> art []) >> Rewr' \\
5442 POP_ASSUM MP_TAC >> rw [SUBSET_DEF] \\
5443 IMP_RES_TAC BIJ_INV \\
5444 Q.EXISTS_TAC ‘BIGUNION (IMAGE (IMAGE g o A) UNIV)’ \\
5445 simp [IMAGE_BIGUNION, IMAGE_IMAGE] \\
5446 CONJ_TAC
5447 >- (AP_TERM_TAC >> AP_THM_TAC >> AP_TERM_TAC \\
5448 rw [Once EXTENSION, o_DEF, FUN_EQ_THM] \\
5449 reverse EQ_TAC >> rw []
5450 >- (rename1 ‘f (g y) IN A i’ \\
5451 fs [o_DEF] \\
5452 Suff ‘f (g y) = y’ >- rw [] \\
5453 FIRST_ASSUM MATCH_MP_TAC \\
5454 Q.PAT_X_ASSUM ‘!x. _ ==> ?x. _’ (MP_TAC o Q.SPEC ‘A (i :num)’) \\
5455 impl_tac >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5456 DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
5457 Q.PAT_X_ASSUM ‘A i = IMAGE f j’ (fs o wrap) \\
5458 Q.EXISTS_TAC ‘x’ >> art [] \\
5459 Q.PAT_X_ASSUM ‘sts SUBSET POW sp’ MP_TAC \\
5460 rw [SUBSET_DEF, IN_POW] \\
5461 POP_ASSUM irule \\
5462 Q.EXISTS_TAC ‘j’ >> art []) \\
5463 rename1 ‘y IN A i’ \\
5464 fs [o_DEF] \\
5465 Q.EXISTS_TAC ‘g y’ \\
5466 reverse CONJ_TAC >- (Q.EXISTS_TAC ‘y’ >> art []) \\
5467 ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
5468 FIRST_ASSUM MATCH_MP_TAC \\
5469 Q.PAT_X_ASSUM ‘!x. _ ==> ?x. _’ (MP_TAC o Q.SPEC ‘A (i :num)’) \\
5470 impl_tac >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5471 DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
5472 Q.PAT_X_ASSUM ‘A i = IMAGE f j’ (fs o wrap) \\
5473 Q.EXISTS_TAC ‘x’ >> art [] \\
5474 Q.PAT_X_ASSUM ‘sts SUBSET POW sp’ MP_TAC \\
5475 rw [SUBSET_DEF, IN_POW] \\
5476 POP_ASSUM irule \\
5477 Q.EXISTS_TAC ‘j’ >> art []) \\
5478 qabbrev_tac ‘B = IMAGE g o A’ \\
5479 Know ‘BIGUNION {B i | i | T} = BIGUNION (IMAGE B UNIV)’
5480 >- (rw [Once EXTENSION, IN_BIGUNION_IMAGE] \\
5481 EQ_TAC >> rw [] >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5482 rename1 ‘x IN B i’ \\
5483 Q.EXISTS_TAC ‘B i’ >> art [] \\
5484 Q.EXISTS_TAC ‘i’ >> art []) \\
5485 DISCH_THEN (REWRITE_TAC o wrap o SYM) \\
5486 FIRST_X_ASSUM MATCH_MP_TAC \\
5487 rw [Abbr ‘B’, SUBSET_DEF] \\
5488 rename1 ‘IMAGE g (A i) IN sts’ \\
5489 Q.PAT_X_ASSUM ‘!x. _ ==> ?x. _’ (MP_TAC o Q.SPEC ‘A (i :num)’) \\
5490 impl_tac >- (Q.EXISTS_TAC ‘i’ >> art []) \\
5491 DISCH_THEN (Q.X_CHOOSE_THEN ‘s’ STRIP_ASSUME_TAC) \\
5492 Q.PAT_X_ASSUM ‘A i = IMAGE f s’ (fs o wrap) \\
5493 Suff ‘IMAGE g (IMAGE f s) = s’ >- rw [] \\
5494 rw [Once EXTENSION] \\
5495 reverse EQ_TAC >> rw []
5496 >- (Q.EXISTS_TAC ‘f x’ \\
5497 reverse CONJ_TAC >- (Q.EXISTS_TAC ‘x’ >> art []) \\
5498 ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
5499 FIRST_X_ASSUM MATCH_MP_TAC \\
5500 Q.PAT_X_ASSUM ‘sts SUBSET POW sp’ MP_TAC \\
5501 rw [SUBSET_DEF, IN_POW] \\
5502 POP_ASSUM irule \\
5503 Q.EXISTS_TAC ‘s’ >> art []) \\
5504 rename1 ‘g (f y) IN s’ \\
5505 Suff ‘g (f y) = y’ >- rw [] \\
5506 FIRST_X_ASSUM MATCH_MP_TAC \\
5507 Q.PAT_X_ASSUM ‘sts SUBSET POW sp’ MP_TAC \\
5508 rw [SUBSET_DEF, IN_POW] \\
5509 POP_ASSUM irule \\
5510 Q.EXISTS_TAC ‘s’ >> art [] ]
5511QED
5512
5513(* Lemma 2.2.5 of [9, p.177] (moving INTER outside of the sigma generator) *)
5514Theorem SIGMA_RESTRICT :
5515 !sp sts B. subset_class sp sts /\ B SUBSET sp ==>
5516 sigma_algebra (B,IMAGE (\s. s INTER B) (subsets (sigma sp sts))) /\
5517 subsets (sigma B (IMAGE (\s. s INTER B) sts)) =
5518 IMAGE (\s. s INTER B) (subsets (sigma sp sts))
5519Proof
5520 rpt STRIP_TAC
5521 >- (MATCH_MP_TAC SIGMA_ALGEBRA_RESTRICT' \\
5522 Q.EXISTS_TAC ‘sp’ \\
5523 rw [SIGMA_REDUCE, SIGMA_ALGEBRA_SIGMA])
5524 >> MP_TAC (Q.SPECL [‘B’, ‘sp’, ‘sts’, ‘I’]
5525 (INST_TYPE [“:'b” |-> “:'a”] PREIMAGE_SIGMA))
5526 >> FULL_SIMP_TAC std_ss [SUBSET_DEF]
5527 >> rw [IN_FUNSET]
5528QED
5529
5530(* Example 3.3 (vi) [7, p.17] (another form of SIGMA_ALGEBRA_RESTRICT') *)
5531Theorem TRACE_SIGMA_ALGEBRA :
5532 !a E. sigma_algebra a /\ E SUBSET (space a) ==>
5533 sigma_algebra (E,{A INTER E | A IN subsets a})
5534Proof
5535 rpt STRIP_TAC
5536 >> Know ‘{A INTER E | A IN subsets a} = IMAGE (\s. s INTER E) (subsets a)’
5537 >- rw [Once EXTENSION, IN_IMAGE]
5538 >> Rewr'
5539 >> MATCH_MP_TAC SIGMA_ALGEBRA_RESTRICT'
5540 >> Q.EXISTS_TAC ‘space a’ >> rw [SPACE]
5541QED
5542
5543(* Lemma 14.1 of [7, p.137] (not used anywhere) *)
5544Theorem SEMIRING_PROD_SETS :
5545 !a b. semiring a /\ semiring b ==>
5546 semiring ((space a CROSS space b),prod_sets (subsets a) (subsets b))
5547Proof
5548 rpt STRIP_TAC
5549 >> RW_TAC std_ss [semiring_def, space_def, subsets_def]
5550 (* subset_class *)
5551 >- (RW_TAC std_ss [subset_class_def, IN_PROD_SETS, GSPECIFICATION] \\
5552 RW_TAC std_ss [SUBSET_DEF, IN_CROSS] >| (* 2 subgoals, same ending *)
5553 [ Suff ‘t SUBSET space a’ >- rw [SUBSET_DEF],
5554 Suff ‘u SUBSET space b’ >- rw [SUBSET_DEF] ] \\
5555 PROVE_TAC [subset_class_def, semiring_def])
5556 (* EMPTY *)
5557 >- (RW_TAC std_ss [IN_CROSS, IN_PROD_SETS, GSPECIFICATION, Once EXTENSION,
5558 NOT_IN_EMPTY] \\
5559 qexistsl_tac [‘{}’, ‘{}’] >> fs [semiring_def])
5560 (* INTER *)
5561 >- (fs [IN_PROD_SETS] \\
5562 rename1 ‘s = t1 CROSS u1’ \\
5563 rename1 ‘t = t2 CROSS u2’ \\
5564 qexistsl_tac [`t1 INTER t2`, `u1 INTER u2`] \\
5565 reverse CONJ_TAC >- METIS_TAC [SEMIRING_INTER] \\
5566 RW_TAC std_ss [Once EXTENSION, IN_CROSS, IN_INTER] >> PROVE_TAC [])
5567 (* DIFF (hard) *)
5568 >> fs [prod_sets_def]
5569 >> rename1 `s = A CROSS B`
5570 >> rename1 `t = A' CROSS B'`
5571 >> REWRITE_TAC [DIFF_INTER_COMPL]
5572 >> Know `COMPL (A' CROSS B') =
5573 (COMPL A' CROSS B') UNION (A' CROSS COMPL B') UNION
5574 (COMPL A' CROSS COMPL B')`
5575 >- (RW_TAC std_ss [Once EXTENSION, IN_CROSS, IN_COMPL, IN_UNION] \\
5576 PROVE_TAC []) >> Rewr'
5577 >> REWRITE_TAC [UNION_OVER_INTER]
5578 >> REWRITE_TAC [INTER_CROSS, GSYM DIFF_INTER_COMPL]
5579 >> `?c1. c1 SUBSET subsets a /\ FINITE c1 /\ disjoint c1 /\
5580 (A DIFF A' = BIGUNION c1)` by METIS_TAC [semiring_def] >> art []
5581 >> `?c2. c2 SUBSET subsets b /\ FINITE c2 /\ disjoint c2 /\
5582 (B DIFF B' = BIGUNION c2)` by METIS_TAC [semiring_def] >> art []
5583 (* applying finite_disjoint_decomposition *)
5584 >> Know `FINITE c1 /\ disjoint c1` >- art []
5585 >> DISCH_THEN (MP_TAC o (MATCH_MP finite_disjoint_decomposition))
5586 >> DISCH_THEN (qx_choosel_then [`f1`, `n1`] STRIP_ASSUME_TAC)
5587 >> Know `FINITE c2 /\ disjoint c2` >- art []
5588 >> DISCH_THEN (MP_TAC o (MATCH_MP finite_disjoint_decomposition))
5589 >> DISCH_THEN (qx_choosel_then [`f2`, `n2`] STRIP_ASSUME_TAC)
5590 >> ASM_REWRITE_TAC [] (* rewrite c1 and c2 in the goal *)
5591 >> Know `BIGUNION (IMAGE f1 (count n1)) CROSS (B INTER B') =
5592 BIGUNION (IMAGE (\n. f1 n CROSS (B INTER B')) (count n1))`
5593 >- (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS,
5594 IN_COUNT] >> PROVE_TAC []) >> Rewr'
5595 >> Know `(A INTER A') CROSS BIGUNION (IMAGE f2 (count n2)) =
5596 BIGUNION (IMAGE (\n. (A INTER A') CROSS f2 n) (count n2))`
5597 >- (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS,
5598 IN_COUNT] >> PROVE_TAC []) >> Rewr'
5599 >> Know `BIGUNION (IMAGE f1 (count n1)) CROSS
5600 BIGUNION (IMAGE f2 (count n2)) =
5601 BIGUNION (IMAGE (\(i,j). f1 i CROSS f2 j) (count n1 CROSS count n2))`
5602 >- (RW_TAC std_ss [Once EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS, IN_COUNT] \\
5603 EQ_TAC >> rpt STRIP_TAC >| (* 3 subgoals *)
5604 [ (* goal 1 (of 3) *)
5605 rename1 `y < n1` >> rename1 `z < n2` \\
5606 Q.EXISTS_TAC `(y,z)` >> fs [],
5607 (* goal 2 (of 3) *)
5608 rename1 `FST z < n1` \\
5609 Q.EXISTS_TAC `FST z` >> art [] \\
5610 Cases_on `z` >> fs [],
5611 (* goal 3 (of 3) *)
5612 rename1 `SND z < n2` \\
5613 Q.EXISTS_TAC `SND z` >> art [] \\
5614 Cases_on `z` >> fs [] ]) >> Rewr'
5615 >> Q.EXISTS_TAC `(IMAGE (\n. f1 n CROSS (B INTER B')) (count n1)) UNION
5616 (IMAGE (\n. (A INTER A') CROSS f2 n) (count n2)) UNION
5617 (IMAGE (\(i,j). f1 i CROSS f2 j) (count n1 CROSS count n2))`
5618 >> rw [BIGUNION_UNION] (* 4 subgoals, first 3 are easy *)
5619 >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, GSPECIFICATION] \\
5620 Q.EXISTS_TAC `(f1 n,B INTER B')` >> rw []
5621 >- fs [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
5622 fs [semiring_def])
5623 >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, GSPECIFICATION] \\
5624 Q.EXISTS_TAC `(A INTER A',f2 n)` >> rw []
5625 >- fs [semiring_def] \\
5626 fs [SUBSET_DEF, IN_IMAGE, IN_COUNT])
5627 >- (RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, GSPECIFICATION] \\
5628 rename1 `y IN count n1 CROSS count n2` \\
5629 Cases_on `y` >> fs [IN_CROSS, IN_COUNT] \\
5630 Q.EXISTS_TAC `(f1 q,f2 r)` >> fs [SUBSET_DEF, IN_IMAGE, IN_COUNT] \\
5631 CONJ_TAC >| (* 2 subgoals *)
5632 [ (* goal 1 (of 2) *)
5633 FIRST_X_ASSUM MATCH_MP_TAC >> Q.EXISTS_TAC `q` >> art [],
5634 (* goal 2 (of 2) *)
5635 FIRST_X_ASSUM MATCH_MP_TAC >> Q.EXISTS_TAC `r` >> art [] ])
5636 >> RW_TAC std_ss [disjoint_def, IN_IMAGE, IN_COUNT, IN_CROSS, IN_UNION]
5637 (* 9 (3 * 3) subgoals *)
5638 >| [ (* goal 1 (of 9) *)
5639 MATCH_MP_TAC DISJOINT_CROSS_L \\
5640 FIRST_X_ASSUM MATCH_MP_TAC >> art [] >> METIS_TAC [],
5641 (* goal 2 (of 9) *)
5642 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] >> ASM_SET_TAC [],
5643 (* goal 3 (of 9) *)
5644 Cases_on `x` >> fs [] \\
5645 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] \\
5646 DISJ2_TAC \\
5647 Know `SND x NOTIN (B DIFF B')` >- ASM_SET_TAC [] \\
5648 Q.PAT_X_ASSUM `B DIFF B' = BIGUNION (IMAGE f2 (count n2))`
5649 (ONCE_REWRITE_TAC o wrap) \\
5650 rw [IN_BIGUNION_IMAGE, IN_COUNT] >> METIS_TAC [],
5651 (* goal 4 (of 9) *)
5652 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] >> ASM_SET_TAC [],
5653 (* goal 5 (of 9) *)
5654 MATCH_MP_TAC DISJOINT_CROSS_R \\
5655 FIRST_X_ASSUM MATCH_MP_TAC >> art [] >> METIS_TAC [],
5656 (* goal 6 (of 9) *)
5657 Cases_on `x` >> fs [] \\
5658 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] \\
5659 DISJ1_TAC \\
5660 Know `FST x NOTIN (A DIFF A')` >- ASM_SET_TAC [] \\
5661 Q.PAT_X_ASSUM `A DIFF A' = BIGUNION (IMAGE f1 (count n1))`
5662 (ONCE_REWRITE_TAC o wrap) \\
5663 rw [IN_BIGUNION_IMAGE, IN_COUNT] >> METIS_TAC [],
5664 (* goal 7 (of 9) *)
5665 Cases_on `x` >> fs [] \\
5666 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] \\
5667 DISJ2_TAC \\
5668 Suff `SND x IN B DIFF B'` >- ASM_SET_TAC [] \\
5669 Q.PAT_X_ASSUM `B DIFF B' = BIGUNION (IMAGE f2 (count n2))`
5670 (ONCE_REWRITE_TAC o wrap) \\
5671 rw [IN_BIGUNION_IMAGE, IN_COUNT] \\
5672 Q.EXISTS_TAC `r` >> art [],
5673 (* goal 8 (of 9) *)
5674 Cases_on `x` >> fs [] \\
5675 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] \\
5676 DISJ1_TAC \\
5677 Suff `FST x IN A DIFF A'` >- ASM_SET_TAC [] \\
5678 Q.PAT_X_ASSUM `A DIFF A' = BIGUNION (IMAGE f1 (count n1))`
5679 (ONCE_REWRITE_TAC o wrap) \\
5680 rw [IN_BIGUNION_IMAGE, IN_COUNT] \\
5681 Q.EXISTS_TAC `q` >> art [],
5682 (* goal 9 (of 9) *)
5683 Cases_on `x` >> Cases_on `x'` >> fs [] \\
5684 RW_TAC std_ss [DISJOINT_ALT, IN_CROSS] \\
5685 reverse (Cases_on `q = q'`)
5686 >- (DISJ1_TAC >> ASM_SET_TAC []) \\
5687 reverse (Cases_on `r = r'`)
5688 >- (DISJ2_TAC >> ASM_SET_TAC []) \\
5689 METIS_TAC [] ]
5690QED
5691
5692(* a sigma_algebra is also a semiring *)
5693Theorem SEMIRING_PROD_SETS' :
5694 !a b. sigma_algebra a /\ sigma_algebra b ==>
5695 semiring ((space a CROSS space b),prod_sets (subsets a) (subsets b))
5696Proof
5697 rpt STRIP_TAC
5698 >> MATCH_MP_TAC SEMIRING_PROD_SETS
5699 >> CONJ_TAC
5700 >> MATCH_MP_TAC ALGEBRA_IMP_SEMIRING
5701 >> MATCH_MP_TAC SIGMA_ALGEBRA_ALGEBRA >> art []
5702QED
5703
5704(***********************)
5705(* Further Results *)
5706(***********************)
5707
5708(* These do not require addition simplifier manipulations. It would
5709 probably be more appropriate to add these in the proper places above.
5710 - Jared Yeager *)
5711
5712Theorem SIGMA_ALGEBRA_SUBSET_SPACE:
5713 !a s. sigma_algebra a /\ s IN subsets a ==> s SUBSET space a
5714Proof
5715 rw[sigma_algebra_def,algebra_def,subset_class_def]
5716QED
5717
5718Theorem SIGMA_ALGEBRA_PROD_SIGMA_WEAK:
5719 !a b. sigma_algebra a /\ sigma_algebra b ==> sigma_algebra (a CROSS b)
5720Proof
5721 rw[] >> irule SIGMA_ALGEBRA_PROD_SIGMA >> fs[sigma_algebra_def,algebra_def]
5722QED
5723
5724Theorem IN_SPACE_PROD_SIGMA:
5725 !a b z. z IN space (a CROSS b) <=> FST z IN space a /\ SND z IN space b
5726Proof
5727 simp[prod_sigma_def,SPACE_SIGMA]
5728QED
5729
5730Theorem MEASURABLE_FST:
5731 !a b. sigma_algebra a /\ sigma_algebra b ==> FST IN measurable (a CROSS b) a
5732Proof
5733 rw[]
5734 >> simp[IN_MEASURABLE,SIGMA_ALGEBRA_PROD_SIGMA_WEAK,FUNSET,IN_SPACE_PROD_SIGMA]
5735 >> rw[]
5736 >> ‘PREIMAGE FST s INTER space (a CROSS b) = s CROSS (space b)’
5737 by (simp[EXTENSION,IN_SPACE_PROD_SIGMA] \\
5738 rw[] >> eq_tac >> rw[] \\
5739 dxrule_all_then mp_tac SIGMA_ALGEBRA_SUBSET_SPACE >> simp[SUBSET_DEF])
5740 >> pop_assum SUBST1_TAC >> simp[prod_sigma_def] >> irule IN_SIGMA
5741 >> simp[prod_sets_def]
5742 >> qexistsl_tac [‘s’,‘space b’] >> simp[SIGMA_ALGEBRA_SPACE]
5743QED
5744
5745Theorem MEASURABLE_SND:
5746 !a b. sigma_algebra a /\ sigma_algebra b ==> SND IN measurable (a CROSS b) b
5747Proof
5748 rw[]
5749 >> simp[IN_MEASURABLE,SIGMA_ALGEBRA_PROD_SIGMA_WEAK,FUNSET,IN_SPACE_PROD_SIGMA]
5750 >> rw[]
5751 >> ‘PREIMAGE SND s INTER space (a CROSS b) = (space a) CROSS s’
5752 by (simp[EXTENSION,IN_SPACE_PROD_SIGMA] \\
5753 rw[] >> eq_tac >> rw[] \\
5754 dxrule_all_then mp_tac SIGMA_ALGEBRA_SUBSET_SPACE >> simp[SUBSET_DEF])
5755 >> pop_assum SUBST1_TAC >> simp[prod_sigma_def] >> irule IN_SIGMA
5756 >> simp[prod_sets_def]
5757 >> qexistsl_tac [‘space a’,‘s’] >> simp[SIGMA_ALGEBRA_SPACE]
5758QED
5759
5760Theorem IN_MEASURABLE_EQ:
5761 !a b f g. f IN measurable a b /\ (!x. x IN space a ==> g x = f x) ==>
5762 g IN measurable a b
5763Proof
5764 rw[measurable_def] >- fs[FUNSET] >> first_x_assum $ dxrule_then mp_tac >>
5765 `PREIMAGE g s INTER space a = PREIMAGE f s INTER space a` suffices_by simp[] >>
5766 rw[EXTENSION] >> Cases_on `x IN space a` >> fs[]
5767QED
5768
5769Theorem IN_MEASURABLE_CONG:
5770 !a b c d f g. a = c /\ b = d /\ (!x. x IN space c ==> f x = g x) ==>
5771 (f IN measurable a b <=> g IN measurable c d)
5772Proof
5773 rw[] >> eq_tac >> rw[]
5774 >> dxrule_at_then (Pos $ el 1) irule IN_MEASURABLE_EQ >> simp[]
5775QED
5776
5777(* for use with irule, often not super useful in prectice due to need to address 'b *)
5778Theorem IN_MEASURABLE_COMP:
5779 !f g h a b c. f IN measurable a b /\ g IN measurable b c /\
5780 (!x. x IN space a ==> h x = g (f x)) ==>
5781 h IN measurable a c
5782Proof
5783 rw[] >> irule IN_MEASURABLE_EQ
5784 >> qexists_tac `g o f` >> simp[MEASURABLE_COMP,SF SFY_ss]
5785QED
5786
5787(* NOTE: more antecendents are added due to changes in ‘measurable’ *)
5788Theorem IN_MEASURABLE_PROD_SIGMA:
5789 !a bx by fx fy f.
5790 sigma_algebra a /\
5791 subset_class (space bx) (subsets bx) /\
5792 subset_class (space by) (subsets by) /\
5793 fx IN measurable a bx /\ fy IN measurable a by /\
5794 (!z. z IN space a ==> f z = (fx z,fy z)) ==> f IN measurable a (bx CROSS by)
5795Proof
5796 rw[] >> irule IN_MEASURABLE_EQ >> qexists_tac `λz. (fx z,fy z)` >> simp[] >>
5797 irule MEASURABLE_PROD_SIGMA' >> simp[o_DEF,ETA_AX]
5798QED
5799
5800(* NOTE: This version is inspired by HVG's "measurable_Pair". *)
5801Theorem MEASURABLE_PAIR :
5802 !a b1 b2 X Y.
5803 sigma_algebra a /\ sigma_algebra b1 /\ sigma_algebra b2 /\
5804 X IN measurable a b1 /\ Y IN measurable a b2 ==>
5805 (\x. (X x,Y x)) IN measurable a (b1 CROSS b2)
5806Proof
5807 rpt STRIP_TAC
5808 >> MATCH_MP_TAC IN_MEASURABLE_PROD_SIGMA
5809 >> qexistsl_tac [‘X’, ‘Y’] >> simp []
5810 >> fs [sigma_algebra_def, algebra_def]
5811QED
5812
5813Theorem algebra_finite_subsets_imp_sigma_algebra :
5814 !a. algebra a /\ FINITE (subsets a) ==> sigma_algebra a
5815Proof
5816 rw [sigma_algebra_def]
5817 >> ‘FINITE c’ by PROVE_TAC [SUBSET_FINITE_I]
5818 >> MP_TAC (Q.ISPEC ‘c :('a set) set’ finite_decomposition_simple) >> rw []
5819 >> MATCH_MP_TAC ALGEBRA_FINITE_UNION >> art []
5820QED
5821
5822Theorem algebra_finite_space_imp_sigma_algebra :
5823 !a. algebra a /\ FINITE (space a) ==> sigma_algebra a
5824Proof
5825 rw [sigma_algebra_def]
5826 >> Know ‘subsets a SUBSET (POW (space a))’
5827 >- (rw [Once SUBSET_DEF, IN_POW] \\
5828 fs [algebra_def, subset_class_def])
5829 >> DISCH_TAC
5830 >> ‘FINITE (POW (space a))’ by PROVE_TAC [FINITE_POW]
5831 >> ‘c SUBSET (POW (space a))’ by PROVE_TAC [SUBSET_TRANS]
5832 >> ‘FINITE c’ by PROVE_TAC [SUBSET_FINITE_I]
5833 >> MP_TAC (Q.ISPEC ‘c :('a set) set’ finite_decomposition_simple) >> rw []
5834 >> MATCH_MP_TAC ALGEBRA_FINITE_UNION >> art []
5835QED
5836
5837(* NOTE: The trivial algebras below are also sigma-algebra by above lemmas *)
5838Theorem trivial_algebra_of_space :
5839 !sp. algebra (sp, {{}; sp})
5840Proof
5841 rw [algebra_def, subset_class_def]
5842 >> SET_TAC []
5843QED
5844
5845Theorem trivial_algebra_of_two_sets :
5846 !sp s. s SUBSET sp ==> algebra (sp, {{}; s; sp DIFF s; sp})
5847Proof
5848 rw [algebra_def, subset_class_def]
5849 >> ASM_SET_TAC []
5850QED
5851
5852(* NOTE: This is head (h) and tail (t) of one-time coin tossing *)
5853Theorem trivial_algebra_of_two_points :
5854 !h t. algebra ({h; t}, {{}; {h}; {t}; {h; t}})
5855Proof
5856 rw [algebra_def, subset_class_def]
5857 >> ASM_SET_TAC []
5858QED
5859
5860(* ------------------------------------------------------------------------- *)
5861(* exhausting_sequence in family of sets *)
5862(* ------------------------------------------------------------------------- *)
5863
5864(* an "exhausting" sequence in a system of sets, moved from martingaleTheory *)
5865Definition exhausting_sequence_def :
5866 exhausting_sequence (a :'a algebra) (f :num -> 'a -> bool) =
5867 (f IN (UNIV -> subsets a) /\ (!n. f n SUBSET f (SUC n)) /\
5868 BIGUNION (IMAGE f UNIV) = space a)
5869End
5870
5871Theorem exhausting_sequence_alt :
5872 !a f. exhausting_sequence a f <=>
5873 f IN (univ(:num) -> subsets a) /\ (!m n. m <= n ==> f m SUBSET f n) /\
5874 BIGUNION (IMAGE f univ(:num)) = space a
5875Proof
5876 RW_TAC std_ss [exhausting_sequence_def]
5877 >> reverse EQ_TAC >- RW_TAC std_ss []
5878 >> STRIP_TAC >> art []
5879 >> GEN_TAC >> Induct_on ‘n’ >- RW_TAC arith_ss [SUBSET_REFL]
5880 >> DISCH_TAC
5881 >> ‘(m = SUC n) \/ m <= n’ by RW_TAC arith_ss [] >- rw [SUBSET_REFL]
5882 >> MATCH_MP_TAC SUBSET_TRANS
5883 >> Q.EXISTS_TAC ‘f n’ >> art []
5884 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
5885QED
5886
5887Definition has_exhausting_sequence :
5888 has_exhausting_sequence a = ?f. exhausting_sequence a f
5889End
5890
5891(* This was part of sigma_finite_def, but no requirement on the measure of each
5892 (f n). The definition is useful because ‘space a IN subsets a’ does not hold
5893 in general for semiring.
5894
5895 |- !a. has_exhausting_sequence a <=>
5896 ?f. f IN (univ(:num) -> subsets a) /\ (!n. f n SUBSET f (SUC n)) /\
5897 BIGUNION (IMAGE f univ(:num)) = space a
5898 *)
5899Theorem has_exhausting_sequence_def =
5900 REWRITE_RULE [exhausting_sequence_def] has_exhausting_sequence
5901
5902(* |- !a. has_exhausting_sequence a <=>
5903 ?f. f IN (univ(:num) -> subsets a) /\
5904 (!m n. m <= n ==> f m SUBSET f n) /\
5905 BIGUNION (IMAGE f univ(:num)) = space a
5906 *)
5907Theorem has_exhausting_sequence_alt =
5908 REWRITE_RULE [exhausting_sequence_alt] has_exhausting_sequence
5909
5910(* ------------------------------------------------------------------------- *)
5911(* Borel sigma-algebra generated from any topology *)
5912(* ------------------------------------------------------------------------- *)
5913
5914Definition general_borel_def :
5915 general_borel top = sigma (topspace top) (open_in top)
5916End
5917
5918Theorem sigma_algebra_general_borel[simp] :
5919 sigma_algebra (general_borel top)
5920Proof
5921 rw [general_borel_def]
5922 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA
5923 >> rw [subset_class_def, topspace, IN_APP]
5924 >> rw [SUBSET_DEF]
5925 >> rename1 ‘y IN s’
5926 >> Q.EXISTS_TAC ‘s’ >> art []
5927QED
5928
5929Theorem space_general_borel :
5930 !top. space (general_borel top) = topspace top
5931Proof
5932 REWRITE_TAC [general_borel_def, SPACE_SIGMA]
5933QED
5934
5935Theorem space_general_borel_mtop :
5936 !E. space (general_borel (mtop E)) = mspace E
5937Proof
5938 REWRITE_TAC [space_general_borel, TOPSPACE_MTOPOLOGY]
5939QED
5940
5941Theorem open_in_general_borel :
5942 !top s. open_in top s ==> s IN subsets (general_borel top)
5943Proof
5944 rw [general_borel_def]
5945 >> MATCH_MP_TAC IN_SIGMA
5946 >> rw [IN_APP]
5947QED
5948
5949Theorem closed_in_general_borel :
5950 !top s. closed_in top s ==> s IN subsets (general_borel top)
5951Proof
5952 rw [closed_in]
5953 >> qabbrev_tac ‘a = general_borel top’
5954 >> ‘topspace top = space a’ by PROVE_TAC [space_general_borel] >> fs []
5955 >> qabbrev_tac ‘t = space a DIFF s’
5956 >> ‘s = space a DIFF t’ by ASM_SET_TAC [] >> POP_ORW
5957 >> MATCH_MP_TAC SIGMA_ALGEBRA_COMPL
5958 >> rw [Abbr ‘a’]
5959 >> MATCH_MP_TAC open_in_general_borel >> art []
5960QED
5961
5962(* Borel space generated from metric spaces always has exhausting sequences *)
5963Theorem exhausting_sequence_general_borel :
5964 !E c. exhausting_sequence (general_borel (mtop E)) (\n. mcball E (c,&n))
5965Proof
5966 rw [exhausting_sequence_def, IN_FUNSET]
5967 >| [ (* goal 1 (of 3) *)
5968 qmatch_abbrev_tac ‘s IN subsets _’ \\
5969 MATCH_MP_TAC closed_in_general_borel \\
5970 rw [Abbr ‘s’, CLOSED_IN_MCBALL],
5971 (* goal 2 (of 3) *)
5972 MATCH_MP_TAC MCBALL_SUBSET_CONCENTRIC >> rw [],
5973 (* goal 3 (of 3) *)
5974 rw [Once EXTENSION, space_general_borel_mtop] \\
5975 EQ_TAC >> rw [] >> fs [IN_MCBALL] \\
5976 qabbrev_tac ‘d = dist E (x,c)’ \\
5977 MP_TAC (Q.SPEC ‘1’ REAL_ARCH) >> simp [] \\
5978 DISCH_THEN (STRIP_ASSUME_TAC o Q.SPEC ‘d’) \\
5979 Q.EXISTS_TAC ‘mcball E (c,&n)’ \\
5980 reverse (rw [IN_MCBALL, MSPACE, Abbr ‘d’])
5981 >- (Q.EXISTS_TAC ‘n’ >> rw []) \\
5982 rw [Once MDIST_SYM] \\
5983 MATCH_MP_TAC REAL_LT_IMP_LE >> art [] ]
5984QED
5985
5986(* NOTE: In HOL4's current setting, “mspace E = UNIV” and therefore the
5987 antecedents ‘mspace E <> {}’ always holds.
5988 *)
5989Theorem has_exhausting_sequence_general_borel :
5990 !E. has_exhausting_sequence (general_borel (mtop E))
5991Proof
5992 rw [has_exhausting_sequence, GSYM MEMBER_NOT_EMPTY]
5993 >> Q.EXISTS_TAC ‘\n. mcball E (x,&n)’
5994 >> rw [exhausting_sequence_general_borel]
5995QED
5996
5997(* NOTE: This is a companion of SIGMA_ALGEBRA_COUNTABLE_UNION *)
5998Theorem SIGMA_ALGEBRA_COUNTABLE_INTER :
5999 !a c. sigma_algebra a /\ countable c /\ c <> {} /\ c SUBSET subsets a ==>
6000 BIGINTER c IN subsets a
6001Proof
6002 rw [COUNTABLE_ENUM]
6003 >> irule (cj 4 SIGMA_ALGEBRA_FN_BIGINTER)
6004 >> fs [SUBSET_DEF, IN_FUNSET]
6005 >> Q.X_GEN_TAC ‘n’
6006 >> FIRST_X_ASSUM MATCH_MP_TAC
6007 >> Q.EXISTS_TAC ‘n’ >> art []
6008QED
6009
6010Theorem SIGMA_ALGEBRA_BIGINTER :
6011 !a f. sigma_algebra a /\ (!n. f n IN subsets a) ==>
6012 BIGINTER (IMAGE f univ(:num)) IN subsets a
6013Proof
6014 rpt STRIP_TAC
6015 >> MATCH_MP_TAC SIGMA_ALGEBRA_COUNTABLE_INTER
6016 >> rw [image_countable, SUBSET_DEF] >> art []
6017QED
6018
6019(* NOTE: The following overloads as variants of “countable” and “FINITE” are
6020 perhaps what one usually thought they were, when actually mentioning them.
6021 *)
6022Overload countably_infinite[local] = “\s. countable s /\ INFINITE s”
6023Overload finitely_many[local] = “\s. FINITE s /\ s <> {}”
6024
6025Theorem SIGMA_ALGEBRA_COUNTABLE_INTERSECTION_OF :
6026 !a P. sigma_algebra a /\ P SUBSET subsets a ==>
6027 countably_infinite INTERSECTION_OF P SUBSET subsets a
6028Proof
6029 rw [SUBSET_DEF, INTERSECTION_OF, COUNTABLE_ENUM]
6030 >- fs [FINITE_EMPTY]
6031 >> irule (cj 4 SIGMA_ALGEBRA_FN_BIGINTER)
6032 >> simp [IN_FUNSET]
6033 >> Q.X_GEN_TAC ‘n’
6034 >> FIRST_X_ASSUM MATCH_MP_TAC
6035 >> rw [IN_APP]
6036 >> FIRST_X_ASSUM MATCH_MP_TAC
6037 >> Q.EXISTS_TAC ‘n’ >> art []
6038QED
6039
6040Theorem SIGMA_ALGEBRA_COUNTABLE_UNION_OF :
6041 !a P. sigma_algebra a /\ P SUBSET subsets a ==>
6042 COUNTABLE UNION_OF P SUBSET subsets a
6043Proof
6044 rw [SUBSET_DEF, UNION_OF, COUNTABLE_ENUM]
6045 >- simp [SIGMA_ALGEBRA_EMPTY]
6046 >> fs [SIGMA_ALGEBRA_ALT, IN_FUNSET]
6047 >> LAST_X_ASSUM MATCH_MP_TAC
6048 >> Q.X_GEN_TAC ‘n’
6049 >> FIRST_X_ASSUM MATCH_MP_TAC
6050 >> rw [IN_APP]
6051 >> FIRST_X_ASSUM MATCH_MP_TAC
6052 >> Q.EXISTS_TAC ‘n’ >> art []
6053QED
6054
6055Theorem SIGMA_ALGEBRA_FINITE_INTERSECTION_OF :
6056 !a P. sigma_algebra a /\ P SUBSET subsets a ==>
6057 finitely_many INTERSECTION_OF P SUBSET subsets a
6058Proof
6059 rw [SUBSET_DEF, INTERSECTION_OF]
6060 >> rename1 ‘s <> {}’
6061 >> MATCH_MP_TAC SIGMA_ALGEBRA_FINITE_INTER'
6062 >> rw [SUBSET_DEF]
6063 >> FIRST_X_ASSUM MATCH_MP_TAC
6064 >> rw [IN_APP]
6065QED
6066
6067Theorem SIGMA_ALGEBRA_FINITE_UNION_OF :
6068 !a P. sigma_algebra a /\ P SUBSET subsets a ==>
6069 FINITE UNION_OF P SUBSET subsets a
6070Proof
6071 rw [SUBSET_DEF, UNION_OF]
6072 >> MATCH_MP_TAC SIGMA_ALGEBRA_FINITE_UNION
6073 >> rw [SUBSET_DEF]
6074 >> FIRST_X_ASSUM MATCH_MP_TAC
6075 >> rw [IN_APP]
6076QED
6077
6078(* ------------------------------------------------------------------------- *)
6079(* Pi-Lambda Theorem *)
6080(* ------------------------------------------------------------------------- *)
6081
6082(*
6083These are the results for algebras from my own accumulated library
6084that I believe stand on their own as something useful for future users.
6085In this case, mostly just the Pi-Lambda Theorem.
6086- Jared Yeager
6087*)
6088
6089(* This weaker version of SIGMA_PROPERTY has helped me when going forward (drule)
6090 in proofs before *)
6091Theorem SIGMA_PROPERTY_WEAK:
6092 ∀sp sts P. sts ⊆ P ∧ sigma_algebra (sp,P) ⇒ subsets (sigma sp sts) ⊆ P
6093Proof
6094 rw[sigma_def] >> simp[Once SUBSET_DEF]
6095QED
6096
6097(* There are further potential results around pi-systems for probability theory,
6098 so perhaps it is worth it to have the definition.
6099 It also makes the name "PI_LAMBDA_THM" make more sense. *)
6100Definition pi_system_def:
6101 pi_system p ⇔ subset_class (space p) (subsets p) ∧ (subsets p ≠ ∅) ∧
6102 ∀s t. s ∈ subsets p ∧ t ∈ subsets p ⇒ s ∩ t ∈ subsets p
6103End
6104
6105(* Effectively a reskinned DYNKIN_LEMMA *)
6106Theorem SIGMA_PI_LAMBDA:
6107 ∀a. sigma_algebra a ⇔ pi_system a ∧ dynkin_system a
6108Proof
6109 rw[pi_system_def,dynkin_system_def,GSYM DYNKIN_LEMMA] >> eq_tac >> rw[] >>
6110 simp[GSYM MEMBER_NOT_EMPTY] >> qexists_tac `space a` >> simp[]
6111QED
6112
6113Theorem PI_LAMBDA_THM:
6114 ∀sp sts P. pi_system (sp,sts) ∧ sts ⊆ P ∧ dynkin_system (sp,P) ⇒ subsets (sigma sp sts) ⊆ P
6115Proof
6116 rw[pi_system_def] >> dxrule_all_then SUBST1_TAC $ GSYM DYNKIN_THM >>
6117 dxrule_then (qspec_then `sp` mp_tac) DYNKIN_MONOTONE >> dxrule DYNKIN_STABLE >> simp[]
6118QED
6119
6120(* ------------------------------------------------------------------------- *)
6121(* More Measurability Results *)
6122(* ------------------------------------------------------------------------- *)
6123
6124(*
6125These are the results from my own accumulated library for general measurable functions
6126that I believe stand on their own as something useful for future users.
6127- Jared Yeager
6128*)
6129
6130(* We have constant functions are measurable for borel/Borel later,
6131 but not for generic spaces. *)
6132Theorem MEASURABLE_CONST:
6133 ∀a b c. sigma_algebra a ∧ c ∈ space b ⇒ (λx. c) ∈ measurable a b
6134Proof
6135 rw[measurable_def,FUNSET] >> Cases_on ‘c ∈ s’ >>
6136 simp[PREIMAGE_def,SIGMA_ALGEBRA_SPACE,SIGMA_ALGEBRA_EMPTY]
6137QED
6138
6139Theorem IN_MEASURABLE_CONST:
6140 ∀a b c f. sigma_algebra a ∧ c ∈ space b ∧ (∀x. x ∈ space a ⇒ f x = c) ⇒ f ∈ measurable a b
6141Proof
6142 rw[] >> irule IN_MEASURABLE_EQ >> irule_at Any MEASURABLE_CONST >>
6143 simp[] >> last_x_assum $ irule_at Any >> simp[]
6144QED
6145
6146(* Helper lemmas for the next result *)
6147
6148Theorem SUBSETS_PROD_SIGMA:
6149 ∀a b. subsets (a × b) =
6150 BIGINTER {s | prod_sets (subsets a) (subsets b) ⊆ s ∧ sigma_algebra (space a × space b,s)}
6151Proof
6152 simp[prod_sigma_def,sigma_def]
6153QED
6154
6155Theorem SIGMA_ALGEBRA_SUBSET_CLASS:
6156 ∀a. sigma_algebra a ⇒ subset_class (space a) (subsets a)
6157Proof
6158 simp[SIGMA_ALGEBRA]
6159QED
6160
6161Theorem PROD_SIGMA_X_SLICE:
6162 ∀a b s y. sigma_algebra a ∧ subset_class (space b) (subsets b) ∧
6163 s ∈ subsets (a × b) ⇒ {x | (x,y) ∈ s} ∈ subsets a
6164Proof
6165 rw[] >> `sigma_algebra (a × b)` by (irule SIGMA_ALGEBRA_PROD_SIGMA >> simp[SIGMA_ALGEBRA_SUBSET_CLASS]) >>
6166 REVERSE $ Cases_on `y ∈ space b`
6167 >- (dxrule_all_then mp_tac SIGMA_ALGEBRA_SUBSET_SPACE >> simp[SUBSET_DEF,SPACE_PROD_SIGMA] >> strip_tac >>
6168 `{x | (x,y) ∈ s} = ∅` suffices_by simp[SIGMA_ALGEBRA_EMPTY] >> simp[EXTENSION] >> qx_gen_tac `x` >>
6169 CCONTR_TAC >> fs[] >> first_x_assum $ dxrule_then mp_tac >> simp[]) >>
6170 fs[SUBSETS_PROD_SIGMA] >>
6171 first_x_assum $ qspec_then `subsets (a × b) ∩ {t | {x | (x,y) ∈ t} ∈ subsets a}` $
6172 irule o cj 2 o SIMP_RULE (srw_ss ()) [] >>
6173 simp[SIGMA_ALGEBRA_ALT_SPACE] >> rpt CONJ_TAC
6174 >- (dxrule_then mp_tac SIGMA_ALGEBRA_SUBSET_CLASS >> simp[subset_class_def,SPACE_PROD_SIGMA])
6175 >- (dxrule_then mp_tac SIGMA_ALGEBRA_SPACE >> simp[SPACE_PROD_SIGMA])
6176 >- (simp[SIGMA_ALGEBRA_SPACE])
6177 >- (NTAC 2 strip_tac >> NTAC 2 $ dxrule_all_then mp_tac SIGMA_ALGEBRA_COMPL >>
6178 simp[SPACE_PROD_SIGMA,DIFF_DEF])
6179 >- (simp[FUNSET_INTER] >> NTAC 2 strip_tac >> simp[SIGMA_ALGEBRA_ENUM] >>
6180 qspecl_then [`a`,`λn. {x | (x,y) ∈ f n}`] mp_tac SIGMA_ALGEBRA_ENUM >> fs[FUNSET] >>
6181 qmatch_abbrev_tac `s ∈ _ ⇒ t ∈ _` >> `s = t` suffices_by simp[] >> UNABBREV_ALL_TAC >>
6182 simp[EXTENSION,IN_BIGUNION_IMAGE] >> qx_gen_tac `x` >> metis_tac[])
6183 >- (simp[prod_sets_def,SUBSET_DEF] >> rw[] >> rename [`s × t`] >> Cases_on `y ∈ t`
6184 >- (`{x | (x,y) ∈ s × t} = s` suffices_by simp[] >> simp[EXTENSION])
6185 >- (`{x | (x,y) ∈ s × t} = ∅` suffices_by simp[SIGMA_ALGEBRA_EMPTY] >> simp[EXTENSION]))
6186 >- (simp[prod_sigma_def,SIGMA_SUBSET_SUBSETS])
6187QED
6188
6189Theorem PROD_SIGMA_Y_SLICE:
6190 ∀a b s x. subset_class (space a) (subsets a) ∧ sigma_algebra b ∧
6191 s ∈ subsets (a × b) ⇒ {y | (x,y) ∈ s} ∈ subsets b
6192Proof
6193 rw[] >> `sigma_algebra (a × b)` by (irule SIGMA_ALGEBRA_PROD_SIGMA >> simp[SIGMA_ALGEBRA_SUBSET_CLASS]) >>
6194 REVERSE $ Cases_on `x ∈ space a`
6195 >- (dxrule_all_then mp_tac SIGMA_ALGEBRA_SUBSET_SPACE >> simp[SUBSET_DEF,SPACE_PROD_SIGMA] >> strip_tac >>
6196 `{y | (x,y) ∈ s} = ∅` suffices_by simp[SIGMA_ALGEBRA_EMPTY] >> simp[EXTENSION] >> qx_gen_tac `y` >>
6197 CCONTR_TAC >> fs[] >> first_x_assum $ dxrule_then mp_tac >> simp[]) >>
6198 fs[SUBSETS_PROD_SIGMA] >>
6199 first_x_assum $ qspec_then `subsets (a × b) ∩ {t | {y | (x,y) ∈ t} ∈ subsets b}` $
6200 irule o cj 2 o SIMP_RULE (srw_ss ()) [] >>
6201 simp[SIGMA_ALGEBRA_ALT_SPACE] >> rpt CONJ_TAC
6202 >- (dxrule_then mp_tac SIGMA_ALGEBRA_SUBSET_CLASS >> simp[subset_class_def,SPACE_PROD_SIGMA])
6203 >- (dxrule_then mp_tac SIGMA_ALGEBRA_SPACE >> simp[SPACE_PROD_SIGMA])
6204 >- (simp[SIGMA_ALGEBRA_SPACE])
6205 >- (NTAC 2 strip_tac >> NTAC 2 $ dxrule_all_then mp_tac SIGMA_ALGEBRA_COMPL >>
6206 simp[SPACE_PROD_SIGMA,DIFF_DEF])
6207 >- (simp[FUNSET_INTER] >> NTAC 2 strip_tac >> simp[SIGMA_ALGEBRA_ENUM] >>
6208 qspecl_then [`b`,`λn. {y | (x,y) ∈ f n}`] mp_tac SIGMA_ALGEBRA_ENUM >> fs[FUNSET] >>
6209 qmatch_abbrev_tac `s ∈ _ ⇒ t ∈ _` >> `s = t` suffices_by simp[] >> UNABBREV_ALL_TAC >>
6210 simp[EXTENSION,IN_BIGUNION_IMAGE] >> qx_gen_tac `y` >> metis_tac[])
6211 >- (simp[prod_sets_def,SUBSET_DEF] >> rw[] >> rename [`s × t`] >> Cases_on `x ∈ s`
6212 >- (`{y | (x,y) ∈ s × t} = t` suffices_by simp[] >> simp[EXTENSION])
6213 >- (`{y | (x,y) ∈ s × t} = ∅` suffices_by simp[SIGMA_ALGEBRA_EMPTY] >> simp[EXTENSION]))
6214 >- (simp[prod_sigma_def,SIGMA_SUBSET_SUBSETS])
6215QED
6216
6217(* IN_MEASURABLE_PROD_SIGMA tells us that pairing measurable functions gives a measurable
6218 function.
6219 This gives us that fixing a variable in a measurable function gives a measurable function.
6220 As before, there is a IN_MEASURABLE_BOREL_FROM_PROD_SIGMA later, but this is more general.
6221*)
6222Theorem IN_MEASURABLE_FROM_PROD_SIGMA:
6223 ∀a b c f. sigma_algebra a ∧ sigma_algebra b ∧ sigma_algebra c ∧ f ∈ measurable (a × b) c ⇒
6224 (∀y. y ∈ space b ⇒ (λx. f (x,y)) ∈ measurable a c) ∧
6225 (∀x. x ∈ space a ⇒ (λy. f (x,y)) ∈ measurable b c)
6226Proof
6227 rw[measurable_def,FUNSET,FORALL_PROD,IN_SPACE_PROD_SIGMA] >>
6228 first_x_assum $ dxrule_then assume_tac
6229 >| [dxrule_at_then Any (qspec_then ‘y’ mp_tac) PROD_SIGMA_X_SLICE,
6230 dxrule_at_then Any (qspec_then ‘x’ mp_tac) PROD_SIGMA_Y_SLICE] >>
6231 simp[SIGMA_ALGEBRA_SUBSET_CLASS] >>
6232 qmatch_goalsub_abbrev_tac ‘t ∈ _ ⇒ r ∈ _’ >> ‘t = r’ suffices_by simp[] >>
6233 simp[Abbr ‘t’,Abbr ‘r’,EXTENSION,IN_SPACE_PROD_SIGMA]
6234QED
6235
6236(* References:
6237
6238 [1] Hurd, J.: Formal verification of probabilistic algorithms. University of
6239 Cambridge (2001).
6240 [2] Coble, A.R.: Anonymity, information, and machine-assisted proof.
6241 University of Cambridge (2010).
6242 [3] Mhamdi, T., Hasan, O., Tahar, S.: Formalization of Measure Theory and
6243 Lebesgue Integration for Probabilistic Analysis in HOL. ACM Trans.
6244 Embedded Comput. Syst. 12, 1--23 (2013).
6245 [4] Wikipedia: https://en.wikipedia.org/wiki/Ring_of_sets
6246 [5] Wikipedia: https://en.wikipedia.org/wiki/Eugene_Dynkin
6247 [6] Wikipedia: https://en.wikipedia.org/wiki/Dynkin_system
6248 [7] Schilling, R.L.: Measures, Integrals and Martingales (Second Edition).
6249 Cambridge University Press (2017).
6250 [8] Chung, K.L.: A Course in Probability Theory, Third Edition.
6251 Academic Press (2001).
6252 [9] Shiryaev, A.N.: Probability-1. Springer-Verlag New York (2016).
6253
6254 *)