martingaleScript.sml

1(* ------------------------------------------------------------------------- *)
2(* The Theory of Martingales for Sigma-Finite Measure Spaces                 *)
3(* (Lebesgue Integration Extras, Product Measure and Fubini-Tonelli Theorem) *)
4(* ------------------------------------------------------------------------- *)
5
6Theory martingale
7Ancestors
8  pair relation prim_rec arithmetic pred_set combin fcp real seq lim
9  transc iterate real_sigma topology real_topology metric nets derivative
10  extreal_base extreal sigma_algebra measure real_borel borel lebesgue
11Libs
12  hurdUtils jrhUtils tautLib realLib
13
14val _ = hide "S";   (* combinTheory *)
15val _ = hide "top"; (* posetTheory *)
16val _ = hide "nf";  (* relationTheory *)
17
18fun METIS ths tm = prove(tm, METIS_TAC ths);
19
20val _ = intLib.deprecate_int ();
21val _ = ratLib.deprecate_rat ();
22
23(* Some proofs here are large with too many assumptions *)
24val _ = set_trace "Goalstack.print_goal_at_top" 0;
25
26(* "The theory of martingales as we know it now goes back to Doob and most of
27    the material of this and the following chapter can be found in his seminal
28    monograph [2] from 1953.
29
30    We want to understand martingales as an analysis tool which will be useful
31    for the study of L^p- and almost everywhere convergence and, in particular,
32    for the further development of measure and integration theory. Our presentation
33    differs somewhat from the standard way to introduce martingales - conditional
34    expectations will be defined later in [1, Chapter 22] - but the results and
35    their proofs are pretty much the usual ones."
36
37  -- Rene L. Schilling, "Measures, Integrals and Martingales" [1]
38
39   "Martingale theory illustrates the history of mathematical probability: the
40    basic definitions are inspired by crude notions of gambling, but the theory
41    has become a sophisticated tool of modern abstract mathematics, drawing from
42    and contributing to other field."
43
44  -- J. L. Doob, "What is a Martingale?" [3] *)
45
46(* ------------------------------------------------------------------------- *)
47(*  Martingale definitions ([1, Chapter 23])                                 *)
48(* ------------------------------------------------------------------------- *)
49
50Definition sub_sigma_algebra_def :
51   sub_sigma_algebra a b =
52      (sigma_algebra a /\ sigma_algebra b /\ (space a = space b) /\
53       (subsets a) SUBSET (subsets b))
54End
55
56(* the set of all filtrations of A *)
57Definition filtration_def :
58   filtration A (a :num -> 'a algebra) <=>
59      (!n. sub_sigma_algebra (a n) A) /\
60      (!i j. i <= j ==> subsets (a i) SUBSET subsets (a j))
61End
62
63(* NOTE: This is usually denoted by (sp,sts,a,m) in textbooks *)
64Definition filtered_measure_space_def :
65   filtered_measure_space m a =
66      (measure_space m /\ filtration (m_space m,measurable_sets m) a)
67End
68
69Definition sigma_finite_filtered_measure_space_def :
70   sigma_finite_filtered_measure_space m a =
71      (filtered_measure_space m a /\ sigma_finite (m_space m,subsets (a 0),measure m))
72End
73
74Definition martingale_def :
75   martingale m a u =
76     (sigma_finite_filtered_measure_space m a /\ (!n. integrable m (u n)) /\
77      !n s. s IN (subsets (a n)) ==>
78           (integral m (\x. u (SUC n) x * indicator_fn s x) =
79            integral m (\x. u n x * indicator_fn s x)))
80End
81
82Definition super_martingale_def :
83   super_martingale m a u =
84     (sigma_finite_filtered_measure_space m a /\ (!n. integrable m (u n)) /\
85      !n s. s IN (subsets (a n)) ==>
86           (integral m (\x. u (SUC n) x * indicator_fn s x) <=
87            integral m (\x. u n x * indicator_fn s x)))
88End
89
90Definition sub_martingale_def :
91   sub_martingale m a u =
92     (sigma_finite_filtered_measure_space m a /\ (!n. integrable m (u n)) /\
93      !n s. s IN (subsets (a n)) ==>
94           (integral m (\x. u n x * indicator_fn s x) <=
95            integral m (\x. u (SUC n) x * indicator_fn s x)))
96End
97
98(*** integral and integrable Theorems with fewer preconditions ***)
99
100Theorem integrable_measurable:
101    !m f. integrable m f ==> f IN Borel_measurable (measurable_space m)
102Proof
103    simp[integrable_def]
104QED
105
106Theorem pos_fn_integrable_AE_finite:
107    !m f. measure_space m /\ (!x. x IN m_space m ==> 0 <= f x) /\
108          f IN Borel_measurable (measurable_space m) /\
109          pos_fn_integral m f <> PosInf ==>
110          AE x::m. f x = (Normal o real o f) x
111Proof
112    rw[] >> rw[AE_ALT] >> qexists_tac ‘{x | x IN m_space m /\ f x = PosInf}’ >>
113    simp[pos_fn_integral_infty_null] >> rw[SUBSET_DEF] >>
114    Cases_on ‘f x’ >> fs[normal_real] >> rw[] >>
115    last_x_assum (dxrule_then assume_tac) >> rfs[]
116QED
117
118Theorem integrable_AE_finite:
119    !m f. measure_space m /\ integrable m f ==>
120          AE x::m. f x = (Normal o real o f) x
121Proof
122    rw[] >> fs[integrable_def]
123 >> map_every (fn tm => qspecl_then [‘m’,tm] assume_tac
124                                    pos_fn_integrable_AE_finite) [‘f^+’,‘f^-’]
125 >> rfs[FN_PLUS_POS,FN_MINUS_POS,IN_MEASURABLE_BOREL_FN_PLUS,
126        IN_MEASURABLE_BOREL_FN_MINUS]
127 >> fs[AE_ALT] >> qexists_tac ‘N UNION N'’
128 >> drule_then assume_tac NULL_SET_UNION
129 >> rfs[IN_APP] >> pop_assum kall_tac
130 >> fs[SUBSET_DEF] >> rw[]
131 >> NTAC 2 (last_x_assum (drule_then assume_tac)) >> Cases_on ‘f x’ >> rw[]
132 >> DISJ2_TAC >> first_x_assum irule >> simp[fn_minus_def,extreal_ainv_def]
133QED
134
135Theorem integrable_eq_AE_alt:
136    !m f g. measure_space m /\ integrable m f /\ (AE x::m. f x = g x) /\
137        g IN Borel_measurable (measurable_space m) ==> integrable m g
138Proof
139    simp[integrable_def] >> NTAC 4 strip_tac >>
140    ‘pos_fn_integral m f^+ = pos_fn_integral m g^+ /\
141        pos_fn_integral m f^- = pos_fn_integral m g^-’ suffices_by (rw[] >> fs[]) >>
142    rw[] >> irule pos_fn_integral_cong_AE >> simp[FN_PLUS_POS,FN_MINUS_POS] >>
143    fs[AE_ALT,SUBSET_DEF] >> qexists_tac ‘N’ >> rw[] >>
144    last_x_assum (dxrule_then assume_tac) >> pop_assum irule >>
145    pop_assum mp_tac >> CONV_TAC CONTRAPOS_CONV >>
146    simp[fn_plus_def,fn_minus_def]
147QED
148
149Theorem integrable_cong_AE:
150    !m f g. complete_measure_space m /\ (AE x::m. f x = g x) ==>
151        (integrable m f <=> integrable m g)
152Proof
153    rw[] >> eq_tac >> rw[] >>
154    dxrule_at_then (Pos $ el 1) (dxrule_at_then (Pos $ el 1) irule) integrable_eq_AE >> simp[] >>
155    qspecl_then [‘m’,‘λx. g x = f x’,‘λx. f x = g x’] (irule_at Any o SIMP_RULE (srw_ss ()) []) AE_subset >>
156    simp[]
157QED
158
159Theorem integrable_cong_AE_alt:
160    !m f g. measure_space m /\ (AE x::m. f x = g x) /\
161            f IN Borel_measurable (measurable_space m) /\
162            g IN Borel_measurable (measurable_space m) ==>
163           (integrable m f <=> integrable m g)
164Proof
165    rw[] >> eq_tac >> rw[]
166 >> dxrule_at_then (Pos $ el 1)
167       (dxrule_at_then (Pos $ el 1) irule) integrable_eq_AE_alt >> simp[]
168 >> qspecl_then [‘m’,‘λx. g x = f x’,‘λx. f x = g x’]
169                (irule_at Any o SIMP_RULE (srw_ss ()) []) AE_subset
170 >> simp[]
171QED
172
173Theorem integral_mono_AE:
174    !m f g. measure_space m /\ (AE x::m. f x <= g x) ==>
175            integral m f <= integral m g
176Proof
177    rw [integral_def]
178 >> irule sub_le_sub_imp >> NTAC 2 $ irule_at Any pos_fn_integral_mono_AE
179 >> simp[FN_PLUS_POS,FN_MINUS_POS]
180 >> map_every (fn tms => qspecl_then tms
181                          (irule_at Any o SIMP_RULE (srw_ss ()) []) AE_subset)
182     [[‘m’,‘λx. f x <= g x’,‘λx. f^+ x <= g^+ x’],
183      [‘m’,‘λx. f x <= g x’,‘λx. g^- x <= f^- x’]]
184 >> simp[GSYM FORALL_AND_THM,GSYM IMP_CONJ_THM]
185 >> NTAC 2 strip_tac >> rw [fn_plus_def,fn_minus_def]
186 >| [ simp[le_neg],
187      simp[Once le_negl],
188      simp[Once le_negr,le_lt],
189      simp[],
190      simp[le_lt] ]
191 >> ‘F’ suffices_by simp[] >> qpat_x_assum ‘~b’ mp_tac >> simp[]
192 >- (irule let_trans >> qexists_tac ‘g x’ >> simp[])
193 >> (irule lte_trans >> qexists_tac ‘f x’ >> simp[])
194QED
195
196Theorem integral_add':
197    !m f g. measure_space m /\ integrable m f /\ integrable m g ==>
198        integral m (λx. f x + g x) = integral m f + integral m g
199Proof
200    rw[] >> imp_res_tac integrable_AE_finite >>
201    (qspecl_then [‘m’,‘f’,‘Normal o real o f’,‘g’,‘Normal o real o g’] assume_tac)
202        AE_eq_add >> rfs[] >>
203    map_every (fn tms => (qspecl_then tms assume_tac) integral_cong_AE)
204        [[‘m’,‘f’,‘Normal o real o f’],[‘m’,‘g’,‘Normal o real o g’],
205        [‘m’,‘λx. f x + g x’,‘λx. Normal (real (f x)) + Normal (real (g x))’]] >>
206    rfs[] >> NTAC 3 (pop_assum kall_tac) >>
207    qspecl_then [‘m’,‘Normal o real o f’,‘Normal o real o g’] assume_tac integral_add >>
208    rfs[] >> pop_assum irule >> rw[] >> irule integrable_eq_AE_alt >> fs[integrable_def] >>
209    simp[IN_MEASURABLE_BOREL_NORMAL_REAL]
210    >| [qexists_tac ‘f’,qexists_tac ‘g’] >> simp[]
211QED
212
213Theorem integrable_add':
214    !m f g. measure_space m /\ integrable m f /\ integrable m g ==> integrable m (λx. f x + g x)
215Proof
216    rw[] >> imp_res_tac integrable_AE_finite >>
217    (qspecl_then [‘m’,‘f’,‘Normal o real o f’,‘g’,‘Normal o real o g’] assume_tac) AE_eq_add >> rfs[] >>
218    map_every (fn tms => (qspecl_then tms assume_tac) integrable_eq_AE_alt)
219        [[‘m’,‘f’,‘Normal o real o f’],[‘m’,‘g’,‘Normal o real o g’],
220        [‘m’,‘λx. Normal (real (f x)) + Normal (real (g x))’,‘λx. f x + g x’]] >>
221    rfs[integrable_measurable,IN_MEASURABLE_BOREL_NORMAL_REAL] >> pop_assum irule >>
222    simp[Once EQ_SYM_EQ] >> irule_at Any IN_MEASURABLE_BOREL_ADD' >>
223    qexistsl_tac [‘g’,‘f’] >> simp[integrable_measurable] >>
224    qspecl_then [‘m’,‘Normal o real o f’,‘Normal o real o g’] (irule o SIMP_RULE (srw_ss ()) []) integrable_add >>
225    simp[]
226QED
227
228(* NOTE: reworked proof for "HOL warning: Type.mk_vartype: non-standard syntax" *)
229Theorem integral_sum' :
230    !m f s. FINITE s /\ measure_space m /\ (!i. i IN s ==> integrable m (f i)) ==>
231            integral m (λx. SIGMA (λi. f i x) s) = SIGMA (λi. integral m (f i)) s
232Proof
233    rpt STRIP_TAC
234 (* applying integral_sum *)
235 >> MP_TAC (Q.SPECL [‘m’, ‘\i. Normal o real o f i’, ‘s’] integral_sum)
236 >> simp []
237 >> qabbrev_tac ‘g = \i. Normal o real o f i’ >> simp []
238 >> Know ‘!i. i IN s ==> integrable m (g i)’
239 >- (rw [Abbr ‘g’] \\
240     MATCH_MP_TAC integrable_eq_AE_alt \\
241     Q.EXISTS_TAC ‘f i’ >> ASM_SIMP_TAC bool_ss [] \\
242     CONJ_TAC >- (MATCH_MP_TAC integrable_AE_finite >> rw []) \\
243     MATCH_MP_TAC IN_MEASURABLE_BOREL_NORMAL_REAL \\
244     fs [measure_space_def, integrable_def])
245 >> RW_TAC std_ss []
246 (* rewrite RHS from f to g *)
247 >> MATCH_MP_TAC EQ_TRANS
248 >> Q.EXISTS_TAC ‘SIGMA (\i. integral m (g i)) s’
249 >> reverse CONJ_TAC
250 >- (irule EXTREAL_SUM_IMAGE_EQ' >> rw [] \\
251     ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
252     MATCH_MP_TAC integral_cong_AE >> RW_TAC bool_ss [Abbr ‘g’] \\
253     MATCH_MP_TAC integrable_AE_finite >> rw [])
254 (* rewrite LHS from f to g *)
255 >> MATCH_MP_TAC EQ_TRANS
256 >> Q.EXISTS_TAC ‘integral m (\x. SIGMA (\i. g i x) s)’
257 >> CONJ_TAC
258 >- (MATCH_MP_TAC integral_cong_AE >> rw [] \\
259     HO_MATCH_MP_TAC AE_subset \\
260     Q.EXISTS_TAC ‘\x. !i. i IN s ==> f i x = g i x’ >> simp [] \\
261     reverse CONJ_TAC >- (rpt STRIP_TAC \\
262                          irule EXTREAL_SUM_IMAGE_EQ' >> rw []) \\
263     HO_MATCH_MP_TAC AE_BIGINTER \\
264     RW_TAC bool_ss [finite_countable, Abbr ‘g’] \\
265     MATCH_MP_TAC integrable_AE_finite >> rw [])
266 >> simp [Abbr ‘g’]
267QED
268
269Theorem integrable_sum':
270    !m f s. FINITE s /\ measure_space m /\ (!i. i IN s ==> integrable m (f i)) ==>
271            integrable m (λx. SIGMA (λi. f i x) s)
272Proof
273    rw[] >> irule integrable_eq_AE_alt
274 >> simp[] >> drule_then (irule_at Any) IN_MEASURABLE_BOREL_SUM'
275 >> qexistsl_tac [‘f’,‘λx. SIGMA (λi. Normal (real (f i x))) s’]
276 >> simp[integrable_measurable]
277 >> qspecl_then [‘m’,‘λi. Normal o real o f i’,‘s’]
278                (irule_at Any o SIMP_RULE (srw_ss ()) []) integrable_sum
279 >> simp[]
280 >> first_assum $ C (resolve_then Any assume_tac) integrable_AE_finite >> rfs[]
281 >> qspecl_then [‘m’,‘λi x. f i x = Normal (real (f i x))’,‘s’]
282                assume_tac AE_BIGINTER
283 >> rfs[finite_countable] >> rw[]
284 >- (irule integrable_eq_AE_alt \\
285     simp[integrable_measurable,IN_MEASURABLE_BOREL_NORMAL_REAL] \\
286     qexists_tac ‘f i’ >> simp[])
287 >> qspecl_then [‘m’,‘λx. !n. n IN s ==> f n x = Normal (real (f n x))’,
288                 ‘λx. SIGMA (λi. Normal (real (f i x))) s = SIGMA (λi. f i x) s’]
289                (irule o SIMP_RULE (srw_ss ()) []) AE_subset
290 >> rw[]
291 >> irule EXTREAL_SUM_IMAGE_EQ' >> simp[]
292QED
293
294Theorem integral_sub':
295    !m f g. measure_space m /\ integrable m f /\ integrable m g ==>
296            integral m (λx. f x - g x) = integral m f - integral m g
297Proof
298    rw [extreal_sub]
299 >> ‘integrable m (\x. -g x)’ by METIS_TAC [integrable_ainv]
300 >> Know ‘Normal (-1) * integral m g = integral m (\x. Normal (-1) * g x)’
301 >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
302     MATCH_MP_TAC integral_cmul >> art [])
303 >> rw [GSYM neg_minus1, GSYM extreal_ainv_def, normal_1]
304 >> HO_MATCH_MP_TAC integral_add' >> rw []
305QED
306
307Theorem integrable_sub':
308    !m f g. measure_space m /\ integrable m f /\ integrable m g ==>
309            integrable m (λx. f x - g x)
310Proof
311    rw [extreal_sub]
312 >> ‘integrable m (\x. -g x)’ by METIS_TAC [integrable_ainv]
313 >> HO_MATCH_MP_TAC integrable_add' >> rw []
314QED
315
316Theorem pos_fn_integral_add3 :
317    !m f g h. measure_space m /\
318             (!x. x IN m_space m ==> 0 <= f x) /\
319             (!x. x IN m_space m ==> 0 <= g x) /\
320             (!x. x IN m_space m ==> 0 <= h x) /\
321              f IN measurable (m_space m,measurable_sets m) Borel /\
322              g IN measurable (m_space m,measurable_sets m) Borel /\
323              h IN measurable (m_space m,measurable_sets m) Borel
324          ==> pos_fn_integral m (\x. f x + g x + h x) =
325              pos_fn_integral m f + pos_fn_integral m g + pos_fn_integral m h
326Proof
327    rpt STRIP_TAC
328 >> Know ‘pos_fn_integral m (\x. f x + g x + h x) =
329          pos_fn_integral m (\x. f x + g x) +
330          pos_fn_integral m h’
331 >- (HO_MATCH_MP_TAC pos_fn_integral_add >> rw [le_add] \\
332     MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD' \\
333     qexistsl_tac [‘f’, ‘g’] >> rw [] \\
334     fs [measure_space_def])
335 >> Rewr'
336 >> Suff ‘pos_fn_integral m (\x. f x + g x) =
337          pos_fn_integral m f + pos_fn_integral m g’ >- rw []
338 >> MATCH_MP_TAC pos_fn_integral_add >> art []
339QED
340
341(* An easy corollary of the new integral_add' and integrable_add' *)
342Theorem integral_add3 :
343    !m f g h. measure_space m /\
344              integrable m f /\ integrable m g /\ integrable m h
345          ==> integral m (\x. f x + g x + h x) =
346              integral m f + integral m g + integral m h
347Proof
348    rpt STRIP_TAC
349 >> Know ‘integral m (\x. f x + g x + h x) =
350          integral m (\x. f x + g x) + integral m h’
351 >- (HO_MATCH_MP_TAC integral_add' >> simp [] \\
352     MATCH_MP_TAC integrable_add' >> rw [])
353 >> Rewr'
354 >> Suff ‘integral m (\x. f x + g x) = integral m f + integral m g’ >- rw []
355 >> MATCH_MP_TAC integral_add' >> rw []
356QED
357
358(* NOTE: This simple proof is based on integral_split' *)
359Theorem integral_disjoint_sets :
360    !m f s t.
361        measure_space m /\ integrable m f /\
362        DISJOINT s t /\ s IN measurable_sets m /\ t IN measurable_sets m ==>
363        integral m (\x. f x * indicator_fn (s UNION t) x) =
364        integral m (\x. f x * indicator_fn s x) +
365        integral m (\x. f x * indicator_fn t x)
366Proof
367    rpt STRIP_TAC
368 >> ‘s UNION t IN measurable_sets m’ by PROVE_TAC [MEASURE_SPACE_UNION]
369 >> ‘integrable m (\x. f x * indicator_fn (s UNION t) x)’
370       by METIS_TAC [integrable_mul_indicator]
371 >> qmatch_abbrev_tac ‘integral m g = _’
372 >> MP_TAC (Q.SPECL [‘m’, ‘g’, ‘s’] integral_split')
373 >> simp [] >> DISCH_THEN K_TAC
374 >> simp [Abbr ‘g’, GSYM mul_assoc]
375 >> ‘!x. indicator_fn (s UNION t) x * indicator_fn s x =
376         indicator_fn ((s UNION t) INTER s) x’
377      by rw [INDICATOR_FN_INTER]
378 >> POP_ORW
379 >> ‘(s UNION t) INTER s = s’ by SET_TAC [] >> POP_ORW
380 >> ‘!x. indicator_fn (s UNION t) x * indicator_fn (m_space m DIFF s) x =
381         indicator_fn ((s UNION t) INTER (m_space m DIFF s)) x’
382      by rw [INDICATOR_FN_INTER]
383 >> POP_ORW
384 >> Suff ‘(s UNION t) INTER (m_space m DIFF s) = t’ >- rw []
385 >> ‘s SUBSET m_space m /\ t SUBSET m_space m’
386       by PROVE_TAC [MEASURE_SPACE_SUBSET_MSPACE]
387 >> ASM_SET_TAC []
388QED
389
390Theorem integral_disjoint_sets_sum :
391    !m f s a.
392        FINITE s /\ measure_space m /\ integrable m f /\
393        (!i. i IN s ==> a i IN measurable_sets m) /\
394        disjoint_family_on a s ==>
395        integral m (\x. f x * indicator_fn (BIGUNION (IMAGE a s)) x) =
396        SIGMA (\i. integral m (\x. f x * indicator_fn (a i) x)) s
397Proof
398    Suff ‘!s. FINITE (s :'b set) ==>
399             (\s. !m f a. measure_space m /\ integrable m f /\
400                    (!i. i IN s ==> a i IN measurable_sets m) /\
401                     disjoint_family_on a s ==>
402                integral m (\x. f x * indicator_fn (BIGUNION (IMAGE a s)) x) =
403                SIGMA (\i. integral m (\x. f x * indicator_fn (a i) x)) s) s’
404 >- RW_TAC std_ss []
405 >> MATCH_MP_TAC FINITE_INDUCT
406 >> RW_TAC std_ss [EXTREAL_SUM_IMAGE_EMPTY, IMAGE_EMPTY, BIGUNION_EMPTY,
407                   FINITE_INSERT, DELETE_NON_ELEMENT, IN_INSERT, BIGUNION_INSERT,
408                   IMAGE_INSERT, disjoint_family_on_def]
409 >- rw [indicator_fn_def, mul_rzero, mul_rone, NOT_IN_EMPTY, integral_zero]
410 >> MP_TAC (Q.SPECL [‘\i. integral m (\x. f x * indicator_fn (a i) x)’, ‘s’]
411                    (INST_TYPE [alpha |-> beta] EXTREAL_SUM_IMAGE_PROPERTY))
412 >> simp []
413 >> DISCH_THEN (MP_TAC o Q.SPEC ‘e’)
414 >> impl_tac
415 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
416     Suff ‘integrable m (\x. f x * indicator_fn (a i) x)’
417     >- METIS_TAC [integrable_finite_integral] \\
418     MATCH_MP_TAC integrable_mul_indicator >> art [] \\
419     FIRST_X_ASSUM MATCH_MP_TAC >> art [])
420 >> Rewr'
421 >> `e NOTIN s` by METIS_TAC [DELETE_NON_ELEMENT]
422 >> `DISJOINT (a e) (BIGUNION (IMAGE a s))`
423       by (RW_TAC std_ss [DISJOINT_BIGUNION, IN_IMAGE] >> METIS_TAC [])
424 >> `(IMAGE a s) SUBSET measurable_sets m`
425       by (RW_TAC std_ss [SUBSET_DEF, IMAGE_DEF, GSPECIFICATION] \\
426           METIS_TAC [])
427 >> `countable (IMAGE a s)` by METIS_TAC [image_countable, finite_countable]
428 >> `BIGUNION (IMAGE a s) IN measurable_sets m`
429       by METIS_TAC [sigma_algebra_def, measure_space_def, subsets_def,
430                     measurable_sets_def]
431 >> METIS_TAC [integral_disjoint_sets]
432QED
433
434(* ------------------------------------------------------------------------- *)
435(*   Convergence theorems and their applications [1, Chapter 9 & 12]         *)
436(* ------------------------------------------------------------------------- *)
437
438(* Another convergence theorem, usually called Fatou's lemma,
439   named after Pierre Fatou (1878-1929), a French mathematician and astronomer.
440
441   This is mainly to prove the validity of the definition of `ext_liminf`. The value
442   of any of the integrals may be infinite.
443
444   This is Theorem 9.11 of [1, p.78], a simple version (enough for now).
445
446   cf. integrationTheory.FATOU for the version of Henstock-Kurzweil integrals.
447 *)
448Theorem fatou_lemma :
449    !m f. measure_space m /\ (!x n. x IN m_space m ==> 0 <= f n x) /\
450         (!n. f n IN measurable (m_space m,measurable_sets m) Borel) ==>
451          pos_fn_integral m (\x. liminf (\n. f n x)) <=
452          liminf (\n. pos_fn_integral m (f n))
453Proof
454    rw [ext_liminf_def]
455 >> Know ‘pos_fn_integral m (\x. sup (IMAGE (\m. inf {f n x | m <= n}) UNIV)) =
456          sup (IMAGE (\i. pos_fn_integral m (\x. inf {f n x | i <= n})) UNIV)’
457 >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence >> rw [] >| (* 3 subgoals *)
458     [ (* goal 1 (of 3) *)
459       MATCH_MP_TAC IN_MEASURABLE_BOREL_INF >> simp [] \\
460       qexistsl_tac [‘f’, ‘from i’] >> rw [IN_FROM] >| (* 2 subgoals *)
461       [ (* goal 1 (of 2) *)
462         rw [Once EXTENSION, IN_FROM] \\
463         Q.EXISTS_TAC ‘i’ >> rw [],
464         (* goal 1 (of 2) *)
465         Suff ‘{f n x | i <= n} = (IMAGE (\n. f n x) (from i))’ >- rw [] \\
466         rw [Once EXTENSION, IN_FROM] ],
467       (* goal 2 (of 3) *)
468       rw [le_inf'] >> METIS_TAC [],
469       (* goal 3 (of 3) *)
470       rw [ext_mono_increasing_def] \\
471       MATCH_MP_TAC inf_mono_subset >> rw [SUBSET_DEF] \\
472       Q.EXISTS_TAC ‘n’ >> rw [] ]) >> Rewr'
473 >> MATCH_MP_TAC sup_mono >> rw []
474 >> rw [le_inf']
475 >> MATCH_MP_TAC pos_fn_integral_mono >> rw []
476 >| [ (* goal 1 (of 2) *)
477      rw [le_inf'] >> rw [],
478      (* goal 2 (of 2) *)
479      rw [inf_le'] \\
480      POP_ASSUM MATCH_MP_TAC \\
481      Q.EXISTS_TAC ‘n'’ >> rw [] ]
482QED
483
484(* This is also called Reverse Fatou Lemma [1, p.80]
485
486   NOTE: the antecedents are just to make sure that WLLN_IID can be proved.
487 *)
488Theorem fatou_lemma' :
489    !m f w. measure_space m /\ pos_fn_integral m w < PosInf /\
490           (!x n. x IN m_space m ==> 0 <= f n x /\ f n x <= w x /\ w x < PosInf) /\
491           (!n. f n IN Borel_measurable (measurable_space m)) ==>
492            limsup (\n. pos_fn_integral m (f n)) <=
493            pos_fn_integral m (\x. limsup (\n. f n x))
494Proof
495    rw [ext_limsup_def]
496 >> Know ‘pos_fn_integral m (\x. inf (IMAGE (\m. sup {f n x | m <= n}) UNIV)) =
497          inf (IMAGE (\i. pos_fn_integral m (\x. sup {f n x | i <= n})) UNIV)’
498 >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence_decreasing \\
499     rw [] >| (* 5 subgoals *)
500     [ (* goal 1 (of 5) *)
501       MATCH_MP_TAC IN_MEASURABLE_BOREL_SUP >> simp [] \\
502       qexistsl_tac [‘f’, ‘from i’] >> rw [IN_FROM] >| (* 2 subgoals *)
503       [ (* goal 5.1 (of 3) *)
504         rw [Once EXTENSION, IN_FROM] \\
505         Q.EXISTS_TAC ‘i’ >> rw [],
506         (* goal 5.2 (of 3) *)
507         Suff ‘{f n x | i <= n} = (IMAGE (\n. f n x) (from i))’ >- rw [] \\
508         rw [Once EXTENSION, IN_FROM] ],
509       (* goal 2 (of 5) *)
510       rw [le_sup'] \\
511       MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘f i x’ >> rw [] \\
512       POP_ASSUM MATCH_MP_TAC \\
513       Q.EXISTS_TAC ‘i’ >> rw [],
514       (* goal 3 (of 5): sup {f n x | i <= n} < PosInf *)
515       MATCH_MP_TAC let_trans >> Q.EXISTS_TAC ‘w x’ \\
516       reverse CONJ_TAC >- rw [GSYM lt_infty] \\
517       rw [sup_le'] >> METIS_TAC [],
518       (* goal 4 (of 5): pos_fn_integral m (\x. sup {f n x | i <= n}) <> PosInf *)
519       REWRITE_TAC [lt_infty] \\
520       MATCH_MP_TAC let_trans \\
521       Q.EXISTS_TAC ‘pos_fn_integral m w’ >> art [] \\
522       MATCH_MP_TAC pos_fn_integral_mono >> rw [] >| (* 2 subgoals *)
523       [ (* goal 4.1 (of 2) *)
524         rw [le_sup'] \\
525         MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘f i x’ >> rw [] \\
526         POP_ASSUM MATCH_MP_TAC \\
527         Q.EXISTS_TAC ‘i’ >> rw [],
528         (* goal 4.2 (of 2) *)
529         rw [sup_le'] >> METIS_TAC [] ],
530       (* goal 5 (of 5) *)
531       rw [ext_mono_decreasing_def] \\
532       MATCH_MP_TAC sup_mono_subset >> rw [SUBSET_DEF] \\
533       Q.EXISTS_TAC ‘n’ >> rw [] ])
534 >> Rewr'
535 >> MATCH_MP_TAC inf_mono >> rw []
536 >> rw [sup_le']
537 >> MATCH_MP_TAC pos_fn_integral_mono >> rw []
538 >> rw [le_sup']
539 >> POP_ASSUM MATCH_MP_TAC
540 >> Q.EXISTS_TAC ‘n'’ >> rw []
541QED
542
543(* Properties A.1 (v) [1, p.409] (a simple version for non-negative sequences) *)
544Theorem ext_limsup_lemma[local] :
545    !a. (!n. 0 <= a n /\ a n <> PosInf) ==>
546        (((\n. real (a n)) --> 0) sequentially <=> limsup a = 0 /\ liminf a = 0)
547Proof
548    rpt STRIP_TAC
549 >> MATCH_MP_TAC (REWRITE_RULE [o_DEF, GSYM extreal_of_num_def]
550                               (Q.SPECL [‘a’, ‘0’] ext_limsup_thm))
551 >> rw []
552 >> MATCH_MP_TAC pos_not_neginf >> rw []
553QED
554
555Theorem lebesgue_dominated_convergence_lemma[local] :
556    !m f fi. measure_space m /\ (!i. integrable m (fi i)) /\
557            (!i x. x IN m_space m ==> fi i x <> PosInf /\ fi i x <> NegInf) /\
558            (!x. x IN m_space m ==> f x <> PosInf /\ f x <> NegInf) /\
559            (!x. x IN m_space m ==>
560                ((\i. real (fi i x)) --> real (f x)) sequentially) /\
561            (?w. integrable m w /\
562                (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
563                 !i x. x IN m_space m ==> abs (fi i x) <= w x)
564        ==> integrable m f
565Proof
566    rpt STRIP_TAC
567 (* applying ext_limsup_thm *)
568 >> Know ‘!x. x IN m_space m ==> limsup (\i. fi i x) = f x /\
569                                 liminf (\i. fi i x) = f x’
570 >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
571     qmatch_abbrev_tac ‘limsup (a :num -> extreal) = _ /\ _’ \\
572     MP_TAC (Q.SPECL [‘a’, ‘real (f x)’] ext_limsup_thm) \\
573     simp [Abbr ‘a’, o_DEF] \\
574     DISCH_THEN K_TAC \\
575     MATCH_MP_TAC normal_real >> simp [])
576 >> DISCH_TAC
577 >> MATCH_MP_TAC integrable_bounded
578 >> Q.EXISTS_TAC ‘w’ >> art []
579 >> CONJ_ASM1_TAC (* f IN Borel_measurable (measurable_space m) *)
580 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_EQ \\
581     Q.EXISTS_TAC ‘\x. limsup (\i. fi i x)’ >> simp [] \\
582     MATCH_MP_TAC IN_MEASURABLE_BOREL_LIMSUP \\
583     Q.EXISTS_TAC ‘fi’ >> simp [] \\
584     fs [integrable_def, FORALL_AND_THM])
585 (* stage work *)
586 >> rpt STRIP_TAC
587 >> ‘f x = limsup (\i. fi i x)’ by simp [] >> POP_ORW
588 >> MATCH_MP_TAC ext_limsup_bounded >> rw []
589QED
590
591(* Theorem 12.2 of [1, p.97], in slightly simplified form
592
593   NOTE: moved “integrable m f” from antecedents (provable) to conclusion.
594 *)
595Theorem lebesgue_dominated_convergence :
596    !m f fi. measure_space m /\ (!i. integrable m (fi i)) /\
597            (!i x. x IN m_space m ==> fi i x <> PosInf /\ fi i x <> NegInf) /\
598            (!x. x IN m_space m ==> f x <> PosInf /\ f x <> NegInf) /\
599            (!x. x IN m_space m ==>
600                ((\i. real (fi i x)) --> real (f x)) sequentially) /\
601            (?w. integrable m w /\
602                (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
603                 !i x. x IN m_space m ==> abs (fi i x) <= w x)
604        ==> integrable m f /\
605            ((\i. real (integral m (fi i))) --> real (integral m f)) sequentially
606Proof
607    rpt GEN_TAC >> STRIP_TAC
608 >> CONJ_ASM1_TAC
609 >- (MATCH_MP_TAC lebesgue_dominated_convergence_lemma \\
610     Q.EXISTS_TAC ‘fi’ >> simp [] \\
611     Q.EXISTS_TAC ‘w’ >> simp [])
612 (* original proof *)
613 >> Suff ‘((\i. real (integral m (\x. abs (fi i x - f x)))) --> 0) sequentially’
614 >- (rw [LIM_SEQUENTIALLY, dist] \\
615     Q.PAT_X_ASSUM ‘!e. 0 < e ==> P’ (MP_TAC o (Q.SPEC ‘e’)) \\
616     RW_TAC std_ss [] \\
617     Q.EXISTS_TAC ‘N’ >> rpt STRIP_TAC \\
618     Q.PAT_X_ASSUM ‘!i. N <= i ==> P’ (MP_TAC o (Q.SPEC ‘i’)) \\
619     RW_TAC std_ss [] \\
620     Know ‘integrable m (\x. fi i x - f x)’
621     >- (MATCH_MP_TAC integrable_sub >> rw []) >> DISCH_TAC \\
622     Know ‘integrable m (\x. abs (fi i x - f x))’
623     >- (HO_MATCH_MP_TAC (REWRITE_RULE [o_DEF] integrable_abs) >> art []) \\
624     DISCH_TAC \\
625     Know ‘abs (real (integral m (\x. abs (fi i x - f x)))) =
626           real (abs (integral m (\x. abs (fi i x - f x))))’
627     >- (MATCH_MP_TAC abs_real >> METIS_TAC [integrable_finite_integral]) \\
628     DISCH_THEN (FULL_SIMP_TAC std_ss o wrap) \\
629     Know ‘real (abs (integral m (\x. abs (fi i x - f x)))) < e <=>
630           Normal (real (abs (integral m (\x. abs (fi i x - f x))))) < Normal e’
631     >- rw [extreal_lt_eq] \\
632     Know ‘Normal (real (abs (integral m (\x. abs (fi i x - f x))))) =
633                        (abs (integral m (\x. abs (fi i x - f x))))’
634     >- (MATCH_MP_TAC normal_real \\
635        ‘?r. integral m (\x. abs (fi i x - f x)) = Normal r’
636            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
637         rw [extreal_abs_def, extreal_not_infty]) >> Rewr' \\
638     DISCH_THEN (FULL_SIMP_TAC std_ss o wrap) \\
639     Know ‘abs (integral m (\x. abs (fi i x - f x))) =
640                integral m (\x. abs (fi i x - f x))’
641     >- (REWRITE_TAC [abs_refl] \\
642         MATCH_MP_TAC integral_pos >> rw [abs_pos]) \\
643     DISCH_THEN (FULL_SIMP_TAC std_ss o wrap) \\
644     Know ‘real (integral m (fi i)) - real (integral m f) =
645           real (integral m (fi i) - integral m f)’
646     >- (‘?a. integral m (fi i) = Normal a’
647            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
648         ‘?b. integral m f = Normal b’
649            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
650         rw [extreal_sub_def, real_normal]) >> Rewr' \\
651     Know ‘abs (real (integral m (fi i) - integral m f)) =
652           real (abs (integral m (fi i) - integral m f))’
653     >- (MATCH_MP_TAC abs_real \\
654         ‘?a. integral m (fi i) = Normal a’
655            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
656         ‘?b. integral m f = Normal b’
657            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
658         rw [extreal_sub_def, extreal_not_infty]) >> Rewr' \\
659     ONCE_REWRITE_TAC [GSYM extreal_lt_eq] \\
660     Know ‘Normal (real (abs (integral m (fi i) - integral m f))) =
661                         abs (integral m (fi i) - integral m f)’
662     >- (MATCH_MP_TAC normal_real \\
663         ‘?a. integral m (fi i) = Normal a’
664            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
665         ‘?b. integral m f = Normal b’
666            by METIS_TAC [extreal_cases, integrable_finite_integral] >> POP_ORW \\
667         rw [extreal_abs_def, extreal_sub_def, extreal_not_infty]) >> Rewr' \\
668     MATCH_MP_TAC let_trans \\
669     Q.EXISTS_TAC ‘integral m (\x. abs (fi i x - f x))’ >> art [] \\
670     Know ‘integral m (fi i) - integral m f = integral m (\x. fi i x - f x)’
671     >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
672         MATCH_MP_TAC integral_sub >> rw []) >> Rewr' \\
673     HO_MATCH_MP_TAC (REWRITE_RULE [o_DEF] integral_triangle_ineq) >> art [])
674 (* stage work, renamed ‘fi’ to ‘u’ *)
675 >> rename1 ‘!i. integrable m (u i)’
676 (* simplify ‘((\i. real (u i x)) --> real (f x)) sequentially’ *)
677 >> Know ‘!x. x IN m_space m ==>
678              !e. 0 < e ==> ?N. !i. N <= i ==> abs (u i x - f x) < Normal e’
679 >- (RW_TAC std_ss [] \\
680     Q.PAT_X_ASSUM ‘!x. x IN m_space m ==>
681                        ((\i. real (u i x)) --> real (f x)) sequentially’ MP_TAC \\
682     rw [LIM_SEQUENTIALLY, dist] \\
683     Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> !e. 0 < e ==> P’ (MP_TAC o (Q.SPEC ‘x’)) \\
684     RW_TAC std_ss [] \\
685     Q.PAT_X_ASSUM ‘!e. 0 < e ==> ?N. P’ (MP_TAC o (Q.SPEC ‘e’)) \\
686     RW_TAC std_ss [] \\
687     Know ‘!i. real (u i x) - real (f x) = real (u i x - f x)’
688     >- (Q.X_GEN_TAC ‘i’ \\
689        ‘?a. u i x = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW \\
690        ‘?b. f x   = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW \\
691         rw [real_normal, extreal_sub_eq]) \\
692     DISCH_THEN (FULL_SIMP_TAC std_ss o wrap) \\
693     Know ‘!i. abs (real (u i x - f x)) = real (abs (u i x - f x))’
694     >- (Q.X_GEN_TAC ‘i’ \\
695         MATCH_MP_TAC abs_real \\
696        ‘?a. u i x = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW \\
697        ‘?b. f x   = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW \\
698         rw [extreal_sub_def]) \\
699     DISCH_THEN (FULL_SIMP_TAC std_ss o wrap) \\
700     POP_ASSUM MP_TAC >> ONCE_REWRITE_TAC [GSYM extreal_lt_eq] \\
701     Know ‘!i. Normal (real (abs (u i x - f x))) = abs (u i x - f x)’
702     >- (Q.X_GEN_TAC ‘i’ \\
703         MATCH_MP_TAC normal_real \\
704        ‘?a. u i x = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW \\
705        ‘?b. f x   = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW \\
706         rw [extreal_sub_def, extreal_abs_def]) >> Rewr' \\
707     DISCH_TAC \\
708     Q.EXISTS_TAC ‘N’ >> rw [])
709 >> DISCH_TAC
710 >> Q.ABBREV_TAC ‘a = \i x. abs (u i x - f x)’
711 >> Know ‘!x. x IN m_space m ==> ((\i. real (a i x)) --> 0) sequentially’
712 >- (rw [Abbr ‘a’, LIM_SEQUENTIALLY, dist] \\
713     Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> !e. 0 < e ==> P’ (MP_TAC o (Q.SPEC ‘x’)) \\
714     RW_TAC std_ss [] \\
715     Q.PAT_X_ASSUM ‘!e. 0 < e ==> ?N. P’ (MP_TAC o (Q.SPEC ‘e’)) \\
716     RW_TAC std_ss [] \\
717     Q.EXISTS_TAC ‘N’ >> rpt STRIP_TAC \\
718     Know ‘abs (real (abs (u i x - f x))) =
719           real (abs (abs (u i x - f x)))’
720     >- (MATCH_MP_TAC abs_real \\
721        ‘?a. u i x = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW \\
722        ‘?b. f x   = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW \\
723         rw [extreal_sub_def, extreal_abs_def]) >> Rewr' \\
724     RW_TAC std_ss [abs_abs, GSYM extreal_lt_eq] \\
725     Suff ‘Normal (real (abs (u i x - f x))) = abs (u i x - f x)’
726     >- RW_TAC std_ss [] \\
727     MATCH_MP_TAC normal_real \\
728    ‘?a. u i x = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW \\
729    ‘?b. f x   = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW \\
730     rw [extreal_sub_def, extreal_abs_def])
731 >> DISCH_TAC
732 >> Q.ABBREV_TAC ‘b = \i. integral m (a i)’
733 (* NOTE: “integrable m f” is needed here *)
734 >> Know ‘!n. integrable m (a n)’
735 >- (rw [Abbr ‘a’] \\
736     HO_MATCH_MP_TAC (REWRITE_RULE [o_DEF] integrable_abs) >> art [] \\
737     MATCH_MP_TAC integrable_sub >> rw [])
738 >> DISCH_TAC
739 >> ‘!i. integral m (\x. abs (u i x - f x)) = b i’
740      by rw [Abbr ‘a’, Abbr ‘b’] >> POP_ORW
741 (* applying ext_limsup_lemma *)
742 >> Know ‘!n. 0 <= b n /\ b n <> PosInf’
743 >- (Q.X_GEN_TAC ‘n’ >> SIMP_TAC std_ss [Abbr ‘b’] \\
744     reverse CONJ_TAC >- METIS_TAC [integrable_finite_integral] \\
745     MATCH_MP_TAC integral_pos >> rw [Abbr ‘a’, abs_pos])
746 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap o (MATCH_MP ext_limsup_lemma))
747 >> Q.UNABBREV_TAC ‘b’
748 (* applying ext_limsup_lemma again *)
749 >> Know ‘!x. x IN m_space m ==>
750              limsup (\i. a i x) = Normal 0 /\ liminf (\i. a i x) = Normal 0’
751 >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
752     Know ‘((\i. real (a i x)) --> 0) sequentially’
753     >- (FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
754     Q.ABBREV_TAC ‘c = \i. a i x’ \\
755    ‘!i. a i x = c i’ by rw [Abbr ‘c’] >> POP_ORW \\
756     Know ‘!n. 0 <= c n /\ c n <> PosInf’
757     >- (Q.X_GEN_TAC ‘n’ >> SIMP_TAC std_ss [Abbr ‘c’, Abbr ‘a’, abs_pos] \\
758        ‘?r. u n x = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
759        ‘?z. f x   = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
760         rw [extreal_sub_def, extreal_abs_def]) \\
761     DISCH_THEN (REWRITE_TAC o wrap o (MATCH_MP ext_limsup_lemma)) \\
762     REWRITE_TAC [GSYM extreal_of_num_def])
763 >> REWRITE_TAC [GSYM extreal_of_num_def]
764 >> DISCH_TAC
765 (* f is also bounded by w *)
766 >> Know ‘!x. x IN m_space m ==> abs (f x) <= w x’
767 >- (RW_TAC std_ss [] \\
768     MATCH_MP_TAC le_epsilon >> rpt STRIP_TAC \\
769    ‘0 <= e’ by PROVE_TAC [lt_imp_le] \\
770    ‘e <> NegInf’ by PROVE_TAC [pos_not_neginf] \\
771    ‘?E. e = Normal E /\ 0 < E’
772        by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
773     Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> !e. 0 < e ==> P’ (MP_TAC o (Q.SPEC ‘x’)) \\
774     RW_TAC std_ss [] \\
775     Q.PAT_X_ASSUM ‘!e. 0 < e ==> ?N. P’ (MP_TAC o (Q.SPEC ‘E’)) \\
776     RW_TAC std_ss [] \\
777     MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘abs (u N x) + Normal E’ \\
778     reverse CONJ_TAC
779     >- (MATCH_MP_TAC le_radd_imp >> METIS_TAC []) \\
780     MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘abs (u N x) + abs (u N x - f x)’ \\
781     CONJ_TAC >- (MATCH_MP_TAC abs_triangle_sub' >> rw []) \\
782     MATCH_MP_TAC le_ladd_imp \\
783     MATCH_MP_TAC lt_imp_le \\
784     Q.UNABBREV_TAC ‘a’ >> FULL_SIMP_TAC std_ss [])
785 >> DISCH_TAC
786 (* preparing for fatou_lemma *)
787 >> Know ‘!i x. x IN m_space m ==> a i x <= 2 * w x’
788 >- (RW_TAC std_ss [GSYM extreal_double, Abbr ‘a’] \\
789     MATCH_MP_TAC le_trans \\
790     Q.EXISTS_TAC ‘abs (u i x) + abs (f x)’ \\
791     CONJ_TAC >- (MATCH_MP_TAC abs_triangle_neg >> rw []) \\
792     MATCH_MP_TAC le_add2 >> rw [])
793 >> DISCH_TAC
794 (* applying ext_liminf_le_limsup *)
795 >> Know ‘!i. 0 <= integral m (a i)’
796 >- (Q.X_GEN_TAC ‘i’ \\
797     MATCH_MP_TAC integral_pos >> rw [Abbr ‘a’, abs_pos])
798 >> DISCH_TAC
799 >> Suff ‘limsup (\i. integral m (a i)) <= 0’
800 >- (DISCH_TAC \\
801     STRONG_CONJ_TAC
802     >- (rw [GSYM le_antisym] \\
803         MATCH_MP_TAC ext_limsup_pos >> rw []) \\
804     DISCH_TAC \\
805     REWRITE_TAC [GSYM le_antisym] \\
806     reverse CONJ_TAC >- (MATCH_MP_TAC ext_liminf_pos >> rw []) \\
807     MATCH_MP_TAC le_trans \\
808     POP_ASSUM K_TAC \\
809     Q.EXISTS_TAC ‘limsup (\i. integral m (a i))’ >> art [] \\
810     REWRITE_TAC [ext_liminf_le_limsup])
811 (* stage work *)
812 >> Suff ‘limsup (\n. integral m (a n)) <= integral m (\x. limsup (\n. a n x))’
813 >- (DISCH_TAC \\
814     MATCH_MP_TAC le_trans \\
815     Q.EXISTS_TAC ‘integral m (\x. limsup (\n. a n x))’ >> art [] \\
816     MATCH_MP_TAC integral_neg >> rw [])
817 (* final: applying fatou_lemma' *)
818 >> Know ‘!n. integral m (a n) = pos_fn_integral m (a n)’
819 >- (Q.X_GEN_TAC ‘n’ \\
820     MATCH_MP_TAC integral_pos_fn >> rw [Abbr ‘a’, abs_pos])
821 >> Rewr'
822 >> Know  ‘integral m (\x. limsup (\n. a n x)) =
823    pos_fn_integral m (\x. limsup (\n. a n x))’
824 >- (MATCH_MP_TAC integral_pos_fn >> rw [])
825 >> Rewr'
826 >> MATCH_MP_TAC fatou_lemma'
827 >> Q.EXISTS_TAC ‘\x. 2 * w x’ >> simp []
828 >> CONJ_TAC (* pos_fn_integral m (\x. 2 * w x) < PosInf *)
829 >- (REWRITE_TAC [extreal_of_num_def] \\
830     Know ‘pos_fn_integral m (\x. Normal 2 * w x) =
831           Normal 2 * pos_fn_integral m w’
832     >- (MATCH_MP_TAC pos_fn_integral_cmul >> rw [le_02]) >> Rewr' \\
833     Know ‘integral m w <> PosInf /\ integral m w <> NegInf’
834     >- (MATCH_MP_TAC integrable_finite_integral >> art []) \\
835     Know ‘integral m w = pos_fn_integral m w’
836     >- (MATCH_MP_TAC integral_pos_fn >> rw []) >> Rewr' \\
837     STRIP_TAC \\
838    ‘?r. pos_fn_integral m w = Normal r’
839       by METIS_TAC [extreal_cases] >> POP_ORW \\
840     rw [GSYM lt_infty, extreal_mul_def])
841 >> reverse CONJ_TAC >- FULL_SIMP_TAC std_ss [integrable_def]
842 >> rw [Abbr ‘a’, abs_pos, GSYM lt_infty]
843 >> ‘w x <> NegInf’ by METIS_TAC [pos_not_neginf]
844 >> ‘?r. w x = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW
845 >> rw [extreal_of_num_def, extreal_mul_def]
846QED
847
848(* The "modern" form (based on extreal_lim) *)
849Theorem lebesgue_dominated_convergence' :
850    !m f fi. measure_space m /\ (!i. integrable m (fi i)) /\
851            (!i x. x IN m_space m ==> fi i x <> PosInf /\ fi i x <> NegInf) /\
852            (!x. x IN m_space m ==> f x <> PosInf /\ f x <> NegInf) /\
853            (!x. x IN m_space m ==> ((\i. fi i x) --> f x) sequentially) /\
854            (?w. integrable m w /\
855                (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
856                 !i x. x IN m_space m ==> abs (fi i x) <= w x)
857        ==> integrable m f /\
858            ((\i. integral m (fi i)) --> integral m f) sequentially
859Proof
860    rpt GEN_TAC >> STRIP_TAC
861 >> Know ‘!x. x IN m_space m ==>
862             ((\i. real (fi i x)) --> real (f x)) sequentially’
863 >- (rpt STRIP_TAC \\
864     qabbrev_tac ‘l = f x’ \\
865     qabbrev_tac ‘g = \i. fi i x’ >> simp [] \\
866    ‘(\i. real (g i)) = real o g’ by rw [FUN_EQ_THM, o_DEF] >> POP_ORW \\
867     Know ‘(real o g --> real l) sequentially <=> (g --> l) sequentially’
868     >- (SYM_TAC >> MATCH_MP_TAC extreal_lim_sequentially_eq \\
869         simp [Abbr ‘l’] \\
870         Q.EXISTS_TAC ‘0’ >> simp [Abbr ‘g’]) >> Rewr' \\
871     simp [Abbr ‘g’, Abbr ‘l’])
872 >> DISCH_TAC
873 >> CONJ_ASM1_TAC
874 >- (MATCH_MP_TAC (cj 1 lebesgue_dominated_convergence) \\
875     Q.EXISTS_TAC ‘fi’ >> simp [] \\
876     Q.EXISTS_TAC ‘w’ >> simp [])
877 >> qmatch_abbrev_tac ‘(g --> l) sequentially’
878 >> Know ‘(g --> l) sequentially <=> (real o g --> real l) sequentially’
879 >- (MATCH_MP_TAC extreal_lim_sequentially_eq \\
880     Know ‘l <> PosInf /\ l <> NegInf’
881     >- (qunabbrev_tac ‘l’ \\
882         MATCH_MP_TAC integrable_finite_integral >> art []) >> Rewr \\
883     Q.EXISTS_TAC ‘0’ >> simp [] \\
884     Q.X_GEN_TAC ‘n’ >> simp [Abbr ‘g’] \\
885     MATCH_MP_TAC integrable_finite_integral >> art [])
886 >> Rewr'
887 >> simp [Abbr ‘g’, Abbr ‘l’, o_DEF]
888 >> MATCH_MP_TAC (cj 2 lebesgue_dominated_convergence) >> simp []
889 >> Q.EXISTS_TAC ‘w’ >> simp []
890QED
891
892(* NOTE: This lemma can be used to further weakening the antecedents of
893   lebesgue_dominated_convergence.
894 *)
895Theorem integrable_bounded_exists :
896    !m fi. measure_space m /\
897          (?w0. integrable m w0 /\
898                !i x. x IN m_space m ==> abs (fi i x) <= w0 x) ==>
899           ?w. integrable m w /\
900              (!x. x IN m_space m ==> 0 <= w x) /\
901              (AE x::m. w x <> PosInf) /\
902               !i x. x IN m_space m ==> abs (fi i x) <= w x
903Proof
904    rpt STRIP_TAC
905 >> Q.EXISTS_TAC ‘abs o w0’
906 >> CONJ_TAC
907 >- (MATCH_MP_TAC integrable_abs >> art [])
908 >> reverse (rw [o_DEF])
909 >- (Q_TAC (TRANS_TAC le_trans) ‘w0 x’ >> simp [le_abs])
910 >> MP_TAC (Q.SPECL [‘m’, ‘\x. w0 x <> PosInf /\ w0 x <> NegInf’,
911                     ‘\x. abs (w0 x) <> PosInf’] AE_subset)
912 >> simp [integrable_AE_normal_full]
913 >> DISCH_THEN MATCH_MP_TAC
914 >> NTAC 2 STRIP_TAC
915 >> MATCH_MP_TAC (cj 1 abs_not_infty) >> art []
916QED
917
918(* ------------------------------------------------------------------------- *)
919(*  Integrals with Respect to Image Measures [1, Chapter 15]                 *)
920(* ------------------------------------------------------------------------- *)
921
922(* Theorem 15.1, Part I (transformation theorem, positive functions only) *)
923Theorem pos_fn_integral_distr :
924    !M B f u. measure_space M /\ sigma_algebra B /\
925              f IN measurable (m_space M, measurable_sets M) B /\
926              u IN measurable B Borel /\
927             (!x. x IN space B ==> 0 <= u x) ==>
928             (pos_fn_integral (space B,subsets B,distr M f) u =
929              pos_fn_integral M (u o f))
930Proof
931    rpt STRIP_TAC
932 >> ‘measure_space (space B,subsets B,distr M f)’ by PROVE_TAC [measure_space_distr]
933 >> Know ‘u o f IN measurable (m_space M,measurable_sets M) Borel’
934 >- (MATCH_MP_TAC MEASURABLE_COMP \\
935     Q.EXISTS_TAC ‘B’ >> art []) >> DISCH_TAC
936 >> MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’]
937                    (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_sup))
938 >> DISCH_THEN (STRIP_ASSUME_TAC o GSYM o REWRITE_RULE [m_space_def])
939 (* LHS simplification *)
940 >> Know ‘pos_fn_integral (space B,subsets B,distr M f) u =
941          sup (IMAGE (\n. pos_fn_integral (space B,subsets B,distr M f)
942                            (fn_seq (space B,subsets B,distr M f) u n)) UNIV)’
943 >- (MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
944     CONJ_TAC
945     >- (Q.X_GEN_TAC ‘n’ \\
946         MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’, ‘n’]
947                         (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_measurable)) \\
948         RW_TAC std_ss [m_space_def, measurable_sets_def, SPACE]) \\
949     CONJ_TAC
950     >- (rpt STRIP_TAC \\
951         MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’, ‘i’, ‘x’]
952                         (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_positive)) \\
953         RW_TAC std_ss []) \\
954     rpt STRIP_TAC \\
955     MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’, ‘x’]
956                     (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_mono_increasing)) \\
957     RW_TAC std_ss []) >> Rewr'
958 (* RHS simplification *)
959 >> Know ‘pos_fn_integral M (u o f) =
960          pos_fn_integral M (\x. sup (IMAGE (\n. fn_seq (space B,subsets B,distr M f)
961                                                        u n (f x)) UNIV))’
962 >- (MATCH_MP_TAC pos_fn_integral_cong >> ASM_SIMP_TAC std_ss [] \\
963     CONJ_TAC
964     >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
965         Q.PAT_X_ASSUM ‘f IN measurable (m_space M,measurable_sets M) B’ MP_TAC \\
966         rw [IN_MEASURABLE, IN_FUNSET]) \\
967     CONJ_TAC
968     >- (rw [le_sup', IN_IMAGE, IN_UNIV] \\
969         MATCH_MP_TAC le_trans \\
970         Q.EXISTS_TAC ‘fn_seq (space B,subsets B,distr M f) u 0 (f x)’ \\
971         reverse CONJ_TAC >- (POP_ASSUM MATCH_MP_TAC \\
972                              Q.EXISTS_TAC ‘0’ >> REWRITE_TAC []) \\
973         MATCH_MP_TAC lemma_fn_seq_positive \\
974         FIRST_X_ASSUM MATCH_MP_TAC \\
975         Q.PAT_X_ASSUM ‘f IN measurable (m_space M,measurable_sets M) B’ MP_TAC \\
976         rw [IN_MEASURABLE, IN_FUNSET]) \\
977     rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
978     Q.PAT_X_ASSUM ‘f IN measurable (m_space M,measurable_sets M) B’ MP_TAC \\
979     rw [IN_MEASURABLE, IN_FUNSET]) >> Rewr'
980 >> Know ‘pos_fn_integral M
981            (\x. sup (IMAGE (\n. fn_seq (space B,subsets B,distr M f) u n (f x))
982                            UNIV)) =
983          sup (IMAGE (\n. pos_fn_integral M
984                            ((fn_seq (space B,subsets B,distr M f) u n) o f))
985                     UNIV)’
986 >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
987     CONJ_TAC
988     >- (GEN_TAC \\
989         MATCH_MP_TAC MEASURABLE_COMP >> Q.EXISTS_TAC ‘B’ >> art [] \\
990         MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’, ‘n’]
991                         (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_measurable)) \\
992         RW_TAC std_ss [m_space_def, measurable_sets_def, SPACE]) \\
993     CONJ_TAC
994     >- (rpt STRIP_TAC \\
995         MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’, ‘n’, ‘f x’]
996                         (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_positive)) \\
997         RW_TAC std_ss [] \\
998         POP_ASSUM MATCH_MP_TAC \\
999         FIRST_X_ASSUM MATCH_MP_TAC \\
1000         Q.PAT_X_ASSUM ‘f IN measurable (m_space M,measurable_sets M) B’ MP_TAC \\
1001         rw [IN_MEASURABLE, IN_FUNSET]) \\
1002     rpt STRIP_TAC \\
1003     MP_TAC (Q.SPECL [‘(space B,subsets B,distr M f)’, ‘u’, ‘f x’]
1004                     (INST_TYPE [alpha |-> “:'b”] lemma_fn_seq_mono_increasing)) \\
1005     RW_TAC std_ss [] \\
1006     POP_ASSUM MATCH_MP_TAC \\
1007     FIRST_X_ASSUM MATCH_MP_TAC \\
1008     Q.PAT_X_ASSUM ‘f IN measurable (m_space M,measurable_sets M) B’ MP_TAC \\
1009     rw [IN_MEASURABLE, IN_FUNSET]) >> Rewr'
1010 >> Suff ‘!n. pos_fn_integral (space B,subsets B,distr M f)
1011                                (fn_seq (space B,subsets B,distr M f) u n) =
1012              pos_fn_integral M (fn_seq (space B,subsets B,distr M f) u n o f)’
1013 >- Rewr
1014 >> POP_ASSUM K_TAC (* clean up *)
1015 (* stage work *)
1016 >> Q.X_GEN_TAC ‘N’
1017 >> SIMP_TAC std_ss [fn_seq_def, m_space_def, o_DEF]
1018 >> Know ‘!i n. (0 :extreal) <= &i / 2 pow n’
1019 >- (rpt GEN_TAC \\
1020    ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
1021       by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
1022    ‘?r. 0 < r /\ (2 pow n = Normal r)’
1023       by METIS_TAC [lt_02, pow_pos_lt, extreal_cases, extreal_lt_eq,
1024                     extreal_of_num_def] >> POP_ORW \\
1025     MATCH_MP_TAC le_div >> rw [extreal_of_num_def, extreal_le_eq])
1026 >> DISCH_TAC
1027 (* LHS simplification *)
1028 >> Know ‘pos_fn_integral (space B,subsets B,distr M f)
1029            (\x. SIGMA (\k. &k / 2 pow N *
1030                           indicator_fn
1031                             {x | x IN space B /\ &k / 2 pow N <= u x /\
1032                                  u x < (&k + 1) / 2 pow N} x) (count (4 ** N)) +
1033                 2 pow N * indicator_fn {x | x IN space B /\ 2 pow N <= u x} x) =
1034          pos_fn_integral (space B,subsets B,distr M f)
1035            (\x. SIGMA (\k. &k / 2 pow N *
1036                           indicator_fn
1037                             {x | x IN space B /\ &k / 2 pow N <= u x /\
1038                                  u x < (&k + 1) / 2 pow N} x) (count (4 ** N))) +
1039          pos_fn_integral (space B,subsets B,distr M f)
1040            (\x. 2 pow N * indicator_fn {x | x IN space B /\ 2 pow N <= u x} x)’
1041 >- (HO_MATCH_MP_TAC pos_fn_integral_add \\
1042     ASM_SIMP_TAC std_ss [m_space_def, measurable_sets_def] \\
1043     CONJ_TAC (* 0 <= SIGMA *)
1044     >- (rpt STRIP_TAC \\
1045         MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> SIMP_TAC std_ss [FINITE_COUNT] \\
1046         Q.X_GEN_TAC ‘n’ >> STRIP_TAC \\
1047         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
1048     CONJ_TAC (* 0 <= 2 pow N * indicator_fn *)
1049     >- (rpt STRIP_TAC \\
1050         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS] \\
1051         MATCH_MP_TAC pow_pos_le >> REWRITE_TAC [le_02]) \\
1052     reverse CONJ_TAC (* 2 pow N * indicator_fn IN Borel_measurable *)
1053     >- (HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR \\
1054         rw [SPACE] >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST >> rw [] \\
1055                        Q.EXISTS_TAC ‘2 pow N’ >> rw []) \\
1056        ‘{x | x IN space B /\ 2 pow N <= u x} = {x | 2 pow N <= u x} INTER space B’
1057            by SET_TAC [] >> POP_ORW \\
1058         METIS_TAC [IN_MEASURABLE_BOREL_ALL]) \\
1059  (* SIGMA IN Borel_measurable *)
1060     MATCH_MP_TAC (INST_TYPE [“:'b” |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
1061     ASM_SIMP_TAC std_ss [SPACE, space_def] \\
1062     qexistsl_tac [‘\k x. &k / 2 pow N *
1063                          indicator_fn
1064                            {x | x IN space B /\ &k / 2 pow N <= u x /\
1065                                 u x < (&k + 1) / 2 pow N} x’, ‘count (4 ** N)’] \\
1066     SIMP_TAC std_ss [FINITE_COUNT] \\
1067     reverse CONJ_TAC
1068     >- (rpt GEN_TAC >> STRIP_TAC \\
1069         MATCH_MP_TAC pos_not_neginf \\
1070         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
1071     rpt STRIP_TAC \\
1072     HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR >> rw []
1073     >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST >> rw [] \\
1074         Q.EXISTS_TAC ‘&i / 2 pow N’ >> rw []) \\
1075    ‘{x | x IN space B /\ &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} =
1076     {x | &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} INTER space B’
1077        by SET_TAC [] >> POP_ORW \\
1078     METIS_TAC [IN_MEASURABLE_BOREL_ALL]) >> Rewr'
1079 (* RHS simplification *)
1080 >> Know ‘pos_fn_integral M
1081            (\x. SIGMA
1082                   (\k. &k / 2 pow N *
1083                        indicator_fn
1084                          {x | x IN space B /\ &k / 2 pow N <= u x /\
1085                               u x < (&k + 1) / 2 pow N} (f x)) (count (4 ** N)) +
1086                 2 pow N * indicator_fn {x | x IN space B /\ 2 pow N <= u x} (f x)) =
1087          pos_fn_integral M
1088            (\x. SIGMA
1089                   (\k. &k / 2 pow N *
1090                        indicator_fn
1091                          {x | x IN space B /\ &k / 2 pow N <= u x /\
1092                               u x < (&k + 1) / 2 pow N} (f x)) (count (4 ** N))) +
1093          pos_fn_integral M
1094            (\x. 2 pow N * indicator_fn {x | x IN space B /\ 2 pow N <= u x} (f x))’
1095 >- (HO_MATCH_MP_TAC pos_fn_integral_add >> ASM_SIMP_TAC std_ss [] \\
1096     CONJ_TAC (* 0 <= SIGMA *)
1097     >- (rpt STRIP_TAC \\
1098         MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> SIMP_TAC std_ss [FINITE_COUNT] \\
1099         Q.X_GEN_TAC ‘n’ >> STRIP_TAC \\
1100         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
1101     CONJ_TAC (* 0 <= 2 pow N * indicator_fn *)
1102     >- (rpt STRIP_TAC \\
1103         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS] \\
1104         MATCH_MP_TAC pow_pos_le >> REWRITE_TAC [le_02]) \\
1105     reverse CONJ_TAC (* 2 pow N * indicator_fn IN Borel_measurable *)
1106     >- (‘(\x. 2 pow N *
1107               indicator_fn {x | x IN space B /\ 2 pow N <= u x} (f x)) =
1108          (\x. 2 pow N *
1109               indicator_fn {x | x IN space B /\ 2 pow N <= u x} x) o f’
1110            by rw [o_DEF] >> POP_ORW \\
1111         MATCH_MP_TAC MEASURABLE_COMP >> Q.EXISTS_TAC ‘B’ >> art [] \\
1112         HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR \\
1113         rw [] >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST >> rw [] \\
1114                   Q.EXISTS_TAC ‘2 pow N’ >> rw []) \\
1115        ‘{x | x IN space B /\ 2 pow N <= u x} = {x | 2 pow N <= u x} INTER space B’
1116            by SET_TAC [] >> POP_ORW \\
1117         METIS_TAC [IN_MEASURABLE_BOREL_ALL]) \\
1118  (* SIGMA IN Borel_measurable *)
1119     MATCH_MP_TAC (INST_TYPE [“:'b” |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
1120     ASM_SIMP_TAC std_ss [SPACE, space_def] \\
1121     qexistsl_tac [‘\k x. &k / 2 pow N *
1122                          indicator_fn
1123                            {x | x IN space B /\ &k / 2 pow N <= u x /\
1124                                 u x < (&k + 1) / 2 pow N} (f x)’,
1125                   ‘count (4 ** N)’] \\
1126     SIMP_TAC std_ss [FINITE_COUNT] \\
1127     CONJ_TAC >- FULL_SIMP_TAC std_ss [measure_space_def] \\
1128     reverse CONJ_TAC
1129     >- (rpt GEN_TAC >> STRIP_TAC \\
1130         MATCH_MP_TAC pos_not_neginf \\
1131         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
1132     rpt STRIP_TAC \\
1133    ‘(\x. &i / 2 pow N * indicator_fn {x | x IN space B /\ &i / 2 pow N <= u x /\
1134                                           u x < (&i + 1) / 2 pow N} (f x)) =
1135     (\x. &i / 2 pow N * indicator_fn {x | x IN space B /\ &i / 2 pow N <= u x /\
1136                                           u x < (&i + 1) / 2 pow N} x) o f’
1137        by RW_TAC std_ss [o_DEF] >> POP_ORW \\
1138     MATCH_MP_TAC MEASURABLE_COMP >> Q.EXISTS_TAC ‘B’ >> art [] \\
1139     HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR >> rw []
1140     >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST >> rw [] \\
1141         Q.EXISTS_TAC ‘&i / 2 pow N’ >> rw []) \\
1142    ‘{x | x IN space B /\ &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} =
1143     {x | &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} INTER space B’
1144        by SET_TAC [] >> POP_ORW \\
1145     METIS_TAC [IN_MEASURABLE_BOREL_ALL]) >> Rewr'
1146 (* LHS simplification *)
1147 >> Know ‘pos_fn_integral (space B,subsets B,distr M f)
1148           (\x. SIGMA
1149               (\k. (\k x. &k / 2 pow N *
1150                           indicator_fn
1151                          {x | x IN space B /\ &k / 2 pow N <= u x /\
1152                               u x < (&k + 1) / 2 pow N} x) k x) (count (4 ** N))) =
1153          SIGMA (\k. pos_fn_integral (space B,subsets B,distr M f)
1154                      ((\k x. &k / 2 pow N *
1155                              indicator_fn
1156                                {x | x IN space B /\ &k / 2 pow N <= u x /\
1157                                     u x < (&k + 1) / 2 pow N} x) k))
1158                (count (4 ** N))’
1159 >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] pos_fn_integral_sum) \\
1160     ASM_SIMP_TAC std_ss [FINITE_COUNT, m_space_def, measurable_sets_def, SPACE] \\
1161     CONJ_TAC (* 0 <= &i / 2 pow N * indicator_fn *)
1162     >- (rpt STRIP_TAC \\
1163         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
1164     rpt STRIP_TAC \\
1165     HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR >> art [] \\
1166     CONJ_TAC >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST >> rw [] \\
1167                  Q.EXISTS_TAC ‘&i / 2 pow N’ >> rw []) \\
1168    ‘{x | x IN space B /\ &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} =
1169     {x | &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} INTER space B’
1170        by SET_TAC [] >> POP_ORW \\
1171     METIS_TAC [IN_MEASURABLE_BOREL_ALL])
1172 >> BETA_TAC >> Rewr'
1173 >> Know ‘pos_fn_integral M
1174           (\x. SIGMA
1175                  (\k. (\k x. &k / 2 pow N *
1176                              indicator_fn
1177                                {x | x IN space B /\ &k / 2 pow N <= u x /\
1178                                     u x < (&k + 1) / 2 pow N} (f x)) k x)
1179                (count (4 ** N))) =
1180          SIGMA (\k. pos_fn_integral M
1181                      ((\k x. &k / 2 pow N *
1182                              indicator_fn
1183                                {x | x IN space B /\ &k / 2 pow N <= u x /\
1184                                     u x < (&k + 1) / 2 pow N} (f x)) k))
1185                (count (4 ** N))’
1186 >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] pos_fn_integral_sum) \\
1187     ASM_SIMP_TAC std_ss [FINITE_COUNT] \\
1188     CONJ_TAC (* 0 <= &i / 2 pow N * indicator_fn *)
1189     >- (rpt STRIP_TAC \\
1190         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
1191     rpt STRIP_TAC \\
1192    ‘(\x. &i / 2 pow N *
1193          indicator_fn {x | x IN space B /\ &i / 2 pow N <= u x /\
1194                            u x < (&i + 1) / 2 pow N} (f x)) =
1195     (\x. &i / 2 pow N *
1196          indicator_fn {x | x IN space B /\ &i / 2 pow N <= u x /\
1197                            u x < (&i + 1) / 2 pow N} x) o f’
1198        by RW_TAC std_ss [o_DEF] >> POP_ORW \\
1199     MATCH_MP_TAC MEASURABLE_COMP >> Q.EXISTS_TAC ‘B’ >> art [] \\
1200     HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR >> art [] \\
1201     CONJ_TAC >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST >> rw [] \\
1202                  Q.EXISTS_TAC ‘&i / 2 pow N’ >> rw []) \\
1203    ‘{x | x IN space B /\ &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} =
1204     {x | &i / 2 pow N <= u x /\ u x < (&i + 1) / 2 pow N} INTER space B’
1205        by SET_TAC [] >> POP_ORW \\
1206     METIS_TAC [IN_MEASURABLE_BOREL_ALL])
1207 >> BETA_TAC >> Rewr'
1208 (* LHS simplification *)
1209 >> Know ‘pos_fn_integral (space B,subsets B,distr M f)
1210            (\x. 2 pow N * indicator_fn {x | x IN space B /\ 2 pow N <= u x} x) =
1211          2 pow N *
1212          pos_fn_integral (space B,subsets B,distr M f)
1213                          (indicator_fn {x | x IN space B /\ 2 pow N <= u x})’
1214 >- (‘2 pow N = Normal (2 pow N)’
1215       by METIS_TAC [extreal_of_num_def, extreal_pow_def] >> POP_ORW \\
1216     MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr'
1217 (* RHS simplification *)
1218 >> Know ‘pos_fn_integral M
1219            (\x. 2 pow N *
1220                 indicator_fn {x | x IN space B /\ 2 pow N <= u x} (f x)) =
1221          2 pow N *
1222          pos_fn_integral M (\x. indicator_fn {x | x IN space B /\ 2 pow N <= u x}
1223                                 (f x))’
1224 >- (‘2 pow N = Normal (2 pow N)’
1225       by METIS_TAC [extreal_of_num_def, extreal_pow_def] >> POP_ORW \\
1226     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr'
1227 (* LHS simplification *)
1228 >> Know ‘!k. pos_fn_integral (space B,subsets B,distr M f)
1229                (\x. &k / 2 pow N *
1230                     indicator_fn {x | x IN space B /\ &k / 2 pow N <= u x /\
1231                                       u x < (&k + 1) / 2 pow N} x) =
1232              &k / 2 pow N *
1233              pos_fn_integral (space B,subsets B,distr M f)
1234                (indicator_fn {x | x IN space B /\ &k / 2 pow N <= u x /\
1235                                   u x < (&k + 1) / 2 pow N})’
1236 >- (GEN_TAC \\
1237    ‘!n. 0:real < 2 pow n’ by RW_TAC real_ss [REAL_POW_LT] \\
1238    ‘!n. 0:real <> 2 pow n’ by RW_TAC real_ss [REAL_LT_IMP_NE] \\
1239    ‘!n k. &k / 2 pow n = Normal (&k / 2 pow n)’
1240       by METIS_TAC [extreal_of_num_def, extreal_pow_def, extreal_div_eq] \\
1241     POP_ORW \\
1242     MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS] \\
1243     MATCH_MP_TAC REAL_LE_DIV >> rw []) >> Rewr'
1244 (* RHS simplification *)
1245 >> Know ‘!k. pos_fn_integral M
1246                (\x. &k / 2 pow N *
1247                     indicator_fn {x | x IN space B /\ &k / 2 pow N <= u x /\
1248                                       u x < (&k + 1) / 2 pow N} (f x)) =
1249              &k / 2 pow N *
1250              pos_fn_integral M
1251                (\x. indicator_fn {x | x IN space B /\ &k / 2 pow N <= u x /\
1252                                       u x < (&k + 1) / 2 pow N} (f x))’
1253 >- (GEN_TAC \\
1254    ‘!n. 0:real < 2 pow n’ by RW_TAC real_ss [REAL_POW_LT] \\
1255    ‘!n. 0:real <> 2 pow n’ by RW_TAC real_ss [REAL_LT_IMP_NE] \\
1256    ‘!n k. &k / 2 pow n = Normal (&k / 2 pow n)’
1257       by METIS_TAC [extreal_of_num_def, extreal_pow_def, extreal_div_eq] \\
1258     POP_ORW \\
1259     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS] \\
1260     MATCH_MP_TAC REAL_LE_DIV >> rw []) >> Rewr'
1261 (* stage work *)
1262 >> Suff ‘!s. s IN subsets B ==>
1263             (pos_fn_integral (space B,subsets B,distr M f) (indicator_fn s) =
1264              pos_fn_integral M (\x. indicator_fn s (f x)))’
1265 >- (DISCH_TAC \\
1266    ‘!k. {x | x IN space B /\ &k / 2 pow N <= u x /\ u x < (&k + 1) / 2 pow N} =
1267         {x | &k / 2 pow N <= u x /\ u x < (&k + 1) / 2 pow N} INTER space B’
1268       by SET_TAC [] >> POP_ORW \\
1269    ‘{x | x IN space B /\ 2 pow N <= u x} = {x | 2 pow N <= u x} INTER space B’
1270       by SET_TAC [] >> POP_ORW \\
1271     Know ‘pos_fn_integral (space B,subsets B,distr M f)
1272             (indicator_fn ({x | 2 pow N <= u x} INTER space B)) =
1273           pos_fn_integral M
1274             (\x. indicator_fn ({x | 2 pow N <= u x} INTER space B) (f x))’
1275     >- (FIRST_X_ASSUM MATCH_MP_TAC \\
1276         METIS_TAC [IN_MEASURABLE_BOREL_ALL]) >> Rewr' \\
1277     Know ‘!k. pos_fn_integral (space B,subsets B,distr M f)
1278                 (indicator_fn
1279                    ({x | &k / 2 pow N <= u x /\ u x < (&k + 1) / 2 pow N} INTER
1280                     space B)) =
1281               pos_fn_integral M
1282                 (\x. indicator_fn
1283                        ({x | &k / 2 pow N <= u x /\ u x < (&k + 1) / 2 pow N}
1284                         INTER space B) (f x))’
1285     >- (GEN_TAC >> FIRST_X_ASSUM MATCH_MP_TAC \\
1286         METIS_TAC [IN_MEASURABLE_BOREL_ALL]) >> Rewr)
1287 (* core proof *)
1288 >> rpt STRIP_TAC
1289 >> Know ‘pos_fn_integral (space B,subsets B,distr M f) (indicator_fn s) =
1290          measure (space B,subsets B,distr M f) s’
1291 >- (MATCH_MP_TAC pos_fn_integral_indicator >> rw []) >> Rewr'
1292 >> SIMP_TAC std_ss [measure_def, distr_def]
1293 >> Know ‘pos_fn_integral M (\x. indicator_fn s (f x)) =
1294          pos_fn_integral M (indicator_fn (PREIMAGE f s INTER m_space M))’
1295 >- (MATCH_MP_TAC pos_fn_integral_cong >> rw [INDICATOR_FN_POS] \\
1296     rw [indicator_fn_def]) >> Rewr'
1297 >> MATCH_MP_TAC EQ_SYM
1298 >> MATCH_MP_TAC pos_fn_integral_indicator
1299 >> fs [IN_MEASURABLE]
1300QED
1301
1302(* Theorem 15.1, Part II (transformation theorem, general form) [1, p.154] *)
1303Theorem integral_distr :
1304    !M B f u. measure_space M /\ sigma_algebra B /\
1305              f IN measurable (m_space M, measurable_sets M) B /\
1306              u IN measurable B Borel ==>
1307             (integral (space B,subsets B,distr M f) u = integral M (u o f)) /\
1308             (integrable (space B,subsets B,distr M f) u = integrable M (u o f))
1309Proof
1310    rpt GEN_TAC >> STRIP_TAC
1311 >> simp [integrable_def, integral_def]
1312 >> Suff ‘(pos_fn_integral (space B,subsets B,distr M f) (fn_plus u) =
1313           pos_fn_integral M (fn_plus (u o f))) /\
1314          (pos_fn_integral (space B,subsets B,distr M f) (fn_minus u) =
1315           pos_fn_integral M (fn_minus (u o f)))’
1316 >- (Rewr >> EQ_TAC >> rw [] \\
1317     MATCH_MP_TAC MEASURABLE_COMP >> Q.EXISTS_TAC ‘B’ >> art [])
1318 >> Know ‘fn_plus (u o f) = fn_plus u o f’
1319 >- rw [FN_PLUS_ALT, o_DEF] >> DISCH_THEN (fs o wrap)
1320 >> Know ‘fn_minus (u o f) = fn_minus u o f’
1321 >- rw [FN_MINUS_ALT, o_DEF] >> DISCH_THEN (fs o wrap)
1322 >> CONJ_TAC
1323 >| [ (* goal 1 (of 2) *)
1324      MATCH_MP_TAC pos_fn_integral_distr >> rw [FN_PLUS_POS] \\
1325      MATCH_MP_TAC IN_MEASURABLE_BOREL_FN_PLUS >> art [],
1326      (* goal 2 (of 2) *)
1327      MATCH_MP_TAC pos_fn_integral_distr >> rw [FN_MINUS_POS] \\
1328      MATCH_MP_TAC IN_MEASURABLE_BOREL_FN_MINUS >> art [] ]
1329QED
1330
1331Theorem pos_fn_integral_cong_measure_old[local] :
1332    !sp sts u v f.
1333        measure_space (sp,sts,u) /\ measure_space (sp,sts,v) /\
1334        (!s. s IN sts ==> u s = v s) /\ (!x. x IN sp ==> 0 <= f x) ==>
1335        (pos_fn_integral (sp,sts,u) f = pos_fn_integral (sp,sts,v) f)
1336Proof
1337    rw [pos_fn_integral_def]
1338 >> Suff ‘!g. psfis (sp,sts,u) g = psfis (sp,sts,v) g’ >- rw []
1339 >> rw [psfis_def, Once EXTENSION, IN_IMAGE]
1340 >> EQ_TAC >> STRIP_TAC (* 2 subgoals, same tactics *)
1341 >> ( fs [psfs_def, pos_simple_fn_def] \\
1342      rename1 ‘!i. i IN s ==> 0 <= z i’ \\
1343      Q.EXISTS_TAC ‘(s,a,z)’ \\
1344      REV_FULL_SIMP_TAC std_ss [pos_simple_fn_integral_def, measure_def] \\
1345      Q.PAT_X_ASSUM ‘x = _’ K_TAC \\
1346      Q.PAT_X_ASSUM ‘_ = (s,a,z)’ K_TAC \\
1347      irule EXTREAL_SUM_IMAGE_EQ >> rfs [] \\
1348      DISJ1_TAC >> NTAC 2 STRIP_TAC \\
1349      MATCH_MP_TAC pos_not_neginf \\
1350      MATCH_MP_TAC le_mul \\
1351      CONJ_TAC >- (rw [extreal_of_num_def, extreal_le_eq]) \\
1352      rename1 ‘y IN s’ \\
1353     ‘positive (sp,sts,v)’ by PROVE_TAC [MEASURE_SPACE_POSITIVE] \\
1354      fs [positive_def] )
1355QED
1356
1357Theorem pos_fn_integral_cong_measure :
1358    !sp sts u v f.
1359        measure_space (sp,sts,u) /\
1360       (!s. s IN sts ==> u s = v s) /\ (!x. x IN sp ==> 0 <= f x) ==>
1361        pos_fn_integral (sp,sts,u) f = pos_fn_integral (sp,sts,v) f
1362Proof
1363    rpt STRIP_TAC
1364 >> MATCH_MP_TAC pos_fn_integral_cong_measure_old >> art []
1365 >> MATCH_MP_TAC measure_space_eq
1366 >> Q.EXISTS_TAC ‘(sp,sts,u)’ >> simp []
1367QED
1368
1369Theorem pos_fn_integral_cong_measure_old'[local] :
1370    !m1 m2 f. measure_space m1 /\ measure_space m2 /\ measure_space_eq m1 m2 /\
1371             (!x. x IN m_space m1 ==> 0 <= f x) ==>
1372              pos_fn_integral m1 f = pos_fn_integral m2 f
1373Proof
1374    RW_TAC std_ss [measure_space_eq_def]
1375 >> MP_TAC (Q.SPECL [‘m_space m1’, ‘measurable_sets m1’, ‘measure m1’,
1376                     ‘measure m2’, ‘f’] pos_fn_integral_cong_measure)
1377 >> rw []
1378QED
1379
1380Theorem pos_fn_integral_cong_measure' :
1381    !m1 m2 f. measure_space m1 /\ measure_space_eq m1 m2 /\
1382             (!x. x IN m_space m1 ==> 0 <= f x) ==>
1383              pos_fn_integral m1 f = pos_fn_integral m2 f
1384Proof
1385    rpt STRIP_TAC
1386 >> MATCH_MP_TAC pos_fn_integral_cong_measure_old' >> art []
1387 >> MATCH_MP_TAC measure_space_eq
1388 >> Q.EXISTS_TAC ‘m1’
1389 >> fs [measure_space_eq_def]
1390QED
1391
1392Theorem pos_fn_integral_distr_of :
1393    !M N f u.
1394        measure_space M /\ measure_space N /\
1395        f IN measurable (measurable_space M) (measurable_space N) /\
1396        u IN Borel_measurable (measurable_space N) /\
1397       (!x. x IN m_space N ==> 0 <= u x) ==>
1398        pos_fn_integral (distr_of M N f) u = pos_fn_integral M (u o f)
1399Proof
1400    rpt STRIP_TAC
1401 >> Know ‘measure_space (distr_of M N f)’
1402 >- (MATCH_MP_TAC measure_space_distr_of >> art [])
1403 >> DISCH_TAC
1404 >> Know ‘measure_space (m_space N,measurable_sets N,distr M f)’
1405 >- (qabbrev_tac ‘B = measurable_space N’ \\
1406    ‘m_space N = space B’ by rw [Abbr ‘B’] >> POP_ORW \\
1407    ‘measurable_sets N = subsets B’ by rw [Abbr ‘B’] >> POP_ORW \\
1408     MATCH_MP_TAC measure_space_distr \\
1409     rw [MEASURE_SPACE_SIGMA_ALGEBRA, Abbr ‘B’])
1410 >> DISCH_TAC
1411 >> Know ‘pos_fn_integral (distr_of M N f) u =
1412          pos_fn_integral (m_space N,measurable_sets N,distr M f) u’
1413 >- (MATCH_MP_TAC pos_fn_integral_cong_measure' >> art [] \\
1414     rw [measure_space_eq_def, distr_of, distr_def])
1415 >> Rewr'
1416 >> qabbrev_tac ‘B = measurable_space N’
1417 >> ‘m_space N = space B’ by rw [Abbr ‘B’] >> POP_ORW
1418 >> ‘measurable_sets N = subsets B’ by rw [Abbr ‘B’] >> POP_ORW
1419 >> MATCH_MP_TAC pos_fn_integral_distr
1420 >> rw [MEASURE_SPACE_SIGMA_ALGEBRA, Abbr ‘B’]
1421QED
1422
1423Theorem integral_cong_measure_base[local] :
1424    !sp sts u v f.
1425        measure_space (sp,sts,u) /\ measure_space (sp,sts,v) /\
1426       (!s. s IN sts ==> (u s = v s)) ==>
1427       (integral (sp,sts,u) f = integral (sp,sts,v) f) /\
1428       (integrable (sp,sts,u) f <=> integrable (sp,sts,v) f)
1429Proof
1430    rpt GEN_TAC >> STRIP_TAC
1431 >> simp [integral_def, integrable_def]
1432 >> Suff ‘pos_fn_integral (sp,sts,u) (fn_plus f) =
1433          pos_fn_integral (sp,sts,v) (fn_plus f) /\
1434          pos_fn_integral (sp,sts,u) (fn_minus f) =
1435          pos_fn_integral (sp,sts,v) (fn_minus f)’ >- rw []
1436 >> CONJ_TAC (* 2 subgoals, same tactics *)
1437 >> MATCH_MP_TAC pos_fn_integral_cong_measure
1438 >> rw [FN_PLUS_POS, FN_MINUS_POS]
1439QED
1440
1441Theorem integral_cong_measure_old[local] :
1442    !sp sts u v f.
1443        measure_space (sp,sts,u) /\ measure_space (sp,sts,v) /\
1444       (!s. s IN sts ==> (u s = v s)) ==>
1445       (integral (sp,sts,u) f = integral (sp,sts,v) f)
1446Proof
1447    PROVE_TAC [integral_cong_measure_base]
1448QED
1449
1450Theorem integral_cong_measure :
1451    !sp sts u v f.
1452        measure_space (sp,sts,u) /\ (!s. s IN sts ==> u s = v s) ==>
1453        integral (sp,sts,u) f = integral (sp,sts,v) f
1454Proof
1455    rpt STRIP_TAC
1456 >> MATCH_MP_TAC integral_cong_measure_old >> art []
1457 >> MATCH_MP_TAC measure_space_eq
1458 >> Q.EXISTS_TAC ‘(sp,sts,u)’ >> simp []
1459QED
1460
1461Theorem integral_cong_measure_old'[local] :
1462    !m1 m2 f. measure_space m1 /\ measure_space m2 /\ measure_space_eq m1 m2 ==>
1463             (integral m1 f = integral m2 f)
1464Proof
1465    RW_TAC std_ss [measure_space_eq_def]
1466 >> MP_TAC (Q.SPECL [‘m_space m1’, ‘measurable_sets m1’, ‘measure m1’,
1467                     ‘measure m2’, ‘f’] integral_cong_measure) >> rw []
1468QED
1469
1470Theorem integral_cong_measure' :
1471    !m1 m2 f. measure_space m1 /\ measure_space_eq m1 m2 ==>
1472              integral m1 f = integral m2 f
1473Proof
1474    rpt STRIP_TAC
1475 >> MATCH_MP_TAC integral_cong_measure_old' >> art []
1476 >> MATCH_MP_TAC measure_space_eq
1477 >> Q.EXISTS_TAC ‘m1’
1478 >> fs [measure_space_eq_def]
1479QED
1480
1481Theorem integrable_cong_measure_old[local] :
1482    !sp sts u v f.
1483        measure_space (sp,sts,u) /\ measure_space (sp,sts,v) /\
1484       (!s. s IN sts ==> (u s = v s)) ==>
1485       (integrable (sp,sts,u) f <=> integrable (sp,sts,v) f)
1486Proof
1487    PROVE_TAC [integral_cong_measure_base]
1488QED
1489
1490Theorem integrable_cong_measure :
1491    !sp sts u v f.
1492        measure_space (sp,sts,u) /\ (!s. s IN sts ==> (u s = v s)) ==>
1493       (integrable (sp,sts,u) f <=> integrable (sp,sts,v) f)
1494Proof
1495    rpt STRIP_TAC
1496 >> MATCH_MP_TAC integrable_cong_measure_old >> art []
1497 >> MATCH_MP_TAC measure_space_eq
1498 >> Q.EXISTS_TAC ‘(sp,sts,u)’ >> simp []
1499QED
1500
1501Theorem integrable_cong_measure_old'[local] :
1502    !m1 m2 f. measure_space m1 /\ measure_space m2 /\ measure_space_eq m1 m2 ==>
1503             (integrable m1 f <=> integrable m2 f)
1504Proof
1505    RW_TAC std_ss [measure_space_eq_def]
1506 >> MP_TAC (Q.SPECL [‘m_space m1’, ‘measurable_sets m1’, ‘measure m1’,
1507                     ‘measure m2’, ‘f’] integrable_cong_measure) >> rw []
1508QED
1509
1510Theorem integrable_cong_measure' :
1511    !m1 m2 f. measure_space m1 /\ measure_space_eq m1 m2 ==>
1512             (integrable m1 f <=> integrable m2 f)
1513Proof
1514    rpt STRIP_TAC
1515 >> MATCH_MP_TAC integrable_cong_measure_old' >> art []
1516 >> MATCH_MP_TAC measure_space_eq
1517 >> Q.EXISTS_TAC ‘m1’
1518 >> fs [measure_space_eq_def]
1519QED
1520
1521(* ------------------------------------------------------------------------- *)
1522(*  Parameter-Dependent Integrals (Part of Chapter 12 of [1])                *)
1523(* ------------------------------------------------------------------------- *)
1524
1525(* Theorem 12.4 [1, p.99] (generalized from open intervals to open sets)
1526
1527   NOTE: ext_continuous_on_def is not used, because we want to make sure the
1528   type of u is (u :real -> 'a -> real) and see the “continuous_on” for real
1529   functions (real -> real) is preserved by integration.
1530
1531   By lebesgue_eq_gauge_integral (not available here), the conclusion is also
1532
1533      real (integral m (Normal o u t)) = integral UNIV (u t)
1534
1535   i.e. (\t. integral UNIV (u t)) continuous_on s
1536 *)
1537Theorem continuity_lemma :
1538    !s m u. measure_space m /\ open s /\
1539      (!t. t IN s ==> integrable m (Normal o u t)) /\
1540      (!x. x IN m_space m ==> (\t. u t x) continuous_on s) /\
1541      (?w. integrable m w /\
1542          (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
1543           !t x. t IN s /\ x IN m_space m ==> Normal (abs (u t x)) <= w x)
1544     ==>
1545      (\t. real (integral m (Normal o u t))) continuous_on s
1546Proof
1547    rpt STRIP_TAC
1548 >> MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON
1549 >> Q.X_GEN_TAC ‘t’ >> DISCH_TAC
1550 >> simp [CONTINUOUS_AT_SEQUENTIALLY]
1551 >> Q.X_GEN_TAC ‘h’
1552 >> DISCH_TAC
1553 (* NOTE: Some initial f(i) may fall outside of (a,b), we need ti shift the
1554    index so that all values are inside (a,b).
1555  *)
1556 >> Know ‘?N. !n. N <= n ==> h n IN s’
1557 >- (Q.PAT_X_ASSUM ‘open s’ MP_TAC >> simp [open_def] \\
1558     DISCH_THEN (MP_TAC o Q.SPEC ‘t’) >> rw [] \\
1559     Q.PAT_X_ASSUM ‘(h --> t) sequentially’ MP_TAC \\
1560     rw [LIM_SEQUENTIALLY] \\
1561     POP_ASSUM (MP_TAC o Q.SPEC ‘e’) >> rw [] \\
1562     Q.EXISTS_TAC ‘N’ >> rpt STRIP_TAC \\
1563     FIRST_X_ASSUM MATCH_MP_TAC \\
1564     FIRST_X_ASSUM MATCH_MP_TAC >> art [])
1565 >> STRIP_TAC (* this asserts ‘N’ *)
1566 (* applying SEQ_OFFSET *)
1567 >> qabbrev_tac ‘g = \i. h (i + N)’
1568 >> ‘!n. g n IN s’ by rw [Abbr ‘g’]
1569 >> Know ‘(g --> t) sequentially’
1570 >- (qunabbrev_tac ‘g’ \\
1571     MATCH_MP_TAC SEQ_OFFSET >> art [])
1572 >> DISCH_TAC
1573 (* stage work *)
1574 >> simp [o_DEF]
1575 >> HO_MATCH_MP_TAC SEQ_OFFSET_REV
1576 >> Q.EXISTS_TAC ‘N’ >> simp []
1577 >> qabbrev_tac ‘fi = \i x. Normal (u (g i) x)’
1578 >> ‘(\x. real (integral m (\y. Normal (u (g x) y)))) =
1579     (\i. real (integral m (fi i)))’
1580       by rw [FUN_EQ_THM, Abbr ‘fi’] >> POP_ORW
1581 >> qabbrev_tac ‘f = \x. Normal (u t x)’
1582 (* applying lebesgue_dominated_convergence *)
1583 >> MATCH_MP_TAC (cj 2 lebesgue_dominated_convergence) >> art []
1584 >> CONJ_TAC (* !i. integrable m (fi i) *)
1585 >- (rw [Abbr ‘fi’] \\
1586     Q.PAT_X_ASSUM ‘!t. _ ==> integrable m (Normal o u t)’ MP_TAC \\
1587     rw [o_DEF])
1588 >> CONJ_TAC >- rw [Abbr ‘fi’]
1589 >> CONJ_TAC >- rw [Abbr ‘f’]
1590 >> reverse CONJ_TAC (* ?w. integrable m w /\ ... *)
1591 >- (Q.EXISTS_TAC ‘w’ >> art [] \\
1592     rw [Abbr ‘fi’, extreal_abs_def])
1593 (* stage work *)
1594 >> rw [LIM_SEQUENTIALLY, Abbr ‘fi’, Abbr ‘f’]
1595 >> Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> (\t. u t x) continuous_on _’
1596      (MP_TAC o Q.SPEC ‘x’)
1597 >> rw [continuous_on]
1598 >> POP_ASSUM (MP_TAC o Q.SPEC ‘t’) >> rw []
1599 >> POP_ASSUM (MP_TAC o Q.SPEC ‘e’) >> rw [] (* this asserts ‘d’ *)
1600 >> Q.PAT_X_ASSUM ‘(g --> t) sequentially’ MP_TAC
1601 >> rw [LIM_SEQUENTIALLY]
1602 >> POP_ASSUM (MP_TAC o Q.SPEC ‘d’) >> simp []
1603 >> DISCH_THEN (Q.X_CHOOSE_THEN ‘N0’ STRIP_ASSUME_TAC)
1604 >> Q.EXISTS_TAC ‘N0’ >> rpt STRIP_TAC
1605 >> FIRST_X_ASSUM MATCH_MP_TAC >> simp []
1606QED
1607
1608fun shared_tactics () =
1609    Q.PAT_X_ASSUM ‘!e. 0 < e ==> _’ (MP_TAC o Q.SPEC ‘e’) >> simp [] \\
1610    DISCH_THEN (Q.X_CHOOSE_THEN ‘d’ STRIP_ASSUME_TAC) \\
1611    Q.EXISTS_TAC ‘d’ >> art [] \\
1612    Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
1613    Q.PAT_X_ASSUM ‘!t'. t' IN s /\ _ ==> _’ (MP_TAC o Q.SPEC ‘y’) >> simp [] \\
1614   ‘y - t <> 0’ by simp [] \\
1615   ‘0 < y - t \/ y - t < 0’ by METIS_TAC [REAL_LT_TOTAL]
1616    >- (‘0 <= y - t’ by simp [REAL_LT_IMP_LE] \\
1617        simp [real_sgn, ABS_REDUCE]) \\
1618   ‘sgn (y - t) = -1’ by simp [REAL_SGN_EQ] \\
1619    simp [ABS_EQ_NEG, REAL_INV_NEG] \\
1620    REWRITE_TAC [Once (GSYM ABS_NEG)] \\
1621    REWRITE_TAC [REAL_NEG_SUB] \\
1622    REWRITE_TAC [GSYM REAL_NEG_LMUL] \\
1623    REWRITE_TAC [REAL_SUB_NEG2];
1624
1625(* |- !m u.
1626        measure_space m /\ (!t. integrable m (Normal o u t)) /\
1627        (!x. x IN m_space m ==> (\t. u t x) continuous_on univ(:real)) /\
1628        (?w. integrable m w /\
1629             (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
1630             !t x. x IN m_space m ==> Normal (abs (u t x)) <= w x) ==>
1631        (\t. real (integral m (Normal o u t))) continuous_on univ(:real)
1632 *)
1633Theorem continuity_univ_lemma =
1634        continuity_lemma |> Q.SPEC ‘UNIV’ |> SRULE [OPEN_UNIV]
1635
1636(* Theorem 12.5 [1, p.100]
1637
1638   NOTE: “open s /\ connected s” is to make sure both OPEN_interval and UNIV
1639   are included.
1640 *)
1641Theorem differentiable_lemma :
1642    !s m u. measure_space (m :'a m_space) /\ open s /\ connected s /\
1643      (!t. t IN s ==> integrable m (Normal o u t)) /\
1644      (!x. x IN m_space m ==> (\t. u t x) differentiable_on s) /\
1645      (?w. integrable m w /\
1646          (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
1647           !t x. t IN s /\ x IN m_space m ==>
1648                 Normal (abs (diff1 (\t. u t x) t)) <= w x)
1649     ==> !t. t IN s ==>
1650             integrable m (\x. Normal (diff1 (\t. u t x) t)) /\
1651             ((\t. real (integral m (Normal o u t))) has_vector_derivative
1652               real (integral m (\x. (Normal (diff1 (\t. u t x) t))))
1653               ) (at t within s)
1654Proof
1655    rpt GEN_TAC >> STRIP_TAC
1656 >> Q.X_GEN_TAC ‘t’
1657 >> DISCH_TAC
1658 >> ‘!x. x IN m_space m ==> (\t. u t x) continuous_on s’
1659      by METIS_TAC [DIFFERENTIABLE_IMP_CONTINUOUS_ON]
1660 (* eliminating ‘diff1’ *)
1661 >> Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> _ differentiable_on s’ MP_TAC
1662 >> simp [differentiable_on, differentiable_alt_has_vector_derivative]
1663 >> simp [GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO, Once SWAP_FORALL_THM]
1664 >> simp [GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM]
1665 >> DISCH_THEN (Q.X_CHOOSE_THEN ‘g’ STRIP_ASSUME_TAC)
1666 (* stage work *)
1667 >> Know ‘!t x. t IN s /\ x IN m_space m ==> diff1 (\t. u t x) t = g t x’
1668 >- (qx_genl_tac [‘v’, ‘x’] >> STRIP_TAC \\
1669     MATCH_MP_TAC has_vector_derivative_imp_diff1 \\
1670     irule (iffLR HAS_VECTOR_DERIVATIVE_WITHIN_OPEN) \\
1671     Q.EXISTS_TAC ‘s’ >> simp [])
1672 >> DISCH_TAC
1673 >> Know ‘integrable m (\x. Normal (diff1 (\t. u t x) t)) <=>
1674          integrable m (Normal o g t)’
1675 >- (MATCH_MP_TAC integrable_cong >> rw [o_DEF])
1676 >> Rewr'
1677 >> Know ‘integral m (\x. Normal (diff1 (\t. u t x) t)) =
1678          integral m (Normal o g t)’
1679 >- (MATCH_MP_TAC integral_cong >> rw [o_DEF])
1680 >> Rewr'
1681 >> Know ‘!t x. t IN s /\ x IN m_space m ==> Normal (abs (g t x)) <= w x’
1682 >- (qx_genl_tac [‘v’, ‘x’] >> STRIP_TAC \\
1683     Q.PAT_X_ASSUM ‘!t x. t IN s /\ x IN m_space m ==> _’
1684       (MP_TAC o Q.SPECL [‘v’, ‘x’]) >> rw [] \\
1685     POP_ASSUM (REWRITE_TAC o wrap o SYM) \\
1686     FIRST_X_ASSUM MATCH_MP_TAC >> art [])
1687 >> POP_ASSUM K_TAC (* diff1 (\t. u t x) t = g t x *)
1688 >> Q.PAT_X_ASSUM ‘!t x. _ ==> Normal (abs (diff1 (\t. u t x) t)) <= _’ K_TAC
1689 >> DISCH_TAC
1690 (* stage work *)
1691 >> Q.PAT_ASSUM ‘!t x. _ ==> (_ has_vector_derivative _) (at t within s)’
1692      (MP_TAC o Q.SPEC ‘t’)
1693 >> SIMP_TAC std_ss [has_vector_derivative_within]
1694 >> qabbrev_tac ‘d = \x. x - t’ >> simp []
1695 >> simp [REAL_ADD_LDISTRIB, REAL_SUB_LDISTRIB]
1696 (* involving ‘sgn’ *)
1697 >> REWRITE_TAC [REWRITE_RULE [real_div] (GSYM REAL_SGN)]
1698 >> REWRITE_TAC [REAL_ARITH “a - (b + c) = a - b - (c :real)”]
1699 >> REWRITE_TAC [GSYM REAL_SUB_LDISTRIB]
1700 (* eliminating ‘sgn’ *)
1701 >> Know ‘!x. ((\t'. inv (abs (d t')) * (u t' x - u t x) -
1702                     sgn (d t') * g t x) --> 0) (at t within s) <=>
1703              ((\t'. inv (d t') * (u t' x - u t x)) --> g t x) (at t within s)’
1704 >- (rw [LIM_WITHIN, dist] \\
1705     EQ_TAC >> rw [Abbr ‘d’] >| (* 2 subgoals, same tactics *)
1706     [ (* goal 1 (of 2) *)
1707       shared_tactics (),
1708       (* goal 2 (of 2) *)
1709       shared_tactics () ])
1710 >> Rewr'
1711 >> qabbrev_tac ‘f = \t'. real (integral m (Normal o u t'))’
1712 >> qabbrev_tac ‘k = real (integral m (Normal o u t))’
1713 >> qabbrev_tac ‘c = real (integral m (Normal o g t))’
1714 >> simp []
1715 >> Know ‘((\t'. inv (abs (d t')) * (f t' - k) - c * sgn (d t')) --> 0)
1716           (at t within s) <=>
1717          ((\t'. inv (d t') * (f t' - k)) --> c) (at t within s)’
1718 >- (rw [LIM_WITHIN, dist] \\
1719     EQ_TAC >> rw [Abbr ‘d’] >| (* 2 subgoals, same tactics *)
1720     [ (* goal 1 (of 2) *)
1721       shared_tactics (),
1722       (* goal 2 (of 2) *)
1723       shared_tactics () ])
1724 >> Rewr'
1725 (* stage work *)
1726 >> simp [LIM_WITHIN_SEQUENTIALLY]
1727 >> simp [GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO, Once SWAP_FORALL_THM, o_DEF]
1728 >> DISCH_TAC
1729 (* integrable m (\x. Normal (g x))
1730
1731    NOTE: Here we need to construct a concrete sequence which converges to t and
1732    is always inside s (by finding a open ball around t in s)
1733
1734    For applying MVT, we need to find a cball inside s. (OPEN_IN_CONTAINS_CBALL)
1735  *)
1736 >> CONJ_ASM1_TAC
1737 >- (MP_TAC (Q.SPEC ‘s’ OPEN_CONTAINS_CBALL) >> simp [] \\
1738     DISCH_THEN (MP_TAC o Q.SPEC ‘t’) \\
1739     simp [SUBSET_DEF, IN_CBALL] >> STRIP_TAC \\
1740     ASSUME_TAC (Q.SPEC ‘inv e’ SEQ_HARMONIC_OFFSET) \\
1741     qabbrev_tac ‘h = \n. inv (&n + inv e)’ \\
1742     Know ‘!i. 0 <= h i’
1743     >- (rw [Abbr ‘h’] \\
1744         MATCH_MP_TAC REAL_LE_ADD >> simp [REAL_LT_IMP_LE]) >> DISCH_TAC \\
1745     Know ‘!i. 0 < h (SUC i)’
1746     >- (rw [Abbr ‘h’] \\
1747         MATCH_MP_TAC REAL_LT_ADD >> simp []) >> DISCH_TAC \\
1748     Know ‘!i. h (SUC i) < e’
1749     >- (rw [Abbr ‘h’] \\
1750         Suff ‘inv (&SUC i + inv e) < inv (inv e)’
1751         >- REWRITE_TAC [REAL_INV_INV] \\
1752         MATCH_MP_TAC REAL_LT_INV >> simp []) >> DISCH_TAC \\
1753    ‘!i. abs (h (SUC i)) < e’ by rw [ABS_REDUCE] \\
1754     MP_TAC (Q.SPECL [‘h’, ‘0’, ‘1’] SEQ_OFFSET) >> simp [GSYM ADD1] \\
1755     DISCH_TAC \\
1756     Know ‘((\i. h (SUC i) + t) --> (0 + t)) sequentially’
1757     >- (HO_MATCH_MP_TAC real_topologyTheory.LIM_ADD \\
1758         simp [real_topologyTheory.LIM_CONST]) \\
1759     simp [] >> DISCH_TAC \\
1760     qabbrev_tac ‘h1 = \i. h (SUC i) + t’ \\
1761     Know ‘!n. h1 n IN cball (t,e) /\ h1 n <> t’
1762     >- (Q.X_GEN_TAC ‘n’ >> simp [Abbr ‘h1’, IN_CBALL] \\
1763         reverse CONJ_TAC
1764         >- (Suff ‘0 < h (SUC n)’ >- REAL_ARITH_TAC >> simp []) \\
1765         ONCE_REWRITE_TAC [DIST_SYM] \\
1766         simp [Abbr ‘d’, dist, REAL_ADD_SUB_ALT, REAL_LT_IMP_LE]) \\
1767     DISCH_THEN (STRIP_ASSUME_TAC o SIMP_RULE bool_ss [FORALL_AND_THM]) \\
1768     Know ‘!n. h1 n IN s’
1769     >- (Q.X_GEN_TAC ‘n’ \\
1770         FIRST_X_ASSUM MATCH_MP_TAC >> fs [IN_CBALL]) >> DISCH_TAC \\
1771     qabbrev_tac ‘gi = \i x. inv (d (h1 i)) * (u (h1 i) x - u t x)’ \\
1772     Know ‘!x. x IN m_space m ==> ((\i. gi i x) --> g t x) sequentially’
1773     >- (rw [Abbr ‘gi’] \\
1774         FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> DISCH_TAC \\
1775     Know ‘!i. integrable m (\x. Normal (gi i x))’
1776     >- (Q.X_GEN_TAC ‘n’ \\
1777         simp [Abbr ‘gi’, GSYM extreal_mul_eq, GSYM extreal_sub_eq] \\
1778         HO_MATCH_MP_TAC integrable_cmul >> art [] \\
1779         HO_MATCH_MP_TAC integrable_sub >> simp [] \\
1780         Q.PAT_X_ASSUM ‘!t. t IN s ==> integrable m (Normal o u t)’ MP_TAC \\
1781         simp [o_DEF]) >> DISCH_TAC \\
1782  (* applying lebesgue_dominated_convergence *)
1783     MP_TAC (Q.SPECL [‘m’, ‘\x. Normal (g (t :real) x)’, ‘\i x. Normal (gi i x)’]
1784                     lebesgue_dominated_convergence) >> simp [] \\
1785     impl_tac
1786     >- (Q.EXISTS_TAC ‘w’ >> rw [extreal_abs_def] \\
1787      (* applying MVT_GENERAL_ALT *)
1788         Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> (\t. u t x) continuous_on s’
1789           (MP_TAC o Q.SPEC ‘x’) >> rw [] \\
1790         Q.PAT_X_ASSUM ‘!t x. x IN m_space m /\ t IN s ==> _’
1791           (MP_TAC o Q.SPEC ‘x’ o SIMP_RULE bool_ss [Once SWAP_FORALL_THM]) \\
1792         rw [] \\
1793         qabbrev_tac ‘u0 = (\t. u t x)’ \\
1794         qabbrev_tac ‘g0 = (\t. g t x)’ >> fs [] \\
1795         Q.PAT_X_ASSUM ‘!x. _ ==> ((\i. gi i x) --> g t x) sequentially’ K_TAC \\
1796         Q.PAT_X_ASSUM ‘!i. integrable m (\x. Normal (gi i x))’ K_TAC \\
1797         simp [Abbr ‘gi’, ABS_MUL, Abbr ‘d’] \\
1798         qabbrev_tac ‘t' = h1 i’ \\
1799        ‘t < t'’ by simp [Abbr ‘t'’, Abbr ‘h1’] \\
1800         MP_TAC (Q.SPECL [‘u0’, ‘g0’, ‘t’, ‘t'’] MVT_GENERAL_ALT) >> art [] \\
1801         impl_tac
1802         >- (CONJ_TAC
1803             >- (MATCH_MP_TAC CONTINUOUS_ON_SUBSET \\
1804                 Q.EXISTS_TAC ‘s’ >> simp [SUBSET_DEF, IN_INTERVAL] \\
1805                 Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
1806                 FIRST_X_ASSUM MATCH_MP_TAC \\
1807                 simp [dist, ABS_BOUNDS] \\
1808                 reverse CONJ_TAC
1809                 >- (Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘0’ \\
1810                     simp [REAL_LT_IMP_LE] \\
1811                     Q.PAT_X_ASSUM ‘t <= y’ MP_TAC >> REAL_ARITH_TAC) \\
1812                 Suff ‘y <= e + t’ >- REAL_ARITH_TAC \\
1813                 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘t'’ >> art [] \\
1814                 simp [Abbr ‘t'’, Abbr ‘h1’, REAL_LT_IMP_LE]) \\
1815             Q.X_GEN_TAC ‘y’ >> rw [IN_INTERVAL] \\
1816             irule (iffLR HAS_VECTOR_DERIVATIVE_WITHIN_OPEN) \\
1817             Q.EXISTS_TAC ‘s’ >> simp [] \\
1818             CONJ_ASM1_TAC
1819             >- (FIRST_X_ASSUM MATCH_MP_TAC \\
1820                 simp [dist, ABS_BOUNDS] \\
1821                 reverse CONJ_TAC
1822                 >- (MATCH_MP_TAC REAL_LT_IMP_LE \\
1823                     Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘0’ >> art [] \\
1824                     Q.PAT_X_ASSUM ‘t < y’ MP_TAC >> REAL_ARITH_TAC) \\
1825                 Suff ‘y <= e + t’ >- REAL_ARITH_TAC \\
1826                 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘t'’ \\
1827                 simp [Abbr ‘t'’, Abbr ‘h1’, REAL_LT_IMP_LE]) \\
1828             FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
1829         simp [IN_INTERVAL, ABS_MUL] \\
1830         Know ‘abs (inv (t' - t)) = inv (abs (t' - t))’
1831         >- (MATCH_MP_TAC ABS_INV \\
1832             POP_ASSUM MP_TAC >> REAL_ARITH_TAC) >> Rewr' \\
1833         DISCH_THEN (Q.X_CHOOSE_THEN ‘t0’ STRIP_ASSUME_TAC) \\
1834         Q_TAC (TRANS_TAC le_trans) ‘Normal (abs (g0 t0))’ \\
1835         reverse CONJ_TAC
1836         >- (simp [Abbr ‘g0’] \\
1837             FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
1838             FIRST_X_ASSUM MATCH_MP_TAC \\
1839             simp [dist, ABS_BOUNDS] \\
1840             reverse CONJ_TAC
1841             >- (MATCH_MP_TAC REAL_LT_IMP_LE \\
1842                 Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘0’ >> art [] \\
1843                 Q.PAT_X_ASSUM ‘t < t0’ MP_TAC >> REAL_ARITH_TAC) \\
1844             Suff ‘t0 <= e + t’ >- REAL_ARITH_TAC \\
1845             Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘t'’ \\
1846             simp [Abbr ‘t'’, Abbr ‘h1’, REAL_LT_IMP_LE]) \\
1847        ‘0 < t' - t’ by simp [REAL_SUB_LT] \\
1848         qabbrev_tac ‘d = t' - t’ \\
1849        ‘d <> 0 /\ 0 <= d’ by PROVE_TAC [REAL_LT_IMP_LE, REAL_LT_IMP_NE] \\
1850        ‘abs d <> 0’ by simp [GSYM ABS_NZ] \\
1851        ‘0 < abs d’ by simp [ABS_NZ'] \\
1852         simp [Once REAL_MUL_COMM, GSYM real_div] \\
1853         ONCE_REWRITE_TAC [REAL_MUL_COMM] >> art []) \\
1854     RW_TAC std_ss [])
1855 (* stage work *)
1856 >> Q.X_GEN_TAC ‘h’
1857 >> RW_TAC std_ss [Abbr ‘c’, Abbr ‘f’, Abbr ‘k’]
1858 >> Q.PAT_X_ASSUM ‘!h x. x IN m_space m /\ (!n. h n IN s /\ h n <> t) /\
1859                        (h --> t) sequentially ==> _’
1860                  (MP_TAC o Q.SPEC ‘h’) >> rw []
1861 >> qabbrev_tac ‘q = Normal o g t’
1862 >> qabbrev_tac ‘qi = \i x. Normal (inv (d (h i)) * (u (h i) x - u t x))’
1863 >> Know ‘!x. x IN m_space m ==>
1864              ((\i. real (qi i x)) --> real (q x)) sequentially’
1865 >- rw [Abbr ‘qi’, Abbr ‘q’]
1866 >> DISCH_TAC
1867 >> qmatch_abbrev_tac ‘(q' --> real (integral m q)) sequentially’
1868 >> Know ‘q' = (\i. real (integral m (qi i)))’
1869 >- (rw [Abbr ‘q'’, FUN_EQ_THM, Abbr ‘qi’, GSYM extreal_mul_eq] \\
1870     Know ‘integral m (\x. Normal (inv (d (h i))) *
1871                           Normal (u (h i) x - u t x)) =
1872           Normal (inv (d (h i))) *
1873           integral m (\x. Normal (u (h i) x - u t x))’
1874     >- (HO_MATCH_MP_TAC integral_cmul >> art [] \\
1875         simp [GSYM extreal_sub_eq] \\
1876         HO_MATCH_MP_TAC integrable_sub' >> art [] \\
1877         Q.PAT_X_ASSUM ‘!t. t IN s ==> integrable m (Normal o u t)’ MP_TAC \\
1878         simp [o_DEF]) >> Rewr' \\
1879     simp [GSYM extreal_sub_eq] \\
1880     Know ‘integral m (\x. Normal (u (h i) x) - Normal (u t x)) =
1881           integral m (Normal o u (h i)) - integral m (Normal o u t)’
1882     >- (simp [o_DEF] \\
1883         HO_MATCH_MP_TAC integral_sub' >> art [] \\
1884         Q.PAT_X_ASSUM ‘!t. t IN s ==> integrable m (Normal o u t)’ MP_TAC \\
1885         simp [o_DEF]) >> Rewr' \\
1886     qmatch_abbrev_tac ‘c * (real a - real b) = _’ \\
1887    ‘a <> PosInf /\ a <> NegInf /\ b <> PosInf /\ b <> NegInf’
1888       by METIS_TAC [integrable_finite_integral] \\
1889  (* applying mul_real *)
1890     Know ‘real (Normal c * (a - b)) = real (Normal c) * real (a - b)’
1891     >- (MATCH_MP_TAC mul_real >> simp [] \\
1892         METIS_TAC [sub_not_infty]) >> Rewr' \\
1893     Know ‘real (a - b) = real a - real b’
1894     >- (MATCH_MP_TAC sub_real >> art []) >> Rewr' \\
1895     simp [])
1896 >> Rewr'
1897 >> qunabbrev_tac ‘q'’
1898 (* applying lebesgue_dominated_convergence, again *)
1899 >> MATCH_MP_TAC (cj 2 lebesgue_dominated_convergence) >> art []
1900 >> CONJ_TAC
1901 >- (rw [Abbr ‘qi’, GSYM extreal_mul_eq] \\
1902     HO_MATCH_MP_TAC integrable_cmul >> art [] \\
1903     simp [GSYM extreal_sub_eq] \\
1904     HO_MATCH_MP_TAC integrable_sub' >> art [] \\
1905     Q.PAT_X_ASSUM ‘!t. t IN s ==> integrable m (Normal o u t)’ MP_TAC \\
1906     simp [o_DEF])
1907 >> CONJ_TAC >- rw [Abbr ‘qi’]
1908 >> CONJ_TAC >- rw [Abbr ‘q’, o_DEF]
1909 (* stage work *)
1910 >> Q.EXISTS_TAC ‘w’ >> art []
1911 >> RW_TAC std_ss [Abbr ‘qi’, extreal_abs_def]
1912 >> Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> (\t. u t x) continuous_on s’
1913      (MP_TAC o Q.SPEC ‘x’)
1914 >> Q.PAT_X_ASSUM ‘!t x. x IN m_space m /\ t IN s ==> _’
1915      (MP_TAC o Q.SPEC ‘x’ o SIMP_RULE bool_ss [Once SWAP_FORALL_THM])
1916 >> qabbrev_tac ‘u0 = (\t. u t x)’
1917 >> qabbrev_tac ‘g0 = (\t. g t x)’
1918 >> RW_TAC std_ss []
1919 >> Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> (_ --> real (q x)) sequentially’ K_TAC
1920 >> Q.PAT_X_ASSUM ‘!x. x IN m_space m ==> (_ --> g t x) sequentially’ K_TAC
1921 >> ‘h i < t \/ t < h i’ by METIS_TAC [REAL_LT_TOTAL]
1922 >| [ (* goal 1 (of 2) *)
1923      simp [ABS_MUL, Abbr ‘d’] \\
1924      qabbrev_tac ‘t' = h i’ \\
1925   (* applying MVT_GENERAL_ALT *)
1926      MP_TAC (Q.SPECL [‘u0’, ‘g0’, ‘t'’, ‘t’] MVT_GENERAL_ALT) >> art [] \\
1927      Know ‘interval [t',t] SUBSET s’
1928      >- (simp [IN_INTERVAL, SUBSET_DEF] \\
1929          Q.X_GEN_TAC ‘z’ >> STRIP_TAC \\
1930       (* applying CONNECTED_IVT *)
1931          MATCH_MP_TAC CONNECTED_IVT \\
1932          qexistsl_tac [‘t'’, ‘t’] >> simp [Abbr ‘t'’]) >> DISCH_TAC \\
1933      impl_tac
1934      >- (CONJ_TAC
1935          >- (MATCH_MP_TAC CONTINUOUS_ON_SUBSET \\
1936              Q.EXISTS_TAC ‘s’ >> art []) \\
1937          Q.X_GEN_TAC ‘z’ >> rw [IN_INTERVAL] \\
1938          irule (iffLR HAS_VECTOR_DERIVATIVE_WITHIN_OPEN) \\
1939          Q.EXISTS_TAC ‘s’ >> art [] \\
1940          CONJ_ASM1_TAC
1941          >- (MATCH_MP_TAC CONNECTED_IVT \\
1942              qexistsl_tac [‘t'’, ‘t’] >> simp [REAL_LT_IMP_LE, Abbr ‘t'’]) \\
1943          FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
1944      simp [IN_INTERVAL, ABS_MUL] \\
1945      Know ‘abs (inv (t' - t)) = inv (abs (t' - t))’
1946      >- (MATCH_MP_TAC ABS_INV \\
1947          Q.PAT_X_ASSUM ‘t' < t’ MP_TAC >> REAL_ARITH_TAC) >> Rewr' \\
1948      DISCH_THEN (Q.X_CHOOSE_THEN ‘z’ STRIP_ASSUME_TAC) \\
1949      Q_TAC (TRANS_TAC le_trans) ‘Normal (abs (g0 z))’ \\
1950      reverse CONJ_TAC
1951      >- (simp [Abbr ‘g0’] \\
1952          FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
1953          MATCH_MP_TAC CONNECTED_IVT \\
1954          qexistsl_tac [‘t'’, ‘t’] >> simp [REAL_LT_IMP_LE, Abbr ‘t'’]) \\
1955     ‘0 < t - t'’ by simp [REAL_SUB_LT] \\
1956      ONCE_REWRITE_TAC [ABS_SUB] \\
1957      qabbrev_tac ‘d = t - t'’ \\
1958     ‘d <> 0 /\ 0 <= d’ by PROVE_TAC [REAL_LT_IMP_LE, REAL_LT_IMP_NE] \\
1959     ‘abs d <> 0’ by simp [GSYM ABS_NZ] \\
1960     ‘0 < abs d’ by simp [ABS_NZ'] \\
1961      simp [Once REAL_MUL_COMM, GSYM real_div] \\
1962      ONCE_REWRITE_TAC [REAL_MUL_COMM] >> art [],
1963      (* goal 2 (of 2) *)
1964      simp [ABS_MUL, Abbr ‘d’] \\
1965      qabbrev_tac ‘t' = h i’ \\
1966   (* applying MVT_GENERAL_ALT *)
1967      MP_TAC (Q.SPECL [‘u0’, ‘g0’, ‘t’, ‘t'’] MVT_GENERAL_ALT) >> art [] \\
1968      Know ‘interval [t,t'] SUBSET s’
1969      >- (simp [IN_INTERVAL, SUBSET_DEF] \\
1970          Q.X_GEN_TAC ‘z’ >> STRIP_TAC \\
1971       (* applying CONNECTED_IVT *)
1972          MATCH_MP_TAC CONNECTED_IVT \\
1973          qexistsl_tac [‘t’, ‘t'’] >> simp [Abbr ‘t'’]) >> DISCH_TAC \\
1974      impl_tac
1975      >- (CONJ_TAC
1976          >- (MATCH_MP_TAC CONTINUOUS_ON_SUBSET \\
1977              Q.EXISTS_TAC ‘s’ >> art []) \\
1978          Q.X_GEN_TAC ‘z’ >> rw [IN_INTERVAL] \\
1979          irule (iffLR HAS_VECTOR_DERIVATIVE_WITHIN_OPEN) \\
1980          Q.EXISTS_TAC ‘s’ >> art [] \\
1981          CONJ_ASM1_TAC
1982          >- (MATCH_MP_TAC CONNECTED_IVT \\
1983              qexistsl_tac [‘t’, ‘t'’] >> simp [REAL_LT_IMP_LE, Abbr ‘t'’]) \\
1984          FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
1985      simp [IN_INTERVAL, ABS_MUL] \\
1986      Know ‘abs (inv (t' - t)) = inv (abs (t' - t))’
1987      >- (MATCH_MP_TAC ABS_INV \\
1988          Q.PAT_X_ASSUM ‘t < t'’ MP_TAC >> REAL_ARITH_TAC) >> Rewr' \\
1989      DISCH_THEN (Q.X_CHOOSE_THEN ‘z’ STRIP_ASSUME_TAC) \\
1990      Q_TAC (TRANS_TAC le_trans) ‘Normal (abs (g0 z))’ \\
1991      reverse CONJ_TAC
1992      >- (simp [Abbr ‘g0’] \\
1993          FIRST_X_ASSUM MATCH_MP_TAC >> art [] \\
1994          MATCH_MP_TAC CONNECTED_IVT \\
1995          qexistsl_tac [‘t’, ‘t'’] >> simp [REAL_LT_IMP_LE, Abbr ‘t'’]) \\
1996     ‘0 < t' - t’ by simp [REAL_SUB_LT] \\
1997      qabbrev_tac ‘d = t' - t’ \\
1998     ‘d <> 0 /\ 0 <= d’ by PROVE_TAC [REAL_LT_IMP_LE, REAL_LT_IMP_NE] \\
1999     ‘abs d <> 0’ by simp [GSYM ABS_NZ] \\
2000     ‘0 < abs d’ by simp [ABS_NZ'] \\
2001      simp [Once REAL_MUL_COMM, GSYM real_div] \\
2002      ONCE_REWRITE_TAC [REAL_MUL_COMM] >> art [] ]
2003QED
2004
2005Theorem differentiable_lemma' :
2006    !s m u. measure_space (m :'a m_space) /\ open s /\ connected s /\
2007      (!t. t IN s ==> integrable m (Normal o u t)) /\
2008      (!x. x IN m_space m ==> (\t. u t x) differentiable_on s) /\
2009      (?w. integrable m w /\
2010          (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
2011           !t x. t IN s /\ x IN m_space m ==>
2012                 Normal (abs (diff1 (\t. u t x) t)) <= w x)
2013     ==> (\t. real (integral m (Normal o u t))) differentiable_on s /\
2014         !t. t IN s ==>
2015             integrable m (\x. Normal (diff1 (\t. u t x) t)) /\
2016             diff1 (\t. real (integral m (Normal o u t))) t =
2017             real (integral m (\x. (Normal (diff1 (\t. u t x) t))))
2018Proof
2019    rpt GEN_TAC >> STRIP_TAC
2020 >> MP_TAC (Q.SPECL [‘s’, ‘m’, ‘u’] differentiable_lemma) >> simp []
2021 >> impl_tac >- (Q.EXISTS_TAC ‘w’ >> art [])
2022 >> DISCH_TAC
2023 >> CONJ_TAC
2024 >- (rw [differentiable_on, differentiable_alt_has_vector_derivative] \\
2025     Q.PAT_X_ASSUM ‘!t. t IN s ==>
2026                        integrable m (\x. Normal (diff1 (\t. u t x) t)) /\ _’
2027                   (MP_TAC o Q.SPEC ‘x’) >> simp [] \\
2028     qmatch_abbrev_tac ‘_ /\ (_ has_vector_derivative l) (at x within s) ==> _’ \\
2029     STRIP_TAC \\
2030     Q.EXISTS_TAC ‘l’ >> art [])
2031 >> Q.X_GEN_TAC ‘t’ >> DISCH_TAC
2032 >> Q.PAT_X_ASSUM ‘!t. t IN s ==>
2033                       integrable m (\x. Normal (diff1 (\t. u t x) t)) /\ _’
2034                  (MP_TAC o Q.SPEC ‘t’) >> rw []
2035 >> MATCH_MP_TAC has_vector_derivative_imp_diff1
2036 >> irule (iffLR HAS_VECTOR_DERIVATIVE_WITHIN_OPEN)
2037 >> Q.EXISTS_TAC ‘s’ >> art []
2038QED
2039
2040(* |- !m u.
2041        measure_space m /\ (!t. integrable m (Normal o u t)) /\
2042        (!x. x IN m_space m ==> (\t. u t x) differentiable_on univ(:real)) /\
2043        (?w. integrable m w /\
2044             (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
2045             !t x.
2046               x IN m_space m ==> Normal (abs (diff1 (\t. u t x) t)) <= w x) ==>
2047        !t. integrable m (\x. Normal (diff1 (\t. u t x) t)) /\
2048            ((\t. real (integral m (Normal o u t))) has_vector_derivative
2049             real (integral m (\x. Normal (diff1 (\t. u t x) t)))) (at t)
2050 *)
2051Theorem differentiable_univ_lemma =
2052        differentiable_lemma |> Q.SPEC ‘UNIV’
2053     |> SRULE [OPEN_UNIV, CONNECTED_UNIV, NET_WITHIN_UNIV]
2054
2055(* |- !m u.
2056        measure_space m /\ (!t. integrable m (Normal o u t)) /\
2057        (!x. x IN m_space m ==> (\t. u t x) differentiable_on univ(:real)) /\
2058        (?w. integrable m w /\
2059             (!x. x IN m_space m ==> 0 <= w x /\ w x <> PosInf) /\
2060             !t x.
2061               x IN m_space m ==> Normal (abs (diff1 (\t. u t x) t)) <= w x) ==>
2062        (\t. real (integral m (Normal o u t))) differentiable_on univ(:real) /\
2063        !t. integrable m (\x. Normal (diff1 (\t. u t x) t)) /\
2064            diff1 (\t. real (integral m (Normal o u t))) t =
2065            real (integral m (\x. Normal (diff1 (\t. u t x) t)))
2066 *)
2067Theorem differentiable_univ_lemma' =
2068        differentiable_lemma' |> Q.SPEC ‘UNIV’
2069     |> SRULE [OPEN_UNIV, CONNECTED_UNIV, NET_WITHIN_UNIV]
2070
2071(* ------------------------------------------------------------------------- *)
2072(*  Product measures and Fubini's theorem (Chapter 14 of [1])                *)
2073(* ------------------------------------------------------------------------- *)
2074
2075Definition fcp_cross_def : (* cf. CROSS_DEF *)
2076    fcp_cross A B = {FCP_CONCAT a b | a IN A /\ b IN B}
2077End
2078
2079Theorem IN_FCP_CROSS : (* cf. IN_CROSS *)
2080    !s a b. s IN fcp_cross a b <=> ?t u. (s = FCP_CONCAT t u) /\ t IN a /\ u IN b
2081Proof
2082    RW_TAC std_ss [fcp_cross_def, GSPECIFICATION, UNCURRY]
2083 >> EQ_TAC >- PROVE_TAC []
2084 >> RW_TAC std_ss []
2085 >> Q.EXISTS_TAC `(t,u)`
2086 >> RW_TAC std_ss []
2087QED
2088
2089(* high dimensional space are made by lower dimensional spaces *)
2090Theorem fcp_cross_UNIV :
2091    FINITE univ(:'b) /\ FINITE univ(:'c) ==>
2092    fcp_cross univ(:'a['b]) univ(:'a['c]) = univ(:'a['b + 'c])
2093Proof
2094    rw [Once EXTENSION, IN_UNIV, GSPECIFICATION, IN_FCP_CROSS]
2095 >> Q.EXISTS_TAC ‘FCP i. x ' (i + dimindex(:'c))’
2096 >> Q.EXISTS_TAC ‘FCP i. x ' i’
2097 >> rw [FCP_CONCAT_def, CART_EQ, index_sum, FCP_BETA]
2098QED
2099
2100Definition fcp_prod_def:   (* cf. prod_sets_def *)
2101    fcp_prod a b = {fcp_cross s t | s IN a /\ t IN b}
2102End
2103
2104Theorem IN_FCP_PROD :
2105    !s A B. s IN fcp_prod A B <=> ?a b. (s = fcp_cross a b) /\ a IN A /\ b IN B
2106Proof
2107    RW_TAC std_ss [fcp_prod_def, GSPECIFICATION, UNCURRY]
2108 >> EQ_TAC >- PROVE_TAC []
2109 >> RW_TAC std_ss []
2110 >> Q.EXISTS_TAC `(a,b)`
2111 >> RW_TAC std_ss []
2112QED
2113
2114Theorem FCP_BIGUNION_CROSS :
2115    !f s t. fcp_cross (BIGUNION (IMAGE f s)) t =
2116            BIGUNION (IMAGE (\n. fcp_cross (f n) t) s)
2117Proof
2118    rw [Once EXTENSION, IN_BIGUNION_IMAGE, IN_FCP_CROSS]
2119 >> EQ_TAC >> rpt STRIP_TAC
2120 >- (rename1 ‘z IN s’ >> Q.EXISTS_TAC ‘z’ >> art [] \\
2121     rename1 ‘x = FCP_CONCAT c u’ \\
2122     qexistsl_tac [‘c’,‘u’] >> art [])
2123 >> rename1 ‘x = FCP_CONCAT c u’
2124 >> qexistsl_tac [‘c’,‘u’] >> art []
2125 >> Q.EXISTS_TAC ‘n’ >> art []
2126QED
2127
2128Theorem FCP_CROSS_BIGUNION :
2129    !f s t. fcp_cross t (BIGUNION (IMAGE f s)) =
2130            BIGUNION (IMAGE (\n. fcp_cross t (f n)) s)
2131Proof
2132    rw [Once EXTENSION, IN_BIGUNION_IMAGE, IN_FCP_CROSS]
2133 >> EQ_TAC >> rpt STRIP_TAC
2134 >- (rename1 ‘z IN s’ >> Q.EXISTS_TAC ‘z’ >> art [] \\
2135     rename1 ‘x = FCP_CONCAT c u’ \\
2136     qexistsl_tac [‘c’,‘u’] >> art [])
2137 >> rename1 ‘x = FCP_CONCAT c u’
2138 >> qexistsl_tac [‘c’,‘u’] >> art []
2139 >> Q.EXISTS_TAC ‘n’ >> art []
2140QED
2141
2142Theorem FCP_CROSS_DIFF :
2143    !(X :'a['b] set) s (t :'a['c] set).
2144        FINITE univ(:'b) /\ FINITE univ(:'c) ==>
2145        fcp_cross (X DIFF s) t = (fcp_cross X t) DIFF (fcp_cross s t)
2146Proof
2147    rw [Once EXTENSION, IN_FCP_CROSS, IN_DIFF]
2148 >> EQ_TAC >> rpt STRIP_TAC (* 3 subgoals *)
2149 >| [ (* goal 1 (of 3) *)
2150      rename1 ‘c IN X’ >> qexistsl_tac [‘c’,‘u’] >> art [],
2151      (* goal 2 (of 3) *)
2152      rename1 ‘c IN X’ \\
2153      rename [‘x = FCP_CONCAT c' u'’, ‘c' NOTIN s \/ u' NOTIN t’] \\
2154      DISJ1_TAC \\
2155      CCONTR_TAC >> fs [] \\
2156      Q.PAT_X_ASSUM ‘x = FCP_CONCAT c' u'’ K_TAC \\
2157      Suff ‘c = c'’ >- METIS_TAC [] \\
2158      PROVE_TAC [FCP_CONCAT_11],
2159      (* goal 3 (of 3) *)
2160      rename1 ‘x = FCP_CONCAT c u’ \\
2161      qexistsl_tac [‘c’,‘u’] >> art [] >> PROVE_TAC [] ]
2162QED
2163
2164Theorem FCP_CROSS_DIFF' :
2165    !(s :'a['b] set) (X :'a['c] set) t.
2166        FINITE univ(:'b) /\ FINITE univ(:'c) ==>
2167        fcp_cross s (X DIFF t) = (fcp_cross s X) DIFF (fcp_cross s t)
2168Proof
2169    rw [Once EXTENSION, IN_FCP_CROSS, IN_DIFF]
2170 >> EQ_TAC >> rpt STRIP_TAC (* 3 subgoals *)
2171 >| [ (* goal 1 (of 3) *)
2172      rename1 ‘c IN s’ >> qexistsl_tac [‘c’,‘u’] >> art [],
2173      (* goal 2 (of 3) *)
2174      rename1 ‘c IN s’ \\
2175      rename[‘x = FCP_CONCAT c' u'’,‘c' NOTIN s \/ u' NOTIN t’] \\
2176      DISJ2_TAC \\
2177      CCONTR_TAC >> fs [] \\
2178      Q.PAT_X_ASSUM ‘x = FCP_CONCAT c' u'’ K_TAC \\
2179      Suff ‘u = u'’ >- METIS_TAC [] \\
2180      PROVE_TAC [FCP_CONCAT_11],
2181      (* goal 3 (of 3) *)
2182      rename1 ‘x = FCP_CONCAT c u’ \\
2183      qexistsl_tac [‘c’,‘u’] >> art [] >> PROVE_TAC [] ]
2184QED
2185
2186Theorem FCP_SUBSET_CROSS :
2187    !(a :'a['b] set) b (c :'a['c] set) d.
2188        a SUBSET b /\ c SUBSET d ==> (fcp_cross a c) SUBSET (fcp_cross b d)
2189Proof
2190    rpt STRIP_TAC
2191 >> rw [SUBSET_DEF, IN_FCP_CROSS]
2192 >> qexistsl_tac [‘t’, ‘u’] >> art []
2193 >> PROVE_TAC [SUBSET_DEF]
2194QED
2195
2196Theorem FCP_INTER_CROSS :
2197    !(a :'a['b] set) (b :'a['c] set) c d.
2198        FINITE univ(:'b) /\ FINITE univ(:'c) ==>
2199       (fcp_cross a b) INTER (fcp_cross c d) = fcp_cross (a INTER c) (b INTER d)
2200Proof
2201    rw [Once EXTENSION, IN_INTER, IN_FCP_CROSS]
2202 >> EQ_TAC >> rpt STRIP_TAC (* 3 subgoals *)
2203 >| [ (* goal 1 (of 3) *)
2204      fs [] >> qexistsl_tac [‘t’, ‘u’] >> art [] \\
2205      PROVE_TAC [FCP_CONCAT_11],
2206      (* goal 2 (of 3) *)
2207      qexistsl_tac [‘t’, ‘u’] >> art [],
2208      (* goal 3 (of 3) *)
2209      qexistsl_tac [‘t’, ‘u’] >> art [] ]
2210QED
2211
2212(* see also LISP ... *)
2213Definition pair_operation_def:
2214    pair_operation (cons :'a -> 'b -> 'c) car cdr =
2215      ((!a b. (car (cons a b) = a) /\ (cdr (cons a b) = b)) /\
2216       (!a b c d. (cons a b = cons c d) <=> (a = c) /\ (b = d)))
2217End
2218
2219(* two sample pair operations: comma (pairTheory) and FCP_CONCAT (fcpTheory) *)
2220Theorem pair_operation_pair :
2221    pair_operation (pair$, :'a -> 'b -> 'a # 'b)
2222                   (FST :'a # 'b -> 'a) (SND :'a # 'b -> 'b)
2223Proof
2224    rw [pair_operation_def]
2225QED
2226
2227Theorem pair_operation_FCP_CONCAT :
2228    FINITE univ(:'b) /\ FINITE univ(:'c) ==>
2229    pair_operation (FCP_CONCAT :'a['b] -> 'a['c] -> 'a['b + 'c])
2230                   (FCP_FST :'a['b + 'c] -> 'a['b])
2231                   (FCP_SND :'a['b + 'c] -> 'a['c])
2232Proof
2233    DISCH_TAC
2234 >> ASM_SIMP_TAC std_ss [pair_operation_def]
2235 >> reverse CONJ_TAC >- METIS_TAC [FCP_CONCAT_11]
2236 >> rpt GEN_TAC
2237 >> PROVE_TAC [FCP_CONCAT_THM]
2238QED
2239
2240Theorem pair_operation_CONS :
2241    pair_operation CONS HD TL
2242Proof
2243    rw [pair_operation_def]
2244QED
2245
2246Definition general_cross_def:
2247    general_cross (cons :'a -> 'b -> 'c) A B = {cons a b | a IN A /\ b IN B}
2248End
2249
2250Theorem general_cross_empty[simp] :
2251    general_cross cons {} B = {} /\
2252    general_cross cons A {} = {}
2253Proof
2254    rw [general_cross_def, Once EXTENSION]
2255QED
2256
2257Theorem IN_general_cross :
2258    !cons s A B. s IN (general_cross cons A B) <=>
2259                 ?a b. s = cons a b /\ a IN A /\ b IN B
2260Proof
2261    RW_TAC std_ss [general_cross_def, GSPECIFICATION]
2262 >> EQ_TAC >> rpt STRIP_TAC
2263 >- (Cases_on ‘x’ >> fs [] >> qexistsl_tac [‘q’,‘r’] >> art [])
2264 >> Q.EXISTS_TAC ‘(a,b)’ >> rw []
2265QED
2266
2267Theorem general_cross_reduce :
2268    !cons car cdr s t. pair_operation cons car cdr ==>
2269                      (t <> {} ==> IMAGE car (general_cross cons s t) = s) /\
2270                      (s <> {} ==> IMAGE cdr (general_cross cons s t) = t)
2271Proof
2272    rw [pair_operation_def, FORALL_AND_THM] (* 2 subgoals *)
2273 >| [ (* goal 1 (of 2) *)
2274      rw [Once EXTENSION, IN_general_cross] \\
2275      EQ_TAC >> RW_TAC std_ss [] >- art [] \\
2276      fs [GSYM MEMBER_NOT_EMPTY] >> rename1 ‘y IN t’ \\
2277      Q.EXISTS_TAC ‘cons x y’ >> simp [],
2278      (* goal 2 (of 2) *)
2279      rw [Once EXTENSION, IN_general_cross] \\
2280      EQ_TAC >> RW_TAC std_ss [] >- art [] \\
2281      fs [GSYM MEMBER_NOT_EMPTY] >> rename1 ‘y IN s’ \\
2282      Q.EXISTS_TAC ‘cons y x’ >> simp [] ]
2283QED
2284
2285(* alternative definition of pred_set$CROSS *)
2286Theorem CROSS_ALT :
2287    !A B. A CROSS B = general_cross pair$, A B
2288Proof
2289    RW_TAC std_ss [Once EXTENSION, IN_CROSS, IN_general_cross]
2290 >> EQ_TAC >> rw [] >> fs []
2291 >> qexistsl_tac [‘FST x’,‘SND x’] >> rw [PAIR]
2292QED
2293
2294(* alternative definition of fcp_cross *)
2295Theorem fcp_cross_alt :
2296    !A B. fcp_cross A B = general_cross FCP_CONCAT A B
2297Proof
2298    RW_TAC std_ss [Once EXTENSION, IN_FCP_CROSS, IN_general_cross]
2299QED
2300
2301Definition general_prod_def:
2302    general_prod (cons :'a -> 'b -> 'c) A B =
2303      {general_cross cons a b | a IN A /\ b IN B}
2304End
2305
2306Theorem IN_general_prod :
2307    !(cons :'a -> 'b -> 'c) s A B.
2308        s IN general_prod cons A B <=>
2309       ?a b. s = general_cross cons a b /\ a IN A /\ b IN B
2310Proof
2311    RW_TAC std_ss [general_prod_def, GSPECIFICATION, UNCURRY]
2312 >> EQ_TAC >> rpt STRIP_TAC
2313 >- (qexistsl_tac [‘FST x’, ‘SND x’] >> art [])
2314 >> Q.EXISTS_TAC `(a,b)`
2315 >> RW_TAC std_ss []
2316QED
2317
2318Theorem prod_sets_alt :
2319    !A B. prod_sets A B = general_prod pair$, A B
2320Proof
2321    RW_TAC std_ss [Once EXTENSION, IN_PROD_SETS, IN_general_prod, GSYM CROSS_ALT]
2322QED
2323
2324Theorem fcp_prod_alt :
2325    !A B. fcp_prod A B = general_prod FCP_CONCAT A B
2326Proof
2327    RW_TAC std_ss [Once EXTENSION, IN_FCP_PROD, IN_general_prod, GSYM fcp_cross_alt]
2328QED
2329
2330Theorem general_BIGUNION_CROSS :
2331    !(cons :'a -> 'b -> 'c) f (s :'index set) t.
2332       (general_cross cons (BIGUNION (IMAGE f s)) t =
2333        BIGUNION (IMAGE (\n. general_cross cons (f n) t) s))
2334Proof
2335    rw [Once EXTENSION, IN_BIGUNION_IMAGE, IN_general_cross]
2336 >> EQ_TAC >> rpt STRIP_TAC
2337 >- (rename1 ‘z IN s’ >> Q.EXISTS_TAC ‘z’ >> art [] \\
2338     qexistsl_tac [‘a’,‘b’] >> art [])
2339 >> qexistsl_tac [‘a’,‘b’] >> art []
2340 >> Q.EXISTS_TAC ‘n’ >> art []
2341QED
2342
2343Theorem general_CROSS_BIGUNION :
2344    !(cons :'a -> 'b -> 'c) f (s :'index set) t.
2345       (general_cross cons t (BIGUNION (IMAGE f s)) =
2346        BIGUNION (IMAGE (\n. general_cross cons t (f n)) s))
2347Proof
2348    rw [Once EXTENSION, IN_BIGUNION_IMAGE, IN_general_cross]
2349 >> EQ_TAC >> rpt STRIP_TAC
2350 >- (rename1 ‘z IN s’ >> Q.EXISTS_TAC ‘z’ >> art [] \\
2351     qexistsl_tac [‘a’,‘b’] >> art [])
2352 >> qexistsl_tac [‘a’,‘b’] >> art []
2353 >> Q.EXISTS_TAC ‘n’ >> art []
2354QED
2355
2356Theorem general_CROSS_DIFF :
2357    !(cons :'a -> 'b -> 'c) car cdr (X :'a set) s (t :'b set).
2358        pair_operation cons car cdr ==>
2359       (general_cross cons (X DIFF s) t =
2360        (general_cross cons X t) DIFF (general_cross cons s t))
2361Proof
2362    rw [Once EXTENSION, IN_general_cross, IN_DIFF]
2363 >> EQ_TAC >> rpt STRIP_TAC (* 3 subgoals *)
2364 >| [ (* goal 1 (of 3) *)
2365      qexistsl_tac [‘a’,‘b’] >> art [],
2366      (* goal 2 (of 3) *)
2367      DISJ1_TAC \\
2368      CCONTR_TAC >> fs [] \\
2369      Q.PAT_X_ASSUM ‘x = cons a' b'’ K_TAC \\
2370      Suff ‘a = a'’ >- METIS_TAC [] \\
2371      METIS_TAC [pair_operation_def],
2372      (* goal 3 (of 3) *)
2373      qexistsl_tac [‘a’,‘b’] >> art [] >> PROVE_TAC [] ]
2374QED
2375
2376Theorem general_CROSS_DIFF' :
2377    !(cons :'a -> 'b -> 'c) car cdr (s :'a set) (X :'b set) t.
2378        pair_operation cons car cdr ==>
2379       (general_cross cons s (X DIFF t) =
2380        (general_cross cons s X) DIFF (general_cross cons s t))
2381Proof
2382    rw [Once EXTENSION, IN_general_cross, IN_DIFF]
2383 >> EQ_TAC >> rpt STRIP_TAC (* 3 subgoals *)
2384 >| [ (* goal 1 (of 3) *)
2385      qexistsl_tac [‘a’,‘b’] >> art [],
2386      (* goal 2 (of 3) *)
2387      DISJ2_TAC \\
2388      CCONTR_TAC >> fs [] \\
2389      Q.PAT_X_ASSUM ‘x = cons a' b'’ K_TAC \\
2390      Suff ‘b = b'’ >- METIS_TAC [] \\
2391      METIS_TAC [pair_operation_def],
2392      (* goal 3 (of 3) *)
2393      qexistsl_tac [‘a’,‘b’] >> art [] >> PROVE_TAC [] ]
2394QED
2395
2396Theorem general_SUBSET_CROSS :
2397    !(cons :'a -> 'b -> 'c) (a :'a set) b (c :'b set) d.
2398        a SUBSET b /\ c SUBSET d ==>
2399        (general_cross cons a c) SUBSET (general_cross cons b d)
2400Proof
2401    rpt STRIP_TAC
2402 >> rw [SUBSET_DEF, IN_general_cross]
2403 >> qexistsl_tac [‘a'’, ‘b'’] >> art []
2404 >> PROVE_TAC [SUBSET_DEF]
2405QED
2406
2407Theorem general_INTER_CROSS :
2408    !(cons :'a -> 'b -> 'c) car cdr (a :'a set) (b :'b set) c d.
2409        pair_operation cons car cdr ==>
2410       ((general_cross cons a b) INTER (general_cross cons c d) =
2411        general_cross cons (a INTER c) (b INTER d))
2412Proof
2413    rw [Once EXTENSION, IN_INTER, IN_general_cross]
2414 >> EQ_TAC >> rpt STRIP_TAC (* 3 subgoals *)
2415 >| [ (* goal 1 (of 3) *)
2416      fs [] >> rename1 ‘x = cons s t’ \\
2417      qexistsl_tac [‘s’, ‘t’] >> art [] \\
2418      METIS_TAC [pair_operation_def],
2419      (* goal 2 (of 3) *)
2420      qexistsl_tac [‘a'’, ‘b'’] >> art [],
2421      (* goal 3 (of 3) *)
2422      qexistsl_tac [‘a'’, ‘b'’] >> art [] ]
2423QED
2424
2425Theorem INDICATOR_FN_FCP_CROSS :
2426    !(s :'a['b] set) (t :'a['c] set) x y.
2427        FINITE univ(:'b) /\ FINITE univ(:'c) ==>
2428       (indicator_fn (fcp_cross s t) (FCP_CONCAT x y) =
2429        indicator_fn s x * indicator_fn t y)
2430Proof
2431    rpt STRIP_TAC
2432 >> rw [IN_FCP_CROSS, indicator_fn_def] (* 4 subgoals *)
2433 >> METIS_TAC [FCP_CONCAT_11]
2434QED
2435
2436Theorem indicator_fn_general_cross :
2437    !(cons :'a -> 'b -> 'c) car cdr (s :'a set) (t :'b set) x y.
2438        pair_operation cons car cdr ==>
2439       (indicator_fn (general_cross cons s t) (cons x y) =
2440        indicator_fn s x * indicator_fn t y)
2441Proof
2442    rpt STRIP_TAC
2443 >> rw [IN_general_cross, indicator_fn_def] (* 4 subgoals *)
2444 >> METIS_TAC [pair_operation_def]
2445QED
2446
2447(* FCP version of ‘prod_sigma’ *)
2448Definition fcp_sigma_def:
2449    fcp_sigma a b =
2450      sigma (fcp_cross (space a) (space b)) (fcp_prod (subsets a) (subsets b))
2451End
2452
2453(* FCP version of SIGMA_ALGEBRA_PROD_SIGMA *)
2454Theorem sigma_algebra_prod_sigma :
2455    !a b. subset_class (space a) (subsets a) /\
2456          subset_class (space b) (subsets b) ==> sigma_algebra (fcp_sigma a b)
2457Proof
2458    RW_TAC std_ss [fcp_sigma_def]
2459 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA
2460 >> RW_TAC std_ss [subset_class_def, IN_FCP_PROD, GSPECIFICATION, IN_FCP_CROSS]
2461 >> fs [subset_class_def]
2462 >> RW_TAC std_ss [SUBSET_DEF, IN_FCP_CROSS]
2463 >> METIS_TAC [SUBSET_DEF]
2464QED
2465
2466Theorem sigma_algebra_prod_sigma' =
2467   Q.GENL [‘X’, ‘Y’, ‘A’, ‘B’]
2468          (REWRITE_RULE [space_def, subsets_def]
2469                        (Q.SPECL [‘(X,A)’, ‘(Y,B)’] sigma_algebra_prod_sigma));
2470
2471Definition general_sigma_def:
2472    general_sigma (cons :'a -> 'b -> 'c) A B =
2473      sigma (general_cross cons (space A) (space B))
2474            (general_prod cons (subsets A) (subsets B))
2475End
2476
2477(* alternative definition of ‘prod_sigma’ *)
2478Theorem prod_sigma_alt :
2479    !A B. prod_sigma A B = general_sigma pair$, A B
2480Proof
2481    RW_TAC std_ss [prod_sigma_def, general_sigma_def,
2482                   GSYM CROSS_ALT, GSYM prod_sets_alt]
2483QED
2484
2485(* alternative definition of ‘fcp_sigma’ *)
2486Theorem fcp_sigma_alt :
2487    !A B. fcp_sigma A B = general_sigma FCP_CONCAT A B
2488Proof
2489    RW_TAC std_ss [fcp_sigma_def, general_sigma_def,
2490                   GSYM fcp_cross_alt, GSYM fcp_prod_alt]
2491QED
2492
2493Theorem sigma_algebra_general_sigma :
2494    !(cons :'a -> 'b -> 'c) A B.
2495        subset_class (space A) (subsets A) /\
2496        subset_class (space B) (subsets B) ==> sigma_algebra (general_sigma cons A B)
2497Proof
2498    RW_TAC std_ss [general_sigma_def]
2499 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA
2500 >> rw [subset_class_def, IN_general_prod, GSPECIFICATION, IN_general_cross]
2501 >> fs [subset_class_def]
2502 >> RW_TAC std_ss [SUBSET_DEF, IN_general_cross]
2503 >> qexistsl_tac [‘a'’, ‘b'’] >> art []
2504 >> METIS_TAC [SUBSET_DEF]
2505QED
2506
2507Theorem exhausting_sequence_general_cross :
2508    !(cons :'a -> 'b -> 'c) X Y A B f g.
2509       exhausting_sequence (X,A) f /\ exhausting_sequence (Y,B) g ==>
2510       exhausting_sequence (general_cross cons X Y,general_prod cons A B)
2511                           (\n. general_cross cons (f n) (g n))
2512Proof
2513    RW_TAC std_ss [exhausting_sequence_alt, space_def, subsets_def,
2514                   IN_FUNSET, IN_UNIV, IN_general_prod] (* 3 subgoals *)
2515 (* goal 1 (of 3) *)
2516 >- (qexistsl_tac [‘f n’, ‘g n’] >> art [])
2517 (* goal 2 (of 3) *)
2518 >- (rw [SUBSET_DEF, IN_general_cross] \\
2519     qexistsl_tac [‘a’, ‘b’] >> art [] \\
2520     METIS_TAC [SUBSET_DEF])
2521 (* goal 3 (of 3) *)
2522 >> simp [Once EXTENSION, IN_BIGUNION_IMAGE, IN_general_cross, IN_UNIV]
2523 >> GEN_TAC >> EQ_TAC >> rpt STRIP_TAC
2524 >- (qexistsl_tac [‘a’, ‘b’] >> art [] \\
2525     CONJ_TAC >> Q.EXISTS_TAC ‘n’ >> art [])
2526 >> rename1 ‘a IN f n1’
2527 >> rename1 ‘b IN g n2’
2528 >> Q.EXISTS_TAC ‘MAX n1 n2’
2529 >> qexistsl_tac [‘a’, ‘b’] >> art []
2530 >> CONJ_TAC (* 2 subgoals *)
2531 >| [ Suff ‘f n1 SUBSET f (MAX n1 n2)’ >- METIS_TAC [SUBSET_DEF] \\
2532      FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss [],
2533      Suff ‘g n2 SUBSET g (MAX n1 n2)’ >- METIS_TAC [SUBSET_DEF] \\
2534      FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss [] ]
2535QED
2536
2537Theorem exhausting_sequence_CROSS :
2538    !X Y A B f g.
2539       exhausting_sequence (X,A) f /\ exhausting_sequence (Y,B) g ==>
2540       exhausting_sequence (X CROSS Y,prod_sets A B) (\n. f n CROSS g n)
2541Proof
2542    rpt GEN_TAC >> STRIP_TAC
2543 >> MP_TAC (Q.SPECL [‘pair$,’, ‘X’, ‘Y’, ‘A’, ‘B’, ‘f’, ‘g’]
2544                    (INST_TYPE [gamma |-> “:'a # 'b”]
2545                               exhausting_sequence_general_cross))
2546 >> RW_TAC std_ss [GSYM CROSS_ALT, GSYM prod_sets_alt]
2547QED
2548
2549(* FCP version of exhausting_sequence_CROSS *)
2550Theorem exhausting_sequence_cross :
2551    !X Y A B f g.
2552       exhausting_sequence (X,A) f /\ exhausting_sequence (Y,B) g ==>
2553       exhausting_sequence (fcp_cross X Y,fcp_prod A B) (\n. fcp_cross (f n) (g n))
2554Proof
2555    rpt GEN_TAC >> STRIP_TAC
2556 >> MP_TAC (Q.SPECL [‘FCP_CONCAT’, ‘X’, ‘Y’, ‘A’, ‘B’, ‘f’, ‘g’]
2557                    (((INST_TYPE [“:'temp1” |-> “:'a['b]”]) o
2558                      (INST_TYPE [“:'temp2” |-> “:'a['c]”]) o
2559                      (INST_TYPE [gamma |-> “:'a['b + 'c]”]) o
2560                      (INST_TYPE [alpha |-> “:'temp1”]) o
2561                      (INST_TYPE [beta |-> “:'temp2”]))
2562                         exhausting_sequence_general_cross))
2563 >> RW_TAC std_ss [GSYM fcp_cross_alt, GSYM fcp_prod_alt]
2564QED
2565
2566Theorem general_sigma_of_generator :
2567    !(cons :'a -> 'b -> 'c) (car :'c -> 'a) (cdr :'c -> 'b)
2568     (X :'a set) (Y :'b set) E G.
2569        pair_operation cons car cdr /\
2570        subset_class X E /\ subset_class Y G /\
2571        has_exhausting_sequence (X,E) /\ has_exhausting_sequence (Y,G) ==>
2572       (general_sigma cons (X,E) (Y,G) = general_sigma cons (sigma X E) (sigma Y G))
2573Proof
2574    rpt STRIP_TAC
2575 >> Q.ABBREV_TAC ‘A = sigma X E’
2576 >> Q.ABBREV_TAC ‘B = sigma Y G’
2577 >> ONCE_REWRITE_TAC [GSYM SPACE]
2578 >> ‘general_cross cons (space A) (space B) = general_cross cons X Y’
2579       by METIS_TAC [SPACE_SIGMA]
2580 >> Suff ‘subsets (general_sigma cons (X,E) (Y,G)) = subsets (general_sigma cons A B)’
2581 >- (Know ‘space (general_sigma cons (X,E) (Y,G)) = space (general_sigma cons A B)’
2582     >- (rw [general_sigma_def, SPACE_SIGMA] \\
2583         METIS_TAC [SPACE_SIGMA]) >> Rewr' >> Rewr)
2584 >> rw [SET_EQ_SUBSET] (* 2 subgoals *)
2585 (* Part I: easy, ‘has_exhausting_sequence’ is not used *)
2586 >- (rw [general_sigma_def] \\
2587     MATCH_MP_TAC SIGMA_MONOTONE \\
2588     rw [IN_general_prod, SUBSET_DEF, GSPECIFICATION] \\
2589     qexistsl_tac [‘a’,‘b’] >> rw [] >| (* 2 subgoals *)
2590     [ (* goal 1 (of 2) *)
2591       Q.UNABBREV_TAC ‘A’ \\
2592       METIS_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF],
2593       (* goal 2 (of 2) *)
2594       Q.UNABBREV_TAC ‘B’ \\
2595       METIS_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF] ])
2596 >> ‘sigma_algebra A /\ sigma_algebra B’ by METIS_TAC [SIGMA_ALGEBRA_SIGMA]
2597 >> ‘sigma_algebra (general_sigma cons (X,E) (Y,G))’
2598      by (MATCH_MP_TAC sigma_algebra_general_sigma >> rw [])
2599 (* Part II: hard *)
2600 >> Q.ABBREV_TAC ‘S = {a | a IN subsets A /\
2601                          !g. g IN G ==> (general_cross cons a g) IN
2602                                            subsets (general_sigma cons (X,E) (Y,G))}’
2603 >> Know ‘sigma_algebra (X,S)’
2604 >- (simp [SIGMA_ALGEBRA_ALT_SPACE] \\
2605     CONJ_TAC (* subset_class *)
2606     >- (RW_TAC std_ss [subset_class_def, Abbr ‘S’, GSPECIFICATION] \\
2607        ‘X = space A’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2608         METIS_TAC [subset_class_def, SIGMA_ALGEBRA_ALT_SPACE]) \\
2609     STRONG_CONJ_TAC (* space *)
2610     >- (RW_TAC std_ss [Abbr ‘S’, GSPECIFICATION]
2611         >- (‘X = space A’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2612             fs [SIGMA_ALGEBRA_ALT_SPACE]) \\
2613        ‘?f. f IN (univ(:num) -> E) /\ (!n. f n SUBSET f (SUC n)) /\
2614             (BIGUNION (IMAGE f univ(:num)) = X)’
2615           by METIS_TAC [has_exhausting_sequence_def, space_def, subsets_def] \\
2616         POP_ASSUM (* rewrite only LHS *)
2617           ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o
2618            wrap o SYM) \\
2619         REWRITE_TAC [general_BIGUNION_CROSS] \\
2620         MATCH_MP_TAC SIGMA_ALGEBRA_ENUM >> art [] \\
2621         rw [general_sigma_def, IN_FUNSET, IN_UNIV] \\
2622         MATCH_MP_TAC IN_SIGMA \\
2623         RW_TAC std_ss [general_prod_def, GSPECIFICATION, IN_general_cross] \\
2624         Q.EXISTS_TAC ‘(f n,g)’ >> fs [IN_FUNSET]) >> DISCH_TAC \\
2625     CONJ_TAC (* DIFF *)
2626     >- (GEN_TAC >> fs [Abbr ‘S’, GSPECIFICATION] >> STRIP_TAC \\
2627         CONJ_TAC >- (‘X = space A’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2628                      fs [SIGMA_ALGEBRA_ALT_SPACE]) \\
2629         rpt STRIP_TAC \\
2630         Know ‘general_cross cons (X DIFF s) g =
2631                 (general_cross cons X g) DIFF (general_cross cons s g)’
2632         >- (MATCH_MP_TAC general_CROSS_DIFF \\
2633             qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
2634         MATCH_MP_TAC SIGMA_ALGEBRA_DIFF >> simp []) \\
2635     RW_TAC std_ss [IN_FUNSET, IN_UNIV] \\
2636     fs [Abbr ‘S’, GSPECIFICATION] \\
2637     CONJ_TAC >- (MATCH_MP_TAC SIGMA_ALGEBRA_ENUM >> rw [IN_FUNSET, IN_UNIV]) \\
2638     RW_TAC std_ss [general_BIGUNION_CROSS] \\
2639     MATCH_MP_TAC SIGMA_ALGEBRA_ENUM >> art [] \\
2640     rw [general_sigma_def, IN_FUNSET, IN_UNIV]) >> DISCH_TAC
2641 (* showing ‘E SUBSET S SUBSET subsets A’ *)
2642 >> Know ‘E SUBSET S’
2643 >- (RW_TAC std_ss [Abbr ‘S’, SUBSET_DEF, GSPECIFICATION]
2644     >- (Q.UNABBREV_TAC ‘A’ >> MATCH_MP_TAC IN_SIGMA >> art []) \\
2645     rw [general_sigma_def] >> MATCH_MP_TAC IN_SIGMA \\
2646     RW_TAC std_ss [IN_general_prod] \\
2647     qexistsl_tac [‘x’, ‘g’] >> art []) >> DISCH_TAC
2648 >> ‘S SUBSET subsets A’
2649       by (RW_TAC std_ss [Abbr ‘S’, SUBSET_DEF, GSPECIFICATION])
2650 >> Know ‘S = subsets A’
2651 >- (Q.UNABBREV_TAC ‘A’ \\
2652     MATCH_MP_TAC SIGMA_SMALLEST >> art []) >> DISCH_TAC
2653 >> Know ‘(general_prod cons (subsets A) G) SUBSET
2654          (subsets (general_sigma cons (X,E) (Y,G)))’
2655 >- (simp [IN_general_prod, SUBSET_DEF, GSPECIFICATION] \\
2656     rpt STRIP_TAC >> Know ‘a IN S’ >- PROVE_TAC [] \\
2657     rw [Abbr ‘S’, GSPECIFICATION])
2658 (* clean up all assumptions about S *)
2659 >> NTAC 4 (POP_ASSUM K_TAC) >> Q.UNABBREV_TAC ‘S’
2660 >> DISCH_TAC
2661 (* Part III: hard *)
2662 >> Q.ABBREV_TAC
2663   ‘S = {b | b IN subsets B /\
2664            !e. e IN E ==>
2665               (general_cross cons e b) IN subsets (general_sigma cons (X,E) (Y,G))}’
2666 >> Know ‘sigma_algebra (Y,S)’
2667 >- (simp [SIGMA_ALGEBRA_ALT_SPACE] \\
2668     CONJ_TAC (* subset_class *)
2669     >- (RW_TAC std_ss [subset_class_def, Abbr ‘S’, GSPECIFICATION] \\
2670        ‘Y = space B’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2671         METIS_TAC [subset_class_def, SIGMA_ALGEBRA_ALT_SPACE]) \\
2672     STRONG_CONJ_TAC (* space *)
2673     >- (RW_TAC std_ss [Abbr ‘S’, GSPECIFICATION]
2674         >- (‘Y = space B’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2675             fs [SIGMA_ALGEBRA_ALT_SPACE]) \\
2676        ‘?f. f IN (univ(:num) -> G) /\ (!n. f n SUBSET f (SUC n)) /\
2677             (BIGUNION (IMAGE f univ(:num)) = Y)’
2678           by METIS_TAC [has_exhausting_sequence_def, space_def, subsets_def] \\
2679         POP_ASSUM (* rewrite only LHS *)
2680           ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o
2681            wrap o SYM) \\
2682         REWRITE_TAC [general_CROSS_BIGUNION] \\
2683         MATCH_MP_TAC SIGMA_ALGEBRA_ENUM >> art [] \\
2684         rw [general_sigma_def, IN_FUNSET, IN_UNIV] \\
2685         MATCH_MP_TAC IN_SIGMA \\
2686         RW_TAC std_ss [IN_general_prod] \\
2687         qexistsl_tac [‘e’, ‘f n’] >> art [] \\
2688         fs [IN_FUNSET, IN_UNIV]) >> DISCH_TAC \\
2689     CONJ_TAC (* DIFF *)
2690     >- (GEN_TAC >> fs [Abbr ‘S’, GSPECIFICATION] >> STRIP_TAC \\
2691         CONJ_TAC >- (‘Y = space B’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2692                      fs [SIGMA_ALGEBRA_ALT_SPACE]) \\
2693         rpt STRIP_TAC \\
2694         Know ‘general_cross cons e (Y DIFF s) =
2695                (general_cross cons e Y) DIFF (general_cross cons e s)’
2696         >- (MATCH_MP_TAC general_CROSS_DIFF' \\
2697             qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
2698         MATCH_MP_TAC SIGMA_ALGEBRA_DIFF >> rw []) \\
2699     RW_TAC std_ss [IN_FUNSET, IN_UNIV] \\
2700     fs [Abbr ‘S’, GSPECIFICATION] \\
2701     CONJ_TAC
2702     >- (MATCH_MP_TAC SIGMA_ALGEBRA_ENUM >> rw [IN_FUNSET, IN_UNIV]) \\
2703     RW_TAC std_ss [general_CROSS_BIGUNION] \\
2704     MATCH_MP_TAC SIGMA_ALGEBRA_ENUM >> art [] \\
2705     rw [general_sigma_def, IN_FUNSET, IN_UNIV]) >> DISCH_TAC
2706 (* showing ‘E SUBSET S SUBSET subsets A’ *)
2707 >> Know ‘G SUBSET S’
2708 >- (RW_TAC std_ss [Abbr ‘S’, SUBSET_DEF, GSPECIFICATION]
2709     >- (Q.UNABBREV_TAC ‘B’ \\
2710         MATCH_MP_TAC IN_SIGMA >> art []) \\
2711     rw [general_sigma_def] >> MATCH_MP_TAC IN_SIGMA \\
2712     RW_TAC std_ss [IN_general_prod] \\
2713     qexistsl_tac [‘e’,‘x’] >> art []) >> DISCH_TAC
2714 >> ‘S SUBSET subsets B’
2715       by (RW_TAC std_ss [Abbr ‘S’, SUBSET_DEF, GSPECIFICATION])
2716 >> Know ‘S = subsets B’
2717 >- (Q.UNABBREV_TAC ‘B’ \\
2718     MATCH_MP_TAC SIGMA_SMALLEST >> art []) >> DISCH_TAC
2719 >> Know ‘(general_prod cons E (subsets B)) SUBSET
2720          (subsets (general_sigma cons (X,E) (Y,G)))’
2721 >- (simp [IN_general_prod, SUBSET_DEF, GSPECIFICATION] \\
2722     rpt STRIP_TAC >> Know ‘b IN S’ >- PROVE_TAC [] \\
2723     rw [Abbr ‘S’, GSPECIFICATION])
2724 (* clean up all assumptions about S *)
2725 >> NTAC 4 (POP_ASSUM K_TAC) >> Q.UNABBREV_TAC ‘S’
2726 >> DISCH_TAC
2727 (* Part IV: final stage *)
2728 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [general_sigma_def]
2729 >> Q.PAT_X_ASSUM ‘general_cross cons (space A) (space B) =
2730                   general_cross cons X Y’ (ONCE_REWRITE_TAC o wrap)
2731 >> Suff ‘general_prod cons (subsets A) (subsets B) SUBSET
2732          subsets (general_sigma cons (X,E) (Y,G))’
2733 >- (DISCH_TAC \\
2734     ASSUME_TAC (Q.SPEC ‘general_cross cons X Y’
2735                        (INST_TYPE [alpha |-> gamma] SIGMA_MONOTONE)) \\
2736     POP_ASSUM (MP_TAC o (Q.SPEC ‘general_prod cons (subsets A) (subsets B)’)) \\
2737     DISCH_THEN (MP_TAC o (Q.SPEC ‘subsets (general_sigma cons (X,E) (Y,G))’)) \\
2738     RW_TAC std_ss [] \\
2739     Suff ‘sigma (general_cross cons X Y) (subsets (general_sigma cons (X,E) (Y,G))) =
2740           general_sigma cons (X,E) (Y,G)’
2741     >- (DISCH_THEN (fs o wrap)) \\
2742    ‘general_cross cons X Y = space (general_sigma cons (X,E) (Y,G))’
2743        by (rw [general_sigma_def, SPACE_SIGMA]) \\
2744     POP_ORW >> MATCH_MP_TAC SIGMA_STABLE >> art [])
2745 >> RW_TAC std_ss [IN_general_prod, GSPECIFICATION, SUBSET_DEF]
2746 (* final goal: a CROSS b IN subsets ((X,E) CROSS (Y,G)) *)
2747 >> Know ‘general_cross cons a b =
2748            (general_cross cons a Y) INTER (general_cross cons X b)’
2749 >- (RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_general_cross] \\
2750     EQ_TAC >> RW_TAC std_ss [] >| (* 3 subgoals *)
2751     [ (* goal 1 (of 3) *)
2752       qexistsl_tac [‘a'’,‘b'’] >> art [] \\
2753       Suff ‘b SUBSET Y’ >- rw [SUBSET_DEF] \\
2754      ‘subset_class (space B) (subsets B)’
2755         by METIS_TAC [sigma_algebra_def, algebra_def, subset_class_def] \\
2756      ‘Y = space B’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2757       METIS_TAC [subset_class_def],
2758       (* goal 2 (of 3) *)
2759       qexistsl_tac [‘a'’,‘b'’] >> art [] \\
2760       Suff ‘a SUBSET X’ >- rw [SUBSET_DEF] \\
2761      ‘subset_class (space A) (subsets A)’
2762         by METIS_TAC [sigma_algebra_def, algebra_def, subset_class_def] \\
2763      ‘X = space A’ by PROVE_TAC [SPACE_SIGMA] >> POP_ORW \\
2764       METIS_TAC [subset_class_def],
2765       (* goal 3 (of 3) *)
2766       rename1 ‘cons a1 b1 = cons a2 b2’ \\
2767       qexistsl_tac [‘a2’,‘b2’] >> art [] \\
2768       Suff ‘b1 = b2’ >- PROVE_TAC [] \\
2769       METIS_TAC [pair_operation_def] ]) >> Rewr'
2770 >> ‘?e. e IN (univ(:num) -> E) /\ (!n. e n SUBSET e (SUC n)) /\
2771         (BIGUNION (IMAGE e univ(:num)) = X)’
2772      by METIS_TAC [has_exhausting_sequence_def, space_def, subsets_def]
2773 >> POP_ASSUM (* rewrite only LHS *)
2774      ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap o SYM)
2775 >> ‘?g. g IN (univ(:num) -> G) /\ (!n. g n SUBSET g (SUC n)) /\
2776         (BIGUNION (IMAGE g univ(:num)) = Y)’
2777      by METIS_TAC [has_exhausting_sequence_def, space_def, subsets_def]
2778 >> POP_ASSUM (* rewrite only LHS *)
2779      ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap o SYM)
2780 >> REWRITE_TAC [general_CROSS_BIGUNION, general_BIGUNION_CROSS]
2781 >> MATCH_MP_TAC SIGMA_ALGEBRA_INTER >> art []
2782 >> Q.PAT_X_ASSUM ‘sigma_algebra (general_sigma cons (X,E) (Y,G))’
2783      (STRIP_ASSUME_TAC o
2784       (REWRITE_RULE [SIGMA_ALGEBRA_ALT_SPACE, IN_FUNSET, IN_UNIV]))
2785 >> CONJ_TAC
2786 >| [ (* goal 1 (of 2) *)
2787      POP_ASSUM MATCH_MP_TAC >> Q.X_GEN_TAC ‘n’ >> BETA_TAC \\
2788      Suff ‘general_cross cons a (g n) IN general_prod cons (subsets A) G’
2789      >- PROVE_TAC [SUBSET_DEF] \\
2790      RW_TAC std_ss [IN_general_prod] \\
2791      qexistsl_tac [‘a’, ‘g n’] >> fs [IN_FUNSET, IN_UNIV],
2792      (* goal 2 (of 2) *)
2793      POP_ASSUM MATCH_MP_TAC >> Q.X_GEN_TAC ‘n’ >> BETA_TAC \\
2794      Suff ‘general_cross cons (e n) b IN general_prod cons E (subsets B)’
2795      >- PROVE_TAC [SUBSET_DEF] \\
2796      RW_TAC std_ss [IN_general_prod] \\
2797      qexistsl_tac [‘e n’, ‘b’] >> fs [IN_FUNSET, IN_UNIV] ]
2798QED
2799
2800(* Lemma 14.3 [1, p.138], reducing consideration of ‘prod_sigma’ to generators *)
2801Theorem PROD_SIGMA_OF_GENERATOR :
2802    !X Y E G. subset_class X E /\ subset_class Y G /\
2803              has_exhausting_sequence (X,E) /\
2804              has_exhausting_sequence (Y,G) ==>
2805             ((X,E) CROSS (Y,G) = (sigma X E) CROSS (sigma Y G))
2806Proof
2807    rpt GEN_TAC >> STRIP_TAC
2808 >> MP_TAC (Q.SPECL [‘pair$,’, ‘FST’, ‘SND’, ‘X’, ‘Y’, ‘E’, ‘G’]
2809                    (INST_TYPE [gamma |-> “:'a # 'b”] general_sigma_of_generator))
2810 >> RW_TAC std_ss [GSYM CROSS_ALT, GSYM prod_sets_alt, GSYM prod_sigma_alt,
2811                   pair_operation_pair]
2812QED
2813
2814(* FCP version of PROD_SIGMA_OF_GENERATOR *)
2815Theorem prod_sigma_of_generator :
2816    !(X :'a['b] set) (Y :'a['c] set) E G.
2817        FINITE univ(:'b) /\ FINITE univ(:'c) /\
2818        subset_class X E /\ subset_class Y G /\
2819        has_exhausting_sequence (X,E) /\
2820        has_exhausting_sequence (Y,G) ==>
2821       (fcp_sigma (X,E) (Y,G) = fcp_sigma (sigma X E) (sigma Y G))
2822Proof
2823    rpt GEN_TAC >> STRIP_TAC
2824 >> MP_TAC (Q.SPECL [‘FCP_CONCAT’, ‘FCP_FST’, ‘FCP_SND’, ‘X’, ‘Y’, ‘E’, ‘G’]
2825                    (((INST_TYPE [“:'temp1” |-> “:'a['b]”]) o
2826                      (INST_TYPE [“:'temp2” |-> “:'a['c]”]) o
2827                      (INST_TYPE [gamma |-> “:'a['b + 'c]”]) o
2828                      (INST_TYPE [alpha |-> “:'temp1”]) o
2829                      (INST_TYPE [beta |-> “:'temp2”])) general_sigma_of_generator))
2830 >> RW_TAC std_ss [GSYM fcp_cross_alt, GSYM fcp_prod_alt, GSYM fcp_sigma_alt,
2831                   pair_operation_FCP_CONCAT]
2832QED
2833
2834Theorem uniqueness_of_prod_measure_general :
2835    !(cons :'a -> 'b -> 'c) (car :'c -> 'a) (cdr :'c -> 'b)
2836     (X :'a set) (Y :'b set) E G A B u v m m'.
2837      pair_operation cons car cdr /\
2838      subset_class X E /\ subset_class Y G /\
2839      sigma_finite (X,E,u) /\ sigma_finite (Y,G,v) /\
2840     (!s t. s IN E /\ t IN E ==> s INTER t IN E) /\
2841     (!s t. s IN G /\ t IN G ==> s INTER t IN G) /\
2842     (A = sigma X E) /\ (B = sigma Y G) /\
2843      measure_space (X,subsets A,u) /\
2844      measure_space (Y,subsets B,v) /\
2845      measure_space (general_cross cons X Y,subsets (general_sigma cons A B),m) /\
2846      measure_space (general_cross cons X Y,subsets (general_sigma cons A B),m') /\
2847     (!s t. s IN E /\ t IN G ==> (m  (general_cross cons s t) = u s * v t)) /\
2848     (!s t. s IN E /\ t IN G ==> (m' (general_cross cons s t) = u s * v t)) ==>
2849      !x. x IN subsets (general_sigma cons A B) ==> (m x = m' x)
2850Proof
2851    rpt GEN_TAC >> STRIP_TAC
2852 (* applying PROD_SIGMA_OF_GENERATOR *)
2853 >> Know ‘general_sigma cons A B = general_sigma cons (X,E) (Y,G)’
2854 >- (simp [Once EQ_SYM_EQ] \\
2855     MATCH_MP_TAC general_sigma_of_generator >> art [] \\
2856     qexistsl_tac [‘car’, ‘cdr’] \\
2857     PROVE_TAC [sigma_finite_has_exhausting_sequence]) >> Rewr'
2858 >> REWRITE_TAC [general_sigma_def, space_def, subsets_def]
2859 >> MATCH_MP_TAC UNIQUENESS_OF_MEASURE
2860 >> ‘sigma_algebra A /\ sigma_algebra B’ by PROVE_TAC [SIGMA_ALGEBRA_SIGMA]
2861 >> CONJ_TAC (* subset_class *)
2862 >- (rw [subset_class_def, IN_general_prod, GSPECIFICATION] \\
2863     MATCH_MP_TAC general_SUBSET_CROSS \\
2864     fs [subset_class_def])
2865 >> CONJ_TAC (* INTER-stable *)
2866 >- (qx_genl_tac [‘a’, ‘b’] \\
2867     simp [IN_general_prod] >> STRIP_TAC \\
2868     rename1 ‘a = general_cross cons a1 b1’ \\
2869     rename1 ‘b = general_cross cons a2 b2’ \\
2870     qexistsl_tac [‘a1 INTER a2’, ‘b1 INTER b2’] \\
2871     CONJ_TAC >- (art [] >> MATCH_MP_TAC general_INTER_CROSS \\
2872                  qexistsl_tac [‘car’, ‘cdr’] >> art []) \\
2873     PROVE_TAC [])
2874 >> CONJ_TAC (* sigma_finite *)
2875 >- (fs [sigma_finite_alt_exhausting_sequence] \\
2876     Q.EXISTS_TAC ‘\n. general_cross cons (f n) (f' n)’ \\
2877     CONJ_TAC >- (MATCH_MP_TAC exhausting_sequence_general_cross >> art []) \\
2878     Q.X_GEN_TAC ‘n’ >> BETA_TAC >> simp [] \\
2879    ‘positive (X,subsets A,u) /\
2880     positive (Y,subsets B,v)’ by PROVE_TAC [MEASURE_SPACE_POSITIVE] \\
2881     fs [GSYM lt_infty] \\
2882    ‘E SUBSET subsets A /\ G SUBSET subsets B’ by METIS_TAC [SIGMA_SUBSET_SUBSETS] \\
2883     rename1 ‘!n. v (g n) <> PosInf’ \\
2884     fs [exhausting_sequence_def, IN_FUNSET, IN_UNIV] \\
2885    ‘f n IN subsets A /\ g n IN subsets B’ by METIS_TAC [SUBSET_DEF] \\
2886    ‘u (f n) <> NegInf /\ v (g n) <> NegInf’
2887       by METIS_TAC [positive_not_infty, measurable_sets_def, measure_def] \\
2888    ‘?r1. u (f n) = Normal r1’ by METIS_TAC [extreal_cases] >> POP_ORW \\
2889    ‘?r2. v (g n) = Normal r2’ by METIS_TAC [extreal_cases] >> POP_ORW \\
2890     REWRITE_TAC [extreal_mul_def, extreal_not_infty])
2891 (* applying PROD_SIGMA_OF_GENERATOR again *)
2892 >> Know ‘general_sigma cons (X,E) (Y,G) = general_sigma cons A B’
2893 >- (simp [] >> MATCH_MP_TAC general_sigma_of_generator >> art [] \\
2894     PROVE_TAC [sigma_finite_has_exhausting_sequence])
2895 >> DISCH_THEN (MP_TAC o
2896                (GEN_REWRITE_RULE (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites
2897                                  [general_sigma_def]))
2898 >> REWRITE_TAC [space_def, subsets_def] >> Rewr' >> art []
2899 >> RW_TAC std_ss [IN_general_prod]
2900 >> METIS_TAC []
2901QED
2902
2903(* Theorem 14.4 [1, p.139], cf. UNIQUENESS_OF_MEASURE *)
2904Theorem UNIQUENESS_OF_PROD_MEASURE :
2905    !(X :'a set) (Y :'b set) E G A B u v m m'.
2906      subset_class X E /\ subset_class Y G /\
2907      sigma_finite (X,E,u) /\ sigma_finite (Y,G,v) /\
2908     (!s t. s IN E /\ t IN E ==> s INTER t IN E) /\
2909     (!s t. s IN G /\ t IN G ==> s INTER t IN G) /\
2910     (A = sigma X E) /\ (B = sigma Y G) /\
2911      measure_space (X,subsets A,u) /\
2912      measure_space (Y,subsets B,v) /\
2913      measure_space (X CROSS Y,subsets (A CROSS B),m) /\
2914      measure_space (X CROSS Y,subsets (A CROSS B),m') /\
2915     (!s t. s IN E /\ t IN G ==> (m  (s CROSS t) = u s * v t)) /\
2916     (!s t. s IN E /\ t IN G ==> (m' (s CROSS t) = u s * v t)) ==>
2917      !x. x IN subsets (A CROSS B) ==> (m x = m' x)
2918Proof
2919    rpt GEN_TAC >> STRIP_TAC
2920 >> MP_TAC (Q.SPECL [‘pair$,’,‘FST’,‘SND’,‘X’,‘Y’,‘E’,‘G’,‘A’,‘B’,‘u’,‘v’,‘m’,‘m'’]
2921                    (INST_TYPE [gamma |-> “:'a # 'b”]
2922                               uniqueness_of_prod_measure_general))
2923 >> RW_TAC std_ss [GSYM CROSS_ALT, GSYM prod_sets_alt, GSYM prod_sigma_alt,
2924                   pair_operation_pair]
2925QED
2926
2927(* FCP version of UNIQUENESS_OF_PROD_MEASURE *)
2928Theorem uniqueness_of_prod_measure :
2929    !(X :'a['b] set) (Y :'a['c] set) E G A B u v m m'.
2930      FINITE univ(:'b) /\ FINITE univ(:'c) /\
2931      subset_class X E /\ subset_class Y G /\
2932      sigma_finite (X,E,u) /\ sigma_finite (Y,G,v) /\
2933     (!s t. s IN E /\ t IN E ==> s INTER t IN E) /\
2934     (!s t. s IN G /\ t IN G ==> s INTER t IN G) /\
2935     (A = sigma X E) /\ (B = sigma Y G) /\
2936      measure_space (X,subsets A,u) /\
2937      measure_space (Y,subsets B,v) /\
2938      measure_space (fcp_cross X Y,subsets (fcp_sigma A B),m) /\
2939      measure_space (fcp_cross X Y,subsets (fcp_sigma A B),m') /\
2940     (!s t. s IN E /\ t IN G ==> (m  (fcp_cross s t) = u s * v t)) /\
2941     (!s t. s IN E /\ t IN G ==> (m' (fcp_cross s t) = u s * v t)) ==>
2942      !x. x IN subsets (fcp_sigma A B) ==> (m x = m' x)
2943Proof
2944    rpt GEN_TAC >> STRIP_TAC
2945 >> MP_TAC (Q.SPECL [‘FCP_CONCAT’, ‘FCP_FST’, ‘FCP_SND’,
2946                     ‘X’, ‘Y’, ‘E’, ‘G’, ‘A’, ‘B’, ‘u’, ‘v’, ‘m’, ‘m'’]
2947                    (((INST_TYPE [“:'temp1” |-> “:'a['b]”]) o
2948                      (INST_TYPE [“:'temp2” |-> “:'a['c]”]) o
2949                      (INST_TYPE [gamma |-> “:'a['b + 'c]”]) o
2950                      (INST_TYPE [alpha |-> “:'temp1”]) o
2951                      (INST_TYPE [beta |-> “:'temp2”]))
2952                     uniqueness_of_prod_measure_general))
2953 >> RW_TAC std_ss [GSYM fcp_cross_alt, GSYM fcp_prod_alt, GSYM fcp_sigma_alt,
2954                   pair_operation_FCP_CONCAT]
2955QED
2956
2957Theorem uniqueness_of_prod_measure_general' :
2958    !(cons :'a -> 'b -> 'c) (car :'c -> 'a) (cdr :'c -> 'b)
2959     (X :'a set) (Y :'b set) A B u v m m'.
2960      pair_operation cons car cdr /\
2961      sigma_finite_measure_space (X,A,u) /\
2962      sigma_finite_measure_space (Y,B,v) /\
2963      measure_space (general_cross cons X Y,
2964                     subsets (general_sigma cons (X,A) (Y,B)),m) /\
2965      measure_space (general_cross cons X Y,
2966                     subsets (general_sigma cons (X,A) (Y,B)),m') /\
2967     (!s t. s IN A /\ t IN B ==> (m  (general_cross cons s t) = u s * v t)) /\
2968     (!s t. s IN A /\ t IN B ==> (m' (general_cross cons s t) = u s * v t)) ==>
2969      !x. x IN subsets (general_sigma cons (X,A) (Y,B)) ==> (m x = m' x)
2970Proof
2971    rpt GEN_TAC >> STRIP_TAC
2972 >> MP_TAC (Q.SPECL [‘cons’, ‘car’, ‘cdr’,
2973                     ‘X’, ‘Y’, ‘A’, ‘B’, ‘(X,A)’, ‘(Y,B)’, ‘u’, ‘v’, ‘m’, ‘m'’]
2974                    uniqueness_of_prod_measure_general)
2975 >> fs [sigma_finite_measure_space_def]
2976 >> ‘sigma_algebra (X,A) /\ sigma_algebra (Y,B)’
2977      by METIS_TAC [measure_space_def, m_space_def, measurable_sets_def]
2978 >> ‘sigma X A = (X,A) /\ sigma Y B = (Y,B)’
2979      by METIS_TAC [SIGMA_STABLE, space_def, subsets_def]
2980 >> Know ‘!s t. s IN A /\ t IN A ==> s INTER t IN A’
2981 >- (rpt STRIP_TAC \\
2982     MATCH_MP_TAC (REWRITE_RULE [space_def, subsets_def]
2983                                (Q.SPEC ‘(X,A)’ SIGMA_ALGEBRA_INTER)) \\
2984     ASM_REWRITE_TAC [])
2985 >> Know ‘!s t. s IN B /\ t IN B ==> s INTER t IN B’
2986 >- (rpt STRIP_TAC \\
2987     MATCH_MP_TAC (REWRITE_RULE [space_def, subsets_def]
2988                                (Q.SPEC ‘(Y,B)’ SIGMA_ALGEBRA_INTER)) \\
2989     ASM_REWRITE_TAC [])
2990 >> RW_TAC std_ss []
2991 >> FIRST_X_ASSUM irule
2992 >> fs [sigma_algebra_def, algebra_def]
2993QED
2994
2995(* A specialized version for sigma-algebras instead of generators *)
2996Theorem UNIQUENESS_OF_PROD_MEASURE' :
2997    !(X :'a set) (Y :'b set) A B u v m m'.
2998      sigma_finite_measure_space (X,A,u) /\
2999      sigma_finite_measure_space (Y,B,v) /\
3000      measure_space (X CROSS Y,subsets ((X,A) CROSS (Y,B)),m) /\
3001      measure_space (X CROSS Y,subsets ((X,A) CROSS (Y,B)),m') /\
3002     (!s t. s IN A /\ t IN B ==> (m  (s CROSS t) = u s * v t)) /\
3003     (!s t. s IN A /\ t IN B ==> (m' (s CROSS t) = u s * v t)) ==>
3004      !x. x IN subsets ((X,A) CROSS (Y,B)) ==> (m x = m' x)
3005Proof
3006    rpt GEN_TAC >> STRIP_TAC
3007 >> MP_TAC (Q.SPECL [‘pair$,’,‘FST’,‘SND’,‘X’,‘Y’,‘A’,‘B’,‘u’,‘v’,‘m’,‘m'’]
3008                    (INST_TYPE [gamma |-> “:'a # 'b”]
3009                               uniqueness_of_prod_measure_general'))
3010 >> RW_TAC std_ss [GSYM CROSS_ALT, GSYM prod_sets_alt, GSYM prod_sigma_alt,
3011                   pair_operation_pair]
3012QED
3013
3014(* FCP version of UNIQUENESS_OF_PROD_MEASURE' *)
3015Theorem uniqueness_of_prod_measure' :
3016    !(X :'a['b] set) (Y :'a['c] set) A B u v m m'.
3017      FINITE univ(:'b) /\ FINITE univ(:'c) /\
3018      sigma_finite_measure_space (X,A,u) /\
3019      sigma_finite_measure_space (Y,B,v) /\
3020      measure_space (fcp_cross X Y,subsets (fcp_sigma (X,A) (Y,B)),m) /\
3021      measure_space (fcp_cross X Y,subsets (fcp_sigma (X,A) (Y,B)),m') /\
3022     (!s t. s IN A /\ t IN B ==> (m  (fcp_cross s t) = u s * v t)) /\
3023     (!s t. s IN A /\ t IN B ==> (m' (fcp_cross s t) = u s * v t)) ==>
3024      !x. x IN subsets (fcp_sigma (X,A) (Y,B)) ==> (m x = m' x)
3025Proof
3026    rpt GEN_TAC >> STRIP_TAC
3027 >> MP_TAC (Q.SPECL [‘FCP_CONCAT’, ‘FCP_FST’, ‘FCP_SND’,
3028                     ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘m’, ‘m'’]
3029                    (((INST_TYPE [“:'temp1” |-> “:'a['b]”]) o
3030                      (INST_TYPE [“:'temp2” |-> “:'a['c]”]) o
3031                      (INST_TYPE [gamma |-> “:'a['b + 'c]”]) o
3032                      (INST_TYPE [alpha |-> “:'temp1”]) o
3033                      (INST_TYPE [beta |-> “:'temp2”]))
3034                     uniqueness_of_prod_measure_general'))
3035 >> RW_TAC std_ss [GSYM fcp_cross_alt, GSYM fcp_prod_alt,
3036                   GSYM fcp_sigma_alt, pair_operation_FCP_CONCAT]
3037QED
3038
3039Theorem existence_of_prod_measure_general :
3040   !(cons :'a -> 'b -> 'c) car cdr (X :'a set) (Y :'b set) A B u v m0.
3041       pair_operation cons car cdr /\
3042       sigma_finite_measure_space (X,A,u) /\
3043       sigma_finite_measure_space (Y,B,v) /\
3044       (!s t. s IN A /\ t IN B ==> (m0 (general_cross cons s t) = u s * v t)) ==>
3045       (!s. s IN subsets (general_sigma cons (X,A) (Y,B)) ==>
3046           (!x. x IN X ==>
3047               (\y. indicator_fn s (cons x y)) IN measurable (Y,B) Borel) /\
3048           (!y. y IN Y ==>
3049               (\x. indicator_fn s (cons x y)) IN measurable (X,A) Borel) /\
3050           (\y. pos_fn_integral (X,A,u)
3051                  (\x. indicator_fn s (cons x y))) IN measurable (Y,B) Borel /\
3052           (\x. pos_fn_integral (Y,B,v)
3053                  (\y. indicator_fn s (cons x y))) IN measurable (X,A) Borel) /\
3054       ?m. sigma_finite_measure_space (general_cross cons X Y,
3055                                       subsets (general_sigma cons (X,A) (Y,B)),m) /\
3056           (!s. s IN (general_prod cons A B) ==> (m s = m0 s)) /\
3057           (!s. s IN subsets (general_sigma cons (X,A) (Y,B)) ==>
3058               (m s = pos_fn_integral (Y,B,v)
3059                        (\y. pos_fn_integral (X,A,u)
3060                                             (\x. indicator_fn s (cons x y)))) /\
3061               (m s = pos_fn_integral (X,A,u)
3062                        (\x. pos_fn_integral (Y,B,v)
3063                                             (\y. indicator_fn s (cons x y)))))
3064Proof
3065    rpt GEN_TAC >> STRIP_TAC
3066 >> fs [sigma_finite_measure_space_def, sigma_finite_alt_exhausting_sequence]
3067 >> ‘sigma_algebra (X,A) /\ sigma_algebra (Y,B)’
3068      by PROVE_TAC [measure_space_def, m_space_def, measurable_sets_def,
3069                    space_def, subsets_def]
3070 >> rename1 ‘!n. u (a n) < PosInf’
3071 >> rename1 ‘!n. v (b n) < PosInf’
3072 >> Q.ABBREV_TAC ‘E = \n. general_cross cons (a n) (b n)’
3073 (* (D n) is supposed to be a dynkin system *)
3074 >> Q.ABBREV_TAC ‘D = \n.
3075     {d | d SUBSET (general_cross cons X Y) /\
3076          (!x. x IN X ==>
3077              (\y. indicator_fn (d INTER (E n)) (cons x y))
3078                 IN Borel_measurable (Y,B)) /\
3079          (!y. y IN Y ==>
3080              (\x. indicator_fn (d INTER (E n)) (cons x y))
3081                 IN Borel_measurable (X,A)) /\
3082          (\y. pos_fn_integral (X,A,u)
3083                               (\x. indicator_fn (d INTER (E n)) (cons x y)))
3084                 IN Borel_measurable (Y,B) /\
3085          (\x. pos_fn_integral (Y,B,v)
3086                               (\y. indicator_fn (d INTER (E n)) (cons x y)))
3087                 IN Borel_measurable (X,A) /\
3088          (pos_fn_integral (X,A,u)
3089             (\x. pos_fn_integral (Y,B,v)
3090                                  (\y. indicator_fn (d INTER (E n)) (cons x y))) =
3091           pos_fn_integral (Y,B,v)
3092             (\y. pos_fn_integral (X,A,u)
3093                                  (\x. indicator_fn (d INTER (E n)) (cons x y))))}’
3094 >> Know ‘!n. (general_prod cons A B) SUBSET (D n)’
3095 >- (rw [IN_general_prod, SUBSET_DEF] \\
3096     rename1 ‘s IN A’ >> rename1 ‘t IN B’ \\
3097     Q.UNABBREV_TAC ‘D’ >> BETA_TAC >> simp [GSPECIFICATION] \\
3098     CONJ_TAC (* (s CROSS t) SUBSET (X CROSS Y) *)
3099     >- (MATCH_MP_TAC general_SUBSET_CROSS \\
3100        ‘subset_class X A /\ subset_class Y B’
3101           by PROVE_TAC [measure_space_def, SIGMA_ALGEBRA_ALT_SPACE, m_space_def,
3102                         measurable_sets_def, space_def, subsets_def] \\
3103         fs [subset_class_def]) \\
3104     Q.UNABBREV_TAC ‘E’ >> BETA_TAC \\
3105     rfs [exhausting_sequence_def, IN_FUNSET, IN_UNIV] \\
3106  (* key separation *)
3107     Know ‘!x y. indicator_fn ((general_cross cons s t) INTER
3108                               (general_cross cons (a n) (b n))) (cons x y) =
3109                 indicator_fn (s INTER a n) x * indicator_fn (t INTER b n) y’
3110     >- (rpt GEN_TAC \\
3111         Know ‘general_cross cons s t INTER general_cross cons (a n) (b n) =
3112               general_cross cons (s INTER a n) (t INTER b n)’
3113         >- (MATCH_MP_TAC general_INTER_CROSS \\
3114             qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
3115         MATCH_MP_TAC indicator_fn_general_cross \\
3116         qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
3117  (* from now on FCP is not needed any more *)
3118     STRONG_CONJ_TAC (* Borel_measurable #1 *)
3119     >- (rpt STRIP_TAC \\
3120        ‘?r. indicator_fn (s INTER a n) x = Normal r’
3121            by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3122         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> art [subsets_def] \\
3123         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3124                                    (ISPEC “(Y,B) :'b algebra” SIGMA_ALGEBRA_INTER)) \\
3125         rw []) >> DISCH_TAC \\
3126     STRONG_CONJ_TAC (* Borel_measurable #2 *)
3127     >- (rpt STRIP_TAC >> ONCE_REWRITE_TAC [mul_comm] \\
3128        ‘?r. indicator_fn (t INTER b n) y = Normal r’
3129            by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3130         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> art [subsets_def] \\
3131         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3132                                    (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3133         rw []) >> DISCH_TAC \\
3134     STRONG_CONJ_TAC (* Borel_measurable #3 *)
3135     >- (Know ‘!y. pos_fn_integral (X,A,u) (\x. indicator_fn (s INTER a n) x *
3136                                                indicator_fn (t INTER b n) y) =
3137                   indicator_fn (t INTER b n) y *
3138                   pos_fn_integral (X,A,u) (indicator_fn (s INTER a n))’
3139         >- (GEN_TAC \\
3140            ‘?r. 0 <= r /\ (indicator_fn (t INTER b n) y = Normal r)’
3141                by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3142             GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [mul_comm] \\
3143             MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
3144         ONCE_REWRITE_TAC [mul_comm] \\
3145         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR' >> art [subsets_def] \\
3146         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3147                                    (ISPEC “(Y,B) :'b algebra” SIGMA_ALGEBRA_INTER)) \\
3148         rw []) >> DISCH_TAC \\
3149     STRONG_CONJ_TAC (* Borel_measurable #4 *)
3150     >- (Know ‘!x. pos_fn_integral (Y,B,v) (\y. indicator_fn (s INTER a n) x *
3151                                                indicator_fn (t INTER b n) y) =
3152                   indicator_fn (s INTER a n) x *
3153                   pos_fn_integral (Y,B,v) (indicator_fn (t INTER b n))’
3154         >- (GEN_TAC \\
3155            ‘?r. 0 <= r /\ (indicator_fn (s INTER a n) x = Normal r)’
3156                by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3157             MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
3158         ONCE_REWRITE_TAC [mul_comm] \\
3159         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR' >> art [subsets_def] \\
3160         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3161                                    (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3162         rw []) >> DISCH_TAC \\
3163     Know ‘!x. pos_fn_integral (Y,B,v) (\y. indicator_fn (s INTER a n) x *
3164                                            indicator_fn (t INTER b n) y) =
3165               indicator_fn (s INTER a n) x *
3166               pos_fn_integral (Y,B,v) (indicator_fn (t INTER b n))’
3167     >- (GEN_TAC \\
3168        ‘?r. 0 <= r /\ (indicator_fn (s INTER a n) x = Normal r)’
3169            by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3170         MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
3171     Know ‘!y. pos_fn_integral (X,A,u) (\x. indicator_fn (s INTER a n) x *
3172                                            indicator_fn (t INTER b n) y) =
3173               indicator_fn (t INTER b n) y *
3174               pos_fn_integral (X,A,u) (indicator_fn (s INTER a n))’
3175     >- (GEN_TAC \\
3176        ‘?r. 0 <= r /\ (indicator_fn (t INTER b n) y = Normal r)’
3177            by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3178         GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [mul_comm] \\
3179         MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
3180     Know ‘pos_fn_integral (Y,B,v) (indicator_fn (t INTER b n)) =
3181           measure (Y,B,v) (t INTER b n)’
3182     >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3183         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3184                                    (ISPEC “(Y,B) :'b algebra” SIGMA_ALGEBRA_INTER)) \\
3185         rw []) >> Rewr' \\
3186     Know ‘pos_fn_integral (X,A,u) (indicator_fn (s INTER a n)) =
3187           measure (X,A,u) (s INTER a n)’
3188     >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3189         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3190                                    (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3191         rw []) >> Rewr' \\
3192     ONCE_REWRITE_TAC [mul_comm] >> REWRITE_TAC [measure_def] \\
3193  (* reduce u() and v() to normal extreals *)
3194     Know ‘u (s INTER a n) <> PosInf’
3195     >- (REWRITE_TAC [lt_infty] \\
3196         MATCH_MP_TAC let_trans >> Q.EXISTS_TAC ‘u (a n)’ >> art [] \\
3197         MATCH_MP_TAC (REWRITE_RULE [measurable_sets_def, measure_def]
3198                                    (Q.SPEC ‘(X,A,u)’ INCREASING)) \\
3199         CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_INCREASING >> art []) \\
3200         ASM_REWRITE_TAC [INTER_SUBSET] \\
3201         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3202                                    (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3203         rw []) >> DISCH_TAC \\
3204     Know ‘v (t INTER b n) <> PosInf’
3205     >- (REWRITE_TAC [lt_infty] \\
3206         MATCH_MP_TAC let_trans >> Q.EXISTS_TAC ‘v (b n)’ >> art [] \\
3207         MATCH_MP_TAC (REWRITE_RULE [measurable_sets_def, measure_def]
3208                                    (Q.SPEC ‘(Y,B,v)’ INCREASING)) \\
3209         CONJ_TAC >- (MATCH_MP_TAC MEASURE_SPACE_INCREASING >> art []) \\
3210         ASM_REWRITE_TAC [INTER_SUBSET] \\
3211         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3212                                    (ISPEC “(Y,B) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3213         rw []) >> DISCH_TAC \\
3214     IMP_RES_TAC MEASURE_SPACE_POSITIVE >> rfs [positive_def] \\
3215     Know ‘0 <= u (s INTER a n)’
3216     >- (FIRST_X_ASSUM MATCH_MP_TAC \\
3217         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3218                                    (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3219         rw []) >> DISCH_TAC \\
3220     Know ‘0 <= v (t INTER b n)’
3221     >- (FIRST_X_ASSUM MATCH_MP_TAC \\
3222         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3223                                    (ISPEC “(Y,B) :'b algebra” SIGMA_ALGEBRA_INTER)) \\
3224         rw []) >> DISCH_TAC \\
3225    ‘u (s INTER a n) <> NegInf /\ v (t INTER b n) <> NegInf’
3226        by PROVE_TAC [pos_not_neginf] \\
3227    ‘?r1. u (s INTER a n) = Normal r1’ by METIS_TAC [extreal_cases] \\
3228    ‘?r2. v (t INTER b n) = Normal r2’ by METIS_TAC [extreal_cases] \\
3229    ‘0 <= r1 /\ 0 <= r2’ by METIS_TAC [extreal_of_num_def, extreal_le_eq] >> art [] \\
3230     Know ‘pos_fn_integral (X,A,u) (\x. Normal r2 * indicator_fn (s INTER a n) x) =
3231           Normal r2 * pos_fn_integral (X,A,u) (indicator_fn (s INTER a n))’
3232     >- (MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
3233     Know ‘pos_fn_integral (Y,B,v) (\y. Normal r1 * indicator_fn (t INTER b n) y) =
3234           Normal r1 * pos_fn_integral (Y,B,v) (indicator_fn (t INTER b n))’
3235     >- (MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
3236     Know ‘pos_fn_integral (Y,B,v) (indicator_fn (t INTER b n)) =
3237           measure (Y,B,v) (t INTER b n)’
3238     >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3239         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3240                                    (ISPEC “(Y,B) :'b algebra” SIGMA_ALGEBRA_INTER)) \\
3241         rw []) >> Rewr' \\
3242     Know ‘pos_fn_integral (X,A,u) (indicator_fn (s INTER a n)) =
3243           measure (X,A,u) (s INTER a n)’
3244     >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3245         MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3246                                    (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3247         rw []) >> Rewr' \\
3248     ASM_REWRITE_TAC [measure_def, Once mul_comm]) >> DISCH_TAC
3249 (* a basic property of D *)
3250 >> Know ‘!n. E n IN D n’
3251 >- (rw [Abbr ‘E’] \\
3252     Suff ‘general_cross cons (a n) (b n) IN general_prod cons A B’
3253     >- PROVE_TAC [SUBSET_DEF] \\
3254     rw [IN_general_prod] >> qexistsl_tac [‘a n’, ‘b n’] >> REWRITE_TAC [] \\
3255     REV_FULL_SIMP_TAC std_ss [exhausting_sequence_def, IN_FUNSET, IN_UNIV,
3256                               subsets_def])
3257 >> DISCH_TAC
3258 (* The following 4 D-properties are frequently needed.
3259    Note: the quantifiers (n,d,x,y) can be anything, in particular it's NOT
3260          required that ‘x IN X’ or ‘y IN y’ or ‘d IN D n’ *)
3261 >> ‘!n d y. pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y))
3262             <> NegInf’
3263      by (rpt GEN_TAC >> MATCH_MP_TAC pos_not_neginf \\
3264          MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS])
3265 >> Know ‘!n d y. pos_fn_integral (X,A,u)
3266                                  (\x. indicator_fn (d INTER E n) (cons x y)) <>
3267                  PosInf’
3268 >- (rw [Abbr ‘E’, lt_infty] >> MATCH_MP_TAC let_trans \\
3269     Q.EXISTS_TAC ‘pos_fn_integral (X,A,u)
3270                     (\x. indicator_fn (general_cross cons (a n) (b n))
3271                                       (cons x y))’ \\
3272     CONJ_TAC >- (MATCH_MP_TAC pos_fn_integral_mono >> rw [INDICATOR_FN_POS] \\
3273                  MATCH_MP_TAC INDICATOR_FN_MONO >> REWRITE_TAC [INTER_SUBSET]) \\
3274     Know ‘!x. indicator_fn (general_cross cons (a n) (b n)) (cons x y) =
3275               indicator_fn (a n) x * indicator_fn (b n) y’
3276     >- (MATCH_MP_TAC indicator_fn_general_cross \\
3277         qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
3278     ONCE_REWRITE_TAC [mul_comm] \\
3279    ‘?r. 0 <= r /\ indicator_fn (b n) y = Normal r’
3280        by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3281     Know ‘pos_fn_integral (X,A,u) (\x. Normal r * indicator_fn (a n) x) =
3282           Normal r * pos_fn_integral (X,A,u) (indicator_fn (a n))’
3283     >- (MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
3284     Know ‘pos_fn_integral (X,A,u) (indicator_fn (a n)) = measure (X,A,u) (a n)’
3285     >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3286         FULL_SIMP_TAC std_ss [exhausting_sequence_def, subsets_def, IN_FUNSET,
3287                               IN_UNIV]) \\
3288     REWRITE_TAC [measure_def] >> Rewr' \\
3289     REWRITE_TAC [GSYM lt_infty] \\
3290     IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
3291     REV_FULL_SIMP_TAC std_ss [positive_def, exhausting_sequence_def,
3292                               IN_FUNSET, IN_UNIV, space_def, subsets_def,
3293                               measurable_sets_def, measure_def] \\
3294     Know ‘u (a n) <> PosInf /\ u (a n) <> NegInf’
3295     >- (CONJ_TAC >- art [lt_infty] \\
3296         MATCH_MP_TAC pos_not_neginf \\
3297         FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> STRIP_TAC \\
3298    ‘?z. u (a n) = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
3299     REWRITE_TAC [extreal_mul_def, extreal_not_infty]) >> DISCH_TAC
3300 >> ‘!n d x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y)) <> NegInf’
3301      by (rpt GEN_TAC >> MATCH_MP_TAC pos_not_neginf \\
3302          MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS])
3303 >> Know ‘!n d x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y)) <> PosInf’
3304 >- (rw [Abbr ‘E’, lt_infty] >> MATCH_MP_TAC let_trans \\
3305     Q.EXISTS_TAC ‘pos_fn_integral (Y,B,v)
3306                     (\y. indicator_fn (general_cross cons (a n) (b n)) (cons x y))’ \\
3307     CONJ_TAC >- (MATCH_MP_TAC pos_fn_integral_mono >> rw [INDICATOR_FN_POS] \\
3308                  MATCH_MP_TAC INDICATOR_FN_MONO >> REWRITE_TAC [INTER_SUBSET]) \\
3309     Know ‘!y. indicator_fn (general_cross cons (a n) (b n)) (cons x y) =
3310               indicator_fn (a n) x * indicator_fn (b n) y’
3311     >- (MATCH_MP_TAC indicator_fn_general_cross \\
3312         qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
3313    ‘?r. 0 <= r /\ indicator_fn (a n) x = Normal r’
3314        by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3315     Know ‘pos_fn_integral (Y,B,v) (\y. Normal r * indicator_fn (b n) y) =
3316           Normal r * pos_fn_integral (Y,B,v) (indicator_fn (b n))’
3317     >- (MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
3318     Know ‘pos_fn_integral (Y,B,v) (indicator_fn (b n)) = measure (Y,B,v) (b n)’
3319     >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3320         FULL_SIMP_TAC std_ss [exhausting_sequence_def, subsets_def, IN_FUNSET, IN_UNIV]) \\
3321     REWRITE_TAC [measure_def] >> Rewr' \\
3322     REWRITE_TAC [GSYM lt_infty] \\
3323     IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
3324     REV_FULL_SIMP_TAC std_ss [positive_def, exhausting_sequence_def,
3325                               IN_FUNSET, IN_UNIV, space_def, subsets_def,
3326                               measurable_sets_def, measure_def] \\
3327     Know ‘v (b n) <> PosInf /\ v (b n) <> NegInf’
3328     >- (CONJ_TAC >- art [lt_infty] \\
3329         MATCH_MP_TAC pos_not_neginf \\
3330         FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> STRIP_TAC \\
3331    ‘?z. v (b n) = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
3332     REWRITE_TAC [extreal_mul_def, extreal_not_infty]) >> DISCH_TAC
3333 (* key property: D n is a dynkin system *)
3334 >> Know ‘!n. dynkin_system (general_cross cons X Y,D n)’
3335 >- (rw [dynkin_system_def] >| (* 4 subgoals *)
3336     [ (* goal 1 (of 4) *)
3337       rw [subset_class_def, Abbr ‘D’],
3338       (* goal 2 (of 4) *)
3339       Suff ‘general_cross cons X Y IN general_prod cons A B’
3340       >- PROVE_TAC [SUBSET_DEF] \\
3341       rw [IN_general_prod] >> qexistsl_tac [‘X’, ‘Y’] >> REWRITE_TAC [] \\
3342       fs [SIGMA_ALGEBRA_ALT_SPACE],
3343       (* goal 3 (of 4): DIFF (hard) *)
3344       rename1 ‘(general_cross cons X Y) DIFF d IN D n’ \\
3345    (* expanding D without touching assumptions *)
3346       Suff ‘(general_cross cons X Y) DIFF d IN
3347             {d | d SUBSET general_cross cons X Y /\
3348                 (!x. x IN X ==>
3349                     (\y. indicator_fn (d INTER E n) (cons x y))
3350                        IN Borel_measurable (Y,B)) /\
3351                 (!y. y IN Y ==>
3352                     (\x. indicator_fn (d INTER E n) (cons x y))
3353                        IN Borel_measurable (X,A)) /\
3354                 (\y. pos_fn_integral (X,A,u)
3355                                      (\x. indicator_fn (d INTER E n) (cons x y)))
3356                        IN Borel_measurable (Y,B) /\
3357                 (\x. pos_fn_integral (Y,B,v)
3358                                      (\y. indicator_fn (d INTER E n) (cons x y)))
3359                        IN Borel_measurable (X,A) /\
3360                  pos_fn_integral (X,A,u)
3361                    (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n)
3362                                                                   (cons x y))) =
3363                  pos_fn_integral (Y,B,v)
3364                    (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n)
3365                                                                   (cons x y)))}’
3366       >- METIS_TAC [Abbr ‘D’] >> simp [GSPECIFICATION] \\
3367       Know ‘indicator_fn (((general_cross cons X Y) DIFF d) INTER E n) =
3368            (\t. indicator_fn (E n) t - indicator_fn (d INTER E n) t)’
3369       >- (ONCE_REWRITE_TAC [INTER_COMM] \\
3370           MATCH_MP_TAC INDICATOR_FN_DIFF_SPACE \\
3371           rw [Abbr ‘E’]
3372           >- (MATCH_MP_TAC general_SUBSET_CROSS \\
3373               FULL_SIMP_TAC std_ss [exhausting_sequence_def, IN_FUNSET, IN_UNIV,
3374                                     subsets_def, space_def] \\
3375               METIS_TAC [sigma_algebra_def, algebra_def, subset_class_def,
3376                          space_def, subsets_def]) \\
3377           REV_FULL_SIMP_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> Rewr' \\
3378       BETA_TAC \\
3379       STRONG_CONJ_TAC (* Borel_measurable #1 *)
3380       >- (rpt STRIP_TAC \\
3381           MATCH_MP_TAC IN_MEASURABLE_BOREL_SUB >> BETA_TAC \\
3382           qexistsl_tac [‘\y. indicator_fn (E n) (cons x y)’,
3383                         ‘\y. indicator_fn (d INTER E n) (cons x y)’] \\
3384           rw [INDICATOR_FN_NOT_INFTY] >|
3385           [ (* goal 1 (of 2) *)
3386            ‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3387             REV_FULL_SIMP_TAC std_ss [Abbr ‘D’, GSPECIFICATION],
3388             (* goal 2 (of 2) *)
3389             FULL_SIMP_TAC std_ss [Abbr ‘D’, GSPECIFICATION] ]) >> DISCH_TAC \\
3390       STRONG_CONJ_TAC (* Borel_measurable #2 (symmetric with #1) *)
3391       >- (rpt STRIP_TAC \\
3392           MATCH_MP_TAC IN_MEASURABLE_BOREL_SUB >> BETA_TAC \\
3393           qexistsl_tac [‘\x. indicator_fn (E n) (cons x y)’,
3394                         ‘\x. indicator_fn (d INTER E n) (cons x y)’] \\
3395           rw [INDICATOR_FN_NOT_INFTY] >|
3396           [ (* goal 1 (of 2) *)
3397            ‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3398             FULL_SIMP_TAC std_ss [Abbr ‘D’, GSPECIFICATION],
3399             (* goal 2 (of 2) *)
3400             FULL_SIMP_TAC std_ss [Abbr ‘D’, GSPECIFICATION] ]) >> DISCH_TAC \\
3401       CONJ_TAC (* Borel_measurable #3 *)
3402       >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3403                                      (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
3404           Q.EXISTS_TAC ‘\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y)) -
3405                             pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y))’ \\
3406           reverse CONJ_TAC
3407           >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_SUB >> BETA_TAC >> art [space_def] \\
3408               qexistsl_tac [‘\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y))’,
3409                             ‘\y. pos_fn_integral (X,A,u)
3410                                    (\x. indicator_fn (d INTER E n) (cons x y))’] \\
3411               rw [] >| (* 2 subgoals *)
3412               [ (* goal 1 (of 2) *)
3413                ‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3414                 Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3415                 RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION],
3416                 (* goal 2 (of 2) *)
3417                 Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3418                 RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION] ]) \\
3419           Q.X_GEN_TAC ‘y’ >> STRIP_TAC >> BETA_TAC \\
3420           HO_MATCH_MP_TAC pos_fn_integral_sub \\
3421           simp [INDICATOR_FN_POS, INDICATOR_FN_NOT_INFTY] \\
3422           CONJ_TAC >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3423                        Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3424                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3425           CONJ_TAC >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3426                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3427           rpt STRIP_TAC \\
3428           MATCH_MP_TAC INDICATOR_FN_MONO >> REWRITE_TAC [INTER_SUBSET]) \\
3429       CONJ_TAC (* Borel_measurable #4 (symmetric with #3) *)
3430       >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3431                                      (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
3432           Q.EXISTS_TAC ‘\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y)) -
3433                             pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y))’ \\
3434           reverse CONJ_TAC
3435           >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_SUB >> BETA_TAC >> art [space_def] \\
3436               qexistsl_tac [‘\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y))’,
3437                             ‘\x. pos_fn_integral (Y,B,v)
3438                                    (\y. indicator_fn (d INTER E n) (cons x y))’] \\
3439               rw [] >| (* 2 subgoals *)
3440               [ (* goal 1 (of 2) *)
3441                ‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3442                 Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3443                 RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION],
3444                 (* goal 2 (of 2) *)
3445                 Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3446                 RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION] ]) \\
3447           Q.X_GEN_TAC ‘x’ >> STRIP_TAC >> BETA_TAC \\
3448           HO_MATCH_MP_TAC pos_fn_integral_sub \\
3449           simp [INDICATOR_FN_POS, INDICATOR_FN_NOT_INFTY] \\
3450           CONJ_TAC >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3451                        Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3452                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3453           CONJ_TAC >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3454                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3455           rpt STRIP_TAC \\
3456           MATCH_MP_TAC INDICATOR_FN_MONO >> REWRITE_TAC [INTER_SUBSET]) \\
3457       Know ‘pos_fn_integral (X,A,u)
3458               (\x. pos_fn_integral (Y,B,v)
3459                      (\y. indicator_fn (E n) (cons x y) -
3460                           indicator_fn (d INTER E n) (cons x y))) =
3461             pos_fn_integral (X,A,u)
3462               (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y)) -
3463                    pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y)))’
3464       >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
3465           CONJ_TAC >- (rpt STRIP_TAC \\
3466                        MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
3467                        Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
3468                        MATCH_MP_TAC le_sub_imp \\
3469                        simp [INDICATOR_FN_NOT_INFTY, add_lzero] \\
3470                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3471           CONJ_TAC >- (rpt STRIP_TAC \\
3472                        MATCH_MP_TAC le_sub_imp >> simp [add_lzero] \\
3473                        MATCH_MP_TAC pos_fn_integral_mono >> rw [INDICATOR_FN_POS] \\
3474                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3475           rpt STRIP_TAC \\
3476           HO_MATCH_MP_TAC pos_fn_integral_sub \\
3477           simp [INDICATOR_FN_POS, INDICATOR_FN_NOT_INFTY] \\
3478           CONJ_TAC >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3479                        Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3480                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3481           CONJ_TAC >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3482                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3483           rpt STRIP_TAC \\
3484           MATCH_MP_TAC INDICATOR_FN_MONO >> REWRITE_TAC [INTER_SUBSET]) >> Rewr' \\
3485       Know ‘pos_fn_integral (Y,B,v)
3486               (\y. pos_fn_integral (X,A,u)
3487                      (\x. indicator_fn (E n) (cons x y) -
3488                           indicator_fn (d INTER E n) (cons x y))) =
3489             pos_fn_integral (Y,B,v)
3490               (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y)) -
3491                    pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y)))’
3492       >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
3493           CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3494                        MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
3495                        Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
3496                        MATCH_MP_TAC le_sub_imp \\
3497                        simp [INDICATOR_FN_NOT_INFTY, add_lzero] \\
3498                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3499           CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3500                        MATCH_MP_TAC le_sub_imp >> simp [add_lzero] \\
3501                        MATCH_MP_TAC pos_fn_integral_mono >> rw [INDICATOR_FN_POS] \\
3502                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3503           Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3504           HO_MATCH_MP_TAC pos_fn_integral_sub \\
3505           simp [INDICATOR_FN_POS, INDICATOR_FN_NOT_INFTY] \\
3506           CONJ_TAC >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3507                        Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3508                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3509           CONJ_TAC >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3510                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3511           Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
3512           MATCH_MP_TAC INDICATOR_FN_MONO >> REWRITE_TAC [INTER_SUBSET]) >> Rewr' \\
3513       Know ‘pos_fn_integral (X,A,u)
3514               (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y)) -
3515                    pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y))) =
3516             pos_fn_integral (X,A,u)
3517               (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y))) -
3518             pos_fn_integral (X,A,u)
3519               (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y)))’
3520       >- (HO_MATCH_MP_TAC pos_fn_integral_sub >> simp [] \\
3521           CONJ_TAC >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3522                        Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3523                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3524           CONJ_TAC >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3525                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3526           CONJ_TAC >- (rpt STRIP_TAC \\
3527                        MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
3528           CONJ_TAC >- (rpt STRIP_TAC \\
3529                        MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3530                        Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3531                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3532           REWRITE_TAC [lt_infty] >> MATCH_MP_TAC let_trans \\
3533           Q.EXISTS_TAC ‘pos_fn_integral (X,A,u)
3534                          (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y)))’ \\
3535           CONJ_TAC >- (MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3536                        CONJ_TAC >- (rpt STRIP_TAC \\
3537                                     MATCH_MP_TAC pos_fn_integral_pos \\
3538                                     simp [INDICATOR_FN_POS]) \\
3539                        rpt STRIP_TAC \\
3540                        MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3541                        Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3542                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3543           rw [Abbr ‘E’, GSYM lt_infty] \\
3544           Know ‘!x y. indicator_fn (general_cross cons (a n) (b n)) (cons x y) =
3545                       indicator_fn (a n) x * indicator_fn (b n) y’
3546           >- (rpt GEN_TAC >> MATCH_MP_TAC indicator_fn_general_cross \\
3547               qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
3548           Know ‘!x. pos_fn_integral (Y,B,v) (\y. indicator_fn (a n) x * indicator_fn (b n) y) =
3549                     indicator_fn (a n) x * pos_fn_integral (Y,B,v) (indicator_fn (b n))’
3550           >- (GEN_TAC \\
3551              ‘?r. 0 <= r /\ indicator_fn (a n) x = Normal r’
3552                 by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3553               Know ‘pos_fn_integral (Y,B,v) (\y. Normal r * indicator_fn (b n) y) =
3554                     Normal r * pos_fn_integral (Y,B,v) (indicator_fn (b n))’
3555               >- (MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) \\
3556               Rewr) >> Rewr' \\
3557           Know ‘pos_fn_integral (Y,B,v) (indicator_fn (b n)) = measure (Y,B,v) (b n)’
3558           >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3559               FULL_SIMP_TAC std_ss [exhausting_sequence_def, subsets_def, IN_FUNSET, IN_UNIV]) \\
3560           REWRITE_TAC [measure_def] >> Rewr' \\
3561           IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
3562           REV_FULL_SIMP_TAC std_ss [positive_def, exhausting_sequence_def,
3563                                     IN_FUNSET, IN_UNIV, space_def, subsets_def,
3564                                     measurable_sets_def, measure_def] \\
3565           Know ‘v (b n) <> PosInf /\ v (b n) <> NegInf’
3566           >- (CONJ_TAC >- art [lt_infty] \\
3567               MATCH_MP_TAC pos_not_neginf \\
3568               FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> STRIP_TAC \\
3569           ONCE_REWRITE_TAC [mul_comm] \\
3570           Know ‘pos_fn_integral (X,A,u) (\x. v (b n) * indicator_fn (a n) x) =
3571                 v (b n) * pos_fn_integral (X,A,u) (indicator_fn (a n))’
3572           >- (‘?z. 0 <= z /\ v (b n) = Normal z’
3573                  by METIS_TAC [extreal_of_num_def, extreal_le_eq, extreal_cases] >> POP_ORW \\
3574               MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
3575           Know ‘pos_fn_integral (X,A,u) (indicator_fn (a n)) = measure (X,A,u) (a n)’
3576           >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3577               FULL_SIMP_TAC std_ss [exhausting_sequence_def, subsets_def, IN_FUNSET, IN_UNIV]) \\
3578           REWRITE_TAC [measure_def] >> Rewr' \\
3579           Know ‘u (a n) <> PosInf /\ u (a n) <> NegInf’
3580           >- (CONJ_TAC >- art [lt_infty] \\
3581               MATCH_MP_TAC pos_not_neginf \\
3582               FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> STRIP_TAC \\
3583          ‘?r1. u (a n) = Normal r1’ by METIS_TAC [extreal_cases] >> POP_ORW \\
3584          ‘?r2. v (b n) = Normal r2’ by METIS_TAC [extreal_cases] >> POP_ORW \\
3585           REWRITE_TAC [extreal_mul_def, extreal_not_infty]) >> Rewr' \\
3586       Know ‘pos_fn_integral (Y,B,v)
3587               (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y)) -
3588                    pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y))) =
3589             pos_fn_integral (Y,B,v)
3590               (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y))) -
3591             pos_fn_integral (Y,B,v)
3592               (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y)))’
3593       >- (HO_MATCH_MP_TAC pos_fn_integral_sub >> simp [] \\
3594           CONJ_TAC >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3595                        Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3596                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3597           CONJ_TAC >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3598                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3599           CONJ_TAC >- (rpt STRIP_TAC \\
3600                        MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
3601           CONJ_TAC >- (rpt STRIP_TAC \\
3602                        MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3603                        Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
3604                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3605           REWRITE_TAC [lt_infty] >> MATCH_MP_TAC let_trans \\
3606           Q.EXISTS_TAC ‘pos_fn_integral (Y,B,v)
3607                          (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y)))’ \\
3608           CONJ_TAC >- (MATCH_MP_TAC pos_fn_integral_mono >> simp [] \\
3609                        CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3610                                     MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
3611                        Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3612                        MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3613                        Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
3614                        MATCH_MP_TAC INDICATOR_FN_MONO >> rw [INTER_SUBSET]) \\
3615           rw [Abbr ‘E’, GSYM lt_infty] \\
3616           Know ‘!x y. indicator_fn (general_cross cons (a n) (b n)) (cons x y) =
3617                      indicator_fn (a n) x * indicator_fn (b n) y’
3618           >- (rpt GEN_TAC >> MATCH_MP_TAC indicator_fn_general_cross \\
3619               qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
3620           ONCE_REWRITE_TAC [mul_comm] \\
3621           Know ‘!y. pos_fn_integral (X,A,u) (\x. indicator_fn (b n) y * indicator_fn (a n) x) =
3622                     indicator_fn (b n) y * pos_fn_integral (X,A,u) (indicator_fn (a n))’
3623           >- (GEN_TAC \\
3624              ‘?r. 0 <= r /\ indicator_fn (b n) y = Normal r’
3625                 by METIS_TAC [indicator_fn_normal] >> POP_ORW \\
3626               Know ‘pos_fn_integral (X,A,u) (\x. Normal r * indicator_fn (a n) x) =
3627                     Normal r * pos_fn_integral (X,A,u) (indicator_fn (a n))’
3628               >- (MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) \\
3629               Rewr) >> Rewr' \\
3630           Know ‘pos_fn_integral (X,A,u) (indicator_fn (a n)) = measure (X,A,u) (a n)’
3631           >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3632               FULL_SIMP_TAC std_ss [exhausting_sequence_def, subsets_def, IN_FUNSET, IN_UNIV]) \\
3633           REWRITE_TAC [measure_def] >> Rewr' \\
3634           IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
3635           REV_FULL_SIMP_TAC std_ss [positive_def, exhausting_sequence_def,
3636                                     IN_FUNSET, IN_UNIV, space_def, subsets_def,
3637                                     measurable_sets_def, measure_def] \\
3638           Know ‘u (a n) <> PosInf /\ u (a n) <> NegInf’
3639           >- (CONJ_TAC >- art [lt_infty] \\
3640               MATCH_MP_TAC pos_not_neginf \\
3641               FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> STRIP_TAC \\
3642           ONCE_REWRITE_TAC [mul_comm] \\
3643           Know ‘pos_fn_integral (Y,B,v) (\y. u (a n) * indicator_fn (b n) y) =
3644                 u (a n) * pos_fn_integral (Y,B,v) (indicator_fn (b n))’
3645           >- (‘?z. 0 <= z /\ u (a n) = Normal z’
3646                  by METIS_TAC [extreal_of_num_def, extreal_le_eq, extreal_cases] >> POP_ORW \\
3647               MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
3648           Know ‘pos_fn_integral (Y,B,v) (indicator_fn (b n)) = measure (Y,B,v) (b n)’
3649           >- (MATCH_MP_TAC pos_fn_integral_indicator >> art [measurable_sets_def] \\
3650               FULL_SIMP_TAC std_ss [exhausting_sequence_def, subsets_def, IN_FUNSET, IN_UNIV]) \\
3651           REWRITE_TAC [measure_def] >> Rewr' \\
3652           Know ‘v (b n) <> PosInf /\ v (b n) <> NegInf’
3653           >- (CONJ_TAC >- art [lt_infty] \\
3654               MATCH_MP_TAC pos_not_neginf \\
3655               FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> STRIP_TAC \\
3656          ‘?r1. u (a n) = Normal r1’ by METIS_TAC [extreal_cases] >> POP_ORW \\
3657          ‘?r2. v (b n) = Normal r2’ by METIS_TAC [extreal_cases] >> POP_ORW \\
3658           REWRITE_TAC [extreal_mul_def, extreal_not_infty]) >> Rewr' \\
3659       Know ‘pos_fn_integral (X,A,u)
3660               (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (E n) (cons x y))) =
3661             pos_fn_integral (Y,B,v)
3662               (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (E n) (cons x y)))’
3663       >- (‘E n = E n INTER E n’ by PROVE_TAC [INTER_IDEMPOT] >> POP_ORW \\
3664           Q.PAT_X_ASSUM ‘!n. E n IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3665           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> Rewr' \\
3666       Know ‘pos_fn_integral (X,A,u)
3667               (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y))) =
3668             pos_fn_integral (Y,B,v)
3669               (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y)))’
3670       >- (Q.PAT_X_ASSUM ‘d IN D n’ MP_TAC \\
3671           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> Rewr,
3672       (* goal 4 (of 4): disjoint countably additive *)
3673       fs [IN_FUNSET, IN_UNIV] >> rename1 ‘!x. d x IN D n’ \\
3674    (* expanding D without touching assumptions *)
3675       Suff ‘BIGUNION (IMAGE d univ(:num)) IN
3676            {d | d SUBSET (general_cross cons X Y) /\
3677                 (!x. x IN X ==>
3678                      (\y. indicator_fn (d INTER E n) (cons x y)) IN Borel_measurable (Y,B)) /\
3679                 (!y. y IN Y ==>
3680                      (\x. indicator_fn (d INTER E n) (cons x y)) IN Borel_measurable (X,A)) /\
3681                 (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y)))
3682                        IN Borel_measurable (Y,B) /\
3683                 (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y)))
3684                        IN Borel_measurable (X,A) /\
3685                 pos_fn_integral (X,A,u)
3686                   (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (d INTER E n) (cons x y))) =
3687                 pos_fn_integral (Y,B,v)
3688                   (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (d INTER E n) (cons x y)))}’
3689       >- METIS_TAC [Abbr ‘D’] >> simp [GSPECIFICATION] \\
3690       Know ‘!x. d x SUBSET (general_cross cons X Y)’
3691       >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘x’)) \\
3692           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> DISCH_TAC \\
3693       CONJ_TAC >- (POP_ASSUM MP_TAC >> rw [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV]) \\
3694       REWRITE_TAC [BIGUNION_OVER_INTER_L] \\
3695    (* applying indicator_fn_split or indicator_fn_suminf *)
3696       Know ‘!x y. indicator_fn (BIGUNION (IMAGE (\i. d i INTER E n) UNIV)) (cons x y) =
3697                   suminf (\i. indicator_fn ((\i. d i INTER E n) i) (cons x y))’
3698       >- (rpt GEN_TAC >> MATCH_MP_TAC EQ_SYM \\
3699           MATCH_MP_TAC indicator_fn_suminf \\
3700           BETA_TAC >> qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC \\
3701           MATCH_MP_TAC DISJOINT_RESTRICT_L \\
3702           FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr' \\
3703       CONJ_TAC (* Borel_measurable #1 *)
3704       >- (rpt STRIP_TAC \\
3705           MATCH_MP_TAC IN_MEASURABLE_BOREL_SUMINF >> simp [INDICATOR_FN_POS] \\
3706           Q.EXISTS_TAC ‘\i y. indicator_fn (d i INTER E n) (cons x y)’ \\
3707           simp [INDICATOR_FN_POS] \\
3708           Q.X_GEN_TAC ‘i’ >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3709           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3710       CONJ_TAC (* Borel_measurable #2 *)
3711       >- (rpt STRIP_TAC \\
3712           MATCH_MP_TAC IN_MEASURABLE_BOREL_SUMINF >> simp [INDICATOR_FN_POS] \\
3713           Q.EXISTS_TAC ‘\i x. indicator_fn (d i INTER E n) (cons x y)’ \\
3714           simp [INDICATOR_FN_POS] \\
3715           Q.X_GEN_TAC ‘i’ >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3716           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3717       CONJ_TAC (* Borel_measurable #3 *)
3718       >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3719                                      (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
3720           BETA_TAC \\
3721           Q.EXISTS_TAC ‘\y. suminf (\i. pos_fn_integral (X,A,u)
3722                                           (\x. indicator_fn (d i INTER E n) (cons x y)))’ \\
3723           reverse CONJ_TAC
3724           >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_SUMINF >> simp [] \\
3725               Q.EXISTS_TAC ‘\i y. pos_fn_integral (X,A,u)
3726                                     (\x. indicator_fn (d i INTER E n) (cons x y))’ >> simp [] \\
3727               reverse CONJ_TAC
3728               >- (qx_genl_tac [‘i’, ‘y’] >> DISCH_TAC \\
3729                   MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
3730               Q.X_GEN_TAC ‘i’ >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3731               RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3732           Q.X_GEN_TAC ‘y’ >> BETA_TAC >> DISCH_TAC \\
3733           Know ‘pos_fn_integral (X,A,u)
3734                   (\x. suminf (\i. (\i x. indicator_fn (d i INTER E n) (cons x y)) i x)) =
3735                 suminf (\i. pos_fn_integral (X,A,u)
3736                               ((\i x. indicator_fn (d i INTER E n) (cons x y)) i))’
3737           >- (MATCH_MP_TAC pos_fn_integral_suminf >> simp [INDICATOR_FN_POS] \\
3738               GEN_TAC >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3739               RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> BETA_TAC >> Rewr) \\
3740       CONJ_TAC (* Borel_measurable #4 *)
3741       >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3742                                      (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
3743           BETA_TAC \\
3744           Q.EXISTS_TAC ‘\x. suminf (\i. pos_fn_integral (Y,B,v)
3745                                           (\y. indicator_fn (d i INTER E n) (cons x y)))’ \\
3746           reverse CONJ_TAC
3747           >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_SUMINF >> simp [] \\
3748               Q.EXISTS_TAC ‘\i x. pos_fn_integral (Y,B,v)
3749                                     (\y. indicator_fn (d i INTER E n) (cons x y))’ >> simp [] \\
3750               reverse CONJ_TAC
3751               >- (qx_genl_tac [‘i’, ‘x’] >> DISCH_TAC \\
3752                   MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
3753               Q.X_GEN_TAC ‘i’ >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3754               RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3755           Q.X_GEN_TAC ‘x’ >> BETA_TAC >> DISCH_TAC \\
3756           Know ‘pos_fn_integral (Y,B,v)
3757                   (\y. suminf (\i. (\i y. indicator_fn (d i INTER E n) (cons x y)) i y)) =
3758                 suminf (\i. pos_fn_integral (Y,B,v)
3759                               ((\i y. indicator_fn (d i INTER E n) (cons x y)) i))’
3760           >- (MATCH_MP_TAC pos_fn_integral_suminf >> simp [INDICATOR_FN_POS] \\
3761               GEN_TAC >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3762               RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> BETA_TAC >> Rewr) \\
3763       Know ‘pos_fn_integral (X,A,u)
3764               (\x. pos_fn_integral (Y,B,v)
3765                      (\y. suminf (\i. indicator_fn (d i INTER E n) (cons x y)))) =
3766             pos_fn_integral (X,A,u)
3767               (\x. suminf (\i. pos_fn_integral (Y,B,v)
3768                                  (\y. indicator_fn (d i INTER E n) (cons x y))))’
3769       >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3770                                      (Q.SPEC ‘(X,A,u)’ pos_fn_integral_cong)) >> simp [] \\
3771           CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
3772                        Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3773                        MATCH_MP_TAC ext_suminf_pos >> simp [INDICATOR_FN_POS]) \\
3774           CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC ext_suminf_pos >> simp [] \\
3775                        Q.X_GEN_TAC ‘i’ >> MATCH_MP_TAC pos_fn_integral_pos \\
3776                        simp [INDICATOR_FN_POS]) \\
3777           rpt STRIP_TAC \\
3778           Know ‘pos_fn_integral (Y,B,v)
3779                   (\y. suminf (\i. (\i y. indicator_fn (d i INTER E n) (cons x y)) i y)) =
3780                 suminf (\i. pos_fn_integral (Y,B,v)
3781                               ((\i y. indicator_fn (d i INTER E n) (cons x y)) i))’
3782           >- (MATCH_MP_TAC pos_fn_integral_suminf \\
3783               simp [INDICATOR_FN_POS] \\
3784               GEN_TAC >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3785               RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> BETA_TAC >> Rewr) \\
3786       BETA_TAC >> Rewr' \\
3787       Know ‘pos_fn_integral (Y,B,v)
3788               (\y. pos_fn_integral (X,A,u)
3789                      (\x. suminf (\i. indicator_fn (d i INTER E n) (cons x y)))) =
3790             pos_fn_integral (Y,B,v)
3791               (\y. suminf (\i. pos_fn_integral (X,A,u)
3792                                  (\x. indicator_fn (d i INTER E n) (cons x y))))’
3793       >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3794                                      (Q.SPEC ‘(Y,B,v)’ pos_fn_integral_cong)) >> simp [] \\
3795           CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3796                        MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
3797                        rpt STRIP_TAC >> MATCH_MP_TAC ext_suminf_pos \\
3798                        simp [INDICATOR_FN_POS]) \\
3799           CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3800                        MATCH_MP_TAC ext_suminf_pos >> simp [] \\
3801                        Q.X_GEN_TAC ‘i’ >> MATCH_MP_TAC pos_fn_integral_pos \\
3802                        simp [INDICATOR_FN_POS]) \\
3803           Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3804           Know ‘pos_fn_integral (X,A,u)
3805                   (\x. suminf (\i. (\i x. indicator_fn (d i INTER E n) (cons x y)) i x)) =
3806                 suminf (\i. pos_fn_integral (X,A,u)
3807                               ((\i x. indicator_fn (d i INTER E n) (cons x y)) i))’
3808           >- (MATCH_MP_TAC pos_fn_integral_suminf \\
3809               simp [INDICATOR_FN_POS] \\
3810               GEN_TAC >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3811               RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> BETA_TAC >> Rewr) >> Rewr' \\
3812       Know ‘pos_fn_integral (X,A,u)
3813               (\x. suminf (\i. (\i x. pos_fn_integral (Y,B,v)
3814                                         (\y. indicator_fn (d i INTER E n) (cons x y))) i x)) =
3815             suminf (\i. pos_fn_integral (X,A,u)
3816                           ((\i x. pos_fn_integral (Y,B,v)
3817                                     (\y. indicator_fn (d i INTER E n) (cons x y))) i))’
3818       >- (MATCH_MP_TAC pos_fn_integral_suminf >> simp [] \\
3819           CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos \\
3820                        simp [INDICATOR_FN_POS]) \\
3821           GEN_TAC >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3822           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> BETA_TAC >> Rewr' \\
3823       Know ‘pos_fn_integral (Y,B,v)
3824               (\y. suminf (\i. (\i y. pos_fn_integral (X,A,u)
3825                                         (\x. indicator_fn (d i INTER E n) (cons x y))) i y)) =
3826             suminf (\i. pos_fn_integral (Y,B,v)
3827                           ((\i y. pos_fn_integral (X,A,u)
3828                                     (\x. indicator_fn (d i INTER E n) (cons x y))) i))’
3829       >- (MATCH_MP_TAC pos_fn_integral_suminf >> simp [] \\
3830           CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos \\
3831                        simp [INDICATOR_FN_POS]) \\
3832           Q.X_GEN_TAC ‘i’ >> Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3833           RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) >> BETA_TAC >> Rewr' \\
3834       MATCH_MP_TAC ext_suminf_eq >> Q.X_GEN_TAC ‘i’ >> BETA_TAC \\
3835       Q.PAT_X_ASSUM ‘!x. d x IN D n’ (MP_TAC o (Q.SPEC ‘i’)) \\
3836       RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION] ]) >> DISCH_TAC
3837 (* clean up *)
3838 >> Q.PAT_X_ASSUM ‘!n d y. pos_fn_integral (X,A,u) f <> PosInf’ K_TAC
3839 >> Q.PAT_X_ASSUM ‘!n d y. pos_fn_integral (X,A,u) f <> NegInf’ K_TAC
3840 >> Q.PAT_X_ASSUM ‘!n d x. pos_fn_integral (Y,B,v) f <> PosInf’ K_TAC
3841 >> Q.PAT_X_ASSUM ‘!n d x. pos_fn_integral (Y,B,v) f <> NegInf’ K_TAC
3842 (* applying DYNKIN_SUBSET and DYNKIN_THM *)
3843 >> Know ‘!n. subsets (general_sigma cons (X,A) (Y,B)) SUBSET D n’
3844 >- (GEN_TAC >> rw [general_sigma_def] \\
3845     Suff ‘sigma (general_cross cons X Y) (general_prod cons A B) =
3846           dynkin (general_cross cons X Y) (general_prod cons A B)’
3847     >- (Rewr' \\
3848         MATCH_MP_TAC (REWRITE_RULE [space_def, subsets_def]
3849                        (Q.SPECL [‘general_prod cons A B’,
3850                                  ‘(general_cross cons X Y,D n)’]
3851                          (INST_TYPE [alpha |-> gamma] DYNKIN_SUBSET))) >> art []) \\
3852     MATCH_MP_TAC EQ_SYM >> MATCH_MP_TAC DYNKIN_THM \\
3853     CONJ_TAC >- (rw [subset_class_def, IN_general_prod] \\
3854                  MATCH_MP_TAC general_SUBSET_CROSS \\
3855                  fs [sigma_algebra_def, algebra_def, subset_class_def]) \\
3856     qx_genl_tac [‘x’, ‘y’] >> STRIP_TAC \\
3857     Q.PAT_X_ASSUM ‘x IN general_prod cons A B’
3858        (STRIP_ASSUME_TAC o (REWRITE_RULE [IN_general_prod])) \\
3859     rename1 ‘x = general_cross cons s1 t1’ \\
3860     Q.PAT_X_ASSUM ‘y IN general_prod cons A B’
3861        (STRIP_ASSUME_TAC o (REWRITE_RULE [IN_general_prod])) \\
3862     rename1 ‘y = general_cross cons s2 t2’ \\
3863     rw [IN_general_prod] \\
3864     qexistsl_tac [‘s1 INTER s2’, ‘t1 INTER t2’] \\
3865     CONJ_TAC >- (MATCH_MP_TAC general_INTER_CROSS \\
3866                  qexistsl_tac [‘car’, ‘cdr’] >> art []) \\
3867     CONJ_TAC >| (* 2 subgoals *)
3868     [ (* goal 1 (of 2) *)
3869       MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3870                                  (ISPEC “(X,A) :'a algebra” SIGMA_ALGEBRA_INTER)) \\
3871       ASM_REWRITE_TAC [],
3872       (* goal 2 (of 2) *)
3873       MATCH_MP_TAC (REWRITE_RULE [subsets_def]
3874                                  (ISPEC “(Y,B) :'b algebra” SIGMA_ALGEBRA_INTER)) \\
3875       ASM_REWRITE_TAC [] ]) >> DISCH_TAC
3876 (* stage work *)
3877 >> Know ‘exhausting_sequence (general_cross cons X Y,general_prod cons A B) E’
3878 >- (Q.UNABBREV_TAC ‘E’ >> MATCH_MP_TAC exhausting_sequence_general_cross >> art [])
3879 >> DISCH_THEN (STRIP_ASSUME_TAC o
3880                (REWRITE_RULE [space_def, subsets_def, exhausting_sequence_alt,
3881                               IN_FUNSET, IN_UNIV]))
3882 >> STRONG_CONJ_TAC (* Borel_measurable *)
3883 >- (GEN_TAC >> DISCH_TAC \\
3884    ‘!n. s IN D n’ by METIS_TAC [SUBSET_DEF] \\
3885    ‘s SUBSET (general_cross cons X Y)’
3886       by (POP_ASSUM MP_TAC >> RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3887    ‘s = s INTER (general_cross cons X Y)’ by ASM_SET_TAC [] >> POP_ORW \\
3888     Know ‘!x y. indicator_fn (s INTER (general_cross cons X Y)) (cons x y) =
3889                 sup (IMAGE (\n. indicator_fn (s INTER (E n)) (cons x y)) UNIV)’
3890     >- (rw [Once EQ_SYM_EQ, sup_eq', IN_IMAGE, IN_UNIV] >| (* 2 subgoals *)
3891         [ (* goal 1 (of 2) *)
3892           MATCH_MP_TAC INDICATOR_FN_MONO >> ASM_SET_TAC [],
3893           (* goal 2 (of 2) *)
3894           rename1 ‘!z. (?n. z = indicator_fn (s INTER E n) (cons x y)) ==> z <= N’ \\
3895           Cases_on ‘!n. indicator_fn (s INTER E n) (cons x y) = 0’
3896           >- (Q.PAT_X_ASSUM ‘_ = general_cross cons X Y’
3897                 (ONCE_REWRITE_TAC o wrap o SYM) \\
3898               POP_ASSUM MP_TAC \\
3899               rw [indicator_fn_def] >> METIS_TAC [ne_01]) \\
3900           fs [] >> FIRST_X_ASSUM MATCH_MP_TAC \\
3901           rename1 ‘indicator_fn (s INTER E i) (cons x y) <> 0’ \\
3902           Q.EXISTS_TAC ‘i’ \\
3903           Q.PAT_X_ASSUM ‘_ = general_cross cons X Y’
3904             (ONCE_REWRITE_TAC o wrap o SYM) \\
3905           POP_ASSUM MP_TAC >> rw [indicator_fn_def] \\
3906           METIS_TAC [] ]) >> Rewr' \\
3907     CONJ_TAC (* Borel_measurable #1 *)
3908     >- (rpt STRIP_TAC \\
3909         MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP >> simp [] \\
3910         Q.EXISTS_TAC ‘\n y. indicator_fn (s INTER E n) (cons x y)’ >> simp [] \\
3911         reverse CONJ_TAC
3912         >- (qx_genl_tac [‘n’, ‘y’] >> DISCH_TAC \\
3913             MATCH_MP_TAC INDICATOR_FN_MONO \\
3914             Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
3915             FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) \\
3916         GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3917         RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3918     CONJ_TAC (* Borel_measurable #2 *)
3919     >- (rpt STRIP_TAC \\
3920         MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP >> simp [] \\
3921         Q.EXISTS_TAC ‘\n x. indicator_fn (s INTER E n) (cons x y)’ >> simp [] \\
3922         reverse CONJ_TAC
3923         >- (qx_genl_tac [‘n’, ‘x’] >> DISCH_TAC \\
3924             MATCH_MP_TAC INDICATOR_FN_MONO \\
3925             Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
3926             FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) \\
3927         GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3928         RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3929  (* applying lebesgue_monotone_convergence (Beppo Levi) *)
3930     CONJ_TAC >| (* 2 subgoals *)
3931     [ (* goal 1 (of 2) *)
3932       MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3933                                  (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
3934       Q.EXISTS_TAC
3935      ‘\y. sup (IMAGE (\n. pos_fn_integral (X,A,u)
3936                             (\x. indicator_fn (s INTER E n) (cons x y))) UNIV)’ \\
3937       reverse CONJ_TAC
3938       >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP >> simp [] \\
3939           Q.EXISTS_TAC
3940          ‘\n y. pos_fn_integral (X,A,u)
3941                   (\x. indicator_fn (s INTER E n) (cons x y))’ >> simp [] \\
3942           CONJ_TAC >- (GEN_TAC \\
3943                        Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3944                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3945           qx_genl_tac [‘n’, ‘y’] >> DISCH_TAC \\
3946           MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3947           rpt STRIP_TAC >> MATCH_MP_TAC INDICATOR_FN_MONO \\
3948           Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
3949           FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) \\
3950       Q.X_GEN_TAC ‘y’ >> DISCH_TAC >> BETA_TAC \\
3951       HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [INDICATOR_FN_POS] \\
3952       CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3953                    RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3954       rw [ext_mono_increasing_def] \\
3955       MATCH_MP_TAC INDICATOR_FN_MONO \\
3956       Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
3957       FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss [],
3958       (* goal 2 (of 2) *)
3959       MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
3960                                  (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
3961       Q.EXISTS_TAC ‘\x. sup (IMAGE (\n. pos_fn_integral (Y,B,v)
3962                                           (\y. indicator_fn (s INTER E n) (cons x y))) UNIV)’ \\
3963       reverse CONJ_TAC
3964       >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP >> simp [] \\
3965           Q.EXISTS_TAC ‘\n x. pos_fn_integral (Y,B,v)
3966                                 (\y. indicator_fn (s INTER E n) (cons x y))’ >> simp [] \\
3967           CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3968                        RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3969           qx_genl_tac [‘n’, ‘x’] >> DISCH_TAC \\
3970           MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
3971           Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
3972           MATCH_MP_TAC INDICATOR_FN_MONO \\
3973           Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
3974           FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) \\
3975       Q.X_GEN_TAC ‘x’ >> DISCH_TAC >> BETA_TAC \\
3976       HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [INDICATOR_FN_POS] \\
3977       CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
3978                    RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3979       rw [ext_mono_increasing_def] \\
3980       MATCH_MP_TAC INDICATOR_FN_MONO \\
3981       Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
3982       FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss [] ]) >> DISCH_TAC
3983 (* final battle *)
3984 >> Q.EXISTS_TAC ‘\s. pos_fn_integral (X,A,u)
3985                        (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn s (cons x y)))’
3986 >> REWRITE_TAC [CONJ_ASSOC]
3987 >> reverse CONJ_TAC (* swap of integrals *)
3988 >- (RW_TAC std_ss [] \\
3989    ‘!n. s IN D n’ by METIS_TAC [SUBSET_DEF] \\
3990    ‘s SUBSET (general_cross cons X Y)’
3991       by (POP_ASSUM MP_TAC >> RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
3992    ‘s = s INTER (general_cross cons X Y)’ by ASM_SET_TAC [] >> POP_ORW \\
3993     Know ‘!x y. indicator_fn (s INTER (general_cross cons X Y)) (cons x y) =
3994                 sup (IMAGE (\n. indicator_fn (s INTER (E n)) (cons x y)) UNIV)’
3995     >- (rw [Once EQ_SYM_EQ, sup_eq', IN_IMAGE, IN_UNIV] >| (* 2 subgoals *)
3996         [ (* goal 1 (of 2) *)
3997           MATCH_MP_TAC INDICATOR_FN_MONO >> ASM_SET_TAC [],
3998           (* goal 2 (of 2) *)
3999           rename1 ‘!z. (?n. z = indicator_fn (s INTER E n) (cons x y)) ==> z <= N’ \\
4000           Cases_on ‘!n. indicator_fn (s INTER E n) (cons x y) = 0’
4001           >- (Q.PAT_X_ASSUM ‘_ = general_cross cons X Y’ (ONCE_REWRITE_TAC o wrap o SYM) \\
4002               POP_ASSUM MP_TAC \\
4003               rw [indicator_fn_def] >> METIS_TAC [ne_01]) \\
4004           fs [] >> FIRST_X_ASSUM MATCH_MP_TAC \\
4005           rename1 ‘indicator_fn (s INTER E i) (cons x y) <> 0’ \\
4006           Q.EXISTS_TAC ‘i’ \\
4007           Q.PAT_X_ASSUM ‘_ = general_cross cons X Y’ (ONCE_REWRITE_TAC o wrap o SYM) \\
4008           POP_ASSUM MP_TAC >> rw [indicator_fn_def] \\
4009           METIS_TAC [] ]) >> Rewr' \\
4010     Know ‘!x y. 0 <= sup (IMAGE (\n. indicator_fn (s INTER E n) (cons x y)) UNIV)’
4011     >- (rw [le_sup'] >> MATCH_MP_TAC le_trans \\
4012         Q.EXISTS_TAC ‘indicator_fn (s INTER E 0) (cons x y)’ \\
4013         simp [INDICATOR_FN_POS] >> POP_ASSUM MATCH_MP_TAC \\
4014         Q.EXISTS_TAC ‘0’ >> REWRITE_TAC []) >> DISCH_TAC \\
4015  (* applying pos_fn_integral_cong *)
4016     Know ‘pos_fn_integral (X,A,u)
4017             (\x. pos_fn_integral (Y,B,v)
4018                    (\y. sup (IMAGE (\n. indicator_fn (s INTER E n) (cons x y)) UNIV))) =
4019           pos_fn_integral (X,A,u)
4020             (\x. sup (IMAGE (\n. pos_fn_integral (Y,B,v)
4021                                    (\y. indicator_fn (s INTER E n) (cons x y))) UNIV))’
4022     >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4023                                    (Q.SPEC ‘(X,A,u)’ pos_fn_integral_cong)) >> simp [] \\
4024         CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos >> simp []) \\
4025         CONJ_TAC >- (rw [le_sup'] >> MATCH_MP_TAC le_trans \\
4026                      Q.EXISTS_TAC ‘pos_fn_integral (Y,B,v)
4027                                     (\y. indicator_fn (s INTER E 0) (cons x y))’ \\
4028                      reverse CONJ_TAC >- (POP_ASSUM MATCH_MP_TAC \\
4029                                           Q.EXISTS_TAC ‘0’ >> REWRITE_TAC []) \\
4030                      MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
4031         rpt STRIP_TAC \\
4032         HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [INDICATOR_FN_POS] \\
4033         CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
4034                      RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
4035         rw [ext_mono_increasing_def] \\
4036         MATCH_MP_TAC INDICATOR_FN_MONO \\
4037         Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
4038         FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) >> Rewr' \\
4039     Know ‘pos_fn_integral (Y,B,v)
4040             (\y. pos_fn_integral (X,A,u)
4041                    (\x. sup (IMAGE (\n. indicator_fn (s INTER E n) (cons x y)) UNIV))) =
4042           pos_fn_integral (Y,B,v)
4043             (\y. sup (IMAGE (\n. pos_fn_integral (X,A,u)
4044                                    (\x. indicator_fn (s INTER E n) (cons x y))) UNIV))’
4045     >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4046                                    (Q.SPEC ‘(Y,B,v)’ pos_fn_integral_cong)) >> simp [] \\
4047         CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
4048                      MATCH_MP_TAC pos_fn_integral_pos >> simp []) \\
4049         CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> rw [le_sup'] >> MATCH_MP_TAC le_trans \\
4050                      Q.EXISTS_TAC ‘pos_fn_integral (X,A,u)
4051                                     (\x. indicator_fn (s INTER E 0) (cons x y))’ \\
4052                      reverse CONJ_TAC >- (POP_ASSUM MATCH_MP_TAC \\
4053                                           Q.EXISTS_TAC ‘0’ >> REWRITE_TAC []) \\
4054                      MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
4055         Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
4056         HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [INDICATOR_FN_POS] \\
4057         CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
4058                      RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
4059         rw [ext_mono_increasing_def] \\
4060         MATCH_MP_TAC INDICATOR_FN_MONO \\
4061         Suff ‘E n SUBSET E (SUC n)’ >- ASM_SET_TAC [] \\
4062         FIRST_X_ASSUM MATCH_MP_TAC >> RW_TAC arith_ss []) >> Rewr' \\
4063     Know ‘pos_fn_integral (X,A,u)
4064             (\x. sup (IMAGE (\n. pos_fn_integral (Y,B,v)
4065                                    (\y. indicator_fn (s INTER E n) (cons x y))) UNIV)) =
4066           sup (IMAGE (\n. pos_fn_integral (X,A,u)
4067                             (\x. pos_fn_integral (Y,B,v)
4068                                    (\y. indicator_fn (s INTER E n) (cons x y)))) UNIV)’
4069     >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
4070         CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
4071                      RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
4072         CONJ_TAC >- (rpt STRIP_TAC \\
4073                      MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
4074         rw [ext_mono_increasing_def] \\
4075         MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
4076         Q.X_GEN_TAC ‘y’ >> DISCH_TAC >> MATCH_MP_TAC INDICATOR_FN_MONO \\
4077         rename1 ‘n <= m’ >> Suff ‘E n SUBSET E m’ >- ASM_SET_TAC [] \\
4078         FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr' \\
4079     Know ‘pos_fn_integral (Y,B,v)
4080             (\y. sup (IMAGE (\n. pos_fn_integral (X,A,u)
4081                                    (\x. indicator_fn (s INTER E n) (cons x y))) UNIV)) =
4082           sup (IMAGE (\n. pos_fn_integral (Y,B,v)
4083                             (\y. pos_fn_integral (X,A,u)
4084                                    (\x. indicator_fn (s INTER E n) (cons x y)))) UNIV)’
4085     >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
4086         CONJ_TAC >- (GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
4087                      RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION]) \\
4088         CONJ_TAC >- (rpt STRIP_TAC \\
4089                      MATCH_MP_TAC pos_fn_integral_pos >> simp [INDICATOR_FN_POS]) \\
4090         rw [ext_mono_increasing_def] \\
4091         MATCH_MP_TAC pos_fn_integral_mono >> simp [INDICATOR_FN_POS] \\
4092         rpt STRIP_TAC >> MATCH_MP_TAC INDICATOR_FN_MONO \\
4093         rename1 ‘n <= m’ >> Suff ‘E n SUBSET E m’ >- ASM_SET_TAC [] \\
4094         FIRST_X_ASSUM MATCH_MP_TAC >> art []) >> Rewr' \\
4095     Suff ‘!n. pos_fn_integral (X,A,u)
4096                 (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (s INTER E n) (cons x y))) =
4097               pos_fn_integral (Y,B,v)
4098                 (\y. pos_fn_integral (X,A,u)
4099                        (\x. indicator_fn (s INTER E n) (cons x y)))’ >- rw [] \\
4100     GEN_TAC >> Q.PAT_X_ASSUM ‘!n. s IN D n’ (MP_TAC o (Q.SPEC ‘n’)) \\
4101     RW_TAC std_ss [Abbr ‘D’, GSPECIFICATION])
4102 >> reverse CONJ_TAC (* compatibility with m0 *)
4103 >- (Q.X_GEN_TAC ‘d’ >> simp [IN_general_prod] \\
4104     DISCH_THEN (qx_choosel_then [‘s’, ‘t’] STRIP_ASSUME_TAC) \\
4105     Q.PAT_X_ASSUM ‘d = general_cross cons s t’ (ONCE_REWRITE_TAC o wrap) \\
4106     Know ‘!x y. indicator_fn (general_cross cons s t) (cons x y) =
4107                 indicator_fn s x * indicator_fn t y’
4108     >- (rpt GEN_TAC >> MATCH_MP_TAC indicator_fn_general_cross \\
4109         qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
4110     Know ‘!x. pos_fn_integral (Y,B,v) (\y. indicator_fn s x * indicator_fn t y) =
4111               indicator_fn s x * pos_fn_integral (Y,B,v) (indicator_fn t)’
4112     >- (GEN_TAC \\
4113        ‘?r. 0 <= r /\ (indicator_fn s x = Normal r)’
4114           by METIS_TAC [indicator_fn_normal, extreal_of_num_def, extreal_le_eq] >> POP_ORW \\
4115         MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
4116     Know ‘pos_fn_integral (Y,B,v) (indicator_fn t) = measure (Y,B,v) t’
4117     >- (MATCH_MP_TAC pos_fn_integral_indicator >> rw []) >> Rewr' >> simp [] \\
4118     GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [mul_comm] \\
4119     IMP_RES_TAC MEASURE_SPACE_POSITIVE >> rfs [positive_def] \\
4120     Know ‘pos_fn_integral (X,A,u) (\x. v t * indicator_fn s x) =
4121           v t * pos_fn_integral (X,A,u) (indicator_fn s)’
4122     >- (Know ‘indicator_fn s = fn_plus (indicator_fn s)’
4123         >- (MATCH_MP_TAC EQ_SYM \\
4124             MATCH_MP_TAC FN_PLUS_POS_ID >> rw [INDICATOR_FN_POS]) >> Rewr' \\
4125         MATCH_MP_TAC pos_fn_integral_cmult >> simp [] \\
4126         MATCH_MP_TAC IN_MEASURABLE_BOREL_INDICATOR \\
4127         Q.EXISTS_TAC ‘s’ >> simp []) >> Rewr' \\
4128     Know ‘pos_fn_integral (X,A,u) (indicator_fn s) = measure (X,A,u) s’
4129     >- (MATCH_MP_TAC pos_fn_integral_indicator >> rw []) >> Rewr' \\
4130     rw [Once mul_comm])
4131 >> reverse CONJ_TAC (* sigma-finiteness *)
4132 >- (Q.EXISTS_TAC ‘E’ \\
4133     CONJ_TAC
4134     >- (rw [exhausting_sequence_def, IN_FUNSET, IN_UNIV] \\
4135         Suff ‘(general_prod cons A B) SUBSET subsets (general_sigma cons (X,A) (Y,B))’
4136         >- METIS_TAC [SUBSET_DEF] \\
4137         REWRITE_TAC [general_sigma_def, space_def, subsets_def] \\
4138         REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) \\
4139     RW_TAC std_ss [Abbr ‘E’] \\
4140     Know ‘!x y. indicator_fn (general_cross cons (a n) (b n)) (cons x y) =
4141                 indicator_fn (a n) x * indicator_fn (b n) y’
4142     >- (rpt GEN_TAC >> MATCH_MP_TAC indicator_fn_general_cross \\
4143         qexistsl_tac [‘car’, ‘cdr’] >> art []) >> Rewr' \\
4144     IMP_RES_TAC MEASURE_SPACE_POSITIVE \\
4145     REV_FULL_SIMP_TAC std_ss [positive_def, exhausting_sequence_def,
4146                               IN_FUNSET, IN_UNIV, space_def, subsets_def,
4147                               measurable_sets_def, measure_def] \\
4148     Know ‘!x. pos_fn_integral (Y,B,v) (\y. indicator_fn (a n) x * indicator_fn (b n) y) =
4149               indicator_fn (a n) x * pos_fn_integral (Y,B,v) (indicator_fn (b n))’
4150     >- (GEN_TAC \\
4151        ‘?r. 0 <= r /\ (indicator_fn (a n) x = Normal r)’
4152           by METIS_TAC [indicator_fn_normal, extreal_of_num_def, extreal_le_eq] >> POP_ORW \\
4153         MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
4154     Know ‘pos_fn_integral (Y,B,v) (indicator_fn (b n)) = measure (Y,B,v) (b n)’
4155     >- (MATCH_MP_TAC pos_fn_integral_indicator >> rw []) >> Rewr' >> simp [] \\
4156     GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [mul_comm] \\
4157     Know ‘v (b n) <> PosInf /\ v (b n) <> NegInf’
4158     >- (CONJ_TAC >- art [lt_infty] \\
4159         MATCH_MP_TAC pos_not_neginf >> simp []) >> STRIP_TAC \\
4160     Know ‘pos_fn_integral (X,A,u) (\x. v (b n) * indicator_fn (a n) x) =
4161           v (b n) * pos_fn_integral (X,A,u) (indicator_fn (a n))’
4162     >- (‘?r. 0 <= r /\ (v (b n) = Normal r)’
4163           by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq] >> POP_ORW \\
4164         MATCH_MP_TAC pos_fn_integral_cmul >> simp [INDICATOR_FN_POS]) >> Rewr' \\
4165     Know ‘pos_fn_integral (X,A,u) (indicator_fn (a n)) = measure (X,A,u) (a n)’
4166     >- (MATCH_MP_TAC pos_fn_integral_indicator >> simp []) >> Rewr' >> simp [] \\
4167     Know ‘u (a n) <> PosInf /\ u (a n) <> NegInf’
4168     >- (CONJ_TAC >- art [lt_infty] \\
4169         MATCH_MP_TAC pos_not_neginf >> simp []) >> STRIP_TAC \\
4170    ‘?r1. u (a n) = Normal r1’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4171    ‘?r2. v (b n) = Normal r2’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4172     REWRITE_TAC [extreal_mul_def, lt_infty, extreal_not_infty])
4173 (* last three goals *)
4174 >> rw [measure_space_def]
4175 (* 1. sigma_algebra *)
4176 >- (Know ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
4177           general_sigma cons (X,A) (Y,B)’
4178     >- (rw [general_sigma_def] >> METIS_TAC [SPACE, SPACE_SIGMA]) >> Rewr' \\
4179     MATCH_MP_TAC sigma_algebra_general_sigma >> simp [] \\
4180     fs [sigma_algebra_def, algebra_def])
4181 (* 2. positive *)
4182 >- (rw [positive_def] >- (simp [pos_fn_integral_zero]) \\
4183     MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
4184     MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS])
4185 (* 3. countably_additive *)
4186 >> rw [countably_additive_def, IN_FUNSET, IN_UNIV, o_DEF]
4187 >> Know ‘!x y. indicator_fn (BIGUNION (IMAGE f UNIV)) (cons x y) =
4188                suminf (\n. indicator_fn (f n) (cons x y))’
4189 >- (RW_TAC std_ss [Once EQ_SYM_EQ] \\
4190     MATCH_MP_TAC indicator_fn_suminf >> simp []) >> Rewr'
4191 >> Know ‘pos_fn_integral (X,A,u)
4192            (\x. pos_fn_integral (Y,B,v)
4193                   (\y. suminf (\n. indicator_fn (f n) (cons x y)))) =
4194          pos_fn_integral (X,A,u)
4195            (\x. suminf (\n. pos_fn_integral (Y,B,v)
4196                               (\y. indicator_fn (f n) (cons x y))))’
4197 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
4198     CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
4199                  Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
4200                  MATCH_MP_TAC ext_suminf_pos >> rw [INDICATOR_FN_POS]) \\
4201     CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC ext_suminf_pos >> rw [] \\
4202                  MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) \\
4203     rpt STRIP_TAC \\
4204  (* preparing for pos_fn_integral_suminf *)
4205    ‘pos_fn_integral (Y,B,v) (\y. suminf (\n. indicator_fn (f n) (cons x y))) =
4206     pos_fn_integral (Y,B,v)
4207                     (\y. suminf (\n. (\n y. indicator_fn (f n) (cons x y)) n y))’
4208       by PROVE_TAC [] >> POP_ORW \\
4209    ‘suminf (\n. pos_fn_integral (Y,B,v) (\y. indicator_fn (f n) (cons x y))) =
4210     suminf (\n. pos_fn_integral (Y,B,v) ((\n y. indicator_fn (f n) (cons x y)) n))’
4211       by PROVE_TAC [] >> POP_ORW \\
4212     MATCH_MP_TAC pos_fn_integral_suminf >> simp [INDICATOR_FN_POS]) >> Rewr'
4213 >> Know ‘pos_fn_integral (X,A,u)
4214            (\x. suminf (\n. (\n x. pos_fn_integral (Y,B,v)
4215                                      (\y. indicator_fn (f n) (cons x y))) n x)) =
4216          suminf (\n. pos_fn_integral (X,A,u)
4217                        ((\n x. pos_fn_integral (Y,B,v)
4218                                  (\y. indicator_fn (f n) (cons x y))) n))’
4219 >- (MATCH_MP_TAC pos_fn_integral_suminf >> rw [] \\
4220     MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS])
4221 >> BETA_TAC >> Rewr
4222QED
4223
4224(* Theorem 14.5 [1, p.139], cf. CARATHEODORY_SEMIRING *)
4225Theorem EXISTENCE_OF_PROD_MEASURE :
4226   !(X :'a set) (Y :'b set) A B u v m0.
4227       sigma_finite_measure_space (X,A,u) /\
4228       sigma_finite_measure_space (Y,B,v) /\
4229       (!s t. s IN A /\ t IN B ==> (m0 (s CROSS t) = u s * v t)) ==>
4230       (!s. s IN subsets ((X,A) CROSS (Y,B)) ==>
4231           (!x. x IN X ==> (\y. indicator_fn s (x,y)) IN measurable (Y,B) Borel) /\
4232           (!y. y IN Y ==> (\x. indicator_fn s (x,y)) IN measurable (X,A) Borel) /\
4233           (\y. pos_fn_integral (X,A,u)
4234                  (\x. indicator_fn s (x,y))) IN measurable (Y,B) Borel /\
4235           (\x. pos_fn_integral (Y,B,v)
4236                  (\y. indicator_fn s (x,y))) IN measurable (X,A) Borel) /\
4237       ?m. sigma_finite_measure_space (X CROSS Y,subsets ((X,A) CROSS (Y,B)),m) /\
4238           (!s. s IN (prod_sets A B) ==> (m s = m0 s)) /\
4239           (!s. s IN subsets ((X,A) CROSS (Y,B)) ==>
4240               (m s = pos_fn_integral (Y,B,v)
4241                        (\y. pos_fn_integral (X,A,u) (\x. indicator_fn s (x,y)))) /\
4242               (m s = pos_fn_integral (X,A,u)
4243                        (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn s (x,y)))))
4244Proof
4245    rpt GEN_TAC >> STRIP_TAC
4246 >> MP_TAC (Q.SPECL [‘pair$,’,‘FST’,‘SND’,‘X’,‘Y’,‘A’,‘B’,‘u’,‘v’,‘m0’]
4247                    (INST_TYPE [gamma |-> “:'a # 'b”]
4248                               existence_of_prod_measure_general))
4249 >> RW_TAC std_ss [GSYM CROSS_ALT, GSYM prod_sets_alt, GSYM prod_sigma_alt,
4250                   pair_operation_pair]
4251QED
4252
4253(* A derived version of EXISTENCE_OF_PROD_MEASURE using ‘integral’ instead of
4254  ‘pos_fn_integral’ (NOTE: this theorem has no general and FCP versions)
4255 *)
4256Theorem EXISTENCE_OF_PROD_MEASURE' :
4257   !(X :'a set) (Y :'b set) A B u v m0.
4258       sigma_finite_measure_space (X,A,u) /\
4259       sigma_finite_measure_space (Y,B,v) /\
4260       (!s t. s IN A /\ t IN B ==> (m0 (s CROSS t) = u s * v t)) ==>
4261       (!s. s IN subsets ((X,A) CROSS (Y,B)) ==>
4262           (!x. x IN X ==> (\y. indicator_fn s (x,y)) IN measurable (Y,B) Borel) /\
4263           (!y. y IN Y ==> (\x. indicator_fn s (x,y)) IN measurable (X,A) Borel) /\
4264           (\y. integral (X,A,u)
4265                         (\x. indicator_fn s (x,y))) IN measurable (Y,B) Borel /\
4266           (\x. integral (Y,B,v)
4267                         (\y. indicator_fn s (x,y))) IN measurable (X,A) Borel) /\
4268       ?m. sigma_finite_measure_space (X CROSS Y,subsets ((X,A) CROSS (Y,B)),m) /\
4269           (!s. s IN (prod_sets A B) ==> (m s = m0 s)) /\
4270           (!s. s IN subsets ((X,A) CROSS (Y,B)) ==>
4271               (m s = integral (Y,B,v)
4272                               (\y. integral (X,A,u) (\x. indicator_fn s (x,y)))) /\
4273               (m s = integral (X,A,u)
4274                               (\x. integral (Y,B,v) (\y. indicator_fn s (x,y)))))
4275Proof
4276    rpt GEN_TAC >> STRIP_TAC
4277 >> MP_TAC (Q.SPECL [‘X’,‘Y’,‘A’,‘B’,‘u’,‘v’,‘m0’] EXISTENCE_OF_PROD_MEASURE)
4278 >> FULL_SIMP_TAC std_ss [sigma_finite_measure_space_def]
4279 >> RW_TAC std_ss [] (* 3 subgoals *)
4280 >| [ (* goal 1 (of 3) *)
4281     ‘(\y. pos_fn_integral (X,A,u)
4282                           (\x. indicator_fn s (x,y))) IN Borel_measurable (Y,B)’
4283        by METIS_TAC [] \\
4284      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4285                                 (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
4286      Q.EXISTS_TAC ‘\y. pos_fn_integral (X,A,u) (\x. indicator_fn s (x,y))’ >> rw [] \\
4287      MATCH_MP_TAC integral_pos_fn >> rw [INDICATOR_FN_POS],
4288      (* goal 2 (of 3) *)
4289     ‘(\x. pos_fn_integral (Y,B,v)
4290                           (\y. indicator_fn s (x,y))) IN Borel_measurable (X,A)’
4291        by METIS_TAC [] \\
4292      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4293                                 (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
4294      Q.EXISTS_TAC ‘\x. pos_fn_integral (Y,B,v) (\y. indicator_fn s (x,y))’ >> rw [] \\
4295      MATCH_MP_TAC integral_pos_fn >> rw [INDICATOR_FN_POS],
4296      (* goal 3 (of 3) *)
4297      Q.EXISTS_TAC ‘m’ >> RW_TAC std_ss [] >| (* 2 subgoals *)
4298      [ (* goal 3.1 (of 2) *)
4299        Know ‘!y. integral (X,A,u) (\x. indicator_fn s (x,y)) =
4300                  pos_fn_integral (X,A,u) (\x. indicator_fn s (x,y))’
4301        >- (GEN_TAC \\
4302            MATCH_MP_TAC integral_pos_fn >> rw [INDICATOR_FN_POS]) >> Rewr' \\
4303        MATCH_MP_TAC EQ_SYM \\
4304        MATCH_MP_TAC integral_pos_fn >> simp [] \\
4305        Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
4306        MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS],
4307        (* goal 3.2 (of 2) *)
4308       ‘pos_fn_integral (Y,B,v)
4309                        (\y. pos_fn_integral (X,A,u) (\x. indicator_fn s (x,y))) =
4310        pos_fn_integral (X,A,u)
4311                        (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn s (x,y)))’
4312           by METIS_TAC [] >> POP_ORW \\
4313        MATCH_MP_TAC EQ_SYM \\
4314        Know ‘!x. integral (Y,B,v) (\y. indicator_fn s (x,y)) =
4315                  pos_fn_integral (Y,B,v) (\y. indicator_fn s (x,y))’
4316        >- (GEN_TAC >> MATCH_MP_TAC integral_pos_fn \\
4317            rw [INDICATOR_FN_POS]) >> Rewr' \\
4318        MATCH_MP_TAC integral_pos_fn >> simp [] \\
4319        rpt STRIP_TAC \\
4320        MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS] ] ]
4321QED
4322
4323(* FCP version of EXISTENCE_OF_PROD_MEASURE *)
4324Theorem existence_of_prod_measure :
4325   !(X :'a['b] set) (Y :'a['c] set) A B u v m0.
4326       FINITE univ(:'b) /\ FINITE univ(:'c) /\
4327       sigma_finite_measure_space (X,A,u) /\
4328       sigma_finite_measure_space (Y,B,v) /\
4329       (!s t. s IN A /\ t IN B ==> (m0 (fcp_cross s t) = u s * v t)) ==>
4330       (!s. s IN subsets (fcp_sigma (X,A) (Y,B)) ==>
4331           (!x. x IN X ==>
4332               (\y. indicator_fn s (FCP_CONCAT x y)) IN measurable (Y,B) Borel) /\
4333           (!y. y IN Y ==>
4334               (\x. indicator_fn s (FCP_CONCAT x y)) IN measurable (X,A) Borel) /\
4335           (\y. pos_fn_integral (X,A,u)
4336                  (\x. indicator_fn s (FCP_CONCAT x y))) IN measurable (Y,B) Borel /\
4337           (\x. pos_fn_integral (Y,B,v)
4338                  (\y. indicator_fn s (FCP_CONCAT x y))) IN measurable (X,A) Borel) /\
4339       ?m. sigma_finite_measure_space
4340             (fcp_cross X Y,subsets (fcp_sigma (X,A) (Y,B)),m) /\
4341           (!s. s IN (fcp_prod A B) ==> (m s = m0 s)) /\
4342           (!s. s IN subsets (fcp_sigma (X,A) (Y,B)) ==>
4343               (m s = pos_fn_integral (Y,B,v)
4344                        (\y. pos_fn_integral (X,A,u)
4345                               (\x. indicator_fn s (FCP_CONCAT x y)))) /\
4346               (m s = pos_fn_integral (X,A,u)
4347                        (\x. pos_fn_integral (Y,B,v)
4348                               (\y. indicator_fn s (FCP_CONCAT x y)))))
4349Proof
4350    rpt GEN_TAC >> STRIP_TAC
4351 >> MP_TAC (Q.SPECL [‘FCP_CONCAT’,‘FCP_FST’,‘FCP_SND’,‘X’,‘Y’,‘A’,‘B’,‘u’,‘v’,‘m0’]
4352                    (((INST_TYPE [“:'temp1” |-> “:'a['b]”]) o
4353                      (INST_TYPE [“:'temp2” |-> “:'a['c]”]) o
4354                      (INST_TYPE [gamma |-> “:'a['b + 'c]”]) o
4355                      (INST_TYPE [alpha |-> “:'temp1”]) o
4356                      (INST_TYPE [beta |-> “:'temp2”]))
4357                      existence_of_prod_measure_general))
4358 >> RW_TAC std_ss [GSYM fcp_cross_alt, GSYM fcp_prod_alt, GSYM fcp_sigma_alt,
4359                   pair_operation_FCP_CONCAT]
4360QED
4361
4362(* Application: 2-dimensional Borel measure space *)
4363local
4364  val thm = Q.prove (
4365     ‘?m. sigma_finite_measure_space m /\
4366         (m_space m = UNIV CROSS UNIV) /\
4367         (measurable_sets m =
4368          subsets ((UNIV,subsets borel) CROSS (UNIV,subsets borel))) /\
4369         (!s t. s IN subsets borel /\ t IN subsets borel ==>
4370               (measure m (s CROSS t) = lambda s * lambda t)) /\
4371         (!s. s IN measurable_sets m ==>
4372             (!x. (\y. indicator_fn s (x,y)) IN Borel_measurable borel) /\
4373             (!y. (\x. indicator_fn s (x,y)) IN Borel_measurable borel) /\
4374             (\y. pos_fn_integral lborel
4375                    (\x. indicator_fn s (x,y))) IN Borel_measurable borel /\
4376             (\x. pos_fn_integral lborel
4377                    (\y. indicator_fn s (x,y))) IN Borel_measurable borel /\
4378             (measure m s =
4379              pos_fn_integral lborel
4380                (\y. pos_fn_integral lborel (\x. indicator_fn s (x,y)))) /\
4381             (measure m s =
4382              pos_fn_integral lborel
4383                (\x. pos_fn_integral lborel (\y. indicator_fn s (x,y)))))’,
4384   (* proof *)
4385      MP_TAC (Q.ISPECL [‘univ(:real)’, ‘univ(:real)’, ‘subsets borel’,
4386                        ‘subsets borel’, ‘lambda’, ‘lambda’,
4387                        ‘\s. lambda (IMAGE FST s) * lambda (IMAGE SND s)’]
4388                       EXISTENCE_OF_PROD_MEASURE) \\
4389      simp [sigma_finite_measure_space_def] \\
4390      Know ‘(univ(:real),subsets borel,lambda) = lborel’
4391      >- REWRITE_TAC [GSYM space_lborel, GSYM sets_lborel, MEASURE_SPACE_REDUCE] \\
4392      Rewr' \\
4393      REWRITE_TAC [measure_space_lborel, sigma_finite_lborel] \\
4394      Know ‘!s t. s IN subsets borel /\ t IN subsets borel ==>
4395                  lambda (IMAGE FST (s CROSS t)) * lambda (IMAGE SND (s CROSS t)) =
4396                  lambda s * lambda t’
4397      >- (rpt STRIP_TAC \\
4398          Cases_on ‘s = {}’ >- rw [lambda_empty] \\
4399          Cases_on ‘t = {}’ >- rw [lambda_empty] \\
4400          Know ‘IMAGE FST (s CROSS t) = s’
4401          >- (rw [Once EXTENSION] >> EQ_TAC >> RW_TAC std_ss [] >- art [] \\
4402              fs [GSYM MEMBER_NOT_EMPTY] >> rename1 ‘y IN t’ \\
4403              Q.EXISTS_TAC ‘(x,y)’ >> rw []) >> Rewr' \\
4404          Know ‘IMAGE SND (s CROSS t) = t’
4405          >- (rw [Once EXTENSION] >> EQ_TAC >> RW_TAC std_ss [] >- art [] \\
4406              fs [GSYM MEMBER_NOT_EMPTY] >> rename1 ‘y IN s’ \\
4407              Q.EXISTS_TAC ‘(y,x)’ >> rw []) >> Rewr) \\
4408      RW_TAC std_ss [] \\
4409      Q.EXISTS_TAC ‘(UNIV CROSS UNIV,
4410                     subsets ((UNIV,subsets borel) CROSS (UNIV,subsets borel)),m)’ \\
4411      Know ‘(univ(:real),subsets borel) = borel’
4412      >- (REWRITE_TAC [GSYM space_borel, SPACE]) \\
4413      DISCH_THEN (fs o wrap) \\
4414      reverse CONJ_TAC >- METIS_TAC [] \\
4415      rpt STRIP_TAC \\
4416      IMP_RES_TAC MEASURE_SPACE_POSITIVE >> fs [positive_def] \\
4417      Cases_on ‘s = {}’ >- rw [lambda_empty] \\
4418      Cases_on ‘t = {}’ >- rw [lambda_empty] \\
4419      Q.PAT_X_ASSUM ‘!s. _ ==> (m s = lambda (IMAGE FST s) * lambda (IMAGE SND s))’
4420        (MP_TAC o (Q.SPEC ‘s CROSS t’)) >> RW_TAC std_ss [] \\
4421      POP_ASSUM MATCH_MP_TAC \\
4422      qexistsl_tac [‘s’, ‘t’] >> art []);
4423in
4424  val lborel_2d_def = new_specification ("lborel_2d_def", ["lborel_2d"], thm);
4425end;
4426
4427(* NOTE: symbols are now aligned with real_measureTheory *)
4428Definition prod_measure_def :
4429    prod_measure m1 m2 =
4430      \s. pos_fn_integral m2 (\y. pos_fn_integral m1 (\x. indicator_fn s (x,y)))
4431End
4432
4433Theorem PROD_MEASURE_CROSS :
4434    !M1 M2 s t. measure_space M1 /\ measure_space M2 /\
4435                s IN measurable_sets M1 /\ t IN measurable_sets M2 ==>
4436                prod_measure M1 M2 (s CROSS t) = measure M1 s * measure M2 t
4437Proof
4438    rw [prod_measure_def, sigma_finite_measure_space_def]
4439 >> ‘!x y s. indicator_fn s (x,y) = indicator_fn (\y. (x,y) IN s) y’
4440       by rw [indicator_fn_def]
4441 >> POP_ORW
4442 >> ‘!x y. (x,y) IN s CROSS t <=> x IN s /\ y IN t’ by rw [IN_CROSS]
4443 >> POP_ORW
4444 >> ‘!x. (\y. x IN s /\ y IN t) = (\y. x IN s) INTER t’ by rw [FUN_EQ_THM]
4445 >> POP_ORW
4446 >> simp [INDICATOR_FN_INTER]
4447 >> ONCE_REWRITE_TAC [mul_comm]
4448 >> ‘!x y. indicator_fn (\y. x IN s) y = indicator_fn s x’
4449       by rw [indicator_fn_def, FUN_EQ_THM]
4450 >> POP_ORW
4451 >> Know ‘pos_fn_integral M2
4452            (\y. pos_fn_integral M1 (\x. indicator_fn t y * indicator_fn s x)) =
4453          pos_fn_integral M2
4454            (\y. indicator_fn t y * pos_fn_integral M1 (indicator_fn s))’
4455 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
4456     CONJ_TAC
4457     >- (rpt STRIP_TAC \\
4458         MATCH_MP_TAC pos_fn_integral_pos >> art [] \\
4459         Q.X_GEN_TAC ‘y’ >> rw [] \\
4460         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
4461     CONJ_TAC
4462     >- (rpt STRIP_TAC \\
4463         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS] \\
4464         MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) \\
4465     rpt STRIP_TAC \\
4466     qabbrev_tac ‘c = indicator_fn t x’ \\
4467    ‘0 <= c /\ c <> PosInf /\ c <> NegInf’
4468       by METIS_TAC [INDICATOR_FN_NOT_INFTY, INDICATOR_FN_POS] \\
4469    ‘?r. 0 <= r /\ c = Normal r’
4470       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq] \\
4471     POP_ORW \\
4472     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS])
4473 >> Rewr'
4474 >> simp [pos_fn_integral_indicator]
4475 >> ONCE_REWRITE_TAC [mul_comm]
4476 >> Cases_on ‘measure M1 s = PosInf’
4477 >- (POP_ORW \\
4478     MATCH_MP_TAC pos_fn_integral_cmul_infty >> art [])
4479 >> ‘0 <= measure M1 s’ by PROVE_TAC [MEASURE_POSITIVE]
4480 >> ‘measure M1 s <> NegInf’ by rw [pos_not_neginf]
4481 >> ‘?r. 0 <= r /\ measure M1 s = Normal r’
4482      by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq]
4483 >> POP_ORW
4484 >> Know ‘pos_fn_integral M2 (\y. Normal r * indicator_fn t y) =
4485          Normal r * pos_fn_integral M2 (indicator_fn t)’
4486 >- (HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS])
4487 >> Rewr'
4488 >> simp [pos_fn_integral_indicator]
4489QED
4490
4491Definition prod_measure_space_def :
4492    prod_measure_space m1 m2 =
4493      (m_space m1 CROSS m_space m2,
4494       subsets (prod_sigma (m_space m1,measurable_sets m1)
4495                           (m_space m2,measurable_sets m2)),
4496       prod_measure m1 m2)
4497End
4498
4499Overload CROSS = “prod_measure_space”
4500
4501(* |- !m1 m2.
4502        m1 CROSS m2 =
4503        (m_space m1 CROSS m_space m2,
4504         subsets
4505           ((m_space m1,measurable_sets m1) CROSS
4506            (m_space m2,measurable_sets m2)),
4507         (\s.
4508              pos_fn_integral m2
4509                (\y. pos_fn_integral m1 (\x. indicator_fn s (x,y)))))
4510 *)
4511Theorem prod_measure_space_alt =
4512    REWRITE_RULE [prod_measure_def] prod_measure_space_def
4513
4514Definition general_prod_measure_def :
4515    general_prod_measure (cons :'a -> 'b -> 'c) m1 m2 =
4516   (\s. pos_fn_integral m2
4517          (\y. pos_fn_integral m1 (\x. indicator_fn s (cons x y))))
4518End
4519
4520(* |- !cons m1 m2.
4521        general_prod_measure_space cons m1 m2 =
4522        (general_cross cons (m_space m1) (m_space m2),
4523         subsets
4524           (general_sigma cons (measurable_space m1) (measurable_space m2)),
4525         (\s.
4526              pos_fn_integral m2
4527                (\y. pos_fn_integral m1 (\x. indicator_fn s (cons x y)))))
4528 *)
4529Definition general_prod_measure_space :
4530    general_prod_measure_space (cons :'a -> 'b -> 'c) m1 m2 =
4531   (general_cross cons (m_space m1) (m_space m2),
4532    subsets (general_sigma cons (measurable_space m1) (measurable_space m2)),
4533    general_prod_measure cons m1 m2)
4534End
4535
4536Theorem general_prod_measure_space_def =
4537        REWRITE_RULE [general_prod_measure_def] general_prod_measure_space
4538
4539Theorem prod_measure_space_alt_general :
4540    !m1 m2. prod_measure_space m1 m2 =
4541            general_prod_measure_space $, m1 m2
4542Proof
4543    RW_TAC std_ss [prod_measure_space_alt, general_prod_measure_space_def,
4544                   CROSS_ALT, prod_sigma_alt]
4545QED
4546
4547Theorem measure_space_general_prod_measure :
4548    !(cons :'a -> 'b -> 'c) car cdr m1 m2.
4549       pair_operation cons car cdr /\
4550       sigma_finite_measure_space m1 /\
4551       sigma_finite_measure_space m2 ==>
4552       measure_space (general_prod_measure_space cons m1 m2)
4553Proof
4554    rw [pair_operation_def, FORALL_AND_THM]
4555 >> PairCases_on ‘m1’ >> rename1 ‘sigma_finite_measure_space (X,A,u)’
4556 >> PairCases_on ‘m2’ >> rename1 ‘sigma_finite_measure_space (Y,B,v)’
4557 (* applying EXISTENCE_OF_PROD_MEASURE *)
4558 >> MP_TAC (Q.SPECL [‘cons’, ‘car’, ‘cdr’, ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’]
4559                    existence_of_prod_measure_general)
4560 >> DISCH_THEN (MP_TAC o (Q.SPEC ‘\x. u (IMAGE car x) * v (IMAGE cdr x)’))
4561 >> Know ‘!s t. s IN A /\ t IN B ==>
4562               (\x. u (IMAGE car x) * v (IMAGE cdr x)) (general_cross cons s t) =
4563                    u s * v t’
4564 >- (rpt STRIP_TAC \\
4565     fs [sigma_finite_measure_space_def] \\
4566     Cases_on ‘s = {}’
4567     >- (Know ‘positive (X,A,u)’ >- simp [MEASURE_SPACE_POSITIVE] \\
4568         rw [positive_def]) \\
4569     Cases_on ‘t = {}’
4570     >- (Know ‘positive (Y,B,v)’ >- simp [MEASURE_SPACE_POSITIVE] \\
4571         rw [positive_def]) \\
4572     Know ‘IMAGE car (general_cross cons s t) = s’
4573     >- (irule (cj 1 general_cross_reduce) >> art [] \\
4574         Q.EXISTS_TAC ‘cdr’ >> rw [pair_operation_def]) >> Rewr' \\
4575     Know ‘IMAGE cdr (general_cross cons s t) = t’
4576     >- (irule (cj 2 general_cross_reduce) >> art [] \\
4577         Q.EXISTS_TAC ‘car’ >> rw [pair_operation_def]) >> Rewr)
4578 >> RW_TAC std_ss [pair_operation_def]
4579 >> qmatch_abbrev_tac ‘measure_space M’
4580 >> ‘m_space M = general_cross cons X Y’
4581      by simp [Abbr ‘M’, general_prod_measure_space]
4582 >> ‘measurable_sets M = subsets (general_sigma cons (X,A) (Y,B))’
4583      by simp [Abbr ‘M’, general_prod_measure_space]
4584 >> ‘space (general_sigma cons (X,A) (Y,B)) = general_cross cons X Y’
4585      by simp [general_sigma_def, SPACE_SIGMA]
4586 >> fs [sigma_finite_measure_space_def]
4587 >> MATCH_MP_TAC measure_space_eq
4588 >> Q.EXISTS_TAC ‘(general_cross cons X Y,
4589                   subsets (general_sigma cons (X,A) (Y,B)),
4590                   m)’
4591 >> simp [Abbr ‘M’, general_prod_measure_space_def]
4592QED
4593
4594Theorem measure_space_prod_measure : (* was: measure_space_pair_measure *)
4595    !m1 m2. sigma_finite_measure_space m1 /\
4596            sigma_finite_measure_space m2 ==> measure_space (m1 CROSS m2)
4597Proof
4598    rw [prod_measure_space_alt_general]
4599 >> MATCH_MP_TAC measure_space_general_prod_measure
4600 >> qexistsl_tac [‘FST’, ‘SND’]
4601 >> simp [pair_operation_pair]
4602QED
4603
4604(* ‘lborel_2d = lborel CROSS lborel’ doesn't hold *)
4605Theorem lborel_2d_prod_measure :
4606    !s. s IN measurable_sets lborel_2d ==>
4607        measure lborel_2d s = measure (lborel CROSS lborel) s
4608Proof
4609    RW_TAC std_ss [prod_measure_space_alt]
4610 >> STRIP_ASSUME_TAC lborel_2d_def
4611 >> rw [space_lborel, sets_lborel]
4612 >> METIS_TAC []
4613QED
4614
4615(******************************************************************************)
4616(*     Fubini-Tonelli Theorems                                                *)
4617(******************************************************************************)
4618
4619(* Theorem 14.8 [1, p.142] (Tonelli's theorem)
4620
4621   named after Leonida Tonelli, an Italian mathematician [5].
4622
4623   cf. HVG's limited version under the name "fubini":
4624
4625 |- !f M1 M2. measure_space M1 /\ measure_space M2 /\
4626       sigma_finite_measure M1 /\ sigma_finite_measure M2 /\
4627       (!x. 0 <= f x) /\
4628       f IN measurable
4629        (m_space (pair_measure M1 M2), measurable_sets (pair_measure M1 M2)) Borel ==>
4630       (pos_fn_integral M1 (\x. pos_fn_integral M2 (\y. f (x,y))) =
4631        pos_fn_integral M2 (\y. pos_fn_integral M1 (\x. f (x,y)))): thm
4632 *)
4633Theorem tonelli_general :
4634    !(cons :'a -> 'b -> 'c) car cdr X Y A B u v f.
4635        pair_operation cons car cdr /\
4636        sigma_finite_measure_space (X,A,u) /\
4637        sigma_finite_measure_space (Y,B,v) /\
4638        f IN measurable (general_sigma cons (X,A) (Y,B)) Borel /\
4639       (!s. s IN general_cross cons X Y ==> 0 <= f s)
4640      ==>
4641       (!y. y IN Y ==> (\x. f (cons x y)) IN measurable (X,A) Borel) /\
4642       (!x. x IN X ==> (\y. f (cons x y)) IN measurable (Y,B) Borel) /\
4643       (\x. pos_fn_integral (Y,B,v)
4644                            (\y. f (cons x y))) IN measurable (X,A) Borel /\
4645       (\y. pos_fn_integral (X,A,u)
4646                            (\x. f (cons x y))) IN measurable (Y,B) Borel /\
4647       (pos_fn_integral (general_prod_measure_space cons (X,A,u) (Y,B,v)) f =
4648        pos_fn_integral (Y,B,v)
4649          (\y. pos_fn_integral (X,A,u) (\x. f (cons x y)))) /\
4650       (pos_fn_integral (general_prod_measure_space cons (X,A,u) (Y,B,v)) f =
4651        pos_fn_integral (X,A,u)
4652          (\x. pos_fn_integral (Y,B,v) (\y. f (cons x y))))
4653Proof
4654    rpt GEN_TAC >> STRIP_TAC
4655 >> Know ‘!x y. x IN X /\ y IN Y ==> 0 <= f (cons x y)’
4656 >- (rpt STRIP_TAC \\
4657     Q.PAT_X_ASSUM ‘!s. s IN general_cross cons X Y ==> 0 <= f s’
4658       (MP_TAC o Q.SPEC ‘cons x y’) \\
4659     rw [IN_general_cross] \\
4660     POP_ASSUM MATCH_MP_TAC \\
4661     qexistsl_tac [‘x’, ‘y’] >> art [])
4662 >> DISCH_TAC
4663 >> ‘measure_space (general_prod_measure_space cons (X,A,u) (Y,B,v))’
4664      by PROVE_TAC [measure_space_general_prod_measure]
4665 (* preliminaries *)
4666 >> Know ‘!i n. (0 :extreal) <= &i / 2 pow n’
4667 >- (rpt GEN_TAC \\
4668    ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
4669       by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
4670    ‘?r. 0 < r /\ (2 pow n = Normal r)’
4671       by METIS_TAC [lt_02, pow_pos_lt, extreal_cases, extreal_lt_eq,
4672                     extreal_of_num_def] >> POP_ORW \\
4673     MATCH_MP_TAC le_div >> rw [extreal_of_num_def, extreal_le_eq])
4674 >> DISCH_TAC
4675 >> Know ‘!i n. &i / 2 pow n <> PosInf /\ &i / 2 pow n <> NegInf’
4676 >- (rpt GEN_TAC \\
4677    ‘&i = Normal (&i)’ by METIS_TAC [extreal_of_num_def] >> POP_ORW \\
4678     MATCH_MP_TAC div_not_infty \\
4679     ONCE_REWRITE_TAC [EQ_SYM_EQ] >> MATCH_MP_TAC lt_imp_ne \\
4680     MATCH_MP_TAC pow_pos_lt >> REWRITE_TAC [lt_02])
4681 >> DISCH_TAC
4682 (* applying EXISTENCE_OF_PROD_MEASURE *)
4683 >> MP_TAC (Q.SPECL [‘cons’, ‘car’, ‘cdr’, ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’]
4684                    existence_of_prod_measure_general)
4685 >> DISCH_THEN (MP_TAC o (Q.SPEC ‘\x. u (IMAGE car x) * v (IMAGE cdr x)’))
4686 >> Know ‘!s t. s IN A /\ t IN B ==>
4687               (\x. u (IMAGE car x) * v (IMAGE cdr x)) (general_cross cons s t) =
4688                    u s * v t’
4689 >- (rpt STRIP_TAC \\
4690     fs [sigma_finite_measure_space_def, pair_operation_def, FORALL_AND_THM] \\
4691     Cases_on ‘s = {}’
4692     >- (Know ‘positive (X,A,u)’ >- simp [MEASURE_SPACE_POSITIVE] \\
4693         rw [positive_def]) \\
4694     Cases_on ‘t = {}’
4695     >- (Know ‘positive (Y,B,v)’ >- simp [MEASURE_SPACE_POSITIVE] \\
4696         rw [positive_def]) \\
4697     Know ‘IMAGE car (general_cross cons s t) = s’
4698     >- (irule (cj 1 general_cross_reduce) >> art [] \\
4699         Q.EXISTS_TAC ‘cdr’ >> rw [pair_operation_def]) >> Rewr' \\
4700     Know ‘IMAGE cdr (general_cross cons s t) = t’
4701     >- (irule (cj 2 general_cross_reduce) >> art [] \\
4702         Q.EXISTS_TAC ‘car’ >> rw [pair_operation_def]) >> Rewr)
4703 >> DISCH_TAC
4704 >> ASM_SIMP_TAC std_ss []
4705 >> STRIP_TAC (* this asserts ‘m’ *)
4706 (* applying lemma_fn_seq_sup *)
4707 >> qabbrev_tac ‘M = general_prod_measure_space cons (X,A,u) (Y,B,v)’
4708 >> MP_TAC (Q.SPECL [‘M’, ‘f’] (INST_TYPE [alpha |-> gamma] lemma_fn_seq_sup))
4709 >> ‘m_space M = general_cross cons X Y’
4710      by simp [Abbr ‘M’, general_prod_measure_space] >> art []
4711 >> DISCH_TAC
4712 >> Know ‘!x y. x IN X /\ y IN Y ==>
4713                sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV) = f (cons x y)’
4714 >- (rpt STRIP_TAC \\
4715     Q.PAT_X_ASSUM ‘!x. x IN general_cross cons X Y /\ 0 <= f x ==> _’
4716       (MP_TAC o Q.SPEC ‘cons x y’) \\
4717     DISCH_THEN MATCH_MP_TAC >> simp [] \\
4718     rw [IN_general_cross] \\
4719     qexistsl_tac [‘x’, ‘y’] >> art [])
4720 >> DISCH_TAC
4721 >> ‘measurable_sets M = subsets (general_sigma cons (X,A) (Y,B))’
4722      by simp [Abbr ‘M’, general_prod_measure_space]
4723 >> ‘space (general_sigma cons (X,A) (Y,B)) = general_cross cons X Y’
4724      by simp [general_sigma_def, SPACE_SIGMA]
4725 >> fs [sigma_finite_measure_space_def]
4726 >> ‘sigma_algebra (X,A) /\ sigma_algebra (Y,B)’
4727      by METIS_TAC [measure_space_def, space_def, subsets_def, m_space_def,
4728                    measurable_sets_def]
4729 >> Know ‘sigma_algebra (general_sigma cons (X,A) (Y,B))’
4730 >- (MATCH_MP_TAC sigma_algebra_general_sigma \\
4731     fs [sigma_algebra_def, algebra_def])
4732 >> DISCH_TAC
4733 (* common measurable sets inside fn_seq *)
4734 >> qabbrev_tac ‘s = \n k. {x | x IN general_cross cons X Y /\
4735                                &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n}’
4736 >> Know ‘!n i. s n i IN subsets (general_sigma cons (X,A) (Y,B))’
4737 >- (rpt GEN_TAC \\
4738     Know ‘s n i = ({x | &i / 2 pow n <= f x} INTER general_cross cons X Y) INTER
4739                   ({x | f x < (&i + 1) / 2 pow n} INTER general_cross cons X Y)’
4740     >- (rw [Abbr ‘s’, Once EXTENSION, IN_INTER] \\
4741         EQ_TAC >> RW_TAC std_ss []) >> Rewr' \\
4742     MATCH_MP_TAC SIGMA_ALGEBRA_INTER \\
4743     MP_TAC (Q.SPECL [‘f’, ‘general_sigma cons (X,A) (Y,B)’]
4744                     (INST_TYPE [alpha |-> gamma] IN_MEASURABLE_BOREL_ALL)) \\
4745     simp [])
4746 >> DISCH_TAC
4747 >> qabbrev_tac ‘t = \n. {x | x IN general_cross cons X Y /\ 2 pow n <= f x}’
4748 >> Know ‘!n. t n IN subsets (general_sigma cons (X,A) (Y,B))’
4749 >- (RW_TAC std_ss [Abbr ‘t’] \\
4750    ‘{x | x IN general_cross cons X Y /\ 2 pow n <= f x} =
4751     {x | 2 pow n <= f x} INTER general_cross cons X Y’ by SET_TAC [] \\
4752     POP_ORW \\
4753     MP_TAC (Q.SPECL [‘f’, ‘general_sigma cons (X,A) (Y,B)’]
4754                     (INST_TYPE [alpha |-> gamma] IN_MEASURABLE_BOREL_ALL)) \\
4755     simp [])
4756 >> DISCH_TAC
4757 (* important properties of fn_seq *)
4758 >> Know ‘!n y. y IN Y /\
4759               (!s. s IN subsets (general_sigma cons (X,A) (Y,B)) ==>
4760                   (\x. indicator_fn s (cons x y)) IN Borel_measurable (X,A)) ==>
4761               (\x. fn_seq M f n (cons x y)) IN Borel_measurable (X,A)’
4762 >- (rpt STRIP_TAC \\
4763     ASM_SIMP_TAC std_ss [fn_seq_def] \\
4764     MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD \\
4765     qexistsl_tac [‘\x. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
4766                              (count (4 ** n))’,
4767                   ‘\x. 2 pow n * indicator_fn (t n) (cons x y)’] \\
4768     ASM_SIMP_TAC std_ss [space_def] \\
4769     CONJ_TAC (* Borel_measurable #1 *)
4770     >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
4771         qexistsl_tac [‘\k x. &k / 2 pow n * indicator_fn (s n k) (cons x y)’,
4772                       ‘count (4 ** n)’] \\
4773         ASM_SIMP_TAC std_ss [FINITE_COUNT, space_def] \\
4774         reverse CONJ_TAC
4775         >- (rpt GEN_TAC >> STRIP_TAC \\
4776             MATCH_MP_TAC pos_not_neginf \\
4777             MATCH_MP_TAC le_mul >> art [INDICATOR_FN_POS]) \\
4778         RW_TAC std_ss [IN_COUNT] \\
4779        ‘?z. &i / 2 pow n = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4780         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
4781         qexistsl_tac [‘\x. indicator_fn (s n i) (cons x y)’, ‘z’] >> rw []) \\
4782     reverse CONJ_TAC
4783     >- (GEN_TAC >> DISCH_TAC >> DISJ1_TAC \\
4784         CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 2 subgoals *)
4785         [ (* goal 1 (of 2) *)
4786           irule EXTREAL_SUM_IMAGE_POS \\
4787           reverse CONJ_TAC >- REWRITE_TAC [FINITE_COUNT] \\
4788           Q.X_GEN_TAC ‘i’ >> rw [] \\
4789           MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS],
4790           (* goal 2 (of 2) *)
4791           MATCH_MP_TAC le_mul >> REWRITE_TAC [INDICATOR_FN_POS] \\
4792           MATCH_MP_TAC pow_pos_le >> REWRITE_TAC [le_02] ]) \\
4793    ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
4794      by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
4795    ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4796     MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
4797     qexistsl_tac [‘\x. indicator_fn (t n) (cons x y)’, ‘r’] >> rw [])
4798 >> DISCH_TAC
4799 >> Know ‘!n x. x IN X /\
4800               (!s. s IN subsets (general_sigma cons (X,A) (Y,B)) ==>
4801                   (\y. indicator_fn s (cons x y)) IN measurable (Y,B) Borel) ==>
4802               (\y. fn_seq M f n (cons x y)) IN Borel_measurable (Y,B)’
4803 >- (rpt STRIP_TAC \\
4804     ASM_SIMP_TAC std_ss [fn_seq_def] \\
4805     MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD \\
4806     qexistsl_tac [‘\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
4807                              (count (4 ** n))’,
4808                   ‘\y. 2 pow n * indicator_fn (t n) (cons x y)’] \\
4809     ASM_SIMP_TAC std_ss [space_def] \\
4810     CONJ_TAC (* Borel_measurable #1 *)
4811     >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
4812         qexistsl_tac [‘\k y. &k / 2 pow n * indicator_fn (s n k) (cons x y)’,
4813                       ‘count (4 ** n)’] \\
4814         ASM_SIMP_TAC std_ss [FINITE_COUNT, space_def] \\
4815         reverse CONJ_TAC
4816         >- (rpt GEN_TAC >> STRIP_TAC \\
4817             MATCH_MP_TAC pos_not_neginf \\
4818             MATCH_MP_TAC le_mul >> art [INDICATOR_FN_POS]) \\
4819         RW_TAC std_ss [IN_COUNT] \\
4820        ‘?z. &i / 2 pow n = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4821         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
4822         qexistsl_tac [‘\y. indicator_fn (s n i) (cons x y)’, ‘z’] >> rw []) \\
4823     reverse CONJ_TAC
4824     >- (GEN_TAC >> DISCH_TAC >> DISJ1_TAC \\
4825         CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 2 subgoals *)
4826         [ (* goal 1 (of 2) *)
4827           irule EXTREAL_SUM_IMAGE_POS \\
4828           reverse CONJ_TAC >- REWRITE_TAC [FINITE_COUNT] \\
4829           Q.X_GEN_TAC ‘i’ >> rw [] \\
4830           MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS],
4831           (* goal 2 (of 2) *)
4832           MATCH_MP_TAC le_mul >> REWRITE_TAC [INDICATOR_FN_POS] \\
4833           MATCH_MP_TAC pow_pos_le >> REWRITE_TAC [le_02] ]) \\
4834    ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
4835       by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
4836    ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4837     MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
4838     qexistsl_tac [‘\y. indicator_fn (t n) (cons x y)’, ‘r’] >> rw [])
4839 >> DISCH_TAC
4840 (* shared property by goal 3 and 5/6 *)
4841 >> Know ‘!n. (\x. pos_fn_integral (Y,B,v)
4842                     (\y. fn_seq M f n (cons x y))) IN Borel_measurable (X,A)’
4843 >- (RW_TAC std_ss [fn_seq_def] \\
4844     MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4845                                (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
4846     BETA_TAC \\
4847     Q.EXISTS_TAC
4848    ‘\x. pos_fn_integral (Y,B,v)
4849           (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
4850                      (count (4 ** n))) +
4851         pos_fn_integral (Y,B,v)
4852           (\y. 2 pow n *
4853                indicator_fn {x | x IN general_cross cons X Y /\ 2 pow n <= f x}
4854                             (cons x y))’ \\
4855     ASM_SIMP_TAC std_ss [] \\
4856     Know ‘!x. x IN X ==>
4857              (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
4858                         (count (4 ** n))) IN Borel_measurable (Y,B)’
4859     >- (rpt STRIP_TAC \\
4860         MATCH_MP_TAC ((INST_TYPE [alpha |-> beta] o
4861                        INST_TYPE [beta |-> “:num”]) IN_MEASURABLE_BOREL_SUM) \\
4862         simp [] \\
4863         qexistsl_tac [‘\k y. &k / 2 pow n * indicator_fn (s n k) (cons x y)’,
4864                       ‘count (4 ** n)’] >> simp [] \\
4865         CONJ_TAC
4866         >- (rpt STRIP_TAC \\
4867            ‘?z. &i / 2 pow n = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4868             MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
4869             qexistsl_tac [‘\y. indicator_fn (s n i) (cons x y)’, ‘z’] >> rw []) \\
4870         qx_genl_tac [‘i’, ‘y’] >> STRIP_TAC \\
4871         MATCH_MP_TAC pos_not_neginf \\
4872         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) >> DISCH_TAC \\
4873     Know ‘!x. x IN X ==>
4874              (\y. 2 pow n * indicator_fn (t n) (cons x y)) IN Borel_measurable (Y,B)’
4875     >- (rpt STRIP_TAC \\
4876        ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
4877           by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
4878        ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4879         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
4880         ASM_SIMP_TAC std_ss [space_def] \\
4881         qexistsl_tac [‘\y. indicator_fn (t n) (cons x y)’, ‘r’] >> rw []) \\
4882     DISCH_TAC \\
4883     RW_TAC std_ss []
4884     >- (HO_MATCH_MP_TAC pos_fn_integral_add \\
4885         ASM_SIMP_TAC std_ss [m_space_def, measurable_sets_def] \\
4886         CONJ_TAC >- (rpt STRIP_TAC \\
4887                      MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw [IN_COUNT] \\
4888                      MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
4889         rpt STRIP_TAC \\
4890         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
4891     MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD \\
4892     qexistsl_tac
4893       [‘\x. pos_fn_integral (Y,B,v)
4894               (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
4895                          (count (4 ** n)))’,
4896        ‘\x. pos_fn_integral (Y,B,v)
4897               (\y. 2 pow n * indicator_fn (t n) (cons x y))’] \\
4898     ASM_SIMP_TAC std_ss [space_def] \\
4899     REWRITE_TAC [CONJ_ASSOC] \\
4900     reverse CONJ_TAC
4901     >- (GEN_TAC >> DISCH_TAC >> DISJ1_TAC \\
4902         CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 2 subgoals *)
4903         [ (* goal 1 (of 2) *)
4904           MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
4905           Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
4906           MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> simp [] \\
4907           Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
4908           MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS],
4909           (* goal 2 (of 2) *)
4910           MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
4911           Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
4912           MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le] ]) \\
4913     CONJ_TAC
4914     >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4915                                    (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
4916         BETA_TAC \\
4917         Q.EXISTS_TAC
4918        ‘\x. SIGMA (\k. pos_fn_integral (Y,B,v)
4919                          (\y. &k / 2 pow n * indicator_fn (s n k) (cons x y)))
4920                   (count (4 ** n))’ \\
4921         reverse CONJ_TAC
4922         >- (MATCH_MP_TAC ((INST_TYPE [alpha |-> beta] o
4923                            INST_TYPE [beta |-> “:num”]) IN_MEASURABLE_BOREL_SUM) \\
4924             simp [] \\
4925             qexistsl_tac [‘\k x. pos_fn_integral (Y,B,v)
4926                                    (\y. &k / 2 pow n *
4927                                         indicator_fn (s n k) (cons x y))’,
4928                           ‘count (4 ** n)’] >> simp [] \\
4929             CONJ_TAC
4930             >- (rpt STRIP_TAC \\
4931                ‘?z. 0 <= z /\ (&i / 2 pow n = Normal z)’
4932                   by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
4933                 POP_ORW \\
4934                 MATCH_MP_TAC
4935                   (REWRITE_RULE [m_space_def, measurable_sets_def]
4936                                 (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
4937                 BETA_TAC \\
4938                 Q.EXISTS_TAC ‘\x. Normal z *
4939                                   pos_fn_integral (Y,B,v)
4940                                     (\y. indicator_fn (s n i) (cons x y))’ \\
4941                 BETA_TAC \\
4942                 CONJ_TAC >- (rpt STRIP_TAC \\
4943                              HO_MATCH_MP_TAC pos_fn_integral_cmul \\
4944                              rw [INDICATOR_FN_POS]) \\
4945                 MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
4946                 qexistsl_tac [‘\x. pos_fn_integral (Y,B,v)
4947                                      (\y. indicator_fn (s n i) (cons x y))’,
4948                               ‘z’] >> rw []) \\
4949             qx_genl_tac [‘i’, ‘x’] >> STRIP_TAC \\
4950             MATCH_MP_TAC pos_not_neginf \\
4951             MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
4952             MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
4953         RW_TAC std_ss [] \\
4954         qabbrev_tac ‘g = \k y. &k / 2 pow n * indicator_fn (s n k) (cons x y)’ \\
4955         MP_TAC (Q.SPECL [‘(Y,B,v)’, ‘g’, ‘count (4 ** n)’]
4956                         ((INST_TYPE [alpha |-> beta] o
4957                           INST_TYPE [beta |-> “:num”]) pos_fn_integral_sum)) \\
4958         simp [Abbr ‘g’] \\
4959         Know ‘!i. i < 4 ** n ==>
4960                   !y. y IN Y ==> 0 <= &i / 2 pow n *
4961                                       indicator_fn (s n i) (cons x y)’
4962         >- (rpt STRIP_TAC >> MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
4963         Suff ‘!i. i < 4 ** n ==>
4964                   (\y. &i / 2 pow n * indicator_fn (s n i) (cons x y))
4965                        IN Borel_measurable (Y,B)’ >- RW_TAC std_ss [] \\
4966         rpt STRIP_TAC \\
4967        ‘?z. &i / 2 pow n = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4968         MATCH_MP_TAC (INST_TYPE [alpha |-> beta] IN_MEASURABLE_BOREL_CMUL) \\
4969         simp [] \\
4970         qexistsl_tac [‘\y. indicator_fn (s n i) (cons x y)’, ‘z’] >> rw []) \\
4971    ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
4972       by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
4973    ‘?r. 0 <= r /\ (2 pow n = Normal r)’
4974       by METIS_TAC [extreal_cases, pow_pos_le, le_02, extreal_le_eq,
4975                     extreal_of_num_def] \\
4976     POP_ORW \\
4977     MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4978                                (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
4979     BETA_TAC \\
4980     Q.EXISTS_TAC ‘\x. Normal r *
4981                       pos_fn_integral (Y,B,v) (\y. indicator_fn (t n) (cons x y))’ \\
4982     BETA_TAC \\
4983     CONJ_TAC >- (rpt STRIP_TAC \\
4984                  HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
4985     MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
4986     qexistsl_tac [‘\x. pos_fn_integral (Y,B,v)
4987                          (\y. indicator_fn (t n) (cons x y))’, ‘r’] >> rw [])
4988 >> DISCH_TAC
4989 (* shared property by goal 4 and 5/6 *)
4990 >> Know ‘!n. (\y. pos_fn_integral (X,A,u)
4991                     (\x. fn_seq M f n (cons x y))) IN Borel_measurable (Y,B)’
4992 >- (RW_TAC std_ss [fn_seq_def] \\
4993     MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
4994                                (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
4995     BETA_TAC \\
4996     Q.EXISTS_TAC ‘\y. pos_fn_integral (X,A,u)
4997                         (\x. SIGMA (\k. &k / 2 pow n *
4998                                         indicator_fn (s n k) (cons x y))
4999                                    (count (4 ** n))) +
5000                       pos_fn_integral (X,A,u)
5001                         (\x. 2 pow n * indicator_fn (t n) (cons x y))’ \\
5002     ASM_SIMP_TAC std_ss [] \\
5003     Know ‘!y. y IN Y ==>
5004              (\x. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5005                         (count (4 ** n))) IN Borel_measurable (X,A)’
5006     >- (rpt STRIP_TAC \\
5007         MATCH_MP_TAC
5008           (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) >> simp [] \\
5009         qexistsl_tac [‘\k x. &k / 2 pow n * indicator_fn (s n k) (cons x y)’,
5010                       ‘count (4 ** n)’] >> simp [] \\
5011         CONJ_TAC
5012         >- (rpt STRIP_TAC \\
5013            ‘?z. &i / 2 pow n = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5014             MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
5015             qexistsl_tac [‘\x. indicator_fn (s n i) (cons x y)’, ‘z’] >> rw []) \\
5016         qx_genl_tac [‘i’, ‘x’] >> STRIP_TAC \\
5017         MATCH_MP_TAC pos_not_neginf \\
5018         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5019     DISCH_TAC \\
5020     Know ‘!y. y IN Y ==>
5021              (\x. 2 pow n * indicator_fn (t n) (cons x y)) IN Borel_measurable (X,A)’
5022     >- (rpt STRIP_TAC \\
5023        ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5024           by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5025        ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5026         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
5027         qexistsl_tac [‘\x. indicator_fn (t n) (cons x y)’, ‘r’] >> rw []) \\
5028     DISCH_TAC \\
5029     RW_TAC std_ss []
5030     >- (HO_MATCH_MP_TAC pos_fn_integral_add \\
5031         ASM_SIMP_TAC std_ss [m_space_def, measurable_sets_def] \\
5032         CONJ_TAC >- (rpt STRIP_TAC \\
5033                      MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw [IN_COUNT] \\
5034                      MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5035         rpt STRIP_TAC \\
5036         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5037     MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD \\
5038     qexistsl_tac [‘\y. pos_fn_integral (X,A,u)
5039                          (\x. SIGMA (\k. &k / 2 pow n *
5040                                          indicator_fn (s n k) (cons x y))
5041                                     (count (4 ** n)))’,
5042                   ‘\y. pos_fn_integral (X,A,u)
5043                          (\x. 2 pow n * indicator_fn (t n) (cons x y))’] \\
5044     ASM_SIMP_TAC std_ss [space_def] \\
5045     REWRITE_TAC [CONJ_ASSOC] \\
5046     reverse CONJ_TAC
5047     >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC >> DISJ1_TAC \\
5048         CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >|
5049         [ (* goal 4.1 (of 2) *)
5050           MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
5051           Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5052           MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> simp [] \\
5053           Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
5054           MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS],
5055           (* goal 4.2 (of 2) *)
5056           MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
5057           Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5058           MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le] ]) \\
5059     CONJ_TAC
5060     >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5061                                    (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5062         BETA_TAC \\
5063         Q.EXISTS_TAC ‘\y. SIGMA (\k. pos_fn_integral (X,A,u)
5064                                        (\x. &k / 2 pow n *
5065                                             indicator_fn (s n k) (cons x y)))
5066                                 (count (4 ** n))’ \\
5067         reverse CONJ_TAC
5068         >- (MATCH_MP_TAC
5069              (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) >> simp [] \\
5070             qexistsl_tac [‘\k y. pos_fn_integral (X,A,u)
5071                                    (\x. &k / 2 pow n *
5072                                         indicator_fn (s n k) (cons x y))’,
5073                           ‘count (4 ** n)’] >> simp [] \\
5074             CONJ_TAC
5075             >- (rpt STRIP_TAC \\
5076                ‘?z. 0 <= z /\ (&i / 2 pow n = Normal z)’
5077                   by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
5078                 POP_ORW \\
5079                 MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5080                                (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5081                 BETA_TAC \\
5082                 Q.EXISTS_TAC ‘\y. Normal z *
5083                                   pos_fn_integral (X,A,u)
5084                                     (\x. indicator_fn (s n i) (cons x y))’ \\
5085                 BETA_TAC \\
5086                 CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5087                              HO_MATCH_MP_TAC pos_fn_integral_cmul \\
5088                              rw [INDICATOR_FN_POS]) \\
5089                 MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> rw [] \\
5090                 qexistsl_tac [‘\y. pos_fn_integral (X,A,u)
5091                                     (\x. indicator_fn (s n i) (cons x y))’,
5092                               ‘z’] >> rw []) \\
5093             qx_genl_tac [‘i’, ‘y’] >> STRIP_TAC \\
5094             MATCH_MP_TAC pos_not_neginf \\
5095             MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5096             MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5097         Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
5098         qabbrev_tac ‘g = \k x. &k / 2 pow n * indicator_fn (s n k) (cons x y)’ \\
5099         MP_TAC (Q.SPECL [‘(X,A,u)’, ‘g’, ‘count (4 ** n)’]
5100                         (INST_TYPE [beta |-> “:num”] pos_fn_integral_sum)) \\
5101         simp [Abbr ‘g’] \\
5102         Know ‘!i. i < 4 ** n ==>
5103                   !x. x IN X ==>
5104                       0 <= &i / 2 pow n * indicator_fn (s n i) (cons x y)’
5105         >- (rpt STRIP_TAC >> MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5106         Suff ‘!i. i < 4 ** n ==>
5107                  (\x. &i / 2 pow n * indicator_fn (s n i) (cons x y))
5108                     IN Borel_measurable (X,A)’
5109         >- RW_TAC std_ss [] \\
5110         rpt STRIP_TAC \\
5111        ‘?z. &i / 2 pow n = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5112         MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5113         qexistsl_tac [‘\x. indicator_fn (s n i) (cons x y)’, ‘z’] >> rw []) \\
5114    ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5115       by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5116    ‘?r. 0 <= r /\ 2 pow n = Normal r’
5117       by METIS_TAC [extreal_cases, pow_pos_le, le_02, extreal_le_eq,
5118                     extreal_of_num_def] \\
5119     POP_ORW \\
5120     MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5121                                (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5122     BETA_TAC \\
5123     Q.EXISTS_TAC ‘\y. Normal r *
5124                       pos_fn_integral (X,A,u) (\x. indicator_fn (t n) (cons x y))’ \\
5125     BETA_TAC \\
5126     CONJ_TAC
5127     >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5128         HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
5129     MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5130     qexistsl_tac [‘\y. pos_fn_integral (X,A,u)
5131                          (\x. indicator_fn (t n) (cons x y))’, ‘r’] >> rw [])
5132 >> DISCH_TAC
5133 (* stage work *)
5134 >> RW_TAC std_ss [] (* 6 subgoals *)
5135 >| [ (* goal 1 (of 6) *)
5136      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5137                                 (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
5138      Q.EXISTS_TAC ‘\x. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV)’ >> rw [] \\
5139      MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP \\
5140      Q.EXISTS_TAC ‘\n x. fn_seq M f n (cons x y)’ >> rw [] \\
5141      irule (SIMP_RULE std_ss [ext_mono_increasing_def]
5142                              lemma_fn_seq_mono_increasing) >> rw [],
5143      (* goal 2 (of 6), symmetric with goal 1 *)
5144      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5145                     (Q.SPEC ‘(Y,B,v)’
5146                       (INST_TYPE [alpha |-> beta] IN_MEASURABLE_BOREL_EQ))) \\
5147      Q.EXISTS_TAC ‘\y. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV)’ >> rw [] \\
5148      MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP \\
5149      Q.EXISTS_TAC ‘\n y. fn_seq M f n (cons x y)’ >> rw [] \\
5150      irule (SIMP_RULE std_ss [ext_mono_increasing_def]
5151                              lemma_fn_seq_mono_increasing) >> rw [],
5152      (* goal 3 (of 6) *)
5153      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5154                                 (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
5155      BETA_TAC \\
5156      Q.EXISTS_TAC ‘\x. pos_fn_integral (Y,B,v)
5157                          (\y. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV))’ \\
5158      rw [] >- (MATCH_MP_TAC pos_fn_integral_cong >> rw []) \\
5159      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5160                                 (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
5161      BETA_TAC \\
5162      Q.EXISTS_TAC ‘\x. sup (IMAGE (\n. pos_fn_integral (Y,B,v)
5163                                          (\y. fn_seq M f n (cons x y))) UNIV)’ \\
5164      rw []
5165      >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence \\
5166          simp [lemma_fn_seq_positive, lemma_fn_seq_mono_increasing]) \\
5167      MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP >> simp [] \\
5168      Q.EXISTS_TAC ‘\n x. pos_fn_integral (Y,B,v) (\y. fn_seq M f n (cons x y))’ \\
5169      RW_TAC std_ss [] \\
5170      MATCH_MP_TAC pos_fn_integral_mono >> simp [lemma_fn_seq_positive] \\
5171      Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5172      irule (SIMP_RULE std_ss [ext_mono_increasing_def]
5173                              lemma_fn_seq_mono_increasing) >> rw [],
5174      (* goal 4 (of 6), symmetric with goal 3 *)
5175      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5176                                 (Q.SPEC ‘(Y,B,b)’ IN_MEASURABLE_BOREL_EQ)) \\
5177      BETA_TAC \\
5178      Q.EXISTS_TAC ‘\y. pos_fn_integral (X,A,u)
5179                          (\x. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV))’ \\
5180      rw [] >- (MATCH_MP_TAC pos_fn_integral_cong >> rw []) \\
5181      MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5182                                 (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5183      BETA_TAC \\
5184      Q.EXISTS_TAC ‘\y. sup (IMAGE (\n. pos_fn_integral (X,A,u)
5185                                          (\x. fn_seq M f n (cons x y))) UNIV)’ \\
5186      rw []
5187      >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence \\
5188          simp [lemma_fn_seq_positive, lemma_fn_seq_mono_increasing]) \\
5189      MATCH_MP_TAC IN_MEASURABLE_BOREL_MONO_SUP >> simp [] \\
5190      Q.EXISTS_TAC ‘\n y. pos_fn_integral (X,A,u) (\x. fn_seq M f n (cons x y))’ \\
5191      ASM_SIMP_TAC std_ss [] \\
5192      qx_genl_tac [‘n’, ‘y’] >> DISCH_TAC \\
5193      MATCH_MP_TAC pos_fn_integral_mono >> simp [lemma_fn_seq_positive] \\
5194      Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5195      irule (SIMP_RULE std_ss [ext_mono_increasing_def]
5196                              lemma_fn_seq_mono_increasing) >> rw [],
5197      (* goal 5 (of 6) *)
5198      Know ‘pos_fn_integral M f =
5199            pos_fn_integral M (\x. sup (IMAGE (\n. fn_seq M f n x) UNIV))’
5200      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp []) >> Rewr' \\
5201      Know ‘pos_fn_integral M
5202              (\x. sup (IMAGE (\n. fn_seq M f n x) UNIV)) =
5203            sup (IMAGE (\n. pos_fn_integral M (fn_seq M f n)) UNIV)’
5204      >- (MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
5205          REWRITE_TAC [CONJ_ASSOC] (* easier goals first *) \\
5206          reverse CONJ_TAC (* mono_increasing *)
5207          >- (rpt STRIP_TAC >> MATCH_MP_TAC lemma_fn_seq_mono_increasing \\
5208              FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
5209          reverse CONJ_TAC (* positive *)
5210          >- (rpt STRIP_TAC >> MATCH_MP_TAC lemma_fn_seq_positive \\
5211              FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
5212          Q.X_GEN_TAC ‘n’ \\
5213          RW_TAC std_ss [fn_seq_def] \\
5214         ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
5215          general_sigma cons (X,A) (Y,B)’
5216            by METIS_TAC [SPACE] >> POP_ORW \\
5217          MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD \\
5218          ASM_SIMP_TAC std_ss [space_def] \\
5219          qexistsl_tac [‘\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5220                            (count (4 ** n))’,
5221                        ‘\z. 2 pow n * indicator_fn (t n) z’] \\
5222          ASM_SIMP_TAC std_ss [CONJ_ASSOC] \\
5223          reverse CONJ_TAC (* nonnegative *)
5224          >- (Q.X_GEN_TAC ‘z’ >> DISCH_TAC >> DISJ1_TAC \\
5225              CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 2 subgoals *)
5226              [ (* goal 5.1 (of 2) *)
5227                MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw [] \\
5228                MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS],
5229                (* goal 5.2 (of 2) *)
5230                MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le] ]) \\
5231          CONJ_TAC (* Borel_measurable #1 *)
5232          >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
5233              ASM_SIMP_TAC std_ss [space_def] \\
5234              qexistsl_tac [‘\k z. &k / 2 pow n * indicator_fn (s n k) z’,
5235                            ‘count (4 ** n)’] >> simp [] \\
5236              reverse CONJ_TAC
5237              >- (qx_genl_tac [‘i’, ‘z’] >> STRIP_TAC \\
5238                  MATCH_MP_TAC pos_not_neginf \\
5239                  MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5240              rpt STRIP_TAC \\
5241             ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5242              MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) \\
5243         ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5244             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5245         ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5246          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) >> Rewr' \\
5247      Know ‘pos_fn_integral (Y,B,v)
5248              (\y. pos_fn_integral (X,A,u) (\x. f (cons x y))) =
5249            pos_fn_integral (Y,B,v)
5250              (\y. pos_fn_integral (X,A,u)
5251                     (\x. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV)))’
5252      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5253          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5254                       MATCH_MP_TAC pos_fn_integral_pos >> rw []) \\
5255          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5256                       MATCH_MP_TAC pos_fn_integral_pos >> rw []) \\
5257          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5258          MATCH_MP_TAC pos_fn_integral_cong >> simp []) >> Rewr' \\
5259      Know ‘pos_fn_integral (Y,B,v)
5260              (\y. pos_fn_integral (X,A,u)
5261                     (\x. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV))) =
5262            pos_fn_integral (Y,B,v)
5263              (\y. sup (IMAGE (\n. pos_fn_integral (X,A,u)
5264                                     (\x. fn_seq M f n (cons x y))) UNIV))’
5265      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5266          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5267                       MATCH_MP_TAC pos_fn_integral_pos >> rw []) \\
5268          CONJ_TAC
5269          >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5270              rw [le_sup'] >> rename1 ‘0 <= z’ \\
5271              Q_TAC (TRANS_TAC le_trans)
5272                    ‘pos_fn_integral (X,A,u) (\x. fn_seq M f 0 (cons x y))’ \\
5273              CONJ_TAC >- (MATCH_MP_TAC pos_fn_integral_pos \\
5274                           rw [lemma_fn_seq_positive]) \\
5275              POP_ASSUM MATCH_MP_TAC >> Q.EXISTS_TAC ‘0’ >> REFL_TAC) \\
5276          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5277          HO_MATCH_MP_TAC lebesgue_monotone_convergence \\
5278          simp [lemma_fn_seq_positive, lemma_fn_seq_mono_increasing]) >> Rewr' \\
5279      Know ‘pos_fn_integral (Y,B,v)
5280              (\y. sup (IMAGE (\n. pos_fn_integral (X,A,u)
5281                                     (\x. fn_seq M f n (cons x y))) UNIV)) =
5282            sup (IMAGE (\n. pos_fn_integral (Y,B,v)
5283                              (\y. pos_fn_integral (X,A,u)
5284                                     (\x. fn_seq M f n (cons x y)))) UNIV)’
5285      >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
5286          CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos \\
5287                       simp [lemma_fn_seq_positive]) \\
5288          RW_TAC std_ss [ext_mono_increasing_def] \\
5289          MATCH_MP_TAC pos_fn_integral_mono >> simp [lemma_fn_seq_positive] \\
5290          rename1 ‘i <= j’ \\
5291          rpt STRIP_TAC \\
5292          irule (SIMP_RULE std_ss [ext_mono_increasing_def]
5293                                  lemma_fn_seq_mono_increasing) >> art [] \\
5294          FIRST_X_ASSUM MATCH_MP_TAC >> rw []) >> Rewr' \\
5295      Suff ‘!n. pos_fn_integral (Y,B,v)
5296                  (\y. pos_fn_integral (X,A,u) (\x. fn_seq M f n (cons x y))) =
5297                pos_fn_integral M (fn_seq M f n)’ >- rw [] \\
5298   (* NOTE: ‘sup’ disappeared now *)
5299      Q.X_GEN_TAC ‘n’ >> ASM_SIMP_TAC std_ss [fn_seq_def] \\
5300   (* RHS simplification *)
5301      Know ‘pos_fn_integral M
5302              (\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5303                         (count (4 ** n)) +
5304                   2 pow n * indicator_fn (t n) z) =
5305            pos_fn_integral M
5306              (\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5307                         (count (4 ** n))) +
5308            pos_fn_integral M (\z. 2 pow n * indicator_fn (t n) z)’
5309      >- (HO_MATCH_MP_TAC pos_fn_integral_add >> simp [] \\
5310          CONJ_TAC >- (rpt STRIP_TAC \\
5311                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw [] \\
5312                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5313          CONJ_TAC >- (rpt STRIP_TAC \\
5314                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5315         ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
5316          general_sigma cons (X,A) (Y,B)’
5317            by METIS_TAC [SPACE] >> POP_ORW \\
5318          reverse CONJ_TAC
5319          >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5320                by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5321              ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5322              MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) \\
5323          MATCH_MP_TAC ((INST_TYPE [alpha |-> gamma] o
5324                         INST_TYPE [beta |-> “:num”]) IN_MEASURABLE_BOREL_SUM) \\
5325          simp [] \\
5326          qexistsl_tac [‘\k z. &k / 2 pow n * indicator_fn (s n k) z’,
5327                        ‘count (4 ** n)’] >> simp [] \\
5328          reverse CONJ_TAC >- (qx_genl_tac [‘i’, ‘z’] >> STRIP_TAC \\
5329                               MATCH_MP_TAC pos_not_neginf \\
5330                               MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5331          rpt STRIP_TAC \\
5332         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5333          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) >> Rewr' \\
5334   (* LHS simplification *)
5335      Know ‘pos_fn_integral (Y,B,v)
5336              (\y. pos_fn_integral (X,A,u)
5337                     (\x. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5338                                (count (4 ** n)) +
5339                          2 pow n * indicator_fn (t n) (cons x y))) =
5340            pos_fn_integral (Y,B,v)
5341              (\y. pos_fn_integral (X,A,u)
5342                     (\x. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5343                                (count (4 ** n))) +
5344                   pos_fn_integral (X,A,u)
5345                     (\x. 2 pow n * indicator_fn (t n) (cons x y)))’
5346      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5347          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5348                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5349                       MATCH_MP_TAC le_add \\
5350                       reverse CONJ_TAC
5351                       >- (MATCH_MP_TAC le_mul \\
5352                           rw [INDICATOR_FN_POS, pow_pos_le]) \\
5353                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5354                       REWRITE_TAC [FINITE_COUNT] \\
5355                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5356                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5357          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5358                       MATCH_MP_TAC le_add \\
5359                       reverse CONJ_TAC
5360                       >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5361                           MATCH_MP_TAC le_mul \\
5362                           rw [INDICATOR_FN_POS, pow_pos_le]) \\
5363                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5364                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5365                       REWRITE_TAC [FINITE_COUNT] \\
5366                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5367                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5368          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5369          HO_MATCH_MP_TAC pos_fn_integral_add >> simp [] \\
5370          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5371                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5372                       REWRITE_TAC [FINITE_COUNT] \\
5373                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5374                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5375          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5376                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5377          reverse CONJ_TAC
5378          >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5379                by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5380              ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5381              MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5382              qexistsl_tac [‘\x. indicator_fn (t n) (cons x y)’, ‘r’] >> rw []) \\
5383          MATCH_MP_TAC
5384            (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) >> simp [] \\
5385          qexistsl_tac [‘\k x. &k / 2 pow n * indicator_fn (s n k) (cons x y)’,
5386                        ‘count (4 ** n)’] >> simp [] \\
5387          reverse CONJ_TAC >- (rpt GEN_TAC >> STRIP_TAC \\
5388                               MATCH_MP_TAC pos_not_neginf \\
5389                               MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5390          rpt STRIP_TAC \\
5391         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5392          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5393          qexistsl_tac [‘\x. indicator_fn (s n i) (cons x y)’, ‘r’] >> rw []) \\
5394      Rewr' \\
5395   (* LHS simplification *)
5396      Know ‘pos_fn_integral (Y,B,v)
5397              (\y. pos_fn_integral (X,A,u)
5398                     (\x. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5399                                (count (4 ** n))) +
5400                   pos_fn_integral (X,A,u)
5401                     (\x. 2 pow n * indicator_fn (t n) (cons x y))) =
5402            pos_fn_integral (Y,B,v)
5403              (\y. pos_fn_integral (X,A,u)
5404                     (\x. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5405                                (count (4 ** n)))) +
5406            pos_fn_integral (Y,B,v)
5407              (\y. pos_fn_integral (X,A,u)
5408                     (\x. 2 pow n * indicator_fn (t n) (cons x y)))’
5409      >- (HO_MATCH_MP_TAC pos_fn_integral_add >> simp [] \\
5410          CONJ_TAC >- (rpt STRIP_TAC \\
5411                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5412                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5413                       REWRITE_TAC [FINITE_COUNT] \\
5414                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5415                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5416          CONJ_TAC >- (rpt STRIP_TAC \\
5417                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5418                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5419          reverse CONJ_TAC
5420          >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5421                by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5422              ‘?r. 0 <= r /\ (2 pow n = Normal r)’
5423                by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
5424                              extreal_of_num_def, le_02] >> POP_ORW \\
5425              MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5426                                         (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5427              BETA_TAC \\
5428              Q.EXISTS_TAC ‘\y. Normal r *
5429                                pos_fn_integral (X,A,u)
5430                                  (\x. indicator_fn (t n) (cons x y))’ \\
5431              reverse CONJ_TAC
5432              >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5433                  qexistsl_tac [‘\y. pos_fn_integral (X,A,u)
5434                                      (\x. indicator_fn (t n) (cons x y))’,
5435                                ‘r’] >> rw []) \\
5436              Q.X_GEN_TAC ‘y’ >> RW_TAC std_ss [] \\
5437              HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
5438          MATCH_MP_TAC ((INST_TYPE [alpha |-> beta] o
5439                         INST_TYPE [beta |-> “:num”]) IN_MEASURABLE_BOREL_SUM) \\
5440          ASM_SIMP_TAC std_ss [space_def] \\
5441          qexistsl_tac [‘\k y. pos_fn_integral (X,A,u)
5442                                 (\x. &k / 2 pow n *
5443                                      indicator_fn (s n k) (cons x y))’,
5444                        ‘count (4 ** n)’] >> simp [] \\
5445          CONJ_TAC
5446          >- (rpt STRIP_TAC \\
5447             ‘?r. 0 <= r /\ &i / 2 pow n = Normal r’
5448                by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
5449              POP_ORW \\
5450              MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5451                                         (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5452              BETA_TAC \\
5453              Q.EXISTS_TAC ‘\y. Normal r *
5454                                pos_fn_integral (X,A,u)
5455                                  (\x. indicator_fn (s n i) (cons x y))’ \\
5456              simp [] \\
5457              reverse CONJ_TAC
5458              >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5459                  qexistsl_tac [‘\y. pos_fn_integral (X,A,u)
5460                                       (\x. indicator_fn (s n i) (cons x y))’,
5461                                ‘r’] >> rw []) \\
5462              Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5463              HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
5464          CONJ_TAC >- (qx_genl_tac [‘i’, ‘y’] >> STRIP_TAC \\
5465                       MATCH_MP_TAC pos_not_neginf \\
5466                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5467                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5468          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5469          MATCH_MP_TAC ((BETA_RULE o
5470                         (Q.SPECL [‘(X,A,u)’,
5471                                   ‘\k x. &k / 2 pow n *
5472                                          indicator_fn (s n k) (cons x y)’,
5473                                   ‘count (4 ** n)’]) o
5474                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
5475          simp [] \\
5476          CONJ_TAC >- (GEN_TAC >> DISCH_TAC \\
5477                       Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5478                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5479          GEN_TAC >> DISCH_TAC \\
5480         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5481          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
5482          ASM_SIMP_TAC std_ss [space_def] \\
5483          qexistsl_tac [‘\x. indicator_fn (s n i) (cons x y)’, ‘r’] >> rw []) \\
5484      Rewr' \\
5485   (* LHS simplification *)
5486      Know ‘pos_fn_integral (Y,B,v)
5487              (\y. pos_fn_integral (X,A,u)
5488                     (\x. 2 pow n * indicator_fn (t n) (cons x y))) =
5489            pos_fn_integral (Y,B,v)
5490              (\y. 2 pow n * pos_fn_integral (X,A,u)
5491                              (\x. indicator_fn (t n) (cons x y)))’
5492      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5493          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5494                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5495                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5496          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5497                       MATCH_MP_TAC le_mul >> rw [pow_pos_le] \\
5498                       MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) \\
5499          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5500         ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5501             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5502         ‘?r. 0 <= r /\ 2 pow n = Normal r’
5503             by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
5504                           extreal_of_num_def, le_02] >> POP_ORW \\
5505          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5506      Know ‘pos_fn_integral (Y,B,v)
5507              (\y. 2 pow n * pos_fn_integral (X,A,u)
5508                               (\x. indicator_fn (t n) (cons x y))) =
5509            2 pow n * pos_fn_integral (Y,B,v)
5510                        (\y. pos_fn_integral (X,A,u)
5511                               (\x. indicator_fn (t n) (cons x y)))’
5512      >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5513             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5514          ‘?r. 0 <= r /\ 2 pow n = Normal r’
5515             by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
5516                           extreal_of_num_def, le_02] >> POP_ORW \\
5517          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [] \\
5518          MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5519     ‘pos_fn_integral (Y,B,v)
5520        (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (t n) (cons x y))) = m (t n)’
5521        by METIS_TAC [] >> POP_ORW \\
5522      Know ‘pos_fn_integral M (\z. 2 pow n * indicator_fn (t n) z) =
5523            2 pow n * pos_fn_integral M (indicator_fn (t n))’
5524      >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5525             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5526          ‘?r. 0 <= r /\ (2 pow n = Normal r)’
5527             by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
5528                           extreal_of_num_def, le_02] >> POP_ORW \\
5529          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5530     ‘pos_fn_integral M (indicator_fn (t n)) = measure M (t n)’
5531        by METIS_TAC [pos_fn_integral_indicator] >> POP_ORW \\
5532      Know ‘measure M (t n) = m (t n)’
5533      >- simp [Abbr ‘M’, general_prod_measure_space_def] >> Rewr' \\
5534   (* stage work *)
5535      Suff ‘pos_fn_integral (Y,B,v)
5536              (\y. pos_fn_integral (X,A,u)
5537                     (\x. SIGMA (\k. &k / 2 pow n *
5538                                     indicator_fn (s n k) (cons x y))
5539                                (count (4 ** n)))) =
5540            pos_fn_integral M
5541              (\z. SIGMA (\k. &k / 2 pow n *
5542                              indicator_fn (s n k) z) (count (4 ** n)))’ >- Rewr \\
5543   (* RHS simplification *)
5544      Know ‘pos_fn_integral M
5545              (\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5546                         (count (4 ** n))) =
5547            SIGMA (\k. pos_fn_integral M
5548                         (\z. &k / 2 pow n * indicator_fn (s n k) z))
5549                  (count (4 ** n))’
5550      >- (MATCH_MP_TAC ((BETA_RULE o
5551                         (Q.SPECL [‘M’,
5552                                   ‘\k z. &k / 2 pow n * indicator_fn (s n k) z’,
5553                                   ‘count (4 ** n)’]) o
5554                         (INST_TYPE [alpha |-> gamma]) o
5555                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
5556          simp [] \\
5557          CONJ_TAC >- (rpt STRIP_TAC \\
5558                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5559          rpt STRIP_TAC \\
5560         ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
5561          general_sigma cons (X,A) (Y,B)’ by METIS_TAC [SPACE] >> POP_ORW \\
5562         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5563          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) >> Rewr' \\
5564      Know ‘!k. pos_fn_integral M (\z. &k / 2 pow n * indicator_fn (s n k) z) =
5565                &k / 2 pow n * pos_fn_integral M (indicator_fn (s n k))’
5566      >- (Q.X_GEN_TAC ‘k’ \\
5567         ‘?r. 0 <= r /\ &k / 2 pow n = Normal r’
5568            by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
5569          POP_ORW \\
5570          MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5571     ‘!k. pos_fn_integral M (indicator_fn (s n k)) = measure M (s n k)’
5572        by METIS_TAC [pos_fn_integral_indicator] >> POP_ORW \\
5573      Know ‘!k. measure M (s n k) = m (s n k)’
5574      >- simp [Abbr ‘M’, general_prod_measure_space_def] >> Rewr' \\
5575   (* LHS simplification *)
5576      Know ‘pos_fn_integral (Y,B,v)
5577              (\y. pos_fn_integral (X,A,u)
5578                     (\x. SIGMA (\k. &k / 2 pow n *
5579                                     indicator_fn (s n k) (cons x y))
5580                                (count (4 ** n)))) =
5581            pos_fn_integral (Y,B,v)
5582              (\y. SIGMA (\k. pos_fn_integral (X,A,u)
5583                                (\x. &k / 2 pow n * indicator_fn (s n k) (cons x y)))
5584                         (count (4 ** n)))’
5585      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5586          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5587                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5588                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5589                       REWRITE_TAC [FINITE_COUNT] \\
5590                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5591                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5592          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5593                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5594                       REWRITE_TAC [FINITE_COUNT] \\
5595                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5596                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5597                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5598          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5599          MATCH_MP_TAC ((BETA_RULE o
5600                         (Q.SPECL [‘(X,A,u)’,
5601                                   ‘\k x. &k / 2 pow n *
5602                                          indicator_fn (s n k) (cons x y)’,
5603                                   ‘count (4 ** n)’]) o
5604                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
5605          simp [] \\
5606          CONJ_TAC >- (rpt STRIP_TAC \\
5607                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5608          rpt STRIP_TAC \\
5609         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5610          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5611          qexistsl_tac [‘\x. indicator_fn (s n i) (cons x y)’, ‘r’] >> rw []) \\
5612      Rewr' \\
5613      Know ‘pos_fn_integral (Y,B,v)
5614              (\y. SIGMA (\k. pos_fn_integral (X,A,u)
5615                                (\x. &k / 2 pow n * indicator_fn (s n k) (cons x y)))
5616                         (count (4 ** n))) =
5617            SIGMA (\k. pos_fn_integral (Y,B,v)
5618                         (\y. pos_fn_integral (X,A,u)
5619                                (\x. &k / 2 pow n * indicator_fn (s n k) (cons x y))))
5620                  (count (4 ** n))’
5621      >- (MATCH_MP_TAC ((BETA_RULE o
5622                         (Q.SPECL [‘(Y,B,v)’,
5623                                   ‘\k y. pos_fn_integral (X,A,u)
5624                                            (\x. &k / 2 pow n *
5625                                                 indicator_fn (s n k) (cons x y))’,
5626                                   ‘count (4 ** n)’]) o
5627                         (INST_TYPE [alpha |-> beta]) o
5628                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
5629          simp [] \\
5630          CONJ_TAC >- (GEN_TAC >> DISCH_TAC \\
5631                       Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5632                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5633                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5634          rpt STRIP_TAC \\
5635         ‘?r. 0 <= r /\ &i / 2 pow n = Normal r’
5636            by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
5637          POP_ORW \\
5638          MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5639                                     (Q.SPEC ‘(Y,B,v)’ IN_MEASURABLE_BOREL_EQ)) \\
5640          BETA_TAC \\
5641          Q.EXISTS_TAC ‘\y. Normal r *
5642                            pos_fn_integral (X,A,u)
5643                              (\x. indicator_fn (s n i) (cons x y))’ \\
5644          reverse CONJ_TAC
5645          >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5646              qexistsl_tac [‘\y. pos_fn_integral (X,A,u)
5647                                   (\x. indicator_fn (s n i) (cons x y))’,
5648                            ‘r’] >> rw []) \\
5649          Q.X_GEN_TAC ‘y’ >> RW_TAC std_ss [] \\
5650          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
5651      Rewr' \\
5652      Suff ‘!k. pos_fn_integral (Y,B,v)
5653                  (\y. pos_fn_integral (X,A,u)
5654                         (\x. &k / 2 pow n * indicator_fn (s n k) (cons x y))) =
5655                &k / 2 pow n * m (s n k)’ >- Rewr \\
5656      Q.X_GEN_TAC ‘k’ \\
5657     ‘?r. 0 <= r /\ &k / 2 pow n = Normal r’
5658        by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
5659      POP_ORW \\
5660      Know ‘pos_fn_integral (Y,B,v)
5661              (\y. pos_fn_integral (X,A,u)
5662                     (\x. Normal r * indicator_fn (s n k) (cons x y))) =
5663            pos_fn_integral (Y,B,v)
5664              (\y. Normal r * pos_fn_integral (X,A,u)
5665                                (\x. indicator_fn (s n k) (cons x y)))’
5666      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5667          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5668                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5669                       MATCH_MP_TAC le_mul \\
5670                       rw [INDICATOR_FN_POS, extreal_le_eq, extreal_of_num_def]) \\
5671          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5672                       MATCH_MP_TAC le_mul \\
5673                       CONJ_TAC >- rw [extreal_le_eq, extreal_of_num_def] \\
5674                       MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) \\
5675          Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5676          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5677      Know ‘pos_fn_integral (Y,B,v)
5678              (\y. Normal r * pos_fn_integral (X,A,u)
5679                                (\x. indicator_fn (s n k) (cons x y))) =
5680            Normal r * pos_fn_integral (Y,B,v)
5681                         (\y. pos_fn_integral (X,A,u)
5682                                (\x. indicator_fn (s n k) (cons x y)))’
5683      >- (HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [] \\
5684          MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5685      Suff ‘pos_fn_integral (Y,B,v)
5686              (\y. pos_fn_integral (X,A,u) (\x. indicator_fn (s n k) (cons x y))) =
5687            m (s n k)’ >- Rewr \\
5688      METIS_TAC [],
5689      (* goal 6 (of 6), symmetric with goal 5 *)
5690      Know ‘pos_fn_integral M f =
5691            pos_fn_integral M (\x. sup (IMAGE (\n. fn_seq M f n x) UNIV))’
5692      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp []) >> Rewr' \\
5693      Know ‘pos_fn_integral M (\x. sup (IMAGE (\n. fn_seq M f n x) UNIV)) =
5694            sup (IMAGE (\n. pos_fn_integral M (fn_seq M f n)) UNIV)’
5695      >- (MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
5696          REWRITE_TAC [CONJ_ASSOC] (* easier goals first *) \\
5697          reverse CONJ_TAC (* mono_increasing *)
5698          >- (rpt STRIP_TAC >> MATCH_MP_TAC lemma_fn_seq_mono_increasing \\
5699              FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
5700          reverse CONJ_TAC (* positive *)
5701          >- (rpt STRIP_TAC >> MATCH_MP_TAC lemma_fn_seq_positive \\
5702              FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
5703          Q.X_GEN_TAC ‘n’ \\
5704          RW_TAC std_ss [fn_seq_def] \\
5705         ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
5706          general_sigma cons (X,A) (Y,B)’ by METIS_TAC [SPACE] >> POP_ORW \\
5707          MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD \\
5708          ASM_SIMP_TAC std_ss [space_def] \\
5709          qexistsl_tac [‘\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5710                                   (count (4 ** n))’,
5711                        ‘\z. 2 pow n * indicator_fn (t n) z’] \\
5712          ASM_SIMP_TAC std_ss [CONJ_ASSOC] \\
5713          reverse CONJ_TAC (* nonnegative *)
5714          >- (Q.X_GEN_TAC ‘z’ >> DISCH_TAC >> DISJ1_TAC \\
5715              CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 2 subgoals *)
5716              [ (* goal 5.1 (of 2) *)
5717                MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw [] \\
5718                MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS],
5719                (* goal 5.2 (of 2) *)
5720                MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le] ]) \\
5721          CONJ_TAC (* Borel_measurable #1 *)
5722          >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
5723              ASM_SIMP_TAC std_ss [space_def] \\
5724              qexistsl_tac [‘\k z. &k / 2 pow n * indicator_fn (s n k) z’,
5725                            ‘count (4 ** n)’] >> simp [] \\
5726              reverse CONJ_TAC
5727              >- (qx_genl_tac [‘i’, ‘z’] >> STRIP_TAC \\
5728                  MATCH_MP_TAC pos_not_neginf \\
5729                  MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5730              rpt STRIP_TAC \\
5731             ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5732              MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) \\
5733         ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5734             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5735         ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5736          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) >> Rewr' \\
5737      Know ‘pos_fn_integral (X,A,u)
5738              (\x. pos_fn_integral (Y,B,v) (\y. f (cons x y))) =
5739            pos_fn_integral (X,A,u)
5740              (\x. pos_fn_integral (Y,B,v)
5741                     (\y. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV)))’
5742      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5743          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5744                       MATCH_MP_TAC pos_fn_integral_pos >> rw []) \\
5745          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5746                       MATCH_MP_TAC pos_fn_integral_pos >> rw []) \\
5747          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5748          MATCH_MP_TAC pos_fn_integral_cong >> simp []) >> Rewr' \\
5749      Know ‘pos_fn_integral (X,A,u)
5750              (\x. pos_fn_integral (Y,B,v)
5751                     (\y. sup (IMAGE (\n. fn_seq M f n (cons x y)) UNIV))) =
5752            pos_fn_integral (X,A,u)
5753              (\x. sup (IMAGE (\n. pos_fn_integral (Y,B,v)
5754                                     (\y. fn_seq M f n (cons x y))) UNIV))’
5755      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5756          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5757                       MATCH_MP_TAC pos_fn_integral_pos >> rw []) \\
5758          CONJ_TAC
5759          >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5760              rw [le_sup'] \\
5761              Q_TAC (TRANS_TAC le_trans)
5762                    ‘pos_fn_integral (Y,B,v) (\y. fn_seq M f 0 (cons x y))’ \\
5763              CONJ_TAC >- (MATCH_MP_TAC pos_fn_integral_pos \\
5764                           rw [lemma_fn_seq_positive]) \\
5765              POP_ASSUM MATCH_MP_TAC >> Q.EXISTS_TAC ‘0’ >> REFL_TAC) \\
5766          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5767          HO_MATCH_MP_TAC lebesgue_monotone_convergence \\
5768          simp [lemma_fn_seq_positive, lemma_fn_seq_mono_increasing]) >> Rewr' \\
5769      Know ‘pos_fn_integral (X,A,u)
5770              (\x. sup (IMAGE (\n. pos_fn_integral (Y,B,v)
5771                                     (\y. fn_seq M f n (cons x y))) UNIV)) =
5772            sup (IMAGE (\n. pos_fn_integral (X,A,u)
5773                              (\x. pos_fn_integral (Y,B,v)
5774                                     (\y. fn_seq M f n (cons x y)))) UNIV)’
5775      >- (HO_MATCH_MP_TAC lebesgue_monotone_convergence >> simp [] \\
5776          CONJ_TAC >- (rpt STRIP_TAC >> MATCH_MP_TAC pos_fn_integral_pos \\
5777                       simp [lemma_fn_seq_positive]) \\
5778          RW_TAC std_ss [ext_mono_increasing_def] \\
5779          MATCH_MP_TAC pos_fn_integral_mono >> simp [lemma_fn_seq_positive] \\
5780          rpt STRIP_TAC \\
5781          irule (SIMP_RULE std_ss [ext_mono_increasing_def]
5782                                  lemma_fn_seq_mono_increasing) >> art [] \\
5783          FIRST_X_ASSUM MATCH_MP_TAC >> rw []) >> Rewr' \\
5784      Suff ‘!n. pos_fn_integral (X,A,u)
5785                  (\x. pos_fn_integral (Y,B,v) (\y. fn_seq M f n (cons x y))) =
5786                pos_fn_integral M (fn_seq M f n)’ >- rw [] \\
5787   (* NOTE: ‘sup’ disappeared now *)
5788      Q.X_GEN_TAC ‘n’ \\
5789      ASM_SIMP_TAC std_ss [fn_seq_def] \\
5790   (* RHS simplification *)
5791      Know ‘pos_fn_integral M
5792              (\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5793                         (count (4 ** n)) +
5794                   2 pow n * indicator_fn (t n) z) =
5795            pos_fn_integral M
5796              (\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
5797                         (count (4 ** n))) +
5798            pos_fn_integral M (\z. 2 pow n * indicator_fn (t n) z)’
5799      >- (HO_MATCH_MP_TAC pos_fn_integral_add >> simp [] \\
5800          CONJ_TAC >- (rpt STRIP_TAC \\
5801                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw [] \\
5802                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5803          CONJ_TAC >- (rpt STRIP_TAC \\
5804                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5805         ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
5806          general_sigma cons (X,A) (Y,B)’ by METIS_TAC [SPACE] >> POP_ORW \\
5807          reverse CONJ_TAC
5808          >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5809                by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5810              ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5811              MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) \\
5812          MATCH_MP_TAC ((INST_TYPE [alpha |-> gamma] o
5813                         INST_TYPE [beta |-> “:num”]) IN_MEASURABLE_BOREL_SUM) \\
5814          simp [] \\
5815          qexistsl_tac [‘\k z. &k / 2 pow n * indicator_fn (s n k) z’,
5816                        ‘count (4 ** n)’] >> simp [] \\
5817          reverse CONJ_TAC >- (qx_genl_tac [‘i’, ‘z’] >> STRIP_TAC \\
5818                               MATCH_MP_TAC pos_not_neginf \\
5819                               MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5820          rpt STRIP_TAC \\
5821         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5822          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) >> Rewr' \\
5823   (* LHS simplification *)
5824      Know ‘pos_fn_integral (X,A,u)
5825              (\x. pos_fn_integral (Y,B,v)
5826                     (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5827                                (count (4 ** n)) +
5828                          2 pow n * indicator_fn (t n) (cons x y))) =
5829            pos_fn_integral (X,A,u)
5830              (\x. pos_fn_integral (Y,B,v)
5831                     (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5832                                (count (4 ** n))) +
5833                   pos_fn_integral (Y,B,v)
5834                     (\y. 2 pow n * indicator_fn (t n) (cons x y)))’
5835      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5836          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5837                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5838                       MATCH_MP_TAC le_add \\
5839                       reverse CONJ_TAC
5840                       >- (MATCH_MP_TAC le_mul \\
5841                           rw [INDICATOR_FN_POS, pow_pos_le]) \\
5842                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5843                       REWRITE_TAC [FINITE_COUNT] \\
5844                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5845                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5846          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5847                       MATCH_MP_TAC le_add \\
5848                       reverse CONJ_TAC
5849                       >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5850                           MATCH_MP_TAC le_mul \\
5851                           rw [INDICATOR_FN_POS, pow_pos_le]) \\
5852                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5853                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5854                       REWRITE_TAC [FINITE_COUNT] \\
5855                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5856                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5857          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5858          HO_MATCH_MP_TAC pos_fn_integral_add >> simp [] \\
5859          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5860                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5861                       REWRITE_TAC [FINITE_COUNT] \\
5862                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5863                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5864          CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5865                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5866          reverse CONJ_TAC
5867          >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5868                by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5869              ‘?r. 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5870              MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5871              qexistsl_tac [‘\y. indicator_fn (t n) (cons x y)’, ‘r’] >> rw []) \\
5872          MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
5873          simp [] \\
5874          qexistsl_tac [‘\k y. &k / 2 pow n * indicator_fn (s n k) (cons x y)’,
5875                        ‘count (4 ** n)’] >> simp [] \\
5876          reverse CONJ_TAC >- (rpt GEN_TAC >> STRIP_TAC \\
5877                               MATCH_MP_TAC pos_not_neginf \\
5878                               MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5879          rpt STRIP_TAC \\
5880         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5881          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5882          qexistsl_tac [‘\y. indicator_fn (s n i) (cons x y)’, ‘r’] >> rw []) \\
5883      Rewr' \\
5884   (* LHS simplification *)
5885      Know ‘pos_fn_integral (X,A,u)
5886              (\x. pos_fn_integral (Y,B,v)
5887                     (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5888                                (count (4 ** n))) +
5889                   pos_fn_integral (Y,B,v)
5890                     (\y. 2 pow n * indicator_fn (t n) (cons x y))) =
5891            pos_fn_integral (X,A,u)
5892              (\x. pos_fn_integral (Y,B,v)
5893                     (\y. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) (cons x y))
5894                                (count (4 ** n)))) +
5895            pos_fn_integral (X,A,u)
5896              (\x. pos_fn_integral (Y,B,v)
5897                     (\y. 2 pow n * indicator_fn (t n) (cons x y)))’
5898      >- (HO_MATCH_MP_TAC pos_fn_integral_add >> simp [] \\
5899          CONJ_TAC >- (rpt STRIP_TAC \\
5900                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5901                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
5902                       REWRITE_TAC [FINITE_COUNT] \\
5903                       Q.X_GEN_TAC ‘i’ >> rw [] \\
5904                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5905          CONJ_TAC >- (rpt STRIP_TAC \\
5906                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5907                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5908          reverse CONJ_TAC
5909          >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5910                by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5911              ‘?r. 0 <= r /\ (2 pow n = Normal r)’
5912                 by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
5913                               extreal_of_num_def, le_02] >> POP_ORW \\
5914              MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5915                                         (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
5916              BETA_TAC \\
5917              Q.EXISTS_TAC ‘\x. Normal r *
5918                                pos_fn_integral (Y,B,v)
5919                                  (\y. indicator_fn (t n) (cons x y))’ \\
5920              reverse CONJ_TAC
5921              >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5922                  qexistsl_tac [‘\x. pos_fn_integral (Y,B,v)
5923                                       (\y. indicator_fn (t n) (cons x y))’,
5924                                ‘r’] >> rw []) \\
5925              Q.X_GEN_TAC ‘x’ >> RW_TAC std_ss [] \\
5926              HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
5927          MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
5928          ASM_SIMP_TAC std_ss [space_def] \\
5929          qexistsl_tac [‘\k x. pos_fn_integral (Y,B,v)
5930                                 (\y. &k / 2 pow n *
5931                                      indicator_fn (s n k) (cons x y))’,
5932                        ‘count (4 ** n)’] >> simp [] \\
5933          CONJ_TAC
5934          >- (rpt STRIP_TAC \\
5935             ‘?r. 0 <= r /\ &i / 2 pow n = Normal r’
5936                by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
5937              POP_ORW \\
5938              MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
5939                                         (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
5940              BETA_TAC \\
5941              Q.EXISTS_TAC ‘\x. Normal r *
5942                                pos_fn_integral (Y,B,v)
5943                                  (\y. indicator_fn (s n i) (cons x y))’ \\
5944              simp [] \\
5945              reverse CONJ_TAC
5946              >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
5947                  qexistsl_tac [‘\x. pos_fn_integral (Y,B,v)
5948                                       (\y. indicator_fn (s n i) (cons x y))’,
5949                                ‘r’] >> rw []) \\
5950              Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5951              HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
5952          CONJ_TAC >- (qx_genl_tac [‘i’, ‘x’] >> STRIP_TAC \\
5953                       MATCH_MP_TAC pos_not_neginf \\
5954                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5955                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5956          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5957          MATCH_MP_TAC ((BETA_RULE o
5958                         (Q.SPECL [‘(Y,B,v)’,
5959                                   ‘\k y. &k / 2 pow n *
5960                                          indicator_fn (s n k) (cons x y)’,
5961                                   ‘count (4 ** n)’]) o
5962                         (INST_TYPE [alpha |-> beta]) o
5963                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
5964          simp [] \\
5965          CONJ_TAC >- (GEN_TAC >> DISCH_TAC \\
5966                       Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
5967                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
5968          GEN_TAC >> DISCH_TAC \\
5969         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
5970          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
5971          ASM_SIMP_TAC std_ss [space_def] \\
5972          qexistsl_tac [‘\y. indicator_fn (s n i) (cons x y)’, ‘r’] >> rw []) \\
5973      Rewr' \\
5974   (* LHS simplification *)
5975      Know ‘pos_fn_integral (X,A,u)
5976              (\x. pos_fn_integral (Y,B,v)
5977                     (\y. 2 pow n * indicator_fn (t n) (cons x y))) =
5978            pos_fn_integral (X,A,u)
5979              (\x. 2 pow n * pos_fn_integral (Y,B,v)
5980                               (\y. indicator_fn (t n) (cons x y)))’
5981      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
5982          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5983                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
5984                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS, pow_pos_le]) \\
5985          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5986                       MATCH_MP_TAC le_mul >> rw [pow_pos_le] \\
5987                       MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) \\
5988          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
5989         ‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
5990             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
5991         ‘?r. 0 <= r /\ (2 pow n = Normal r)’
5992             by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
5993                           extreal_of_num_def, le_02] >> POP_ORW \\
5994          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
5995      Know ‘pos_fn_integral (X,A,u)
5996              (\x. 2 pow n * pos_fn_integral (Y,B,v)
5997                               (\y. indicator_fn (t n) (cons x y))) =
5998            2 pow n * pos_fn_integral (X,A,u)
5999                        (\x. pos_fn_integral (Y,B,v)
6000                               (\y. indicator_fn (t n) (cons x y)))’
6001      >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
6002             by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
6003          ‘?r. 0 <= r /\ (2 pow n = Normal r)’
6004             by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
6005                           extreal_of_num_def, le_02] >> POP_ORW \\
6006          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [] \\
6007          MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) >> Rewr' \\
6008     ‘pos_fn_integral (X,A,u)
6009        (\x. pos_fn_integral (Y,B,v) (\y. indicator_fn (t n) (cons x y))) =
6010      m (t n)’ by METIS_TAC [] >> POP_ORW \\
6011      Know ‘pos_fn_integral M (\z. 2 pow n * indicator_fn (t n) z) =
6012            2 pow n * pos_fn_integral M (indicator_fn (t n))’
6013      >- (‘2 pow n <> PosInf /\ 2 pow n <> NegInf’
6014            by METIS_TAC [pow_not_infty, extreal_of_num_def, extreal_not_infty] \\
6015          ‘?r. 0 <= r /\ (2 pow n = Normal r)’
6016            by METIS_TAC [extreal_cases, pow_pos_le, extreal_le_eq,
6017                          extreal_of_num_def, le_02] >> POP_ORW \\
6018          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
6019     ‘pos_fn_integral M (indicator_fn (t n)) = measure M (t n)’
6020        by METIS_TAC [pos_fn_integral_indicator] >> POP_ORW \\
6021      Know ‘measure M (t n) = m (t n)’
6022      >- simp [Abbr ‘M’, general_prod_measure_space_def] >> Rewr' \\
6023   (* stage work *)
6024      Suff ‘pos_fn_integral (X,A,u)
6025              (\x. pos_fn_integral (Y,B,v)
6026                     (\y. SIGMA (\k. &k / 2 pow n *
6027                                     indicator_fn (s n k) (cons x y))
6028                                (count (4 ** n)))) =
6029            pos_fn_integral M
6030              (\z. SIGMA (\k. &k / 2 pow n *
6031                              indicator_fn (s n k) z) (count (4 ** n)))’ >- Rewr \\
6032   (* RHS simplification *)
6033      Know ‘pos_fn_integral M
6034              (\z. SIGMA (\k. &k / 2 pow n * indicator_fn (s n k) z)
6035                         (count (4 ** n))) =
6036            SIGMA (\k. pos_fn_integral M
6037                         (\z. &k / 2 pow n * indicator_fn (s n k) z))
6038                  (count (4 ** n))’
6039      >- (MATCH_MP_TAC ((BETA_RULE o
6040                         (Q.SPECL [‘M’,
6041                                   ‘\k z. &k / 2 pow n * indicator_fn (s n k) z’,
6042                                   ‘count (4 ** n)’]) o
6043                         (INST_TYPE [alpha |-> gamma]) o
6044                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
6045          simp [] \\
6046          CONJ_TAC >- (rpt STRIP_TAC \\
6047                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
6048          rpt STRIP_TAC \\
6049         ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
6050          general_sigma cons (X,A) (Y,B)’ by METIS_TAC [SPACE] >> POP_ORW \\
6051         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
6052          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR >> rw []) >> Rewr' \\
6053      Know ‘!k. pos_fn_integral M
6054                  (\z. &k / 2 pow n * indicator_fn (s n k) z) =
6055                &k / 2 pow n * pos_fn_integral M (indicator_fn (s n k))’
6056      >- (Q.X_GEN_TAC ‘k’ \\
6057         ‘?r. 0 <= r /\ (&k / 2 pow n = Normal r)’
6058            by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
6059          POP_ORW \\
6060          MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
6061     ‘!k. pos_fn_integral M (indicator_fn (s n k)) = measure M (s n k)’
6062        by METIS_TAC [pos_fn_integral_indicator] >> POP_ORW \\
6063      Know ‘!k. measure M (s n k) = m (s n k)’
6064      >- simp [Abbr ‘M’, general_prod_measure_space_def] >> Rewr' \\
6065   (* LHS simplification *)
6066      Know ‘pos_fn_integral (X,A,u)
6067              (\x. pos_fn_integral (Y,B,v)
6068                     (\y. SIGMA (\k. &k / 2 pow n *
6069                                     indicator_fn (s n k) (cons x y))
6070                                (count (4 ** n)))) =
6071            pos_fn_integral (X,A,u)
6072              (\x. SIGMA (\k. pos_fn_integral (Y,B,v)
6073                                (\y. &k / 2 pow n * indicator_fn (s n k) (cons x y)))
6074                         (count (4 ** n)))’
6075      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
6076          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6077                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
6078                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
6079                       REWRITE_TAC [FINITE_COUNT] \\
6080                       Q.X_GEN_TAC ‘i’ >> rw [] \\
6081                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
6082          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6083                       MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS \\
6084                       REWRITE_TAC [FINITE_COUNT] \\
6085                       Q.X_GEN_TAC ‘i’ >> rw [] \\
6086                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
6087                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
6088          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6089          MATCH_MP_TAC ((BETA_RULE o
6090                         (Q.SPECL [‘(Y,B,v)’,
6091                                   ‘\k y. &k / 2 pow n *
6092                                          indicator_fn (s n k) (cons x y)’,
6093                                   ‘count (4 ** n)’]) o
6094                         (INST_TYPE [alpha |-> beta]) o
6095                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
6096          simp [] \\
6097          CONJ_TAC >- (rpt STRIP_TAC \\
6098                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
6099          rpt STRIP_TAC \\
6100         ‘?r. &i / 2 pow n = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
6101          MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
6102          qexistsl_tac [‘\y. indicator_fn (s n i) (cons x y)’, ‘r’] >> rw []) \\
6103      Rewr' \\
6104      Know ‘pos_fn_integral (X,A,u)
6105              (\x. SIGMA (\k. pos_fn_integral (Y,B,v)
6106                                (\y. &k / 2 pow n * indicator_fn (s n k) (cons x y)))
6107                         (count (4 ** n))) =
6108            SIGMA (\k. pos_fn_integral (X,A,u)
6109                         (\x. pos_fn_integral (Y,B,v)
6110                                (\y. &k / 2 pow n * indicator_fn (s n k) (cons x y))))
6111                  (count (4 ** n))’
6112      >- (MATCH_MP_TAC ((BETA_RULE o
6113                         (Q.SPECL [‘(X,A,u)’,
6114                                   ‘\k x. pos_fn_integral (Y,B,v)
6115                                            (\y. &k / 2 pow n *
6116                                                 indicator_fn (s n k) (cons x y))’,
6117                                   ‘count (4 ** n)’]) o
6118                         (INST_TYPE [beta |-> “:num”])) pos_fn_integral_sum) \\
6119          simp [] \\
6120          CONJ_TAC >- (GEN_TAC >> DISCH_TAC \\
6121                       Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6122                       MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
6123                       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
6124          rpt STRIP_TAC \\
6125         ‘?r. 0 <= r /\ &i / 2 pow n = Normal r’
6126            by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] \\
6127          POP_ORW \\
6128          MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
6129                                     (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
6130          BETA_TAC \\
6131          Q.EXISTS_TAC ‘\x. Normal r *
6132                            pos_fn_integral (Y,B,v)
6133                              (\y. indicator_fn (s n i) (cons x y))’ \\
6134          reverse CONJ_TAC
6135          >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL >> simp [] \\
6136              qexistsl_tac [‘\x. pos_fn_integral (Y,B,v)
6137                                   (\y. indicator_fn (s n i) (cons x y))’,
6138                            ‘r’] >> rw []) \\
6139          Q.X_GEN_TAC ‘x’ >> RW_TAC std_ss [] \\
6140          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) \\
6141      Rewr' \\
6142      Suff ‘!k. pos_fn_integral (X,A,u)
6143                  (\x. pos_fn_integral (Y,B,v)
6144                         (\y. &k / 2 pow n * indicator_fn (s n k) (cons x y))) =
6145                &k / 2 pow n * m (s n k)’ >- Rewr \\
6146      Q.X_GEN_TAC ‘k’ \\
6147     ‘?r. 0 <= r /\ &k / 2 pow n = Normal r’
6148        by METIS_TAC [extreal_cases, extreal_le_eq, extreal_of_num_def] >> POP_ORW \\
6149      Know ‘pos_fn_integral (X,A,u)
6150              (\x. pos_fn_integral (Y,B,v)
6151                     (\y. Normal r * indicator_fn (s n k) (cons x y))) =
6152            pos_fn_integral (X,A,u)
6153              (\x. Normal r * pos_fn_integral (Y,B,v)
6154                                (\y. indicator_fn (s n k) (cons x y)))’
6155      >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
6156          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6157                       MATCH_MP_TAC pos_fn_integral_pos >> simp [] \\
6158                       Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
6159                       MATCH_MP_TAC le_mul \\
6160                       rw [INDICATOR_FN_POS, extreal_le_eq, extreal_of_num_def]) \\
6161          CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6162                       MATCH_MP_TAC le_mul \\
6163                       CONJ_TAC >- rw [extreal_le_eq, extreal_of_num_def] \\
6164                       MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) \\
6165          Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6166          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [INDICATOR_FN_POS]) >> Rewr' \\
6167      Know ‘pos_fn_integral (X,A,u)
6168              (\x. Normal r * pos_fn_integral (Y,B,v)
6169                                (\y. indicator_fn (s n k) (cons x y))) =
6170            Normal r * pos_fn_integral (X,A,u)
6171                         (\x. pos_fn_integral (Y,B,v)
6172                                (\y. indicator_fn (s n k) (cons x y)))’
6173      >- (HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [] \\
6174          MATCH_MP_TAC pos_fn_integral_pos >> rw [INDICATOR_FN_POS]) >> Rewr' \\
6175      Suff ‘pos_fn_integral (X,A,u)
6176              (\x. pos_fn_integral (Y,B,v)
6177                     (\y. indicator_fn (s n k) (cons x y))) = m (s n k)’ >- Rewr \\
6178      METIS_TAC [] ]
6179QED
6180
6181Theorem TONELLI :
6182    !(X :'a set) (Y :'b set) A B u v f.
6183        sigma_finite_measure_space (X,A,u) /\
6184        sigma_finite_measure_space (Y,B,v) /\
6185        f IN measurable ((X,A) CROSS (Y,B)) Borel /\
6186        (!s. s IN X CROSS Y ==> 0 <= f s)
6187       ==>
6188        (!y. y IN Y ==> (\x. f (x,y)) IN measurable (X,A) Borel) /\
6189        (!x. x IN X ==> (\y. f (x,y)) IN measurable (Y,B) Borel) /\
6190        (\x. pos_fn_integral (Y,B,v) (\y. f (x,y))) IN measurable (X,A) Borel /\
6191        (\y. pos_fn_integral (X,A,u) (\x. f (x,y))) IN measurable (Y,B) Borel /\
6192        (pos_fn_integral ((X,A,u) CROSS (Y,B,v)) f =
6193         pos_fn_integral (Y,B,v) (\y. pos_fn_integral (X,A,u) (\x. f (x,y)))) /\
6194        (pos_fn_integral ((X,A,u) CROSS (Y,B,v)) f =
6195         pos_fn_integral (X,A,u) (\x. pos_fn_integral (Y,B,v) (\y. f (x,y))))
6196Proof
6197    rpt GEN_TAC >> STRIP_TAC
6198 >> MP_TAC (Q.SPECL [‘$,’, ‘FST’, ‘SND’, ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘f’]
6199                    (INST_TYPE [gamma |-> “:'a # 'b”] tonelli_general))
6200 >> ASM_SIMP_TAC std_ss [pair_operation_pair, GSYM CROSS_ALT,
6201                         GSYM prod_sigma_alt, GSYM prod_measure_space_alt_general]
6202 >> STRIP_TAC
6203 >> NTAC 2 (POP_ASSUM (REWRITE_TAC o wrap o SYM))
6204QED
6205
6206(* Corollary 14.9 (Fubini's theorem) [1, p.142]
6207
6208   Named after Guido Fubini, an Italian mathematician [6].
6209 *)
6210Theorem fubini_general :
6211    !(cons :'a -> 'b -> 'c) car cdr X Y A B u v f.
6212        pair_operation cons car cdr /\
6213        sigma_finite_measure_space (X,A,u) /\
6214        sigma_finite_measure_space (Y,B,v) /\
6215        f IN measurable (general_sigma cons (X,A) (Y,B)) Borel /\
6216       (pos_fn_integral (general_prod_measure_space cons (X,A,u) (Y,B,v))
6217                        (abs o f) <> PosInf \/
6218        pos_fn_integral (Y,B,v)
6219          (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y))) <> PosInf \/
6220        pos_fn_integral (X,A,u)
6221          (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y))) <> PosInf)
6222       ==>
6223        pos_fn_integral (general_prod_measure_space cons (X,A,u) (Y,B,v))
6224                        (abs o f) <> PosInf /\
6225        pos_fn_integral (Y,B,v)
6226          (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y))) <> PosInf /\
6227        pos_fn_integral (X,A,u)
6228          (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y))) <> PosInf /\
6229        integrable (general_prod_measure_space cons (X,A,u) (Y,B,v)) f /\
6230       (AE y::(Y,B,v). integrable (X,A,u) (\x. f (cons x y))) /\
6231       (AE x::(X,A,u). integrable (Y,B,v) (\y. f (cons x y))) /\
6232        integrable (X,A,u) (\x. integral (Y,B,v) (\y. f (cons x y))) /\
6233        integrable (Y,B,v) (\y. integral (X,A,u) (\x. f (cons x y))) /\
6234       (integral (general_prod_measure_space cons (X,A,u) (Y,B,v)) f =
6235        integral (Y,B,v) (\y. integral (X,A,u) (\x. f (cons x y)))) /\
6236       (integral (general_prod_measure_space cons (X,A,u) (Y,B,v)) f =
6237        integral (X,A,u) (\x. integral (Y,B,v) (\y. f (cons x y))))
6238Proof
6239    rpt GEN_TAC
6240 (* prevent from separating ‘P \/ Q \/ R’ *)
6241 >> ONCE_REWRITE_TAC [DECIDE “(X /\ A /\ B /\ C /\ D ==> E) <=>
6242                              (X ==> A ==> B ==> C ==> D ==> E)”]
6243 >> rpt DISCH_TAC
6244 >> qabbrev_tac ‘M = general_prod_measure_space cons (X,A,u) (Y,B,v)’
6245>> Know ‘measure_space M’
6246 >- (qunabbrev_tac ‘M’ \\
6247     MATCH_MP_TAC measure_space_general_prod_measure \\
6248     qexistsl_tac [‘car’, ‘cdr’] >> art [])
6249 >> DISCH_TAC
6250 >> Know ‘sigma_algebra (general_sigma cons (X,A) (Y,B))’
6251 >- (MATCH_MP_TAC sigma_algebra_general_sigma \\
6252     fs [sigma_algebra_def, algebra_def, sigma_finite_measure_space_def,
6253         measure_space_def])
6254 >> DISCH_TAC
6255 >> ‘(abs o f) IN Borel_measurable (general_sigma cons (X,A) (Y,B))’
6256      by (MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS' >> art [])
6257 >> ‘!s. s IN general_cross cons X Y ==> 0 <= (abs o f) s’ by rw [o_DEF, abs_pos]
6258 (* applying TONELLI on ‘abs o f’ *)
6259 >> Know ‘(!y. y IN Y ==> (\x. (abs o f) (cons x y)) IN Borel_measurable (X,A)) /\
6260          (!x. x IN X ==> (\y. (abs o f) (cons x y)) IN Borel_measurable (Y,B)) /\
6261          (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))
6262            IN Borel_measurable (X,A) /\
6263          (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))
6264            IN Borel_measurable (Y,B) /\
6265          pos_fn_integral M (abs o f) =
6266          pos_fn_integral (Y,B,v)
6267            (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y))) /\
6268          pos_fn_integral M (abs o f) =
6269          pos_fn_integral (X,A,u)
6270            (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’
6271 >- (MP_TAC (Q.SPECL [‘cons’, ‘car’, ‘cdr’,
6272                      ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘abs o f’] tonelli_general) \\
6273     simp [] >> PROVE_TAC [])
6274 >> STRIP_TAC
6275 >> Q.PAT_X_ASSUM ‘!s. s IN general_cross cons X Y ==> 0 <= (abs o f) s’ K_TAC
6276 (* group the first subgoals together *)
6277 >> NTAC 2 (ONCE_REWRITE_TAC [CONJ_ASSOC])
6278 >> STRONG_CONJ_TAC >- METIS_TAC []
6279 (* replace one of three finite integrals by all finite integrals *)
6280 >> Q.PAT_X_ASSUM ‘P \/ Q \/ R’ K_TAC
6281 >> STRIP_TAC (* P /\ Q /\ R *)
6282 >> Know ‘space (general_sigma cons (X,A) (Y,B)) = general_cross cons X Y’
6283 >- simp [general_sigma_def, SPACE_SIGMA]
6284 >> DISCH_TAC
6285 >> ‘m_space M = general_cross cons X Y’
6286      by simp [Abbr ‘M’, general_prod_measure_space]
6287 >> ‘measurable_sets M = subsets (general_sigma cons (X,A) (Y,B))’
6288      by simp [Abbr ‘M’, general_prod_measure_space]
6289 >> ‘(general_cross cons X Y,subsets (general_sigma cons (X,A) (Y,B))) =
6290     general_sigma cons (X,A) (Y,B)’
6291       by METIS_TAC [SPACE]
6292 (* integrable ((X,A,u) CROSS (Y,B,v)) f *)
6293 >> STRONG_CONJ_TAC
6294 >- (MATCH_MP_TAC integrable_from_abs >> simp [integrable_def] \\
6295     ASM_SIMP_TAC bool_ss [FN_PLUS_ABS_SELF, FN_MINUS_ABS_ZERO,
6296                           pos_fn_integral_zero] \\
6297     rw [] (* 0 <> PosInf *))
6298 >> DISCH_TAC
6299 (* applying TONELLI again on both f^+ and f^- *)
6300 >> ‘(fn_plus f) IN Borel_measurable (general_sigma cons (X,A) (Y,B))’
6301      by PROVE_TAC [IN_MEASURABLE_BOREL_FN_PLUS]
6302 >> ‘!s. s IN general_cross cons X Y ==> 0 <= (fn_plus f) s’ by rw [FN_PLUS_POS]
6303 >> Know ‘(!y. y IN Y ==> (\x. (fn_plus f) (cons x y)) IN Borel_measurable (X,A)) /\
6304          (!x. x IN X ==> (\y. (fn_plus f) (cons x y)) IN Borel_measurable (Y,B)) /\
6305          (\x. pos_fn_integral (Y,B,v) (\y. (fn_plus f) (cons x y)))
6306             IN Borel_measurable (X,A) /\
6307          (\y. pos_fn_integral (X,A,u) (\x. (fn_plus f) (cons x y)))
6308             IN Borel_measurable (Y,B) /\
6309          pos_fn_integral M (fn_plus f) =
6310          pos_fn_integral (Y,B,v)
6311            (\y. pos_fn_integral (X,A,u) (\x. (fn_plus f) (cons x y))) /\
6312          pos_fn_integral M (fn_plus f) =
6313          pos_fn_integral (X,A,u)
6314            (\x. pos_fn_integral (Y,B,v) (\y. (fn_plus f) (cons x y)))’
6315 >- (MP_TAC (Q.SPECL [‘cons’, ‘car’, ‘cdr’,
6316                      ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘fn_plus f’] tonelli_general) \\
6317     simp [] >> PROVE_TAC [])
6318 >> STRIP_TAC
6319 >> Q.PAT_X_ASSUM ‘!s. s IN general_cross cons X Y ==> 0 <= (fn_plus f) s’ K_TAC
6320 >> ‘(fn_minus f) IN Borel_measurable (general_sigma cons (X,A) (Y,B))’
6321      by PROVE_TAC [IN_MEASURABLE_BOREL_FN_MINUS]
6322 >> ‘!s. s IN general_cross cons X Y ==> 0 <= (fn_minus f) s’ by rw [FN_MINUS_POS]
6323 >> Know ‘(!y. y IN Y ==> (\x. (fn_minus f) (cons x y)) IN Borel_measurable (X,A)) /\
6324          (!x. x IN X ==> (\y. (fn_minus f) (cons x y)) IN Borel_measurable (Y,B)) /\
6325          (\x. pos_fn_integral (Y,B,v) (\y. (fn_minus f) (cons x y)))
6326             IN Borel_measurable (X,A) /\
6327          (\y. pos_fn_integral (X,A,u) (\x. (fn_minus f) (cons x y)))
6328             IN Borel_measurable (Y,B) /\
6329          pos_fn_integral M (fn_minus f) =
6330          pos_fn_integral (Y,B,v)
6331            (\y. pos_fn_integral (X,A,u) (\x. (fn_minus f) (cons x y))) /\
6332          pos_fn_integral M (fn_minus f) =
6333          pos_fn_integral (X,A,u)
6334            (\x. pos_fn_integral (Y,B,v) (\y. (fn_minus f) (cons x y)))’
6335 >- (MP_TAC (Q.SPECL [‘cons’, ‘car’, ‘cdr’,
6336                      ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘fn_minus f’] tonelli_general) \\
6337     simp [] >> PROVE_TAC [])
6338 >> STRIP_TAC
6339 >> Q.PAT_X_ASSUM ‘!s. s IN general_cross cons X Y ==> 0 <= (fn_minus f) s’ K_TAC
6340 >> Q.PAT_X_ASSUM ‘sigma_finite_measure_space (X,A,u)’
6341      (STRIP_ASSUME_TAC o (REWRITE_RULE [sigma_finite_measure_space_def]))
6342 >> Q.PAT_X_ASSUM ‘sigma_finite_measure_space (Y,B,v)’
6343      (STRIP_ASSUME_TAC o (REWRITE_RULE [sigma_finite_measure_space_def]))
6344 (* some shared properties *)
6345 >> Know ‘pos_fn_integral (Y,B,v)
6346            (\y. pos_fn_integral (X,A,u) (\x. (fn_plus f) (cons x y))) <> PosInf’
6347 >- (REWRITE_TAC [lt_infty] \\
6348     Q_TAC (TRANS_TAC let_trans)
6349           ‘pos_fn_integral (Y,B,v)
6350              (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))’ \\
6351     reverse CONJ_TAC >- PROVE_TAC [lt_infty] \\
6352     Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_plus f) =
6353                    pos_fn_integral (Y,B,v)
6354                      (\y. pos_fn_integral (X,A,u) (\x. (fn_plus f) (cons x y)))’
6355       (ONCE_REWRITE_TAC o wrap o SYM) \\
6356     Q.PAT_X_ASSUM ‘pos_fn_integral M (abs o f) =
6357                    pos_fn_integral (Y,B,v)
6358                      (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))’
6359       (ONCE_REWRITE_TAC o wrap o SYM) \\
6360     MATCH_MP_TAC pos_fn_integral_mono \\
6361     rw [FN_PLUS_POS, FN_PLUS_LE_ABS])
6362 >> DISCH_TAC
6363 >> Know ‘pos_fn_integral (X,A,u)
6364            (\x. pos_fn_integral (Y,B,v) (\y. (fn_plus f) (cons x y))) <> PosInf’
6365 >- (REWRITE_TAC [lt_infty] \\
6366     Q_TAC (TRANS_TAC let_trans)
6367           ‘pos_fn_integral (X,A,u)
6368              (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’ \\
6369     reverse CONJ_TAC >- PROVE_TAC [lt_infty] \\
6370     Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_plus f) =
6371                    pos_fn_integral (X,A,u)
6372                      (\x. pos_fn_integral (Y,B,v) (\y. (fn_plus f) (cons x y)))’
6373       (ONCE_REWRITE_TAC o wrap o SYM) \\
6374     Q.PAT_X_ASSUM ‘pos_fn_integral M (abs o f) =
6375                    pos_fn_integral (X,A,u)
6376                      (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’
6377       (ONCE_REWRITE_TAC o wrap o SYM) \\
6378     MATCH_MP_TAC pos_fn_integral_mono \\
6379     rw [FN_PLUS_POS, FN_PLUS_LE_ABS])
6380 >> DISCH_TAC
6381 >> Know ‘pos_fn_integral (Y,B,v)
6382            (\y. pos_fn_integral (X,A,u) (\x. (fn_minus f) (cons x y))) <> PosInf’
6383 >- (REWRITE_TAC [lt_infty] \\
6384     Q_TAC (TRANS_TAC let_trans)
6385           ‘pos_fn_integral (Y,B,v)
6386              (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))’ \\
6387     reverse CONJ_TAC >- PROVE_TAC [lt_infty] \\
6388     Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_minus f) =
6389                    pos_fn_integral (Y,B,v)
6390                      (\y. pos_fn_integral (X,A,u) (\x. (fn_minus f) (cons x y)))’
6391       (ONCE_REWRITE_TAC o wrap o SYM) \\
6392     Q.PAT_X_ASSUM ‘pos_fn_integral M (abs o f) =
6393                    pos_fn_integral (Y,B,v)
6394                      (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))’
6395       (ONCE_REWRITE_TAC o wrap o SYM) \\
6396     MATCH_MP_TAC pos_fn_integral_mono \\
6397     rw [FN_MINUS_POS, FN_MINUS_LE_ABS])
6398 >> DISCH_TAC
6399 >> Know ‘pos_fn_integral (X,A,u)
6400            (\x. pos_fn_integral (Y,B,v) (\y. (fn_minus f) (cons x y))) <> PosInf’
6401 >- (REWRITE_TAC [lt_infty] \\
6402     Q_TAC (TRANS_TAC let_trans)
6403           ‘pos_fn_integral (X,A,u)
6404              (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’ \\
6405     reverse CONJ_TAC >- PROVE_TAC [lt_infty] \\
6406     Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_minus f) =
6407                    pos_fn_integral (X,A,u)
6408                      (\x. pos_fn_integral (Y,B,v) (\y. (fn_minus f) (cons x y)))’
6409       (ONCE_REWRITE_TAC o wrap o SYM) \\
6410     Q.PAT_X_ASSUM ‘pos_fn_integral M (abs o f) =
6411                    pos_fn_integral (X,A,u)
6412                      (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’
6413       (ONCE_REWRITE_TAC o wrap o SYM) \\
6414     MATCH_MP_TAC pos_fn_integral_mono \\
6415     rw [FN_MINUS_POS, FN_MINUS_LE_ABS])
6416 >> DISCH_TAC
6417 (* clean up useless assumptions *)
6418 >> Q.PAT_X_ASSUM ‘sigma_finite (X,A,u)’ K_TAC
6419 >> Q.PAT_X_ASSUM ‘sigma_finite (Y,B,v)’ K_TAC
6420 (* push ‘fn_plus/fn_minus’ inside *)
6421 >> ‘!y. fn_plus (\x. f (cons x y)) = (\x. (fn_plus f) (cons x y))’
6422      by rw [FUN_EQ_THM, FN_PLUS_ALT]
6423 >> ‘!y. fn_minus (\x. f (cons x y)) = (\x. (fn_minus f) (cons x y))’
6424      by rw [FUN_EQ_THM, FN_MINUS_ALT]
6425 >> ‘!x. fn_plus (\y. f (cons x y)) = (\y. (fn_plus f) (cons x y))’
6426      by rw [FUN_EQ_THM, FN_PLUS_ALT]
6427 >> ‘!x. fn_minus (\y. f (cons x y)) = (\y. (fn_minus f) (cons x y))’
6428      by rw [FUN_EQ_THM, FN_MINUS_ALT]
6429 (* goal: AE y::(Y,B,v). integrable (X,A,u) (\x. f (x,y)) *)
6430 >> STRONG_CONJ_TAC
6431 >- (rw [Once FN_DECOMP, integrable_def] \\
6432  (* applying pos_fn_integral_infty_null *)
6433     Know ‘null_set (Y,B,v)
6434                    {y | y IN m_space (Y,B,v) /\
6435                         ((\y. pos_fn_integral (X,A,u)
6436                                 (\x. (fn_plus f) (cons x y))) y = PosInf)}’
6437     >- (MATCH_MP_TAC pos_fn_integral_infty_null >> simp [] \\
6438         Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
6439         MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_PLUS_POS]) \\
6440     simp [] \\
6441     qmatch_abbrev_tac ‘null_set _ N1 ==> _’ >> DISCH_TAC \\
6442     Know ‘null_set (Y,B,v)
6443                    {y | y IN m_space (Y,B,v) /\
6444                         ((\y. pos_fn_integral (X,A,u)
6445                                 (\x. (fn_minus f) (cons x y))) y = PosInf)}’
6446     >- (MATCH_MP_TAC pos_fn_integral_infty_null >> simp [] \\
6447         Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
6448         MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_MINUS_POS]) \\
6449     simp [] \\
6450     qmatch_abbrev_tac ‘null_set _ N2 ==> _’ >> DISCH_TAC \\
6451     rw [AE_DEF] \\
6452     Q.EXISTS_TAC ‘N1 UNION N2’ \\
6453     CONJ_TAC >- PROVE_TAC [NULL_SET_UNION'] \\
6454     Q.X_GEN_TAC ‘y’ >> rw [] >| (* 3 subgoals *)
6455     [ (* goal 1 (of 3) *)
6456      ‘!x. (fn_plus f) (cons x y) - (fn_minus f) (cons x y) = f (cons x y)’
6457         by METIS_TAC [FN_DECOMP] >> POP_ORW \\
6458      ‘sigma_algebra (X,A)’ by fs [measure_space_def] \\
6459       simp [Once IN_MEASURABLE_BOREL_PLUS_MINUS],
6460       (* goal 2 (of 3) *)
6461       CCONTR_TAC >> fs [Abbr ‘N1’],
6462       (* goal 3 (of 3) *)
6463       CCONTR_TAC >> fs [Abbr ‘N2’] ])
6464 >> DISCH_TAC
6465 (* goal: AE x::(X,A,u). integrable (Y,B,v) (\y. f (x,y)) *)
6466 >> STRONG_CONJ_TAC
6467 >- (rw [Once FN_DECOMP, integrable_def] \\
6468  (* applying pos_fn_integral_infty_null *)
6469     Know ‘null_set (X,A,u)
6470                    {x | x IN m_space (X,A,u) /\
6471                         ((\x. pos_fn_integral (Y,B,v)
6472                                 (\y. (fn_plus f) (cons x y))) x = PosInf)}’
6473     >- (MATCH_MP_TAC pos_fn_integral_infty_null >> simp [] \\
6474         Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6475         MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_PLUS_POS]) \\
6476     simp [] \\
6477     qmatch_abbrev_tac ‘null_set _ N1 ==> _’ >> DISCH_TAC \\
6478     Know ‘null_set (X,A,u)
6479                    {x | x IN m_space (X,A,u) /\
6480                         ((\x. pos_fn_integral (Y,B,v)
6481                                 (\y. (fn_minus f) (cons x y))) x = PosInf)}’
6482     >- (MATCH_MP_TAC pos_fn_integral_infty_null >> simp [] \\
6483         Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6484         MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_MINUS_POS]) \\
6485     simp [] \\
6486     qmatch_abbrev_tac ‘null_set _ N2 ==> _’ >> DISCH_TAC \\
6487     rw [AE_DEF] \\
6488     Q.EXISTS_TAC ‘N1 UNION N2’ \\
6489     CONJ_TAC >- PROVE_TAC [NULL_SET_UNION'] \\
6490     Q.X_GEN_TAC ‘x’ >> rw [] >| (* 3 subgoals *)
6491     [ (* goal 1 (of 3) *)
6492      ‘!y. (fn_plus f) (cons x y) - (fn_minus f) (cons x y) = f (cons x y)’
6493         by METIS_TAC [FN_DECOMP] >> POP_ORW \\
6494      ‘sigma_algebra (Y,B)’ by fs [measure_space_def] \\
6495       simp [Once IN_MEASURABLE_BOREL_PLUS_MINUS],
6496       (* goal 2 (of 3) *)
6497       CCONTR_TAC >> fs [Abbr ‘N1’],
6498       (* goal 3 (of 3) *)
6499       CCONTR_TAC >> fs [Abbr ‘N2’] ])
6500 >> DISCH_TAC
6501 (* goal: integrable (X,A,u) (\x. integral (Y,B,v) (\y. f (x,y))) *)
6502 >> STRONG_CONJ_TAC
6503 >- (rw [integrable_def] >| (* 3 subgoals *)
6504     [ (* goal 1 (of 3) *)
6505       MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
6506                                  (Q.SPEC ‘(X,A,u)’ IN_MEASURABLE_BOREL_EQ)) \\
6507       Q.EXISTS_TAC ‘\x. pos_fn_integral (Y,B,v) (\y. fn_plus f (cons x y)) -
6508                         pos_fn_integral (Y,B,v) (\y. fn_minus f (cons x y))’ \\
6509       BETA_TAC \\
6510       CONJ_TAC >- RW_TAC std_ss [integral_def] \\
6511       MATCH_MP_TAC IN_MEASURABLE_BOREL_SUB' \\
6512       FULL_SIMP_TAC std_ss [measure_space_def, space_def, m_space_def,
6513                             measurable_sets_def] \\
6514       qexistsl_tac [‘\x. pos_fn_integral (Y,B,v) (\y. fn_plus f (cons x y))’,
6515                     ‘\x. pos_fn_integral (Y,B,v) (\y. fn_minus f (cons x y))’] \\
6516       simp [],
6517       (* goal 2 (of 3) *)
6518       REWRITE_TAC [lt_infty] \\
6519       Q_TAC (TRANS_TAC let_trans)
6520             ‘pos_fn_integral (X,A,u)
6521                (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’ \\
6522       reverse CONJ_TAC >- art [GSYM lt_infty] \\
6523       MATCH_MP_TAC pos_fn_integral_mono_AE \\
6524       rw [FN_PLUS_POS]
6525       >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [abs_pos]) \\
6526       Q.PAT_X_ASSUM ‘AE x::(X,A,u). integrable (Y,B,v) (\y. f (cons x y))’
6527         MP_TAC >> rw [AE_DEF] \\
6528       Q.EXISTS_TAC ‘N’ >> rw [] \\
6529       Q_TAC (TRANS_TAC le_trans)
6530             ‘abs ((\x. integral (Y,B,v) (\y. f (cons x y))) x)’ \\
6531       CONJ_TAC >- REWRITE_TAC [FN_PLUS_LE_ABS] >> BETA_TAC \\
6532       MP_TAC (Q.SPECL [‘(Y,B,v)’, ‘(\y. f (cons (x :'a) y))’]
6533                       (INST_TYPE [alpha |-> beta] integral_triangle_ineq')) \\
6534       simp [o_DEF],
6535       (* goal 3 (of 3) *)
6536       REWRITE_TAC [lt_infty] \\
6537       Q_TAC (TRANS_TAC let_trans)
6538             ‘pos_fn_integral (X,A,u)
6539                (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (cons x y)))’ \\
6540       reverse CONJ_TAC >- art [GSYM lt_infty] \\
6541       MATCH_MP_TAC pos_fn_integral_mono_AE >> rw [FN_MINUS_POS]
6542       >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [abs_pos]) \\
6543       Q.PAT_X_ASSUM ‘AE x::(X,A,u). integrable (Y,B,v) (\y. f (cons x y))’
6544         MP_TAC >> rw [AE_DEF] \\
6545       Q.EXISTS_TAC ‘N’ >> rw [] \\
6546       Q_TAC (TRANS_TAC le_trans)
6547             ‘abs ((\x. integral (Y,B,v) (\y. f (cons x y))) x)’ \\
6548       CONJ_TAC >- REWRITE_TAC [FN_MINUS_LE_ABS] >> BETA_TAC \\
6549       MP_TAC (Q.SPECL [‘(Y,B,v)’, ‘(\y. f (cons (x :'a) y))’]
6550                       (INST_TYPE [alpha |-> beta] integral_triangle_ineq')) \\
6551       simp [o_DEF] ])
6552 >> DISCH_TAC
6553 (* goal: integrable (Y,B,v) (\y. integral (X,A,u) (\y. f (x,y))) *)
6554 >> STRONG_CONJ_TAC
6555 >- (rw [integrable_def] >| (* 3 subgoals *)
6556     [ (* goal 1 (of 3) *)
6557       MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
6558                       (ISPEC “(Y,B,v) :'b m_space” IN_MEASURABLE_BOREL_EQ)) \\
6559       Q.EXISTS_TAC ‘\y. pos_fn_integral (X,A,u) (\x. fn_plus f (cons x y)) -
6560                         pos_fn_integral (X,A,u) (\x. fn_minus f (cons x y))’ \\
6561       BETA_TAC \\
6562       CONJ_TAC >- RW_TAC std_ss [integral_def] \\
6563       MATCH_MP_TAC IN_MEASURABLE_BOREL_SUB' \\
6564       FULL_SIMP_TAC std_ss [measure_space_def, space_def, m_space_def,
6565                             measurable_sets_def] \\
6566       qexistsl_tac [‘\y. pos_fn_integral (X,A,u) (\x. fn_plus f (cons x y))’,
6567                     ‘\y. pos_fn_integral (X,A,u) (\x. fn_minus f (cons x y))’] \\
6568       simp [],
6569       (* goal 2 (of 3) *)
6570       REWRITE_TAC [lt_infty] \\
6571       Q_TAC (TRANS_TAC let_trans)
6572             ‘pos_fn_integral (Y,B,v)
6573                (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))’ \\
6574       reverse CONJ_TAC >- art [GSYM lt_infty] \\
6575       MATCH_MP_TAC pos_fn_integral_mono_AE >> rw [FN_PLUS_POS]
6576       >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [abs_pos]) \\
6577       Q.PAT_X_ASSUM ‘AE y::(Y,B,v). integrable (X,A,u) (\x. f (cons x y))’
6578         MP_TAC >> rw [AE_DEF] \\
6579       Q.EXISTS_TAC ‘N’ >> rw [] >> rename1 ‘y IN Y’ \\
6580       Q_TAC (TRANS_TAC le_trans)
6581             ‘abs ((\y. integral (X,A,u) (\x. f (cons x y))) y)’ \\
6582       CONJ_TAC >- REWRITE_TAC [FN_PLUS_LE_ABS] >> BETA_TAC \\
6583       MP_TAC (Q.SPECL [‘(X,A,u)’, ‘(\x. f (cons x (y :'b)))’]
6584                       integral_triangle_ineq') \\
6585       simp [o_DEF],
6586       (* goal 3 (of 3) *)
6587       REWRITE_TAC [lt_infty] \\
6588       Q_TAC (TRANS_TAC let_trans)
6589             ‘pos_fn_integral (Y,B,v)
6590                (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (cons x y)))’ \\
6591       reverse CONJ_TAC >- art [GSYM lt_infty] \\
6592       MATCH_MP_TAC pos_fn_integral_mono_AE >> rw [FN_MINUS_POS]
6593       >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [abs_pos]) \\
6594       Q.PAT_X_ASSUM ‘AE y::(Y,B,v). integrable (X,A,u) (\x. f (cons x y))’
6595         MP_TAC >> rw [AE_DEF] \\
6596       Q.EXISTS_TAC ‘N’ >> rw [] >> rename1 ‘y IN Y’ \\
6597       Q_TAC (TRANS_TAC le_trans)
6598             ‘abs ((\y. integral (X,A,u) (\x. f (cons x y))) y)’ \\
6599       CONJ_TAC >- REWRITE_TAC [FN_MINUS_LE_ABS] >> BETA_TAC \\
6600       MP_TAC (Q.SPECL [‘(X,A,u)’, ‘(\x. f (cons x (y :'b)))’]
6601                       integral_triangle_ineq') \\
6602       simp [o_DEF] ])
6603 >> DISCH_TAC
6604 (* final goals *)
6605 >> CONJ_TAC
6606 >| [ (* goal 1 (of 2) *)
6607      GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [integral_def] \\
6608      Know ‘integral (Y,B,v) (\y. integral (X,A,u) (\x. f (cons x y))) =
6609            integral (Y,B,v)
6610                     (\y. pos_fn_integral (X,A,u) (\x. fn_plus f (cons x y)) -
6611                          pos_fn_integral (X,A,u) (\x. fn_minus f (cons x y)))’
6612      >- (MATCH_MP_TAC integral_cong >> simp [] \\
6613          Q.X_GEN_TAC ‘y’ >> rw [integral_def]) >> Rewr' \\
6614      Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_plus f) =
6615                     pos_fn_integral (Y,B,v)
6616                       (\y. pos_fn_integral (X,A,u) (\x. fn_plus f (cons x y)))’
6617        (ONCE_REWRITE_TAC o wrap) \\
6618      Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_minus f) =
6619                     pos_fn_integral (Y,B,v)
6620                       (\y. pos_fn_integral (X,A,u) (\x. fn_minus f (cons x y)))’
6621        (ONCE_REWRITE_TAC o wrap) \\
6622      SYM_TAC >> MATCH_MP_TAC integral_add_lemma' >> rw [] >| (* 5 subgoals *)
6623      [ (* goal 1.1 (of 5) *)
6624        MATCH_MP_TAC integrable_eq >> simp [] \\
6625        Q.EXISTS_TAC ‘\y. integral (X,A,u) (\x. f (cons x y))’ \\
6626        simp [integral_def],
6627        (* goal 1.2 (of 5) *)
6628        qabbrev_tac ‘g = \y. pos_fn_integral (X,A,u) (\x. fn_plus f (cons x y))’ \\
6629        Know ‘integrable (Y,B,v) g <=>
6630              g IN Borel_measurable (Y,B) /\ pos_fn_integral (Y,B,v) g <> PosInf’
6631        >- (MATCH_MP_TAC
6632              (REWRITE_RULE [m_space_def, measurable_sets_def]
6633                            (Q.SPEC ‘(Y,B,v)’
6634                                    (INST_TYPE [alpha |-> beta] integrable_pos))) \\
6635            rw [Abbr ‘g’] \\
6636            MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_PLUS_POS]) >> Rewr' \\
6637        qunabbrev_tac ‘g’ >> art [],
6638        (* goal 1.3 (of 5) *)
6639        qabbrev_tac ‘g = \y. pos_fn_integral (X,A,u) (\x. fn_minus f (cons x y))’ \\
6640        Know ‘integrable (Y,B,v) g <=>
6641              g IN Borel_measurable (Y,B) /\ pos_fn_integral (Y,B,v) g <> PosInf’
6642        >- (MATCH_MP_TAC
6643              (REWRITE_RULE [m_space_def, measurable_sets_def]
6644                            (Q.SPEC ‘(Y,B,v)’
6645                                    (INST_TYPE [alpha |-> beta] integrable_pos))) \\
6646            rw [Abbr ‘g’] \\
6647            MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_MINUS_POS]) >> Rewr' \\
6648        qunabbrev_tac ‘g’ >> art [],
6649        (* goal 1.4 (of 5) *)
6650        MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_PLUS_POS],
6651        (* goal 1.5 (of 5) *)
6652        MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_MINUS_POS] ],
6653      (* goal 2 (of 2) *)
6654      GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [integral_def] \\
6655      Know ‘integral (X,A,u) (\x. integral (Y,B,v) (\y. f (cons x y))) =
6656            integral (X,A,u)
6657                     (\x. pos_fn_integral (Y,B,v) (\y. fn_plus f (cons x y)) -
6658                          pos_fn_integral (Y,B,v) (\y. fn_minus f (cons x y)))’
6659      >- (MATCH_MP_TAC integral_cong >> simp [] \\
6660          Q.X_GEN_TAC ‘x’ >> rw [integral_def]) >> Rewr' \\
6661      Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_plus f) =
6662                     pos_fn_integral (X,A,u)
6663                       (\x. pos_fn_integral (Y,B,v) (\y. fn_plus f (cons x y)))’
6664        (ONCE_REWRITE_TAC o wrap) \\
6665      Q.PAT_X_ASSUM ‘pos_fn_integral M (fn_minus f) =
6666                     pos_fn_integral (X,A,u)
6667                       (\x. pos_fn_integral (Y,B,v) (\y. fn_minus f (cons x y)))’
6668        (ONCE_REWRITE_TAC o wrap) \\
6669      SYM_TAC >> MATCH_MP_TAC integral_add_lemma' >> rw [] >| (* 5 subgoals *)
6670      [ (* goal 2.1 (of 5) *)
6671        MATCH_MP_TAC integrable_eq >> simp [] \\
6672        Q.EXISTS_TAC ‘\x. integral (Y,B,v) (\y. f (cons x y))’ \\
6673        simp [integral_def],
6674        (* goal 2.2 (of 5) *)
6675        qabbrev_tac ‘g = \x. pos_fn_integral (Y,B,v) (\y. fn_plus f (cons x y))’ \\
6676        Know ‘integrable (X,A,u) g <=>
6677              g IN Borel_measurable (X,A) /\ pos_fn_integral (X,A,u) g <> PosInf’
6678        >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
6679                                       (Q.SPEC ‘(X,A,u)’ integrable_pos)) \\
6680            rw [Abbr ‘g’] \\
6681            MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_PLUS_POS]) >> Rewr' \\
6682        qunabbrev_tac ‘g’ >> art [],
6683        (* goal 2.3 (of 5) *)
6684        qabbrev_tac ‘g = \x. pos_fn_integral (Y,B,v) (\y. fn_minus f (cons x y))’ \\
6685        Know ‘integrable (X,A,u) g <=>
6686              g IN Borel_measurable (X,A) /\ pos_fn_integral (X,A,u) g <> PosInf’
6687        >- (MATCH_MP_TAC (REWRITE_RULE [m_space_def, measurable_sets_def]
6688                                       (Q.SPEC ‘(X,A,u)’ integrable_pos)) \\
6689            rw [Abbr ‘g’] \\
6690            MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_MINUS_POS]) >> Rewr' \\
6691        qunabbrev_tac ‘g’ >> art [],
6692        (* goal 2.4 (of 5) *)
6693        MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_PLUS_POS],
6694        (* goal 2.5 (of 5) *)
6695        MATCH_MP_TAC pos_fn_integral_pos >> rw [FN_MINUS_POS] ] ]
6696QED
6697
6698Theorem FUBINI :
6699    !(X :'a set) (Y :'b set) A B u v f.
6700        sigma_finite_measure_space (X,A,u) /\
6701        sigma_finite_measure_space (Y,B,v) /\
6702        f IN measurable ((X,A) CROSS (Y,B)) Borel /\
6703       (pos_fn_integral ((X,A,u) CROSS (Y,B,v)) (abs o f) <> PosInf \/
6704        pos_fn_integral (Y,B,v)
6705          (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (x,y))) <> PosInf \/
6706        pos_fn_integral (X,A,u)
6707          (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (x,y))) <> PosInf)
6708       ==>
6709        pos_fn_integral ((X,A,u) CROSS (Y,B,v)) (abs o f) <> PosInf /\
6710        pos_fn_integral (Y,B,v)
6711          (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (x,y))) <> PosInf /\
6712        pos_fn_integral (X,A,u)
6713          (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (x,y))) <> PosInf /\
6714        integrable ((X,A,u) CROSS (Y,B,v)) f /\
6715       (AE y::(Y,B,v). integrable (X,A,u) (\x. f (x,y))) /\
6716       (AE x::(X,A,u). integrable (Y,B,v) (\y. f (x,y))) /\
6717        integrable (X,A,u) (\x. integral (Y,B,v) (\y. f (x,y))) /\
6718        integrable (Y,B,v) (\y. integral (X,A,u) (\x. f (x,y))) /\
6719       (integral ((X,A,u) CROSS (Y,B,v)) f =
6720        integral (Y,B,v) (\y. integral (X,A,u) (\x. f (x,y)))) /\
6721       (integral ((X,A,u) CROSS (Y,B,v)) f =
6722        integral (X,A,u) (\x. integral (Y,B,v) (\y. f (x,y))))
6723Proof
6724    rpt GEN_TAC
6725 >> REWRITE_TAC [DECIDE “(A /\ B /\ C /\ D ==> E) <=>
6726                         (A ==> B ==> C ==> D ==> E)”]
6727 >> rpt DISCH_TAC
6728 >> MP_TAC (Q.SPECL [‘$,’, ‘FST’, ‘SND’,
6729                     ‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘f’]
6730                    (INST_TYPE [gamma |-> “:'a # 'b”] fubini_general))
6731 >> ASM_SIMP_TAC bool_ss [pair_operation_pair, GSYM CROSS_ALT,
6732                          GSYM prod_sigma_alt,
6733                          GSYM prod_measure_space_alt_general]
6734 >> DISCH_THEN MATCH_MP_TAC
6735 >> PROVE_TAC []
6736QED
6737
6738(* another form without using ‘pos_fn_integral’ *)
6739Theorem FUBINI' :
6740    !(X :'a set) (Y :'b set) A B u v f.
6741        sigma_finite_measure_space (X,A,u) /\
6742        sigma_finite_measure_space (Y,B,v) /\
6743        f IN measurable ((X,A) CROSS (Y,B)) Borel /\
6744     (* if at least one of the three integrals is finite (P \/ Q \/ R) *)
6745       (integral ((X,A,u) CROSS (Y,B,v)) (abs o f) <> PosInf \/
6746        integral (Y,B,v) (\y. integral (X,A,u) (\x. (abs o f) (x,y))) <> PosInf \/
6747        integral (X,A,u) (\x. integral (Y,B,v) (\y. (abs o f) (x,y))) <> PosInf)
6748       ==>
6749     (* then all three integrals are finite (P /\ Q /\ R) *)
6750        integral ((X,A,u) CROSS (Y,B,v)) (abs o f) <> PosInf /\
6751        integral (Y,B,v) (\y. integral (X,A,u) (\x. (abs o f) (x,y))) <> PosInf /\
6752        integral (X,A,u) (\x. integral (Y,B,v) (\y. (abs o f) (x,y))) <> PosInf /\
6753        integrable ((X,A,u) CROSS (Y,B,v)) f /\
6754       (AE y::(Y,B,v). integrable (X,A,u) (\x. f (x,y))) /\
6755       (AE x::(X,A,u). integrable (Y,B,v) (\y. f (x,y))) /\
6756        integrable (X,A,u) (\x. integral (Y,B,v) (\y. f (x,y))) /\
6757        integrable (Y,B,v) (\y. integral (X,A,u) (\x. f (x,y))) /\
6758       (integral ((X,A,u) CROSS (Y,B,v)) f =
6759        integral (Y,B,v) (\y. integral (X,A,u) (\x. f (x,y)))) /\
6760       (integral ((X,A,u) CROSS (Y,B,v)) f =
6761        integral (X,A,u) (\x. integral (Y,B,v) (\y. f (x,y))))
6762Proof
6763    rpt GEN_TAC
6764 (* prevent from separating ‘P \/ Q \/ R’ *)
6765 >> REWRITE_TAC [DECIDE “(A /\ B /\ C /\ D ==> E) <=>
6766                         (A ==> B ==> C ==> D ==> E)”]
6767 >> rpt DISCH_TAC
6768 >> ASSUME_TAC (Q.SPECL [‘X’, ‘Y’, ‘A’, ‘B’, ‘u’, ‘v’, ‘f’] FUBINI)
6769 >> ‘measure_space ((X,A,u) CROSS (Y,B,v))’
6770      by METIS_TAC [measure_space_prod_measure]
6771 >> ‘measure_space (X,A,u) /\ measure_space (Y,B,v)’
6772      by METIS_TAC [sigma_finite_measure_space_def]
6773 >> Q.PAT_X_ASSUM ‘P \/ Q \/ R’ MP_TAC
6774 >> Know ‘integral ((X,A,u) CROSS (Y,B,v)) (abs o f) = pos_fn_integral
6775                   ((X,A,u) CROSS (Y,B,v)) (abs o f)’
6776 >- (MATCH_MP_TAC integral_pos_fn >> rw [abs_pos])
6777 >> Rewr'
6778 >> Know ‘integral (Y,B,v) (\y. integral (X,A,u) (\x. (abs o f) (x,y))) =
6779          pos_fn_integral (Y,B,v) (\y. integral (X,A,u) (\x. (abs o f) (x,y)))’
6780 >- (MATCH_MP_TAC integral_pos_fn >> rw [] \\
6781     MATCH_MP_TAC integral_pos >> rw [abs_pos])
6782 >> Rewr'
6783 >> Know ‘pos_fn_integral (Y,B,v) (\y. integral (X,A,u) (\x. (abs o f) (x,y))) =
6784          pos_fn_integral (Y,B,v) (\y. pos_fn_integral (X,A,u) (\x. (abs o f) (x,y)))’
6785 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
6786     CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
6787                  MATCH_MP_TAC integral_pos >> rw [abs_pos]) \\
6788     CONJ_TAC >- (Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
6789                  MATCH_MP_TAC pos_fn_integral_pos >> rw [abs_pos]) \\
6790     Q.X_GEN_TAC ‘y’ >> DISCH_TAC \\
6791     MATCH_MP_TAC integral_pos_fn >> rw [abs_pos])
6792 >> Rewr'
6793 >> Know ‘integral (X,A,u) (\x. integral (Y,B,v) (\y. (abs o f) (x,y))) =
6794          pos_fn_integral (X,A,u) (\x. integral (Y,B,v) (\y. (abs o f) (x,y)))’
6795 >- (MATCH_MP_TAC integral_pos_fn >> rw [] \\
6796     MATCH_MP_TAC integral_pos >> rw [abs_pos])
6797 >> Rewr'
6798 >> Know ‘pos_fn_integral (X,A,u) (\x. integral (Y,B,v) (\y. (abs o f) (x,y))) =
6799          pos_fn_integral (X,A,u) (\x. pos_fn_integral (Y,B,v) (\y. (abs o f) (x,y)))’
6800 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
6801     CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6802                  MATCH_MP_TAC integral_pos >> rw [abs_pos]) \\
6803     CONJ_TAC >- (Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6804                  MATCH_MP_TAC pos_fn_integral_pos >> rw [abs_pos]) \\
6805     Q.X_GEN_TAC ‘x’ >> DISCH_TAC \\
6806     MATCH_MP_TAC integral_pos_fn >> rw [abs_pos])
6807 >> Rewr'
6808 >> METIS_TAC []
6809QED
6810
6811(* More compact forms of FUBINI and FUBINI' *)
6812Theorem Fubini =
6813        FUBINI
6814     |> Q.SPECL [‘m_space m1’, ‘m_space m2’,
6815                 ‘measurable_sets m1’, ‘measurable_sets m2’,
6816                 ‘measure m1’, ‘measure m2’]
6817     |> REWRITE_RULE [MEASURE_SPACE_REDUCE]
6818     |> Q.GENL [‘m1’, ‘m2’]
6819
6820Theorem Fubini' =
6821        FUBINI'
6822     |> Q.SPECL [‘m_space m1’, ‘m_space m2’,
6823                 ‘measurable_sets m1’, ‘measurable_sets m2’,
6824                 ‘measure m1’, ‘measure m2’]
6825     |> REWRITE_RULE [MEASURE_SPACE_REDUCE]
6826     |> Q.GENL [‘m1’, ‘m2’]
6827
6828(* This theorem only needs TONELLI *)
6829Theorem IN_MEASURABLE_BOREL_FROM_PROD_SIGMA :
6830    !X Y A B f. sigma_algebra (X,A) /\ sigma_algebra (Y,B) /\
6831                f IN measurable ((X,A) CROSS (Y,B)) Borel ==>
6832               (!y. y IN Y ==> (\x. f (x,y)) IN measurable (X,A) Borel) /\
6833               (!x. x IN X ==> (\y. f (x,y)) IN measurable (Y,B) Borel)
6834Proof
6835    rpt GEN_TAC >> STRIP_TAC
6836 >> ‘sigma_finite_measure_space (X,A,\s. 0) /\
6837     sigma_finite_measure_space (Y,B,\s. 0)’
6838      by METIS_TAC [measure_space_trivial, space_def, subsets_def]
6839 >> Know ‘sigma_algebra ((X,A) CROSS (Y,B))’
6840 >- (MATCH_MP_TAC SIGMA_ALGEBRA_PROD_SIGMA' \\
6841     fs [sigma_algebra_def, algebra_def]) >> DISCH_TAC
6842 >> ‘(fn_plus f) IN measurable ((X,A) CROSS (Y,B)) Borel’
6843      by PROVE_TAC [IN_MEASURABLE_BOREL_FN_PLUS]
6844 >> ‘!s. s IN X CROSS Y ==> 0 <= (fn_plus f) s’ by rw [FN_PLUS_POS]
6845 >> Know ‘(!y. y IN Y ==> (\x. (fn_plus f) (x,y)) IN Borel_measurable (X,A)) /\
6846          (!x. x IN X ==> (\y. (fn_plus f) (x,y)) IN Borel_measurable (Y,B))’
6847 >- (MP_TAC (Q.SPECL [‘X’, ‘Y’, ‘A’, ‘B’, ‘\s. 0’, ‘\s. 0’, ‘fn_plus f’] TONELLI) \\
6848     RW_TAC std_ss []) >> STRIP_TAC
6849 >> ‘(fn_minus f) IN measurable ((X,A) CROSS (Y,B)) Borel’
6850      by PROVE_TAC [IN_MEASURABLE_BOREL_FN_MINUS]
6851 >> ‘!s. s IN X CROSS Y ==> 0 <= (fn_minus f) s’ by rw [FN_MINUS_POS]
6852 >> Know ‘(!y. y IN Y ==> (\x. (fn_minus f) (x,y)) IN Borel_measurable (X,A)) /\
6853          (!x. x IN X ==> (\y. (fn_minus f) (x,y)) IN Borel_measurable (Y,B))’
6854 >- (MP_TAC (Q.SPECL [‘X’, ‘Y’, ‘A’, ‘B’, ‘\s. 0’, ‘\s. 0’, ‘fn_minus f’] TONELLI) \\
6855     RW_TAC std_ss []) >> STRIP_TAC
6856 (* push ‘fn_plus/fn_minus’ inside *)
6857 >> ‘!y. fn_plus (\x. f (x,y)) = (\x. (fn_plus f) (x,y))’
6858      by rw [FUN_EQ_THM, FN_PLUS_ALT]
6859 >> ‘!y. fn_minus (\x. f (x,y)) = (\x. (fn_minus f) (x,y))’
6860      by rw [FUN_EQ_THM, FN_MINUS_ALT]
6861 >> ‘!x. fn_plus (\y. f (x,y)) = (\y. (fn_plus f) (x,y))’
6862      by rw [FUN_EQ_THM, FN_PLUS_ALT]
6863 >> ‘!x. fn_minus (\y. f (x,y)) = (\y. (fn_minus f) (x,y))’
6864      by rw [FUN_EQ_THM, FN_MINUS_ALT]
6865 (* final goals *)
6866 >> CONJ_TAC >> rpt STRIP_TAC
6867 >| [ ASM_SIMP_TAC std_ss
6868        [Once (MATCH_MP IN_MEASURABLE_BOREL_PLUS_MINUS
6869                        (ASSUME “sigma_algebra (X :'a set,A :'a set set)”))],
6870      ASM_SIMP_TAC std_ss
6871        [Once (MATCH_MP IN_MEASURABLE_BOREL_PLUS_MINUS
6872                        (ASSUME “sigma_algebra (Y :'b set,B :'b set set)”))] ]
6873QED
6874
6875(* ------------------------------------------------------------------------- *)
6876(*  Filtration and basic version of martingales (Chapter 23 of [1])          *)
6877(* ------------------------------------------------------------------------- *)
6878
6879(* ‘sub_sigma_algebra’ is a partial-order between sigma-algebra *)
6880Theorem SUB_SIGMA_ALGEBRA_REFL:
6881    !a. sigma_algebra a ==> sub_sigma_algebra a a
6882Proof
6883    RW_TAC std_ss [sub_sigma_algebra_def, SUBSET_REFL]
6884QED
6885
6886Theorem SUB_SIGMA_ALGEBRA_TRANS:
6887    !a b c. sub_sigma_algebra a b /\ sub_sigma_algebra b c ==> sub_sigma_algebra a c
6888Proof
6889    RW_TAC std_ss [sub_sigma_algebra_def]
6890 >> MATCH_MP_TAC SUBSET_TRANS
6891 >> Q.EXISTS_TAC `subsets b` >> art []
6892QED
6893
6894Theorem SUB_SIGMA_ALGEBRA_ANTISYM:
6895    !a b. sub_sigma_algebra a b /\ sub_sigma_algebra b a ==> (a = b)
6896Proof
6897    RW_TAC std_ss [sub_sigma_algebra_def]
6898 >> Q.PAT_X_ASSUM `space b = space a` K_TAC
6899 >> ONCE_REWRITE_TAC [GSYM SPACE]
6900 >> ASM_REWRITE_TAC [CLOSED_PAIR_EQ]
6901 >> MATCH_MP_TAC SUBSET_ANTISYM >> art []
6902QED
6903
6904Theorem SUB_SIGMA_ALGEBRA_ORDER:   Order sub_sigma_algebra
6905Proof
6906    RW_TAC std_ss [Order, antisymmetric_def, transitive_def]
6907 >- (MATCH_MP_TAC SUB_SIGMA_ALGEBRA_ANTISYM >> art [])
6908 >> IMP_RES_TAC SUB_SIGMA_ALGEBRA_TRANS
6909QED
6910
6911(* Another form of measureTheory.MEASURE_SPACE_RESTRICTION *)
6912Theorem SUB_SIGMA_ALGEBRA_MEASURE_SPACE:
6913    !m a. measure_space m /\ sub_sigma_algebra a (m_space m,measurable_sets m) ==>
6914          measure_space (m_space m,subsets a,measure m)
6915Proof
6916    RW_TAC std_ss [sub_sigma_algebra_def, space_def, subsets_def]
6917 >> MATCH_MP_TAC MEASURE_SPACE_RESTRICTION
6918 >> Q.EXISTS_TAC `measurable_sets m`
6919 >> simp [MEASURE_SPACE_REDUCE]
6920 >> METIS_TAC [SPACE]
6921QED
6922
6923Theorem FILTRATION_BOUNDED:
6924    !A a. filtration A a ==> !n. sub_sigma_algebra (a n) A
6925Proof
6926    PROVE_TAC [filtration_def]
6927QED
6928
6929Theorem FILTRATION_MONO:
6930    !A a. filtration A a ==> !i j. i <= j ==> subsets (a i) SUBSET subsets (a j)
6931Proof
6932    PROVE_TAC [filtration_def]
6933QED
6934
6935(* all sigma-algebras in `filtration A` are subset of A *)
6936Theorem FILTRATION_SUBSETS:
6937    !A a. filtration A a ==> !n. subsets (a n) SUBSET (subsets A)
6938Proof
6939    RW_TAC std_ss [filtration_def, sub_sigma_algebra_def]
6940QED
6941
6942Theorem FILTRATION:
6943    !A a. filtration A a <=> (!n. sub_sigma_algebra (a n) A) /\
6944                             (!n. subsets (a n) SUBSET (subsets A)) /\
6945                             (!i j. i <= j ==> subsets (a i) SUBSET subsets (a j))
6946Proof
6947    rpt GEN_TAC >> EQ_TAC
6948 >- (DISCH_TAC >> IMP_RES_TAC FILTRATION_SUBSETS >> fs [filtration_def])
6949 >> RW_TAC std_ss [filtration_def]
6950QED
6951
6952(* all sub measure spaces of a sigma-finite fms are also sigma-finite *)
6953Theorem SIGMA_FINITE_FILTERED_MEASURE_SPACE :
6954    !m a. sigma_finite_filtered_measure_space m a ==>
6955          !n. sigma_finite (m_space m,subsets (a n),measure m)
6956Proof
6957    RW_TAC std_ss [sigma_finite_filtered_measure_space_def,
6958                   filtered_measure_space_def, filtration_def]
6959 >> Know ‘measure_space (m_space m,subsets (a 0),measure m) /\
6960          measure_space (m_space m,subsets (a n),measure m)’
6961 >- (CONJ_TAC \\ (* 2 subgoals, same tactics *)
6962     MATCH_MP_TAC (Q.SPEC ‘m’ SUB_SIGMA_ALGEBRA_MEASURE_SPACE) >> art [])
6963 >> STRIP_TAC
6964 >> POP_ASSUM (simp o wrap o (MATCH_MP SIGMA_FINITE_ALT))
6965 >> POP_ASSUM (fs o wrap o (MATCH_MP SIGMA_FINITE_ALT))
6966 >> Q.EXISTS_TAC ‘f’
6967 >> fs [IN_FUNSET, measurable_sets_def, m_space_def, measure_def]
6968 >> ‘0 <= n’ by rw []
6969 >> METIS_TAC [SUBSET_DEF]
6970QED
6971
6972Theorem sigma_finite_filtered_measure_space_alt =
6973    REWRITE_RULE [filtered_measure_space_def]
6974                 sigma_finite_filtered_measure_space_def
6975
6976Theorem sigma_finite_filtered_measure_space_alt_all :
6977    !m a. sigma_finite_filtered_measure_space m a <=>
6978          measure_space m /\ filtration (m_space m,measurable_sets m) a /\
6979          !n. sigma_finite (m_space m,subsets (a n),measure m)
6980Proof
6981    rpt GEN_TAC
6982 >> reverse EQ_TAC
6983 >- rw [sigma_finite_filtered_measure_space_alt]
6984 >> DISCH_TAC
6985 >> IMP_RES_TAC SIGMA_FINITE_FILTERED_MEASURE_SPACE
6986 >> fs [sigma_finite_filtered_measure_space_alt]
6987QED
6988
6989(* the smallest sigma-algebra generated by all (a n) *)
6990Definition infty_sigma_algebra_def:
6991    infty_sigma_algebra sp a =
6992      sigma sp (BIGUNION (IMAGE (\(i :num). subsets (a i)) UNIV))
6993End
6994
6995Theorem INFTY_SIGMA_ALGEBRA_BOUNDED:
6996    !A a. filtration A a ==>
6997          sub_sigma_algebra (infty_sigma_algebra (space A) a) A
6998Proof
6999    RW_TAC std_ss [sub_sigma_algebra_def, FILTRATION, infty_sigma_algebra_def]
7000 >- (MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\
7001     RW_TAC std_ss [subset_class_def, IN_BIGUNION_IMAGE, IN_UNIV] \\
7002    `x IN subsets A` by PROVE_TAC [SUBSET_DEF] \\
7003     METIS_TAC [sigma_algebra_def, algebra_def, subset_class_def, space_def,
7004                subsets_def])
7005 >- REWRITE_TAC [SPACE_SIGMA]
7006 >> MATCH_MP_TAC SIGMA_SUBSET >> art []
7007 >> RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV]
7008 >> PROVE_TAC [SUBSET_DEF]
7009QED
7010
7011Theorem INFTY_SIGMA_ALGEBRA_MAXIMAL:
7012    !A a. filtration A a ==>
7013          !n. sub_sigma_algebra (a n) (infty_sigma_algebra (space A) a)
7014Proof
7015 (* proof *)
7016    RW_TAC std_ss [sub_sigma_algebra_def, FILTRATION, infty_sigma_algebra_def]
7017 >- (MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA \\
7018     RW_TAC std_ss [subset_class_def, IN_BIGUNION_IMAGE, IN_UNIV] \\
7019    `x IN subsets A` by PROVE_TAC [SUBSET_DEF] \\
7020     METIS_TAC [sigma_algebra_def, algebra_def, subset_class_def, space_def,
7021                subsets_def])
7022 >- REWRITE_TAC [SPACE_SIGMA]
7023 >> MATCH_MP_TAC SUBSET_TRANS
7024 >> Q.EXISTS_TAC `BIGUNION (IMAGE (\i. subsets (a i)) univ(:num))`
7025 >> CONJ_TAC
7026 >- (RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] \\
7027     Q.EXISTS_TAC `n` >> art [])
7028 >> REWRITE_TAC [SIGMA_SUBSET_SUBSETS]
7029QED
7030
7031(* A construction of sigma-filteration from only measurable functions *)
7032Theorem filtration_from_measurable_functions :
7033    !m X A. measure_space m /\
7034           (!n. X n IN Borel_measurable (measurable_space m)) /\
7035           (!n. A n = sigma (m_space m) (\n. Borel) X (count1 n)) ==>
7036            filtration (measurable_space m) A
7037Proof
7038    rw [filtration_def]
7039 >- (rw [sub_sigma_algebra_def, space_sigma_functions]
7040     >- (MATCH_MP_TAC sigma_algebra_sigma_functions \\
7041         rw [IN_FUNSET, SPACE_BOREL]) \\
7042     MATCH_MP_TAC (REWRITE_RULE [space_def, subsets_def]
7043                    (Q.ISPECL [‘measurable_space m’, ‘\n:num. Borel’]
7044                               sigma_functions_subset)) \\
7045     rw [MEASURE_SPACE_SIGMA_ALGEBRA, SIGMA_ALGEBRA_BOREL])
7046 (* stage work *)
7047 >> REWRITE_TAC [Once sigma_functions_def]
7048 >> Q.ABBREV_TAC ‘B = (sigma (m_space m) (\n. Borel) X (count1 j))’
7049 >> ‘m_space m = space B’ by METIS_TAC [space_sigma_functions]
7050 >> POP_ORW
7051 >> MATCH_MP_TAC SIGMA_SUBSET
7052 >> CONJ_ASM1_TAC
7053 >- (Q.UNABBREV_TAC ‘B’ \\
7054     MATCH_MP_TAC sigma_algebra_sigma_functions \\
7055     rw [IN_FUNSET, SPACE_BOREL])
7056 >> rw [SUBSET_DEF, IN_BIGUNION_IMAGE]
7057 >> rename1 ‘k < SUC i’
7058 >> rename1 ‘t IN subsets Borel’
7059 >> ‘k <= i’ by rw []
7060 >> ‘k <= j’ by rw []
7061 (* applying SIGMA_SIMULTANEOUSLY_MEASURABLE *)
7062 >> Suff ‘X k IN measurable B Borel’ >- rw [IN_MEASURABLE]
7063 >> MP_TAC (ISPECL [“m_space m”, “\n:num. Borel”, “X :num->'a->extreal”, “count1 j”]
7064                   SIGMA_SIMULTANEOUSLY_MEASURABLE)
7065 >> rw [SIGMA_ALGEBRA_BOREL, IN_FUNSET, SPACE_BOREL]
7066QED
7067
7068(* ------------------------------------------------------------------------- *)
7069(*  Martingale alternative definitions and properties (Chapter 23 of [1])    *)
7070(* ------------------------------------------------------------------------- *)
7071
7072(* ‘u’ is a martingale if, and only if, it is both a sub- and a super-martingale
7073
7074   This is Example 23.3 (i) [1, p.277]
7075 *)
7076Theorem MARTINGALE_EQ_SUB_SUPER :
7077    !m a u. martingale m a u <=> sub_martingale m a u /\ super_martingale m a u
7078Proof
7079    RW_TAC std_ss [martingale_def, sub_martingale_def, super_martingale_def]
7080 >> EQ_TAC >> RW_TAC std_ss [le_refl]
7081 >> ASM_SIMP_TAC std_ss [GSYM le_antisym]
7082QED
7083
7084(* simple alternative definitions: ‘n < SUC n’ is replaced by ‘i <= j’ *)
7085val martingale_shared_tactics_1 =
7086    reverse EQ_TAC >- RW_TAC arith_ss []
7087 >> RW_TAC arith_ss [sigma_finite_filtered_measure_space_alt]
7088 >> Q.PAT_X_ASSUM ‘i <= j’ MP_TAC
7089 >> Induct_on ‘j - i’
7090 >- (RW_TAC arith_ss [] \\
7091    ‘j = i’ by RW_TAC arith_ss [] >> RW_TAC arith_ss [le_refl])
7092 >> RW_TAC arith_ss []
7093 >> ‘v = PRE j - i’ by RW_TAC arith_ss []
7094 >> ‘i < j /\ i <= PRE j’ by RW_TAC arith_ss []
7095 >> ‘SUC (PRE j) = j’ by RW_TAC arith_ss []
7096 >> ‘s IN subsets (a (PRE j))’ by METIS_TAC [FILTRATION_MONO, SUBSET_DEF]
7097 >> Q.PAT_X_ASSUM ‘!n s. s IN subsets (a n) ==> P’
7098     (MP_TAC o (Q.SPECL [‘PRE j’, ‘s’]))
7099 >> RW_TAC arith_ss [];
7100
7101val martingale_shared_tactics_2 =
7102    MATCH_MP_TAC le_trans
7103 >> Q.EXISTS_TAC ‘integral m (\x. u (PRE j) x * indicator_fn s x)’
7104 >> POP_ASSUM (REWRITE_TAC o wrap)
7105 >> FIRST_X_ASSUM irule
7106 >> RW_TAC arith_ss [];
7107
7108Theorem martingale_alt :
7109   !m a u.
7110      martingale m a u <=>
7111      sigma_finite_filtered_measure_space m a /\ (!n. integrable m (u n)) /\
7112      !i j s. i <= j /\ s IN subsets (a i) ==>
7113             (integral m (\x. u i x * indicator_fn s x) =
7114              integral m (\x. u j x * indicator_fn s x))
7115Proof
7116    RW_TAC std_ss [martingale_def]
7117 >> martingale_shared_tactics_1
7118QED
7119
7120Theorem super_martingale_alt :
7121   !m a u.
7122      super_martingale m a u <=>
7123      sigma_finite_filtered_measure_space m a /\ (!n. integrable m (u n)) /\
7124      !i j s. i <= j /\ s IN subsets (a i) ==>
7125             (integral m (\x. u j x * indicator_fn s x) <=
7126              integral m (\x. u i x * indicator_fn s x))
7127Proof
7128    RW_TAC std_ss [super_martingale_def]
7129 >> martingale_shared_tactics_1
7130 >> martingale_shared_tactics_2
7131QED
7132
7133Theorem sub_martingale_alt :
7134   !m a u.
7135      sub_martingale m a u <=>
7136      sigma_finite_filtered_measure_space m a /\ (!n. integrable m (u n)) /\
7137      !i j s. i <= j /\ s IN subsets (a i) ==>
7138             (integral m (\x. u i x * indicator_fn s x) <=
7139              integral m (\x. u j x * indicator_fn s x))
7140Proof
7141    RW_TAC std_ss [sub_martingale_def]
7142 >> martingale_shared_tactics_1
7143 >> martingale_shared_tactics_2
7144QED
7145
7146(* Remark 23.2 [1, p.276]: we can replace the sigma-algebra (a n) with any
7147   INTER-stable generator (g n) of (a n) containing an exhausive sequence.
7148
7149   NOTE: in typical applications, it's expected to have (g n) such that
7150  ‘!i j. i <= j ==> g i SUBSET g j’ and thus the exhausting sequence of (g 0)
7151   is also the exhausting sequence of all (g n).
7152 *)
7153
7154val martingale_alt_generator_shared_tactics_1 =
7155    qx_genl_tac [‘m’, ‘a’, ‘u’, ‘G’]
7156 >> RW_TAC std_ss [sigma_finite_filtered_measure_space_alt,
7157                   filtered_measure_space_def,
7158                   martingale_alt, sub_martingale_alt, super_martingale_alt]
7159 >> EQ_TAC (* easy part first *)
7160 >- (RW_TAC std_ss [] \\
7161     FIRST_X_ASSUM MATCH_MP_TAC >> rw [] \\
7162     Suff ‘(G i) SUBSET subsets (sigma (m_space m) (G i))’ >- METIS_TAC [SUBSET_DEF] \\
7163     REWRITE_TAC [SIGMA_SUBSET_SUBSETS])
7164 >> rw [sigma_finite_alt_exhausting_sequence, exhausting_sequence_def, IN_FUNSET]
7165 >- (fs [has_exhausting_sequence_def, IN_FUNSET, IN_UNIV] \\
7166     Q.PAT_X_ASSUM ‘!n. ?f. P’ (MP_TAC o (Q.SPEC ‘0’)) \\
7167     RW_TAC std_ss [] \\
7168     Q.EXISTS_TAC ‘f’ >> rw []
7169     >- (Suff ‘(G 0) SUBSET subsets (sigma (m_space m) (G 0))’
7170         >- METIS_TAC [SUBSET_DEF] \\
7171         REWRITE_TAC [SIGMA_SUBSET_SUBSETS]) \\
7172     FIRST_X_ASSUM MATCH_MP_TAC \\
7173     Q.EXISTS_TAC ‘0’ >> art [])
7174 (* stage work *)
7175 >> FULL_SIMP_TAC std_ss [integral_def]
7176 >> Know ‘!n. subsets (a n) SUBSET (measurable_sets m)’
7177 >- (fs [filtration_def, sub_sigma_algebra_def])
7178 >> DISCH_TAC
7179 >> ‘!n s. s IN G n ==> s IN measurable_sets m’
7180      by METIS_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF]
7181 >> Know ‘!n s. (\x. u n x * indicator_fn s x)^+ =
7182                (\x. fn_plus (u n) x * indicator_fn s x)’
7183 >- (rpt GEN_TAC >> ONCE_REWRITE_TAC [mul_comm] \\
7184     MATCH_MP_TAC FN_PLUS_FMUL >> rw [INDICATOR_FN_POS])
7185 >> DISCH_THEN (FULL_SIMP_TAC std_ss o wrap)
7186 >> Know ‘!n s. (\x. u n x * indicator_fn s x)^- =
7187                (\x. fn_minus (u n) x * indicator_fn s x)’
7188 >- (rpt GEN_TAC >> ONCE_REWRITE_TAC [mul_comm] \\
7189     MATCH_MP_TAC FN_MINUS_FMUL >> rw [INDICATOR_FN_POS])
7190 >> DISCH_THEN (FULL_SIMP_TAC std_ss o wrap)
7191 (* simplifications by abbreviations *)
7192 >> Q.ABBREV_TAC ‘A = \n s. pos_fn_integral m (\x. (u n)^+ x * indicator_fn s x)’
7193 >> Q.ABBREV_TAC ‘B = \n s. pos_fn_integral m (\x. (u n)^- x * indicator_fn s x)’
7194 >> FULL_SIMP_TAC std_ss []
7195 >> Know ‘!n s. 0 <= A n s /\ 0 <= B n s’
7196 >- (rw [Abbr ‘A’, Abbr ‘B’] \\
7197     MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
7198     MATCH_MP_TAC le_mul \\
7199     rw [FN_PLUS_POS, FN_MINUS_POS, INDICATOR_FN_POS])
7200 >> DISCH_TAC
7201 >> Know ‘!n s. A n s < PosInf /\ B n s < PosInf’
7202 >- (rw [Abbr ‘A’, Abbr ‘B’] >| (* 2 subgoals *)
7203     [ (* goal 1 (of 2) *)
7204       MATCH_MP_TAC let_trans \\
7205       Q.EXISTS_TAC ‘pos_fn_integral m (fn_plus (u n))’ \\
7206       reverse CONJ_TAC >- (REWRITE_TAC [GSYM lt_infty] \\
7207                            METIS_TAC [integrable_def]) \\
7208       MATCH_MP_TAC pos_fn_integral_mono >> rw []
7209       >- (MATCH_MP_TAC le_mul >> rw [FN_PLUS_POS, INDICATOR_FN_POS]) \\
7210       GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites [GSYM mul_rone] \\
7211       MATCH_MP_TAC le_lmul_imp >> rw [FN_PLUS_POS, INDICATOR_FN_LE_1],
7212       (* goal 2 (of 2) *)
7213       MATCH_MP_TAC let_trans \\
7214       Q.EXISTS_TAC ‘pos_fn_integral m (fn_minus (u n))’ \\
7215       reverse CONJ_TAC >- (REWRITE_TAC [GSYM lt_infty] \\
7216                            METIS_TAC [integrable_def]) \\
7217       MATCH_MP_TAC pos_fn_integral_mono >> rw []
7218       >- (MATCH_MP_TAC le_mul >> rw [FN_MINUS_POS, INDICATOR_FN_POS]) \\
7219       GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites [GSYM mul_rone] \\
7220       MATCH_MP_TAC le_lmul_imp >> rw [FN_MINUS_POS, INDICATOR_FN_LE_1] ])
7221 >> DISCH_TAC;
7222 (* end of martingale_alt_generator_shared_tactics_1 *)
7223
7224val martingale_alt_generator_shared_tactics_2 =
7225    Q.ABBREV_TAC ‘f = \i j x. fn_plus (u i) x + fn_minus (u j) x’
7226 >> Know ‘!i j s. s IN measurable_sets m ==> A i s + B j s = (f i j * m) s’
7227 >- (qx_genl_tac [‘k’, ‘n’, ‘t’] \\
7228     RW_TAC std_ss [Abbr ‘f’, Abbr ‘A’, Abbr ‘B’, density_measure_def] \\
7229     Know ‘pos_fn_integral m (\x. (u k)^+ x * indicator_fn t x) +
7230           pos_fn_integral m (\x. (u n)^- x * indicator_fn t x) =
7231           pos_fn_integral m (\x. (u k)^+ x * indicator_fn t x +
7232                                  (u n)^- x * indicator_fn t x)’
7233     >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
7234         HO_MATCH_MP_TAC pos_fn_integral_add >> rw [] >| (* 4 subgoals *)
7235         [ (* goal 1 (of 4) *)
7236           MATCH_MP_TAC le_mul >> rw [FN_PLUS_POS, INDICATOR_FN_POS],
7237           (* goal 2 (of 4) *)
7238           MATCH_MP_TAC le_mul >> rw [FN_MINUS_POS, INDICATOR_FN_POS],
7239           (* goal 3 (of 4) *)
7240           MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR >> rw [] \\
7241           MATCH_MP_TAC IN_MEASURABLE_BOREL_FN_PLUS \\
7242           FULL_SIMP_TAC std_ss [integrable_def, measure_space_def],
7243           (* goal 4 (of 4) *)
7244           MATCH_MP_TAC IN_MEASURABLE_BOREL_MUL_INDICATOR >> rw [] \\
7245           MATCH_MP_TAC IN_MEASURABLE_BOREL_FN_MINUS \\
7246           FULL_SIMP_TAC std_ss [integrable_def, measure_space_def] ]) >> Rewr' \\
7247     MATCH_MP_TAC pos_fn_integral_cong >> rw [] >| (* 3 subgoals *)
7248     [ (* goal 1 (of 3) *)
7249       MATCH_MP_TAC le_add >> CONJ_TAC >> MATCH_MP_TAC le_mul \\
7250       rw [FN_PLUS_POS, FN_MINUS_POS, INDICATOR_FN_POS],
7251       (* goal 2 (of 3) *)
7252       MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS] \\
7253       MATCH_MP_TAC le_add >> rw [FN_PLUS_POS, FN_MINUS_POS],
7254       (* goal 3 (of 3) *)
7255       rw [indicator_fn_def] ])
7256 >> DISCH_TAC
7257 >> ‘s IN measurable_sets m’ by METIS_TAC [SIGMA_SUBSET_SUBSETS, SUBSET_DEF];
7258 (* end of martingale_alt_generator_shared_tactics_2 *)
7259
7260val martingale_alt_generator_shared_tactics_3 =
7261    Know ‘!i j. measure_space (m_space m,measurable_sets m,f i j * m)’
7262 >- (qx_genl_tac [‘M’, ‘N’] \\
7263     MATCH_MP_TAC (REWRITE_RULE [density_def] measure_space_density) \\
7264     RW_TAC std_ss [Abbr ‘f’] >| (* 2 subgoals *)
7265     [ (* goal 1 (of 2) *)
7266       MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD' \\
7267       qexistsl_tac [‘fn_plus (u M)’, ‘fn_minus (u N)’] >> simp [] \\
7268       FULL_SIMP_TAC std_ss [integrable_def, measure_space_def] \\
7269       PROVE_TAC [IN_MEASURABLE_BOREL_FN_PLUS, IN_MEASURABLE_BOREL_FN_MINUS],
7270       (* goal 2 (of 2) *)
7271       MATCH_MP_TAC le_add >> rw [FN_PLUS_POS, FN_MINUS_POS] ])
7272 >> DISCH_TAC;
7273(* end of martingale_alt_generator_shared_tactics_3 *)
7274
7275val martingale_alt_generator_shared_tactics_4 =
7276    Suff ‘!i j n. measure_space (m_space m,subsets (sigma (m_space m) (G n)),f i j * m)’
7277 >- Rewr
7278 >> Q.PAT_X_ASSUM ‘i <= j’ K_TAC
7279 >> Q.PAT_X_ASSUM ‘s IN subsets (sigma (m_space m) (G i))’ K_TAC
7280 >> Q.PAT_X_ASSUM ‘s IN measurable_sets m’ K_TAC
7281 >> rpt GEN_TAC
7282 >> MATCH_MP_TAC MEASURE_SPACE_RESTRICTION
7283 >> Q.EXISTS_TAC ‘measurable_sets m’ >> art []
7284 >> CONJ_TAC >- PROVE_TAC [] (* sigma (G n) SUBSET measurable_sets m *)
7285 >> ‘(m_space m,subsets (sigma (m_space m) (G n))) = sigma (m_space m) (G n)’
7286       by METIS_TAC [SPACE, SPACE_SIGMA]
7287 >> POP_ORW
7288 >> MATCH_MP_TAC SIGMA_ALGEBRA_SIGMA >> art [];
7289 (* end of martingale_alt_generator_shared_tactics_4 *)
7290
7291Theorem martingale_alt_generator :
7292   !m a u g. (!n. a n = sigma (m_space m) (g n)) /\
7293             (!n. has_exhausting_sequence (m_space m,g n)) /\
7294             (!n s. s IN (g n) ==> measure m s < PosInf) /\
7295             (!n s t. s IN (g n) /\ t IN (g n) ==> s INTER t IN (g n)) ==>
7296     (martingale m a u <=>
7297      filtered_measure_space m a /\ (!n. integrable m (u n)) /\
7298      !i j s. i <= j /\ s IN (g i) ==>
7299             (integral m (\x. u i x * indicator_fn s x) =
7300              integral m (\x. u j x * indicator_fn s x)))
7301Proof
7302 (* expectations: ‘A i s - B i s = A j s - B j s’ *)
7303    martingale_alt_generator_shared_tactics_1
7304 (* stage work on transforming the goal into equivalence of two measures *)
7305 >> Know ‘!i j s. (A i s - B i s = A j s - B j s <=>
7306                   A i s + B j s = A j s + B i s)’
7307 >- (qx_genl_tac [‘M’, ‘N’, ‘t’] \\
7308    ‘A M t <> NegInf /\ A N t <> NegInf /\ B M t <> NegInf /\ B N t <> NegInf’
7309       by METIS_TAC [pos_not_neginf] \\
7310    ‘A M t <> PosInf /\ A N t <> PosInf /\ B M t <> PosInf /\ B N t <> PosInf’
7311       by METIS_TAC [lt_infty] \\
7312    ‘?r1. A M t = Normal r1’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7313    ‘?r2. A N t = Normal r2’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7314    ‘?r3. B M t = Normal r3’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7315    ‘?r4. B N t = Normal r4’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7316     rw [extreal_add_def, extreal_sub_def, extreal_le_eq] >> REAL_ARITH_TAC)
7317 >> DISCH_THEN (FULL_SIMP_TAC pure_ss o wrap)
7318 (* applying density_measure_def *)
7319 >> martingale_alt_generator_shared_tactics_2
7320 (* final modification of the goal *)
7321 >> ‘A i s + B j s = A j s + B i s <=> (f i j * m) s = (f j i * m) s’
7322      by METIS_TAC [] >> POP_ORW
7323 (* final modification of the major assumption *)
7324 >> Know ‘!i j s. i <= j /\ s IN G i ==> (f i j * m) s = (f j i * m) s’
7325 >- (qx_genl_tac [‘k’, ‘n’, ‘t’] >> rpt STRIP_TAC \\
7326    ‘t IN measurable_sets m’ by PROVE_TAC [] \\
7327     METIS_TAC [])
7328 >> DISCH_TAC
7329 >> Q.PAT_X_ASSUM ‘!i j s. i <= j /\ s IN G i ==> A i s + B j s = A j s + B i s’ K_TAC
7330 (* applying measure_space_density, density_def *)
7331 >> martingale_alt_generator_shared_tactics_3
7332 (* applying UNIQUENESS_OF_MEASURE *)
7333 >> irule UNIQUENESS_OF_MEASURE
7334 >> qexistsl_tac [‘m_space m’, ‘G i’] >> simp []
7335 >> CONJ_TAC (* f i j * m = f j i * m *)
7336 >- (rpt STRIP_TAC >> FIRST_X_ASSUM MATCH_MP_TAC >> art [])
7337 >> Know ‘!n. subset_class (m_space m) (G n)’
7338 >- (rw [subset_class_def] \\
7339    ‘x IN measurable_sets m’ by METIS_TAC [SUBSET_DEF] \\
7340     FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_def, algebra_def,
7341                           subset_class_def, space_def, subsets_def])
7342 >> DISCH_TAC
7343 (* easy goals first *)
7344 >> ASM_REWRITE_TAC [CONJ_ASSOC]
7345 >> reverse CONJ_TAC (* sigma_finite of G *)
7346 >- (Q.PAT_X_ASSUM ‘!n. has_exhausting_sequence (m_space m,G n)’ (MP_TAC o (Q.SPEC ‘i’)) \\
7347     rw [sigma_finite_def, has_exhausting_sequence_def, IN_FUNSET] \\
7348     rename1 ‘!x. g x IN G i’ >> Q.EXISTS_TAC ‘g’ >> rw [] \\
7349    ‘g n IN measurable_sets m’ by METIS_TAC [SUBSET_DEF] \\
7350    ‘(f i j * m) (g n) = A i (g n) + B j (g n)’ by METIS_TAC [] >> POP_ORW \\
7351     METIS_TAC [add_not_infty, lt_infty])
7352 (* final: applying MEASURE_SPACE_RESTRICTION *)
7353 >> martingale_alt_generator_shared_tactics_4
7354QED
7355
7356val martingale_alt_generator_shared_tactics_5 =
7357    Know ‘!i j s. (A i s - B i s <= A j s - B j s <=>
7358                   A i s + B j s <= A j s + B i s)’
7359 >- (qx_genl_tac [‘M’, ‘N’, ‘t’] \\
7360    ‘A M t <> NegInf /\ A N t <> NegInf /\ B M t <> NegInf /\ B N t <> NegInf’
7361       by METIS_TAC [pos_not_neginf] \\
7362    ‘A M t <> PosInf /\ A N t <> PosInf /\ B M t <> PosInf /\ B N t <> PosInf’
7363       by METIS_TAC [lt_infty] \\
7364    ‘?r1. A M t = Normal r1’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7365    ‘?r2. A N t = Normal r2’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7366    ‘?r3. B M t = Normal r3’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7367    ‘?r4. B N t = Normal r4’ by METIS_TAC [extreal_cases] >> POP_ORW \\
7368     rw [extreal_add_def, extreal_sub_def, extreal_le_eq] >> REAL_ARITH_TAC)
7369 >> DISCH_THEN (FULL_SIMP_TAC pure_ss o wrap);
7370 (* end of martingale_alt_generator_shared_tactics_5 *)
7371
7372(* For sub- and super-martingales, we need, in addition, that (g n) is a semi-ring.
7373
7374   This theorem (and the next one) relies on measureTheory.SEMIRING_SIGMA_MONOTONE
7375 *)
7376Theorem sub_martingale_alt_generator :
7377   !m a u g. (!n. a n = sigma (m_space m) (g n)) /\
7378             (!n. has_exhausting_sequence (m_space m,g n)) /\
7379             (!n s. s IN (g n) ==> measure m s < PosInf) /\
7380             (!n. semiring (m_space m,g n)) ==>
7381     (sub_martingale m a u <=>
7382      filtered_measure_space m a /\ (!n. integrable m (u n)) /\
7383      !i j s. i <= j /\ s IN (g i) ==>
7384             (integral m (\x. u i x * indicator_fn s x) <=
7385              integral m (\x. u j x * indicator_fn s x)))
7386Proof
7387    martingale_alt_generator_shared_tactics_1
7388 (* stage work on transforming the goal into equivalence of two measures *)
7389 >> martingale_alt_generator_shared_tactics_5
7390 (* applying density_measure_def *)
7391 >> martingale_alt_generator_shared_tactics_2
7392 (* final modification of the goal *)
7393 >> ‘A i s + B j s <= A j s + B i s <=> (f i j * m) s <= (f j i * m) s’
7394      by METIS_TAC [] >> POP_ORW
7395 (* final modification of the major assumption *)
7396 >> Know ‘!i j s. i <= j /\ s IN G i ==> (f i j * m) s <= (f j i * m) s’
7397 >- (qx_genl_tac [‘M’, ‘N’, ‘t’] >> rpt STRIP_TAC \\
7398    ‘t IN measurable_sets m’ by PROVE_TAC [] \\
7399     METIS_TAC [])
7400 >> DISCH_TAC
7401 >> Q.PAT_X_ASSUM ‘!i j s. i <= j /\ s IN G i ==> A i s + B j s <= _’ K_TAC
7402 (* applying measure_space_density, density_def *)
7403 >> martingale_alt_generator_shared_tactics_3
7404 (* applying SEMIRING_SIGMA_MONOTONE *)
7405 >> irule SEMIRING_SIGMA_MONOTONE
7406 >> qexistsl_tac [‘m_space m’, ‘G i’] >> simp []
7407 >> CONJ_TAC (* (f j i * m) s < PosInf *)
7408 >- (Q.X_GEN_TAC ‘t’ >> DISCH_TAC \\
7409    ‘t IN measurable_sets m’ by METIS_TAC [SUBSET_DEF] \\
7410    ‘(f j i * m) t = A j t + B i t’ by METIS_TAC [] >> POP_ORW \\
7411     METIS_TAC [add_not_infty, lt_infty])
7412 (* applying MEASURE_SPACE_RESTRICTION *)
7413 >> martingale_alt_generator_shared_tactics_4
7414 (* subset_class *)
7415 >> Q.PAT_X_ASSUM ‘!n. semiring (m_space m,G n)’ (MP_TAC o (Q.SPEC ‘n’))
7416 >> rw [semiring_def]
7417QED
7418
7419Theorem super_martingale_alt_generator :
7420   !m a u g. (!n. a n = sigma (m_space m) (g n)) /\
7421             (!n. has_exhausting_sequence (m_space m,g n)) /\
7422             (!n s. s IN (g n) ==> measure m s < PosInf) /\
7423             (!n. semiring (m_space m,g n)) ==>
7424     (super_martingale m a u <=>
7425      filtered_measure_space m a /\ (!n. integrable m (u n)) /\
7426      !i j s. i <= j /\ s IN (g i) ==>
7427             (integral m (\x. u j x * indicator_fn s x) <=
7428              integral m (\x. u i x * indicator_fn s x)))
7429Proof
7430    martingale_alt_generator_shared_tactics_1
7431 (* stage work on transforming the goal into equivalence of two measures *)
7432 >> martingale_alt_generator_shared_tactics_5
7433 (* applying density_measure_def *)
7434 >> martingale_alt_generator_shared_tactics_2
7435 (* final modification of the goal *)
7436 >> ‘A j s + B i s <= A i s + B j s <=> (f j i * m) s <= (f i j * m) s’
7437      by METIS_TAC [] >> POP_ORW
7438 (* final modification of the major assumption *)
7439 >> Know ‘!i j s. i <= j /\ s IN G i ==> (f j i * m) s <= (f i j * m) s’
7440 >- (qx_genl_tac [‘M’, ‘N’, ‘t’] >> rpt STRIP_TAC \\
7441    ‘t IN measurable_sets m’ by PROVE_TAC [] \\
7442     METIS_TAC [])
7443 >> DISCH_TAC
7444 >> Q.PAT_X_ASSUM ‘!i j s. i <= j /\ s IN G i ==> A j s + B i s <= _’ K_TAC
7445 (* applying measure_space_density, density_def *)
7446 >> martingale_alt_generator_shared_tactics_3
7447 (* applying SEMIRING_SIGMA_MONOTONE *)
7448 >> irule SEMIRING_SIGMA_MONOTONE
7449 >> qexistsl_tac [‘m_space m’, ‘G i’] >> simp []
7450 >> CONJ_TAC (* (f i j * m) s < PosInf *)
7451 >- (Q.X_GEN_TAC ‘t’ >> DISCH_TAC \\
7452    ‘t IN measurable_sets m’ by METIS_TAC [SUBSET_DEF] \\
7453    ‘(f i j * m) t = A i t + B j t’ by METIS_TAC [] >> POP_ORW \\
7454     METIS_TAC [add_not_infty, lt_infty])
7455 (* applying MEASURE_SPACE_RESTRICTION *)
7456 >> martingale_alt_generator_shared_tactics_4
7457 (* subset_class *)
7458 >> Q.PAT_X_ASSUM ‘!n. semiring (m_space m,G n)’ (MP_TAC o (Q.SPEC ‘n’))
7459 >> rw [semiring_def]
7460QED
7461
7462(* NOTE: general_filtration_def, general_martingale_def, etc. are moved to
7463        "examples/probability/stochastic_processScript.sml" *)
7464
7465(* ------------------------------------------------------------------------- *)
7466(*  The Function Spaces L^p and Important Inequalities [1, Chapter 13]       *)
7467(* ------------------------------------------------------------------------- *)
7468
7469(* The L^p function space (1 <= p), was: ‘function_space’
7470
7471   NOTE: added `c <> PosInf` to the case `p = PosInf`.
7472 *)
7473Definition lp_space_def :
7474    lp_space p m =
7475      {f | f IN measurable (m_space m,measurable_sets m) Borel /\
7476           if p = PosInf then
7477             ?c. 0 < c /\ c <> PosInf /\
7478                 measure m {x | x IN m_space m /\ c <= abs (f x)} = 0
7479           else
7480             pos_fn_integral m (\x. (abs (f x)) powr p) <> PosInf}
7481End
7482
7483(* The most common function spaces (L^1 and L^2, plus L^\infty) *)
7484Overload L1_space = “lp_space 1”
7485Overload L2_space = “lp_space 2”
7486Overload L_PosInf = “lp_space PosInf”
7487
7488(* alternative definition of ‘lp_space’ when p is finite (was: 1 <= p) *)
7489Theorem lp_space_alt_finite :
7490    !p m f. 0 < p /\ p <> PosInf ==>
7491           (f IN lp_space p m <=>
7492            f IN measurable (m_space m,measurable_sets m) Borel /\
7493            pos_fn_integral m (\x. (abs (f x)) powr p) <> PosInf)
7494Proof
7495    rw [lp_space_def]
7496QED
7497
7498Theorem lp_space_alt_finite' :
7499    !p m f. measure_space m /\ 0 < p /\ p <> PosInf ==>
7500           (f IN lp_space p m <=>
7501            f IN measurable (m_space m,measurable_sets m) Borel /\
7502            integral m (\x. (abs (f x)) powr p) <> PosInf)
7503Proof
7504    rpt STRIP_TAC
7505 >> Know ‘integral m (\x. abs (f x) powr p) = pos_fn_integral m (\x. abs (f x) powr p)’
7506 >- (MATCH_MP_TAC integral_pos_fn >> rw [powr_pos])
7507 >> Rewr'
7508 >> MATCH_MP_TAC lp_space_alt_finite >> art []
7509QED
7510
7511(* alternative definition of ‘lp_space’ when p is infinite *)
7512Theorem lp_space_alt_infinite :
7513    !m f. measure_space m ==>
7514         (f IN lp_space PosInf m <=>
7515          f IN measurable (m_space m,measurable_sets m) Borel /\
7516          ?c. 0 < c /\ c <> PosInf /\ AE x::m. abs (f x) < c)
7517Proof
7518    rpt GEN_TAC >> STRIP_TAC
7519 >> ‘f IN measurable (m_space m,measurable_sets m) Borel ==>
7520     !c. {x | x IN m_space m /\ c <= abs (f x)} IN measurable_sets m’
7521       by rw [IN_MEASURABLE_BOREL_ALL_MEASURE_ABS']
7522 >> Know ‘f IN measurable (m_space m,measurable_sets m) Borel ==>
7523          !c. (AE x::m. abs (f x) < c) <=>
7524               null_set m {x | x IN m_space m /\ ~(abs (f x) < c)}’
7525 >- (DISCH_TAC >> Q.X_GEN_TAC ‘c’ \\
7526     HO_MATCH_MP_TAC AE_iff_null \\
7527     rw [extreal_lt_def])
7528 >> RW_TAC std_ss [null_set_def, extreal_lt_def]
7529 >> EQ_TAC >> rw [lp_space_def, GSYM extreal_lt_def]
7530 >> Q.EXISTS_TAC ‘c’
7531 >> FULL_SIMP_TAC std_ss [GSYM extreal_lt_def]
7532 >> METIS_TAC []
7533QED
7534
7535(* special case when ‘p = 1’ *)
7536Theorem L1_space_alt_integrable :
7537    !m f. measure_space m ==> (f IN L1_space m <=> integrable m f)
7538Proof
7539    rw [lp_space_alt_finite]
7540 >> Know ‘(\x. abs (f x) powr 1) = abs o f’
7541 >- (rw [FUN_EQ_THM] \\
7542     MATCH_MP_TAC powr_1 >> rw [])
7543 >> Rewr'
7544 >> EQ_TAC (* easy part first *)
7545 >- (rpt STRIP_TAC \\
7546     MATCH_MP_TAC integrable_from_abs >> art [] \\
7547     PROVE_TAC [integrable_abs_alt])
7548 >> DISCH_TAC
7549 >> ‘integrable m (abs o f)’ by PROVE_TAC [integrable_abs]
7550 >> CONJ_ASM1_TAC >- fs [integrable_def]
7551 >> PROVE_TAC [integrable_abs_alt]
7552QED
7553
7554(* special case when ‘p = 2’ *)
7555Theorem L2_space_alt_integrable_square :
7556    !m f. measure_space m ==>
7557         (f IN L2_space m <=>
7558          f IN Borel_measurable (m_space m,measurable_sets m) /\
7559          integrable m (\x. (f x) pow 2))
7560Proof
7561    rpt STRIP_TAC
7562 >> Q.ABBREV_TAC ‘g = \x. (f x) pow 2’
7563 >> ‘!x. x IN m_space m ==> 0 <= g x’ by rw [Abbr ‘g’, le_pow2]
7564 >> ASM_SIMP_TAC std_ss [integrable_pos]
7565 >> Know ‘f IN L2_space m <=>
7566          f IN measurable (m_space m,measurable_sets m) Borel /\
7567          pos_fn_integral m (\x. (abs (f x)) powr 2) <> PosInf’
7568 >- (MATCH_MP_TAC lp_space_alt_finite \\
7569     rw [extreal_of_num_def, extreal_le_eq])
7570 >> Rewr'
7571 >> EQ_TAC
7572 >> rw [GSYM gen_powr, le_02, Abbr ‘g’, IN_MEASURABLE_BOREL_POW]
7573QED
7574
7575(* The "else" part should only be used when ‘1 <= p’ (and also ‘p <> PosInf’) *)
7576Definition seminorm_def :
7577    seminorm p m f =
7578    if p = PosInf then
7579       inf {c | 0 < c /\ measure m {x | x IN m_space m /\ c <= abs (f x)} = 0}
7580    else
7581      (pos_fn_integral m (\x. (abs (f x)) powr p)) powr (inv p)
7582End
7583
7584(* was: 1 <= p *)
7585Theorem seminorm_normal :
7586    !p m f. 0 < p /\ p <> PosInf ==>
7587            seminorm p m f = (pos_fn_integral m (\x. (abs (f x)) powr p)) powr (inv p)
7588Proof
7589    rw [seminorm_def]
7590QED
7591
7592Theorem seminorm_infty :
7593    !m f. seminorm PosInf m f =
7594          inf {c | 0 < c /\ measure m {x | x IN m_space m /\ c <= abs (f x)} = 0}
7595Proof
7596    rw [seminorm_def]
7597QED
7598
7599Theorem seminorm_infty_alt :
7600    !m f. measure_space m /\ f IN measurable (m_space m,measurable_sets m) Borel ==>
7601          seminorm PosInf m f = inf {c | 0 < c /\ AE x::m. abs (f x) < c}
7602Proof
7603    rw [seminorm_infty]
7604 >> Suff ‘!c. (AE x::m. abs (f x) < c) <=>
7605              measure m {x | x IN m_space m /\ c <= abs (f x)} = 0’ >- rw []
7606 >> Q.X_GEN_TAC ‘c’
7607 >> HO_MATCH_MP_TAC AE_iff_measurable
7608 >> rw [extreal_lt_def]
7609 >> rw [IN_MEASURABLE_BOREL_ALL_MEASURE_ABS']
7610QED
7611
7612(* was: 1 <= p *)
7613Theorem seminorm_pos :
7614    !p m f. 0 < p ==> 0 <= seminorm p m f
7615Proof
7616    rpt STRIP_TAC
7617 >> Cases_on ‘p = PosInf’
7618 >- (rw [seminorm_infty, le_inf'] \\
7619     MATCH_MP_TAC lt_imp_le >> art [])
7620 >> rw [seminorm_normal, powr_pos]
7621QED
7622
7623Theorem seminorm_one :
7624    !m f. measure_space m ==> seminorm 1 m f = pos_fn_integral m (abs o f)
7625Proof
7626    rpt STRIP_TAC
7627 >> MP_TAC (Q.SPECL [‘1’, ‘m’, ‘f’] seminorm_normal)
7628 >> rw [powr_pos, abs_pos, powr_1, o_DEF]
7629 >> MATCH_MP_TAC powr_1
7630 >> MATCH_MP_TAC pos_fn_integral_pos
7631 >> rw [abs_pos]
7632QED
7633
7634Theorem seminorm_two :
7635    !m f. measure_space m ==>
7636          seminorm 2 m f = sqrt (pos_fn_integral m (\x. (f x) pow 2))
7637Proof
7638    rpt STRIP_TAC
7639 >> Know ‘seminorm 2 m f = (pos_fn_integral m (\x. (abs (f x)) powr 2)) powr (inv 2)’
7640 >- (MATCH_MP_TAC seminorm_normal >> rw [extreal_of_num_def, extreal_le_eq])
7641 >> Rewr'
7642 >> Know ‘pos_fn_integral m (\x. abs (f x) powr 2) powr (inv 2) =
7643          sqrt (pos_fn_integral m (\x. abs (f x) powr 2))’
7644 >- (MATCH_MP_TAC (GSYM sqrt_powr) \\
7645     MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos])
7646 >> Rewr'
7647 >> rw [GSYM gen_powr, abs_pow2, le_02]
7648QED
7649
7650(* was: 1 <= p; removed ‘p <> PosInf’ *)
7651Theorem seminorm_not_infty :
7652    !p m f. measure_space m /\ 0 < p /\ f IN lp_space p m ==>
7653            seminorm p m f <> PosInf /\ seminorm p m f <> NegInf
7654Proof
7655    rpt GEN_TAC >> STRIP_TAC
7656 >> Suff ‘seminorm p m f <> PosInf’
7657 >- (RW_TAC std_ss [] \\
7658     MATCH_MP_TAC pos_not_neginf \\
7659     MATCH_MP_TAC seminorm_pos >> art [])
7660 >> Cases_on ‘p = PosInf’
7661 >- (rw [seminorm_infty, lt_infty] \\
7662     fs [lp_space_def] \\
7663     rw [GSYM inf_lt'] \\
7664     Q.EXISTS_TAC ‘c’ >> rw [GSYM lt_infty])
7665 >> RW_TAC std_ss [seminorm_normal]
7666 >> rfs [lp_space_def]
7667 >> ‘0 <= p’ by METIS_TAC [lt_imp_le]
7668 >> ‘p <> NegInf’ by PROVE_TAC [pos_not_neginf]
7669 >> Know ‘0 <= pos_fn_integral m (\x. abs (f x) powr p)’
7670 >- (MATCH_MP_TAC pos_fn_integral_pos >> rw [] \\
7671     REWRITE_TAC [powr_pos])
7672 >> DISCH_TAC
7673 >> ‘pos_fn_integral m (\x. abs (f x) powr p) <> NegInf’
7674      by PROVE_TAC [pos_not_neginf]
7675 >> ‘?r. 0 <= r /\ pos_fn_integral m (\x. abs (f x) powr p) = Normal r’
7676      by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq]
7677 >> POP_ORW
7678 >> ‘0 < inv p’ by PROVE_TAC [inv_pos']
7679 >> ‘r = 0 \/ 0 < r’ by PROVE_TAC [REAL_LE_LT]
7680 >- (POP_ORW \\
7681     rw [GSYM extreal_of_num_def, zero_rpow])
7682 >> ‘p <> NegInf’ by PROVE_TAC [pos_not_neginf]
7683 >> ‘p <> 0’ by PROVE_TAC [lt_imp_ne]
7684 >> ‘?z. 0 < z /\ p = Normal z’
7685       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq]
7686 >> POP_ORW
7687 >> ‘z <> 0’ by PROVE_TAC [REAL_LT_IMP_NE]
7688 >> rw [extreal_inv_eq]
7689 >> ‘0 < inv z’ by PROVE_TAC [REAL_INV_POS]
7690 >> rw [normal_powr]
7691QED
7692
7693(* ‘seminorm PosInf m f’ is the AE upper bound of (abs o f)
7694
7695   NOTE: The key in this proof is to construct the needed null set satisfying AE
7696         of the goal, and to eliminate the ‘inf’ behind ‘seminorm’.
7697 *)
7698Theorem seminorm_infty_AE_bound :
7699    !m f. measure_space m /\ f IN Borel_measurable (m_space m,measurable_sets m)
7700      ==> (AE x::m. abs (f x) <= seminorm PosInf m f)
7701Proof
7702    rpt STRIP_TAC
7703 >> Q.ABBREV_TAC ‘c = seminorm PosInf m f’
7704 (* This special case must be eliminated first *)
7705 >> Cases_on ‘c = PosInf’
7706 >- (rw [le_infty] \\
7707     MATCH_MP_TAC AE_T >> art [])
7708 >> Know ‘c <> NegInf’
7709 >- (MATCH_MP_TAC pos_not_neginf \\
7710     Q.UNABBREV_TAC ‘c’ \\
7711     MATCH_MP_TAC seminorm_pos >> rw [extreal_of_num_def, lt_infty])
7712 >> DISCH_TAC
7713 (* now start finding the null sets whose BIGUNION is the needed one *)
7714 >> Know ‘!n. AE x::m. abs (f x) <= c + inv (&SUC n)’
7715 >- (rw [AE_DEF] \\
7716     Know ‘0 < inv (&SUC n)’
7717     >- (MATCH_MP_TAC inv_pos' >> rw [extreal_of_num_def, extreal_lt_eq]) \\
7718     DISCH_TAC \\
7719     Know ‘seminorm PosInf m f < c + inv (&SUC n)’
7720     >- (simp [] >> MATCH_MP_TAC lt_addr_imp >> art []) \\
7721  (* applying inf_lt' *)
7722     REWRITE_TAC [seminorm_infty, GSYM inf_lt'] >> rw [] \\
7723     Q.EXISTS_TAC ‘{z | z IN m_space m /\ x <= abs (f z)}’ \\
7724     reverse CONJ_TAC
7725     >- (rw [GSYM extreal_lt_def] \\
7726         MATCH_MP_TAC lt_imp_le >> PROVE_TAC [lt_trans]) \\
7727     rw [null_set_def, le_abs_bounds] \\
7728    ‘{z | z IN m_space m /\ (f z <= -x \/ x <= f z)} =
7729       ({z | f z <= -x} INTER m_space m) UNION ({z | x <= f z} INTER m_space m)’
7730        by SET_TAC [] >> POP_ORW \\
7731     MATCH_MP_TAC MEASURE_SPACE_UNION >> art [] \\
7732    ‘sigma_algebra (measurable_space m)’
7733       by PROVE_TAC [MEASURE_SPACE_SIGMA_ALGEBRA] \\
7734     METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE])
7735 (* stage work, ‘seminorm’ is not used below *)
7736 >> rw [AE_DEF]
7737 >> fs [SKOLEM_THM] (* This asserts function f'(n) of null sets *)
7738 >> Q.EXISTS_TAC ‘BIGUNION (IMAGE f' UNIV)’
7739 >> CONJ_TAC
7740 >- (MATCH_MP_TAC NULL_SET_BIGUNION' >> rw [])
7741 >> rw [IN_BIGUNION_IMAGE]
7742 >> rename1 ‘!n. x NOTIN (g n)’ (* rename f' with g *)
7743 (* applying le_epsilon! *)
7744 >> MATCH_MP_TAC le_epsilon >> rw []
7745 (* now we need to find n such that ‘inv (&SUCn) <= e’ *)
7746 >> ‘?n. inv (&SUC n) <= e’ by METIS_TAC [EXTREAL_ARCH_INV, lt_imp_le]
7747 >> MATCH_MP_TAC le_trans
7748 >> Q.EXISTS_TAC ‘c + inv (&SUC n)’
7749 >> CONJ_TAC >- METIS_TAC []
7750 >> MATCH_MP_TAC le_ladd_imp >> art []
7751QED
7752
7753(* was: 1 <= p *)
7754Theorem seminorm_powr :
7755    !p m f. measure_space m /\ 0 < p /\ p <> PosInf ==>
7756           (seminorm p m f) powr p = pos_fn_integral m (\x. (abs (f x)) powr p)
7757Proof
7758    RW_TAC std_ss [seminorm_normal]
7759 >> Q.ABBREV_TAC ‘a = pos_fn_integral m (\x. abs (f x) powr p)’
7760 >> ‘0 < inv p’ by PROVE_TAC [inv_pos']
7761 >> ‘inv p <> PosInf’ by METIS_TAC [inv_not_infty, lt_imp_ne]
7762 >> Know ‘0 <= a’
7763 >- (Q.UNABBREV_TAC ‘a’ \\
7764     MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos])
7765 >> RW_TAC std_ss [powr_powr]
7766 >> Suff ‘inv p * p = 1’ >- rw [powr_1]
7767 >> MATCH_MP_TAC mul_linv_pos >> art []
7768QED
7769
7770(* was: 1 <= p; removed ‘p <> PosInf’ *)
7771Theorem seminorm_eq_0 :
7772    !p m f. measure_space m /\ 0 < p /\ f IN Borel_measurable (measurable_space m) ==>
7773           (seminorm p m f = 0 <=> AE x::m. f x = 0)
7774Proof
7775    rpt STRIP_TAC
7776 >> Cases_on ‘p = PosInf’
7777 >- (POP_ORW >> rw [seminorm_infty] \\
7778     reverse EQ_TAC >| (* 2 subgoals, first is easier *)
7779     [ (* goal 1 (of 2) *)
7780       rw [AE_DEF] \\
7781       Know ‘!c. 0 < c ==> measure m {x | x IN m_space m /\ c <= abs (f x)} = 0’
7782       >- (rpt STRIP_TAC \\
7783           fs [null_set_def] \\
7784           Q.ABBREV_TAC ‘s = {x | x IN m_space m /\ c <= abs (f x)}’ \\
7785          ‘s IN measurable_sets m’
7786             by rw [Abbr ‘s’, IN_MEASURABLE_BOREL_ALL_MEASURE_ABS'] \\
7787          ‘s = (s DIFF N) UNION (s INTER N)’ by SET_TAC [] >> POP_ORW \\
7788          ‘DISJOINT (s DIFF N) (s INTER N)’ by SET_TAC [DISJOINT_ALT] \\
7789           Know ‘measure m (s DIFF N UNION s INTER N) =
7790                 measure m (s DIFF N) + measure m (s INTER N)’
7791           >- (MATCH_MP_TAC MEASURE_ADDITIVE >> rw [] >|
7792               [ MATCH_MP_TAC MEASURE_SPACE_DIFF >> art [],
7793                 MATCH_MP_TAC MEASURE_SPACE_INTER >> art [] ]) >> Rewr' \\
7794           Know ‘measure m (s INTER N) = 0’
7795           >- (reverse (rw [GSYM le_antisym])
7796               >- (MATCH_MP_TAC MEASURE_POSITIVE >> art [] \\
7797                   MATCH_MP_TAC MEASURE_SPACE_INTER >> art []) \\
7798               Q.PAT_X_ASSUM ‘measure m N = 0’ (ONCE_REWRITE_TAC o wrap o SYM) \\
7799               MATCH_MP_TAC MEASURE_INCREASING >> art [] \\
7800               CONJ_TAC >- SET_TAC [] \\
7801               MATCH_MP_TAC MEASURE_SPACE_INTER >> art []) \\
7802           DISCH_THEN (rw o wrap) \\
7803           Suff ‘s DIFF N = {}’ >- (Rewr' >> PROVE_TAC [MEASURE_EMPTY]) \\
7804           rw [Abbr ‘s’, Once EXTENSION] \\
7805           CCONTR_TAC >> fs [] \\
7806          ‘f x = 0’ by PROVE_TAC [] >> fs [abs_0] \\
7807           METIS_TAC [let_antisym]) >> DISCH_TAC \\
7808       Know ‘{c | 0 < c /\ measure m {x | x IN m_space m /\ c <= abs (f x)} = 0} =
7809             {c | 0 < c}’
7810       >- (rw [Once EXTENSION] >> EQ_TAC >> rw []) >> Rewr' \\
7811       rw [inf_eq'] >- (MATCH_MP_TAC lt_imp_le >> art []) \\
7812       CCONTR_TAC >> fs [GSYM extreal_lt_def] \\
7813       Cases_on ‘y = PosInf’
7814       >- (Q.PAT_X_ASSUM ‘!z. 0 < z ==> y <= z’ (MP_TAC o (Q.SPEC ‘1’)) \\
7815           rw [le_infty]) \\
7816       Q.PAT_X_ASSUM ‘!z. 0 < z ==> y <= z’ (MP_TAC o (Q.SPEC ‘1 / 2 * y’)) \\
7817       Know ‘0 < 1 / 2 * y’
7818       >- (MATCH_MP_TAC lt_mul >> rw [half_between]) >> rw [GSYM extreal_lt_def] \\
7819       Suff ‘1 / 2 * y < 1 * y’ >- rw [] \\
7820       rw [lt_rmul, half_between],
7821       (* goal 2 (of 2) *)
7822       DISCH_TAC \\
7823       Know ‘(AE x::m. f x = 0) <=> measure m {x | x IN m_space m /\ f x <> 0} = 0’
7824       >- (HO_MATCH_MP_TAC AE_iff_measurable \\
7825           rw [IN_MEASURABLE_BOREL_ALL_MEASURE_ABS']) >> Rewr' \\
7826      ‘!x. f x <> 0 <=> 0 < abs (f x)’ by PROVE_TAC [abs_gt_0] >> POP_ORW \\
7827      ‘{x | x IN m_space m /\ 0 < abs (f x)} IN measurable_sets m’
7828         by rw [IN_MEASURABLE_BOREL_ALL_MEASURE_ABS'] \\
7829      ‘!c. {x | x IN m_space m /\ c <= abs (f x)} IN measurable_sets m’
7830         by rw [IN_MEASURABLE_BOREL_ALL_MEASURE_ABS'] \\
7831    (* The measure inside ‘inf {}’ should be monotonic *)
7832       Q.ABBREV_TAC ‘H = \c. measure m {x | x IN m_space m /\ c <= abs (f x)}’ \\
7833    (* So it's actually decreasing, with smaller c the measure is larger *)
7834       Know ‘!a b. a <= b ==> H b <= H a’
7835       >- (rw [Abbr ‘H’] \\
7836           MATCH_MP_TAC MEASURE_INCREASING >> art [] \\
7837           rw [SUBSET_DEF] \\
7838           MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘b’ >> art []) >> DISCH_TAC \\
7839       FULL_SIMP_TAC std_ss [] (* simplify assumptions using ‘H’ *) \\
7840       Q.ABBREV_TAC ‘s = {x | x IN m_space m /\ 0 < abs (f x)}’ \\
7841    (* NOTE: below we show that, if ‘measure m s < 0’ then ‘inf {} > 0’ *)
7842       CCONTR_TAC \\
7843      ‘measure m s = 0 \/ 0 < measure m s’ by PROVE_TAC [MEASURE_POSITIVE, le_lt] \\
7844       Q.PAT_X_ASSUM ‘measure m s <> 0’ K_TAC \\
7845       POP_ASSUM MP_TAC (* 0 < measure m s *) \\
7846       Know ‘s = BIGUNION (IMAGE (\n. {x | x IN m_space m /\
7847                                      (inv &SUC n) <= abs (f x)}) UNIV)’
7848       >- (rw [Abbr ‘s’, Once EXTENSION, IN_BIGUNION_IMAGE, Excl "abs_gt_0"] \\
7849           reverse EQ_TAC >> RW_TAC std_ss [] >> art []
7850           >- (MATCH_MP_TAC lte_trans \\
7851               Q.EXISTS_TAC ‘inv (&SUC n)’ >> art [] \\
7852               MATCH_MP_TAC inv_pos' >> rw [extreal_of_num_def, extreal_lt_eq]) \\
7853           Q.ABBREV_TAC ‘y = abs (f x)’ \\
7854           MATCH_MP_TAC EXTREAL_ARCH_INV' >> art []) \\
7855       DISCH_THEN (PURE_ONCE_REWRITE_TAC o wrap) \\
7856    (* applying MONOTONE_CONVERGENCE2 *)
7857       Q.ABBREV_TAC ‘g = \n. {x | x IN m_space m /\ realinv (&SUC n) <= abs (f x)}’ \\
7858       Know ‘measure m (BIGUNION (IMAGE g univ(:num))) =
7859             sup (IMAGE (measure m o g) univ(:num))’
7860       >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
7861           MATCH_MP_TAC MONOTONE_CONVERGENCE2 >> rw [IN_FUNSET, Abbr ‘g’] \\
7862           rw [SUBSET_DEF] \\
7863           MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘inv (&SUC n)’ >> rw [] \\
7864           MATCH_MP_TAC inv_le_antimono_imp >> rw [extreal_of_num_def]) \\
7865       DISCH_THEN (PURE_ONCE_REWRITE_TAC o wrap) \\
7866       Q.UNABBREV_TAC ‘s’ (* useless *) \\
7867    (* applying lt_sup *)
7868       DISCH_THEN (STRIP_ASSUME_TAC o (SIMP_RULE (srw_ss()) [o_DEF, lt_sup])) \\
7869       rename1 ‘x = measure m (g n)’ \\
7870       Q.PAT_X_ASSUM ‘x = measure m (g n)’ (FULL_SIMP_TAC std_ss o wrap) \\
7871       REV_FULL_SIMP_TAC std_ss [Abbr ‘g’] (* remove ‘g’, using ‘H’ *) \\
7872       Q.ABBREV_TAC ‘z = inv (&SUC n)’ (* this is an important constant *) \\
7873       Know ‘0 < z’
7874       >- (Q.UNABBREV_TAC ‘z’ \\
7875           MATCH_MP_TAC inv_pos' >> rw [extreal_of_num_def]) >> DISCH_TAC \\
7876    (* now we show ‘inf {H c = 0} = 0’ is impossible since z <= inf {} *)
7877       Suff ‘z <= inf {c | 0 < c /\ H c = 0}’
7878       >- (DISCH_TAC \\
7879          ‘0 < inf {c | 0 < c /\ H c = 0}’ by PROVE_TAC [lte_trans] \\
7880           METIS_TAC [lt_le]) \\
7881       rw [le_inf'] \\
7882       SPOSE_NOT_THEN (ASSUME_TAC o (REWRITE_RULE [GSYM extreal_lt_def])) \\
7883      ‘y <= z’ by PROVE_TAC [lt_imp_le] \\
7884      ‘H z <= H y’ by PROVE_TAC [] \\
7885       METIS_TAC [let_antisym] ])
7886 >> rw [seminorm_normal]
7887 >> ‘0 <= p’ by PROVE_TAC [lt_imp_le]
7888 >> ‘p <> 0’ by PROVE_TAC [lt_imp_ne]
7889 >> ‘0 < inv p’ by PROVE_TAC [inv_pos']
7890 >> Know ‘pos_fn_integral m (\x. abs (f x) powr p) powr (inv p) = 0 <=>
7891          pos_fn_integral m (\x. abs (f x) powr p) = 0’
7892 >- (MATCH_MP_TAC powr_eq_0 >> rw [inv_not_infty] \\
7893     MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos])
7894 >> Rewr'
7895 >> Q.ABBREV_TAC ‘g = \x. abs (f x) powr p’
7896 >> Know ‘pos_fn_integral m g = 0 <=> measure m {x | x IN m_space m /\ g x <> 0} = 0’
7897 >- (MATCH_MP_TAC pos_fn_integral_eq_0 >> rw [Abbr ‘g’, powr_pos] \\
7898     MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> art [])
7899 >> Rewr'
7900 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
7901 >> HO_MATCH_MP_TAC AE_iff_measurable
7902 >> simp [Abbr ‘g’, powr_eq_0]
7903 >> rw [IN_MEASURABLE_BOREL_ALL_MEASURE_ABS']
7904QED
7905
7906(* was: 1 <= p, removed ‘p <> PosInf’ *)
7907Theorem lp_space_alt_seminorm :
7908    !p m f. measure_space m /\ 0 < p ==>
7909           (f IN lp_space p m <=>
7910            f IN Borel_measurable (m_space m,measurable_sets m) /\
7911            seminorm p m f < PosInf)
7912Proof
7913    RW_TAC std_ss [GSYM lt_infty]
7914 >> EQ_TAC
7915 >- (rpt STRIP_TAC >- rfs [lp_space_def] \\
7916     METIS_TAC [seminorm_not_infty])
7917 >> Cases_on ‘p = PosInf’
7918 >- (POP_ASSUM (FULL_SIMP_TAC std_ss o wrap) \\
7919     rw [lp_space_alt_infinite] \\
7920    ‘0 <= seminorm PosInf m f’ by (MATCH_MP_TAC seminorm_pos >> rw []) \\
7921    ‘seminorm PosInf m f <> NegInf’ by PROVE_TAC [pos_not_neginf] \\
7922    ‘seminorm PosInf m f = 0 \/ 0 < seminorm PosInf m f’ by PROVE_TAC [le_lt]
7923     >- (Know ‘AE x::m. f x = 0’ >- METIS_TAC [seminorm_eq_0] \\
7924         rw [AE_DEF] \\
7925         Q.EXISTS_TAC ‘1’ >> rw [] \\
7926         Q.EXISTS_TAC ‘N’ >> rw []) \\
7927     Know ‘AE x::m. abs (f x) <= seminorm PosInf m f’
7928     >- (MATCH_MP_TAC seminorm_infty_AE_bound >> art []) \\
7929     rw [AE_DEF] \\
7930     Q.ABBREV_TAC ‘c = seminorm PosInf m f’ \\
7931     Q.EXISTS_TAC ‘c + 1’ \\
7932     CONJ_TAC >- rw [lt_add] \\
7933     CONJ_TAC >- (‘1 <> PosInf’ by rw [] >> METIS_TAC [add_not_infty]) \\
7934     Q.EXISTS_TAC ‘N’ >> rw [] \\
7935     MATCH_MP_TAC let_trans >> Q.EXISTS_TAC ‘c’ \\
7936     reverse CONJ_TAC >- (MATCH_MP_TAC lt_addr_imp >> rw []) \\
7937     FIRST_X_ASSUM MATCH_MP_TAC >> art [])
7938 >> rw [lp_space_alt_finite, seminorm_normal]
7939 >> CCONTR_TAC
7940 >> ‘0 < inv p’ by PROVE_TAC [inv_pos']
7941 >> gs [infty_powr]
7942QED
7943
7944(* Theorem 13.2 (Hoelder's inequality) [1, p.117]
7945
7946   NOTE: ‘p <> PosInf /\ q <> PosInf’ was there but then removed.
7947 *)
7948Theorem Hoelder_inequality_lemma[local] :
7949    !m u v. measure_space m /\ u IN lp_space PosInf m /\ v IN L1_space m ==>
7950            integrable m (\x. u x * v x) /\
7951            integral m (\x. abs (u x * v x)) <= seminorm PosInf m u * seminorm 1 m v
7952Proof
7953    rpt GEN_TAC >> STRIP_TAC
7954 >> ‘u IN measurable (m_space m,measurable_sets m) Borel /\
7955     v IN measurable (m_space m,measurable_sets m) Borel’
7956       by fs [lp_space_def]
7957 >> ‘seminorm PosInf m u <> PosInf /\ seminorm PosInf m u <> NegInf’
7958       by (MATCH_MP_TAC seminorm_not_infty >> rw [])
7959 >> ONCE_REWRITE_TAC [CONJ_SYM]
7960 >> CONJ_ASM1_TAC
7961 >- (Know ‘integral m (\x. abs (u x * v x)) = pos_fn_integral m (\x. abs (u x * v x))’
7962     >- (MATCH_MP_TAC integral_pos_fn >> rw [abs_pos]) >> Rewr' \\
7963     rw [seminorm_one] \\
7964     Know ‘0 <= seminorm PosInf m u’
7965     >- (MATCH_MP_TAC seminorm_pos >> rw []) >> DISCH_TAC \\
7966     Know ‘seminorm PosInf m u * pos_fn_integral m (abs o v) =
7967           pos_fn_integral m (\x. seminorm PosInf m u * (abs o v) x)’
7968     >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
7969        ‘?r. 0 <= r /\ seminorm PosInf m u = Normal r’
7970           by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq] \\
7971         POP_ORW \\
7972         MATCH_MP_TAC pos_fn_integral_cmul >> rw [o_DEF, abs_pos]) >> Rewr' \\
7973     MATCH_MP_TAC pos_fn_integral_mono_AE >> rw [abs_pos]
7974     >- (MATCH_MP_TAC le_mul >> rw [abs_pos]) \\
7975     Know ‘AE x::m. abs (u x) <= seminorm PosInf m u’
7976     >- (MATCH_MP_TAC seminorm_infty_AE_bound >> art []) \\
7977     rw [AE_DEF] >> Q.EXISTS_TAC ‘N’ >> rw [abs_mul] \\
7978     MATCH_MP_TAC le_rmul_imp >> rw [abs_pos])
7979 (* stage work *)
7980 >> MATCH_MP_TAC integrable_from_abs >> art []
7981 >> CONJ_ASM1_TAC
7982 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES \\
7983     qexistsl_tac [‘u’, ‘v’] >> rw [])
7984 >> rw [integrable_abs_alt, lt_infty]
7985 >> Know ‘pos_fn_integral m (abs o (\x. u x * v x)) =
7986          integral m (\x. abs (u x * v x))’
7987 >- (rw [o_DEF, Once EQ_SYM_EQ] \\
7988     MATCH_MP_TAC integral_pos_fn >> rw [abs_pos])
7989 >> Rewr'
7990 >> MATCH_MP_TAC let_trans
7991 >> Q.EXISTS_TAC ‘seminorm PosInf m u * seminorm 1 m v’ >> art []
7992 >> ‘seminorm 1 m v <> PosInf /\ seminorm 1 m v <> NegInf’
7993      by PROVE_TAC [seminorm_not_infty, lt_01]
7994 >> ‘?a. seminorm PosInf m u = Normal a’ by METIS_TAC [extreal_cases]
7995 >> ‘?b. seminorm 1 m v = Normal b’ by METIS_TAC [extreal_cases]
7996 >> rw [GSYM lt_infty, extreal_mul_def, extreal_not_infty]
7997QED
7998
7999Theorem Hoelder_inequality :
8000    !m u v p q. measure_space m /\ 0 < p /\ 0 < q /\ inv(p) + inv(q) = 1 /\
8001                u IN lp_space p m /\ v IN lp_space q m
8002            ==> integrable m (\x. u x * v x) /\
8003                integral m (\x. abs (u x * v x)) <= seminorm p m u * seminorm q m v
8004Proof
8005    rpt GEN_TAC >> STRIP_TAC
8006 >> ‘p <> 0 /\ q <> 0’ by rw [lt_imp_ne]
8007 >> ‘1 <= p /\ 1 <= q’ by PROVE_TAC [conjugate_properties]
8008 >> ‘0 <= p /\ 0 <= q’ by rw [lt_imp_le]
8009 >> ‘p <> NegInf /\ q <> NegInf’ by PROVE_TAC [pos_not_neginf]
8010 >> ‘u IN measurable (m_space m,measurable_sets m) Borel /\
8011     v IN measurable (m_space m,measurable_sets m) Borel’
8012       by gs [lp_space_def]
8013 (* special cases *)
8014 >> Cases_on ‘p = PosInf’
8015 >- (‘q = 1’ by PROVE_TAC [conjugate_properties] >> fs [] \\
8016     MATCH_MP_TAC Hoelder_inequality_lemma >> art [])
8017 >> Cases_on ‘q = PosInf’
8018 >- (‘p = 1’ by PROVE_TAC [conjugate_properties] >> fs [] \\
8019     ONCE_REWRITE_TAC [mul_comm] \\
8020     MATCH_MP_TAC Hoelder_inequality_lemma >> art [])
8021 (* stage work *)
8022 >> ‘seminorm p m u <> PosInf /\ seminorm p m u <> NegInf /\
8023     seminorm q m v <> PosInf /\ seminorm q m v <> NegInf’
8024       by PROVE_TAC [seminorm_not_infty]
8025 >> Suff ‘integral m (\x. abs (u x * v x)) <= seminorm p m u * seminorm q m v’
8026 >- (RW_TAC std_ss [] \\
8027     MATCH_MP_TAC integrable_from_abs >> ASM_SIMP_TAC std_ss [o_DEF] \\
8028     STRONG_CONJ_TAC
8029     >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES \\
8030         qexistsl_tac [‘u’, ‘v’] >> rw []) >> DISCH_TAC \\
8031     Q.ABBREV_TAC ‘g = \x. abs (u x * v x)’ \\
8032     Know ‘integrable m g <=>
8033           g IN Borel_measurable (m_space m,measurable_sets m) /\
8034           pos_fn_integral m g <> PosInf’
8035     >- (MATCH_MP_TAC integrable_pos >> rw [Abbr ‘g’, abs_pos]) >> Rewr' \\
8036     CONJ_TAC >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS \\
8037                  Q.EXISTS_TAC ‘\x. u x * v x’ >> rw [Abbr ‘g’]) \\
8038     Know ‘pos_fn_integral m g = integral m g’
8039     >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
8040         MATCH_MP_TAC integral_pos_fn >> rw [Abbr ‘g’, abs_pos]) >> Rewr' \\
8041     REWRITE_TAC [lt_infty] \\
8042     MATCH_MP_TAC let_trans \\
8043     Q.EXISTS_TAC ‘seminorm p m u * seminorm q m v’ >> art [] \\
8044     REWRITE_TAC [GSYM lt_infty] \\
8045    ‘?a. seminorm p m u = Normal a’ by METIS_TAC [extreal_cases] \\
8046    ‘?b. seminorm q m v = Normal b’ by METIS_TAC [extreal_cases] \\
8047     rw [extreal_mul_def, extreal_not_infty])
8048 >> Know ‘integral m (\x. abs (u x * v x)) = pos_fn_integral m (\x. abs (u x * v x))’
8049 >- (MATCH_MP_TAC integral_pos_fn >> rw [abs_pos])
8050 >> Rewr'
8051 (* special cases stop young_inequality from applicable (division by zero) *)
8052 >> Cases_on ‘seminorm p m u = 0’
8053 >- (rw [] \\
8054     Suff ‘pos_fn_integral m (\x. abs (u x * v x)) = 0’ >- rw [le_lt] \\
8055     POP_ASSUM MP_TAC \\
8056     ASM_SIMP_TAC std_ss [seminorm_normal] \\
8057     Know ‘pos_fn_integral m (\x. abs (u x) powr p) powr (inv p) = 0 <=>
8058           pos_fn_integral m (\x. abs (u x) powr p) = 0’
8059     >- (MATCH_MP_TAC powr_eq_0 \\
8060         rpt CONJ_TAC >| (* 3 subgoals *)
8061         [ (* goal 1 (of 3) *)
8062           MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos],
8063           (* goal 2 (of 3) *)
8064           rw [inv_pos'],
8065           (* goal 3 (of 3) *)
8066           METIS_TAC [inv_not_infty] ]) >> Rewr' \\
8067     Q.ABBREV_TAC ‘f = \x. abs (u x) powr p’ \\
8068     Know ‘f IN measurable (m_space m,measurable_sets m) Borel’
8069     >- (Q.UNABBREV_TAC ‘f’ \\
8070         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> art []) >> DISCH_TAC \\
8071     Know ‘pos_fn_integral m f = 0 <=>
8072           measure m {x | x IN m_space m /\ f x <> 0} = 0’
8073     >- (MATCH_MP_TAC pos_fn_integral_eq_0 >> rw [Abbr ‘f’, powr_pos]) >> Rewr' \\
8074    ‘measure m {x | x IN m_space m /\ f x <> 0} = 0 <=>
8075     AE x::m. (abs o f) x = 0’ by METIS_TAC [integral_abs_eq_0] >> POP_ORW \\
8076     POP_ASSUM K_TAC (* cleanup ‘f’ *) \\
8077     simp [Abbr ‘f’, powr_eq_0] >> rw [AE_ALT] \\
8078     Know ‘pos_fn_integral m (\x. abs (u x * v x)) = 0 <=>
8079           measure m {x | x IN m_space m /\ abs (u x * v x) <> 0} = 0’
8080     >- (HO_MATCH_MP_TAC pos_fn_integral_eq_0 >> rw [] \\
8081         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS \\
8082         Q.EXISTS_TAC ‘\x. u x * v x’ >> rw [] \\
8083         MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES' \\
8084         qexistsl_tac [‘u’, ‘v’] >> simp []) >> Rewr' \\
8085     rw [abs_not_zero] \\
8086     Know ‘{x | x IN m_space m /\ u x <> 0} IN measurable_sets m’
8087     >- (‘{x | x IN m_space m /\ u x <> 0} = {x | u x <> 0} INTER m_space m’
8088            by SET_TAC [] >> POP_ORW \\
8089         rw [IN_MEASURABLE_BOREL_ALL_MEASURE]) >> DISCH_TAC \\
8090     Know ‘{x | x IN m_space m /\ u x <> 0 /\ v x <> 0} IN measurable_sets m’
8091     >- (‘{x | x IN m_space m /\ u x <> 0 /\ v x <> 0} =
8092          {x | x IN m_space m /\ u x <> 0} INTER
8093          ({x | v x <> 0} INTER m_space m)’ by SET_TAC [] >> POP_ORW \\
8094         MATCH_MP_TAC MEASURE_SPACE_INTER \\
8095         rw [IN_MEASURABLE_BOREL_ALL_MEASURE]) >> DISCH_TAC \\
8096     reverse (rw [Once (GSYM le_antisym)])
8097     >- (Know ‘positive m’ >- PROVE_TAC [MEASURE_SPACE_POSITIVE] \\
8098         rw [positive_def]) \\
8099     MATCH_MP_TAC le_trans \\
8100     Q.EXISTS_TAC ‘measure m {x | x IN m_space m /\ u x <> 0}’ \\
8101     CONJ_TAC >- (MATCH_MP_TAC INCREASING \\
8102                  rw [MEASURE_SPACE_INCREASING, SUBSET_DEF]) \\
8103    ‘0 = measure m N’ by PROVE_TAC [null_set_def] \\
8104     POP_ASSUM
8105       (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites o wrap) \\
8106     MATCH_MP_TAC INCREASING >> rw [MEASURE_SPACE_INCREASING] \\
8107     fs [null_set_def])
8108 >> Cases_on ‘seminorm q m v = 0’ (* symmetric with above *)
8109 >- (rw [] \\
8110     Suff ‘pos_fn_integral m (\x. abs (u x * v x)) = 0’ >- rw [le_lt] \\
8111     POP_ASSUM MP_TAC \\
8112     ASM_SIMP_TAC std_ss [seminorm_normal] \\
8113     Know ‘pos_fn_integral m (\x. abs (v x) powr q) powr (inv q) = 0 <=>
8114           pos_fn_integral m (\x. abs (v x) powr q) = 0’
8115     >- (MATCH_MP_TAC powr_eq_0 \\
8116         rpt CONJ_TAC >| (* 3 subgoals *)
8117         [ (* goal 1 (of 3) *)
8118           MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos],
8119           (* goal 2 (of 3) *)
8120           rw [inv_pos'],
8121           (* goal 3 (of 3) *)
8122           METIS_TAC [inv_not_infty] ]) >> Rewr' \\
8123     Q.ABBREV_TAC ‘f = \x. abs (v x) powr q’ \\
8124     Know ‘f IN measurable (m_space m,measurable_sets m) Borel’
8125     >- (Q.UNABBREV_TAC ‘f’ \\
8126         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> art []) >> DISCH_TAC \\
8127     Know ‘pos_fn_integral m f = 0 <=>
8128           measure m {x | x IN m_space m /\ f x <> 0} = 0’
8129     >- (MATCH_MP_TAC pos_fn_integral_eq_0 >> rw [Abbr ‘f’, powr_pos]) >> Rewr' \\
8130    ‘measure m {x | x IN m_space m /\ f x <> 0} = 0 <=>
8131     AE x::m. (abs o f) x = 0’ by METIS_TAC [integral_abs_eq_0] >> POP_ORW \\
8132     POP_ASSUM K_TAC (* cleanup ‘f’ *) \\
8133     simp [Abbr ‘f’, powr_eq_0] >> rw [AE_ALT] \\
8134     Know ‘pos_fn_integral m (\x. abs (u x * v x)) = 0 <=>
8135           measure m {x | x IN m_space m /\ abs (u x * v x) <> 0} = 0’
8136     >- (HO_MATCH_MP_TAC pos_fn_integral_eq_0 >> rw [] \\
8137         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS \\
8138         Q.EXISTS_TAC ‘\x. u x * v x’ >> rw [] \\
8139         MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES' \\
8140         qexistsl_tac [‘u’, ‘v’] >> simp []) >> Rewr' \\
8141     rw [abs_not_zero] \\
8142     Know ‘{x | x IN m_space m /\ v x <> 0} IN measurable_sets m’
8143     >- (‘{x | x IN m_space m /\ v x <> 0} = {x | v x <> 0} INTER m_space m’
8144            by SET_TAC [] >> POP_ORW \\
8145         rw [IN_MEASURABLE_BOREL_ALL_MEASURE]) >> DISCH_TAC \\
8146     Know ‘{x | x IN m_space m /\ u x <> 0 /\ v x <> 0} IN measurable_sets m’
8147     >- (‘{x | x IN m_space m /\ u x <> 0 /\ v x <> 0} =
8148            ({x | u x <> 0} INTER m_space m) INTER
8149            {x | x IN m_space m /\ v x <> 0}’ by SET_TAC [] >> POP_ORW \\
8150         MATCH_MP_TAC MEASURE_SPACE_INTER \\
8151         rw [IN_MEASURABLE_BOREL_ALL_MEASURE]) >> DISCH_TAC \\
8152     reverse (rw [Once (GSYM le_antisym)])
8153     >- (Know ‘positive m’ >- PROVE_TAC [MEASURE_SPACE_POSITIVE] \\
8154         rw [positive_def]) \\
8155     MATCH_MP_TAC le_trans \\
8156     Q.EXISTS_TAC ‘measure m {x | x IN m_space m /\ v x <> 0}’ \\
8157     CONJ_TAC >- (MATCH_MP_TAC INCREASING \\
8158                  rw [MEASURE_SPACE_INCREASING, SUBSET_DEF]) \\
8159    ‘0 = measure m N’ by PROVE_TAC [null_set_def] \\
8160     POP_ASSUM
8161       (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites o wrap) \\
8162     MATCH_MP_TAC INCREASING >> rw [MEASURE_SPACE_INCREASING] \\
8163     fs [null_set_def])
8164 >> ‘0 <= seminorm p m u /\ 0 <= seminorm q m v’ by PROVE_TAC [seminorm_pos]
8165 >> ‘0 < seminorm p m u /\ 0 < seminorm q m v’ by PROVE_TAC [le_lt]
8166 (* stage work (for ‘p <> PosInf /\ q <> PosInf’) *)
8167 >> Q.ABBREV_TAC ‘A = \x. abs (u x) / seminorm p m u’
8168 >> Q.ABBREV_TAC ‘B = \x. abs (v x) / seminorm q m v’
8169 >> Know ‘!x. 0 <= A x’
8170 >- (rw [Abbr ‘A’] \\
8171    ‘?r. 0 < r /\ seminorm p m u = Normal r’
8172       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
8173     POP_ORW \\
8174     MATCH_MP_TAC le_div >> rw [abs_pos])
8175 >> DISCH_TAC
8176 >> Know ‘!x. 0 <= B x’
8177 >- (rw [Abbr ‘B’] \\
8178    ‘?r. 0 < r /\ seminorm q m v = Normal r’
8179       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
8180     POP_ORW \\
8181     MATCH_MP_TAC le_div >> rw [abs_pos])
8182 >> DISCH_TAC
8183 >> Know ‘!x. A x * B x <= (A x) powr p / p + (B x) powr q / q’
8184 >- (Q.X_GEN_TAC ‘x’ \\
8185     MP_TAC (Q.SPECL [‘A x’, ‘B x’, ‘p’, ‘q’] young_inequality) \\
8186     RW_TAC std_ss [])
8187 >> DISCH_TAC
8188 >> Know ‘pos_fn_integral m (\x. A x * B x) <=
8189          pos_fn_integral m (\x. A x powr p / p + B x powr q / q)’
8190 >- (MATCH_MP_TAC pos_fn_integral_mono >> rw [] \\
8191     MATCH_MP_TAC le_mul >> art [])
8192 >> POP_ASSUM K_TAC
8193 >> ‘seminorm p m u * seminorm q m v <> 0’ by METIS_TAC [entire]
8194 >> ‘0 <= seminorm p m u * seminorm q m v’ by PROVE_TAC [le_mul]
8195 >> ‘0 < seminorm p m u * seminorm q m v’ by PROVE_TAC [le_lt]
8196 >> ‘seminorm p m u * seminorm q m v <> NegInf’ by PROVE_TAC [pos_not_neginf]
8197 >> Know ‘seminorm p m u * seminorm q m v <> PosInf’
8198 >- (‘?a. seminorm p m u = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW \\
8199     ‘?b. seminorm q m v = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW \\
8200     rw [extreal_mul_def])
8201 >> DISCH_TAC
8202 >> Know ‘pos_fn_integral m (\x. A x * B x) =
8203          pos_fn_integral m (\x. abs (u x * v x)) / (seminorm p m u * seminorm q m v)’
8204 >- (simp [Abbr ‘A’, Abbr ‘B’] \\
8205     Know ‘!x. abs (u x) / seminorm p m u * (abs (v x) / seminorm q m v) =
8206               abs (u x * v x) / (seminorm p m u * seminorm q m v)’
8207     >- (Q.X_GEN_TAC ‘x’ \\
8208        ‘?a. a <> 0 /\ seminorm p m u = Normal a’
8209           by METIS_TAC [extreal_cases, extreal_of_num_def] \\
8210         POP_ORW \\
8211        ‘?b. b <> 0 /\ seminorm q m v = Normal b’
8212           by METIS_TAC [extreal_cases, extreal_of_num_def] \\
8213         POP_ORW \\
8214        ‘a * b <> 0’ by PROVE_TAC [REAL_ENTIRE] \\
8215         rw [extreal_div_def, extreal_mul_def, abs_mul] \\
8216         Know ‘inv (Normal (a * b)) = inv (Normal a) * inv (Normal b)’
8217         >- (rw [extreal_inv_def, extreal_mul_def]) >> Rewr' \\
8218         METIS_TAC [mul_comm, mul_assoc]) >> Rewr' \\
8219    ‘?r. 0 < r /\ seminorm p m u * seminorm q m v = Normal r’
8220        by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8221    ‘r <> 0’ by PROVE_TAC [REAL_LT_IMP_NE] \\
8222     rw [extreal_div_def, extreal_inv_def] \\
8223     ONCE_REWRITE_TAC [mul_comm] \\
8224     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [abs_pos] \\
8225     MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
8226 >> Rewr'
8227 >> Know ‘pos_fn_integral m (\x. A x powr p / p + B x powr q / q) =
8228          pos_fn_integral m (\x. A x powr p / p) +
8229          pos_fn_integral m (\x. B x powr q / q)’
8230 >- (HO_MATCH_MP_TAC pos_fn_integral_add \\
8231     RW_TAC bool_ss [] >| (* 4 subgoals *)
8232     [ (* goal 1 (of 4) *)
8233      ‘?r. 0 < r /\ p = Normal r’
8234         by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8235       MATCH_MP_TAC le_div >> art [powr_pos],
8236       (* goal 2 (of 4) *)
8237      ‘?r. 0 < r /\ q = Normal r’
8238         by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8239       MATCH_MP_TAC le_div >> art [powr_pos],
8240       (* goal 3 (of 4) *)
8241       NTAC 5 (POP_ASSUM K_TAC) (* all about ‘seminorm p m u * seminorm q m v’ *) \\
8242       rw [Abbr ‘A’] \\
8243      ‘?r. 0 < r /\ seminorm p m u = Normal r’
8244         by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8245      ‘r <> 0’ by rw [REAL_LT_IMP_NE] \\
8246       rw [extreal_div_def, extreal_inv_def] \\
8247       Know ‘!x. (abs (u x) * Normal (inv r)) powr p =
8248                 (abs (u x)) powr p * Normal (inv r) powr p’
8249       >- (Q.X_GEN_TAC ‘x’ >> MATCH_MP_TAC mul_powr \\
8250           rw [extreal_of_num_def, extreal_le_eq, REAL_LT_IMP_LE]) >> Rewr' \\
8251      ‘?P. 0 < P /\ p = Normal P’
8252         by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8253      ‘P <> 0’ by rw [REAL_LT_IMP_NE] \\
8254      ‘0 < inv r’ by rw [REAL_INV_POS] \\
8255       rw [extreal_div_def, extreal_inv_def, extreal_mul_def, normal_powr, GSYM mul_assoc] \\
8256       MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
8257       qexistsl_tac [‘\x. abs (u x) powr Normal P’, ‘inv P * inv r powr P’] \\
8258       RW_TAC std_ss [] >| (* 3 subgoals *)
8259       [ (* goal 3.1 (of 3) *)
8260         simp [],
8261         (* goal 3.2 (of 3) *)
8262         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR \\
8263        ‘0 <= P’ by rw [REAL_LT_IMP_LE] \\
8264         rw [extreal_of_num_def, extreal_le_eq],
8265         (* goal 3.3 (of 3) *)
8266         PROVE_TAC [mul_comm] ],
8267       (* goal 4 (of 4) *)
8268       NTAC 5 (POP_ASSUM K_TAC) (* all about ‘seminorm p m u * seminorm q m v’ *) \\
8269       rw [Abbr ‘B’] \\
8270      ‘?r. 0 < r /\ seminorm q m v = Normal r’
8271         by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8272      ‘r <> 0’ by rw [REAL_LT_IMP_NE] \\
8273       rw [extreal_div_def, extreal_inv_def] \\
8274       Know ‘!x. (abs (v x) * Normal (inv r)) powr q =
8275                 (abs (v x)) powr q * Normal (inv r) powr q’
8276       >- (Q.X_GEN_TAC ‘x’ >> MATCH_MP_TAC mul_powr \\
8277           rw [extreal_of_num_def, extreal_le_eq, REAL_LT_IMP_LE]) >> Rewr' \\
8278      ‘?Q. 0 < Q /\ q = Normal Q’
8279         by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8280      ‘Q <> 0’ by rw [REAL_LT_IMP_NE] \\
8281      ‘0 < inv r’ by rw [REAL_INV_POS] \\
8282       rw [extreal_div_def, extreal_inv_def, extreal_mul_def, normal_powr,
8283           GSYM mul_assoc] \\
8284       MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
8285       qexistsl_tac [‘\x. abs (v x) powr Normal Q’, ‘inv Q * inv r powr Q’] \\
8286       RW_TAC std_ss [] >| (* 3 subgoals *)
8287       [ (* goal 4.1 (of 3) *)
8288         simp [],
8289         (* goal 4.2 (of 3) *)
8290         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR \\
8291        ‘0 <= Q’ by rw [REAL_LT_IMP_LE] \\
8292         rw [extreal_of_num_def, extreal_le_eq],
8293         (* goal 4.3 (of 3) *)
8294         PROVE_TAC [mul_comm] ] ])
8295 >> Rewr'
8296 >> Suff ‘pos_fn_integral m (\x. A x powr p / p) = inv p /\
8297          pos_fn_integral m (\x. B x powr q / q) = inv q’
8298 >- (Rewr' >> art [] \\
8299    ‘?r. 0 < r /\ seminorm p m u * seminorm q m v = Normal r’
8300       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8301     Know ‘pos_fn_integral m (\x. abs (u x * v x)) / Normal r <= 1 <=>
8302           pos_fn_integral m (\x. abs (u x * v x)) <= 1 * Normal r’
8303     >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
8304         MATCH_MP_TAC le_ldiv >> art []) >> Rewr' >> rw [])
8305 >> Know ‘pos_fn_integral m (\x. A x powr p / p) =
8306          inv p * pos_fn_integral m (\x. A x powr p)’
8307 >- (‘?r. 0 < r /\ p = Normal r’
8308        by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8309     ‘r <> 0’ by PROVE_TAC [REAL_LT_IMP_NE] \\
8310     rw [extreal_div_def, extreal_inv_def, Once mul_comm] \\
8311     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [powr_pos] \\
8312     MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
8313 >> Rewr'
8314 >> Know ‘pos_fn_integral m (\x. B x powr q / q) =
8315          inv q * pos_fn_integral m (\x. B x powr q)’
8316 >- (‘?r. 0 < r /\ q = Normal r’
8317        by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] >> POP_ORW \\
8318     ‘r <> 0’ by PROVE_TAC [REAL_LT_IMP_NE] \\
8319     rw [extreal_div_def, extreal_inv_def, Once mul_comm] \\
8320     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [powr_pos] \\
8321     MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
8322 >> Rewr'
8323 >> Suff ‘pos_fn_integral m (\x. A x powr p) = 1 /\
8324          pos_fn_integral m (\x. B x powr q) = 1’ >- rw []
8325 (* final stage *)
8326 >> FULL_SIMP_TAC std_ss [Abbr ‘A’, Abbr ‘B’]
8327 >> NTAC 5 (POP_ASSUM K_TAC) (* all about ‘seminorm p m u * seminorm q m v’ *)
8328 >> CONJ_TAC (* 2 subgoals *)
8329 >| [ (* goal 1 (of 2) *)
8330      Know ‘!x. abs (u x) / seminorm p m u = abs (u x) * inv (seminorm p m u)’
8331      >- (‘?r. 0 < r /\ seminorm p m u = Normal r’
8332            by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
8333          POP_ORW >> ‘r <> 0’ by rw [REAL_LT_IMP_NE] \\
8334          rw [extreal_div_def]) >> Rewr' \\
8335      Know ‘!x. (abs (u x) * inv (seminorm p m u)) powr p =
8336                (abs (u x)) powr p * (inv (seminorm p m u)) powr p’
8337      >- (Q.X_GEN_TAC ‘x’ \\
8338          MATCH_MP_TAC mul_powr >> rw [le_inv]) >> Rewr' \\
8339      Know ‘inv (seminorm p m u) powr p = inv ((seminorm p m u) powr p)’
8340      >- (MATCH_MP_TAC inv_powr >> art []) >> Rewr' \\
8341      Know ‘seminorm p m u powr p = pos_fn_integral m (\x. abs (u x) powr p)’
8342      >- (MATCH_MP_TAC seminorm_powr >> art []) >> Rewr' \\
8343      Q.ABBREV_TAC ‘c = pos_fn_integral m (\x. abs (u x) powr p)’ \\
8344      Know ‘c <> 0’
8345      >- (SPOSE_NOT_THEN (ASSUME_TAC o REWRITE_RULE []) \\
8346          Suff ‘seminorm p m u = 0’ >- PROVE_TAC [] \\
8347          Q.PAT_X_ASSUM ‘seminorm p m u <> 0’ K_TAC \\
8348         ‘0 < inv p’ by PROVE_TAC [inv_pos'] \\
8349          ASM_SIMP_TAC std_ss [seminorm_normal, zero_rpow]) >> DISCH_TAC \\
8350      Know ‘inv c <> PosInf /\ inv c <> NegInf’
8351      >- (MATCH_MP_TAC inv_not_infty >> art []) >> STRIP_TAC \\
8352      ONCE_REWRITE_TAC [mul_comm] \\
8353      Know ‘0 <= c’
8354      >- (Q.UNABBREV_TAC ‘c’ \\
8355          MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos]) >> DISCH_TAC \\
8356     ‘0 < c’ by PROVE_TAC [le_lt] \\
8357     ‘0 <= inv c’ by PROVE_TAC [le_inv] \\
8358      Know ‘pos_fn_integral m (\x. inv c * abs (u x) powr p) =
8359            inv c * pos_fn_integral m (\x. abs (u x) powr p)’
8360      >- (‘?r. 0 <= r /\ inv c = Normal r’
8361            by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq] \\
8362          POP_ORW \\
8363          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [powr_pos]) >> Rewr' \\
8364      simp [] (* inv c * c = 1 *) \\
8365      MATCH_MP_TAC mul_linv_pos >> art [] \\
8366      Q.UNABBREV_TAC ‘c’ \\
8367      METIS_TAC [lp_space_alt_finite],
8368      (* goal 2 (of 2), symmetric with above *)
8369      Know ‘!x. abs (v x) / seminorm q m v = abs (v x) * inv (seminorm q m v)’
8370      >- (‘?r. 0 < r /\ seminorm q m v = Normal r’
8371            by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
8372          POP_ORW >> ‘r <> 0’ by rw [REAL_LT_IMP_NE] \\
8373          rw [extreal_div_def]) >> Rewr' \\
8374      Know ‘!x. (abs (v x) * inv (seminorm q m v)) powr q =
8375                (abs (v x)) powr q * (inv (seminorm q m v)) powr q’
8376      >- (Q.X_GEN_TAC ‘x’ \\
8377          MATCH_MP_TAC mul_powr >> rw [le_inv]) >> Rewr' \\
8378      Know ‘inv (seminorm q m v) powr q = inv ((seminorm q m v) powr q)’
8379      >- (MATCH_MP_TAC inv_powr >> art []) >> Rewr' \\
8380      Know ‘seminorm q m v powr q = pos_fn_integral m (\x. abs (v x) powr q)’
8381      >- (MATCH_MP_TAC seminorm_powr >> art []) >> Rewr' \\
8382      Q.ABBREV_TAC ‘c = pos_fn_integral m (\x. abs (v x) powr q)’ \\
8383      Know ‘c <> 0’
8384      >- (SPOSE_NOT_THEN (ASSUME_TAC o REWRITE_RULE []) \\
8385          Suff ‘seminorm q m v = 0’ >- PROVE_TAC [] \\
8386          Q.PAT_X_ASSUM ‘seminorm q m v <> 0’ K_TAC \\
8387         ‘0 < inv q’ by PROVE_TAC [inv_pos'] \\
8388          ASM_SIMP_TAC std_ss [seminorm_normal, zero_rpow]) >> DISCH_TAC \\
8389      Know ‘inv c <> PosInf /\ inv c <> NegInf’
8390      >- (MATCH_MP_TAC inv_not_infty >> art []) >> STRIP_TAC \\
8391      ONCE_REWRITE_TAC [mul_comm] \\
8392      Know ‘0 <= c’
8393      >- (Q.UNABBREV_TAC ‘c’ \\
8394          MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos]) >> DISCH_TAC \\
8395     ‘0 < c’ by PROVE_TAC [le_lt] \\
8396     ‘0 <= inv c’ by PROVE_TAC [le_inv] \\
8397      Know ‘pos_fn_integral m (\x. inv c * abs (v x) powr q) =
8398            inv c * pos_fn_integral m (\x. abs (v x) powr q)’
8399      >- (‘?r. 0 <= r /\ inv c = Normal r’
8400            by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_le_eq] \\
8401          POP_ORW \\
8402          HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [powr_pos]) >> Rewr' \\
8403      simp [] (* inv c * c = 1 *) \\
8404      MATCH_MP_TAC mul_linv_pos >> art [] \\
8405      Q.UNABBREV_TAC ‘c’ \\
8406      METIS_TAC [lp_space_alt_finite] ]
8407QED
8408
8409(* A more convenient version (only the 2nd part) using ‘pos_fn_integral’ *)
8410Theorem Hoelder_inequality' :
8411    !m u v p q. measure_space m /\ 0 < p /\ 0 < q /\ inv(p) + inv(q) = 1 /\
8412                u IN lp_space p m /\ v IN lp_space q m
8413            ==> pos_fn_integral m (\x. abs (u x * v x)) <=
8414                seminorm p m u * seminorm q m v
8415Proof
8416    rpt STRIP_TAC
8417 >> Suff ‘pos_fn_integral m (\x. abs (u x * v x)) = integral m (\x. abs (u x * v x))’
8418 >- METIS_TAC [Hoelder_inequality]
8419 >> MATCH_MP_TAC (GSYM integral_pos_fn)
8420 >> rw [abs_pos]
8421QED
8422
8423(* Cauchy-Schwarz Inequality as a corollary of Hoelder's Inequality (p = q = 2)
8424
8425   see, e.g., Corollary 13.3 (Cauchy-Schwarz inequality) [1, p.118]
8426 *)
8427Theorem Cauchy_Schwarz_inequality :
8428    !m u v. measure_space m /\ u IN L2_space m /\ v IN L2_space m ==>
8429            integrable m (\x. u x * v x) /\
8430            integral m (\x. abs (u x * v x)) <= seminorm 2 m u * seminorm 2 m v
8431Proof
8432    rpt GEN_TAC >> STRIP_TAC
8433 >> MATCH_MP_TAC Hoelder_inequality
8434 >> simp [inv_1over, half_double, GSYM ne_02]
8435QED
8436
8437(* A more convenient version (only the 2nd part) using ‘pos_fn_integral’, ‘pow’ and
8438  ‘sqrt’ instead of ‘seminorm’, also with ‘abs’ eliminated inside ‘pow 2’.
8439 *)
8440Theorem Cauchy_Schwarz_inequality' :
8441    !m u v. measure_space m /\ u IN L2_space m /\ v IN L2_space m
8442        ==> pos_fn_integral m (\x. abs (u x * v x)) <=
8443            sqrt (pos_fn_integral m (\x. (u x) pow 2) *
8444                  pos_fn_integral m (\x. (v x) pow 2))
8445Proof
8446    rpt STRIP_TAC
8447 >> Know ‘pos_fn_integral m (\x. abs (u x * v x)) = integral m (\x. abs (u x * v x))’
8448 >- (MATCH_MP_TAC (GSYM integral_pos_fn) >> rw [abs_pos])
8449 >> Rewr'
8450 >> Suff ‘sqrt (pos_fn_integral m (\x. (u x) pow 2) *
8451                pos_fn_integral m (\x. (v x) pow 2)) =
8452          seminorm 2 m u * seminorm 2 m v’
8453 >- METIS_TAC [Cauchy_Schwarz_inequality]
8454 >> ASM_SIMP_TAC std_ss [seminorm_two]
8455 >> Q.ABBREV_TAC ‘A = pos_fn_integral m (\x. (u x) pow 2)’
8456 >> Q.ABBREV_TAC ‘B = pos_fn_integral m (\x. (v x) pow 2)’
8457 >> Know ‘0 <= A /\ 0 <= B’
8458 >- (RW_TAC std_ss [Abbr ‘A’, Abbr ‘B’] \\
8459     MATCH_MP_TAC pos_fn_integral_pos >> rw [le_pow2])
8460 >> RW_TAC std_ss [sqrt_mul]
8461QED
8462
8463(* This is the first part of Minkowski's inequality
8464
8465   NOTE: ‘0 < p’ doesn't hold for Minkowski's inequality but hold for this lemma.
8466 *)
8467Theorem lp_space_add :
8468    !p m u v. measure_space m /\ 0 < p /\ u IN lp_space p m /\ v IN lp_space p m
8469          ==> (\x. u x + v x) IN lp_space p m
8470Proof
8471    rpt GEN_TAC >> STRIP_TAC
8472 >> ‘0 <= p’ by PROVE_TAC [lt_imp_le]
8473 >> ‘p <> NegInf’ by PROVE_TAC [pos_not_neginf]
8474  (* special case: p = PosInf *)
8475 >> Cases_on ‘p = PosInf’
8476 >- (Q.PAT_X_ASSUM ‘u IN lp_space p m’ MP_TAC \\
8477     Q.PAT_X_ASSUM ‘v IN lp_space p m’ MP_TAC \\
8478     rw [lp_space_alt_infinite]
8479     >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD' \\
8480         qexistsl_tac [‘u’, ‘v’] >> simp []) \\
8481     Q.PAT_X_ASSUM ‘AE x::m. abs (v x) < c’ MP_TAC \\
8482     rename1 ‘AE x::m. abs (u x) < d’ \\
8483     Q.PAT_X_ASSUM ‘AE x::m. abs (u x) < d’ MP_TAC \\
8484     rw [AE_DEF] \\
8485     Q.EXISTS_TAC ‘d + c’ \\
8486     CONJ_TAC >- PROVE_TAC [lt_add] \\
8487     CONJ_TAC >- PROVE_TAC [add_not_infty] \\
8488     Q.EXISTS_TAC ‘N UNION N'’ \\
8489     rw [NULL_SET_UNION', GSYM extreal_add_def] \\
8490     MATCH_MP_TAC let_trans \\
8491     Q.EXISTS_TAC ‘abs (u x) + abs (v x)’ \\
8492     rw [lt_add2, abs_triangle_full])
8493 (* general case: p <> PosInf *)
8494 >> rw [lp_space_alt_finite]
8495 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD' (* key result *) \\
8496     qexistsl_tac [‘u’, ‘v’] >> simp [] \\
8497     gs [lp_space_alt_finite, measure_space_def])
8498 >> REWRITE_TAC [lt_infty]
8499 >> MATCH_MP_TAC let_trans
8500 >> Q.EXISTS_TAC ‘pos_fn_integral m
8501                   (\x. 2 powr p * (abs (u x) powr p + abs (v x) powr p))’
8502 >> reverse CONJ_TAC (* easy goal first *)
8503 >- (gs [lp_space_alt_finite] \\
8504     Know ‘?c. 0 <= c /\ 2 powr p = Normal c’
8505     >- (‘?r. 0 < r /\ p = Normal r’
8506            by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
8507         POP_ORW \\
8508         rw [extreal_of_num_def, normal_powr] \\
8509         MATCH_MP_TAC REAL_LT_IMP_LE \\
8510         MATCH_MP_TAC RPOW_POS_LT >> rw []) >> STRIP_TAC >> POP_ORW \\
8511     Know ‘pos_fn_integral m (\x. Normal c * (abs (u x) powr p + abs (v x) powr p)) =
8512           Normal c * pos_fn_integral m (\x. abs (u x) powr p + abs (v x) powr p)’
8513     >- (HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [] \\
8514         MATCH_MP_TAC le_add >> rw [powr_pos]) >> Rewr' \\
8515     Suff ‘pos_fn_integral m (\x. abs (u x) powr p + abs (v x) powr p) <> PosInf’
8516     >- (DISCH_TAC \\
8517         Know ‘pos_fn_integral m (\x. abs (u x) powr p + abs (v x) powr p) <> NegInf’
8518         >- (MATCH_MP_TAC pos_not_neginf \\
8519             MATCH_MP_TAC pos_fn_integral_pos >> rw [le_add, powr_pos]) \\
8520         DISCH_TAC \\
8521        ‘?r. pos_fn_integral m (\x. abs (u x) powr p + abs (v x) powr p) = Normal r’
8522           by METIS_TAC [extreal_cases] >> POP_ORW \\
8523         rw [extreal_mul_def, lt_infty]) \\
8524     Q.PAT_X_ASSUM ‘0 <= c’ K_TAC \\
8525     Know ‘pos_fn_integral m (\x. abs (u x) powr p + abs (v x) powr p) =
8526           pos_fn_integral m (\x. abs (u x) powr p) +
8527           pos_fn_integral m (\x. abs (v x) powr p)’
8528     >- (HO_MATCH_MP_TAC pos_fn_integral_add \\
8529         rw [powr_pos] \\ (* 2 subgoals, same tactics *)
8530         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw []) >> Rewr' \\
8531     Know ‘pos_fn_integral m (\x. abs (u x) powr p) <> NegInf /\
8532           pos_fn_integral m (\x. abs (v x) powr p) <> NegInf’
8533     >- (CONJ_TAC \\ (* 2 subgoals, same tactics *)
8534         MATCH_MP_TAC pos_not_neginf \\
8535         MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos]) >> STRIP_TAC \\
8536    ‘?a. pos_fn_integral m (\x. abs (u x) powr p) = Normal a’
8537       by METIS_TAC [extreal_cases] >> POP_ORW \\
8538    ‘?b. pos_fn_integral m (\x. abs (v x) powr p) = Normal b’
8539       by METIS_TAC [extreal_cases] >> POP_ORW \\
8540     rw [extreal_add_def])
8541 (* applying pos_fn_integral_mono_AE *)
8542 >> MATCH_MP_TAC pos_fn_integral_mono_AE
8543 >> rw [powr_pos]
8544 >- (MATCH_MP_TAC le_mul >> art [powr_pos] \\
8545     MATCH_MP_TAC le_add >> art [powr_pos])
8546 >> gs [lp_space_alt_finite]
8547 >> Know ‘null_set m {x | x IN m_space m /\ abs (u x) powr p = PosInf} /\
8548          null_set m {x | x IN m_space m /\ abs (v x) powr p = PosInf}’
8549 >- (CONJ_TAC (* 2 subgoals, same tactics *) \\
8550     HO_MATCH_MP_TAC pos_fn_integral_infty_null >> rw [powr_pos] \\
8551     MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw [])
8552 >> rw [AE_DEF]
8553 >> Q.EXISTS_TAC ‘{x | x IN m_space m /\ abs (u x) powr p = PosInf} UNION
8554                  {x | x IN m_space m /\ abs (v x) powr p = PosInf}’
8555 >> CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [IN_APP] NULL_SET_UNION) >> art [])
8556 >> rw [GSPECIFICATION]
8557 >> Know ‘u x <> PosInf /\ u x <> NegInf /\ v x <> PosInf /\ v x <> NegInf’
8558 >- (rpt CONJ_TAC >> CCONTR_TAC \\
8559     gs [extreal_abs_def, infty_powr])
8560 >> STRIP_TAC
8561 >> ‘?a. u x = Normal a’ by METIS_TAC [extreal_cases] >> POP_ORW
8562 >> ‘?b. v x = Normal b’ by METIS_TAC [extreal_cases] >> POP_ORW
8563 >> rw [extreal_add_def]
8564 (* special cases *)
8565 >> Cases_on ‘a + b = 0’
8566 >- (rw [GSYM extreal_of_num_def, zero_rpow] \\
8567     MATCH_MP_TAC le_mul >> rw [powr_pos] \\
8568     MATCH_MP_TAC le_add >> rw [powr_pos])
8569 >> Cases_on ‘a = 0’
8570 >- (rw [GSYM extreal_of_num_def, zero_rpow] \\
8571     GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [GSYM mul_lone] \\
8572     MATCH_MP_TAC le_rmul_imp >> rw [powr_pos] \\
8573     MATCH_MP_TAC powr_ge_1 >> rw [extreal_of_num_def, extreal_le_eq])
8574 >> Cases_on ‘b = 0’
8575 >- (rw [GSYM extreal_of_num_def, zero_rpow] \\
8576     GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [GSYM mul_lone] \\
8577     MATCH_MP_TAC le_rmul_imp >> rw [powr_pos] \\
8578     MATCH_MP_TAC powr_ge_1 >> rw [extreal_of_num_def, extreal_le_eq])
8579 >> ‘?r. 0 < r /\ p = Normal r’
8580       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq]
8581 >> POP_ORW
8582 >> rw [extreal_abs_def]
8583 >> ‘0 < abs (a + b) /\ 0 < abs a /\ 0 < abs b’ by rw []
8584 >> rw [normal_powr, extreal_of_num_def, extreal_add_def, extreal_mul_def,
8585        extreal_le_eq]
8586 >> ONCE_REWRITE_TAC [REAL_MUL_COMM]
8587 (* below is real-only *)
8588 >> MATCH_MP_TAC REAL_LE_TRANS
8589 >> Q.EXISTS_TAC ‘(max (abs a powr r) (abs b powr r)) * 2 powr r’
8590 >> reverse CONJ_TAC
8591 >- (MATCH_MP_TAC REAL_LE_RMUL_IMP \\
8592     CONJ_TAC >- (MATCH_MP_TAC REAL_LT_IMP_LE \\
8593                  MATCH_MP_TAC RPOW_POS_LT >> rw []) \\
8594     rw [REAL_MAX_LE] (* 2 subgoals, same tactics *) \\
8595     MATCH_MP_TAC REAL_LT_IMP_LE \\
8596     MATCH_MP_TAC RPOW_POS_LT >> art [])
8597 >> Know ‘max (abs a powr r) (abs b powr r) = (max (abs a) (abs b)) powr r’
8598 >- (Cases_on ‘abs a <= abs b’
8599     >- (‘abs a powr r <= abs b powr r’ by rw [BASE_RPOW_LE] \\
8600         rw [max_def]) \\
8601    ‘~(abs a powr r <= abs b powr r)’ by rw [BASE_RPOW_LE] \\
8602     rw [max_def])
8603 >> Rewr'
8604 >> ‘0 < max (abs a) (abs b)’ by rw [REAL_LT_MAX]
8605 >> rw [GSYM RPOW_MUL]
8606 >> ‘0 < 2 * max (abs a) (abs b)’ by rw [REAL_LT_MUL]
8607 >> rw [BASE_RPOW_LE]
8608 >> MATCH_MP_TAC REAL_LE_TRANS
8609 >> Q.EXISTS_TAC ‘abs a + abs b’
8610 >> rw [ABS_TRIANGLE, GSYM REAL_DOUBLE]
8611 >> Cases_on ‘abs a <= abs b’ >> rw [max_def]
8612 >> FULL_SIMP_TAC std_ss [GSYM real_lt]
8613 >> MATCH_MP_TAC REAL_LT_IMP_LE >> art []
8614QED
8615
8616(* Minkowski's Inequality (or triangle inequality of seminorm)
8617
8618   see, e.g., Corollary 13.4 (Minkowski's inequality) [1, p.118]
8619
8620   NOTE: This inequality does NOT hold when ‘0 < p < 1’, where the inequality
8621         became ‘seminorm p m u + seminorm p m v <= seminorm p m (\x. u x + v x)’,
8622         namely "Reversed Minkowski's Inequality" (less useful), which can be proven
8623         from the present Minkowski_inequality by considering u and (\x. 1 / v x).
8624 *)
8625Theorem Minkowski_inequality :
8626    !p m u v. measure_space m /\ 1 <= p /\ u IN lp_space p m /\ v IN lp_space p m
8627          ==> (\x. u x + v x) IN lp_space p m /\
8628              seminorm p m (\x. u x + v x) <= seminorm p m u + seminorm p m v
8629Proof
8630    rpt GEN_TAC >> STRIP_TAC
8631 >> ‘0 < p’ by PROVE_TAC [lt_01, lte_trans]
8632 >> STRONG_CONJ_TAC
8633 >- (MATCH_MP_TAC lp_space_add >> art [])
8634 >> DISCH_TAC
8635 (* special case *)
8636 >> Cases_on ‘p = PosInf’
8637 >- (POP_ASSUM (FULL_SIMP_TAC std_ss o wrap) \\
8638    ‘u IN measurable (m_space m,measurable_sets m) Borel /\
8639     v IN measurable (m_space m,measurable_sets m) Borel’ by fs [lp_space_def] \\
8640    ‘(AE x::m. abs (u x) <= seminorm PosInf m u) /\
8641     (AE x::m. abs (v x) <= seminorm PosInf m v)’
8642       by METIS_TAC [seminorm_infty_AE_bound] \\
8643     Q.ABBREV_TAC ‘cu = seminorm PosInf m u’ \\
8644     Q.ABBREV_TAC ‘cv = seminorm PosInf m v’ \\
8645     rw [seminorm_infty, inf_le'] \\
8646     MATCH_MP_TAC le_epsilon >> rpt STRIP_TAC \\
8647     FIRST_X_ASSUM MATCH_MP_TAC \\
8648     CONJ_TAC >- (MATCH_MP_TAC lte_trans >> Q.EXISTS_TAC ‘e’ >> art [] \\
8649                  MATCH_MP_TAC le_addl_imp \\
8650                  MATCH_MP_TAC le_add \\
8651                 ‘0 < PosInf’ by rw [] \\
8652                  rw [seminorm_pos, Abbr ‘cu’, Abbr ‘cv’]) \\
8653     Q.ABBREV_TAC ‘P = \x. abs (u x + v x) < cu + cv + e’ \\
8654    ‘{x | x IN m_space m /\ cu + cv + e <= abs (u x + v x)} =
8655     {x | x IN m_space m /\ ~P x}’
8656        by rw [Abbr ‘P’, extreal_lt_def] >> POP_ORW \\
8657     Know ‘measure m {x | x IN m_space m /\ ~P x} = 0 <=> (AE x::m. P x)’
8658     >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
8659         MATCH_MP_TAC AE_iff_measurable >> rw [Abbr ‘P’, extreal_lt_def] \\
8660         Q.ABBREV_TAC ‘f = (\x. u x + v x)’ \\
8661        ‘sigma_algebra (measurable_space m)’
8662           by PROVE_TAC [MEASURE_SPACE_SIGMA_ALGEBRA] \\
8663        ‘f IN Borel_measurable (measurable_space m)’ by fs [lp_space_def] \\
8664         rw [le_abs_bounds] \\
8665        ‘{x | x IN m_space m /\ (f x <= -(cu + cv + e) \/ cu + cv + e <= f x)} =
8666           ({x | f x <= -(cu + cv + e)} INTER m_space m) UNION
8667           ({x | cu + cv + e <= f x} INTER m_space m)’ by SET_TAC [] >> POP_ORW \\
8668         MATCH_MP_TAC MEASURE_SPACE_UNION >> art [] \\
8669         METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE]) >> Rewr' \\
8670     simp [Abbr ‘P’] \\
8671  (* applying abs_triangle *)
8672    ‘0 < PosInf’ by rw [] \\
8673    ‘cu <> PosInf /\ cu <> NegInf’ by METIS_TAC [seminorm_not_infty] \\
8674    ‘cv <> PosInf /\ cv <> NegInf’ by METIS_TAC [seminorm_not_infty] \\
8675     Q.PAT_X_ASSUM ‘AE x::m. abs (u x) <= cu’ MP_TAC \\
8676     Q.PAT_X_ASSUM ‘AE x::m. abs (v x) <= cv’ MP_TAC \\
8677     rw [AE_DEF] \\
8678     Q.EXISTS_TAC ‘N UNION N'’ \\
8679     CONJ_TAC >- (MATCH_MP_TAC NULL_SET_UNION' >> art []) \\
8680     rw [] >> MATCH_MP_TAC let_trans >> Q.EXISTS_TAC ‘cu + cv’ \\
8681     reverse CONJ_TAC >- (MATCH_MP_TAC lt_addr_imp >> art [] \\
8682                          METIS_TAC [add_not_infty]) \\
8683     MATCH_MP_TAC le_trans >> Q.EXISTS_TAC ‘abs (u x) + abs (v x)’ \\
8684     reverse CONJ_TAC >- (MATCH_MP_TAC le_add2 >> rw []) \\
8685     MATCH_MP_TAC abs_triangle \\
8686    ‘abs (u x) <= cu /\ abs (v x) <= cv’ by PROVE_TAC [] \\
8687     CCONTR_TAC >> FULL_SIMP_TAC bool_ss [] \\
8688     fs [extreal_abs_def, le_infty])
8689 (* general case *)
8690 >> ‘p <> 0’ by PROVE_TAC [lt_imp_ne]
8691 >> ‘0 <= p’ by rw [lt_imp_le]
8692 >> ‘p <> NegInf’ by rw [pos_not_neginf]
8693 >> ‘0 <= p - 1’ by rw [GSYM sub_zero_le]
8694 >> Know ‘pos_fn_integral m (\x. abs (u x + v x) powr (1 + (p - 1))) =
8695          pos_fn_integral m (\x. abs (u x + v x) powr 1 *
8696                                 abs (u x + v x) powr (p - 1))’
8697 >- (MATCH_MP_TAC pos_fn_integral_cong >> rw [powr_pos]
8698     >- (MATCH_MP_TAC le_mul >> rw [powr_pos]) \\
8699     MATCH_MP_TAC powr_add >> rw [abs_pos, sub_not_infty])
8700 >> simp [powr_1, abs_pos, sub_add2]
8701 >> DISCH_TAC
8702 (* applying abs_triangle *)
8703 >> Know ‘pos_fn_integral m (\x. abs (u x + v x) powr p) <=
8704          pos_fn_integral m (\x. (abs (u x) + abs (v x)) *
8705                                  abs (u x + v x) powr (p - 1))’
8706 >- (POP_ORW \\
8707     MATCH_MP_TAC pos_fn_integral_mono_AE \\
8708     rw [le_mul, le_add, abs_pos, powr_pos] \\
8709     gs [lp_space_alt_finite] \\
8710     Know ‘null_set m {x | x IN m_space m /\ abs (u x) powr p = PosInf} /\
8711           null_set m {x | x IN m_space m /\ abs (v x) powr p = PosInf}’
8712     >- (CONJ_TAC (* 2 subgoals, same tactics *) \\
8713         HO_MATCH_MP_TAC pos_fn_integral_infty_null >> rw [powr_pos] \\
8714         MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw []) \\
8715     rw [AE_DEF] \\
8716     Q.EXISTS_TAC ‘{x | x IN m_space m /\ abs (u x) powr p = PosInf} UNION
8717                   {x | x IN m_space m /\ abs (v x) powr p = PosInf}’ \\
8718     CONJ_TAC >- (MATCH_MP_TAC (REWRITE_RULE [IN_APP] NULL_SET_UNION) >> art []) \\
8719     rw [GSPECIFICATION] \\
8720     MATCH_MP_TAC le_rmul_imp >> simp [powr_pos] \\
8721     Know ‘u x <> PosInf /\ u x <> NegInf /\ v x <> PosInf /\ v x <> NegInf’
8722     >- (rpt CONJ_TAC >> CCONTR_TAC \\
8723         gs [extreal_abs_def, infty_powr]) >> STRIP_TAC \\
8724     MATCH_MP_TAC abs_triangle >> art [])
8725 >> POP_ASSUM K_TAC
8726 >> Know ‘!x. (abs (u x) + abs (v x)) * abs (u x + v x) powr (p - 1) =
8727               abs (u x) * abs (u x + v x) powr (p - 1) +
8728               abs (v x) * abs (u x + v x) powr (p - 1)’
8729 >- (Q.X_GEN_TAC ‘x’ \\
8730     MATCH_MP_TAC add_rdistrib >> DISJ1_TAC >> rw [abs_pos])
8731 >> Rewr'
8732 (* applying pos_fn_integral_add *)
8733 >> Know ‘pos_fn_integral m
8734           (\x. abs (u x) * abs (u x + v x) powr (p - 1) +
8735                abs (v x) * abs (u x + v x) powr (p - 1)) =
8736          pos_fn_integral m (\x. abs (u x) * abs (u x + v x) powr (p - 1)) +
8737          pos_fn_integral m (\x. abs (v x) * abs (u x + v x) powr (p - 1))’
8738 >- (HO_MATCH_MP_TAC pos_fn_integral_add \\
8739     gs [lp_space_alt_finite] \\
8740     rw [le_mul, abs_pos, powr_pos] >| (* 2 subgoals *)
8741     [ (* goal 1 (of 2) *)
8742       MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES \\
8743       qexistsl_tac [‘\x. abs (u x)’, ‘\x. abs (u x + v x) powr (p - 1)’] \\
8744       rw [] >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS \\
8745                 Q.EXISTS_TAC ‘u’ >> fs [measure_space_def]) \\
8746       HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw [sub_not_infty] \\
8747       MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD' \\
8748       qexistsl_tac [‘u’, ‘v’] >> fs [measure_space_def],
8749       (* goal 2 (of 2) *)
8750       MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES \\
8751       qexistsl_tac [‘\x. abs (v x)’, ‘\x. abs (u x + v x) powr (p - 1)’] \\
8752       rw [] >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS \\
8753                 Q.EXISTS_TAC ‘v’ >> fs [measure_space_def]) \\
8754       HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw [sub_not_infty] \\
8755       MATCH_MP_TAC IN_MEASURABLE_BOREL_ADD' \\
8756       qexistsl_tac [‘u’, ‘v’] >> fs [measure_space_def] ])
8757 >> Rewr'
8758 (* special case *)
8759 >> Cases_on ‘p = 1’
8760 >- rw [sub_refl, abs_pos, powr_1, seminorm_one, o_DEF]
8761 >> ‘1 < p’ by rw [lt_le]
8762 >> ‘0 < p - 1’ by PROVE_TAC [sub_zero_lt]
8763 >> ‘p - 1 <> 0’ by PROVE_TAC [lt_imp_ne]
8764 >> Know ‘p - 1 <> PosInf /\ p - 1 <> NegInf’
8765 >- (‘?r. p = Normal r’ by METIS_TAC [extreal_cases] \\
8766     rw [extreal_of_num_def, extreal_sub_def])
8767 >> STRIP_TAC
8768 >> ‘0 < inv (p - 1)’ by rw [inv_pos_eq]
8769 >> ‘inv (p - 1) <> 0’ by PROVE_TAC [lt_imp_ne]
8770 (* ‘q’ and its properties *)
8771 >> Q.ABBREV_TAC ‘q = p / (p - 1)’
8772 >> Know ‘(p - 1) * q = p’
8773 >- (rw [Abbr ‘q’, div_eq_mul_rinv] \\
8774     GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [mul_comm] \\
8775     rw [GSYM mul_assoc, mul_linv])
8776 >> DISCH_TAC
8777 >> Know ‘inv p + inv q = 1’
8778 >- (rw [Abbr ‘q’, div_eq_mul_rinv, inv_mul, inv_inv] \\
8779     rw [sub_ldistrib, inv_not_infty, mul_linv_pos] \\
8780     rw [sub_add2, inv_not_infty])
8781 >> DISCH_TAC
8782 >> Know ‘1 <= q’
8783 >- (Q.UNABBREV_TAC ‘q’ \\
8784     Know ‘1 <= p / (p - 1) <=> 1 * (p - 1) <= p’
8785     >- (‘?r. 0 < r /\ p - 1 = Normal r’
8786            by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq] \\
8787         POP_ORW \\
8788         MATCH_MP_TAC (GSYM le_rdiv) >> art []) >> Rewr' \\
8789     rw [sub_le_eq, le_addr])
8790 >> DISCH_TAC
8791 >> ‘0 < q’ by PROVE_TAC [lte_trans, lt_01]
8792 >> ‘q <> 0’ by PROVE_TAC [lt_imp_ne]
8793 >> Know ‘q <> PosInf’
8794 >- (rw [Abbr ‘q’, div_eq_mul_rinv] \\
8795    ‘?r. r <> 0 /\ p - 1 = Normal r’
8796        by METIS_TAC [extreal_cases, extreal_of_num_def] >> POP_ORW \\
8797    ‘?z. p = Normal z’ by METIS_TAC [extreal_cases] >> POP_ORW \\
8798     rw [extreal_inv_eq, extreal_mul_def])
8799 >> DISCH_TAC
8800 (* ‘f’ and its properties *)
8801 >> Q.ABBREV_TAC ‘f = \x. abs (u x + v x) powr (p - 1)’
8802 >> ‘!x. 0 <= f x’ by rw [Abbr ‘f’, powr_pos]
8803 >> ‘!x. abs (f x) = f x’ by rw [abs_refl]
8804 >> RW_TAC std_ss []
8805 >> Know ‘f IN lp_space q m’
8806 >- (gs [lp_space_alt_finite, Abbr ‘f’] \\
8807     CONJ_TAC
8808     >- (HO_MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw [sub_not_infty]) \\
8809    ‘!x. abs (abs (u x + v x) powr (p - 1)) = abs (u x + v x) powr (p - 1)’
8810       by rw [abs_refl] >> POP_ORW \\
8811     rw [powr_powr])
8812 >> DISCH_TAC
8813 (* applying Hoelder_inequality' *)
8814 >> Know ‘pos_fn_integral m (\x. abs (u x * f x)) <= seminorm p m u * seminorm q m f’
8815 >- (MATCH_MP_TAC Hoelder_inequality' >> art [])
8816 >> Know ‘pos_fn_integral m (\x. abs (v x * f x)) <= seminorm p m v * seminorm q m f’
8817 >- (MATCH_MP_TAC Hoelder_inequality' >> art [])
8818 >> rw [abs_mul]
8819 >> Know ‘pos_fn_integral m (\x. abs (u x + v x) powr p) <=
8820          seminorm p m u * seminorm q m f + seminorm p m v * seminorm q m f’
8821 >- (MATCH_MP_TAC le_trans \\
8822     Q.EXISTS_TAC ‘pos_fn_integral m (\x. abs (u x) * f x) +
8823                   pos_fn_integral m (\x. abs (v x) * f x)’ >> art [] \\
8824     MATCH_MP_TAC le_add2 >> art [])
8825 >> NTAC 2 (POP_ASSUM K_TAC)
8826 >> Q.PAT_X_ASSUM ‘pos_fn_integral m (\x. abs (u x + v x) powr p) <= A + B’ K_TAC
8827 >> DISCH_TAC
8828 (* applying seminorm_eq_0 *)
8829 >> Cases_on ‘seminorm q m f = 0’
8830 >- (gs [lp_space_alt_finite, seminorm_eq_0] \\
8831     Suff ‘seminorm p m (\x. u x + v x) = 0’
8832     >- (Rewr' >> MATCH_MP_TAC le_add >> rw [seminorm_pos]) \\
8833     Know ‘seminorm p m (\x. u x + v x) = 0 <=> AE x::m. u x + v x = 0’
8834     >- (HO_MATCH_MP_TAC seminorm_eq_0 >> art []) >> Rewr' \\
8835     POP_ASSUM MP_TAC \\
8836     rw [AE_DEF, Abbr ‘f’] \\
8837     Q.EXISTS_TAC ‘N’ >> rw [] \\
8838     Q.PAT_X_ASSUM ‘!x. x IN m_space m /\ x NOTIN N ==> P’ (MP_TAC o (Q.SPEC ‘x’)) \\
8839    ‘0 <= abs (u x + v x)’ by rw [abs_pos] \\
8840     RW_TAC std_ss [powr_eq_0, abs_eq_0])
8841 >> ‘0 <= seminorm q m f’ by rw [seminorm_pos]
8842 >> ‘0 < seminorm q m f’ by rw [lt_le]
8843 >> Know ‘seminorm p m (\x. u x + v x) <= seminorm p m u + seminorm p m v <=>
8844          seminorm p m (\x. u x + v x) * seminorm q m f <=
8845         (seminorm p m u + seminorm p m v) * seminorm q m f’
8846 >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
8847     MATCH_MP_TAC le_rmul >> PROVE_TAC [seminorm_not_infty])
8848 >> Rewr'
8849 >> Know ‘(seminorm p m u + seminorm p m v) * seminorm q m f =
8850           seminorm p m u * seminorm q m f + seminorm p m v * seminorm q m f’
8851 >- (MATCH_MP_TAC add_rdistrib >> DISJ1_TAC >> rw [seminorm_pos])
8852 >> Rewr'
8853 >> Suff ‘seminorm p m (\x. u x + v x) * seminorm q m f =
8854          pos_fn_integral m (\x. abs (u x + v x) powr p)’ >- rw []
8855 >> Q.PAT_X_ASSUM ‘pos_fn_integral m (\x. abs (u x + v x) powr p) <= P’ K_TAC
8856 (* final stage *)
8857 >> rw [Abbr ‘f’, seminorm_normal]
8858 >> ‘!x. abs (abs (u x + v x) powr (p - 1)) = abs (u x + v x) powr (p - 1)’
8859       by rw [abs_refl, powr_pos, abs_pos] >> POP_ORW
8860 >> rw [powr_powr]
8861 >> Q.ABBREV_TAC ‘A = pos_fn_integral m (\x. abs (u x + v x) powr p)’
8862 >> Know ‘0 <= A’
8863 >- (Q.UNABBREV_TAC ‘A’ \\
8864     MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos])
8865 >> DISCH_TAC
8866 >> ‘A = A powr (inv p + inv q)’ by rw [powr_1]
8867 >> POP_ASSUM (fn th => GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites [th])
8868 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
8869 >> MATCH_MP_TAC powr_add
8870 >> simp [inv_not_infty]
8871 >> CONJ_TAC (* 2 subgoals, same tactics *)
8872 >> MATCH_MP_TAC lt_imp_le
8873 >> MATCH_MP_TAC inv_pos' >> art []
8874QED
8875
8876Theorem Minkowski_inequality' :
8877    !p m u v. measure_space m /\ 1 <= p /\ u IN lp_space p m /\ v IN lp_space p m
8878          ==> seminorm p m (\x. u x + v x) <= seminorm p m u + seminorm p m v
8879Proof
8880    rpt STRIP_TAC
8881 >> drule Minkowski_inequality >> rw []
8882QED
8883
8884(* NOTE: ‘u IN measurable (m_space m,measurable_sets m) Borel’, e.g., and
8885  ‘AE x::m. u x = v x’ together do NOT implies ‘v IN measurable ...’ unless
8886   the measure space is complete, cf. IN_MEASURABLE_BOREL_AE_EQ.
8887 *)
8888Theorem seminorm_cong_AE :
8889    !m u v p. measure_space m /\ 0 < p /\
8890              u IN measurable (m_space m,measurable_sets m) Borel /\
8891              v IN measurable (m_space m,measurable_sets m) Borel /\
8892             (AE x::m. u x = v x) ==> seminorm p m u = seminorm p m v
8893Proof
8894    rpt STRIP_TAC
8895 >> Cases_on ‘p = PosInf’
8896 >- (rw [seminorm_infty_alt] \\
8897     Suff ‘!c. (AE x::m. abs (u x) < c) <=> (AE x::m. abs (v x) < c)’ >- rw [] \\
8898     Q.PAT_X_ASSUM ‘AE x::m. u x = v x’ MP_TAC \\
8899     rw [AE_DEF] >> rename1 ‘null_set m N0’ \\
8900     EQ_TAC >> rw [] >| (* 2 subgoals *)
8901     [ (* goal 1 (of 2) *)
8902       Q.EXISTS_TAC ‘N UNION N0’ >> rw [NULL_SET_UNION'] \\
8903      ‘v x = u x’ by PROVE_TAC [] >> POP_ORW \\
8904       FIRST_X_ASSUM MATCH_MP_TAC >> art [],
8905       (* goal 2 (of 2) *)
8906       Q.EXISTS_TAC ‘N UNION N0’ >> rw [NULL_SET_UNION'] ])
8907 >> rw [seminorm_normal]
8908 >> Suff ‘pos_fn_integral m (\x. abs (u x) powr p) =
8909          pos_fn_integral m (\x. abs (v x) powr p)’ >- rw []
8910 >> MATCH_MP_TAC pos_fn_integral_cong_AE >> rw [powr_pos]
8911 >> HO_MATCH_MP_TAC AE_subset
8912 >> Q.EXISTS_TAC ‘\x. u x = v x’ >> rw []
8913QED
8914
8915Theorem seminorm_cong :
8916    !m u v p. measure_space m /\ 0 < p /\
8917             (u IN measurable (m_space m,measurable_sets m) Borel \/
8918              v IN measurable (m_space m,measurable_sets m) Borel) /\
8919             (!x. x IN m_space m ==> u x = v x) ==> seminorm p m u = seminorm p m v
8920Proof
8921    rpt STRIP_TAC
8922 >> ‘u IN measurable (m_space m,measurable_sets m) Borel /\
8923     v IN measurable (m_space m,measurable_sets m) Borel’
8924      by METIS_TAC [IN_MEASURABLE_BOREL_EQ]
8925 >> MATCH_MP_TAC seminorm_cong_AE
8926 >> rw [AE_DEF]
8927 >> Q.EXISTS_TAC ‘{}’ >> rw [NULL_SET_EMPTY]
8928QED
8929
8930Theorem lp_space_cong :
8931    !p m u v. measure_space m /\ 0 < p /\ (!x. x IN m_space m ==> u x = v x) ==>
8932             (u IN lp_space p m <=> v IN lp_space p m)
8933Proof
8934    rpt STRIP_TAC
8935 >> rw [lp_space_alt_seminorm]
8936 >> EQ_TAC >> rpt STRIP_TAC
8937 >> ‘u IN measurable (m_space m,measurable_sets m) Borel /\
8938     v IN measurable (m_space m,measurable_sets m) Borel’
8939      by METIS_TAC [IN_MEASURABLE_BOREL_EQ]
8940 (* 2 subgoals, same tactics *)
8941 >> (Suff ‘seminorm p m u = seminorm p m v’ >- (DISCH_THEN (fs o wrap)) \\
8942     MATCH_MP_TAC seminorm_cong >> art [])
8943QED
8944
8945Theorem lp_space_cong_AE :
8946    !p m u v. measure_space m /\ 0 < p /\
8947              u IN Borel_measurable (measurable_space m) /\
8948              v IN Borel_measurable (measurable_space m) /\
8949             (AE x::m. u x = v x) ==> (u IN lp_space p m <=> v IN lp_space p m)
8950Proof
8951    rpt STRIP_TAC
8952 >> rw [lp_space_alt_seminorm]
8953 >> Suff ‘seminorm p m u = seminorm p m v’ >- rw []
8954 >> MATCH_MP_TAC seminorm_cong_AE >> art []
8955QED
8956
8957Theorem seminorm_zero :
8958    !p m. measure_space m /\ 0 < p ==> seminorm p m (\x. 0) = 0
8959Proof
8960    rpt STRIP_TAC
8961 >> Know ‘(\x. 0) IN measurable (measurable_space m) Borel’
8962 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CONST \\
8963     Q.EXISTS_TAC ‘0’ >> fs [measure_space_def])
8964 >> DISCH_TAC
8965 >> Cases_on ‘p = PosInf’
8966 >- (rw [seminorm_infty_alt, inf_eq'] >| (* 2 subgoals *)
8967     [ (* goal 1 (of 2) *)
8968       MATCH_MP_TAC lt_imp_le >> art [],
8969       (* goal 2 (of 2) *)
8970       MATCH_MP_TAC le_epsilon >> rw [] \\
8971       FIRST_X_ASSUM MATCH_MP_TAC >> rw [AE_T] ])
8972 >> ‘0 < inv p’ by PROVE_TAC [inv_pos']
8973 >> rw [seminorm_normal, zero_rpow, pos_fn_integral_zero]
8974QED
8975
8976Theorem seminorm_cmul :
8977    !p m u r. measure_space m /\ 0 < p /\
8978              u IN measurable (measurable_space m) Borel ==>
8979              seminorm p m (\x. Normal r * u x) = Normal (abs r) * seminorm p m u
8980Proof
8981    rpt STRIP_TAC
8982 >> Cases_on ‘r = 0’ >- rw [seminorm_zero, normal_0]
8983 >> Know ‘(\x. Normal r * u x) IN measurable (measurable_space m) Borel’
8984 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
8985     qexistsl_tac [‘u’, ‘r’] >> fs [measure_space_def])
8986 >> DISCH_TAC
8987 >> Cases_on ‘p = PosInf’
8988 >- (rw [seminorm_infty_alt, abs_mul, extreal_abs_def] \\
8989    ‘!x c. Normal (abs r) * abs (u x) = abs (u x) * Normal (abs r)’
8990        by PROVE_TAC [mul_comm] >> POP_ORW \\
8991     Know ‘!x c. abs (u x) * Normal (abs r) < c <=> abs (u x) < c / Normal (abs r)’
8992     >- (rpt GEN_TAC \\
8993         ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
8994         MATCH_MP_TAC lt_rdiv >> rw [abs_gt_0]) >> Rewr' \\
8995     Know ‘{c | 0 < c /\ AE x::m. abs (u x) < c / Normal (abs r)} =
8996           {d * Normal (abs r) | 0 < d /\ AE y::m. abs (u y) < d}’
8997     >- (rw [Once EXTENSION] >> EQ_TAC >> rw [] >| (* 3 subgoals *)
8998         [ (* goal 1 (of 3) *)
8999           Q.EXISTS_TAC ‘x / Normal (abs r)’ >> rw [] >| (* 2 subgoals *)
9000           [ MATCH_MP_TAC div_mul_refl >> rw [],
9001             MATCH_MP_TAC lt_div >> rw [abs_gt_0] ],
9002           (* goal 2 (of 3) *)
9003           MATCH_MP_TAC lt_mul >> rw [],
9004           (* goal 3 (of 3) *)
9005           Suff ‘d * Normal (abs r) / Normal (abs r) = d’ >- rw [] \\
9006           ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
9007           MATCH_MP_TAC mul_div_refl >> rw [] ]) >> Rewr' \\
9008     Suff ‘!P. inf {d * Normal (abs r) | 0 < d /\ P d} =
9009               Normal (abs r) * inf {c | 0 < c /\ P c}’ >- rw [] \\
9010     MATCH_MP_TAC inf_cmul >> rw [abs_gt_0])
9011 (* stage work *)
9012 >> rw [seminorm_normal, abs_mul, extreal_abs_def]
9013 >> Know ‘!x. (Normal (abs r) * abs (u x)) powr p =
9014              Normal (abs r) powr p * abs (u x) powr p’
9015 >- (Q.X_GEN_TAC ‘x’ >> MATCH_MP_TAC mul_powr >> rw [])
9016 >> Rewr'
9017 >> ‘p <> NegInf’ by PROVE_TAC [pos_not_neginf, lt_imp_le]
9018 >> ‘?z. 0 < z /\ p = Normal z’
9019       by METIS_TAC [extreal_cases, extreal_of_num_def, extreal_lt_eq]
9020 >> POP_ORW
9021 (* applying IN_MEASURABLE_BOREL_ABS_POWR *)
9022 >> Know ‘(\x. abs (u x) powr Normal z) IN Borel_measurable (measurable_space m)’
9023 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR \\
9024     rw [REAL_LT_IMP_LE])
9025 >> DISCH_TAC
9026 >> Know ‘pos_fn_integral m (\x. Normal (abs r) powr Normal z *
9027                                 abs (u x) powr Normal z) =
9028          Normal (abs r) powr Normal z *
9029          pos_fn_integral m (\x. abs (u x) powr Normal z)’
9030 >- (Know ‘Normal (abs r) powr (Normal z) = Normal (abs r powr z)’
9031     >- (MATCH_MP_TAC normal_powr >> rw []) >> Rewr' \\
9032     HO_MATCH_MP_TAC pos_fn_integral_cmul >> rw [powr_pos] \\
9033     MATCH_MP_TAC REAL_LT_IMP_LE \\
9034     MATCH_MP_TAC RPOW_POS_LT >> rw [])
9035 >> Rewr'
9036 (* final stage *)
9037 >> Q.ABBREV_TAC ‘y = pos_fn_integral m (\x. abs (u x) powr Normal z)’
9038 >> Know ‘0 <= y’
9039 >- (Q.UNABBREV_TAC ‘y’ \\
9040     MATCH_MP_TAC pos_fn_integral_pos >> rw [powr_pos])
9041 >> DISCH_TAC
9042 >> Know ‘(Normal (abs r) powr (Normal z) * y) powr inv (Normal z) =
9043          (Normal (abs r) powr (Normal z)) powr inv (Normal z) *
9044           y powr inv (Normal z)’
9045 >- (MATCH_MP_TAC mul_powr \\
9046    ‘Normal z <> 0’ by rw [REAL_LT_IMP_NE] \\
9047     rw [inv_pos', inv_not_infty, powr_pos])
9048 >> Rewr'
9049 >> Suff ‘(Normal (abs r) powr Normal z) powr inv (Normal z) = Normal (abs r)’
9050 >- rw []
9051 >> Know ‘(Normal (abs r) powr Normal z) powr inv (Normal z) =
9052           Normal (abs r) powr (Normal z * inv (Normal z))’
9053 >- (MATCH_MP_TAC powr_powr \\
9054    ‘Normal z <> 0’ by rw [REAL_LT_IMP_NE] \\
9055     rw [inv_pos', inv_not_infty, powr_pos])
9056 >> Rewr'
9057 >> Suff ‘Normal z * inv (Normal z) = 1’ >- (Rewr' >> rw [powr_1])
9058 >> ONCE_REWRITE_TAC [mul_comm]
9059 >> MATCH_MP_TAC mul_linv_pos >> rw []
9060QED
9061
9062Theorem lp_space_cmul :
9063    !p m u r. measure_space m /\ 0 < p /\ u IN lp_space p m ==>
9064              (\x. Normal r * u x) IN lp_space p m
9065Proof
9066    rpt STRIP_TAC
9067 >> ‘seminorm p m u <> PosInf /\ seminorm p m u <> NegInf’
9068       by PROVE_TAC [seminorm_not_infty]
9069 >> ‘0 <= seminorm p m u’ by PROVE_TAC [seminorm_pos]
9070 >> ‘u IN Borel_measurable (measurable_space m)’ by fs [lp_space_def]
9071 >> Q.PAT_X_ASSUM ‘u IN lp_space p m’ MP_TAC
9072 >> rw [lp_space_alt_seminorm, seminorm_cmul, GSYM lt_infty]
9073 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL \\
9074     qexistsl_tac [‘u’, ‘r’] >> fs [measure_space_def])
9075 >> ‘?z. seminorm p m u = Normal z’ by METIS_TAC [extreal_cases]
9076 >> rw [extreal_mul_eq]
9077QED
9078
9079Theorem lp_space_add_cmul :
9080    !p m u v a b.
9081       measure_space m /\ 0 < p /\ u IN lp_space p m /\ v IN lp_space p m ==>
9082      (\x. Normal a * u x + Normal b * v x) IN lp_space p m
9083Proof
9084    rpt STRIP_TAC
9085 >> HO_MATCH_MP_TAC lp_space_add >> rw [lp_space_cmul]
9086QED
9087
9088(* cf. lp_space_alt_finite, lp_space_alt_infinite *)
9089Theorem lp_space_AE_normal :
9090    !p m f. measure_space m /\ 0 < p /\ f IN lp_space p m ==>
9091            AE x::m. f x <> PosInf /\ f x <> NegInf
9092Proof
9093    rpt STRIP_TAC
9094 >> Cases_on ‘p = PosInf’
9095 >- (‘?c. 0 < c /\ c <> PosInf /\ AE x::m. abs (f x) < c’
9096        by METIS_TAC [lp_space_alt_infinite] \\
9097     POP_ASSUM MP_TAC >> rw [AE_DEF, abs_bounds_lt, lt_infty] \\
9098     Q.EXISTS_TAC ‘N’ >> rw []
9099     >- (Q_TAC (TRANS_TAC lt_trans) ‘c’ >> rw [GSYM lt_infty]) \\
9100     Q_TAC (TRANS_TAC lt_trans) ‘-c’ >> rw [GSYM lt_infty] \\
9101    ‘NegInf = -PosInf’ by rw [extreal_ainv_def] >> POP_ORW \\
9102     rw [eq_neg])
9103 >> ‘f IN Borel_measurable (measurable_space m) /\
9104     pos_fn_integral m (\x. abs (f x) powr p) <> PosInf’
9105       by METIS_TAC [lp_space_alt_finite]
9106 (* applying pos_fn_integral_infty_null *)
9107 >> Q.ABBREV_TAC ‘g = \x. abs (f x) powr p’
9108 >> Know ‘null_set m {x | x IN m_space m /\ g x = PosInf}’
9109 >- (MATCH_MP_TAC pos_fn_integral_infty_null >> art [] \\
9110     CONJ_TAC >- rw [Abbr ‘g’, powr_pos] \\
9111     Q.UNABBREV_TAC ‘g’ \\
9112     MATCH_MP_TAC IN_MEASURABLE_BOREL_ABS_POWR >> rw [lt_imp_le])
9113 >> DISCH_TAC
9114 >> rw [AE_DEF]
9115 >> Q.EXISTS_TAC ‘{x | x IN m_space m /\ g x = PosInf}’
9116 >> rw [Abbr ‘g’] >> CCONTR_TAC (* 2 subgoals, same tactics *)
9117 >> gs [extreal_abs_def, infty_powr]
9118QED
9119
9120Theorem lp_space_sub :
9121    !p m u v. measure_space m /\ 0 < p /\
9122              u IN lp_space p m /\ v IN lp_space p m ==>
9123             (\x. u x - v x) IN lp_space p m
9124Proof
9125    rw [extreal_sub]
9126 >> HO_MATCH_MP_TAC lp_space_add >> art []
9127 >> ‘(\x. -v x) = (\x. Normal (-1) * v x)’
9128       by rw [FUN_EQ_THM, GSYM extreal_ainv_def, GSYM neg_minus1, normal_1]
9129 >> POP_ORW
9130 >> MATCH_MP_TAC lp_space_cmul >> art []
9131QED
9132
9133(* ------------------------------------------------------------------------- *)
9134(*   Applications of Radon_Nikodym (ported from HVG's normal_rvScript.sml)   *)
9135(* ------------------------------------------------------------------------- *)
9136
9137(* Radon-Nikodym derivative (RN_deriv)
9138
9139  `RN_deriv v m` (HOL) = `RN_deriv m (m_space m,measurable_sets m,v)` (Isabelle/HOL)
9140
9141   The existence of `RN_deriv v m` is then asserted by Radon-Nikodym theorem, and
9142   its uniqueness is asserted by the following (unproved) theorem:
9143
9144     !m f f'. measure_space m /\ sigma_finite m /\
9145              f IN borel_measurable (m_space m,measurable_sets m) /\
9146              f' IN borel_measurable (m_space m,measurable_sets m) /\
9147              nonneg f /\ nonneg f' /\
9148              (!s. s IN measurable_sets m ==> ((f * m) s = (f' * m) s))
9149          ==> AE x::m. (f x = f' x)
9150
9151   see also density_measure_def for the overload of ‘*’ in `f * m`.
9152 *)
9153Definition RN_deriv_def : (* or `v / m` (dv/dm) *)
9154    RN_deriv v m =
9155      @f. f IN measurable (m_space m,measurable_sets m) Borel /\
9156          (!x. x IN m_space m ==> 0 <= f x) /\
9157          !s. s IN measurable_sets m ==> ((f * m) s = v s)
9158End
9159
9160(* `f = RN_deriv v m` is denoted by `f = v / m`
9161   NOTE: cannot use the Overload syntax sugar here (on "/").
9162 *)
9163Overload "/" = “RN_deriv”
9164
9165Theorem RN_deriv_thm :
9166    !m v. measure_space m /\
9167          (?f. f IN measurable (m_space m,measurable_sets m) Borel /\
9168              (!x. x IN m_space m ==> 0 <= f x) /\
9169              (!s. s IN measurable_sets m ==> (f * m) s = v s)) ==>
9170          !s. s IN measurable_sets m ==> (v / m * m) s = v s
9171Proof
9172    RW_TAC std_ss [RN_deriv_def]
9173 >> SELECT_ELIM_TAC
9174 >> CONJ_TAC >- (Q.EXISTS_TAC ‘f’ >> rw [])
9175 >> Q.X_GEN_TAC ‘g’
9176 >> rpt STRIP_TAC
9177 >> POP_ASSUM MATCH_MP_TAC >> art []
9178QED
9179
9180(* This is ported from the following theorem (RN_derivI)
9181
9182    !f M N. f IN measurable (m_space M, measurable_sets M) Borel /\
9183            (!x. 0 <= f x) /\ (density M f = measure_of N) /\
9184             measure_space M /\ measure_space N /\
9185            (measurable_sets M = measurable_sets N) ==>
9186            (density M (RN_deriv M N) = measure_of N)
9187 *)
9188Theorem RN_deriv_thm' :
9189    !f m v. measure_space m /\
9190            f IN measurable (m_space m,measurable_sets m) Borel /\
9191           (!x. x IN m_space m ==> 0 <= f x) /\
9192           (!s. s IN measurable_sets m ==> (f * m) s = v s) ==>
9193            measure_space_eq (density m (v / m))
9194                             (m_space m,measurable_sets m,v)
9195Proof
9196    rw [measure_space_eq_def, density_def]
9197 >> irule RN_deriv_thm >> art []
9198 >> Q.EXISTS_TAC ‘f’ >> rw []
9199QED
9200
9201(* NOTE: This is compatible with the original "RN_deriv" of HVG Concordia *)
9202Overload RN_deriv' = “\M N. RN_deriv (measure N) M”
9203
9204Theorem RN_derivI :
9205    !f M N. measure_space M /\ measure_space N /\
9206            f IN measurable (m_space M, measurable_sets M) Borel /\
9207            (!x. x IN m_space M ==> 0 <= f x) /\
9208             density_of M f = measure_of N /\
9209             measure_space M /\ measure_space N /\
9210             measurable_sets M = measurable_sets N ==>
9211             density_of M (RN_deriv' M N) = measure_of N
9212Proof
9213    RW_TAC std_ss [RN_deriv_def] >> SELECT_ELIM_TAC
9214 >> `m_space M = m_space N` by METIS_TAC [sets_eq_imp_space_eq]
9215 >> Know `measurable_sets N SUBSET POW (m_space N)`
9216 >- FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_iff2]
9217 >> DISCH_TAC
9218 >> `sigma_sets (m_space N) (measurable_sets N) = measurable_sets N`
9219      by METIS_TAC [sigma_sets_eq, measure_space_def]
9220 >> RW_TAC std_ss []
9221 >- (Q.EXISTS_TAC `f` >> FULL_SIMP_TAC std_ss [] \\
9222     RW_TAC std_ss [] \\
9223     UNDISCH_TAC ``density_of M f = measure_of N`` \\
9224     GEN_REWR_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM MEASURE_SPACE_REDUCE] \\
9225     simp [density_measure_def, measure_of, FUN_EQ_THM, density_of] THEN
9226     DISCH_THEN (MP_TAC o Q.SPEC `s`) >> simp [] \\
9227     DISCH_THEN (REWRITE_TAC o wrap o SYM) \\
9228     MATCH_MP_TAC pos_fn_integral_cong >> simp [] \\
9229     CONJ_ASM1_TAC
9230     >- (Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
9231         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
9232     CONJ_TAC >- rw [le_max] \\
9233     rw [Once EQ_SYM_EQ] \\
9234     MATCH_MP_TAC max_0_reduce >> rw [])
9235 >> GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM MEASURE_SPACE_REDUCE]
9236 >> FULL_SIMP_TAC std_ss [density_of, measure_def, measure_of]
9237 >> RW_TAC std_ss [MEASURE_SPACE_REDUCE, FUN_EQ_THM]
9238 >> Cases_on ‘a IN measurable_sets N’ >> rw []
9239 >> Know ‘pos_fn_integral M (\x'. max 0 (x x' * indicator_fn a x')) =
9240          pos_fn_integral M (\x'. x x' * indicator_fn a x')’
9241 >- (MATCH_MP_TAC pos_fn_integral_cong \\
9242     simp [] \\
9243     CONJ_TAC >- rw [le_max] \\
9244     CONJ_ASM1_TAC
9245     >- (Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
9246         MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]) \\
9247     Q.X_GEN_TAC ‘z’ >> STRIP_TAC \\
9248     MATCH_MP_TAC max_0_reduce \\
9249     MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS])
9250 >> Rewr'
9251 >> SIMP_TAC std_ss [GSYM density_measure]
9252 >> FIRST_X_ASSUM MATCH_MP_TAC >> art []
9253QED
9254
9255Theorem density_RN_deriv :
9256    !M N. sigma_finite_measure_space M /\ measure_space N /\
9257          measure_absolutely_continuous' N M /\
9258          measurable_sets M = measurable_sets N ==>
9259          density_of M (RN_deriv' M N) = measure_of N
9260Proof
9261    RW_TAC std_ss [sigma_finite_measure_space_def]
9262 >> MATCH_MP_TAC RN_derivI
9263 >> MP_TAC (Q.SPECL [‘M’, ‘N’] RADON_NIKODYM) >> rw []
9264 >> Q.EXISTS_TAC ‘f’ >> rw []
9265 >> ASM_SIMP_TAC std_ss [density_of]
9266 >> ‘m_space M = m_space N’ by METIS_TAC [sets_eq_imp_space_eq]
9267 >> Know ‘measurable_sets N SUBSET POW (m_space N)’
9268 >- FULL_SIMP_TAC std_ss [measure_space_def, sigma_algebra_iff2]
9269 >> DISCH_TAC
9270 >> ‘sigma_sets (m_space N) (measurable_sets N) = measurable_sets N’
9271      by METIS_TAC [sigma_sets_eq, measure_space_def]
9272 >> GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM MEASURE_SPACE_REDUCE]
9273 >> ASM_SIMP_TAC std_ss [FUN_EQ_THM, measure_of]
9274 >> rw [MEASURE_SPACE_REDUCE, density_measure_def]
9275 >> Suff ‘pos_fn_integral M (\x. max 0 (f x * indicator_fn a x)) =
9276          pos_fn_integral M (\x. f x * indicator_fn a x)’ >- rw []
9277 >> MATCH_MP_TAC pos_fn_integral_cong >> simp []
9278 >> CONJ_TAC >- rw [le_max]
9279 >> CONJ_ASM1_TAC
9280 >- (Q.X_GEN_TAC ‘y’ >> STRIP_TAC \\
9281     MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS])
9282 >> Q.X_GEN_TAC ‘z’ >> STRIP_TAC
9283 >> MATCH_MP_TAC max_0_reduce
9284 >> MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]
9285QED
9286
9287(* NOTE: The new, shorter proof is based on pos_fn_integral_cong_measure' *)
9288Theorem RN_deriv_positive_integral :
9289    !M N f. sigma_finite_measure_space M /\ measure_space N /\
9290            measure_absolutely_continuous' N M /\
9291            measurable_sets M = measurable_sets N /\
9292            f IN measurable (m_space M, measurable_sets M) Borel /\
9293           (!x. x IN m_space M ==> 0 <= f x) ==>
9294            pos_fn_integral N f =
9295            pos_fn_integral (density_of M (RN_deriv' M N)) f
9296Proof
9297    rpt STRIP_TAC
9298 >> MATCH_MP_TAC pos_fn_integral_cong_measure'
9299 >> Know ‘density_of M (RN_deriv' M N) = measure_of N’
9300 >- (MATCH_MP_TAC density_RN_deriv >> art [])
9301 >> Rewr'
9302 >> fs [sigma_finite_measure_space_def]
9303 >> ‘m_space N = m_space M’ by METIS_TAC [sets_eq_imp_space_eq]
9304 >> simp [measure_of_measure_space, measure_space_eq_measure_of]
9305QED
9306
9307(* NOTE: This alternative definition eliminated the inner ‘max 0’ *)
9308Theorem density_of_pos_fn :
9309    !M f. measure_space M /\ (!x. x IN m_space M ==> 0 <= f x) ==>
9310          density_of M f =
9311            (m_space M,measurable_sets M,
9312              (\s. if s IN measurable_sets M then
9313                      pos_fn_integral M (\x. f x * indicator_fn s x)
9314                   else 0))
9315Proof
9316    rw [density_of, FUN_EQ_THM]
9317 >> Cases_on ‘s IN measurable_sets M’ >> rw []
9318 >> MATCH_MP_TAC pos_fn_integral_cong
9319 >> rw [le_max, le_mul, INDICATOR_FN_POS]
9320 >> MATCH_MP_TAC max_0_reduce
9321 >> MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]
9322QED
9323
9324Theorem pos_fn_integral_density_of :
9325    !m f g. measure_space m /\
9326           (!x. x IN m_space m ==> 0 <= f x) /\
9327           (!x. x IN m_space m ==> 0 <= g x) /\
9328            f IN Borel_measurable (measurable_space m) ==>
9329            pos_fn_integral (density_of m f) g = pos_fn_integral (density m f) g
9330Proof
9331    rpt STRIP_TAC
9332 >> MATCH_MP_TAC pos_fn_integral_cong_measure'
9333 >> simp [measure_space_density, measure_space_density_of]
9334 >> reverse CONJ_TAC >- rw [density_of]
9335 >> rw [measure_space_eq_def, density_def, density_of]
9336 >> qabbrev_tac ‘h = \x. f x * indicator_fn s x’ >> simp []
9337 >> Know ‘pos_fn_integral m (\x. max 0 (h x)) = pos_fn_integral m h’
9338 >- (MATCH_MP_TAC pos_fn_integral_max_0 >> rw [Abbr ‘h’] \\
9339     MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS])
9340 >> Rewr'
9341 >> rw [Abbr ‘h’, density_measure_def]
9342QED
9343
9344Theorem pos_fn_integral_density :
9345    !m f g. measure_space m /\
9346            f IN measurable (m_space m, measurable_sets m) Borel /\
9347            g IN measurable (m_space m, measurable_sets m) Borel /\
9348           (AE x::m. 0 <= f x) /\ (!x. 0 <= g x)
9349       ==> (pos_fn_integral (density m (fn_plus f)) g =
9350            pos_fn_integral m (\x. (fn_plus f) x * g x))
9351Proof
9352    rpt STRIP_TAC
9353 >> MP_TAC (Q.SPECL [`f`, `g`, `m`] pos_fn_integral_density')
9354 >> RW_TAC std_ss [GSYM density_fn_plus]
9355 >> Know `(\x. max 0 (g x)) = g`
9356 >- (RW_TAC std_ss [FUN_EQ_THM, GSYM fn_plus] \\
9357     Suff `fn_plus g = g` >- rw [] \\
9358     MATCH_MP_TAC nonneg_fn_plus >> rw [nonneg_def])
9359 >> DISCH_THEN (fs o wrap)
9360 >> POP_ASSUM K_TAC
9361 >> Suff `!x. max 0 ((\x. f x * g x) x) = (fn_plus f) x * g x` >- rw []
9362 >> GEN_TAC >> REWRITE_TAC [GSYM fn_plus]
9363 >> ONCE_REWRITE_TAC [mul_comm]
9364 >> ASM_SIMP_TAC std_ss [FN_PLUS_FMUL]
9365QED
9366
9367Theorem density_eq :
9368    !m f g. measure_space m /\
9369           (!x. x IN m_space m ==> 0 <= g x) /\
9370           (!x. x IN m_space m ==> f x = g x) ==>
9371            density m f = density m g
9372Proof
9373    rw [density_def, density_measure_def, FUN_EQ_THM]
9374 >> MATCH_MP_TAC pos_fn_integral_cong
9375 >> simp []
9376 >> rpt STRIP_TAC
9377 >> MATCH_MP_TAC le_mul >> rw [INDICATOR_FN_POS]
9378QED
9379
9380(* NOTE: This is the recommended version for “pos_fn_integral” and “density” *)
9381Theorem pos_fn_integral_density_reduce :
9382    !m f g. measure_space m /\
9383            f IN measurable (m_space m, measurable_sets m) Borel /\
9384            g IN measurable (m_space m, measurable_sets m) Borel /\
9385           (!x. x IN m_space m ==> 0 <= f x) /\
9386           (!x. x IN m_space m ==> 0 <= g x)
9387       ==> pos_fn_integral (density m f) g = pos_fn_integral m (\x. f x * g x)
9388Proof
9389    rpt STRIP_TAC
9390 >> qabbrev_tac ‘g' = \x. if x IN m_space m then g x else 0’
9391 >> ‘!x. 0 <= g' x’ by rw [Abbr ‘g'’]
9392 >> Know ‘g' IN Borel_measurable (measurable_space m)’
9393 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_EQ \\
9394     Q.EXISTS_TAC ‘g’ >> rw [Abbr ‘g'’])
9395 >> DISCH_TAC
9396 >> Know ‘AE x::m. 0 <= f x’
9397 >- (HO_MATCH_MP_TAC FORALL_IMP_AE >> rw [])
9398 >> DISCH_TAC
9399 >> Know ‘measure_space (density m f)’
9400 >- (MATCH_MP_TAC measure_space_density >> rw [])
9401 >> DISCH_TAC
9402 >> Know ‘pos_fn_integral (density m f) g = pos_fn_integral (density m f) g'’
9403 >- (MATCH_MP_TAC pos_fn_integral_cong >> rw [density_def] \\
9404     rw [Abbr ‘g'’])
9405 >> Rewr'
9406 >> Know ‘pos_fn_integral m (\x. f x * g x) = pos_fn_integral m (\x. f x * g' x)’
9407 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [Abbr ‘g'’] \\
9408     rpt STRIP_TAC \\
9409     MATCH_MP_TAC le_mul >> rw [])
9410 >> Rewr'
9411 >> MP_TAC (Q.SPECL [‘m’, ‘f’, ‘g'’] pos_fn_integral_density) >> simp []
9412 >> Know ‘density m f^+ = density m f’
9413 >- (MATCH_MP_TAC density_eq >> rw [FN_PLUS_REDUCE])
9414 >> Rewr'
9415 >> Rewr'
9416 >> MATCH_MP_TAC pos_fn_integral_cong >> simp []
9417 >> rpt STRIP_TAC
9418 >> MATCH_MP_TAC le_mul >> rw []
9419QED
9420
9421Theorem pos_fn_integral_density_of_reduce :
9422    !m f g. measure_space m /\
9423            f IN measurable (m_space m, measurable_sets m) Borel /\
9424            g IN measurable (m_space m, measurable_sets m) Borel /\
9425           (!x. x IN m_space m ==> 0 <= f x) /\
9426           (!x. x IN m_space m ==> 0 <= g x)
9427       ==> pos_fn_integral (density_of m f) g = pos_fn_integral m (\x. f x * g x)
9428Proof
9429    rpt STRIP_TAC
9430 >> Know ‘pos_fn_integral (density_of m f) g = pos_fn_integral (density m f) g’
9431 >- (MATCH_MP_TAC pos_fn_integral_density_of >> art [])
9432 >> Rewr'
9433 >> MATCH_MP_TAC pos_fn_integral_density_reduce >> art []
9434QED
9435
9436Theorem integral_density :
9437    !m f g. measure_space m /\
9438            f IN measurable (m_space m, measurable_sets m) Borel /\
9439            g IN measurable (m_space m, measurable_sets m) Borel /\
9440           (!x. x IN m_space m ==> 0 <= f x)
9441       ==> (integrable (density m f) g <=> integrable m (\x. f x * g x)) /\
9442            integral (density m f) g = integral m (\x. f x * g x)
9443Proof
9444    rpt GEN_TAC >> STRIP_TAC
9445 >> simp [integrable_def, integral_def]
9446 >> Know ‘(\x. f x * g x) IN Borel_measurable (measurable_space m)’
9447 >- (MATCH_MP_TAC IN_MEASURABLE_BOREL_TIMES \\
9448     qexistsl_tac [‘f’, ‘g’] >> simp [])
9449 >> Rewr
9450 >> Suff ‘pos_fn_integral (density m f) g^+ =
9451          pos_fn_integral m (\x. f x * g x)^+ /\
9452          pos_fn_integral (density m f) g^- =
9453          pos_fn_integral m (\x. f x * g x)^-’ >- simp []
9454 (* preparing for pos_fn_integral_density_reduce *)
9455 >> Know ‘pos_fn_integral m (\x. f x * g x)^+ =
9456          pos_fn_integral m (\x. f x * g^+ x)’
9457 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [FN_PLUS_POS] \\
9458     CONJ_TAC
9459     >- (rpt STRIP_TAC >> MATCH_MP_TAC le_mul >> simp [FN_PLUS_POS]) \\
9460     rpt STRIP_TAC \\
9461     MATCH_MP_TAC fn_plus_fmul >> simp [])
9462 >> Rewr'
9463 >> Know ‘pos_fn_integral m (\x. f x * g x)^- =
9464          pos_fn_integral m (\x. f x * g^- x)’
9465 >- (MATCH_MP_TAC pos_fn_integral_cong >> simp [FN_MINUS_POS] \\
9466     CONJ_TAC
9467     >- (rpt STRIP_TAC >> MATCH_MP_TAC le_mul >> simp [FN_MINUS_POS]) \\
9468     rpt STRIP_TAC \\
9469     MATCH_MP_TAC fn_minus_fmul >> simp [])
9470 >> Rewr'
9471 (* applying pos_fn_integral_density_reduce *)
9472 >> CONJ_TAC (* 2 subgoals *)
9473 >| [ (* goal 1 (of 2) *)
9474      MATCH_MP_TAC pos_fn_integral_density_reduce >> simp [FN_PLUS_POS] \\
9475      MATCH_MP_TAC IN_MEASURABLE_BOREL_FN_PLUS \\
9476      simp [MEASURE_SPACE_SIGMA_ALGEBRA],
9477      (* goal 2 (of 2) *)
9478      MATCH_MP_TAC pos_fn_integral_density_reduce >> simp [FN_MINUS_POS] \\
9479      MATCH_MP_TAC IN_MEASURABLE_BOREL_FN_MINUS \\
9480      simp [MEASURE_SPACE_SIGMA_ALGEBRA] ]
9481QED
9482
9483(* NOTE: This is an easy corollary of TONELLI *)
9484Theorem pos_fn_integral_exchange :
9485    !m1 m2 f. sigma_finite_measure_space m1 /\
9486              sigma_finite_measure_space m2 /\
9487              f IN Borel_measurable (measurable_space m1 CROSS measurable_space m2) /\
9488             (!z. z IN m_space m1 CROSS m_space m2 ==> 0 <= f z) ==>
9489              pos_fn_integral m1 (\x. pos_fn_integral m2 (\y. f (x,y))) =
9490              pos_fn_integral m2 (\y. pos_fn_integral m1 (\x. f (x,y)))
9491Proof
9492    rpt STRIP_TAC
9493 >> MP_TAC (Q.SPECL [‘m_space m1’, ‘m_space m2’,
9494                     ‘measurable_sets m1’, ‘measurable_sets m2’,
9495                     ‘measure m1’, ‘measure m2’, ‘f’] TONELLI)
9496 >> simp [MEASURE_SPACE_REDUCE]
9497 >> STRIP_TAC
9498 >> NTAC 2 (POP_ASSUM (REWRITE_TAC o wrap o SYM))
9499QED
9500
9501Theorem MEASURABLE_SPACE_PROD :
9502    !M1 M2. measure_space M1 /\ measure_space M2 ==>
9503            measurable_space (M1 CROSS M2) =
9504            measurable_space M1 CROSS measurable_space M2
9505Proof
9506    rw [prod_measure_space_def, prod_sigma_def, SPACE_PROD_SIGMA]
9507 >> qmatch_abbrev_tac ‘(sp, subsets a) = _’
9508 >> ‘sp = space a’ by rw [Abbr ‘a’, SPACE_SIGMA] >> rw [SPACE]
9509QED
9510
9511Theorem SPACE_PROD :
9512    !M1 M2. measure_space M1 /\ measure_space M2 ==>
9513            m_space (M1 CROSS M2) = m_space M1 CROSS m_space M2
9514Proof
9515    rw [prod_measure_space_def]
9516QED
9517
9518(* ------------------------------------------------------------------------- *)
9519(*  More Radon-Nikodym Derivative Results                                    *)
9520(* ------------------------------------------------------------------------- *)
9521
9522(*
9523These are the results from my own accumulated library for RN derivatives
9524that I believe stand on their own as something useful for future users.
9525I used different machinery in my own work, but that can be hidden,
9526and the main results wrapped in the canonical machinery.
9527- Jared Yeager
9528*)
9529
9530
9531(* Helper lemmas *)
9532
9533Theorem pos_fn_integral_eq_0_imp_AE_0:
9534    !m f. measure_space m /\ f IN Borel_measurable (measurable_space m) /\
9535        (!x. x IN m_space m ==> 0 <= f x) /\ pos_fn_integral m f = 0 ==> AE x::m. f x = 0
9536Proof
9537    rw[] >>
9538    qspecl_then [`m`,`λx. !n. f x < 1 / &SUC n`,`λx. f x = 0`]
9539        (irule o SIMP_RULE (srw_ss ()) []) AE_subset >>
9540    CONJ_TAC
9541    >- (rw[] >> CCONTR_TAC >> last_x_assum $ dxrule_then assume_tac >> rfs[le_lt] >>
9542        qpat_x_assum `!n. _` mp_tac >> simp[extreal_lt_def] >> Cases_on `f x` >> fs[] >>
9543        simp[extreal_of_num_def,SYM normal_1,extreal_div_def,extreal_inv_def,extreal_mul_def] >>
9544        rw[] >> qspec_then `1 / r` assume_tac REAL_BIGNUM >> fs[] >> qexists_tac `n - 1` >>
9545        Cases_on `n` >- rfs[REAL_LT_LDIV_EQ] >> rename [`1 / r < &SUC n`] >>
9546        rfs[REAL_LT_LDIV_EQ] >> simp[REAL_LE_LT]) >>
9547    qspecl_then [`m`,`λn x. f x < 1 / &SUC n`,`univ(:num)`] (irule o SIMP_RULE (srw_ss ()) []) AE_BIGINTER >>
9548    rw[num_countable] >> simp[AE_DEF] >> qexists_tac `{x | ~(f x < 1 / &SUC n)} INTER m_space m` >> csimp[] >>
9549    simp[extreal_lt_def,null_set_def] >> CONJ_ASM1_TAC
9550    >- (irule $ cj 2 IN_MEASURABLE_BOREL_ALL_MEASURE >> simp[]) >>
9551    drule_then assume_tac $ cj 2 $ iffLR measure_space_def >>
9552    drule_all_then assume_tac $ cj 2 $ iffLR positive_def >> qmatch_abbrev_tac `measure _ s = _` >>
9553    CCONTR_TAC >> pop_assum $ assume_tac o GSYM >> dxrule_all_then assume_tac $ iffRL lt_le >>
9554    qpat_x_assum `pos_fn_integral m f = 0` mp_tac >> simp[GSYM le_antisym,GSYM extreal_lt_def] >> DISJ1_TAC >>
9555    irule lte_trans >> qexists_tac `pos_fn_integral m (λx. Normal (1 / &SUC n) * 𝟙 s x)` >>
9556    irule_at Any pos_fn_integral_mono >> simp[pos_fn_integral_cmul_indicator,le_mul,INDICATOR_FN_POS,lt_mul] >>
9557    rw[] >> fs[SYM normal_1,extreal_of_num_def,extreal_div_def,extreal_inv_def,extreal_mul_def] >>
9558    fs[normal_0] >> simp[GSYM REAL_INV_1OVER] >> rw[indicator_fn_def,Abbr`s`]
9559QED
9560
9561Theorem integral_eq_0_imp_AE_0:
9562    !m f. measure_space m /\ f IN Borel_measurable (measurable_space m) /\
9563        (!s. s IN measurable_sets m ==> integral m (λx. f x * indicator_fn s x) = 0) ==>
9564        AE x::m. f x = 0
9565Proof
9566    rw[] >>
9567    qspecl_then [‘m’,‘λx. f^+ x = 0 /\ f^- x = 0’,‘λx. f x = 0’] (irule o SIMP_RULE (srw_ss ()) []) AE_subset >>
9568    CONJ_TAC >- (rw[] >> simp[Once FN_DECOMP]) >>
9569    qspecl_then [‘m’,‘λx. f^+ x = 0’,‘λx. f^- x = 0’] (irule o SIMP_RULE (srw_ss ()) []) AE_INTER >>
9570    simp[] >> NTAC 2 $ irule_at Any pos_fn_integral_eq_0_imp_AE_0 >>
9571    drule_at_then Any mp_tac $ iffLR IN_MEASURABLE_BOREL_PLUS_MINUS >>
9572    simp[FN_PLUS_POS,FN_MINUS_POS] >> DISCH_TAC >>
9573    fs[] >> imp_res_tac IN_MEASURABLE_BOREL_OR >> pop_assum kall_tac >> rfs[] >>
9574    NTAC 2 $ first_x_assum $ qspec_then ‘0’ assume_tac >>
9575    map_every qabbrev_tac [‘s = {x | 0 < f^+ x} INTER m_space m’,‘t = {x | 0 < f^- x} INTER m_space m’] >>
9576    RES_TAC >> fs[integral_def,fn_plus_mul_indicator,fn_minus_mul_indicator] >>
9577    ‘pos_fn_integral m (λx. f^+ x * indicator_fn s x) =
9578     pos_fn_integral m f^+ /\
9579     pos_fn_integral m (λx. f^- x * indicator_fn s x) = 0 /\
9580     pos_fn_integral m (λx. f^+ x * indicator_fn t x) = 0 /\
9581     pos_fn_integral m (λx. f^- x * indicator_fn t x) = pos_fn_integral m f^-’
9582        suffices_by (strip_tac >> fs[]) >>
9583    drule_then (SUBST1_TAC o GSYM) pos_fn_integral_zero >>
9584    NTAC 4 $ irule_at Any pos_fn_integral_cong >>
9585    simp[FN_PLUS_POS,FN_MINUS_POS,INDICATOR_FN_POS,le_mul] >>
9586    NTAC 2 $ pop_assum kall_tac >> rw[indicator_fn_def,Abbr ‘s’,Abbr ‘t’]
9587    >- (qspecl_then [‘f’,‘x’] mp_tac FN_MINUS_POS >> simp[le_lt])
9588    >- (fs[fn_plus_def,fn_minus_def] >> Cases_on ‘f x < 0’ >> fs[ineq_imp])
9589    >- (fs[fn_plus_def,fn_minus_def] >> Cases_on ‘0 < f x’ >> fs[ineq_imp])
9590    >- (qspecl_then [‘f’,‘x’] mp_tac FN_PLUS_POS >> simp[le_lt])
9591QED
9592
9593Theorem integral_eq_imp_AE_eq:
9594    !m f g. measure_space m /\ integrable m f /\ integrable m g /\
9595           (!s. s IN measurable_sets m ==>
9596            integral m (λx. f x * indicator_fn s x) =
9597            integral m (λx. g x * indicator_fn s x)) ==>
9598            AE x::m. f x = g x
9599Proof
9600    rw[] >>
9601    qspecl_then [`m`,
9602                 `λx. f x = (Normal o real o f) x /\ g x = (Normal o real o g) x /\
9603                      g x - f x = 0`,`λx. f x = g x`]
9604                (irule o SIMP_RULE (srw_ss ()) []) AE_subset >>
9605    CONJ_TAC >- (rw[] >> Cases_on `f x` >> Cases_on `g x` >> fs[extreal_sub_def]) >>
9606    qspecl_then [`m`,`λx. f x = Normal (real (f x)) /\ g x = Normal (real (g x))`,
9607        `λx. g x - f x = 0`] (irule o SIMP_RULE (srw_ss ()) [GSYM CONJ_ASSOC]) AE_INTER >>
9608    qspecl_then [`m`,`λx. f x = Normal (real (f x))`,`λx. g x = Normal (real (g x))`]
9609        (irule_at Any o SIMP_RULE (srw_ss ()) []) AE_INTER >>
9610    simp[SIMP_RULE (srw_ss ()) [] integrable_AE_finite] >>
9611    qspecl_then [`m`,`λx. g x - f x`] (irule o SIMP_RULE (srw_ss ()) []) integral_eq_0_imp_AE_0 >>
9612    irule_at Any IN_MEASURABLE_BOREL_SUB' >> qexistsl_tac [`f`,`g`] >>
9613    simp[SIMP_RULE (srw_ss ()) [] $ iffLR integrable_def] >> rw[] >>
9614    map_every (fn tms => qspecl_then tms assume_tac integrable_mul_indicator)
9615        [[`m`,`s`,`f`],[`m`,`s`,`g`]] >>
9616    rfs[] >> first_x_assum $ drule_then assume_tac >>
9617    qspecl_then [`m`,`λx. g x * indicator_fn s x`,`λx. f x * indicator_fn s x`]
9618                assume_tac integral_sub' >> rfs[] >>
9619    drule_all_then assume_tac integrable_normal_integral >> fs[] >>
9620    pop_assum SUBST_ALL_TAC >>
9621    fs[extreal_sub_def,normal_0] >> pop_assum $ SUBST1_TAC o SYM >>
9622    irule integral_cong >>
9623    rw[indicator_fn_def]
9624QED
9625
9626Theorem pos_fn_integral_cong':
9627    !sp sts mu nu f g.
9628        (measure_space (sp,sts,mu) \/ measure_space (sp,sts,nu)) /\
9629        (!s. s IN sts ==> mu s = nu s) /\
9630        (!x. x IN sp ==> 0 <= f x \/ 0 <= g x) /\ (!x. x IN sp ==> f x = g x) ==>
9631        pos_fn_integral (sp,sts,mu) f = pos_fn_integral (sp,sts,nu) g
9632Proof
9633    rw[] >> irule EQ_TRANS >> qexists_tac `pos_fn_integral (sp,sts,nu) f` >>
9634    irule_at Any pos_fn_integral_cong_measure >>
9635    irule_at Any pos_fn_integral_cong >> fs[] >>
9636    dxrule_then irule measure_space_eq >> simp[]
9637QED
9638
9639(* Internal definition transformed into an overload,
9640   tied back to original definition *)
9641
9642Definition RN_deriv_property_def :
9643    RN_deriv_property sa nu mu f <=>
9644       f IN Borel_measurable sa /\
9645      (!x. x IN space sa ==> 0 <= f x) /\
9646      (!s. s IN subsets sa ==> (f * (space sa,subsets sa,mu)) s = nu s)
9647End
9648
9649Theorem IN_RN_deriv_property :
9650    !f sa nu mu. f IN RN_deriv_property sa nu mu <=>
9651                 f IN Borel_measurable sa /\
9652                (!x. x IN space sa ==> 0 <= f x) /\
9653                (!s. s IN subsets sa ==> (f * (space sa,subsets sa,mu)) s = nu s)
9654Proof
9655    rpt GEN_TAC
9656 >> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [IN_APP]
9657 >> REWRITE_TAC [RN_deriv_property_def]
9658QED
9659
9660Theorem RN_deriv_RN_deriv_property :
9661    !sa mu nu. sigma_finite_measure_space (space sa,subsets sa,mu) /\
9662        measure_space (space sa,subsets sa,nu) /\ nu << (space sa,subsets sa,mu) ==>
9663        nu / (space sa,subsets sa,mu) IN RN_deriv_property sa nu mu
9664Proof
9665    ntac 4 strip_tac >> simp[RN_deriv_def]
9666 >> SELECT_ELIM_TAC
9667 >> reverse CONJ_TAC
9668 >- (Q.X_GEN_TAC ‘f’ >> rpt STRIP_TAC \\
9669     simp [IN_APP, RN_deriv_property_def])
9670 >> fs[sigma_finite_measure_space_def]
9671 >> qspecl_then [‘(space sa,subsets sa,mu)’,‘nu’] assume_tac Radon_Nikodym'
9672 >> rfs[]
9673 >> qexists_tac `f` >> simp[]
9674QED
9675
9676Theorem RN_deriv_property_almost_unique :
9677    !sa mu nu f g. measure_space (space sa,subsets sa,mu) /\
9678        sigma_finite_measure_space (space sa,subsets sa,nu) /\
9679        f IN RN_deriv_property sa nu mu /\ g IN RN_deriv_property sa nu mu ==>
9680        AE x::(space sa,subsets sa,mu). f x = g x
9681Proof
9682    rw[sigma_finite_measure_space_def,sigma_finite_def]
9683 >> rename [`Ai IN (univ(:num) → subsets sa)`]
9684 >> qspecl_then [`(space sa,subsets sa,nu)`,
9685                 `λx. !n. x IN Ai n ==> f x = g x`, `λx. f x = g x`]
9686                (irule o SIMP_RULE (srw_ss ()) []) AE_subset
9687 >> qexists_tac `Ai`
9688 >> CONJ_TAC
9689 >- (rw[] >> qpat_x_assum `_ = space sa` $ SUBST_ALL_TAC o SYM \\
9690     rfs[IN_BIGUNION_IMAGE,SF SFY_ss])
9691 >> qspecl_then [`(space sa,subsets sa,nu)`,
9692                 `λn x. x IN Ai n ==> f x = g x`,`univ(:num)`]
9693                (irule o SIMP_RULE (srw_ss ()) []) AE_BIGINTER
9694 >> rw[]
9695 >> qspecl_then [`(space sa,subsets sa,nu)`,
9696                 `λx. f x * indicator_fn (Ai n) x = g x * indicator_fn (Ai n) x`,
9697                 `λx. x IN Ai n ==> f x = g x`]
9698                (irule o SIMP_RULE (srw_ss ()) []) AE_subset
9699 >> CONJ_TAC >- (rw[] >> fs[indicator_fn_def])
9700 >> qspecl_then [`m`,`λx. f x * indicator_fn (Ai n) x`,
9701                 `λx. g x * indicator_fn (Ai n) x`]
9702                (irule o SIMP_RULE (srw_ss ()) []) integral_eq_imp_AE_eq
9703 >> fs [density_measure_def, FUNSET, IN_RN_deriv_property]
9704 >> simp[INDICATOR_FN_POS,le_mul,integrable_pos,integral_pos_fn,
9705         IN_MEASURABLE_BOREL_MUL_INDICATOR,lt_infty,SF SFY_ss]
9706 >> rw[]
9707 >> `Ai n INTER s IN subsets sa`
9708      by (irule SIGMA_ALGEBRA_INTER >> fs[measure_space_def])
9709 >> NTAC 2 $ first_x_assum $ drule_then assume_tac
9710 >> fs[INDICATOR_FN_INTER,mul_assoc]
9711QED
9712
9713Theorem RN_deriv_property_almost_RN_deriv :
9714    !sa mu nu f g. sigma_finite_measure_space (space sa,subsets sa,mu) /\
9715        sigma_finite_measure_space (space sa,subsets sa,nu) /\
9716        nu << (space sa,subsets sa,mu) /\ f IN RN_deriv_property sa nu mu ==>
9717        AE x::(space sa,subsets sa,mu). f x = (nu / (space sa,subsets sa,mu)) x
9718Proof
9719    rw[] >> irule RN_deriv_property_almost_unique >>
9720    conj_tac >- simp[iffLR sigma_finite_measure_space_def] >>
9721    qexists_tac ‘nu’ >> ntac 2 (conj_tac >- simp[]) >>
9722    irule RN_deriv_RN_deriv_property >> simp[iffLR sigma_finite_measure_space_def]
9723QED
9724
9725(* Using RN derivative to change space of integration *)
9726
9727Theorem RN_deriv_property_pos_fn_integral :
9728    !sa mu nu dndm f.
9729        f IN Borel_measurable sa /\ (!x. x IN space sa ==> 0 <= f x) /\
9730        measure_space (space sa,subsets sa,mu) /\
9731        measure_space (space sa,subsets sa,nu) /\
9732        dndm IN RN_deriv_property sa nu mu ==>
9733        pos_fn_integral (space sa,subsets sa,nu) f =
9734        pos_fn_integral (space sa,subsets sa,mu) (λx. dndm x * f x)
9735Proof
9736    rw[] >> fs[measure_absolutely_continuous_def,density_measure_def] >>
9737    fs [IN_RN_deriv_property] >>
9738    qspecl_then [`(space sa,subsets sa,mu)`,`dndm`,`f`] assume_tac pos_fn_integral_density_reduce >>
9739    rfs[density_def,density_measure_def] >> pop_assum $ SUBST1_TAC o SYM >>
9740    irule pos_fn_integral_cong' >> simp[]
9741QED
9742
9743Theorem RN_deriv_property_integral[local]:
9744    !sa mu nu dndm f.
9745        f IN Borel_measurable sa /\
9746        measure_space (space sa,subsets sa,mu) /\
9747        measure_space (space sa,subsets sa,nu) /\
9748        dndm IN RN_deriv_property sa nu mu ==>
9749        integral (space sa,subsets sa,nu) f =
9750        integral (space sa,subsets sa,mu) (λx. dndm x * f x)
9751Proof
9752    rw[integral_def] >> ‘sigma_algebra sa’ by fs[measure_space_def]
9753 >> map_every (fn tms => qspecl_then tms mp_tac RN_deriv_property_pos_fn_integral)
9754              [[‘sa’,‘mu’,‘nu’,‘dndm’,‘f^+’],[‘sa’,‘mu’,‘nu’,‘dndm’,‘f^-’]]
9755 >> simp[iffLR IN_MEASURABLE_BOREL_PLUS_MINUS,FN_PLUS_POS,FN_MINUS_POS,SF SFY_ss]
9756 >> fs [IN_RN_deriv_property]
9757 >> NTAC 2 $ disch_then kall_tac
9758 >> ‘!x1:extreal x2 x3 x4. x1 = x3 /\ x2 = x4 ==> x1 - x2 = x3 - x4’ by simp[]
9759 >> pop_assum irule >> NTAC 2 $ irule_at Any pos_fn_integral_cong >> simp[]
9760 >> `!x. x IN space sa ==> ((λx. dndm x * f x)^+ x = dndm x * f^+ x) /\
9761                           ((λx. dndm x * f x)^- x = dndm x * f^- x)`
9762      by (NTAC 2 strip_tac >> simp[FN_PLUS_MUL,FN_MINUS_MUL])
9763 >> simp[FN_PLUS_POS,FN_MINUS_POS,le_mul]
9764QED
9765
9766Theorem RN_deriv_pos_fn_integral:
9767    !m v f. f IN Borel_measurable (measurable_space m) /\
9768           (!x. x IN m_space m ==> 0 <= f x) /\
9769            sigma_finite_measure_space m /\
9770            measure_space (m_space m,measurable_sets m,v) /\ v << m ==>
9771            pos_fn_integral (m_space m,measurable_sets m,v) f =
9772            pos_fn_integral m (λx. (v / m) x * f x)
9773Proof
9774    rw[]
9775 >> resolve_then Any (qspecl_then [‘measurable_space m’,‘v’,‘measure m’]
9776                                  (irule o SRULE []))
9777        RN_deriv_RN_deriv_property RN_deriv_property_pos_fn_integral
9778 >> simp[sigma_finite_measure_space_measure_space]
9779QED
9780
9781Theorem RN_deriv_integral:
9782    !m v f. f IN Borel_measurable (measurable_space m) /\
9783           (!x. x IN m_space m ==> 0 <= f x) /\
9784            sigma_finite_measure_space m /\
9785            measure_space (m_space m,measurable_sets m,v) /\ v << m ==>
9786            integral (m_space m,measurable_sets m,v) f =
9787            integral m (λx. (v / m) x * f x)
9788Proof
9789    rw[]
9790 >> resolve_then Any (qspecl_then [‘measurable_space m’,‘v’,‘measure m’]
9791                                  (irule o SRULE []))
9792        RN_deriv_RN_deriv_property RN_deriv_property_integral
9793 >> simp[sigma_finite_measure_space_measure_space]
9794QED
9795
9796(* Multiplying RN derivatives *)
9797
9798Theorem RN_deriv_property_mul :
9799    !sa lam mu nu dmdl dndm dndl.
9800        measure_space (space sa,subsets sa,mu) /\
9801        measure_space (space sa,subsets sa,nu) /\
9802        measure_space (space sa,subsets sa,lam) /\
9803        dmdl IN RN_deriv_property sa mu lam /\
9804        dndm IN RN_deriv_property sa nu mu /\
9805        (!x. x IN space sa ==> dndl x = dmdl x * dndm x) ==>
9806        dndl IN RN_deriv_property sa nu lam
9807Proof
9808    ntac 8 strip_tac >> ‘sigma_algebra sa’ by fs[measure_space_def]
9809 >> fs [IN_RN_deriv_property]
9810 >> simp[density_measure_def]
9811 >> irule_at Any IN_MEASURABLE_BOREL_MUL'
9812 >> qexistsl_tac [`dndm`,`dmdl`]
9813 >> fs[] >> simp[le_mul,SF SFY_ss] >> rw[]
9814 >> qpat_x_assum ‘!s. s IN subsets sa ==> _ s = nu s’ $ drule_then $ SUBST1_TAC o SYM
9815 >> simp[density_measure_def]
9816 >> qspecl_then [‘sa’,‘lam’,‘mu’,‘dmdl’,‘(λx. dndm x * indicator_fn s x)’]
9817                mp_tac RN_deriv_property_pos_fn_integral
9818 >> simp[IN_RN_deriv_property]
9819 >> impl_tac
9820 >- (irule_at Any IN_MEASURABLE_BOREL_MUL_INDICATOR \\
9821     simp[INDICATOR_FN_POS,le_mul,SF SFY_ss])
9822 >> disch_then SUBST1_TAC >> irule pos_fn_integral_cong
9823 >> simp[INDICATOR_FN_POS,le_mul] >> rw[indicator_fn_def] >> simp[mul_comm]
9824QED
9825
9826Theorem RN_deriv_mul:
9827    !m u v. sigma_finite_measure_space m /\
9828        sigma_finite_measure_space (m_space m,measurable_sets m,u) /\
9829        sigma_finite_measure_space (m_space m,measurable_sets m,v) /\
9830        u << m /\ v << (m_space m,measurable_sets m,u) ==>
9831        AE x::m. (u / m) x * (v / (m_space m,measurable_sets m,u)) x = (v / m) x
9832Proof
9833    rw[] >> drule_all_then assume_tac measure_absolutely_continuous_trans >>
9834    qabbrev_tac ‘deriv = RN_deriv_property’ >>
9835    qspecl_then [‘measurable_space m’,‘measure m’,‘v’,
9836        ‘λx. (u / m) x * (v / (m_space m,measurable_sets m,u)) x’,‘v / m’]
9837        mp_tac RN_deriv_property_almost_RN_deriv >>
9838    simp[Excl "SET_SPEC_CONV"] >> disch_then irule >>
9839    qspecl_then [‘measurable_space m’,‘measure m’,‘u’,‘v’,
9840        ‘u / m’,‘v / (m_space m,measurable_sets m,u)’,
9841        ‘(λx. (u / m) x * (v / (m_space m,measurable_sets m,u)) x)’]
9842        mp_tac RN_deriv_property_mul >>
9843    simp[Excl "SET_SPEC_CONV",sigma_finite_measure_space_measure_space] >>
9844    disch_then irule >>
9845    qspecl_then [‘measurable_space m’,‘measure m’,‘u’]
9846                mp_tac RN_deriv_RN_deriv_property >>
9847    impl_tac >- simp[sigma_finite_measure_space_measure_space] >>
9848    simp[Excl "SET_SPEC_CONV"] >> disch_then kall_tac >>
9849    qspecl_then [‘measurable_space m’,‘u’,‘v’] mp_tac RN_deriv_RN_deriv_property >>
9850    impl_tac >- simp[sigma_finite_measure_space_measure_space] >>
9851    simp[Excl "SET_SPEC_CONV"]
9852QED
9853
9854(* Inverting RN derivative *)
9855
9856Theorem RN_deriv_property_1 :
9857    !sa mu. measure_space (space sa,subsets sa,mu) ==>
9858           (λx. 1) IN RN_deriv_property sa mu mu
9859Proof
9860    ntac 3 strip_tac >> ‘sigma_algebra sa’ by fs[measure_space_def] >>
9861    fs [IN_RN_deriv_property] >>
9862    rw[density_measure_def,IN_MEASURABLE_BOREL_CONST',SF SFY_ss,SF ETA_ss] >>
9863    drule_then assume_tac pos_fn_integral_indicator >> rfs[]
9864QED
9865
9866Theorem RN_deriv_1:
9867    !m. sigma_finite_measure_space m ==> AE x::m. ((measure m) / m) x = 1
9868Proof
9869    rw[] >> qabbrev_tac ‘deriv = RN_deriv_property’ >>
9870    qspecl_then [‘measurable_space m’,‘measure m’,‘measure m’,‘λx. 1’,
9871                 ‘measure m / m’] mp_tac RN_deriv_property_almost_RN_deriv >>
9872    simp[Excl "SET_SPEC_CONV",SF ETA_ss,measure_absolutely_continuous_self] >>
9873    disch_then irule >>
9874    qspecl_then [‘measurable_space m’,‘measure m’] mp_tac RN_deriv_property_1 >>
9875    simp[Excl "SET_SPEC_CONV",SF ETA_ss,sigma_finite_measure_space_measure_space]
9876QED
9877
9878Theorem RN_deriv_inv:
9879    !m v. sigma_finite_measure_space m /\
9880        sigma_finite_measure_space (m_space m,measurable_sets m,v) /\
9881        v << m /\ measure m << (m_space m,measurable_sets m,v) ==>
9882        AE x::m. (measure m / (m_space m,measurable_sets m,v)) x = inv ((v / m) x)
9883Proof
9884    rw[] >>
9885    qspecl_then [‘m’,‘λx. P1 x /\ P2 x’]
9886     (resolve_then Any (qspecl_then [‘m’,
9887        ‘λx. (measure m / (m_space m,measurable_sets m,v)) x = inv ((v / m) x)’,
9888        ‘λx. ((measure m) / m) x = 1’,
9889        ‘λx. (v / m) x * (measure m / (m_space m,measurable_sets m,v)) x =
9890             (measure m / m) x’] mp_tac)
9891        AE_INTER o SRULE [] o GENL [“m:'a m_space”,“P1:'a->bool”,“P2:'a->bool”])
9892      AE_subset >>
9893    simp[sigma_finite_measure_space_measure_space] >>
9894    disch_then irule >> irule_at Any RN_deriv_1 >> irule_at Any RN_deriv_mul >>
9895    rw[] >> pop_assum SUBST_ALL_TAC >> simp[rinv_uniq]
9896QED
9897
9898(* References:
9899
9900  [1] Schilling, R.L.: Measures, Integrals and Martingales (Second Edition).
9901      Cambridge University Press (2017).
9902  [2] Doob, J.L.: Stochastic processes. Wiley-Interscience (1990).
9903  [3] Doob, J.L.: What is a Martingale? Amer. Math. Monthly. 78(5), 451-463 (1971).
9904  [4] Pintacuda, N.: Probabilita'. Zanichelli, Bologna (1995).
9905  [5] Wikipedia: https://en.wikipedia.org/wiki/Leonida_Tonelli
9906  [6] Wikipedia: https://en.wikipedia.org/wiki/Guido_Fubini
9907 *)