1(*  Title:      HOL/Real_Vector_Spaces.thy
2    Author:     Brian Huffman
3    Author:     Johannes H��lzl
4*)
5
6section \<open>Vector Spaces and Algebras over the Reals\<close>
7
8theory Real_Vector_Spaces
9imports Real Topological_Spaces Vector_Spaces
10begin
11
12subsection \<open>Real vector spaces\<close>
13
14class scaleR =
15  fixes scaleR :: "real \<Rightarrow> 'a \<Rightarrow> 'a" (infixr "*\<^sub>R" 75)
16begin
17
18abbreviation divideR :: "'a \<Rightarrow> real \<Rightarrow> 'a"  (infixl "'/\<^sub>R" 70)
19  where "x /\<^sub>R r \<equiv> scaleR (inverse r) x"
20
21end
22
23class real_vector = scaleR + ab_group_add +
24  assumes scaleR_add_right: "scaleR a (x + y) = scaleR a x + scaleR a y"
25  and scaleR_add_left: "scaleR (a + b) x = scaleR a x + scaleR b x"
26  and scaleR_scaleR: "scaleR a (scaleR b x) = scaleR (a * b) x"
27  and scaleR_one: "scaleR 1 x = x"
28
29
30class real_algebra = real_vector + ring +
31  assumes mult_scaleR_left [simp]: "scaleR a x * y = scaleR a (x * y)"
32    and mult_scaleR_right [simp]: "x * scaleR a y = scaleR a (x * y)"
33
34class real_algebra_1 = real_algebra + ring_1
35
36class real_div_algebra = real_algebra_1 + division_ring
37
38class real_field = real_div_algebra + field
39
40instantiation real :: real_field
41begin
42
43definition real_scaleR_def [simp]: "scaleR a x = a * x"
44
45instance
46  by standard (simp_all add: algebra_simps)
47
48end
49
50locale linear = Vector_Spaces.linear "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
51begin
52lemmas scaleR = scale
53end
54
55global_interpretation real_vector?: vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a::real_vector"
56  rewrites "Vector_Spaces.linear ( *\<^sub>R) ( *\<^sub>R) = linear"
57    and "Vector_Spaces.linear ( *) ( *\<^sub>R) = linear"
58  defines dependent_raw_def: dependent = real_vector.dependent
59    and representation_raw_def: representation = real_vector.representation
60    and subspace_raw_def: subspace = real_vector.subspace
61    and span_raw_def: span = real_vector.span
62    and extend_basis_raw_def: extend_basis = real_vector.extend_basis
63    and dim_raw_def: dim = real_vector.dim
64    apply unfold_locales
65       apply (rule scaleR_add_right)
66      apply (rule scaleR_add_left)
67     apply (rule scaleR_scaleR)
68    apply (rule scaleR_one)
69   apply (force simp: linear_def)
70  apply (force simp: linear_def real_scaleR_def[abs_def])
71  done
72
73hide_const (open)\<comment> \<open>locale constants\<close>
74  real_vector.dependent
75  real_vector.independent
76  real_vector.representation
77  real_vector.subspace
78  real_vector.span
79  real_vector.extend_basis
80  real_vector.dim
81
82abbreviation "independent x \<equiv> \<not> dependent x"
83
84global_interpretation real_vector?: vector_space_pair "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
85  rewrites  "Vector_Spaces.linear ( *\<^sub>R) ( *\<^sub>R) = linear"
86    and "Vector_Spaces.linear ( *) ( *\<^sub>R) = linear"
87  defines construct_raw_def: construct = real_vector.construct
88  apply unfold_locales
89  unfolding linear_def real_scaleR_def
90  by (rule refl)+
91
92hide_const (open)\<comment> \<open>locale constants\<close>
93  real_vector.construct
94
95lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
96  unfolding linear_def by (rule Vector_Spaces.linear_compose)
97
98text \<open>Recover original theorem names\<close>
99
100lemmas scaleR_left_commute = real_vector.scale_left_commute
101lemmas scaleR_zero_left = real_vector.scale_zero_left
102lemmas scaleR_minus_left = real_vector.scale_minus_left
103lemmas scaleR_diff_left = real_vector.scale_left_diff_distrib
104lemmas scaleR_sum_left = real_vector.scale_sum_left
105lemmas scaleR_zero_right = real_vector.scale_zero_right
106lemmas scaleR_minus_right = real_vector.scale_minus_right
107lemmas scaleR_diff_right = real_vector.scale_right_diff_distrib
108lemmas scaleR_sum_right = real_vector.scale_sum_right
109lemmas scaleR_eq_0_iff = real_vector.scale_eq_0_iff
110lemmas scaleR_left_imp_eq = real_vector.scale_left_imp_eq
111lemmas scaleR_right_imp_eq = real_vector.scale_right_imp_eq
112lemmas scaleR_cancel_left = real_vector.scale_cancel_left
113lemmas scaleR_cancel_right = real_vector.scale_cancel_right
114
115text \<open>Legacy names\<close>
116
117lemmas scaleR_left_distrib = scaleR_add_left
118lemmas scaleR_right_distrib = scaleR_add_right
119lemmas scaleR_left_diff_distrib = scaleR_diff_left
120lemmas scaleR_right_diff_distrib = scaleR_diff_right
121
122lemmas linear_injective_0 = linear_inj_iff_eq_0
123  and linear_injective_on_subspace_0 = linear_inj_on_iff_eq_0
124  and linear_cmul = linear_scale
125  and linear_scaleR = linear_scale_self
126  and subspace_mul = subspace_scale
127  and span_linear_image = linear_span_image
128  and span_0 = span_zero
129  and span_mul = span_scale
130  and injective_scaleR = injective_scale
131
132lemma scaleR_minus1_left [simp]: "scaleR (-1) x = - x"
133  for x :: "'a::real_vector"
134  using scaleR_minus_left [of 1 x] by simp
135
136lemma scaleR_2:
137  fixes x :: "'a::real_vector"
138  shows "scaleR 2 x = x + x"
139  unfolding one_add_one [symmetric] scaleR_left_distrib by simp
140
141lemma scaleR_half_double [simp]:
142  fixes a :: "'a::real_vector"
143  shows "(1 / 2) *\<^sub>R (a + a) = a"
144proof -
145  have "\<And>r. r *\<^sub>R (a + a) = (r * 2) *\<^sub>R a"
146    by (metis scaleR_2 scaleR_scaleR)
147  then show ?thesis
148    by simp
149qed
150
151interpretation scaleR_left: additive "(\<lambda>a. scaleR a x :: 'a::real_vector)"
152  by standard (rule scaleR_left_distrib)
153
154interpretation scaleR_right: additive "(\<lambda>x. scaleR a x :: 'a::real_vector)"
155  by standard (rule scaleR_right_distrib)
156
157lemma nonzero_inverse_scaleR_distrib:
158  "a \<noteq> 0 \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> inverse (scaleR a x) = scaleR (inverse a) (inverse x)"
159  for x :: "'a::real_div_algebra"
160  by (rule inverse_unique) simp
161
162lemma inverse_scaleR_distrib: "inverse (scaleR a x) = scaleR (inverse a) (inverse x)"
163  for x :: "'a::{real_div_algebra,division_ring}"
164  by (metis inverse_zero nonzero_inverse_scaleR_distrib scale_eq_0_iff)
165
166lemmas sum_constant_scaleR = real_vector.sum_constant_scale\<comment> \<open>legacy name\<close>
167
168named_theorems vector_add_divide_simps "to simplify sums of scaled vectors"
169
170lemma [vector_add_divide_simps]:
171  "v + (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)"
172  "a *\<^sub>R v + (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)"
173  "(a / z) *\<^sub>R v + w = (if z = 0 then w else (a *\<^sub>R v + z *\<^sub>R w) /\<^sub>R z)"
174  "(a / z) *\<^sub>R v + b *\<^sub>R w = (if z = 0 then b *\<^sub>R w else (a *\<^sub>R v + (b * z) *\<^sub>R w) /\<^sub>R z)"
175  "v - (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)"
176  "a *\<^sub>R v - (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)"
177  "(a / z) *\<^sub>R v - w = (if z = 0 then -w else (a *\<^sub>R v - z *\<^sub>R w) /\<^sub>R z)"
178  "(a / z) *\<^sub>R v - b *\<^sub>R w = (if z = 0 then -b *\<^sub>R w else (a *\<^sub>R v - (b * z) *\<^sub>R w) /\<^sub>R z)"
179  for v :: "'a :: real_vector"
180  by (simp_all add: divide_inverse_commute scaleR_add_right scaleR_diff_right)
181
182
183lemma eq_vector_fraction_iff [vector_add_divide_simps]:
184  fixes x :: "'a :: real_vector"
185  shows "(x = (u / v) *\<^sub>R a) \<longleftrightarrow> (if v=0 then x = 0 else v *\<^sub>R x = u *\<^sub>R a)"
186by auto (metis (no_types) divide_eq_1_iff divide_inverse_commute scaleR_one scaleR_scaleR)
187
188lemma vector_fraction_eq_iff [vector_add_divide_simps]:
189  fixes x :: "'a :: real_vector"
190  shows "((u / v) *\<^sub>R a = x) \<longleftrightarrow> (if v=0 then x = 0 else u *\<^sub>R a = v *\<^sub>R x)"
191by (metis eq_vector_fraction_iff)
192
193lemma real_vector_affinity_eq:
194  fixes x :: "'a :: real_vector"
195  assumes m0: "m \<noteq> 0"
196  shows "m *\<^sub>R x + c = y \<longleftrightarrow> x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
197    (is "?lhs \<longleftrightarrow> ?rhs")
198proof
199  assume ?lhs
200  then have "m *\<^sub>R x = y - c" by (simp add: field_simps)
201  then have "inverse m *\<^sub>R (m *\<^sub>R x) = inverse m *\<^sub>R (y - c)" by simp
202  then show "x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
203    using m0
204  by (simp add: scaleR_diff_right)
205next
206  assume ?rhs
207  with m0 show "m *\<^sub>R x + c = y"
208    by (simp add: scaleR_diff_right)
209qed
210
211lemma real_vector_eq_affinity: "m \<noteq> 0 \<Longrightarrow> y = m *\<^sub>R x + c \<longleftrightarrow> inverse m *\<^sub>R y - (inverse m *\<^sub>R c) = x"
212  for x :: "'a::real_vector"
213  using real_vector_affinity_eq[where m=m and x=x and y=y and c=c]
214  by metis
215
216lemma scaleR_eq_iff [simp]: "b + u *\<^sub>R a = a + u *\<^sub>R b \<longleftrightarrow> a = b \<or> u = 1"
217  for a :: "'a::real_vector"
218proof (cases "u = 1")
219  case True
220  then show ?thesis by auto
221next
222  case False
223  have "a = b" if "b + u *\<^sub>R a = a + u *\<^sub>R b"
224  proof -
225    from that have "(u - 1) *\<^sub>R a = (u - 1) *\<^sub>R b"
226      by (simp add: algebra_simps)
227    with False show ?thesis
228      by auto
229  qed
230  then show ?thesis by auto
231qed
232
233lemma scaleR_collapse [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R a = a"
234  for a :: "'a::real_vector"
235  by (simp add: algebra_simps)
236
237
238subsection \<open>Embedding of the Reals into any \<open>real_algebra_1\<close>: \<open>of_real\<close>\<close>
239
240definition of_real :: "real \<Rightarrow> 'a::real_algebra_1"
241  where "of_real r = scaleR r 1"
242
243lemma scaleR_conv_of_real: "scaleR r x = of_real r * x"
244  by (simp add: of_real_def)
245
246lemma of_real_0 [simp]: "of_real 0 = 0"
247  by (simp add: of_real_def)
248
249lemma of_real_1 [simp]: "of_real 1 = 1"
250  by (simp add: of_real_def)
251
252lemma of_real_add [simp]: "of_real (x + y) = of_real x + of_real y"
253  by (simp add: of_real_def scaleR_left_distrib)
254
255lemma of_real_minus [simp]: "of_real (- x) = - of_real x"
256  by (simp add: of_real_def)
257
258lemma of_real_diff [simp]: "of_real (x - y) = of_real x - of_real y"
259  by (simp add: of_real_def scaleR_left_diff_distrib)
260
261lemma of_real_mult [simp]: "of_real (x * y) = of_real x * of_real y"
262  by (simp add: of_real_def mult.commute)
263
264lemma of_real_sum[simp]: "of_real (sum f s) = (\<Sum>x\<in>s. of_real (f x))"
265  by (induct s rule: infinite_finite_induct) auto
266
267lemma of_real_prod[simp]: "of_real (prod f s) = (\<Prod>x\<in>s. of_real (f x))"
268  by (induct s rule: infinite_finite_induct) auto
269
270lemma nonzero_of_real_inverse:
271  "x \<noteq> 0 \<Longrightarrow> of_real (inverse x) = inverse (of_real x :: 'a::real_div_algebra)"
272  by (simp add: of_real_def nonzero_inverse_scaleR_distrib)
273
274lemma of_real_inverse [simp]:
275  "of_real (inverse x) = inverse (of_real x :: 'a::{real_div_algebra,division_ring})"
276  by (simp add: of_real_def inverse_scaleR_distrib)
277
278lemma nonzero_of_real_divide:
279  "y \<noteq> 0 \<Longrightarrow> of_real (x / y) = (of_real x / of_real y :: 'a::real_field)"
280  by (simp add: divide_inverse nonzero_of_real_inverse)
281
282lemma of_real_divide [simp]:
283  "of_real (x / y) = (of_real x / of_real y :: 'a::real_div_algebra)"
284  by (simp add: divide_inverse)
285
286lemma of_real_power [simp]:
287  "of_real (x ^ n) = (of_real x :: 'a::{real_algebra_1}) ^ n"
288  by (induct n) simp_all
289
290lemma of_real_eq_iff [simp]: "of_real x = of_real y \<longleftrightarrow> x = y"
291  by (simp add: of_real_def)
292
293lemma inj_of_real: "inj of_real"
294  by (auto intro: injI)
295
296lemmas of_real_eq_0_iff [simp] = of_real_eq_iff [of _ 0, simplified]
297lemmas of_real_eq_1_iff [simp] = of_real_eq_iff [of _ 1, simplified]
298
299lemma minus_of_real_eq_of_real_iff [simp]: "-of_real x = of_real y \<longleftrightarrow> -x = y"
300  using of_real_eq_iff[of "-x" y] by (simp only: of_real_minus)
301
302lemma of_real_eq_minus_of_real_iff [simp]: "of_real x = -of_real y \<longleftrightarrow> x = -y"
303  using of_real_eq_iff[of x "-y"] by (simp only: of_real_minus)
304
305lemma of_real_eq_id [simp]: "of_real = (id :: real \<Rightarrow> real)"
306  by (rule ext) (simp add: of_real_def)
307
308text \<open>Collapse nested embeddings.\<close>
309lemma of_real_of_nat_eq [simp]: "of_real (of_nat n) = of_nat n"
310  by (induct n) auto
311
312lemma of_real_of_int_eq [simp]: "of_real (of_int z) = of_int z"
313  by (cases z rule: int_diff_cases) simp
314
315lemma of_real_numeral [simp]: "of_real (numeral w) = numeral w"
316  using of_real_of_int_eq [of "numeral w"] by simp
317
318lemma of_real_neg_numeral [simp]: "of_real (- numeral w) = - numeral w"
319  using of_real_of_int_eq [of "- numeral w"] by simp
320
321text \<open>Every real algebra has characteristic zero.\<close>
322instance real_algebra_1 < ring_char_0
323proof
324  from inj_of_real inj_of_nat have "inj (of_real \<circ> of_nat)"
325    by (rule inj_comp)
326  then show "inj (of_nat :: nat \<Rightarrow> 'a)"
327    by (simp add: comp_def)
328qed
329
330lemma fraction_scaleR_times [simp]:
331  fixes a :: "'a::real_algebra_1"
332  shows "(numeral u / numeral v) *\<^sub>R (numeral w * a) = (numeral u * numeral w / numeral v) *\<^sub>R a"
333by (metis (no_types, lifting) of_real_numeral scaleR_conv_of_real scaleR_scaleR times_divide_eq_left)
334
335lemma inverse_scaleR_times [simp]:
336  fixes a :: "'a::real_algebra_1"
337  shows "(1 / numeral v) *\<^sub>R (numeral w * a) = (numeral w / numeral v) *\<^sub>R a"
338by (metis divide_inverse_commute inverse_eq_divide of_real_numeral scaleR_conv_of_real scaleR_scaleR)
339
340lemma scaleR_times [simp]:
341  fixes a :: "'a::real_algebra_1"
342  shows "(numeral u) *\<^sub>R (numeral w * a) = (numeral u * numeral w) *\<^sub>R a"
343by (simp add: scaleR_conv_of_real)
344
345instance real_field < field_char_0 ..
346
347
348subsection \<open>The Set of Real Numbers\<close>
349
350definition Reals :: "'a::real_algebra_1 set"  ("\<real>")
351  where "\<real> = range of_real"
352
353lemma Reals_of_real [simp]: "of_real r \<in> \<real>"
354  by (simp add: Reals_def)
355
356lemma Reals_of_int [simp]: "of_int z \<in> \<real>"
357  by (subst of_real_of_int_eq [symmetric], rule Reals_of_real)
358
359lemma Reals_of_nat [simp]: "of_nat n \<in> \<real>"
360  by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real)
361
362lemma Reals_numeral [simp]: "numeral w \<in> \<real>"
363  by (subst of_real_numeral [symmetric], rule Reals_of_real)
364
365lemma Reals_0 [simp]: "0 \<in> \<real>" and Reals_1 [simp]: "1 \<in> \<real>"
366  by (simp_all add: Reals_def)
367
368lemma Reals_add [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a + b \<in> \<real>"
369  by (metis (no_types, hide_lams) Reals_def Reals_of_real imageE of_real_add)
370
371lemma Reals_minus [simp]: "a \<in> \<real> \<Longrightarrow> - a \<in> \<real>"
372  by (auto simp: Reals_def)
373
374lemma Reals_minus_iff [simp]: "- a \<in> \<real> \<longleftrightarrow> a \<in> \<real>"
375  apply (auto simp: Reals_def)
376  by (metis add.inverse_inverse of_real_minus rangeI)
377
378lemma Reals_diff [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a - b \<in> \<real>"
379  by (metis Reals_add Reals_minus_iff add_uminus_conv_diff)
380
381lemma Reals_mult [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a * b \<in> \<real>"
382  by (metis (no_types, lifting) Reals_def Reals_of_real imageE of_real_mult)
383
384lemma nonzero_Reals_inverse: "a \<in> \<real> \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> inverse a \<in> \<real>"
385  for a :: "'a::real_div_algebra"
386  by (metis Reals_def Reals_of_real imageE of_real_inverse)
387
388lemma Reals_inverse: "a \<in> \<real> \<Longrightarrow> inverse a \<in> \<real>"
389  for a :: "'a::{real_div_algebra,division_ring}"
390  using nonzero_Reals_inverse by fastforce
391
392lemma Reals_inverse_iff [simp]: "inverse x \<in> \<real> \<longleftrightarrow> x \<in> \<real>"
393  for x :: "'a::{real_div_algebra,division_ring}"
394  by (metis Reals_inverse inverse_inverse_eq)
395
396lemma nonzero_Reals_divide: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> a / b \<in> \<real>"
397  for a b :: "'a::real_field"
398  by (simp add: divide_inverse)
399
400lemma Reals_divide [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a / b \<in> \<real>"
401  for a b :: "'a::{real_field,field}"
402  using nonzero_Reals_divide by fastforce
403
404lemma Reals_power [simp]: "a \<in> \<real> \<Longrightarrow> a ^ n \<in> \<real>"
405  for a :: "'a::real_algebra_1"
406  by (metis Reals_def Reals_of_real imageE of_real_power)
407
408lemma Reals_cases [cases set: Reals]:
409  assumes "q \<in> \<real>"
410  obtains (of_real) r where "q = of_real r"
411  unfolding Reals_def
412proof -
413  from \<open>q \<in> \<real>\<close> have "q \<in> range of_real" unfolding Reals_def .
414  then obtain r where "q = of_real r" ..
415  then show thesis ..
416qed
417
418lemma sum_in_Reals [intro,simp]: "(\<And>i. i \<in> s \<Longrightarrow> f i \<in> \<real>) \<Longrightarrow> sum f s \<in> \<real>"
419proof (induct s rule: infinite_finite_induct)
420  case infinite
421  then show ?case by (metis Reals_0 sum.infinite)
422qed simp_all
423
424lemma prod_in_Reals [intro,simp]: "(\<And>i. i \<in> s \<Longrightarrow> f i \<in> \<real>) \<Longrightarrow> prod f s \<in> \<real>"
425proof (induct s rule: infinite_finite_induct)
426  case infinite
427  then show ?case by (metis Reals_1 prod.infinite)
428qed simp_all
429
430lemma Reals_induct [case_names of_real, induct set: Reals]:
431  "q \<in> \<real> \<Longrightarrow> (\<And>r. P (of_real r)) \<Longrightarrow> P q"
432  by (rule Reals_cases) auto
433
434
435subsection \<open>Ordered real vector spaces\<close>
436
437class ordered_real_vector = real_vector + ordered_ab_group_add +
438  assumes scaleR_left_mono: "x \<le> y \<Longrightarrow> 0 \<le> a \<Longrightarrow> a *\<^sub>R x \<le> a *\<^sub>R y"
439    and scaleR_right_mono: "a \<le> b \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> b *\<^sub>R x"
440begin
441
442lemma scaleR_mono: "a \<le> b \<Longrightarrow> x \<le> y \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> b *\<^sub>R y"
443  by (meson local.dual_order.trans local.scaleR_left_mono local.scaleR_right_mono)
444
445lemma scaleR_mono': "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> c \<Longrightarrow> a *\<^sub>R c \<le> b *\<^sub>R d"
446  by (rule scaleR_mono) (auto intro: order.trans)
447
448lemma pos_le_divideRI:
449  assumes "0 < c"
450    and "c *\<^sub>R a \<le> b"
451  shows "a \<le> b /\<^sub>R c"
452proof -
453  from scaleR_left_mono[OF assms(2)] assms(1)
454  have "c *\<^sub>R a /\<^sub>R c \<le> b /\<^sub>R c"
455    by simp
456  with assms show ?thesis
457    by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide)
458qed
459
460lemma pos_le_divideR_eq:
461  assumes "0 < c"
462  shows "a \<le> b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a \<le> b"
463    (is "?lhs \<longleftrightarrow> ?rhs")
464proof
465  assume ?lhs
466  from scaleR_left_mono[OF this] assms have "c *\<^sub>R a \<le> c *\<^sub>R (b /\<^sub>R c)"
467    by simp
468  with assms show ?rhs
469    by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide)
470next
471  assume ?rhs
472  with assms show ?lhs by (rule pos_le_divideRI)
473qed
474
475lemma scaleR_image_atLeastAtMost: "c > 0 \<Longrightarrow> scaleR c ` {x..y} = {c *\<^sub>R x..c *\<^sub>R y}"
476  apply (auto intro!: scaleR_left_mono)
477  apply (rule_tac x = "inverse c *\<^sub>R xa" in image_eqI)
478   apply (simp_all add: pos_le_divideR_eq[symmetric] scaleR_scaleR scaleR_one)
479  done
480
481end
482
483lemma neg_le_divideR_eq:
484  fixes a :: "'a :: ordered_real_vector"
485  assumes "c < 0"
486  shows "a \<le> b /\<^sub>R c \<longleftrightarrow> b \<le> c *\<^sub>R a"
487  using pos_le_divideR_eq [of "-c" a "-b"] assms by simp
488
489lemma scaleR_nonneg_nonneg: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> a *\<^sub>R x"
490  for x :: "'a::ordered_real_vector"
491  using scaleR_left_mono [of 0 x a] by simp
492
493lemma scaleR_nonneg_nonpos: "0 \<le> a \<Longrightarrow> x \<le> 0 \<Longrightarrow> a *\<^sub>R x \<le> 0"
494  for x :: "'a::ordered_real_vector"
495  using scaleR_left_mono [of x 0 a] by simp
496
497lemma scaleR_nonpos_nonneg: "a \<le> 0 \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> 0"
498  for x :: "'a::ordered_real_vector"
499  using scaleR_right_mono [of a 0 x] by simp
500
501lemma split_scaleR_neg_le: "(0 \<le> a \<and> x \<le> 0) \<or> (a \<le> 0 \<and> 0 \<le> x) \<Longrightarrow> a *\<^sub>R x \<le> 0"
502  for x :: "'a::ordered_real_vector"
503  by (auto simp: scaleR_nonneg_nonpos scaleR_nonpos_nonneg)
504
505lemma le_add_iff1: "a *\<^sub>R e + c \<le> b *\<^sub>R e + d \<longleftrightarrow> (a - b) *\<^sub>R e + c \<le> d"
506  for c d e :: "'a::ordered_real_vector"
507  by (simp add: algebra_simps)
508
509lemma le_add_iff2: "a *\<^sub>R e + c \<le> b *\<^sub>R e + d \<longleftrightarrow> c \<le> (b - a) *\<^sub>R e + d"
510  for c d e :: "'a::ordered_real_vector"
511  by (simp add: algebra_simps)
512
513lemma scaleR_left_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b"
514  for a b :: "'a::ordered_real_vector"
515  by (drule scaleR_left_mono [of _ _ "- c"], simp_all)
516
517lemma scaleR_right_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> a *\<^sub>R c \<le> b *\<^sub>R c"
518  for c :: "'a::ordered_real_vector"
519  by (drule scaleR_right_mono [of _ _ "- c"], simp_all)
520
521lemma scaleR_nonpos_nonpos: "a \<le> 0 \<Longrightarrow> b \<le> 0 \<Longrightarrow> 0 \<le> a *\<^sub>R b"
522  for b :: "'a::ordered_real_vector"
523  using scaleR_right_mono_neg [of a 0 b] by simp
524
525lemma split_scaleR_pos_le: "(0 \<le> a \<and> 0 \<le> b) \<or> (a \<le> 0 \<and> b \<le> 0) \<Longrightarrow> 0 \<le> a *\<^sub>R b"
526  for b :: "'a::ordered_real_vector"
527  by (auto simp: scaleR_nonneg_nonneg scaleR_nonpos_nonpos)
528
529lemma zero_le_scaleR_iff:
530  fixes b :: "'a::ordered_real_vector"
531  shows "0 \<le> a *\<^sub>R b \<longleftrightarrow> 0 < a \<and> 0 \<le> b \<or> a < 0 \<and> b \<le> 0 \<or> a = 0"
532    (is "?lhs = ?rhs")
533proof (cases "a = 0")
534  case True
535  then show ?thesis by simp
536next
537  case False
538  show ?thesis
539  proof
540    assume ?lhs
541    from \<open>a \<noteq> 0\<close> consider "a > 0" | "a < 0" by arith
542    then show ?rhs
543    proof cases
544      case 1
545      with \<open>?lhs\<close> have "inverse a *\<^sub>R 0 \<le> inverse a *\<^sub>R (a *\<^sub>R b)"
546        by (intro scaleR_mono) auto
547      with 1 show ?thesis
548        by simp
549    next
550      case 2
551      with \<open>?lhs\<close> have "- inverse a *\<^sub>R 0 \<le> - inverse a *\<^sub>R (a *\<^sub>R b)"
552        by (intro scaleR_mono) auto
553      with 2 show ?thesis
554        by simp
555    qed
556  next
557    assume ?rhs
558    then show ?lhs
559      by (auto simp: not_le \<open>a \<noteq> 0\<close> intro!: split_scaleR_pos_le)
560  qed
561qed
562
563lemma scaleR_le_0_iff: "a *\<^sub>R b \<le> 0 \<longleftrightarrow> 0 < a \<and> b \<le> 0 \<or> a < 0 \<and> 0 \<le> b \<or> a = 0"
564  for b::"'a::ordered_real_vector"
565  by (insert zero_le_scaleR_iff [of "-a" b]) force
566
567lemma scaleR_le_cancel_left: "c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
568  for b :: "'a::ordered_real_vector"
569  by (auto simp: neq_iff scaleR_left_mono scaleR_left_mono_neg
570      dest: scaleR_left_mono[where a="inverse c"] scaleR_left_mono_neg[where c="inverse c"])
571
572lemma scaleR_le_cancel_left_pos: "0 < c \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> a \<le> b"
573  for b :: "'a::ordered_real_vector"
574  by (auto simp: scaleR_le_cancel_left)
575
576lemma scaleR_le_cancel_left_neg: "c < 0 \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> b \<le> a"
577  for b :: "'a::ordered_real_vector"
578  by (auto simp: scaleR_le_cancel_left)
579
580lemma scaleR_left_le_one_le: "0 \<le> x \<Longrightarrow> a \<le> 1 \<Longrightarrow> a *\<^sub>R x \<le> x"
581  for x :: "'a::ordered_real_vector" and a :: real
582  using scaleR_right_mono[of a 1 x] by simp
583
584
585subsection \<open>Real normed vector spaces\<close>
586
587class dist =
588  fixes dist :: "'a \<Rightarrow> 'a \<Rightarrow> real"
589
590class norm =
591  fixes norm :: "'a \<Rightarrow> real"
592
593class sgn_div_norm = scaleR + norm + sgn +
594  assumes sgn_div_norm: "sgn x = x /\<^sub>R norm x"
595
596class dist_norm = dist + norm + minus +
597  assumes dist_norm: "dist x y = norm (x - y)"
598
599class uniformity_dist = dist + uniformity +
600  assumes uniformity_dist: "uniformity = (INF e:{0 <..}. principal {(x, y). dist x y < e})"
601begin
602
603lemma eventually_uniformity_metric:
604  "eventually P uniformity \<longleftrightarrow> (\<exists>e>0. \<forall>x y. dist x y < e \<longrightarrow> P (x, y))"
605  unfolding uniformity_dist
606  by (subst eventually_INF_base)
607     (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"])
608
609end
610
611class real_normed_vector = real_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity +
612  assumes norm_eq_zero [simp]: "norm x = 0 \<longleftrightarrow> x = 0"
613    and norm_triangle_ineq: "norm (x + y) \<le> norm x + norm y"
614    and norm_scaleR [simp]: "norm (scaleR a x) = \<bar>a\<bar> * norm x"
615begin
616
617lemma norm_ge_zero [simp]: "0 \<le> norm x"
618proof -
619  have "0 = norm (x + -1 *\<^sub>R x)"
620    using scaleR_add_left[of 1 "-1" x] norm_scaleR[of 0 x] by (simp add: scaleR_one)
621  also have "\<dots> \<le> norm x + norm (-1 *\<^sub>R x)" by (rule norm_triangle_ineq)
622  finally show ?thesis by simp
623qed
624
625end
626
627class real_normed_algebra = real_algebra + real_normed_vector +
628  assumes norm_mult_ineq: "norm (x * y) \<le> norm x * norm y"
629
630class real_normed_algebra_1 = real_algebra_1 + real_normed_algebra +
631  assumes norm_one [simp]: "norm 1 = 1"
632
633lemma (in real_normed_algebra_1) scaleR_power [simp]: "(scaleR x y) ^ n = scaleR (x^n) (y^n)"
634  by (induct n) (simp_all add: scaleR_one scaleR_scaleR mult_ac)
635
636class real_normed_div_algebra = real_div_algebra + real_normed_vector +
637  assumes norm_mult: "norm (x * y) = norm x * norm y"
638
639class real_normed_field = real_field + real_normed_div_algebra
640
641instance real_normed_div_algebra < real_normed_algebra_1
642proof
643  show "norm (x * y) \<le> norm x * norm y" for x y :: 'a
644    by (simp add: norm_mult)
645next
646  have "norm (1 * 1::'a) = norm (1::'a) * norm (1::'a)"
647    by (rule norm_mult)
648  then show "norm (1::'a) = 1" by simp
649qed
650
651lemma norm_zero [simp]: "norm (0::'a::real_normed_vector) = 0"
652  by simp
653
654lemma zero_less_norm_iff [simp]: "norm x > 0 \<longleftrightarrow> x \<noteq> 0"
655  for x :: "'a::real_normed_vector"
656  by (simp add: order_less_le)
657
658lemma norm_not_less_zero [simp]: "\<not> norm x < 0"
659  for x :: "'a::real_normed_vector"
660  by (simp add: linorder_not_less)
661
662lemma norm_le_zero_iff [simp]: "norm x \<le> 0 \<longleftrightarrow> x = 0"
663  for x :: "'a::real_normed_vector"
664  by (simp add: order_le_less)
665
666lemma norm_minus_cancel [simp]: "norm (- x) = norm x"
667  for x :: "'a::real_normed_vector"
668proof -
669  have "norm (- x) = norm (scaleR (- 1) x)"
670    by (simp only: scaleR_minus_left scaleR_one)
671  also have "\<dots> = \<bar>- 1\<bar> * norm x"
672    by (rule norm_scaleR)
673  finally show ?thesis by simp
674qed
675
676lemma norm_minus_commute: "norm (a - b) = norm (b - a)"
677  for a b :: "'a::real_normed_vector"
678proof -
679  have "norm (- (b - a)) = norm (b - a)"
680    by (rule norm_minus_cancel)
681  then show ?thesis by simp
682qed
683
684lemma dist_add_cancel [simp]: "dist (a + b) (a + c) = dist b c"
685  for a :: "'a::real_normed_vector"
686  by (simp add: dist_norm)
687
688lemma dist_add_cancel2 [simp]: "dist (b + a) (c + a) = dist b c"
689  for a :: "'a::real_normed_vector"
690  by (simp add: dist_norm)
691
692lemma dist_scaleR [simp]: "dist (x *\<^sub>R a) (y *\<^sub>R a) = \<bar>x - y\<bar> * norm a"
693  for a :: "'a::real_normed_vector"
694  by (metis dist_norm norm_scaleR scaleR_left.diff)
695
696lemma norm_uminus_minus: "norm (- x - y :: 'a :: real_normed_vector) = norm (x + y)"
697  by (subst (2) norm_minus_cancel[symmetric], subst minus_add_distrib) simp
698
699lemma norm_triangle_ineq2: "norm a - norm b \<le> norm (a - b)"
700  for a b :: "'a::real_normed_vector"
701proof -
702  have "norm (a - b + b) \<le> norm (a - b) + norm b"
703    by (rule norm_triangle_ineq)
704  then show ?thesis by simp
705qed
706
707lemma norm_triangle_ineq3: "\<bar>norm a - norm b\<bar> \<le> norm (a - b)"
708  for a b :: "'a::real_normed_vector"
709proof -
710  have "norm a - norm b \<le> norm (a - b)"
711    by (simp add: norm_triangle_ineq2)
712  moreover have "norm b - norm a \<le> norm (a - b)"
713    by (metis norm_minus_commute norm_triangle_ineq2)
714  ultimately show ?thesis
715    by (simp add: abs_le_iff)
716qed
717
718lemma norm_triangle_ineq4: "norm (a - b) \<le> norm a + norm b"
719  for a b :: "'a::real_normed_vector"
720proof -
721  have "norm (a + - b) \<le> norm a + norm (- b)"
722    by (rule norm_triangle_ineq)
723  then show ?thesis by simp
724qed
725
726lemma norm_triangle_le_diff:
727  fixes x y :: "'a::real_normed_vector"
728  shows "norm x + norm y \<le> e \<Longrightarrow> norm (x - y) \<le> e"
729    by (meson norm_triangle_ineq4 order_trans)
730
731lemma norm_diff_ineq: "norm a - norm b \<le> norm (a + b)"
732  for a b :: "'a::real_normed_vector"
733proof -
734  have "norm a - norm (- b) \<le> norm (a - - b)"
735    by (rule norm_triangle_ineq2)
736  then show ?thesis by simp
737qed
738
739lemma norm_add_leD: "norm (a + b) \<le> c \<Longrightarrow> norm b \<le> norm a + c"
740  for a b :: "'a::real_normed_vector"
741  by (metis add.commute diff_le_eq norm_diff_ineq order.trans)
742
743lemma norm_diff_triangle_ineq: "norm ((a + b) - (c + d)) \<le> norm (a - c) + norm (b - d)"
744  for a b c d :: "'a::real_normed_vector"
745proof -
746  have "norm ((a + b) - (c + d)) = norm ((a - c) + (b - d))"
747    by (simp add: algebra_simps)
748  also have "\<dots> \<le> norm (a - c) + norm (b - d)"
749    by (rule norm_triangle_ineq)
750  finally show ?thesis .
751qed
752
753lemma norm_diff_triangle_le:
754  fixes x y z :: "'a::real_normed_vector"
755  assumes "norm (x - y) \<le> e1"  "norm (y - z) \<le> e2"
756  shows "norm (x - z) \<le> e1 + e2"
757  using norm_diff_triangle_ineq [of x y y z] assms by simp
758
759lemma norm_diff_triangle_less:
760  fixes x y z :: "'a::real_normed_vector"
761  assumes "norm (x - y) < e1"  "norm (y - z) < e2"
762  shows "norm (x - z) < e1 + e2"
763  using norm_diff_triangle_ineq [of x y y z] assms by simp
764
765lemma norm_triangle_mono:
766  fixes a b :: "'a::real_normed_vector"
767  shows "norm a \<le> r \<Longrightarrow> norm b \<le> s \<Longrightarrow> norm (a + b) \<le> r + s"
768  by (metis add_mono_thms_linordered_semiring(1) norm_triangle_ineq order.trans)
769
770lemma norm_sum:
771  fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
772  shows "norm (sum f A) \<le> (\<Sum>i\<in>A. norm (f i))"
773  by (induct A rule: infinite_finite_induct) (auto intro: norm_triangle_mono)
774
775lemma sum_norm_le:
776  fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
777  assumes fg: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> g x"
778  shows "norm (sum f S) \<le> sum g S"
779  by (rule order_trans [OF norm_sum sum_mono]) (simp add: fg)
780
781lemma abs_norm_cancel [simp]: "\<bar>norm a\<bar> = norm a"
782  for a :: "'a::real_normed_vector"
783  by (rule abs_of_nonneg [OF norm_ge_zero])
784
785lemma norm_add_less: "norm x < r \<Longrightarrow> norm y < s \<Longrightarrow> norm (x + y) < r + s"
786  for x y :: "'a::real_normed_vector"
787  by (rule order_le_less_trans [OF norm_triangle_ineq add_strict_mono])
788
789lemma norm_mult_less: "norm x < r \<Longrightarrow> norm y < s \<Longrightarrow> norm (x * y) < r * s"
790  for x y :: "'a::real_normed_algebra"
791  by (rule order_le_less_trans [OF norm_mult_ineq]) (simp add: mult_strict_mono')
792
793lemma norm_of_real [simp]: "norm (of_real r :: 'a::real_normed_algebra_1) = \<bar>r\<bar>"
794  by (simp add: of_real_def)
795
796lemma norm_numeral [simp]: "norm (numeral w::'a::real_normed_algebra_1) = numeral w"
797  by (subst of_real_numeral [symmetric], subst norm_of_real, simp)
798
799lemma norm_neg_numeral [simp]: "norm (- numeral w::'a::real_normed_algebra_1) = numeral w"
800  by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp)
801
802lemma norm_of_real_add1 [simp]: "norm (of_real x + 1 :: 'a :: real_normed_div_algebra) = \<bar>x + 1\<bar>"
803  by (metis norm_of_real of_real_1 of_real_add)
804
805lemma norm_of_real_addn [simp]:
806  "norm (of_real x + numeral b :: 'a :: real_normed_div_algebra) = \<bar>x + numeral b\<bar>"
807  by (metis norm_of_real of_real_add of_real_numeral)
808
809lemma norm_of_int [simp]: "norm (of_int z::'a::real_normed_algebra_1) = \<bar>of_int z\<bar>"
810  by (subst of_real_of_int_eq [symmetric], rule norm_of_real)
811
812lemma norm_of_nat [simp]: "norm (of_nat n::'a::real_normed_algebra_1) = of_nat n"
813  by (metis abs_of_nat norm_of_real of_real_of_nat_eq)
814
815lemma nonzero_norm_inverse: "a \<noteq> 0 \<Longrightarrow> norm (inverse a) = inverse (norm a)"
816  for a :: "'a::real_normed_div_algebra"
817  by (metis inverse_unique norm_mult norm_one right_inverse)
818
819lemma norm_inverse: "norm (inverse a) = inverse (norm a)"
820  for a :: "'a::{real_normed_div_algebra,division_ring}"
821  by (metis inverse_zero nonzero_norm_inverse norm_zero)
822
823lemma nonzero_norm_divide: "b \<noteq> 0 \<Longrightarrow> norm (a / b) = norm a / norm b"
824  for a b :: "'a::real_normed_field"
825  by (simp add: divide_inverse norm_mult nonzero_norm_inverse)
826
827lemma norm_divide: "norm (a / b) = norm a / norm b"
828  for a b :: "'a::{real_normed_field,field}"
829  by (simp add: divide_inverse norm_mult norm_inverse)
830
831lemma norm_inverse_le_norm:
832  fixes x :: "'a::real_normed_div_algebra"
833  shows "r \<le> norm x \<Longrightarrow> 0 < r \<Longrightarrow> norm (inverse x) \<le> inverse r"
834  by (simp add: le_imp_inverse_le norm_inverse)
835
836lemma norm_power_ineq: "norm (x ^ n) \<le> norm x ^ n"
837  for x :: "'a::real_normed_algebra_1"
838proof (induct n)
839  case 0
840  show "norm (x ^ 0) \<le> norm x ^ 0" by simp
841next
842  case (Suc n)
843  have "norm (x * x ^ n) \<le> norm x * norm (x ^ n)"
844    by (rule norm_mult_ineq)
845  also from Suc have "\<dots> \<le> norm x * norm x ^ n"
846    using norm_ge_zero by (rule mult_left_mono)
847  finally show "norm (x ^ Suc n) \<le> norm x ^ Suc n"
848    by simp
849qed
850
851lemma norm_power: "norm (x ^ n) = norm x ^ n"
852  for x :: "'a::real_normed_div_algebra"
853  by (induct n) (simp_all add: norm_mult)
854
855lemma power_eq_imp_eq_norm:
856  fixes w :: "'a::real_normed_div_algebra"
857  assumes eq: "w ^ n = z ^ n" and "n > 0"
858    shows "norm w = norm z"
859proof -
860  have "norm w ^ n = norm z ^ n"
861    by (metis (no_types) eq norm_power)
862  then show ?thesis
863    using assms by (force intro: power_eq_imp_eq_base)
864qed
865
866lemma power_eq_1_iff:
867  fixes w :: "'a::real_normed_div_algebra"
868  shows "w ^ n = 1 \<Longrightarrow> norm w = 1 \<or> n = 0"
869  by (metis norm_one power_0_left power_eq_0_iff power_eq_imp_eq_norm power_one)
870
871lemma norm_mult_numeral1 [simp]: "norm (numeral w * a) = numeral w * norm a"
872  for a b :: "'a::{real_normed_field,field}"
873  by (simp add: norm_mult)
874
875lemma norm_mult_numeral2 [simp]: "norm (a * numeral w) = norm a * numeral w"
876  for a b :: "'a::{real_normed_field,field}"
877  by (simp add: norm_mult)
878
879lemma norm_divide_numeral [simp]: "norm (a / numeral w) = norm a / numeral w"
880  for a b :: "'a::{real_normed_field,field}"
881  by (simp add: norm_divide)
882
883lemma norm_of_real_diff [simp]:
884  "norm (of_real b - of_real a :: 'a::real_normed_algebra_1) \<le> \<bar>b - a\<bar>"
885  by (metis norm_of_real of_real_diff order_refl)
886
887text \<open>Despite a superficial resemblance, \<open>norm_eq_1\<close> is not relevant.\<close>
888lemma square_norm_one:
889  fixes x :: "'a::real_normed_div_algebra"
890  assumes "x\<^sup>2 = 1"
891  shows "norm x = 1"
892  by (metis assms norm_minus_cancel norm_one power2_eq_1_iff)
893
894lemma norm_less_p1: "norm x < norm (of_real (norm x) + 1 :: 'a)"
895  for x :: "'a::real_normed_algebra_1"
896proof -
897  have "norm x < norm (of_real (norm x + 1) :: 'a)"
898    by (simp add: of_real_def)
899  then show ?thesis
900    by simp
901qed
902
903lemma prod_norm: "prod (\<lambda>x. norm (f x)) A = norm (prod f A)"
904  for f :: "'a \<Rightarrow> 'b::{comm_semiring_1,real_normed_div_algebra}"
905  by (induct A rule: infinite_finite_induct) (auto simp: norm_mult)
906
907lemma norm_prod_le:
908  "norm (prod f A) \<le> (\<Prod>a\<in>A. norm (f a :: 'a :: {real_normed_algebra_1,comm_monoid_mult}))"
909proof (induct A rule: infinite_finite_induct)
910  case empty
911  then show ?case by simp
912next
913  case (insert a A)
914  then have "norm (prod f (insert a A)) \<le> norm (f a) * norm (prod f A)"
915    by (simp add: norm_mult_ineq)
916  also have "norm (prod f A) \<le> (\<Prod>a\<in>A. norm (f a))"
917    by (rule insert)
918  finally show ?case
919    by (simp add: insert mult_left_mono)
920next
921  case infinite
922  then show ?case by simp
923qed
924
925lemma norm_prod_diff:
926  fixes z w :: "'i \<Rightarrow> 'a::{real_normed_algebra_1, comm_monoid_mult}"
927  shows "(\<And>i. i \<in> I \<Longrightarrow> norm (z i) \<le> 1) \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> norm (w i) \<le> 1) \<Longrightarrow>
928    norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) \<le> (\<Sum>i\<in>I. norm (z i - w i))"
929proof (induction I rule: infinite_finite_induct)
930  case empty
931  then show ?case by simp
932next
933  case (insert i I)
934  note insert.hyps[simp]
935
936  have "norm ((\<Prod>i\<in>insert i I. z i) - (\<Prod>i\<in>insert i I. w i)) =
937    norm ((\<Prod>i\<in>I. z i) * (z i - w i) + ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) * w i)"
938    (is "_ = norm (?t1 + ?t2)")
939    by (auto simp: field_simps)
940  also have "\<dots> \<le> norm ?t1 + norm ?t2"
941    by (rule norm_triangle_ineq)
942  also have "norm ?t1 \<le> norm (\<Prod>i\<in>I. z i) * norm (z i - w i)"
943    by (rule norm_mult_ineq)
944  also have "\<dots> \<le> (\<Prod>i\<in>I. norm (z i)) * norm(z i - w i)"
945    by (rule mult_right_mono) (auto intro: norm_prod_le)
946  also have "(\<Prod>i\<in>I. norm (z i)) \<le> (\<Prod>i\<in>I. 1)"
947    by (intro prod_mono) (auto intro!: insert)
948  also have "norm ?t2 \<le> norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) * norm (w i)"
949    by (rule norm_mult_ineq)
950  also have "norm (w i) \<le> 1"
951    by (auto intro: insert)
952  also have "norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) \<le> (\<Sum>i\<in>I. norm (z i - w i))"
953    using insert by auto
954  finally show ?case
955    by (auto simp: ac_simps mult_right_mono mult_left_mono)
956next
957  case infinite
958  then show ?case by simp
959qed
960
961lemma norm_power_diff:
962  fixes z w :: "'a::{real_normed_algebra_1, comm_monoid_mult}"
963  assumes "norm z \<le> 1" "norm w \<le> 1"
964  shows "norm (z^m - w^m) \<le> m * norm (z - w)"
965proof -
966  have "norm (z^m - w^m) = norm ((\<Prod> i < m. z) - (\<Prod> i < m. w))"
967    by (simp add: prod_constant)
968  also have "\<dots> \<le> (\<Sum>i<m. norm (z - w))"
969    by (intro norm_prod_diff) (auto simp: assms)
970  also have "\<dots> = m * norm (z - w)"
971    by simp
972  finally show ?thesis .
973qed
974
975
976subsection \<open>Metric spaces\<close>
977
978class metric_space = uniformity_dist + open_uniformity +
979  assumes dist_eq_0_iff [simp]: "dist x y = 0 \<longleftrightarrow> x = y"
980    and dist_triangle2: "dist x y \<le> dist x z + dist y z"
981begin
982
983lemma dist_self [simp]: "dist x x = 0"
984  by simp
985
986lemma zero_le_dist [simp]: "0 \<le> dist x y"
987  using dist_triangle2 [of x x y] by simp
988
989lemma zero_less_dist_iff: "0 < dist x y \<longleftrightarrow> x \<noteq> y"
990  by (simp add: less_le)
991
992lemma dist_not_less_zero [simp]: "\<not> dist x y < 0"
993  by (simp add: not_less)
994
995lemma dist_le_zero_iff [simp]: "dist x y \<le> 0 \<longleftrightarrow> x = y"
996  by (simp add: le_less)
997
998lemma dist_commute: "dist x y = dist y x"
999proof (rule order_antisym)
1000  show "dist x y \<le> dist y x"
1001    using dist_triangle2 [of x y x] by simp
1002  show "dist y x \<le> dist x y"
1003    using dist_triangle2 [of y x y] by simp
1004qed
1005
1006lemma dist_commute_lessI: "dist y x < e \<Longrightarrow> dist x y < e"
1007  by (simp add: dist_commute)
1008
1009lemma dist_triangle: "dist x z \<le> dist x y + dist y z"
1010  using dist_triangle2 [of x z y] by (simp add: dist_commute)
1011
1012lemma dist_triangle3: "dist x y \<le> dist a x + dist a y"
1013  using dist_triangle2 [of x y a] by (simp add: dist_commute)
1014
1015lemma dist_pos_lt: "x \<noteq> y \<Longrightarrow> 0 < dist x y"
1016  by (simp add: zero_less_dist_iff)
1017
1018lemma dist_nz: "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
1019  by (simp add: zero_less_dist_iff)
1020
1021declare dist_nz [symmetric, simp]
1022
1023lemma dist_triangle_le: "dist x z + dist y z \<le> e \<Longrightarrow> dist x y \<le> e"
1024  by (rule order_trans [OF dist_triangle2])
1025
1026lemma dist_triangle_lt: "dist x z + dist y z < e \<Longrightarrow> dist x y < e"
1027  by (rule le_less_trans [OF dist_triangle2])
1028
1029lemma dist_triangle_less_add: "dist x1 y < e1 \<Longrightarrow> dist x2 y < e2 \<Longrightarrow> dist x1 x2 < e1 + e2"
1030  by (rule dist_triangle_lt [where z=y]) simp
1031
1032lemma dist_triangle_half_l: "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
1033  by (rule dist_triangle_lt [where z=y]) simp
1034
1035lemma dist_triangle_half_r: "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
1036  by (rule dist_triangle_half_l) (simp_all add: dist_commute)
1037
1038lemma dist_triangle_third:
1039  assumes "dist x1 x2 < e/3" "dist x2 x3 < e/3" "dist x3 x4 < e/3"
1040  shows "dist x1 x4 < e"
1041proof -
1042  have "dist x1 x3 < e/3 + e/3"
1043    by (metis assms(1) assms(2) dist_commute dist_triangle_less_add)
1044  then have "dist x1 x4 < (e/3 + e/3) + e/3"
1045    by (metis assms(3) dist_commute dist_triangle_less_add)
1046  then show ?thesis
1047    by simp
1048qed
1049  
1050subclass uniform_space
1051proof
1052  fix E x
1053  assume "eventually E uniformity"
1054  then obtain e where E: "0 < e" "\<And>x y. dist x y < e \<Longrightarrow> E (x, y)"
1055    by (auto simp: eventually_uniformity_metric)
1056  then show "E (x, x)" "\<forall>\<^sub>F (x, y) in uniformity. E (y, x)"
1057    by (auto simp: eventually_uniformity_metric dist_commute)
1058  show "\<exists>D. eventually D uniformity \<and> (\<forall>x y z. D (x, y) \<longrightarrow> D (y, z) \<longrightarrow> E (x, z))"
1059    using E dist_triangle_half_l[where e=e]
1060    unfolding eventually_uniformity_metric
1061    by (intro exI[of _ "\<lambda>(x, y). dist x y < e / 2"] exI[of _ "e/2"] conjI)
1062      (auto simp: dist_commute)
1063qed
1064
1065lemma open_dist: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
1066  by (simp add: dist_commute open_uniformity eventually_uniformity_metric)
1067
1068lemma open_ball: "open {y. dist x y < d}"
1069  unfolding open_dist
1070proof (intro ballI)
1071  fix y
1072  assume *: "y \<in> {y. dist x y < d}"
1073  then show "\<exists>e>0. \<forall>z. dist z y < e \<longrightarrow> z \<in> {y. dist x y < d}"
1074    by (auto intro!: exI[of _ "d - dist x y"] simp: field_simps dist_triangle_lt)
1075qed
1076
1077subclass first_countable_topology
1078proof
1079  fix x
1080  show "\<exists>A::nat \<Rightarrow> 'a set. (\<forall>i. x \<in> A i \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
1081  proof (safe intro!: exI[of _ "\<lambda>n. {y. dist x y < inverse (Suc n)}"])
1082    fix S
1083    assume "open S" "x \<in> S"
1084    then obtain e where e: "0 < e" and "{y. dist x y < e} \<subseteq> S"
1085      by (auto simp: open_dist subset_eq dist_commute)
1086    moreover
1087    from e obtain i where "inverse (Suc i) < e"
1088      by (auto dest!: reals_Archimedean)
1089    then have "{y. dist x y < inverse (Suc i)} \<subseteq> {y. dist x y < e}"
1090      by auto
1091    ultimately show "\<exists>i. {y. dist x y < inverse (Suc i)} \<subseteq> S"
1092      by blast
1093  qed (auto intro: open_ball)
1094qed
1095
1096end
1097
1098instance metric_space \<subseteq> t2_space
1099proof
1100  fix x y :: "'a::metric_space"
1101  assume xy: "x \<noteq> y"
1102  let ?U = "{y'. dist x y' < dist x y / 2}"
1103  let ?V = "{x'. dist y x' < dist x y / 2}"
1104  have *: "d x z \<le> d x y + d y z \<Longrightarrow> d y z = d z y \<Longrightarrow> \<not> (d x y * 2 < d x z \<and> d z y * 2 < d x z)"
1105    for d :: "'a \<Rightarrow> 'a \<Rightarrow> real" and x y z :: 'a
1106    by arith
1107  have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
1108    using dist_pos_lt[OF xy] *[of dist, OF dist_triangle dist_commute]
1109    using open_ball[of _ "dist x y / 2"] by auto
1110  then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
1111    by blast
1112qed
1113
1114text \<open>Every normed vector space is a metric space.\<close>
1115instance real_normed_vector < metric_space
1116proof
1117  fix x y z :: 'a
1118  show "dist x y = 0 \<longleftrightarrow> x = y"
1119    by (simp add: dist_norm)
1120  show "dist x y \<le> dist x z + dist y z"
1121    using norm_triangle_ineq4 [of "x - z" "y - z"] by (simp add: dist_norm)
1122qed
1123
1124
1125subsection \<open>Class instances for real numbers\<close>
1126
1127instantiation real :: real_normed_field
1128begin
1129
1130definition dist_real_def: "dist x y = \<bar>x - y\<bar>"
1131
1132definition uniformity_real_def [code del]:
1133  "(uniformity :: (real \<times> real) filter) = (INF e:{0 <..}. principal {(x, y). dist x y < e})"
1134
1135definition open_real_def [code del]:
1136  "open (U :: real set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
1137
1138definition real_norm_def [simp]: "norm r = \<bar>r\<bar>"
1139
1140instance
1141  by intro_classes (auto simp: abs_mult open_real_def dist_real_def sgn_real_def uniformity_real_def)
1142
1143end
1144
1145declare uniformity_Abort[where 'a=real, code]
1146
1147lemma dist_of_real [simp]: "dist (of_real x :: 'a) (of_real y) = dist x y"
1148  for a :: "'a::real_normed_div_algebra"
1149  by (metis dist_norm norm_of_real of_real_diff real_norm_def)
1150
1151declare [[code abort: "open :: real set \<Rightarrow> bool"]]
1152
1153instance real :: linorder_topology
1154proof
1155  show "(open :: real set \<Rightarrow> bool) = generate_topology (range lessThan \<union> range greaterThan)"
1156  proof (rule ext, safe)
1157    fix S :: "real set"
1158    assume "open S"
1159    then obtain f where "\<forall>x\<in>S. 0 < f x \<and> (\<forall>y. dist y x < f x \<longrightarrow> y \<in> S)"
1160      unfolding open_dist bchoice_iff ..
1161    then have *: "S = (\<Union>x\<in>S. {x - f x <..} \<inter> {..< x + f x})"
1162      by (fastforce simp: dist_real_def)
1163    show "generate_topology (range lessThan \<union> range greaterThan) S"
1164      apply (subst *)
1165      apply (intro generate_topology_Union generate_topology.Int)
1166       apply (auto intro: generate_topology.Basis)
1167      done
1168  next
1169    fix S :: "real set"
1170    assume "generate_topology (range lessThan \<union> range greaterThan) S"
1171    moreover have "\<And>a::real. open {..<a}"
1172      unfolding open_dist dist_real_def
1173    proof clarify
1174      fix x a :: real
1175      assume "x < a"
1176      then have "0 < a - x \<and> (\<forall>y. \<bar>y - x\<bar> < a - x \<longrightarrow> y \<in> {..<a})" by auto
1177      then show "\<exists>e>0. \<forall>y. \<bar>y - x\<bar> < e \<longrightarrow> y \<in> {..<a}" ..
1178    qed
1179    moreover have "\<And>a::real. open {a <..}"
1180      unfolding open_dist dist_real_def
1181    proof clarify
1182      fix x a :: real
1183      assume "a < x"
1184      then have "0 < x - a \<and> (\<forall>y. \<bar>y - x\<bar> < x - a \<longrightarrow> y \<in> {a<..})" by auto
1185      then show "\<exists>e>0. \<forall>y. \<bar>y - x\<bar> < e \<longrightarrow> y \<in> {a<..}" ..
1186    qed
1187    ultimately show "open S"
1188      by induct auto
1189  qed
1190qed
1191
1192instance real :: linear_continuum_topology ..
1193
1194lemmas open_real_greaterThan = open_greaterThan[where 'a=real]
1195lemmas open_real_lessThan = open_lessThan[where 'a=real]
1196lemmas open_real_greaterThanLessThan = open_greaterThanLessThan[where 'a=real]
1197lemmas closed_real_atMost = closed_atMost[where 'a=real]
1198lemmas closed_real_atLeast = closed_atLeast[where 'a=real]
1199lemmas closed_real_atLeastAtMost = closed_atLeastAtMost[where 'a=real]
1200
1201
1202subsection \<open>Extra type constraints\<close>
1203
1204text \<open>Only allow @{term "open"} in class \<open>topological_space\<close>.\<close>
1205setup \<open>Sign.add_const_constraint
1206  (@{const_name "open"}, SOME @{typ "'a::topological_space set \<Rightarrow> bool"})\<close>
1207
1208text \<open>Only allow @{term "uniformity"} in class \<open>uniform_space\<close>.\<close>
1209setup \<open>Sign.add_const_constraint
1210  (@{const_name "uniformity"}, SOME @{typ "('a::uniformity \<times> 'a) filter"})\<close>
1211
1212text \<open>Only allow @{term dist} in class \<open>metric_space\<close>.\<close>
1213setup \<open>Sign.add_const_constraint
1214  (@{const_name dist}, SOME @{typ "'a::metric_space \<Rightarrow> 'a \<Rightarrow> real"})\<close>
1215
1216text \<open>Only allow @{term norm} in class \<open>real_normed_vector\<close>.\<close>
1217setup \<open>Sign.add_const_constraint
1218  (@{const_name norm}, SOME @{typ "'a::real_normed_vector \<Rightarrow> real"})\<close>
1219
1220
1221subsection \<open>Sign function\<close>
1222
1223lemma norm_sgn: "norm (sgn x) = (if x = 0 then 0 else 1)"
1224  for x :: "'a::real_normed_vector"
1225  by (simp add: sgn_div_norm)
1226
1227lemma sgn_zero [simp]: "sgn (0::'a::real_normed_vector) = 0"
1228  by (simp add: sgn_div_norm)
1229
1230lemma sgn_zero_iff: "sgn x = 0 \<longleftrightarrow> x = 0"
1231  for x :: "'a::real_normed_vector"
1232  by (simp add: sgn_div_norm)
1233
1234lemma sgn_minus: "sgn (- x) = - sgn x"
1235  for x :: "'a::real_normed_vector"
1236  by (simp add: sgn_div_norm)
1237
1238lemma sgn_scaleR: "sgn (scaleR r x) = scaleR (sgn r) (sgn x)"
1239  for x :: "'a::real_normed_vector"
1240  by (simp add: sgn_div_norm ac_simps)
1241
1242lemma sgn_one [simp]: "sgn (1::'a::real_normed_algebra_1) = 1"
1243  by (simp add: sgn_div_norm)
1244
1245lemma sgn_of_real: "sgn (of_real r :: 'a::real_normed_algebra_1) = of_real (sgn r)"
1246  unfolding of_real_def by (simp only: sgn_scaleR sgn_one)
1247
1248lemma sgn_mult: "sgn (x * y) = sgn x * sgn y"
1249  for x y :: "'a::real_normed_div_algebra"
1250  by (simp add: sgn_div_norm norm_mult mult.commute)
1251
1252hide_fact (open) sgn_mult
1253
1254lemma real_sgn_eq: "sgn x = x / \<bar>x\<bar>"
1255  for x :: real
1256  by (simp add: sgn_div_norm divide_inverse)
1257
1258lemma zero_le_sgn_iff [simp]: "0 \<le> sgn x \<longleftrightarrow> 0 \<le> x"
1259  for x :: real
1260  by (cases "0::real" x rule: linorder_cases) simp_all
1261
1262lemma sgn_le_0_iff [simp]: "sgn x \<le> 0 \<longleftrightarrow> x \<le> 0"
1263  for x :: real
1264  by (cases "0::real" x rule: linorder_cases) simp_all
1265
1266lemma norm_conv_dist: "norm x = dist x 0"
1267  unfolding dist_norm by simp
1268
1269declare norm_conv_dist [symmetric, simp]
1270
1271lemma dist_0_norm [simp]: "dist 0 x = norm x"
1272  for x :: "'a::real_normed_vector"
1273  by (simp add: dist_norm)
1274
1275lemma dist_diff [simp]: "dist a (a - b) = norm b"  "dist (a - b) a = norm b"
1276  by (simp_all add: dist_norm)
1277
1278lemma dist_of_int: "dist (of_int m) (of_int n :: 'a :: real_normed_algebra_1) = of_int \<bar>m - n\<bar>"
1279proof -
1280  have "dist (of_int m) (of_int n :: 'a) = dist (of_int m :: 'a) (of_int m - (of_int (m - n)))"
1281    by simp
1282  also have "\<dots> = of_int \<bar>m - n\<bar>" by (subst dist_diff, subst norm_of_int) simp
1283  finally show ?thesis .
1284qed
1285
1286lemma dist_of_nat:
1287  "dist (of_nat m) (of_nat n :: 'a :: real_normed_algebra_1) = of_int \<bar>int m - int n\<bar>"
1288  by (subst (1 2) of_int_of_nat_eq [symmetric]) (rule dist_of_int)
1289
1290
1291subsection \<open>Bounded Linear and Bilinear Operators\<close>
1292
1293lemma linearI: "linear f"
1294  if "\<And>b1 b2. f (b1 + b2) = f b1 + f b2"
1295    "\<And>r b. f (r *\<^sub>R b) = r *\<^sub>R f b"
1296  using that
1297  by unfold_locales (auto simp: algebra_simps)
1298
1299lemma linear_iff:
1300  "linear f \<longleftrightarrow> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (c *\<^sub>R x) = c *\<^sub>R f x)"
1301  (is "linear f \<longleftrightarrow> ?rhs")
1302proof
1303  assume "linear f"
1304  then interpret f: linear f .
1305  show "?rhs" by (simp add: f.add f.scale)
1306next
1307  assume "?rhs"
1308  then show "linear f" by (intro linearI) auto
1309qed
1310
1311lemmas linear_scaleR_left = linear_scale_left
1312lemmas linear_imp_scaleR = linear_imp_scale
1313
1314corollary real_linearD:
1315  fixes f :: "real \<Rightarrow> real"
1316  assumes "linear f" obtains c where "f = ( *) c"
1317  by (rule linear_imp_scaleR [OF assms]) (force simp: scaleR_conv_of_real)
1318
1319lemma linear_times_of_real: "linear (\<lambda>x. a * of_real x)"
1320  by (auto intro!: linearI simp: distrib_left)
1321    (metis mult_scaleR_right scaleR_conv_of_real)
1322
1323locale bounded_linear = linear f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
1324  assumes bounded: "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
1325begin
1326
1327lemma pos_bounded: "\<exists>K>0. \<forall>x. norm (f x) \<le> norm x * K"
1328proof -
1329  obtain K where K: "\<And>x. norm (f x) \<le> norm x * K"
1330    using bounded by blast
1331  show ?thesis
1332  proof (intro exI impI conjI allI)
1333    show "0 < max 1 K"
1334      by (rule order_less_le_trans [OF zero_less_one max.cobounded1])
1335  next
1336    fix x
1337    have "norm (f x) \<le> norm x * K" using K .
1338    also have "\<dots> \<le> norm x * max 1 K"
1339      by (rule mult_left_mono [OF max.cobounded2 norm_ge_zero])
1340    finally show "norm (f x) \<le> norm x * max 1 K" .
1341  qed
1342qed
1343
1344lemma nonneg_bounded: "\<exists>K\<ge>0. \<forall>x. norm (f x) \<le> norm x * K"
1345  using pos_bounded by (auto intro: order_less_imp_le)
1346
1347lemma linear: "linear f"
1348  by (fact local.linear_axioms)
1349
1350end
1351
1352lemma bounded_linear_intro:
1353  assumes "\<And>x y. f (x + y) = f x + f y"
1354    and "\<And>r x. f (scaleR r x) = scaleR r (f x)"
1355    and "\<And>x. norm (f x) \<le> norm x * K"
1356  shows "bounded_linear f"
1357  by standard (blast intro: assms)+
1358
1359locale bounded_bilinear =
1360  fixes prod :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
1361    (infixl "**" 70)
1362  assumes add_left: "prod (a + a') b = prod a b + prod a' b"
1363    and add_right: "prod a (b + b') = prod a b + prod a b'"
1364    and scaleR_left: "prod (scaleR r a) b = scaleR r (prod a b)"
1365    and scaleR_right: "prod a (scaleR r b) = scaleR r (prod a b)"
1366    and bounded: "\<exists>K. \<forall>a b. norm (prod a b) \<le> norm a * norm b * K"
1367begin
1368
1369lemma pos_bounded: "\<exists>K>0. \<forall>a b. norm (a ** b) \<le> norm a * norm b * K"
1370proof -
1371  obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
1372    using bounded by blast
1373  then have "norm (a ** b) \<le> norm a * norm b * (max 1 K)" for a b
1374    by (rule order.trans) (simp add: mult_left_mono)
1375  then show ?thesis
1376    by force
1377qed
1378
1379lemma nonneg_bounded: "\<exists>K\<ge>0. \<forall>a b. norm (a ** b) \<le> norm a * norm b * K"
1380  using pos_bounded by (auto intro: order_less_imp_le)
1381
1382lemma additive_right: "additive (\<lambda>b. prod a b)"
1383  by (rule additive.intro, rule add_right)
1384
1385lemma additive_left: "additive (\<lambda>a. prod a b)"
1386  by (rule additive.intro, rule add_left)
1387
1388lemma zero_left: "prod 0 b = 0"
1389  by (rule additive.zero [OF additive_left])
1390
1391lemma zero_right: "prod a 0 = 0"
1392  by (rule additive.zero [OF additive_right])
1393
1394lemma minus_left: "prod (- a) b = - prod a b"
1395  by (rule additive.minus [OF additive_left])
1396
1397lemma minus_right: "prod a (- b) = - prod a b"
1398  by (rule additive.minus [OF additive_right])
1399
1400lemma diff_left: "prod (a - a') b = prod a b - prod a' b"
1401  by (rule additive.diff [OF additive_left])
1402
1403lemma diff_right: "prod a (b - b') = prod a b - prod a b'"
1404  by (rule additive.diff [OF additive_right])
1405
1406lemma sum_left: "prod (sum g S) x = sum ((\<lambda>i. prod (g i) x)) S"
1407  by (rule additive.sum [OF additive_left])
1408
1409lemma sum_right: "prod x (sum g S) = sum ((\<lambda>i. (prod x (g i)))) S"
1410  by (rule additive.sum [OF additive_right])
1411
1412
1413lemma bounded_linear_left: "bounded_linear (\<lambda>a. a ** b)"
1414proof -
1415  obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
1416    using pos_bounded by blast
1417  then show ?thesis
1418    by (rule_tac K="norm b * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_left add_left)
1419qed
1420
1421lemma bounded_linear_right: "bounded_linear (\<lambda>b. a ** b)"
1422proof -
1423  obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
1424    using pos_bounded by blast
1425  then show ?thesis
1426    by (rule_tac K="norm a * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_right add_right)
1427qed
1428
1429lemma prod_diff_prod: "(x ** y - a ** b) = (x - a) ** (y - b) + (x - a) ** b + a ** (y - b)"
1430  by (simp add: diff_left diff_right)
1431
1432lemma flip: "bounded_bilinear (\<lambda>x y. y ** x)"
1433  apply standard
1434      apply (simp_all add: add_right add_left scaleR_right scaleR_left)
1435  by (metis bounded mult.commute)
1436
1437lemma comp1:
1438  assumes "bounded_linear g"
1439  shows "bounded_bilinear (\<lambda>x. ( **) (g x))"
1440proof unfold_locales
1441  interpret g: bounded_linear g by fact
1442  show "\<And>a a' b. g (a + a') ** b = g a ** b + g a' ** b"
1443    "\<And>a b b'. g a ** (b + b') = g a ** b + g a ** b'"
1444    "\<And>r a b. g (r *\<^sub>R a) ** b = r *\<^sub>R (g a ** b)"
1445    "\<And>a r b. g a ** (r *\<^sub>R b) = r *\<^sub>R (g a ** b)"
1446    by (auto simp: g.add add_left add_right g.scaleR scaleR_left scaleR_right)
1447  from g.nonneg_bounded nonneg_bounded obtain K L
1448    where nn: "0 \<le> K" "0 \<le> L"
1449      and K: "\<And>x. norm (g x) \<le> norm x * K"
1450      and L: "\<And>a b. norm (a ** b) \<le> norm a * norm b * L"
1451    by auto
1452  have "norm (g a ** b) \<le> norm a * K * norm b * L" for a b
1453    by (auto intro!:  order_trans[OF K] order_trans[OF L] mult_mono simp: nn)
1454  then show "\<exists>K. \<forall>a b. norm (g a ** b) \<le> norm a * norm b * K"
1455    by (auto intro!: exI[where x="K * L"] simp: ac_simps)
1456qed
1457
1458lemma comp: "bounded_linear f \<Longrightarrow> bounded_linear g \<Longrightarrow> bounded_bilinear (\<lambda>x y. f x ** g y)"
1459  by (rule bounded_bilinear.flip[OF bounded_bilinear.comp1[OF bounded_bilinear.flip[OF comp1]]])
1460
1461end
1462
1463lemma bounded_linear_ident[simp]: "bounded_linear (\<lambda>x. x)"
1464  by standard (auto intro!: exI[of _ 1])
1465
1466lemma bounded_linear_zero[simp]: "bounded_linear (\<lambda>x. 0)"
1467  by standard (auto intro!: exI[of _ 1])
1468
1469lemma bounded_linear_add:
1470  assumes "bounded_linear f"
1471    and "bounded_linear g"
1472  shows "bounded_linear (\<lambda>x. f x + g x)"
1473proof -
1474  interpret f: bounded_linear f by fact
1475  interpret g: bounded_linear g by fact
1476  show ?thesis
1477  proof
1478    from f.bounded obtain Kf where Kf: "norm (f x) \<le> norm x * Kf" for x
1479      by blast
1480    from g.bounded obtain Kg where Kg: "norm (g x) \<le> norm x * Kg" for x
1481      by blast
1482    show "\<exists>K. \<forall>x. norm (f x + g x) \<le> norm x * K"
1483      using add_mono[OF Kf Kg]
1484      by (intro exI[of _ "Kf + Kg"]) (auto simp: field_simps intro: norm_triangle_ineq order_trans)
1485  qed (simp_all add: f.add g.add f.scaleR g.scaleR scaleR_right_distrib)
1486qed
1487
1488lemma bounded_linear_minus:
1489  assumes "bounded_linear f"
1490  shows "bounded_linear (\<lambda>x. - f x)"
1491proof -
1492  interpret f: bounded_linear f by fact
1493  show ?thesis
1494    by unfold_locales (simp_all add: f.add f.scaleR f.bounded)
1495qed
1496
1497lemma bounded_linear_sub: "bounded_linear f \<Longrightarrow> bounded_linear g \<Longrightarrow> bounded_linear (\<lambda>x. f x - g x)"
1498  using bounded_linear_add[of f "\<lambda>x. - g x"] bounded_linear_minus[of g]
1499  by (auto simp: algebra_simps)
1500
1501lemma bounded_linear_sum:
1502  fixes f :: "'i \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
1503  shows "(\<And>i. i \<in> I \<Longrightarrow> bounded_linear (f i)) \<Longrightarrow> bounded_linear (\<lambda>x. \<Sum>i\<in>I. f i x)"
1504  by (induct I rule: infinite_finite_induct) (auto intro!: bounded_linear_add)
1505
1506lemma bounded_linear_compose:
1507  assumes "bounded_linear f"
1508    and "bounded_linear g"
1509  shows "bounded_linear (\<lambda>x. f (g x))"
1510proof -
1511  interpret f: bounded_linear f by fact
1512  interpret g: bounded_linear g by fact
1513  show ?thesis
1514  proof unfold_locales
1515    show "f (g (x + y)) = f (g x) + f (g y)" for x y
1516      by (simp only: f.add g.add)
1517    show "f (g (scaleR r x)) = scaleR r (f (g x))" for r x
1518      by (simp only: f.scaleR g.scaleR)
1519    from f.pos_bounded obtain Kf where f: "\<And>x. norm (f x) \<le> norm x * Kf" and Kf: "0 < Kf"
1520      by blast
1521    from g.pos_bounded obtain Kg where g: "\<And>x. norm (g x) \<le> norm x * Kg"
1522      by blast
1523    show "\<exists>K. \<forall>x. norm (f (g x)) \<le> norm x * K"
1524    proof (intro exI allI)
1525      fix x
1526      have "norm (f (g x)) \<le> norm (g x) * Kf"
1527        using f .
1528      also have "\<dots> \<le> (norm x * Kg) * Kf"
1529        using g Kf [THEN order_less_imp_le] by (rule mult_right_mono)
1530      also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)"
1531        by (rule mult.assoc)
1532      finally show "norm (f (g x)) \<le> norm x * (Kg * Kf)" .
1533    qed
1534  qed
1535qed
1536
1537lemma bounded_bilinear_mult: "bounded_bilinear (( *) :: 'a \<Rightarrow> 'a \<Rightarrow> 'a::real_normed_algebra)"
1538  apply (rule bounded_bilinear.intro)
1539      apply (auto simp: algebra_simps)
1540  apply (rule_tac x=1 in exI)
1541  apply (simp add: norm_mult_ineq)
1542  done
1543
1544lemma bounded_linear_mult_left: "bounded_linear (\<lambda>x::'a::real_normed_algebra. x * y)"
1545  using bounded_bilinear_mult
1546  by (rule bounded_bilinear.bounded_linear_left)
1547
1548lemma bounded_linear_mult_right: "bounded_linear (\<lambda>y::'a::real_normed_algebra. x * y)"
1549  using bounded_bilinear_mult
1550  by (rule bounded_bilinear.bounded_linear_right)
1551
1552lemmas bounded_linear_mult_const =
1553  bounded_linear_mult_left [THEN bounded_linear_compose]
1554
1555lemmas bounded_linear_const_mult =
1556  bounded_linear_mult_right [THEN bounded_linear_compose]
1557
1558lemma bounded_linear_divide: "bounded_linear (\<lambda>x. x / y)"
1559  for y :: "'a::real_normed_field"
1560  unfolding divide_inverse by (rule bounded_linear_mult_left)
1561
1562lemma bounded_bilinear_scaleR: "bounded_bilinear scaleR"
1563  apply (rule bounded_bilinear.intro)
1564      apply (auto simp: algebra_simps)
1565  apply (rule_tac x=1 in exI, simp)
1566  done
1567
1568lemma bounded_linear_scaleR_left: "bounded_linear (\<lambda>r. scaleR r x)"
1569  using bounded_bilinear_scaleR
1570  by (rule bounded_bilinear.bounded_linear_left)
1571
1572lemma bounded_linear_scaleR_right: "bounded_linear (\<lambda>x. scaleR r x)"
1573  using bounded_bilinear_scaleR
1574  by (rule bounded_bilinear.bounded_linear_right)
1575
1576lemmas bounded_linear_scaleR_const =
1577  bounded_linear_scaleR_left[THEN bounded_linear_compose]
1578
1579lemmas bounded_linear_const_scaleR =
1580  bounded_linear_scaleR_right[THEN bounded_linear_compose]
1581
1582lemma bounded_linear_of_real: "bounded_linear (\<lambda>r. of_real r)"
1583  unfolding of_real_def by (rule bounded_linear_scaleR_left)
1584
1585lemma real_bounded_linear: "bounded_linear f \<longleftrightarrow> (\<exists>c::real. f = (\<lambda>x. x * c))"
1586  for f :: "real \<Rightarrow> real"
1587proof -
1588  {
1589    fix x
1590    assume "bounded_linear f"
1591    then interpret bounded_linear f .
1592    from scaleR[of x 1] have "f x = x * f 1"
1593      by simp
1594  }
1595  then show ?thesis
1596    by (auto intro: exI[of _ "f 1"] bounded_linear_mult_left)
1597qed
1598
1599instance real_normed_algebra_1 \<subseteq> perfect_space
1600proof
1601  show "\<not> open {x}" for x :: 'a
1602    apply (clarsimp simp: open_dist dist_norm)
1603    apply (rule_tac x = "x + of_real (e/2)" in exI)
1604    apply simp
1605    done
1606qed
1607
1608
1609subsection \<open>Filters and Limits on Metric Space\<close>
1610
1611lemma (in metric_space) nhds_metric: "nhds x = (INF e:{0 <..}. principal {y. dist y x < e})"
1612  unfolding nhds_def
1613proof (safe intro!: INF_eq)
1614  fix S
1615  assume "open S" "x \<in> S"
1616  then obtain e where "{y. dist y x < e} \<subseteq> S" "0 < e"
1617    by (auto simp: open_dist subset_eq)
1618  then show "\<exists>e\<in>{0<..}. principal {y. dist y x < e} \<le> principal S"
1619    by auto
1620qed (auto intro!: exI[of _ "{y. dist x y < e}" for e] open_ball simp: dist_commute)
1621
1622lemma (in metric_space) tendsto_iff: "(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) F)"
1623  unfolding nhds_metric filterlim_INF filterlim_principal by auto
1624
1625lemma tendsto_dist_iff:
1626  "((f \<longlongrightarrow> l) F) \<longleftrightarrow> (((\<lambda>x. dist (f x) l) \<longlongrightarrow> 0) F)"
1627  unfolding tendsto_iff by simp
1628
1629lemma (in metric_space) tendstoI [intro?]:
1630  "(\<And>e. 0 < e \<Longrightarrow> eventually (\<lambda>x. dist (f x) l < e) F) \<Longrightarrow> (f \<longlongrightarrow> l) F"
1631  by (auto simp: tendsto_iff)
1632
1633lemma (in metric_space) tendstoD: "(f \<longlongrightarrow> l) F \<Longrightarrow> 0 < e \<Longrightarrow> eventually (\<lambda>x. dist (f x) l < e) F"
1634  by (auto simp: tendsto_iff)
1635
1636lemma (in metric_space) eventually_nhds_metric:
1637  "eventually P (nhds a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. dist x a < d \<longrightarrow> P x)"
1638  unfolding nhds_metric
1639  by (subst eventually_INF_base)
1640     (auto simp: eventually_principal Bex_def subset_eq intro: exI[of _ "min a b" for a b])
1641
1642lemma eventually_at: "eventually P (at a within S) \<longleftrightarrow> (\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<and> dist x a < d \<longrightarrow> P x)"
1643  for a :: "'a :: metric_space"
1644  by (auto simp: eventually_at_filter eventually_nhds_metric)
1645
1646lemma frequently_at: "frequently P (at a within S) \<longleftrightarrow> (\<forall>d>0. \<exists>x\<in>S. x \<noteq> a \<and> dist x a < d \<and> P x)"
1647  for a :: "'a :: metric_space"
1648  unfolding frequently_def eventually_at by auto
1649
1650lemma eventually_at_le: "eventually P (at a within S) \<longleftrightarrow> (\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<and> dist x a \<le> d \<longrightarrow> P x)"
1651  for a :: "'a::metric_space"
1652  unfolding eventually_at_filter eventually_nhds_metric
1653  apply safe
1654  apply (rule_tac x="d / 2" in exI, auto)
1655  done
1656
1657lemma eventually_at_left_real: "a > (b :: real) \<Longrightarrow> eventually (\<lambda>x. x \<in> {b<..<a}) (at_left a)"
1658  by (subst eventually_at, rule exI[of _ "a - b"]) (force simp: dist_real_def)
1659
1660lemma eventually_at_right_real: "a < (b :: real) \<Longrightarrow> eventually (\<lambda>x. x \<in> {a<..<b}) (at_right a)"
1661  by (subst eventually_at, rule exI[of _ "b - a"]) (force simp: dist_real_def)
1662
1663lemma metric_tendsto_imp_tendsto:
1664  fixes a :: "'a :: metric_space"
1665    and b :: "'b :: metric_space"
1666  assumes f: "(f \<longlongrightarrow> a) F"
1667    and le: "eventually (\<lambda>x. dist (g x) b \<le> dist (f x) a) F"
1668  shows "(g \<longlongrightarrow> b) F"
1669proof (rule tendstoI)
1670  fix e :: real
1671  assume "0 < e"
1672  with f have "eventually (\<lambda>x. dist (f x) a < e) F" by (rule tendstoD)
1673  with le show "eventually (\<lambda>x. dist (g x) b < e) F"
1674    using le_less_trans by (rule eventually_elim2)
1675qed
1676
1677lemma filterlim_real_sequentially: "LIM x sequentially. real x :> at_top"
1678  apply (clarsimp simp: filterlim_at_top)
1679  apply (rule_tac c="nat \<lceil>Z + 1\<rceil>" in eventually_sequentiallyI, linarith)
1680  done
1681
1682lemma filterlim_nat_sequentially: "filterlim nat sequentially at_top"
1683proof -
1684  have "\<forall>\<^sub>F x in at_top. Z \<le> nat x" for Z
1685    by (auto intro!: eventually_at_top_linorderI[where c="int Z"])
1686  then show ?thesis
1687    unfolding filterlim_at_top ..
1688qed
1689
1690lemma filterlim_floor_sequentially: "filterlim floor at_top at_top"
1691proof -
1692  have "\<forall>\<^sub>F x in at_top. Z \<le> \<lfloor>x\<rfloor>" for Z
1693    by (auto simp: le_floor_iff intro!: eventually_at_top_linorderI[where c="of_int Z"])
1694  then show ?thesis
1695    unfolding filterlim_at_top ..
1696qed
1697
1698lemma filterlim_sequentially_iff_filterlim_real:
1699  "filterlim f sequentially F \<longleftrightarrow> filterlim (\<lambda>x. real (f x)) at_top F"
1700  apply (rule iffI)
1701  subgoal using filterlim_compose filterlim_real_sequentially by blast
1702  subgoal premises prems
1703  proof -
1704    have "filterlim (\<lambda>x. nat (floor (real (f x)))) sequentially F"
1705      by (intro filterlim_compose[OF filterlim_nat_sequentially]
1706          filterlim_compose[OF filterlim_floor_sequentially] prems)
1707    then show ?thesis by simp
1708  qed
1709  done
1710
1711
1712subsubsection \<open>Limits of Sequences\<close>
1713
1714lemma lim_sequentially: "X \<longlonglongrightarrow> L \<longleftrightarrow> (\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (X n) L < r)"
1715  for L :: "'a::metric_space"
1716  unfolding tendsto_iff eventually_sequentially ..
1717
1718lemmas LIMSEQ_def = lim_sequentially  (*legacy binding*)
1719
1720lemma LIMSEQ_iff_nz: "X \<longlonglongrightarrow> L \<longleftrightarrow> (\<forall>r>0. \<exists>no>0. \<forall>n\<ge>no. dist (X n) L < r)"
1721  for L :: "'a::metric_space"
1722  unfolding lim_sequentially by (metis Suc_leD zero_less_Suc)
1723
1724lemma metric_LIMSEQ_I: "(\<And>r. 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. dist (X n) L < r) \<Longrightarrow> X \<longlonglongrightarrow> L"
1725  for L :: "'a::metric_space"
1726  by (simp add: lim_sequentially)
1727
1728lemma metric_LIMSEQ_D: "X \<longlonglongrightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. dist (X n) L < r"
1729  for L :: "'a::metric_space"
1730  by (simp add: lim_sequentially)
1731
1732lemma LIMSEQ_norm_0:
1733  assumes  "\<And>n::nat. norm (f n) < 1 / real (Suc n)"
1734  shows "f \<longlonglongrightarrow> 0"
1735proof (rule metric_LIMSEQ_I)
1736  fix \<epsilon> :: "real"
1737  assume "\<epsilon> > 0"
1738  then obtain N::nat where "\<epsilon> > inverse N" "N > 0"
1739    by (metis neq0_conv real_arch_inverse)
1740  then have "norm (f n) < \<epsilon>" if "n \<ge> N" for n
1741  proof -
1742    have "1 / (Suc n) \<le> 1 / N"
1743      using \<open>0 < N\<close> inverse_of_nat_le le_SucI that by blast
1744    also have "\<dots> < \<epsilon>"
1745      by (metis (no_types) \<open>inverse (real N) < \<epsilon>\<close> inverse_eq_divide)
1746    finally show ?thesis
1747      by (meson assms less_eq_real_def not_le order_trans)
1748  qed
1749  then show "\<exists>no. \<forall>n\<ge>no. dist (f n) 0 < \<epsilon>"
1750    by auto
1751qed
1752
1753
1754subsubsection \<open>Limits of Functions\<close>
1755
1756lemma LIM_def: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<forall>r > 0. \<exists>s > 0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r)"
1757  for a :: "'a::metric_space" and L :: "'b::metric_space"
1758  unfolding tendsto_iff eventually_at by simp
1759
1760lemma metric_LIM_I:
1761  "(\<And>r. 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r) \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
1762  for a :: "'a::metric_space" and L :: "'b::metric_space"
1763  by (simp add: LIM_def)
1764
1765lemma metric_LIM_D: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r"
1766  for a :: "'a::metric_space" and L :: "'b::metric_space"
1767  by (simp add: LIM_def)
1768
1769lemma metric_LIM_imp_LIM:
1770  fixes l :: "'a::metric_space"
1771    and m :: "'b::metric_space"
1772  assumes f: "f \<midarrow>a\<rightarrow> l"
1773    and le: "\<And>x. x \<noteq> a \<Longrightarrow> dist (g x) m \<le> dist (f x) l"
1774  shows "g \<midarrow>a\<rightarrow> m"
1775  by (rule metric_tendsto_imp_tendsto [OF f]) (auto simp: eventually_at_topological le)
1776
1777lemma metric_LIM_equal2:
1778  fixes a :: "'a::metric_space"
1779  assumes "g \<midarrow>a\<rightarrow> l" "0 < R"
1780    and "\<And>x. x \<noteq> a \<Longrightarrow> dist x a < R \<Longrightarrow> f x = g x"
1781  shows "f \<midarrow>a\<rightarrow> l"
1782proof -
1783  have "\<And>S. \<lbrakk>open S; l \<in> S; \<forall>\<^sub>F x in at a. g x \<in> S\<rbrakk> \<Longrightarrow> \<forall>\<^sub>F x in at a. f x \<in> S"
1784    apply (clarsimp simp add: eventually_at)
1785    apply (rule_tac x="min d R" in exI)
1786     apply (auto simp: assms)
1787    done
1788  then show ?thesis
1789    using assms by (simp add: tendsto_def)
1790qed
1791
1792lemma metric_LIM_compose2:
1793  fixes a :: "'a::metric_space"
1794  assumes f: "f \<midarrow>a\<rightarrow> b"
1795    and g: "g \<midarrow>b\<rightarrow> c"
1796    and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<noteq> b"
1797  shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
1798  using inj by (intro tendsto_compose_eventually[OF g f]) (auto simp: eventually_at)
1799
1800lemma metric_isCont_LIM_compose2:
1801  fixes f :: "'a :: metric_space \<Rightarrow> _"
1802  assumes f [unfolded isCont_def]: "isCont f a"
1803    and g: "g \<midarrow>f a\<rightarrow> l"
1804    and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<noteq> f a"
1805  shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> l"
1806  by (rule metric_LIM_compose2 [OF f g inj])
1807
1808
1809subsection \<open>Complete metric spaces\<close>
1810
1811subsection \<open>Cauchy sequences\<close>
1812
1813lemma (in metric_space) Cauchy_def: "Cauchy X = (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e)"
1814proof -
1815  have *: "eventually P (INF M. principal {(X m, X n) | n m. m \<ge> M \<and> n \<ge> M}) \<longleftrightarrow>
1816    (\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. P (X m, X n))" for P
1817    apply (subst eventually_INF_base)
1818    subgoal by simp
1819    subgoal for a b
1820      by (intro bexI[of _ "max a b"]) (auto simp: eventually_principal subset_eq)
1821    subgoal by (auto simp: eventually_principal, blast)
1822    done
1823  have "Cauchy X \<longleftrightarrow> (INF M. principal {(X m, X n) | n m. m \<ge> M \<and> n \<ge> M}) \<le> uniformity"
1824    unfolding Cauchy_uniform_iff le_filter_def * ..
1825  also have "\<dots> = (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e)"
1826    unfolding uniformity_dist le_INF_iff by (auto simp: * le_principal)
1827  finally show ?thesis .
1828qed
1829
1830lemma (in metric_space) Cauchy_altdef: "Cauchy f \<longleftrightarrow> (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (f m) (f n) < e)"
1831  (is "?lhs \<longleftrightarrow> ?rhs")
1832proof
1833  assume ?rhs
1834  show ?lhs
1835    unfolding Cauchy_def
1836  proof (intro allI impI)
1837    fix e :: real assume e: "e > 0"
1838    with \<open>?rhs\<close> obtain M where M: "m \<ge> M \<Longrightarrow> n > m \<Longrightarrow> dist (f m) (f n) < e" for m n
1839      by blast
1840    have "dist (f m) (f n) < e" if "m \<ge> M" "n \<ge> M" for m n
1841      using M[of m n] M[of n m] e that by (cases m n rule: linorder_cases) (auto simp: dist_commute)
1842    then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m) (f n) < e"
1843      by blast
1844  qed
1845next
1846  assume ?lhs
1847  show ?rhs
1848  proof (intro allI impI)
1849    fix e :: real
1850    assume e: "e > 0"
1851    with \<open>Cauchy f\<close> obtain M where "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> dist (f m) (f n) < e"
1852      unfolding Cauchy_def by blast
1853    then show "\<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (f m) (f n) < e"
1854      by (intro exI[of _ M]) force
1855  qed
1856qed
1857
1858lemma (in metric_space) Cauchy_altdef2: "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
1859proof 
1860  assume "Cauchy s"
1861  then show ?rhs by (force simp: Cauchy_def)
1862next
1863    assume ?rhs
1864    {
1865      fix e::real
1866      assume "e>0"
1867      with \<open>?rhs\<close> obtain N where N: "\<forall>n\<ge>N. dist (s n) (s N) < e/2"
1868        by (erule_tac x="e/2" in allE) auto
1869      {
1870        fix n m
1871        assume nm: "N \<le> m \<and> N \<le> n"
1872        then have "dist (s m) (s n) < e" using N
1873          using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
1874          by blast
1875      }
1876      then have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
1877        by blast
1878    }
1879    then have ?lhs
1880      unfolding Cauchy_def by blast
1881  then show ?lhs
1882    by blast
1883qed
1884
1885lemma (in metric_space) metric_CauchyI:
1886  "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e) \<Longrightarrow> Cauchy X"
1887  by (simp add: Cauchy_def)
1888
1889lemma (in metric_space) CauchyI':
1890  "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (X m) (X n) < e) \<Longrightarrow> Cauchy X"
1891  unfolding Cauchy_altdef by blast
1892
1893lemma (in metric_space) metric_CauchyD:
1894  "Cauchy X \<Longrightarrow> 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e"
1895  by (simp add: Cauchy_def)
1896
1897lemma (in metric_space) metric_Cauchy_iff2:
1898  "Cauchy X = (\<forall>j. (\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. dist (X m) (X n) < inverse(real (Suc j))))"
1899  apply (auto simp add: Cauchy_def)
1900  by (metis less_trans of_nat_Suc reals_Archimedean)
1901
1902lemma Cauchy_iff2: "Cauchy X \<longleftrightarrow> (\<forall>j. (\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. \<bar>X m - X n\<bar> < inverse (real (Suc j))))"
1903  by (simp only: metric_Cauchy_iff2 dist_real_def)
1904
1905lemma lim_1_over_n: "((\<lambda>n. 1 / of_nat n) \<longlongrightarrow> (0::'a::real_normed_field)) sequentially"
1906proof (subst lim_sequentially, intro allI impI exI)
1907  fix e :: real
1908  assume e: "e > 0"
1909  fix n :: nat
1910  assume n: "n \<ge> nat \<lceil>inverse e + 1\<rceil>"
1911  have "inverse e < of_nat (nat \<lceil>inverse e + 1\<rceil>)" by linarith
1912  also note n
1913  finally show "dist (1 / of_nat n :: 'a) 0 < e"
1914    using e by (simp add: divide_simps mult.commute norm_divide)
1915qed
1916
1917lemma (in metric_space) complete_def:
1918  shows "complete S = (\<forall>f. (\<forall>n. f n \<in> S) \<and> Cauchy f \<longrightarrow> (\<exists>l\<in>S. f \<longlonglongrightarrow> l))"
1919  unfolding complete_uniform
1920proof safe
1921  fix f :: "nat \<Rightarrow> 'a"
1922  assume f: "\<forall>n. f n \<in> S" "Cauchy f"
1923    and *: "\<forall>F\<le>principal S. F \<noteq> bot \<longrightarrow> cauchy_filter F \<longrightarrow> (\<exists>x\<in>S. F \<le> nhds x)"
1924  then show "\<exists>l\<in>S. f \<longlonglongrightarrow> l"
1925    unfolding filterlim_def using f
1926    by (intro *[rule_format])
1927       (auto simp: filtermap_sequentually_ne_bot le_principal eventually_filtermap Cauchy_uniform)
1928next
1929  fix F :: "'a filter"
1930  assume "F \<le> principal S" "F \<noteq> bot" "cauchy_filter F"
1931  assume seq: "\<forall>f. (\<forall>n. f n \<in> S) \<and> Cauchy f \<longrightarrow> (\<exists>l\<in>S. f \<longlonglongrightarrow> l)"
1932
1933  from \<open>F \<le> principal S\<close> \<open>cauchy_filter F\<close>
1934  have FF_le: "F \<times>\<^sub>F F \<le> uniformity_on S"
1935    by (simp add: cauchy_filter_def principal_prod_principal[symmetric] prod_filter_mono)
1936
1937  let ?P = "\<lambda>P e. eventually P F \<and> (\<forall>x. P x \<longrightarrow> x \<in> S) \<and> (\<forall>x y. P x \<longrightarrow> P y \<longrightarrow> dist x y < e)"
1938  have P: "\<exists>P. ?P P \<epsilon>" if "0 < \<epsilon>" for \<epsilon> :: real
1939  proof -
1940    from that have "eventually (\<lambda>(x, y). x \<in> S \<and> y \<in> S \<and> dist x y < \<epsilon>) (uniformity_on S)"
1941      by (auto simp: eventually_inf_principal eventually_uniformity_metric)
1942    from filter_leD[OF FF_le this] show ?thesis
1943      by (auto simp: eventually_prod_same)
1944  qed
1945
1946  have "\<exists>P. \<forall>n. ?P (P n) (1 / Suc n) \<and> P (Suc n) \<le> P n"
1947  proof (rule dependent_nat_choice)
1948    show "\<exists>P. ?P P (1 / Suc 0)"
1949      using P[of 1] by auto
1950  next
1951    fix P n assume "?P P (1/Suc n)"
1952    moreover obtain Q where "?P Q (1 / Suc (Suc n))"
1953      using P[of "1/Suc (Suc n)"] by auto
1954    ultimately show "\<exists>Q. ?P Q (1 / Suc (Suc n)) \<and> Q \<le> P"
1955      by (intro exI[of _ "\<lambda>x. P x \<and> Q x"]) (auto simp: eventually_conj_iff)
1956  qed
1957  then obtain P where P: "eventually (P n) F" "P n x \<Longrightarrow> x \<in> S"
1958    "P n x \<Longrightarrow> P n y \<Longrightarrow> dist x y < 1 / Suc n" "P (Suc n) \<le> P n"
1959    for n x y
1960    by metis
1961  have "antimono P"
1962    using P(4) unfolding decseq_Suc_iff le_fun_def by blast
1963
1964  obtain X where X: "P n (X n)" for n
1965    using P(1)[THEN eventually_happens'[OF \<open>F \<noteq> bot\<close>]] by metis
1966  have "Cauchy X"
1967    unfolding metric_Cauchy_iff2 inverse_eq_divide
1968  proof (intro exI allI impI)
1969    fix j m n :: nat
1970    assume "j \<le> m" "j \<le> n"
1971    with \<open>antimono P\<close> X have "P j (X m)" "P j (X n)"
1972      by (auto simp: antimono_def)
1973    then show "dist (X m) (X n) < 1 / Suc j"
1974      by (rule P)
1975  qed
1976  moreover have "\<forall>n. X n \<in> S"
1977    using P(2) X by auto
1978  ultimately obtain x where "X \<longlonglongrightarrow> x" "x \<in> S"
1979    using seq by blast
1980
1981  show "\<exists>x\<in>S. F \<le> nhds x"
1982  proof (rule bexI)
1983    have "eventually (\<lambda>y. dist y x < e) F" if "0 < e" for e :: real
1984    proof -
1985      from that have "(\<lambda>n. 1 / Suc n :: real) \<longlonglongrightarrow> 0 \<and> 0 < e / 2"
1986        by (subst LIMSEQ_Suc_iff) (auto intro!: lim_1_over_n)
1987      then have "\<forall>\<^sub>F n in sequentially. dist (X n) x < e / 2 \<and> 1 / Suc n < e / 2"
1988        using \<open>X \<longlonglongrightarrow> x\<close>
1989        unfolding tendsto_iff order_tendsto_iff[where 'a=real] eventually_conj_iff
1990        by blast
1991      then obtain n where "dist x (X n) < e / 2" "1 / Suc n < e / 2"
1992        by (auto simp: eventually_sequentially dist_commute)
1993      show ?thesis
1994        using \<open>eventually (P n) F\<close>
1995      proof eventually_elim
1996        case (elim y)
1997        then have "dist y (X n) < 1 / Suc n"
1998          by (intro X P)
1999        also have "\<dots> < e / 2" by fact
2000        finally show "dist y x < e"
2001          by (rule dist_triangle_half_l) fact
2002      qed
2003    qed
2004    then show "F \<le> nhds x"
2005      unfolding nhds_metric le_INF_iff le_principal by auto
2006  qed fact
2007qed
2008
2009text\<open>apparently unused\<close>
2010lemma (in metric_space) totally_bounded_metric:
2011  "totally_bounded S \<longleftrightarrow> (\<forall>e>0. \<exists>k. finite k \<and> S \<subseteq> (\<Union>x\<in>k. {y. dist x y < e}))"
2012  unfolding totally_bounded_def eventually_uniformity_metric imp_ex
2013  apply (subst all_comm)
2014  apply (intro arg_cong[where f=All] ext, safe)
2015  subgoal for e
2016    apply (erule allE[of _ "\<lambda>(x, y). dist x y < e"])
2017    apply auto
2018    done
2019  subgoal for e P k
2020    apply (intro exI[of _ k])
2021    apply (force simp: subset_eq)
2022    done
2023  done
2024
2025
2026subsubsection \<open>Cauchy Sequences are Convergent\<close>
2027
2028(* TODO: update to uniform_space *)
2029class complete_space = metric_space +
2030  assumes Cauchy_convergent: "Cauchy X \<Longrightarrow> convergent X"
2031
2032lemma Cauchy_convergent_iff: "Cauchy X \<longleftrightarrow> convergent X"
2033  for X :: "nat \<Rightarrow> 'a::complete_space"
2034  by (blast intro: Cauchy_convergent convergent_Cauchy)
2035
2036text \<open>To prove that a Cauchy sequence converges, it suffices to show that a subsequence converges.\<close>
2037
2038lemma Cauchy_converges_subseq:
2039  fixes u::"nat \<Rightarrow> 'a::metric_space"
2040  assumes "Cauchy u"
2041    "strict_mono r"
2042    "(u \<circ> r) \<longlonglongrightarrow> l"
2043  shows "u \<longlonglongrightarrow> l"
2044proof -
2045  have *: "eventually (\<lambda>n. dist (u n) l < e) sequentially" if "e > 0" for e
2046  proof -
2047    have "e/2 > 0" using that by auto
2048    then obtain N1 where N1: "\<And>m n. m \<ge> N1 \<Longrightarrow> n \<ge> N1 \<Longrightarrow> dist (u m) (u n) < e/2"
2049      using \<open>Cauchy u\<close> unfolding Cauchy_def by blast
2050    obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> dist ((u \<circ> r) n) l < e / 2"
2051      using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff \<open>(u \<circ> r) \<longlonglongrightarrow> l\<close>] \<open>e/2 > 0\<close>]
2052      unfolding eventually_sequentially by auto
2053    have "dist (u n) l < e" if "n \<ge> max N1 N2" for n
2054    proof -
2055      have "dist (u n) l \<le> dist (u n) ((u \<circ> r) n) + dist ((u \<circ> r) n) l"
2056        by (rule dist_triangle)
2057      also have "\<dots> < e/2 + e/2"
2058        apply (intro add_strict_mono)
2059        using N1[of n "r n"] N2[of n] that unfolding comp_def
2060        by (auto simp: less_imp_le) (meson assms(2) less_imp_le order.trans seq_suble)
2061      finally show ?thesis by simp
2062    qed 
2063    then show ?thesis unfolding eventually_sequentially by blast
2064  qed
2065  have "(\<lambda>n. dist (u n) l) \<longlonglongrightarrow> 0"
2066    apply (rule order_tendstoI)
2067    using * by auto (meson eventually_sequentiallyI less_le_trans zero_le_dist)
2068  then show ?thesis using tendsto_dist_iff by auto
2069qed
2070
2071subsection \<open>The set of real numbers is a complete metric space\<close>
2072
2073text \<open>
2074  Proof that Cauchy sequences converge based on the one from
2075  \<^url>\<open>http://pirate.shu.edu/~wachsmut/ira/numseq/proofs/cauconv.html\<close>
2076\<close>
2077
2078text \<open>
2079  If sequence @{term "X"} is Cauchy, then its limit is the lub of
2080  @{term "{r::real. \<exists>N. \<forall>n\<ge>N. r < X n}"}
2081\<close>
2082lemma increasing_LIMSEQ:
2083  fixes f :: "nat \<Rightarrow> real"
2084  assumes inc: "\<And>n. f n \<le> f (Suc n)"
2085    and bdd: "\<And>n. f n \<le> l"
2086    and en: "\<And>e. 0 < e \<Longrightarrow> \<exists>n. l \<le> f n + e"
2087  shows "f \<longlonglongrightarrow> l"
2088proof (rule increasing_tendsto)
2089  fix x
2090  assume "x < l"
2091  with dense[of 0 "l - x"] obtain e where "0 < e" "e < l - x"
2092    by auto
2093  from en[OF \<open>0 < e\<close>] obtain n where "l - e \<le> f n"
2094    by (auto simp: field_simps)
2095  with \<open>e < l - x\<close> \<open>0 < e\<close> have "x < f n"
2096    by simp
2097  with incseq_SucI[of f, OF inc] show "eventually (\<lambda>n. x < f n) sequentially"
2098    by (auto simp: eventually_sequentially incseq_def intro: less_le_trans)
2099qed (use bdd in auto)
2100
2101lemma real_Cauchy_convergent:
2102  fixes X :: "nat \<Rightarrow> real"
2103  assumes X: "Cauchy X"
2104  shows "convergent X"
2105proof -
2106  define S :: "real set" where "S = {x. \<exists>N. \<forall>n\<ge>N. x < X n}"
2107  then have mem_S: "\<And>N x. \<forall>n\<ge>N. x < X n \<Longrightarrow> x \<in> S"
2108    by auto
2109
2110  have bound_isUb: "y \<le> x" if N: "\<forall>n\<ge>N. X n < x" and "y \<in> S" for N and x y :: real
2111  proof -
2112    from that have "\<exists>M. \<forall>n\<ge>M. y < X n"
2113      by (simp add: S_def)
2114    then obtain M where "\<forall>n\<ge>M. y < X n" ..
2115    then have "y < X (max M N)" by simp
2116    also have "\<dots> < x" using N by simp
2117    finally show ?thesis by (rule order_less_imp_le)
2118  qed
2119
2120  obtain N where "\<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m) (X n) < 1"
2121    using X[THEN metric_CauchyD, OF zero_less_one] by auto
2122  then have N: "\<forall>n\<ge>N. dist (X n) (X N) < 1" by simp
2123  have [simp]: "S \<noteq> {}"
2124  proof (intro exI ex_in_conv[THEN iffD1])
2125    from N have "\<forall>n\<ge>N. X N - 1 < X n"
2126      by (simp add: abs_diff_less_iff dist_real_def)
2127    then show "X N - 1 \<in> S" by (rule mem_S)
2128  qed
2129  have [simp]: "bdd_above S"
2130  proof
2131    from N have "\<forall>n\<ge>N. X n < X N + 1"
2132      by (simp add: abs_diff_less_iff dist_real_def)
2133    then show "\<And>s. s \<in> S \<Longrightarrow>  s \<le> X N + 1"
2134      by (rule bound_isUb)
2135  qed
2136  have "X \<longlonglongrightarrow> Sup S"
2137  proof (rule metric_LIMSEQ_I)
2138    fix r :: real
2139    assume "0 < r"
2140    then have r: "0 < r/2" by simp
2141    obtain N where "\<forall>n\<ge>N. \<forall>m\<ge>N. dist (X n) (X m) < r/2"
2142      using metric_CauchyD [OF X r] by auto
2143    then have "\<forall>n\<ge>N. dist (X n) (X N) < r/2" by simp
2144    then have N: "\<forall>n\<ge>N. X N - r/2 < X n \<and> X n < X N + r/2"
2145      by (simp only: dist_real_def abs_diff_less_iff)
2146
2147    from N have "\<forall>n\<ge>N. X N - r/2 < X n" by blast
2148    then have "X N - r/2 \<in> S" by (rule mem_S)
2149    then have 1: "X N - r/2 \<le> Sup S" by (simp add: cSup_upper)
2150
2151    from N have "\<forall>n\<ge>N. X n < X N + r/2" by blast
2152    from bound_isUb[OF this]
2153    have 2: "Sup S \<le> X N + r/2"
2154      by (intro cSup_least) simp_all
2155
2156    show "\<exists>N. \<forall>n\<ge>N. dist (X n) (Sup S) < r"
2157    proof (intro exI allI impI)
2158      fix n
2159      assume n: "N \<le> n"
2160      from N n have "X n < X N + r/2" and "X N - r/2 < X n"
2161        by simp_all
2162      then show "dist (X n) (Sup S) < r" using 1 2
2163        by (simp add: abs_diff_less_iff dist_real_def)
2164    qed
2165  qed
2166  then show ?thesis by (auto simp: convergent_def)
2167qed
2168
2169instance real :: complete_space
2170  by intro_classes (rule real_Cauchy_convergent)
2171
2172class banach = real_normed_vector + complete_space
2173
2174instance real :: banach ..
2175
2176lemma tendsto_at_topI_sequentially:
2177  fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
2178  assumes *: "\<And>X. filterlim X at_top sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
2179  shows "(f \<longlongrightarrow> y) at_top"
2180proof -
2181  obtain A where A: "decseq A" "open (A n)" "y \<in> A n" "nhds y = (INF n. principal (A n))" for n
2182    by (rule nhds_countable[of y]) (rule that)
2183
2184  have "\<forall>m. \<exists>k. \<forall>x\<ge>k. f x \<in> A m"
2185  proof (rule ccontr)
2186    assume "\<not> (\<forall>m. \<exists>k. \<forall>x\<ge>k. f x \<in> A m)"
2187    then obtain m where "\<And>k. \<exists>x\<ge>k. f x \<notin> A m"
2188      by auto
2189    then have "\<exists>X. \<forall>n. (f (X n) \<notin> A m) \<and> max n (X n) + 1 \<le> X (Suc n)"
2190      by (intro dependent_nat_choice) (auto simp del: max.bounded_iff)
2191    then obtain X where X: "\<And>n. f (X n) \<notin> A m" "\<And>n. max n (X n) + 1 \<le> X (Suc n)"
2192      by auto
2193    have "1 \<le> n \<Longrightarrow> real n \<le> X n" for n
2194      using X[of "n - 1"] by auto
2195    then have "filterlim X at_top sequentially"
2196      by (force intro!: filterlim_at_top_mono[OF filterlim_real_sequentially]
2197          simp: eventually_sequentially)
2198    from topological_tendstoD[OF *[OF this] A(2, 3), of m] X(1) show False
2199      by auto
2200  qed
2201  then obtain k where "k m \<le> x \<Longrightarrow> f x \<in> A m" for m x
2202    by metis
2203  then show ?thesis
2204    unfolding at_top_def A by (intro filterlim_base[where i=k]) auto
2205qed
2206
2207lemma tendsto_at_topI_sequentially_real:
2208  fixes f :: "real \<Rightarrow> real"
2209  assumes mono: "mono f"
2210    and limseq: "(\<lambda>n. f (real n)) \<longlonglongrightarrow> y"
2211  shows "(f \<longlongrightarrow> y) at_top"
2212proof (rule tendstoI)
2213  fix e :: real
2214  assume "0 < e"
2215  with limseq obtain N :: nat where N: "N \<le> n \<Longrightarrow> \<bar>f (real n) - y\<bar> < e" for n
2216    by (auto simp: lim_sequentially dist_real_def)
2217  have le: "f x \<le> y" for x :: real
2218  proof -
2219    obtain n where "x \<le> real_of_nat n"
2220      using real_arch_simple[of x] ..
2221    note monoD[OF mono this]
2222    also have "f (real_of_nat n) \<le> y"
2223      by (rule LIMSEQ_le_const[OF limseq]) (auto intro!: exI[of _ n] monoD[OF mono])
2224    finally show ?thesis .
2225  qed
2226  have "eventually (\<lambda>x. real N \<le> x) at_top"
2227    by (rule eventually_ge_at_top)
2228  then show "eventually (\<lambda>x. dist (f x) y < e) at_top"
2229  proof eventually_elim
2230    case (elim x)
2231    with N[of N] le have "y - f (real N) < e" by auto
2232    moreover note monoD[OF mono elim]
2233    ultimately show "dist (f x) y < e"
2234      using le[of x] by (auto simp: dist_real_def field_simps)
2235  qed
2236qed
2237
2238end
2239