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