lebesgue_measureScript.sml
1(* ========================================================================= *)
2(* Lebesgue Measure Theory (lebesgue_measure_hvgScript.sml) *)
3(* *)
4(* (c) Copyright 2015, *)
5(* Muhammad Qasim, *)
6(* Osman Hasan, *)
7(* Hardware Verification Group, *)
8(* Concordia University *)
9(* *)
10(* Contact: <m_qasi@ece.concordia.ca> *)
11(* *)
12(* Note: This theory is inspired from isabelle *)
13(* ------------------------------------------------------------------------- *)
14(* Equivalence of Lebesgue and Gauge (Henstock-Kurzweil) Integration *)
15(* ========================================================================= *)
16
17Theory lebesgue_measure
18Ancestors
19 prim_rec arithmetic num pred_set combin cardinal While
20 relation real seq transc real_sigma iterate topology metric
21 real_topology integration sigma_algebra extreal_base extreal
22 real_borel measure borel integer intreal lebesgue
23 integral[qualified] lift_ieee[qualified]
24Libs
25 numLib pred_setLib hurdUtils jrhUtils realLib
26
27val integral_def = integrationTheory.integral_def;
28
29val ASM_ARITH_TAC = rpt (POP_ASSUM MP_TAC) >> ARITH_TAC; (* numLib *)
30val DISC_RW_KILL = DISCH_TAC >> ONCE_ASM_REWRITE_TAC [] >> POP_ASSUM K_TAC;
31fun METIS ths tm = prove(tm, METIS_TAC ths);
32
33val _ = hide "top"; (* posetTheory *)
34val _ = hide "nf"; (* relationTheory *)
35
36val _ = intLib.deprecate_int ();
37val _ = ratLib.deprecate_rat ();
38
39(* Some proofs here are large with too many assumptions *)
40val _ = set_trace "Goalstack.print_goal_at_top" 0;
41
42(* ------------------------------------------------------------------------- *)
43(* Lebesgue sigma-algebra with the household Lebesgue measure (lebesgue) *)
44(* ------------------------------------------------------------------------- *)
45
46Theorem absolutely_integrable_on_indicator :
47 !A X. indicator A absolutely_integrable_on X <=>
48 indicator A integrable_on X
49Proof
50 rpt GEN_TAC >> REWRITE_TAC [absolutely_integrable_on]
51 >> EQ_TAC >> STRIP_TAC >> art []
52 >> Suff ‘!x. abs(indicator A x) = indicator A x’
53 >- (Rewr' >> METIS_TAC [ETA_AX])
54 >> RW_TAC real_ss [indicator]
55QED
56
57Theorem has_integral_indicator_UNIV :
58 !s A x. (indicator (s INTER A) has_integral x) UNIV =
59 (indicator s has_integral x) A
60Proof
61 Know ‘!(s :real set) A. (\x. if x IN A then indicator s x else 0) =
62 indicator (s INTER A)’
63 >- SET_TAC [indicator]
64 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
65 >> RW_TAC std_ss [HAS_INTEGRAL_RESTRICT_UNIV]
66 >> METIS_TAC [ETA_AX]
67QED
68
69Theorem integral_indicator_UNIV :
70 !s A. integral UNIV (indicator (s INTER A)) =
71 integral A (indicator s)
72Proof
73 REWRITE_TAC [integral_def] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
74 ABS_TAC THEN METIS_TAC [has_integral_indicator_UNIV]
75QED
76
77Theorem integrable_indicator_UNIV :
78 !s A. (indicator (s INTER A)) integrable_on UNIV <=>
79 (indicator s) integrable_on A
80Proof
81 RW_TAC std_ss [integrable_on] THEN AP_TERM_TAC THEN
82 ABS_TAC THEN METIS_TAC [has_integral_indicator_UNIV]
83QED
84
85Theorem integral_one : (* was: MEASURE_HOLLIGHT_EQ_ISABELLE *)
86 !A. integral A (\x. 1) = integral univ(:real) (indicator A)
87Proof
88 ONCE_REWRITE_TAC [METIS [SET_RULE ``A = A INTER A``]
89 ``indicator A = indicator (A INTER A)``]
90 >> SIMP_TAC std_ss [integral_indicator_UNIV]
91 >> rpt STRIP_TAC
92 >> MATCH_MP_TAC INTEGRAL_EQ >> SIMP_TAC std_ss [indicator]
93QED
94
95val indicator_fn_pos_le = INDICATOR_FN_POS;
96
97Theorem has_integral_interval_cube :
98 !a b n. (indicator (interval [a,b]) has_integral
99 content (interval [a,b] INTER (line n))) (line n)
100Proof
101 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC [GSYM has_integral_indicator_UNIV] THEN
102 SIMP_TAC std_ss [indicator, HAS_INTEGRAL_RESTRICT_UNIV] THEN
103 SIMP_TAC std_ss [line, GSYM interval, INTER_INTERVAL] THEN
104 ONCE_REWRITE_TAC [REAL_ARITH ``content (interval [(max a (-&n),min b (&n))]) =
105 content (interval [(max a (-&n),min b (&n))]) * 1``] THEN
106 METIS_TAC [HAS_INTEGRAL_CONST]
107QED
108
109(* Lebesgue sigma-algebra with the household measure (lebesgue),
110 constructed by Henstock-Kurzweil (gauge) Integration.
111
112 Named after Henri Lebesgue (1875-1941), a French mathematician [5]
113
114 NOTE: This definition of "Lebesgue measurable sets (and Lebesgue measure)"
115 is aligned with Definition 18.1 [2, p.300] and 18.7 [2, p.304].
116 *)
117Definition lebesgue_def :
118 lebesgue = (univ(:real),
119 {A | !n. (indicator A) integrable_on (line n)},
120 (\A. sup {Normal (integral (line n) (indicator A)) | n IN UNIV}))
121End
122
123(* NOTE: This name is inspired by HVG's old theorem name lmeasure_eq_0 *)
124Overload lmeasure = “measure lebesgue”
125
126Theorem space_lebesgue :
127 m_space lebesgue = univ(:real)
128Proof
129 SIMP_TAC std_ss [lebesgue_def, m_space_def]
130QED
131
132Theorem in_sets_lebesgue : (* was: lebesgueI *)
133 !A. (!n. indicator A integrable_on line n) ==> A IN measurable_sets lebesgue
134Proof
135 SIMP_TAC std_ss [lebesgue_def, measurable_sets_def] THEN SET_TAC []
136QED
137
138val lebesgueI = in_sets_lebesgue;
139
140Theorem limseq_indicator_BIGUNION : (* was: LIMSEQ_indicator_UN *)
141 !A x. ((\k. indicator (BIGUNION {(A:num->real->bool) i | i < k}) x) -->
142 (indicator (BIGUNION {A i | i IN UNIV}) x)) sequentially
143Proof
144 REPEAT GEN_TAC THEN ASM_CASES_TAC ``?i. x IN (A:num->real->bool) i`` THENL
145 [ALL_TAC, FULL_SIMP_TAC std_ss [indicator, IN_BIGUNION] THEN
146 SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV] THEN
147 KNOW_TAC ``~(?s. x IN s /\ ?i. s = (A:num->real->bool) i)`` THENL
148 [METIS_TAC [], DISCH_TAC] THEN
149 KNOW_TAC ``!k. ~(?s. x IN s /\ ?i. (s = (A:num->real->bool) i) /\ i < k)`` THENL
150 [METIS_TAC [], DISCH_TAC] THEN ASM_SIMP_TAC std_ss [LIM_CONST]] THEN
151 FULL_SIMP_TAC std_ss [] THEN
152 KNOW_TAC ``!k. indicator (BIGUNION {(A:num->real->bool) j | j < k + SUC i}) x = 1`` THENL
153 [RW_TAC real_ss [indicator, GSPECIFICATION, IN_BIGUNION] THEN
154 UNDISCH_TAC ``~?s. x IN s /\ ?j. (s = (A:num->real->bool) j) /\ j < k + SUC i`` THEN
155 SIMP_TAC std_ss [] THEN EXISTS_TAC ``(A:num->real->bool) i`` THEN
156 ASM_SIMP_TAC std_ss [] THEN EXISTS_TAC ``i:num`` THEN ASM_SIMP_TAC std_ss [] THEN
157 ARITH_TAC, DISCH_TAC] THEN
158 KNOW_TAC ``indicator (BIGUNION {(A:num->real->bool) i | i IN univ(:num)}) x = 1`` THENL
159 [RW_TAC real_ss [indicator, GSPECIFICATION, IN_BIGUNION] THEN
160 POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [IN_UNIV] THEN METIS_TAC [], DISCH_TAC] THEN
161 MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC ``SUC i`` THEN
162 ASM_SIMP_TAC std_ss [LIM_CONST]
163QED
164
165val LIMSEQ_indicator_UN = limseq_indicator_BIGUNION;
166
167Theorem sigma_algebra_lebesgue :
168 sigma_algebra (UNIV, {A | !n. (indicator A) integrable_on (line n)})
169Proof
170 RW_TAC std_ss [sigma_algebra_alt_pow]
171 >- (REWRITE_TAC [POW_DEF] >> SET_TAC [])
172 >- (SIMP_TAC std_ss [GSPECIFICATION] \\
173 Know `indicator {} = (\x:real. 0)` >- SET_TAC [indicator] \\
174 Rewr' >> SIMP_TAC std_ss [INTEGRABLE_0])
175 >- (FULL_SIMP_TAC std_ss [GSPECIFICATION] \\
176 Know `indicator (univ(:real) DIFF s) = (\x. 1 - indicator s x)`
177 >- (SIMP_TAC std_ss [indicator] >> ABS_TAC \\
178 SIMP_TAC std_ss [IN_DIFF, IN_UNIV] >> COND_CASES_TAC \\
179 FULL_SIMP_TAC real_ss []) >> Rewr' \\
180 ONCE_REWRITE_TAC [METIS [] ``(\x. 1 - indicator s x) =
181 (\x. (\x. 1) x - (\x. indicator s x) x)``] \\
182 GEN_TAC >> MATCH_MP_TAC INTEGRABLE_SUB >> CONJ_TAC >|
183 [SIMP_TAC std_ss [line, GSYM interval, INTEGRABLE_CONST],
184 METIS_TAC [ETA_AX]])
185 >> FULL_SIMP_TAC std_ss [GSPECIFICATION]
186 >> KNOW_TAC ``!k n. indicator (BIGUNION {(A:num->real->bool) i | i < k})
187 integrable_on (line n)``
188 >- (Induct_on `k`
189 >- (SIMP_TAC std_ss [LT] THEN REWRITE_TAC [SET_RULE ``BIGUNION {A i | i | F} = {}``] THEN
190 KNOW_TAC ``indicator {} = (\x:real. 0)``
191 THENL [SET_TAC [indicator], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
192 SIMP_TAC std_ss [INTEGRABLE_0]) \\
193 KNOW_TAC ``BIGUNION {A i | i < SUC k} =
194 BIGUNION {(A:num->real->bool) i | i < k} UNION A k`` THENL
195 [ SIMP_TAC std_ss [ADD1, ARITH_PROVE ``i < SUC k <=> (i < k \/ (i = k))``] THEN
196 SET_TAC [], DISCH_TAC THEN ASM_REWRITE_TAC [] ] THEN
197 KNOW_TAC ``indicator (BIGUNION {(A:num->real->bool) i | i < k} UNION A k) =
198 (\x. max (indicator (BIGUNION {A i | i < k}) x) (indicator (A k) x))`` THENL
199 [ SIMP_TAC std_ss [FUN_EQ_THM] THEN GEN_TAC THEN
200 SIMP_TAC std_ss [max_def, indicator] THEN
201 REPEAT COND_CASES_TAC THEN FULL_SIMP_TAC std_ss [IN_UNION] THEN
202 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN FULL_SIMP_TAC real_ss [],
203 DISCH_TAC ] THEN
204 REWRITE_TAC [GSYM absolutely_integrable_on_indicator] THEN GEN_TAC THEN
205 ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX THEN
206 ASM_SIMP_TAC std_ss [absolutely_integrable_on_indicator] THEN
207 FULL_SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_IMAGE, IN_UNIV] THEN
208 FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC [])
209 >> DISCH_TAC
210 >> GEN_TAC
211 >> MP_TAC (ISPECL [``(\k. indicator (BIGUNION {(A:num->real->bool) i | i < k}))``,
212 ``indicator (BIGUNION {(A:num->real->bool) i | i IN univ(:num)})``,
213 ``(\x:real. 1:real)``, ``line n``] DOMINATED_CONVERGENCE)
214 >> KNOW_TAC ``(!k.
215 (\k. indicator (BIGUNION {(A:num->real->bool) i | i < k})) k integrable_on line n) /\
216 (\x. 1) integrable_on line n /\
217 (!k x.
218 x IN line n ==>
219 abs ((\k. indicator (BIGUNION {A i | i < k})) k x) <= (\x. 1) x) /\
220 (!x.
221 x IN line n ==>
222 ((\k. (\k. indicator (BIGUNION {A i | i < k})) k x) -->
223 indicator (BIGUNION {A i | i IN univ(:num)}) x) sequentially)``
224 >| [ALL_TAC, METIS_TAC []]
225 >> REPEAT CONJ_TAC
226 >| [ FULL_SIMP_TAC std_ss [],
227 SIMP_TAC std_ss [line, GSYM interval, INTEGRABLE_CONST],
228 SIMP_TAC std_ss [DROP_INDICATOR_ABS_LE_1],
229 METIS_TAC [LIMSEQ_indicator_UN] ]
230QED
231
232Theorem sets_lebesgue :
233 measurable_sets lebesgue = {A | !n. (indicator A) integrable_on (line n)}
234Proof
235 SIMP_TAC std_ss [lebesgue_def, measurable_sets_def]
236QED
237
238Theorem in_sets_lebesgue_imp : (* was: lebesgueD *)
239 !A n. A IN measurable_sets lebesgue ==> indicator A integrable_on line n
240Proof
241 SIMP_TAC std_ss [sets_lebesgue, GSPECIFICATION]
242QED
243
244val lebesgueD = in_sets_lebesgue_imp;
245
246Theorem measure_lebesgue :
247 measure lebesgue =
248 (\A. sup {Normal (integral (line n) (indicator A)) | n IN UNIV})
249Proof
250 SIMP_TAC std_ss [measure_def, lebesgue_def]
251QED
252
253Theorem positive_lebesgue :
254 positive lebesgue
255Proof
256 SIMP_TAC std_ss [lebesgue_def, positive_def, sets_lebesgue, measure_lebesgue] THEN
257 SIMP_TAC std_ss [INDICATOR_EMPTY, IN_UNIV, INTEGRAL_0, extreal_of_num_def] THEN
258 REWRITE_TAC [SET_RULE ``{Normal 0 | n | T} = {Normal 0}``, sup_sing] THEN
259 RW_TAC std_ss [] THEN MATCH_MP_TAC le_sup_imp THEN
260 ONCE_REWRITE_TAC [GSYM SPECIFICATION] THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
261 EXISTS_TAC ``0:num`` THEN SIMP_TAC std_ss [extreal_11, line, GSYM interval] THEN
262 SIMP_TAC std_ss [REAL_NEG_0, INTEGRAL_REFL]
263QED
264
265Theorem countably_additive_lebesgue :
266 countably_additive lebesgue
267Proof
268 RW_TAC std_ss [countably_additive_def]
269 >> Know `!A. IMAGE A univ(:num) SUBSET measurable_sets lebesgue ==>
270 !i n. indicator (A i) integrable_on line n`
271 >- (rpt STRIP_TAC >> MATCH_MP_TAC lebesgueD \\
272 FULL_SIMP_TAC std_ss [SUBSET_DEF] \\
273 FIRST_X_ASSUM MATCH_MP_TAC >> METIS_TAC [IN_IMAGE, IN_UNIV])
274 >> DISCH_TAC
275 >> Know `!i n. 0 <= integral (line n) (indicator ((f:num->real->bool) i))`
276 >- (rpt STRIP_TAC >> MATCH_MP_TAC INTEGRAL_COMPONENT_POS \\
277 SIMP_TAC std_ss [DROP_INDICATOR_POS_LE] \\
278 FIRST_X_ASSUM MATCH_MP_TAC \\
279 FULL_SIMP_TAC std_ss [IN_FUNSET, SUBSET_DEF, IN_IMAGE] \\
280 METIS_TAC []) >> DISCH_TAC
281 >> Know `BIGUNION {f i | i IN UNIV} IN measurable_sets lebesgue ==>
282 !i n. (indicator ((f:num->real->bool) i)) integrable_on line n`
283 >- (RW_TAC std_ss [] \\
284 MATCH_MP_TAC lebesgueD \\
285 FULL_SIMP_TAC std_ss [IN_FUNSET, IN_UNIV])
286 >> FULL_SIMP_TAC std_ss [GSYM IMAGE_DEF] >> DISCH_TAC
287 >> SIMP_TAC std_ss [o_DEF, measure_lebesgue]
288 >> Know `suminf (\i. sup {(\n i. Normal (integral (line n) (indicator (f i)))) n i | n IN UNIV}) =
289 sup {suminf (\i. (\n i. Normal (integral (line n) (indicator (f i)))) n i) | n IN UNIV}`
290 >- (MATCH_MP_TAC ext_suminf_sup_eq \\
291 SIMP_TAC std_ss [extreal_of_num_def] \\
292 CONJ_TAC
293 >- (SIMP_TAC std_ss [extreal_le_def] >> rpt STRIP_TAC \\
294 MATCH_MP_TAC INTEGRAL_SUBSET_COMPONENT_LE \\
295 FULL_SIMP_TAC std_ss [LINE_MONO, DROP_INDICATOR_POS_LE]) \\
296 SIMP_TAC std_ss [extreal_le_def] \\
297 rpt GEN_TAC >> MATCH_MP_TAC INTEGRAL_COMPONENT_POS \\
298 FULL_SIMP_TAC std_ss [DROP_INDICATOR_POS_LE])
299 >> RW_TAC std_ss [] >> POP_ASSUM K_TAC
300 >> Suff `!n. Normal (integral (line n) (indicator (BIGUNION (IMAGE f univ(:num))))) =
301 suminf (\x. Normal (integral (line n) (indicator ((f:num->real->bool) x))))`
302 >- (DISCH_TAC >> ASM_SIMP_TAC std_ss [])
303 >> GEN_TAC
304 >> Know `suminf (\x. Normal (integral (line n) (indicator (f x)))) =
305 sup (IMAGE (\n'. EXTREAL_SUM_IMAGE (\x. Normal (integral (line n) (indicator (f x))))
306 (count n')) UNIV)`
307 >- (MATCH_MP_TAC ext_suminf_def \\
308 rw [extreal_of_num_def, extreal_le_eq]) >> Rewr'
309 >> SIMP_TAC std_ss [FINITE_COUNT, EXTREAL_SUM_IMAGE_NORMAL]
310 >> Know `mono_increasing
311 (\n'. SIGMA (\x. integral (line n) (indicator ((f:num->real->bool) x))) (count n'))`
312 >- (SIMP_TAC std_ss [mono_increasing_def] THEN
313 REPEAT STRIP_TAC THEN SIMP_TAC std_ss [GSYM extreal_le_def] THEN
314 SIMP_TAC std_ss [FINITE_COUNT, GSYM EXTREAL_SUM_IMAGE_NORMAL] THEN
315 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET THEN
316 ASM_SIMP_TAC real_ss [count_def, GSPECIFICATION, FINITE_COUNT, SUBSET_DEF] THEN
317 REPEAT STRIP_TAC THEN REWRITE_TAC [extreal_of_num_def, extreal_le_def] THEN
318 MATCH_MP_TAC INTEGRAL_COMPONENT_POS THEN
319 ASM_SIMP_TAC std_ss [DROP_INDICATOR_POS_LE]) >> DISCH_TAC
320 >> ASM_SIMP_TAC std_ss [GSYM sup_seq', REAL_SUM_IMAGE_COUNT]
321 >> Know `!n m. sum (0,m) (\x. integral (line n) (indicator ((f:num->real->bool) x))) =
322 integral (line n) (indicator (BIGUNION {f i | i < m}))`
323 THENL (* The rest (original proof) works fine *)
324[GEN_TAC THEN Induct_on `m` THENL
325 [REWRITE_TAC [realTheory.sum, LT] THEN
326 REWRITE_TAC [SET_RULE ``{f i | i | F} = {}``, BIGUNION_EMPTY] THEN
327 SIMP_TAC real_ss [INDICATOR_EMPTY, INTEGRAL_0], ALL_TAC] THEN
328 KNOW_TAC ``!m. BIGUNION {(f:num->real->bool) i | i < m} IN
329 measurable_sets lebesgue`` THENL
330 [GEN_TAC THEN MATCH_MP_TAC lebesgueI THEN GEN_TAC THEN
331 ASSUME_TAC sigma_algebra_lebesgue THEN
332 FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, GSPECIFICATION, subsets_def, space_def] THEN
333 POP_ASSUM MATCH_MP_TAC THEN
334 ASM_SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNIV] THEN CONJ_TAC THENL
335 [REWRITE_TAC [pred_setTheory.COUNTABLE_ALT] THEN SET_TAC [], ALL_TAC] THEN METIS_TAC [],
336 DISCH_TAC] THEN
337 KNOW_TAC ``!m. BIGUNION {(f:num->real->bool) i | i < m} INTER f m = {}`` THENL
338 [GEN_TAC THEN SIMP_TAC std_ss [INTER_DEF, IN_BIGUNION, GSPECIFICATION] THEN
339 SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] THEN
340 GEN_TAC THEN ASM_CASES_TAC ``x NOTIN (f:num->real->bool) m'`` THEN
341 ASM_REWRITE_TAC [] THEN GEN_TAC THEN
342 ASM_CASES_TAC ``x IN (s:real->bool)`` THEN FULL_SIMP_TAC std_ss [] THEN
343 GEN_TAC THEN ASM_CASES_TAC ``~(i < m':num)`` THEN FULL_SIMP_TAC std_ss [] THEN
344 EXISTS_TAC ``x:real`` THEN FULL_SIMP_TAC std_ss [DISJOINT_DEF] THEN
345 POP_ASSUM MP_TAC THEN DISCH_THEN (ASSUME_TAC o MATCH_MP LESS_NOT_EQ) THEN
346 ASM_SET_TAC [], DISCH_TAC] THEN
347 KNOW_TAC ``!x. indicator (BIGUNION {(f:num->real->bool) i | i < SUC m}) x =
348 indicator (BIGUNION {f i | i < m}) x +
349 indicator (f m) x`` THENL
350 [GEN_TAC THEN SIMP_TAC std_ss [indicator] THEN
351 ASM_CASES_TAC ``x IN ((f:num->real->bool) m)`` THEN ASM_SIMP_TAC std_ss [] THENL
352 [KNOW_TAC ``x NOTIN BIGUNION {(f:num->real->bool) i | i < m}`` THENL
353 [ASM_SET_TAC [], DISCH_TAC] THEN ASM_SIMP_TAC real_ss [IN_BIGUNION] THEN
354 SIMP_TAC std_ss [GSPECIFICATION] THEN
355 KNOW_TAC ``?s. x IN s /\ ?i. (s = (f:num->real->bool) i) /\ i < SUC m`` THENL
356 [ALL_TAC, METIS_TAC []] THEN EXISTS_TAC ``(f:num->real->bool) m`` THEN
357 ASM_REWRITE_TAC [] THEN EXISTS_TAC ``m:num`` THEN SIMP_TAC arith_ss [], ALL_TAC] THEN
358 FULL_SIMP_TAC real_ss [IN_BIGUNION, GSPECIFICATION] THEN COND_CASES_TAC THENL
359 [ALL_TAC, COND_CASES_TAC THENL [ALL_TAC, SIMP_TAC real_ss []] THEN
360 FULL_SIMP_TAC std_ss [] THEN FIRST_X_ASSUM (MP_TAC o SPEC ``s:real->bool``) THEN
361 ASM_SIMP_TAC std_ss [] THEN DISCH_THEN (MP_TAC o SPEC ``i:num``) THEN
362 ASM_SIMP_TAC arith_ss []] THEN FULL_SIMP_TAC std_ss [] THEN
363 COND_CASES_TAC THENL [SIMP_TAC std_ss [], ALL_TAC] THEN
364 FULL_SIMP_TAC std_ss [] THEN FIRST_X_ASSUM (MP_TAC o SPEC ``(f:num->real->bool) i``) THEN
365 ASM_SIMP_TAC std_ss [] THEN DISCH_THEN (MP_TAC o SPEC ``i:num``) THEN
366 RW_TAC std_ss [] THEN KNOW_TAC ``i = m:num`` THENL
367 [ASM_SIMP_TAC arith_ss [], DISCH_TAC] THEN FULL_SIMP_TAC std_ss [],
368 DISCH_TAC] THEN
369 ONCE_REWRITE_TAC [realTheory.sum] THEN ASM_REWRITE_TAC [] THEN
370 ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN REWRITE_TAC [ADD] THEN
371 GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
372 [METIS [] ``!f. indicator f = (\x. indicator f x)``] THEN
373 SIMP_TAC std_ss [] THEN
374 KNOW_TAC ``integral (line n') (indicator (BIGUNION {f i | i < SUC m})) =
375 integral (line n') ((\x. (\x. indicator (BIGUNION {f i | i < m}) x) x +
376 (\x. indicator ((f:num->real->bool) m) x) x))`` THENL
377 [FIRST_X_ASSUM (ASSUME_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
378 ASM_SIMP_TAC std_ss [] THEN METIS_TAC [], DISC_RW_KILL] THEN
379 MATCH_MP_TAC INTEGRAL_ADD THEN METIS_TAC [lebesgueD], DISCH_TAC] THEN
380 ASM_SIMP_TAC std_ss [] THEN
381 MATCH_MP_TAC (METIS [] ``!P. (P /\ Q) ==> Q``) THEN
382 ONCE_REWRITE_TAC [METIS []
383 ``(indicator (BIGUNION {(f:num->real->bool) i | i < n'})) =
384 (\n'. indicator (BIGUNION {f i | i < n'})) n'``] THEN
385 EXISTS_TAC ``(indicator (BIGUNION (IMAGE (f:num->real->bool) univ(:num))))
386 integrable_on (line n)`` THEN
387 MATCH_MP_TAC DOMINATED_CONVERGENCE THEN EXISTS_TAC ``\x:real. 1:real`` THEN
388 REPEAT CONJ_TAC THENL
389 [KNOW_TAC ``!m. BIGUNION {(f:num->real->bool) i | i < m} IN
390 measurable_sets lebesgue`` THENL
391 [GEN_TAC THEN MATCH_MP_TAC lebesgueI THEN GEN_TAC THEN
392 ASSUME_TAC sigma_algebra_lebesgue THEN
393 FULL_SIMP_TAC std_ss [SIGMA_ALGEBRA, GSPECIFICATION, subsets_def, space_def] THEN
394 POP_ASSUM MATCH_MP_TAC THEN
395 ASM_SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNIV] THEN CONJ_TAC THENL
396 [REWRITE_TAC [pred_setTheory.COUNTABLE_ALT] THEN SET_TAC [], ALL_TAC] THEN
397 METIS_TAC [],
398 DISCH_TAC] THEN METIS_TAC [lebesgueD],
399 SIMP_TAC std_ss [line, GSYM interval, INTEGRABLE_CONST],
400 FULL_SIMP_TAC std_ss [DROP_INDICATOR_ABS_LE_1], ALL_TAC] THEN
401 METIS_TAC [LIMSEQ_indicator_UN, IMAGE_DEF]
402QED
403
404Theorem measure_space_lebesgue :
405 measure_space lebesgue
406Proof
407 SIMP_TAC std_ss [measure_space_def, positive_lebesgue]
408 >> SIMP_TAC std_ss [sets_lebesgue, space_lebesgue, sigma_algebra_lebesgue]
409 >> SIMP_TAC std_ss [countably_additive_lebesgue]
410QED
411
412Theorem borel_imp_lebesgue_sets : (* was: lebesgueI_borel *)
413 !s. s IN subsets borel ==> s IN measurable_sets lebesgue
414Proof
415 RW_TAC std_ss [borel_eq_ge_le]
416 >> POP_ASSUM MP_TAC
417 >> Q.SPEC_TAC (‘s’, ‘s’)
418 >> REWRITE_TAC [GSYM SUBSET_DEF]
419 >> ‘measurable_sets lebesgue = subsets (m_space lebesgue,measurable_sets lebesgue)’
420 by rw [subsets_def]
421 >> POP_ORW
422 >> ‘univ(:real) = space (m_space lebesgue,measurable_sets lebesgue)’
423 by rw [space_def, space_lebesgue]
424 >> POP_ORW
425 >> MATCH_MP_TAC SIGMA_SUBSET
426 >> CONJ_TAC >- rw [space_lebesgue, sets_lebesgue, sigma_algebra_lebesgue]
427 >> RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNIV, subsets_def]
428 >> rename1 ‘(\(a,b). {x | a <= x /\ x <= b}) y IN measurable_sets lebesgue’
429 >> Cases_on ‘y’
430 >> RW_TAC std_ss []
431 >> MATCH_MP_TAC lebesgueI
432 >> REWRITE_TAC [integrable_on, GSYM interval]
433 >> METIS_TAC [has_integral_interval_cube]
434QED
435
436val lebesgueI_borel = borel_imp_lebesgue_sets;
437
438(* TODO: prove this theorem with PSUBSET, i.e. the existence of non-Borel
439 Lebesgue-measurable sets.
440 *)
441Theorem lborel_subset_lebesgue :
442 measurable_sets lborel SUBSET measurable_sets lebesgue
443Proof
444 RW_TAC std_ss [SUBSET_DEF, sets_lborel]
445 >> MATCH_MP_TAC lebesgueI_borel >> art []
446QED
447
448Theorem borel_imp_lebesgue_measurable :
449 !f. f IN borel_measurable (space borel, subsets borel) ==>
450 f IN borel_measurable (m_space lebesgue, measurable_sets lebesgue)
451Proof
452 RW_TAC std_ss [measurable_def, GSPECIFICATION]
453 >| [ FULL_SIMP_TAC std_ss [space_lebesgue, space_borel, space_def],
454 FULL_SIMP_TAC std_ss [space_def, subsets_def] ]
455 >> FULL_SIMP_TAC std_ss [space_borel, space_lebesgue, INTER_UNIV]
456 >> MATCH_MP_TAC lebesgueI_borel >> ASM_SET_TAC []
457QED
458
459val borel_measurable_lebesgueI = borel_imp_lebesgue_measurable;
460
461(* |- !f. f IN borel_measurable borel ==>
462 f IN borel_measurable (m_space lebesgue,measurable_sets lebesgue)
463 *)
464Theorem borel_imp_lebesgue_measurable' =
465 REWRITE_RULE [SPACE] borel_imp_lebesgue_measurable
466
467Theorem negligible_in_lebesgue :
468 !s. negligible s ==> s IN measurable_sets lebesgue
469Proof
470 RW_TAC std_ss [negligible]
471 >> MATCH_MP_TAC lebesgueI
472 >> METIS_TAC [integrable_on, line, GSYM interval]
473QED
474
475val lebesgueI_negligible = negligible_in_lebesgue;
476
477Theorem lebesgue_of_negligible :
478 !s. negligible s ==> (measure lebesgue s = 0)
479Proof
480 RW_TAC std_ss [measure_lebesgue]
481 >> Know `!n. integral (line n) (indicator s) = 0`
482 >- (FULL_SIMP_TAC std_ss [integral_def, negligible, line, GSYM interval] \\
483 GEN_TAC >> MATCH_MP_TAC SELECT_UNIQUE \\
484 GEN_TAC \\
485 reverse EQ_TAC >- METIS_TAC [] \\
486 METIS_TAC [HAS_INTEGRAL_UNIQUE]) >> Rewr
487 >> SIMP_TAC std_ss [GSYM extreal_of_num_def]
488 >> REWRITE_TAC [SET_RULE ``{(0 :extreal) | n IN UNIV} = {0}``]
489 >> SIMP_TAC std_ss [sup_sing]
490QED
491
492Theorem lmeasure_eq_0 = lebesgue_of_negligible
493
494Theorem INTEGRAL_POS :
495 !f s. f integrable_on s /\ (!x. x IN s ==> 0 <= f x) ==>
496 0 <= integral s f
497Proof
498 rpt STRIP_TAC
499 >> qabbrev_tac ‘g :real -> real = \x. 0’
500 >> ‘0 = abs (integral s g)’ by simp [Abbr ‘g’, INTEGRAL_0]
501 >> POP_ORW
502 >> MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL
503 >> rw [Abbr ‘g’, INTEGRABLE_0]
504QED
505
506Theorem negligible_iff_lmeasure_zero :
507 !s. s IN measurable_sets lebesgue ==> (negligible s <=> lmeasure s = 0)
508Proof
509 rpt STRIP_TAC
510 >> EQ_TAC >- REWRITE_TAC [lebesgue_of_negligible]
511 >> DISCH_TAC
512 >> rw [negligible]
513 >> MP_TAC (Q.SPECL [‘a’, ‘b’] LINE_EXISTS) >> rw []
514 >> Know ‘indicator s integrable_on line n’
515 >- (Q.PAT_X_ASSUM ‘s IN measurable_sets lebesgue’ MP_TAC \\
516 rw [lebesgue_def])
517 >> DISCH_TAC
518 >> qabbrev_tac ‘f = indicator s’
519 >> Know ‘f integrable_on interval [a,b]’
520 >- (MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
521 Q.EXISTS_TAC ‘line n’ >> art [])
522 >> DISCH_TAC
523 >> qabbrev_tac ‘t = interval [a,b]’
524 >> simp [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
525 >> reverse (rw [GSYM REAL_LE_ANTISYM])
526 >- (MATCH_MP_TAC INTEGRAL_POS >> rw [Abbr ‘f’, INDICATOR_POS])
527 >> Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘integral (line n) f’
528 >> CONJ_TAC
529 >- (MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE \\
530 rw [Abbr ‘f’, INDICATOR_POS])
531 >> Know ‘sup (IMAGE (\n. Normal (integral (line n) f)) UNIV) = 0’
532 >- (Q.PAT_X_ASSUM ‘lmeasure s = 0’ MP_TAC \\
533 rw [lebesgue_def] \\
534 POP_ASSUM (REWRITE_TAC o wrap o SYM) \\
535 AP_TERM_TAC >> rw [Once EXTENSION])
536 >> DISCH_TAC
537 >> REWRITE_TAC [GSYM extreal_le_eq, normal_0]
538 >> POP_ASSUM (REWRITE_TAC o wrap o SYM)
539 >> rw [le_sup']
540 >> POP_ASSUM MATCH_MP_TAC
541 >> Q.EXISTS_TAC ‘n’ >> REFL_TAC
542QED
543
544Theorem negligible_alt_lebesgue_null_set :
545 !s. negligible s <=> s IN null_set lebesgue
546Proof
547 rw [IN_NULL_SET, null_set_def]
548 >> METIS_TAC [negligible_in_lebesgue, negligible_iff_lmeasure_zero]
549QED
550
551Theorem lebesgue_measure_iff_LIMSEQ[local] :
552 !A m. A IN measurable_sets lebesgue /\ 0 <= m ==>
553 (measure lebesgue A = Normal m <=>
554 ((\n. integral (line n) (indicator A)) --> m) sequentially)
555Proof
556 RW_TAC std_ss [Once EQ_SYM_EQ]
557 >> `!n. Normal (integral (line n) (indicator A)) =
558 Normal ((\n. integral (line n) (indicator A)) n)` by METIS_TAC []
559 >> SIMP_TAC std_ss [measure_lebesgue, GSYM IMAGE_DEF]
560 >> ONCE_ASM_REWRITE_TAC []
561 >> MATCH_MP_TAC sup_seq'
562 >> RW_TAC std_ss [mono_increasing_def]
563 >> MATCH_MP_TAC INTEGRAL_SUBSET_COMPONENT_LE
564 >> ASM_SIMP_TAC std_ss [LINE_MONO, lebesgueD, DROP_INDICATOR_POS_LE]
565QED
566
567Theorem lmeasure_iff_LIMSEQ = lebesgue_measure_iff_LIMSEQ
568
569(* It's hard to calculate `measure lebesgue` on intervals by "lebesgue_def",
570 but once the following lemma is proven, by UNIQUENESS_OF_MEASURE we
571 will have `lebesgue` and `lborel` coincide on `subsets borel`, and thus
572 `measure lebesgue` of other intervals can be derived from lambda lemmas.
573
574 Most steps are from "lborel_eqI" (HVG's lebesgue_measure_hvgScript.sml).
575 *)
576Theorem lebesgue_closed_interval :
577 !a b. a <= b ==> measure lebesgue (interval [a,b]) = Normal (b - a)
578Proof
579 RW_TAC std_ss [lebesgue_def, measure_def, GSYM CONTENT_CLOSED_INTERVAL]
580 >> SIMP_TAC std_ss [sup_eq']
581 >> CONJ_TAC >> GEN_TAC
582 >- (SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV] \\
583 STRIP_TAC >> POP_ORW \\
584 ASM_SIMP_TAC std_ss [extreal_le_def] \\
585 ONCE_REWRITE_TAC [GSYM integral_indicator_UNIV] \\
586 ONCE_REWRITE_TAC [INTER_COMM] \\
587 REWRITE_TAC [integral_indicator_UNIV] \\
588 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] \\
589 MATCH_MP_TAC INTEGRAL_COMPONENT_UBOUND \\
590 SIMP_TAC std_ss [DROP_INDICATOR_LE_1] \\
591 ONCE_REWRITE_TAC [GSYM integrable_indicator_UNIV] \\
592 SIMP_TAC std_ss [INTER_INTERVAL, line, GSYM interval, indicator] \\
593 ONCE_REWRITE_TAC [METIS [] ``1 = (\x:real. 1:real) x``] \\
594 REWRITE_TAC [INTEGRABLE_RESTRICT_UNIV, INTEGRABLE_CONST])
595 >> DISCH_THEN MATCH_MP_TAC
596 >> SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV, extreal_11]
597 >> MP_TAC (Q.SPECL [`abs a`, `abs b`] REAL_LE_TOTAL)
598 >> ONCE_REWRITE_TAC [EQ_SYM_EQ] >> STRIP_TAC
599 >| [ (* goal 1 (of 2) *)
600 `?n. abs b <= &n` by SIMP_TAC std_ss [SIMP_REAL_ARCH] \\
601 Q.EXISTS_TAC `n` >> MATCH_MP_TAC INTEGRAL_UNIQUE \\
602 Suff `{x | a <= x /\ x <= b} = {x | a <= x /\ x <= b} INTER line n`
603 >- METIS_TAC [has_integral_interval_cube, GSYM interval] \\
604 SIMP_TAC std_ss [EXTENSION, IN_INTER, GSPECIFICATION, line] \\
605 GEN_TAC >> POP_ASSUM MP_TAC >> POP_ASSUM MP_TAC >> REAL_ARITH_TAC,
606 (* goal 2 (of 2) *)
607 `?n. abs a <= &n` by SIMP_TAC std_ss [SIMP_REAL_ARCH] \\
608 Q.EXISTS_TAC `n` THEN MATCH_MP_TAC INTEGRAL_UNIQUE \\
609 Suff `{x | a <= x /\ x <= b} = {x | a <= x /\ x <= b} INTER line n`
610 >- METIS_TAC [has_integral_interval_cube, GSYM interval] \\
611 SIMP_TAC std_ss [EXTENSION, IN_INTER, GSPECIFICATION, line] \\
612 GEN_TAC >> POP_ASSUM MP_TAC >> POP_ASSUM MP_TAC >> REAL_ARITH_TAC ]
613QED
614
615(* |- !c. measure lebesgue {c} = 0 *)
616Theorem lebesgue_sing =
617 ((Q.GEN `c`) o
618 (SIMP_RULE real_ss [REAL_LE_REFL, GSYM extreal_of_num_def, INTERVAL_SING]) o
619 (Q.SPECL [`c`,`c`])) lebesgue_closed_interval;
620
621Theorem lebesgue_empty :
622 measure lebesgue {} = 0
623Proof
624 MATCH_MP_TAC lebesgue_of_negligible
625 >> REWRITE_TAC [NEGLIGIBLE_EMPTY]
626QED
627
628Theorem lebesgue_closed_interval_content :
629 !a b. measure lebesgue (interval [a,b]) = Normal (content (interval [a,b]))
630Proof
631 rpt STRIP_TAC
632 >> `a <= b \/ b < a` by PROVE_TAC [REAL_LTE_TOTAL]
633 >- ASM_SIMP_TAC std_ss [CONTENT_CLOSED_INTERVAL, lebesgue_closed_interval]
634 >> IMP_RES_TAC REAL_LT_IMP_LE
635 >> fs [GSYM CONTENT_EQ_0, GSYM extreal_of_num_def]
636 >> fs [INTERVAL_EQ_EMPTY, lebesgue_empty]
637QED
638
639(* A direct application of the above theorem:
640 |- measure_space (space borel,subsets borel,measure lebesgue) ==>
641 !s. s IN subsets borel ==> lambda s = measure lebesgue s
642 *)
643val lemma =
644 REWRITE_RULE [m_space_def, measurable_sets_def, measure_def,
645 lebesgue_closed_interval_content]
646 (Q.SPEC `(space borel, subsets borel, measure lebesgue)` lambda_eq);
647
648(* lborel and lebesgue coincide on borel *)
649Theorem lambda_eq_lebesgue :
650 !s. s IN subsets borel ==> lambda s = measure lebesgue s
651Proof
652 MATCH_MP_TAC lemma
653 >> ASSUME_TAC borel_imp_lebesgue_sets
654 >> RW_TAC std_ss [measure_space_def, m_space_def, measurable_sets_def,
655 SPACE, sigma_algebra_borel] (* 2 subgoals *)
656 >| [ (* goal 1 (of 2): positive *)
657 MP_TAC positive_lebesgue \\
658 RW_TAC std_ss [positive_def, measure_def, measurable_sets_def],
659 (* goal 2 (of 2): countably_additive *)
660 MP_TAC countably_additive_lebesgue \\
661 RW_TAC std_ss [countably_additive_def, measure_def, measurable_sets_def,
662 IN_FUNSET, IN_UNIV] ]
663QED
664
665(* |- !s. s IN subsets borel ==> measure lebesgue s = lambda s *)
666Theorem lebesgue_eq_lambda = GSYM lambda_eq_lebesgue;
667
668(* a sample application of "lebesgue_eq_lambda" *)
669Theorem lebesgue_open_interval :
670 !a b. a <= b ==> measure lebesgue (interval (a,b)) = Normal (b - a)
671Proof
672 rpt STRIP_TAC
673 >> `interval (a,b) IN subsets borel`
674 by METIS_TAC [borel_measurable_sets, interval]
675 >> ASM_SIMP_TAC std_ss [lebesgue_eq_lambda, lambda_open_interval]
676QED
677
678Theorem borel_null_set_subset_lebesgue :
679 null_set lborel SUBSET null_set lebesgue
680Proof
681 simp [SUBSET_DEF, IN_APP]
682 >> rw [null_set_def]
683 >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue]
684 >> gs [lebesgue_eq_lambda, sets_lborel]
685QED
686
687Theorem borel_null_set_imp_negligible :
688 !s. s IN null_set lborel ==> negligible s
689Proof
690 rw [negligible_alt_lebesgue_null_set]
691 >> METIS_TAC [SUBSET_DEF, borel_null_set_subset_lebesgue]
692QED
693
694(* ------------------------------------------------------------------------- *)
695(* Equivalence of Lebesgue and Gauge (Henstock-Kurzweil) Integration *)
696(* ------------------------------------------------------------------------- *)
697
698(* |- !k x.
699 0 <= x /\ x < 1 /\ 0 < k ==>
700 ?n. n < 2 ** k /\ &n / 2 pow k <= x /\ x < &SUC n / 2 pow k
701 *)
702Theorem lemma1[local] = lift_ieeeTheory.error_bound_lemma1
703 |> Q.SPEC ‘k’ |> GEN_ALL
704
705(* lemma1 also holds if “0 < k” is removed *)
706Theorem lemma1a[local] :
707 !k x. 0 <= x /\ x < (1 :real) ==>
708 ?n. n < 2 ** k /\ &n / 2 pow k <= x /\ x < &SUC n / 2 pow k
709Proof
710 rpt STRIP_TAC
711 >> ‘k = 0 \/ 0 < k’ by simp [] >- rw []
712 >> MATCH_MP_TAC lemma1 >> art []
713QED
714
715Theorem lemma1b[local] :
716 !k x. 0 <= x /\ x <= (1 :real) ==>
717 ?n. n < 2 ** k /\ &n / 2 pow k <= x /\ x <= &SUC n / 2 pow k
718Proof
719 rpt STRIP_TAC
720 >> ‘x < 1 \/ x = (1 :real)’ by PROVE_TAC [REAL_LE_LT]
721 >- (MP_TAC (Q.SPECL [‘k’, ‘x’] lemma1a) \\
722 RW_TAC std_ss [] \\
723 Q.EXISTS_TAC ‘n’ >> RW_TAC real_ss [REAL_LT_IMP_LE])
724 >> POP_ORW
725 >> Q.EXISTS_TAC ‘2 ** k - 1’ >> simp [REAL_POW]
726QED
727
728Theorem lemma1c[local] :
729 !k x c. c <= x /\ x <= c + (1 :real) ==>
730 ?n. n < 2 ** k /\ c + &n / 2 pow k <= x /\ x <= c + &SUC n / 2 pow k
731Proof
732 rpt STRIP_TAC
733 >> MP_TAC (Q.SPECL [‘k’, ‘x - c’] lemma1b)
734 >> impl_tac >- REAL_ASM_ARITH_TAC
735 >> STRIP_TAC
736 >> Q.EXISTS_TAC ‘n’
737 >> REAL_ASM_ARITH_TAC
738QED
739
740(* |- !k x.
741 0 <= x /\ x < 1 /\ 0 < k ==>
742 ?n. n <= 2 ** k /\ abs (x - &n / 2 pow k) <= 1 / 2 pow SUC k
743 *)
744Theorem lemma2[local] = lift_ieeeTheory.error_bound_lemma2
745 |> Q.SPEC ‘k’ |> GEN_ALL
746 |> SIMP_RULE real_ss [REAL_INV_1OVER, GSYM ADD1]
747
748(* remove “0 < k”, use “_ <= 1 / 2 pow k” instead of “_ <= 1 / 2 pow SUC k” *)
749Theorem lemma2a[local] :
750 !k x. 0 <= x /\ x < (1 :real) ==>
751 ?n. n <= 2 ** k /\ abs (x - &n / 2 pow k) <= 1 / 2 pow k
752Proof
753 rpt STRIP_TAC
754 >> ‘k = 0 \/ 0 < k’ by simp []
755 >- (Q.EXISTS_TAC ‘0’ >> simp [ABS_BOUNDS, REAL_LT_IMP_LE] \\
756 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘0’ >> simp [])
757 >> MP_TAC (Q.SPECL [‘k’, ‘x’] lemma2)
758 >> RW_TAC std_ss []
759 >> Q.EXISTS_TAC ‘n’ >> art []
760 >> Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘1 / 2 pow SUC k’ >> art []
761 >> MATCH_MP_TAC REAL_LT_IMP_LE
762 >> simp [REAL_POW_MONO_LT]
763QED
764
765(* furthermore, use “n < 2 ** k” instead of “n <= 2 ** k”
766
767 NOTE: It turns out that lemma2 (and all variants) are not needed. Only
768 lemma1a is used in [dyadic_covering_lemma_01] below.
769 *)
770Theorem lemma2b[local] :
771 !k x. 0 <= x /\ x < (1 :real) ==>
772 ?n. n < 2 ** k /\ abs (x - &n / 2 pow k) <= 1 / 2 pow k
773Proof
774 rpt STRIP_TAC
775 >> MP_TAC (Q.SPECL [‘k’, ‘x’] lemma2a)
776 >> RW_TAC std_ss []
777 >> ‘n < 2 ** k \/ n = 2 ** k’ by simp []
778 >- (Q.EXISTS_TAC ‘n’ >> art [])
779 >> Q.PAT_X_ASSUM ‘abs _ <= 1 / 2 pow k’ MP_TAC
780 >> ASM_SIMP_TAC real_ss [GSYM REAL_POW]
781 >> ‘2 pow k / 2 pow k = (1 :real)’ by simp [REAL_DIV_REFL] >> POP_ORW
782 >> ‘x - 1 < 0 :real’ by simp [REAL_SUB_LT_NEG]
783 >> ASM_SIMP_TAC real_ss [ABS_EQ_NEG]
784 >> ‘1 - x <= 1 / 2 pow k <=> 1 - 1 / 2 pow k <= x’ by REAL_ARITH_TAC
785 >> POP_ORW
786 >> Know ‘(1 - 1 / 2 pow k) :real = &(2 ** k) / 2 pow k - 1 / 2 pow k’
787 >- (ASM_SIMP_TAC real_ss [GSYM REAL_POW] \\
788 Suff ‘2 pow k / 2 pow k = (1 :real)’ >- rw [] \\
789 MATCH_MP_TAC REAL_DIV_REFL >> simp [])
790 >> Rewr'
791 >> REWRITE_TAC [REAL_DIV_SUB]
792 >> ‘&(2 ** k) - (1 :real) = &(2 ** k - 1)’
793 by simp [REAL_OF_NUM_SUB] >> POP_ORW
794 >> STRIP_TAC
795 >> Q.EXISTS_TAC ‘2 ** k - 1’
796 >> SIMP_TAC real_ss [EXP_POS]
797 >> ‘(0 :real) <= x - &(2 ** k - 1) / 2 pow k’ by simp [REAL_SUB_LE]
798 >> ASM_SIMP_TAC real_ss [ABS_REDUCE]
799 >> REWRITE_TAC [REAL_LE_SUB_RADD, REAL_DIV_ADD]
800 >> SIMP_TAC real_ss [REAL_OF_NUM_ADD]
801 >> SIMP_TAC arith_ss [GSYM LESS_EQ_ADD_SUB]
802 >> SIMP_TAC real_ss [GSYM REAL_POW]
803 >> Suff ‘2 pow k / 2 pow k = (1 :real)’ >- rw [REAL_LT_IMP_LE]
804 >> MATCH_MP_TAC REAL_DIV_REFL >> simp []
805QED
806
807(* |- !k x.
808 1 <= x /\ x < 2 /\ 0 < k ==>
809 ?n. n <= 2 ** k /\ abs (1 + &n / 2 pow k - x) <= 1 / 2 pow SUC k
810 *)
811Theorem lemma3[local] = lift_ieeeTheory.error_bound_lemma3
812 |> Q.SPEC ‘k’ |> GEN_ALL
813 |> SIMP_RULE real_ss [REAL_INV_1OVER, GSYM ADD1]
814
815(* |- !y. 0 < y ==> ?n. 1 / 2 pow n < y *)
816Theorem lemma4[local] = REAL_ARCH_POW_INV |> Q.SPEC ‘1 / 2’
817 |> SIMP_RULE real_ss [pow_div, POW_ONE]
818
819Theorem lemma5[local] :
820 !n k. &n / 2 pow k < (&SUC n / 2 pow k) :real
821Proof
822 rpt GEN_TAC
823 >> qmatch_abbrev_tac ‘x / z < y / (z :real)’
824 >> Know ‘x / z < y / z <=> x < y’
825 >- (MATCH_MP_TAC REAL_LT_RDIV >> simp [Abbr ‘z’])
826 >> Rewr'
827 >> simp [Abbr ‘x’, Abbr ‘y’]
828QED
829
830Theorem lemma5a[local] :
831 !n k c. c + &n / 2 pow k < (c + &SUC n / 2 pow k) :real
832Proof
833 rpt STRIP_TAC
834 >> MATCH_MP_TAC REAL_LT_IADD
835 >> REWRITE_TAC [lemma5]
836QED
837
838Theorem lemma6[local] :
839 !n k. &SUC n / 2 pow k - &n / 2 pow k = (1 / 2 pow k) :real
840Proof
841 RW_TAC real_ss [REAL_DIV_SUB]
842 >> simp [GSYM REAL_OF_NUM_SUB]
843QED
844
845Theorem lemma6a[local] :
846 !n k c. (c + &SUC n / 2 pow k) - (c + &n / 2 pow k) = (1 / 2 pow k) :real
847Proof
848 rw [REAL_ARITH “c + a - (c + b) = a - (b :real)”, lemma6]
849QED
850
851(* "non-overlapping" = disjoint interiors *)
852Definition nonoverlapping_def :
853 nonoverlapping s t <=> DISJOINT (interior s) (interior t)
854End
855
856(* cf. right_open_interval_DISJOINT_EQ *)
857Theorem closed_interval_nonoverlapping :
858 !a b c d. a < b /\ c < d ==>
859 (nonoverlapping (interval [a,b]) (interval [c,d]) <=>
860 b <= c \/ d <= a)
861Proof
862 RW_TAC std_ss [nonoverlapping_def, INTERIOR_INTERVAL]
863 >> EQ_TAC >> rw [DISJOINT_ALT, IN_INTERVAL, REAL_NOT_LT] (* 3 subgoals *)
864 >| [ (* goal 1 (of 3): a < b <= c < d or c < d <= a < b *)
865 CCONTR_TAC >> fs [REAL_NOT_LE] \\
866 MP_TAC (Q.SPECL [‘max a c’, ‘min b d’] REAL_MEAN) \\
867 ASM_REWRITE_TAC [REAL_MAX_LT, REAL_LT_MIN] \\
868 CCONTR_TAC >> fs [] \\
869 ‘z <= c \/ d <= z’ by PROVE_TAC [] >- METIS_TAC [REAL_LTE_ANTISYM] \\
870 METIS_TAC [REAL_LTE_ANTISYM],
871 (* goal 2 (of 3) *)
872 CCONTR_TAC >> fs [REAL_NOT_LE] \\
873 (* a < x < b <= c < x < d *)
874 ‘x < c’ by PROVE_TAC [REAL_LTE_TRANS] \\
875 METIS_TAC [REAL_LT_ANTISYM],
876 (* goal 3 (of 3) *)
877 CCONTR_TAC >> fs [REAL_NOT_LE] \\
878 (* c < x < d <= a < x < b *)
879 ‘x < a’ by PROVE_TAC [REAL_LTE_TRANS] \\
880 METIS_TAC [REAL_LT_ANTISYM] ]
881QED
882
883Theorem nonoverlapping_comm :
884 !s t. nonoverlapping s t <=> nonoverlapping t s
885Proof
886 RW_TAC std_ss [nonoverlapping_def, Once DISJOINT_SYM]
887QED
888
889(* cf. SUBSET_DISJOINT *)
890Theorem nonoverlapping_subset_inclusive :
891 !s t u v. nonoverlapping s t /\ u SUBSET s /\ v SUBSET t ==>
892 nonoverlapping u v
893Proof
894 rw [nonoverlapping_def]
895 >> MATCH_MP_TAC SUBSET_DISJOINT
896 >> qexistsl_tac [‘interior s’, ‘interior t’] >> art []
897 >> rw [SUBSET_INTERIOR]
898QED
899
900Theorem nonoverlapping_empty[simp] :
901 nonoverlapping s {} /\ nonoverlapping {} s
902Proof
903 simp [nonoverlapping_def, INTERIOR_EMPTY, DISJOINT_EMPTY]
904QED
905
906(* cf. CLOSED_interval (constructor) *)
907Definition closed_interval_def :
908 closed_interval k <=> ?a b. k = interval [a,b]
909End
910
911Theorem closed_interval_closed :
912 closed_interval k ==> closed k
913Proof
914 RW_TAC std_ss [closed_interval_def]
915 >> REWRITE_TAC [CLOSED_INTERVAL]
916QED
917
918Theorem closed_interval_interval :
919 closed_interval (interval [a,b])
920Proof
921 rw [closed_interval_def]
922 >> qexistsl_tac [‘a’, ‘b’] >> art []
923QED
924
925Theorem closed_interval_imp_lebesgue :
926 !s. closed_interval s ==> s IN measurable_sets lebesgue
927Proof
928 rpt STRIP_TAC
929 >> Suff ‘s IN measurable_sets lborel’
930 >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue]
931 >> REWRITE_TAC [sets_lborel]
932 >> MATCH_MP_TAC borel_closed
933 >> MATCH_MP_TAC closed_interval_closed >> art []
934QED
935
936Theorem closed_interval_nonoverlapping_imp_negligible[local] :
937 !s t. closed_interval s /\ closed_interval t /\ nonoverlapping s t ==>
938 negligible (s INTER t)
939Proof
940 rw [closed_interval_def, nonoverlapping_def]
941 >> fs [INTERIOR_INTERVAL]
942 >> rename1 ‘DISJOINT (interval (a,b)) (interval (c,d))’
943 >> fs [DISJOINT_DEF, DISJOINT_INTERVAL] (* 4 subgoals *)
944 >| [ (* goal 1 (of 4) *)
945 ‘b < a \/ b = a’ by fs [REAL_LE_LT]
946 >- (‘interval [a,b] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
947 simp [NEGLIGIBLE_EMPTY]) \\
948 simp [INTERVAL_SING] \\
949 Cases_on ‘a IN interval [c,d]’
950 >- (Suff ‘{a} INTER interval [c,d] = {a}’ >- simp [NEGLIGIBLE_SING] \\
951 fs [IN_INTERVAL] \\
952 rw [Once EXTENSION, IN_INTERVAL] \\
953 EQ_TAC >> rw []) \\
954 Suff ‘{a} INTER interval [c,d] = {}’ >- simp [NEGLIGIBLE_EMPTY] \\
955 rw [Once EXTENSION, IN_INTERVAL, REAL_NOT_LE] \\
956 fs [IN_INTERVAL, REAL_NOT_LE],
957 (* goal 2 (of 4) *)
958 ‘d < c \/ d = c’ by fs [REAL_LE_LT]
959 >- (‘interval [c,d] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
960 simp [NEGLIGIBLE_EMPTY]) \\
961 simp [INTERVAL_SING] \\
962 Cases_on ‘c IN interval [a,b]’
963 >- (Suff ‘interval [a,b] INTER {c} = {c}’ >- simp [NEGLIGIBLE_SING] \\
964 fs [IN_INTERVAL] \\
965 rw [Once EXTENSION, IN_INTERVAL] \\
966 EQ_TAC >> rw []) \\
967 Suff ‘interval [a,b] INTER {c} = {}’ >- simp [NEGLIGIBLE_EMPTY] \\
968 rw [Once EXTENSION, IN_INTERVAL, REAL_NOT_LE] \\
969 fs [IN_INTERVAL, REAL_NOT_LE],
970 (* goal 3 (of 4) *)
971 reverse (Cases_on ‘a <= b’)
972 >- (fs [REAL_NOT_LE] \\
973 ‘interval [a,b] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
974 simp [NEGLIGIBLE_EMPTY]) \\
975 reverse (Cases_on ‘c <= d’)
976 >- (fs [REAL_NOT_LE] \\
977 ‘interval [c,d] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
978 simp [NEGLIGIBLE_EMPTY]) \\
979 (* now we have: a <= b <= c <= d *)
980 simp [INTER_INTERVAL] \\
981 ‘a <= c /\ b <= d’ by PROVE_TAC [REAL_LE_TRANS] \\
982 simp [REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
983 ‘b < c \/ b = c’ by PROVE_TAC [REAL_LE_LT]
984 >- (‘interval [c,b] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
985 simp [NEGLIGIBLE_EMPTY]) \\
986 simp [INTERVAL_SING, NEGLIGIBLE_SING],
987 (* goal 4 (of 4) *)
988 reverse (Cases_on ‘a <= b’)
989 >- (fs [REAL_NOT_LE] \\
990 ‘interval [a,b] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
991 simp [NEGLIGIBLE_EMPTY]) \\
992 reverse (Cases_on ‘c <= d’)
993 >- (fs [REAL_NOT_LE] \\
994 ‘interval [c,d] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
995 simp [NEGLIGIBLE_EMPTY]) \\
996 (* now we have: c <= d <= a <= b *)
997 simp [INTER_INTERVAL] \\
998 ‘c <= a /\ d <= b’ by PROVE_TAC [REAL_LE_TRANS] \\
999 simp [REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
1000 ‘d < a \/ d = a’ by PROVE_TAC [REAL_LE_LT]
1001 >- (‘interval [a,d] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
1002 simp [NEGLIGIBLE_EMPTY]) \\
1003 simp [INTERVAL_SING, NEGLIGIBLE_SING] ]
1004QED
1005
1006Theorem closed_interval_negligible_imp_nonoverlapping[local] :
1007 !s t. closed_interval s /\ closed_interval t /\ negligible (s INTER t) ==>
1008 nonoverlapping s t
1009Proof
1010 rw [closed_interval_def, nonoverlapping_def]
1011 >> simp [INTERIOR_INTERVAL]
1012 >> simp [DISJOINT_DEF, DISJOINT_INTERVAL]
1013 >> rename1 ‘negligible (interval [a,b] INTER interval [c,d])’
1014 >> fs [INTER_INTERVAL]
1015 >> ‘lmeasure (interval [max a c,min b d]) = 0’
1016 by PROVE_TAC [lebesgue_of_negligible]
1017 >> CCONTR_TAC >> fs [REAL_NOT_LE]
1018 (* a < b,
1019 c < d *)
1020 >> Know ‘max a c < min b d’ >- simp [REAL_MAX_LT, REAL_LT_MIN]
1021 >> qmatch_abbrev_tac ‘x < (y :real) ==> F’ >> DISCH_TAC
1022 >> ‘x <= y’ by simp [REAL_LT_IMP_LE]
1023 (* applying lebesgue_closed_interval *)
1024 >> ‘lmeasure (interval [x,y]) = Normal (y - x)’
1025 by PROVE_TAC [lebesgue_closed_interval]
1026 >> Suff ‘y - x <> 0’ >- METIS_TAC [extreal_11, normal_0]
1027 >> Q.PAT_X_ASSUM ‘x < y’ MP_TAC
1028 >> REAL_ARITH_TAC
1029QED
1030
1031Theorem closed_interval_negligible_eq_nonoverlapping :
1032 !s t. closed_interval s /\ closed_interval t ==>
1033 (negligible (s INTER t) <=> nonoverlapping s t)
1034Proof
1035 PROVE_TAC [closed_interval_nonoverlapping_imp_negligible,
1036 closed_interval_negligible_imp_nonoverlapping]
1037QED
1038
1039(* NOTE: Here we use the “gauge” definition from the old integralTheory, as it
1040 avoids “open” sets and directly gives the radius g(x) as a positive real.
1041
1042 The asserted ‘J’ may contain duplicated elements, i.e. J(i) is finite. This is
1043 why we used “J i <> J j” instead of “i <> j” in the disjointness conclusion.
1044
1045 NOTE: Instead of proving “E INTER J i SUBSET cball (t i,g (t i))” as required
1046 in textbook, we use the same proof to show “J i SUBSET cball (t i,g (t i))”,
1047 which is required by definition of [FINE] later.
1048 *)
1049Theorem dyadic_covering_lemma_unit[local] :
1050 !g E c. gauge UNIV g /\ E <> {} /\ E SUBSET interval [c,c + 1] ==>
1051 ?J t. (!i. J i SUBSET interval [c,c + 1] /\
1052 closed_interval (J i) /\
1053 t i IN E INTER J (i :num) /\
1054 J i SUBSET cball (t i,g (t i))) /\
1055 (!i j. J i <> J j ==> nonoverlapping (J i) (J j)) /\
1056 E SUBSET BIGUNION (IMAGE J UNIV)
1057Proof
1058 rw [integralTheory.gauge', SUBSET_DEF, IN_INTERVAL, IN_CBALL, IN_INTERVAL]
1059 >> qabbrev_tac ‘f = \k n. interval [c + &n / 2 pow k,c + &SUC n / 2 pow k]’
1060 >> ‘!x. ?n. 1 / 2 pow n < g x’ by METIS_TAC [lemma4]
1061 >> FULL_SIMP_TAC std_ss [SKOLEM_THM]
1062 >> rename1 ‘!x. 1 / 2 pow d x < g x’
1063 >> Know ‘!x. c <= x /\ x <= c + 1 ==>
1064 ?k n. n < 2 ** k /\ x IN f k n /\ f k n SUBSET cball (x,g x)’
1065 >- (RW_TAC std_ss [Abbr ‘f’, SUBSET_DEF, IN_INTERVAL, IN_CBALL] \\
1066 Q.PAT_X_ASSUM ‘!x. _ < g x’ (STRIP_ASSUME_TAC o Q.SPEC ‘x’) \\
1067 qabbrev_tac ‘k = d x’ \\
1068 MP_TAC (Q.SPECL [‘k’, ‘x’, ‘c’] lemma1c) >> RW_TAC std_ss [] \\
1069 qexistsl_tac [‘k’, ‘n’] >> art [] \\
1070 Q.X_GEN_TAC ‘y’ >> RW_TAC std_ss [dist] \\
1071 MATCH_MP_TAC REAL_LT_IMP_LE \\
1072 Q_TAC (TRANS_TAC REAL_LET_TRANS) ‘1 / 2 pow k’ >> art [] \\
1073 Cases_on ‘0 <= x - y’
1074 >- (ASM_SIMP_TAC real_ss [ABS_REDUCE] \\
1075 Suff ‘x <= 1 / 2 pow k + y’ >- REAL_ARITH_TAC \\
1076 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘c + &SUC n / 2 pow k’ >> art [] \\
1077 Suff ‘c + (&SUC n / 2 pow k - 1 / 2 pow k) <= y’ >- REAL_ARITH_TAC \\
1078 ASM_SIMP_TAC real_ss [REAL_DIV_SUB, ADD1] \\
1079 simp [GSYM REAL_OF_NUM_SUB]) \\
1080 FULL_SIMP_TAC real_ss [GSYM real_lt, ABS_EQ_NEG] \\
1081 Suff ‘y - 1 / 2 pow k <= x’ >- REAL_ARITH_TAC \\
1082 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘c + &n / 2 pow k’ >> art [] \\
1083 Suff ‘y <= c + (&n / 2 pow k + 1 / 2 pow k)’ >- REAL_ARITH_TAC \\
1084 ASM_SIMP_TAC real_ss [REAL_DIV_ADD, GSYM ADD1])
1085 >> DISCH_TAC
1086 (* stage work *)
1087 >> qabbrev_tac ‘J0 = {s | ?n k. s = f k n /\ n < 2 ** k}’
1088 >> Know ‘!s1 s2. s1 IN J0 /\ s2 IN J0 /\ s1 <> s2 ==>
1089 s1 SUBSET s2 \/ s2 SUBSET s1 \/ nonoverlapping s1 s2’
1090 >- (rw [Abbr ‘J0’, Abbr ‘f’] \\
1091 POP_ASSUM MP_TAC >> rename1 ‘m < 2 ** l’ \\
1092 ‘c + &n / 2 pow k < (c + &SUC n / 2 pow k) :real /\
1093 c + &m / 2 pow l < (c + &SUC m / 2 pow l) :real’ by simp [] \\
1094 ASM_SIMP_TAC std_ss [closed_interval_11] \\
1095 Cases_on ‘k = l’
1096 >- (simp [] >> DISCH_TAC (* n <> m *) \\
1097 simp [closed_interval_subset_eq, closed_interval_nonoverlapping]) \\
1098 NTAC 5 (POP_ASSUM MP_TAC) \\
1099 (* applying wlog_tac *)
1100 wlog_tac ‘k <= l’ []
1101 >- (rpt STRIP_TAC \\
1102 ‘l <= k /\ l < k’ by simp [] \\
1103 ONCE_REWRITE_TAC [nonoverlapping_comm] \\
1104 Q.PAT_X_ASSUM ‘!k l n m. P’ (MP_TAC o Q.SPECL [‘l’, ‘k’, ‘m’, ‘n’]) \\
1105 METIS_TAC []) \\
1106 rpt STRIP_TAC \\
1107 ‘k < l’ by simp [] >> Q.PAT_X_ASSUM ‘k <= l’ K_TAC \\
1108 ‘?p. p + k = l’ by METIS_TAC [LESS_ADD] \\
1109 POP_ASSUM (FULL_SIMP_TAC std_ss o wrap o SYM) \\
1110 ‘(&n / 2 pow k) :real = &(n * 2 ** p) / 2 pow (p + k)’
1111 by (simp [POW_ADD] >> simp [REAL_OF_NUM_MUL, REAL_POW]) \\
1112 POP_ASSUM (FULL_SIMP_TAC std_ss o wrap) \\
1113 ‘(&SUC n / 2 pow k) :real = &(SUC n * 2 ** p) / 2 pow (p + k)’
1114 by (simp [POW_ADD] >> simp [REAL_OF_NUM_MUL, REAL_POW]) \\
1115 POP_ASSUM (FULL_SIMP_TAC std_ss o wrap) \\
1116 qabbrev_tac ‘l = p + k’ \\
1117 simp [closed_interval_subset_eq, closed_interval_nonoverlapping])
1118 >> DISCH_TAC
1119 >> Know ‘countable J0’
1120 >- (qabbrev_tac ‘t = \k. count (2 ** k)’ \\
1121 Know ‘J0 = {f x y | x IN univ(:num) /\ y IN t x}’
1122 >- (rw [Once EXTENSION, Abbr ‘J0’, Abbr ‘t’, IN_COUNT] \\
1123 METIS_TAC []) >> Rewr' \\
1124 MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT >> rw [])
1125 >> DISCH_TAC
1126 >> Know ‘J0 <> {}’
1127 >- (rw [Abbr ‘J0’, Once EXTENSION, NOT_IN_EMPTY] \\
1128 qexistsl_tac [‘0’, ‘0’] >> simp [])
1129 >> DISCH_TAC
1130 >> qabbrev_tac ‘J1 = J0 DIFF {s | ~?x k n. x IN E INTER s /\ s = f k n /\
1131 f k n SUBSET cball (x,g x)}’
1132 >> ‘J1 SUBSET J0’ by rw [SUBSET_DEF, Abbr ‘J1’]
1133 >> ‘countable J1’ by PROVE_TAC [COUNTABLE_SUBSET]
1134 >> Know ‘!s. s IN J1 ==> ?x k n. x IN E /\ x IN s /\ s = f k n /\ n < 2 ** k /\
1135 f k n SUBSET cball (x,g x)’
1136 >- (rw [Abbr ‘J1’, Abbr ‘J0’] \\
1137 rename1 ‘y IN f l m’ \\
1138 qexistsl_tac [‘y’, ‘k’, ‘n’] >> rw [] >> gs [])
1139 >> DISCH_TAC
1140 (* stage work *)
1141 >> Know ‘!x. x IN E ==>
1142 ?s k n. s IN J1 /\ s = f k n /\ n < 2 ** k /\ x IN f k n /\
1143 f k n SUBSET cball (x,g x)’
1144 >- (rpt (Q.PAT_X_ASSUM ‘countable _’ K_TAC) \\
1145 rpt (Q.PAT_X_ASSUM ‘_ SUBSET _’ K_TAC) \\
1146 rw [Abbr ‘J1’, Abbr ‘J0’] \\
1147 Q.PAT_X_ASSUM ‘!x. c <= x /\ x <= c + 1 ==> ?k n. _’ (MP_TAC o Q.SPEC ‘x’) \\
1148 RW_TAC std_ss [] \\
1149 qexistsl_tac [‘k’, ‘n’] >> art [] \\
1150 CONJ_TAC >- (qexistsl_tac [‘n’, ‘k’] >> art []) \\
1151 qexistsl_tac [‘x’, ‘k’, ‘n’] >> art [])
1152 >> DISCH_TAC
1153 (* “E <> {}” is needed here *)
1154 >> Know ‘J1 <> {}’
1155 >- (rw [Once EXTENSION, NOT_IN_EMPTY] \\
1156 ‘?x. x IN E’ by METIS_TAC [MEMBER_NOT_EMPTY] \\
1157 METIS_TAC [])
1158 >> DISCH_TAC
1159 (* J2 is done by removing smaller sets from J1 *)
1160 >> qabbrev_tac ‘J2 = J1 DIFF {s | s IN J1 /\ ?t. t IN J1 /\ s PSUBSET t}’
1161 >> ‘J2 SUBSET J1’ by rw [SUBSET_DEF, Abbr ‘J2’]
1162 >> ‘countable J2’ by PROVE_TAC [COUNTABLE_SUBSET]
1163 >> Know ‘J2 <> {}’
1164 >- (rpt (Q.PAT_X_ASSUM ‘countable _’ K_TAC) \\
1165 Q.PAT_X_ASSUM ‘J2 SUBSET J1’ K_TAC \\
1166 rw [Abbr ‘J2’, Once EXTENSION, NOT_IN_EMPTY, PSUBSET_DEF] \\
1167 SIMP_TAC (bool_ss ++ DNF_ss) [GSYM IMP_DISJ_THM] \\
1168 qabbrev_tac ‘P = \k. ?x n. n < 2 ** k /\ x IN E INTER f k n /\
1169 f k n SUBSET cball (x,g x)’ \\
1170 MP_TAC (Q.SPEC ‘P’ LEAST_EXISTS_IMP) \\
1171 qabbrev_tac ‘l = $LEAST P’ (* here “l” means least *) \\
1172 impl_tac
1173 >- (simp [Abbr ‘P’] \\
1174 ‘?s. s IN J1’ by METIS_TAC [MEMBER_NOT_EMPTY] \\
1175 Q.PAT_X_ASSUM ‘!s. s IN J1 ==> ?x k n. _’ (MP_TAC o Q.SPEC ‘s’) \\
1176 RW_TAC std_ss [] \\
1177 qexistsl_tac [‘k’, ‘x’, ‘n’] >> art []) \\
1178 rw [Abbr ‘P’] \\
1179 Q.EXISTS_TAC ‘f l n’ \\
1180 CONJ_TAC
1181 >- (rw [Abbr ‘J1’, Abbr ‘J0’]
1182 >- (qexistsl_tac [‘n’, ‘l’] >> art []) \\
1183 qexistsl_tac [‘x’, ‘l’, ‘n’] >> art []) \\
1184 NTAC 2 STRIP_TAC \\
1185 Q.PAT_X_ASSUM ‘!s. s IN J1 ==> _’ (MP_TAC o Q.SPEC ‘t’) >> POP_ORW \\
1186 RW_TAC std_ss [] >> rename1 ‘y IN f k m’ \\
1187 Know ‘c + &SUC n / 2 pow l - (c + &n / 2 pow l) :real <=
1188 c + &SUC m / 2 pow k - (c + &m / 2 pow k)’
1189 >- (MATCH_MP_TAC closed_interval_subset \\
1190 REWRITE_TAC [lemma5a] \\
1191 POP_ASSUM MP_TAC >> simp [Abbr ‘f’]) \\
1192 simp [lemma6a] \\
1193 Know ‘2 pow k <= (2 pow l) :real <=> k <= l’
1194 >- (MATCH_MP_TAC REAL_POW_MONO_EQ >> simp []) >> Rewr' \\
1195 DISCH_TAC \\
1196 ‘k = l \/ k < l’ by simp [] (* 2 subgoals *)
1197 >- (Q.PAT_X_ASSUM ‘f l n SUBSET f k m’ MP_TAC \\
1198 simp [Abbr ‘f’, closed_interval_subset_eq, lemma5] \\
1199 simp [LE_ANTISYM]) \\
1200 METIS_TAC [])
1201 >> DISCH_TAC
1202 >> Know ‘!x. x IN E ==> ?s. x IN s /\ s IN J2’
1203 >- (rpt STRIP_TAC \\
1204 qabbrev_tac ‘P = \k. ?y n. n < 2 ** k /\
1205 x IN E INTER f k n /\
1206 y IN E INTER f k n /\
1207 f k n SUBSET cball (y,g y)’ \\
1208 (* NOTE: “$LEAST P” is biggest interval for any y IN E containing also x *)
1209 MP_TAC (Q.SPEC ‘P’ LEAST_EXISTS_IMP) \\
1210 qabbrev_tac ‘l = $LEAST P’ \\
1211 impl_tac
1212 >- (simp [Abbr ‘P’] \\
1213 Q.PAT_X_ASSUM ‘!x. x IN E ==> ?s k n. _’ drule >> rw [] \\
1214 qexistsl_tac [‘k’, ‘x’, ‘n’] >> art []) \\
1215 rw [Abbr ‘P’] \\
1216 Q.EXISTS_TAC ‘f l n’ >> art [] \\
1217 Q.PAT_X_ASSUM ‘J2 SUBSET J1’ K_TAC \\
1218 Q.PAT_X_ASSUM ‘countable J2’ K_TAC \\
1219 Q.PAT_X_ASSUM ‘K2 <> {}’ K_TAC \\
1220 rw [Abbr ‘J2’]
1221 >- (rw [Abbr ‘J1’, Abbr ‘J0’] >- (qexistsl_tac [‘n’, ‘l’] >> art []) \\
1222 qexistsl_tac [‘y’, ‘l’, ‘n’] >> art []) \\
1223 STRONG_DISJ_TAC \\
1224 RW_TAC std_ss [PSUBSET_DEF, GSYM IMP_DISJ_THM] \\
1225 Q.PAT_X_ASSUM ‘!s. s IN J1 ==> _’ (MP_TAC o Q.SPEC ‘t’) \\
1226 RW_TAC std_ss [] >> rename1 ‘z IN f k m’ \\
1227 Know ‘c + &SUC n / 2 pow l - (c + &n / 2 pow l) :real <=
1228 c + &SUC m / 2 pow k - (c + &m / 2 pow k)’
1229 >- (MATCH_MP_TAC closed_interval_subset \\
1230 REWRITE_TAC [lemma5a] \\
1231 Q.PAT_X_ASSUM ‘f l n SUBSET f k m’ MP_TAC \\
1232 simp [Abbr ‘f’]) \\
1233 simp [lemma6a] \\
1234 Know ‘2 pow k <= (2 pow l) :real <=> k <= l’
1235 >- (MATCH_MP_TAC REAL_POW_MONO_EQ >> simp []) >> Rewr' \\
1236 DISCH_TAC \\
1237 ‘k = l \/ k < l’ by simp [] (* 2 subgoals *)
1238 >- (Q.PAT_X_ASSUM ‘f l n SUBSET f k m’ MP_TAC \\
1239 simp [Abbr ‘f’, closed_interval_subset_eq, lemma5] \\
1240 simp [LE_ANTISYM]) \\
1241 ‘x IN f k m’ by PROVE_TAC [SUBSET_DEF] \\
1242 METIS_TAC [])
1243 >> DISCH_TAC
1244 >> Know ‘!s1 s2. s1 IN J2 /\ s2 IN J2 /\ s1 <> s2 ==> ~(s1 SUBSET s2)’
1245 >- (rw [Abbr ‘J2’, PSUBSET_DEF] \\
1246 METIS_TAC [])
1247 >> DISCH_TAC
1248 >> ‘?J. J2 = IMAGE J univ(:num)’ by METIS_TAC [COUNTABLE_AS_IMAGE]
1249 >> ‘!i. J i IN J2’ by rw []
1250 (* stage work *)
1251 >> Know ‘!i. ?xs. FST xs IN E /\
1252 J i = f (FST (SND xs)) (SND (SND xs)) /\
1253 SND (SND xs) < 2 ** FST (SND xs) /\ FST xs IN J i /\
1254 J i SUBSET cball (FST xs,g (FST xs))’
1255 >- (Q.X_GEN_TAC ‘i’ \\
1256 ‘J i IN J1’ by PROVE_TAC [SUBSET_DEF] \\
1257 Q.PAT_X_ASSUM ‘!s. s IN J1 ==> ?x k n. _’ (MP_TAC o Q.SPEC ‘J (i :num)’) \\
1258 RW_TAC std_ss [] \\
1259 Q.EXISTS_TAC ‘(x,k,n)’ >> simp [] >> fs [])
1260 >> simp [SKOLEM_THM]
1261 >> DISCH_THEN (Q.X_CHOOSE_THEN ‘ts’ STRIP_ASSUME_TAC)
1262 >> qexistsl_tac [‘J’, ‘\i. FST (ts i)’]
1263 (* nonoverlapping *)
1264 >> Know ‘!i j. J i <> J j ==> nonoverlapping (J i) (J j)’
1265 >- (POP_ASSUM K_TAC >> rpt STRIP_TAC \\
1266 ‘J2 SUBSET J0’ by PROVE_TAC [SUBSET_TRANS] \\
1267 ‘!i. J i IN J0’ by PROVE_TAC [SUBSET_DEF] \\
1268 METIS_TAC [])
1269 >> Rewr
1270 >> Know ‘!i. closed_interval (J i)’
1271 >- (rw [Abbr ‘f’, closed_interval_def] \\
1272 qexistsl_tac [‘c + &SND (SND (ts i)) / 2 pow FST (SND (ts i))’,
1273 ‘c + &SUC (SND (SND (ts i))) / 2 pow FST (SND (ts i))’] \\
1274 REFL_TAC)
1275 >> Rewr
1276 (* !x. x IN E ==> ?s. x IN s /\ ?x. s = J x *)
1277 >> reverse CONJ_TAC
1278 >- (rpt STRIP_TAC \\
1279 Q.PAT_X_ASSUM ‘!x. x IN E ==> ?s. x IN s /\ s IN J2’ drule >> rw [])
1280 (* stage work *)
1281 >> Q.X_GEN_TAC ‘i’ >> simp []
1282 >> POP_ASSUM (MP_TAC o Q.SPEC ‘i’)
1283 >> Cases_on ‘ts i’ >> simp []
1284 >> PairCases_on ‘r’ >> simp []
1285 >> rename1 ‘ts i = (y,k,n)’ >> simp []
1286 >> STRIP_TAC
1287 >> reverse CONJ_TAC
1288 >- (CONJ_TAC (* y IN f k n *)
1289 >- (Q.PAT_X_ASSUM ‘J i = f k n’ (REWRITE_TAC o wrap o SYM) >> art []) \\
1290 rpt STRIP_TAC \\
1291 Know ‘x IN cball (y,g y)’ >- METIS_TAC [SUBSET_DEF] \\
1292 simp [IN_CBALL])
1293 (* !x. x IN f k n ==> c <= x /\ x <= c + 1 *)
1294 >> RW_TAC real_ss [Abbr ‘f’, IN_INTERVAL]
1295 >| [ (* goal 1 (of 2) *)
1296 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘c + &n / 2 pow k’ >> art [] \\
1297 simp [REAL_LE_ADDR],
1298 (* goal 2 (of 2) *)
1299 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘c + &SUC n / 2 pow k’ >> art [] \\
1300 simp [ADD1, REAL_POW] ]
1301QED
1302
1303(* NOTE: “J i <> J j” changed to “i <> j”, i.e. no duplicated elements. *)
1304Theorem dyadic_covering_lemma_unit'[local] :
1305 !g E c. gauge g /\ E <> {} /\ E SUBSET interval [c,c + 1] ==>
1306 ?J t. (!i. J i SUBSET interval [c,c + 1] /\
1307 closed_interval (J i) /\
1308 t i IN E INTER J (i :num) /\
1309 J i SUBSET g (t i)) /\
1310 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
1311 E SUBSET BIGUNION (IMAGE J UNIV)
1312Proof
1313 rpt STRIP_TAC
1314 >> Know ‘?d. gauge UNIV d /\ !x. cball (x,d x) SUBSET (g x)’
1315 >- (fs [gauge_def, OPEN_CONTAINS_CBALL, FORALL_AND_THM,
1316 GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
1317 Q.EXISTS_TAC ‘\x. f x x’ \\
1318 rw [integralTheory.gauge'])
1319 >> STRIP_TAC
1320 >> MP_TAC (Q.SPECL [‘d’, ‘E’, ‘c’] dyadic_covering_lemma_unit)
1321 >> RW_TAC std_ss [FORALL_AND_THM]
1322 >> qabbrev_tac ‘s = IMAGE J UNIV’
1323 >> ‘countable s’ by simp [image_countable, Abbr ‘s’]
1324 >> reverse (Cases_on ‘FINITE s’)
1325 >- (FULL_SIMP_TAC std_ss [COUNTABLE_ALT_BIJ] \\
1326 qabbrev_tac ‘h = enumerate s’ \\
1327 Know ‘!i. h i IN s’
1328 >- (Q.X_GEN_TAC ‘i’ \\
1329 Q.PAT_X_ASSUM ‘BIJ h UNIV s’ MP_TAC \\
1330 rw [BIJ_DEF, INJ_DEF]) >> DISCH_TAC \\
1331 Know ‘!i j. i <> j ==> h i <> h j’
1332 >- (rpt STRIP_TAC \\
1333 Q.PAT_X_ASSUM ‘BIJ h UNIV s’ MP_TAC \\
1334 rw [BIJ_DEF, INJ_DEF] \\
1335 DISJ1_TAC >> qexistsl_tac [‘i’, ‘j’] >> art []) >> DISCH_TAC \\
1336 Know ‘!i. ?n. h i = J n’
1337 >- (Q.X_GEN_TAC ‘i’ \\
1338 Q.PAT_X_ASSUM ‘!i. h i IN s’ (MP_TAC o Q.SPEC ‘i’) \\
1339 rw [Abbr ‘s’]) \\
1340 RW_TAC std_ss [SKOLEM_THM] (* this asserts f *) \\
1341 qexistsl_tac [‘h’, ‘t o f’] \\
1342 ASM_SIMP_TAC std_ss [o_DEF] \\
1343 CONJ_TAC
1344 >- (Q.X_GEN_TAC ‘i’ \\
1345 Q_TAC (TRANS_TAC SUBSET_TRANS) ‘cball (t (f i),d (t (f i)))’ \\
1346 simp []) \\
1347 CONJ_TAC
1348 >- (rpt STRIP_TAC \\
1349 FIRST_X_ASSUM MATCH_MP_TAC \\
1350 Q.PAT_X_ASSUM ‘!i. h i = J (f i)’ (REWRITE_TAC o wrap o GSYM) \\
1351 FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
1352 Suff ‘IMAGE h UNIV = s’ >- simp [] \\
1353 POP_ASSUM K_TAC (* !i. h i = J (f i) *) \\
1354 rw [Once EXTENSION] \\
1355 EQ_TAC >- (rw [] >> simp []) \\
1356 Q.PAT_X_ASSUM ‘BIJ h UNIV s’ MP_TAC \\
1357 rw [BIJ_DEF, SURJ_DEF] \\
1358 Q.PAT_X_ASSUM ‘!x. x IN s ==> ?y. h y = x’ (MP_TAC o Q.SPEC ‘x’) \\
1359 simp [] >> DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
1360 Q.EXISTS_TAC ‘j’ >> art [])
1361 (* FINITE s *)
1362 >> FULL_SIMP_TAC std_ss [FINITE_BIJ_COUNT_EQ, GSYM MEMBER_NOT_EMPTY]
1363 >> rename1 ‘BIJ h (count n) s’
1364 >> Know ‘!i. i < n ==> h i IN s’
1365 >- (rpt STRIP_TAC \\
1366 Q.PAT_X_ASSUM ‘BIJ h (count n) s’ MP_TAC >> rw [BIJ_DEF, INJ_DEF])
1367 >> DISCH_TAC
1368 >> Know ‘!i j. i < n /\ j < n /\ i <> j ==> h i <> h j’
1369 >- (rpt STRIP_TAC \\
1370 Q.PAT_X_ASSUM ‘BIJ h (count n) s’ MP_TAC >> rw [BIJ_DEF, INJ_DEF] \\
1371 DISJ1_TAC >> qexistsl_tac [‘i’, ‘j’] >> art [])
1372 >> DISCH_TAC
1373 >> Know ‘!i. i < n ==> ?n. h i = J n’
1374 >- (rpt STRIP_TAC \\
1375 Q.PAT_X_ASSUM ‘!i. i < n ==> h i IN s’ (MP_TAC o Q.SPEC ‘i’) \\
1376 rw [Abbr ‘s’])
1377 >> RW_TAC std_ss [EXT_SKOLEM_THM'] (* this asserts f *)
1378 >> qabbrev_tac ‘L = \i. if i < n then h i else interval [x,x]’
1379 >> qabbrev_tac ‘u = \i. if i < n then t (f i) else x’
1380 >> qexistsl_tac [‘L’, ‘u’]
1381 >> Know ‘!i j. i <> j ==> nonoverlapping (L i) (L j)’
1382 >- (rw [Abbr ‘L’] >| (* 4 subgoals *)
1383 [ (* goal 1 (of 4) *)
1384 FIRST_X_ASSUM MATCH_MP_TAC \\
1385 Q.PAT_X_ASSUM ‘!i. i < n ==> h i = J (f i)’
1386 (ASM_SIMP_TAC std_ss o wrap o GSYM),
1387 (* goal 2 (of 4) *)
1388 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1389 simp [iffLR (cj 2 INTERVAL_EQ_EMPTY)],
1390 (* goal 3 (of 4) *)
1391 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1392 simp [iffLR (cj 2 INTERVAL_EQ_EMPTY)],
1393 (* goal 4 (of 4) *)
1394 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1395 simp [iffLR (cj 2 INTERVAL_EQ_EMPTY)] ])
1396 >> Rewr
1397 >> reverse CONJ_TAC
1398 >- (simp [SUBSET_DEF] \\
1399 Q.X_GEN_TAC ‘w’ >> DISCH_TAC \\
1400 Know ‘w IN BIGUNION s’ >- PROVE_TAC [SUBSET_DEF] \\
1401 rw [IN_BIGUNION] >> rename1 ‘A IN s’ \\
1402 Q.EXISTS_TAC ‘A’ >> art [] \\
1403 Q.PAT_X_ASSUM ‘BIJ h (count n) s’ MP_TAC \\
1404 rw [BIJ_DEF, SURJ_DEF] \\
1405 POP_ASSUM (MP_TAC o Q.SPEC ‘A’) >> art [] \\
1406 DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
1407 Q.EXISTS_TAC ‘j’ >> rw [Abbr ‘L’])
1408 >> RW_TAC std_ss [Abbr ‘L’, Abbr ‘u’, closed_interval_interval] (* 4 subgoals *)
1409 >| [ (* goal 1 (of 4) *)
1410 ‘x IN interval [(c,c + 1)]’ by PROVE_TAC [SUBSET_DEF] \\
1411 simp [SUBSET_DEF, INTERVAL_SING],
1412 (* goal 2 (of 4) *)
1413 simp [INTERVAL_SING],
1414 (* goal 3 (of 4) *)
1415 Q_TAC (TRANS_TAC SUBSET_TRANS) ‘cball (t (f i),d (t (f i)))’ \\
1416 simp [],
1417 (* goal 4 (of 4) *)
1418 simp [INTERVAL_SING, SUBSET_DEF, CENTRE_IN_CBALL] \\
1419 Suff ‘x IN cball (x,d x)’ >- METIS_TAC [SUBSET_DEF] \\
1420 rw [IN_CBALL, DIST_REFL] \\
1421 MATCH_MP_TAC REAL_LT_IMP_LE \\
1422 fs [integralTheory.gauge'] ]
1423QED
1424
1425Theorem UNIT_INTERVAL_PARTITION :
1426 univ(:real) =
1427 BIGUNION (IMAGE (\i. interval [real_of_int i, real_of_int i + 1])
1428 univ(:int))
1429Proof
1430 rw [Once EXTENSION, IN_BIGUNION_IMAGE, IN_INTERVAL]
1431 >> Q.EXISTS_TAC ‘INT_FLOOR x’
1432 >> MP_TAC (Q.SPEC ‘x’ INT_FLOOR_BOUNDS') (* intrealTheory *)
1433 >> qabbrev_tac ‘r = real_of_int (INT_FLOOR x)’
1434 >> REAL_ARITH_TAC
1435QED
1436
1437(* cf. INFINITE_INT_UNIV *)
1438Theorem COUNTABLE_INT_UNIV :
1439 countable univ(:int)
1440Proof
1441 Suff ‘UNIV = IMAGE int_of_num UNIV UNION IMAGE (\n. -int_of_num n) UNIV’
1442 >- (Rewr' \\
1443 MATCH_MP_TAC COUNTABLE_UNION_IMP (* cardinalTheory *) \\
1444 CONJ_TAC >> MATCH_MP_TAC COUNTABLE_IMAGE >> simp [])
1445 >> rw [Once EXTENSION]
1446 >> STRIP_ASSUME_TAC (Q.SPEC ‘x’ int_cases)
1447 >| [ DISJ1_TAC >> Q.EXISTS_TAC ‘n’ >> art [],
1448 DISJ2_TAC >> Q.EXISTS_TAC ‘n’ >> art [] ]
1449QED
1450
1451(* 18.15 Dyadic Covering Lemma [2, p.311] *)
1452Theorem dyadic_covering_lemma :
1453 !g E. gauge UNIV g /\ E <> {} ==>
1454 ?J t. (!i. closed_interval (J i) /\
1455 t i IN E INTER J (i :num) /\
1456 J i SUBSET cball (t i,g (t i))) /\
1457 (!i j. J i <> J j ==> nonoverlapping (J i) (J j)) /\
1458 E SUBSET BIGUNION (IMAGE J UNIV)
1459Proof
1460 rpt STRIP_TAC
1461 >> qabbrev_tac ‘e = \i. E INTER interval [real_of_int i,real_of_int i + 1]’
1462 >> ‘!i. e i SUBSET interval [real_of_int i,real_of_int i + 1]’
1463 by rw [SUBSET_DEF, Abbr ‘e’, IN_INTERVAL]
1464 (* applying dyadic_covering_lemma_unit *)
1465 >> Know ‘!n. e n <> {} ==>
1466 ?J t. (!i. J i SUBSET interval [real_of_int n,real_of_int n + 1] /\
1467 closed_interval (J i) /\
1468 t i IN e n INTER J (i :num) /\
1469 J i SUBSET cball (t i,g (t i))) /\
1470 (!i j. J i <> J j ==> nonoverlapping (J i) (J j)) /\
1471 e n SUBSET BIGUNION (IMAGE J UNIV)’
1472 >- (rpt STRIP_TAC \\
1473 MATCH_MP_TAC dyadic_covering_lemma_unit >> simp [])
1474 (* this asserts f and f' in place of J and t *)
1475 >> DISCH_THEN (STRIP_ASSUME_TAC o
1476 SIMP_RULE std_ss [GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM])
1477 >> Know ‘E = BIGUNION (IMAGE e UNIV)’
1478 >- (simp [Abbr ‘e’, GSYM BIGUNION_OVER_INTER_R] \\
1479 simp [GSYM UNIT_INTERVAL_PARTITION])
1480 >> DISCH_TAC
1481 >> Know ‘?n0. e n0 <> {}’
1482 >- (Suff ‘BIGUNION (IMAGE e univ(:int)) <> {}’
1483 >- (POP_ASSUM K_TAC \\
1484 rw [Once EXTENSION, IN_BIGUNION_IMAGE] \\
1485 Cases_on ‘x = {}’ >> fs [] \\
1486 rename1 ‘x = e n0’ \\
1487 Q.EXISTS_TAC ‘n0’ >> rw []) \\
1488 POP_ASSUM (art o wrap o SYM))
1489 >> STRIP_TAC
1490 >> Q.PAT_X_ASSUM ‘E = _’ (REWRITE_TAC o wrap)
1491 (* NOTE: Here I want to construct an non-empty countable set holding pairs
1492 (a,b) which comes from all (f i,f' i) pairs of each non-empty (e' n).
1493 Then, by COUNTABLE_ENUM or COUNTABLE_AS_IMAGE, the final existence of J/t
1494 is derived from this countable set.
1495 *)
1496 >> qabbrev_tac ‘a = \i. IMAGE (\j. (f i j, f' i j)) UNIV’
1497 >> qabbrev_tac ‘s = \i. if e i <> {} then a i else {}’
1498 >> qabbrev_tac ‘c = BIGUNION (IMAGE s UNIV)’
1499 >> Know ‘c <> {}’
1500 >- (simp [Abbr ‘c’, Once EXTENSION, IN_BIGUNION_IMAGE, Abbr ‘s’, NOT_IN_EMPTY] \\
1501 Suff ‘?i. e i <> {}’
1502 >- (STRIP_TAC \\
1503 Q.EXISTS_TAC ‘a i’ \\
1504 Know ‘a i <> {}’ >- rw [Abbr ‘a’, Once EXTENSION, NOT_IN_EMPTY] \\
1505 rw [] >> Q.EXISTS_TAC ‘i’ >> art []) \\
1506 Q.EXISTS_TAC ‘n0’ \\
1507 rw [Abbr ‘e’, Once EXTENSION, NOT_IN_EMPTY] \\
1508 simp [MEMBER_NOT_EMPTY])
1509 >> DISCH_TAC
1510 >> Q.PAT_X_ASSUM ‘e n0 <> {}’ K_TAC (* no more needed *)
1511 >> Know ‘countable c’
1512 >- (POP_ASSUM K_TAC (* c <> {} *) \\
1513 qunabbrev_tac ‘c’ \\
1514 MATCH_MP_TAC COUNTABLE_BIGUNION \\
1515 CONJ_TAC >- (MATCH_MP_TAC COUNTABLE_IMAGE \\
1516 REWRITE_TAC [COUNTABLE_INT_UNIV]) \\
1517 rw [Abbr ‘s’] \\
1518 rename1 ‘countable (if e n <> {} then a n else {})’ \\
1519 Cases_on ‘e n = {}’ >> simp [COUNTABLE_EMPTY, Abbr ‘a’])
1520 >> DISCH_TAC
1521 (* stage work *)
1522 >> Know ‘!z1 z2. z1 IN c /\ z2 IN c /\ FST z1 <> FST z2 ==>
1523 nonoverlapping (FST z1) (FST z2)’
1524 >- (rw [Abbr ‘c’, Abbr ‘s’, IN_BIGUNION_IMAGE] \\
1525 rename1 ‘z2 IN if e j <> {} then a j else {}’ \\
1526 Cases_on ‘e i = {}’ >> fs [] \\
1527 Cases_on ‘e j = {}’ >> fs [] \\
1528 Q.PAT_X_ASSUM ‘z2 IN a j’ MP_TAC \\
1529 Q.PAT_X_ASSUM ‘z1 IN a i’ MP_TAC \\
1530 Q.PAT_X_ASSUM ‘FST z1 <> FST z2’ MP_TAC \\
1531 rw [Abbr ‘a’] >> fs [] >> rename1 ‘f i m <> f j n’ \\
1532 Cases_on ‘i = j’ >- rw [] \\
1533 Q.PAT_X_ASSUM ‘f i m <> f j n’ K_TAC \\
1534 ‘f i m SUBSET interval [real_of_int i,real_of_int i + 1] /\
1535 f j n SUBSET interval [real_of_int j,real_of_int j + 1]’ by rw [] \\
1536 MATCH_MP_TAC nonoverlapping_subset_inclusive \\
1537 qexistsl_tac [‘interval [real_of_int i,real_of_int i + 1]’,
1538 ‘interval [real_of_int j,real_of_int j + 1]’] \\
1539 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1540 simp [closed_interval_disjoint_eq] \\
1541 SIMP_TAC real_ss [GSYM real_of_int_add, GSYM real_of_int_num] \\
1542 simp [] \\
1543 Q.PAT_X_ASSUM ‘i <> j’ MP_TAC >> intLib.ARITH_TAC)
1544 >> DISCH_TAC
1545 (* stage work *)
1546 >> Suff ‘!z. z IN c ==> closed_interval (FST z) /\
1547 SND z IN BIGUNION (IMAGE e UNIV) INTER FST z /\
1548 FST z SUBSET cball (SND z,g (SND z))’
1549 >- (DISCH_TAC \\
1550 MP_TAC (ISPEC “c :(real set # real) set” COUNTABLE_AS_IMAGE) \\
1551 simp [] >> DISCH_THEN (Q.X_CHOOSE_THEN ‘h’ STRIP_ASSUME_TAC) \\
1552 ‘!n. h n IN c’ by rw [] \\
1553 qexistsl_tac [‘FST o h’, ‘SND o h’] >> simp [o_DEF] \\
1554 CONJ_TAC
1555 >- (Q.X_GEN_TAC ‘n’ \\
1556 Q.PAT_X_ASSUM ‘!z. z IN c ==> _’ (MP_TAC o Q.SPEC ‘h (n :num)’) >> rw []) \\
1557 simp [SUBSET_DEF, IN_BIGUNION_IMAGE] \\
1558 Q.X_GEN_TAC ‘x’ \\
1559 DISCH_THEN (Q.X_CHOOSE_THEN ‘n’ STRIP_ASSUME_TAC) \\
1560 Cases_on ‘e n = {}’ >- fs [] \\
1561 Know ‘x IN BIGUNION (IMAGE (f n) UNIV)’ >- METIS_TAC [SUBSET_DEF] \\
1562 simp [IN_BIGUNION_IMAGE] \\
1563 DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
1564 Know ‘(f n j,f' n j) IN c’
1565 >- (Q.PAT_X_ASSUM ‘c = IMAGE h UNIV’ K_TAC \\
1566 rw [Abbr ‘c’] \\
1567 Q.EXISTS_TAC ‘s n’ \\
1568 reverse CONJ_TAC >- (Q.EXISTS_TAC ‘n’ >> simp []) \\
1569 rw [Abbr ‘s’] \\
1570 rw [Abbr ‘a’] \\
1571 Q.EXISTS_TAC ‘j’ >> simp []) \\
1572 Q.PAT_X_ASSUM ‘c = IMAGE h UNIV’ (REWRITE_TAC o wrap) >> simp [] \\
1573 DISCH_THEN (Q.X_CHOOSE_THEN ‘i’ STRIP_ASSUME_TAC) \\
1574 Q.EXISTS_TAC ‘i’ \\
1575 POP_ASSUM (simp o wrap o SYM))
1576 (* stage work *)
1577 >> NTAC 3 (POP_ASSUM K_TAC)
1578 >> Q.X_GEN_TAC ‘z’
1579 >> simp [Abbr ‘c’, Abbr ‘s’, IN_BIGUNION_IMAGE, SUBSET_DEF]
1580 >> STRIP_TAC
1581 >> Cases_on ‘e i = {}’ >> fs []
1582 >> Q.PAT_X_ASSUM ‘z IN a i’ MP_TAC
1583 >> simp [Abbr ‘a’]
1584 >> STRIP_TAC >> POP_ORW >> simp []
1585 >> CONJ_TAC
1586 >- (Q.PAT_X_ASSUM ‘!n. e n <> {} ==> _’ (MP_TAC o Q.SPEC ‘i’) >> simp [] \\
1587 STRIP_TAC \\
1588 NTAC 2 (POP_ASSUM K_TAC) \\
1589 POP_ASSUM (MP_TAC o Q.SPEC ‘j’) >> rw [Abbr ‘e’] \\
1590 Q.EXISTS_TAC ‘i’ >> art [])
1591 >> rw []
1592 >> Q.PAT_X_ASSUM ‘!n. e n <> {} ==> _’ (MP_TAC o Q.SPEC ‘i’) >> simp []
1593 >> STRIP_TAC
1594 >> NTAC 2 (POP_ASSUM K_TAC)
1595 >> POP_ASSUM (MP_TAC o Q.SPEC ‘j’)
1596 >> rw [SUBSET_DEF]
1597QED
1598
1599(* NOTE: This version uses “gauge” of integrationTheory.gauge_def, and it
1600 improve the conclusion to “!i j. i <> j ==> nonoverlapping (J i) (J j)”,
1601 which means that the constructed sequence is indeed infinitely countable.
1602 *)
1603Theorem dyadic_covering_lemma' :
1604 !g E. gauge g /\ E <> {} ==>
1605 ?J t. (!i. closed_interval (J i) /\
1606 t i IN E INTER J (i :num) /\
1607 J i SUBSET g (t i)) /\
1608 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
1609 E SUBSET BIGUNION (IMAGE J UNIV)
1610Proof
1611 rpt STRIP_TAC
1612 >> Know ‘?d. gauge UNIV d /\ !x. cball (x,d x) SUBSET (g x)’
1613 >- (fs [gauge_def, OPEN_CONTAINS_CBALL, FORALL_AND_THM,
1614 GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
1615 Q.EXISTS_TAC ‘\x. f x x’ \\
1616 rw [integralTheory.gauge'])
1617 >> STRIP_TAC
1618 >> MP_TAC (Q.SPECL [‘d’, ‘E’] dyadic_covering_lemma)
1619 >> RW_TAC std_ss [FORALL_AND_THM]
1620 >> qabbrev_tac ‘s = IMAGE J UNIV’
1621 >> ‘countable s’ by simp [image_countable, Abbr ‘s’]
1622 >> reverse (Cases_on ‘FINITE s’)
1623 >- (FULL_SIMP_TAC std_ss [COUNTABLE_ALT_BIJ] \\
1624 qabbrev_tac ‘h = enumerate s’ \\
1625 Know ‘!i. h i IN s’
1626 >- (Q.X_GEN_TAC ‘i’ \\
1627 Q.PAT_X_ASSUM ‘BIJ h UNIV s’ MP_TAC \\
1628 rw [BIJ_DEF, INJ_DEF]) >> DISCH_TAC \\
1629 Know ‘!i j. i <> j ==> h i <> h j’
1630 >- (rpt STRIP_TAC \\
1631 Q.PAT_X_ASSUM ‘BIJ h UNIV s’ MP_TAC \\
1632 rw [BIJ_DEF, INJ_DEF] \\
1633 DISJ1_TAC >> qexistsl_tac [‘i’, ‘j’] >> art []) >> DISCH_TAC \\
1634 Know ‘!i. ?n. h i = J n’
1635 >- (Q.X_GEN_TAC ‘i’ \\
1636 Q.PAT_X_ASSUM ‘!i. h i IN s’ (MP_TAC o Q.SPEC ‘i’) \\
1637 rw [Abbr ‘s’]) \\
1638 RW_TAC std_ss [SKOLEM_THM] (* this asserts f *) \\
1639 qexistsl_tac [‘h’, ‘t o f’] \\
1640 ASM_SIMP_TAC std_ss [o_DEF] \\
1641 CONJ_TAC
1642 >- (Q.X_GEN_TAC ‘i’ \\
1643 Q_TAC (TRANS_TAC SUBSET_TRANS) ‘cball (t (f i),d (t (f i)))’ \\
1644 simp []) \\
1645 CONJ_TAC
1646 >- (rpt STRIP_TAC \\
1647 FIRST_X_ASSUM MATCH_MP_TAC \\
1648 Q.PAT_X_ASSUM ‘!i. h i = J (f i)’ (REWRITE_TAC o wrap o GSYM) \\
1649 FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\
1650 Suff ‘IMAGE h UNIV = s’ >- simp [] \\
1651 POP_ASSUM K_TAC (* !i. h i = J (f i) *) \\
1652 rw [Once EXTENSION] \\
1653 EQ_TAC >- (rw [] >> simp []) \\
1654 Q.PAT_X_ASSUM ‘BIJ h UNIV s’ MP_TAC \\
1655 rw [BIJ_DEF, SURJ_DEF] \\
1656 Q.PAT_X_ASSUM ‘!x. x IN s ==> ?y. h y = x’ (MP_TAC o Q.SPEC ‘x’) \\
1657 simp [] >> DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
1658 Q.EXISTS_TAC ‘j’ >> art [])
1659 (* FINITE s *)
1660 >> FULL_SIMP_TAC std_ss [FINITE_BIJ_COUNT_EQ, GSYM MEMBER_NOT_EMPTY]
1661 >> Know ‘!i. i < n ==> c i IN s’
1662 >- (rpt STRIP_TAC \\
1663 Q.PAT_X_ASSUM ‘BIJ c (count n) s’ MP_TAC >> rw [BIJ_DEF, INJ_DEF])
1664 >> DISCH_TAC
1665 >> Know ‘!i j. i < n /\ j < n /\ i <> j ==> c i <> c j’
1666 >- (rpt STRIP_TAC \\
1667 Q.PAT_X_ASSUM ‘BIJ c (count n) s’ MP_TAC >> rw [BIJ_DEF, INJ_DEF] \\
1668 DISJ1_TAC >> qexistsl_tac [‘i’, ‘j’] >> art [])
1669 >> DISCH_TAC
1670 >> Know ‘!i. i < n ==> ?n. c i = J n’
1671 >- (rpt STRIP_TAC \\
1672 Q.PAT_X_ASSUM ‘!i. i < n ==> c i IN s’ (MP_TAC o Q.SPEC ‘i’) \\
1673 rw [Abbr ‘s’])
1674 >> RW_TAC std_ss [EXT_SKOLEM_THM'] (* this asserts f *)
1675 >> qabbrev_tac ‘L = \i. if i < n then c i else interval [x,x]’
1676 >> qabbrev_tac ‘u = \i. if i < n then t (f i) else x’
1677 >> qexistsl_tac [‘L’, ‘u’]
1678 >> Know ‘!i j. i <> j ==> nonoverlapping (L i) (L j)’
1679 >- (rw [Abbr ‘L’] >| (* 4 subgoals *)
1680 [ (* goal 1 (of 4) *)
1681 FIRST_X_ASSUM MATCH_MP_TAC \\
1682 Q.PAT_X_ASSUM ‘!i. i < n ==> c i = J (f i)’
1683 (ASM_SIMP_TAC std_ss o wrap o GSYM),
1684 (* goal 2 (of 4) *)
1685 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1686 simp [iffLR (cj 2 INTERVAL_EQ_EMPTY)],
1687 (* goal 3 (of 4) *)
1688 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1689 simp [iffLR (cj 2 INTERVAL_EQ_EMPTY)],
1690 (* goal 4 (of 4) *)
1691 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
1692 simp [iffLR (cj 2 INTERVAL_EQ_EMPTY)] ])
1693 >> Rewr
1694 >> reverse CONJ_TAC
1695 >- (simp [SUBSET_DEF] \\
1696 Q.X_GEN_TAC ‘w’ >> DISCH_TAC \\
1697 Know ‘w IN BIGUNION s’ >- PROVE_TAC [SUBSET_DEF] \\
1698 rw [IN_BIGUNION] >> rename1 ‘A IN s’ \\
1699 Q.EXISTS_TAC ‘A’ >> art [] \\
1700 Q.PAT_X_ASSUM ‘BIJ c (count n) s’ MP_TAC \\
1701 rw [BIJ_DEF, SURJ_DEF] \\
1702 POP_ASSUM (MP_TAC o Q.SPEC ‘A’) >> art [] \\
1703 DISCH_THEN (Q.X_CHOOSE_THEN ‘j’ STRIP_ASSUME_TAC) \\
1704 Q.EXISTS_TAC ‘j’ >> rw [Abbr ‘L’])
1705 >> RW_TAC std_ss [Abbr ‘L’, Abbr ‘u’, closed_interval_interval] (* 3 subgoals *)
1706 >| [ (* goal 1 (of 3) *)
1707 simp [IN_INTERVAL],
1708 (* goal 2 (of 3) *)
1709 Q_TAC (TRANS_TAC SUBSET_TRANS) ‘cball (t (f i),d (t (f i)))’ \\
1710 simp [],
1711 (* goal 3 (of 3) *)
1712 simp [closed_interval_def, SUBSET_DEF, IN_INTERVAL] \\
1713 Q.X_GEN_TAC ‘w’ >> STRIP_TAC \\
1714 ‘w = x’ by PROVE_TAC [REAL_LE_ANTISYM] >> POP_ORW \\
1715 FULL_SIMP_TAC std_ss [gauge_def] ]
1716QED
1717
1718Definition integrable_sets_def :
1719 integrable_sets X = {E | indicator E integrable_on X}
1720End
1721
1722(* NOTE: The other direction is not true. For example, UNIV is in lebesgue,
1723 but “indicator UNIV integrable_on UNIV” doesn't hold, as the integral
1724 is clearly infinity, not a normal real value.
1725
1726 This set is denoted as I(R) in [2, p.300] (Definition 18.1).
1727 *)
1728Theorem integrable_sets_subset_lebesgue :
1729 integrable_sets UNIV SUBSET measurable_sets lebesgue
1730Proof
1731 rw [integrable_sets_def, SUBSET_DEF, lebesgue_def, line_def]
1732 >> MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL
1733 >> Q.EXISTS_TAC ‘UNIV’ >> simp []
1734QED
1735
1736(* |- !E. indicator E integrable_on univ(:real) ==>
1737 E IN measurable_sets lebesgue
1738 *)
1739Theorem integrable_indicator_imp_sets_lebesgue =
1740 integrable_sets_subset_lebesgue
1741 |> SRULE [SUBSET_DEF, integrable_sets_def] |> Q.SPEC ‘E’ |> GEN_ALL
1742
1743(* This restrict version is based on INTEGRAL_ABS_BOUND_INTEGRAL *)
1744Theorem INTEGRAL_MONO_LEMMA :
1745 !f g s. f integrable_on s /\ g integrable_on s /\
1746 (!x. x IN s ==> 0 <= f x) /\
1747 (!x. x IN s ==> 0 <= g x) /\
1748 (!x. x IN s ==> f x <= g x) ==> integral s f <= integral s g
1749Proof
1750 rpt STRIP_TAC
1751 >> Know ‘integral s f = abs (integral s f)’
1752 >- (simp [Once EQ_SYM_EQ, ABS_REFL] \\
1753 MATCH_MP_TAC INTEGRAL_POS >> art [])
1754 >> Rewr'
1755 >> MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL >> rw []
1756 >> Suff ‘abs (f x) = f x’ >- (Rewr' >> simp [])
1757 >> simp [ABS_REFL]
1758QED
1759
1760Theorem INTEGRAL_HAS_INTEGRAL :
1761 !f s y. (f has_integral y) s ==> integral s f = y
1762Proof
1763 PROVE_TAC [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
1764QED
1765
1766Theorem has_integral_indicator_imp_lebesgue :
1767 !E y. (indicator E has_integral y) UNIV ==> lmeasure E = Normal y
1768Proof
1769 rw [lebesgue_def]
1770 >> Know ‘indicator E integrable_on UNIV’
1771 >- (simp [integrable_on] \\
1772 Q.EXISTS_TAC ‘y’ >> art [])
1773 >> DISCH_TAC
1774 >> Know ‘!n. (indicator E) integrable_on (line n)’
1775 >- (rw [line_def] \\
1776 MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
1777 Q.EXISTS_TAC ‘UNIV’ >> simp [])
1778 >> DISCH_TAC
1779 >> qabbrev_tac ‘f = \k. indicator (E INTER line k)’
1780 >> Know ‘!k. f k integrable_on UNIV’
1781 >- (rw [integrable_on, Abbr ‘f’, has_integral_indicator_UNIV] \\
1782 fs [integrable_on])
1783 >> DISCH_TAC
1784 >> Know ‘!k x. f k x <= f (SUC k) x’
1785 >- (rw [Abbr ‘f’] \\
1786 MATCH_MP_TAC INDICATOR_MONO \\
1787 rw [line_def, SUBSET_DEF, IN_INTERVAL] >| (* 2 subgoals *)
1788 [ Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘-&k’ >> simp [],
1789 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘&k’ >> simp [] ])
1790 >> DISCH_TAC
1791 >> qabbrev_tac ‘g = indicator E’
1792 >> Know ‘!x. ((\k. f k x) --> g x) sequentially’
1793 >- (rw [LIM_SEQUENTIALLY, dist, Abbr ‘f’, Abbr ‘g’] \\
1794 MP_TAC (Q.SPEC ‘abs x’ SIMP_REAL_ARCH) \\
1795 rw [ABS_BOUNDS] \\
1796 ‘x IN line n’ by simp [line] \\
1797 Q.EXISTS_TAC ‘n’ >> rw [] \\
1798 ‘line n SUBSET line k’ by PROVE_TAC [LINE_MONO] \\
1799 ‘x IN line k’ by PROVE_TAC [SUBSET_DEF] \\
1800 simp [indicator])
1801 >> DISCH_TAC
1802 >> Know ‘bounded {integral UNIV (f n) | n | T}’
1803 >- (simp [bounded_def] \\
1804 Q.EXISTS_TAC ‘y’ >> rw [] \\
1805 ‘integral UNIV g = y’ by PROVE_TAC [INTEGRAL_HAS_INTEGRAL] \\
1806 POP_ASSUM (REWRITE_TAC o wrap o SYM) \\
1807 MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL >> rw [] \\
1808 Know ‘abs (f n x) = f n x’
1809 >- (MATCH_MP_TAC ABS_REDUCE \\
1810 simp [Abbr ‘f’, INDICATOR_POS]) >> Rewr' \\
1811 simp [Abbr ‘f’, Abbr ‘g’] \\
1812 MATCH_MP_TAC INDICATOR_MONO >> SET_TAC [])
1813 >> DISCH_TAC
1814 (* applying MONOTONE_CONVERGENCE_INCREASING *)
1815 >> MP_TAC (Q.SPECL [‘f’, ‘g’, ‘UNIV’] MONOTONE_CONVERGENCE_INCREASING)
1816 >> simp []
1817 >> Know ‘integral UNIV g = y’
1818 >- (simp [integral_def] \\
1819 SELECT_ELIM_TAC \\
1820 CONJ_TAC >- (Q.EXISTS_TAC ‘y’ >> art []) \\
1821 METIS_TAC [HAS_INTEGRAL_UNIQUE])
1822 >> Rewr'
1823 >> Know ‘!n. integral (line n) g = integral UNIV (f n)’
1824 >- (rw [Once EQ_SYM_EQ, Abbr ‘g’, Abbr ‘f’] \\
1825 simp [integral_indicator_UNIV])
1826 >> Rewr'
1827 >> DISCH_TAC
1828 >> qabbrev_tac ‘s = {integral UNIV (f n) | n | T}’
1829 >> Know ‘{Normal (integral UNIV (f n)) | n | T} = IMAGE Normal s’
1830 >- (rw [Once EXTENSION, Abbr ‘s’] \\
1831 METIS_TAC [])
1832 >> Rewr'
1833 (* applying sup_image_normal *)
1834 >> Know ‘sup (IMAGE Normal s) = Normal (sup s)’
1835 >- (MATCH_MP_TAC sup_image_normal \\
1836 CONJ_TAC >- rw [Abbr ‘s’, Once EXTENSION, NOT_IN_EMPTY] \\
1837 simp [Abbr ‘s’])
1838 >> Rewr'
1839 >> simp [Abbr ‘s’]
1840 (* applying mono_increasing_converges_to_sup *)
1841 >> qabbrev_tac ‘h = \n. integral UNIV (f n)’
1842 >> ‘{integral UNIV (f n) | n | T} = IMAGE h UNIV’
1843 by rw [Once EXTENSION, Abbr ‘h’]
1844 >> POP_ORW
1845 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
1846 >> MATCH_MP_TAC mono_increasing_converges_to_sup
1847 >> simp [GSYM LIM_SEQUENTIALLY_SEQ]
1848 >> simp [mono_increasing_def, Abbr ‘h’]
1849 >> qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC
1850 >> MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> simp []
1851 >> ‘!n x. 0 <= f n x’ by rw [Abbr ‘f’, INDICATOR_POS]
1852 >> simp []
1853 >> rw [Abbr ‘f’]
1854 >> MATCH_MP_TAC INDICATOR_MONO
1855 >> Suff ‘line i SUBSET line j’ >- SET_TAC []
1856 >> MATCH_MP_TAC LINE_MONO >> art []
1857QED
1858
1859(* Another form of has_integral_indicator_imp_lebesgue *)
1860Theorem integrable_indicator_imp_lmeasure :
1861 !E y. E IN integrable_sets UNIV ==>
1862 lmeasure E = Normal (integral UNIV (indicator E))
1863Proof
1864 rw [integrable_on, integrable_sets_def]
1865 >> ‘integral UNIV (indicator E) = y’ by PROVE_TAC [INTEGRAL_HAS_INTEGRAL]
1866 >> POP_ORW
1867 >> MATCH_MP_TAC has_integral_indicator_imp_lebesgue >> art []
1868QED
1869
1870(* Yet another form *)
1871Theorem integral_indicator_lmeasure :
1872 !E y. E IN integrable_sets UNIV ==>
1873 lmeasure E <> PosInf /\
1874 integral UNIV (indicator E) = real (lmeasure E)
1875Proof
1876 rw [integrable_indicator_imp_lmeasure]
1877QED
1878
1879Theorem has_integral_indicator_imp_lebesgue' :
1880 !E y s. E IN measurable_sets lebesgue /\ E SUBSET s ==>
1881 (indicator E has_integral y) s ==> lmeasure E = Normal y
1882Proof
1883 rpt STRIP_TAC
1884 >> MATCH_MP_TAC has_integral_indicator_imp_lebesgue
1885 >> qabbrev_tac ‘t = UNIV DIFF s’
1886 >> ‘UNIV = s UNION t’ by ASM_SET_TAC [] >> POP_ORW
1887 >> ‘s INTER t = {}’ by ASM_SET_TAC []
1888 >> ONCE_REWRITE_TAC [GSYM REAL_ADD_RID]
1889 >> MATCH_MP_TAC HAS_INTEGRAL_UNION >> art [NEGLIGIBLE_EMPTY]
1890 >> MATCH_MP_TAC HAS_INTEGRAL_IS_0
1891 >> rw [indicator, Abbr ‘t’]
1892 >> PROVE_TAC [SUBSET_DEF]
1893QED
1894
1895(* NOTE: HAS_INTEGRAL_BIGUNION, HAS_INTEGRAL_INTEGRABLE_INTEGRAL, INTEGRABLE_SUM *)
1896Theorem INTEGRAL_BIGUNION :
1897 !f t. FINITE t /\ (!s. s IN t ==> f integrable_on s) /\
1898 (!s s'. s IN t /\ s' IN t /\ s <> s' ==> negligible (s INTER s')) ==>
1899 f integrable_on (BIGUNION t) /\
1900 integral (BIGUNION t) f = sum t (\s. integral s f)
1901Proof
1902 rpt GEN_TAC >> STRIP_TAC
1903 >> Q.PAT_X_ASSUM ‘!s. s IN t ==> f integrable_on s’
1904 (STRIP_ASSUME_TAC o REWRITE_RULE [integrable_on])
1905 >> fs [GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM]
1906 >> rename1 ‘!s. s IN t ==> (f has_integral i s) s’
1907 >> MP_TAC (Q.SPECL [‘f’, ‘i’, ‘t’] HAS_INTEGRAL_BIGUNION)
1908 >> simp [] >> DISCH_TAC
1909 >> Know ‘sum t (\s. integral s f) = sum t i’
1910 >- (MATCH_MP_TAC SUM_EQ' \\
1911 Q.X_GEN_TAC ‘s’ >> rw [] \\
1912 METIS_TAC [HAS_INTEGRAL_INTEGRABLE_INTEGRAL])
1913 >> Rewr'
1914 >> METIS_TAC [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
1915QED
1916
1917(* NOTE: This is the "unit" version of [approximation_thm] over [c,c + 1] *)
1918Theorem approximation_lemma1[local] :
1919 !E c e. E IN measurable_sets lebesgue /\ E <> {} /\ 0 < e /\
1920 E SUBSET interval [c,c + 1] ==>
1921 ?J. (!i. J i SUBSET interval [c,c + 1]) /\
1922 (!i. closed_interval (J i)) /\
1923 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
1924 E SUBSET BIGUNION (IMAGE J UNIV) /\
1925 lmeasure E <= suminf (lmeasure o J) /\
1926 suminf (lmeasure o J) <= lmeasure E + Normal e
1927Proof
1928 rpt STRIP_TAC
1929 >> Know ‘!a b. indicator E integrable_on interval [a,b]’
1930 >- (rpt GEN_TAC \\
1931 fs [lebesgue_def] \\
1932 MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
1933 STRIP_ASSUME_TAC (Q.SPECL [‘a’, ‘b’] LINE_EXISTS) \\
1934 Q.EXISTS_TAC ‘line n’ >> art [])
1935 >> DISCH_TAC
1936 >> POP_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE [integrable_on] o
1937 Q.SPECL [‘c’, ‘c + 1’]) (* this asserts ‘y’ *)
1938 >> ‘lmeasure E = Normal y’
1939 by PROVE_TAC [has_integral_indicator_imp_lebesgue']
1940 >> qabbrev_tac ‘s = interval [c,c + 1]’
1941 >> ‘(indicator E) integrable_on s /\ integral s (indicator E) = y’
1942 by PROVE_TAC [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
1943 >> Q.PAT_X_ASSUM ‘(indicator E has_integral y) s’
1944 (MP_TAC o SRULE [has_integral_def])
1945 >> Know ‘?a b. s = interval [a,b]’
1946 >- (simp [Abbr ‘s’] \\
1947 qexistsl_tac [‘c’, ‘c + 1’] >> REFL_TAC)
1948 >> Rewr
1949 >> rw [has_integral_compact_interval]
1950 >> POP_ASSUM (MP_TAC o Q.SPEC ‘e’)
1951 >> RW_TAC real_ss [] (* this asserts ‘d’ (the gauge). *)
1952 >> qabbrev_tac ‘f = indicator E’
1953 >> qabbrev_tac ‘y = integral s f’
1954 (* applying dyadic_covering_lemma' *)
1955 >> MP_TAC (Q.SPECL [‘d’, ‘E’, ‘c’] dyadic_covering_lemma_unit')
1956 >> RW_TAC std_ss [FORALL_AND_THM, GSYM CONJ_ASSOC]
1957 (* NOTE: J may covers entire univ(:real), including those outside of [-B,B]. *)
1958 >> Q.EXISTS_TAC ‘J’ >> simp []
1959 >> ‘!n. J n IN measurable_sets lebesgue’
1960 by PROVE_TAC [closed_interval_imp_lebesgue]
1961 (* The first subgoal involves only a measure-theoretic proof *)
1962 >> CONJ_TAC
1963 >- (Q.PAT_X_ASSUM ‘lmeasure E = Normal y’ (REWRITE_TAC o wrap o SYM) \\
1964 Know ‘BIGUNION (IMAGE J UNIV) IN measurable_sets lebesgue’
1965 >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION \\
1966 simp [measure_space_lebesgue]) >> DISCH_TAC \\
1967 qabbrev_tac ‘A = interior o J’ \\
1968 Know ‘lmeasure o J = lmeasure o A’
1969 >- (simp [FUN_EQ_THM, Abbr ‘A’] \\
1970 Q.X_GEN_TAC ‘i’ \\
1971 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM,
1972 INTERIOR_INTERVAL] \\
1973 rename1 ‘!i. J i = interval [a i,b i]’ \\
1974 Cases_on ‘a i <= b i’
1975 >- simp [lebesgue_open_interval, lebesgue_closed_interval] \\
1976 ‘b i < a i /\ b i <= a i’ by PROVE_TAC [REAL_NOT_LE, REAL_LT_IMP_LE] \\
1977 simp [iffLR (cj 1 INTERVAL_EQ_EMPTY),
1978 iffLR (cj 2 INTERVAL_EQ_EMPTY)]) >> Rewr' \\
1979 Know ‘!n. A n IN measurable_sets lebesgue’
1980 >- (rw [Abbr ‘A’] \\
1981 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM,
1982 INTERIOR_INTERVAL] \\
1983 rename1 ‘!i. J i = interval [a i,b i]’ \\
1984 Suff ‘interval (a n,b n) IN measurable_sets lborel’
1985 >- PROVE_TAC [SUBSET_DEF, lborel_subset_lebesgue] \\
1986 simp [sets_lborel, borel_measurable_sets, OPEN_interval]) >> DISCH_TAC \\
1987 Know ‘BIGUNION (IMAGE A UNIV) IN measurable_sets lebesgue’
1988 >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION \\
1989 simp [measure_space_lebesgue]) >> DISCH_TAC \\
1990 (* applying COUNTABLY_ADDITIVE *)
1991 Know ‘suminf (lmeasure o A) = lmeasure (BIGUNION (IMAGE A UNIV))’
1992 >- (MATCH_MP_TAC COUNTABLY_ADDITIVE \\
1993 simp [countably_additive_lebesgue, IN_FUNSET] \\
1994 rpt STRIP_TAC \\
1995 Q.PAT_X_ASSUM ‘!i j. i <> j ==> nonoverlapping (J i) (J j)’
1996 (MP_TAC o Q.SPECL [‘i’, ‘j’]) \\
1997 simp [nonoverlapping_def, Abbr ‘A’]) >> Rewr' \\
1998 Suff ‘lmeasure (BIGUNION (IMAGE A UNIV)) =
1999 lmeasure (BIGUNION (IMAGE J UNIV))’
2000 >- (Rewr' \\
2001 MATCH_MP_TAC MEASURE_INCREASING >> simp [measure_space_lebesgue]) \\
2002 qabbrev_tac ‘C = frontier o J’ \\
2003 Know ‘!n. C n IN measurable_sets lebesgue’
2004 >- (Q.X_GEN_TAC ‘n’ \\
2005 Suff ‘C n IN measurable_sets lborel’
2006 >- PROVE_TAC [SUBSET_DEF, lborel_subset_lebesgue] \\
2007 SIMP_TAC std_ss [Abbr ‘C’, sets_lborel] \\
2008 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2009 rename1 ‘!i. J i = interval [a i,b i]’ \\
2010 simp [FRONTIER_CLOSED_INTERVAL] \\
2011 MATCH_MP_TAC SIGMA_ALGEBRA_DIFF \\
2012 simp [sigma_algebra_borel, borel_measurable_sets,
2013 OPEN_interval, CLOSED_interval]) >> DISCH_TAC \\
2014 Know ‘BIGUNION (IMAGE C UNIV) IN measurable_sets lebesgue’
2015 >- (MATCH_MP_TAC MEASURE_SPACE_BIGUNION \\
2016 simp [measure_space_lebesgue]) >> DISCH_TAC \\
2017 Know ‘!n. DISJOINT (A n) (C n)’
2018 >- (rw [Abbr ‘A’, Abbr ‘C’] \\
2019 simp [GSYM SET_DIFF_FRONTIER, DISJOINT_ALT]) >> DISCH_TAC \\
2020 Know ‘!n. J n = A n UNION C n’
2021 >- (rw [Abbr ‘A’, Abbr ‘C’, frontier] \\
2022 ‘closed (J n)’ by PROVE_TAC [closed_interval_closed] \\
2023 simp [CLOSURE_CLOSED] \\
2024 Suff ‘interior (J n) SUBSET J n’ >- SET_TAC [] \\
2025 REWRITE_TAC [INTERIOR_SUBSET]) >> DISCH_TAC \\
2026 (* NOTE: BIGUNION (IMAGE A UNIV) and BIGUNION (IMAGE C UNIV) are not
2027 disjoint in general: some C in form of [x,x] may stand in the middle
2028 of another (A n). But these singleton sets do not contribute measures.
2029 *)
2030 Know ‘BIGUNION (IMAGE J UNIV) =
2031 BIGUNION (IMAGE A UNIV) UNION BIGUNION (IMAGE C UNIV)’
2032 >- (REWRITE_TAC [BIGUNION_IMAGE_UNION] \\
2033 POP_ASSUM (fn th => simp [GSYM th, ETA_THM])) >> Rewr' \\
2034 (* applying MEASURE_ADD_ABSORB *)
2035 SYM_TAC >> MATCH_MP_TAC MEASURE_ADD_ABSORB \\
2036 simp [measure_space_lebesgue] \\
2037 reverse (rw [GSYM le_antisym])
2038 >- (MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue]) \\
2039 Q_TAC (TRANS_TAC le_trans) ‘suminf (lmeasure o C)’ \\
2040 CONJ_TAC
2041 >- (MATCH_MP_TAC MEASURE_COUNTABLY_SUBADDITIVE \\
2042 simp [measure_space_lebesgue, IN_FUNSET]) \\
2043 Suff ‘suminf (lmeasure o C) = 0’ >- simp [] \\
2044 MATCH_MP_TAC ext_suminf_zero \\
2045 NTAC 4 (POP_ASSUM K_TAC) (* C-assumptions *) \\
2046 rw [o_DEF, Abbr ‘C’] \\
2047 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2048 rename1 ‘!i. J i = interval [a i,b i]’ \\
2049 simp [FRONTIER_CLOSED_INTERVAL] \\
2050 Know ‘interval [(a n,b n)] DIFF interval (a n,b n) = {a n} UNION {b n}’
2051 >- (rw [Once EXTENSION, IN_INTERVAL, REAL_NOT_LT] \\
2052 Know ‘a n <= b n’
2053 >- (CCONTR_TAC >> fs [REAL_NOT_LE] \\
2054 Q.PAT_X_ASSUM ‘!i. t i IN E /\ t i IN J i’ (MP_TAC o Q.SPEC ‘n’) \\
2055 simp [iffLR (cj 1 INTERVAL_EQ_EMPTY)]) \\
2056 REAL_ARITH_TAC) >> Rewr' \\
2057 qmatch_abbrev_tac ‘lmeasure ({x1} UNION {x2}) = 0’ \\
2058 Cases_on ‘x1 = x2’
2059 >- (POP_ORW \\
2060 ‘{x2} UNION {x2} = {x2}’ by SET_TAC [] >> POP_ORW \\
2061 simp [lebesgue_sing]) \\
2062 Suff ‘lmeasure ({x1} UNION {x2}) = lmeasure ({x1}) + lmeasure ({x2})’
2063 >- (Rewr' >> simp [lebesgue_sing]) \\
2064 MATCH_MP_TAC MEASURE_ADDITIVE >> simp [measure_space_lebesgue] \\
2065 Suff ‘{x1} IN measurable_sets lborel /\
2066 {x2} IN measurable_sets lborel’
2067 >- PROVE_TAC [SUBSET_DEF, lborel_subset_lebesgue] \\
2068 simp [sets_lborel, borel_measurable_sets])
2069 (* applying ext_suminf_def *)
2070 >> qmatch_abbrev_tac ‘suminf g <= _’
2071 >> Know ‘suminf g = sup (IMAGE (\n. SIGMA g (count n)) UNIV)’
2072 >- (MATCH_MP_TAC ext_suminf_def \\
2073 rw [Abbr ‘g’] \\
2074 MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue])
2075 >> Rewr'
2076 (* applying sup_le', fixing ‘n’ *)
2077 >> rw [sup_le', Abbr ‘g’]
2078 (* applying HENSTOCK_LEMMA_PART1 (Saks-Henstock Lemma 5.3 [2, p.76]) *)
2079 >> MP_TAC (Q.SPECL [‘f’, ‘c’, ‘c + 1’, ‘d’, ‘e’] HENSTOCK_LEMMA_PART1)
2080 >> RW_TAC real_ss [] (* all antecedents are eliminated *)
2081 (* applying lebesgue_closed_interval_content, eliminating “lmeasure” *)
2082 >> Know ‘lmeasure o J = Normal o content o J’
2083 >- (rw [o_DEF, FUN_EQ_THM] \\
2084 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2085 rename1 ‘!i. J i = interval [a i,b i]’ \\
2086 REWRITE_TAC [lebesgue_closed_interval_content])
2087 >> Rewr'
2088 (* next, eliminating extreals! *)
2089 >> Know ‘SIGMA (Normal o content o J) (count n) =
2090 Normal (SIGMA (content o J) (count n))’
2091 >- (simp [o_DEF] \\
2092 HO_MATCH_MP_TAC EXTREAL_SUM_IMAGE_NORMAL >> simp [])
2093 >> Rewr'
2094 >> simp [extreal_add_eq]
2095 (* rewrite SIGMA to sum (iterateTheory) *)
2096 >> Know ‘SIGMA (content o J) (count n) = sum (count n) (content o J)’
2097 >- (MATCH_MP_TAC REAL_SUM_IMAGE_sum >> simp [])
2098 >> Rewr'
2099 (* stage work *)
2100 >> qabbrev_tac ‘p = IMAGE (\i. (t i,J i)) (count n)’
2101 >> Q.PAT_X_ASSUM ‘!p. p tagged_partial_division_of s /\ d FINE p ==> _’
2102 (MP_TAC o Q.SPEC ‘p’)
2103 >> impl_tac
2104 >- (rw [Abbr ‘p’, tagged_partial_division_of, FINE] >| (* 5 subgoals *)
2105 [ (* goal 1 (of 5) *)
2106 FULL_SIMP_TAC std_ss [IN_INTER],
2107 (* goal 2 (of 5) *)
2108 ASM_REWRITE_TAC [],
2109 (* goal 3 (of 5) *)
2110 fs [closed_interval_def],
2111 (* goal 4 (of 5) *)
2112 rename1 ‘j < n’ \\
2113 Cases_on ‘i = j’ >- METIS_TAC [] \\
2114 Q.PAT_X_ASSUM ‘!i j. i <> j ==> _’ drule \\
2115 rw [nonoverlapping_def, DISJOINT_DEF],
2116 (* goal 5 (of 5) *)
2117 ASM_REWRITE_TAC [] ])
2118 (* applying real_sigmaTheory.SUM_SUB' *)
2119 >> Know ‘(\(x,k). content k * f x - integral k f) =
2120 (\z. content (SND z) * f (FST z) - integral (SND z) f)’
2121 >- (rw [FUN_EQ_THM] \\
2122 PairCases_on ‘z’ >> simp [])
2123 >> Rewr'
2124 >> Know ‘sum p (\z. content (SND z) * f (FST z) - integral (SND z) f) =
2125 sum p (\z. content (SND z) * f (FST z)) -
2126 sum p (\z. integral (SND z) f)’
2127 >- (HO_MATCH_MP_TAC SUM_SUB' >> simp [Abbr ‘p’])
2128 >> Rewr'
2129 >> Know ‘(\z. content (SND z) * f (FST z)) = (\(x,k). content k * f x)’
2130 >- (rw [FUN_EQ_THM] \\
2131 PairCases_on ‘z’ >> simp [])
2132 >> Rewr'
2133 >> Know ‘(\(z :real # real set). integral (SND z) f) =
2134 (\((x :real),k). integral k f)’
2135 >- (rw [FUN_EQ_THM] \\
2136 PairCases_on ‘z’ >> simp [])
2137 >> Rewr'
2138 (* applying SUM_IMAGE *)
2139 >> qabbrev_tac ‘h = (\i. (t i,J i))’
2140 >> qmatch_abbrev_tac ‘abs (sum p g1 - sum p g2) <= e ==> _’
2141 >> simp [Abbr ‘p’]
2142 (* ‘N’ is the trivial set of indexes with zero contents *)
2143 >> qabbrev_tac ‘N = {i | i < n /\ ?x. J i = interval [x,x]}’
2144 >> qabbrev_tac ‘M = count n DIFF N’
2145 >> Know ‘!i j. i IN M /\ j IN M /\ J i = J j ==> i = j’
2146 >- (rw [Abbr ‘N’, Abbr ‘M’] \\
2147 CCONTR_TAC \\
2148 Q.PAT_X_ASSUM ‘!i j. i <> j ==> nonoverlapping (J i) (J j)’ drule \\
2149 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2150 rename1 ‘!i. J i = interval [a i,b i]’ \\
2151 rw [nonoverlapping_def, INTERIOR_INTERVAL] \\
2152 simp [INTERVAL_NE_EMPTY] \\
2153 CCONTR_TAC >> fs [REAL_NOT_LT] \\
2154 ‘b j = a j \/ b j < (a j) :real’ by METIS_TAC [REAL_LE_LT]
2155 >- METIS_TAC [] \\
2156 Suff ‘J i = {}’ >- METIS_TAC [NOT_IN_EMPTY] \\
2157 simp [GSYM INTERVAL_EQ_EMPTY])
2158 >> DISCH_TAC
2159 >> ‘N SUBSET count n’ by rw [SUBSET_DEF, Abbr ‘N’]
2160 >> Know ‘!i. i IN N ==> content (J i) = 0’
2161 >- (rw [Abbr ‘N’] >> fs [CONTENT_CLOSED_INTERVAL])
2162 >> DISCH_TAC
2163 >> Know ‘!i. i IN N ==> integral (J i) f = 0’
2164 >- (rw [Abbr ‘N’] >> simp [INTEGRAL_REFL])
2165 >> DISCH_TAC
2166 >> ‘DISJOINT N M /\ count n = N UNION M’ by ASM_SET_TAC [] >> POP_ORW
2167 >> Know ‘FINITE N’
2168 >- (irule SUBSET_FINITE >> Q.EXISTS_TAC ‘count n’ >> simp [FINITE_COUNT])
2169 >> DISCH_TAC
2170 >> Know ‘FINITE M’
2171 >- (irule SUBSET_FINITE >> Q.EXISTS_TAC ‘count n’ >> simp [FINITE_COUNT] \\
2172 rw [SUBSET_DEF, Abbr ‘M’])
2173 >> DISCH_TAC
2174 >> REWRITE_TAC [IMAGE_UNION]
2175 >> Know ‘DISJOINT (IMAGE h N) (IMAGE h M)’
2176 >- (rw [DISJOINT_ALT, Abbr ‘M’, Abbr ‘h’, Abbr ‘N’] \\
2177 rename1 ‘t j = t i’ >> simp [] \\
2178 STRONG_DISJ_TAC >> art [] \\
2179 rename1 ‘J i = interval [x,x]’ \\
2180 Q.EXISTS_TAC ‘x’ >> REFL_TAC)
2181 >> DISCH_TAC
2182 >> Know ‘sum (IMAGE h N UNION IMAGE h M) g1 =
2183 sum (IMAGE h N) g1 + sum (IMAGE h M) g1’
2184 >- (MATCH_MP_TAC SUM_UNION >> simp [IMAGE_FINITE])
2185 >> Rewr'
2186 >> Know ‘sum (IMAGE h N UNION IMAGE h M) g2 =
2187 sum (IMAGE h N) g2 + sum (IMAGE h M) g2’
2188 >- (MATCH_MP_TAC SUM_UNION >> simp [IMAGE_FINITE])
2189 >> Rewr'
2190 >> Know ‘sum (N UNION M) (content o J) =
2191 sum N (content o J) + sum M (content o J)’
2192 >- (MATCH_MP_TAC SUM_UNION >> simp [])
2193 >> Rewr'
2194 (* applying SUM_EQ_0' *)
2195 >> Know ‘sum (IMAGE h N) g1 = 0’
2196 >- (MATCH_MP_TAC SUM_EQ_0' \\
2197 rw [Abbr ‘h’, Abbr ‘g1’] >> simp [])
2198 >> DISCH_THEN (simp o wrap)
2199 >> Know ‘sum (IMAGE h N) g2 = 0’
2200 >- (MATCH_MP_TAC SUM_EQ_0' \\
2201 rw [Abbr ‘h’, Abbr ‘g2’] >> simp [])
2202 >> DISCH_THEN (simp o wrap)
2203 >> Know ‘sum N (content o J) = 0’
2204 >- (MATCH_MP_TAC SUM_EQ_0' >> rw [o_DEF])
2205 >> DISCH_THEN (simp o wrap)
2206 >> Know ‘sum (IMAGE h M) g1 = sum M (g1 o h)’
2207 >- (MATCH_MP_TAC SUM_IMAGE >> rw [Abbr ‘h’])
2208 >> Rewr'
2209 >> Know ‘sum (IMAGE h M) g2 = sum M (g2 o h)’
2210 >- (MATCH_MP_TAC SUM_IMAGE >> rw [Abbr ‘h’])
2211 >> Rewr'
2212 >> simp [o_DEF, Abbr ‘h’, Abbr ‘g1’, Abbr ‘g2’]
2213 >> Know ‘sum M (\i. f (t i) * content (J i)) =
2214 sum M (\x. content (J x))’
2215 >- (MATCH_MP_TAC SUM_EQ' \\
2216 Q.X_GEN_TAC ‘j’ >> rw [Abbr ‘f’] \\
2217 DISJ2_TAC \\
2218 Q.PAT_X_ASSUM ‘!i. t i IN E INTER J i’ (MP_TAC o Q.SPEC ‘j’) \\
2219 rw [indicator])
2220 >> Rewr'
2221 (* eliminating “abs” by ABS_REFL, etc. *)
2222 >> Know ‘abs (sum M (\x. content (J x)) - sum M (\i. integral (J i) f)) =
2223 sum M (\x. content (J x)) - sum M (\i. integral (J i) f)’
2224 >- (simp [ABS_REFL, REAL_SUB_LE] \\
2225 MATCH_MP_TAC SUM_LE' >> art [] \\
2226 Q.X_GEN_TAC ‘j’ >> rw [] \\
2227 Know ‘content (J j) = integral (J j) (\x. 1)’
2228 >- (fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2229 rename1 ‘!i. J i = interval [a i,b i]’ \\
2230 simp [INTEGRAL_CONST]) >> Rewr' \\
2231 MATCH_MP_TAC INTEGRAL_LE_AE \\
2232 Q.EXISTS_TAC ‘{}’ \\
2233 simp [Abbr ‘f’, NEGLIGIBLE_EMPTY, DROP_INDICATOR_LE_1] \\
2234 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2235 rename1 ‘!i. J i = interval [a i,b i]’ \\
2236 simp [INTEGRABLE_CONST] \\
2237 MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
2238 Q.EXISTS_TAC ‘s’ >> art [] \\
2239 Q.PAT_X_ASSUM ‘!i. J i = interval [a i,b i]’ (simp o wrap o GSYM))
2240 >> Rewr'
2241 >> simp [REAL_ARITH “a - b <= c <=> a <= b + (c :real)”]
2242 >> DISCH_TAC
2243 >> Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘sum M (\i. integral (J i) f) + e’
2244 >> POP_ASSUM (simp o wrap)
2245 >> qunabbrev_tac ‘y’
2246 (* applying SUM_IMAGE again *)
2247 >> ‘(\i. integral (J i) f) = (\s. integral s f) o J’ by rw [FUN_EQ_THM, o_DEF]
2248 >> POP_ORW
2249 >> qabbrev_tac ‘g = \(s :real set). integral s f’
2250 >> Know ‘sum M (g o J) = sum (IMAGE J M) g’
2251 >- (SYM_TAC >> MATCH_MP_TAC SUM_IMAGE >> art [])
2252 >> Rewr'
2253 (* applying INTEGRAL_BIGUNION *)
2254 >> MP_TAC (Q.SPECL [‘f’, ‘IMAGE J (M :num set)’] INTEGRAL_BIGUNION)
2255 >> ASM_SIMP_TAC std_ss [FINITE_IMAGE]
2256 >> impl_tac
2257 >- (RW_TAC std_ss [IN_IMAGE] (* 2 subgoals, first one is easy *)
2258 >- (rename1 ‘j IN M’ \\
2259 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2260 rename1 ‘!i. J i = interval [a i,b i]’ \\
2261 MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
2262 Q.EXISTS_TAC ‘s’ >> art [] \\
2263 Q.PAT_X_ASSUM ‘!i. J i = interval [a i,b i]’ (simp o wrap o GSYM)) \\
2264 rename1 ‘J j <> J k’ \\
2265 (* applying NEGLIGIBLE_SING or NEGLIGIBLE_EMPTY *)
2266 ‘j <> k’ by PROVE_TAC [] \\
2267 Q.PAT_X_ASSUM ‘!i j. i <> j ==> nonoverlapping (J i) (J j)’ drule \\
2268 fs [closed_interval_def, GSYM RIGHT_EXISTS_IMP_THM, SKOLEM_THM] \\
2269 rename1 ‘!i. J i = interval [a i,b i]’ \\
2270 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
2271 simp [DISJOINT_DEF, DISJOINT_INTERVAL] \\
2272 Know ‘interval [a j,b j] <> {} /\
2273 interval [a k,b k] <> {}’ >- METIS_TAC [NOT_IN_EMPTY] \\
2274 simp [INTERVAL_NE_EMPTY] >> STRIP_TAC \\
2275 STRIP_TAC >| (* 4 subgoals *)
2276 [ (* goal 1 (of 4) *)
2277 ‘a j = b j’ by PROVE_TAC [REAL_LE_ANTISYM] \\
2278 simp [INTERVAL_SING] \\
2279 qmatch_abbrev_tac ‘negligible ({x} INTER A)’ \\
2280 Suff ‘{x} INTER A = {} \/ {x} INTER A = {x}’
2281 >- METIS_TAC [NEGLIGIBLE_SING, NEGLIGIBLE_EMPTY] \\
2282 SET_TAC [],
2283 (* goal 2 (of 4) *)
2284 ‘a k = b k’ by PROVE_TAC [REAL_LE_ANTISYM] \\
2285 simp [INTERVAL_SING] \\
2286 qmatch_abbrev_tac ‘negligible (A INTER {x})’ \\
2287 Suff ‘A INTER {x} = {} \/ A INTER {x} = {x}’
2288 >- METIS_TAC [NEGLIGIBLE_SING, NEGLIGIBLE_EMPTY] \\
2289 SET_TAC [],
2290 (* goal 3 (of 4): [a j, b j] <= [a k, b k] *)
2291 ‘b j = a k \/ b j < a k’ by PROVE_TAC [REAL_LE_LT]
2292 >- (simp [INTER_INTERVAL] \\
2293 ‘a j <= a k’ by PROVE_TAC [REAL_LE_TRANS] \\
2294 simp [REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
2295 simp [INTERVAL_SING, NEGLIGIBLE_SING]) \\
2296 ‘a j < a k’ by PROVE_TAC [REAL_LET_TRANS] \\
2297 ‘b j < b k’ by PROVE_TAC [REAL_LTE_TRANS] \\
2298 simp [INTER_INTERVAL, REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
2299 ‘interval [a k,b j] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
2300 simp [NEGLIGIBLE_EMPTY],
2301 (* goal 4 (of 4): [a k, b k] <= [a j, b j] *)
2302 ‘b k = a j \/ b k < a j’ by PROVE_TAC [REAL_LE_LT]
2303 >- (simp [INTER_INTERVAL] \\
2304 ‘a k <= a j’ by PROVE_TAC [REAL_LE_TRANS] \\
2305 simp [REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
2306 simp [INTERVAL_SING, NEGLIGIBLE_SING]) \\
2307 ‘a k < a j’ by PROVE_TAC [REAL_LET_TRANS] \\
2308 ‘b k < b j’ by PROVE_TAC [REAL_LTE_TRANS] \\
2309 simp [INTER_INTERVAL, REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
2310 ‘interval [a j,b k] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
2311 simp [NEGLIGIBLE_EMPTY] ])
2312 >> STRIP_TAC
2313 >> POP_ASSUM (ONCE_REWRITE_TAC o wrap o SYM)
2314 >> simp [Abbr ‘g’]
2315 >> MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE
2316 >> simp [Abbr ‘f’, INDICATOR_POS]
2317 >> rw [BIGUNION_SUBSET] >> art []
2318QED
2319
2320(* NOTE: removed ‘E <> {}’ (E = {} is a trivial case) for easier applications *)
2321Theorem approximation_lemma1'[local] :
2322 !E c e. E IN measurable_sets lebesgue /\ 0 < e /\
2323 E SUBSET interval [c,c + 1] ==>
2324 ?J. (!i. J i SUBSET interval [(c,c + 1)]) /\
2325 (!i. closed_interval (J i)) /\
2326 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
2327 E SUBSET BIGUNION (IMAGE J UNIV) /\
2328 lmeasure E <= suminf (lmeasure o J) /\
2329 suminf (lmeasure o J) <= lmeasure E + Normal e
2330Proof
2331 rpt STRIP_TAC
2332 >> reverse (Cases_on ‘E = {}’)
2333 >- (MATCH_MP_TAC approximation_lemma1 >> art [])
2334 >> POP_ASSUM (fn th => fs [th, lebesgue_empty])
2335 >> qabbrev_tac ‘d = min 1 e’
2336 >> ‘0 < d’ by simp [REAL_LT_MIN, Abbr ‘d’]
2337 >> qabbrev_tac ‘J = \(i :num). if i = 0 then interval [c,c + d]
2338 else interval [c,c]’
2339 >> ‘J 0 = interval [c,c + d]’ by simp [Abbr ‘J’]
2340 >> ‘!i. i <> 0 ==> J i = interval [c,c]’ by rw [Abbr ‘J’]
2341 >> Q.EXISTS_TAC ‘J’
2342 >> CONJ_TAC
2343 >- (reverse (rw [Abbr ‘J’])
2344 >- (rw [INTERVAL_SING, SUBSET_DEF] \\
2345 simp [IN_INTERVAL]) \\
2346 simp [closed_interval_subset_eq] \\
2347 simp [Abbr ‘d’, REAL_MIN_LE])
2348 >> CONJ_TAC
2349 >- (rw [closed_interval_def] \\
2350 Cases_on ‘i = 0’ >> simp [] >| (* 2 subgoals *)
2351 [ qexistsl_tac [‘c’, ‘c + d’] >> REFL_TAC,
2352 qexistsl_tac [‘c’, ‘c’] >> REFL_TAC ])
2353 >> CONJ_TAC
2354 >- (rw [nonoverlapping_def] \\
2355 Cases_on ‘i = 0’ >> simp [INTERIOR_INTERVAL] >> simp [INTERVAL_SING])
2356 (* applying ext_suminf_sum *)
2357 >> ‘!i. i <> 0 ==> lmeasure (J i) = 0’
2358 by rw [lebesgue_closed_interval, REAL_LT_IMP_LE, normal_0]
2359 >> qabbrev_tac ‘f = lmeasure o J’
2360 >> Know ‘suminf f = SIGMA f (count 1)’
2361 >- (MATCH_MP_TAC ext_suminf_sum \\
2362 reverse CONJ_TAC >- rw [Abbr ‘f’] \\
2363 RW_TAC std_ss [Abbr ‘f’, o_DEF] \\
2364 MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue] \\
2365 Suff ‘J n IN measurable_sets lborel’
2366 >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue] \\
2367 REWRITE_TAC [sets_lborel] \\
2368 Cases_on ‘n = 0’ >> simp [CLOSED_interval, borel_measurable_sets])
2369 >> Rewr'
2370 >> simp [Abbr ‘f’, EXTREAL_SUM_IMAGE_COUNT_ONE, REAL_LT_IMP_LE,
2371 lebesgue_closed_interval, REAL_ADD_SUB]
2372 >> simp [Abbr ‘d’, REAL_MIN_LE]
2373QED
2374
2375Theorem lebesgue_additive :
2376 !s t. s IN measurable_sets lebesgue /\
2377 t IN measurable_sets lebesgue /\ negligible (s INTER t) ==>
2378 lmeasure (s UNION t) = lmeasure s + lmeasure t
2379Proof
2380 rpt STRIP_TAC
2381 >> MP_TAC (ISPECL [“lebesgue”, “s :real set”, “t :real set”]
2382 MEASURE_SPACE_STRONG_ADDITIVE)
2383 >> simp [measure_space_lebesgue, lebesgue_of_negligible]
2384QED
2385
2386Theorem NEGLIGIBLE_COUNTABLE_BIGUNION' :
2387 !s. (!n. negligible (s n)) ==> negligible (BIGUNION (IMAGE s univ(:num)))
2388Proof
2389 rpt STRIP_TAC
2390 >> ‘IMAGE s UNIV = {s n | n IN UNIV}’ by rw [Once EXTENSION]
2391 >> POP_ORW
2392 >> MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_BIGUNION >> art []
2393QED
2394
2395Theorem lebesgue_countably_additive :
2396 !f s. f IN (univ(:num) -> measurable_sets lebesgue) /\
2397 (!i j. i <> j ==> negligible (f i INTER f j)) /\
2398 s = BIGUNION (IMAGE f univ(:num)) ==>
2399 suminf (lmeasure o f) = lmeasure s
2400Proof
2401 RW_TAC std_ss [IN_FUNSET, IN_UNIV]
2402 >> qmatch_abbrev_tac ‘_ = lmeasure s’
2403 (* NOTE: Now that each two (f n) are not disjoint, but can we modify them
2404 to make them disjoint while still keeping their existing measure?
2405 *)
2406 >> qabbrev_tac
2407 ‘g = \i. BIGUNION (IMAGE (\j. if j = i then {} else f i INTER f j) UNIV)’
2408 >> Know ‘!n. negligible (g n)’
2409 >- (rw [Abbr ‘g’] \\
2410 MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_BIGUNION' \\
2411 Q.X_GEN_TAC ‘i’ >> simp [] \\
2412 Cases_on ‘n = i’ >> simp [NEGLIGIBLE_EMPTY])
2413 >> DISCH_TAC
2414 >> ‘!n. g n IN measurable_sets lebesgue’ by PROVE_TAC [negligible_in_lebesgue]
2415 >> qabbrev_tac ‘h = \i. f i DIFF g i’
2416 >> Know ‘!n. h n IN measurable_sets lebesgue’
2417 >- (rw [Abbr ‘h’] \\
2418 MATCH_MP_TAC MEASURE_SPACE_DIFF \\
2419 simp [measure_space_lebesgue])
2420 >> DISCH_TAC
2421 >> Know ‘!n. lmeasure (h n) = lmeasure (f n)’
2422 >- (rw [Abbr ‘h’] \\
2423 MATCH_MP_TAC MEASURE_SUB_ABSORB \\
2424 simp [measure_space_lebesgue, lebesgue_of_negligible])
2425 >> DISCH_TAC
2426 >> ‘lmeasure o f = lmeasure o h’ by rw [FUN_EQ_THM, o_DEF] >> POP_ORW
2427 >> Know ‘!i j. i <> j ==> DISJOINT (h i) (h j)’
2428 >- (rw [DISJOINT_ALT, Abbr ‘h’] \\
2429 DISJ1_TAC \\
2430 POP_ASSUM MP_TAC \\
2431 rw [Abbr ‘g’, IN_BIGUNION_IMAGE] \\
2432 POP_ASSUM (MP_TAC o Q.SPEC ‘j’) >> simp [])
2433 >> DISCH_TAC
2434 (* applying MEASURE_COUNTABLY_ADDITIVE *)
2435 >> qabbrev_tac ‘t = BIGUNION (IMAGE h UNIV)’
2436 >> Know ‘t IN measurable_sets lebesgue’
2437 >- (qunabbrev_tac ‘t’ \\
2438 MATCH_MP_TAC MEASURE_SPACE_BIGUNION \\
2439 simp [measure_space_lebesgue])
2440 >> DISCH_TAC
2441 >> Know ‘suminf (lmeasure o h) = lmeasure t’
2442 >- (MATCH_MP_TAC MEASURE_COUNTABLY_ADDITIVE \\
2443 simp [IN_FUNSET, measure_space_lebesgue])
2444 >> Rewr'
2445 >> qabbrev_tac ‘N = BIGUNION (IMAGE g UNIV)’
2446 >> Know ‘N IN measurable_sets lebesgue’
2447 >- (qunabbrev_tac ‘N’ \\
2448 MATCH_MP_TAC MEASURE_SPACE_BIGUNION \\
2449 simp [measure_space_lebesgue])
2450 >> DISCH_TAC
2451 >> ‘negligible N’ by PROVE_TAC [NEGLIGIBLE_COUNTABLE_BIGUNION']
2452 >> Know ‘s = t UNION N’
2453 >- (rw [Once EXTENSION, Abbr ‘s’, IN_BIGUNION_IMAGE, Abbr ‘t’, Abbr ‘N’] \\
2454 EQ_TAC
2455 >- (DISCH_THEN (Q.X_CHOOSE_THEN ‘i’ STRIP_ASSUME_TAC) \\
2456 simp [Abbr ‘h’] \\
2457 Cases_on ‘?j. x IN g j’ >> simp [] \\
2458 fs [] \\
2459 Q.EXISTS_TAC ‘i’ >> simp []) \\
2460 simp [Abbr ‘h’] \\
2461 STRIP_TAC
2462 >- (rename1 ‘x IN f i’ \\
2463 Q.EXISTS_TAC ‘i’ >> simp []) \\
2464 rename1 ‘x IN g i’ \\
2465 POP_ASSUM MP_TAC >> rw [Abbr ‘g’, IN_BIGUNION_IMAGE] \\
2466 Cases_on ‘j = i’ >> fs [] \\
2467 Q.EXISTS_TAC ‘i’ >> simp [])
2468 >> Rewr'
2469 >> SYM_TAC
2470 >> MATCH_MP_TAC MEASURE_ADD_ABSORB
2471 >> simp [measure_space_lebesgue, lebesgue_of_negligible]
2472QED
2473
2474(* This is an intermediate result also as a proof of concept *)
2475Theorem approximation_lemma2[local] :
2476 !E e n. E IN measurable_sets lebesgue /\ 0 < e /\
2477 E SUBSET interval [-&SUC n,-&n] UNION interval [&n,&SUC n] ==>
2478 ?J. (!i. closed_interval (J i)) /\
2479 (!i. J i SUBSET interval [-&SUC n,-&n] UNION
2480 interval [&n,&SUC n]) /\
2481 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
2482 E SUBSET BIGUNION (IMAGE J UNIV) /\
2483 lmeasure E <= suminf (lmeasure o J) /\
2484 suminf (lmeasure o J) <= lmeasure E + Normal e
2485Proof
2486 rpt STRIP_TAC
2487 >> qabbrev_tac ‘A = interval [&n,&SUC n]’
2488 >> qabbrev_tac ‘B = interval [-&SUC n,-&n]’
2489 >> Know ‘A IN measurable_sets lebesgue /\ B IN measurable_sets lebesgue’
2490 >- (Suff ‘A IN measurable_sets lborel /\ B IN measurable_sets lborel’
2491 >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue] \\
2492 simp [Abbr ‘A’, Abbr ‘B’, CLOSED_interval,
2493 sets_lborel, borel_measurable_sets])
2494 >> STRIP_TAC
2495 (* applying approximation_lemma1 *)
2496 >> qabbrev_tac ‘E1 = E INTER A’
2497 >> qabbrev_tac ‘E2 = E INTER B’
2498 >> ‘E1 SUBSET A /\ E2 SUBSET B’ by simp [Abbr ‘E1’, Abbr ‘E2’]
2499 >> ‘E1 IN measurable_sets lebesgue /\ E2 IN measurable_sets lebesgue’
2500 by METIS_TAC [MEASURE_SPACE_INTER, measure_space_lebesgue]
2501 (* applying approximation_lemma1', twice *)
2502 >> MP_TAC (Q.SPECL [‘E1’, ‘&n’, ‘e / 2’] approximation_lemma1')
2503 >> simp [GSYM ADD1]
2504 >> DISCH_THEN (Q.X_CHOOSE_THEN ‘J1’ STRIP_ASSUME_TAC)
2505 >> MP_TAC (Q.SPECL [‘E2’, ‘-&SUC n’, ‘e / 2’] approximation_lemma1')
2506 >> Know ‘-&SUC n + 1 = (-&n) :real’
2507 >- (SIMP_TAC std_ss [ADD1, GSYM REAL_OF_NUM_ADD] \\
2508 REAL_ARITH_TAC)
2509 >> Rewr'
2510 >> simp []
2511 >> DISCH_THEN (Q.X_CHOOSE_THEN ‘J2’ STRIP_ASSUME_TAC)
2512 >> Know ‘negligible (A INTER B)’
2513 >- (simp [Abbr ‘A’, Abbr ‘B’, INTER_INTERVAL] \\
2514 simp [REAL_MAX_REDUCE, REAL_MIN_REDUCE] \\
2515 Cases_on ‘n = 0’ >- simp [INTERVAL_SING, NEGLIGIBLE_SING] \\
2516 ‘interval [&n,-&n] = {}’ by simp [GSYM INTERVAL_EQ_EMPTY] \\
2517 simp [NEGLIGIBLE_EMPTY])
2518 >> DISCH_TAC
2519 >> Know ‘negligible (E1 INTER E2)’
2520 >- (Suff ‘E1 INTER E2 SUBSET (A INTER B)’ >- METIS_TAC [NEGLIGIBLE_SUBSET] \\
2521 ASM_SET_TAC [])
2522 >> DISCH_TAC
2523 >> ‘E = E1 UNION E2’ by ASM_SET_TAC [] >> POP_ORW
2524 >> Know ‘lmeasure (E1 UNION E2) = lmeasure E1 + lmeasure E2’
2525 >- (MATCH_MP_TAC lebesgue_additive >> art [])
2526 >> Rewr'
2527 >> ‘Normal e = Normal (e / 2) + Normal (e / 2)’
2528 by simp [extreal_add_eq, REAL_HALF_DOUBLE] >> POP_ORW
2529 >> Know ‘lmeasure E1 + lmeasure E2 + (Normal (e / 2) + Normal (e / 2)) =
2530 lmeasure E1 + Normal (e / 2) + (lmeasure E2 + Normal (e / 2))’
2531 >- (MATCH_MP_TAC add2_assoc \\
2532 rpt CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 4 subgoals *)
2533 [ (* goal 1 (of 4) *)
2534 MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue],
2535 (* goal 2 (of 4) *)
2536 MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue],
2537 (* goal 3 (of 4) *)
2538 simp [extreal_of_num_def, REAL_LT_IMP_LE],
2539 (* goal 4 (of 4) *)
2540 simp [extreal_of_num_def, REAL_LT_IMP_LE] ])
2541 >> Rewr'
2542 (* NOTE: Now we need to merge two countable sequence into one. The "standard"
2543 way is to interleave them as ODD and EVEN elements:
2544 0 , 1 , 2 , 3 , ...
2545 J1(0), J2(0), J1(1), J2(1), ...
2546 *)
2547 >> qabbrev_tac ‘J = \i. if EVEN i then J1 (i DIV 2) else J2 ((i - 1) DIV 2)’
2548 >> Q.EXISTS_TAC ‘J’
2549 >> CONJ_TAC >- RW_TAC arith_ss [Abbr ‘J’]
2550 >> CONJ_TAC
2551 >- (rw [Abbr ‘J’, SUBSET_DEF] >| (* 2 subgoals *)
2552 [ (* goal 1 (of 2) *)
2553 rename1 ‘x IN J1 j’ >> DISJ2_TAC \\
2554 PROVE_TAC [SUBSET_DEF],
2555 (* goal 2 (of 2) *)
2556 rename1 ‘x IN J2 j’ >> DISJ1_TAC \\
2557 PROVE_TAC [SUBSET_DEF] ])
2558 >> Know ‘nonoverlapping A B’
2559 >- (simp [Abbr ‘A’, Abbr ‘B’, nonoverlapping_def, INTERIOR_INTERVAL] \\
2560 simp [DISJOINT_DEF, DISJOINT_INTERVAL])
2561 >> DISCH_TAC
2562 >> CONJ_TAC (* nonoverlapping *)
2563 >- (RW_TAC std_ss [Abbr ‘J’] >| (* 4 subgoals *)
2564 [ (* goal 1 (of 4) *)
2565 FIRST_X_ASSUM MATCH_MP_TAC >> fs [EVEN_EXISTS],
2566 (* goal 2 (of 4) *)
2567 MATCH_MP_TAC nonoverlapping_subset_inclusive \\
2568 qexistsl_tac [‘A’, ‘B’] >> art [],
2569 (* goal 3 (of 4) *)
2570 MATCH_MP_TAC nonoverlapping_subset_inclusive \\
2571 qexistsl_tac [‘B’, ‘A’] >> simp [Once nonoverlapping_comm],
2572 (* goal 4 (of 4) *)
2573 FIRST_X_ASSUM MATCH_MP_TAC >> fs [GSYM ODD_EVEN, ODD_EXISTS] ])
2574 (* E1 UNION E2 SUBSET _ *)
2575 >> CONJ_TAC
2576 >- (RW_TAC std_ss [IN_UNION, SUBSET_DEF, IN_BIGUNION_IMAGE, IN_UNIV] >|
2577 [ (* goal 1 (of 2) *)
2578 Know ‘x IN BIGUNION (IMAGE J1 UNIV)’ >- PROVE_TAC [SUBSET_DEF] \\
2579 rw [IN_BIGUNION_IMAGE, Abbr ‘J’] \\
2580 rename1 ‘x IN J1 (i :num)’ \\
2581 Q.EXISTS_TAC ‘2 * i’ >> simp [EVEN_DOUBLE],
2582 (* goal 2 (of 2) *)
2583 Know ‘x IN BIGUNION (IMAGE J2 UNIV)’ >- PROVE_TAC [SUBSET_DEF] \\
2584 rw [IN_BIGUNION_IMAGE, Abbr ‘J’] \\
2585 rename1 ‘x IN J2 (i :num)’ \\
2586 Q.EXISTS_TAC ‘SUC (2 * i)’ >> simp [EVEN_ODD, ODD_DOUBLE] ])
2587 (* applying le_add2, twice *)
2588 >> Suff ‘suminf (lmeasure o J) =
2589 suminf (lmeasure o J1) + suminf (lmeasure o J2)’
2590 >- (Rewr' \\
2591 CONJ_TAC >- (MATCH_MP_TAC le_add2 >> art []) \\
2592 MATCH_MP_TAC le_add2 >> art [])
2593 (* preparing for sup_add_mono *)
2594 >> qmatch_abbrev_tac ‘suminf h = suminf f + suminf g’
2595 >> Know ‘!i. 0 <= f i’
2596 >- (rw [Abbr ‘f’, o_DEF] \\
2597 MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue] \\
2598 Suff ‘J1 i IN measurable_sets lborel’
2599 >- PROVE_TAC [lborel_subset_lebesgue, SUBSET_DEF] \\
2600 Q.PAT_X_ASSUM ‘!i. closed_interval (J1 i)’ (MP_TAC o Q.SPEC ‘i’) \\
2601 rw [closed_interval_def, CLOSED_interval] \\
2602 simp [borel_measurable_sets, sets_lborel])
2603 >> DISCH_TAC
2604 >> Know ‘!i. 0 <= g i’
2605 >- (rw [Abbr ‘g’, o_DEF] \\
2606 MATCH_MP_TAC MEASURE_POSITIVE >> simp [measure_space_lebesgue] \\
2607 Suff ‘J2 i IN measurable_sets lborel’
2608 >- PROVE_TAC [lborel_subset_lebesgue, SUBSET_DEF] \\
2609 Q.PAT_X_ASSUM ‘!i. closed_interval (J2 i)’ (MP_TAC o Q.SPEC ‘i’) \\
2610 rw [closed_interval_def, CLOSED_interval] \\
2611 simp [borel_measurable_sets, sets_lborel])
2612 >> DISCH_TAC
2613 >> Know ‘!i. 0 <= h i’
2614 >- (rw [Abbr ‘h’, o_DEF, Abbr ‘J’] >| (* 2 subgoals *)
2615 [ (* goal 1 (of 2) *)
2616 qmatch_abbrev_tac ‘0 <= lmeasure (J1 j)’ \\
2617 Q.PAT_X_ASSUM ‘!i. 0 <= f i’ (MP_TAC o Q.SPEC ‘j’) \\
2618 rw [Abbr ‘f’, o_DEF],
2619 (* goal 2 (of 2) *)
2620 qmatch_abbrev_tac ‘0 <= lmeasure (J2 j)’ \\
2621 Q.PAT_X_ASSUM ‘!i. 0 <= g i’ (MP_TAC o Q.SPEC ‘j’) \\
2622 rw [Abbr ‘g’, o_DEF] ])
2623 >> DISCH_TAC
2624 >> simp [ext_suminf_def]
2625 (* applying sup_add_mono *)
2626 >> qmatch_abbrev_tac ‘sup (IMAGE h' UNIV) =
2627 sup (IMAGE f' UNIV) + sup (IMAGE g' UNIV)’
2628 >> Suff ‘sup (IMAGE h' UNIV) = sup (IMAGE (\i. f' i + g' i) UNIV)’
2629 >- (Rewr' >> MATCH_MP_TAC sup_add_mono \\
2630 Know ‘!i. 0 <= f' i’
2631 >- (rw [Abbr ‘f'’] \\
2632 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw []) >> DISCH_TAC \\
2633 Know ‘!i. 0 <= g' i’
2634 >- (rw [Abbr ‘g'’] \\
2635 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> rw []) >> DISCH_TAC \\
2636 simp [Abbr ‘f'’, Abbr ‘g'’] \\
2637 CONJ_TAC >> Q.X_GEN_TAC ‘i’ >| (* 2 subgoals *)
2638 [ (* goal 1 (of 2) *)
2639 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> rw [SUBSET_DEF],
2640 (* goal 2 (of 2) *)
2641 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> rw [SUBSET_DEF] ])
2642 (* final goal *)
2643 >> RW_TAC std_ss [GSYM le_antisym]
2644 >| [ (* goal 1 (of 2) *)
2645 MATCH_MP_TAC sup_le_sup_imp' \\
2646 Q.X_GEN_TAC ‘z’ >> simp [] \\
2647 DISCH_THEN (Q.X_CHOOSE_THEN ‘N’ STRIP_ASSUME_TAC) >> POP_ORW \\
2648 Suff ‘?i. h' N <= f' i + g' i’
2649 >- (STRIP_TAC \\
2650 Q.EXISTS_TAC ‘f' i + g' i’ >> art [] \\
2651 Q.EXISTS_TAC ‘i’ >> REFL_TAC) \\
2652 (* NOTE: The choice ‘N’ is more than enough (actually “N DIV 2” may just work) *)
2653 Q.EXISTS_TAC ‘N’ >> simp [Abbr ‘f'’, Abbr ‘g'’, Abbr ‘h'’] \\
2654 qabbrev_tac ‘s = {i | i < N /\ EVEN i}’ \\
2655 qabbrev_tac ‘t = {i | i < N /\ ODD i}’ \\
2656 Know ‘SIGMA h (count N) = SIGMA h (s UNION t)’
2657 >- (AP_TERM_TAC \\
2658 rw [Once EXTENSION, Abbr ‘s’, Abbr ‘t’] \\
2659 METIS_TAC [EVEN_ODD]) >> Rewr' \\
2660 ‘DISJOINT s t’ by rw [DISJOINT_ALT, Abbr ‘s’, Abbr ‘t’, EVEN_ODD] \\
2661 Know ‘FINITE s’
2662 >- (irule SUBSET_FINITE \\
2663 Q.EXISTS_TAC ‘count N’ >> simp [SUBSET_DEF, Abbr ‘s’]) >> DISCH_TAC \\
2664 Know ‘FINITE t’
2665 >- (irule SUBSET_FINITE \\
2666 Q.EXISTS_TAC ‘count N’ >> simp [SUBSET_DEF, Abbr ‘t’]) >> DISCH_TAC \\
2667 Know ‘SIGMA h (s UNION t) = SIGMA h s + SIGMA h t’
2668 >- (irule EXTREAL_SUM_IMAGE_DISJOINT_UNION >> simp [] \\
2669 DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
2670 MATCH_MP_TAC pos_not_neginf >> art []) >> Rewr' \\
2671 qabbrev_tac ‘s' = {i DIV 2 | i < N /\ EVEN i}’ \\
2672 ‘s' = IMAGE (\i. i DIV 2) s’ by rw [Once EXTENSION, Abbr ‘s'’, Abbr ‘s’] \\
2673 Know ‘SIGMA h s = SIGMA f s'’
2674 >- (POP_ORW >> qmatch_abbrev_tac ‘_ = SIGMA f (IMAGE f' s)’ \\
2675 Know ‘SIGMA f (IMAGE f' s) = SIGMA (f o f') s’
2676 >- (irule EXTREAL_SUM_IMAGE_IMAGE >> simp [] \\
2677 CONJ_TAC >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> STRIP_TAC \\
2678 MATCH_MP_TAC pos_not_neginf >> art []) \\
2679 rw [INJ_DEF, Abbr ‘s’, Abbr ‘f'’] >- (Q.EXISTS_TAC ‘i’ >> art []) \\
2680 rename1 ‘j < N’ >> gs [EVEN_EXISTS]) >> Rewr' \\
2681 irule EXTREAL_SUM_IMAGE_EQ >> simp [] \\
2682 reverse CONJ_TAC
2683 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
2684 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >> art []) \\
2685 Q.X_GEN_TAC ‘i’ >> rw [Abbr ‘s’, Abbr ‘h’, Abbr ‘f’, Abbr ‘f'’] \\
2686 simp [Abbr ‘J’]) >> Rewr' \\
2687 ‘FINITE s'’ by simp [IMAGE_FINITE] \\
2688 Q.PAT_X_ASSUM ‘s' = _’ K_TAC \\
2689 qabbrev_tac ‘t' = {(i - 1) DIV 2 | i < N /\ ODD i}’ \\
2690 ‘t' = IMAGE (\i. (i - 1) DIV 2) t’ by rw [Once EXTENSION, Abbr ‘t'’, Abbr ‘t’] \\
2691 Know ‘SIGMA h t = SIGMA g t'’
2692 >- (POP_ORW >> qmatch_abbrev_tac ‘_ = SIGMA g (IMAGE g' t)’ \\
2693 Know ‘SIGMA g (IMAGE g' t) = SIGMA (g o g') t’
2694 >- (irule EXTREAL_SUM_IMAGE_IMAGE >> simp [] \\
2695 CONJ_TAC
2696 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> STRIP_TAC \\
2697 MATCH_MP_TAC pos_not_neginf >> art []) \\
2698 rw [INJ_DEF, Abbr ‘t’, Abbr ‘g'’] >- (Q.EXISTS_TAC ‘i’ >> art []) \\
2699 rename1 ‘j < N’ >> gs [ODD_EXISTS]) >> Rewr' \\
2700 irule EXTREAL_SUM_IMAGE_EQ >> simp [] \\
2701 reverse CONJ_TAC
2702 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
2703 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >> art []) \\
2704 Q.X_GEN_TAC ‘i’ >> rw [Abbr ‘t’, Abbr ‘h’, Abbr ‘g’, Abbr ‘g'’] \\
2705 fs [ODD_EVEN] \\
2706 simp [Abbr ‘J’]) >> Rewr' \\
2707 ‘FINITE t'’ by simp [IMAGE_FINITE] \\
2708 Q.PAT_X_ASSUM ‘t' = _’ K_TAC \\
2709 MATCH_MP_TAC le_add2 >> CONJ_TAC >| (* 2 subgoals *)
2710 [ (* goal 1.1 (of 2) *)
2711 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> simp [] \\
2712 rw [SUBSET_DEF, Abbr ‘s'’] \\
2713 Q_TAC (TRANS_TAC LESS_EQ_LESS_TRANS) ‘i’ >> art [] \\
2714 MATCH_MP_TAC DIV_LESS_EQ >> simp [],
2715 (* goal 1.2 (of 2) *)
2716 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> simp [] \\
2717 rw [SUBSET_DEF, Abbr ‘t'’] \\
2718 Q_TAC (TRANS_TAC LESS_EQ_LESS_TRANS) ‘i’ >> art [] \\
2719 Q_TAC (TRANS_TAC LESS_EQ_TRANS) ‘i - 1’ >> simp [] \\
2720 MATCH_MP_TAC DIV_LESS_EQ >> simp [] ],
2721 (* goal 2 (of 2) *)
2722 MATCH_MP_TAC sup_le_sup_imp' \\
2723 Q.X_GEN_TAC ‘z’ >> simp [] \\
2724 DISCH_THEN (Q.X_CHOOSE_THEN ‘N’ STRIP_ASSUME_TAC) >> POP_ORW \\
2725 Suff ‘?i. f' N + g' N <= h' i’
2726 >- (STRIP_TAC \\
2727 Q.EXISTS_TAC ‘h' i’ >> art [] \\
2728 Q.EXISTS_TAC ‘i’ >> REFL_TAC) \\
2729 (* NOTE: The choice ‘N’ here is just enough *)
2730 Q.EXISTS_TAC ‘2 * N’ >> simp [Abbr ‘f'’, Abbr ‘g'’, Abbr ‘h'’] \\
2731 qabbrev_tac ‘s = {i | i < 2 * N /\ EVEN i}’ \\
2732 qabbrev_tac ‘t = {i | i < 2 * N /\ ODD i}’ \\
2733 Know ‘SIGMA h (count (2 * N)) = SIGMA h (s UNION t)’
2734 >- (AP_TERM_TAC \\
2735 rw [Once EXTENSION, Abbr ‘s’, Abbr ‘t’] \\
2736 METIS_TAC [EVEN_ODD]) >> Rewr' \\
2737 ‘DISJOINT s t’ by rw [DISJOINT_ALT, Abbr ‘s’, Abbr ‘t’, EVEN_ODD] \\
2738 Know ‘FINITE s’
2739 >- (irule SUBSET_FINITE \\
2740 Q.EXISTS_TAC ‘count (2 * N)’ >> simp [SUBSET_DEF, Abbr ‘s’]) \\
2741 DISCH_TAC \\
2742 Know ‘FINITE t’
2743 >- (irule SUBSET_FINITE \\
2744 Q.EXISTS_TAC ‘count (2 * N)’ >> simp [SUBSET_DEF, Abbr ‘t’]) \\
2745 DISCH_TAC \\
2746 Know ‘SIGMA h (s UNION t) = SIGMA h s + SIGMA h t’
2747 >- (irule EXTREAL_SUM_IMAGE_DISJOINT_UNION >> simp [] \\
2748 DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
2749 MATCH_MP_TAC pos_not_neginf >> art []) >> Rewr' \\
2750 qabbrev_tac ‘s' = {i DIV 2 | i < 2 * N /\ EVEN i}’ \\
2751 ‘s' = IMAGE (\i. i DIV 2) s’ by rw [Once EXTENSION, Abbr ‘s'’, Abbr ‘s’] \\
2752 Know ‘SIGMA h s = SIGMA f s'’
2753 >- (POP_ORW >> qmatch_abbrev_tac ‘_ = SIGMA f (IMAGE f' s)’ \\
2754 Know ‘SIGMA f (IMAGE f' s) = SIGMA (f o f') s’
2755 >- (irule EXTREAL_SUM_IMAGE_IMAGE >> simp [] \\
2756 CONJ_TAC
2757 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> STRIP_TAC \\
2758 MATCH_MP_TAC pos_not_neginf >> art []) \\
2759 rw [INJ_DEF, Abbr ‘s’, Abbr ‘f'’]
2760 >- (Q.EXISTS_TAC ‘i’ >> art []) \\
2761 rename1 ‘j < 2 * N’ \\
2762 gs [EVEN_EXISTS]) >> Rewr' \\
2763 irule EXTREAL_SUM_IMAGE_EQ >> simp [] \\
2764 reverse CONJ_TAC
2765 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
2766 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >> art []) \\
2767 Q.X_GEN_TAC ‘i’ >> rw [Abbr ‘s’, Abbr ‘h’, Abbr ‘f’, Abbr ‘f'’] \\
2768 simp [Abbr ‘J’]) >> Rewr' \\
2769 ‘FINITE s'’ by simp [IMAGE_FINITE] \\
2770 Q.PAT_X_ASSUM ‘s' = _’ K_TAC \\
2771 qabbrev_tac ‘t' = {(i - 1) DIV 2 | i < 2 * N /\ ODD i}’ \\
2772 ‘t' = IMAGE (\i. (i - 1) DIV 2) t’
2773 by rw [Once EXTENSION, Abbr ‘t'’, Abbr ‘t’] \\
2774 Know ‘SIGMA h t = SIGMA g t'’
2775 >- (POP_ORW >> qmatch_abbrev_tac ‘_ = SIGMA g (IMAGE g' t)’ \\
2776 Know ‘SIGMA g (IMAGE g' t) = SIGMA (g o g') t’
2777 >- (irule EXTREAL_SUM_IMAGE_IMAGE >> simp [] \\
2778 CONJ_TAC >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> STRIP_TAC \\
2779 MATCH_MP_TAC pos_not_neginf >> art []) \\
2780 rw [INJ_DEF, Abbr ‘t’, Abbr ‘g'’]
2781 >- (Q.EXISTS_TAC ‘i’ >> art []) \\
2782 rename1 ‘j < 2 * N’ \\
2783 gs [ODD_EXISTS]) >> Rewr' \\
2784 irule EXTREAL_SUM_IMAGE_EQ >> simp [] \\
2785 reverse CONJ_TAC
2786 >- (DISJ1_TAC >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
2787 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >> art []) \\
2788 Q.X_GEN_TAC ‘i’ >> rw [Abbr ‘t’, Abbr ‘h’, Abbr ‘g’, Abbr ‘g'’] \\
2789 fs [ODD_EVEN] >> simp [Abbr ‘J’]) >> Rewr' \\
2790 ‘FINITE t'’ by simp [IMAGE_FINITE] \\
2791 Q.PAT_X_ASSUM ‘t' = _’ K_TAC \\
2792 MATCH_MP_TAC le_add2 >> CONJ_TAC >| (* 2 subgoals *)
2793 [ (* goal 1.1 (of 2) *)
2794 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> simp [] \\
2795 rw [SUBSET_DEF, Abbr ‘s'’] >> rename1 ‘j < N’ \\
2796 Q.EXISTS_TAC ‘2 * j’ >> simp [EVEN_DOUBLE],
2797 (* goal 1.2 (of 2) *)
2798 MATCH_MP_TAC EXTREAL_SUM_IMAGE_MONO_SET >> simp [] \\
2799 rw [SUBSET_DEF, Abbr ‘t'’] >> rename1 ‘j < N’ \\
2800 Q.EXISTS_TAC ‘SUC (2 * j)’ >> simp [ODD_DOUBLE] ] ]
2801QED
2802
2803Theorem UNIT_INTERVAL_PARTITION' :
2804 univ(:real) = BIGUNION (IMAGE (\n. interval [-&SUC n,-&n] UNION
2805 interval [&n,&SUC n]) univ(:num))
2806Proof
2807 qabbrev_tac ‘A = \n. interval [-&SUC n,-&n]’
2808 >> qabbrev_tac ‘B = \n. interval [&n,&SUC n]’
2809 >> simp []
2810 >> rw [Once EXTENSION, IN_BIGUNION_IMAGE]
2811 >> Cases_on ‘0 <= x’
2812 >- (MP_TAC (Q.SPEC ‘x’ SIMP_REAL_ARCH_SUC) >> rw [] \\
2813 Q.EXISTS_TAC ‘n’ >> DISJ2_TAC >> rw [Abbr ‘B’, IN_INTERVAL] \\
2814 MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
2815 >> fs [REAL_NOT_LE]
2816 >> ‘x <= 0’ by simp [REAL_LT_IMP_LE]
2817 >> ‘0 <= -x’ by simp []
2818 >> MP_TAC (Q.SPEC ‘-x’ SIMP_REAL_ARCH_SUC) >> rw []
2819 >> Q.EXISTS_TAC ‘n’ >> DISJ1_TAC
2820 >> rw [Abbr ‘A’, IN_INTERVAL] (* 2 subgoals, same tactic *)
2821 >> REAL_ASM_ARITH_TAC
2822QED
2823
2824(* 18.16 Approximation Theorem [2, p.312]
2825
2826 NOTE: It's a stronger result than textbook for all Lebesgue measurable sets.
2827 *)
2828Theorem approximation_thm :
2829 !E e. E IN measurable_sets lebesgue /\ 0 < e ==>
2830 ?J. (!i. closed_interval (J i)) /\
2831 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
2832 E SUBSET BIGUNION (IMAGE J UNIV) /\
2833 lmeasure E <= suminf (lmeasure o J) /\
2834 suminf (lmeasure o J) <= lmeasure E + Normal e
2835Proof
2836 rpt STRIP_TAC
2837 >> qabbrev_tac ‘A = \n. interval [-&SUC n,-&n]’
2838 >> qabbrev_tac ‘B = \n. interval [&n,&SUC n]’
2839 >> Know ‘!n. closed_interval (A n)’
2840 >- (rw [closed_interval_def, Abbr ‘A’] \\
2841 qexistsl_tac [‘-&SUC n’, ‘-&n’] >> REFL_TAC)
2842 >> DISCH_TAC
2843 >> Know ‘!n. closed_interval (B n)’
2844 >- (rw [closed_interval_def, Abbr ‘B’] \\
2845 qexistsl_tac [‘&n’, ‘&SUC n’] >> REFL_TAC)
2846 >> DISCH_TAC
2847 >> Know ‘!i j. i <> j ==> nonoverlapping (A i) (A j)’
2848 >- (rw [Abbr ‘A’] \\
2849 simp [closed_interval_nonoverlapping])
2850 >> DISCH_TAC
2851 >> Know ‘!i j. i <> j ==> nonoverlapping (B i) (B j)’
2852 >- (rw [Abbr ‘B’] \\
2853 simp [closed_interval_nonoverlapping])
2854 >> DISCH_TAC
2855 >> Know ‘!i j. (A i UNION B i) INTER (A j UNION B j) =
2856 (A i INTER A j) UNION (B i INTER B j)’
2857 >- (rpt GEN_TAC \\
2858 Cases_on ‘i = j’ >- simp [] \\
2859 rw [Once EXTENSION] \\
2860 EQ_TAC >> rw [] >> simp [] >| (* only 2 subgoals left *)
2861 [ (* goal 1 (of 2) *)
2862 Suff ‘F’ >- simp [] \\
2863 NTAC 3 (POP_ASSUM MP_TAC) >> simp [Abbr ‘A’, Abbr ‘B’] \\
2864 KILL_TAC >> rw [IN_INTERVAL] \\
2865 CCONTR_TAC >> fs [] (* -&SUC i <= x <= -&i < &j <= x <= &SUC j *) \\
2866 ‘i < j \/ j < i’ by simp [] >| (* 2 subgoals *)
2867 [ (* goal 1.1 (of 2) *)
2868 ‘-&i <= (&i :real)’ by simp [] \\
2869 ‘&i < (&j :real)’ by simp [] \\
2870 ‘-&i < (&j :real)’ by PROVE_TAC [REAL_LET_TRANS] \\
2871 ‘x < &j’ by PROVE_TAC [REAL_LET_TRANS] \\
2872 METIS_TAC [REAL_LET_ANTISYM],
2873 (* goal 1.2 (of 2) *)
2874 ‘-&i < (&j :real)’ by simp [] \\
2875 ‘x < &j’ by PROVE_TAC [REAL_LET_TRANS] \\
2876 METIS_TAC [REAL_LET_ANTISYM] ],
2877 (* goal 2 (of 2) *)
2878 Suff ‘F’ >- simp [] \\
2879 NTAC 3 (POP_ASSUM MP_TAC) >> simp [Abbr ‘A’, Abbr ‘B’] \\
2880 KILL_TAC >> rw [IN_INTERVAL] \\
2881 CCONTR_TAC >> fs [] (* -&SUC j <= x <= -&j < &i <= x <= &SUC i *) \\
2882 ‘i < j \/ j < i’ by simp [] >| (* 2 subgoals *)
2883 [ (* goal 2.1 (of 2) *)
2884 ‘-&j < (&i :real)’ by simp [] \\
2885 ‘x < &i’ by PROVE_TAC [REAL_LET_TRANS] \\
2886 METIS_TAC [REAL_LET_ANTISYM],
2887 (* goal 2.2 (of 2) *)
2888 ‘-&j <= (&j :real)’ by simp [] \\
2889 ‘&j < (&i :real)’ by simp [] \\
2890 ‘-&j < (&i :real)’ by PROVE_TAC [REAL_LET_TRANS] \\
2891 ‘x < &i’ by PROVE_TAC [REAL_LET_TRANS] \\
2892 METIS_TAC [REAL_LET_ANTISYM] ] ])
2893 >> DISCH_TAC
2894 >> Know ‘!n. A n IN measurable_sets lebesgue /\
2895 B n IN measurable_sets lebesgue’
2896 >- (Q.X_GEN_TAC ‘n’ \\
2897 Suff ‘A n IN measurable_sets lborel /\ B n IN measurable_sets lborel’
2898 >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue] \\
2899 simp [Abbr ‘A’, Abbr ‘B’, CLOSED_interval, sets_lborel,
2900 borel_measurable_sets])
2901 >> DISCH_THEN (STRIP_ASSUME_TAC o SIMP_RULE std_ss [FORALL_AND_THM])
2902 (* decompose E *)
2903 >> Know ‘E = E INTER UNIV’ >- SET_TAC []
2904 >> ‘UNIV = BIGUNION (IMAGE (\n. A n UNION B n) UNIV)’
2905 by simp [UNIT_INTERVAL_PARTITION'] >> POP_ORW
2906 >> SIMP_TAC std_ss [BIGUNION_OVER_INTER_R]
2907 >> qmatch_abbrev_tac ‘E = BIGUNION (IMAGE s UNIV) ==> _’ (* this asserts “s” *)
2908 >> Rewr'
2909 >> Know ‘!n. s n IN measurable_sets lebesgue’
2910 >- (RW_TAC std_ss [Abbr ‘s’] \\
2911 MATCH_MP_TAC MEASURE_SPACE_INTER >> simp [measure_space_lebesgue] \\
2912 MATCH_MP_TAC MEASURE_SPACE_UNION >> simp [measure_space_lebesgue])
2913 >> DISCH_TAC
2914 >> Know ‘!n. (0 :real) < e * (1 / 2) pow (n + 1)’
2915 >- (Q.X_GEN_TAC ‘n’ \\
2916 MATCH_MP_TAC REAL_LT_MUL >> art [GSYM ADD1] \\
2917 MATCH_MP_TAC POW_POS_LT >> simp [])
2918 >> DISCH_TAC
2919 >> ‘!n. s n SUBSET A n UNION B n’ by rw [Abbr ‘s’]
2920 (* applying approximation_lemma2 *)
2921 >> Know ‘!n. ?J. (!i. closed_interval (J i)) /\
2922 (!i. J i SUBSET (A n UNION B n)) /\
2923 (!i j. i <> j ==> nonoverlapping (J i) (J j)) /\
2924 s n SUBSET BIGUNION (IMAGE J univ(:num)) /\
2925 lmeasure (s n) <= suminf (lmeasure o J) /\
2926 suminf (lmeasure o J) <=
2927 lmeasure (s n) + Normal (e * (1 / 2) pow (n + 1))’
2928 >- (Q.X_GEN_TAC ‘n’ \\
2929 MP_TAC (Q.SPECL [‘s (n :num)’, ‘e * (1 / 2) pow (n + 1)’, ‘n’]
2930 approximation_lemma2) >> simp [])
2931 >> SIMP_TAC std_ss [SKOLEM_THM, FORALL_AND_THM] (* this asserts f *)
2932 >> Know ‘!n. Normal (e * (1 / 2) pow (n + 1)) = Normal e * (1 / 2) pow (n + 1)’
2933 >- (RW_TAC std_ss [GSYM extreal_mul_eq] \\
2934 AP_TERM_TAC \\
2935 REWRITE_TAC [GSYM extreal_pow_def] \\
2936 simp [extreal_div_eq, extreal_of_num_def])
2937 >> Rewr'
2938 >> STRIP_TAC
2939 >> Know ‘!i j. i <> j ==> negligible (s i INTER s j)’
2940 >- (rpt STRIP_TAC \\
2941 MATCH_MP_TAC NEGLIGIBLE_SUBSET \\
2942 Q.EXISTS_TAC ‘(A i UNION B i) INTER (A j UNION B j)’ \\
2943 reverse CONJ_TAC >- (simp [Abbr ‘s’] >> SET_TAC []) \\
2944 simp [] \\
2945 MATCH_MP_TAC NEGLIGIBLE_UNION \\
2946 CONJ_TAC \\ (* 2 subgoals, same tactics *)
2947 MATCH_MP_TAC closed_interval_nonoverlapping_imp_negligible >> simp [])
2948 >> DISCH_TAC
2949 (* applying lebesgue_countably_additive *)
2950 >> Know ‘lmeasure (BIGUNION (IMAGE s UNIV)) = suminf (lmeasure o s)’
2951 >- (SYM_TAC >> MATCH_MP_TAC lebesgue_countably_additive \\
2952 simp [IN_FUNSET])
2953 >> Rewr'
2954 (* applying NUM_2D_BIJ_INV *)
2955 >> Q.X_CHOOSE_THEN ‘h’ STRIP_ASSUME_TAC NUM_2D_BIJ_INV
2956 >> Q.EXISTS_TAC ‘UNCURRY f o h’
2957 >> qabbrev_tac ‘l = \n i. lmeasure (f n i)’
2958 >> Know ‘lmeasure o UNCURRY f o h = UNCURRY l o h’
2959 >- (rw [FUN_EQ_THM, o_DEF, Abbr ‘l’] \\
2960 qabbrev_tac ‘t = h x’ \\
2961 PairCases_on ‘t’ >> simp [])
2962 >> Rewr'
2963 (* applying ext_suminf_2d_full *)
2964 >> Know ‘suminf (UNCURRY l o h) = suminf (\n. suminf (l n))’
2965 >- (MATCH_MP_TAC ext_suminf_2d_full >> simp [] \\
2966 rw [Abbr ‘l’] \\
2967 MATCH_MP_TAC MEASURE_POSITIVE \\
2968 simp [measure_space_lebesgue, closed_interval_imp_lebesgue])
2969 >> Rewr'
2970 >> CONJ_TAC (* closed_interval *)
2971 >- (rw [o_DEF] >> Cases_on ‘h (i :num)’ >> simp [])
2972 (* [-&SUC j,-&j] < [-&SUC i,-&i] < [&i,&SUC i] < [&j,&SUC j]
2973 A j A i B i B j *)
2974 >> Know ‘!i j. i < j ==> nonoverlapping (A i UNION B i) (A j UNION B j)’
2975 >- (rpt STRIP_TAC \\
2976 MATCH_MP_TAC nonoverlapping_subset_inclusive \\
2977 qexistsl_tac [‘interval [-&SUC i,&SUC i]’, ‘{x | x <= -&j \/ &j <= x}’] \\
2978 reverse CONJ_TAC
2979 >- (rw [Abbr ‘A’, Abbr ‘B’, SUBSET_DEF, IN_INTERVAL] >| (* 2 subgoals *)
2980 [ (* goal 1 (of 2) *)
2981 ‘-&i <= (&i) :real’ by simp [] \\
2982 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘-&i’ >> art [] \\
2983 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘&i’ >> simp [],
2984 (* goal 2 (of 2) *)
2985 ‘-&i <= (&i) :real’ by simp [] \\
2986 ‘-&i <= x’ by PROVE_TAC [REAL_LE_TRANS] \\
2987 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘-&i’ >> simp [] ]) \\
2988 simp [nonoverlapping_def, INTERIOR_INTERVAL] \\
2989 ‘SUC i <= j’ by simp [] \\
2990 qabbrev_tac ‘n = SUC i’ \\
2991 rw [DISJOINT_ALT, IN_INTERIOR, IN_INTERVAL] \\
2992 STRONG_DISJ_TAC >> rename1 ‘0 < r’ \\
2993 rw [SUBSET_DEF, IN_BALL, REAL_NOT_LE] \\
2994 (* -&j <= -&n < x < y < &n <= &j *)
2995 MP_TAC (Q.SPECL [‘x’, ‘min (x + r) &n’] REAL_MEAN) \\
2996 simp [REAL_LT_MIN] >> STRIP_TAC (* this asserts ‘z’ *) \\
2997 Q.EXISTS_TAC ‘z’ >> simp [dist] \\
2998 ‘x - z < 0’ by simp [REAL_SUB_LT_NEG] \\
2999 simp [ABS_EQ_NEG] \\
3000 CONJ_TAC >- (Q.PAT_X_ASSUM ‘z < x + r’ MP_TAC >> REAL_ARITH_TAC) \\
3001 CONJ_TAC >| (* 2 subgoals *)
3002 [ (* goal 1 (of 2) *)
3003 Q_TAC (TRANS_TAC REAL_LET_TRANS) ‘-&n’ >> simp [] \\
3004 Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘x’ >> art [],
3005 (* goal 2 (of 2) *)
3006 Q_TAC (TRANS_TAC REAL_LTE_TRANS) ‘&n’ >> simp [] ])
3007 >> DISCH_TAC
3008 >> CONJ_TAC (* nonoverlapping *)
3009 >- (rw [o_DEF] \\
3010 Cases_on ‘h (i :num)’ >> rename1 ‘h i = (n1,i1)’ \\
3011 Cases_on ‘h (j :num)’ >> rename1 ‘h j = (n2,i2)’ \\
3012 simp [] \\
3013 Cases_on ‘n1 = n2’
3014 >- (Suff ‘i1 <> i2’ >- rw [] \\
3015 CCONTR_TAC >> fs [] \\
3016 ‘h i = h j’ by PROVE_TAC [] \\
3017 Q.PAT_X_ASSUM ‘BIJ h _ _’ MP_TAC \\
3018 rw [BIJ_DEF, INJ_DEF] >> DISJ1_TAC \\
3019 qexistsl_tac [‘i’, ‘j’] >> simp []) \\
3020 MATCH_MP_TAC nonoverlapping_subset_inclusive \\
3021 qexistsl_tac [‘A n1 UNION B n1’, ‘A n2 UNION B n2’] >> art [] \\
3022 ‘n1 < n2 \/ n2 < n1’ by simp [] >- simp [] \\
3023 simp [Once nonoverlapping_comm])
3024 >> CONJ_TAC (* SUBSET *)
3025 >- (rw [SUBSET_DEF, IN_BIGUNION_IMAGE, o_DEF] \\
3026 rename1 ‘x IN s n’ \\
3027 Know ‘x IN BIGUNION (IMAGE (f n) UNIV)’ >- METIS_TAC [SUBSET_DEF] \\
3028 rw [IN_BIGUNION_IMAGE] >> rename1 ‘x IN f n j’ \\
3029 Q.PAT_X_ASSUM ‘BIJ h _ _’ MP_TAC >> rw [BIJ_DEF, SURJ_DEF] \\
3030 POP_ASSUM (MP_TAC o Q.SPEC ‘(n,j)’) >> rw [] \\
3031 Q.EXISTS_TAC ‘y’ >> simp [])
3032 >> CONJ_TAC (* suminf <= suminf *)
3033 >- (MATCH_MP_TAC ext_suminf_mono \\
3034 CONJ_TAC >- (rw [o_DEF] >> MATCH_MP_TAC MEASURE_POSITIVE \\
3035 simp [measure_space_lebesgue]) \\
3036 rw [o_DEF, Abbr ‘l’] \\
3037 Q.PAT_X_ASSUM ‘!n. lmeasure (s n) <= suminf (lmeasure o f n)’
3038 (MP_TAC o Q.SPEC ‘n’) >> simp [o_DEF])
3039 (* applying pow_half_ser_by_e *)
3040 >> Know ‘Normal e = suminf (\n. Normal e * (1 / 2) pow (n + 1))’
3041 >- (MATCH_MP_TAC pow_half_ser_by_e >> simp [extreal_of_num_def])
3042 >> Rewr'
3043 (* applying ext_suminf_add *)
3044 >> Know ‘suminf (lmeasure o s) + suminf (\n. Normal e * (1 / 2) pow (n + 1)) =
3045 suminf (\n. (lmeasure o s) n + (\n. Normal e * (1 / 2) pow (n + 1)) n)’
3046 >- (SYM_TAC >> MATCH_MP_TAC ext_suminf_add >> rw []
3047 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
3048 simp [measure_space_lebesgue]) \\
3049 MATCH_MP_TAC le_mul \\
3050 CONJ_TAC >- simp [extreal_of_num_def, REAL_LT_IMP_LE] \\
3051 MATCH_MP_TAC pow_pos_le >> simp [])
3052 >> Rewr'
3053 >> simp [o_DEF]
3054 >> MATCH_MP_TAC ext_suminf_mono >> rw []
3055 >- (MATCH_MP_TAC ext_suminf_pos \\
3056 Q.X_GEN_TAC ‘j’ >> rw [Abbr ‘l’] \\
3057 MATCH_MP_TAC MEASURE_POSITIVE \\
3058 simp [measure_space_lebesgue] \\
3059 MATCH_MP_TAC closed_interval_imp_lebesgue >> art [])
3060 >> Q.PAT_X_ASSUM ‘!n. suminf (lmeasure o f n) <= _’ (MP_TAC o Q.SPEC ‘n’)
3061 >> simp [Abbr ‘l’, o_DEF]
3062QED
3063
3064(* NOTE: “fsigma” is overload_on “fsigma_in euclidean” *)
3065Theorem lebesgue_approximation_fsigma :
3066 !E e. E IN measurable_sets lebesgue /\ 0 < e ==>
3067 ?s. fsigma s /\ E SUBSET s /\
3068 lmeasure E <= lambda s /\
3069 lambda s <= lmeasure E + Normal e
3070Proof
3071 rpt STRIP_TAC
3072 >> MP_TAC (Q.SPECL [‘E’, ‘e’] approximation_thm) >> rw []
3073 >> qabbrev_tac ‘s = BIGUNION (IMAGE J UNIV)’
3074 >> Q.EXISTS_TAC ‘s’ >> art []
3075 >> CONJ_ASM1_TAC
3076 >- (qunabbrev_tac ‘s’ \\
3077 MATCH_MP_TAC (ISPEC “euclidean” FSIGMA_IN_UNIONS) >> rw [] \\
3078 MATCH_MP_TAC CLOSED_IMP_FSIGMA_IN \\
3079 REWRITE_TAC [GSYM CLOSED_IN] \\
3080 MATCH_MP_TAC closed_interval_closed >> art [])
3081 >> ‘s IN subsets borel’ by PROVE_TAC [borel_fsigma]
3082 >> ‘lambda s = lmeasure s’ by PROVE_TAC [lebesgue_eq_lambda] >> POP_ORW
3083 >> Suff ‘lmeasure s = suminf (lmeasure o J)’ >- simp []
3084 >> SYM_TAC >> MATCH_MP_TAC lebesgue_countably_additive
3085 >> rw [IN_FUNSET]
3086 >- (MATCH_MP_TAC closed_interval_imp_lebesgue >> art [])
3087 >> MATCH_MP_TAC closed_interval_nonoverlapping_imp_negligible
3088 >> simp []
3089QED
3090
3091Theorem lebesgue_approximation :
3092 !E e. E IN measurable_sets lebesgue /\ 0 < e ==>
3093 ?s. s IN subsets borel /\ E SUBSET s /\
3094 lmeasure E <= lambda s /\
3095 lambda s <= lmeasure E + Normal e
3096Proof
3097 rpt STRIP_TAC
3098 >> drule_all_then STRIP_ASSUME_TAC lebesgue_approximation_fsigma
3099 >> Q.EXISTS_TAC ‘s’ >> art []
3100 >> MATCH_MP_TAC borel_fsigma >> art []
3101QED
3102
3103Theorem negligible_approximation_lemma[local] :
3104 !E e. E IN measurable_sets lebesgue /\ lmeasure E = 0 /\ 0 < e ==>
3105 ?s. s IN subsets borel /\ E SUBSET s /\ lambda s <= Normal e
3106Proof
3107 rpt STRIP_TAC
3108 >> MP_TAC (Q.SPECL [‘E’, ‘e’] lebesgue_approximation) >> rw []
3109 >> Q.EXISTS_TAC ‘s’ >> art []
3110QED
3111
3112Theorem negligible_approximation :
3113 !E e. negligible E /\ 0 < e ==>
3114 ?s. s IN subsets borel /\ E SUBSET s /\ lambda s <= Normal e
3115Proof
3116 rpt STRIP_TAC
3117 >> ‘E IN measurable_sets lebesgue’ by PROVE_TAC [negligible_in_lebesgue]
3118 >> ‘lmeasure E = 0’ by PROVE_TAC [lebesgue_of_negligible]
3119 >> MATCH_MP_TAC negligible_approximation_lemma >> art []
3120QED
3121
3122Theorem negligible_approximation_null_set :
3123 !E. negligible E ==> ?N. N IN null_set lborel /\ E SUBSET N
3124Proof
3125 rpt STRIP_TAC
3126 >> Know ‘!n. (0 :real) < inv &SUC n’
3127 >- (Q.X_GEN_TAC ‘n’ \\
3128 MATCH_MP_TAC REAL_INV_POS >> simp [])
3129 >> DISCH_TAC
3130 >> Know ‘!n. ?s. s IN subsets borel /\ E SUBSET s /\
3131 lambda s <= Normal (inv &SUC n)’
3132 >- (Q.X_GEN_TAC ‘n’ \\
3133 MP_TAC (Q.SPECL [‘E’, ‘inv &SUC n’] negligible_approximation) >> rw [] \\
3134 Q.EXISTS_TAC ‘s’ >> art [])
3135 >> simp [SKOLEM_THM, FORALL_AND_THM] (* this asserts ‘f’ *)
3136 >> STRIP_TAC
3137 >> qabbrev_tac ‘g = \n. BIGINTER (IMAGE f (count1 n))’
3138 >> Know ‘!n. g n IN subsets borel’
3139 >- (rw [Abbr ‘g’] \\
3140 MATCH_MP_TAC SIGMA_ALGEBRA_FINITE_INTER >> rw [sigma_algebra_borel])
3141 >> DISCH_TAC
3142 >> ‘!n. g n SUBSET f n’ by rw [Abbr ‘g’, IN_BIGINTER_IMAGE, SUBSET_DEF]
3143 >> Know ‘!n. lambda (g n) <= Normal (inv &SUC n)’
3144 >- (rpt STRIP_TAC \\
3145 Q_TAC (TRANS_TAC le_trans) ‘lambda (f n)’ >> art [] \\
3146 MATCH_MP_TAC MEASURE_INCREASING >> rw [lborel_def, sets_lborel])
3147 >> DISCH_TAC
3148 >> ‘!n. g (SUC n) SUBSET g n’ by rw [Abbr ‘g’, IN_BIGINTER_IMAGE, SUBSET_DEF]
3149 >> qabbrev_tac ‘s = BIGINTER (IMAGE g UNIV)’
3150 >> Q.EXISTS_TAC ‘s’
3151 >> reverse CONJ_TAC
3152 >- (rw [SUBSET_DEF, Abbr ‘s’, IN_BIGINTER_IMAGE] \\
3153 rw [Abbr ‘g’, IN_BIGINTER_IMAGE] \\
3154 METIS_TAC [SUBSET_DEF])
3155 >> simp [IN_NULL_SET, null_set_def, sets_lborel]
3156 >> CONJ_ASM1_TAC
3157 >- (qunabbrev_tac ‘s’ \\
3158 MATCH_MP_TAC SIGMA_ALGEBRA_BIGINTER >> simp [sigma_algebra_borel])
3159 >> reverse (rw [GSYM le_antisym])
3160 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
3161 simp [lborel_def, sets_lborel])
3162 >> Know ‘lambda s = inf (IMAGE (lambda o g) UNIV)’
3163 >- (SYM_TAC >> MATCH_MP_TAC MONOTONE_CONVERGENCE_BIGINTER \\
3164 rw [IN_FUNSET, lborel_def, sets_lborel, lt_infty] \\
3165 Q_TAC (TRANS_TAC let_trans) ‘Normal (inv &SUC n)’ \\
3166 simp [GSYM lt_infty])
3167 >> Rewr'
3168 >> MATCH_MP_TAC le_epsilon >> rw []
3169 >> rw [inf_le']
3170 >> MP_TAC (Q.SPEC ‘e’ EXTREAL_ARCH_INV) >> rw []
3171 >> Q_TAC (TRANS_TAC le_trans) ‘inv &SUC n’ >> simp [lt_imp_le]
3172 >> Know ‘inv &SUC n = Normal (inv &SUC n)’
3173 >- (‘&SUC n <> (0 :real)’ by simp [] \\
3174 simp [extreal_of_num_def, extreal_inv_eq])
3175 >> Rewr'
3176 >> Q_TAC (TRANS_TAC le_trans) ‘lambda (g n)’ >> art []
3177 >> FIRST_X_ASSUM MATCH_MP_TAC
3178 >> Q.EXISTS_TAC ‘n’ >> REFL_TAC
3179QED
3180
3181(* |- !E. E IN null_set lebesgue ==> ?N. N IN null_set lborel /\ E SUBSET N *)
3182Theorem negligible_approximation_null_set' =
3183 negligible_approximation_null_set
3184 |> REWRITE_RULE [negligible_alt_lebesgue_null_set]
3185
3186Theorem pos_fn_integral_fn_seq :
3187 !m f n. measure_space m /\ f IN Borel_measurable (measurable_space m) ==>
3188 pos_fn_integral m (fn_seq m f n) = fn_seq_integral m f n
3189Proof
3190 RW_TAC std_ss [fn_seq_integral_def, fn_seq_def]
3191 >> qabbrev_tac ‘s = \n. count (4 ** n)’
3192 >> qabbrev_tac ‘a = \n k. {x | x IN m_space m /\ &k / 2 pow n <= f x /\
3193 f x < (&k + 1) / 2 pow n}’
3194 >> Know ‘!n i. a n i IN measurable_sets m’
3195 >- (rw [Abbr ‘a’] \\
3196 ‘{x | x IN m_space m /\ &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} =
3197 {x | &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} INTER m_space m’
3198 by SET_TAC [] >> POP_ORW \\
3199 METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE, MEASURE_SPACE_SIGMA_ALGEBRA])
3200 >> DISCH_TAC
3201 >> qabbrev_tac ‘b = \n. {x | x IN m_space m /\ 2 pow n <= f x}’
3202 >> Know ‘!i. b i IN measurable_sets m’
3203 >- (Q.X_GEN_TAC ‘n’ >> simp [Abbr ‘b’] \\
3204 ‘{x | x IN m_space m /\ 2 pow n <= f x} =
3205 {x | 2 pow n <= f x} INTER m_space m’ by SET_TAC [] >> POP_ORW \\
3206 METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE, MEASURE_SPACE_SIGMA_ALGEBRA])
3207 >> DISCH_TAC
3208 >> qabbrev_tac ‘c = \n k. (&k / 2 pow n) :extreal’
3209 >> Know ‘!i k. 0 <= c i k’
3210 >- (rw [Abbr ‘c’] \\
3211 ‘2 pow i = Normal (2 pow i)’
3212 by simp [extreal_of_num_def, extreal_pow_def] >> POP_ORW \\
3213 MATCH_MP_TAC le_div >> simp [REAL_POW_LT])
3214 >> DISCH_TAC
3215 >> qabbrev_tac ‘h = \x. SIGMA (\k. c n k * indicator_fn (a n k) x) (s n)’
3216 >> Know ‘!x. x IN m_space m ==> 0 <= h x’
3217 >- (rw [Abbr ‘h’] \\
3218 irule EXTREAL_SUM_IMAGE_POS >> simp [Abbr ‘s’] \\
3219 Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
3220 MATCH_MP_TAC le_mul >> rw [Abbr ‘c’, INDICATOR_FN_POS])
3221 >> DISCH_TAC
3222 >> qabbrev_tac ‘g = \x. 2 pow n * indicator_fn (b n) x’ >> simp []
3223 >> Know ‘!x. x IN m_space m ==> 0 <= g x’
3224 >- (rw [Abbr ‘g’] \\
3225 MATCH_MP_TAC le_mul >> simp [pow_pos_le, INDICATOR_FN_POS])
3226 >> DISCH_TAC
3227 >> Know ‘pos_fn_integral m (\x. h x + g x) =
3228 pos_fn_integral m h + pos_fn_integral m g’
3229 >- (MATCH_MP_TAC pos_fn_integral_add >> art [] \\
3230 CONJ_TAC (* h IN Borel_measurable (measurable_space m) *)
3231 >- (MATCH_MP_TAC (INST_TYPE [beta |-> “:num”] IN_MEASURABLE_BOREL_SUM) \\
3232 simp [MEASURE_SPACE_SIGMA_ALGEBRA, Abbr ‘h’] \\
3233 qexistsl_tac [‘\k x. c n k * indicator_fn (a n k) x’, ‘s n’] \\
3234 simp [Abbr ‘s’] \\
3235 reverse CONJ_TAC
3236 >- (rpt GEN_TAC >> STRIP_TAC \\
3237 MATCH_MP_TAC pos_not_neginf \\
3238 MATCH_MP_TAC le_mul >> simp [INDICATOR_FN_POS]) \\
3239 rw [Abbr ‘c’] \\
3240 simp [extreal_of_num_def, extreal_pow_def] \\
3241 ‘(0 :real) < 2 pow n’ by simp [REAL_POW_LT] \\
3242 ‘2 pow n <> 0 :real’ by PROVE_TAC [REAL_LT_IMP_NE] \\
3243 simp [extreal_div_eq] \\
3244 MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR \\
3245 simp [MEASURE_SPACE_SIGMA_ALGEBRA]) \\
3246 (* g IN Borel_measurable (measurable_space m) *)
3247 rw [Abbr ‘g’, extreal_of_num_def, extreal_pow_def] \\
3248 MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR \\
3249 simp [MEASURE_SPACE_SIGMA_ALGEBRA])
3250 >> Rewr'
3251 >> Know ‘pos_fn_integral m g = 2 pow n * measure m (b n)’
3252 >- (simp [Abbr ‘g’, extreal_of_num_def, extreal_pow_def] \\
3253 MATCH_MP_TAC pos_fn_integral_cmul_indicator \\
3254 simp [REAL_POW_LE])
3255 >> Rewr'
3256 >> qmatch_abbrev_tac ‘x1 + y = x2 + (y :extreal)’
3257 >> Know ‘y <> NegInf’
3258 >- (MATCH_MP_TAC pos_not_neginf \\
3259 qunabbrev_tac ‘y’ \\
3260 MATCH_MP_TAC le_mul >> simp [pow_pos_le] \\
3261 MATCH_MP_TAC MEASURE_POSITIVE >> art [])
3262 >> DISCH_TAC
3263 >> Cases_on ‘y = PosInf’
3264 >- (POP_ORW \\
3265 Suff ‘x1 + PosInf = PosInf /\ x2 + PosInf = PosInf’ >- simp [] \\
3266 Suff ‘x1 <> NegInf /\ x2 <> NegInf’ >- PROVE_TAC [add_infty] \\
3267 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf >| (* 2 subgoals *)
3268 [ (* goal 1 (of 2) *)
3269 qunabbrev_tac ‘x1’ \\
3270 MATCH_MP_TAC pos_fn_integral_pos >> art [],
3271 (* goal 2 (of 2) *)
3272 qunabbrev_tac ‘x2’ \\
3273 irule EXTREAL_SUM_IMAGE_POS >> rw [Abbr ‘s’] \\
3274 MATCH_MP_TAC le_mul >> art [] \\
3275 MATCH_MP_TAC MEASURE_POSITIVE >> art [] ])
3276 >> Know ‘x1 + y = x2 + y <=> x1 = x2’
3277 >- (MATCH_MP_TAC EXTREAL_EQ_RADD >> art [])
3278 >> Rewr'
3279 >> qunabbrevl_tac [‘x1’, ‘x2’]
3280 (* cleanup y and y-assumptions *)
3281 >> NTAC 2 (POP_ASSUM K_TAC) >> qunabbrev_tac ‘y’
3282 (* cleanup g and g-assumptions *)
3283 >> POP_ASSUM K_TAC >> qunabbrev_tac ‘g’
3284 >> POP_ASSUM K_TAC (* h-assumption *)
3285 >> qunabbrev_tac ‘h’
3286 (* re-define another g *)
3287 >> qabbrev_tac ‘g = \k x. c n k * indicator_fn (a n k) x’ >> simp []
3288 >> Know ‘!i x. x IN m_space m ==> 0 <= g i x’
3289 >- (rw [Abbr ‘g’] \\
3290 MATCH_MP_TAC le_mul >> simp [INDICATOR_FN_POS])
3291 >> DISCH_TAC
3292 >> MP_TAC (Q.SPECL [‘m’, ‘g’, ‘s (n :num)’]
3293 (INST_TYPE [beta |-> “:num”] pos_fn_integral_sum))
3294 >> impl_tac
3295 >- (simp [Abbr ‘s’] \\
3296 rw [Abbr ‘g’, Abbr ‘c’, extreal_of_num_def, extreal_pow_def] \\
3297 ‘(0 :real) < 2 pow n’ by simp [REAL_POW_LT] \\
3298 ‘2 pow n <> 0 :real’ by PROVE_TAC [REAL_LT_IMP_NE] \\
3299 simp [extreal_div_eq] \\
3300 MATCH_MP_TAC IN_MEASURABLE_BOREL_CMUL_INDICATOR \\
3301 simp [MEASURE_SPACE_SIGMA_ALGEBRA])
3302 >> Rewr'
3303 >> irule EXTREAL_SUM_IMAGE_EQ
3304 >> simp [Abbr ‘s’]
3305 >> reverse CONJ_TAC
3306 >- (DISJ1_TAC \\
3307 Q.X_GEN_TAC ‘i’ >> DISCH_TAC \\
3308 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf
3309 >- (MATCH_MP_TAC pos_fn_integral_pos >> art []) \\
3310 MATCH_MP_TAC le_mul >> art [] \\
3311 MATCH_MP_TAC MEASURE_POSITIVE >> art [])
3312 >> rw [Abbr ‘g’]
3313 >> simp [Abbr ‘c’, extreal_of_num_def, extreal_pow_def]
3314 >> ‘(0 :real) < 2 pow n’ by simp [REAL_POW_LT]
3315 >> ‘2 pow n <> 0 :real’ by PROVE_TAC [REAL_LT_IMP_NE]
3316 >> simp [extreal_div_eq]
3317 >> MATCH_MP_TAC pos_fn_integral_cmul_indicator >> art []
3318 >> MATCH_MP_TAC REAL_LE_DIV >> simp [POW_POS]
3319QED
3320
3321(* cf. measureTheory.fn_seq_def. Here is the version for (f :'a -> real) *)
3322Definition real_fn_seq_def :
3323 real_fn_seq m (f :'a -> real) =
3324 (\n x. SIGMA
3325 (\k. &k / 2 pow n *
3326 indicator
3327 {x | x IN m_space m /\ &k / 2 pow n <= f x /\
3328 f x < (&k + 1) / 2 pow n} x) (count (4 ** n)) +
3329 2 pow n * indicator {x | x IN m_space m /\ 2 pow n <= f x} x)
3330End
3331
3332Theorem fn_seq_alt_real_fn_seq :
3333 !m f n x. fn_seq m (Normal o f) n x = Normal (real_fn_seq m f n x)
3334Proof
3335 RW_TAC std_ss [fn_seq_def, real_fn_seq_def]
3336 >> ASM_SIMP_TAC real_ss [extreal_of_num_def, extreal_pow_eq]
3337 >> ‘2 pow n <> (0 :real)’ by simp []
3338 >> ASM_SIMP_TAC real_ss
3339 [extreal_div_eq, extreal_le_eq, extreal_lt_eq, extreal_add_eq]
3340 >> qabbrev_tac ‘A = \k. {x | x IN m_space m /\ &k / 2 pow n <= f x /\
3341 f x < &(k + 1) / 2 pow n}’
3342 >> qabbrev_tac ‘B = {x | x IN m_space m /\ 2 pow n <= f x}’
3343 >> qabbrev_tac ‘N = count (4 ** n)’
3344 >> qabbrev_tac ‘c = \k. (&k / 2 pow n) :real’
3345 >> ASM_SIMP_TAC std_ss []
3346 >> simp [indicator_fn, o_DEF, extreal_mul_eq]
3347 >> qabbrev_tac ‘g = \k. c k * indicator (A k) x’ >> simp []
3348 >> Know ‘SIGMA (\k. Normal (g k)) N = Normal (SIGMA g N)’
3349 >- (MATCH_MP_TAC EXTREAL_SUM_IMAGE_NORMAL \\
3350 simp [Abbr ‘N’])
3351 >> Rewr'
3352 >> simp [extreal_add_eq]
3353QED
3354
3355Theorem real_fn_seq_alt_fn_seq :
3356 !m f n x. real_fn_seq m f n x = real (fn_seq m (Normal o f) n x)
3357Proof
3358 rw [fn_seq_alt_real_fn_seq]
3359QED
3360
3361(* cf. lemma_fn_seq_positive *)
3362Theorem lemma_real_fn_seq_positive[local] :
3363 !m f n x. 0 <= f x ==> 0 <= real_fn_seq m f n x
3364Proof
3365 rw [real_fn_seq_alt_fn_seq]
3366 >> MATCH_MP_TAC real_positive
3367 >> MATCH_MP_TAC lemma_fn_seq_positive
3368 >> simp [extreal_of_num_def, o_DEF]
3369QED
3370
3371(* cf. lemma_fn_seq_upper_bounded *)
3372Theorem lemma_real_fn_seq_upper_bounded[local] :
3373 !m f n x. 0 <= f x ==> real_fn_seq m f n x <= f x
3374Proof
3375 RW_TAC std_ss [real_fn_seq_alt_fn_seq]
3376 >> qabbrev_tac ‘nf = Normal o f’
3377 >> ‘0 <= nf x’ by rw [Abbr ‘nf’, o_DEF, extreal_of_num_def]
3378 >> MP_TAC (Q.SPECL [‘m’, ‘nf’, ‘n’, ‘x’] lemma_fn_seq_upper_bounded)
3379 >> MP_TAC (Q.SPECL [‘m’, ‘nf’, ‘n’, ‘x’] lemma_fn_seq_positive)
3380 >> rw [o_DEF]
3381 >> qabbrev_tac ‘y = fn_seq m nf n x’
3382 >> ‘y <> NegInf’ by simp [pos_not_neginf]
3383 >> Know ‘y <> PosInf’
3384 >- (REWRITE_TAC [lt_infty] \\
3385 Q_TAC (TRANS_TAC let_trans) ‘nf x’ \\
3386 simp [GSYM lt_infty, Abbr ‘nf’, o_DEF])
3387 >> DISCH_TAC
3388 >> ‘?r. y = Normal r’ by METIS_TAC [extreal_cases]
3389 >> gs [Abbr ‘nf’, o_DEF]
3390QED
3391
3392(* cf. lemma_fn_seq_mono_increasing *)
3393Theorem lemma_real_fn_seq_mono_increasing[local] :
3394 !m f x. 0 <= f x ==> mono_increasing (\n. real_fn_seq m f n x)
3395Proof
3396 rpt GEN_TAC >> DISCH_TAC
3397 >> simp [real_fn_seq_alt_fn_seq, mono_increasing_def]
3398 >> qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC
3399 >> MATCH_MP_TAC le_real_imp
3400 >> CONJ_TAC
3401 >- (MATCH_MP_TAC lemma_fn_seq_positive \\
3402 simp [extreal_of_num_def, o_DEF])
3403 >> CONJ_TAC
3404 >- (irule (SRULE [ext_mono_increasing_def] lemma_fn_seq_mono_increasing) \\
3405 simp [extreal_of_num_def, o_DEF])
3406 >> REWRITE_TAC [lt_infty]
3407 >> Q_TAC (TRANS_TAC let_trans) ‘(Normal o f) x’
3408 >> CONJ_TAC
3409 >- (MATCH_MP_TAC lemma_fn_seq_upper_bounded \\
3410 simp [extreal_of_num_def, o_DEF])
3411 >> simp [GSYM lt_infty, o_DEF]
3412QED
3413
3414(* cf. fn_seq_integral_def
3415
3416 NOTE: This definition requires all (k <> 0) “lambda _” must be finite, such
3417 that “lambda' _” is meaningful. This may be derived from “integrable lborel f”
3418 aka “pos_fn_integral lborel f <> PosInf”.
3419 *)
3420Overload lambda'[local] = “\s. real (lambda s)”
3421
3422Definition real_fn_seq_integral_def :
3423 real_fn_seq_integral (f :real -> real) n =
3424 SIGMA (\k. &k / 2 pow n *
3425 lambda' {x | &k / 2 pow n <= f x /\
3426 f x < (&k + 1) / 2 pow n}) (count (4 ** n)) +
3427 2 pow n * lambda' {x | 2 pow n <= f x}
3428End
3429
3430Theorem real_fn_seq_lemma1[local] :
3431 !f i n. f IN borel_measurable borel ==>
3432 {x | &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} IN subsets borel
3433
3434Proof
3435 rpt STRIP_TAC
3436 >> MATCH_MP_TAC
3437 (SRULE [sigma_algebra_borel, space_borel]
3438 (ISPEC “borel” in_borel_measurable_ge_lt_imp)) >> art []
3439QED
3440
3441Theorem real_fn_seq_lemma2[local] :
3442 !f n. f IN borel_measurable borel ==> {x | 2 pow n <= f x} IN subsets borel
3443Proof
3444 rpt STRIP_TAC
3445 >> irule (SRULE [sigma_algebra_borel, space_borel]
3446 (ISPECL [“f :real -> real”,“borel”]
3447 (cj 2 (iffLR in_borel_measurable_ge)))) >> art []
3448QED
3449
3450(* NOTE: “real PosInf = 0” has been used here to avoid more antecedents. *)
3451Theorem real_fn_seq_integral_positive :
3452 !f n. f IN borel_measurable borel ==> 0 <= real_fn_seq_integral f n
3453Proof
3454 RW_TAC std_ss [real_fn_seq_integral_def]
3455 >> MATCH_MP_TAC REAL_LE_ADD
3456 >> reverse CONJ_TAC
3457 >- (MATCH_MP_TAC REAL_LE_MUL >> simp [] \\
3458 MATCH_MP_TAC real_positive \\
3459 MATCH_MP_TAC MEASURE_POSITIVE >> simp [lborel_def, sets_lborel] \\
3460 MATCH_MP_TAC real_fn_seq_lemma2 >> art [])
3461 >> HO_MATCH_MP_TAC REAL_SUM_IMAGE_POS
3462 >> SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT]
3463 >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC
3464 >> MATCH_MP_TAC REAL_LE_MUL
3465 >> CONJ_TAC >- simp []
3466 >> MATCH_MP_TAC real_positive
3467 >> MATCH_MP_TAC MEASURE_POSITIVE
3468 >> SIMP_TAC std_ss [lborel_def, sets_lborel]
3469 >> MATCH_MP_TAC real_fn_seq_lemma1 >> art []
3470QED
3471
3472Theorem fn_seq_integral_positive :
3473 !m f n. measure_space m /\ f IN Borel_measurable (measurable_space m) ==>
3474 0 <= fn_seq_integral m f n
3475Proof
3476 RW_TAC std_ss [fn_seq_integral_def]
3477 >> MATCH_MP_TAC le_add
3478 >> reverse CONJ_TAC
3479 >- (MATCH_MP_TAC le_mul >> simp [pow_pos_le] \\
3480 MATCH_MP_TAC MEASURE_POSITIVE >> art [] \\
3481 ‘{x | x IN m_space m /\ 2 pow n <= f x} =
3482 {x | 2 pow n <= f x} INTER m_space m’ by SET_TAC [] >> POP_ORW \\
3483 simp [IN_MEASURABLE_BOREL_ALL_MEASURE])
3484 >> HO_MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS
3485 >> SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT]
3486 >> Q.X_GEN_TAC ‘i’ >> DISCH_TAC
3487 >> MATCH_MP_TAC le_mul
3488 >> CONJ_TAC
3489 >- (‘2 pow n = Normal (2 pow n)’ by simp [extreal_of_num_def, extreal_pow_def] \\
3490 ‘2 pow n <> (0 :real)’ by simp [] \\
3491 simp [extreal_div_eq] \\
3492 MATCH_MP_TAC le_div >> simp [])
3493 >> MATCH_MP_TAC MEASURE_POSITIVE >> art []
3494 >> ‘{x | x IN m_space m /\ &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} =
3495 {x | &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} INTER m_space m’
3496 by SET_TAC []
3497 >> POP_ORW
3498 >> simp [IN_MEASURABLE_BOREL_ALL_MEASURE]
3499QED
3500
3501(* NOTE: If k = 0, then “&k / 2 pow n * lmeasure s = 0” even the measure is inf *)
3502Theorem lemma_fn_seq_finite_measure1[local] :
3503 !m f k n. measure_space m /\ f IN Borel_measurable (measurable_space m) /\
3504 (!x. x IN m_space m ==> 0 <= f x) /\
3505 pos_fn_integral m f <> PosInf /\ k < 4 ** n /\ k <> 0 ==>
3506 measure m {x | x IN m_space m /\ &k / 2 pow n <= f x /\
3507 f x < (&k + 1) / 2 pow n} <> PosInf
3508Proof
3509 rpt STRIP_TAC
3510 >> ASSUME_TAC (Q.SPECL [‘m’, ‘f’, ‘n’] lemma_fn_seq_positive')
3511 >> ASSUME_TAC (Q.SPECL [‘m’, ‘f’, ‘n’] lemma_fn_seq_upper_bounded')
3512 >> Know ‘pos_fn_integral m (fn_seq m f n) <> PosInf’
3513 >- (REWRITE_TAC [lt_infty] \\
3514 Q_TAC (TRANS_TAC let_trans) ‘pos_fn_integral m f’ \\
3515 reverse CONJ_TAC >- art [GSYM lt_infty] \\
3516 MATCH_MP_TAC pos_fn_integral_mono >> simp [])
3517 >> Know ‘pos_fn_integral m (fn_seq m f n) = fn_seq_integral m f n’
3518 >- (MATCH_MP_TAC pos_fn_integral_fn_seq >> art [])
3519 >> simp [] >> DISCH_THEN K_TAC
3520 >> simp [fn_seq_integral_def]
3521 >> qmatch_abbrev_tac ‘a + b = PosInf’
3522 >> ‘sigma_algebra (measurable_space m)’ by PROVE_TAC [MEASURE_SPACE_SIGMA_ALGEBRA]
3523 >> Know ‘0 <= b’
3524 >- (qunabbrev_tac ‘b’ \\
3525 MATCH_MP_TAC le_mul >> simp [pow_pos_le] \\
3526 MATCH_MP_TAC MEASURE_POSITIVE >> art [] \\
3527 ‘{x | x IN m_space m /\ 2 pow n <= f x} =
3528 {x | 2 pow n <= f x} INTER m_space m’ by SET_TAC [] >> POP_ORW \\
3529 METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE])
3530 >> DISCH_TAC
3531 >> qunabbrev_tac ‘a’
3532 >> qmatch_abbrev_tac ‘SIGMA g _ + b = PosInf’
3533 >> qmatch_abbrev_tac ‘a + b = PosInf’
3534 >> Know ‘!i. 0 <= g i’
3535 >- (rw [Abbr ‘g’] \\
3536 MATCH_MP_TAC le_mul \\
3537 CONJ_TAC
3538 >- (‘2 pow n = Normal (2 pow n)’
3539 by rw [extreal_of_num_def, extreal_pow_def] >> POP_ORW \\
3540 MATCH_MP_TAC le_div >> simp []) \\
3541 MATCH_MP_TAC MEASURE_POSITIVE >> art [] \\
3542 qmatch_abbrev_tac ‘s IN measurable_sets m’ \\
3543 ‘s = {x | &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} INTER m_space m’
3544 by (qunabbrev_tac ‘s’ >> SET_TAC []) >> POP_ORW \\
3545 METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE])
3546 >> DISCH_TAC
3547 >> Know ‘0 <= a’
3548 >- (qunabbrev_tac ‘a’ \\
3549 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> simp [])
3550 >> DISCH_TAC
3551 >> Suff ‘a = PosInf’
3552 >- (Rewr' \\
3553 Suff ‘b <> NegInf’ >- METIS_TAC [add_infty] \\
3554 MATCH_MP_TAC pos_not_neginf >> art [])
3555 >> qunabbrev_tac ‘a’
3556 >> MATCH_MP_TAC EXTREAL_SUM_IMAGE_EQ_POSINF >> simp []
3557 >> Q.EXISTS_TAC ‘k’
3558 >> simp [Abbr ‘g’]
3559 >> Suff ‘0 < &k / 2 pow n’ >- PROVE_TAC [mul_rposinf]
3560 >> ‘2 pow n = Normal (2 pow n)’
3561 by rw [extreal_of_num_def, extreal_pow_def] >> POP_ORW
3562 >> MATCH_MP_TAC lt_div
3563 >> simp [extreal_of_num_def]
3564QED
3565
3566Theorem lemma_fn_seq_finite_measure1'[local] :
3567 !f k n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
3568 pos_fn_integral lborel (Normal o f) <> PosInf /\
3569 k < 4 ** n /\ k <> 0 ==>
3570 lambda {x | &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n} <>
3571 PosInf
3572Proof
3573 rpt STRIP_TAC
3574 >> qabbrev_tac ‘nf = Normal o f’
3575 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
3576 >> Know ‘nf IN Borel_measurable borel’
3577 >- (qunabbrev_tac ‘nf’ \\
3578 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
3579 simp [sigma_algebra_borel])
3580 >> DISCH_TAC
3581 >> MP_TAC (Q.SPECL [‘nf’, ‘k’, ‘n’]
3582 (ISPEC “lborel” lemma_fn_seq_finite_measure1))
3583 >> simp [lborel_def, space_lborel]
3584 >> ‘2 pow n <> (0 :real)’ by simp []
3585 >> ASM_SIMP_TAC std_ss
3586 [Abbr ‘nf’, extreal_div_eq, extreal_of_num_def, extreal_pow_def,
3587 extreal_add_eq, extreal_lt_eq, extreal_le_eq]
3588QED
3589
3590Theorem lemma_fn_seq_finite_measure2[local] :
3591 !m f n. measure_space m /\ f IN Borel_measurable (measurable_space m) /\
3592 (!x. x IN m_space m ==> 0 <= f x) /\
3593 pos_fn_integral m f <> PosInf ==>
3594 measure m {x | x IN m_space m /\ 2 pow n <= f x} <> PosInf
3595Proof
3596 rpt STRIP_TAC
3597 >> ASSUME_TAC (Q.SPECL [‘m’, ‘f’, ‘n’] lemma_fn_seq_positive')
3598 >> ASSUME_TAC (Q.SPECL [‘m’, ‘f’, ‘n’] lemma_fn_seq_upper_bounded')
3599 >> Know ‘pos_fn_integral m (fn_seq m f n) <> PosInf’
3600 >- (REWRITE_TAC [lt_infty] \\
3601 Q_TAC (TRANS_TAC let_trans) ‘pos_fn_integral m f’ \\
3602 reverse CONJ_TAC >- art [GSYM lt_infty] \\
3603 MATCH_MP_TAC pos_fn_integral_mono >> simp [])
3604 >> Know ‘pos_fn_integral m (fn_seq m f n) = fn_seq_integral m f n’
3605 >- (MATCH_MP_TAC pos_fn_integral_fn_seq >> art [])
3606 >> simp [] >> DISCH_THEN K_TAC
3607 >> simp [fn_seq_integral_def]
3608 >> qmatch_abbrev_tac ‘a + b = PosInf’
3609 >> ‘sigma_algebra (measurable_space m)’ by PROVE_TAC [MEASURE_SPACE_SIGMA_ALGEBRA]
3610 >> Know ‘0 <= b’
3611 >- (qunabbrev_tac ‘b’ \\
3612 MATCH_MP_TAC le_mul >> simp [pow_pos_le])
3613 >> DISCH_TAC
3614 >> qunabbrev_tac ‘a’
3615 >> qmatch_abbrev_tac ‘SIGMA g _ + b = PosInf’
3616 >> qmatch_abbrev_tac ‘a + b = PosInf’
3617 >> Know ‘!i. 0 <= g i’
3618 >- (rw [Abbr ‘g’] \\
3619 MATCH_MP_TAC le_mul \\
3620 CONJ_TAC
3621 >- (‘2 pow n = Normal (2 pow n)’
3622 by rw [extreal_of_num_def, extreal_pow_def] >> POP_ORW \\
3623 MATCH_MP_TAC le_div >> simp []) \\
3624 MATCH_MP_TAC MEASURE_POSITIVE >> art [] \\
3625 qmatch_abbrev_tac ‘s IN measurable_sets m’ \\
3626 ‘s = {x | &i / 2 pow n <= f x /\ f x < (&i + 1) / 2 pow n} INTER m_space m’
3627 by (qunabbrev_tac ‘s’ >> SET_TAC []) >> POP_ORW \\
3628 METIS_TAC [IN_MEASURABLE_BOREL_ALL_MEASURE])
3629 >> DISCH_TAC
3630 >> Know ‘0 <= a’
3631 >- (qunabbrev_tac ‘a’ \\
3632 MATCH_MP_TAC EXTREAL_SUM_IMAGE_POS >> simp [])
3633 >> DISCH_TAC
3634 >> Suff ‘b = PosInf’
3635 >- (Rewr' \\
3636 Suff ‘a <> NegInf’ >- METIS_TAC [add_infty] \\
3637 MATCH_MP_TAC pos_not_neginf >> art [])
3638 >> qunabbrev_tac ‘b’
3639 >> Suff ‘0 < 2 pow n’ >- PROVE_TAC [mul_rposinf]
3640 >> simp [pow_pos_lt]
3641QED
3642
3643Theorem lemma_fn_seq_finite_measure2'[local] :
3644 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
3645 pos_fn_integral lborel (Normal o f) <> PosInf ==>
3646 lambda {x | 2 pow n <= f x} <> PosInf
3647Proof
3648 rpt STRIP_TAC
3649 >> qabbrev_tac ‘nf = Normal o f’
3650 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
3651 >> Know ‘nf IN Borel_measurable borel’
3652 >- (qunabbrev_tac ‘nf’ \\
3653 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
3654 simp [sigma_algebra_borel])
3655 >> DISCH_TAC
3656 >> MP_TAC (Q.SPECL [‘nf’, ‘n’] (ISPEC “lborel” lemma_fn_seq_finite_measure2))
3657 >> simp [lborel_def, space_lborel]
3658 >> simp [Abbr ‘nf’, extreal_of_num_def, extreal_pow_def]
3659QED
3660
3661Theorem finite_lmeasure_imp_integral_indicator :
3662 !s y. s IN measurable_sets lebesgue /\ lmeasure s = Normal y ==>
3663 indicator s integrable_on UNIV /\
3664 integral UNIV (indicator s) = y
3665Proof
3666 rpt GEN_TAC
3667 >> simp [lebesgue_def] >> STRIP_TAC
3668 >> qabbrev_tac ‘f = \n. indicator (s INTER line n)’
3669 >> ‘!n x. 0 <= f n x’ by rw [Abbr ‘f’, INDICATOR_POS]
3670 >> Know ‘!m n x. m <= n ==> f m x <= f n x’
3671 >- (rw [Abbr ‘f’] \\
3672 MATCH_MP_TAC INDICATOR_MONO \\
3673 Suff ‘line m SUBSET line n’ >- SET_TAC [] \\
3674 MATCH_MP_TAC LINE_MONO >> art [])
3675 >> DISCH_TAC
3676 >> ‘!n. f n integrable_on univ(:real)’ by PROVE_TAC [integrable_indicator_UNIV]
3677 >> Know ‘{Normal (integral (line n) (indicator s)) | n | T} =
3678 IMAGE Normal {integral (line n) (indicator s) | n | T}’
3679 >- (rw [Once EXTENSION] \\
3680 EQ_TAC >> rw [] \\ (* 2 subgoals, same tactics *)
3681 Q.EXISTS_TAC ‘n’ >> REFL_TAC)
3682 >> DISCH_THEN (fs o wrap)
3683 >> qabbrev_tac ‘t = {integral (line n) (indicator s) | n | T}’
3684 >> Know ‘bounded t’
3685 >- (rw [bounded_def] \\
3686 Q.EXISTS_TAC ‘y’ >> rw [Abbr ‘t’] \\
3687 Q.PAT_X_ASSUM ‘sup _ = Normal y’ MP_TAC >> rw [sup_eq'] \\
3688 Q.PAT_X_ASSUM ‘!z. _ ==> z <= Normal y’
3689 (MP_TAC o Q.SPEC ‘Normal (integral (line n) (indicator s))’) \\
3690 impl_tac
3691 >- (Q.EXISTS_TAC ‘integral (line n) (indicator s)’ >> simp [] \\
3692 Q.EXISTS_TAC ‘n’ >> REFL_TAC) \\
3693 rw [] \\
3694 qmatch_abbrev_tac ‘abs x <= y’ \\
3695 Suff ‘abs x = x’ >- (Rewr' >> art []) \\
3696 rw [abs_refl, Abbr ‘x’] \\
3697 MATCH_MP_TAC INTEGRAL_POS >> simp [INDICATOR_POS])
3698 >> DISCH_TAC
3699 (* applying sup_image_normal *)
3700 >> Know ‘sup (IMAGE Normal t) = Normal (sup t)’
3701 >- (MATCH_MP_TAC sup_image_normal >> art [] \\
3702 rw [Abbr ‘t’, Once EXTENSION])
3703 >> DISCH_THEN (fs o wrap)
3704 >> MP_TAC (Q.SPECL [‘f’, ‘UNIV’]
3705 BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) >> simp []
3706 >> impl_tac
3707 >- (Q.PAT_X_ASSUM ‘bounded t’ MP_TAC \\
3708 rw [Abbr ‘t’, bounded_def] \\
3709 Q.EXISTS_TAC ‘a’ \\
3710 simp [Abbr ‘f’, integral_indicator_UNIV])
3711 >> STRIP_TAC (* this asserts ‘g’, and ‘k’ (negligible) *)
3712 >> rename1 ‘negligible N’
3713 (* stage work *)
3714 >> qabbrev_tac ‘h = \n. integral UNIV (f n)’
3715 >> qabbrev_tac ‘r = integral univ(:real) g’
3716 (* applying mono_increasing_converges_to_sup *)
3717 >> Know ‘r = sup (IMAGE h UNIV)’
3718 >- (MATCH_MP_TAC mono_increasing_converges_to_sup \\
3719 simp [GSYM LIM_SEQUENTIALLY_SEQ] \\
3720 simp [mono_increasing_def, Abbr ‘h’] \\
3721 qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC \\
3722 MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> simp [])
3723 >> Know ‘IMAGE h UNIV = t’
3724 >- (rw [Abbr ‘t’, Once EXTENSION, Abbr ‘h’] \\
3725 simp [integral_indicator_UNIV, Abbr ‘f’])
3726 >> Rewr'
3727 >> DISCH_TAC
3728 >> Q.PAT_X_ASSUM ‘(h --> r) sequentially’ K_TAC
3729 (* applying mono_increasing_converges_to_sup again *)
3730 >> qabbrev_tac ‘f' = flip f’
3731 >> ‘!x. (\k. f k x) = f' x’ by rw [FUN_EQ_THM, Abbr ‘f'’]
3732 >> POP_ASSUM (fs o wrap)
3733 >> Know ‘!x. x NOTIN N ==> g x = sup (IMAGE (f' x) UNIV)’
3734 >- (rpt STRIP_TAC \\
3735 MATCH_MP_TAC mono_increasing_converges_to_sup \\
3736 simp [GSYM LIM_SEQUENTIALLY_SEQ] \\
3737 simp [mono_increasing_def, Abbr ‘f'’])
3738 >> DISCH_TAC
3739 >> Know ‘!x. sup (IMAGE (f' x) univ(:num)) = indicator s x’
3740 >- (rw [Abbr ‘f'’, GSYM REAL_LE_ANTISYM]
3741 >- (MATCH_MP_TAC REAL_IMP_SUP_LE' >> simp [Abbr ‘f’] \\
3742 RW_TAC std_ss [] \\
3743 MATCH_MP_TAC INDICATOR_MONO >> SET_TAC []) \\
3744 qmatch_abbrev_tac ‘(r :real) <= sup p’ \\
3745 (* applying REAL_LE_SUP' *)
3746 Know ‘r <= sup p <=> !y. (!z. z IN p ==> z <= y) ==> r <= y’
3747 >- (MATCH_MP_TAC REAL_LE_SUP' \\
3748 CONJ_TAC >- rw [Once EXTENSION, Abbr ‘p’] \\
3749 Q.EXISTS_TAC ‘1’ \\
3750 rw [Abbr ‘p’, Abbr ‘f’] \\
3751 REWRITE_TAC [DROP_INDICATOR_LE_1]) >> Rewr' \\
3752 rw [Abbr ‘p’, Abbr ‘r’, Abbr ‘f’] \\
3753 Know ‘!n. indicator (s INTER line n) x <= y’
3754 >- (Q.X_GEN_TAC ‘n’ \\
3755 POP_ASSUM MATCH_MP_TAC \\
3756 Q.EXISTS_TAC ‘n’ >> REFL_TAC) >> DISCH_TAC \\
3757 STRIP_ASSUME_TAC (Q.SPEC ‘x’ REAL_IN_LINE) \\
3758 Suff ‘indicator s x = indicator (s INTER line n) x’ >- rw [] \\
3759 rw [indicator])
3760 >> DISCH_THEN (fs o wrap)
3761 >> Q.PAT_X_ASSUM ‘!x. x NOTIN N ==> (f' x --> indicator s x) sequentially’ K_TAC
3762 >> qunabbrev_tac ‘f'’
3763 (* stage work *)
3764 >> Suff ‘(indicator s has_integral y) UNIV’
3765 >- METIS_TAC [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
3766 >> Know ‘(indicator s has_integral y) UNIV <=> (g has_integral y) UNIV’
3767 >- (MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ \\
3768 Q.EXISTS_TAC ‘N’ >> rw [])
3769 >> Rewr'
3770 >> simp [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
3771QED
3772
3773val lemma_fn_seq_finite_measure_tactics =
3774 ‘s IN measurable_sets lborel’ by simp [sets_lborel]
3775 >> ‘s IN measurable_sets lebesgue’
3776 by METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue]
3777 >> Cases_on ‘negligible s’
3778 >- (‘lmeasure s = 0’ by PROVE_TAC [negligible_iff_lmeasure_zero] \\
3779 ‘lambda s = 0’ by PROVE_TAC [lambda_eq_lebesgue] \\
3780 ASM_SIMP_TAC std_ss [extreal_of_num_def, extreal_not_infty])
3781 >> simp [lambda_eq_lebesgue]
3782 >> CCONTR_TAC >> fs [lebesgue_def]
3783 (* NOTE: Here "infinite measure" actually means that the (finite) measure of
3784 ‘s INTER line n’ can be bigger than any given (positive) value. We find a
3785 big enough N such that ‘s INTER line N’ is big enough for all discussions
3786 about ‘lmeasure s’. If c <= f x for x IN s, then f cannot have integral y
3787 on UNIV, because even on ‘s INTER line N’ its integration is bigger than
3788 c * lmeasure (s INTER line N) > c * (y / c) = y.
3789 *)
3790 >> Know ‘!z. ?N. z < integral (line N) (indicator s)’
3791 >- (Q.X_GEN_TAC ‘z’ \\
3792 POP_ASSUM MP_TAC \\
3793 rw [GSYM le_infty, le_sup'] \\
3794 POP_ASSUM (MP_TAC o Q.SPEC ‘Normal z’) \\
3795 rw [le_infty, extreal_not_le] \\
3796 fs [extreal_lt_eq] \\
3797 rename1 ‘z < integral (line N) (indicator s)’ \\
3798 Q.EXISTS_TAC ‘N’ >> art [])
3799 >> POP_ASSUM K_TAC
3800 >> DISCH_THEN (STRIP_ASSUME_TAC o Q.SPEC ‘y / c’) (* this asserts ‘N’ *)
3801 >> ‘c <> 0’ by PROVE_TAC [REAL_LT_IMP_NE]
3802 >> Know ‘y / c * c < integral (line N) (indicator s) * c’
3803 >- (MATCH_MP_TAC REAL_LT_RMUL_IMP >> art [])
3804 >> simp [REAL_DIV_RMUL, REAL_NOT_LT]
3805 >> Q.PAT_X_ASSUM ‘y / c < integral (line N) (indicator s)’ K_TAC
3806 >> Know ‘c * integral (line N) (indicator s) =
3807 integral (line N) (\x. c * indicator s x)’
3808 >- (SYM_TAC >> MATCH_MP_TAC INTEGRAL_CMUL >> art [])
3809 >> Rewr'
3810 >> Know ‘(\x. c * indicator s x) integrable_on line N’
3811 >- (MATCH_MP_TAC INTEGRABLE_CMUL >> art [])
3812 >> DISCH_TAC
3813 >> Q.PAT_X_ASSUM ‘!a b. f integrable_on interval [a,b]’
3814 (MP_TAC o Q.SPECL [‘-&N’, ‘&N’])
3815 >> simp [GSYM line_def]
3816 >> DISCH_TAC
3817 >> ‘?z. (f has_integral z) (line N)’ by PROVE_TAC [integrable_on]
3818 >> Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘z’
3819 >> reverse CONJ_TAC
3820 >- (MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE \\
3821 qexistsl_tac [‘f’, ‘line N’, ‘UNIV’] >> simp [])
3822 >> ‘z = integral (line N) f’ by PROVE_TAC [INTEGRAL_HAS_INTEGRAL]
3823 >> POP_ORW
3824 (* applying INTEGRAL_MONO_LEMMA *)
3825 >> MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> simp []
3826 >> CONJ_TAC
3827 >- (rpt STRIP_TAC \\
3828 MATCH_MP_TAC REAL_LE_MUL \\
3829 simp [INDICATOR_POS, REAL_LT_IMP_LE])
3830 >> rw [indicator];
3831
3832(* NOTE: This lemma assumes “f integrable_on univ(:real)” and can only be
3833 proved under gauge integration (harder).
3834 *)
3835Theorem lemma_fn_seq_finite_measure1_alt[local] :
3836 !f k n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
3837 f integrable_on univ(:real) /\
3838 k < 4 ** n /\ k <> 0 ==>
3839 lambda {x | &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n} <>
3840 PosInf
3841Proof
3842 RW_TAC std_ss []
3843 >> Know ‘!a b. f integrable_on interval [a,b]’
3844 >- (rpt GEN_TAC >> MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
3845 Q.EXISTS_TAC ‘UNIV’ >> simp [])
3846 >> DISCH_TAC
3847 >> Q.PAT_X_ASSUM ‘f integrable_on univ(:real)’
3848 (STRIP_ASSUME_TAC o REWRITE_RULE [integrable_on]) (* this asserts ‘y’ *)
3849 >> Know ‘0 <= y’
3850 >- (MATCH_MP_TAC HAS_INTEGRAL_DROP_POS \\
3851 qexistsl_tac [‘f’, ‘UNIV’] >> simp [])
3852 >> DISCH_TAC
3853 >> qmatch_abbrev_tac ‘lambda s <> PosInf’
3854 >> ‘!x. x IN s ==> &k / 2 pow n <= f x’ by rw [Abbr ‘s’]
3855 >> qabbrev_tac ‘c :real = &k / 2 pow n’
3856 >> Know ‘0 < c’
3857 >- (qunabbrev_tac ‘c’ \\
3858 MATCH_MP_TAC REAL_LT_DIV >> simp [POW_POS_LT])
3859 >> DISCH_TAC
3860 >> Know ‘s IN subsets borel’
3861 >- (qunabbrev_tac ‘s’ \\
3862 MATCH_MP_TAC
3863 (SRULE [sigma_algebra_borel, space_borel]
3864 (ISPEC “borel” in_borel_measurable_ge_lt_imp)) >> art [])
3865 >> DISCH_TAC
3866 >> lemma_fn_seq_finite_measure_tactics
3867QED
3868
3869Theorem lemma_fn_seq_finite_measure2_alt[local] :
3870 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
3871 f integrable_on univ(:real) ==>
3872 lambda {x | 2 pow n <= f x} <> PosInf
3873Proof
3874 RW_TAC std_ss []
3875 >> Know ‘!a b. f integrable_on interval [a,b]’
3876 >- (rpt GEN_TAC >> MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL \\
3877 Q.EXISTS_TAC ‘UNIV’ >> simp [])
3878 >> DISCH_TAC
3879 >> Q.PAT_X_ASSUM ‘f integrable_on univ(:real)’
3880 (STRIP_ASSUME_TAC o REWRITE_RULE [integrable_on]) (* this asserts ‘y’ *)
3881 >> Know ‘0 <= y’
3882 >- (MATCH_MP_TAC HAS_INTEGRAL_DROP_POS \\
3883 qexistsl_tac [‘f’, ‘UNIV’] >> simp [])
3884 >> DISCH_TAC
3885 >> qmatch_abbrev_tac ‘lambda s <> PosInf’
3886 >> ‘!x. x IN s ==> 2 pow n <= f x’ by rw [Abbr ‘s’]
3887 >> qabbrev_tac ‘c :real = 2 pow n’
3888 >> Know ‘0 < c’
3889 >- (qunabbrev_tac ‘c’ \\
3890 MATCH_MP_TAC REAL_POW_LT >> simp [])
3891 >> DISCH_TAC
3892 >> Know ‘s IN subsets borel’
3893 >- (qunabbrev_tac ‘s’ \\
3894 MATCH_MP_TAC
3895 (iffLR (SRULE [sigma_algebra_borel, space_borel, IN_FUNSET]
3896 (ISPECL [“f :real -> real”, “borel”]
3897 in_borel_measurable_ge))) >> art [])
3898 >> DISCH_TAC
3899 >> lemma_fn_seq_finite_measure_tactics
3900QED
3901
3902Theorem finite_lmeasure_has_integral_indicator :
3903 !s y. s IN measurable_sets lebesgue /\ lmeasure s = Normal y ==>
3904 (indicator s has_integral y) UNIV
3905Proof
3906 rpt STRIP_TAC
3907 >> REWRITE_TAC [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
3908 >> MATCH_MP_TAC finite_lmeasure_imp_integral_indicator >> art []
3909QED
3910
3911Theorem integrable_sets_iff_finite_measure :
3912 !s. s IN integrable_sets UNIV <=>
3913 s IN measurable_sets lebesgue /\ lmeasure s <> PosInf
3914Proof
3915 Q.X_GEN_TAC ‘s’ >> EQ_TAC
3916 >- (rpt STRIP_TAC >- METIS_TAC [integrable_sets_subset_lebesgue, SUBSET_DEF] \\
3917 ‘lmeasure s = Normal (integral univ(:real) (indicator s))’
3918 by PROVE_TAC [integrable_indicator_imp_lmeasure] >> fs [])
3919 >> rpt STRIP_TAC
3920 >> Know ‘lmeasure s <> NegInf’
3921 >- (MATCH_MP_TAC pos_not_neginf \\
3922 MATCH_MP_TAC MEASURE_POSITIVE \\
3923 simp [measure_space_lebesgue])
3924 >> DISCH_TAC
3925 >> ‘?r. lmeasure s = Normal r’ by METIS_TAC [extreal_cases]
3926 >> simp [integrable_sets_def]
3927 >> MATCH_MP_TAC (cj 1 finite_lmeasure_imp_integral_indicator)
3928 >> Q.EXISTS_TAC ‘r’ >> art []
3929QED
3930
3931Theorem finite_lmeasure_has_integral_indicator_real :
3932 !s. s IN measurable_sets lebesgue /\ lmeasure s <> PosInf ==>
3933 (indicator s has_integral (real (lmeasure s))) UNIV
3934Proof
3935 rpt STRIP_TAC
3936 >> Know ‘lmeasure s <> NegInf’
3937 >- (MATCH_MP_TAC pos_not_neginf \\
3938 MATCH_MP_TAC MEASURE_POSITIVE \\
3939 simp [measure_space_lebesgue])
3940 >> DISCH_TAC
3941 >> ‘?r. lmeasure s = Normal r’ by METIS_TAC [extreal_cases]
3942 >> MP_TAC (Q.SPECL [‘s’, ‘r’] finite_lmeasure_has_integral_indicator) >> rw []
3943QED
3944
3945(* |- !s. s IN integrable_sets univ(:real) ==>
3946 (indicator s has_integral real (lmeasure s)) univ(:real)
3947 *)
3948Theorem integrable_sets_has_integral_indicator_real =
3949 finite_lmeasure_has_integral_indicator_real
3950 |> REWRITE_RULE [GSYM integrable_sets_iff_finite_measure]
3951
3952(* cf. HAS_INTEGRAL_SUM *)
3953Theorem HAS_INTEGRAL_SIGMA :
3954 !f i s t. FINITE t /\ (!a. a IN t ==> (f a has_integral i a) s) ==>
3955 ((\x. SIGMA (\a. f a x) t) has_integral SIGMA i t) s
3956Proof
3957 rpt STRIP_TAC
3958 >> simp [REAL_SUM_IMAGE_sum]
3959 >> MATCH_MP_TAC HAS_INTEGRAL_SUM >> art []
3960QED
3961
3962Theorem real_fn_seq_has_integral :
3963 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
3964 pos_fn_integral lborel (Normal o f) <> PosInf ==>
3965 (real_fn_seq lborel f n has_integral real_fn_seq_integral f n) UNIV
3966Proof
3967 RW_TAC std_ss [real_fn_seq_def, real_fn_seq_integral_def, space_lborel, IN_UNIV]
3968 >> HO_MATCH_MP_TAC HAS_INTEGRAL_ADD
3969 >> reverse CONJ_TAC
3970 >- (HO_MATCH_MP_TAC HAS_INTEGRAL_CMUL \\
3971 MP_TAC (Q.SPECL [‘f’, ‘n’] lemma_fn_seq_finite_measure2') >> rw [] \\
3972 qabbrev_tac ‘s = {x | 2 pow n <= f x}’ \\
3973 ‘(\x. indicator s x) = indicator s’ by rw [FUN_EQ_THM] >> POP_ORW \\
3974 Know ‘s IN subsets borel’
3975 >- (qunabbrev_tac ‘s’ \\
3976 MATCH_MP_TAC real_fn_seq_lemma2 >> art []) >> DISCH_TAC \\
3977 gs [lambda_eq_lebesgue] \\
3978 MATCH_MP_TAC finite_lmeasure_has_integral_indicator_real >> art [] \\
3979 METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue, sets_lborel])
3980 (* stage work *)
3981 >> HO_MATCH_MP_TAC HAS_INTEGRAL_SIGMA
3982 >> SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT]
3983 >> Q.X_GEN_TAC ‘j’ >> DISCH_TAC
3984 >> Cases_on ‘j = 0’ >- simp [HAS_INTEGRAL_0]
3985 >> HO_MATCH_MP_TAC HAS_INTEGRAL_CMUL
3986 >> qabbrev_tac ‘s = {x | &j / 2 pow n <= f x /\ f x < (&j + 1) / 2 pow n}’
3987 >> ‘(\x. indicator s x) = indicator s’ by rw [FUN_EQ_THM] >> POP_ORW
3988 >> Know ‘s IN subsets borel’
3989 >- (qunabbrev_tac ‘s’ \\
3990 MATCH_MP_TAC real_fn_seq_lemma1 >> art [])
3991 >> DISCH_TAC
3992 >> gs [lambda_eq_lebesgue]
3993 >> MATCH_MP_TAC finite_lmeasure_has_integral_indicator_real
3994 >> CONJ_TAC >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue, sets_lborel]
3995 >> MP_TAC (Q.SPECL [‘f’, ‘j’, ‘n’] lemma_fn_seq_finite_measure1')
3996 >> simp [lambda_eq_lebesgue]
3997QED
3998
3999Theorem real_fn_seq_has_integral_alt :
4000 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4001 f integrable_on univ(:real) ==>
4002 (real_fn_seq lborel f n has_integral real_fn_seq_integral f n) UNIV
4003Proof
4004 RW_TAC std_ss [real_fn_seq_def, real_fn_seq_integral_def, space_lborel, IN_UNIV]
4005 >> HO_MATCH_MP_TAC HAS_INTEGRAL_ADD
4006 >> reverse CONJ_TAC
4007 >- (HO_MATCH_MP_TAC HAS_INTEGRAL_CMUL \\
4008 MP_TAC (Q.SPECL [‘f’, ‘n’] lemma_fn_seq_finite_measure2_alt) >> rw [] \\
4009 qabbrev_tac ‘s = {x | 2 pow n <= f x}’ \\
4010 ‘(\x. indicator s x) = indicator s’ by rw [FUN_EQ_THM] >> POP_ORW \\
4011 Know ‘s IN subsets borel’
4012 >- (qunabbrev_tac ‘s’ \\
4013 MATCH_MP_TAC real_fn_seq_lemma2 >> art []) >> DISCH_TAC \\
4014 gs [lambda_eq_lebesgue] \\
4015 MATCH_MP_TAC finite_lmeasure_has_integral_indicator_real >> art [] \\
4016 METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue, sets_lborel])
4017 (* stage work *)
4018 >> HO_MATCH_MP_TAC HAS_INTEGRAL_SIGMA
4019 >> SIMP_TAC std_ss [FINITE_COUNT, IN_COUNT]
4020 >> Q.X_GEN_TAC ‘j’ >> DISCH_TAC
4021 >> Cases_on ‘j = 0’ >- simp [HAS_INTEGRAL_0]
4022 >> HO_MATCH_MP_TAC HAS_INTEGRAL_CMUL
4023 >> qabbrev_tac ‘s = {x | &j / 2 pow n <= f x /\ f x < (&j + 1) / 2 pow n}’
4024 >> ‘(\x. indicator s x) = indicator s’ by rw [FUN_EQ_THM] >> POP_ORW
4025 >> Know ‘s IN subsets borel’
4026 >- (qunabbrev_tac ‘s’ \\
4027 MATCH_MP_TAC real_fn_seq_lemma1 >> art [])
4028 >> DISCH_TAC
4029 >> gs [lambda_eq_lebesgue]
4030 >> MATCH_MP_TAC finite_lmeasure_has_integral_indicator_real
4031 >> CONJ_TAC >- METIS_TAC [SUBSET_DEF, lborel_subset_lebesgue, sets_lborel]
4032 >> MP_TAC (Q.SPECL [‘f’, ‘j’, ‘n’] lemma_fn_seq_finite_measure1_alt)
4033 >> simp [lambda_eq_lebesgue]
4034QED
4035
4036Theorem real_fn_seq_integral_alt_fn_seq_integral :
4037 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4038 pos_fn_integral lborel (Normal o f) <> PosInf ==>
4039 real_fn_seq_integral f n = real (fn_seq_integral lborel (Normal o f) n)
4040Proof
4041 RW_TAC std_ss [real_fn_seq_integral_def, fn_seq_integral_def, space_lborel,
4042 IN_UNIV]
4043 >> qabbrev_tac ‘nf = Normal o f’
4044 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4045 >> Know ‘nf IN Borel_measurable borel’
4046 >- (qunabbrev_tac ‘nf’ \\
4047 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4048 simp [sigma_algebra_borel])
4049 >> DISCH_TAC
4050 >> ‘2 pow n = Normal (2 pow n)’
4051 by rw [extreal_of_num_def, extreal_pow_def] >> POP_ORW
4052 >> ‘2 pow n <> (0 :real)’ by simp []
4053 >> ASM_SIMP_TAC std_ss [extreal_of_num_def, extreal_div_eq, extreal_le_eq,
4054 extreal_lt_eq, extreal_add_eq]
4055 >> qabbrev_tac ‘c = \k. (&k / 2 pow n) :real’
4056 >> ‘!k. 0 <= c k’ by rw [Abbr ‘c’]
4057 >> qabbrev_tac ‘A = \k. {x | &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n}’
4058 >> Know ‘!k. (A k) IN subsets borel’
4059 >- (RW_TAC std_ss [Abbr ‘A’, Abbr ‘c’] \\
4060 MATCH_MP_TAC real_fn_seq_lemma1 >> art [])
4061 >> DISCH_TAC
4062 >> qabbrev_tac ‘B = {x | 2 pow n <= f x}’
4063 >> Know ‘B IN subsets borel’
4064 >- (qunabbrev_tac ‘B’ \\
4065 MATCH_MP_TAC real_fn_seq_lemma2 >> art [])
4066 >> DISCH_TAC
4067 >> qabbrev_tac ‘s = count (4 ** n)’
4068 >> ‘FINITE s’ by simp [Abbr ‘s’]
4069 >> ASM_SIMP_TAC std_ss []
4070 >> Know ‘SIGMA (\k. Normal (c k) * lambda (A k)) s =
4071 SIGMA (\k. Normal (c k) * Normal (lambda' (A k))) s’
4072 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\
4073 reverse CONJ_TAC
4074 >- (DISJ1_TAC \\
4075 Q.X_GEN_TAC ‘i’ >> simp [Abbr ‘s’] >> DISCH_TAC \\
4076 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf (* 2 subgoals, same tactics *)
4077 >- (MATCH_MP_TAC le_mul \\
4078 CONJ_TAC >- simp [extreal_of_num_def] \\
4079 MATCH_MP_TAC MEASURE_POSITIVE \\
4080 simp [lborel_def, sets_lborel]) \\
4081 Cases_on ‘i = 0’ >- simp [Abbr ‘c’, extreal_mul_eq] \\
4082 MATCH_MP_TAC le_mul \\
4083 CONJ_TAC >- simp [extreal_of_num_def] \\
4084 Know ‘0 <= lambda (A i)’
4085 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
4086 simp [lborel_def, sets_lborel]) >> DISCH_TAC \\
4087 Suff ‘Normal (real (lambda (A i))) = lambda (A i)’
4088 >- (Rewr' >> art []) \\
4089 MATCH_MP_TAC normal_real \\
4090 CONJ_TAC >- simp [pos_not_neginf] \\
4091 POP_ASSUM K_TAC \\
4092 SIMP_TAC std_ss [Abbr ‘A’] \\
4093 MATCH_MP_TAC lemma_fn_seq_finite_measure1' >> simp []) \\
4094 Q.X_GEN_TAC ‘i’ >> simp [Abbr ‘s’] >> DISCH_TAC \\
4095 Cases_on ‘i = 0’ >- simp [Abbr ‘c’, normal_0] \\
4096 Suff ‘Normal (lambda' (A i)) = lambda (A i)’ >- simp [] \\
4097 MATCH_MP_TAC normal_real \\
4098 Know ‘0 <= lambda (A i)’
4099 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
4100 simp [lborel_def, sets_lborel]) >> DISCH_TAC \\
4101 CONJ_TAC >- simp [pos_not_neginf] \\
4102 POP_ASSUM K_TAC \\
4103 SIMP_TAC std_ss [Abbr ‘A’] \\
4104 MATCH_MP_TAC lemma_fn_seq_finite_measure1' >> simp [])
4105 >> Rewr'
4106 >> Know ‘lambda B = Normal (lambda' B)’
4107 >- (SYM_TAC >> MATCH_MP_TAC normal_real \\
4108 Know ‘0 <= lambda B’
4109 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
4110 simp [lborel_def, sets_lborel]) >> DISCH_TAC \\
4111 CONJ_TAC >- simp [pos_not_neginf] \\
4112 SIMP_TAC std_ss [Abbr ‘B’] \\
4113 MATCH_MP_TAC lemma_fn_seq_finite_measure2' >> simp [])
4114 >> Rewr'
4115 >> simp [extreal_mul_eq]
4116 >> Know ‘SIGMA (\k. Normal (c k * lambda' (A k))) s =
4117 Normal (SIGMA (\k. c k * lambda' (A k)) s)’
4118 >- (HO_MATCH_MP_TAC EXTREAL_SUM_IMAGE_NORMAL >> art [])
4119 >> Rewr'
4120 >> simp [extreal_add_eq]
4121QED
4122
4123Theorem real_fn_seq_integral_alt_fn_seq_integral_alt :
4124 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4125 f integrable_on UNIV ==>
4126 fn_seq_integral lborel (Normal o f) n <> PosInf /\
4127 real_fn_seq_integral f n = real (fn_seq_integral lborel (Normal o f) n)
4128Proof
4129 rpt GEN_TAC
4130 >> ASM_SIMP_TAC bool_ss
4131 [real_fn_seq_integral_def, fn_seq_integral_def, space_lborel, IN_UNIV]
4132 >> STRIP_TAC
4133 >> qabbrev_tac ‘nf = Normal o f’
4134 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4135 >> Know ‘nf IN Borel_measurable borel’
4136 >- (qunabbrev_tac ‘nf’ \\
4137 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4138 simp [sigma_algebra_borel])
4139 >> DISCH_TAC
4140 >> ‘2 pow n = Normal (2 pow n)’
4141 by rw [extreal_of_num_def, extreal_pow_def] >> POP_ORW
4142 >> ‘2 pow n <> (0 :real)’ by simp []
4143 >> ASM_SIMP_TAC std_ss [extreal_of_num_def, extreal_div_eq, extreal_le_eq,
4144 extreal_lt_eq, extreal_add_eq, Abbr ‘nf’]
4145 >> qabbrev_tac ‘c = \k. (&k / 2 pow n) :real’
4146 >> ‘!k. 0 <= c k’ by rw [Abbr ‘c’]
4147 >> qabbrev_tac ‘A = \k. {x | &k / 2 pow n <= f x /\ f x < (&k + 1) / 2 pow n}’
4148 >> Know ‘!k. (A k) IN subsets borel’
4149 >- (RW_TAC std_ss [Abbr ‘A’, Abbr ‘c’] \\
4150 MATCH_MP_TAC real_fn_seq_lemma1 >> art [])
4151 >> DISCH_TAC
4152 >> qabbrev_tac ‘B = {x | 2 pow n <= f x}’
4153 >> Know ‘B IN subsets borel’
4154 >- (qunabbrev_tac ‘B’ \\
4155 MATCH_MP_TAC real_fn_seq_lemma2 >> art [])
4156 >> DISCH_TAC
4157 >> qabbrev_tac ‘s = count (4 ** n)’
4158 >> ‘FINITE s’ by simp [Abbr ‘s’]
4159 >> ASM_SIMP_TAC std_ss []
4160 >> Know ‘SIGMA (\k. Normal (c k) * lambda (A k)) s =
4161 SIGMA (\k. Normal (c k) * Normal (lambda' (A k))) s’
4162 >- (irule EXTREAL_SUM_IMAGE_EQ >> art [] \\
4163 reverse CONJ_TAC
4164 >- (DISJ1_TAC \\
4165 Q.X_GEN_TAC ‘i’ >> simp [Abbr ‘s’] >> DISCH_TAC \\
4166 CONJ_TAC >> MATCH_MP_TAC pos_not_neginf (* 2 subgoals, same tactics *)
4167 >- (MATCH_MP_TAC le_mul \\
4168 CONJ_TAC >- simp [extreal_of_num_def] \\
4169 MATCH_MP_TAC MEASURE_POSITIVE \\
4170 simp [lborel_def, sets_lborel]) \\
4171 Cases_on ‘i = 0’ >- simp [Abbr ‘c’, extreal_mul_eq] \\
4172 MATCH_MP_TAC le_mul \\
4173 CONJ_TAC >- simp [extreal_of_num_def] \\
4174 Know ‘0 <= lambda (A i)’
4175 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
4176 simp [lborel_def, sets_lborel]) >> DISCH_TAC \\
4177 Suff ‘Normal (real (lambda (A i))) = lambda (A i)’
4178 >- (Rewr' >> art []) \\
4179 MATCH_MP_TAC normal_real \\
4180 CONJ_TAC >- simp [pos_not_neginf] \\
4181 POP_ASSUM K_TAC \\
4182 SIMP_TAC std_ss [Abbr ‘A’] \\
4183 MATCH_MP_TAC lemma_fn_seq_finite_measure1_alt >> simp []) \\
4184 Q.X_GEN_TAC ‘i’ >> simp [Abbr ‘s’] >> DISCH_TAC \\
4185 Cases_on ‘i = 0’ >- simp [Abbr ‘c’, normal_0] \\
4186 Suff ‘Normal (lambda' (A i)) = lambda (A i)’ >- simp [] \\
4187 MATCH_MP_TAC normal_real \\
4188 Know ‘0 <= lambda (A i)’
4189 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
4190 simp [lborel_def, sets_lborel]) >> DISCH_TAC \\
4191 CONJ_TAC >- simp [pos_not_neginf] \\
4192 POP_ASSUM K_TAC \\
4193 SIMP_TAC std_ss [Abbr ‘A’] \\
4194 MATCH_MP_TAC lemma_fn_seq_finite_measure1_alt >> simp [])
4195 >> Rewr'
4196 >> Know ‘lambda B = Normal (lambda' B)’
4197 >- (SYM_TAC >> MATCH_MP_TAC normal_real \\
4198 Know ‘0 <= lambda B’
4199 >- (MATCH_MP_TAC MEASURE_POSITIVE \\
4200 simp [lborel_def, sets_lborel]) >> DISCH_TAC \\
4201 CONJ_TAC >- simp [pos_not_neginf] \\
4202 SIMP_TAC std_ss [Abbr ‘B’] \\
4203 MATCH_MP_TAC lemma_fn_seq_finite_measure2_alt >> simp [])
4204 >> Rewr'
4205 >> simp [extreal_mul_eq]
4206 >> Know ‘SIGMA (\k. Normal (c k * lambda' (A k))) s =
4207 Normal (SIGMA (\k. c k * lambda' (A k)) s)’
4208 >- (HO_MATCH_MP_TAC EXTREAL_SUM_IMAGE_NORMAL >> art [])
4209 >> Rewr'
4210 >> simp [extreal_add_eq]
4211QED
4212
4213Theorem fn_seq_integral_alt_real_fn_seq_integral :
4214 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4215 pos_fn_integral lborel (Normal o f) <> PosInf ==>
4216 fn_seq_integral lborel (Normal o f) n = Normal (real_fn_seq_integral f n)
4217Proof
4218 rw [real_fn_seq_integral_alt_fn_seq_integral]
4219 >> SYM_TAC
4220 >> MATCH_MP_TAC normal_real
4221 >> qabbrev_tac ‘nf = Normal o f’
4222 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4223 >> Know ‘nf IN Borel_measurable borel’
4224 >- (qunabbrev_tac ‘nf’ \\
4225 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4226 simp [sigma_algebra_borel])
4227 >> DISCH_TAC
4228 >> CONJ_TAC
4229 >- (MATCH_MP_TAC pos_not_neginf \\
4230 MATCH_MP_TAC fn_seq_integral_positive \\
4231 simp [lborel_def, measure_space_lborel])
4232 (* applying pos_fn_integral_fn_seq *)
4233 >> Know ‘fn_seq_integral lborel nf n =
4234 pos_fn_integral lborel (fn_seq lborel nf n)’
4235 >- (SYM_TAC >> MATCH_MP_TAC pos_fn_integral_fn_seq \\
4236 simp [lborel_def, measure_space_lborel])
4237 >> Rewr'
4238 >> REWRITE_TAC [lt_infty]
4239 >> Q_TAC (TRANS_TAC let_trans) ‘pos_fn_integral lborel nf’
4240 >> reverse CONJ_TAC >- art [GSYM lt_infty]
4241 >> MATCH_MP_TAC pos_fn_integral_mono
4242 >> simp [space_lborel, lemma_fn_seq_positive, lemma_fn_seq_upper_bounded]
4243QED
4244
4245Theorem fn_seq_integral_alt_real_fn_seq_integral_alt :
4246 !f n. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4247 f integrable_on UNIV ==>
4248 fn_seq_integral lborel (Normal o f) n = Normal (real_fn_seq_integral f n)
4249Proof
4250 rw [Once EQ_SYM_EQ]
4251 >> MP_TAC (Q.SPECL [‘f’, ‘n’] real_fn_seq_integral_alt_fn_seq_integral_alt)
4252 >> RW_TAC std_ss []
4253 >> MATCH_MP_TAC normal_real >> art []
4254 >> qabbrev_tac ‘nf = Normal o f’
4255 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4256 >> Know ‘nf IN Borel_measurable borel’
4257 >- (qunabbrev_tac ‘nf’ \\
4258 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4259 simp [sigma_algebra_borel])
4260 >> DISCH_TAC
4261 >> MATCH_MP_TAC pos_not_neginf
4262 >> MATCH_MP_TAC fn_seq_integral_positive
4263 >> simp [lborel_def, measure_space_lborel]
4264QED
4265
4266Theorem fn_seq_integral_mono_increasing :
4267 !m f. measure_space m /\ f IN Borel_measurable (measurable_space m) /\
4268 (!x. x IN m_space m ==> 0 <= f x) ==>
4269 mono_increasing (fn_seq_integral m f)
4270Proof
4271 rpt STRIP_TAC
4272 >> simp [ext_mono_increasing_def]
4273 >> qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC
4274 >> Know ‘!n. fn_seq_integral m f n = pos_fn_integral m (fn_seq m f n)’
4275 >- (Q.X_GEN_TAC ‘n’ \\
4276 SYM_TAC >> MATCH_MP_TAC pos_fn_integral_fn_seq >> art [])
4277 >> Rewr'
4278 >> MATCH_MP_TAC pos_fn_integral_mono
4279 >> simp [lemma_fn_seq_positive']
4280 >> rpt STRIP_TAC
4281 >> MP_TAC (Q.SPECL [‘m’, ‘f’, ‘x’] lemma_fn_seq_mono_increasing)
4282 >> rw [ext_mono_increasing_def]
4283QED
4284
4285Theorem real_fn_seq_integral_mono_increasing :
4286 !f. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4287 pos_fn_integral lborel (Normal o f) <> PosInf ==>
4288 mono_increasing (real_fn_seq_integral f)
4289Proof
4290 rw [mono_increasing_def]
4291 >> simp [real_fn_seq_integral_alt_fn_seq_integral]
4292 >> MATCH_MP_TAC le_real_imp
4293 >> qabbrev_tac ‘nf = Normal o f’
4294 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4295 >> Know ‘nf IN Borel_measurable borel’
4296 >- (qunabbrev_tac ‘nf’ \\
4297 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4298 simp [sigma_algebra_borel])
4299 >> DISCH_TAC
4300 >> CONJ_TAC
4301 >- (MATCH_MP_TAC fn_seq_integral_positive >> simp [lborel_def])
4302 >> CONJ_TAC
4303 >- (MP_TAC (ISPECL [“lborel”, “nf :real -> extreal”]
4304 fn_seq_integral_mono_increasing) \\
4305 rw [lborel_def, ext_mono_increasing_def])
4306 >> Know ‘fn_seq_integral lborel nf n =
4307 pos_fn_integral lborel (fn_seq lborel nf n)’
4308 >- (SYM_TAC >> MATCH_MP_TAC pos_fn_integral_fn_seq \\
4309 simp [lborel_def])
4310 >> Rewr'
4311 >> REWRITE_TAC [lt_infty]
4312 >> Q_TAC (TRANS_TAC let_trans) ‘pos_fn_integral lborel nf’
4313 >> simp [GSYM lt_infty]
4314 >> MATCH_MP_TAC pos_fn_integral_mono
4315 >> simp [lemma_fn_seq_positive, lemma_fn_seq_upper_bounded, space_lborel]
4316QED
4317
4318Theorem real_fn_seq_integral_mono_increasing_alt :
4319 !f. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4320 f integrable_on UNIV ==>
4321 mono_increasing (real_fn_seq_integral f)
4322Proof
4323 rw [mono_increasing_def]
4324 >> MP_TAC (Q.SPECL [‘f’, ‘m’] real_fn_seq_integral_alt_fn_seq_integral_alt)
4325 >> RW_TAC std_ss []
4326 >> MP_TAC (Q.SPECL [‘f’, ‘n’] real_fn_seq_integral_alt_fn_seq_integral_alt)
4327 >> RW_TAC std_ss []
4328 >> MATCH_MP_TAC le_real_imp >> art []
4329 >> qabbrev_tac ‘nf = Normal o f’
4330 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4331 >> Know ‘nf IN Borel_measurable borel’
4332 >- (qunabbrev_tac ‘nf’ \\
4333 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4334 simp [sigma_algebra_borel])
4335 >> DISCH_TAC
4336 >> CONJ_TAC
4337 >- (MATCH_MP_TAC fn_seq_integral_positive >> simp [lborel_def])
4338 >> MP_TAC (ISPECL [“lborel”, “nf :real -> extreal”]
4339 fn_seq_integral_mono_increasing)
4340 >> rw [lborel_def, ext_mono_increasing_def]
4341QED
4342
4343(* NOTE: first we prove the equivalence for bounded positive functions *)
4344Theorem lebesgue_eq_gauge_integral_positive_bounded :
4345 !f. f IN borel_measurable borel /\
4346 (!x. 0 <= f x) /\ bounded (IMAGE f UNIV) /\
4347 pos_fn_integral lborel (Normal o f) <> PosInf ==>
4348 f integrable_on UNIV /\
4349 pos_fn_integral lborel (Normal o f) = Normal (integral UNIV f)
4350Proof
4351 Q.X_GEN_TAC ‘f’
4352 >> simp [bounded_alt] >> STRIP_TAC
4353 >> qabbrev_tac ‘nf = Normal o f’
4354 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4355 >> Know ‘nf IN Borel_measurable borel’
4356 >- (qunabbrev_tac ‘nf’ \\
4357 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4358 simp [sigma_algebra_borel])
4359 >> DISCH_TAC
4360 (* applying integral_sequence *)
4361 >> MP_TAC (ISPECL [“lborel”, “nf :real -> extreal”] integral_sequence)
4362 >> impl_tac >- simp [lborel_def, space_lborel]
4363 >> Rewr'
4364 >> qabbrev_tac ‘fi = fn_seq lborel nf’
4365 >> Know ‘f = \x. real (sup (IMAGE (\n. fi n x) UNIV))’
4366 >- (rw [FUN_EQ_THM, Abbr ‘fi’] \\
4367 MP_TAC (ISPECL [“lborel”, “nf :real -> extreal”] lemma_fn_seq_sup) \\
4368 rw [lborel_def, space_lborel] \\
4369 simp [Abbr ‘nf’, o_DEF, real_normal])
4370 >> Rewr'
4371 >> qunabbrev_tac ‘fi’
4372 >> Know ‘!i. pos_fn_integral lborel (fn_seq lborel nf i) =
4373 fn_seq_integral lborel nf i’
4374 >- (Q.X_GEN_TAC ‘n’ \\
4375 MATCH_MP_TAC pos_fn_integral_fn_seq >> rw [lborel_def])
4376 >> DISCH_TAC
4377 >> Know ‘!i. fn_seq_integral lborel nf i <= pos_fn_integral lborel nf’
4378 >- (Q.X_GEN_TAC ‘i’ \\
4379 POP_ASSUM (simp o wrap o GSYM) \\
4380 MATCH_MP_TAC pos_fn_integral_mono \\
4381 simp [space_lborel, lemma_fn_seq_positive] \\
4382 Q.X_GEN_TAC ‘x’ \\
4383 MATCH_MP_TAC lemma_fn_seq_upper_bounded \\
4384 rw [Abbr ‘nf’, o_DEF])
4385 >> DISCH_TAC
4386 >> Q.PAT_X_ASSUM ‘!i. pos_fn_integral lborel (fn_seq lborel nf i) = _’
4387 (REWRITE_TAC o wrap)
4388 >> qabbrev_tac ‘fn = \n x. real (fn_seq lborel nf n x)’
4389 (* applying sup_normal (NOTE: “bounded (IMAGE f UNIV)” is used here) *)
4390 >> qabbrev_tac ‘s = \x. IMAGE (\n. fn_seq lborel nf n x) UNIV’ >> simp []
4391 >> Know ‘!x. sup (s x) = Normal (sup (s x o Normal))’
4392 >- (rw [Once EQ_SYM_EQ] \\
4393 MATCH_MP_TAC sup_normal \\
4394 Q.EXISTS_TAC ‘a’ >> rw [abs_bounds] (* 2 subgoals *)
4395 >- (rw [Abbr ‘s’, le_sup'] \\
4396 Q_TAC (TRANS_TAC le_trans) ‘0’ \\
4397 CONJ_TAC >- simp [extreal_of_num_def, extreal_ainv_def] \\
4398 Q_TAC (TRANS_TAC le_trans) ‘fn_seq lborel nf 0 x’ \\
4399 reverse CONJ_TAC
4400 >- (POP_ASSUM MATCH_MP_TAC \\
4401 Q.EXISTS_TAC ‘0’ >> art []) \\
4402 MATCH_MP_TAC lemma_fn_seq_positive >> art []) \\
4403 rw [Abbr ‘s’, sup_le'] \\
4404 Q_TAC (TRANS_TAC le_trans) ‘nf x’ \\
4405 CONJ_TAC >- (MATCH_MP_TAC lemma_fn_seq_upper_bounded >> art []) \\
4406 rw [Abbr ‘nf’, o_DEF] \\
4407 Suff ‘abs (f x) <= a’ >- simp [ABS_BOUNDS] \\
4408 FIRST_X_ASSUM MATCH_MP_TAC \\
4409 Q.EXISTS_TAC ‘x’ >> art [])
4410 >> Rewr'
4411 >> simp [real_normal, Abbr ‘s’]
4412 >> Know ‘!x. IMAGE (\n. fn_seq lborel nf n x) UNIV o Normal =
4413 IMAGE (\n. fn n x) UNIV’
4414 >- (Q.X_GEN_TAC ‘y’ >> rw [Once EXTENSION, o_DEF] \\
4415 EQ_TAC >> rw [Abbr ‘fn’]
4416 >- (Q.EXISTS_TAC ‘n’ \\
4417 POP_ASSUM (simp o wrap o SYM)) \\
4418 Q.EXISTS_TAC ‘n’ \\
4419 MATCH_MP_TAC normal_real \\
4420 CONJ_TAC
4421 >- (MATCH_MP_TAC pos_not_neginf \\
4422 MATCH_MP_TAC lemma_fn_seq_positive >> art []) \\
4423 REWRITE_TAC [lt_infty] \\
4424 Q_TAC (TRANS_TAC let_trans) ‘nf y’ \\
4425 CONJ_TAC >- (MATCH_MP_TAC lemma_fn_seq_upper_bounded >> art []) \\
4426 simp [Abbr ‘nf’, o_DEF])
4427 >> Rewr'
4428 >> MP_TAC (Q.SPECL [‘fn’, ‘UNIV’] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING)
4429 >> simp []
4430 >> ‘fn = (\n x. real_fn_seq lborel f n x)’
4431 by rw [Abbr ‘fn’, Abbr ‘nf’, fn_seq_alt_real_fn_seq, FUN_EQ_THM]
4432 >> POP_ORW
4433 >> simp [Abbr ‘fn’]
4434 >> ‘!k. (\x. real_fn_seq lborel f k x) = real_fn_seq lborel f k’
4435 by rw [FUN_EQ_THM] >> POP_ORW
4436 (* applying lemma_real_fn_seq_mono_increasing *)
4437 >> Know ‘!k x. real_fn_seq lborel f k x <= real_fn_seq lborel f (SUC k) x’
4438 >- (rpt GEN_TAC \\
4439 MP_TAC (Q.SPECL [‘f’, ‘x’]
4440 (Q.ISPEC ‘lborel’ lemma_real_fn_seq_mono_increasing)) \\
4441 rw [mono_increasing_def])
4442 >> Rewr
4443 (* applying real_fn_seq_has_integral *)
4444 >> Know ‘!n. (real_fn_seq lborel f n has_integral real_fn_seq_integral f n)
4445 univ(:real)’
4446 >- (Q.X_GEN_TAC ‘n’ \\
4447 MATCH_MP_TAC real_fn_seq_has_integral >> simp [])
4448 >> simp [HAS_INTEGRAL_INTEGRABLE_INTEGRAL, FORALL_AND_THM]
4449 >> STRIP_TAC
4450 (* applying lemma_real_fn_seq_upper_bounded *)
4451 >> impl_tac (* bounded *)
4452 >- (rw [bounded_def] \\
4453 Know ‘0 <= pos_fn_integral lborel nf’
4454 >- (MATCH_MP_TAC pos_fn_integral_pos >> simp [lborel_def, space_lborel]) \\
4455 DISCH_TAC \\
4456 ‘pos_fn_integral lborel nf <> NegInf’ by simp [pos_not_neginf] \\
4457 ‘?r. pos_fn_integral lborel nf = Normal r’ by METIS_TAC [extreal_cases] \\
4458 Q.EXISTS_TAC ‘r’ >> rw [] \\
4459 Know ‘abs (real_fn_seq_integral f k) = real_fn_seq_integral f k’
4460 >- simp [ABS_REFL, real_fn_seq_integral_positive] >> Rewr' \\
4461 Know ‘real_fn_seq_integral f k =
4462 real (fn_seq_integral lborel (Normal o f) k)’
4463 >- (MATCH_MP_TAC real_fn_seq_integral_alt_fn_seq_integral \\
4464 simp []) >> Rewr' \\
4465 ‘r = real (pos_fn_integral lborel nf)’ by simp [real_normal] >> POP_ORW \\
4466 POP_ASSUM K_TAC >> simp [] \\
4467 MATCH_MP_TAC le_real_imp >> simp [] \\
4468 MATCH_MP_TAC fn_seq_integral_positive >> simp [lborel_def])
4469 >> STRIP_TAC (* this asserts g and k (negligible) *)
4470 >> rename1 ‘negligible E’
4471 >> ‘(\k. real_fn_seq_integral f k) = real_fn_seq_integral f’ by rw [FUN_EQ_THM]
4472 >> POP_ASSUM (fs o wrap)
4473 >> qabbrev_tac ‘h = flip (real_fn_seq lborel f)’
4474 >> ‘!x. (\k. real_fn_seq lborel f k x) = h x’ by rw [Abbr ‘h’, FUN_EQ_THM]
4475 >> POP_ASSUM (fs o wrap)
4476 (* applying mono_increasing_converges_to_sup *)
4477 >> Know ‘!x. x NOTIN E ==> g x = sup (IMAGE (h x) UNIV)’
4478 >- (rpt STRIP_TAC \\
4479 MATCH_MP_TAC mono_increasing_converges_to_sup \\
4480 simp [GSYM LIM_SEQUENTIALLY_SEQ] \\
4481 simp [Abbr ‘h’, combinTheory.C_DEF, lemma_real_fn_seq_mono_increasing])
4482 >> DISCH_TAC
4483 >> Q.PAT_X_ASSUM ‘!x. x NOTIN E ==> (h x --> g x) sequentially’ K_TAC
4484 >> Know ‘integral univ(:real) (\x. sup (IMAGE (h x) univ(:num))) =
4485 integral univ(:real) g’
4486 >- (MATCH_MP_TAC INTEGRAL_SPIKE \\
4487 Q.EXISTS_TAC ‘E’ >> simp [])
4488 >> Rewr'
4489 >> CONJ_TAC
4490 >- (irule INTEGRABLE_SPIKE \\
4491 qexistsl_tac [‘g’, ‘E’] >> simp [])
4492 >> Know ‘!n. fn_seq_integral lborel nf n = Normal (real_fn_seq_integral f n)’
4493 >- (rw [Abbr ‘nf’] \\
4494 MATCH_MP_TAC fn_seq_integral_alt_real_fn_seq_integral >> art [])
4495 >> Rewr'
4496 (* applying sup_image_normal, again *)
4497 >> Know ‘IMAGE (\i. Normal (real_fn_seq_integral f i)) UNIV =
4498 IMAGE Normal {real_fn_seq_integral f n | n | T}’
4499 >- (rw [Once EXTENSION] \\
4500 EQ_TAC >> rw [] >| (* 2 subgoals *)
4501 [ Q.EXISTS_TAC ‘i’ >> REFL_TAC,
4502 Q.EXISTS_TAC ‘n’ >> REFL_TAC ])
4503 >> Rewr'
4504 >> qmatch_abbrev_tac ‘sup (IMAGE Normal s) = Normal r’
4505 >> Know ‘sup (IMAGE Normal s) = Normal (sup s)’
4506 >- (MATCH_MP_TAC sup_image_normal \\
4507 CONJ_TAC >- rw [Abbr ‘s’, Once EXTENSION] \\
4508 rw [bounded_def, Abbr ‘s’] \\
4509 Q.EXISTS_TAC ‘real (pos_fn_integral lborel nf)’ >> rw [] \\
4510 Know ‘abs (real_fn_seq_integral f n) = real_fn_seq_integral f n’
4511 >- rw [ABS_REFL, real_fn_seq_integral_positive] >> Rewr' \\
4512 Know ‘real_fn_seq_integral f n = real (fn_seq_integral lborel nf n)’
4513 >- (qunabbrev_tac ‘nf’ \\
4514 MATCH_MP_TAC real_fn_seq_integral_alt_fn_seq_integral >> simp []) \\
4515 Rewr' \\
4516 MATCH_MP_TAC le_real_imp >> art [] \\
4517 MATCH_MP_TAC fn_seq_integral_positive >> simp [lborel_def])
4518 >> Rewr'
4519 >> REWRITE_TAC [extreal_11]
4520 (* applying mono_increasing_converges_to_sup, yet again *)
4521 >> SYM_TAC >> simp [Abbr ‘s’]
4522 >> ‘{real_fn_seq_integral f n | n | T} = IMAGE (real_fn_seq_integral f) UNIV’
4523 by rw [Once EXTENSION] >> POP_ORW
4524 >> MATCH_MP_TAC mono_increasing_converges_to_sup
4525 >> simp [GSYM LIM_SEQUENTIALLY_SEQ, real_fn_seq_integral_mono_increasing]
4526QED
4527
4528(* NOTE: removed “bounded (IMAGE f UNIV)” from the above result *)
4529Theorem lebesgue_eq_gauge_integral_positive :
4530 !f. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4531 pos_fn_integral lborel (Normal o f) <> PosInf ==>
4532 f integrable_on UNIV /\
4533 pos_fn_integral lborel (Normal o f) = Normal (integral UNIV f)
4534Proof
4535 rpt GEN_TAC >> STRIP_TAC
4536 >> qabbrev_tac ‘nf = Normal o f’
4537 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4538 >> Know ‘nf IN Borel_measurable borel’
4539 >- (qunabbrev_tac ‘nf’ \\
4540 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4541 simp [sigma_algebra_borel])
4542 >> DISCH_TAC
4543 >> qabbrev_tac ‘g = \n x. min (f x) &n’
4544 >> ‘!n x. 0 <= g n x’ by rw [Abbr ‘g’, REAL_LE_MIN]
4545 >> Know ‘!n. bounded (IMAGE (g n) UNIV)’
4546 >- (rw [bounded_def] \\
4547 Q.EXISTS_TAC ‘&n’ \\
4548 Q.X_GEN_TAC ‘x’ \\
4549 DISCH_THEN (Q.X_CHOOSE_THEN ‘y’ STRIP_ASSUME_TAC) >> POP_ORW \\
4550 simp [ABS_REDUCE] \\
4551 simp [Abbr ‘g’, REAL_MIN_LE])
4552 >> DISCH_TAC
4553 >> Know ‘!n. g n IN borel_measurable borel’
4554 >- (rw [Abbr ‘g’] \\
4555 HO_MATCH_MP_TAC in_borel_measurable_min >> simp [sigma_algebra_borel] \\
4556 MATCH_MP_TAC in_borel_measurable_const \\
4557 Q.EXISTS_TAC ‘&n’ >> simp [sigma_algebra_borel])
4558 >> DISCH_TAC
4559 >> ‘!n x. g n x <= f x’ by rw [Abbr ‘g’, REAL_MIN_LE]
4560 >> qabbrev_tac ‘ng = \n. Normal o g n’
4561 >> ‘!n x. 0 <= ng n x’ by rw [Abbr ‘ng’, o_DEF, extreal_of_num_def]
4562 >> ‘!n x. ng n x <= nf x’ by rw [Abbr ‘ng’, Abbr ‘nf’, REAL_MIN_LE]
4563 >> Know ‘!n. ng n IN Borel_measurable borel’
4564 >- (rw [Abbr ‘ng’] \\
4565 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4566 simp [sigma_algebra_borel])
4567 >> DISCH_TAC
4568 >> Know ‘!x. mono_increasing (\i. ng i x)’
4569 >- (Q.X_GEN_TAC ‘x’ \\
4570 simp [ext_mono_increasing_def, Abbr ‘ng’, o_DEF] \\
4571 qx_genl_tac [‘i’, ‘j’] >> rw [Abbr ‘g’] \\
4572 MATCH_MP_TAC REAL_IMP_MIN_LE2 >> simp [])
4573 >> DISCH_TAC
4574 >> Know ‘!n. pos_fn_integral lborel (ng n) <> PosInf’
4575 >- (rw [lt_infty] \\
4576 Q_TAC (TRANS_TAC let_trans) ‘pos_fn_integral lborel nf’ \\
4577 simp [GSYM lt_infty] \\
4578 MATCH_MP_TAC pos_fn_integral_mono >> simp [])
4579 >> DISCH_TAC
4580 (* applying lebesgue_eq_gauge_integral_positive_bounded *)
4581 >> Know ‘!n. g n integrable_on UNIV /\
4582 pos_fn_integral lborel (ng n) = Normal (integral univ(:real) (g n))’
4583 >- (Q.X_GEN_TAC ‘n’ >> fs [Abbr ‘ng’] \\
4584 MATCH_MP_TAC lebesgue_eq_gauge_integral_positive_bounded >> simp [])
4585 >> DISCH_THEN (STRIP_ASSUME_TAC o SRULE [FORALL_AND_THM])
4586 (* applying lebesgue_monotone_convergence *)
4587 >> Know ‘pos_fn_integral lborel nf =
4588 sup (IMAGE (\i. pos_fn_integral lborel (ng i)) UNIV)’
4589 >- (MATCH_MP_TAC lebesgue_monotone_convergence \\
4590 simp [lborel_def, space_lborel] \\
4591 NTAC 5 (POP_ASSUM K_TAC) (* irrelevant assumptions *) \\
4592 Q.X_GEN_TAC ‘x’ >> rw [sup_eq'] >- art [] \\
4593 Know ‘!n. ng n x <= y’
4594 >- (Q.X_GEN_TAC ‘n’ >> POP_ASSUM MATCH_MP_TAC \\
4595 Q.EXISTS_TAC ‘n’ >> REFL_TAC) \\
4596 POP_ASSUM K_TAC \\
4597 simp [Abbr ‘ng’, Abbr ‘nf’, o_DEF, Abbr ‘g’] \\
4598 Cases_on ‘y = PosInf’ >- simp [] \\
4599 Cases_on ‘y = NegInf’ >- simp [] \\
4600 ‘?r. y = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4601 simp [] \\
4602 CCONTR_TAC >> fs [REAL_NOT_LE] \\
4603 STRIP_ASSUME_TAC (Q.SPEC ‘r’ SIMP_REAL_ARCH) \\
4604 Q.PAT_X_ASSUM ‘!n. min (f x) (&n) <= r’ (MP_TAC o Q.SPEC ‘SUC n’) \\
4605 simp [REAL_LT_MIN, REAL_NOT_LE] \\
4606 Q_TAC (TRANS_TAC REAL_LET_TRANS) ‘&n’ >> simp [])
4607 >> Rewr'
4608 (* applying MONOTONE_CONVERGENCE_INCREASING *)
4609 >> MP_TAC (Q.SPECL [‘g’, ‘f’, ‘UNIV’] MONOTONE_CONVERGENCE_INCREASING) >> simp []
4610 >> impl_tac
4611 >- (CONJ_TAC
4612 >- (qx_genl_tac [‘n’, ‘x’] \\
4613 Q.PAT_X_ASSUM ‘!x. mono_increasing (\i. ng i x)’ (MP_TAC o Q.SPEC ‘x’) \\
4614 rw [ext_mono_increasing_def, Abbr ‘ng’, o_DEF]) \\
4615 reverse CONJ_TAC
4616 >- (rw [bounded_def] \\
4617 Q.EXISTS_TAC ‘real (pos_fn_integral lborel nf)’ >> rw [] \\
4618 Know ‘abs (integral univ(:real) (g k)) = integral univ(:real) (g k)’
4619 >- (REWRITE_TAC [ABS_REFL] \\
4620 MATCH_MP_TAC INTEGRAL_POS >> rw []) >> Rewr' \\
4621 ONCE_REWRITE_TAC [GSYM extreal_le_eq] \\
4622 Know ‘Normal (real (pos_fn_integral lborel nf)) =
4623 pos_fn_integral lborel nf’
4624 >- (MATCH_MP_TAC normal_real >> art [] \\
4625 MATCH_MP_TAC pos_not_neginf \\
4626 MATCH_MP_TAC pos_fn_integral_pos \\
4627 simp [measure_space_lborel]) >> Rewr' \\
4628 POP_ASSUM (REWRITE_TAC o wrap o GSYM) \\
4629 MATCH_MP_TAC pos_fn_integral_mono >> simp [space_lborel]) \\
4630 rw [LIM_SEQUENTIALLY, dist, Abbr ‘g’] \\
4631 STRIP_ASSUME_TAC (Q.SPEC ‘f (x :real)’ SIMP_REAL_ARCH) \\
4632 Q.EXISTS_TAC ‘n’ >> rpt STRIP_TAC \\
4633 Know ‘min (f x) (&k) = f x’
4634 >- (MATCH_MP_TAC (cj 1 REAL_MIN_REDUCE) >> DISJ1_TAC \\
4635 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘&n’ >> simp []) >> Rewr' \\
4636 simp [])
4637 >> RW_TAC std_ss []
4638 (* applying sup_image_normal *)
4639 >> Know ‘IMAGE (\i. Normal (integral UNIV (g i))) UNIV =
4640 IMAGE Normal {integral UNIV (g n) | n | T}’
4641 >- (rw [Once EXTENSION] \\
4642 EQ_TAC >> rw [] >| (* 2 subgoals *)
4643 [ Q.EXISTS_TAC ‘i’ >> REFL_TAC,
4644 Q.EXISTS_TAC ‘n’ >> REFL_TAC ])
4645 >> Rewr'
4646 (* applying sup_image_normal *)
4647 >> qmatch_abbrev_tac ‘sup (IMAGE Normal s) = Normal r’
4648 >> Know ‘sup (IMAGE Normal s) = Normal (sup s)’
4649 >- (MATCH_MP_TAC sup_image_normal \\
4650 CONJ_TAC >- rw [Abbr ‘s’, Once EXTENSION] \\
4651 rw [bounded_def, Abbr ‘s’] \\
4652 Q.EXISTS_TAC ‘integral UNIV f’ >> rw [] \\
4653 Know ‘abs (integral UNIV (g n)) = integral UNIV (g n)’
4654 >- (REWRITE_TAC [ABS_REFL] \\
4655 MATCH_MP_TAC INTEGRAL_POS >> simp []) >> Rewr' \\
4656 qunabbrev_tac ‘r’ \\
4657 MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> simp [])
4658 >> Rewr'
4659 >> REWRITE_TAC [extreal_11]
4660 (* applying mono_increasing_converges_to_sup *)
4661 >> SYM_TAC >> simp [Abbr ‘s’]
4662 >> ‘{integral UNIV (g n) | n | T} = IMAGE (\n. integral UNIV (g n)) UNIV’
4663 by rw [Once EXTENSION] >> POP_ORW
4664 >> MATCH_MP_TAC mono_increasing_converges_to_sup
4665 >> simp [GSYM LIM_SEQUENTIALLY_SEQ]
4666 (* final goal (easy) *)
4667 >> simp [mono_increasing_def]
4668 >> qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC
4669 >> MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> rw []
4670 >> Q.PAT_X_ASSUM ‘!x. mono_increasing (\i. ng i x)’ (MP_TAC o Q.SPEC ‘x’)
4671 >> rw [ext_mono_increasing_def, o_DEF, Abbr ‘ng’]
4672QED
4673
4674Theorem fn_plus_normal :
4675 !f. fn_plus (Normal o f) = Normal o fn_plus f
4676Proof
4677 rw [FUN_EQ_THM, fn_plus, o_DEF, real_fn_plus_def]
4678 >> simp [extreal_of_num_def, extreal_max_eq]
4679QED
4680
4681Theorem fn_minus_normal :
4682 !f. fn_minus (Normal o f) = Normal o fn_minus f
4683Proof
4684 rw [FUN_EQ_THM, fn_minus, o_DEF, real_fn_minus_def]
4685 >> simp [extreal_of_num_def, extreal_min_eq, extreal_ainv_def]
4686QED
4687
4688Theorem lebesgue_eq_gauge_integral :
4689 !f. integrable lborel (Normal o f) ==>
4690 f absolutely_integrable_on UNIV /\
4691 integral lborel (Normal o f) = Normal (integral UNIV f)
4692Proof
4693 Q.X_GEN_TAC ‘f’
4694 >> simp [integrable_def, lebesgueTheory.integral_def,
4695 fn_plus_normal, fn_minus_normal, lborel_def]
4696 >> STRIP_TAC
4697 >> Know ‘real o (Normal o f) IN borel_measurable borel’
4698 >- (MATCH_MP_TAC in_borel_measurable_from_Borel \\
4699 simp [sigma_algebra_borel])
4700 >> ‘real o Normal o f = f’ by rw [FUN_EQ_THM, o_DEF, real_normal] >> POP_ORW
4701 >> DISCH_TAC
4702 >> Know ‘f absolutely_integrable_on UNIV <=>
4703 (\x. fn_plus f x - fn_minus f x) absolutely_integrable_on UNIV’
4704 >- (Suff ‘(\x. fn_plus f x - fn_minus f x) = f’ >- Rewr \\
4705 rw [FUN_EQ_THM, GSYM fn_decompose])
4706 >> Rewr'
4707 >> Know ‘integral UNIV f = integral UNIV (\x. fn_plus f x - fn_minus f x)’
4708 >- (Suff ‘(\x. fn_plus f x - fn_minus f x) = f’ >- Rewr \\
4709 rw [FUN_EQ_THM, GSYM fn_decompose])
4710 >> Rewr'
4711 >> Know ‘fn_plus f IN borel_measurable borel’
4712 >- (‘fn_plus f = \x. max 0 (f x)’ by rw [FUN_EQ_THM, real_fn_plus_def] \\
4713 POP_ORW \\
4714 HO_MATCH_MP_TAC in_borel_measurable_max >> simp [sigma_algebra_borel] \\
4715 MATCH_MP_TAC in_borel_measurable_const \\
4716 Q.EXISTS_TAC ‘0’ >> simp [sigma_algebra_borel])
4717 >> DISCH_TAC
4718 >> Know ‘fn_minus f IN borel_measurable borel’
4719 >- (‘fn_minus f = \x. -min 0 (f x)’ by rw [FUN_EQ_THM, real_fn_minus_def] \\
4720 POP_ORW \\
4721 HO_MATCH_MP_TAC in_borel_measurable_ainv >> simp [sigma_algebra_borel] \\
4722 HO_MATCH_MP_TAC in_borel_measurable_min >> simp [sigma_algebra_borel] \\
4723 MATCH_MP_TAC in_borel_measurable_const \\
4724 Q.EXISTS_TAC ‘0’ >> simp [sigma_algebra_borel])
4725 >> DISCH_TAC
4726 >> qabbrev_tac ‘f1 = fn_plus f’
4727 >> qabbrev_tac ‘f2 = fn_minus f’
4728 >> ‘!x. 0 <= f1 x’ by rw [Abbr ‘f1’, real_fn_plus_pos]
4729 >> ‘!x. 0 <= f2 x’ by rw [Abbr ‘f2’, real_fn_minus_pos]
4730 (* applying lebesgue_eq_gauge_integral_positive, twice *)
4731 >> MP_TAC (Q.SPEC ‘f1’ lebesgue_eq_gauge_integral_positive)
4732 >> simp [] >> STRIP_TAC
4733 >> MP_TAC (Q.SPEC ‘f2’ lebesgue_eq_gauge_integral_positive)
4734 >> simp [] >> STRIP_TAC
4735 >> simp [extreal_sub_eq]
4736 >> reverse CONJ_TAC >- (SYM_TAC >> MATCH_MP_TAC INTEGRAL_SUB >> art [])
4737 >> MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB
4738 >> CONJ_TAC (* 2 subgoals, same tactics *)
4739 >> MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE >> simp []
4740QED
4741
4742(* NOTE: “pos_fn_integral lborel (Normal o f) <> PosInf” is automatically
4743 implied by “pos_fn_integral lborel (Normal o f) = Normal _”.
4744 *)
4745Theorem lebesgue_eq_gauge_integral_positive_bounded_alt :
4746 !f. f IN borel_measurable borel /\ f integrable_on UNIV /\
4747 (!x. 0 <= f x) /\ bounded (IMAGE f UNIV) ==>
4748 pos_fn_integral lborel (Normal o f) = Normal (integral UNIV f)
4749Proof
4750 Q.X_GEN_TAC ‘f’
4751 >> simp [bounded_alt] >> STRIP_TAC
4752 >> qabbrev_tac ‘nf = Normal o f’
4753 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4754 >> Know ‘nf IN Borel_measurable borel’
4755 >- (qunabbrev_tac ‘nf’ \\
4756 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4757 simp [sigma_algebra_borel])
4758 >> DISCH_TAC
4759 (* applying integral_sequence *)
4760 >> MP_TAC (ISPECL [“lborel”, “nf :real -> extreal”] integral_sequence)
4761 >> impl_tac >- simp [lborel_def, space_lborel]
4762 >> Rewr'
4763 >> qabbrev_tac ‘fi = fn_seq lborel nf’
4764 >> Know ‘f = \x. real (sup (IMAGE (\n. fi n x) UNIV))’
4765 >- (rw [FUN_EQ_THM, Abbr ‘fi’] \\
4766 MP_TAC (ISPECL [“lborel”, “nf :real -> extreal”] lemma_fn_seq_sup) \\
4767 rw [lborel_def, space_lborel] \\
4768 simp [Abbr ‘nf’, o_DEF, real_normal])
4769 >> Rewr'
4770 >> qunabbrev_tac ‘fi’
4771 >> Know ‘!i. pos_fn_integral lborel (fn_seq lborel nf i) =
4772 fn_seq_integral lborel nf i’
4773 >- (Q.X_GEN_TAC ‘n’ \\
4774 MATCH_MP_TAC pos_fn_integral_fn_seq >> rw [lborel_def])
4775 >> DISCH_TAC
4776 >> Know ‘!i. fn_seq_integral lborel nf i <= pos_fn_integral lborel nf’
4777 >- (Q.X_GEN_TAC ‘i’ \\
4778 POP_ASSUM (simp o wrap o GSYM) \\
4779 MATCH_MP_TAC pos_fn_integral_mono \\
4780 simp [space_lborel, lemma_fn_seq_positive] \\
4781 Q.X_GEN_TAC ‘x’ \\
4782 MATCH_MP_TAC lemma_fn_seq_upper_bounded \\
4783 rw [Abbr ‘nf’, o_DEF])
4784 >> DISCH_TAC
4785 >> Q.PAT_X_ASSUM ‘!i. pos_fn_integral lborel (fn_seq lborel nf i) = _’
4786 (REWRITE_TAC o wrap)
4787 >> qabbrev_tac ‘fn = \n x. real (fn_seq lborel nf n x)’
4788 (* applying sup_normal (NOTE: “bounded (IMAGE f UNIV)” is used here) *)
4789 >> qabbrev_tac ‘s = \x. IMAGE (\n. fn_seq lborel nf n x) UNIV’ >> simp []
4790 >> Know ‘!x. sup (s x) = Normal (sup (s x o Normal))’
4791 >- (rw [Once EQ_SYM_EQ] \\
4792 MATCH_MP_TAC sup_normal \\
4793 Q.EXISTS_TAC ‘a’ >> rw [abs_bounds] (* 2 subgoals *)
4794 >- (rw [Abbr ‘s’, le_sup'] \\
4795 Q_TAC (TRANS_TAC le_trans) ‘0’ \\
4796 CONJ_TAC >- simp [extreal_of_num_def, extreal_ainv_def] \\
4797 Q_TAC (TRANS_TAC le_trans) ‘fn_seq lborel nf 0 x’ \\
4798 reverse CONJ_TAC
4799 >- (POP_ASSUM MATCH_MP_TAC \\
4800 Q.EXISTS_TAC ‘0’ >> art []) \\
4801 MATCH_MP_TAC lemma_fn_seq_positive >> art []) \\
4802 rw [Abbr ‘s’, sup_le'] \\
4803 Q_TAC (TRANS_TAC le_trans) ‘nf x’ \\
4804 CONJ_TAC >- (MATCH_MP_TAC lemma_fn_seq_upper_bounded >> art []) \\
4805 rw [Abbr ‘nf’, o_DEF] \\
4806 Suff ‘abs (f x) <= a’ >- simp [ABS_BOUNDS] \\
4807 FIRST_X_ASSUM MATCH_MP_TAC \\
4808 Q.EXISTS_TAC ‘x’ >> art [])
4809 >> Rewr'
4810 >> simp [real_normal, Abbr ‘s’]
4811 >> Know ‘!x. IMAGE (\n. fn_seq lborel nf n x) UNIV o Normal =
4812 IMAGE (\n. fn n x) UNIV’
4813 >- (Q.X_GEN_TAC ‘y’ >> rw [Once EXTENSION, o_DEF] \\
4814 EQ_TAC >> rw [Abbr ‘fn’]
4815 >- (Q.EXISTS_TAC ‘n’ \\
4816 POP_ASSUM (simp o wrap o SYM)) \\
4817 Q.EXISTS_TAC ‘n’ \\
4818 MATCH_MP_TAC normal_real \\
4819 CONJ_TAC
4820 >- (MATCH_MP_TAC pos_not_neginf \\
4821 MATCH_MP_TAC lemma_fn_seq_positive >> art []) \\
4822 REWRITE_TAC [lt_infty] \\
4823 Q_TAC (TRANS_TAC let_trans) ‘nf y’ \\
4824 CONJ_TAC >- (MATCH_MP_TAC lemma_fn_seq_upper_bounded >> art []) \\
4825 simp [Abbr ‘nf’, o_DEF])
4826 >> Rewr'
4827 >> MP_TAC (Q.SPECL [‘fn’, ‘UNIV’] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING)
4828 >> simp []
4829 >> ‘fn = (\n x. real_fn_seq lborel f n x)’
4830 by rw [Abbr ‘fn’, Abbr ‘nf’, fn_seq_alt_real_fn_seq, FUN_EQ_THM]
4831 >> POP_ORW
4832 >> simp [Abbr ‘fn’]
4833 >> ‘!k. (\x. real_fn_seq lborel f k x) = real_fn_seq lborel f k’
4834 by rw [FUN_EQ_THM] >> POP_ORW
4835 (* applying lemma_real_fn_seq_mono_increasing *)
4836 >> Know ‘!k x. real_fn_seq lborel f k x <= real_fn_seq lborel f (SUC k) x’
4837 >- (rpt GEN_TAC \\
4838 MP_TAC (Q.SPECL [‘f’, ‘x’]
4839 (Q.ISPEC ‘lborel’ lemma_real_fn_seq_mono_increasing)) \\
4840 rw [mono_increasing_def])
4841 >> Rewr
4842 (* applying real_fn_seq_has_integral *)
4843 >> Know ‘!n. (real_fn_seq lborel f n has_integral real_fn_seq_integral f n)
4844 univ(:real)’
4845 >- (Q.X_GEN_TAC ‘n’ \\
4846 MATCH_MP_TAC real_fn_seq_has_integral_alt >> simp [])
4847 >> simp [HAS_INTEGRAL_INTEGRABLE_INTEGRAL, FORALL_AND_THM]
4848 >> STRIP_TAC
4849 (* applying lemma_real_fn_seq_upper_bounded *)
4850 >> impl_tac (* bounded *)
4851 >- (rw [bounded_def] \\
4852 Know ‘0 <= pos_fn_integral lborel nf’
4853 >- (MATCH_MP_TAC pos_fn_integral_pos >> simp [lborel_def, space_lborel]) \\
4854 DISCH_TAC \\
4855 Q.EXISTS_TAC ‘integral UNIV f’ >> rw [] \\
4856 Know ‘abs (real_fn_seq_integral f k) = real_fn_seq_integral f k’
4857 >- simp [ABS_REFL, real_fn_seq_integral_positive] >> Rewr' \\
4858 Q.PAT_X_ASSUM ‘!n. integral UNIV (real_fn_seq lborel f n) = _’
4859 (REWRITE_TAC o wrap o GSYM) \\
4860 MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> rw [lemma_real_fn_seq_upper_bounded] \\
4861 MATCH_MP_TAC lemma_real_fn_seq_positive >> art [])
4862 >> STRIP_TAC (* this asserts g and k (negligible) *)
4863 >> rename1 ‘negligible E’
4864 >> ‘(\k. real_fn_seq_integral f k) = real_fn_seq_integral f’ by rw [FUN_EQ_THM]
4865 >> POP_ASSUM (fs o wrap)
4866 >> qabbrev_tac ‘h = flip (real_fn_seq lborel f)’
4867 >> ‘!x. (\k. real_fn_seq lborel f k x) = h x’ by rw [Abbr ‘h’, FUN_EQ_THM]
4868 >> POP_ASSUM (fs o wrap)
4869 (* applying mono_increasing_converges_to_sup *)
4870 >> Know ‘!x. x NOTIN E ==> g x = sup (IMAGE (h x) UNIV)’
4871 >- (rpt STRIP_TAC \\
4872 MATCH_MP_TAC mono_increasing_converges_to_sup \\
4873 simp [GSYM LIM_SEQUENTIALLY_SEQ] \\
4874 simp [Abbr ‘h’, combinTheory.C_DEF, lemma_real_fn_seq_mono_increasing])
4875 >> DISCH_TAC
4876 >> Q.PAT_X_ASSUM ‘!x. x NOTIN E ==> (h x --> g x) sequentially’ K_TAC
4877 >> Know ‘integral univ(:real) (\x. sup (IMAGE (h x) univ(:num))) =
4878 integral univ(:real) g’
4879 >- (MATCH_MP_TAC INTEGRAL_SPIKE \\
4880 Q.EXISTS_TAC ‘E’ >> simp [])
4881 >> Rewr'
4882 >> Know ‘!n. fn_seq_integral lborel nf n = Normal (real_fn_seq_integral f n)’
4883 >- (rw [Abbr ‘nf’] \\
4884 MATCH_MP_TAC fn_seq_integral_alt_real_fn_seq_integral_alt >> art [])
4885 >> Rewr'
4886 (* applying sup_image_normal, again *)
4887 >> Know ‘IMAGE (\i. Normal (real_fn_seq_integral f i)) UNIV =
4888 IMAGE Normal {real_fn_seq_integral f n | n | T}’
4889 >- (rw [Once EXTENSION] \\
4890 EQ_TAC >> rw [] >| (* 2 subgoals *)
4891 [ Q.EXISTS_TAC ‘i’ >> REFL_TAC,
4892 Q.EXISTS_TAC ‘n’ >> REFL_TAC ])
4893 >> Rewr'
4894 >> qmatch_abbrev_tac ‘sup (IMAGE Normal s) = Normal r’
4895 >> Know ‘sup (IMAGE Normal s) = Normal (sup s)’
4896 >- (MATCH_MP_TAC sup_image_normal \\
4897 CONJ_TAC >- rw [Abbr ‘s’, Once EXTENSION] \\
4898 rw [bounded_def, Abbr ‘s’] \\
4899 Q.EXISTS_TAC ‘integral UNIV f’ >> rw [] \\
4900 Know ‘abs (real_fn_seq_integral f n) = real_fn_seq_integral f n’
4901 >- simp [ABS_REFL, real_fn_seq_integral_positive] >> Rewr' \\
4902 Q.PAT_X_ASSUM ‘!n. integral UNIV (real_fn_seq lborel f n) = _’
4903 (REWRITE_TAC o wrap o GSYM) \\
4904 MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> rw [lemma_real_fn_seq_upper_bounded] \\
4905 MATCH_MP_TAC lemma_real_fn_seq_positive >> art [])
4906 >> Rewr'
4907 >> simp []
4908 (* applying mono_increasing_converges_to_sup, yet again *)
4909 >> SYM_TAC >> simp [Abbr ‘s’]
4910 >> ‘{real_fn_seq_integral f n | n | T} = IMAGE (real_fn_seq_integral f) UNIV’
4911 by rw [Once EXTENSION] >> POP_ORW
4912 >> MATCH_MP_TAC mono_increasing_converges_to_sup
4913 >> simp [GSYM LIM_SEQUENTIALLY_SEQ, real_fn_seq_integral_mono_increasing_alt]
4914QED
4915
4916(* NOTE: removed “bounded (IMAGE f UNIV)” from the above result *)
4917Theorem lebesgue_eq_gauge_integral_positive_alt :
4918 !f. f IN borel_measurable borel /\ (!x. 0 <= f x) /\
4919 f integrable_on UNIV ==>
4920 pos_fn_integral lborel (Normal o f) = Normal (integral UNIV f)
4921Proof
4922 rpt GEN_TAC >> STRIP_TAC
4923 >> qabbrev_tac ‘nf = Normal o f’
4924 >> ‘!x. 0 <= nf x’ by rw [Abbr ‘nf’, o_DEF]
4925 >> Know ‘nf IN Borel_measurable borel’
4926 >- (qunabbrev_tac ‘nf’ \\
4927 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4928 simp [sigma_algebra_borel])
4929 >> DISCH_TAC
4930 >> qabbrev_tac ‘g = \n x. min (f x) &n’
4931 >> ‘!n x. 0 <= g n x’ by rw [Abbr ‘g’, REAL_LE_MIN]
4932 >> Know ‘!n. bounded (IMAGE (g n) UNIV)’
4933 >- (rw [bounded_def] \\
4934 Q.EXISTS_TAC ‘&n’ \\
4935 Q.X_GEN_TAC ‘x’ \\
4936 DISCH_THEN (Q.X_CHOOSE_THEN ‘y’ STRIP_ASSUME_TAC) >> POP_ORW \\
4937 simp [ABS_REDUCE] \\
4938 simp [Abbr ‘g’, REAL_MIN_LE])
4939 >> DISCH_TAC
4940 >> Know ‘!n. g n IN borel_measurable borel’
4941 >- (rw [Abbr ‘g’] \\
4942 HO_MATCH_MP_TAC in_borel_measurable_min >> simp [sigma_algebra_borel] \\
4943 MATCH_MP_TAC in_borel_measurable_const \\
4944 Q.EXISTS_TAC ‘&n’ >> simp [sigma_algebra_borel])
4945 >> DISCH_TAC
4946 >> ‘!n x. g n x <= f x’ by rw [Abbr ‘g’, REAL_MIN_LE]
4947 >> qabbrev_tac ‘ng = \n. Normal o g n’
4948 >> ‘!n x. 0 <= ng n x’ by rw [Abbr ‘ng’, o_DEF, extreal_of_num_def]
4949 >> ‘!n x. ng n x <= nf x’ by rw [Abbr ‘ng’, Abbr ‘nf’, REAL_MIN_LE]
4950 >> Know ‘!n. ng n IN Borel_measurable borel’
4951 >- (rw [Abbr ‘ng’] \\
4952 MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL' \\
4953 simp [sigma_algebra_borel])
4954 >> DISCH_TAC
4955 >> Know ‘!x. mono_increasing (\i. ng i x)’
4956 >- (Q.X_GEN_TAC ‘x’ \\
4957 simp [ext_mono_increasing_def, Abbr ‘ng’, o_DEF] \\
4958 qx_genl_tac [‘i’, ‘j’] >> rw [Abbr ‘g’] \\
4959 MATCH_MP_TAC REAL_IMP_MIN_LE2 >> simp [])
4960 >> DISCH_TAC
4961 (* NOTE: Here the proof diverges *)
4962 >> Know ‘!n. g n integrable_on univ(:real)’
4963 >- (rw [Abbr ‘g’] \\
4964 MATCH_MP_TAC INTEGRABLE_MIN_CONST >> simp [ETA_AX])
4965 >> DISCH_TAC
4966 (* applying lebesgue_eq_gauge_integral_positive_bounded *)
4967 >> Know ‘!n. pos_fn_integral lborel (ng n) = Normal (integral univ(:real) (g n))’
4968 >- (Q.X_GEN_TAC ‘n’ >> fs [Abbr ‘ng’] \\
4969 MATCH_MP_TAC lebesgue_eq_gauge_integral_positive_bounded_alt >> simp [])
4970 >> DISCH_TAC
4971 (* applying lebesgue_monotone_convergence *)
4972 >> Know ‘pos_fn_integral lborel nf =
4973 sup (IMAGE (\i. pos_fn_integral lborel (ng i)) UNIV)’
4974 >- (MATCH_MP_TAC lebesgue_monotone_convergence \\
4975 simp [lborel_def, space_lborel] \\
4976 Q.X_GEN_TAC ‘x’ >> rw [sup_eq'] >- art [] \\
4977 Know ‘!n. ng n x <= y’
4978 >- (Q.X_GEN_TAC ‘n’ >> POP_ASSUM MATCH_MP_TAC \\
4979 Q.EXISTS_TAC ‘n’ >> REFL_TAC) \\
4980 POP_ASSUM K_TAC \\
4981 simp [Abbr ‘ng’, Abbr ‘nf’, o_DEF, Abbr ‘g’] \\
4982 Cases_on ‘y = PosInf’ >- simp [] \\
4983 Cases_on ‘y = NegInf’ >- simp [] \\
4984 ‘?r. y = Normal r’ by METIS_TAC [extreal_cases] >> POP_ORW \\
4985 simp [] \\
4986 CCONTR_TAC >> fs [REAL_NOT_LE] \\
4987 STRIP_ASSUME_TAC (Q.SPEC ‘r’ SIMP_REAL_ARCH) \\
4988 Q.PAT_X_ASSUM ‘!n. min (f x) (&n) <= r’ (MP_TAC o Q.SPEC ‘SUC n’) \\
4989 simp [REAL_LT_MIN, REAL_NOT_LE] \\
4990 Q_TAC (TRANS_TAC REAL_LET_TRANS) ‘&n’ >> simp [])
4991 >> Rewr'
4992 (* applying MONOTONE_CONVERGENCE_INCREASING *)
4993 >> MP_TAC (Q.SPECL [‘g’, ‘f’, ‘UNIV’] MONOTONE_CONVERGENCE_INCREASING) >> simp []
4994 >> impl_tac
4995 >- (CONJ_TAC
4996 >- (qx_genl_tac [‘n’, ‘x’] \\
4997 Q.PAT_X_ASSUM ‘!x. mono_increasing (\i. ng i x)’ (MP_TAC o Q.SPEC ‘x’) \\
4998 rw [ext_mono_increasing_def, Abbr ‘ng’, o_DEF]) \\
4999 reverse CONJ_TAC
5000 >- (rw [bounded_def] \\
5001 Q.EXISTS_TAC ‘integral UNIV f’ >> rw [] \\
5002 Know ‘abs (integral univ(:real) (g k)) = integral univ(:real) (g k)’
5003 >- (REWRITE_TAC [ABS_REFL] \\
5004 MATCH_MP_TAC INTEGRAL_POS >> rw []) >> Rewr' \\
5005 MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> simp []) \\
5006 rw [LIM_SEQUENTIALLY, dist, Abbr ‘g’] \\
5007 STRIP_ASSUME_TAC (Q.SPEC ‘f (x :real)’ SIMP_REAL_ARCH) \\
5008 Q.EXISTS_TAC ‘n’ >> rpt STRIP_TAC \\
5009 Know ‘min (f x) (&k) = f x’
5010 >- (MATCH_MP_TAC (cj 1 REAL_MIN_REDUCE) >> DISJ1_TAC \\
5011 Q_TAC (TRANS_TAC REAL_LE_TRANS) ‘&n’ >> simp []) >> Rewr' \\
5012 simp [])
5013 >> RW_TAC std_ss []
5014 (* applying sup_image_normal *)
5015 >> Know ‘IMAGE (\i. Normal (integral UNIV (g i))) UNIV =
5016 IMAGE Normal {integral UNIV (g n) | n | T}’
5017 >- (rw [Once EXTENSION] \\
5018 EQ_TAC >> rw [] >| (* 2 subgoals *)
5019 [ Q.EXISTS_TAC ‘i’ >> REFL_TAC,
5020 Q.EXISTS_TAC ‘n’ >> REFL_TAC ])
5021 >> Rewr'
5022 (* applying sup_image_normal *)
5023 >> qmatch_abbrev_tac ‘sup (IMAGE Normal s) = Normal r’
5024 >> Know ‘sup (IMAGE Normal s) = Normal (sup s)’
5025 >- (MATCH_MP_TAC sup_image_normal \\
5026 CONJ_TAC >- rw [Abbr ‘s’, Once EXTENSION] \\
5027 rw [bounded_def, Abbr ‘s’] \\
5028 Q.EXISTS_TAC ‘integral UNIV f’ >> rw [] \\
5029 Know ‘abs (integral UNIV (g n)) = integral UNIV (g n)’
5030 >- (REWRITE_TAC [ABS_REFL] \\
5031 MATCH_MP_TAC INTEGRAL_POS >> simp []) >> Rewr' \\
5032 qunabbrev_tac ‘r’ \\
5033 MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> simp [])
5034 >> Rewr'
5035 >> REWRITE_TAC [extreal_11]
5036 (* applying mono_increasing_converges_to_sup *)
5037 >> SYM_TAC >> simp [Abbr ‘s’]
5038 >> ‘{integral UNIV (g n) | n | T} = IMAGE (\n. integral UNIV (g n)) UNIV’
5039 by rw [Once EXTENSION] >> POP_ORW
5040 >> MATCH_MP_TAC mono_increasing_converges_to_sup
5041 >> simp [GSYM LIM_SEQUENTIALLY_SEQ]
5042 (* final goal (easy) *)
5043 >> simp [mono_increasing_def]
5044 >> qx_genl_tac [‘i’, ‘j’] >> DISCH_TAC
5045 >> MATCH_MP_TAC INTEGRAL_MONO_LEMMA >> rw []
5046 >> Q.PAT_X_ASSUM ‘!x. mono_increasing (\i. ng i x)’ (MP_TAC o Q.SPEC ‘x’)
5047 >> rw [ext_mono_increasing_def, o_DEF, Abbr ‘ng’]
5048QED
5049
5050Theorem real_fn_plus_alt_abs :
5051 !f. real_fn_plus f = \x. 1 / 2 * (f x + abs (f x))
5052Proof
5053 rw [real_fn_plus_def, FUN_EQ_THM]
5054 >> Cases_on ‘0 <= f x’
5055 >- simp [ABS_REDUCE, REAL_DOUBLE, REAL_MAX_REDUCE]
5056 >> fs [REAL_NOT_LE, ABS_EQ_NEG]
5057 >> simp [REAL_MAX_REDUCE]
5058QED
5059
5060Theorem real_fn_minus_alt_abs :
5061 !f. real_fn_minus f = \x. 1 / 2 * (abs (f x) - f x)
5062Proof
5063 rw [real_fn_minus_def, FUN_EQ_THM]
5064 >> Cases_on ‘0 <= f x’
5065 >- simp [ABS_REDUCE, REAL_DOUBLE, REAL_MIN_REDUCE]
5066 >> fs [REAL_NOT_LE, ABS_EQ_NEG]
5067 >> simp [REAL_MIN_REDUCE]
5068 >> REAL_ARITH_TAC
5069QED
5070
5071(* NOTE: Don't know if “f IN borel_measurable borel” can be derived from
5072 “f absolutely_integrable_on UNIV”.
5073 *)
5074Theorem lebesgue_eq_gauge_integral_alt :
5075 !f. f IN borel_measurable borel /\ f absolutely_integrable_on UNIV ==>
5076 integrable lborel (Normal o f) /\
5077 integral lborel (Normal o f) = Normal (integral UNIV f)
5078Proof
5079 Q.X_GEN_TAC ‘f’
5080 >> simp [integrable_def, lebesgueTheory.integral_def, absolutely_integrable_on,
5081 fn_plus_normal, fn_minus_normal, lborel_def]
5082 >> STRIP_TAC
5083 >> Know ‘integral UNIV f = integral UNIV (\x. fn_plus f x - fn_minus f x)’
5084 >- (Suff ‘(\x. fn_plus f x - fn_minus f x) = f’ >- Rewr \\
5085 rw [FUN_EQ_THM, GSYM fn_decompose])
5086 >> Rewr'
5087 >> Know ‘fn_plus f IN borel_measurable borel’
5088 >- (‘fn_plus f = \x. max 0 (f x)’ by rw [FUN_EQ_THM, real_fn_plus_def] \\
5089 POP_ORW \\
5090 HO_MATCH_MP_TAC in_borel_measurable_max >> simp [sigma_algebra_borel] \\
5091 MATCH_MP_TAC in_borel_measurable_const \\
5092 Q.EXISTS_TAC ‘0’ >> simp [sigma_algebra_borel])
5093 >> DISCH_TAC
5094 >> Know ‘fn_minus f IN borel_measurable borel’
5095 >- (‘fn_minus f = \x. -min 0 (f x)’ by rw [FUN_EQ_THM, real_fn_minus_def] \\
5096 POP_ORW \\
5097 HO_MATCH_MP_TAC in_borel_measurable_ainv >> simp [sigma_algebra_borel] \\
5098 HO_MATCH_MP_TAC in_borel_measurable_min >> simp [sigma_algebra_borel] \\
5099 MATCH_MP_TAC in_borel_measurable_const \\
5100 Q.EXISTS_TAC ‘0’ >> simp [sigma_algebra_borel])
5101 >> DISCH_TAC
5102 >> qabbrev_tac ‘f1 = fn_plus f’
5103 >> qabbrev_tac ‘f2 = fn_minus f’
5104 >> ‘!x. 0 <= f1 x’ by rw [Abbr ‘f1’, real_fn_plus_pos]
5105 >> ‘!x. 0 <= f2 x’ by rw [Abbr ‘f2’, real_fn_minus_pos]
5106 >> Know ‘f1 integrable_on UNIV’
5107 >- (rw [Abbr ‘f1’, real_fn_plus_alt_abs] \\
5108 HO_MATCH_MP_TAC INTEGRABLE_CMUL \\
5109 HO_MATCH_MP_TAC INTEGRABLE_ADD >> art [])
5110 >> DISCH_TAC
5111 >> Know ‘f2 integrable_on UNIV’
5112 >- (rw [Abbr ‘f2’, real_fn_minus_alt_abs] \\
5113 HO_MATCH_MP_TAC INTEGRABLE_CMUL \\
5114 HO_MATCH_MP_TAC INTEGRABLE_SUB >> art [])
5115 >> DISCH_TAC
5116 (* applying lebesgue_eq_gauge_integral_positive, twice *)
5117 >> MP_TAC (Q.SPEC ‘f1’ lebesgue_eq_gauge_integral_positive_alt)
5118 >> simp [] >> STRIP_TAC
5119 >> MP_TAC (Q.SPEC ‘f2’ lebesgue_eq_gauge_integral_positive_alt)
5120 >> simp [] >> STRIP_TAC
5121 >> simp [extreal_sub_eq]
5122 >> reverse CONJ_TAC >- (SYM_TAC >> MATCH_MP_TAC INTEGRAL_SUB >> art [])
5123 >> MATCH_MP_TAC IN_MEASURABLE_BOREL_IMP_BOREL'
5124 >> simp [sigma_algebra_borel]
5125QED
5126
5127Theorem lebesgue_eq_gauge_integrable :
5128 !f. f IN borel_measurable borel ==>
5129 (integrable lborel (Normal o f) <=> f absolutely_integrable_on UNIV)
5130Proof
5131 rpt STRIP_TAC
5132 >> EQ_TAC >> DISCH_TAC
5133 >| [ (* goal 1 (of 2) *)
5134 MATCH_MP_TAC (cj 1 lebesgue_eq_gauge_integral) >> art [],
5135 (* goal 2 (of 2) *)
5136 MATCH_MP_TAC (cj 1 lebesgue_eq_gauge_integral_alt) >> art [] ]
5137QED
5138
5139Theorem FTC_integral_lborel :
5140 !f f' g a b. a <= b /\
5141 (!x. x IN interval [a,b] ==>
5142 (f has_vector_derivative f' x) (at x within interval [a,b])) /\
5143 f' IN borel_measurable borel /\
5144 (!x. g x = f' x * indicator (interval [a,b]) x) /\
5145 (integrable lborel (Normal o g) \/
5146 g absolutely_integrable_on UNIV) ==>
5147 integral lborel (Normal o g) = Normal (f b - f a)
5148Proof
5149 rpt GEN_TAC
5150 >> qabbrev_tac ‘P = (integrable lborel (Normal o g) \/
5151 g absolutely_integrable_on UNIV)’
5152 >> STRIP_TAC
5153 >> Q.PAT_X_ASSUM ‘!x. g x = _’ (ASSUME_TAC o GSYM)
5154 (* applying FTC *)
5155 >> MP_TAC (Q.SPECL [‘f’, ‘f'’, ‘a’, ‘b’] FUNDAMENTAL_THEOREM_OF_CALCULUS)
5156 >> simp [Once (GSYM HAS_INTEGRAL_MUL_INDICATOR)]
5157 >> simp [HAS_INTEGRAL_INTEGRABLE_INTEGRAL]
5158 >> STRIP_TAC
5159 >> POP_ASSUM (REWRITE_TAC o wrap o SYM)
5160 >> fs [Abbr ‘P’, SF ETA_ss]
5161 >| [ (* goal 1 (of 2) *)
5162 MATCH_MP_TAC (cj 2 lebesgue_eq_gauge_integral) >> art [],
5163 (* goal 2 (of 2) *)
5164 MATCH_MP_TAC (cj 2 lebesgue_eq_gauge_integral_alt) >> art [] \\
5165 Q.PAT_X_ASSUM ‘!x. _ = g x’ (ASSUME_TAC o GSYM) \\
5166 ‘g = \x. f' x * indicator (interval [(a,b)]) x’ by rw [FUN_EQ_THM] \\
5167 POP_ORW \\
5168 HO_MATCH_MP_TAC in_borel_measurable_mul_indicator \\
5169 simp [sigma_algebra_borel, CLOSED_interval, borel_measurable_sets] ]
5170QED
5171
5172(* References:
5173
5174 [1] Schilling, R.L.: Measures, Integrals and Martingales (Second Edition).
5175 Cambridge University Press (2017).
5176 [2] Bartle, R.G.: A Modern Theory of Integration. American Math. Soc. (2001).
5177 [5] Wikipedia: https://en.wikipedia.org/wiki/Henri_Lebesgue
5178 *)