Update from HH
[hl193./.git] / 100 / fourier.ml
1 (* ========================================================================= *)
2 (* L_p spaces, square integrable functions and basics of Fourier series.     *)
3 (* ========================================================================= *)
4
5 needs "Multivariate/realanalysis.ml";;
6
7 (* ------------------------------------------------------------------------- *)
8 (* Somewhat general lemmas, but perhaps not enough to be installed.          *)
9 (* ------------------------------------------------------------------------- *)
10
11 let SUM_NUMBERS = prove
12  (`!n. sum(0..n) (\r. &r) = (&n * (&n + &1)) / &2`,
13   INDUCT_TAC THEN
14   ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; GSYM REAL_OF_NUM_SUC] THEN
15   REAL_ARITH_TAC);;
16
17 let REAL_MAX_RPOW = prove
18  (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z
19            ==> max (x rpow z) (y rpow z) = (max x y) rpow z`,
20   MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
21    [MESON_TAC[REAL_ARITH `max x y:real = max y x`]; ALL_TAC] THEN
22   SIMP_TAC[RPOW_LE2; REAL_ARITH `max x y:real = if x <= y then y else x`]);;
23
24 let REAL_MIN_RPOW = prove
25  (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z
26            ==> min (x rpow z) (y rpow z) = (min x y) rpow z`,
27   MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
28    [MESON_TAC[REAL_ARITH `min x y:real = min y x`]; ALL_TAC] THEN
29   SIMP_TAC[RPOW_LE2; REAL_ARITH `min x y:real = if x <= y then x else y`]);;
30
31 let MEASURABLE_ON_LIFT_RPOW = prove
32  (`!f:real^N->real s y.
33         (\x. lift(f x)) measurable_on s /\ &0 < y
34         ==> (\x. lift(f x rpow y)) measurable_on s`,
35   REPEAT STRIP_TAC THEN
36   SUBGOAL_THEN
37    `(\x:real^N. lift(f x rpow y)) =
38     (lift o (\w. w rpow y) o drop) o (\x. lift(f x))`
39   SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN
40   MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL
41    [ASM_REWRITE_TAC[];
42     ONCE_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN
43     REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN
44     MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC;
45     ASM_SIMP_TAC[o_DEF; DROP_VEC; RPOW_ZERO; LIFT_NUM; REAL_LT_IMP_NZ]]);;
46
47 let LIM_RPOW_NULL = prove
48  (`!net p x:A->real.
49         ((lift o x) --> vec 0) net /\ &0 < p
50         ==> ((\i. lift(x(i) rpow p)) --> vec 0) net`,
51   REPEAT GEN_TAC THEN
52   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
53   DISCH_THEN(MP_TAC o ISPEC `lift o (\x. x rpow p) o drop` o
54     MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN
55   ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN
56   REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
57   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN
58   REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
59   MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN
60   REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC);;
61
62 let REAL_INTEGRABLE_REFLECT_AND_ADD = prove
63  (`!f a. f real_integrable_on real_interval[--a,a]
64          ==> f real_integrable_on real_interval[&0,a] /\
65              (\x. f(--x)) real_integrable_on real_interval[&0,a] /\
66              (\x. f x + f(--x)) real_integrable_on real_interval[&0,a]`,
67   REPEAT GEN_TAC THEN DISCH_TAC THEN
68   MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
69   REPEAT CONJ_TAC THENL
70    [ALL_TAC;
71     ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN
72     REWRITE_TAC[REAL_NEG_NEG; ETA_AX];
73     SIMP_TAC[REAL_INTEGRABLE_ADD]] THEN
74   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
75    (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_SUBINTERVAL)) THEN
76   REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REAL_ARITH_TAC);;
77
78 let REAL_INTEGRAL_REFLECT_AND_ADD = prove
79  (`!f a. f real_integrable_on real_interval[--a,a]
80          ==> real_integral (real_interval[--a,a]) f =
81              real_integral (real_interval[&0,a])
82                            (\x. f x + f(--x))`,
83   REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= a` THENL
84    [MP_TAC(SPECL [`f:real->real`; `--a:real`; `a:real`; `&0:real`]
85         REAL_INTEGRAL_COMBINE) THEN
86     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
87     DISCH_THEN(SUBST1_TAC o SYM) THEN
88     ASM_SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRABLE_REFLECT_AND_ADD] THEN
89     GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INTEGRAL_REFLECT] THEN
90     REWRITE_TAC[REAL_NEG_NEG; ETA_AX; REAL_NEG_0; REAL_ADD_AC];
91     ASM_SIMP_TAC[REAL_INTEGRAL_NULL;
92                  REAL_ARITH `~(&0 <= a) ==> a <= --a /\ a <= &0`]]);;
93
94 (* ------------------------------------------------------------------------- *)
95 (* L_p spaces with respect to a set s.                                       *)
96 (* ------------------------------------------------------------------------- *)
97
98 let lspace = new_definition
99  `lspace s p =
100    {f:real^M->real^N | f measurable_on s /\
101                        (\x. lift(norm(f x) rpow p)) integrable_on s}`;;
102
103 let LSPACE_ZERO = prove
104  (`!s. lspace s (&0) =
105           if measurable s then {f:real^M->real^N | f measurable_on s} else {}`,
106   REWRITE_TAC[lspace; RPOW_POW; real_pow; NORM_0; LIFT_NUM] THEN
107   GEN_TAC THEN REWRITE_TAC[INTEGRABLE_ON_CONST; VEC_EQ; ARITH_EQ] THEN
108   ASM_CASES_TAC `measurable(s:real^M->bool)` THEN
109   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
110
111 let LSPACE_CONST = prove
112  (`!s p c. measurable s ==> (\x. c) IN lspace s p`,
113   SIMP_TAC[lspace; IN_ELIM_THM; INTEGRABLE_ON_CONST;
114            INTEGRABLE_IMP_MEASURABLE]);;
115
116 let LSPACE_0 = prove
117  (`!s p. ~(p = &0) ==> (\x. vec 0) IN lspace s p`,
118   SIMP_TAC[lspace; IN_ELIM_THM; NORM_0; RPOW_ZERO; LIFT_NUM] THEN
119   SIMP_TAC[INTEGRABLE_IMP_MEASURABLE; INTEGRABLE_0]);;
120
121 let LSPACE_CMUL = prove
122  (`!s p c f:real^M->real^N.
123         f IN lspace s p ==> (\x. c % f x) IN lspace s p`,
124   REPEAT GEN_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN
125   SIMP_TAC[NORM_MUL; RPOW_MUL; NORM_POS_LE; LIFT_CMUL] THEN
126   SIMP_TAC[MEASURABLE_ON_CMUL; INTEGRABLE_CMUL]);;
127
128 let LSPACE_NEG = prove
129  (`!s p f:real^M->real^N. f IN lspace s p ==> (\x. --(f x)) IN lspace s p`,
130   REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`; LSPACE_CMUL]);;
131
132 let LSPACE_ADD = prove
133  (`!s p f g:real^M->real^N.
134       &0 <= p /\ f IN lspace s p /\ g IN lspace s p
135       ==> (\x. f(x) + g(x)) IN lspace s p`,
136   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `p = &0` THEN
137   ASM_REWRITE_TAC[] THENL
138    [REWRITE_TAC[LSPACE_ZERO] THEN
139     ASM_CASES_TAC `measurable(s:real^M->bool)` THEN
140     ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; MEASURABLE_ON_ADD];
141     ALL_TAC] THEN
142   REWRITE_TAC[lspace; IN_ELIM_THM] THEN
143   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_ADD] THEN
144   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
145   EXISTS_TAC `\x. lift(&2 rpow p * (norm((f:real^M->real^N) x) rpow p +
146                                     norm((g:real^M->real^N) x) rpow p))` THEN
147   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
148    [SUBGOAL_THEN
149      `(\x:real^M. lift(norm(f x + g x:real^N) rpow p)) =
150       (lift o (\y. y rpow p) o drop) o (\x. lift(norm(f x + g x)))`
151     SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN
152     MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL
153      [MATCH_MP_TAC MEASURABLE_ON_NORM THEN
154       MATCH_MP_TAC MEASURABLE_ON_ADD THEN ASM_REWRITE_TAC[];
155       ONCE_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN
156       REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN
157       MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC;
158       ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ] THEN
159       REWRITE_TAC[LIFT_NUM]];
160     REWRITE_TAC[LIFT_CMUL; LIFT_ADD] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN
161     MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[];
162     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
163     REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP] THEN
164     MATCH_MP_TAC(REAL_ARITH
165      `(&0 <= norm(f + g:real^N) rpow p /\ &0 <= norm f /\ &0 <= norm g /\
166        norm(f + g) rpow p <= (norm f + norm g) rpow p) /\
167       (&0 <= norm f /\ &0 <= norm g ==> (norm f + norm g) rpow p <= e)
168       ==> abs(norm(f + g) rpow p) <= e`) THEN
169     CONJ_TAC THENL
170      [ASM_SIMP_TAC[NORM_POS_LE; RPOW_POS_LE; RPOW_LE2; NORM_TRIANGLE; RPOW_LE2;
171                    REAL_LT_IMP_LE];
172       SPEC_TAC(`norm((g:real^M->real^N) x)`,`z:real`) THEN
173       SPEC_TAC(`norm((f:real^M->real^N) x)`,`w:real`) THEN
174       MATCH_MP_TAC REAL_WLOG_LE THEN
175       CONJ_TAC THENL [MESON_TAC[REAL_ADD_SYM]; ALL_TAC] THEN
176       REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
177       EXISTS_TAC `(&2 * z) rpow p` THEN CONJ_TAC THENL
178        [MATCH_MP_TAC RPOW_LE2 THEN ASM_REAL_ARITH_TAC;
179         ASM_SIMP_TAC[RPOW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
180         ASM_SIMP_TAC[REAL_LE_ADDL; RPOW_POS_LE; REAL_POS]]]]);;
181
182 let LSPACE_SUB = prove
183  (`!s p f g:real^M->real^N.
184       &0 <= p /\ f IN lspace s p /\ g IN lspace s p
185       ==> (\x. f(x) - g(x)) IN lspace s p`,
186   SIMP_TAC[VECTOR_SUB; LSPACE_ADD; LSPACE_NEG]);;
187
188 let LSPACE_IMP_INTEGRABLE = prove
189  (`!s p f. f IN lspace s p ==> (\x. lift(norm(f x) rpow p)) integrable_on s`,
190   SIMP_TAC[lspace; IN_ELIM_THM]);;
191
192 let LSPACE_NORM = prove
193  (`!s p f. f IN lspace s p ==> (\x. lift(norm(f x))) IN lspace s p`,
194   REWRITE_TAC[lspace; IN_ELIM_THM] THEN
195   SIMP_TAC[NORM_LIFT; REAL_ABS_NORM; MEASURABLE_ON_NORM]);;
196
197 let LSPACE_VSUM = prove
198  (`!s p f:A->real^M->real^N t.
199         &0 < p /\ FINITE t /\ (!i. i IN t ==> (f i) IN lspace s p)
200         ==> (\x. vsum t (\i. f i x)) IN lspace s p`,
201   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
202   REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
203   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
204   ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; LSPACE_0; REAL_LT_IMP_NZ] THEN
205   ASM_SIMP_TAC[LSPACE_ADD; REAL_LT_IMP_LE; ETA_AX; IN_INSERT]);;
206
207 let LSPACE_MAX = prove
208  (`!s p k f:real^M->real^N g:real^M->real^N.
209       f IN lspace s p /\ g IN lspace s p /\ &0 < p
210       ==> ((\x. lambda i. max (f x$i) (g x$i)):real^M->real^N) IN lspace s p`,
211   REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
212   ASM_SIMP_TAC[MEASURABLE_ON_MAX] THEN
213   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
214   EXISTS_TAC
215    `\x. lift(&(dimindex(:N)) rpow p *
216              max (norm((f:real^M->real^N) x) rpow p)
217                  (norm((g:real^M->real^N) x) rpow p))` THEN
218   ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM;
219                MEASURABLE_ON_MAX] THEN
220   CONJ_TAC THENL
221    [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN
222     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
223     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN
224     CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
225     ASM_REWRITE_TAC[] THEN
226     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
227     REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN
228     SIMP_TAC[RPOW_POS_LE; NORM_POS_LE];
229     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
230     ASM_SIMP_TAC[REAL_MAX_RPOW; NORM_POS_LE; REAL_LT_IMP_LE] THEN
231     REWRITE_TAC[GSYM RPOW_MUL; NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN
232     REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN
233     ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN
234     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
235     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
236     GEN_REWRITE_TAC
237       (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
238     MATCH_MP_TAC SUM_BOUND THEN
239     SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN
240     REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
241      `abs(x) <= y /\ abs(x') <= y' ==> abs(max x x') <= max y y'`) THEN
242     ASM_SIMP_TAC[COMPONENT_LE_NORM]]);;
243
244 let LSPACE_MIN = prove
245  (`!s p k f:real^M->real^N g:real^M->real^N.
246       f IN lspace s p /\ g IN lspace s p /\ &0 < p
247       ==> ((\x. lambda i. min (f x$i) (g x$i)):real^M->real^N) IN lspace s p`,
248   REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
249   ASM_SIMP_TAC[MEASURABLE_ON_MIN] THEN
250   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
251   EXISTS_TAC
252    `\x. lift(&(dimindex(:N)) rpow p *
253              max (norm((f:real^M->real^N) x) rpow p)
254                  (norm((g:real^M->real^N) x) rpow p))` THEN
255   ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM;
256                MEASURABLE_ON_MIN] THEN
257   CONJ_TAC THENL
258    [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN
259     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
260     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN
261     CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
262     ASM_REWRITE_TAC[] THEN
263     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
264     REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN
265     SIMP_TAC[RPOW_POS_LE; NORM_POS_LE];
266     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
267     ASM_SIMP_TAC[REAL_MAX_RPOW; NORM_POS_LE; REAL_LT_IMP_LE] THEN
268     REWRITE_TAC[GSYM RPOW_MUL; NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN
269     REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN
270     ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN
271     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
272     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
273     GEN_REWRITE_TAC
274       (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
275     MATCH_MP_TAC SUM_BOUND THEN
276     SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN
277     REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
278      `abs(x) <= y /\ abs(x') <= y' ==> abs(min x x') <= max y y'`) THEN
279     ASM_SIMP_TAC[COMPONENT_LE_NORM]]);;
280
281 let LSPACE_BOUNDED_MEASURABLE = prove
282  (`!s p f:real^M->real^N g:real^M->real^N.
283         &0 < p /\ f measurable_on s /\ g IN lspace s p /\
284         (!x. x IN s ==> norm(f x) <= norm(g x))
285         ==> f IN lspace s p`,
286   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[lspace; IN_ELIM_THM] THEN
287   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
288   EXISTS_TAC `\x. lift(norm((g:real^M->real^N) x) rpow p)` THEN
289   ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE] THEN
290   ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM] THEN
291   REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN
292   REWRITE_TAC[REAL_ABS_RPOW; REAL_ABS_NORM] THEN
293   ASM_SIMP_TAC[RPOW_LE2; REAL_LT_IMP_LE; NORM_POS_LE]);;
294
295 let LSPACE_INTEGRABLE_PRODUCT = prove
296  (`!s p q f:real^M->real^N g:real^M->real^N.
297         &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\
298         f IN lspace s p /\ g IN lspace s q
299         ==> (\x. lift(norm(f x) * norm(g x))) integrable_on s`,
300   REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
301   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
302   EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x) rpow p / p) +
303                   lift(norm((g:real^M->real^N) x) rpow q / q)` THEN
304   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
305    [REWRITE_TAC[LIFT_CMUL] THEN
306     GEN_REWRITE_TAC (LAND_CONV o ABS_CONV o LAND_CONV)
307         [GSYM LIFT_DROP] THEN
308     MATCH_MP_TAC MEASURABLE_ON_DROP_MUL THEN
309     CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_NORM THEN ASM_REWRITE_TAC[];
310     MATCH_MP_TAC INTEGRABLE_ADD THEN
311     REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
312     REWRITE_TAC[LIFT_CMUL] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN
313     ASM_REWRITE_TAC[];
314     REWRITE_TAC[NORM_LIFT; REAL_ABS_MUL; REAL_ABS_NORM; LIFT_DROP;
315                 DROP_ADD] THEN
316     REPEAT STRIP_TAC THEN MATCH_MP_TAC YOUNG_INEQUALITY THEN
317     ASM_REWRITE_TAC[NORM_POS_LE]]);;
318
319 let LSPACE_1 = prove
320  (`!f:real^M->real^N s. f IN lspace s (&1) <=> f absolutely_integrable_on s`,
321   REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE; lspace; IN_ELIM_THM] THEN
322   REWRITE_TAC[RPOW_POW; REAL_POW_1]);;
323
324 let LSPACE_MONO = prove
325  (`!f:real^M->real^N s p q.
326         f IN lspace s q /\ measurable s /\ &0 < p /\ p <= q
327         ==> f IN lspace s p`,
328   REWRITE_TAC[lspace; IN_ELIM_THM] THEN
329   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
330   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
331   EXISTS_TAC `\x. lift(max (&1) (norm((f:real^M->real^N) x) rpow q))` THEN
332   ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM] THEN CONJ_TAC THENL
333    [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
334     MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN
335     CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
336     ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; INTEGRABLE_ON_CONST] THEN
337     REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN
338     SIMP_TAC[RPOW_POS_LE; NORM_POS_LE; REAL_POS];
339     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
340     REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ABS_RPOW; REAL_ABS_NORM] THEN
341     DISJ_CASES_TAC(ISPECL [`&1`; `norm((f:real^M->real^N) x)`] REAL_LE_TOTAL)
342     THENL
343      [MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max z y`) THEN
344       MATCH_MP_TAC RPOW_MONO THEN ASM_REWRITE_TAC[];
345       MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max y z`) THEN
346       MATCH_MP_TAC RPOW_1_LE THEN REWRITE_TAC[NORM_POS_LE] THEN
347       ASM_REAL_ARITH_TAC]]);;
348
349 let LSPACE_INCLUSION = prove
350  (`!s p q. measurable s /\ &0 < p /\ p <= q
351            ==> (lspace s q :(real^M->real^N)->bool) SUBSET (lspace s p)`,
352   REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN
353   MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `q:real` THEN
354   ASM_REWRITE_TAC[]);;
355
356 (* ------------------------------------------------------------------------- *)
357 (* The corresponding seminorm; Hoelder and Minkowski inequalities.           *)
358 (* ------------------------------------------------------------------------- *)
359
360 let lnorm = new_definition
361  `lnorm s p f =
362    drop(integral s (\x. lift(norm(f x) rpow p))) rpow (inv p)`;;
363
364 let LNORM_0 = prove
365  (`!s p. ~(p = &0) ==> lnorm s p (\x. vec 0) = &0`,
366   REPEAT STRIP_TAC THEN
367   ASM_REWRITE_TAC[lnorm; NORM_0; RPOW_ZERO] THEN
368   ASM_REWRITE_TAC[LIFT_NUM; INTEGRAL_0; DROP_VEC; RPOW_ZERO; REAL_INV_EQ_0]);;
369
370 let LNORM_NEG = prove
371  (`!s p f:real^M->real^N. lnorm s p (\x. --(f x)) = lnorm s p f`,
372   REWRITE_TAC[lnorm; NORM_NEG]);;
373
374 let LNORM_MUL = prove
375  (`!s p f c. f IN lspace s p /\ ~(p = &0)
376              ==> lnorm s p (\x. c % f x) = abs(c) * lnorm s p f`,
377   REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm; NORM_MUL; RPOW_MUL; LIFT_CMUL] THEN
378   ASM_SIMP_TAC[INTEGRAL_CMUL; LSPACE_IMP_INTEGRABLE] THEN
379   REWRITE_TAC[DROP_CMUL; RPOW_MUL] THEN
380   AP_THM_TAC THEN AP_TERM_TAC THEN
381   ASM_SIMP_TAC[RPOW_RPOW; REAL_ABS_POS; REAL_MUL_RINV] THEN
382   REWRITE_TAC[RPOW_POW; REAL_POW_1]);;
383
384 let LNORM_EQ_0 = prove
385  (`!s p f. ~(p = &0) /\ f IN lspace s p
386            ==> (lnorm s p f = &0 <=>
387                 negligible {x | x IN s /\ ~(f x = vec 0)})`,
388   REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
389   ASM_SIMP_TAC[lnorm; RPOW_EQ_0; REAL_INV_EQ_0] THEN
390   REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
391   ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL] THEN
392   SIMP_TAC[HAS_INTEGRAL_NEGLIGIBLE_EQ; lift; LAMBDA_BETA; NORM_POS_LE;
393            RPOW_POS_LE] THEN
394   AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
395   SIMP_TAC[IN_ELIM_THM; CART_EQ; LAMBDA_BETA] THEN
396   REWRITE_TAC[FORALL_1; DIMINDEX_1; VEC_COMPONENT] THEN
397   ASM_REWRITE_TAC[RPOW_EQ_0; NORM_EQ_0; CART_EQ; VEC_COMPONENT]);;
398
399 let LNORM_POS_LE = prove
400  (`!s p f. f IN lspace s p ==> &0 <= lnorm s p f`,
401   SIMP_TAC[lspace; IN_ELIM_THM; lnorm] THEN REPEAT STRIP_TAC THEN
402   MATCH_MP_TAC RPOW_POS_LE THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN
403   ASM_SIMP_TAC[LIFT_DROP; NORM_POS_LE; RPOW_POS_LE]);;
404
405 let LNORM_NORM = prove
406  (`!s p f. lnorm s p (\x. lift(norm(f x))) = lnorm s p f`,
407   REWRITE_TAC[lnorm; NORM_LIFT; REAL_ABS_NORM]);;
408
409 let LNORM_RPOW = prove
410  (`!s p f:real^M->real^N.
411         f IN lspace s p /\ ~(p = &0)
412         ==> (lnorm s p f) rpow p =
413             drop(integral s (\x. lift(norm(f x) rpow p)))`,
414   REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN
415   ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; RPOW_RPOW;
416                LSPACE_IMP_INTEGRABLE; RPOW_POS_LE] THEN
417   ASM_SIMP_TAC[REAL_MUL_LINV; RPOW_POW; REAL_POW_1]);;
418
419 let INTEGRAL_LNORM_RPOW = prove
420  (`!s p f:real^M->real^N.
421         f IN lspace s p /\ ~(p = &0)
422         ==> integral s (\x. lift(norm(f x) rpow p)) =
423             lift((lnorm s p f) rpow p)`,
424   SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; LNORM_RPOW]);;
425
426 let HOELDER_INEQUALITY = prove
427  (`!s p q f:real^M->real^N g:real^M->real^N.
428         &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\
429         f IN lspace s p /\ g IN lspace s q
430         ==> drop(integral s (\x. lift(norm(f x) * norm(g x))))
431               <= lnorm s p f * lnorm s q g`,
432   MP_TAC LSPACE_INTEGRABLE_PRODUCT THEN
433   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
434   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
435   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
436   SUBGOAL_THEN `&0 <= lnorm s p (f:real^M->real^N) /\
437                 &0 <= lnorm s q (g:real^M->real^N)`
438   MP_TAC THENL [ASM_SIMP_TAC[LNORM_POS_LE]; REWRITE_TAC[IMP_CONJ]] THEN
439   REPEAT
440    (GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
441     DISCH_THEN(DISJ_CASES_THEN2 MP_TAC ASSUME_TAC) THENL
442      [ASM_SIMP_TAC[LNORM_EQ_0; REAL_LT_IMP_NZ] THEN REPEAT DISCH_TAC THEN
443       MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 ==> x <= y`) THEN
444       ASM_SIMP_TAC[REAL_LE_MUL; LNORM_POS_LE; GSYM LIFT_EQ; LIFT_DROP] THEN
445       ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL; LIFT_NUM] THEN
446       SIMP_TAC[HAS_INTEGRAL_NEGLIGIBLE_EQ; lift; LAMBDA_BETA; NORM_POS_LE;
447                REAL_LE_MUL] THEN
448       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
449           NEGLIGIBLE_SUBSET)) THEN
450       SIMP_TAC[CART_EQ; SUBSET; IN_ELIM_THM; LAMBDA_BETA] THEN
451       REWRITE_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT] THEN
452       REWRITE_TAC[REAL_ENTIRE; CART_EQ; NORM_EQ_0; VEC_COMPONENT] THEN
453       MESON_TAC[];
454       ALL_TAC]) THEN
455   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
456   ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_MUL] THEN
457   REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
458   REWRITE_TAC[GSYM DROP_CMUL] THEN ASM_SIMP_TAC[GSYM INTEGRAL_CMUL] THEN
459   REWRITE_TAC[REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
460   EXISTS_TAC `drop(integral s
461    (\x. lift(norm(inv(lnorm s p f) % (f:real^M->real^N) x) rpow p / p +
462              norm(inv(lnorm s q g) % (g:real^M->real^N) x) rpow q / q)))` THEN
463   CONJ_TAC THENL
464    [MATCH_MP_TAC INTEGRAL_DROP_LE THEN
465     ASM_SIMP_TAC[LIFT_DROP; INTEGRABLE_CMUL] THEN CONJ_TAC THENL
466      [REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC INTEGRABLE_ADD THEN
467       REWRITE_TAC[NORM_MUL; RPOW_MUL] THEN
468       REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
469       ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; INTEGRABLE_CMUL; LIFT_CMUL];
470       REWRITE_TAC[DROP_CMUL; LIFT_DROP; NORM_MUL; REAL_ABS_INV] THEN
471       ASM_SIMP_TAC[real_abs; LNORM_POS_LE; REAL_LT_IMP_NZ] THEN
472       ONCE_REWRITE_TAC[REAL_ARITH
473        `(a * b) * (c * d:real) = (a * c) * (b * d)`] THEN
474       REPEAT STRIP_TAC THEN MATCH_MP_TAC YOUNG_INEQUALITY THEN
475       ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; LNORM_POS_LE; REAL_LE_INV_EQ]];
476     REWRITE_TAC[LIFT_ADD; NORM_MUL; LIFT_CMUL; RPOW_MUL] THEN
477     REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
478     REWRITE_TAC[LIFT_CMUL; VECTOR_MUL_ASSOC] THEN
479     ASM_SIMP_TAC[INTEGRAL_ADD; INTEGRABLE_CMUL; INTEGRAL_CMUL;
480                  LSPACE_IMP_INTEGRABLE; REAL_ABS_INV] THEN
481     ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`; RPOW_INV] THEN
482     ASM_SIMP_TAC[INTEGRAL_LNORM_RPOW; REAL_LT_IMP_NZ] THEN
483     REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP] THEN
484     ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ;
485                  RPOW_POS_LT] THEN
486     ASM_REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]]);;
487
488 let HOELDER_INEQUALITY_FULL = prove
489  (`!s p q f:real^M->real^N g:real^M->real^N.
490         &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\
491         f IN lspace s p /\ g IN lspace s q
492         ==> (\x. lift(norm(f x) * norm(g x))) integrable_on s /\
493             drop(integral s (\x. lift(norm(f x) * norm(g x))))
494               <= lnorm s p f * lnorm s q g`,
495   REPEAT GEN_TAC THEN DISCH_TAC THEN
496   FIRST_ASSUM(ASSUME_TAC o MATCH_MP LSPACE_INTEGRABLE_PRODUCT) THEN
497   ASM_SIMP_TAC[HOELDER_INEQUALITY]);;
498
499 let LNORM_TRIANGLE = prove
500  (`!s p f:real^M->real^N g:real^M->real^N.
501         f IN lspace s p /\ g IN lspace s p /\ &1 <= p
502         ==> lnorm s p (\x. f x + g x) <= lnorm s p f + lnorm s p g`,
503   REPEAT STRIP_TAC THEN ASM_CASES_TAC `p = &1` THENL
504    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
505     ASM_SIMP_TAC[lnorm;
506       MESON[RPOW_POW; REAL_POW_1; REAL_INV_1] `x rpow (inv(&1)) = x`;
507       GSYM DROP_ADD; GSYM INTEGRAL_ADD; LSPACE_IMP_INTEGRABLE] THEN
508     MATCH_MP_TAC INTEGRAL_DROP_LE_MEASURABLE THEN
509     ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; INTEGRABLE_ADD] THEN
510     REWRITE_TAC[RPOW_POW; REAL_POW_1; LIFT_DROP; DROP_ADD] THEN
511     REWRITE_TAC[NORM_POS_LE; NORM_TRIANGLE] THEN
512     MATCH_MP_TAC MEASURABLE_ON_NORM THEN MATCH_MP_TAC MEASURABLE_ON_ADD THEN
513     RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN
514     ASM_REWRITE_TAC[];
515     ALL_TAC] THEN
516   SUBGOAL_THEN `&1 < p` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
517   SUBGOAL_THEN `&0 <= lnorm s p (\x. (f:real^M->real^N) x + g x)` MP_TAC THENL
518    [ASM_SIMP_TAC[LNORM_POS_LE; LSPACE_ADD; REAL_ARITH `&1 <= p ==> &0 <= p`];
519     GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
520     STRIP_TAC THEN ASM_SIMP_TAC[LNORM_POS_LE; REAL_LE_ADD]] THEN
521   MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
522   EXISTS_TAC `lnorm s p (\x. (f:real^M->real^N) x + g x) rpow (p - &1)` THEN
523   ASM_SIMP_TAC[RPOW_POS_LT] THEN
524   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_POW_1] THEN
525   ASM_SIMP_TAC[GSYM RPOW_POW; GSYM RPOW_ADD] THEN
526   ASM_SIMP_TAC[LSPACE_ADD; LNORM_RPOW; REAL_ARITH `p - &1 + &1 = p`;
527                REAL_ARITH `&1 <= p ==> &0 <= p /\ ~(p = &0)`] THEN
528   CONV_TAC(LAND_CONV(SUBS_CONV[REAL_ARITH `p = &1 + (p - &1)`])) THEN
529   ASM_SIMP_TAC[RPOW_ADD_ALT; NORM_POS_LE; REAL_ARITH
530    `&1 <= p ==> &1 + p - &1 = &0 ==> p - &1 = &0`] THEN
531   REWRITE_TAC[RPOW_POW; REAL_POW_1] THEN
532   MP_TAC(ISPECL
533    [`s:real^M->bool`; `p:real`; `p / (p - &1)`;
534     `\x. lift(norm((g:real^M->real^N) x))`;
535     `\x. lift(norm((f:real^M->real^N)(x) + g(x)) rpow (p - &1))`]
536         HOELDER_INEQUALITY_FULL) THEN
537   MP_TAC(ISPECL
538    [`s:real^M->bool`; `p:real`; `p / (p - &1)`;
539     `\x. lift(norm((f:real^M->real^N) x))`;
540     `\x. lift(norm((f:real^M->real^N)(x) + g(x)) rpow (p - &1))`]
541         HOELDER_INEQUALITY_FULL) THEN
542   ASM_SIMP_TAC[LSPACE_NORM; REAL_LT_DIV; REAL_SUB_LT;
543                REAL_ARITH `&1 < p ==> &0 < p`;
544                REAL_FIELD `&1 < p ==> inv(p) + inv(p / (p - &1)) = &1`] THEN
545   MATCH_MP_TAC(TAUT
546     `p /\ (q ==> r ==> s) ==> (p ==> q) ==> (p ==> r) ==> s`) THEN
547   CONJ_TAC THENL
548    [SIMP_TAC[lspace; IN_ELIM_THM; NORM_LIFT; REAL_ABS_NORM; REAL_ABS_RPOW;
549              RPOW_RPOW; NORM_POS_LE] THEN
550     ASM_SIMP_TAC[REAL_FIELD `&1 < p ==> (p - &1) * p / (p - &1) = p`] THEN
551     ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; LSPACE_ADD;
552                  REAL_ARITH `&1 < p ==> &0 <= p`] THEN
553     MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN
554     CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
555     SUBGOAL_THEN `((\x. f x + g x):real^M->real^N) IN lspace s p` MP_TAC THENL
556      [ASM_SIMP_TAC[LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`];
557       SIMP_TAC[lspace; IN_ELIM_THM; MEASURABLE_ON_NORM]];
558     ALL_TAC] THEN
559   REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LNORM_NORM; REAL_ABS_RPOW] THEN
560   MATCH_MP_TAC(TAUT
561    `(p1 /\ p2 ==> b1 /\ b2 ==> c) ==> p1 /\ b1 ==> p2 /\ b2 ==> c`) THEN
562   STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2) THEN
563   ASM_SIMP_TAC[GSYM DROP_ADD; GSYM INTEGRAL_ADD] THEN
564   SUBGOAL_THEN
565    `lnorm s (p / (p - &1)) (\x. lift(norm (f x + g x) rpow (p - &1))) =
566     lnorm s p (\x. (f:real^M->real^N) x + g x) rpow (p - &1)`
567   SUBST1_TAC THENL
568    [REWRITE_TAC[lnorm] THEN
569     ASM_SIMP_TAC[RPOW_RPOW; INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE;
570                  NORM_LIFT; REAL_ABS_NORM; REAL_ABS_RPOW] THEN
571     ASM_SIMP_TAC[REAL_FIELD `&1 < p ==> (p - &1) * p / (p - &1) = p`] THEN
572     REWRITE_TAC[REAL_INV_DIV] THEN REWRITE_TAC[real_div] THEN
573     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC(GSYM RPOW_RPOW) THEN
574     MATCH_MP_TAC INTEGRAL_DROP_POS THEN
575     ASM_SIMP_TAC[LIFT_DROP; RPOW_POS_LE; NORM_POS_LE; LSPACE_IMP_INTEGRABLE;
576                  LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`];
577     ALL_TAC] THEN
578   MATCH_MP_TAC(REAL_ARITH
579    `i2 <= i1 ==> i1 <= f * y + g * y ==> i2 <= y * (f + g)`) THEN
580   MATCH_MP_TAC INTEGRAL_DROP_LE_MEASURABLE THEN
581   ASM_SIMP_TAC[INTEGRABLE_ADD] THEN CONJ_TAC THENL
582    [MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN CONJ_TAC THENL
583      [ALL_TAC;
584       MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN
585       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]] THEN
586     (SUBGOAL_THEN `((\x. f x + g x):real^M->real^N) IN lspace s p` MP_TAC THENL
587       [ASM_SIMP_TAC[LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`];
588        SIMP_TAC[lspace; IN_ELIM_THM; MEASURABLE_ON_NORM]]);
589     REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; LIFT_DROP; DROP_ADD] THEN
590     SIMP_TAC[NORM_TRIANGLE; REAL_LE_RMUL; NORM_POS_LE; RPOW_POS_LE;
591              REAL_LE_MUL]]);;
592
593 let VSUM_LNORM = prove
594  (`!s p f:A->real^M->real^N t.
595         &1 <= p /\ FINITE t /\ (!i. i IN t ==> (f i) IN lspace s p)
596         ==> lnorm s p (\x. vsum t (\i. f i x)) <= sum t (\i. lnorm s p (f i))`,
597   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
598   REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
599   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
600   ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; LNORM_0; REAL_LE_REFL;
601                REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN
602   MAP_EVERY X_GEN_TAC [`i:A`; `u:A->bool`] THEN
603   REWRITE_TAC[IN_INSERT] THEN
604   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
605   ASM_SIMP_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
606   MATCH_MP_TAC(REAL_ARITH `a <= x + y ==> y <= z ==> a <= x + z`) THEN
607   W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN
608   ASM_SIMP_TAC[ETA_AX; LSPACE_VSUM; REAL_ARITH `&1 <= p ==> &0 < p`]);;
609
610 (* ------------------------------------------------------------------------- *)
611 (* The main lemma for Riesz-Fischer, as in Royden's book.                    *)
612 (* ------------------------------------------------------------------------- *)
613
614 let LSPACE_SUMMABLE_UNIV = prove
615  (`!f:num->real^M->real^N p s.
616         &1 <= p /\
617         (!i. f i IN lspace s p) /\
618         real_summable (:num) (\i. lnorm s p (f i))
619         ==> ?g. g IN lspace s p /\
620                 !e. &0 < e  ==> eventually
621                                   (\n. lnorm s p (\x. vsum (0..n) (\i. f i x) -
622                                                       g(x)) < e)
623                                   sequentially`,
624   REPEAT STRIP_TAC THEN
625   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_SUMS_INFSUM]) THEN
626   ABBREV_TAC `M = real_infsum (:num) (\i. lnorm s p (f i:real^M->real^N))` THEN
627   DISCH_TAC THEN
628   ABBREV_TAC
629    `g = \n x:real^M. vsum(0..n) (\i. lift(norm(f i x:real^N)))` THEN
630   SUBGOAL_THEN `!n:num. lnorm s p (g n:real^M->real^1) <= M` ASSUME_TAC THENL
631    [GEN_TAC THEN EXPAND_TAC "g" THEN
632     W(MP_TAC o PART_MATCH (lhand o rand) VSUM_LNORM o lhand o snd) THEN
633     ASM_SIMP_TAC[FINITE_NUMSEG; LSPACE_NORM; ETA_AX] THEN
634     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
635     REWRITE_TAC[LNORM_NORM] THEN EXPAND_TAC "M" THEN
636     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SET_RULE `s = UNIV INTER s`] THEN
637     REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC REAL_PARTIAL_SUMS_LE_INFSUM THEN
638     ASM_SIMP_TAC[LNORM_POS_LE];
639     ALL_TAC] THEN
640   SUBGOAL_THEN `!n:num. (g n:real^M->real^1) IN lspace s p` ASSUME_TAC THENL
641    [GEN_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
642     MATCH_MP_TAC LSPACE_VSUM THEN
643     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[FINITE_NUMSEG]] THEN
644     ASM_SIMP_TAC[LSPACE_NORM; ETA_AX];
645     ALL_TAC] THEN
646   SUBGOAL_THEN `!n:num x:real^M. &0 <= drop(g n x)` ASSUME_TAC THENL
647    [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN
648     SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; LIFT_DROP] THEN
649     MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN
650     REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE];
651     ALL_TAC] THEN
652   MP_TAC(ISPECL [`\i:num x:real^M. lift(drop(g i x) rpow p)`; `s:real^M->bool`]
653         BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN
654   REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL
655    [MATCH_MP_TAC(TAUT `b /\ a /\ c ==> a /\ b /\ c`) THEN CONJ_TAC THENL
656      [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN
657       SIMP_TAC[DROP_VSUM; FINITE_NUMSEG] THEN
658       MATCH_MP_TAC RPOW_LE2 THEN REPEAT CONJ_TAC THENL
659        [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN
660         REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE];
661         SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_LE_ADDR] THEN
662         REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE];
663         ASM_REAL_ARITH_TAC];
664       ALL_TAC] THEN
665     SUBGOAL_THEN
666      `!k x. drop((g:num->real^M->real^1) k x) = norm(g k x)`
667      (fun th -> REWRITE_TAC[th])
668     THENL
669      [REPEAT GEN_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN
670       ASM_REWRITE_TAC[real_abs];
671       ALL_TAC] THEN
672     ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; ETA_AX] THEN
673     REWRITE_TAC[bounded] THEN EXISTS_TAC `M rpow p` THEN
674       REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN
675       DISCH_THEN(K ALL_TAC) THEN
676     ASM_SIMP_TAC[INTEGRAL_LNORM_RPOW; ETA_AX;
677                  REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN
678     REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW] THEN
679     MATCH_MP_TAC RPOW_LE2 THEN
680     ASM_SIMP_TAC[REAL_ARITH `&1 <= p ==> &0 <= p`] THEN
681     MATCH_MP_TAC(REAL_ARITH
682      `&0 <= x /\ x <= a ==> &0 <= abs x /\ abs x <= a`) THEN
683     ASM_SIMP_TAC[LNORM_POS_LE];
684     ALL_TAC] THEN
685   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
686   MAP_EVERY X_GEN_TAC [`hp:real^M->real^1`; `k:real^M->bool`] THEN
687   STRIP_TAC THEN
688   ABBREV_TAC `h:real^M->real^1 = \x. lift(drop(hp x) rpow (inv p))` THEN
689   SUBGOAL_THEN
690    `!x. x IN s DIFF k ==> ((\i. g i x) --> ((h:real^M->real^1) x)) sequentially`
691   ASSUME_TAC THENL
692    [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
693     MP_TAC(ISPECL
694      [`lift o (\x. x rpow (inv p)) o drop`;
695       `sequentially`; `\i. lift(drop((g:num->real^M->real^1) i x) rpow p)`;
696       `(hp:real^M->real^1) x`]
697         LIM_CONTINUOUS_FUNCTION) THEN
698     ASM_SIMP_TAC[] THEN ANTS_TAC THENL
699      [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN
700       REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
701       MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN
702       REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC;
703       ALL_TAC] THEN
704     EXPAND_TAC "h" THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN
705     ASM_SIMP_TAC[RPOW_RPOW; REAL_MUL_RINV;
706                  REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN
707     REWRITE_TAC[RPOW_POW; REAL_POW_1; LIFT_DROP; ETA_AX];
708     ALL_TAC] THEN
709   SUBGOAL_THEN
710    `!x. x IN s DIFF k ==> summable (:num) (\i. (f:num->real^M->real^N) i x)`
711   MP_TAC THENL
712    [REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_LIFT_ABSCONV_IMP_CONV THEN
713     REWRITE_TAC[summable] THEN EXISTS_TAC `(h:real^M->real^1) x` THEN
714     REWRITE_TAC[sums; INTER_UNIV] THEN
715     RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN
716     ASM_SIMP_TAC[];
717     ALL_TAC] THEN
718   REWRITE_TAC[summable] THEN
719   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
720   REWRITE_TAC[SKOLEM_THM] THEN
721   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^M->real^N` THEN
722   DISCH_TAC THEN
723   SUBGOAL_THEN
724    `!n x. x IN s DIFF k
725           ==> norm(vsum (0..n) (\i. (f:num->real^M->real^N) i x)) <= drop(h x)`
726   ASSUME_TAC THENL
727    [REPEAT STRIP_TAC THEN
728     MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN
729     REWRITE_TAC[FINITE_NUMSEG] THEN
730     GEN_REWRITE_TAC LAND_CONV [GSYM LIFT_DROP] THEN
731     SIMP_TAC[LIFT_SUM; FINITE_NUMSEG] THEN
732     MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN
733     EXISTS_TAC `\n. vsum (0..n)
734                    (\i. lift(norm((f:num->real^M->real^N) i x)))` THEN
735     REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
736      [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_SIMP_TAC[IN_DIFF];
737       REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN
738       X_GEN_TAC `m:num` THEN DISCH_TAC THEN
739       SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; o_DEF; LIFT_DROP] THEN
740       MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
741       REWRITE_TAC[SUBSET; IN_NUMSEG; NORM_POS_LE; FINITE_NUMSEG] THEN
742       UNDISCH_TAC `n:num <= m` THEN ARITH_TAC];
743     ALL_TAC] THEN
744   SUBGOAL_THEN
745    `!x. x IN s DIFF k ==> norm((l:real^M->real^N) x) <= drop(h x)`
746   ASSUME_TAC THENL
747    [REPEAT STRIP_TAC THEN
748     MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
749     EXISTS_TAC `\n. vsum ((:num) INTER (0..n))
750                          (\i. (f:num->real^M->real^N) i x)` THEN
751     ASM_SIMP_TAC[IN_DIFF; GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
752     MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[INTER_UNIV];
753     ALL_TAC] THEN
754   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
755    [REWRITE_TAC[lspace; IN_ELIM_THM] THEN
756     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
757      [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
758       EXISTS_TAC `\n x. vsum (0..n) (\i. (f:num->real^M->real^N) i x)` THEN
759       EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
760       ONCE_REWRITE_TAC[SET_RULE `0..n = UNIV INTER (0..n)`] THEN
761       ASM_REWRITE_TAC[GSYM sums] THEN GEN_TAC THEN
762       REWRITE_TAC[INTER_UNIV] THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN
763       RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN
764       ASM_REWRITE_TAC[FINITE_NUMSEG];
765       DISCH_TAC] THEN
766     MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
767     EXISTS_TAC
768      `\x. if x IN k then lift(norm(l x:real^N) rpow p)
769           else (hp:real^M->real^1) x` THEN
770     ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; ETA_AX;
771                  REAL_ARITH `&1 <= p ==> &0 < p`] THEN
772     CONJ_TAC THENL
773      [UNDISCH_TAC `(hp:real^M->real^1) integrable_on s` THEN
774       MATCH_MP_TAC INTEGRABLE_SPIKE THEN
775       EXISTS_TAC `k:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF];
776       REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN
777       GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN
778       REWRITE_TAC[LIFT_DROP; REAL_LE_REFL] THEN
779       MATCH_MP_TAC REAL_LE_TRANS THEN
780       EXISTS_TAC `drop(h(x:real^M)) rpow p` THEN CONJ_TAC THENL
781        [MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; IN_DIFF] THEN
782         ASM_REAL_ARITH_TAC;
783         EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN
784         MATCH_MP_TAC(REAL_ARITH `x = y pow 1 ==> x <= y`) THEN
785         MATCH_MP_TAC EQ_TRANS THEN
786         EXISTS_TAC `drop(hp(x:real^M)) rpow (inv p * p)` THEN CONJ_TAC THENL
787          [MATCH_MP_TAC RPOW_RPOW THEN
788           MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN
789           EXISTS_TAC `\k. lift(drop((g:num->real^M->real^1) k x) rpow p)` THEN
790           ASM_SIMP_TAC[IN_DIFF; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
791           ASM_SIMP_TAC[LIFT_DROP; RPOW_POS_LE; EVENTUALLY_TRUE];
792           ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN
793           REWRITE_TAC[RPOW_POW]]]];
794     DISCH_TAC] THEN
795   SUBGOAL_THEN `!x:real^M. x IN s DIFF k ==> &0 <= drop(h x)` ASSUME_TAC THENL
796    [ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; ALL_TAC] THEN
797   SUBGOAL_THEN `!x:real^M. x IN s DIFF k ==> &0 <= drop(hp x)` ASSUME_TAC THENL
798    [REPEAT STRIP_TAC THEN
799     MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN
800     EXISTS_TAC `\k. lift(drop((g:num->real^M->real^1) k x) rpow p)` THEN
801     ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; RPOW_POS_LE] THEN
802     REWRITE_TAC[EVENTUALLY_TRUE];
803     ALL_TAC] THEN
804   MP_TAC(ISPECL
805    [`\n x. lift(norm(vsum (0..n) (\i. (f:num->real^M->real^N) i x) - l x)
806                     rpow p)`;
807     `(\x. vec 0):real^M->real^1`;
808     `\x:real^M. &2 rpow p % lift(drop(h x) rpow p)`;
809     `s DIFF k:real^M->bool`]
810    DOMINATED_CONVERGENCE) THEN
811   REWRITE_TAC[lnorm; INTEGRAL_0; REAL_INTEGRAL_0; INTEGRABLE_0] THEN
812   ANTS_TAC THENL
813    [REPEAT CONJ_TAC THENL
814      [X_GEN_TAC `n:num` THEN
815       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN
816       EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL
817        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
818           NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
819         MATCH_MP_TAC LSPACE_IMP_INTEGRABLE THEN
820         MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN
821         CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
822         MATCH_MP_TAC LSPACE_VSUM THEN
823         ASM_REWRITE_TAC[FINITE_NUMSEG] THEN ASM_REAL_ARITH_TAC];
824       MATCH_MP_TAC INTEGRABLE_CMUL THEN EXPAND_TAC "h" THEN
825       REWRITE_TAC[LIFT_DROP] THEN
826       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN
827       EXISTS_TAC `hp:real^M->real^1` THEN
828       EXISTS_TAC `{}:real^M->bool` THEN
829       ASM_SIMP_TAC[DIFF_EMPTY; NEGLIGIBLE_EMPTY; RPOW_RPOW] THEN
830       ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN
831       REWRITE_TAC[LIFT_DROP; RPOW_POW; REAL_POW_1] THEN
832       UNDISCH_TAC `(hp:real^M->real^1) integrable_on s` THEN
833       MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
834       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
835         NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
836       REWRITE_TAC[DROP_CMUL; GSYM RPOW_MUL; LIFT_DROP] THEN
837       REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN
838       REWRITE_TAC[REAL_ABS_NORM; LIFT_DROP; REAL_ABS_RPOW] THEN
839       MATCH_MP_TAC RPOW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN
840       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
841       MATCH_MP_TAC(NORM_ARITH
842        `norm(x:real^N) <= a /\ norm(y) <= a ==> norm(x - y) <= &2 * a`) THEN
843       ASM_SIMP_TAC[];
844       X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
845       MATCH_MP_TAC LIM_RPOW_NULL THEN
846       CONJ_TAC THENL [REWRITE_TAC[o_DEF]; ASM_REAL_ARITH_TAC] THEN
847       REWRITE_TAC[GSYM LIM_NULL_NORM] THEN REWRITE_TAC[GSYM LIM_NULL] THEN
848       RULE_ASSUM_TAC(REWRITE_RULE[sums; INTER_UNIV]) THEN
849       ASM_SIMP_TAC[]];
850     GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV o ABS_CONV)
851      [GSYM LIFT_DROP] THEN
852     DISCH_THEN(MP_TAC o MATCH_MP
853      (REWRITE_RULE[IMP_CONJ; o_DEF] LIM_RPOW_NULL)) THEN
854     DISCH_THEN(MP_TAC o SPEC `inv p:real`) THEN
855     ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
856     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
857     REWRITE_TAC[tendsto; DIST_0; NORM_REAL; GSYM drop; LIFT_DROP] THEN
858     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
859     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
860     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
861     SUBGOAL_THEN
862      `!f:real^M->real^1. integral (s DIFF k) f = integral s f`
863     MP_TAC THENL [ALL_TAC; SIMP_TAC[REAL_ARITH `abs(x) < e ==> x < e`]] THEN
864     GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN
865     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
866       NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]);;
867
868 let LSPACE_SUMMABLE = prove
869  (`!f:num->real^M->real^N p s t.
870         &1 <= p /\
871         (!i. i IN t ==> f i IN lspace s p) /\
872         real_summable t (\i. lnorm s p (f i))
873         ==> ?g. g IN lspace s p /\
874                 ((\n. lnorm s p (\x. vsum (t INTER (0..n)) (\i. f i x) - g x))
875                  ---> &0) sequentially`,
876   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUMMABLE_RESTRICT] THEN
877   REWRITE_TAC[] THEN STRIP_TAC THEN
878   MP_TAC(ISPECL
879     [`(\n:num x. if n IN t then f n x else vec 0):num->real^M->real^N`;
880      `p:real`; `s:real^M->bool`] LSPACE_SUMMABLE_UNIV) THEN
881   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
882    [CONJ_TAC THENL
883      [X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN
884       ASM_SIMP_TAC[LSPACE_0; ETA_AX; REAL_ARITH `&1 <= p ==> ~(p = &0)`];
885       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_summable]) THEN
886       REWRITE_TAC[real_summable] THEN MATCH_MP_TAC MONO_EXISTS THEN
887       GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN
888       AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
889       REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN
890       ASM_SIMP_TAC[ETA_AX; LNORM_0; REAL_ARITH `&1 <= p ==> ~(p = &0)`]];
891     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
892     ASM_CASES_TAC `(g:real^M->real^N) IN lspace s p` THEN
893     ASM_REWRITE_TAC[tendsto_real] THEN
894     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
895     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
896     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
897     X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
898     MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x = y ==> x < e ==> abs y < e`) THEN
899     CONJ_TAC THENL
900      [MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC LSPACE_SUB THEN
901       ASM_SIMP_TAC[REAL_ARITH `&1 <= p ==> &0 <= p`] THEN
902       MATCH_MP_TAC LSPACE_VSUM THEN
903       ASM_SIMP_TAC[FINITE_NUMSEG; REAL_ARITH `&1 <= p ==> &0 < p`] THEN
904       X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN
905       ASM_SIMP_TAC[ETA_AX; LSPACE_0; REAL_ARITH `&1 <= p ==> ~(p = &0)`];
906       AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
907       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN
908       REWRITE_TAC[SET_RULE `s INTER t = {x | x IN t /\ x IN s}`]]]);;
909
910 (* ------------------------------------------------------------------------- *)
911 (* Completeness (Riesz-Fischer).                                             *)
912 (* ------------------------------------------------------------------------- *)
913
914 let RIESZ_FISCHER = prove
915  (`!f:num->real^M->real^N p s.
916         &1 <= p /\ (!n. (f n) IN lspace s p) /\
917         (!e. &0 < e
918              ==> ?N. !m n. m >= N /\ n >= N
919                            ==> lnorm s p (\x. f m x - f n x) < e)
920         ==> ?g. g IN lspace s p /\
921                 !e. &0 < e
922                     ==> ?N. !n. n >= N
923                                 ==> lnorm s p (\x. f n x - g x) < e`,
924   REPEAT STRIP_TAC THEN
925   SUBGOAL_THEN
926    `?k:num->num.
927         (!n. k n < k (SUC n)) /\
928         (!n. lnorm s p ((\x. f (k(SUC n)) x - f (k n) x):real^M->real^N)
929              < inv(&2 pow n))`
930   STRIP_ASSUME_TAC THENL
931    [FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
932     REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN
933     DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN
934     MP_TAC(prove_recursive_functions_exist num_RECURSION
935      `k 0 = N 0 /\
936       !n. k(SUC n) = MAX (k n + 1) (MAX (N n) (N(SUC n)))`) THEN
937     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
938     ASM_REWRITE_TAC[ARITH_RULE `n < MAX (n + 1) m`] THEN
939     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
940     CONJ_TAC THENL [ARITH_TAC; SPEC_TAC(`n:num`,`n:num`)] THEN
941     INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ARITH_TAC;
942     ALL_TAC] THEN
943   MP_TAC(ISPECL
944    [`\n x. f (k(SUC n)) x - (f:num->real^M->real^N) (k n) x`;
945     `p:real`; `s:real^M->bool`] LSPACE_SUMMABLE_UNIV) THEN
946   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
947    [ASM_SIMP_TAC[LSPACE_SUB; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN
948     MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN
949     EXISTS_TAC `\n. inv(&2) pow n` THEN CONJ_TAC THENL
950      [MATCH_MP_TAC REAL_SUMMABLE_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV;
951       EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN
952       REWRITE_TAC[GSYM REAL_INV_POW] THEN
953       MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < y ==> abs x <= y`) THEN
954       ASM_SIMP_TAC[LNORM_POS_LE; LSPACE_SUB; ETA_AX;
955                    REAL_ARITH `&1 <= p ==> &0 <= p`]];
956     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` MP_TAC) THEN
957     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN
958     EXISTS_TAC `\x. (g:real^M->real^N) x + f (k 0:num) x` THEN
959     ASM_SIMP_TAC[LSPACE_ADD; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN
960     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
961     REMOVE_THEN "*" (MP_TAC o SPEC `e / &2`) THEN
962     ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN
963     REWRITE_TAC[ADD1; VSUM_DIFFS_ALT; LE_0] THEN
964     DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "+")) THEN
965     FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
966     ASM_REWRITE_TAC[REAL_HALF; GE] THEN
967     DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
968     EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN
969     REWRITE_TAC[ARITH_RULE `MAX N1 N2 <= n <=> N1 <= n /\ N2 <= n`] THEN
970     STRIP_TAC THEN REMOVE_THEN "+" (MP_TAC o SPEC `n:num`) THEN
971     FIRST_X_ASSUM(MP_TAC o SPECL [`k(n + 1):num`; `n:num`]) THEN
972     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
973      [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n + 1` THEN
974       CONJ_TAC THENL [ASM_ARITH_TAC; SPEC_TAC(`n + 1`,`m:num`)] THEN
975       INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN
976       MATCH_MP_TAC(ARITH_RULE
977        `m <= k m /\ k m < k(SUC m) ==> SUC m <= k(SUC m)`) THEN
978       ASM_REWRITE_TAC[];
979       REPEAT DISCH_TAC THEN
980       ONCE_REWRITE_TAC[VECTOR_ARITH
981        `f n x - (g x + f (k 0) x):real^N =
982         (f (k (n + 1)) x - f (k 0) x - g x) +
983         --(f (k (n + 1)) x - f n x)`] THEN
984       W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN
985       ASM_SIMP_TAC[LSPACE_SUB; LSPACE_NEG; ETA_AX;
986                     REAL_ARITH `&1 <= p ==> &0 <= p`] THEN
987       MATCH_MP_TAC(REAL_ARITH
988        `x < e / &2 /\ y < e / &2 ==> z <= x + y ==> z < e`) THEN
989       ASM_SIMP_TAC[LNORM_NEG; LSPACE_SUB; ETA_AX;
990                    REAL_ARITH `&1 <= p ==> &0 <= p`]]]);;
991
992 (* ------------------------------------------------------------------------- *)
993 (* A sort of dominated convergence theorem for L_p spaces.                   *)
994 (* ------------------------------------------------------------------------- *)
995
996 let LSPACE_DOMINATED_CONVERGENCE = prove
997  (`!f:num->real^M->real^N g h:real^M->real^N s p k.
998         &0 < p /\
999         (!n. (f n) IN lspace s p) /\ h IN lspace s p /\
1000         (!n x. x IN s ==> norm(f n x) <= norm(h x)) /\
1001         negligible k /\
1002         (!x. x IN s DIFF k ==> ((\n. f n x) --> g(x)) sequentially)
1003         ==> g IN lspace s p /\
1004             ((\n. lnorm s p (\x. f n x - g x)) ---> &0) sequentially`,
1005   REPEAT GEN_TAC THEN STRIP_TAC THEN
1006   MP_TAC(ISPECL
1007    [`\n x. lift(norm((f:num->real^M->real^N) n x) rpow p)`;
1008     `\x. lift(norm((g:real^M->real^N) x) rpow p)`;
1009     `\x. lift(norm((h:real^M->real^N) x) rpow p)`;
1010     `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN
1011   REWRITE_TAC[] THEN ANTS_TAC THENL
1012    [REPEAT CONJ_TAC THENL
1013      [X_GEN_TAC `k:num` THEN
1014       FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE o SPEC `k:num`) THEN
1015       MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
1016       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1017           NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
1018       FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN
1019       MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
1020       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1021           NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
1022       MAP_EVERY X_GEN_TAC [`k:num`; `x:real^M`] THEN
1023       REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
1024       REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM; LIFT_DROP] THEN
1025       MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE];
1026       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
1027       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
1028       DISCH_THEN(MP_TAC o ISPEC
1029        `(lift o (\x. x rpow p) o  drop) o (lift o (norm:real^N->real))` o
1030          MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN
1031       ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN
1032       REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
1033       MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
1034       REWRITE_TAC[CONTINUOUS_AT_LIFT_NORM] THEN
1035       GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN
1036       REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
1037       MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN
1038       REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC];
1039     STRIP_TAC] THEN
1040   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1041    [REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL
1042      [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN
1043       EXISTS_TAC `f:num->real^M->real^N` THEN
1044       EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
1045       RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[];
1046       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE
1047        [TAUT `a ==> b ==> c <=> b ==> a ==> c`] INTEGRABLE_SPIKE_SET)) THEN
1048       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1049         NEGLIGIBLE_SUBSET)) THEN SET_TAC[]];
1050     DISCH_TAC] THEN
1051   SUBGOAL_THEN
1052    `!x. x IN s DIFF k
1053         ==> norm((g:real^M->real^N) x) <= norm((h:real^M->real^N) x)`
1054   ASSUME_TAC THENL
1055    [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
1056     MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
1057     EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN
1058     ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
1059     MATCH_MP_TAC ALWAYS_EVENTUALLY THEN
1060     RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_SIMP_TAC[];
1061     ALL_TAC] THEN
1062   MP_TAC(ISPECL
1063    [`\n x. lift(norm((f:num->real^M->real^N) n x - g x) rpow p)`;
1064     `(\x. vec 0):real^M->real^1`;
1065     `\x. lift(norm(&2 % (h:real^M->real^N) x) rpow p)`;
1066     `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN
1067   REWRITE_TAC[] THEN ANTS_TAC THENL
1068    [REPEAT CONJ_TAC THENL
1069      [X_GEN_TAC `k:num` THEN
1070       SUBGOAL_THEN `(\x. (f:num->real^M->real^N) k x - g x) IN lspace s p`
1071       MP_TAC THENL
1072        [ASM_SIMP_TAC[LSPACE_SUB; REAL_LT_IMP_LE; ETA_AX]; ALL_TAC] THEN
1073       DISCH_THEN(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN
1074       REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
1075       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1076           NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
1077       REWRITE_TAC[NORM_MUL; RPOW_MUL; LIFT_CMUL] THEN
1078       MATCH_MP_TAC INTEGRABLE_CMUL THEN
1079       UNDISCH_TAC `(h:real^M->real^N) IN lspace s p` THEN
1080       DISCH_THEN(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN
1081       MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN
1082       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1083           NEGLIGIBLE_SUBSET)) THEN SET_TAC[];
1084       MAP_EVERY X_GEN_TAC [`k:num`; `x:real^M`] THEN
1085       REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
1086       REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM; LIFT_DROP] THEN
1087       MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN
1088       MATCH_MP_TAC(NORM_ARITH
1089         `norm(x:real^N) <= norm(z) /\ norm(y) <= norm z
1090          ==> norm(x - y) <= norm(&2 % z:real^N)`) THEN
1091       ASM_SIMP_TAC[IN_DIFF];
1092       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
1093       UNDISCH_TAC
1094        `!x. x IN s DIFF k
1095             ==> ((\n. (f:num->real^M->real^N) n x) --> g x) sequentially` THEN
1096       DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
1097       GEN_REWRITE_TAC LAND_CONV [LIM_NULL] THEN
1098       DISCH_THEN(MP_TAC o ISPEC
1099        `(lift o (\x. x rpow p) o  drop) o (lift o (norm:real^N->real))` o
1100          MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN
1101       ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN
1102       ASM_SIMP_TAC[NORM_0; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_DROP; LIFT_NUM] THEN
1103       DISCH_THEN MATCH_MP_TAC THEN
1104       MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
1105       REWRITE_TAC[CONTINUOUS_AT_LIFT_NORM] THEN
1106       GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN
1107       REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
1108       MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN
1109       REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC];
1110     DISCH_THEN(MP_TAC o CONJUNCT2)] THEN
1111   REWRITE_TAC[INTEGRAL_0; TENDSTO_REAL; lnorm; o_DEF; LIFT_DROP; LIFT_NUM] THEN
1112   DISCH_THEN(MP_TAC o ISPEC `lift o (\x. x rpow inv p) o  drop` o
1113      MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN
1114   ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN
1115   ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_LT_IMP_NZ; LIFT_NUM] THEN ANTS_TAC THENL
1116    [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN
1117     REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
1118     MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN
1119     REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC;
1120     ALL_TAC] THEN
1121   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN
1122   MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN
1123   X_GEN_TAC `k:num` THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN
1124   AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
1125   MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN
1126   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1127           NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);;
1128
1129 (* ------------------------------------------------------------------------- *)
1130 (* Approximation of functions in L_p by bounded ones and continuous ones.    *)
1131 (* ------------------------------------------------------------------------- *)
1132
1133 let LSPACE_APPROXIMATE_BOUNDED = prove
1134  (`!f:real^M->real^N s p e.
1135         &0 < p /\ measurable s /\ f IN lspace s p /\ &0 < e
1136         ==> ?g. g IN lspace s p /\
1137                 bounded (IMAGE g s) /\
1138                 lnorm s p (\x. f x - g x) < e`,
1139   REPEAT STRIP_TAC THEN
1140   MP_TAC(ISPECL
1141    [`(\n x. (lambda i. max (--(&n)) (min (&n) ((f:real^M->real^N)(x)$i))))
1142      :num->real^M->real^N`;
1143     `f:real^M->real^N`;
1144     `f:real^M->real^N`;
1145     `s:real^M->bool`; `p:real`; `{}:real^M->bool`]
1146         LSPACE_DOMINATED_CONVERGENCE) THEN
1147   ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN
1148   MATCH_MP_TAC(TAUT
1149    `b /\ c /\ a /\ (a /\ d ==> e)
1150     ==> (a /\ b /\ c ==> d) ==> e`) THEN
1151   REPEAT CONJ_TAC THENL
1152    [REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
1153     SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC;
1154     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN
1155     MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
1156     MP_TAC(ISPEC
1157       `sup(IMAGE (\i. abs((f:real^M->real^N) x$i)) (1..dimindex(:N)))`
1158       REAL_ARCH_SIMPLE) THEN
1159     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
1160     SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY;
1161              NOT_LT; DIMINDEX_GE_1; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
1162     SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG; CART_EQ; LAMBDA_BETA] THEN
1163     DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
1164     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
1165     MATCH_MP_TAC(REAL_ARITH
1166      `abs(x) <= n ==> max (--n) (min n x) = x`) THEN
1167     ASM_MESON_TAC[REAL_OF_NUM_LE; REAL_LE_TRANS];
1168     X_GEN_TAC `n:num` THEN
1169     MP_TAC(ISPECL
1170      [`s:real^M->bool`; `p:real`; `vec n:real^N`] LSPACE_CONST) THEN
1171     ASM_REWRITE_TAC[] THEN
1172     UNDISCH_TAC `(f:real^M->real^N) IN lspace s p` THEN
1173     REWRITE_TAC[IMP_IMP] THEN
1174     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE
1175      [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LSPACE_MIN)) THEN
1176     ASM_REWRITE_TAC[] THEN
1177     MP_TAC(ISPECL
1178      [`s:real^M->bool`; `p:real`; `--vec n:real^N`] LSPACE_CONST) THEN
1179     ASM_REWRITE_TAC[IMP_IMP] THEN
1180     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE
1181      [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LSPACE_MAX)) THEN
1182     ASM_REWRITE_TAC[] THEN
1183     MATCH_MP_TAC(MESON[] `x = y ==> x IN s ==> y IN s`) THEN
1184     SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VEC_COMPONENT;
1185              VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC;
1186     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1187     REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
1188     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1189     DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
1190     REWRITE_TAC[LE_REFL; REAL_SUB_RZERO] THEN DISCH_TAC THEN
1191     EXISTS_TAC
1192      `(\x. (lambda i. max (-- &n) (min (&n) ((f:real^M->real^N) x$i))))
1193       :real^M->real^N` THEN
1194     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1195      [REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN
1196       EXISTS_TAC `&(dimindex(:N)) * &n` THEN
1197       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
1198       W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
1199       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
1200       GEN_REWRITE_TAC
1201         (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
1202       MATCH_MP_TAC SUM_BOUND THEN
1203       SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN REAL_ARITH_TAC;
1204       MATCH_MP_TAC(REAL_ARITH `abs(x) < e ==> x < e`) THEN
1205       ONCE_REWRITE_TAC[GSYM LNORM_NEG] THEN
1206       ASM_REWRITE_TAC[VECTOR_NEG_SUB]]]);;
1207
1208 let LSPACE_APPROXIMATE_CONTINUOUS =  prove
1209  (`!f:real^M->real^N s p e.
1210         &1 <= p /\ measurable s /\ f IN lspace s p /\ &0 < e
1211         ==> ?g. g continuous_on (:real^M) /\
1212                 g IN lspace s p /\
1213                 lnorm s p (\x. f x - g x) < e`,
1214   REPEAT STRIP_TAC THEN
1215   FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 <= p ==> &0 < p`)) THEN
1216   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `p:real`; `e / &2`]
1217         LSPACE_APPROXIMATE_BOUNDED) THEN
1218   ASM_REWRITE_TAC[REAL_HALF] THEN
1219   DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
1220   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
1221   REWRITE_TAC[FORALL_IN_IMAGE] THEN
1222   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
1223   SUBGOAL_THEN
1224    `?k g. negligible k /\
1225           (!n. g n continuous_on (:real^M)) /\
1226           (!n x. x IN s ==> norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\
1227           (!x. x IN (s DIFF k)  ==> ((\n. g n x) --> h x) sequentially)`
1228   STRIP_ASSUME_TAC THENL
1229    [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL
1230      [RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[];
1231       ALL_TAC] THEN
1232     REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN
1233     X_GEN_TAC `k:real^M->bool` THEN
1234     DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN
1235     EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))):
1236                 num->real^M->real^N` THEN
1237     ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
1238      [X_GEN_TAC `n:num` THEN
1239       FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
1240       MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`]
1241                 CONTINUOUS_ON_CONST) THEN
1242       REWRITE_TAC[IMP_IMP] THEN
1243       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN
1244       MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`]
1245                 CONTINUOUS_ON_CONST) THEN
1246       REWRITE_TAC[IMP_IMP] THEN
1247       DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN
1248       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1249       SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA];
1250       REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
1251       SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN
1252       REAL_ARITH_TAC;
1253       X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
1254       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
1255       REWRITE_TAC[LIM_SEQUENTIALLY] THEN
1256       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN
1257       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
1258       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
1259       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
1260       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
1261       MATCH_MP_TAC(NORM_ARITH
1262        `norm(c - a:real^N) <= norm(b - a)
1263         ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN
1264       MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
1265       SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN
1266       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
1267       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
1268       DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN
1269       DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN
1270       REAL_ARITH_TAC];
1271     ALL_TAC] THEN
1272   SUBGOAL_THEN `!n. ((g:num->real^M->real^N) n) IN lspace s p` ASSUME_TAC THENL
1273    [X_GEN_TAC `n:num` THEN
1274     MATCH_MP_TAC LSPACE_BOUNDED_MEASURABLE THEN
1275     EXISTS_TAC `(\x. B % vec 1):real^M->real^N` THEN
1276     ASM_SIMP_TAC[LSPACE_CONST] THEN
1277     ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
1278     MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator]
1279         MEASURABLE_ON_RESTRICT) THEN
1280     ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN
1281     MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN
1282     ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE];
1283     ALL_TAC] THEN
1284   MP_TAC(ISPECL
1285    [`g:num->real^M->real^N`; `h:real^M->real^N`;
1286     `(\x. B % vec 1):real^M->real^N`;
1287     `s:real^M->bool`; `p:real`; `k:real^M->bool`]
1288         LSPACE_DOMINATED_CONVERGENCE) THEN
1289   ASM_SIMP_TAC[LSPACE_CONST] THEN
1290   REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN
1291   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
1292   DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
1293   REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN
1294   EXISTS_TAC `(g:num->real^M->real^N) n` THEN
1295   ASM_REWRITE_TAC[] THEN
1296   SUBGOAL_THEN
1297    `(\x. f x - (g:num->real^M->real^N) n x) =
1298     (\x. (f x - h x) + --(g n x - h x))`
1299   SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
1300   W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN
1301   ASM_SIMP_TAC[LSPACE_SUB; ETA_AX; REAL_LT_IMP_LE; LSPACE_NEG] THEN
1302   MATCH_MP_TAC(REAL_ARITH
1303    `y < e / &2 /\ z < e / &2 ==> x <= y + z ==> x < e`) THEN
1304   ASM_SIMP_TAC[LNORM_NEG; REAL_ARITH `abs x < e ==> x < e`]);;
1305
1306 (* ------------------------------------------------------------------------- *)
1307 (* Square-integrable real->real functions.                                   *)
1308 (* ------------------------------------------------------------------------- *)
1309
1310 parse_as_infix("square_integrable_on",(12,"right"));;
1311
1312 let square_integrable_on = new_definition
1313  `f square_integrable_on s <=>
1314      f real_measurable_on s /\ (\x. f(x) pow 2) real_integrable_on s`;;
1315
1316 let SQUARE_INTEGRABLE_IMP_MEASURABLE = prove
1317  (`!f s. f square_integrable_on s ==> f real_measurable_on s`,
1318   SIMP_TAC[square_integrable_on]);;
1319
1320 let SQUARE_INTEGRABLE_LSPACE = prove
1321  (`!f s. f square_integrable_on s <=>
1322          (lift o f o drop) IN lspace (IMAGE lift s) (&2)`,
1323   REWRITE_TAC[square_integrable_on; lspace; IN_ELIM_THM] THEN
1324   REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; RPOW_POW] THEN
1325   REWRITE_TAC[o_THM; NORM_REAL; GSYM drop; LIFT_DROP] THEN
1326   REWRITE_TAC[REAL_POW2_ABS; o_DEF]);;
1327
1328 let SQUARE_INTEGRABLE_0 = prove
1329  (`!s. (\x. &0) square_integrable_on s`,
1330   REWRITE_TAC[square_integrable_on; REAL_MEASURABLE_ON_0] THEN
1331   CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_INTEGRABLE_0]);;
1332
1333 let SQUARE_INTEGRABLE_NEG_EQ = prove
1334  (`!f s. (\x. --(f x)) square_integrable_on s <=> f square_integrable_on s`,
1335   REWRITE_TAC[square_integrable_on; REAL_MEASURABLE_ON_NEG_EQ;
1336                REAL_POW_NEG; ARITH]);;
1337
1338 let SQUARE_INTEGRABLE_NEG = prove
1339  (`!f s. f square_integrable_on s ==> (\x. --(f x)) square_integrable_on s`,
1340   REWRITE_TAC[SQUARE_INTEGRABLE_NEG_EQ]);;
1341
1342 let SQUARE_INTEGRABLE_LMUL = prove
1343  (`!f s c. f square_integrable_on s ==> (\x. c * f(x)) square_integrable_on s`,
1344   SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_LMUL] THEN
1345   SIMP_TAC[REAL_POW_MUL; REAL_INTEGRABLE_LMUL]);;
1346
1347 let SQUARE_INTEGRABLE_RMUL = prove
1348  (`!f s c. f square_integrable_on s ==> (\x. f(x) * c) square_integrable_on s`,
1349   SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_RMUL] THEN
1350   SIMP_TAC[REAL_POW_MUL; REAL_INTEGRABLE_RMUL]);;
1351
1352 let SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_PRODUCT = prove
1353  (`!f g s. f square_integrable_on s /\ g square_integrable_on s
1354            ==> (\x. f(x) * g(x)) absolutely_real_integrable_on s`,
1355   REPEAT STRIP_TAC THEN
1356   REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE] THEN
1357   ASM_SIMP_TAC[REAL_MEASURABLE_ON_MUL; SQUARE_INTEGRABLE_IMP_MEASURABLE] THEN
1358   MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `&2`;
1359                  `lift o f o drop`; `lift o g o drop`]
1360         LSPACE_INTEGRABLE_PRODUCT) THEN
1361   CONV_TAC REAL_RAT_REDUCE_CONV THEN
1362   ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; REAL_INTEGRABLE_ON] THEN
1363   REWRITE_TAC[o_DEF; NORM_REAL; GSYM drop; LIFT_DROP; REAL_ABS_MUL]);;
1364
1365 let SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT = prove
1366  (`!f g s. f square_integrable_on s /\ g square_integrable_on s
1367            ==> (\x. f(x) * g(x)) real_integrable_on s`,
1368   SIMP_TAC[SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_PRODUCT;
1369            ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);;
1370
1371 let SQUARE_INTEGRABLE_ADD = prove
1372  (`!f g s. f square_integrable_on s /\ g square_integrable_on s
1373            ==> (\x. f(x) + g(x)) square_integrable_on s`,
1374   REPEAT STRIP_TAC THEN
1375   ASM_SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_ADD;
1376                SQUARE_INTEGRABLE_IMP_MEASURABLE] THEN
1377   SIMP_TAC[REAL_ARITH `(x + y) pow 2 = (x pow 2 + y pow 2) + &2 * x * y`] THEN
1378   MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN
1379   ASM_SIMP_TAC[SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT;
1380                REAL_INTEGRABLE_LMUL] THEN
1381   RULE_ASSUM_TAC(REWRITE_RULE[square_integrable_on]) THEN
1382   ASM_SIMP_TAC[REAL_INTEGRABLE_ADD]);;
1383
1384 let SQUARE_INTEGRABLE_SUB = prove
1385  (`!f g s. f square_integrable_on s /\ g square_integrable_on s
1386            ==> (\x. f(x) - g(x)) square_integrable_on s`,
1387   SIMP_TAC[real_sub; SQUARE_INTEGRABLE_ADD; SQUARE_INTEGRABLE_NEG_EQ]);;
1388
1389 let SQUARE_INTEGRABLE_ABS = prove
1390  (`!f g s. f square_integrable_on s ==> (\x. abs(f x)) square_integrable_on s`,
1391   SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_ABS; REAL_POW2_ABS]);;
1392
1393 let SQUARE_INTEGRABLE_SUM = prove
1394  (`!f s t. FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s)
1395            ==> (\x. sum t (\i. f i x)) square_integrable_on s`,
1396   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
1397   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1398   SIMP_TAC[SQUARE_INTEGRABLE_0; IN_INSERT; SQUARE_INTEGRABLE_ADD; ETA_AX;
1399            SUM_CLAUSES]);;
1400
1401 let REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE = prove
1402  (`!f a b. f real_continuous_on real_interval[a,b]
1403            ==> f square_integrable_on real_interval[a,b]`,
1404   REPEAT STRIP_TAC THEN REWRITE_TAC[square_integrable_on] THEN CONJ_TAC THENL
1405    [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
1406     MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN ASM_REWRITE_TAC[];
1407     MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN
1408     MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN ASM_REWRITE_TAC[]]);;
1409
1410 let SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove
1411  (`!f s. f square_integrable_on s /\ real_measurable s
1412          ==> f absolutely_real_integrable_on s`,
1413   REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN
1414   REWRITE_TAC[GSYM LSPACE_1] THEN
1415   MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `&2` THEN
1416   ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE;
1417                   GSYM SQUARE_INTEGRABLE_LSPACE] THEN
1418   CONV_TAC REAL_RAT_REDUCE_CONV);;
1419
1420 let SQUARE_INTEGRABLE_IMP_INTEGRABLE = prove
1421  (`!f s. f square_integrable_on s /\ real_measurable s
1422          ==> f real_integrable_on s`,
1423   SIMP_TAC[SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE;
1424            ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);;
1425
1426 (* ------------------------------------------------------------------------- *)
1427 (* The norm and inner product in L2.                                         *)
1428 (* ------------------------------------------------------------------------- *)
1429
1430 let l2product = new_definition
1431  `l2product s f g = real_integral s (\x. f(x) * g(x))`;;
1432
1433 let l2norm = new_definition
1434  `l2norm s f = sqrt(l2product s f f)`;;
1435
1436 let L2NORM_LNORM = prove
1437  (`!f s. f square_integrable_on s
1438          ==> l2norm s f = lnorm (IMAGE lift s) (&2) (lift o f o drop)`,
1439   REPEAT STRIP_TAC THEN REWRITE_TAC[l2norm; lnorm; l2product] THEN
1440   RULE_ASSUM_TAC(REWRITE_RULE[square_integrable_on]) THEN
1441   ASM_SIMP_TAC[GSYM REAL_POW_2; REAL_INTEGRAL] THEN
1442   REWRITE_TAC[NORM_REAL; o_DEF; GSYM drop; LIFT_DROP; RPOW_POW] THEN
1443   REWRITE_TAC[REAL_POW2_ABS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
1444   MATCH_MP_TAC(GSYM RPOW_SQRT) THEN
1445   MATCH_MP_TAC INTEGRAL_DROP_POS THEN
1446   REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; REAL_LE_POW_2] THEN
1447   FIRST_ASSUM(MP_TAC o REWRITE_RULE[REAL_INTEGRABLE_ON] o CONJUNCT2) THEN
1448   REWRITE_TAC[o_DEF]);;
1449
1450 let L2PRODUCT_SYM = prove
1451  (`!s f g. l2product s f g = l2product s g f`,
1452   REWRITE_TAC[l2product; REAL_MUL_SYM]);;
1453
1454 let L2PRODUCT_POS_LE = prove
1455  (`!s f. f square_integrable_on s ==> &0 <= l2product s f f`,
1456   REWRITE_TAC[square_integrable_on; l2product] THEN
1457   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_POS THEN
1458   REWRITE_TAC[REAL_LE_SQUARE] THEN ASM_REWRITE_TAC[GSYM REAL_POW_2]);;
1459
1460 let L2NORM_POW_2 = prove
1461  (`!s f. f square_integrable_on s ==> (l2norm s f) pow 2 = l2product s f f`,
1462   SIMP_TAC[l2norm; SQRT_POW_2; L2PRODUCT_POS_LE]);;
1463
1464 let L2NORM_POS_LE = prove
1465  (`!s f. f square_integrable_on s ==> &0 <= l2norm s f`,
1466   SIMP_TAC[l2norm; SQRT_POS_LE; L2PRODUCT_POS_LE]);;
1467
1468 let L2NORM_LE = prove
1469  (`!s f g. f square_integrable_on s /\ g square_integrable_on s
1470            ==> (l2norm s f <= l2norm s g <=>
1471                 l2product s f f <= l2product s g g)`,
1472   SIMP_TAC[SQRT_MONO_LE_EQ; l2norm; SQRT_MONO_LE_EQ; L2PRODUCT_POS_LE]);;
1473
1474 let L2NORM_EQ = prove
1475  (`!s f g. f square_integrable_on s /\ g square_integrable_on s
1476            ==> (l2norm s f = l2norm s g <=>
1477                 l2product s f f = l2product s g g)`,
1478   SIMP_TAC[GSYM REAL_LE_ANTISYM; L2NORM_LE]);;
1479
1480 let SCHWARTZ_INEQUALITY_STRONG = prove
1481  (`!f g s. f square_integrable_on s /\
1482            g square_integrable_on s
1483            ==> l2product s (\x. abs(f x)) (\x. abs(g x))
1484                <= l2norm s f * l2norm s g`,
1485   REPEAT STRIP_TAC THEN
1486   MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `&2`;
1487                  `lift o f o drop`; `lift o g o drop`] HOELDER_INEQUALITY) THEN
1488   CONV_TAC REAL_RAT_REDUCE_CONV THEN
1489   ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; GSYM L2NORM_LNORM] THEN
1490   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
1491   REWRITE_TAC[l2product] THEN
1492   ASM_SIMP_TAC[REAL_INTEGRAL; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT;
1493                SQUARE_INTEGRABLE_ABS] THEN
1494   REWRITE_TAC[NORM_REAL; o_DEF; GSYM drop; LIFT_DROP; REAL_LE_REFL]);;
1495
1496 let SCHWARTZ_INEQUALITY_ABS = prove
1497  (`!f g s. f square_integrable_on s /\
1498            g square_integrable_on s
1499            ==> abs(l2product s f g) <= l2norm s f * l2norm s g`,
1500   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1501   EXISTS_TAC `l2product s (\x. abs(f x)) (\x. abs(g x))` THEN
1502   ASM_SIMP_TAC[SCHWARTZ_INEQUALITY_STRONG] THEN REWRITE_TAC[l2product] THEN
1503   MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN
1504   ASM_SIMP_TAC[SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT;
1505                SQUARE_INTEGRABLE_ABS] THEN
1506   REWRITE_TAC[REAL_ABS_MUL; REAL_LE_REFL]);;
1507
1508 let SCHWARTZ_INEQUALITY = prove
1509  (`!f g s. f square_integrable_on s /\
1510            g square_integrable_on s
1511            ==> l2product s f g <= l2norm s f * l2norm s g`,
1512   MESON_TAC[SCHWARTZ_INEQUALITY_ABS;
1513             REAL_ARITH `abs x <= a ==> x <= a`]);;
1514
1515 let L2NORM_TRIANGLE = prove
1516  (`!f g s. f square_integrable_on s /\
1517            g square_integrable_on s
1518            ==> l2norm s (\x. f x + g x) <= l2norm s f + l2norm s g`,
1519   REPEAT STRIP_TAC THEN
1520   MP_TAC(ISPECL [`IMAGE lift s`; `&2`;
1521                  `lift o f o drop`; `lift o g o drop`] LNORM_TRIANGLE) THEN
1522   CONV_TAC REAL_RAT_REDUCE_CONV THEN
1523   ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; L2NORM_LNORM;
1524                SQUARE_INTEGRABLE_ADD] THEN
1525   REWRITE_TAC[o_DEF; LIFT_ADD]);;
1526
1527 let L2PRODUCT_LADD = prove
1528  (`!s f g h.
1529         f square_integrable_on s /\
1530         g square_integrable_on s /\
1531         h square_integrable_on s
1532         ==> l2product s (\x. f x + g x) h =
1533             l2product s f h + l2product s g h`,
1534   SIMP_TAC[l2product; REAL_ADD_RDISTRIB; REAL_INTEGRAL_ADD;
1535            SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);;
1536
1537 let L2PRODUCT_RADD = prove
1538  (`!s f g h.
1539         f square_integrable_on s /\
1540         g square_integrable_on s /\
1541         h square_integrable_on s
1542         ==> l2product s f (\x. g x + h x) =
1543             l2product s f g + l2product s f h`,
1544   SIMP_TAC[l2product; REAL_ADD_LDISTRIB; REAL_INTEGRAL_ADD;
1545            SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);;
1546
1547 let L2PRODUCT_LSUB = prove
1548  (`!s f g h.
1549         f square_integrable_on s /\
1550         g square_integrable_on s /\
1551         h square_integrable_on s
1552         ==> l2product s (\x. f x - g x) h =
1553             l2product s f h - l2product s g h`,
1554   SIMP_TAC[l2product; REAL_SUB_RDISTRIB; REAL_INTEGRAL_SUB;
1555            SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);;
1556
1557 let L2PRODUCT_RSUB = prove
1558  (`!s f g h.
1559         f square_integrable_on s /\
1560         g square_integrable_on s /\
1561         h square_integrable_on s
1562         ==> l2product s f (\x. g x - h x) =
1563             l2product s f g - l2product s f h`,
1564   SIMP_TAC[l2product; REAL_SUB_LDISTRIB; REAL_INTEGRAL_SUB;
1565            SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);;
1566
1567 let L2PRODUCT_LZERO = prove
1568  (`!s f. l2product s (\x. &0) f = &0`,
1569   REWRITE_TAC[l2product; REAL_MUL_LZERO; REAL_INTEGRAL_0]);;
1570
1571 let L2PRODUCT_RZERO = prove
1572  (`!s f. l2product s f (\x. &0) = &0`,
1573   REWRITE_TAC[l2product; REAL_MUL_RZERO; REAL_INTEGRAL_0]);;
1574
1575 let L2PRODUCT_LSUM = prove
1576  (`!s f g t.
1577         FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) /\
1578         g square_integrable_on s
1579         ==> l2product s (\x. sum t (\i. f i x)) g =
1580             sum t (\i. l2product s (f i) g)`,
1581   REPLICATE_TAC 3 GEN_TAC THEN
1582   ASM_CASES_TAC `g square_integrable_on s` THEN ASM_REWRITE_TAC[IMP_CONJ] THEN
1583   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1584   ASM_SIMP_TAC[L2PRODUCT_LZERO; SUM_CLAUSES; L2PRODUCT_LADD;
1585                SQUARE_INTEGRABLE_SUM; ETA_AX; IN_INSERT]);;
1586
1587 let L2PRODUCT_RSUM = prove
1588  (`!s f g t.
1589         FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) /\
1590         g square_integrable_on s
1591         ==> l2product s g (\x. sum t (\i. f i x)) =
1592             sum t (\i. l2product s g (f i))`,
1593   ONCE_REWRITE_TAC[L2PRODUCT_SYM] THEN REWRITE_TAC[L2PRODUCT_LSUM]);;
1594
1595 let L2PRODUCT_LMUL = prove
1596  (`!s c f g.
1597         f square_integrable_on s /\ g square_integrable_on s
1598         ==> l2product s (\x. c * f x) g = c * l2product s f g`,
1599   SIMP_TAC[l2product; GSYM REAL_MUL_ASSOC; REAL_INTEGRAL_LMUL;
1600            SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);;
1601
1602 let L2PRODUCT_RMUL = prove
1603  (`!s c f g.
1604         f square_integrable_on s /\ g square_integrable_on s
1605         ==> l2product s f (\x. c * g x) = c * l2product s f g`,
1606   ONCE_REWRITE_TAC[L2PRODUCT_SYM] THEN SIMP_TAC[L2PRODUCT_LMUL]);;
1607
1608 let L2NORM_LMUL = prove
1609  (`!f s c. f square_integrable_on s
1610            ==> l2norm s (\x. c * f(x)) = abs(c) * l2norm s f`,
1611   REPEAT STRIP_TAC THEN
1612   ASM_SIMP_TAC[l2norm; L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL] THEN
1613   ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL] THEN
1614   REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_2] THEN
1615   REWRITE_TAC[SQRT_MUL; POW_2_SQRT_ABS]);;
1616
1617 let L2NORM_RMUL = prove
1618  (`!f s c. f square_integrable_on s
1619            ==> l2norm s (\x. f(x) * c) = l2norm s f * abs(c)`,
1620   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[L2NORM_LMUL]);;
1621
1622 let L2NORM_NEG = prove
1623  (`!f s. f square_integrable_on s ==> l2norm s (\x. --(f x)) = l2norm s f`,
1624   ONCE_REWRITE_TAC[REAL_ARITH `--x:real = --(&1) * x`] THEN
1625   SIMP_TAC[L2NORM_LMUL; REAL_ABS_NEG; REAL_ABS_NUM; REAL_MUL_LID]);;
1626
1627 let L2NORM_SUB = prove
1628  (`!f g s.  f square_integrable_on s /\ g square_integrable_on s
1629         ==> l2norm s (\x. f x - g x) = l2norm s (\x. g x - f x)`,
1630   REPEAT STRIP_TAC THEN
1631   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_NEG_SUB] THEN
1632   ASM_SIMP_TAC[L2NORM_NEG; SQUARE_INTEGRABLE_SUB; ETA_AX]);;
1633
1634 let L2_SUMMABLE = prove
1635  (`!f s t.
1636      (!i. i IN t ==> (f i) square_integrable_on s) /\
1637      real_summable t (\i. l2norm s (f i))
1638      ==> ?g. g square_integrable_on s /\
1639              ((\n. l2norm s (\x. sum (t INTER (0..n)) (\i. f i x) - g x))
1640               ---> &0) sequentially`,
1641   REPEAT STRIP_TAC THEN
1642   MP_TAC(ISPECL [`\n:num. (lift o f n o drop)`;
1643                  `&2`; `IMAGE lift s`; `t:num->bool`]
1644         LSPACE_SUMMABLE) THEN
1645   ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN
1646   CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL
1647    [UNDISCH_TAC `real_summable t (\i. l2norm s (f i))` THEN
1648     MATCH_MP_TAC EQ_IMP THEN
1649     REWRITE_TAC[real_summable; real_sums; REALLIM_SEQUENTIALLY] THEN
1650     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
1651     X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
1652     X_GEN_TAC `e:real` THEN AP_TERM_TAC THEN
1653     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `N:num` THEN
1654     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN
1655     AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
1656     AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN
1657     ASM_SIMP_TAC[GSYM L2NORM_LNORM; IN_INTER; ETA_AX];
1658     DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` MP_TAC) THEN
1659     SUBGOAL_THEN `g = (lift o (drop o g o lift) o drop)` SUBST1_TAC THENL
1660      [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN
1661     ABBREV_TAC `h = drop o g o lift` THEN
1662     REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN
1663     DISCH_THEN(fun th -> EXISTS_TAC `h:real->real` THEN MP_TAC th) THEN
1664     ASM_CASES_TAC `h square_integrable_on s` THEN ASM_REWRITE_TAC[] THEN
1665     SIMP_TAC[o_DEF; GSYM LIFT_SUB; REWRITE_RULE[o_DEF] (GSYM LIFT_SUM);
1666              FINITE_NUMSEG; FINITE_INTER] THEN
1667     SUBGOAL_THEN `!f. (\x. lift(f(drop x))) = (lift o f o drop)`
1668      (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
1669     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1670     REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
1671     MATCH_MP_TAC(GSYM L2NORM_LNORM) THEN
1672     MATCH_MP_TAC SQUARE_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN
1673     MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN
1674     ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);;
1675
1676 let L2_COMPLETE = prove
1677  (`!f s. (!i. f i square_integrable_on s) /\
1678          (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N
1679                                    ==> l2norm s (\x. f m x - f n x) < e)
1680          ==> ?g. g square_integrable_on s /\
1681                  ((\n. l2norm s (\x. f n x - g x)) ---> &0) sequentially`,
1682   REPEAT STRIP_TAC THEN
1683   MP_TAC(ISPECL [`\n:num. lift o f n o drop`; `&2`; `IMAGE lift s`]
1684         RIESZ_FISCHER) THEN
1685   ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN ANTS_TAC THENL
1686    [CONV_TAC REAL_RAT_REDUCE_CONV;
1687     DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` MP_TAC) THEN
1688     SUBGOAL_THEN `g = (lift o (drop o g o lift) o drop)` SUBST1_TAC THENL
1689      [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN
1690     ABBREV_TAC `h = drop o g o lift` THEN
1691     REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN
1692     DISCH_THEN(fun th -> EXISTS_TAC `h:real->real` THEN MP_TAC th) THEN
1693     ASM_CASES_TAC `h square_integrable_on s` THEN ASM_REWRITE_TAC[]] THEN
1694   (SUBGOAL_THEN `!f g. (\x. (lift o f o drop) x - (lift o g o drop) x) =
1695                        (lift o (\y. f y - g y) o drop)`
1696     (fun th -> REWRITE_TAC[th])
1697    THENL
1698     [REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB];
1699      ASM_SIMP_TAC[GSYM L2NORM_LNORM; SQUARE_INTEGRABLE_SUB; ETA_AX]]) THEN
1700   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
1701   ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> abs(x - &0) = x`; GE;
1702                L2NORM_POS_LE; SQUARE_INTEGRABLE_SUB; ETA_AX]);;
1703
1704 let SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove
1705  (`!f s e. real_measurable s /\ f square_integrable_on s /\ &0 < e
1706            ==> ?g. g real_continuous_on (:real) /\
1707                    g square_integrable_on s /\
1708                    l2norm s (\x. f x - g x) < e`,
1709   REPEAT STRIP_TAC THEN
1710   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `&2:real`; `e:real`]
1711           LSPACE_APPROXIMATE_CONTINUOUS) THEN
1712   ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; REAL_OF_NUM_LE; ARITH;
1713                   GSYM REAL_MEASURABLE_MEASURABLE] THEN
1714   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN
1715   EXISTS_TAC `drop o g o lift` THEN CONJ_TAC THENL
1716    [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_DROP; ETA_AX;
1717                     IMAGE_LIFT_UNIV];
1718     ALL_TAC] THEN
1719   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1720    [ASM_REWRITE_TAC[SQUARE_INTEGRABLE_LSPACE; o_DEF; LIFT_DROP; ETA_AX];
1721     DISCH_TAC THEN
1722     ASM_SIMP_TAC[L2NORM_LNORM; SQUARE_INTEGRABLE_SUB; ETA_AX] THEN
1723     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
1724      `x < e ==> x = y ==> y < e`)) THEN
1725     REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB]]);;
1726
1727 (* ------------------------------------------------------------------------- *)
1728 (* Orthonormal system of L2 functions and their Fourier coefficients.        *)
1729 (* ------------------------------------------------------------------------- *)
1730
1731 let orthonormal_system = new_definition
1732  `orthonormal_system s w <=>
1733         !m n. l2product s (w m) (w n) = if m = n then &1 else &0`;;
1734
1735 let orthonormal_coefficient = new_definition
1736  `orthonormal_coefficient s w f (n:num) = l2product s (w n) f`;;
1737
1738 let ORTHONORMAL_SYSTEM_L2NORM = prove
1739  (`!s w. orthonormal_system s w ==> !i. l2norm s (w i) = &1`,
1740   SIMP_TAC[orthonormal_system; l2norm; SQRT_1]);;
1741
1742 let ORTHONORMAL_PARTIAL_SUM_DIFF = prove
1743  (`!s w a f t.
1744         orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1745         f square_integrable_on s /\ FINITE t
1746         ==> l2norm s (\x. f(x) - sum t (\i. a i * w i x)) pow 2 =
1747             (l2norm s f) pow 2 + sum t (\i. (a i) pow 2) -
1748             &2 * sum t (\i. a i * orthonormal_coefficient s w f i)`,
1749   REPEAT STRIP_TAC THEN
1750   SUBGOAL_THEN `(\x. sum t (\i:num. a i * w i x)) square_integrable_on s`
1751   ASSUME_TAC THENL
1752    [ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; ETA_AX; FINITE_NUMSEG;
1753                  SQUARE_INTEGRABLE_LMUL];
1754    ALL_TAC] THEN
1755   ASM_SIMP_TAC[L2NORM_POW_2; SQUARE_INTEGRABLE_SUB; ETA_AX; L2PRODUCT_LSUB] THEN
1756   ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; ETA_AX; L2PRODUCT_RSUB] THEN
1757   MATCH_MP_TAC(REAL_ARITH
1758    `x' = x /\ b - &2 * x = c ==> a - x - (x' - b) = a + c`) THEN
1759   CONJ_TAC THENL [ASM_REWRITE_TAC[L2PRODUCT_SYM]; ALL_TAC] THEN
1760   ASM_SIMP_TAC[L2PRODUCT_RSUM; ETA_AX; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG;
1761                SQUARE_INTEGRABLE_SUM] THEN
1762   ASM_SIMP_TAC[L2PRODUCT_LSUM; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG;
1763                ETA_AX] THEN
1764   ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1765   ASM_SIMP_TAC[L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1766   RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN
1767   ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA] THEN
1768   REWRITE_TAC[orthonormal_coefficient; REAL_MUL_RID; GSYM REAL_POW_2] THEN
1769   REWRITE_TAC[L2PRODUCT_SYM]);;
1770
1771 let ORTHONORMAL_OPTIMAL_PARTIAL_SUM = prove
1772  (`!s w a f t.
1773         orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1774         f square_integrable_on s /\ FINITE t
1775         ==>  l2norm s (\x. f(x) -
1776                            sum t (\i. orthonormal_coefficient s w f i * w i x))
1777              <= l2norm s (\x. f(x) - sum t (\i. a i * w i x))`,
1778   REPEAT STRIP_TAC THEN
1779   ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
1780    [L2NORM_LE; SQUARE_INTEGRABLE_SUM; ETA_AX; FINITE_NUMSEG;
1781     GSYM L2NORM_POW_2; SQUARE_INTEGRABLE_LMUL; SQUARE_INTEGRABLE_SUB] THEN
1782   ASM_SIMP_TAC[ORTHONORMAL_PARTIAL_SUM_DIFF] THEN
1783   REWRITE_TAC[REAL_LE_LADD] THEN
1784   ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_SUB] THEN
1785   MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN
1786   REWRITE_TAC[REAL_ARITH
1787    `b pow 2 - &2 * b * b <= a pow 2 - &2 * a * b <=> &0 <= (a - b) pow 2`] THEN
1788   REWRITE_TAC[REAL_LE_POW_2]);;
1789
1790 let BESSEL_INEQUALITY = prove
1791  (`!s w f t.
1792         orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1793         f square_integrable_on s /\ FINITE t
1794         ==> sum t (\i. (orthonormal_coefficient s w f i) pow 2)
1795              <= l2norm s f pow 2`,
1796   REPEAT GEN_TAC THEN DISCH_TAC THEN
1797   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_PARTIAL_SUM_DIFF) THEN
1798   DISCH_THEN(MP_TAC o SPEC `orthonormal_coefficient s w f`) THEN
1799   REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a + b - &2 * b = a - b`] THEN
1800   MATCH_MP_TAC(REAL_ARITH `&0 <= p ==> p = x - y ==> y <= x`) THEN
1801   REWRITE_TAC[REAL_LE_POW_2]);;
1802
1803 let FOURIER_SERIES_SQUARE_SUMMABLE = prove
1804  (`!s w f t.
1805         orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1806         f square_integrable_on s
1807         ==> real_summable t (\i. (orthonormal_coefficient s w f i) pow 2)`,
1808   REPEAT GEN_TAC THEN DISCH_TAC THEN
1809   REWRITE_TAC[real_summable; real_sums; REALLIM_SEQUENTIALLY] THEN
1810   MP_TAC(ISPECL
1811    [`\n. sum(t INTER (0..n)) (\i. (orthonormal_coefficient s w f i) pow 2)`;
1812     `l2norm s f pow 2`] CONVERGENT_BOUNDED_MONOTONE) THEN
1813   REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
1814    [X_GEN_TAC `n:num` THEN
1815     MP_TAC(ISPECL [`s:real->bool`; `w:num->real->real`;
1816                 `f:real->real`; `t INTER (0..n)`] BESSEL_INEQUALITY) THEN
1817     ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN
1818     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
1819     MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= y`) THEN
1820     SIMP_TAC[SUM_POS_LE; FINITE_INTER; FINITE_NUMSEG; REAL_LE_POW_2] THEN
1821     MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
1822     SIMP_TAC[FINITE_INTER; SUBSET_REFL; FINITE_NUMSEG; REAL_LE_POW_2];
1823     DISJ1_TAC THEN REPEAT STRIP_TAC THEN
1824     MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
1825     SIMP_TAC[INTER_SUBSET; FINITE_NUMSEG; REAL_LE_POW_2; FINITE_INTER] THEN
1826     MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u INTER s SUBSET u INTER t`) THEN
1827     REWRITE_TAC[SUBSET_NUMSEG] THEN ASM_ARITH_TAC]);;
1828
1829 let ORTHONORMAL_FOURIER_PARTIAL_SUM_DIFF_SQUARED = prove
1830  (`!s w a f t.
1831     orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1832     f square_integrable_on s /\ FINITE t
1833     ==> l2norm s (\x. f x -
1834                       sum t (\i. orthonormal_coefficient s w f i * w i x))
1835         pow 2 =
1836         l2norm s f pow 2 - sum t (\i. orthonormal_coefficient s w f i pow 2)`,
1837   REPEAT GEN_TAC THEN DISCH_TAC THEN
1838   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_PARTIAL_SUM_DIFF) THEN
1839   DISCH_THEN(MP_TAC o SPEC `orthonormal_coefficient s w f`) THEN
1840   REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a + b - &2 * b = a - b`]);;
1841
1842 let FOURIER_SERIES_L2_SUMMABLE = prove
1843  (`!s w f t.
1844     orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1845     f square_integrable_on s
1846     ==> ?g. g square_integrable_on s /\
1847             ((\n. l2norm s
1848                     (\x. sum (t INTER (0..n))
1849                              (\i. orthonormal_coefficient s w f i * w i x) -
1850                          g(x))) ---> &0) sequentially`,
1851   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC L2_COMPLETE THEN
1852   ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG;
1853                SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1854   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1855   FIRST_ASSUM(MP_TAC o SPEC `t:num->bool` o
1856    MATCH_MP FOURIER_SERIES_SQUARE_SUMMABLE) THEN
1857   REWRITE_TAC[REAL_SUMMABLE; summable; sums; CONVERGENT_EQ_CAUCHY] THEN
1858   REWRITE_TAC[cauchy; GE] THEN
1859   DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN
1860   ASM_SIMP_TAC[REAL_POW_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN
1861   X_GEN_TAC `N:num` THEN STRIP_TAC THEN
1862   GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN
1863   CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THENL
1864    [ASM_CASES_TAC `N:num <= m` THEN ASM_CASES_TAC `N:num <= n` THEN
1865     ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1866     MATCH_MP_TAC L2NORM_SUB THEN
1867     ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG;
1868                SQUARE_INTEGRABLE_LMUL; ETA_AX];
1869     ALL_TAC] THEN
1870   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN EXISTS_TAC `2` THEN
1871   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
1872   FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `m:num`]) THEN
1873   SIMP_TAC[DIST_REAL; GSYM drop; DROP_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN
1874   ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN
1875   SUBGOAL_THEN
1876    `!f. sum (t INTER (0..n)) f - sum (t INTER (0..m)) f =
1877         sum (t INTER (m+1..n)) f`
1878    (fun th -> REWRITE_TAC[th])
1879   THENL
1880    [X_GEN_TAC `h:num->real` THEN
1881     REWRITE_TAC[REAL_ARITH `a - b:real = c <=> b + c = a`] THEN
1882     MATCH_MP_TAC SUM_UNION_EQ THEN
1883     SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; EXTENSION; IN_INTER; NOT_IN_EMPTY;
1884              IN_UNION; IN_NUMSEG] THEN
1885     CONJ_TAC THEN X_GEN_TAC `i:num` THEN
1886     ASM_CASES_TAC `(i:num) IN t` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
1887     ALL_TAC] THEN
1888   MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN
1889   ASM_SIMP_TAC[L2NORM_POW_2; SQUARE_INTEGRABLE_SUM; FINITE_INTER;
1890                FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1891   ASM_SIMP_TAC[L2PRODUCT_RSUM; ETA_AX; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG;
1892                FINITE_INTER; SQUARE_INTEGRABLE_SUM] THEN
1893   ASM_SIMP_TAC[L2PRODUCT_LSUM; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG;
1894                FINITE_INTER; ETA_AX] THEN
1895   ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1896   ASM_SIMP_TAC[L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1897   RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN
1898   ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA] THEN
1899   REWRITE_TAC[REAL_MUL_RID; REAL_POW_2; REAL_ARITH `x <= abs x`]);;
1900
1901 let FOURIER_SERIES_L2_SUMMABLE_STRONG = prove
1902  (`!s w f t.
1903     orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\
1904     f square_integrable_on s
1905     ==> ?g. g square_integrable_on s /\
1906             (!i. i IN t
1907                  ==> orthonormal_coefficient s w (\x. f x - g x) i = &0) /\
1908             ((\n. l2norm s
1909                    (\x. sum (t INTER (0..n))
1910                             (\i. orthonormal_coefficient s w f i * w i x) -
1911                         g(x))) ---> &0) sequentially`,
1912   REPEAT GEN_TAC THEN DISCH_TAC THEN
1913   FIRST_ASSUM(MP_TAC o SPEC `t:num->bool` o
1914     MATCH_MP FOURIER_SERIES_L2_SUMMABLE) THEN
1915   REWRITE_TAC[orthonormal_coefficient] THEN
1916   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN
1917   STRIP_TAC THEN ASM_REWRITE_TAC[orthonormal_coefficient] THEN
1918   X_GEN_TAC `i:num` THEN DISCH_TAC THEN
1919   MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN
1920   EXISTS_TAC
1921    `\n. l2product s (w i)
1922      (\x. (f x - sum (t INTER (0..n)) (\i. l2product s (w i) f * w i x)) +
1923           (sum (t INTER (0..n)) (\i. l2product s (w i) f * w i x) - g x))` THEN
1924   REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
1925    [MATCH_MP_TAC REALLIM_EVENTUALLY THEN
1926     MATCH_MP_TAC ALWAYS_EVENTUALLY THEN GEN_TAC THEN
1927     REWRITE_TAC[] THEN AP_TERM_TAC THEN
1928     REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC;
1929     ALL_TAC] THEN
1930   ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
1931    [L2PRODUCT_RADD; SQUARE_INTEGRABLE_SUB;  SQUARE_INTEGRABLE_SUM;
1932     FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1933   GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN
1934   MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL
1935    [MATCH_MP_TAC REALLIM_EVENTUALLY THEN
1936     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
1937     EXISTS_TAC `i:num` THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN
1938     ASM_SIMP_TAC[L2PRODUCT_RSUB; SQUARE_INTEGRABLE_SUM; L2PRODUCT_RSUM;
1939            FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1940     ASM_SIMP_TAC[L2PRODUCT_RMUL; ETA_AX] THEN
1941     RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN
1942     ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO] THEN
1943     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1944     ASM_SIMP_TAC[SUM_DELTA; IN_INTER; IN_NUMSEG; LE_0; REAL_MUL_RID] THEN
1945     REWRITE_TAC[REAL_SUB_REFL];
1946     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1947      (REWRITE_RULE[IMP_CONJ_ALT] REALLIM_NULL_COMPARISON)) THEN
1948     MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN
1949     REWRITE_TAC[] THEN
1950     W(MP_TAC o PART_MATCH (lhand o rand) SCHWARTZ_INEQUALITY_ABS o
1951         lhand o snd) THEN
1952     ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB;  SQUARE_INTEGRABLE_SUM;
1953       FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN
1954     ASM_SIMP_TAC[ORTHONORMAL_SYSTEM_L2NORM; REAL_MUL_LID]]);;
1955
1956 (* ------------------------------------------------------------------------- *)
1957 (* Actual trigonometric orthogonality relations.                             *)
1958 (* ------------------------------------------------------------------------- *)
1959
1960 let REAL_INTEGRABLE_ON_INTERVAL_TAC =
1961   MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN
1962   MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
1963   REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
1964   GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC;;
1965
1966 let HAS_REAL_INTEGRAL_SIN_NX = prove
1967  (`!n. ((\x. sin(&n * x)) has_real_integral &0) (real_interval[--pi,pi])`,
1968   GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN
1969   ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0; REAL_MUL_LZERO; SIN_0] THEN
1970   MP_TAC(ISPECL
1971    [`\x. --(inv(&n) * cos(&n * x))`; `\x. sin(&n * x)`; `--pi`; `pi`]
1972         REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
1973   SIMP_TAC[REAL_ARITH `&0 <= pi ==> --pi <= pi`; PI_POS_LE] THEN
1974   REWRITE_TAC[REAL_MUL_RNEG; SIN_NPI; COS_NPI; SIN_NEG; COS_NEG] THEN
1975   REWRITE_TAC[REAL_SUB_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN
1976   X_GEN_TAC `x:real` THEN DISCH_TAC THEN REAL_DIFF_TAC THEN
1977   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN
1978   CONV_TAC REAL_FIELD);;
1979
1980 let REAL_INTEGRABLE_SIN_CX = prove
1981  (`!c. (\x. sin(c * x)) real_integrable_on real_interval[--pi,pi]`,
1982   GEN_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);;
1983
1984 let REAL_INTEGRAL_SIN_NX = prove
1985  (`!n. real_integral (real_interval[--pi,pi]) (\x. sin(&n * x)) = &0`,
1986   GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
1987   REWRITE_TAC[HAS_REAL_INTEGRAL_SIN_NX]);;
1988
1989 let HAS_REAL_INTEGRAL_COS_NX = prove
1990  (`!n. ((\x. cos(&n * x)) has_real_integral (if n = 0 then &2 * pi else &0))
1991        (real_interval[--pi,pi])`,
1992   GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL
1993    [ASM_REWRITE_TAC[COS_0; REAL_MUL_LZERO] THEN
1994     REWRITE_TAC[REAL_ARITH `&2 * pi = &1 * (pi - --pi)`] THEN
1995     MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN
1996     MP_TAC PI_POS THEN REAL_ARITH_TAC;
1997     MP_TAC(ISPECL
1998      [`\x. inv(&n) * sin(&n * x)`; `\x. cos(&n * x)`; `--pi`; `pi`]
1999           REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
2000     SIMP_TAC[REAL_ARITH `&0 <= pi ==> --pi <= pi`; PI_POS_LE] THEN
2001     REWRITE_TAC[REAL_MUL_RNEG; SIN_NPI; COS_NPI; SIN_NEG; COS_NEG] THEN
2002     ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_SUB_REFL] THEN
2003     DISCH_THEN MATCH_MP_TAC THEN
2004     X_GEN_TAC `x:real` THEN DISCH_TAC THEN REAL_DIFF_TAC THEN
2005     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
2006      [GSYM REAL_OF_NUM_EQ]) THEN
2007     CONV_TAC REAL_FIELD]);;
2008
2009 let REAL_INTEGRABLE_COS_CX = prove
2010  (`!c. (\x. cos(c * x)) real_integrable_on real_interval[--pi,pi]`,
2011   GEN_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);;
2012
2013 let REAL_INTEGRAL_COS_NX = prove
2014  (`!n. real_integral (real_interval[--pi,pi]) (\x. cos(&n * x)) =
2015        if n = 0 then &2 * pi else &0`,
2016   GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
2017   REWRITE_TAC[HAS_REAL_INTEGRAL_COS_NX]);;
2018
2019 let REAL_INTEGRAL_SIN_AND_COS = prove
2020  (`!m n. real_integral (real_interval[--pi,pi])
2021            (\x. cos(&m * x) * cos(&n * x)) =
2022                 (if m = n then if n = 0 then &2 * pi else pi else &0) /\
2023          real_integral (real_interval[--pi,pi])
2024            (\x. cos(&m * x) * sin(&n * x)) = &0 /\
2025          real_integral (real_interval[--pi,pi])
2026            (\x. sin(&m * x) * cos(&n * x)) = &0 /\
2027          real_integral (real_interval[--pi,pi])
2028            (\x. sin(&m * x) * sin(&n * x)) =
2029               (if m = n /\ ~(n = 0) then pi else &0)`,
2030   GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN
2031   MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
2032    [REWRITE_TAC[REAL_MUL_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
2033   MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN DISCH_TAC THEN
2034   REWRITE_TAC[REAL_MUL_SIN_COS; REAL_MUL_COS_SIN;
2035               REAL_MUL_COS_COS; REAL_MUL_SIN_SIN] THEN
2036   REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
2037   SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRAL_SUB; real_div;
2038            REAL_INTEGRABLE_SIN_CX; REAL_INTEGRABLE_COS_CX;
2039            REAL_INTEGRAL_RMUL; REAL_INTEGRABLE_SUB; REAL_INTEGRABLE_ADD] THEN
2040   ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_SUB] THEN
2041   REWRITE_TAC[REAL_INTEGRAL_SIN_NX; REAL_INTEGRAL_COS_NX] THEN
2042   REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO; REAL_ADD_LID] THEN
2043   ASM_SIMP_TAC[ARITH_RULE `n:num <= m ==> (m - n = 0 <=> m = n)`] THEN
2044   REWRITE_TAC[ADD_EQ_0] THEN
2045   ASM_CASES_TAC `n = 0` THEN
2046   ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ARITH `(a + a) * inv(&2) = a`;
2047                   REAL_MUL_LZERO] THEN
2048   REAL_ARITH_TAC);;
2049
2050 let REAL_INTEGRABLE_SIN_AND_COS = prove
2051  (`!m n a b.
2052       (\x. cos(&m * x) * cos(&n * x)) real_integrable_on real_interval[a,b] /\
2053       (\x. cos(&m * x) * sin(&n * x)) real_integrable_on real_interval[a,b] /\
2054       (\x. sin(&m * x) * cos(&n * x)) real_integrable_on real_interval[a,b] /\
2055       (\x. sin(&m * x) * sin(&n * x)) real_integrable_on real_interval[a,b]`,
2056   REPEAT GEN_TAC THEN REPEAT CONJ_TAC THEN
2057   REAL_INTEGRABLE_ON_INTERVAL_TAC);;
2058
2059 let trigonometric_set_def = new_definition
2060  `trigonometric_set n =
2061     if n = 0 then \x. &1 / sqrt(&2 * pi)
2062     else if ODD n then \x. sin(&(n DIV 2 + 1) * x) / sqrt(pi)
2063     else \x. cos(&(n DIV 2) * x) / sqrt(pi)`;;
2064
2065 let trigonometric_set = prove
2066  (`trigonometric_set 0 = (\x. cos(&0 * x) / sqrt(&2 * pi)) /\
2067    trigonometric_set (2 * n + 1) = (\x. sin(&(n + 1) * x) / sqrt(pi)) /\
2068    trigonometric_set (2 * n + 2) = (\x. cos(&(n + 1) * x) / sqrt(pi))`,
2069   REWRITE_TAC[trigonometric_set_def; EVEN_ADD; EVEN_MULT; ARITH; ADD_EQ_0;
2070               GSYM NOT_EVEN] THEN
2071   REWRITE_TAC[ARITH_RULE `(2 * n + 1) DIV 2 = n`] THEN
2072   REWRITE_TAC[ARITH_RULE `(2 * n + 2) DIV 2 = n + 1`] THEN
2073   REWRITE_TAC[REAL_MUL_LZERO; COS_0]);;
2074
2075 let TRIGONOMETRIC_SET_EVEN = prove
2076  (`!k. trigonometric_set(2 * k) =
2077         if k = 0 then \x. &1 / sqrt(&2 * pi)
2078         else \x. cos(&k * x) / sqrt pi`,
2079   INDUCT_TAC THEN
2080   REWRITE_TAC[ARITH; trigonometric_set; REAL_MUL_LZERO; COS_0] THEN
2081   REWRITE_TAC[NOT_SUC; ARITH_RULE `2 * SUC k = 2 * k + 2`] THEN
2082   REWRITE_TAC[trigonometric_set; GSYM ADD1]);;
2083
2084 let ODD_EVEN_INDUCT_LEMMA = prove
2085  (`(!n:num. P 0) /\ (!n. P(2 * n + 1)) /\ (!n. P(2 * n + 2)) ==> !n. P n`,
2086   REWRITE_TAC[FORALL_SIMP] THEN STRIP_TAC THEN
2087   MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN
2088   X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN
2089   MP_TAC(ISPEC `n:num` EVEN_OR_ODD) THEN
2090   REWRITE_TAC[EVEN_EXISTS; ODD_EXISTS] THEN STRIP_TAC THEN
2091   ASM_REWRITE_TAC[ARITH_RULE
2092     `SUC(2 * n) = 2 * n + 1 /\ SUC(2 * n + 1) = 2 * n + 2`]);;
2093
2094 let ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET = prove
2095  (`orthonormal_system (real_interval[--pi,pi]) trigonometric_set`,
2096   REWRITE_TAC[orthonormal_system; l2product] THEN
2097   MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2098   REPEAT CONJ_TAC THEN X_GEN_TAC `m:num` THEN
2099   MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2100   REPEAT CONJ_TAC THEN X_GEN_TAC `n:num` THEN
2101   REWRITE_TAC[trigonometric_set] THEN
2102   REWRITE_TAC[REAL_ARITH `a / k * b / l:real = (inv(k) * inv(l)) * a * b`] THEN
2103   SIMP_TAC[REAL_INTEGRAL_LMUL; REAL_INTEGRABLE_SIN_AND_COS] THEN
2104   REWRITE_TAC[REAL_INTEGRAL_SIN_AND_COS] THEN
2105   REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_MUL_RZERO] THEN
2106   ASM_CASES_TAC `m:num = n` THEN
2107   TRY (COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
2108   TRY (MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC) THEN
2109   ASM_REWRITE_TAC[ARITH_RULE `0 = a + b <=> a = 0 /\ b = 0`;
2110                   EQ_ADD_RCANCEL; EQ_MULT_LCANCEL] THEN
2111   REWRITE_TAC[ARITH; REAL_MUL_RZERO] THEN
2112   REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_POW_2] THEN
2113   SIMP_TAC[SQRT_POW_2; REAL_LE_MUL; REAL_POS; PI_POS_LE] THEN
2114   MATCH_MP_TAC REAL_MUL_LINV THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);;
2115
2116 let SQUARE_INTEGRABLE_TRIGONOMETRIC_SET = prove
2117  (`!i. (trigonometric_set i) square_integrable_on real_interval[--pi,pi]`,
2118   MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2119   REWRITE_TAC[trigonometric_set] THEN
2120   REWRITE_TAC[real_div] THEN REPEAT STRIP_TAC THEN
2121   MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN
2122   MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
2123   REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
2124   GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC);;
2125
2126 (* ------------------------------------------------------------------------- *)
2127 (* Weierstrass for trigonometric polynomials.                                *)
2128 (* ------------------------------------------------------------------------- *)
2129
2130 let WEIERSTRASS_TRIG_POLYNOMIAL = prove
2131  (`!f e. f real_continuous_on real_interval[--pi,pi] /\
2132          f(--pi) = f pi /\ &0 < e
2133          ==> ?n a b.
2134                 !x. x IN real_interval[--pi,pi]
2135                     ==> abs(f x - sum(0..n) (\k. a k * sin(&k * x) +
2136                                                  b k * cos(&k * x))) < e`,
2137   let lemma1 = prove
2138    (`!f. f real_continuous_on (:real) /\ (!x. f(x + &2 * pi) = f x)
2139          ==> !z. norm z = &1
2140                  ==> (f o Im o clog) real_continuous
2141                      at z within {w | norm w = &1}`,
2142     REPEAT STRIP_TAC THEN
2143     DISJ_CASES_TAC(REAL_ARITH `&0 <= Re z \/ Re z < &0`) THENL
2144      [ALL_TAC;
2145       REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS] THEN
2146       MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
2147       EXISTS_TAC `Cx o f o (\x. x + pi) o Im o clog o (--)` THEN
2148       EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN
2149       CONJ_TAC THENL
2150        [X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN
2151         ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN
2152         STRIP_TAC THEN ASM_SIMP_TAC[CLOG_NEG; o_THM] THEN
2153         COND_CASES_TAC THEN
2154         ASM_REWRITE_TAC[IM_ADD; IM_SUB; IM_MUL_II; RE_CX; REAL_SUB_ADD] THEN
2155         ASM_REWRITE_TAC[REAL_ARITH `(x + pi) + pi = x + &2 * pi`];
2156         REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN
2157         CONJ_TAC THENL
2158          [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN CONTINUOUS_TAC;
2159           REWRITE_TAC[GSYM o_ASSOC; GSYM REAL_CONTINUOUS_CONTINUOUS]]]] THEN
2160     REWRITE_TAC[o_ASSOC] THEN
2161     MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN
2162     (CONJ_TAC THENL
2163       [MATCH_MP_TAC CONTINUOUS_WITHIN_CLOG THEN
2164        REWRITE_TAC[GSYM real] THEN DISCH_TAC THEN
2165        UNDISCH_TAC `norm(z:complex) = &1` THEN
2166        ASM_SIMP_TAC[REAL_NORM; RE_NEG; REAL_NEG_GT0] THEN
2167        ASM_REAL_ARITH_TAC;
2168        ALL_TAC]) THEN
2169     MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_COMPOSE THEN
2170     REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN] THEN
2171     TRY(MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN
2172         SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_CONST;
2173                  REAL_CONTINUOUS_WITHIN_ID]) THEN
2174     MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
2175     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
2176      [REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
2177     SIMP_TAC[IN_UNIV; WITHINREAL_UNIV]) in
2178   let lemma2 = prove
2179    (`!f. f real_continuous_on real_interval[--pi,pi] /\ f(--pi) = f pi
2180          ==> !z. norm z = &1
2181                  ==> (f o Im o clog) real_continuous
2182                      at z within {w | norm w = &1}`,
2183     REPEAT STRIP_TAC THEN
2184     MP_TAC(ISPECL
2185      [`f:real->real`; `--pi`; `pi`] REAL_TIETZE_PERIODIC_INTERVAL) THEN
2186     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN
2187     DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
2188     MP_TAC(ISPEC `g:real->real` lemma1) THEN
2189     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN
2190     ASM_REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS] THEN
2191     MATCH_MP_TAC(REWRITE_RULE
2192      [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`]
2193       CONTINUOUS_TRANSFORM_WITHIN) THEN
2194     EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN
2195     X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN
2196     ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN
2197     STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
2198     AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2199     ASM_SIMP_TAC[IN_REAL_INTERVAL; CLOG_WORKS; REAL_LT_IMP_LE]) in
2200   REPEAT STRIP_TAC THEN
2201   (CHOOSE_THEN MP_TAC o prove_inductive_relations_exist)
2202    `(!c. poly2 (\x. c)) /\
2203     (!p q. poly2 p /\ poly2 q ==> poly2 (\x. p x + q x)) /\
2204     (!p q. poly2 p /\ poly2 q ==> poly2 (\x. p x * q x)) /\
2205     poly2 Re /\ poly2 Im` THEN
2206   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o CONJUNCT1)) THEN
2207   MP_TAC(ISPECL [`poly2:(complex->real)->bool`; `{z:complex | norm z = &1}`]
2208         STONE_WEIERSTRASS) THEN
2209   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
2210    [REPEAT CONJ_TAC THENL
2211      [MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN CONJ_TAC THENL
2212        [REWRITE_TAC[bounded; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_REFL];
2213         ONCE_REWRITE_TAC[SET_RULE `{x | p x} = {x | x IN UNIV /\ p x}`] THEN
2214         REWRITE_TAC[GSYM LIFT_EQ] THEN
2215         MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
2216         REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF; CLOSED_UNIV]];
2217       MATCH_MP_TAC(MESON[]
2218        `(!x f. P f ==> R f x) ==> (!f. P f ==> !x. Q x ==> R f x)`) THEN
2219       GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2220       REWRITE_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_MUL] THEN
2221       REWRITE_TAC[REAL_CONTINUOUS_CONST;
2222                   REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN];
2223       MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN
2224       REWRITE_TAC[IN_ELIM_THM; COMPLEX_EQ; DE_MORGAN_THM] THEN STRIP_TAC THENL
2225        [EXISTS_TAC `Re` THEN ASM_REWRITE_TAC[];
2226         EXISTS_TAC `Im` THEN ASM_REWRITE_TAC[]]];
2227     ALL_TAC] THEN
2228   DISCH_THEN(MP_TAC o SPECL [`(f:real->real) o Im o clog`; `e:real`]) THEN
2229   ASM_SIMP_TAC[IN_ELIM_THM; lemma2] THEN
2230   DISCH_THEN(X_CHOOSE_THEN `g:complex->real` STRIP_ASSUME_TAC) THEN
2231   ABBREV_TAC
2232    `trigpoly =
2233      \f. ?n a b.
2234          f = \x. sum(0..n) (\k. a k * sin(&k * x) +  b k * cos(&k * x))` THEN
2235   SUBGOAL_THEN `!c:real. trigpoly(\x:real. c)` ASSUME_TAC THENL
2236    [X_GEN_TAC `c:real` THEN EXPAND_TAC "trigpoly" THEN REWRITE_TAC[] THEN
2237     EXISTS_TAC `0` THEN
2238     REWRITE_TAC[SUM_SING_NUMSEG; REAL_MUL_LZERO; SIN_0; COS_0] THEN
2239     MAP_EVERY EXISTS_TAC [`(\n. &0):num->real`; `(\n. c):num->real`] THEN
2240     REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC;
2241     ALL_TAC] THEN
2242   SUBGOAL_THEN
2243    `!f g:real->real. trigpoly f /\ trigpoly g ==> trigpoly(\x. f x + g x)`
2244   ASSUME_TAC THENL
2245    [REPEAT GEN_TAC THEN EXPAND_TAC "trigpoly" THEN
2246     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
2247     REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
2248     MAP_EVERY X_GEN_TAC
2249      [`n1:num`; `a1:num->real`; `b1:num->real`;
2250       `n2:num`; `a2:num->real`; `b2:num->real`] THEN
2251     DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN
2252     MAP_EVERY EXISTS_TAC
2253      [`MAX n1 n2`;
2254       `(\n. (if n <= n1 then a1 n else &0) +
2255              (if n <= n2 then a2 n else &0)):num->real`;
2256       `(\n. (if n <= n1 then b1 n else &0) +
2257             (if n <= n2 then b2 n else &0)):num->real`] THEN
2258     REWRITE_TAC[SUM_ADD_NUMSEG; FUN_EQ_THM; REAL_ADD_RDISTRIB] THEN
2259     GEN_TAC THEN
2260     MATCH_MP_TAC(REAL_ARITH
2261      `a:real = e /\ b = g /\ c = f /\ d = h
2262       ==> (a + b) + (c + d) = (e + f) + (g + h)`) THEN
2263     REPEAT CONJ_TAC THEN
2264     REWRITE_TAC[COND_RATOR; COND_RAND; REAL_MUL_LZERO] THEN
2265     REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN
2266     MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN
2267     REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC;
2268     ALL_TAC] THEN
2269   SUBGOAL_THEN
2270    `!f s:num->bool. FINITE s /\ (!i. i IN s ==> trigpoly(f i))
2271                     ==> trigpoly(\x:real. sum s (\i. f i x))`
2272   ASSUME_TAC THENL
2273    [GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
2274     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2275     ASM_SIMP_TAC[SUM_CLAUSES; IN_INSERT; ETA_AX];
2276     ALL_TAC] THEN
2277   SUBGOAL_THEN
2278    `!f:real->real c. trigpoly f ==> trigpoly (\x. c * f x)`
2279   ASSUME_TAC THENL
2280    [REPEAT GEN_TAC THEN EXPAND_TAC "trigpoly" THEN
2281     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2282     MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`; `b:num->real`] THEN
2283     DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC
2284      [`n:num`; `\i. c * (a:num->real) i`; `\i. c * (b:num->real) i`] THEN
2285     REWRITE_TAC[REAL_ADD_LDISTRIB; GSYM SUM_LMUL; GSYM REAL_MUL_ASSOC];
2286     ALL_TAC] THEN
2287   SUBGOAL_THEN `!i. trigpoly(\x. sin(&i * x))` ASSUME_TAC THENL
2288    [X_GEN_TAC `k:num` THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY EXISTS_TAC
2289      [`k:num`; `\i:num. if i = k then &1 else &0`; `\i:num. &0`] THEN
2290     REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; COND_RAND; COND_RATOR] THEN
2291     SIMP_TAC[SUM_DELTA; REAL_MUL_LID; IN_NUMSEG; LE_0; LE_REFL];
2292     ALL_TAC] THEN
2293   SUBGOAL_THEN `!i. trigpoly(\x. cos(&i * x))` ASSUME_TAC THENL
2294    [X_GEN_TAC `k:num` THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY EXISTS_TAC
2295      [`k:num`; `\i:num. &0`; `\i:num. if i = k then &1 else &0`] THEN
2296     REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; COND_RAND; COND_RATOR] THEN
2297     SIMP_TAC[SUM_DELTA; REAL_MUL_LID; IN_NUMSEG; LE_0; LE_REFL];
2298     ALL_TAC] THEN
2299   SUBGOAL_THEN
2300    `!i j. trigpoly(\x. sin(&i * x) * sin(&j * x)) /\
2301           trigpoly(\x. sin(&i * x) * cos(&j * x)) /\
2302           trigpoly(\x. cos(&i * x) * sin(&j * x)) /\
2303           trigpoly(\x. cos(&i * x) * cos(&j * x))`
2304   ASSUME_TAC THENL
2305    [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC WLOG_LE THEN
2306     CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI; REAL_MUL_AC]; ALL_TAC] THEN
2307     REWRITE_TAC[REAL_MUL_SIN_SIN; REAL_MUL_SIN_COS; REAL_MUL_COS_SIN;
2308                 REAL_MUL_COS_COS] THEN
2309     REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
2310     SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_ADD] THEN
2311     REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`;
2312                 REAL_ARITH `x - y:real = x + --(&1) * y`] THEN
2313     ASM_SIMP_TAC[];
2314     ALL_TAC] THEN
2315   SUBGOAL_THEN
2316    `!f g:real->real. trigpoly f /\ trigpoly g ==> trigpoly(\x. f x * g x)`
2317   ASSUME_TAC THENL
2318    [REPEAT GEN_TAC THEN
2319     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM
2320          th]) THEN
2321     REWRITE_TAC[] THEN
2322     DISCH_THEN(REPEAT_TCL STRIP_THM_THEN SUBST1_TAC) THEN
2323     REWRITE_TAC[REAL_MUL_SUM_NUMSEG] THEN
2324     FIRST_ASSUM MATCH_MP_TAC THEN
2325     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
2326     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
2327     FIRST_X_ASSUM MATCH_MP_TAC THEN
2328     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
2329     X_GEN_TAC `j:num` THEN STRIP_TAC THEN
2330     REWRITE_TAC[REAL_ARITH
2331     `(ai * si + bi * ci) * (aj * sj + bj * cj):real =
2332      ((ai * aj) * (si * sj) + (bi * bj) * (ci * cj)) +
2333      ((ai * bj) * (si * cj) + (aj * bi) * (ci * sj))`] THEN
2334     ASM_SIMP_TAC[];
2335     ALL_TAC] THEN
2336   SUBGOAL_THEN
2337    `!f:complex->real. poly2 f ==> trigpoly(\x.  f(cexp(ii * Cx x)))`
2338   (MP_TAC o SPEC `g:complex->real`) THENL
2339    [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
2340     REWRITE_TAC[RE_CEXP; IM_CEXP; RE_MUL_II; IM_CX; IM_MUL_II; RE_CX] THEN
2341     ONCE_REWRITE_TAC[MESON[REAL_MUL_LID]
2342      `cos x = cos(&1 * x) /\ sin x = sin(&1 * x)`] THEN
2343     ASM_SIMP_TAC[];
2344     ALL_TAC] THEN
2345   ASM_REWRITE_TAC[] THEN EXPAND_TAC "trigpoly" THEN
2346   MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t)
2347    [`n:num`; `a:num->real`; `b:num->real`] THEN
2348   REWRITE_TAC[FUN_EQ_THM] THEN
2349   DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN
2350   X_GEN_TAC `r:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN
2351   FIRST_X_ASSUM(MP_TAC o SPEC `cexp(ii * Cx r)`) THEN
2352   REWRITE_TAC[NORM_CEXP_II] THEN MATCH_MP_TAC(REAL_ARITH
2353    `x = x' ==> abs(x - y) < e ==> abs(x' - y) < e`) THEN
2354   REWRITE_TAC[o_DEF] THEN
2355   ASM_CASES_TAC `r = --pi` THENL
2356    [UNDISCH_THEN `r = --pi` SUBST_ALL_TAC THEN
2357     REWRITE_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN] THEN
2358     REWRITE_TAC[COS_NEG; SIN_NEG; SIN_PI; COS_PI] THEN
2359     REWRITE_TAC[CX_NEG; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN
2360     ASM_REWRITE_TAC[CLOG_NEG_1; COMPLEX_ADD_RID; IM_MUL_II; RE_CX];
2361     ASM_SIMP_TAC[CLOG_CEXP; IM_MUL_II; RE_CX; REAL_LT_LE]]);;
2362
2363 (* ------------------------------------------------------------------------- *)
2364 (* A bit of extra hacking round so that the ends of a function are OK.       *)
2365 (* ------------------------------------------------------------------------- *)
2366
2367 let REAL_INTEGRAL_TWEAK_ENDS = prove
2368  (`!a b d e.
2369         a < b /\ &0 < e
2370         ==> ?f. f real_continuous_on real_interval[a,b] /\
2371                 f(a) = d /\ f(b) = &0 /\
2372                 l2norm (real_interval[a,b]) f < e`,
2373   REPEAT STRIP_TAC THEN
2374   SUBGOAL_THEN
2375    `!n. (\x. if x <= a + inv(&n + &1)
2376              then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0)
2377         real_continuous_on real_interval[a,b]`
2378   ASSUME_TAC THENL
2379    [X_GEN_TAC `n:num` THEN
2380     SUBGOAL_THEN `a < a + inv(&n + &1)` ASSUME_TAC THENL
2381      [REWRITE_TAC[REAL_LT_ADDR; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
2382       ALL_TAC] THEN
2383     ASM_CASES_TAC `a + inv(&n + &1) <= b` THENL
2384      [SUBGOAL_THEN
2385        `real_interval[a,b] = real_interval[a,a + inv(&n + &1)] UNION
2386                              real_interval[a + inv(&n + &1),b]`
2387       SUBST1_TAC THENL
2388        [REWRITE_TAC[EXTENSION; IN_UNION; IN_REAL_INTERVAL] THEN
2389         ASM_REAL_ARITH_TAC;
2390         ALL_TAC] THEN
2391       MATCH_MP_TAC REAL_CONTINUOUS_ON_CASES THEN
2392       REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST] THEN
2393       CONJ_TAC THENL
2394        [SIMP_TAC[real_div; REAL_CONTINUOUS_ON_MUL; REAL_CONTINUOUS_ON_CONST;
2395                  REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_ID];
2396         X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
2397         ASM_CASES_TAC `x:real = a + inv(&n + &1)` THENL
2398          [ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_RZERO];
2399           ASM_REAL_ARITH_TAC]];
2400       MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THEN
2401       EXISTS_TAC `\x. ((&n + &1) * d) * ((a + inv(&n + &1)) - x)` THEN
2402       SIMP_TAC[real_div; REAL_CONTINUOUS_ON_MUL; REAL_CONTINUOUS_ON_CONST;
2403                REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_ID] THEN
2404       REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC];
2405     ALL_TAC] THEN
2406   MP_TAC
2407    (ISPECL [`\n x. (if x <= a + inv(&n + &1)
2408                     then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0)
2409                    pow 2`;
2410             `\x:real. if x = a then d pow 2 else &0`;
2411             `\x:real. (d:real) pow 2`;
2412             `real_interval[a,b]`]
2413         REAL_DOMINATED_CONVERGENCE) THEN
2414   REWRITE_TAC[] THEN ANTS_TAC THENL
2415    [REPEAT CONJ_TAC THENL
2416      [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN
2417       ASM_SIMP_TAC[REAL_CONTINUOUS_ON_POW];
2418       MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN
2419       REWRITE_TAC[REAL_CONTINUOUS_ON_CONST];
2420       MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN
2421       REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN
2422       REWRITE_TAC[REAL_ABS_POW] THEN
2423       REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_ABS] THEN
2424       COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_POS] THEN
2425       REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN
2426       ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN
2427       REWRITE_TAC[REAL_ARITH `d * x <= d <=> &0 <= d * (&1 - x)`] THEN
2428       MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
2429       REWRITE_TAC[REAL_ABS_MUL; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN
2430       REWRITE_TAC[REAL_ARITH `&0 <= &1 - x * y <=> y * x <= &1`] THEN
2431       SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
2432       REWRITE_TAC[real_div; REAL_MUL_LID] THEN ASM_REAL_ARITH_TAC;
2433       X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN
2434       ASM_CASES_TAC `x:real = a` THEN ASM_REWRITE_TAC[] THENL
2435        [ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_LE_INV_EQ;
2436                         REAL_ARITH `&0 <= &n + &1`] THEN
2437         REWRITE_TAC[REAL_ADD_SUB] THEN
2438         SIMP_TAC[REAL_FIELD `&0 < x ==> (x * d) * inv x = d`;
2439                  REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
2440         REWRITE_TAC[REALLIM_CONST];
2441         MATCH_MP_TAC REALLIM_EVENTUALLY THEN
2442         REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
2443         MP_TAC(ISPEC `x - a:real` REAL_ARCH_INV) THEN
2444         DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN
2445         ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2446         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
2447         STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
2448         COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
2449         MATCH_MP_TAC(TAUT `F ==> p`) THEN
2450         SUBGOAL_THEN `inv(&n + &1) <= inv(&N)` MP_TAC THENL
2451          [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
2452         MATCH_MP_TAC REAL_LE_INV2 THEN
2453         REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN
2454         ASM_ARITH_TAC]];
2455     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2456     REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
2457     DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN
2458     ASM_SIMP_TAC[REAL_POW_LT] THEN
2459     DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN
2460     MP_TAC(ISPEC `b - a:real` REAL_ARCH_INV) THEN
2461     ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2462     DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN
2463     SUBGOAL_THEN `?n:num. N <= n /\ M <= n` STRIP_ASSUME_TAC THENL
2464      [EXISTS_TAC `M + N:num` THEN ARITH_TAC; ALL_TAC] THEN
2465     REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
2466     DISCH_TAC THEN
2467     EXISTS_TAC `\x. if x <= a + inv(&n + &1)
2468                  then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0` THEN
2469     ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
2470      [MP_TAC(REAL_ARITH `&0 < &n + &1`) THEN
2471       SIMP_TAC[REAL_LE_ADDR; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN
2472       CONV_TAC REAL_FIELD;
2473       SUBGOAL_THEN `inv(&n + &1) < b - a` MP_TAC THENL
2474         [ALL_TAC; REAL_ARITH_TAC] THEN
2475       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&M)` THEN
2476       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
2477       ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
2478       ASM_ARITH_TAC;
2479       SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL
2480        [ASM_MESON_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; ALL_TAC] THEN
2481       REWRITE_TAC[l2norm; l2product] THEN MATCH_MP_TAC SQRT_MONO_LT THEN
2482       REWRITE_TAC[GSYM REAL_POW_2] THEN
2483       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2484        `abs(i - l) < e ==> &0 <= i /\ l = &0 ==> i < e`)) THEN
2485       CONJ_TAC THENL
2486        [MATCH_MP_TAC REAL_INTEGRAL_POS THEN
2487         ASM_SIMP_TAC[REAL_INTEGRABLE_CONTINUOUS; REAL_CONTINUOUS_ON_POW] THEN
2488         REWRITE_TAC[REAL_LE_POW_2];
2489         MP_TAC(ISPEC `real_interval[a,b]` REAL_INTEGRAL_0) THEN
2490         MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
2491         MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
2492         EXISTS_TAC `{a:real}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN
2493         SIMP_TAC[IN_DIFF; IN_SING]]]]);;
2494
2495 let SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS_ENDS = prove
2496  (`!f a b e.
2497         f square_integrable_on real_interval[a,b] /\ a < b /\ &0 < e
2498         ==> ?g. g real_continuous_on real_interval[a,b] /\
2499                 g b = g a /\
2500                 g square_integrable_on real_interval[a,b] /\
2501                 l2norm (real_interval[a,b]) (\x. f x - g x) < e`,
2502   REPEAT STRIP_TAC THEN
2503   MP_TAC(ISPECL [`f:real->real`; `real_interval[a,b]`; `e / &2`]
2504         SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN
2505   ASM_REWRITE_TAC[REAL_HALF; REAL_MEASURABLE_REAL_INTERVAL] THEN
2506   DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
2507   MP_TAC(ISPECL
2508    [`a:real`; `b:real`; `(g:real->real) b - g a`; `e / &2`]
2509         REAL_INTEGRAL_TWEAK_ENDS) THEN
2510   ASM_REWRITE_TAC[REAL_HALF] THEN
2511   DISCH_THEN(X_CHOOSE_THEN `h:real->real` STRIP_ASSUME_TAC) THEN
2512   SUBGOAL_THEN `h square_integrable_on real_interval[a,b]` ASSUME_TAC THENL
2513    [ASM_SIMP_TAC[REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE]; ALL_TAC] THEN
2514   EXISTS_TAC `\x. (g:real->real) x + h x` THEN
2515   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
2516    [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[] THEN
2517     MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN
2518     ASM_REWRITE_TAC[SUBSET_UNIV];
2519     REAL_ARITH_TAC;
2520     MATCH_MP_TAC SQUARE_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[];
2521     ONCE_REWRITE_TAC[REAL_ARITH `f - (g + h):real = (f - g) + --h`] THEN
2522     W(MP_TAC o PART_MATCH (lhand o rand) L2NORM_TRIANGLE o lhand o snd) THEN
2523     ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_NEG] THEN
2524     MATCH_MP_TAC(REAL_ARITH
2525      `y < e / &2 /\ z < e / &2 ==> x <= y + z ==> x < e`) THEN
2526     ASM_SIMP_TAC[L2NORM_NEG]]);;
2527
2528 (* ------------------------------------------------------------------------- *)
2529 (* Hence the main approximation result.                                      *)
2530 (* ------------------------------------------------------------------------- *)
2531
2532 let WEIERSTRASS_L2_TRIG_POLYNOMIAL = prove
2533  (`!f e. f square_integrable_on real_interval[--pi,pi] /\ &0 < e
2534          ==> ?n a b.
2535                 l2norm (real_interval[--pi,pi])
2536                        (\x. f x - sum(0..n) (\k. a k * sin(&k * x) +
2537                                                  b k * cos(&k * x))) < e`,
2538   REPEAT STRIP_TAC THEN
2539   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `e / &2`]
2540         SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS_ENDS) THEN
2541   ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `--pi < pi <=> &0 < pi`; PI_POS] THEN
2542   DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
2543   MP_TAC(ISPECL [`g:real->real`; `e / &6`] WEIERSTRASS_TRIG_POLYNOMIAL) THEN
2544   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
2545   MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t)
2546    [`n:num`; `u:num->real`; `v:num->real`] THEN
2547   DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2548   SUBGOAL_THEN
2549    `!n u v. (\x. sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x)))
2550             square_integrable_on (real_interval[--pi,pi])`
2551   ASSUME_TAC THENL
2552    [REPEAT GEN_TAC THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN
2553     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
2554     MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN
2555     MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
2556     REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
2557     GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC;
2558     ALL_TAC] THEN
2559   EXISTS_TAC `l2norm (real_interval[--pi,pi]) (\x. f x - g x) +
2560               l2norm (real_interval[--pi,pi]) (\x. g x - sum(0..n)
2561                    (\k. u k * sin(&k * x) + v k * cos(&k * x)))` THEN
2562   CONJ_TAC THENL
2563    [W(MP_TAC o PART_MATCH (rand o rand) L2NORM_TRIANGLE o rand o snd) THEN
2564     REWRITE_TAC[REAL_ARITH `(f - g) + (g - h):real = f - h`] THEN
2565     ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB];
2566     ALL_TAC] THEN
2567   MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y <= e / &2 ==> x + y < e`) THEN
2568   ASM_REWRITE_TAC[] THEN
2569   REWRITE_TAC[l2norm; l2product; GSYM REAL_POW_2] THEN
2570   MATCH_MP_TAC REAL_LE_LSQRT THEN
2571   SUBGOAL_THEN
2572    `(\x. g x - sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x)))
2573     square_integrable_on (real_interval[--pi,pi])`
2574   MP_TAC THENL [ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB]; ALL_TAC] THEN
2575   REWRITE_TAC[square_integrable_on] THEN STRIP_TAC THEN
2576   ASM_SIMP_TAC[REAL_INTEGRAL_POS; REAL_LE_POW_2] THEN
2577   CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2578   MATCH_MP_TAC REAL_LE_TRANS THEN
2579   EXISTS_TAC `real_integral(real_interval[--pi,pi]) (\x. (e / &6) pow 2)` THEN
2580   CONJ_TAC THENL
2581    [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN
2582     REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN X_GEN_TAC `x:real` THEN
2583     DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
2584     MATCH_MP_TAC(REAL_ARITH `abs x < e ==> abs(x) <= abs e`) THEN
2585     ASM_SIMP_TAC[];
2586     SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `--pi <= pi <=> &0 <= pi`;
2587              PI_POS_LE] THEN
2588     REWRITE_TAC[real_div; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN
2589     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN
2590     MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);;
2591
2592 let WEIERSTRASS_L2_TRIGONOMETRIC_SET = prove
2593  (`!f e. f square_integrable_on real_interval[--pi,pi] /\ &0 < e
2594          ==> ?n a.
2595                 l2norm (real_interval[--pi,pi])
2596                        (\x. f x -
2597                             sum(0..n) (\k. a k * trigonometric_set k x))
2598                 < e`,
2599   REPEAT GEN_TAC THEN DISCH_TAC THEN
2600   FIRST_ASSUM(MP_TAC o MATCH_MP WEIERSTRASS_L2_TRIG_POLYNOMIAL) THEN
2601   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2602   MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`; `b:num->real`] THEN
2603   DISCH_TAC THEN EXISTS_TAC `2 * n + 1` THEN
2604   SUBST1_TAC(ARITH_RULE `0 = 2 * 0`) THEN
2605   REWRITE_TAC[SUM_PAIR; SUM_ADD_NUMSEG; trigonometric_set] THEN
2606   EXISTS_TAC
2607    `(\k. if k = 0 then sqrt(&2 * pi) * b 0
2608          else if EVEN k then sqrt pi * b(k DIV 2)
2609          else if k <= 2 * n then sqrt pi * a((k + 1) DIV 2)
2610          else &0):num->real` THEN
2611   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2612      `x < e ==> y = x ==> y < e`)) THEN
2613   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
2614   X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN
2615   REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH; ADD_EQ_0; MULT_EQ_0] THEN
2616   REWRITE_TAC[SUM_ADD_NUMSEG] THEN
2617   GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN BINOP_TAC THENL
2618    [MATCH_MP_TAC SUM_EQ_NUMSEG THEN
2619     SIMP_TAC[LE_0; ARITH_RULE `2 * i <= 2 * n <=> i <= n`] THEN
2620     INDUCT_TAC THENL
2621      [REWRITE_TAC[trigonometric_set; ARITH; LE_0] THEN
2622       MATCH_MP_TAC(REAL_FIELD
2623        `&0 < s ==> (s * b) * c / s = b * c`) THEN
2624       MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC;
2625       DISCH_THEN(K ALL_TAC) THEN
2626       REWRITE_TAC[NOT_SUC; ARITH_RULE `2 * (SUC i) = 2 * i + 2`] THEN
2627       REWRITE_TAC[trigonometric_set;
2628                   ARITH_RULE `(2 * i + 2) DIV 2 = SUC i`] THEN
2629       REWRITE_TAC[ADD1] THEN MATCH_MP_TAC(REAL_FIELD
2630        `&0 < s ==> (s * b) * c / s = b * c`) THEN
2631       MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]];
2632     REWRITE_TAC[ARITH_RULE `2 * i + 1 = 2 * (i + 1) - 1`] THEN
2633     REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN
2634     REWRITE_TAC[GSYM ADD1; ARITH; SUM_CLAUSES_NUMSEG] THEN
2635     REWRITE_TAC[ARITH_RULE `1 <= SUC n /\ 2 * SUC n - 1 = 2 * n + 1`] THEN
2636     REWRITE_TAC[ARITH_RULE `~(2 * n + 1 <= 2 * n)`; REAL_MUL_LZERO] THEN
2637     SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; REAL_ADD_RID] THEN
2638     SIMP_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID; ARITH] THEN
2639     MATCH_MP_TAC SUM_EQ_NUMSEG THEN
2640     SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> 2 * i - 1 <= 2 * n`] THEN
2641     INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN
2642     REWRITE_TAC[ARITH_RULE `SUC(2 * SUC i - 1) DIV 2 = SUC i`] THEN
2643     DISCH_TAC THEN MATCH_MP_TAC(REAL_FIELD
2644      `&0 < s ==> (s * b) * c / s = b * c`) THEN
2645     MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]);;
2646
2647 (* ------------------------------------------------------------------------- *)
2648 (* Convergence w.r.t. L2 norm of trigonometric Fourier series.               *)
2649 (* ------------------------------------------------------------------------- *)
2650
2651 let fourier_coefficient = new_definition
2652  `fourier_coefficient =
2653     orthonormal_coefficient (real_interval[--pi,pi]) trigonometric_set`;;
2654
2655 let FOURIER_SERIES_L2 = prove
2656  (`!f. f square_integrable_on real_interval[--pi,pi]
2657        ==> ((\n. l2norm (real_interval[--pi,pi])
2658                         (\x. f(x) - sum(0..n) (\i. fourier_coefficient f i *
2659                                                    trigonometric_set i x)))
2660             ---> &0) sequentially`,
2661   REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
2662   X_GEN_TAC `e:real` THEN STRIP_TAC THEN
2663   MP_TAC(ISPECL [`f:real->real`; `e:real`]
2664     WEIERSTRASS_L2_TRIGONOMETRIC_SET) THEN
2665   ASM_REWRITE_TAC[] THEN
2666   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
2667   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2668   X_GEN_TAC `a:num->real` THEN DISCH_TAC THEN
2669   X_GEN_TAC `m:num` THEN DISCH_TAC THEN
2670   REWRITE_TAC[fourier_coefficient] THEN MP_TAC(ISPECL
2671    [`real_interval[--pi,pi]`; `trigonometric_set`;
2672     `(\i. if i <= n then a i else &0):num->real`;
2673     `f:real->real`; `0..m`]
2674     ORTHONORMAL_OPTIMAL_PARTIAL_SUM) THEN
2675   ASM_REWRITE_TAC[FINITE_NUMSEG; ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET;
2676                   SQUARE_INTEGRABLE_TRIGONOMETRIC_SET; REAL_SUB_RZERO] THEN
2677   MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a < e ==> x <= a ==> abs x < e`) THEN
2678   CONJ_TAC THENL
2679    [MATCH_MP_TAC L2NORM_POS_LE THEN
2680     MATCH_MP_TAC SQUARE_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN
2681     MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN
2682     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
2683     MATCH_MP_TAC SQUARE_INTEGRABLE_LMUL THEN
2684     REWRITE_TAC[ETA_AX; SQUARE_INTEGRABLE_TRIGONOMETRIC_SET];
2685     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2686      `x < e ==> y = x ==> y < e`)) THEN
2687     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
2688     X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN
2689     MATCH_MP_TAC SUM_EQ_SUPERSET THEN
2690     ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; LE_0] THEN
2691     SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; LE_0]]);;
2692
2693 (* ------------------------------------------------------------------------- *)
2694 (* Fourier coefficients go to 0 (weak form of Riemann-Lebesgue).             *)
2695 (* ------------------------------------------------------------------------- *)
2696
2697 let TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE = prove
2698  (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi]
2699          ==> (\x. trigonometric_set n x * f x)
2700              absolutely_real_integrable_on real_interval[--pi,pi]`,
2701   REPEAT STRIP_TAC THEN
2702   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
2703   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
2704    [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN
2705     EXISTS_TAC `(:real)` THEN
2706     REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN
2707     MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
2708     MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
2709     REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
2710     SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2711     REWRITE_TAC[trigonometric_set; real_div] THEN
2712     REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC;
2713     REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN
2714     SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2715     REWRITE_TAC[trigonometric_set; REAL_ABS_DIV] THEN
2716     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`;
2717              SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
2718     REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2719     EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN
2720     MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN
2721     SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN
2722     MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);;
2723
2724 let TRIGONOMETRIC_SET_MUL_INTEGRABLE = prove
2725  (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi]
2726          ==> (\x. trigonometric_set n x * f x)
2727              real_integrable_on real_interval[--pi,pi]`,
2728   SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
2729            TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE]);;
2730
2731 let ABSOLUTELY_INTEGRABLE_SIN_PRODUCT,ABSOLUTELY_INTEGRABLE_COS_PRODUCT =
2732  (CONJ_PAIR o prove)
2733  (`(!f k. f absolutely_real_integrable_on real_interval[--pi,pi]
2734           ==> (\x. sin(k * x) * f x) absolutely_real_integrable_on
2735               real_interval[--pi,pi]) /\
2736    (!f k. f absolutely_real_integrable_on real_interval[--pi,pi]
2737           ==> (\x. cos(k * x) * f x) absolutely_real_integrable_on
2738               real_interval[--pi,pi])`,
2739   REPEAT STRIP_TAC THEN
2740   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
2741   (ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
2742     [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN
2743      EXISTS_TAC `(:real)` THEN
2744      REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN
2745      MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
2746      MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
2747      REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
2748      SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2749      REWRITE_TAC[trigonometric_set; real_div] THEN
2750      REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC;
2751      REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN
2752      SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2753      REWRITE_TAC[trigonometric_set; COS_BOUND; SIN_BOUND]]));;
2754
2755 let FOURIER_PRODUCTS_INTEGRABLE_STRONG = prove
2756  (`!f. f absolutely_real_integrable_on real_interval[--pi,pi]
2757        ==> f real_integrable_on real_interval[--pi,pi] /\
2758            (!k. (\x. cos(k * x) * f x) real_integrable_on
2759                 real_interval[--pi,pi]) /\
2760            (!k. (\x. sin(k * x) * f x) real_integrable_on
2761                 real_interval[--pi,pi])`,
2762   SIMP_TAC[ABSOLUTELY_INTEGRABLE_SIN_PRODUCT;
2763            ABSOLUTELY_INTEGRABLE_COS_PRODUCT;
2764            ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);;
2765
2766 let FOURIER_PRODUCTS_INTEGRABLE = prove
2767  (`!f. f square_integrable_on real_interval[--pi,pi]
2768        ==> f real_integrable_on real_interval[--pi,pi] /\
2769            (!k. (\x. cos(k * x) * f x) real_integrable_on
2770                 real_interval[--pi,pi]) /\
2771            (!k. (\x. sin(k * x) * f x) real_integrable_on
2772                 real_interval[--pi,pi])`,
2773   GEN_TAC THEN DISCH_TAC THEN
2774   MATCH_MP_TAC FOURIER_PRODUCTS_INTEGRABLE_STRONG THEN
2775   ASM_SIMP_TAC[REAL_MEASURABLE_REAL_INTERVAL;
2776                SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE]);;
2777
2778 let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove
2779  (`!f s e. real_measurable s /\ f absolutely_real_integrable_on s /\ &0 < e
2780            ==> ?g. g real_continuous_on (:real) /\
2781                    g absolutely_real_integrable_on s /\
2782                    real_integral s (\x. abs(f x - g x)) < e`,
2783   REPEAT STRIP_TAC THEN
2784   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `&1:real`; `e:real`]
2785           LSPACE_APPROXIMATE_CONTINUOUS) THEN
2786   ASM_REWRITE_TAC[LSPACE_1; GSYM ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_OF_NUM_LE;
2787                   ARITH; GSYM REAL_MEASURABLE_MEASURABLE] THEN
2788   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN
2789   EXISTS_TAC `drop o g o lift` THEN CONJ_TAC THENL
2790    [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_DROP; ETA_AX;
2791                     IMAGE_LIFT_UNIV];
2792     ALL_TAC] THEN
2793   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2794    [ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX];
2795     DISCH_TAC THEN
2796     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2797      `x < e ==> x = y ==> y < e`)) THEN
2798     REWRITE_TAC[lnorm; REAL_INV_1; RPOW_POW; REAL_POW_1] THEN
2799     W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN
2800     ANTS_TAC THENL
2801      [SUBGOAL_THEN
2802        `(\x. f x - (drop o g o lift) x) absolutely_real_integrable_on s`
2803       MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_real_integrable_on]] THEN
2804       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ETA_AX];
2805       DISCH_THEN SUBST1_TAC THEN
2806       REWRITE_TAC[o_DEF; NORM_LIFT; LIFT_DROP; NORM_REAL; GSYM drop;
2807                   DROP_SUB; LIFT_SUB]]]);;
2808
2809 let RIEMANN_LEBESGUE_SQUARE_INTEGRABLE = prove
2810  (`!s w f.
2811         orthonormal_system s w /\
2812         (!i. w i square_integrable_on s) /\
2813         f square_integrable_on s
2814         ==> (orthonormal_coefficient s w f ---> &0) sequentially`,
2815   REPEAT GEN_TAC THEN DISCH_TAC THEN
2816   FIRST_ASSUM(MP_TAC o SPEC `(:num)` o
2817     MATCH_MP FOURIER_SERIES_SQUARE_SUMMABLE) THEN
2818   DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMMABLE_IMP_TOZERO) THEN
2819   SIMP_TAC[IN_UNIV; REALLIM_NULL_POW_EQ; ARITH; ETA_AX]);;
2820
2821 let RIEMANN_LEBESGUE = prove
2822  (`!f. f absolutely_real_integrable_on real_interval[--pi,pi]
2823        ==> (fourier_coefficient f ---> &0) sequentially`,
2824   REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
2825   X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL
2826    [`f:real->real`; `real_interval[--pi,pi]`; `e / &2`]
2827    ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN
2828   ASM_SIMP_TAC[REAL_HALF; REAL_MEASURABLE_REAL_INTERVAL;
2829                LEFT_IMP_EXISTS_THM] THEN
2830   X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN
2831   MP_TAC(ISPECL [`real_interval[--pi,pi]`; `trigonometric_set`; `g:real->real`]
2832         RIEMANN_LEBESGUE_SQUARE_INTEGRABLE) THEN
2833   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
2834    [REWRITE_TAC[ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET;
2835                 SQUARE_INTEGRABLE_TRIGONOMETRIC_SET] THEN
2836     MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN
2837     MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN
2838     ASM_REWRITE_TAC[SUBSET_UNIV];
2839     ALL_TAC] THEN
2840   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
2841   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
2842   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
2843   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
2844   ASM_CASES_TAC `N:num <= n` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN
2845   REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN
2846   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2847    `x < e / &2 ==> abs(y - z) <= x ==> y < e / &2 ==> z < e`)) THEN
2848   MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= r ==> abs(abs x - abs y) <= r`) THEN
2849   W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_SUB o
2850     rand o lhand o snd) THEN
2851   ASM_SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE] THEN
2852   REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2853   MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL
2854    [MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN
2855     ASM_SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE];
2856     SUBGOAL_THEN `(\x. (f:real->real) x - g x) absolutely_real_integrable_on
2857                   real_interval[--pi,pi]`
2858     MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB]; ALL_TAC] THEN
2859     SIMP_TAC[absolutely_real_integrable_on];
2860     GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN
2861     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SUB] THEN
2862     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2863     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
2864     SPEC_TAC(`n:num`,`n:num`) THEN
2865     MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2866     REWRITE_TAC[trigonometric_set; REAL_ABS_DIV] THEN
2867     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`;
2868              SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
2869     REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2870     EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN
2871     MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN
2872     SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN
2873     MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);;
2874
2875 let RIEMANN_LEBESGUE_SIN = prove
2876  (`!f. f absolutely_real_integrable_on real_interval[--pi,pi]
2877        ==> ((\n. real_integral (real_interval[--pi,pi])
2878                                  (\x. sin(&n * x) * f x)) ---> &0)
2879               sequentially`,
2880   REPEAT STRIP_TAC THEN
2881   FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN
2882   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN
2883   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2884   FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN
2885   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2886   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
2887   EXISTS_TAC `N + 1` THEN MATCH_MP_TAC num_INDUCTION THEN
2888   CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC)] THEN
2889   DISCH_TAC THEN
2890   FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 1`) THEN
2891   ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
2892   REWRITE_TAC[fourier_coefficient; orthonormal_coefficient;
2893               trigonometric_set; l2product; REAL_SUB_RZERO] THEN
2894   ONCE_REWRITE_TAC[REAL_ARITH `a / sqrt pi * b = inv(sqrt pi) * a * b`] THEN
2895   ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN
2896   REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
2897   ASM_SIMP_TAC[REAL_LT_LDIV_EQ; SQRT_POS_LT; PI_POS;
2898                REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_ABS_DIV] THEN
2899   REWRITE_TAC[ADD1] THEN
2900   MATCH_MP_TAC(REAL_ARITH `d <= e ==> x < d ==> x < e`) THEN
2901   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
2902   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
2903   ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
2904   MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &4 ==> inv(&4) * abs x <= &1`) THEN
2905   SIMP_TAC[SQRT_POS_LE; PI_POS_LE] THEN
2906   MATCH_MP_TAC REAL_LE_LSQRT THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);;
2907
2908 let RIEMANN_LEBESGUE_COS = prove
2909  (`!f. f absolutely_real_integrable_on real_interval[--pi,pi]
2910        ==> ((\n. real_integral (real_interval[--pi,pi])
2911                                  (\x. cos(&n * x) * f x)) ---> &0)
2912               sequentially`,
2913   REPEAT STRIP_TAC THEN
2914   FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN
2915   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN
2916   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2917   FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN
2918   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2919   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
2920   EXISTS_TAC `N + 1` THEN MATCH_MP_TAC num_INDUCTION THEN
2921   CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC)] THEN
2922   DISCH_TAC THEN
2923   FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 2`) THEN
2924   ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
2925   REWRITE_TAC[fourier_coefficient; orthonormal_coefficient;
2926               trigonometric_set; l2product; REAL_SUB_RZERO] THEN
2927   ONCE_REWRITE_TAC[REAL_ARITH `a / sqrt pi * b = inv(sqrt pi) * a * b`] THEN
2928   ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN
2929   REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
2930   ASM_SIMP_TAC[REAL_LT_LDIV_EQ; SQRT_POS_LT; PI_POS;
2931                REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_ABS_DIV] THEN
2932   REWRITE_TAC[ADD1] THEN
2933   MATCH_MP_TAC(REAL_ARITH `d <= e ==> x < d ==> x < e`) THEN
2934   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
2935   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
2936   ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
2937   MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &4 ==> inv(&4) * abs x <= &1`) THEN
2938   SIMP_TAC[SQRT_POS_LE; PI_POS_LE] THEN
2939   MATCH_MP_TAC REAL_LE_LSQRT THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);;
2940
2941 let RIEMANN_LEBESGUE_SIN_HALF = prove
2942  (`!f. f absolutely_real_integrable_on real_interval[--pi,pi]
2943        ==> ((\n. real_integral (real_interval[--pi,pi])
2944                                (\x. sin((&n + &1 / &2) * x) * f x)) ---> &0)
2945               sequentially`,
2946   REPEAT STRIP_TAC THEN
2947   REWRITE_TAC[SIN_ADD; REAL_ADD_RDISTRIB] THEN
2948   MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN
2949   EXISTS_TAC `(\n. real_integral (real_interval[--pi,pi])
2950                           (\x. sin(&n * x) * cos(&1 / &2 * x) * f x) +
2951                    real_integral (real_interval[--pi,pi])
2952                           (\x. cos(&n * x) * sin(&1 / &2 * x) * f x))` THEN
2953   CONJ_TAC THENL
2954    [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN
2955     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC SYM_CONV THEN
2956     MATCH_MP_TAC REAL_INTEGRAL_ADD;
2957     MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL
2958      [MATCH_MP_TAC RIEMANN_LEBESGUE_SIN;
2959       MATCH_MP_TAC RIEMANN_LEBESGUE_COS]] THEN
2960   ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
2961                ABSOLUTELY_INTEGRABLE_SIN_PRODUCT;
2962                ABSOLUTELY_INTEGRABLE_COS_PRODUCT]);;
2963
2964 let FOURIER_SUM_LIMIT_PAIR = prove
2965  (`!f n t l.
2966         f absolutely_real_integrable_on real_interval [--pi,pi]
2967         ==> (((\n. sum(0..2*n) (\k. fourier_coefficient f k *
2968                                     trigonometric_set k t)) ---> l)
2969              sequentially <=>
2970              ((\n. sum(0..n) (\k. fourier_coefficient f k *
2971                                   trigonometric_set k t)) ---> l)
2972              sequentially)`,
2973   REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
2974   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL
2975    [FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN
2976     REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN
2977     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
2978     DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "1")) THEN
2979     SUBGOAL_THEN `&0 < e / &2` (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th))
2980     THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2981     DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "2")) THEN
2982     EXISTS_TAC `N1 + 2 * N2 + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
2983     DISJ_CASES_THEN SUBST1_TAC
2984      (ARITH_RULE `n = 2 * n DIV 2 \/ n = SUC(2 * n DIV 2)`) THEN
2985     REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THENL
2986      [MATCH_MP_TAC(REAL_ARITH `abs x < e / &2 ==> abs x < e`) THEN
2987       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
2988       MATCH_MP_TAC(REAL_ARITH
2989        `abs(x - l) < e / &2 /\ abs y < e / &2 ==> abs((x + y) - l) < e`) THEN
2990       CONJ_TAC THENL
2991        [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
2992       MATCH_MP_TAC(REAL_ARITH
2993        `abs(x * y) <= abs(x) * &1 /\ abs(x) < e ==> abs(x * y) < e`) THEN
2994       CONJ_TAC THENL
2995        [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
2996         REWRITE_TAC[REAL_ABS_POS] THEN
2997         SPEC_TAC(`SUC(2 * n DIV 2)`,`r:num`) THEN
2998         MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
2999         REWRITE_TAC[ADD1; trigonometric_set; REAL_ABS_DIV] THEN
3000         SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`;
3001                  SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
3002         REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
3003         EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN
3004         MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN
3005         SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN
3006         MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC;
3007         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
3008     FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
3009     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN
3010     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]);;
3011
3012 (* ------------------------------------------------------------------------- *)
3013 (* Express Fourier sum in terms of the special expansion at the origin.      *)
3014 (* ------------------------------------------------------------------------- *)
3015
3016 let FOURIER_SUM_0 = prove
3017  (`!f n.
3018      sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) =
3019      sum (0..n DIV 2)
3020          (\k. fourier_coefficient f (2 * k) * trigonometric_set (2 * k) (&0))`,
3021   REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
3022   EXISTS_TAC `sum (2 * 0..2 * (n DIV 2) + 1)
3023                  (\k. fourier_coefficient f k * trigonometric_set k (&0))` THEN
3024   CONJ_TAC THENL
3025    [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC SYM_CONV THEN
3026     MATCH_MP_TAC SUM_SUPERSET THEN
3027     REWRITE_TAC[IN_NUMSEG; SUBSET; LE_0] THEN
3028     CONJ_TAC THENL [ARITH_TAC; GEN_TAC] THEN
3029     DISCH_THEN(SUBST1_TAC o MATCH_MP (ARITH_RULE
3030      `x <= 2 * n DIV 2 + 1 /\ ~(x <= n) ==> x = 2 * n DIV 2 + 1`));
3031     REWRITE_TAC[SUM_PAIR]] THEN
3032   REWRITE_TAC[trigonometric_set;  real_div; REAL_MUL_RZERO; SIN_0;
3033               REAL_MUL_LZERO; REAL_ADD_RID]);;
3034
3035 let FOURIER_SUM_0_EXPLICIT = prove
3036  (`!f n.
3037      sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) =
3038      (fourier_coefficient f 0 / sqrt(&2) +
3039       sum (1..n DIV 2) (\k. fourier_coefficient f (2 * k))) / sqrt pi`,
3040   REPEAT GEN_TAC THEN REWRITE_TAC[FOURIER_SUM_0] THEN
3041   SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_div;
3042            REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN
3043   REWRITE_TAC[MULT_CLAUSES; trigonometric_set;
3044               REAL_MUL_LZERO; COS_0; real_div] THEN
3045   BINOP_TAC THENL
3046    [REWRITE_TAC[REAL_MUL_LID; SQRT_MUL; REAL_INV_MUL; GSYM REAL_MUL_ASSOC];
3047     REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
3048     INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN
3049     REWRITE_TAC[trigonometric_set; ARITH_RULE `2 * SUC i = 2 * i + 2`] THEN
3050     REWRITE_TAC[REAL_MUL_RZERO; COS_0; real_div; REAL_MUL_LID]]);;
3051
3052 let FOURIER_SUM_0_INTEGRALS = prove
3053  (`!f n.
3054       f absolutely_real_integrable_on real_interval[--pi,pi]
3055       ==> sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) =
3056           (real_integral(real_interval[--pi,pi]) f / &2 +
3057            sum(1..n DIV 2) (\k. real_integral (real_interval[--pi,pi])
3058                                               (\x. cos(&k * x) * f x))) / pi`,
3059   REPEAT STRIP_TAC THEN REWRITE_TAC[FOURIER_SUM_0_EXPLICIT] THEN
3060   REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN
3061   REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN
3062   REWRITE_TAC[trigonometric_set] THEN BINOP_TAC THENL
3063    [REWRITE_TAC[COS_0; REAL_MUL_LZERO; real_div; REAL_MUL_LID] THEN
3064     ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN
3065     REWRITE_TAC[REAL_ARITH `((a * b) * c) * d:real = b * a * c * d`] THEN
3066     REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN
3067     AP_TERM_TAC THEN
3068     SIMP_TAC[GSYM SQRT_MUL; REAL_POS; PI_POS_LE; REAL_LE_MUL] THEN
3069     REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC POW_2_SQRT THEN
3070     MP_TAC PI_POS THEN REAL_ARITH_TAC;
3071     MATCH_MP_TAC SUM_EQ_NUMSEG THEN
3072     INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN STRIP_TAC THEN
3073     REWRITE_TAC[trigonometric_set; ARITH_RULE `2 * SUC i = 2 * i + 2`] THEN
3074     REWRITE_TAC[REAL_MUL_RZERO; COS_0; real_div; REAL_MUL_LID] THEN
3075     ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN
3076     ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN
3077     ONCE_REWRITE_TAC[REAL_ARITH `(i * x) * i:real = x * i * i`] THEN
3078     REWRITE_TAC[ADD1; GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN
3079     AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_POW_2] THEN
3080     MATCH_MP_TAC SQRT_POW_2 THEN REWRITE_TAC[PI_POS_LE]]);;
3081
3082 let FOURIER_SUM_0_INTEGRAL = prove
3083  (`!f n.
3084       f absolutely_real_integrable_on real_interval[--pi,pi]
3085       ==> sum(0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) =
3086           real_integral(real_interval[--pi,pi])
3087            (\x. (&1 / &2 + sum(1..n DIV 2) (\k. cos(&k * x))) * f x) / pi`,
3088   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_0_INTEGRALS] THEN
3089   ASM_SIMP_TAC[GSYM REAL_INTEGRAL_SUM; FINITE_NUMSEG;
3090                FOURIER_PRODUCTS_INTEGRABLE_STRONG; real_div;
3091                GSYM REAL_INTEGRAL_ADD;
3092                GSYM REAL_INTEGRAL_RMUL; REAL_INTEGRABLE_RMUL; ETA_AX;
3093                REAL_INTEGRABLE_SUM] THEN
3094   AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
3095   REWRITE_TAC[FUN_EQ_THM; SUM_RMUL] THEN REAL_ARITH_TAC);;
3096
3097 (* ------------------------------------------------------------------------- *)
3098 (* How Fourier coefficients behave under addition etc.                       *)
3099 (* ------------------------------------------------------------------------- *)
3100
3101 let FOURIER_COEFFICIENT_ADD = prove
3102  (`!f g i. f absolutely_real_integrable_on real_interval[--pi,pi] /\
3103            g absolutely_real_integrable_on real_interval[--pi,pi]
3104            ==> fourier_coefficient (\x. f x + g x) i =
3105                 fourier_coefficient f i + fourier_coefficient g i`,
3106   SIMP_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN
3107   SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE; REAL_ADD_LDISTRIB;
3108            REAL_INTEGRAL_ADD]);;
3109
3110 let FOURIER_COEFFICIENT_SUB = prove
3111  (`!f g i. f absolutely_real_integrable_on real_interval[--pi,pi] /\
3112            g absolutely_real_integrable_on real_interval[--pi,pi]
3113            ==> fourier_coefficient (\x. f x - g x) i =
3114                 fourier_coefficient f i - fourier_coefficient g i`,
3115   SIMP_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN
3116   SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE; REAL_SUB_LDISTRIB;
3117            REAL_INTEGRAL_SUB]);;
3118
3119 let FOURIER_COEFFICIENT_CONST = prove
3120  (`!c i. fourier_coefficient (\x. c) i =
3121          if i = 0 then c * sqrt(&2 * pi) else &0`,
3122   GEN_TAC THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
3123   REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product;
3124               trigonometric_set] THEN
3125   REPEAT CONJ_TAC THENL
3126    [MP_TAC(ISPEC `0` HAS_REAL_INTEGRAL_COS_NX) THEN
3127     DISCH_THEN(MP_TAC o SPEC `inv(sqrt(&2 * pi)) * c` o
3128      MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN
3129     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
3130     DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
3131     MATCH_MP_TAC(REAL_FIELD
3132      `&0 < s /\ s pow 2 = &2 * pi ==> &2 * pi * inv(s) * c = c * s`) THEN
3133     SIMP_TAC[SQRT_POW_2; REAL_LT_MUL; REAL_LE_MUL; REAL_POS; REAL_OF_NUM_LT;
3134              ARITH; SQRT_POS_LT; PI_POS; REAL_LT_IMP_LE];
3135     X_GEN_TAC `n:num` THEN
3136     MP_TAC(ISPEC `n + 1` HAS_REAL_INTEGRAL_SIN_NX) THEN
3137     DISCH_THEN(MP_TAC o SPEC `inv(sqrt pi) * c` o
3138       MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN
3139     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LZERO] THEN
3140     REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_INTEGRAL_UNIQUE];
3141      X_GEN_TAC `n:num` THEN
3142     MP_TAC(ISPEC `n + 1` HAS_REAL_INTEGRAL_COS_NX) THEN
3143     DISCH_THEN(MP_TAC o SPEC `inv(sqrt pi) * c` o
3144       MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN
3145     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LZERO] THEN
3146     REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_INTEGRAL_UNIQUE; REAL_MUL_LZERO]]);;
3147
3148 (* ------------------------------------------------------------------------- *)
3149 (* Shifting the origin for integration of periodic functions.                *)
3150 (* ------------------------------------------------------------------------- *)
3151
3152 let REAL_PERIODIC_INTEGER_MULTIPLE = prove
3153  (`!f:real->real a.
3154         (!x. f(x + a) = f x) <=> (!x n. integer n ==> f(x + n * a) = f x)`,
3155   REPEAT STRIP_TAC THEN EQ_TAC THENL
3156    [ALL_TAC; MESON_TAC[INTEGER_CLOSED; REAL_MUL_LID]] THEN
3157   DISCH_TAC THEN
3158   SUBGOAL_THEN `!x n. f(x + &n * a) = (f:real->real) x` ASSUME_TAC THENL
3159    [GEN_TAC THEN INDUCT_TAC THEN
3160     ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN
3161     ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB;
3162                     REAL_ADD_ASSOC; REAL_MUL_LID];
3163     REWRITE_TAC[INTEGER_CASES] THEN REPEAT STRIP_TAC THEN
3164     ASM_REWRITE_TAC[] THEN
3165     ASM_MESON_TAC[REAL_ARITH `(x + -- &n * a) + &n * a = x`]]);;
3166
3167 let HAS_REAL_INTEGRAL_OFFSET = prove
3168  (`!f i a b c. (f has_real_integral i) (real_interval[a,b])
3169                 ==> ((\x. f(x + c)) has_real_integral i)
3170                     (real_interval[a - c,b - c])`,
3171   REPEAT GEN_TAC THEN
3172   DISCH_THEN(MP_TAC o SPECL [`&1`; `c:real`] o
3173    MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY)) THEN
3174   REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_LID; REAL_INV_1] THEN
3175   REWRITE_TAC[REAL_ABS_1; REAL_MUL_LID; REAL_INV_1] THEN
3176   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3177   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
3178   REWRITE_TAC[IN_REAL_INTERVAL; EXISTS_REFL;
3179               REAL_ARITH `x - c:real = y <=> x = y + c`] THEN
3180   REAL_ARITH_TAC);;
3181
3182 let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_LEMMA = prove
3183  (`!f i a b c.
3184         (!x. f(x + (b - a)) = f(x)) /\
3185         (f has_real_integral i) (real_interval[a,a+c])
3186         ==> (f has_real_integral i) (real_interval[b,b+c])`,
3187   REPEAT STRIP_TAC THEN FIRST_X_ASSUM
3188     (MP_TAC o SPEC `a - b:real` o MATCH_MP HAS_REAL_INTEGRAL_OFFSET) THEN
3189   REWRITE_TAC[REAL_ARITH
3190    `a - (a - b):real = b /\ (a + c) - (a - b) = b + c`] THEN
3191   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_EQ) THEN
3192   X_GEN_TAC `x:real` THEN DISCH_TAC THEN
3193   FIRST_X_ASSUM(MP_TAC o SPEC `x + a - b:real`) THEN
3194   REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3195   AP_TERM_TAC THEN REAL_ARITH_TAC);;
3196
3197 let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS = prove
3198  (`!f i a b c.
3199         (!x. f(x + (b - a)) = f x) /\ &0 <= c /\ a + c <= b /\
3200         (f has_real_integral i) (real_interval[a,b])
3201         ==> ((\x. f(x + c)) has_real_integral i)
3202              (real_interval[a,b])`,
3203   let tac =
3204     REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN
3205     MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN
3206     EXISTS_TAC `real_interval[a,b]` THEN
3207     ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN CONJ_TAC THENL
3208      [ASM_MESON_TAC[real_integrable_on]; ASM_REAL_ARITH_TAC] in
3209   REPEAT STRIP_TAC THEN
3210   CONJUNCTS_THEN SUBST1_TAC
3211    (REAL_ARITH `a:real = (a + c) - c /\ b = (b + c) - c`) THEN
3212   MATCH_MP_TAC HAS_REAL_INTEGRAL_OFFSET THEN
3213   SUBGOAL_THEN
3214    `((f has_real_integral (real_integral(real_interval[a,a+c]) f))
3215      (real_interval[a,a+c]) /\
3216      (f has_real_integral (real_integral(real_interval[a+c,b]) f))
3217      (real_interval[a+c,b])) /\
3218     ((f has_real_integral (real_integral(real_interval[a+c,b]) f))
3219      (real_interval[a+c,b]) /\
3220      (f has_real_integral (real_integral(real_interval[a,a+c]) f))
3221      (real_interval[b,b+c]))`
3222   MP_TAC THENL
3223    [REPEAT CONJ_TAC THEN TRY tac THEN
3224     MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_LEMMA THEN
3225     EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[] THEN tac;
3226     DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP
3227      (REWRITE_RULE[TAUT `a /\ b /\ c /\ d ==> e <=>
3228                   c /\ d ==> a /\ b ==> e`] HAS_REAL_INTEGRAL_COMBINE))) THEN
3229     REPEAT(ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN
3230     ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; REAL_ADD_SYM]]);;
3231
3232 let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_WEAK = prove
3233  (`!f i a b c.
3234         (!x. f(x + (b - a)) = f x) /\ abs(c) <= b - a /\
3235         (f has_real_integral i) (real_interval[a,b])
3236         ==> ((\x. f(x + c)) has_real_integral i)
3237              (real_interval[a,b])`,
3238   REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= c` THENL
3239    [MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS THEN
3240     ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
3241     MP_TAC(ISPECL [`\x. (f:real->real)(--x)`; `i:real`;
3242                    `--b:real`; `--a:real`; `--c:real`]
3243           HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS) THEN
3244     ASM_REWRITE_TAC[REAL_NEG_ADD; HAS_REAL_INTEGRAL_REFLECT] THEN
3245     REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN
3246     CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
3247     X_GEN_TAC `x:real` THEN
3248     FIRST_X_ASSUM(MP_TAC o SPEC `--x + (a - b):real`) THEN
3249     REWRITE_TAC[REAL_ARITH `--(--a - --b):real = a - b`] THEN
3250     DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN REAL_ARITH_TAC]);;
3251
3252 let HAS_REAL_INTEGRAL_PERIODIC_OFFSET = prove
3253  (`!f i a b c.
3254         (!x. f(x + (b - a)) = f x) /\
3255         (f has_real_integral i) (real_interval[a,b])
3256         ==> ((\x. f(x + c)) has_real_integral i) (real_interval[a,b])`,
3257   REPEAT GEN_TAC THEN
3258   DISJ_CASES_TAC (REAL_ARITH `b <= a \/ a < b`) THEN
3259   ASM_SIMP_TAC[HAS_REAL_INTEGRAL_NULL_EQ] THEN STRIP_TAC THEN
3260   SUBGOAL_THEN
3261    `((\x. f(x + (b - a) * frac(c / (b - a)))) has_real_integral i)
3262     (real_interval[a,b])`
3263   MP_TAC THENL
3264    [MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_WEAK THEN
3265     ASM_REWRITE_TAC[REAL_ABS_MUL] THEN
3266     MATCH_MP_TAC(REAL_ARITH
3267      `a < b /\ (b - a) * f < (b - a) * &1
3268       ==> abs(b - a) * f <= b - a`) THEN
3269     ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_LMUL_EQ] THEN
3270     ASM_REWRITE_TAC[real_abs; FLOOR_FRAC];
3271     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_EQ) THEN
3272     X_GEN_TAC `x:real` THEN STRIP_TAC THEN REWRITE_TAC[FRAC_FLOOR] THEN
3273     ASM_SIMP_TAC[REAL_FIELD
3274      `a < b ==> x + (b - a) * (c / (b - a) - f) =
3275                 (x + c) + --f * (b - a)`] THEN
3276     RULE_ASSUM_TAC(REWRITE_RULE[REAL_PERIODIC_INTEGER_MULTIPLE]) THEN
3277     FIRST_X_ASSUM MATCH_MP_TAC THEN
3278     SIMP_TAC[INTEGER_CLOSED; FLOOR]]);;
3279
3280 let REAL_INTEGRABLE_PERIODIC_OFFSET = prove
3281  (`!f a b c.
3282         (!x. f(x + (b - a)) = f x) /\
3283         f real_integrable_on real_interval[a,b]
3284         ==> (\x. f(x + c)) real_integrable_on real_interval[a,b]`,
3285   REWRITE_TAC[real_integrable_on] THEN
3286   MESON_TAC[HAS_REAL_INTEGRAL_PERIODIC_OFFSET]);;
3287
3288 let ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET = prove
3289  (`!f a b c.
3290         (!x. f(x + (b - a)) = f x) /\
3291         f absolutely_real_integrable_on real_interval[a,b]
3292         ==> (\x. f(x + c)) absolutely_real_integrable_on real_interval[a,b]`,
3293   REWRITE_TAC[absolutely_real_integrable_on] THEN
3294   REPEAT STRIP_TAC THEN
3295   MP_TAC(GEN `f:real->real` (SPEC_ALL REAL_INTEGRABLE_PERIODIC_OFFSET)) THEN
3296   DISCH_THEN MATCH_MP_TAC THEN
3297   ASM_REWRITE_TAC[]);;
3298
3299 let REAL_INTEGRAL_PERIODIC_OFFSET = prove
3300  (`!f a b c.
3301         (!x. f(x + (b - a)) = f x) /\
3302         f real_integrable_on real_interval[a,b]
3303         ==> real_integral (real_interval[a,b]) (\x. f(x + c)) =
3304             real_integral (real_interval[a,b]) f`,
3305   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
3306   MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET THEN
3307   ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);;
3308
3309 let FOURIER_OFFSET_TERM = prove
3310  (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\
3311            (!x. f(x + &2 * pi) = f x)
3312            ==> fourier_coefficient (\x. f(x + t)) (2 * n + 2) *
3313                trigonometric_set (2 * n + 2) (&0) =
3314                fourier_coefficient f (2 * n + 1) *
3315                trigonometric_set (2 * n + 1) t +
3316                fourier_coefficient f (2 * n + 2) *
3317                trigonometric_set (2 * n + 2) t`,
3318   REPEAT STRIP_TAC THEN
3319   REWRITE_TAC[trigonometric_set; fourier_coefficient;
3320               orthonormal_coefficient] THEN
3321   REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN
3322   AP_THM_TAC THEN AP_TERM_TAC THEN
3323   REWRITE_TAC[REAL_MUL_RZERO; COS_0; REAL_MUL_RID] THEN
3324   REWRITE_TAC[l2product] THEN
3325   REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN
3326   ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; GSYM REAL_INTEGRAL_RMUL;
3327                 FOURIER_PRODUCTS_INTEGRABLE_STRONG; GSYM REAL_MUL_ASSOC] THEN
3328   ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (a * c) * b`] THEN
3329   REWRITE_TAC[REAL_MUL_SIN_SIN; REAL_MUL_COS_COS] THEN
3330   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN
3331   W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_ADD o
3332      rand o rand o snd) THEN
3333   REWRITE_TAC[] THEN ANTS_TAC THENL
3334    [CONJ_TAC THEN
3335     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
3336     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
3337     (CONJ_TAC THENL
3338       [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN
3339        EXISTS_TAC `(:real)` THEN
3340        REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN
3341        MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
3342        MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
3343        REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
3344        SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
3345        REWRITE_TAC[trigonometric_set; real_div] THEN
3346        REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC;
3347        ASM_REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN
3348        REPEAT STRIP_TAC THEN REWRITE_TAC[real_sub] THEN
3349        MATCH_MP_TAC(REAL_ARITH
3350         `abs x <= &1 /\ abs y <= &1 ==> abs((x + y) / &2) <= &1`) THEN
3351        REWRITE_TAC[SIN_BOUND; COS_BOUND; REAL_ABS_NEG]]);
3352     ALL_TAC] THEN
3353   DISCH_THEN(SUBST1_TAC o SYM) THEN
3354   REWRITE_TAC[REAL_ARITH
3355    `(cm - cp) / &2 * f + (cm + cp) / &2 * f = cm * f`] THEN
3356   MP_TAC(ISPECL
3357    [`\x. cos(&(n + 1) * (x - t)) * f x`;
3358     `real_integral (real_interval[--pi,pi])
3359                    (\x. cos(&(n + 1) * (x - t)) * f x)`;
3360     `--pi`; `pi`; `t:real`] HAS_REAL_INTEGRAL_PERIODIC_OFFSET) THEN
3361   REWRITE_TAC[] THEN
3362   SUBGOAL_THEN
3363    `(\x. cos (&(n + 1) * (x - t)) * f x) real_integrable_on
3364     real_interval[--pi,pi]`
3365   MP_TAC THENL
3366    [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
3367     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
3368     CONJ_TAC THENL
3369      [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN
3370       EXISTS_TAC `(:real)` THEN
3371       REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN
3372       MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
3373       MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
3374       REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN
3375       SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN
3376       REWRITE_TAC[trigonometric_set; real_div] THEN
3377       REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC;
3378       ASM_REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN
3379       REWRITE_TAC[COS_BOUND]];
3380     REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_TAC] THEN
3381   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN ANTS_TAC THENL
3382    [REWRITE_TAC[REAL_ARITH
3383      `n * ((x + &2 * pi) - t) = (&2 * n) * pi + n * (x - t)`] THEN
3384     REWRITE_TAC[COS_ADD; SIN_NPI; COS_NPI; REAL_OF_NUM_MUL] THEN
3385     REWRITE_TAC[REAL_POW_NEG; REAL_MUL_LZERO; EVEN_MULT; ARITH] THEN
3386     REWRITE_TAC[REAL_POW_ONE; REAL_SUB_RZERO; REAL_MUL_LID];
3387     REWRITE_TAC[REAL_ARITH `(x + t) - t:real = x`] THEN DISCH_TAC THEN
3388     MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
3389     ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = a * c * b`] THEN
3390     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3391     MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]);;
3392
3393 let FOURIER_SUM_OFFSET = prove
3394  (`!f n t.
3395         f absolutely_real_integrable_on real_interval[--pi,pi] /\
3396         (!x. f (x + &2 * pi) = f x)
3397         ==> sum(0..2*n) (\k. fourier_coefficient f k *
3398                              trigonometric_set k t) =
3399             sum(0..2*n) (\k. fourier_coefficient (\x. f (x + t)) k *
3400                              trigonometric_set k (&0))`,
3401   REPEAT STRIP_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN
3402   BINOP_TAC THENL
3403    [REWRITE_TAC[fourier_coefficient; trigonometric_set; l2product;
3404                 orthonormal_coefficient; REAL_MUL_LZERO; COS_0] THEN
3405     AP_THM_TAC THEN AP_TERM_TAC THEN
3406     MP_TAC(SPECL [`\x:real. &1 / sqrt(&2 * pi) * f x`;
3407                   `--pi`; `pi`; `t:real`] REAL_INTEGRAL_PERIODIC_OFFSET) THEN
3408     ASM_SIMP_TAC[REAL_ARITH `pi - --pi = &2 * pi`; REAL_INTEGRABLE_LMUL;
3409                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE];
3410     ALL_TAC] THEN
3411   ASM_CASES_TAC `n = 0` THEN
3412   ASM_REWRITE_TAC[MULT_CLAUSES; SUM_CLAUSES_NUMSEG; ARITH_EQ] THEN
3413   SUBGOAL_THEN `1..2*n = 2*0+1..(2*(n-1)+1)+1` SUBST1_TAC THENL
3414    [BINOP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
3415   REWRITE_TAC[SUM_OFFSET; SUM_PAIR] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
3416   X_GEN_TAC `k:num` THEN STRIP_TAC THEN
3417   REWRITE_TAC[ARITH_RULE `(k + 1) + 1 = k + 2`] THEN
3418   ASM_SIMP_TAC[GSYM FOURIER_OFFSET_TERM] THEN
3419   REWRITE_TAC[trigonometric_set; REAL_MUL_RZERO; COS_0; SIN_0] THEN
3420   REAL_ARITH_TAC);;
3421
3422 let FOURIER_SUM_OFFSET_UNPAIRED = prove
3423  (`!f n t.
3424         f absolutely_real_integrable_on real_interval [--pi,pi] /\
3425         (!x. f (x + &2 * pi) = f x)
3426         ==> sum(0..2*n) (\k. fourier_coefficient f k *
3427                              trigonometric_set k t) =
3428             sum(0..n) (\k. fourier_coefficient (\x. f (x + t)) (2 * k) *
3429                            trigonometric_set (2 * k) (&0))`,
3430   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET] THEN
3431   MATCH_MP_TAC EQ_TRANS THEN
3432   EXISTS_TAC
3433    `sum(0..n) (\k. fourier_coefficient (\x. f (x + t)) (2 * k) *
3434                    trigonometric_set (2 * k) (&0) +
3435                    fourier_coefficient (\x. f (x + t)) (2 * k + 1) *
3436                    trigonometric_set (2 * k + 1) (&0))` THEN
3437   REWRITE_TAC[] THEN CONJ_TAC THENL
3438    [REWRITE_TAC[GSYM SUM_PAIR] THEN
3439     REWRITE_TAC[GSYM ADD1; MULT_CLAUSES; SUM_CLAUSES_NUMSEG; LE_0];
3440     MATCH_MP_TAC SUM_EQ_NUMSEG THEN GEN_TAC THEN DISCH_TAC THEN
3441     REWRITE_TAC[REAL_EQ_ADD_LCANCEL_0]] THEN
3442   REWRITE_TAC[ADD1; trigonometric_set; real_div; REAL_MUL_RZERO] THEN
3443   REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID]);;
3444
3445 (* ------------------------------------------------------------------------- *)
3446 (* Express partial sums using Dirichlet kernel.                              *)
3447 (* ------------------------------------------------------------------------- *)
3448
3449 let dirichlet_kernel = new_definition
3450  `dirichlet_kernel n x =
3451         if x = &0 then &n + &1 / &2
3452         else sin((&n + &1 / &2) * x) / (&2 * sin(x / &2))`;;
3453
3454 let DIRICHLET_KERNEL_0 = prove
3455  (`!x. abs(x) < &2 * pi ==> dirichlet_kernel 0 x = &1 / &2`,
3456   REPEAT STRIP_TAC THEN REWRITE_TAC[dirichlet_kernel] THEN
3457   COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID] THEN
3458   REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_SYM; REAL_MUL_RID] THEN
3459   MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> inv(&2 * x) * x = inv(&2)`) THEN
3460   DISCH_TAC THEN SUBGOAL_THEN `~(x * inv(&2) = &0)` MP_TAC THENL
3461    [ASM_REAL_ARITH_TAC; REWRITE_TAC[] THEN MATCH_MP_TAC SIN_EQ_0_PI] THEN
3462   ASM_REAL_ARITH_TAC);;
3463
3464 let DIRICHLET_KERNEL_NEG = prove
3465  (`!n x. dirichlet_kernel n (--x) = dirichlet_kernel n x`,
3466   REPEAT GEN_TAC THEN REWRITE_TAC[dirichlet_kernel; REAL_NEG_EQ_0] THEN
3467   COND_CASES_TAC THEN
3468   ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; real_div; SIN_NEG;
3469                   REAL_INV_NEG; REAL_NEG_NEG]);;
3470
3471 let DIRICHLET_KERNEL_CONTINUOUS_STRONG = prove
3472  (`!n. (dirichlet_kernel n) real_continuous_on
3473        real_interval(--(&2 * pi),&2 * pi)`,
3474   let lemma = prove
3475    (`f real_differentiable (atreal a) /\ f(a) = b
3476      ==> (f ---> b) (atreal a)`,
3477     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
3478       MATCH_MP REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL) THEN
3479     REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN ASM_MESON_TAC[]) in
3480   SIMP_TAC[REAL_OPEN_REAL_INTERVAL; IN_REAL_INTERVAL;
3481            REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT] THEN
3482   MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN STRIP_TAC THEN
3483   GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
3484   REWRITE_TAC[dirichlet_kernel] THEN ASM_CASES_TAC `x = &0` THENL
3485    [ALL_TAC;
3486     SUBGOAL_THEN
3487      `(\x. sin((&k + &1 / &2) * x) / (&2 * sin(x / &2)))
3488       real_continuous atreal x`
3489     MP_TAC THENL
3490      [MATCH_MP_TAC REAL_CONTINUOUS_DIV THEN
3491       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
3492        [CONJ_TAC THEN
3493         MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
3494         REAL_DIFFERENTIABLE_TAC;
3495         MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN
3496         ASM_REWRITE_TAC[NETLIMIT_ATREAL] THEN ASM_REAL_ARITH_TAC];
3497       ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN
3498       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN
3499       REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `abs x` THEN
3500       ASM_REAL_ARITH_TAC]] THEN
3501   ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN
3502   MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN
3503   EXISTS_TAC `\x. sin((&k + &1 / &2) * x) / (&2 * sin(x / &2))` THEN
3504   CONJ_TAC THENL
3505    [SIMP_TAC[EVENTUALLY_ATREAL; REAL_ARITH
3506      `&0 < abs(x - &0) <=> ~(x = &0)`] THEN
3507     EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01];
3508     ALL_TAC] THEN
3509   MATCH_MP_TAC LHOSPITAL THEN MAP_EVERY EXISTS_TAC
3510    [`\x. (&k + &1 / &2) * cos((&k + &1 / &2) * x)`;
3511     `\x. cos(x / &2)`; `&1`] THEN
3512   REWRITE_TAC[REAL_LT_01; REAL_SUB_RZERO] THEN REPEAT STRIP_TAC THENL
3513    [REAL_DIFF_TAC THEN REAL_ARITH_TAC;
3514     REAL_DIFF_TAC THEN REAL_ARITH_TAC;
3515     FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[] THEN
3516       MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI) THEN
3517     MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC;
3518     MATCH_MP_TAC lemma THEN
3519     REWRITE_TAC[REAL_MUL_RZERO; SIN_0] THEN REAL_DIFFERENTIABLE_TAC;
3520     MATCH_MP_TAC lemma THEN
3521     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; real_div; SIN_0] THEN
3522     REAL_DIFFERENTIABLE_TAC;
3523     REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
3524     REWRITE_TAC[GSYM real_div] THEN
3525     GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_DIV_1] THEN
3526     MATCH_MP_TAC REALLIM_DIV THEN
3527     REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN CONJ_TAC THEN
3528     MATCH_MP_TAC lemma THEN
3529     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO;
3530                 real_div; COS_0; REAL_MUL_RID] THEN
3531     REAL_DIFFERENTIABLE_TAC]);;
3532
3533 let DIRICHLET_KERNEL_CONTINUOUS = prove
3534  (`!n. (dirichlet_kernel n) real_continuous_on real_interval[--pi,pi]`,
3535   GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN
3536   EXISTS_TAC `real_interval(--(&2 * pi),&2 * pi)` THEN
3537   REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS_STRONG] THEN
3538   REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);;
3539
3540 let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL = prove
3541  (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi]
3542          ==> (\x. dirichlet_kernel n x * f x)
3543              absolutely_real_integrable_on real_interval[--pi,pi]`,
3544   REPEAT STRIP_TAC THEN
3545   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
3546   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3547    [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN
3548     ASM_REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS; ETA_AX;
3549                     REAL_CLOSED_REAL_INTERVAL];
3550     MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
3551     MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN
3552     ASM_REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS; ETA_AX;
3553                     REAL_COMPACT_INTERVAL]]);;
3554
3555 let COSINE_SUM_LEMMA = prove
3556  (`!n x. (&1 / &2 + sum(1..n) (\k. cos(&k * x))) * sin(x / &2) =
3557          sin((&n + &1 / &2) * x) / &2`,
3558   REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL
3559    [ASM_REWRITE_TAC[REAL_ADD_LID; SUM_CLAUSES_NUMSEG; ARITH] THEN
3560     REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ADD_RID; REAL_MUL_SYM];
3561     REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN
3562     REWRITE_TAC[REAL_MUL_COS_SIN; real_div; REAL_SUB_RDISTRIB] THEN
3563     SUBGOAL_THEN
3564      `!k x. &k * x + x * inv(&2) = (&(k + 1) * x - x * inv(&2))`
3565      (fun th -> REWRITE_TAC[th; SUM_DIFFS_ALT])
3566     THENL [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN
3567     ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM real_div] THEN
3568     REWRITE_TAC[REAL_ARITH `&1 * x - x / &2 = x / &2`] THEN
3569     REWRITE_TAC[REAL_ARITH `(&n + &1) * x - x / &2 = (&n + &1 / &2) * x`] THEN
3570     REWRITE_TAC[REAL_ADD_RDISTRIB] THEN REAL_ARITH_TAC]);;
3571
3572 let DIRICHLET_KERNEL_COSINE_SUM = prove
3573  (`!n x. ~(x = &0) /\ abs(x) < &2 * pi
3574          ==> dirichlet_kernel n x = &1 / &2 + sum(1..n) (\k. cos(&k * x))`,
3575   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN
3576   MATCH_MP_TAC(REAL_FIELD
3577     `~(y = &0) /\ z * y = x / &2 ==> x / (&2 * y) = z`) THEN
3578   REWRITE_TAC[COSINE_SUM_LEMMA] THEN
3579   MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC);;
3580
3581 let HAS_REAL_INTEGRAL_DIRICHLET_KERNEL = prove
3582  (`!n. (dirichlet_kernel n has_real_integral pi) (real_interval[--pi,pi])`,
3583   GEN_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN
3584   EXISTS_TAC `\x. &1 / &2 + sum(1..n) (\k. cos(&k * x))` THEN
3585   EXISTS_TAC `{&0}` THEN
3586   REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN
3587   SIMP_TAC[REAL_ARITH `&0 < pi /\ --pi <= x /\ x <= pi ==> abs(x) < &2 * pi`;
3588            DIRICHLET_KERNEL_COSINE_SUM; PI_POS] THEN
3589   SUBGOAL_THEN `pi = pi + sum(1..n) (\k. &0)` MP_TAC THENL
3590    [REWRITE_TAC[SUM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN
3591   DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN
3592   MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL
3593    [GEN_REWRITE_TAC LAND_CONV [REAL_ARITH  `pi = (&1 / &2) * (pi - --pi)`] THEN
3594     MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN MP_TAC PI_POS THEN
3595     REAL_ARITH_TAC;
3596     MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN
3597     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
3598     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
3599     MP_TAC(SPEC `k:num` HAS_REAL_INTEGRAL_COS_NX) THEN ASM_SIMP_TAC[LE_1]]);;
3600
3601 let HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF = prove
3602  (`!n. (dirichlet_kernel n has_real_integral (pi / &2))
3603        (real_interval[&0,pi])`,
3604   GEN_TAC THEN
3605   MP_TAC(ISPECL [`dirichlet_kernel n`; `--pi`; `pi`; `&0`; `pi`]
3606         REAL_INTEGRABLE_SUBINTERVAL) THEN
3607   ANTS_TAC THENL
3608    [CONJ_TAC THENL
3609      [MESON_TAC[HAS_REAL_INTEGRAL_DIRICHLET_KERNEL; real_integrable_on];
3610       REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN
3611       REAL_ARITH_TAC];
3612     REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_TAC] THEN
3613   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
3614    [GSYM HAS_REAL_INTEGRAL_REFLECT]) THEN
3615   REWRITE_TAC[DIRICHLET_KERNEL_NEG; ETA_AX; REAL_NEG_0] THEN DISCH_TAC THEN
3616   REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
3617   CONJ_TAC THENL [ASM_MESON_TAC[real_integrable_on]; ALL_TAC] THEN
3618   MP_TAC(ISPECL
3619    [`dirichlet_kernel n`;
3620     `real_integral (real_interval [&0,pi]) (dirichlet_kernel n)`;
3621     `real_integral (real_interval [&0,pi]) (dirichlet_kernel n)`;
3622     `--pi`; `pi`; `&0`] HAS_REAL_INTEGRAL_COMBINE) THEN
3623   ASM_REWRITE_TAC[GSYM REAL_MUL_2] THEN
3624   ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN
3625   DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
3626   MATCH_MP_TAC(REAL_ARITH `x = pi ==> x = &2 * y ==> y = pi / &2`) THEN
3627   MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
3628   REWRITE_TAC[HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]);;
3629
3630 let FOURIER_SUM_OFFSET_DIRICHLET_KERNEL = prove
3631  (`!f n t.
3632         f absolutely_real_integrable_on real_interval[--pi,pi] /\
3633         (!x. f (x + &2 * pi) = f x)
3634         ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) =
3635             real_integral (real_interval[--pi,pi])
3636                           (\x. dirichlet_kernel n x * f(x + t)) / pi`,
3637   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_UNPAIRED] THEN
3638   SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH] THEN
3639   REWRITE_TAC[trigonometric_set; COS_0; REAL_MUL_LZERO] THEN
3640   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
3641    `fourier_coefficient (\x. f(x + t)) 0 * &1 / sqrt(&2 * pi) +
3642     sum (1..n) (\k. fourier_coefficient (\x. f(x + t)) (2 * k) / sqrt pi)` THEN
3643   CONJ_TAC THENL
3644    [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
3645     SIMP_TAC[TRIGONOMETRIC_SET_EVEN; LE_1; REAL_MUL_RZERO; COS_0] THEN
3646     REAL_ARITH_TAC;
3647     ALL_TAC] THEN
3648   REWRITE_TAC[real_div; REAL_MUL_LID;
3649               fourier_coefficient; orthonormal_coefficient;
3650               trigonometric_set; l2product] THEN
3651   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
3652         ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
3653   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN
3654   ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
3655    [GSYM REAL_MUL_ASSOC; GSYM REAL_INTEGRAL_RMUL; GSYM REAL_INTEGRAL_ADD;
3656     ABSOLUTELY_INTEGRABLE_COS_PRODUCT;
3657     ABSOLUTELY_INTEGRABLE_SIN_PRODUCT;
3658     ABSOLUTELY_REAL_INTEGRABLE_LMUL;
3659     TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE;
3660     ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
3661     GSYM REAL_INTEGRAL_SUM; FINITE_NUMSEG;
3662     ABSOLUTELY_REAL_INTEGRABLE_RMUL;
3663     ABSOLUTELY_REAL_INTEGRABLE_SUM;
3664     ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL] THEN
3665   MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{}:real->bool` THEN
3666   REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN
3667   X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN
3668   REWRITE_TAC[REAL_MUL_LZERO; COS_0; REAL_ARITH
3669    `a * b * c * b:real = (a * c) * b pow 2`] THEN
3670   SIMP_TAC[REAL_POW_INV; SQRT_POW_2; REAL_LE_MUL; REAL_POS; PI_POS_LE;
3671            REAL_LE_INV_EQ] THEN
3672   REWRITE_TAC[REAL_INV_MUL; REAL_ARITH
3673    `d * f * i = (&1 * f) * inv(&2) * i + y <=> i * f * (d - &1 / &2) = y`] THEN
3674   MATCH_MP_TAC EQ_TRANS THEN
3675   EXISTS_TAC `sum(1..n) (\k. inv pi * f(x + t) * cos(&k * x))` THEN
3676   CONJ_TAC THENL
3677    [REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
3678     REWRITE_TAC[REAL_ARITH `x - &1 / &2 = y <=> x = &1 / &2 + y`] THEN
3679     ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[dirichlet_kernel] THENL
3680      [REWRITE_TAC[REAL_MUL_RZERO; COS_0; SUM_CONST_NUMSEG; ADD_SUB] THEN
3681       REAL_ARITH_TAC;
3682       MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN
3683       MATCH_MP_TAC(TAUT `a /\ b /\ ~d /\ (~c ==> e)
3684                          ==> (a /\ b /\ c ==> d) ==> e`) THEN
3685       REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
3686       ASM_SIMP_TAC[REAL_FIELD
3687       `~(y = &0) ==> (x / (&2 * y) = z <=> z * y = x / &2)`] THEN
3688       REWRITE_TAC[COSINE_SUM_LEMMA]];
3689     MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN
3690     ASM_SIMP_TAC[TRIGONOMETRIC_SET_EVEN; LE_1] THEN
3691     REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_RING
3692      `s * s:real = p ==> p * f * c = (c * s) * f * s`) THEN
3693     REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN
3694     SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; PI_POS_LE]]);;
3695
3696 let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL = prove
3697  (`!f t l.
3698         f absolutely_real_integrable_on real_interval[--pi,pi] /\
3699         (!x. f (x + &2 * pi) = f x)
3700         ==> (((\n. sum (0..n)
3701                        (\k. fourier_coefficient f k * trigonometric_set k t))
3702               ---> l) sequentially <=>
3703             ((\n. real_integral (real_interval[--pi,pi])
3704                                 (\x. dirichlet_kernel n x * f(x + t)))
3705              ---> pi * l) sequentially)`,
3706   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN
3707   ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL] THEN
3708   SUBGOAL_THEN `l = (l * pi) / pi`
3709    (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])
3710   THENL [MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN
3711   SIMP_TAC[real_div; REALLIM_RMUL_EQ; PI_NZ; REAL_INV_EQ_0] THEN
3712   REWRITE_TAC[REAL_MUL_AC]);;
3713
3714 (* ------------------------------------------------------------------------- *)
3715 (* A directly deduced sufficient condition for convergence at a point.       *)
3716 (* ------------------------------------------------------------------------- *)
3717
3718 let SIMPLE_FOURIER_CONVERGENCE_PERIODIC = prove
3719  (`!f t.
3720         f absolutely_real_integrable_on real_interval[--pi,pi] /\
3721         (\x. (f(x + t) - f(t)) / sin(x / &2))
3722         absolutely_real_integrable_on real_interval[--pi,pi] /\
3723         (!x. f (x + &2 * pi) = f x)
3724         ==> ((\n. sum (0..n)
3725                       (\k. fourier_coefficient f k * trigonometric_set k t))
3726               ---> f(t)) sequentially`,
3727   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN
3728   MP_TAC(ISPECL [`\x. (f:real->real)(x) - f(t)`; `t:real`; `&0`]
3729         FOURIER_SUM_LIMIT_DIRICHLET_KERNEL) THEN
3730   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
3731         ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
3732   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN
3733   ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB;
3734                ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
3735   MATCH_MP_TAC(TAUT `(a ==> c) /\ b ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL
3736    [ASM_SIMP_TAC[FOURIER_COEFFICIENT_SUB; FOURIER_COEFFICIENT_CONST;
3737                  ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
3738     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN
3739     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN
3740     X_GEN_TAC `n:num` THEN DISCH_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN
3741     MATCH_MP_TAC(REAL_ARITH
3742      `s:real = u /\ ft * t = x ==> (f0 - ft) * t + s = (f0 * t + u) - x`) THEN
3743     CONJ_TAC THENL
3744      [MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LE_1; ARITH; REAL_SUB_RZERO];
3745       REWRITE_TAC[trigonometric_set; REAL_MUL_LZERO; COS_0] THEN
3746       MATCH_MP_TAC(REAL_FIELD `&0 < s ==> (f * s) * &1 / s = f`) THEN
3747       MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC];
3748     MP_TAC(ISPECL [`\x. (f:real->real)(x) - f(t)`; `t:real`; `&0`]
3749         FOURIER_SUM_LIMIT_DIRICHLET_KERNEL) THEN
3750     MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
3751           ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
3752     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN
3753     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB;
3754                  ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
3755     SUBGOAL_THEN
3756      `!n. real_integral (real_interval [--pi,pi])
3757                         (\x. dirichlet_kernel n x * (f(x + t) - f(t))) =
3758           real_integral (real_interval [--pi,pi])
3759                         (\x. sin((&n + &1 / &2) * x) *
3760                              inv(&2) * (f(x + t) - f(t)) / sin(x / &2))`
3761      (fun th -> REWRITE_TAC[th])
3762     THENL
3763      [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
3764       EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN
3765       REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN
3766       REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN
3767       REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC];
3768       ALL_TAC] THEN
3769     REWRITE_TAC[REAL_MUL_RZERO] THEN
3770     MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN
3771     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]]);;
3772
3773 (* ------------------------------------------------------------------------- *)
3774 (* A more natural sufficient Hoelder condition at a point.                   *)
3775 (* ------------------------------------------------------------------------- *)
3776
3777 let REAL_SIN_X2_ZEROS = prove
3778  (`{x | sin(x / &2) = &0} = IMAGE (\n. &2 * pi * n) integer`,
3779   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
3780   REWRITE_TAC[IN_ELIM_THM; SIN_EQ_0; REAL_ARITH
3781    `y / &2 = n * pi <=> &2 * pi * n = y`] THEN
3782   REWRITE_TAC[PI_NZ; REAL_RING
3783    `&2 * pi * m = &2 * pi * n <=> pi = &0 \/ m = n`] THEN
3784   MESON_TAC[IN]);;
3785
3786 let HOELDER_FOURIER_CONVERGENCE_PERIODIC = prove
3787  (`!f d M a t.
3788         f absolutely_real_integrable_on real_interval[--pi,pi] /\
3789         (!x. f(x + &2 * pi) = f(x)) /\
3790         &0 < d /\ &0 < a /\
3791         (!x. abs(x - t) < d ==> abs(f x - f t) <= M * abs(x - t) rpow a)
3792         ==> ((\n. sum (0..n)
3793                       (\k. fourier_coefficient f k * trigonometric_set k t))
3794              ---> f t) sequentially`,
3795   REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_FOURIER_CONVERGENCE_PERIODIC THEN
3796   ASM_REWRITE_TAC[] THEN
3797   SUBGOAL_THEN
3798     `?e. &0 < e /\
3799          !x. abs(x) < e
3800              ==> abs((f (x + t) - f t) / sin (x / &2))
3801                  <= &4 * abs M * abs(x) rpow (a - &1)`
3802   STRIP_ASSUME_TAC THENL
3803    [MP_TAC(REAL_DIFF_CONV
3804      `((\x. sin(x / &2)) has_real_derivative w) (atreal (&0))`) THEN
3805     CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COS_0; REAL_MUL_RID] THEN
3806     REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL; REALLIM_ATREAL] THEN
3807     DISCH_THEN(MP_TAC o SPEC `&1 / &4`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3808     REWRITE_TAC[SIN_0; REAL_SUB_RZERO] THEN DISCH_THEN
3809      (X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN
3810     EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
3811     X_GEN_TAC `x:real` THEN STRIP_TAC THEN
3812     ASM_CASES_TAC `sin(x / &2) = &0` THENL
3813      [ONCE_REWRITE_TAC[real_div] THEN ASM_REWRITE_TAC[REAL_INV_0] THEN
3814       REWRITE_TAC[GSYM REAL_ABS_RPOW; GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC;
3815       ALL_TAC] THEN
3816     ASM_CASES_TAC `x = &0` THENL
3817      [ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_ADD_LID;
3818                       REAL_MUL_LZERO] THEN
3819       REWRITE_TAC[GSYM REAL_ABS_RPOW; GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC;
3820       ALL_TAC] THEN
3821     REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN
3822     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3823     DISCH_THEN(ASSUME_TAC o MATCH_MP (REAL_ARITH
3824      `abs(x - &1 / &2) < &1 / &4 ==> &1 / &4 <= abs(x)`)) THEN
3825     SUBGOAL_THEN
3826      `abs((f(x + t) - f t) / sin (x / &2)) =
3827       abs(inv(sin(x / &2) / x)) * abs(f(x + t) - f t) / abs(x)`
3828     SUBST1_TAC THENL
3829      [REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_INV] THEN
3830       UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD;
3831       ALL_TAC] THEN
3832     MATCH_MP_TAC REAL_LE_MUL2 THEN
3833     SIMP_TAC[REAL_ABS_POS; REAL_LE_DIV] THEN CONJ_TAC THENL
3834      [REWRITE_TAC[REAL_ABS_INV] THEN
3835       SUBST1_TAC(REAL_ARITH `&4 = inv(&1 / &4)`) THEN
3836       MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC;
3837       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; GSYM REAL_MUL_ASSOC] THEN
3838       GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM REAL_POW_1] THEN
3839       ASM_SIMP_TAC[GSYM RPOW_POW; GSYM RPOW_ADD; GSYM REAL_ABS_NZ] THEN
3840       REWRITE_TAC[REAL_ARITH `a - &1 + &1 = a`] THEN
3841       MATCH_MP_TAC REAL_LE_TRANS THEN
3842       EXISTS_TAC `M * abs((x + t) - t) rpow a` THEN CONJ_TAC THENL
3843        [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
3844         REWRITE_TAC[REAL_ARITH `(x + t) - t:real = x`] THEN
3845         REWRITE_TAC[GSYM REAL_ABS_RPOW] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
3846         REAL_ARITH_TAC]];
3847     ALL_TAC] THEN
3848   SUBGOAL_THEN `real_bounded (IMAGE (\x. inv(sin(x / &2)))
3849                 (real_interval[--pi,pi] DIFF real_interval(--e,e)))`
3850   MP_TAC THENL
3851    [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
3852     MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
3853      [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
3854       X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN
3855       STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
3856       MATCH_MP_TAC REAL_CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_ATREAL] THEN
3857       CONJ_TAC THENL
3858        [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
3859         REAL_DIFFERENTIABLE_TAC;
3860         DISCH_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN
3861         ASM_REAL_ARITH_TAC];
3862       REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN
3863       SIMP_TAC[REAL_CLOSED_DIFF; REAL_CLOSED_REAL_INTERVAL;
3864                REAL_OPEN_REAL_INTERVAL] THEN
3865       MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN
3866       EXISTS_TAC `real_interval[--pi,pi]` THEN
3867       REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET_DIFF]];
3868     SIMP_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_REAL_INTERVAL; IN_DIFF] THEN
3869     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN
3870   MATCH_MP_TAC
3871     REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
3872   EXISTS_TAC `\x:real. max (B * abs(f(x + t) - f t))
3873                            ((&4 * abs M) * abs(x) rpow (a - &1))` THEN
3874   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
3875         ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
3876   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN REPEAT STRIP_TAC THENL
3877    [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL
3878      [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
3879       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
3880       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB;
3881                    ABSOLUTELY_REAL_INTEGRABLE_CONST];
3882       MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
3883       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
3884       REPEAT STRIP_TAC THEN
3885       MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
3886       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
3887       REAL_DIFFERENTIABLE_TAC;
3888       REWRITE_TAC[REAL_SIN_X2_ZEROS] THEN
3889       MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN
3890       MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]];
3891     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
3892     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN
3893     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_LMUL;
3894        ABSOLUTELY_REAL_INTEGRABLE_ABS;
3895        ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
3896     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN
3897     MP_TAC(ISPECL
3898      [`\x. inv(a) * x rpow a`; `\x. x rpow (a - &1)`; `&0`; `pi`]
3899      REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN
3900     REWRITE_TAC[PI_POS_LE] THEN ANTS_TAC THENL
3901      [CONJ_TAC THENL
3902        [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN
3903         MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC;
3904         REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
3905         REAL_DIFF_TAC THEN
3906         MAP_EVERY UNDISCH_TAC [`&0 < a`; `&0 < x`] THEN CONV_TAC REAL_FIELD];
3907       DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_REAL_INTEGRAL_INTEGRABLE)] THEN
3908     MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE THEN
3909     SIMP_TAC[RPOW_POS_LE; REAL_ABS_POS] THEN
3910     MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `&0` THEN
3911     REWRITE_TAC[REAL_NEG_LE0; PI_POS_LE] THEN CONJ_TAC THENL
3912      [ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN
3913       REWRITE_TAC[REAL_ABS_NEG; REAL_NEG_NEG; REAL_NEG_0];
3914       ALL_TAC] THEN
3915     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
3916         REAL_INTEGRABLE_EQ)) THEN
3917     SIMP_TAC[IN_REAL_INTERVAL; real_abs];
3918     RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN
3919     ASM_CASES_TAC `abs(x) < e` THENL
3920      [MATCH_MP_TAC(REAL_ARITH `x <= b ==> x <= max a b`) THEN
3921       ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC];
3922       MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= max a b`) THEN
3923       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3924       REWRITE_TAC[real_div; REAL_ABS_MUL] THEN
3925       MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
3926       REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
3927       ASM_REAL_ARITH_TAC]]);;
3928
3929 (* ------------------------------------------------------------------------- *)
3930 (* In particular, a Lipschitz condition at the point.                        *)
3931 (* ------------------------------------------------------------------------- *)
3932
3933 let LIPSCHITZ_FOURIER_CONVERGENCE_PERIODIC = prove
3934  (`!f d M t.
3935         f absolutely_real_integrable_on real_interval[--pi,pi] /\
3936         (!x. f(x + &2 * pi) = f(x)) /\
3937         &0 < d /\ (!x. abs(x - t) < d ==> abs(f x - f t) <= M * abs(x - t))
3938         ==> ((\n. sum (0..n)
3939                       (\k. fourier_coefficient f k * trigonometric_set k t))
3940              ---> f t) sequentially`,
3941   REPEAT STRIP_TAC THEN
3942   MATCH_MP_TAC HOELDER_FOURIER_CONVERGENCE_PERIODIC THEN
3943   MAP_EVERY EXISTS_TAC [`d:real`; `M:real`; `&1`] THEN
3944   ASM_REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LT_01]);;
3945
3946 (* ------------------------------------------------------------------------- *)
3947 (* In particular, if left and right derivatives both exist.                  *)
3948 (* ------------------------------------------------------------------------- *)
3949
3950 let BIDIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC = prove
3951  (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\
3952          (!x. f(x + &2 * pi) = f(x)) /\
3953          f real_differentiable (atreal t within {x | t < x}) /\
3954          f real_differentiable (atreal t within {x | x < t})
3955          ==> ((\n. sum (0..n)
3956                        (\k. fourier_coefficient f k * trigonometric_set k t))
3957               ---> f t) sequentially`,
3958   REPEAT GEN_TAC THEN
3959   REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3960   REWRITE_TAC[real_differentiable; HAS_REAL_DERIVATIVE_WITHINREAL] THEN
3961   DISCH_THEN(CONJUNCTS_THEN2
3962    (X_CHOOSE_THEN `B1:real` (LABEL_TAC "1"))
3963    (X_CHOOSE_THEN `B2:real` (LABEL_TAC "2"))) THEN
3964   MATCH_MP_TAC LIPSCHITZ_FOURIER_CONVERGENCE_PERIODIC THEN
3965   REMOVE_THEN "1" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN
3966   DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN
3967   DISCH_THEN(X_CHOOSE_THEN `d1:real`
3968    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
3969   REMOVE_THEN "2" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN
3970   DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN
3971   DISCH_THEN(X_CHOOSE_THEN `d2:real`
3972    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
3973   MAP_EVERY EXISTS_TAC [`min d1 d2:real`; `abs B1 + abs B2 + &1`] THEN
3974   ASM_REWRITE_TAC[REAL_LT_MIN] THEN
3975   X_GEN_TAC `x:real` THEN STRIP_TAC THEN
3976   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `x = t \/ t < x \/ x < t`)
3977   THENL
3978    [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_MUL_RZERO; REAL_LE_REFL];
3979     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_DIV;
3980                  REAL_ARITH `t < x ==> &0 < abs(x - t)`] THEN
3981     REMOVE_THEN "1" (MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC;
3982     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_DIV;
3983                  REAL_ARITH `x < t ==> &0 < abs(x - t)`] THEN
3984     REMOVE_THEN "2" (MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC]);;
3985
3986 (* ------------------------------------------------------------------------- *)
3987 (* And in particular at points where the function is differentiable.         *)
3988 (* ------------------------------------------------------------------------- *)
3989
3990 let DIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC = prove
3991  (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\
3992          (!x. f(x + &2 * pi) = f(x)) /\
3993          f real_differentiable (atreal t)
3994          ==> ((\n. sum (0..n)
3995                        (\k. fourier_coefficient f k * trigonometric_set k t))
3996               ---> f t) sequentially`,
3997   REPEAT STRIP_TAC THEN
3998   MATCH_MP_TAC BIDIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC THEN
3999   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
4000   UNDISCH_TAC `f real_differentiable (atreal t)` THEN
4001   REWRITE_TAC[real_differentiable] THEN MATCH_MP_TAC MONO_EXISTS THEN
4002   REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);;
4003
4004 (* ------------------------------------------------------------------------- *)
4005 (* Use reflection to halve the region of integration.                        *)
4006 (* ------------------------------------------------------------------------- *)
4007
4008 let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED = prove
4009  (`!f n c.
4010         f absolutely_real_integrable_on real_interval [--pi,pi] /\
4011         (!x. f(x + &2 * pi) = f(x))
4012         ==> (\x. dirichlet_kernel n x * f(t + x))
4013             absolutely_real_integrable_on real_interval[--pi,pi] /\
4014             (\x. dirichlet_kernel n x * f(t - x))
4015             absolutely_real_integrable_on real_interval[--pi,pi] /\
4016             (\x. dirichlet_kernel n x * c)
4017             absolutely_real_integrable_on real_interval[--pi,pi]`,
4018   REPEAT STRIP_TAC THEN
4019   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THENL
4020    [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4021     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
4022     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
4023     REWRITE_TAC[absolutely_real_integrable_on] THEN
4024     ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN
4025     REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN
4026     REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN
4027     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4028     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
4029     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
4030     REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]]);;
4031
4032 let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART = prove
4033  (`!f n d c.
4034         f absolutely_real_integrable_on real_interval [--pi,pi] /\
4035         (!x. f(x + &2 * pi) = f(x)) /\ d <= pi
4036         ==> (\x. dirichlet_kernel n x * f(t + x))
4037             absolutely_real_integrable_on real_interval[&0,d] /\
4038             (\x. dirichlet_kernel n x * f(t - x))
4039             absolutely_real_integrable_on real_interval[&0,d] /\
4040             (\x. dirichlet_kernel n x * c)
4041             absolutely_real_integrable_on real_interval[&0,d] /\
4042             (\x. dirichlet_kernel n x * (f(t + x) + f(t - x)))
4043             absolutely_real_integrable_on real_interval[&0,d] /\
4044             (\x. dirichlet_kernel n x * ((f(t + x) + f(t - x)) - c))
4045             absolutely_real_integrable_on real_interval[&0,d]`,
4046   REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
4047   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP
4048   ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED) ASSUME_TAC) THEN
4049   REWRITE_TAC[GSYM CONJ_ASSOC] THEN
4050   MATCH_MP_TAC(TAUT
4051    `(a /\ b /\ c) /\ (a /\ b /\ c ==> d /\ e)
4052     ==> a /\ b /\ c /\ d /\ e`) THEN
4053   CONJ_TAC THENL
4054    [REPEAT STRIP_TAC THEN
4055     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
4056     EXISTS_TAC `real_interval[--pi,pi]` THEN REPEAT STRIP_TAC THEN
4057     ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN
4058     ASM_REAL_ARITH_TAC;
4059     SIMP_TAC[REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB;
4060              ABSOLUTELY_REAL_INTEGRABLE_ADD;
4061              ABSOLUTELY_REAL_INTEGRABLE_SUB]]);;
4062
4063 let FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF = prove
4064  (`!f n t.
4065         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4066         (!x. f (x + &2 * pi) = f x)
4067         ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) -
4068             l =
4069             real_integral (real_interval[&0,pi])
4070                           (\x. dirichlet_kernel n x *
4071                                ((f(t + x) + f(t - x)) - &2 * l)) / pi`,
4072   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL] THEN
4073   MATCH_MP_TAC(MATCH_MP (REAL_FIELD
4074    `&0 < pi ==> x = y + pi * l ==> x / pi - l = y / pi`) PI_POS) THEN
4075   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
4076         ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
4077   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN
4078   ASM_SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD;
4079                ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL;
4080                ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
4081   REWRITE_TAC[MESON[REAL_ADD_SYM]
4082    `dirichlet_kernel n x * f(x + t) = dirichlet_kernel n x * f(t + x)`] THEN
4083   REWRITE_TAC[DIRICHLET_KERNEL_NEG; GSYM real_sub] THEN
4084   MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF) THEN
4085   DISCH_THEN(MP_TAC o SPEC `&2 * l` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN
4086   REWRITE_TAC[REAL_ARITH `pi / &2 * &2 * l = pi * l`] THEN
4087   DISCH_THEN(SUBST1_TAC o GSYM o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
4088   ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN
4089   REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB] THEN
4090   MATCH_MP_TAC(GSYM REAL_INTEGRAL_SUB) THEN
4091   MP_TAC(GEN `c:real` (ISPECL [`f:real->real`; `n:num`; `pi`; `c:real`]
4092         ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART)) THEN
4093   ASM_REWRITE_TAC[REAL_LE_REFL; FORALL_AND_THM] THEN STRIP_TAC THEN
4094   ASM_SIMP_TAC[GSYM REAL_ADD_LDISTRIB;
4095                ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);;
4096
4097 let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_HALF = prove
4098  (`!f t l.
4099         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4100         (!x. f (x + &2 * pi) = f x)
4101         ==> (((\n. sum (0..n)
4102                        (\k. fourier_coefficient f k * trigonometric_set k t))
4103               ---> l) sequentially <=>
4104             ((\n. real_integral (real_interval[&0,pi])
4105                                 (\x. dirichlet_kernel n x *
4106                                      ((f(t + x) + f(t - x)) - &2 * l)))
4107              ---> &0) sequentially)`,
4108   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN
4109   GEN_REWRITE_TAC LAND_CONV [REALLIM_NULL] THEN
4110   ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF] THEN
4111   REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_RMUL_EQ THEN
4112   MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);;
4113
4114 (* ------------------------------------------------------------------------- *)
4115 (* Localization principle: convergence only depends on values "nearby".      *)
4116 (* ------------------------------------------------------------------------- *)
4117
4118 let RIEMANN_LOCALIZATION_INTEGRAL = prove
4119  (`!d f g.
4120         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4121         g absolutely_real_integrable_on real_interval[--pi,pi] /\
4122         &0 < d /\ (!x. abs(x) < d ==> f x = g x)
4123         ==> ((\n. real_integral (real_interval[--pi,pi])
4124                                 (\x. dirichlet_kernel n x * f(x)) -
4125                   real_integral (real_interval[--pi,pi])
4126                                 (\x. dirichlet_kernel n x * g(x)))
4127              ---> &0) sequentially`,
4128   REPEAT STRIP_TAC THEN
4129   SUBGOAL_THEN
4130    `!n. real_integral (real_interval[--pi,pi])
4131                       (\x. dirichlet_kernel n x * f(x)) -
4132         real_integral (real_interval[--pi,pi])
4133                       (\x. dirichlet_kernel n x * g(x)) =
4134         real_integral (real_interval[--pi,pi])
4135                       (\x. dirichlet_kernel n x *
4136                            (if abs(x) < d then &0 else f(x) - g(x)))`
4137    (fun th -> REWRITE_TAC[th])
4138   THENL
4139    [ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL;
4140                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
4141                  GSYM REAL_INTEGRAL_SUB] THEN
4142     X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
4143     EXISTS_TAC `{}:real->bool` THEN
4144     REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN
4145     X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
4146     STRIP_TAC THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN AP_TERM_TAC THEN
4147     COND_CASES_TAC THEN REWRITE_TAC[REAL_ARITH `&0 = x - y <=> x = y`] THEN
4148     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
4149     ALL_TAC] THEN
4150   SUBGOAL_THEN
4151    `!n. real_integral (real_interval[--pi,pi])
4152                       (\x. dirichlet_kernel n x *
4153                            (if abs x < d then &0 else f(x) - g(x))) =
4154         real_integral (real_interval[--pi,pi])
4155                       (\x. sin((&n + &1 / &2) * x) *
4156                            inv(&2) *
4157                            (if abs x < d then &0 else f(x) - g(x)) /
4158                            sin(x / &2))`
4159    (fun th -> REWRITE_TAC[th])
4160   THENL
4161    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
4162     EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN
4163     REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN
4164     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN
4165     REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC];
4166     ALL_TAC] THEN
4167   MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN
4168   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN
4169   SUBGOAL_THEN `real_bounded (IMAGE (\x. inv(sin(x / &2)))
4170                 (real_interval[--pi,pi] DIFF real_interval(--d,d)))`
4171   MP_TAC THENL
4172    [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
4173     MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
4174      [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4175       X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN
4176       STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4177       MATCH_MP_TAC REAL_CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_ATREAL] THEN
4178       CONJ_TAC THENL
4179        [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4180         REAL_DIFFERENTIABLE_TAC;
4181         DISCH_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN
4182         ASM_REAL_ARITH_TAC];
4183       REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN
4184       SIMP_TAC[REAL_CLOSED_DIFF; REAL_CLOSED_REAL_INTERVAL;
4185                REAL_OPEN_REAL_INTERVAL] THEN
4186       MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN
4187       EXISTS_TAC `real_interval[--pi,pi]` THEN
4188       REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET_DIFF]];
4189     SIMP_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_REAL_INTERVAL; IN_DIFF] THEN
4190     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN
4191   MATCH_MP_TAC
4192     REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
4193   EXISTS_TAC `\x:real. B * abs(f(x) - g(x))` THEN
4194   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
4195    [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL
4196      [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN
4197       ASM_SIMP_TAC[INTEGRABLE_IMP_REAL_MEASURABLE; REAL_MEASURABLE_ON_0;
4198                    ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
4199                    ABSOLUTELY_REAL_INTEGRABLE_SUB] THEN
4200       SUBGOAL_THEN `{x | abs x < d} = real_interval(--d,d)`
4201        (fun th -> REWRITE_TAC[th; REAL_LEBESGUE_MEASURABLE_INTERVAL]) THEN
4202       REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_REAL_INTERVAL] THEN
4203       REAL_ARITH_TAC;
4204       MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
4205       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4206       REPEAT STRIP_TAC THEN
4207       MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4208       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4209       REAL_DIFFERENTIABLE_TAC;
4210       SUBGOAL_THEN `{x | sin(x / &2) = &0} = IMAGE (\n. &2 * pi * n) integer`
4211       SUBST1_TAC THENL
4212        [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
4213         REWRITE_TAC[IN_ELIM_THM; SIN_EQ_0; REAL_ARITH
4214          `y / &2 = n * pi <=> &2 * pi * n = y`] THEN
4215         REWRITE_TAC[PI_NZ; REAL_RING
4216           `&2 * pi * m = &2 * pi * n <=> pi = &0 \/ m = n`] THEN
4217         MESON_TAC[IN];
4218         MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN
4219         MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]];
4220     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
4221     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN
4222     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ABS;
4223                  ABSOLUTELY_REAL_INTEGRABLE_SUB];
4224     X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
4225     STRIP_TAC THEN COND_CASES_TAC THENL
4226      [REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ABS_NUM] THEN
4227       MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC;
4228       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[real_div] THEN
4229       REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
4230       REWRITE_TAC[REAL_ABS_POS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4231       ASM_REAL_ARITH_TAC]]);;
4232
4233 let RIEMANN_LOCALIZATION_INTEGRAL_RANGE = prove
4234  (`!d f.
4235         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4236         &0 < d /\ d <= pi
4237         ==> ((\n. real_integral (real_interval[--pi,pi])
4238                                 (\x. dirichlet_kernel n x * f(x)) -
4239                   real_integral (real_interval[--d,d])
4240                                 (\x. dirichlet_kernel n x * f(x)))
4241              ---> &0) sequentially`,
4242   REPEAT STRIP_TAC THEN MP_TAC
4243    (ISPECL[`d:real`; `f:real->real`;
4244            `\x. if x IN real_interval[--d,d] then f x else &0`]
4245      RIEMANN_LOCALIZATION_INTEGRAL) THEN
4246   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
4247    [CONJ_TAC THENL
4248      [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN
4249       REWRITE_TAC[MESON[] `(if p then if q then x else y else y) =
4250                            (if p /\ q then x else y)`] THEN
4251       REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; GSYM IN_INTER] THEN
4252       REWRITE_TAC[INTER; IN_REAL_INTERVAL] THEN
4253       ASM_SIMP_TAC[REAL_ARITH
4254        `&0 < d /\ d <= pi
4255         ==> ((--pi <= x /\ x <= pi) /\ --d <= x /\ x <= d <=>
4256              --d <= x /\ x <= d)`] THEN
4257       REWRITE_TAC[GSYM real_interval] THEN
4258       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4259         ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN
4260       REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
4261       REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC];
4262     REWRITE_TAC[MESON[REAL_MUL_RZERO]
4263      `a * (if p then b else &0) = if p then a * b else &0`] THEN
4264     SUBGOAL_THEN `real_interval[--d,d] SUBSET real_interval[--pi,pi]`
4265     MP_TAC THENL
4266      [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
4267       DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_INTEGRAL_RESTRICT th])]]);;
4268
4269 let RIEMANN_LOCALIZATION = prove
4270  (`!t d c f g.
4271         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4272         g absolutely_real_integrable_on real_interval[--pi,pi] /\
4273         (!x. f(x + &2 * pi) = f(x)) /\ (!x. g(x + &2 * pi) = g(x)) /\
4274         &0 < d /\ (!x. abs(x - t) < d ==> f x = g x)
4275         ==> (((\n. sum (0..n)
4276                        (\k. fourier_coefficient f k * trigonometric_set k t))
4277               ---> c) sequentially <=>
4278              ((\n. sum (0..n)
4279                        (\k. fourier_coefficient g k * trigonometric_set k t))
4280               ---> c) sequentially)`,
4281   REPEAT STRIP_TAC THEN
4282   ASM_SIMP_TAC[FOURIER_SUM_LIMIT_DIRICHLET_KERNEL] THEN
4283   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4284   MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN
4285   REWRITE_TAC[] THEN MATCH_MP_TAC RIEMANN_LOCALIZATION_INTEGRAL THEN
4286   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
4287    [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4288     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
4289     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
4290     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4291     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
4292     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
4293     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4294     ASM_REAL_ARITH_TAC]);;
4295
4296 (* ------------------------------------------------------------------------- *)
4297 (* Localize the earlier integral.                                            *)
4298 (* ------------------------------------------------------------------------- *)
4299
4300 let RIEMANN_LOCALIZATION_INTEGRAL_RANGE_HALF = prove
4301  (`!d f.
4302         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4303         &0 < d /\ d <= pi
4304         ==> ((\n. real_integral (real_interval[&0,pi])
4305                                 (\x. dirichlet_kernel n x * (f(x) + f(--x))) -
4306                   real_integral (real_interval[&0,d])
4307                                 (\x. dirichlet_kernel n x * (f(x) + f(--x))))
4308              ---> &0) sequentially`,
4309   REPEAT STRIP_TAC THEN MP_TAC
4310    (SPECL [`d:real`; `f:real->real`] RIEMANN_LOCALIZATION_INTEGRAL_RANGE) THEN
4311   MP_TAC(GEN `n:num` (ISPECL [`f:real->real`; `n:num`]
4312     ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL)) THEN
4313   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
4314   SUBGOAL_THEN
4315    `!n. (\x. dirichlet_kernel n x * f x) absolutely_real_integrable_on
4316         real_interval[--d,d]`
4317   ASSUME_TAC THENL
4318    [X_GEN_TAC `n:num` THEN
4319     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4320       ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL) o SPEC `n:num`) THEN
4321     REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
4322     ASM_SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD;
4323                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
4324     REWRITE_TAC[DIRICHLET_KERNEL_NEG; GSYM REAL_ADD_LDISTRIB]]);;
4325
4326 let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART = prove
4327  (`!f t l d.
4328         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4329         (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ d <= pi
4330         ==> (((\n. sum (0..n)
4331                        (\k. fourier_coefficient f k * trigonometric_set k t))
4332               ---> l) sequentially <=>
4333             ((\n. real_integral (real_interval[&0,d])
4334                                 (\x. dirichlet_kernel n x *
4335                                      ((f(t + x) + f(t - x)) - &2 * l)))
4336              ---> &0) sequentially)`,
4337   REPEAT STRIP_TAC THEN
4338   ASM_SIMP_TAC[FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_HALF] THEN
4339   MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN
4340   REWRITE_TAC[REAL_ARITH `(x + y) - &2 * l = (x - l) + (y - l)`] THEN
4341   MP_TAC(MESON[real_sub] `!x. (f:real->real)(t - x) = f(t + --x)`) THEN
4342   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
4343    MATCH_MP_TAC RIEMANN_LOCALIZATION_INTEGRAL_RANGE_HALF THEN
4344   ASM_REWRITE_TAC[] THEN
4345   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN
4346   REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
4347   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4348   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
4349   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]);;
4350
4351 (* ------------------------------------------------------------------------- *)
4352 (* Make a harmless simplifying tweak to the Dirichlet kernel.                *)
4353 (* ------------------------------------------------------------------------- *)
4354
4355 let REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND = prove
4356  (`!f n s. real_integral s (\x. dirichlet_kernel n x * f x) =
4357            real_integral s (\x. sin((&n + &1 / &2) * x) / (&2 * sin(x / &2)) *
4358                                 f x)`,
4359   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
4360   EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN
4361   SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);;
4362
4363 let REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND = prove
4364  (`!f n s. (\x. dirichlet_kernel n x * f x) real_integrable_on s <=>
4365            (\x. sin((&n + &1 / &2) * x) / (&2 * sin(x / &2)) * f x)
4366            real_integrable_on s`,
4367   REPEAT STRIP_TAC THEN EQ_TAC THEN
4368   MATCH_MP_TAC REAL_INTEGRABLE_SPIKE THEN
4369   EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN
4370   SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);;
4371
4372 let FOURIER_SUM_LIMIT_SINE_PART = prove
4373  (`!f t l d.
4374         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4375         (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ d <= pi
4376         ==> (((\n. sum (0..n)
4377                        (\k. fourier_coefficient f k * trigonometric_set k t))
4378               ---> l) sequentially <=>
4379             ((\n. real_integral (real_interval[&0,d])
4380                                 (\x. sin((&n + &1 / &2) * x) *
4381                                      ((f(t + x) + f(t - x)) - &2 * l) / x))
4382              ---> &0) sequentially)`,
4383   let lemma0 = prove
4384    (`!x. abs(sin(x) - x) <= abs(x) pow 3`,
4385     GEN_TAC THEN MP_TAC(ISPECL [`0`; `Cx x`] TAYLOR_CSIN) THEN
4386     REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN
4387     CONV_TAC NUM_REDUCE_CONV THEN
4388     REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; IM_CX] THEN
4389     REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_ABS_0] THEN
4390     REWRITE_TAC[REAL_EXP_0; REAL_MUL_LID] THEN REAL_ARITH_TAC) in
4391   let lemma1 = prove
4392    (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= x pow 2`,
4393     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
4394     MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs x` THEN
4395     REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM(CONJUNCT2 real_pow)] THEN
4396     ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; ARITH] THEN
4397     ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; REAL_MUL_RID] THEN
4398     REWRITE_TAC[lemma0]) in
4399   let lemma2 = prove
4400    (`!x. abs(x) <= &1 / &2  ==> abs(x) / &2 <= abs(sin x)`,
4401     REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` lemma0) THEN
4402     MATCH_MP_TAC(REAL_ARITH
4403       `&4 * x3 <= abs x ==> abs(s - x) <= x3 ==> abs(x) / &2 <= abs s`) THEN
4404     REWRITE_TAC[REAL_ARITH
4405      `&4 * x pow 3 <= x <=> x * x pow 2 <= x * (&1 / &2) pow 2`] THEN
4406     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
4407     ASM_REAL_ARITH_TAC) in
4408   let lemma3 = prove
4409    (`!x. ~(x = &0) /\ abs x <= &1 / &2
4410          ==> abs(inv(sin x) - inv x) <= &2 * abs x`,
4411     REPEAT STRIP_TAC THEN
4412     MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(sin x)` THEN
4413     REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ASM_CASES_TAC `sin x = &0` THENL
4414      [MP_TAC(SPEC `x:real` SIN_EQ_0_PI) THEN
4415       MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC;
4416       ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_SUB_LDISTRIB; REAL_MUL_RINV] THEN
4417       REWRITE_TAC[REAL_ARITH `abs(&1 - s * inv x) = abs(s / x - &1)`] THEN
4418       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(x:real) pow 2` THEN
4419       ASM_SIMP_TAC[lemma1] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
4420       REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN
4421       MATCH_MP_TAC REAL_LE_RMUL THEN
4422       MP_TAC(ISPEC `x:real` lemma2) THEN ASM_REAL_ARITH_TAC]) in
4423   REPEAT STRIP_TAC THEN
4424   MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `d:real`]
4425         FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART) THEN
4426   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4427   MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN
4428   MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN
4429   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
4430         ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
4431   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN
4432   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN
4433   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
4434   GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN
4435   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
4436    [GSYM REAL_INTEGRABLE_REFLECT] THEN
4437   REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN
4438   REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN EXISTS_TAC
4439    `\n. real_integral (real_interval[&0,d])
4440                       (\x. sin((&n + &1 / &2) * x) *
4441                            (inv(&2 * sin(x / &2)) - inv x) *
4442                            ((f(t + x) + f(t - x)) - &2 * l))` THEN
4443   REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL
4444    [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
4445     REWRITE_TAC[REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND] THEN
4446     REWRITE_TAC[REAL_ARITH
4447      `a * (inv y - inv x) * b:real = a / y * b - a / x * b`] THEN
4448     REWRITE_TAC[REAL_ARITH `sin(y) * (a - b) / x = sin(y) / x * (a - b)`] THEN
4449     MATCH_MP_TAC REAL_INTEGRAL_SUB THEN CONJ_TAC THENL
4450      [REWRITE_TAC[GSYM REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND] THEN
4451       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
4452       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
4453       EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL
4454       [ALL_TAC; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC] THEN
4455       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THEN
4456       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD;
4457                    ABSOLUTELY_REAL_INTEGRABLE_SUB;
4458                    ABSOLUTELY_REAL_INTEGRABLE_CONST];
4459       MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN
4460       EXISTS_TAC `\x. dirichlet_kernel n x * (&2 * sin(x / &2)) / x *
4461                       ((f(t + x) + f(t - x)) - &2 * l)` THEN
4462       EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN
4463       CONJ_TAC THENL
4464        [X_GEN_TAC `x:real` THEN
4465         REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL; REAL_MUL_ASSOC] THEN
4466         STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4467         ASM_REWRITE_TAC[dirichlet_kernel] THEN
4468         MATCH_MP_TAC(REAL_FIELD
4469          `~(x = &0) /\ ~(y = &0) ==> a / x = a / (&2 * y) * (&2 * y) / x`) THEN
4470         MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC;
4471         MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
4472         MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
4473         EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL
4474          [ALL_TAC;
4475           REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC] THEN
4476         MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THEN
4477         MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
4478         ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD;
4479                      ABSOLUTELY_REAL_INTEGRABLE_SUB;
4480                      ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
4481         CONJ_TAC THENL
4482          [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN
4483           REWRITE_TAC[REAL_NEGLIGIBLE_SING; SING_GSPEC] THEN
4484           CONJ_TAC THEN MATCH_MP_TAC
4485             REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN
4486           REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN
4487           REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4488           REPEAT STRIP_TAC THEN
4489           MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4490           MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4491           REAL_DIFFERENTIABLE_TAC;
4492           ALL_TAC]]] THEN
4493     SUBGOAL_THEN `real_bounded (IMAGE (\x. &1 + (x / &2) pow 2)
4494                                       (real_interval[--pi,pi]))`
4495     MP_TAC THENL
4496      [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
4497       MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN
4498       REWRITE_TAC[REAL_COMPACT_INTERVAL] THEN
4499       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4500       REPEAT STRIP_TAC THEN
4501       MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4502       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4503       REAL_DIFFERENTIABLE_TAC;
4504       REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN
4505       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN
4506       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN
4507       ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN
4508       ASM_CASES_TAC `x = &0` THENL
4509        [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RID] THEN
4510         ASM_REAL_ARITH_TAC;
4511         REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN
4512         MATCH_MP_TAC(REAL_ARITH
4513          `abs(z - &1) <= y ==> abs(&1 + y) <= B ==> abs(z) <= B`) THEN
4514         ASM_SIMP_TAC[REAL_FIELD
4515           `~(x = &0) ==> (&2 * y) / x = y / (x / &2)`] THEN
4516         MATCH_MP_TAC lemma1 THEN ASM_REAL_ARITH_TAC]];
4517
4518     SUBGOAL_THEN `real_interval[&0,d] SUBSET real_interval[--pi,pi]`
4519     MP_TAC THENL
4520      [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
4521       DISCH_THEN(fun th -> REWRITE_TAC
4522        [GSYM(MATCH_MP REAL_INTEGRAL_RESTRICT th)])] THEN
4523     REWRITE_TAC[MESON[REAL_MUL_LZERO; REAL_MUL_RZERO]
4524      `(if p x then a x * b x * c x else &0) =
4525       a x * (if p x then b x else &0) * c x`] THEN
4526     MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN
4527     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
4528     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD;
4529                  ABSOLUTELY_REAL_INTEGRABLE_SUB;
4530                  ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
4531     CONJ_TAC THENL
4532      [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN
4533       REWRITE_TAC[REAL_MEASURABLE_ON_0; SET_RULE `{x | x IN s} = s`;
4534                   REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN
4535       MATCH_MP_TAC REAL_MEASURABLE_ON_SUB THEN CONJ_TAC THEN
4536       GEN_REWRITE_TAC (LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[] THEN
4537       ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN
4538       MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN
4539       SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET;
4540                REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST;
4541                REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING;
4542                REAL_CLOSED_UNIV] THEN
4543       CONJ_TAC THENL
4544        [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
4545         REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4546         REPEAT STRIP_TAC THEN
4547         MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4548         MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4549         REAL_DIFFERENTIABLE_TAC;
4550         REWRITE_TAC[REAL_ARITH `&2 * x = &0 <=> x = &0`] THEN
4551         REWRITE_TAC[REAL_SIN_X2_ZEROS] THEN
4552         MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN
4553         MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]];
4554       ALL_TAC] THEN
4555     SUBGOAL_THEN
4556      `real_bounded(IMAGE (\x. inv (&2 * sin (x / &2)) - inv x)
4557                          (real_interval[--pi,-- &1] UNION
4558                           real_interval[&1,pi]))`
4559     MP_TAC THENL
4560      [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
4561       MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN
4562       SIMP_TAC[REAL_COMPACT_INTERVAL; REAL_COMPACT_UNION] THEN
4563       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4564       REPEAT STRIP_TAC THEN
4565       MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4566       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4567       REAL_DIFFERENTIABLE_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN
4568       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
4569       REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC;
4570       ALL_TAC] THEN
4571     REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN
4572     REWRITE_TAC[IN_REAL_INTERVAL; IN_UNION] THEN
4573     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
4574     EXISTS_TAC `max B (&2)` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
4575     X_GEN_TAC `x:real` THEN STRIP_TAC THEN
4576     COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
4577     ASM_CASES_TAC `abs(x) <= &1` THENL
4578      [ALL_TAC;
4579       MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN
4580       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC] THEN
4581     ASM_CASES_TAC `x = &0` THENL
4582      [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_INV_0; SIN_0] THEN
4583       ASM_REAL_ARITH_TAC;
4584       ALL_TAC] THEN
4585     REWRITE_TAC[REAL_INV_MUL] THEN
4586     MATCH_MP_TAC(REAL_ARITH
4587      `abs(is - &2 * ix) <= &1 ==> abs(inv(&2) * is - ix) <= max B (&2)`) THEN
4588     REWRITE_TAC[GSYM real_div] THEN
4589     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV)
4590      [GSYM REAL_INV_DIV] THEN
4591     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * abs(x / &2)` THEN
4592     CONJ_TAC THENL [MATCH_MP_TAC lemma3; ASM_REAL_ARITH_TAC] THEN
4593     ASM_REAL_ARITH_TAC]);;
4594
4595 (* ------------------------------------------------------------------------- *)
4596 (* Dini's test.                                                              *)
4597 (* ------------------------------------------------------------------------- *)
4598
4599 let FOURIER_DINI_TEST = prove
4600  (`!f t l d.
4601         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4602         (!x. f (x + &2 * pi) = f x) /\
4603         &0 < d /\
4604         (\x. abs((f(t + x) + f(t - x)) - &2 * l) / x)
4605         real_integrable_on real_interval[&0,d]
4606         ==> ((\n. sum (0..n)
4607                       (\k. fourier_coefficient f k * trigonometric_set k t))
4608              ---> l) sequentially`,
4609   REPEAT STRIP_TAC THEN
4610   MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `pi`]
4611                 FOURIER_SUM_LIMIT_SINE_PART) THEN
4612   ASM_REWRITE_TAC[PI_POS; REAL_LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN
4613   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4614   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT) THEN
4615   REWRITE_TAC[real_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN
4616   ASM_SIMP_TAC[IN_REAL_INTERVAL; REAL_LE_REFL; REAL_LT_IMP_LE] THEN
4617   SIMP_TAC[REAL_INTEGRAL_NULL; REAL_LE_REFL] THEN
4618   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
4619   DISCH_THEN(X_CHOOSE_THEN `k:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4620   ABBREV_TAC `dd = min d (min (k / &2) pi)` THEN
4621   DISCH_THEN(MP_TAC o SPEC `dd:real`) THEN
4622   REWRITE_TAC[REAL_SUB_RZERO] THEN ANTS_TAC THENL
4623    [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4624   SUBGOAL_THEN `&0 < dd /\ dd <= d /\ dd <= pi /\ dd < k`
4625   STRIP_ASSUME_TAC THENL
4626    [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4627   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
4628       ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
4629   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN
4630   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN
4631   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
4632   GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN
4633   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
4634    [GSYM REAL_INTEGRABLE_REFLECT] THEN
4635   REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN
4636   REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN
4637   SUBGOAL_THEN
4638    `(\x. ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on
4639     real_interval[&0,dd]`
4640   ASSUME_TAC THENL
4641    [REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE] THEN CONJ_TAC THENL
4642      [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN
4643       SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET;
4644                REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST;
4645                REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING;
4646                REAL_CLOSED_UNIV] THEN
4647       MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
4648       MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
4649       MAP_EVERY EXISTS_TAC [`--pi`; `pi`] THEN
4650       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
4651                    REAL_INTEGRABLE_ADD; REAL_INTEGRABLE_SUB;
4652                    REAL_INTEGRABLE_CONST] THEN
4653       REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
4654       MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
4655       MAP_EVERY EXISTS_TAC [`&0:real`; `d:real`] THEN CONJ_TAC THENL
4656        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE
4657          [TAUT `p ==> q ==> r <=> q ==> p ==> r`]
4658                 REAL_INTEGRABLE_SPIKE)) THEN
4659         EXISTS_TAC `{}:real->bool` THEN REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY] THEN
4660         SIMP_TAC[REAL_ABS_DIV; IN_REAL_INTERVAL; IN_DIFF] THEN
4661         SIMP_TAC[real_abs];
4662         REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]];
4663     ALL_TAC] THEN
4664   SUBGOAL_THEN
4665    `(\x. ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on
4666     real_interval[dd,pi]`
4667   ASSUME_TAC THENL
4668    [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
4669     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
4670     REPEAT CONJ_TAC THENL
4671      [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[] THEN
4672       ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN
4673       MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN
4674       SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET;
4675                REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST;
4676                REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING;
4677                REAL_CLOSED_UNIV];
4678       REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN
4679       EXISTS_TAC `inv dd:real` THEN X_GEN_TAC `x:real` THEN
4680       REWRITE_TAC[IN_REAL_INTERVAL; REAL_ABS_INV] THEN STRIP_TAC THEN
4681       MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC;
4682       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
4683       EXISTS_TAC `real_interval[--pi,pi]` THEN
4684       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD;
4685                    ABSOLUTELY_REAL_INTEGRABLE_SUB;
4686                    ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
4687       REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC];
4688     ALL_TAC] THEN
4689   SUBGOAL_THEN
4690    `(!n. (\x. sin((&n + &1 / &2) * x) *
4691            ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on
4692          real_interval[&0,dd]) /\
4693     (!n. (\x. sin((&n + &1 / &2) * x) *
4694           ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on
4695          real_interval[dd,pi])`
4696   STRIP_ASSUME_TAC THENL
4697    [REPEAT STRIP_TAC THEN
4698     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
4699     ASM_REWRITE_TAC[] THEN
4700     (CONJ_TAC THENL
4701       [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN
4702        REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN
4703        REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4704        REPEAT STRIP_TAC THEN
4705        MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
4706        MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4707        REAL_DIFFERENTIABLE_TAC;
4708        REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN
4709        EXISTS_TAC `&1` THEN REWRITE_TAC[SIN_BOUND]]);
4710     ALL_TAC] THEN
4711   REPEAT STRIP_TAC THEN
4712   MP_TAC(ISPEC `\x. if abs x < dd then &0
4713                     else ((f:real->real)(t + x) - l) / x`
4714      RIEMANN_LEBESGUE_SIN_HALF) THEN
4715   SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD;
4716            ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
4717            FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN
4718   ANTS_TAC THENL
4719    [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN
4720     REWRITE_TAC[MESON[] `(if P x then if Q x then &0 else a x else &0) =
4721                          (if P x /\ ~Q x then a x else &0)`] THEN
4722     REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
4723     REWRITE_TAC[MESON[REAL_MUL_RZERO; REAL_MUL_LZERO]
4724     `(if P x /\ Q x then a x * b x else &0) =
4725      (if Q x then a x else &0) * (if P x then b x else &0)`] THEN
4726     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
4727     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV;
4728                  ABSOLUTELY_REAL_INTEGRABLE_SUB;
4729                  ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
4730     CONJ_TAC THENL
4731      [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN
4732       REWRITE_TAC[REAL_MEASURABLE_ON_0] THEN CONJ_TAC THENL
4733        [REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN
4734         REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_COMPL] THEN
4735         REWRITE_TAC[REAL_ARITH `abs x < d <=> --d < x /\ x < d`] THEN
4736         REWRITE_TAC[GSYM real_interval; REAL_LEBESGUE_MEASURABLE_INTERVAL];
4737         GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[] THEN
4738         ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN
4739         MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN
4740         SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET;
4741                  REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST;
4742                  REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING;
4743                  REAL_CLOSED_UNIV]];
4744       REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_UNIV] THEN
4745       EXISTS_TAC `inv dd:real` THEN X_GEN_TAC `x:real` THEN
4746       REWRITE_TAC[REAL_NOT_LT] THEN COND_CASES_TAC THEN
4747       ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_ABS_NUM;
4748                    REAL_ABS_INV] THEN
4749       MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC];
4750     ALL_TAC] THEN
4751   REWRITE_TAC[REAL_ABS_NEG; REAL_MUL_RNEG; SIN_NEG; REAL_MUL_LNEG] THEN
4752   REWRITE_TAC[GSYM real_sub; GSYM REAL_SUB_LDISTRIB] THEN
4753   REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN
4754   REWRITE_TAC[REAL_ARITH
4755    `(if p then &0 else a) - (if p then &0 else --b) =
4756     (if p then &0 else a + b)`] THEN
4757   REWRITE_TAC[GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN
4758   REWRITE_TAC[MESON[REAL_MUL_RZERO]
4759    `s * (if p then &0 else y) = (if ~p then s * y else &0)`] THEN
4760   ONCE_REWRITE_TAC[GSYM REAL_INTEGRAL_RESTRICT_UNIV] THEN
4761   REWRITE_TAC[MESON[]
4762    `(if p then if q then x else &0 else &0) =
4763     (if p /\ q then x else &0)`] THEN
4764   REWRITE_TAC[IN_REAL_INTERVAL] THEN
4765   ASM_SIMP_TAC[REAL_ARITH
4766    `&0 < dd /\ dd <= pi
4767     ==> ((&0 <= x /\ x <= pi) /\ ~(abs x < dd) <=>
4768          dd <= x /\ x <= pi)`] THEN
4769   REWRITE_TAC[GSYM IN_REAL_INTERVAL; REAL_INTEGRAL_RESTRICT_UNIV] THEN
4770   REWRITE_TAC[REAL_ARITH `(x - l) + (y - l) = (x + y) - &2 * l`] THEN
4771   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
4772   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
4773   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
4774   X_GEN_TAC `n:num` THEN DISCH_TAC THEN
4775   FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
4776   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
4777    `real_integral(real_interval[&0,dd]) f +
4778     real_integral(real_interval[dd,pi]) f =
4779     real_integral(real_interval[&0,pi]) f /\
4780     abs(real_integral(real_interval[&0,dd]) f) < e / &2
4781     ==> abs(real_integral(real_interval[dd,pi]) f - &0) < e / &2
4782         ==> abs(real_integral(real_interval[&0,pi]) f) < e`) THEN
4783   CONJ_TAC THENL
4784    [MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN
4785     REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
4786     MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `dd:real` THEN
4787     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_LT_IMP_LE];
4788     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4789      `abs x < e / &2 ==> abs y <= x ==> abs y < e / &2`)) THEN
4790     MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN
4791     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
4792     CONJ_TAC THENL
4793      [MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
4794       MAP_EVERY EXISTS_TAC [`&0`; `d:real`] THEN
4795       ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
4796       X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
4797       SIMP_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ARITH
4798         `&0 <= x ==> abs x = x`] THEN
4799       REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
4800       MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN
4801       ONCE_REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN
4802       MATCH_MP_TAC REAL_LE_RMUL THEN
4803       REWRITE_TAC[REAL_ABS_POS; SIN_BOUND]]]);;
4804
4805 (* ------------------------------------------------------------------------- *)
4806 (* Convergence for functions of bounded variation.                           *)
4807 (* ------------------------------------------------------------------------- *)
4808
4809 let REAL_INTEGRAL_SIN_OVER_X_BOUND = prove
4810  (`!a b c.
4811        &0 <= a /\ &0 < c
4812        ==> (\x. sin(c * x) / x) real_integrable_on real_interval[a,b] /\
4813            abs(real_integral (real_interval[a,b]) (\x. sin(c * x) / x)) <= &4`,
4814   let lemma0 = prove
4815    (`!a b. (\x. sin x) real_integrable_on (real_interval[a,b]) /\
4816            abs(real_integral (real_interval[a,b]) (\x. sin x)) <= &2`,
4817     REPEAT GEN_TAC THEN ASM_CASES_TAC `a <= b` THENL
4818      [MP_TAC(ISPECL [`\x. --(cos x)`; `\x. sin x`; `a:real`; `b:real`]
4819         REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
4820       REWRITE_TAC[] THEN ANTS_TAC THENL
4821        [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
4822         REAL_ARITH_TAC;
4823         REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN
4824         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
4825          `abs x <= &1 /\ abs y <= &1 ==> abs(--y - --x) <= &2`) THEN
4826         REWRITE_TAC[COS_BOUND]];
4827       RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4828       ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE;
4829                    REAL_ABS_NUM; REAL_POS]]) in
4830   let lemma1 = prove
4831    (`!a b. &0 < a
4832            ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\
4833                abs(real_integral (real_interval[a,b])
4834                                  (\x. sin x / x)) <= &4 / a`,
4835     REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a <= b` THENL
4836      [MP_TAC(ISPECL [`\x. sin x`; `\x:real. --(inv x)`; `a:real`; `b:real`]
4837               REAL_SECOND_MEAN_VALUE_THEOREM_FULL) THEN
4838       ASM_REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; lemma0] THEN
4839       ANTS_TAC THENL
4840        [REWRITE_TAC[REAL_LE_NEG2; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
4841         MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC;
4842         DISCH_THEN(X_CHOOSE_THEN `c:real`
4843          (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4844         DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_NEG) THEN
4845         REWRITE_TAC[REAL_ARITH `--(--(inv y) * x):real = x / y`] THEN
4846         REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN
4847         ASM_REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_NEG_NEG] THEN
4848         MATCH_MP_TAC(REAL_ARITH
4849          `inv b <= inv a /\ abs x <= inv a * &2 /\ abs y <= inv b * &2
4850           ==> abs(x + y) <= &4 / a`) THEN
4851         ASM_SIMP_TAC[REAL_LE_INV2; REAL_ABS_MUL] THEN CONJ_TAC THEN
4852         MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; lemma0] THEN
4853         ASM_REWRITE_TAC[real_abs; REAL_LE_REFL; REAL_LE_INV_EQ] THEN
4854         ASM_REAL_ARITH_TAC];
4855       RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4856       ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE;
4857                    REAL_ABS_NUM; REAL_POS] THEN
4858       MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC]) in
4859   let lemma2 = prove
4860    (`!x. &0 <= x ==> sin(x) <= x`,
4861     REPEAT STRIP_TAC THEN ASM_CASES_TAC `x <= &1` THENL
4862      [ALL_TAC; ASM_MESON_TAC[SIN_BOUNDS; REAL_LE_TOTAL; REAL_LE_TRANS]] THEN
4863     MP_TAC(ISPECL [`1`; `Cx x`] TAYLOR_CSIN) THEN
4864     CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN
4865     REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN
4866     CONV_TAC NUM_REDUCE_CONV THEN
4867     REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV; GSYM CX_NEG;
4868                 GSYM CX_ADD; GSYM CX_SUB] THEN
4869     REWRITE_TAC[COMPLEX_NORM_CX; IM_CX; REAL_ABS_0; REAL_EXP_0] THEN
4870     SIMP_TAC[REAL_POW_1; REAL_DIV_1; real_pow;
4871              REAL_MUL_LNEG; REAL_MUL_LID] THEN
4872     MATCH_MP_TAC(REAL_ARITH
4873      `e <= t ==> abs(sin x - (x + --t)) <= e ==> sin x <= x`) THEN
4874     ASM_REWRITE_TAC[real_abs; REAL_ARITH
4875      `x pow 5 / &24 <= x pow 3 / &6 <=>
4876       x pow 3 * x pow 2 <= x pow 3 * &2 pow 2`] THEN
4877     MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_POW_LE] THEN
4878     REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC) in
4879   let lemma3 = prove
4880    (`!x. &0 <= x /\ x <= &2 ==> abs(sin x / x) <= &1`,
4881     GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL
4882      [ASM_SIMP_TAC[real_div; REAL_MUL_RZERO; REAL_INV_0;
4883                    REAL_ABS_NUM; REAL_POS];
4884       ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_MUL_LID;
4885                    REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < abs x`] THEN
4886       MATCH_MP_TAC(REAL_ARITH `s <= x /\ &0 <= s ==> abs s <= abs x`) THEN
4887       ASM_SIMP_TAC[lemma2] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN
4888       MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC]) in
4889   let lemma4 = prove
4890    (`!a b. &0 <= a /\ b <= &2
4891            ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\
4892                abs(real_integral (real_interval[a,b])
4893                                  (\x. sin x / x)) <= &2`,
4894     REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL
4895      [MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
4896        [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
4897         EXISTS_TAC `(\x. &1):real->real` THEN
4898         REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL
4899          [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL
4900            [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
4901             GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[lemma0];
4902             MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN
4903             REWRITE_TAC[REAL_CONTINUOUS_ON_ID];
4904             REWRITE_TAC[SING_GSPEC; REAL_NEGLIGIBLE_SING]];
4905           REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
4906           MATCH_MP_TAC lemma3 THEN ASM_REAL_ARITH_TAC];
4907         DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
4908         EXISTS_TAC `real_integral (real_interval [a,b]) (\x. &1)` THEN
4909         CONJ_TAC THENL
4910          [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN
4911           ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN
4912           REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
4913           MATCH_MP_TAC lemma3 THEN ASM_REAL_ARITH_TAC;
4914           ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN ASM_REAL_ARITH_TAC]];
4915       RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4916       ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE;
4917                    REAL_ABS_NUM; REAL_POS]]) in
4918   let lemma5 = prove
4919    (`!a b. &0 <= a
4920            ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\
4921                abs(real_integral (real_interval[a,b]) (\x. sin x / x)) <= &4`,
4922     REPEAT GEN_TAC THEN DISCH_TAC THEN
4923     ASM_CASES_TAC `b <= &2` THENL
4924      [ASM_MESON_TAC[lemma4; REAL_ARITH `x <= &2 ==> x <= &4`]; ALL_TAC] THEN
4925     ASM_CASES_TAC `&2 <= a` THENL
4926      [MP_TAC(SPECL [`a:real`; `b:real`] lemma1) THEN
4927       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4928       MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
4929       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
4930       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&2 <= a ==> &0 < a`] THEN
4931       ASM_REAL_ARITH_TAC;
4932       ALL_TAC] THEN
4933     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4934     MP_TAC(ISPECL [`\x. sin x / x`; `a:real`; `b:real`; `&2`]
4935           REAL_INTEGRABLE_COMBINE) THEN
4936     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL
4937      [CONJ_TAC THENL
4938        [ASM_MESON_TAC[lemma4; REAL_LE_REFL];
4939         ASM_MESON_TAC[lemma1; REAL_ARITH `&0 < &2`]];
4940       DISCH_TAC] THEN
4941     MP_TAC(ISPECL [`\x. sin x / x`; `a:real`; `b:real`; `&2`]
4942           REAL_INTEGRAL_COMBINE) THEN
4943     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4944     MATCH_MP_TAC(REAL_ARITH
4945      `abs(x) <= &2 /\ abs(y) <= &2 ==> abs(x + y) <= &4`) THEN
4946     CONJ_TAC THENL
4947      [ASM_MESON_TAC[lemma4; REAL_LE_REFL];
4948       GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &4 / &2`] THEN
4949       ASM_MESON_TAC[lemma1; REAL_ARITH `&0 < &2`]]) in
4950   REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL
4951    [MP_TAC(ISPECL [`c * a:real`; `c * b:real`] lemma5) THEN
4952     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN
4953     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4954     GEN_REWRITE_TAC LAND_CONV [HAS_REAL_INTEGRAL_INTEGRAL] THEN
4955     DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4956      HAS_REAL_INTEGRAL_STRETCH)) THEN
4957     ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ADD_RID; REAL_SUB_RZERO] THEN
4958     DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN
4959     ASM_SIMP_TAC[IMAGE_STRETCH_REAL_INTERVAL; REAL_LE_INV_EQ; REAL_LT_IMP_LE;
4960       REAL_FIELD `&0 < c ==> inv c * c * a = a`; REAL_INV_MUL; real_div;
4961       REAL_FIELD `&0 < c ==> c * s * inv c * inv x = s * inv x`;
4962       REAL_FIELD `&0 < c ==> c * inv c * i = i /\ abs c = c`] THEN
4963     REWRITE_TAC[GSYM real_div; REAL_INTERVAL_EQ_EMPTY] THEN
4964     ASM_SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LMUL_EQ] THEN
4965     REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
4966     STRIP_TAC THEN ASM_REWRITE_TAC[];
4967     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4968     ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE;
4969                  REAL_ABS_NUM; REAL_POS]]);;
4970
4971 let FOURIER_JORDAN_BOUNDED_VARIATION = prove
4972  (`!f x d.
4973         f absolutely_real_integrable_on real_interval[--pi,pi] /\
4974         (!x. f(x + &2 * pi) = f x) /\
4975         &0 < d /\
4976         f has_bounded_real_variation_on real_interval[x - d,x + d]
4977         ==> ((\n. sum (0..n)
4978                       (\k. fourier_coefficient f k * trigonometric_set k x))
4979              ---> ((reallim (atreal x within {l | l <= x}) f +
4980                     reallim (atreal x within {r | r >= x}) f) / &2))
4981             sequentially`,
4982   let lemma = prove
4983    (`!f l d. &0 < d
4984              ==> ((f ---> l) (atreal (&0) within real_interval[&0,d]) <=>
4985                   (f ---> l) (atreal (&0) within {x | &0 <= x}))`,
4986     REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_WITHINREAL_SET THEN
4987     REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `d:real` THEN
4988     ASM_REWRITE_TAC[IN_ELIM_THM; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC) in
4989   MAP_EVERY X_GEN_TAC [`f:real->real`; `t:real`; `d0:real`] THEN
4990   STRIP_TAC THEN
4991   ABBREV_TAC `s = (reallim (atreal t within {l | l <= t}) f +
4992                    reallim (atreal t within {r | r >= t}) f) / &2` THEN
4993   MP_TAC(SPECL [`f:real->real`; `t:real`; `s:real`; `min d0 pi`]
4994         FOURIER_SUM_LIMIT_SINE_PART) THEN
4995   ASM_REWRITE_TAC[REAL_LT_MIN; PI_POS; REAL_ARITH `min d0 pi <= pi`] THEN
4996   DISCH_THEN SUBST1_TAC THEN
4997   ABBREV_TAC `h = \u. ((f:real->real)(t + u) + f(t - u)) - &2 * s` THEN
4998   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
4999   SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ABBREV_TAC `d = min d0 pi` THEN
5000   SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
5001    [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5002   SUBGOAL_THEN
5003    `h has_bounded_real_variation_on real_interval[&0,d]`
5004   ASSUME_TAC THENL
5005    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
5006      [HAS_BOUNDED_REAL_VARIATION_DARBOUX]) THEN
5007     EXPAND_TAC "h" THEN REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_DARBOUX] THEN
5008     REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_REAL_INTERVAL] THEN
5009     MAP_EVERY X_GEN_TAC [`f1:real->real`; `f2:real->real`] THEN STRIP_TAC THEN
5010     EXISTS_TAC `\x. ((f1:real->real)(t + x) - f2(t - x)) - s` THEN
5011     EXISTS_TAC `\x. ((f2:real->real)(t + x) - f1(t - x)) + s` THEN
5012     ASM_REWRITE_TAC[REAL_ARITH `x - s <= y - s <=> x <= y`; REAL_LE_RADD] THEN
5013     REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
5014     REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
5015      `a <= a' /\ b' <= b ==> a - b <= a' - b'`) THEN
5016     CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
5017     ALL_TAC] THEN
5018   SUBGOAL_THEN `(h ---> &0) (atreal(&0) within {x | &0 <= x})`
5019   ASSUME_TAC THENL
5020    [EXPAND_TAC "h" THEN EXPAND_TAC "s" THEN
5021     REWRITE_TAC[REAL_ARITH
5022      `(f' + f) - &2 * (l + l') / &2 = (f - l) + (f' - l')`] THEN
5023     MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL
5024      [SUBGOAL_THEN
5025        `?l. (f ---> l) (atreal t within {l | l <= t})` MP_TAC
5026       THENL
5027        [MP_TAC(ISPECL [`f:real->real`; `t - d0:real`; `t + d0:real`; `t:real`]
5028          HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT) THEN
5029         ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
5030         ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5031         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN
5032         REWRITE_TAC[REALLIM_WITHINREAL] THEN
5033         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5034         ASM_CASES_TAC `&0 < e` THEN
5035         ASM_REWRITE_TAC[IN_REAL_INTERVAL; IN_ELIM_THM] THEN
5036         DISCH_THEN(X_CHOOSE_THEN `d1:real` (fun th ->
5037           EXISTS_TAC `min d0 d1` THEN
5038           CONJUNCTS_THEN2 ASSUME_TAC MP_TAC th)) THEN
5039         ASM_REWRITE_TAC[REAL_LT_MIN] THEN
5040         MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC;
5041         DISCH_THEN(MP_TAC o SELECT_RULE) THEN
5042         REWRITE_TAC[GSYM reallim] THEN
5043         REWRITE_TAC[REALLIM_WITHINREAL] THEN
5044         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5045         ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
5046         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN
5047         DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5048         ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
5049          X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t - x:real` th)) THEN
5050         MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
5051         REAL_ARITH_TAC];
5052       SUBGOAL_THEN
5053        `?l. (f ---> l) (atreal t within {r | r >= t})` MP_TAC
5054       THENL
5055        [MP_TAC(ISPECL [`f:real->real`; `t - d0:real`; `t + d0:real`; `t:real`]
5056          HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT) THEN
5057         ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
5058         ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5059         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN
5060         REWRITE_TAC[REALLIM_WITHINREAL] THEN
5061         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5062         ASM_CASES_TAC `&0 < e` THEN
5063         ASM_REWRITE_TAC[IN_REAL_INTERVAL; IN_ELIM_THM] THEN
5064         DISCH_THEN(X_CHOOSE_THEN `d1:real` (fun th ->
5065           EXISTS_TAC `min d0 d1` THEN
5066           CONJUNCTS_THEN2 ASSUME_TAC MP_TAC th)) THEN
5067         ASM_REWRITE_TAC[REAL_LT_MIN] THEN
5068         MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC;
5069         DISCH_THEN(MP_TAC o SELECT_RULE) THEN
5070         REWRITE_TAC[GSYM reallim] THEN
5071         REWRITE_TAC[REALLIM_WITHINREAL] THEN
5072         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5073         ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
5074         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN
5075         DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5076         ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
5077          X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t + x:real` th)) THEN
5078         MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
5079         REAL_ARITH_TAC]];
5080     ALL_TAC] THEN
5081   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5082   SUBGOAL_THEN
5083    `?k. &0 < k /\ k < d /\
5084         !n. (\x. sin ((&n + &1 / &2) * x) * h x / x)
5085             real_integrable_on real_interval[&0,k] /\
5086             abs(real_integral (real_interval[&0,k])
5087                               (\x. sin ((&n + &1 / &2) * x) * h x / x))
5088               <= e / &2`
5089   STRIP_ASSUME_TAC THENL
5090    [SUBGOAL_THEN
5091      `?h1 h2.
5092          (!x y. x IN real_interval[&0,d] /\ y IN real_interval[&0,d] /\ x <= y
5093                 ==> h1 x <= h1 y) /\
5094          (!x y. x IN real_interval[&0,d] /\ y IN real_interval[&0,d] /\ x <= y
5095                 ==> h2 x <= h2 y) /\
5096          (h1 ---> &0) (atreal (&0) within {x | &0 <= x}) /\
5097          (h2 ---> &0) (atreal (&0) within {x | &0 <= x}) /\
5098          (!x. h x = h1 x - h2 x)`
5099     STRIP_ASSUME_TAC THENL
5100      [MP_TAC(ISPECL [`h:real->real`; `&0`; `d:real`]
5101           HAS_BOUNDED_REAL_VARIATION_DARBOUX) THEN
5102       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5103       MAP_EVERY X_GEN_TAC [`h1:real->real`; `h2:real->real`] THEN
5104       STRIP_TAC THEN
5105       MP_TAC(ISPECL [`h1:real->real`; `&0`; `d:real`; `&0`]
5106            INCREASING_RIGHT_LIMIT) THEN
5107       ASM_REWRITE_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN
5108       ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN
5109       DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN
5110       MP_TAC(ISPECL [`h2:real->real`; `&0`; `d:real`; `&0`]
5111            INCREASING_RIGHT_LIMIT) THEN
5112       ASM_REWRITE_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN
5113       ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN
5114       DISCH_THEN(X_CHOOSE_TAC `l':real`) THEN
5115       SUBGOAL_THEN `l':real = l` SUBST_ALL_TAC THENL
5116        [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
5117         MATCH_MP_TAC(ISPEC `atreal (&0) within {x | &0 <= x}`
5118           REALLIM_UNIQUE) THEN
5119         EXISTS_TAC `h:real->real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5120          [W(MP_TAC o PART_MATCH (lhs o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o
5121             rand o snd) THEN
5122           REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN
5123           ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
5124           REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM; IN_SING] THEN
5125           EXISTS_TAC `&1` THEN REAL_ARITH_TAC;
5126           GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
5127           ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REALLIM_SUB THEN
5128           MAP_EVERY UNDISCH_TAC
5129            [`(h1 ---> l) (atreal(&0) within real_interval[&0,d])`;
5130             `(h2 ---> l') (atreal(&0) within real_interval[&0,d])`] THEN
5131           ASM_SIMP_TAC[lemma]];
5132         EXISTS_TAC `\x. (h1:real->real)(x) - l` THEN
5133         EXISTS_TAC `\x. (h2:real->real)(x) - l` THEN
5134         ASM_REWRITE_TAC[REAL_ARITH `x - l <= y - l <=> x <= y`] THEN
5135         ASM_REWRITE_TAC[GSYM REALLIM_NULL] THEN
5136         MAP_EVERY UNDISCH_TAC
5137          [`(h1 ---> l) (atreal(&0) within real_interval[&0,d])`;
5138           `(h2 ---> l) (atreal(&0) within real_interval[&0,d])`] THEN
5139         ASM_SIMP_TAC[lemma] THEN REPEAT DISCH_TAC THEN REAL_ARITH_TAC];
5140       ALL_TAC] THEN
5141     SUBGOAL_THEN
5142      `?k. &0 < k /\ k < d /\ abs(h1 k) < e / &16 /\ abs(h2 k) < e / &16`
5143     MP_TAC THENL
5144      [UNDISCH_TAC `(h2 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN
5145       UNDISCH_TAC `(h1 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN
5146       REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN
5147       DISCH_THEN(MP_TAC o SPEC `e / &16`) THEN ANTS_TAC THENL
5148        [ASM_REAL_ARITH_TAC;
5149         DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC)] THEN
5150       DISCH_THEN(MP_TAC o SPEC `e / &16`) THEN ANTS_TAC THENL
5151        [ASM_REAL_ARITH_TAC;
5152         DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC)] THEN
5153       EXISTS_TAC `min d (min k1 k2) / &2` THEN
5154       REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
5155       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
5156       ALL_TAC] THEN
5157     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN
5158     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN
5159     MP_TAC(ISPECL [`\x. sin((&n + &1 / &2) * x) / x`; `h1:real->real`;
5160                      `&0`; `k:real`; `&0`; `(h1:real->real) k`]
5161       REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN
5162     ASM_SIMP_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; REAL_LT_IMP_LE] THEN
5163     ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LE_REFL; REAL_ADD_LID;
5164                  REAL_ARITH `&0 < &n + &1 / &2`; REAL_MUL_LZERO] THEN
5165     ANTS_TAC THENL
5166      [CONJ_TAC THENL
5167        [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
5168         REPEAT STRIP_TAC THENL
5169          [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
5170           UNDISCH_TAC `(h1 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN
5171           REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN
5172           DISCH_THEN(MP_TAC o SPEC `--((h1:real->real) x)`) THEN
5173           REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
5174            [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5175           DISCH_THEN(X_CHOOSE_THEN `dd:real` MP_TAC) THEN
5176           DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5177            (MP_TAC o SPEC `min d (min x dd) / &2`)) THEN
5178           REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
5179            [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5180           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5181            `h < &0 ==> h' <= h ==> ~(abs h' < --h)`));
5182           ALL_TAC] THEN
5183         FIRST_X_ASSUM MATCH_MP_TAC THEN
5184         REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
5185         REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
5186         FIRST_X_ASSUM MATCH_MP_TAC THEN
5187         REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC];
5188       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
5189        [REAL_ARITH `h * s / x:real = s * h / x`] THEN
5190       REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
5191       DISCH_THEN(X_CHOOSE_THEN `c1:real` STRIP_ASSUME_TAC)] THEN
5192     MP_TAC(ISPECL [`\x. sin((&n + &1 / &2) * x) / x`; `h2:real->real`;
5193                      `&0`; `k:real`; `&0`; `(h2:real->real) k`]
5194       REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN
5195     ASM_SIMP_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; REAL_LT_IMP_LE] THEN
5196     ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LE_REFL; REAL_ADD_LID;
5197                  REAL_ARITH `&0 < &n + &1 / &2`; REAL_MUL_LZERO] THEN
5198     ANTS_TAC THENL
5199      [CONJ_TAC THENL
5200        [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
5201         REPEAT STRIP_TAC THENL
5202          [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
5203           UNDISCH_TAC `(h2 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN
5204           REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN
5205           DISCH_THEN(MP_TAC o SPEC `--((h2:real->real) x)`) THEN
5206           REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
5207            [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5208           DISCH_THEN(X_CHOOSE_THEN `dd:real` MP_TAC) THEN
5209           DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5210            (MP_TAC o SPEC `min d (min x dd) / &2`)) THEN
5211           REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
5212            [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5213           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5214            `h < &0 ==> h' <= h ==> ~(abs h' < --h)`));
5215           ALL_TAC] THEN
5216         FIRST_X_ASSUM MATCH_MP_TAC THEN
5217         REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
5218         REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
5219         FIRST_X_ASSUM MATCH_MP_TAC THEN
5220         REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC];
5221       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
5222        [REAL_ARITH `h * s / x:real = s * h / x`] THEN
5223       REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
5224       DISCH_THEN(X_CHOOSE_THEN `c2:real` STRIP_ASSUME_TAC)] THEN
5225     REWRITE_TAC[REAL_ARITH
5226      `s * (h - h') / x:real = s * h / x - s * h' / x`] THEN
5227     ASM_SIMP_TAC[REAL_INTEGRABLE_SUB; REAL_INTEGRAL_SUB] THEN
5228     MATCH_MP_TAC(REAL_ARITH
5229      `abs(x) <= e / &16 * &4 /\ abs(y) <= e / &16 * &4
5230       ==> abs(x - y) <= e / &2`) THEN
5231     REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN
5232     MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
5233     RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN
5234     ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LT_IMP_LE;
5235                  REAL_ARITH `&0 < &n + &1 / &2`];
5236     ALL_TAC] THEN
5237   MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`]
5238       ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN
5239   ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN
5240   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN
5241   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5242   GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN
5243   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
5244    [GSYM REAL_INTEGRABLE_REFLECT] THEN
5245   REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN
5246   REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN
5247   SUBGOAL_THEN
5248    `(\x. h x / x) absolutely_real_integrable_on real_interval[k,d]`
5249   ASSUME_TAC THENL
5250    [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
5251     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
5252     REPEAT CONJ_TAC THENL
5253      [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
5254       MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN
5255       REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN
5256       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
5257       REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN
5258       REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
5259       RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC;
5260       REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN
5261       EXISTS_TAC `inv k:real` THEN REPEAT STRIP_TAC THEN
5262       REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
5263       ASM_REAL_ARITH_TAC;
5264       EXPAND_TAC "h" THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN
5265       REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
5266       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
5267       EXISTS_TAC `real_interval[--pi,pi]` THEN
5268       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD] THEN
5269       REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC];
5270     ALL_TAC] THEN
5271   SUBGOAL_THEN
5272    `!n. (\x. sin((&n + &1 / &2) * x) * h x / x) absolutely_real_integrable_on
5273         real_interval[k,d]`
5274   ASSUME_TAC THENL
5275    [GEN_TAC THEN
5276     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
5277     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5278      [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN
5279       REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN
5280       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
5281       REPEAT STRIP_TAC THEN
5282       MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN
5283       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
5284       REAL_DIFFERENTIABLE_TAC;
5285       REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN
5286       EXISTS_TAC `&1` THEN REWRITE_TAC[SIN_BOUND]];
5287     ALL_TAC] THEN
5288   MP_TAC(ISPEC `\x. if k <= x /\ x <= d then h x / x else &0`
5289         RIEMANN_LEBESGUE_SIN_HALF) THEN
5290   REWRITE_TAC[absolutely_real_integrable_on] THEN
5291   REWRITE_TAC[MESON[REAL_ABS_NUM]
5292    `abs(if p then x else &0) = if p then abs x else &0`] THEN
5293   ONCE_REWRITE_TAC[GSYM REAL_INTEGRAL_RESTRICT_UNIV; GSYM
5294                    REAL_INTEGRABLE_RESTRICT_UNIV] THEN
5295   REWRITE_TAC[MESON[REAL_MUL_RZERO]
5296    `(if P then s * (if Q then a else &0) else &0) =
5297     (if P /\ Q then s * a else &0)`] THEN
5298   REWRITE_TAC[IN_REAL_INTERVAL] THEN
5299   REWRITE_TAC[MESON[] `(if P then if Q then x else &0 else &0) =
5300                        (if P /\ Q then x else &0)`] THEN
5301   SUBGOAL_THEN `!x. (--pi <= x /\ x <= pi) /\ k <= x /\ x <= d <=>
5302                     k <= x /\ x <= d`
5303    (fun th -> REWRITE_TAC[th])
5304   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5305   REWRITE_TAC[GSYM IN_REAL_INTERVAL; REAL_INTEGRAL_RESTRICT_UNIV;
5306               REAL_INTEGRABLE_RESTRICT_UNIV] THEN
5307   ASM_REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN
5308   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
5309   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
5310   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
5311   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
5312   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
5313   FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN
5314   MATCH_MP_TAC(REAL_ARITH
5315    `x + y = z ==> abs(x) <= e / &2 ==> abs(y) < e / &2 ==> abs(z) < e`) THEN
5316   REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN
5317   REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
5318   MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `k:real` THEN
5319   ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
5320   ASM_REAL_ARITH_TAC);;
5321
5322 let FOURIER_JORDAN_BOUNDED_VARIATION_SIMPLE = prove
5323  (`!f x. f has_bounded_real_variation_on real_interval[--pi,pi] /\
5324          (!x. f(x + &2 * pi) = f x)
5325          ==> ((\n. sum (0..n)
5326                        (\k. fourier_coefficient f k * trigonometric_set k x))
5327               ---> ((reallim (atreal x within {l | l <= x}) f +
5328                      reallim (atreal x within {r | r >= x}) f) / &2))
5329              sequentially`,
5330   REPEAT STRIP_TAC THEN MATCH_MP_TAC FOURIER_JORDAN_BOUNDED_VARIATION THEN
5331   EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL
5332    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
5333      [HAS_BOUNDED_REAL_VARIATION_DARBOUX]) THEN
5334     STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
5335     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN
5336     CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INCREASING THEN
5337     ASM_REWRITE_TAC[];
5338     SUBGOAL_THEN
5339      `!n. integer n
5340           ==> f has_bounded_real_variation_on
5341               real_interval [(&2 * n - &1) * pi,(&2 * n + &1) * pi]`
5342     ASSUME_TAC THENL
5343      [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&2 * --n * pi` o
5344        MATCH_MP HAS_BOUNDED_REAL_VARIATION_TRANSLATION) THEN
5345       REWRITE_TAC[INTEGER_NEG; GSYM REAL_INTERVAL_TRANSLATION] THEN
5346       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
5347        [REAL_PERIODIC_INTEGER_MULTIPLE]) THEN
5348       DISCH_THEN(MP_TAC o GEN `x:real` o SPECL [`x:real`; `--n:real`]) THEN
5349       ASM_REWRITE_TAC[REAL_ARITH `x + n * &2 * pi = &2 * n * pi + x`] THEN
5350       ASM_REWRITE_TAC[INTEGER_NEG] THEN DISCH_TAC THEN
5351       ASM_REWRITE_TAC[ETA_AX] THEN
5352       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
5353       REWRITE_TAC[CONS_11; PAIR_EQ] THEN REAL_ARITH_TAC;
5354       ALL_TAC] THEN
5355     SUBGOAL_THEN
5356      `!n. f has_bounded_real_variation_on
5357           real_interval[--pi,&(2 * n + 1) * pi]`
5358     ASSUME_TAC THENL
5359      [INDUCT_TAC THEN
5360       ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID] THEN
5361       MP_TAC(ISPECL [`f:real->real`; `--pi`; `&((2 + 2 * n) + 1) * pi`;
5362                      `&(2 * n + 1) * pi`]
5363         HAS_BOUNDED_REAL_VARIATION_ON_COMBINE) THEN
5364       ANTS_TAC THENL
5365        [REWRITE_TAC[REAL_ARITH `--pi = --(&1) * pi`] THEN
5366         SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_OF_NUM_LE] THEN
5367         CONJ_TAC THENL [REAL_ARITH_TAC; ARITH_TAC];
5368         DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN
5369         REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
5370         REWRITE_TAC[REAL_ARITH
5371          `(&2 * n + &1) * pi = (&2 * (n + &1) - &1) * pi`] THEN
5372         REWRITE_TAC[REAL_ARITH
5373          `((&2 + &2 * n) + &1) * pi = (&2 * (n + &1) + &1) * pi`] THEN
5374         FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED]];
5375       ALL_TAC] THEN
5376     SUBGOAL_THEN
5377      `!m n. f has_bounded_real_variation_on
5378             real_interval[--(&(2 * m + 1)) * pi,&(2 * n + 1) * pi]`
5379     ASSUME_TAC THENL
5380      [INDUCT_TAC THEN
5381       ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID; REAL_MUL_LNEG] THEN
5382       X_GEN_TAC `n:num` THEN
5383       MP_TAC(ISPECL [`f:real->real`; `--(&((2 + 2 * m) + 1) * pi)`;
5384                      `&(2 * n + 1) * pi`; `--(&(2 * m + 1) * pi)`]
5385         HAS_BOUNDED_REAL_VARIATION_ON_COMBINE) THEN
5386       ANTS_TAC THENL
5387        [REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN
5388         SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_OF_NUM_LE] THEN
5389         REWRITE_TAC[REAL_LE_NEG2; REAL_ARITH `--a <= b <=> &0 <= a + b`] THEN
5390         REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ARITH_TAC;
5391         DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN
5392         REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
5393         REWRITE_TAC[REAL_ARITH
5394           `--(&2 * m + &1) = &2 * --(m + &1) + &1`] THEN
5395         REWRITE_TAC[REAL_ARITH
5396           `--((&2 + &2 * m) + &1) = &2 * --(m + &1) - &1`] THEN
5397         FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED]];
5398       ALL_TAC] THEN
5399     MP_TAC(ISPEC `&2 * pi` REAL_ARCH) THEN
5400     ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN
5401     DISCH_THEN(MP_TAC o SPEC `abs x + &3`) THEN
5402     DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
5403     MATCH_MP_TAC HAS_BOUNDED_REAL_VARIATION_ON_SUBSET THEN
5404     EXISTS_TAC `real_interval[-- &(2 * N + 1) * pi,&(2 * N + 1) * pi]` THEN
5405     ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
5406     REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
5407     MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC]);;
5408
5409 (* ------------------------------------------------------------------------- *)
5410 (* Cesaro summability of Fourier series using Fejer kernel.                  *)
5411 (* ------------------------------------------------------------------------- *)
5412
5413 let fejer_kernel = new_definition
5414   `fejer_kernel n x = if n = 0 then &0
5415                       else sum(0..n-1) (\r. dirichlet_kernel r x) / &n`;;
5416
5417 let FEJER_KERNEL = prove
5418  (`fejer_kernel n x =
5419         if n = 0 then &0
5420         else if x = &0 then &n / &2
5421         else sin(&n / &2 * x) pow 2 / (&2 * &n * sin(x / &2) pow 2)`,
5422   REWRITE_TAC[fejer_kernel; dirichlet_kernel] THEN
5423   ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[SUM_0] THEN
5424   ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL
5425    [REWRITE_TAC[SUM_ADD_NUMSEG; SUM_CONST_NUMSEG;
5426                 REWRITE_RULE[ETA_AX] SUM_NUMBERS] THEN
5427     ASM_SIMP_TAC[SUB_ADD; GSYM REAL_OF_NUM_SUB; LE_1; SUB_0] THEN
5428     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
5429      [GSYM REAL_OF_NUM_EQ]) THEN
5430     CONV_TAC REAL_FIELD;
5431     ALL_TAC] THEN
5432   ASM_CASES_TAC `sin(x / &2) = &0` THENL
5433    [ASM_REWRITE_TAC[REAL_POW_ZERO; ARITH_EQ; REAL_MUL_RZERO; real_div;
5434                     REAL_INV_0; SUM_0; REAL_MUL_LZERO];
5435     ALL_TAC] THEN
5436   MATCH_MP_TAC(REAL_FIELD
5437    `~(n = &0) /\ ~(s = &0) /\ &2 * s pow 2 * l = r
5438     ==> l / n = r / (&2 * n * s pow 2)`) THEN
5439   ASM_REWRITE_TAC[REAL_OF_NUM_EQ; GSYM SUM_LMUL] THEN
5440   ASM_SIMP_TAC[REAL_FIELD
5441    `~(s = &0) ==> &2 * s pow 2 * a / (&2 * s) = s * a`] THEN
5442   REWRITE_TAC[REAL_MUL_SIN_SIN] THEN
5443   REWRITE_TAC[REAL_ARITH `x / &2 - (&n + &1 / &2) * x = --(&n * x)`;
5444               REAL_ARITH `x / &2 + (&n + &1 / &2) * x = (&n + &1) * x`] THEN
5445   REWRITE_TAC[real_div; SUM_RMUL; COS_NEG; REAL_OF_NUM_ADD] THEN
5446   REWRITE_TAC[SUM_DIFFS; LE_0; REAL_MUL_LZERO] THEN
5447   ASM_SIMP_TAC[SUB_ADD; LE_1; REAL_SUB_COS] THEN
5448   REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; real_div; REAL_MUL_AC] THEN
5449   REAL_ARITH_TAC);;
5450
5451 let FEJER_KERNEL_CONTINUOUS_STRONG = prove
5452  (`!n. (fejer_kernel n) real_continuous_on
5453        real_interval(--(&2 * pi),&2 * pi)`,
5454   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
5455   REWRITE_TAC[fejer_kernel] THEN
5456   ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN
5457   REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN
5458   MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN
5459   REWRITE_TAC[FINITE_NUMSEG; DIRICHLET_KERNEL_CONTINUOUS_STRONG]);;
5460
5461 let FEJER_KERNEL_CONTINUOUS = prove
5462  (`!n. (fejer_kernel n) real_continuous_on real_interval[--pi,pi]`,
5463   GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN
5464   EXISTS_TAC `real_interval(--(&2 * pi),&2 * pi)` THEN
5465   REWRITE_TAC[FEJER_KERNEL_CONTINUOUS_STRONG] THEN
5466   REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);;
5467
5468 let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL = prove
5469  (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi]
5470          ==> (\x. fejer_kernel n x * f x)
5471              absolutely_real_integrable_on real_interval[--pi,pi]`,
5472   REPEAT STRIP_TAC THEN
5473   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
5474   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5475    [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN
5476     ASM_REWRITE_TAC[FEJER_KERNEL_CONTINUOUS; ETA_AX;
5477                     REAL_CLOSED_REAL_INTERVAL];
5478     MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
5479     MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN
5480     ASM_REWRITE_TAC[FEJER_KERNEL_CONTINUOUS; ETA_AX;
5481                     REAL_COMPACT_INTERVAL]]);;
5482
5483 let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED = prove
5484  (`!f n c.
5485         f absolutely_real_integrable_on real_interval [--pi,pi] /\
5486         (!x. f(x + &2 * pi) = f(x))
5487         ==> (\x. fejer_kernel n x * f(t + x))
5488             absolutely_real_integrable_on real_interval[--pi,pi] /\
5489             (\x. fejer_kernel n x * f(t - x))
5490             absolutely_real_integrable_on real_interval[--pi,pi] /\
5491             (\x. fejer_kernel n x * c)
5492             absolutely_real_integrable_on real_interval[--pi,pi]`,
5493   REPEAT STRIP_TAC THEN
5494   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL THENL
5495    [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
5496     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
5497     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
5498     REWRITE_TAC[absolutely_real_integrable_on] THEN
5499     ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN
5500     REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN
5501     REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN
5502     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
5503     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
5504     ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
5505     REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]]);;
5506
5507 let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART = prove
5508  (`!f n d c.
5509         f absolutely_real_integrable_on real_interval [--pi,pi] /\
5510         (!x. f(x + &2 * pi) = f(x)) /\ d <= pi
5511         ==> (\x. fejer_kernel n x * f(t + x))
5512             absolutely_real_integrable_on real_interval[&0,d] /\
5513             (\x. fejer_kernel n x * f(t - x))
5514             absolutely_real_integrable_on real_interval[&0,d] /\
5515             (\x. fejer_kernel n x * c)
5516             absolutely_real_integrable_on real_interval[&0,d] /\
5517             (\x. fejer_kernel n x * (f(t + x) + f(t - x)))
5518             absolutely_real_integrable_on real_interval[&0,d] /\
5519             (\x. fejer_kernel n x * ((f(t + x) + f(t - x)) - c))
5520             absolutely_real_integrable_on real_interval[&0,d]`,
5521   REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
5522   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP
5523   ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED) ASSUME_TAC) THEN
5524   REWRITE_TAC[GSYM CONJ_ASSOC] THEN
5525   MATCH_MP_TAC(TAUT
5526    `(a /\ b /\ c) /\ (a /\ b /\ c ==> d /\ e)
5527     ==> a /\ b /\ c /\ d /\ e`) THEN
5528   CONJ_TAC THENL
5529    [REPEAT STRIP_TAC THEN
5530     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
5531     EXISTS_TAC `real_interval[--pi,pi]` THEN REPEAT STRIP_TAC THEN
5532     ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN
5533     ASM_REAL_ARITH_TAC;
5534     SIMP_TAC[REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB;
5535              ABSOLUTELY_REAL_INTEGRABLE_ADD;
5536              ABSOLUTELY_REAL_INTEGRABLE_SUB]]);;
5537
5538 let FOURIER_SUM_OFFSET_FEJER_KERNEL_HALF = prove
5539  (`!f n t.
5540      f absolutely_real_integrable_on real_interval[--pi,pi] /\
5541      (!x. f (x + &2 * pi) = f x) /\
5542      0 < n
5543      ==> sum(0..n-1) (\r. sum (0..2*r)
5544                               (\k. fourier_coefficient f k *
5545                                    trigonometric_set k t)) / &n - l =
5546          real_integral (real_interval[&0,pi])
5547                        (\x. fejer_kernel n x *
5548                             ((f(t + x) + f(t - x)) - &2 * l)) / pi`,
5549   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LE_1; REAL_OF_NUM_EQ; REAL_FIELD
5550    `~(n = &0) ==> (x / n - l = y <=> x - n * l = n * y)`] THEN
5551   MP_TAC(ISPECL [`l:real`; `0`; `n - 1`] SUM_CONST_NUMSEG) THEN
5552   ASM_SIMP_TAC[SUB_ADD; LE_1; SUB_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
5553   REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN
5554   ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF] THEN
5555   REWRITE_TAC[real_div; SUM_RMUL; REAL_MUL_ASSOC] THEN
5556   AP_THM_TAC THEN AP_TERM_TAC THEN
5557   W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_SUM o lhand o snd) THEN
5558   ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART;
5559                ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
5560                FINITE_NUMSEG; REAL_LE_REFL] THEN
5561   DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SUM_RMUL] THEN
5562   ASM_SIMP_TAC[GSYM REAL_INTEGRAL_LMUL; REAL_LE_REFL;
5563                ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART;
5564                ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
5565   MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
5566   ASM_SIMP_TAC[fejer_kernel; LE_1] THEN MATCH_MP_TAC(REAL_FIELD
5567    `~(n = &0) ==> s * f = n * s / n * f`) THEN
5568   ASM_SIMP_TAC[LE_1; REAL_OF_NUM_EQ]);;
5569
5570 let FOURIER_SUM_LIMIT_FEJER_KERNEL_HALF = prove
5571  (`!f t l.
5572         f absolutely_real_integrable_on real_interval[--pi,pi] /\
5573         (!x. f (x + &2 * pi) = f x)
5574         ==> (((\n. sum(0..n-1) (\r. sum (0..2*r)
5575                                         (\k. fourier_coefficient f k *
5576                                              trigonometric_set k t)) / &n)
5577                ---> l) sequentially <=>
5578              ((\n. real_integral (real_interval[&0,pi])
5579                                  (\x. fejer_kernel n x *
5580                                       ((f(t + x) + f(t - x)) - &2 * l)))
5581               ---> &0) sequentially)`,
5582   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN
5583   GEN_REWRITE_TAC LAND_CONV [REALLIM_NULL] THEN REWRITE_TAC[] THEN
5584   GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REALLIM_NULL_RMUL_EQ PI_NZ)] THEN
5585   MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN MATCH_MP_TAC REALLIM_EVENTUALLY THEN
5586   REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN
5587   ASM_SIMP_TAC[FOURIER_SUM_OFFSET_FEJER_KERNEL_HALF; LE_1] THEN
5588   ASM_SIMP_TAC[PI_POS; REAL_LT_IMP_NZ; REAL_DIV_RMUL; REAL_SUB_REFL]);;
5589
5590 let HAS_REAL_INTEGRAL_FEJER_KERNEL = prove
5591  (`!n. (fejer_kernel n has_real_integral (if n = 0 then &0 else pi))
5592        (real_interval[--pi,pi])`,
5593   GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
5594   REWRITE_TAC[fejer_kernel] THEN
5595   ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0] THEN
5596   SUBGOAL_THEN `pi = sum(0..n-1) (\r. pi) / &n`
5597    (fun th -> GEN_REWRITE_TAC LAND_CONV [th])
5598   THENL
5599    [ASM_SIMP_TAC[SUM_CONST_NUMSEG; SUB_ADD; LE_1; SUB_0] THEN
5600     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN
5601     CONV_TAC REAL_FIELD;
5602     REWRITE_TAC[real_div] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN
5603     MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN
5604     REWRITE_TAC[FINITE_NUMSEG; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]]);;
5605
5606 let HAS_REAL_INTEGRAL_FEJER_KERNEL_HALF = prove
5607  (`!n. (fejer_kernel n has_real_integral (if n = 0 then &0 else pi / &2))
5608        (real_interval[&0,pi])`,
5609   GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
5610   REWRITE_TAC[fejer_kernel] THEN
5611   ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0] THEN
5612   SUBGOAL_THEN `pi / &2 = sum(0..n-1) (\r. pi / &2) / &n`
5613    (fun th -> GEN_REWRITE_TAC LAND_CONV [th])
5614   THENL
5615    [ASM_SIMP_TAC[SUM_CONST_NUMSEG; SUB_ADD; LE_1; SUB_0] THEN
5616     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN
5617     CONV_TAC REAL_FIELD;
5618     REWRITE_TAC[real_div] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN
5619     MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN REWRITE_TAC[GSYM real_div] THEN
5620     REWRITE_TAC[FINITE_NUMSEG; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF]]);;
5621
5622 let FEJER_KERNEL_POS_LE = prove
5623  (`!n x. &0 <= fejer_kernel n x`,
5624   REPEAT GEN_TAC THEN REWRITE_TAC[FEJER_KERNEL] THEN
5625   REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV]) THEN
5626   MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_POW_2] THEN
5627   REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS]) THEN
5628   REWRITE_TAC[REAL_LE_POW_2]);;
5629
5630 let FOURIER_FEJER_CESARO_SUMMABLE = prove
5631  (`!f x l r.
5632         f absolutely_real_integrable_on real_interval[--pi,pi] /\
5633         (!x. f(x + &2 * pi) = f x) /\
5634         (f ---> l) (atreal x within {x' | x' <= x}) /\
5635         (f ---> r) (atreal x within {x' | x' >= x})
5636         ==> ((\n. sum(0..n-1) (\m. sum (0..2*m)
5637                                        (\k. fourier_coefficient f k *
5638                                             trigonometric_set k x)) / &n)
5639              ---> (l + r) / &2)
5640             sequentially`,
5641   MAP_EVERY X_GEN_TAC [`f:real->real`; `t:real`; `l:real`; `r:real`] THEN
5642   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_LIMIT_FEJER_KERNEL_HALF] THEN
5643   REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN
5644   ABBREV_TAC `h = \u. ((f:real->real)(t + u) + f(t - u)) - (l + r)` THEN
5645   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
5646   SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
5647   SUBGOAL_THEN `(h ---> &0) (atreal(&0) within {x | &0 <= x})`
5648   ASSUME_TAC THENL
5649    [EXPAND_TAC "h" THEN REWRITE_TAC[REAL_ARITH
5650      `(f' + f) - (l + l'):real = (f - l) + (f' - l')`] THEN
5651     MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL
5652      [UNDISCH_TAC `(f ---> l) (atreal t within {x' | x' <= t})` THEN
5653       REWRITE_TAC[REALLIM_WITHINREAL] THEN
5654       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5655       ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
5656       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN
5657       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5658       ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
5659        X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t - x:real` th)) THEN
5660       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
5661       REAL_ARITH_TAC;
5662       UNDISCH_TAC `(f ---> r) (atreal t within {x' | x' >= t})` THEN
5663       REWRITE_TAC[REALLIM_WITHINREAL] THEN
5664       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5665       ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
5666       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN
5667       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5668       ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
5669        X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t + x:real` th)) THEN
5670       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
5671       REAL_ARITH_TAC];
5672     ALL_TAC] THEN
5673   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5674   SUBGOAL_THEN
5675    `?k. &0 < k /\ k < pi /\
5676         (!x. &0 < x /\ x <= k ==> abs(h x) < e / &2 / pi)`
5677   STRIP_ASSUME_TAC THENL
5678    [UNDISCH_TAC `(h ---> &0) (atreal (&0) within {x | &0 <= x})` THEN
5679     REWRITE_TAC[REALLIM_WITHINREAL] THEN
5680     DISCH_THEN(MP_TAC o SPEC `e / &2 / pi`) THEN
5681     ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; PI_POS; IN_ELIM_THM; REAL_SUB_RZERO;
5682                  LEFT_IMP_EXISTS_THM] THEN
5683     X_GEN_TAC `k:real` THEN STRIP_TAC THEN EXISTS_TAC `min k pi / &2` THEN
5684     REPEAT(CONJ_TAC THENL
5685      [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
5686     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5687     ASM_REAL_ARITH_TAC;
5688     ALL_TAC] THEN
5689   SUBGOAL_THEN
5690    `((\n. real_integral (real_interval[k,pi])
5691                         (\x. fejer_kernel n x * h x))
5692      ---> &0) sequentially`
5693   MP_TAC THENL
5694    [MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN
5695     EXISTS_TAC
5696      `\n. real_integral (real_interval[k,pi])
5697                         (\x. abs(h x) / (&2 * sin(x / &2) pow 2)) / &n` THEN
5698     CONJ_TAC THENL
5699      [ALL_TAC;
5700       REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN
5701       REWRITE_TAC[REALLIM_1_OVER_N]] THEN
5702     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN
5703     X_GEN_TAC `n:num` THEN DISCH_TAC THEN
5704     ASM_SIMP_TAC[FEJER_KERNEL; LE_1] THEN
5705     SUBGOAL_THEN
5706      `(\x. h x / (&2 * sin(x / &2) pow 2))
5707       absolutely_real_integrable_on real_interval[k,pi]`
5708     MP_TAC THENL
5709      [REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
5710       MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
5711       REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THENL
5712        [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
5713         MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS;
5714         MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
5715         MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN
5716         REWRITE_TAC[REAL_COMPACT_INTERVAL];
5717         EXPAND_TAC "h" THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN
5718         REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN
5719         MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN
5720         EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL
5721          [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL
5722            [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
5723             MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
5724             ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`];
5725             REWRITE_TAC[real_sub; absolutely_real_integrable_on] THEN
5726             ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN
5727             REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN
5728             REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN
5729             ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
5730             MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN
5731             ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]];
5732           REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]] THEN
5733       (REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
5734        REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN
5735        STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN
5736        CONJ_TAC THENL
5737         [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN
5738          REAL_DIFFERENTIABLE_TAC;
5739          REWRITE_TAC[REAL_RING `&2 * x pow 2 = &0 <=> x = &0`] THEN
5740          MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC SIN_POS_PI THEN
5741          ASM_REAL_ARITH_TAC]);
5742       DISCH_THEN(fun th -> ASSUME_TAC th THEN
5743         MP_TAC(MATCH_MP ABSOLUTELY_REAL_INTEGRABLE_ABS th)) THEN
5744       REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_POW] THEN
5745       REWRITE_TAC[REAL_POW2_ABS] THEN DISCH_TAC] THEN
5746     GEN_REWRITE_TAC RAND_CONV [real_div] THEN
5747     ASM_SIMP_TAC[GSYM REAL_INTEGRAL_RMUL;
5748                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
5749     MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN
5750     ASM_SIMP_TAC[REAL_INTEGRABLE_RMUL;
5751                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
5752     MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
5753      [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
5754       COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN
5755       REWRITE_TAC[REAL_ABS_MUL] THEN
5756       GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
5757       REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
5758       MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
5759       REWRITE_TAC[GSYM REAL_INV_MUL; REAL_ABS_MUL] THEN
5760       ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN
5761       MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
5762       REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; ABS_SQUARE_LE_1; SIN_BOUND] THEN
5763       MATCH_MP_TAC(REAL_ARITH `x = y /\ &0 <= x ==> abs x <= y`) THEN
5764       REWRITE_TAC[GSYM real_div; REAL_LE_INV_EQ] THEN
5765       SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_POW_2] THEN
5766       REWRITE_TAC[REAL_MUL_AC];
5767       DISCH_TAC] THEN
5768     MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
5769     EXISTS_TAC `\x.  abs(h x) / (&2 * sin(x / &2) pow 2) * inv(&n)` THEN
5770     ASM_SIMP_TAC[REAL_INTEGRABLE_RMUL;
5771                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN
5772     MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
5773     MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN
5774     EXISTS_TAC
5775      `\x. sin(&n / &2 * x) pow 2 / (&2 * &n * sin(x / &2) pow 2) * h(x)` THEN
5776     CONJ_TAC THENL
5777      [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
5778       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
5779       ALL_TAC] THEN
5780     REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN
5781     ONCE_REWRITE_TAC[REAL_ARITH
5782      `s * t * n * i * h:real = n * s * h * (t * i)`] THEN
5783     MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN
5784     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN
5785     MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
5786     ASM_REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL
5787      [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN
5788       MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN
5789       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
5790       REPEAT STRIP_TAC THEN
5791       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN
5792       REAL_DIFFERENTIABLE_TAC;
5793       REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN
5794       REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; ABS_SQUARE_LE_1; SIN_BOUND]];
5795     ALL_TAC] THEN
5796   REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN
5797   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
5798   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `MAX 1 N` THEN
5799   X_GEN_TAC `n:num` THEN
5800   REWRITE_TAC[ARITH_RULE `MAX a b <= x <=> a <= x /\ b <= x`] THEN
5801   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
5802   ASM_REWRITE_TAC[] THEN
5803   MP_TAC(ISPECL [`\x. fejer_kernel n x * h x`; `&0`; `pi`; `k:real`]
5804         REAL_INTEGRAL_COMBINE) THEN
5805   ANTS_TAC THENL
5806    [ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "h" THEN
5807     ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART;
5808                  ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
5809                  REAL_LE_REFL];
5810     ALL_TAC] THEN
5811   MATCH_MP_TAC(REAL_ARITH
5812    `abs x <= e / &2 ==> x + y = z ==> abs y < e / &2 ==> abs z < e`) THEN
5813   MATCH_MP_TAC REAL_LE_TRANS THEN
5814   EXISTS_TAC `real_integral (real_interval[&0,k])
5815                             (\x. fejer_kernel n x * e / &2 / pi)` THEN
5816   CONJ_TAC THENL
5817    [SUBGOAL_THEN
5818      `real_integral (real_interval [&0,k]) (\x. fejer_kernel n x * h x) =
5819       real_integral (real_interval [&0,k])
5820                     (\x. fejer_kernel n x * (if x = &0 then &0 else h x))`
5821     SUBST1_TAC THENL
5822      [MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
5823       EXISTS_TAC `{&0}` THEN SIMP_TAC[IN_DIFF; IN_SING] THEN
5824       REWRITE_TAC[REAL_NEGLIGIBLE_SING];
5825       ALL_TAC] THEN
5826     MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN
5827     REPEAT CONJ_TAC THENL
5828      [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN
5829       MAP_EVERY EXISTS_TAC [`\x. fejer_kernel n x * h x`; `{&0}`] THEN
5830       SIMP_TAC[IN_DIFF; IN_SING; REAL_NEGLIGIBLE_SING] THEN
5831       EXPAND_TAC "h" THEN
5832       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART;
5833                    ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE;
5834                    REAL_LT_IMP_LE];
5835       MP_TAC(ISPECL
5836        [`\x:real. e / &2 / pi`; `n:num`; `k:real`; `&0`]
5837         ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART) THEN
5838       ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST; REAL_LT_IMP_LE;
5839                    ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE];
5840       X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN
5841       REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
5842       REWRITE_TAC[REAL_ABS_POS; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN
5843       REWRITE_TAC[FEJER_KERNEL_POS_LE] THEN COND_CASES_TAC THEN
5844       ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_NUM; REAL_POS;
5845                    PI_POS_LE; REAL_LT_IMP_LE] THEN
5846       MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5847       ASM_REAL_ARITH_TAC];
5848     MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_FEJER_KERNEL_HALF) THEN
5849     ASM_SIMP_TAC[LE_1] THEN DISCH_TAC THEN
5850     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
5851      `real_integral (real_interval[&0,pi])
5852                     (\x. fejer_kernel n x * e / &2 / pi)` THEN
5853     CONJ_TAC THENL
5854      [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REWRITE_TAC[] THEN
5855       REPEAT CONJ_TAC THENL
5856        [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC;
5857         MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN REWRITE_TAC[ETA_AX] THEN
5858         MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN
5859         EXISTS_TAC `real_interval[&0,pi]` THEN CONJ_TAC THENL
5860          [ASM_MESON_TAC[real_integrable_on];
5861           REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC];
5862         MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN REWRITE_TAC[ETA_AX] THEN
5863         ASM_MESON_TAC[real_integrable_on];
5864         REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
5865         ASM_REWRITE_TAC[FEJER_KERNEL_POS_LE] THEN
5866         REPEAT(MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC) THEN
5867         MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC];
5868       FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN
5869       DISCH_THEN(MP_TAC o SPEC `e / &2 / pi`) THEN
5870       SIMP_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
5871       REPEAT STRIP_TAC THEN SIMP_TAC[PI_POS; REAL_FIELD
5872        `&0 < pi ==> pi / &2 * e / &2 / pi = e / &4`] THEN
5873       ASM_REAL_ARITH_TAC]]);;
5874
5875 let FOURIER_FEJER_CESARO_SUMMABLE_SIMPLE = prove
5876  (`!f x l r.
5877         f real_continuous_on (:real) /\ (!x. f(x + &2 * pi) = f x)
5878         ==> ((\n. sum(0..n-1) (\m. sum (0..2*m)
5879                                        (\k. fourier_coefficient f k *
5880                                             trigonometric_set k x)) / &n)
5881              ---> f(x))
5882             sequentially`,
5883   REPEAT STRIP_TAC THEN
5884   GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [REAL_ARITH `x = (x + x) / &2`] THEN
5885   MATCH_MP_TAC FOURIER_FEJER_CESARO_SUMMABLE THEN ASM_REWRITE_TAC[] THEN
5886   CONJ_TAC THENL
5887    [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS THEN
5888     ASM_MESON_TAC[REAL_CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
5889     CONJ_TAC THEN MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN
5890     REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN
5891     ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV;
5892                   IN_UNIV]]);;