|
1 (* Title: Library/Euclidean_Space |
|
2 Author: Amine Chaieb, University of Cambridge |
|
3 *) |
|
4 |
|
5 header {* (Real) Vectors in Euclidean space, and elementary linear algebra.*} |
|
6 |
|
7 theory Euclidean_Space |
|
8 imports |
|
9 Complex_Main "~~/src/HOL/Decision_Procs/Dense_Linear_Order" |
|
10 Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type |
|
11 Inner_Product |
|
12 uses "positivstellensatz.ML" ("normarith.ML") |
|
13 begin |
|
14 |
|
15 text{* Some common special cases.*} |
|
16 |
|
17 lemma forall_1: "(\<forall>i::1. P i) \<longleftrightarrow> P 1" |
|
18 by (metis num1_eq_iff) |
|
19 |
|
20 lemma exhaust_2: |
|
21 fixes x :: 2 shows "x = 1 \<or> x = 2" |
|
22 proof (induct x) |
|
23 case (of_int z) |
|
24 then have "0 <= z" and "z < 2" by simp_all |
|
25 then have "z = 0 | z = 1" by arith |
|
26 then show ?case by auto |
|
27 qed |
|
28 |
|
29 lemma forall_2: "(\<forall>i::2. P i) \<longleftrightarrow> P 1 \<and> P 2" |
|
30 by (metis exhaust_2) |
|
31 |
|
32 lemma exhaust_3: |
|
33 fixes x :: 3 shows "x = 1 \<or> x = 2 \<or> x = 3" |
|
34 proof (induct x) |
|
35 case (of_int z) |
|
36 then have "0 <= z" and "z < 3" by simp_all |
|
37 then have "z = 0 \<or> z = 1 \<or> z = 2" by arith |
|
38 then show ?case by auto |
|
39 qed |
|
40 |
|
41 lemma forall_3: "(\<forall>i::3. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3" |
|
42 by (metis exhaust_3) |
|
43 |
|
44 lemma UNIV_1: "UNIV = {1::1}" |
|
45 by (auto simp add: num1_eq_iff) |
|
46 |
|
47 lemma UNIV_2: "UNIV = {1::2, 2::2}" |
|
48 using exhaust_2 by auto |
|
49 |
|
50 lemma UNIV_3: "UNIV = {1::3, 2::3, 3::3}" |
|
51 using exhaust_3 by auto |
|
52 |
|
53 lemma setsum_1: "setsum f (UNIV::1 set) = f 1" |
|
54 unfolding UNIV_1 by simp |
|
55 |
|
56 lemma setsum_2: "setsum f (UNIV::2 set) = f 1 + f 2" |
|
57 unfolding UNIV_2 by simp |
|
58 |
|
59 lemma setsum_3: "setsum f (UNIV::3 set) = f 1 + f 2 + f 3" |
|
60 unfolding UNIV_3 by (simp add: add_ac) |
|
61 |
|
62 subsection{* Basic componentwise operations on vectors. *} |
|
63 |
|
64 instantiation "^" :: (plus,type) plus |
|
65 begin |
|
66 definition vector_add_def : "op + \<equiv> (\<lambda> x y. (\<chi> i. (x$i) + (y$i)))" |
|
67 instance .. |
|
68 end |
|
69 |
|
70 instantiation "^" :: (times,type) times |
|
71 begin |
|
72 definition vector_mult_def : "op * \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))" |
|
73 instance .. |
|
74 end |
|
75 |
|
76 instantiation "^" :: (minus,type) minus begin |
|
77 definition vector_minus_def : "op - \<equiv> (\<lambda> x y. (\<chi> i. (x$i) - (y$i)))" |
|
78 instance .. |
|
79 end |
|
80 |
|
81 instantiation "^" :: (uminus,type) uminus begin |
|
82 definition vector_uminus_def : "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))" |
|
83 instance .. |
|
84 end |
|
85 instantiation "^" :: (zero,type) zero begin |
|
86 definition vector_zero_def : "0 \<equiv> (\<chi> i. 0)" |
|
87 instance .. |
|
88 end |
|
89 |
|
90 instantiation "^" :: (one,type) one begin |
|
91 definition vector_one_def : "1 \<equiv> (\<chi> i. 1)" |
|
92 instance .. |
|
93 end |
|
94 |
|
95 instantiation "^" :: (ord,type) ord |
|
96 begin |
|
97 definition vector_less_eq_def: |
|
98 "less_eq (x :: 'a ^'b) y = (ALL i. x$i <= y$i)" |
|
99 definition vector_less_def: "less (x :: 'a ^'b) y = (ALL i. x$i < y$i)" |
|
100 |
|
101 instance by (intro_classes) |
|
102 end |
|
103 |
|
104 instantiation "^" :: (scaleR, type) scaleR |
|
105 begin |
|
106 definition vector_scaleR_def: "scaleR = (\<lambda> r x. (\<chi> i. scaleR r (x$i)))" |
|
107 instance .. |
|
108 end |
|
109 |
|
110 text{* Also the scalar-vector multiplication. *} |
|
111 |
|
112 definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70) |
|
113 where "c *s x = (\<chi> i. c * (x$i))" |
|
114 |
|
115 text{* Constant Vectors *} |
|
116 |
|
117 definition "vec x = (\<chi> i. x)" |
|
118 |
|
119 text{* Dot products. *} |
|
120 |
|
121 definition dot :: "'a::{comm_monoid_add, times} ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" (infix "\<bullet>" 70) where |
|
122 "x \<bullet> y = setsum (\<lambda>i. x$i * y$i) UNIV" |
|
123 |
|
124 lemma dot_1[simp]: "(x::'a::{comm_monoid_add, times}^1) \<bullet> y = (x$1) * (y$1)" |
|
125 by (simp add: dot_def setsum_1) |
|
126 |
|
127 lemma dot_2[simp]: "(x::'a::{comm_monoid_add, times}^2) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2)" |
|
128 by (simp add: dot_def setsum_2) |
|
129 |
|
130 lemma dot_3[simp]: "(x::'a::{comm_monoid_add, times}^3) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2) + (x$3) * (y$3)" |
|
131 by (simp add: dot_def setsum_3) |
|
132 |
|
133 subsection {* A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space. *} |
|
134 |
|
135 method_setup vector = {* |
|
136 let |
|
137 val ss1 = HOL_basic_ss addsimps [@{thm dot_def}, @{thm setsum_addf} RS sym, |
|
138 @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib}, |
|
139 @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym] |
|
140 val ss2 = @{simpset} addsimps |
|
141 [@{thm vector_add_def}, @{thm vector_mult_def}, |
|
142 @{thm vector_minus_def}, @{thm vector_uminus_def}, |
|
143 @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def}, |
|
144 @{thm vector_scaleR_def}, |
|
145 @{thm Cart_lambda_beta}, @{thm vector_scalar_mult_def}] |
|
146 fun vector_arith_tac ths = |
|
147 simp_tac ss1 |
|
148 THEN' (fn i => rtac @{thm setsum_cong2} i |
|
149 ORELSE rtac @{thm setsum_0'} i |
|
150 ORELSE simp_tac (HOL_basic_ss addsimps [@{thm "Cart_eq"}]) i) |
|
151 (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *) |
|
152 THEN' asm_full_simp_tac (ss2 addsimps ths) |
|
153 in |
|
154 Attrib.thms >> (fn ths => K (SIMPLE_METHOD' (vector_arith_tac ths))) |
|
155 end |
|
156 *} "Lifts trivial vector statements to real arith statements" |
|
157 |
|
158 lemma vec_0[simp]: "vec 0 = 0" by (vector vector_zero_def) |
|
159 lemma vec_1[simp]: "vec 1 = 1" by (vector vector_one_def) |
|
160 |
|
161 |
|
162 |
|
163 text{* Obvious "component-pushing". *} |
|
164 |
|
165 lemma vec_component [simp]: "(vec x :: 'a ^ 'n)$i = x" |
|
166 by (vector vec_def) |
|
167 |
|
168 lemma vector_add_component [simp]: |
|
169 fixes x y :: "'a::{plus} ^ 'n" |
|
170 shows "(x + y)$i = x$i + y$i" |
|
171 by vector |
|
172 |
|
173 lemma vector_minus_component [simp]: |
|
174 fixes x y :: "'a::{minus} ^ 'n" |
|
175 shows "(x - y)$i = x$i - y$i" |
|
176 by vector |
|
177 |
|
178 lemma vector_mult_component [simp]: |
|
179 fixes x y :: "'a::{times} ^ 'n" |
|
180 shows "(x * y)$i = x$i * y$i" |
|
181 by vector |
|
182 |
|
183 lemma vector_smult_component [simp]: |
|
184 fixes y :: "'a::{times} ^ 'n" |
|
185 shows "(c *s y)$i = c * (y$i)" |
|
186 by vector |
|
187 |
|
188 lemma vector_uminus_component [simp]: |
|
189 fixes x :: "'a::{uminus} ^ 'n" |
|
190 shows "(- x)$i = - (x$i)" |
|
191 by vector |
|
192 |
|
193 lemma vector_scaleR_component [simp]: |
|
194 fixes x :: "'a::scaleR ^ 'n" |
|
195 shows "(scaleR r x)$i = scaleR r (x$i)" |
|
196 by vector |
|
197 |
|
198 lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector |
|
199 |
|
200 lemmas vector_component = |
|
201 vec_component vector_add_component vector_mult_component |
|
202 vector_smult_component vector_minus_component vector_uminus_component |
|
203 vector_scaleR_component cond_component |
|
204 |
|
205 subsection {* Some frequently useful arithmetic lemmas over vectors. *} |
|
206 |
|
207 instance "^" :: (semigroup_add,type) semigroup_add |
|
208 apply (intro_classes) by (vector add_assoc) |
|
209 |
|
210 |
|
211 instance "^" :: (monoid_add,type) monoid_add |
|
212 apply (intro_classes) by vector+ |
|
213 |
|
214 instance "^" :: (group_add,type) group_add |
|
215 apply (intro_classes) by (vector algebra_simps)+ |
|
216 |
|
217 instance "^" :: (ab_semigroup_add,type) ab_semigroup_add |
|
218 apply (intro_classes) by (vector add_commute) |
|
219 |
|
220 instance "^" :: (comm_monoid_add,type) comm_monoid_add |
|
221 apply (intro_classes) by vector |
|
222 |
|
223 instance "^" :: (ab_group_add,type) ab_group_add |
|
224 apply (intro_classes) by vector+ |
|
225 |
|
226 instance "^" :: (cancel_semigroup_add,type) cancel_semigroup_add |
|
227 apply (intro_classes) |
|
228 by (vector Cart_eq)+ |
|
229 |
|
230 instance "^" :: (cancel_ab_semigroup_add,type) cancel_ab_semigroup_add |
|
231 apply (intro_classes) |
|
232 by (vector Cart_eq) |
|
233 |
|
234 instance "^" :: (real_vector, type) real_vector |
|
235 by default (vector scaleR_left_distrib scaleR_right_distrib)+ |
|
236 |
|
237 instance "^" :: (semigroup_mult,type) semigroup_mult |
|
238 apply (intro_classes) by (vector mult_assoc) |
|
239 |
|
240 instance "^" :: (monoid_mult,type) monoid_mult |
|
241 apply (intro_classes) by vector+ |
|
242 |
|
243 instance "^" :: (ab_semigroup_mult,type) ab_semigroup_mult |
|
244 apply (intro_classes) by (vector mult_commute) |
|
245 |
|
246 instance "^" :: (ab_semigroup_idem_mult,type) ab_semigroup_idem_mult |
|
247 apply (intro_classes) by (vector mult_idem) |
|
248 |
|
249 instance "^" :: (comm_monoid_mult,type) comm_monoid_mult |
|
250 apply (intro_classes) by vector |
|
251 |
|
252 fun vector_power :: "('a::{one,times} ^'n) \<Rightarrow> nat \<Rightarrow> 'a^'n" where |
|
253 "vector_power x 0 = 1" |
|
254 | "vector_power x (Suc n) = x * vector_power x n" |
|
255 |
|
256 instance "^" :: (semiring,type) semiring |
|
257 apply (intro_classes) by (vector ring_simps)+ |
|
258 |
|
259 instance "^" :: (semiring_0,type) semiring_0 |
|
260 apply (intro_classes) by (vector ring_simps)+ |
|
261 instance "^" :: (semiring_1,type) semiring_1 |
|
262 apply (intro_classes) by vector |
|
263 instance "^" :: (comm_semiring,type) comm_semiring |
|
264 apply (intro_classes) by (vector ring_simps)+ |
|
265 |
|
266 instance "^" :: (comm_semiring_0,type) comm_semiring_0 by (intro_classes) |
|
267 instance "^" :: (cancel_comm_monoid_add, type) cancel_comm_monoid_add .. |
|
268 instance "^" :: (semiring_0_cancel,type) semiring_0_cancel by (intro_classes) |
|
269 instance "^" :: (comm_semiring_0_cancel,type) comm_semiring_0_cancel by (intro_classes) |
|
270 instance "^" :: (ring,type) ring by (intro_classes) |
|
271 instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes) |
|
272 instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes) |
|
273 |
|
274 instance "^" :: (ring_1,type) ring_1 .. |
|
275 |
|
276 instance "^" :: (real_algebra,type) real_algebra |
|
277 apply intro_classes |
|
278 apply (simp_all add: vector_scaleR_def ring_simps) |
|
279 apply vector |
|
280 apply vector |
|
281 done |
|
282 |
|
283 instance "^" :: (real_algebra_1,type) real_algebra_1 .. |
|
284 |
|
285 lemma of_nat_index: |
|
286 "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n" |
|
287 apply (induct n) |
|
288 apply vector |
|
289 apply vector |
|
290 done |
|
291 lemma zero_index[simp]: |
|
292 "(0 :: 'a::zero ^'n)$i = 0" by vector |
|
293 |
|
294 lemma one_index[simp]: |
|
295 "(1 :: 'a::one ^'n)$i = 1" by vector |
|
296 |
|
297 lemma one_plus_of_nat_neq_0: "(1::'a::semiring_char_0) + of_nat n \<noteq> 0" |
|
298 proof- |
|
299 have "(1::'a) + of_nat n = 0 \<longleftrightarrow> of_nat 1 + of_nat n = (of_nat 0 :: 'a)" by simp |
|
300 also have "\<dots> \<longleftrightarrow> 1 + n = 0" by (simp only: of_nat_add[symmetric] of_nat_eq_iff) |
|
301 finally show ?thesis by simp |
|
302 qed |
|
303 |
|
304 instance "^" :: (semiring_char_0,type) semiring_char_0 |
|
305 proof (intro_classes) |
|
306 fix m n ::nat |
|
307 show "(of_nat m :: 'a^'b) = of_nat n \<longleftrightarrow> m = n" |
|
308 by (simp add: Cart_eq of_nat_index) |
|
309 qed |
|
310 |
|
311 instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes |
|
312 instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes |
|
313 |
|
314 lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x" |
|
315 by (vector mult_assoc) |
|
316 lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x" |
|
317 by (vector ring_simps) |
|
318 lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y" |
|
319 by (vector ring_simps) |
|
320 lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector |
|
321 lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector |
|
322 lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y" |
|
323 by (vector ring_simps) |
|
324 lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector |
|
325 lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector |
|
326 lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector |
|
327 lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector |
|
328 lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x" |
|
329 by (vector ring_simps) |
|
330 |
|
331 lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)" |
|
332 by (simp add: Cart_eq) |
|
333 |
|
334 subsection {* Topological space *} |
|
335 |
|
336 instantiation "^" :: (topological_space, finite) topological_space |
|
337 begin |
|
338 |
|
339 definition open_vector_def: |
|
340 "open (S :: ('a ^ 'b) set) \<longleftrightarrow> |
|
341 (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and> |
|
342 (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))" |
|
343 |
|
344 instance proof |
|
345 show "open (UNIV :: ('a ^ 'b) set)" |
|
346 unfolding open_vector_def by auto |
|
347 next |
|
348 fix S T :: "('a ^ 'b) set" |
|
349 assume "open S" "open T" thus "open (S \<inter> T)" |
|
350 unfolding open_vector_def |
|
351 apply clarify |
|
352 apply (drule (1) bspec)+ |
|
353 apply (clarify, rename_tac Sa Ta) |
|
354 apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI) |
|
355 apply (simp add: open_Int) |
|
356 done |
|
357 next |
|
358 fix K :: "('a ^ 'b) set set" |
|
359 assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)" |
|
360 unfolding open_vector_def |
|
361 apply clarify |
|
362 apply (drule (1) bspec) |
|
363 apply (drule (1) bspec) |
|
364 apply clarify |
|
365 apply (rule_tac x=A in exI) |
|
366 apply fast |
|
367 done |
|
368 qed |
|
369 |
|
370 end |
|
371 |
|
372 lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}" |
|
373 unfolding open_vector_def by auto |
|
374 |
|
375 lemma open_vimage_Cart_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)" |
|
376 unfolding open_vector_def |
|
377 apply clarify |
|
378 apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp) |
|
379 done |
|
380 |
|
381 lemma closed_vimage_Cart_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)" |
|
382 unfolding closed_open vimage_Compl [symmetric] |
|
383 by (rule open_vimage_Cart_nth) |
|
384 |
|
385 lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}" |
|
386 proof - |
|
387 have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto |
|
388 thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}" |
|
389 by (simp add: closed_INT closed_vimage_Cart_nth) |
|
390 qed |
|
391 |
|
392 lemma tendsto_Cart_nth [tendsto_intros]: |
|
393 assumes "((\<lambda>x. f x) ---> a) net" |
|
394 shows "((\<lambda>x. f x $ i) ---> a $ i) net" |
|
395 proof (rule topological_tendstoI) |
|
396 fix S assume "open S" "a $ i \<in> S" |
|
397 then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)" |
|
398 by (simp_all add: open_vimage_Cart_nth) |
|
399 with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net" |
|
400 by (rule topological_tendstoD) |
|
401 then show "eventually (\<lambda>x. f x $ i \<in> S) net" |
|
402 by simp |
|
403 qed |
|
404 |
|
405 subsection {* Square root of sum of squares *} |
|
406 |
|
407 definition |
|
408 "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)" |
|
409 |
|
410 lemma setL2_cong: |
|
411 "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B" |
|
412 unfolding setL2_def by simp |
|
413 |
|
414 lemma strong_setL2_cong: |
|
415 "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B" |
|
416 unfolding setL2_def simp_implies_def by simp |
|
417 |
|
418 lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0" |
|
419 unfolding setL2_def by simp |
|
420 |
|
421 lemma setL2_empty [simp]: "setL2 f {} = 0" |
|
422 unfolding setL2_def by simp |
|
423 |
|
424 lemma setL2_insert [simp]: |
|
425 "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow> |
|
426 setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)" |
|
427 unfolding setL2_def by (simp add: setsum_nonneg) |
|
428 |
|
429 lemma setL2_nonneg [simp]: "0 \<le> setL2 f A" |
|
430 unfolding setL2_def by (simp add: setsum_nonneg) |
|
431 |
|
432 lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0" |
|
433 unfolding setL2_def by simp |
|
434 |
|
435 lemma setL2_constant: "setL2 (\<lambda>x. y) A = sqrt (of_nat (card A)) * \<bar>y\<bar>" |
|
436 unfolding setL2_def by (simp add: real_sqrt_mult) |
|
437 |
|
438 lemma setL2_mono: |
|
439 assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i" |
|
440 assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i" |
|
441 shows "setL2 f K \<le> setL2 g K" |
|
442 unfolding setL2_def |
|
443 by (simp add: setsum_nonneg setsum_mono power_mono prems) |
|
444 |
|
445 lemma setL2_strict_mono: |
|
446 assumes "finite K" and "K \<noteq> {}" |
|
447 assumes "\<And>i. i \<in> K \<Longrightarrow> f i < g i" |
|
448 assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i" |
|
449 shows "setL2 f K < setL2 g K" |
|
450 unfolding setL2_def |
|
451 by (simp add: setsum_strict_mono power_strict_mono assms) |
|
452 |
|
453 lemma setL2_right_distrib: |
|
454 "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A" |
|
455 unfolding setL2_def |
|
456 apply (simp add: power_mult_distrib) |
|
457 apply (simp add: setsum_right_distrib [symmetric]) |
|
458 apply (simp add: real_sqrt_mult setsum_nonneg) |
|
459 done |
|
460 |
|
461 lemma setL2_left_distrib: |
|
462 "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A" |
|
463 unfolding setL2_def |
|
464 apply (simp add: power_mult_distrib) |
|
465 apply (simp add: setsum_left_distrib [symmetric]) |
|
466 apply (simp add: real_sqrt_mult setsum_nonneg) |
|
467 done |
|
468 |
|
469 lemma setsum_nonneg_eq_0_iff: |
|
470 fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add" |
|
471 shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)" |
|
472 apply (induct set: finite, simp) |
|
473 apply (simp add: add_nonneg_eq_0_iff setsum_nonneg) |
|
474 done |
|
475 |
|
476 lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)" |
|
477 unfolding setL2_def |
|
478 by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff) |
|
479 |
|
480 lemma setL2_triangle_ineq: |
|
481 shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A" |
|
482 proof (cases "finite A") |
|
483 case False |
|
484 thus ?thesis by simp |
|
485 next |
|
486 case True |
|
487 thus ?thesis |
|
488 proof (induct set: finite) |
|
489 case empty |
|
490 show ?case by simp |
|
491 next |
|
492 case (insert x F) |
|
493 hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le> |
|
494 sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)" |
|
495 by (intro real_sqrt_le_mono add_left_mono power_mono insert |
|
496 setL2_nonneg add_increasing zero_le_power2) |
|
497 also have |
|
498 "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)" |
|
499 by (rule real_sqrt_sum_squares_triangle_ineq) |
|
500 finally show ?case |
|
501 using insert by simp |
|
502 qed |
|
503 qed |
|
504 |
|
505 lemma sqrt_sum_squares_le_sum: |
|
506 "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y" |
|
507 apply (rule power2_le_imp_le) |
|
508 apply (simp add: power2_sum) |
|
509 apply (simp add: mult_nonneg_nonneg) |
|
510 apply (simp add: add_nonneg_nonneg) |
|
511 done |
|
512 |
|
513 lemma setL2_le_setsum [rule_format]: |
|
514 "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A" |
|
515 apply (cases "finite A") |
|
516 apply (induct set: finite) |
|
517 apply simp |
|
518 apply clarsimp |
|
519 apply (erule order_trans [OF sqrt_sum_squares_le_sum]) |
|
520 apply simp |
|
521 apply simp |
|
522 apply simp |
|
523 done |
|
524 |
|
525 lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>" |
|
526 apply (rule power2_le_imp_le) |
|
527 apply (simp add: power2_sum) |
|
528 apply (simp add: mult_nonneg_nonneg) |
|
529 apply (simp add: add_nonneg_nonneg) |
|
530 done |
|
531 |
|
532 lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)" |
|
533 apply (cases "finite A") |
|
534 apply (induct set: finite) |
|
535 apply simp |
|
536 apply simp |
|
537 apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs]) |
|
538 apply simp |
|
539 apply simp |
|
540 done |
|
541 |
|
542 lemma setL2_mult_ineq_lemma: |
|
543 fixes a b c d :: real |
|
544 shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>" |
|
545 proof - |
|
546 have "0 \<le> (a * d - b * c)\<twosuperior>" by simp |
|
547 also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)" |
|
548 by (simp only: power2_diff power_mult_distrib) |
|
549 also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)" |
|
550 by simp |
|
551 finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>" |
|
552 by simp |
|
553 qed |
|
554 |
|
555 lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A" |
|
556 apply (cases "finite A") |
|
557 apply (induct set: finite) |
|
558 apply simp |
|
559 apply (rule power2_le_imp_le, simp) |
|
560 apply (rule order_trans) |
|
561 apply (rule power_mono) |
|
562 apply (erule add_left_mono) |
|
563 apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg) |
|
564 apply (simp add: power2_sum) |
|
565 apply (simp add: power_mult_distrib) |
|
566 apply (simp add: right_distrib left_distrib) |
|
567 apply (rule ord_le_eq_trans) |
|
568 apply (rule setL2_mult_ineq_lemma) |
|
569 apply simp |
|
570 apply (intro mult_nonneg_nonneg setL2_nonneg) |
|
571 apply simp |
|
572 done |
|
573 |
|
574 lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A" |
|
575 apply (rule_tac s="insert i (A - {i})" and t="A" in subst) |
|
576 apply fast |
|
577 apply (subst setL2_insert) |
|
578 apply simp |
|
579 apply simp |
|
580 apply simp |
|
581 done |
|
582 |
|
583 subsection {* Metric *} |
|
584 |
|
585 (* TODO: move somewhere else *) |
|
586 lemma finite_choice: "finite A \<Longrightarrow> \<forall>x\<in>A. \<exists>y. P x y \<Longrightarrow> \<exists>f. \<forall>x\<in>A. P x (f x)" |
|
587 apply (induct set: finite, simp_all) |
|
588 apply (clarify, rename_tac y) |
|
589 apply (rule_tac x="f(x:=y)" in exI, simp) |
|
590 done |
|
591 |
|
592 instantiation "^" :: (metric_space, finite) metric_space |
|
593 begin |
|
594 |
|
595 definition dist_vector_def: |
|
596 "dist (x::'a^'b) (y::'a^'b) = setL2 (\<lambda>i. dist (x$i) (y$i)) UNIV" |
|
597 |
|
598 lemma dist_nth_le: "dist (x $ i) (y $ i) \<le> dist x y" |
|
599 unfolding dist_vector_def |
|
600 by (rule member_le_setL2) simp_all |
|
601 |
|
602 instance proof |
|
603 fix x y :: "'a ^ 'b" |
|
604 show "dist x y = 0 \<longleftrightarrow> x = y" |
|
605 unfolding dist_vector_def |
|
606 by (simp add: setL2_eq_0_iff Cart_eq) |
|
607 next |
|
608 fix x y z :: "'a ^ 'b" |
|
609 show "dist x y \<le> dist x z + dist y z" |
|
610 unfolding dist_vector_def |
|
611 apply (rule order_trans [OF _ setL2_triangle_ineq]) |
|
612 apply (simp add: setL2_mono dist_triangle2) |
|
613 done |
|
614 next |
|
615 (* FIXME: long proof! *) |
|
616 fix S :: "('a ^ 'b) set" |
|
617 show "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)" |
|
618 unfolding open_vector_def open_dist |
|
619 apply safe |
|
620 apply (drule (1) bspec) |
|
621 apply clarify |
|
622 apply (subgoal_tac "\<exists>e>0. \<forall>i y. dist y (x$i) < e \<longrightarrow> y \<in> A i") |
|
623 apply clarify |
|
624 apply (rule_tac x=e in exI, clarify) |
|
625 apply (drule spec, erule mp, clarify) |
|
626 apply (drule spec, drule spec, erule mp) |
|
627 apply (erule le_less_trans [OF dist_nth_le]) |
|
628 apply (subgoal_tac "\<forall>i\<in>UNIV. \<exists>e>0. \<forall>y. dist y (x$i) < e \<longrightarrow> y \<in> A i") |
|
629 apply (drule finite_choice [OF finite], clarify) |
|
630 apply (rule_tac x="Min (range f)" in exI, simp) |
|
631 apply clarify |
|
632 apply (drule_tac x=i in spec, clarify) |
|
633 apply (erule (1) bspec) |
|
634 apply (drule (1) bspec, clarify) |
|
635 apply (subgoal_tac "\<exists>r. (\<forall>i::'b. 0 < r i) \<and> e = setL2 r UNIV") |
|
636 apply clarify |
|
637 apply (rule_tac x="\<lambda>i. {y. dist y (x$i) < r i}" in exI) |
|
638 apply (rule conjI) |
|
639 apply clarify |
|
640 apply (rule conjI) |
|
641 apply (clarify, rename_tac y) |
|
642 apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp) |
|
643 apply clarify |
|
644 apply (simp only: less_diff_eq) |
|
645 apply (erule le_less_trans [OF dist_triangle]) |
|
646 apply simp |
|
647 apply clarify |
|
648 apply (drule spec, erule mp) |
|
649 apply (simp add: dist_vector_def setL2_strict_mono) |
|
650 apply (rule_tac x="\<lambda>i. e / sqrt (of_nat CARD('b))" in exI) |
|
651 apply (simp add: divide_pos_pos setL2_constant) |
|
652 done |
|
653 qed |
|
654 |
|
655 end |
|
656 |
|
657 lemma LIMSEQ_Cart_nth: |
|
658 "(X ----> a) \<Longrightarrow> (\<lambda>n. X n $ i) ----> a $ i" |
|
659 unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth) |
|
660 |
|
661 lemma LIM_Cart_nth: |
|
662 "(f -- x --> y) \<Longrightarrow> (\<lambda>x. f x $ i) -- x --> y $ i" |
|
663 unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth) |
|
664 |
|
665 lemma Cauchy_Cart_nth: |
|
666 "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)" |
|
667 unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le]) |
|
668 |
|
669 lemma LIMSEQ_vector: |
|
670 fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite" |
|
671 assumes X: "\<And>i. (\<lambda>n. X n $ i) ----> (a $ i)" |
|
672 shows "X ----> a" |
|
673 proof (rule metric_LIMSEQ_I) |
|
674 fix r :: real assume "0 < r" |
|
675 then have "0 < r / of_nat CARD('n)" (is "0 < ?s") |
|
676 by (simp add: divide_pos_pos) |
|
677 def N \<equiv> "\<lambda>i. LEAST N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s" |
|
678 def M \<equiv> "Max (range N)" |
|
679 have "\<And>i. \<exists>N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s" |
|
680 using X `0 < ?s` by (rule metric_LIMSEQ_D) |
|
681 hence "\<And>i. \<forall>n\<ge>N i. dist (X n $ i) (a $ i) < ?s" |
|
682 unfolding N_def by (rule LeastI_ex) |
|
683 hence M: "\<And>i. \<forall>n\<ge>M. dist (X n $ i) (a $ i) < ?s" |
|
684 unfolding M_def by simp |
|
685 { |
|
686 fix n :: nat assume "M \<le> n" |
|
687 have "dist (X n) a = setL2 (\<lambda>i. dist (X n $ i) (a $ i)) UNIV" |
|
688 unfolding dist_vector_def .. |
|
689 also have "\<dots> \<le> setsum (\<lambda>i. dist (X n $ i) (a $ i)) UNIV" |
|
690 by (rule setL2_le_setsum [OF zero_le_dist]) |
|
691 also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV" |
|
692 by (rule setsum_strict_mono, simp_all add: M `M \<le> n`) |
|
693 also have "\<dots> = r" |
|
694 by simp |
|
695 finally have "dist (X n) a < r" . |
|
696 } |
|
697 hence "\<forall>n\<ge>M. dist (X n) a < r" |
|
698 by simp |
|
699 then show "\<exists>M. \<forall>n\<ge>M. dist (X n) a < r" .. |
|
700 qed |
|
701 |
|
702 lemma Cauchy_vector: |
|
703 fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite" |
|
704 assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)" |
|
705 shows "Cauchy (\<lambda>n. X n)" |
|
706 proof (rule metric_CauchyI) |
|
707 fix r :: real assume "0 < r" |
|
708 then have "0 < r / of_nat CARD('n)" (is "0 < ?s") |
|
709 by (simp add: divide_pos_pos) |
|
710 def N \<equiv> "\<lambda>i. LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s" |
|
711 def M \<equiv> "Max (range N)" |
|
712 have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s" |
|
713 using X `0 < ?s` by (rule metric_CauchyD) |
|
714 hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s" |
|
715 unfolding N_def by (rule LeastI_ex) |
|
716 hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s" |
|
717 unfolding M_def by simp |
|
718 { |
|
719 fix m n :: nat |
|
720 assume "M \<le> m" "M \<le> n" |
|
721 have "dist (X m) (X n) = setL2 (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV" |
|
722 unfolding dist_vector_def .. |
|
723 also have "\<dots> \<le> setsum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV" |
|
724 by (rule setL2_le_setsum [OF zero_le_dist]) |
|
725 also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV" |
|
726 by (rule setsum_strict_mono, simp_all add: M `M \<le> m` `M \<le> n`) |
|
727 also have "\<dots> = r" |
|
728 by simp |
|
729 finally have "dist (X m) (X n) < r" . |
|
730 } |
|
731 hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" |
|
732 by simp |
|
733 then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" .. |
|
734 qed |
|
735 |
|
736 instance "^" :: (complete_space, finite) complete_space |
|
737 proof |
|
738 fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X" |
|
739 have "\<And>i. (\<lambda>n. X n $ i) ----> lim (\<lambda>n. X n $ i)" |
|
740 using Cauchy_Cart_nth [OF `Cauchy X`] |
|
741 by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff) |
|
742 hence "X ----> Cart_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))" |
|
743 by (simp add: LIMSEQ_vector) |
|
744 then show "convergent X" |
|
745 by (rule convergentI) |
|
746 qed |
|
747 |
|
748 subsection {* Norms *} |
|
749 |
|
750 instantiation "^" :: (real_normed_vector, finite) real_normed_vector |
|
751 begin |
|
752 |
|
753 definition norm_vector_def: |
|
754 "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) UNIV" |
|
755 |
|
756 definition vector_sgn_def: |
|
757 "sgn (x::'a^'b) = scaleR (inverse (norm x)) x" |
|
758 |
|
759 instance proof |
|
760 fix a :: real and x y :: "'a ^ 'b" |
|
761 show "0 \<le> norm x" |
|
762 unfolding norm_vector_def |
|
763 by (rule setL2_nonneg) |
|
764 show "norm x = 0 \<longleftrightarrow> x = 0" |
|
765 unfolding norm_vector_def |
|
766 by (simp add: setL2_eq_0_iff Cart_eq) |
|
767 show "norm (x + y) \<le> norm x + norm y" |
|
768 unfolding norm_vector_def |
|
769 apply (rule order_trans [OF _ setL2_triangle_ineq]) |
|
770 apply (simp add: setL2_mono norm_triangle_ineq) |
|
771 done |
|
772 show "norm (scaleR a x) = \<bar>a\<bar> * norm x" |
|
773 unfolding norm_vector_def |
|
774 by (simp add: setL2_right_distrib) |
|
775 show "sgn x = scaleR (inverse (norm x)) x" |
|
776 by (rule vector_sgn_def) |
|
777 show "dist x y = norm (x - y)" |
|
778 unfolding dist_vector_def norm_vector_def |
|
779 by (simp add: dist_norm) |
|
780 qed |
|
781 |
|
782 end |
|
783 |
|
784 lemma norm_nth_le: "norm (x $ i) \<le> norm x" |
|
785 unfolding norm_vector_def |
|
786 by (rule member_le_setL2) simp_all |
|
787 |
|
788 interpretation Cart_nth: bounded_linear "\<lambda>x. x $ i" |
|
789 apply default |
|
790 apply (rule vector_add_component) |
|
791 apply (rule vector_scaleR_component) |
|
792 apply (rule_tac x="1" in exI, simp add: norm_nth_le) |
|
793 done |
|
794 |
|
795 instance "^" :: (banach, finite) banach .. |
|
796 |
|
797 subsection {* Inner products *} |
|
798 |
|
799 instantiation "^" :: (real_inner, finite) real_inner |
|
800 begin |
|
801 |
|
802 definition inner_vector_def: |
|
803 "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) UNIV" |
|
804 |
|
805 instance proof |
|
806 fix r :: real and x y z :: "'a ^ 'b" |
|
807 show "inner x y = inner y x" |
|
808 unfolding inner_vector_def |
|
809 by (simp add: inner_commute) |
|
810 show "inner (x + y) z = inner x z + inner y z" |
|
811 unfolding inner_vector_def |
|
812 by (simp add: inner_add_left setsum_addf) |
|
813 show "inner (scaleR r x) y = r * inner x y" |
|
814 unfolding inner_vector_def |
|
815 by (simp add: setsum_right_distrib) |
|
816 show "0 \<le> inner x x" |
|
817 unfolding inner_vector_def |
|
818 by (simp add: setsum_nonneg) |
|
819 show "inner x x = 0 \<longleftrightarrow> x = 0" |
|
820 unfolding inner_vector_def |
|
821 by (simp add: Cart_eq setsum_nonneg_eq_0_iff) |
|
822 show "norm x = sqrt (inner x x)" |
|
823 unfolding inner_vector_def norm_vector_def setL2_def |
|
824 by (simp add: power2_norm_eq_inner) |
|
825 qed |
|
826 |
|
827 end |
|
828 |
|
829 subsection{* Properties of the dot product. *} |
|
830 |
|
831 lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x" |
|
832 by (vector mult_commute) |
|
833 lemma dot_ladd: "((x::'a::ring ^ 'n) + y) \<bullet> z = (x \<bullet> z) + (y \<bullet> z)" |
|
834 by (vector ring_simps) |
|
835 lemma dot_radd: "x \<bullet> (y + (z::'a::ring ^ 'n)) = (x \<bullet> y) + (x \<bullet> z)" |
|
836 by (vector ring_simps) |
|
837 lemma dot_lsub: "((x::'a::ring ^ 'n) - y) \<bullet> z = (x \<bullet> z) - (y \<bullet> z)" |
|
838 by (vector ring_simps) |
|
839 lemma dot_rsub: "(x::'a::ring ^ 'n) \<bullet> (y - z) = (x \<bullet> y) - (x \<bullet> z)" |
|
840 by (vector ring_simps) |
|
841 lemma dot_lmult: "(c *s x) \<bullet> y = (c::'a::ring) * (x \<bullet> y)" by (vector ring_simps) |
|
842 lemma dot_rmult: "x \<bullet> (c *s y) = (c::'a::comm_ring) * (x \<bullet> y)" by (vector ring_simps) |
|
843 lemma dot_lneg: "(-x) \<bullet> (y::'a::ring ^ 'n) = -(x \<bullet> y)" by vector |
|
844 lemma dot_rneg: "(x::'a::ring ^ 'n) \<bullet> (-y) = -(x \<bullet> y)" by vector |
|
845 lemma dot_lzero[simp]: "0 \<bullet> x = (0::'a::{comm_monoid_add, mult_zero})" by vector |
|
846 lemma dot_rzero[simp]: "x \<bullet> 0 = (0::'a::{comm_monoid_add, mult_zero})" by vector |
|
847 lemma dot_pos_le[simp]: "(0::'a\<Colon>ordered_ring_strict) <= x \<bullet> x" |
|
848 by (simp add: dot_def setsum_nonneg) |
|
849 |
|
850 lemma setsum_squares_eq_0_iff: assumes fS: "finite F" and fp: "\<forall>x \<in> F. f x \<ge> (0 ::'a::pordered_ab_group_add)" shows "setsum f F = 0 \<longleftrightarrow> (ALL x:F. f x = 0)" |
|
851 using fS fp setsum_nonneg[OF fp] |
|
852 proof (induct set: finite) |
|
853 case empty thus ?case by simp |
|
854 next |
|
855 case (insert x F) |
|
856 from insert.prems have Fx: "f x \<ge> 0" and Fp: "\<forall> a \<in> F. f a \<ge> 0" by simp_all |
|
857 from insert.hyps Fp setsum_nonneg[OF Fp] |
|
858 have h: "setsum f F = 0 \<longleftrightarrow> (\<forall>a \<in>F. f a = 0)" by metis |
|
859 from add_nonneg_eq_0_iff[OF Fx setsum_nonneg[OF Fp]] insert.hyps(1,2) |
|
860 show ?case by (simp add: h) |
|
861 qed |
|
862 |
|
863 lemma dot_eq_0: "x \<bullet> x = 0 \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) = 0" |
|
864 by (simp add: dot_def setsum_squares_eq_0_iff Cart_eq) |
|
865 |
|
866 lemma dot_pos_lt[simp]: "(0 < x \<bullet> x) \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) \<noteq> 0" using dot_eq_0[of x] dot_pos_le[of x] |
|
867 by (auto simp add: le_less) |
|
868 |
|
869 subsection{* The collapse of the general concepts to dimension one. *} |
|
870 |
|
871 lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))" |
|
872 by (simp add: Cart_eq forall_1) |
|
873 |
|
874 lemma forall_one: "(\<forall>(x::'a ^1). P x) \<longleftrightarrow> (\<forall>x. P(\<chi> i. x))" |
|
875 apply auto |
|
876 apply (erule_tac x= "x$1" in allE) |
|
877 apply (simp only: vector_one[symmetric]) |
|
878 done |
|
879 |
|
880 lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)" |
|
881 by (simp add: norm_vector_def UNIV_1) |
|
882 |
|
883 lemma norm_real: "norm(x::real ^ 1) = abs(x$1)" |
|
884 by (simp add: norm_vector_1) |
|
885 |
|
886 lemma dist_real: "dist(x::real ^ 1) y = abs((x$1) - (y$1))" |
|
887 by (auto simp add: norm_real dist_norm) |
|
888 |
|
889 subsection {* A connectedness or intermediate value lemma with several applications. *} |
|
890 |
|
891 lemma connected_real_lemma: |
|
892 fixes f :: "real \<Rightarrow> 'a::metric_space" |
|
893 assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2" |
|
894 and dst: "\<And>e x. a <= x \<Longrightarrow> x <= b \<Longrightarrow> 0 < e ==> \<exists>d > 0. \<forall>y. abs(y - x) < d \<longrightarrow> dist(f y) (f x) < e" |
|
895 and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1" |
|
896 and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2" |
|
897 and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)" |
|
898 shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x") |
|
899 proof- |
|
900 let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}" |
|
901 have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa) |
|
902 have Sub: "\<exists>y. isUb UNIV ?S y" |
|
903 apply (rule exI[where x= b]) |
|
904 using ab fb e12 by (auto simp add: isUb_def setle_def) |
|
905 from reals_complete[OF Se Sub] obtain l where |
|
906 l: "isLub UNIV ?S l"by blast |
|
907 have alb: "a \<le> l" "l \<le> b" using l ab fa fb e12 |
|
908 apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def) |
|
909 by (metis linorder_linear) |
|
910 have ale1: "\<forall>z \<ge> a. z < l \<longrightarrow> f z \<in> e1" using l |
|
911 apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def) |
|
912 by (metis linorder_linear not_le) |
|
913 have th1: "\<And>z x e d :: real. z <= x + e \<Longrightarrow> e < d ==> z < x \<or> abs(z - x) < d" by arith |
|
914 have th2: "\<And>e x:: real. 0 < e ==> ~(x + e <= x)" by arith |
|
915 have th3: "\<And>d::real. d > 0 \<Longrightarrow> \<exists>e > 0. e < d" by dlo |
|
916 {assume le2: "f l \<in> e2" |
|
917 from le2 fa fb e12 alb have la: "l \<noteq> a" by metis |
|
918 hence lap: "l - a > 0" using alb by arith |
|
919 from e2[rule_format, OF le2] obtain e where |
|
920 e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e2" by metis |
|
921 from dst[OF alb e(1)] obtain d where |
|
922 d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis |
|
923 have "\<exists>d'. d' < d \<and> d' >0 \<and> l - d' > a" using lap d(1) |
|
924 apply ferrack by arith |
|
925 then obtain d' where d': "d' > 0" "d' < d" "l - d' > a" by metis |
|
926 from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e2" by metis |
|
927 from th0[rule_format, of "l - d'"] d' have "f (l - d') \<in> e2" by auto |
|
928 moreover |
|
929 have "f (l - d') \<in> e1" using ale1[rule_format, of "l -d'"] d' by auto |
|
930 ultimately have False using e12 alb d' by auto} |
|
931 moreover |
|
932 {assume le1: "f l \<in> e1" |
|
933 from le1 fa fb e12 alb have lb: "l \<noteq> b" by metis |
|
934 hence blp: "b - l > 0" using alb by arith |
|
935 from e1[rule_format, OF le1] obtain e where |
|
936 e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e1" by metis |
|
937 from dst[OF alb e(1)] obtain d where |
|
938 d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis |
|
939 have "\<exists>d'. d' < d \<and> d' >0" using d(1) by dlo |
|
940 then obtain d' where d': "d' > 0" "d' < d" by metis |
|
941 from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e1" by auto |
|
942 hence "\<forall>y. l \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" using d' by auto |
|
943 with ale1 have "\<forall>y. a \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" by auto |
|
944 with l d' have False |
|
945 by (auto simp add: isLub_def isUb_def setle_def setge_def leastP_def) } |
|
946 ultimately show ?thesis using alb by metis |
|
947 qed |
|
948 |
|
949 text{* One immediately useful corollary is the existence of square roots! --- Should help to get rid of all the development of square-root for reals as a special case @{typ "real^1"} *} |
|
950 |
|
951 lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)" |
|
952 proof- |
|
953 have "(x + 1/2)^2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith |
|
954 thus ?thesis by (simp add: ring_simps power2_eq_square) |
|
955 qed |
|
956 |
|
957 lemma square_continuous: "0 < (e::real) ==> \<exists>d. 0 < d \<and> (\<forall>y. abs(y - x) < d \<longrightarrow> abs(y * y - x * x) < e)" |
|
958 using isCont_power[OF isCont_ident, of 2, unfolded isCont_def LIM_eq, rule_format, of e x] apply (auto simp add: power2_eq_square) |
|
959 apply (rule_tac x="s" in exI) |
|
960 apply auto |
|
961 apply (erule_tac x=y in allE) |
|
962 apply auto |
|
963 done |
|
964 |
|
965 lemma real_le_lsqrt: "0 <= x \<Longrightarrow> 0 <= y \<Longrightarrow> x <= y^2 ==> sqrt x <= y" |
|
966 using real_sqrt_le_iff[of x "y^2"] by simp |
|
967 |
|
968 lemma real_le_rsqrt: "x^2 \<le> y \<Longrightarrow> x \<le> sqrt y" |
|
969 using real_sqrt_le_mono[of "x^2" y] by simp |
|
970 |
|
971 lemma real_less_rsqrt: "x^2 < y \<Longrightarrow> x < sqrt y" |
|
972 using real_sqrt_less_mono[of "x^2" y] by simp |
|
973 |
|
974 lemma sqrt_even_pow2: assumes n: "even n" |
|
975 shows "sqrt(2 ^ n) = 2 ^ (n div 2)" |
|
976 proof- |
|
977 from n obtain m where m: "n = 2*m" unfolding even_nat_equiv_def2 |
|
978 by (auto simp add: nat_number) |
|
979 from m have "sqrt(2 ^ n) = sqrt ((2 ^ m) ^ 2)" |
|
980 by (simp only: power_mult[symmetric] mult_commute) |
|
981 then show ?thesis using m by simp |
|
982 qed |
|
983 |
|
984 lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)" |
|
985 apply (cases "x = 0", simp_all) |
|
986 using sqrt_divide_self_eq[of x] |
|
987 apply (simp add: inverse_eq_divide real_sqrt_ge_0_iff field_simps) |
|
988 done |
|
989 |
|
990 text{* Hence derive more interesting properties of the norm. *} |
|
991 |
|
992 text {* |
|
993 This type-specific version is only here |
|
994 to make @{text normarith.ML} happy. |
|
995 *} |
|
996 lemma norm_0: "norm (0::real ^ _) = 0" |
|
997 by (rule norm_zero) |
|
998 |
|
999 lemma norm_mul[simp]: "norm(a *s x) = abs(a) * norm x" |
|
1000 by (simp add: norm_vector_def vector_component setL2_right_distrib |
|
1001 abs_mult cong: strong_setL2_cong) |
|
1002 lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))" |
|
1003 by (simp add: norm_vector_def dot_def setL2_def power2_eq_square) |
|
1004 lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)" |
|
1005 by (simp add: norm_vector_def setL2_def dot_def power2_eq_square) |
|
1006 lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x" |
|
1007 by (simp add: real_vector_norm_def) |
|
1008 lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n::finite)" by (metis norm_eq_zero) |
|
1009 lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0" |
|
1010 by vector |
|
1011 lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y" |
|
1012 by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib) |
|
1013 lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::real) = b \<or> x = 0" |
|
1014 by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib) |
|
1015 lemma vector_mul_lcancel_imp: "a \<noteq> (0::real) ==> a *s x = a *s y ==> (x = y)" |
|
1016 by (metis vector_mul_lcancel) |
|
1017 lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::real) *s x = b *s x ==> a = b" |
|
1018 by (metis vector_mul_rcancel) |
|
1019 lemma norm_cauchy_schwarz: |
|
1020 fixes x y :: "real ^ 'n::finite" |
|
1021 shows "x \<bullet> y <= norm x * norm y" |
|
1022 proof- |
|
1023 {assume "norm x = 0" |
|
1024 hence ?thesis by (simp add: dot_lzero dot_rzero)} |
|
1025 moreover |
|
1026 {assume "norm y = 0" |
|
1027 hence ?thesis by (simp add: dot_lzero dot_rzero)} |
|
1028 moreover |
|
1029 {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0" |
|
1030 let ?z = "norm y *s x - norm x *s y" |
|
1031 from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps) |
|
1032 from dot_pos_le[of ?z] |
|
1033 have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2" |
|
1034 apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps) |
|
1035 by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym) |
|
1036 hence "x\<bullet>y \<le> (norm x ^2 * norm y ^2) / (norm x * norm y)" using p |
|
1037 by (simp add: field_simps) |
|
1038 hence ?thesis using h by (simp add: power2_eq_square)} |
|
1039 ultimately show ?thesis by metis |
|
1040 qed |
|
1041 |
|
1042 lemma norm_cauchy_schwarz_abs: |
|
1043 fixes x y :: "real ^ 'n::finite" |
|
1044 shows "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y" |
|
1045 using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"] |
|
1046 by (simp add: real_abs_def dot_rneg) |
|
1047 |
|
1048 lemma norm_triangle_sub: |
|
1049 fixes x y :: "'a::real_normed_vector" |
|
1050 shows "norm x \<le> norm y + norm (x - y)" |
|
1051 using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps) |
|
1052 |
|
1053 lemma norm_triangle_le: "norm(x::real ^'n::finite) + norm y <= e ==> norm(x + y) <= e" |
|
1054 by (metis order_trans norm_triangle_ineq) |
|
1055 lemma norm_triangle_lt: "norm(x::real ^'n::finite) + norm(y) < e ==> norm(x + y) < e" |
|
1056 by (metis basic_trans_rules(21) norm_triangle_ineq) |
|
1057 |
|
1058 lemma component_le_norm: "\<bar>x$i\<bar> <= norm (x::real ^ 'n::finite)" |
|
1059 apply (simp add: norm_vector_def) |
|
1060 apply (rule member_le_setL2, simp_all) |
|
1061 done |
|
1062 |
|
1063 lemma norm_bound_component_le: "norm(x::real ^ 'n::finite) <= e |
|
1064 ==> \<bar>x$i\<bar> <= e" |
|
1065 by (metis component_le_norm order_trans) |
|
1066 |
|
1067 lemma norm_bound_component_lt: "norm(x::real ^ 'n::finite) < e |
|
1068 ==> \<bar>x$i\<bar> < e" |
|
1069 by (metis component_le_norm basic_trans_rules(21)) |
|
1070 |
|
1071 lemma norm_le_l1: "norm (x:: real ^'n::finite) <= setsum(\<lambda>i. \<bar>x$i\<bar>) UNIV" |
|
1072 by (simp add: norm_vector_def setL2_le_setsum) |
|
1073 |
|
1074 lemma real_abs_norm: "\<bar>norm x\<bar> = norm (x :: real ^ _)" |
|
1075 by (rule abs_norm_cancel) |
|
1076 lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n::finite) - norm y\<bar> <= norm(x - y)" |
|
1077 by (rule norm_triangle_ineq3) |
|
1078 lemma norm_le: "norm(x::real ^ _) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y" |
|
1079 by (simp add: real_vector_norm_def) |
|
1080 lemma norm_lt: "norm(x::real ^ _) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y" |
|
1081 by (simp add: real_vector_norm_def) |
|
1082 lemma norm_eq: "norm (x::real ^ _) = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y" |
|
1083 by (simp add: order_eq_iff norm_le) |
|
1084 lemma norm_eq_1: "norm(x::real ^ _) = 1 \<longleftrightarrow> x \<bullet> x = 1" |
|
1085 by (simp add: real_vector_norm_def) |
|
1086 |
|
1087 text{* Squaring equations and inequalities involving norms. *} |
|
1088 |
|
1089 lemma dot_square_norm: "x \<bullet> x = norm(x)^2" |
|
1090 by (simp add: real_vector_norm_def) |
|
1091 |
|
1092 lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2" |
|
1093 by (auto simp add: real_vector_norm_def) |
|
1094 |
|
1095 lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2" |
|
1096 proof- |
|
1097 have "x^2 \<le> y^2 \<longleftrightarrow> (x -y) * (y + x) \<le> 0" by (simp add: ring_simps power2_eq_square) |
|
1098 also have "\<dots> \<longleftrightarrow> \<bar>x\<bar> \<le> \<bar>y\<bar>" apply (simp add: zero_compare_simps real_abs_def not_less) by arith |
|
1099 finally show ?thesis .. |
|
1100 qed |
|
1101 |
|
1102 lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2" |
|
1103 apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric]) |
|
1104 using norm_ge_zero[of x] |
|
1105 apply arith |
|
1106 done |
|
1107 |
|
1108 lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2" |
|
1109 apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric]) |
|
1110 using norm_ge_zero[of x] |
|
1111 apply arith |
|
1112 done |
|
1113 |
|
1114 lemma norm_lt_square: "norm(x) < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a^2" |
|
1115 by (metis not_le norm_ge_square) |
|
1116 lemma norm_gt_square: "norm(x) > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a^2" |
|
1117 by (metis norm_le_square not_less) |
|
1118 |
|
1119 text{* Dot product in terms of the norm rather than conversely. *} |
|
1120 |
|
1121 lemma dot_norm: "x \<bullet> y = (norm(x + y) ^2 - norm x ^ 2 - norm y ^ 2) / 2" |
|
1122 by (simp add: norm_pow_2 dot_ladd dot_radd dot_sym) |
|
1123 |
|
1124 lemma dot_norm_neg: "x \<bullet> y = ((norm x ^ 2 + norm y ^ 2) - norm(x - y) ^ 2) / 2" |
|
1125 by (simp add: norm_pow_2 dot_ladd dot_radd dot_lsub dot_rsub dot_sym) |
|
1126 |
|
1127 |
|
1128 text{* Equality of vectors in terms of @{term "op \<bullet>"} products. *} |
|
1129 |
|
1130 lemma vector_eq: "(x:: real ^ 'n::finite) = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y\<and> y \<bullet> y = x \<bullet> x" (is "?lhs \<longleftrightarrow> ?rhs") |
|
1131 proof |
|
1132 assume "?lhs" then show ?rhs by simp |
|
1133 next |
|
1134 assume ?rhs |
|
1135 then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y\<bullet> y = 0" by simp |
|
1136 hence "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0" |
|
1137 by (simp add: dot_rsub dot_lsub dot_sym) |
|
1138 then have "(x - y) \<bullet> (x - y) = 0" by (simp add: ring_simps dot_lsub dot_rsub) |
|
1139 then show "x = y" by (simp add: dot_eq_0) |
|
1140 qed |
|
1141 |
|
1142 |
|
1143 subsection{* General linear decision procedure for normed spaces. *} |
|
1144 |
|
1145 lemma norm_cmul_rule_thm: |
|
1146 fixes x :: "'a::real_normed_vector" |
|
1147 shows "b >= norm(x) ==> \<bar>c\<bar> * b >= norm(scaleR c x)" |
|
1148 unfolding norm_scaleR |
|
1149 apply (erule mult_mono1) |
|
1150 apply simp |
|
1151 done |
|
1152 |
|
1153 (* FIXME: Move all these theorems into the ML code using lemma antiquotation *) |
|
1154 lemma norm_add_rule_thm: |
|
1155 fixes x1 x2 :: "'a::real_normed_vector" |
|
1156 shows "norm x1 \<le> b1 \<Longrightarrow> norm x2 \<le> b2 \<Longrightarrow> norm (x1 + x2) \<le> b1 + b2" |
|
1157 by (rule order_trans [OF norm_triangle_ineq add_mono]) |
|
1158 |
|
1159 lemma ge_iff_diff_ge_0: "(a::'a::ordered_ring) \<ge> b == a - b \<ge> 0" |
|
1160 by (simp add: ring_simps) |
|
1161 |
|
1162 lemma pth_1: |
|
1163 fixes x :: "'a::real_normed_vector" |
|
1164 shows "x == scaleR 1 x" by simp |
|
1165 |
|
1166 lemma pth_2: |
|
1167 fixes x :: "'a::real_normed_vector" |
|
1168 shows "x - y == x + -y" by (atomize (full)) simp |
|
1169 |
|
1170 lemma pth_3: |
|
1171 fixes x :: "'a::real_normed_vector" |
|
1172 shows "- x == scaleR (-1) x" by simp |
|
1173 |
|
1174 lemma pth_4: |
|
1175 fixes x :: "'a::real_normed_vector" |
|
1176 shows "scaleR 0 x == 0" and "scaleR c 0 = (0::'a)" by simp_all |
|
1177 |
|
1178 lemma pth_5: |
|
1179 fixes x :: "'a::real_normed_vector" |
|
1180 shows "scaleR c (scaleR d x) == scaleR (c * d) x" by simp |
|
1181 |
|
1182 lemma pth_6: |
|
1183 fixes x :: "'a::real_normed_vector" |
|
1184 shows "scaleR c (x + y) == scaleR c x + scaleR c y" |
|
1185 by (simp add: scaleR_right_distrib) |
|
1186 |
|
1187 lemma pth_7: |
|
1188 fixes x :: "'a::real_normed_vector" |
|
1189 shows "0 + x == x" and "x + 0 == x" by simp_all |
|
1190 |
|
1191 lemma pth_8: |
|
1192 fixes x :: "'a::real_normed_vector" |
|
1193 shows "scaleR c x + scaleR d x == scaleR (c + d) x" |
|
1194 by (simp add: scaleR_left_distrib) |
|
1195 |
|
1196 lemma pth_9: |
|
1197 fixes x :: "'a::real_normed_vector" shows |
|
1198 "(scaleR c x + z) + scaleR d x == scaleR (c + d) x + z" |
|
1199 "scaleR c x + (scaleR d x + z) == scaleR (c + d) x + z" |
|
1200 "(scaleR c x + w) + (scaleR d x + z) == scaleR (c + d) x + (w + z)" |
|
1201 by (simp_all add: algebra_simps) |
|
1202 |
|
1203 lemma pth_a: |
|
1204 fixes x :: "'a::real_normed_vector" |
|
1205 shows "scaleR 0 x + y == y" by simp |
|
1206 |
|
1207 lemma pth_b: |
|
1208 fixes x :: "'a::real_normed_vector" shows |
|
1209 "scaleR c x + scaleR d y == scaleR c x + scaleR d y" |
|
1210 "(scaleR c x + z) + scaleR d y == scaleR c x + (z + scaleR d y)" |
|
1211 "scaleR c x + (scaleR d y + z) == scaleR c x + (scaleR d y + z)" |
|
1212 "(scaleR c x + w) + (scaleR d y + z) == scaleR c x + (w + (scaleR d y + z))" |
|
1213 by (simp_all add: algebra_simps) |
|
1214 |
|
1215 lemma pth_c: |
|
1216 fixes x :: "'a::real_normed_vector" shows |
|
1217 "scaleR c x + scaleR d y == scaleR d y + scaleR c x" |
|
1218 "(scaleR c x + z) + scaleR d y == scaleR d y + (scaleR c x + z)" |
|
1219 "scaleR c x + (scaleR d y + z) == scaleR d y + (scaleR c x + z)" |
|
1220 "(scaleR c x + w) + (scaleR d y + z) == scaleR d y + ((scaleR c x + w) + z)" |
|
1221 by (simp_all add: algebra_simps) |
|
1222 |
|
1223 lemma pth_d: |
|
1224 fixes x :: "'a::real_normed_vector" |
|
1225 shows "x + 0 == x" by simp |
|
1226 |
|
1227 lemma norm_imp_pos_and_ge: |
|
1228 fixes x :: "'a::real_normed_vector" |
|
1229 shows "norm x == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x" |
|
1230 by atomize auto |
|
1231 |
|
1232 lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith |
|
1233 |
|
1234 lemma norm_pths: |
|
1235 fixes x :: "'a::real_normed_vector" shows |
|
1236 "x = y \<longleftrightarrow> norm (x - y) \<le> 0" |
|
1237 "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)" |
|
1238 using norm_ge_zero[of "x - y"] by auto |
|
1239 |
|
1240 lemma vector_dist_norm: |
|
1241 fixes x :: "'a::real_normed_vector" |
|
1242 shows "dist x y = norm (x - y)" |
|
1243 by (rule dist_norm) |
|
1244 |
|
1245 use "normarith.ML" |
|
1246 |
|
1247 method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac) |
|
1248 *} "Proves simple linear statements about vector norms" |
|
1249 |
|
1250 |
|
1251 text{* Hence more metric properties. *} |
|
1252 |
|
1253 lemma dist_triangle_alt: |
|
1254 fixes x y z :: "'a::metric_space" |
|
1255 shows "dist y z <= dist x y + dist x z" |
|
1256 using dist_triangle [of y z x] by (simp add: dist_commute) |
|
1257 |
|
1258 lemma dist_pos_lt: |
|
1259 fixes x y :: "'a::metric_space" |
|
1260 shows "x \<noteq> y ==> 0 < dist x y" |
|
1261 by (simp add: zero_less_dist_iff) |
|
1262 |
|
1263 lemma dist_nz: |
|
1264 fixes x y :: "'a::metric_space" |
|
1265 shows "x \<noteq> y \<longleftrightarrow> 0 < dist x y" |
|
1266 by (simp add: zero_less_dist_iff) |
|
1267 |
|
1268 lemma dist_triangle_le: |
|
1269 fixes x y z :: "'a::metric_space" |
|
1270 shows "dist x z + dist y z <= e \<Longrightarrow> dist x y <= e" |
|
1271 by (rule order_trans [OF dist_triangle2]) |
|
1272 |
|
1273 lemma dist_triangle_lt: |
|
1274 fixes x y z :: "'a::metric_space" |
|
1275 shows "dist x z + dist y z < e ==> dist x y < e" |
|
1276 by (rule le_less_trans [OF dist_triangle2]) |
|
1277 |
|
1278 lemma dist_triangle_half_l: |
|
1279 fixes x1 x2 y :: "'a::metric_space" |
|
1280 shows "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e" |
|
1281 by (rule dist_triangle_lt [where z=y], simp) |
|
1282 |
|
1283 lemma dist_triangle_half_r: |
|
1284 fixes x1 x2 y :: "'a::metric_space" |
|
1285 shows "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e" |
|
1286 by (rule dist_triangle_half_l, simp_all add: dist_commute) |
|
1287 |
|
1288 lemma dist_triangle_add: |
|
1289 fixes x y x' y' :: "'a::real_normed_vector" |
|
1290 shows "dist (x + y) (x' + y') <= dist x x' + dist y y'" |
|
1291 by norm |
|
1292 |
|
1293 lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y" |
|
1294 unfolding dist_norm vector_ssub_ldistrib[symmetric] norm_mul .. |
|
1295 |
|
1296 lemma dist_triangle_add_half: |
|
1297 fixes x x' y y' :: "'a::real_normed_vector" |
|
1298 shows "dist x x' < e / 2 \<Longrightarrow> dist y y' < e / 2 \<Longrightarrow> dist(x + y) (x' + y') < e" |
|
1299 by norm |
|
1300 |
|
1301 lemma setsum_component [simp]: |
|
1302 fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n" |
|
1303 shows "(setsum f S)$i = setsum (\<lambda>x. (f x)$i) S" |
|
1304 by (cases "finite S", induct S set: finite, simp_all) |
|
1305 |
|
1306 lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)" |
|
1307 by (simp add: Cart_eq) |
|
1308 |
|
1309 lemma setsum_clauses: |
|
1310 shows "setsum f {} = 0" |
|
1311 and "finite S \<Longrightarrow> setsum f (insert x S) = |
|
1312 (if x \<in> S then setsum f S else f x + setsum f S)" |
|
1313 by (auto simp add: insert_absorb) |
|
1314 |
|
1315 lemma setsum_cmul: |
|
1316 fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n" |
|
1317 shows "setsum (\<lambda>x. c *s f x) S = c *s setsum f S" |
|
1318 by (simp add: Cart_eq setsum_right_distrib) |
|
1319 |
|
1320 lemma setsum_norm: |
|
1321 fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" |
|
1322 assumes fS: "finite S" |
|
1323 shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S" |
|
1324 proof(induct rule: finite_induct[OF fS]) |
|
1325 case 1 thus ?case by simp |
|
1326 next |
|
1327 case (2 x S) |
|
1328 from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq) |
|
1329 also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S" |
|
1330 using "2.hyps" by simp |
|
1331 finally show ?case using "2.hyps" by simp |
|
1332 qed |
|
1333 |
|
1334 lemma real_setsum_norm: |
|
1335 fixes f :: "'a \<Rightarrow> real ^'n::finite" |
|
1336 assumes fS: "finite S" |
|
1337 shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S" |
|
1338 proof(induct rule: finite_induct[OF fS]) |
|
1339 case 1 thus ?case by simp |
|
1340 next |
|
1341 case (2 x S) |
|
1342 from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq) |
|
1343 also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S" |
|
1344 using "2.hyps" by simp |
|
1345 finally show ?case using "2.hyps" by simp |
|
1346 qed |
|
1347 |
|
1348 lemma setsum_norm_le: |
|
1349 fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" |
|
1350 assumes fS: "finite S" |
|
1351 and fg: "\<forall>x \<in> S. norm (f x) \<le> g x" |
|
1352 shows "norm (setsum f S) \<le> setsum g S" |
|
1353 proof- |
|
1354 from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S" |
|
1355 by - (rule setsum_mono, simp) |
|
1356 then show ?thesis using setsum_norm[OF fS, of f] fg |
|
1357 by arith |
|
1358 qed |
|
1359 |
|
1360 lemma real_setsum_norm_le: |
|
1361 fixes f :: "'a \<Rightarrow> real ^ 'n::finite" |
|
1362 assumes fS: "finite S" |
|
1363 and fg: "\<forall>x \<in> S. norm (f x) \<le> g x" |
|
1364 shows "norm (setsum f S) \<le> setsum g S" |
|
1365 proof- |
|
1366 from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S" |
|
1367 by - (rule setsum_mono, simp) |
|
1368 then show ?thesis using real_setsum_norm[OF fS, of f] fg |
|
1369 by arith |
|
1370 qed |
|
1371 |
|
1372 lemma setsum_norm_bound: |
|
1373 fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" |
|
1374 assumes fS: "finite S" |
|
1375 and K: "\<forall>x \<in> S. norm (f x) \<le> K" |
|
1376 shows "norm (setsum f S) \<le> of_nat (card S) * K" |
|
1377 using setsum_norm_le[OF fS K] setsum_constant[symmetric] |
|
1378 by simp |
|
1379 |
|
1380 lemma real_setsum_norm_bound: |
|
1381 fixes f :: "'a \<Rightarrow> real ^ 'n::finite" |
|
1382 assumes fS: "finite S" |
|
1383 and K: "\<forall>x \<in> S. norm (f x) \<le> K" |
|
1384 shows "norm (setsum f S) \<le> of_nat (card S) * K" |
|
1385 using real_setsum_norm_le[OF fS K] setsum_constant[symmetric] |
|
1386 by simp |
|
1387 |
|
1388 lemma setsum_vmul: |
|
1389 fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}" |
|
1390 assumes fS: "finite S" |
|
1391 shows "setsum f S *s v = setsum (\<lambda>x. f x *s v) S" |
|
1392 proof(induct rule: finite_induct[OF fS]) |
|
1393 case 1 then show ?case by (simp add: vector_smult_lzero) |
|
1394 next |
|
1395 case (2 x F) |
|
1396 from "2.hyps" have "setsum f (insert x F) *s v = (f x + setsum f F) *s v" |
|
1397 by simp |
|
1398 also have "\<dots> = f x *s v + setsum f F *s v" |
|
1399 by (simp add: vector_sadd_rdistrib) |
|
1400 also have "\<dots> = setsum (\<lambda>x. f x *s v) (insert x F)" using "2.hyps" by simp |
|
1401 finally show ?case . |
|
1402 qed |
|
1403 |
|
1404 (* FIXME : Problem thm setsum_vmul[of _ "f:: 'a \<Rightarrow> real ^'n"] --- |
|
1405 Get rid of *s and use real_vector instead! Also prove that ^ creates a real_vector !! *) |
|
1406 |
|
1407 (* FIXME: Here too need stupid finiteness assumption on T!!! *) |
|
1408 lemma setsum_group: |
|
1409 assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T" |
|
1410 shows "setsum (\<lambda>y. setsum g {x. x\<in> S \<and> f x = y}) T = setsum g S" |
|
1411 |
|
1412 apply (subst setsum_image_gen[OF fS, of g f]) |
|
1413 apply (rule setsum_mono_zero_right[OF fT fST]) |
|
1414 by (auto intro: setsum_0') |
|
1415 |
|
1416 lemma vsum_norm_allsubsets_bound: |
|
1417 fixes f:: "'a \<Rightarrow> real ^'n::finite" |
|
1418 assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e" |
|
1419 shows "setsum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e" |
|
1420 proof- |
|
1421 let ?d = "real CARD('n)" |
|
1422 let ?nf = "\<lambda>x. norm (f x)" |
|
1423 let ?U = "UNIV :: 'n set" |
|
1424 have th0: "setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P = setsum (\<lambda>i. setsum (\<lambda>x. \<bar>f x $ i\<bar>) P) ?U" |
|
1425 by (rule setsum_commute) |
|
1426 have th1: "2 * ?d * e = of_nat (card ?U) * (2 * e)" by (simp add: real_of_nat_def) |
|
1427 have "setsum ?nf P \<le> setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P" |
|
1428 apply (rule setsum_mono) |
|
1429 by (rule norm_le_l1) |
|
1430 also have "\<dots> \<le> 2 * ?d * e" |
|
1431 unfolding th0 th1 |
|
1432 proof(rule setsum_bounded) |
|
1433 fix i assume i: "i \<in> ?U" |
|
1434 let ?Pp = "{x. x\<in> P \<and> f x $ i \<ge> 0}" |
|
1435 let ?Pn = "{x. x \<in> P \<and> f x $ i < 0}" |
|
1436 have thp: "P = ?Pp \<union> ?Pn" by auto |
|
1437 have thp0: "?Pp \<inter> ?Pn ={}" by auto |
|
1438 have PpP: "?Pp \<subseteq> P" and PnP: "?Pn \<subseteq> P" by blast+ |
|
1439 have Ppe:"setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp \<le> e" |
|
1440 using component_le_norm[of "setsum (\<lambda>x. f x) ?Pp" i] fPs[OF PpP] |
|
1441 by (auto intro: abs_le_D1) |
|
1442 have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e" |
|
1443 using component_le_norm[of "setsum (\<lambda>x. - f x) ?Pn" i] fPs[OF PnP] |
|
1444 by (auto simp add: setsum_negf intro: abs_le_D1) |
|
1445 have "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P = setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp + setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn" |
|
1446 apply (subst thp) |
|
1447 apply (rule setsum_Un_zero) |
|
1448 using fP thp0 by auto |
|
1449 also have "\<dots> \<le> 2*e" using Pne Ppe by arith |
|
1450 finally show "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P \<le> 2*e" . |
|
1451 qed |
|
1452 finally show ?thesis . |
|
1453 qed |
|
1454 |
|
1455 lemma dot_lsum: "finite S \<Longrightarrow> setsum f S \<bullet> (y::'a::{comm_ring}^'n) = setsum (\<lambda>x. f x \<bullet> y) S " |
|
1456 by (induct rule: finite_induct, auto simp add: dot_lzero dot_ladd dot_radd) |
|
1457 |
|
1458 lemma dot_rsum: "finite S \<Longrightarrow> (y::'a::{comm_ring}^'n) \<bullet> setsum f S = setsum (\<lambda>x. y \<bullet> f x) S " |
|
1459 by (induct rule: finite_induct, auto simp add: dot_rzero dot_radd) |
|
1460 |
|
1461 subsection{* Basis vectors in coordinate directions. *} |
|
1462 |
|
1463 |
|
1464 definition "basis k = (\<chi> i. if i = k then 1 else 0)" |
|
1465 |
|
1466 lemma basis_component [simp]: "basis k $ i = (if k=i then 1 else 0)" |
|
1467 unfolding basis_def by simp |
|
1468 |
|
1469 lemma delta_mult_idempotent: |
|
1470 "(if k=a then 1 else (0::'a::semiring_1)) * (if k=a then 1 else 0) = (if k=a then 1 else 0)" by (cases "k=a", auto) |
|
1471 |
|
1472 lemma norm_basis: |
|
1473 shows "norm (basis k :: real ^'n::finite) = 1" |
|
1474 apply (simp add: basis_def real_vector_norm_def dot_def) |
|
1475 apply (vector delta_mult_idempotent) |
|
1476 using setsum_delta[of "UNIV :: 'n set" "k" "\<lambda>k. 1::real"] |
|
1477 apply auto |
|
1478 done |
|
1479 |
|
1480 lemma norm_basis_1: "norm(basis 1 :: real ^'n::{finite,one}) = 1" |
|
1481 by (rule norm_basis) |
|
1482 |
|
1483 lemma vector_choose_size: "0 <= c ==> \<exists>(x::real^'n::finite). norm x = c" |
|
1484 apply (rule exI[where x="c *s basis arbitrary"]) |
|
1485 by (simp only: norm_mul norm_basis) |
|
1486 |
|
1487 lemma vector_choose_dist: assumes e: "0 <= e" |
|
1488 shows "\<exists>(y::real^'n::finite). dist x y = e" |
|
1489 proof- |
|
1490 from vector_choose_size[OF e] obtain c:: "real ^'n" where "norm c = e" |
|
1491 by blast |
|
1492 then have "dist x (x - c) = e" by (simp add: dist_norm) |
|
1493 then show ?thesis by blast |
|
1494 qed |
|
1495 |
|
1496 lemma basis_inj: "inj (basis :: 'n \<Rightarrow> real ^'n::finite)" |
|
1497 by (simp add: inj_on_def Cart_eq) |
|
1498 |
|
1499 lemma cond_value_iff: "f (if b then x else y) = (if b then f x else f y)" |
|
1500 by auto |
|
1501 |
|
1502 lemma basis_expansion: |
|
1503 "setsum (\<lambda>i. (x$i) *s basis i) UNIV = (x::('a::ring_1) ^'n::finite)" (is "?lhs = ?rhs" is "setsum ?f ?S = _") |
|
1504 by (auto simp add: Cart_eq cond_value_iff setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong) |
|
1505 |
|
1506 lemma basis_expansion_unique: |
|
1507 "setsum (\<lambda>i. f i *s basis i) UNIV = (x::('a::comm_ring_1) ^'n::finite) \<longleftrightarrow> (\<forall>i. f i = x$i)" |
|
1508 by (simp add: Cart_eq setsum_delta cond_value_iff cong del: if_weak_cong) |
|
1509 |
|
1510 lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)" |
|
1511 by auto |
|
1512 |
|
1513 lemma dot_basis: |
|
1514 shows "basis i \<bullet> x = x$i" "x \<bullet> (basis i :: 'a^'n::finite) = (x$i :: 'a::semiring_1)" |
|
1515 by (auto simp add: dot_def basis_def cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong) |
|
1516 |
|
1517 lemma inner_basis: |
|
1518 fixes x :: "'a::{real_inner, real_algebra_1} ^ 'n::finite" |
|
1519 shows "inner (basis i) x = inner 1 (x $ i)" |
|
1520 and "inner x (basis i) = inner (x $ i) 1" |
|
1521 unfolding inner_vector_def basis_def |
|
1522 by (auto simp add: cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong) |
|
1523 |
|
1524 lemma basis_eq_0: "basis i = (0::'a::semiring_1^'n) \<longleftrightarrow> False" |
|
1525 by (auto simp add: Cart_eq) |
|
1526 |
|
1527 lemma basis_nonzero: |
|
1528 shows "basis k \<noteq> (0:: 'a::semiring_1 ^'n)" |
|
1529 by (simp add: basis_eq_0) |
|
1530 |
|
1531 lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = (z::'a::semiring_1^'n::finite)" |
|
1532 apply (auto simp add: Cart_eq dot_basis) |
|
1533 apply (erule_tac x="basis i" in allE) |
|
1534 apply (simp add: dot_basis) |
|
1535 apply (subgoal_tac "y = z") |
|
1536 apply simp |
|
1537 apply (simp add: Cart_eq) |
|
1538 done |
|
1539 |
|
1540 lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = (y::'a::semiring_1^'n::finite)" |
|
1541 apply (auto simp add: Cart_eq dot_basis) |
|
1542 apply (erule_tac x="basis i" in allE) |
|
1543 apply (simp add: dot_basis) |
|
1544 apply (subgoal_tac "x = y") |
|
1545 apply simp |
|
1546 apply (simp add: Cart_eq) |
|
1547 done |
|
1548 |
|
1549 subsection{* Orthogonality. *} |
|
1550 |
|
1551 definition "orthogonal x y \<longleftrightarrow> (x \<bullet> y = 0)" |
|
1552 |
|
1553 lemma orthogonal_basis: |
|
1554 shows "orthogonal (basis i :: 'a^'n::finite) x \<longleftrightarrow> x$i = (0::'a::ring_1)" |
|
1555 by (auto simp add: orthogonal_def dot_def basis_def cond_value_iff cond_application_beta setsum_delta cong del: if_weak_cong) |
|
1556 |
|
1557 lemma orthogonal_basis_basis: |
|
1558 shows "orthogonal (basis i :: 'a::ring_1^'n::finite) (basis j) \<longleftrightarrow> i \<noteq> j" |
|
1559 unfolding orthogonal_basis[of i] basis_component[of j] by simp |
|
1560 |
|
1561 (* FIXME : Maybe some of these require less than comm_ring, but not all*) |
|
1562 lemma orthogonal_clauses: |
|
1563 "orthogonal a (0::'a::comm_ring ^'n)" |
|
1564 "orthogonal a x ==> orthogonal a (c *s x)" |
|
1565 "orthogonal a x ==> orthogonal a (-x)" |
|
1566 "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x + y)" |
|
1567 "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x - y)" |
|
1568 "orthogonal 0 a" |
|
1569 "orthogonal x a ==> orthogonal (c *s x) a" |
|
1570 "orthogonal x a ==> orthogonal (-x) a" |
|
1571 "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x + y) a" |
|
1572 "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x - y) a" |
|
1573 unfolding orthogonal_def dot_rneg dot_rmult dot_radd dot_rsub |
|
1574 dot_lzero dot_rzero dot_lneg dot_lmult dot_ladd dot_lsub |
|
1575 by simp_all |
|
1576 |
|
1577 lemma orthogonal_commute: "orthogonal (x::'a::{ab_semigroup_mult,comm_monoid_add} ^'n)y \<longleftrightarrow> orthogonal y x" |
|
1578 by (simp add: orthogonal_def dot_sym) |
|
1579 |
|
1580 subsection{* Explicit vector construction from lists. *} |
|
1581 |
|
1582 primrec from_nat :: "nat \<Rightarrow> 'a::{monoid_add,one}" |
|
1583 where "from_nat 0 = 0" | "from_nat (Suc n) = 1 + from_nat n" |
|
1584 |
|
1585 lemma from_nat [simp]: "from_nat = of_nat" |
|
1586 by (rule ext, induct_tac x, simp_all) |
|
1587 |
|
1588 primrec |
|
1589 list_fun :: "nat \<Rightarrow> _ list \<Rightarrow> _ \<Rightarrow> _" |
|
1590 where |
|
1591 "list_fun n [] = (\<lambda>x. 0)" |
|
1592 | "list_fun n (x # xs) = fun_upd (list_fun (Suc n) xs) (from_nat n) x" |
|
1593 |
|
1594 definition "vector l = (\<chi> i. list_fun 1 l i)" |
|
1595 (*definition "vector l = (\<chi> i. if i <= length l then l ! (i - 1) else 0)"*) |
|
1596 |
|
1597 lemma vector_1: "(vector[x]) $1 = x" |
|
1598 unfolding vector_def by simp |
|
1599 |
|
1600 lemma vector_2: |
|
1601 "(vector[x,y]) $1 = x" |
|
1602 "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)" |
|
1603 unfolding vector_def by simp_all |
|
1604 |
|
1605 lemma vector_3: |
|
1606 "(vector [x,y,z] ::('a::zero)^3)$1 = x" |
|
1607 "(vector [x,y,z] ::('a::zero)^3)$2 = y" |
|
1608 "(vector [x,y,z] ::('a::zero)^3)$3 = z" |
|
1609 unfolding vector_def by simp_all |
|
1610 |
|
1611 lemma forall_vector_1: "(\<forall>v::'a::zero^1. P v) \<longleftrightarrow> (\<forall>x. P(vector[x]))" |
|
1612 apply auto |
|
1613 apply (erule_tac x="v$1" in allE) |
|
1614 apply (subgoal_tac "vector [v$1] = v") |
|
1615 apply simp |
|
1616 apply (vector vector_def) |
|
1617 apply (simp add: forall_1) |
|
1618 done |
|
1619 |
|
1620 lemma forall_vector_2: "(\<forall>v::'a::zero^2. P v) \<longleftrightarrow> (\<forall>x y. P(vector[x, y]))" |
|
1621 apply auto |
|
1622 apply (erule_tac x="v$1" in allE) |
|
1623 apply (erule_tac x="v$2" in allE) |
|
1624 apply (subgoal_tac "vector [v$1, v$2] = v") |
|
1625 apply simp |
|
1626 apply (vector vector_def) |
|
1627 apply (simp add: forall_2) |
|
1628 done |
|
1629 |
|
1630 lemma forall_vector_3: "(\<forall>v::'a::zero^3. P v) \<longleftrightarrow> (\<forall>x y z. P(vector[x, y, z]))" |
|
1631 apply auto |
|
1632 apply (erule_tac x="v$1" in allE) |
|
1633 apply (erule_tac x="v$2" in allE) |
|
1634 apply (erule_tac x="v$3" in allE) |
|
1635 apply (subgoal_tac "vector [v$1, v$2, v$3] = v") |
|
1636 apply simp |
|
1637 apply (vector vector_def) |
|
1638 apply (simp add: forall_3) |
|
1639 done |
|
1640 |
|
1641 subsection{* Linear functions. *} |
|
1642 |
|
1643 definition "linear f \<longleftrightarrow> (\<forall>x y. f(x + y) = f x + f y) \<and> (\<forall>c x. f(c *s x) = c *s f x)" |
|
1644 |
|
1645 lemma linear_compose_cmul: "linear f ==> linear (\<lambda>x. (c::'a::comm_semiring) *s f x)" |
|
1646 by (vector linear_def Cart_eq ring_simps) |
|
1647 |
|
1648 lemma linear_compose_neg: "linear (f :: 'a ^'n \<Rightarrow> 'a::comm_ring ^'m) ==> linear (\<lambda>x. -(f(x)))" by (vector linear_def Cart_eq) |
|
1649 |
|
1650 lemma linear_compose_add: "linear (f :: 'a ^'n \<Rightarrow> 'a::semiring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f(x) + g(x))" |
|
1651 by (vector linear_def Cart_eq ring_simps) |
|
1652 |
|
1653 lemma linear_compose_sub: "linear (f :: 'a ^'n \<Rightarrow> 'a::ring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f x - g x)" |
|
1654 by (vector linear_def Cart_eq ring_simps) |
|
1655 |
|
1656 lemma linear_compose: "linear f \<Longrightarrow> linear g ==> linear (g o f)" |
|
1657 by (simp add: linear_def) |
|
1658 |
|
1659 lemma linear_id: "linear id" by (simp add: linear_def id_def) |
|
1660 |
|
1661 lemma linear_zero: "linear (\<lambda>x. 0::'a::semiring_1 ^ 'n)" by (simp add: linear_def) |
|
1662 |
|
1663 lemma linear_compose_setsum: |
|
1664 assumes fS: "finite S" and lS: "\<forall>a \<in> S. linear (f a :: 'a::semiring_1 ^ 'n \<Rightarrow> 'a ^ 'm)" |
|
1665 shows "linear(\<lambda>x. setsum (\<lambda>a. f a x :: 'a::semiring_1 ^'m) S)" |
|
1666 using lS |
|
1667 apply (induct rule: finite_induct[OF fS]) |
|
1668 by (auto simp add: linear_zero intro: linear_compose_add) |
|
1669 |
|
1670 lemma linear_vmul_component: |
|
1671 fixes f:: "'a::semiring_1^'m \<Rightarrow> 'a^'n" |
|
1672 assumes lf: "linear f" |
|
1673 shows "linear (\<lambda>x. f x $ k *s v)" |
|
1674 using lf |
|
1675 apply (auto simp add: linear_def ) |
|
1676 by (vector ring_simps)+ |
|
1677 |
|
1678 lemma linear_0: "linear f ==> f 0 = (0::'a::semiring_1 ^'n)" |
|
1679 unfolding linear_def |
|
1680 apply clarsimp |
|
1681 apply (erule allE[where x="0::'a"]) |
|
1682 apply simp |
|
1683 done |
|
1684 |
|
1685 lemma linear_cmul: "linear f ==> f(c*s x) = c *s f x" by (simp add: linear_def) |
|
1686 |
|
1687 lemma linear_neg: "linear (f :: 'a::ring_1 ^'n \<Rightarrow> _) ==> f (-x) = - f x" |
|
1688 unfolding vector_sneg_minus1 |
|
1689 using linear_cmul[of f] by auto |
|
1690 |
|
1691 lemma linear_add: "linear f ==> f(x + y) = f x + f y" by (metis linear_def) |
|
1692 |
|
1693 lemma linear_sub: "linear (f::'a::ring_1 ^'n \<Rightarrow> _) ==> f(x - y) = f x - f y" |
|
1694 by (simp add: diff_def linear_add linear_neg) |
|
1695 |
|
1696 lemma linear_setsum: |
|
1697 fixes f:: "'a::semiring_1^'n \<Rightarrow> _" |
|
1698 assumes lf: "linear f" and fS: "finite S" |
|
1699 shows "f (setsum g S) = setsum (f o g) S" |
|
1700 proof (induct rule: finite_induct[OF fS]) |
|
1701 case 1 thus ?case by (simp add: linear_0[OF lf]) |
|
1702 next |
|
1703 case (2 x F) |
|
1704 have "f (setsum g (insert x F)) = f (g x + setsum g F)" using "2.hyps" |
|
1705 by simp |
|
1706 also have "\<dots> = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp |
|
1707 also have "\<dots> = setsum (f o g) (insert x F)" using "2.hyps" by simp |
|
1708 finally show ?case . |
|
1709 qed |
|
1710 |
|
1711 lemma linear_setsum_mul: |
|
1712 fixes f:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m" |
|
1713 assumes lf: "linear f" and fS: "finite S" |
|
1714 shows "f (setsum (\<lambda>i. c i *s v i) S) = setsum (\<lambda>i. c i *s f (v i)) S" |
|
1715 using linear_setsum[OF lf fS, of "\<lambda>i. c i *s v i" , unfolded o_def] |
|
1716 linear_cmul[OF lf] by simp |
|
1717 |
|
1718 lemma linear_injective_0: |
|
1719 assumes lf: "linear (f:: 'a::ring_1 ^ 'n \<Rightarrow> _)" |
|
1720 shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)" |
|
1721 proof- |
|
1722 have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)" by (simp add: inj_on_def) |
|
1723 also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)" by simp |
|
1724 also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)" |
|
1725 by (simp add: linear_sub[OF lf]) |
|
1726 also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)" by auto |
|
1727 finally show ?thesis . |
|
1728 qed |
|
1729 |
|
1730 lemma linear_bounded: |
|
1731 fixes f:: "real ^'m::finite \<Rightarrow> real ^'n::finite" |
|
1732 assumes lf: "linear f" |
|
1733 shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x" |
|
1734 proof- |
|
1735 let ?S = "UNIV:: 'm set" |
|
1736 let ?B = "setsum (\<lambda>i. norm(f(basis i))) ?S" |
|
1737 have fS: "finite ?S" by simp |
|
1738 {fix x:: "real ^ 'm" |
|
1739 let ?g = "(\<lambda>i. (x$i) *s (basis i) :: real ^ 'm)" |
|
1740 have "norm (f x) = norm (f (setsum (\<lambda>i. (x$i) *s (basis i)) ?S))" |
|
1741 by (simp only: basis_expansion) |
|
1742 also have "\<dots> = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)" |
|
1743 using linear_setsum[OF lf fS, of ?g, unfolded o_def] linear_cmul[OF lf] |
|
1744 by auto |
|
1745 finally have th0: "norm (f x) = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)" . |
|
1746 {fix i assume i: "i \<in> ?S" |
|
1747 from component_le_norm[of x i] |
|
1748 have "norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" |
|
1749 unfolding norm_mul |
|
1750 apply (simp only: mult_commute) |
|
1751 apply (rule mult_mono) |
|
1752 by (auto simp add: ring_simps norm_ge_zero) } |
|
1753 then have th: "\<forall>i\<in> ?S. norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" by metis |
|
1754 from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th] |
|
1755 have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis} |
|
1756 then show ?thesis by blast |
|
1757 qed |
|
1758 |
|
1759 lemma linear_bounded_pos: |
|
1760 fixes f:: "real ^'n::finite \<Rightarrow> real ^ 'm::finite" |
|
1761 assumes lf: "linear f" |
|
1762 shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x" |
|
1763 proof- |
|
1764 from linear_bounded[OF lf] obtain B where |
|
1765 B: "\<forall>x. norm (f x) \<le> B * norm x" by blast |
|
1766 let ?K = "\<bar>B\<bar> + 1" |
|
1767 have Kp: "?K > 0" by arith |
|
1768 {assume C: "B < 0" |
|
1769 have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff) |
|
1770 with C have "B * norm (1:: real ^ 'n) < 0" |
|
1771 by (simp add: zero_compare_simps) |
|
1772 with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp |
|
1773 } |
|
1774 then have Bp: "B \<ge> 0" by ferrack |
|
1775 {fix x::"real ^ 'n" |
|
1776 have "norm (f x) \<le> ?K * norm x" |
|
1777 using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp |
|
1778 apply (auto simp add: ring_simps split add: abs_split) |
|
1779 apply (erule order_trans, simp) |
|
1780 done |
|
1781 } |
|
1782 then show ?thesis using Kp by blast |
|
1783 qed |
|
1784 |
|
1785 lemma smult_conv_scaleR: "c *s x = scaleR c x" |
|
1786 unfolding vector_scalar_mult_def vector_scaleR_def by simp |
|
1787 |
|
1788 lemma linear_conv_bounded_linear: |
|
1789 fixes f :: "real ^ _ \<Rightarrow> real ^ _" |
|
1790 shows "linear f \<longleftrightarrow> bounded_linear f" |
|
1791 proof |
|
1792 assume "linear f" |
|
1793 show "bounded_linear f" |
|
1794 proof |
|
1795 fix x y show "f (x + y) = f x + f y" |
|
1796 using `linear f` unfolding linear_def by simp |
|
1797 next |
|
1798 fix r x show "f (scaleR r x) = scaleR r (f x)" |
|
1799 using `linear f` unfolding linear_def |
|
1800 by (simp add: smult_conv_scaleR) |
|
1801 next |
|
1802 have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x" |
|
1803 using `linear f` by (rule linear_bounded) |
|
1804 thus "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K" |
|
1805 by (simp add: mult_commute) |
|
1806 qed |
|
1807 next |
|
1808 assume "bounded_linear f" |
|
1809 then interpret f: bounded_linear f . |
|
1810 show "linear f" |
|
1811 unfolding linear_def smult_conv_scaleR |
|
1812 by (simp add: f.add f.scaleR) |
|
1813 qed |
|
1814 |
|
1815 subsection{* Bilinear functions. *} |
|
1816 |
|
1817 definition "bilinear f \<longleftrightarrow> (\<forall>x. linear(\<lambda>y. f x y)) \<and> (\<forall>y. linear(\<lambda>x. f x y))" |
|
1818 |
|
1819 lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)" |
|
1820 by (simp add: bilinear_def linear_def) |
|
1821 lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)" |
|
1822 by (simp add: bilinear_def linear_def) |
|
1823 |
|
1824 lemma bilinear_lmul: "bilinear h ==> h (c *s x) y = c *s (h x y)" |
|
1825 by (simp add: bilinear_def linear_def) |
|
1826 |
|
1827 lemma bilinear_rmul: "bilinear h ==> h x (c *s y) = c *s (h x y)" |
|
1828 by (simp add: bilinear_def linear_def) |
|
1829 |
|
1830 lemma bilinear_lneg: "bilinear h ==> h (- (x:: 'a::ring_1 ^ 'n)) y = -(h x y)" |
|
1831 by (simp only: vector_sneg_minus1 bilinear_lmul) |
|
1832 |
|
1833 lemma bilinear_rneg: "bilinear h ==> h x (- (y:: 'a::ring_1 ^ 'n)) = - h x y" |
|
1834 by (simp only: vector_sneg_minus1 bilinear_rmul) |
|
1835 |
|
1836 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0" |
|
1837 using add_imp_eq[of x y 0] by auto |
|
1838 |
|
1839 lemma bilinear_lzero: |
|
1840 fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h 0 x = 0" |
|
1841 using bilinear_ladd[OF bh, of 0 0 x] |
|
1842 by (simp add: eq_add_iff ring_simps) |
|
1843 |
|
1844 lemma bilinear_rzero: |
|
1845 fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h x 0 = 0" |
|
1846 using bilinear_radd[OF bh, of x 0 0 ] |
|
1847 by (simp add: eq_add_iff ring_simps) |
|
1848 |
|
1849 lemma bilinear_lsub: "bilinear h ==> h (x - (y:: 'a::ring_1 ^ 'n)) z = h x z - h y z" |
|
1850 by (simp add: diff_def bilinear_ladd bilinear_lneg) |
|
1851 |
|
1852 lemma bilinear_rsub: "bilinear h ==> h z (x - (y:: 'a::ring_1 ^ 'n)) = h z x - h z y" |
|
1853 by (simp add: diff_def bilinear_radd bilinear_rneg) |
|
1854 |
|
1855 lemma bilinear_setsum: |
|
1856 fixes h:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m \<Rightarrow> 'a ^ 'k" |
|
1857 assumes bh: "bilinear h" and fS: "finite S" and fT: "finite T" |
|
1858 shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) " |
|
1859 proof- |
|
1860 have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S" |
|
1861 apply (rule linear_setsum[unfolded o_def]) |
|
1862 using bh fS by (auto simp add: bilinear_def) |
|
1863 also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S" |
|
1864 apply (rule setsum_cong, simp) |
|
1865 apply (rule linear_setsum[unfolded o_def]) |
|
1866 using bh fT by (auto simp add: bilinear_def) |
|
1867 finally show ?thesis unfolding setsum_cartesian_product . |
|
1868 qed |
|
1869 |
|
1870 lemma bilinear_bounded: |
|
1871 fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite" |
|
1872 assumes bh: "bilinear h" |
|
1873 shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y" |
|
1874 proof- |
|
1875 let ?M = "UNIV :: 'm set" |
|
1876 let ?N = "UNIV :: 'n set" |
|
1877 let ?B = "setsum (\<lambda>(i,j). norm (h (basis i) (basis j))) (?M \<times> ?N)" |
|
1878 have fM: "finite ?M" and fN: "finite ?N" by simp_all |
|
1879 {fix x:: "real ^ 'm" and y :: "real^'n" |
|
1880 have "norm (h x y) = norm (h (setsum (\<lambda>i. (x$i) *s basis i) ?M) (setsum (\<lambda>i. (y$i) *s basis i) ?N))" unfolding basis_expansion .. |
|
1881 also have "\<dots> = norm (setsum (\<lambda> (i,j). h ((x$i) *s basis i) ((y$j) *s basis j)) (?M \<times> ?N))" unfolding bilinear_setsum[OF bh fM fN] .. |
|
1882 finally have th: "norm (h x y) = \<dots>" . |
|
1883 have "norm (h x y) \<le> ?B * norm x * norm y" |
|
1884 apply (simp add: setsum_left_distrib th) |
|
1885 apply (rule real_setsum_norm_le) |
|
1886 using fN fM |
|
1887 apply simp |
|
1888 apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps) |
|
1889 apply (rule mult_mono) |
|
1890 apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm) |
|
1891 apply (rule mult_mono) |
|
1892 apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm) |
|
1893 done} |
|
1894 then show ?thesis by metis |
|
1895 qed |
|
1896 |
|
1897 lemma bilinear_bounded_pos: |
|
1898 fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite" |
|
1899 assumes bh: "bilinear h" |
|
1900 shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y" |
|
1901 proof- |
|
1902 from bilinear_bounded[OF bh] obtain B where |
|
1903 B: "\<forall>x y. norm (h x y) \<le> B * norm x * norm y" by blast |
|
1904 let ?K = "\<bar>B\<bar> + 1" |
|
1905 have Kp: "?K > 0" by arith |
|
1906 have KB: "B < ?K" by arith |
|
1907 {fix x::"real ^'m" and y :: "real ^'n" |
|
1908 from KB Kp |
|
1909 have "B * norm x * norm y \<le> ?K * norm x * norm y" |
|
1910 apply - |
|
1911 apply (rule mult_right_mono, rule mult_right_mono) |
|
1912 by (auto simp add: norm_ge_zero) |
|
1913 then have "norm (h x y) \<le> ?K * norm x * norm y" |
|
1914 using B[rule_format, of x y] by simp} |
|
1915 with Kp show ?thesis by blast |
|
1916 qed |
|
1917 |
|
1918 lemma bilinear_conv_bounded_bilinear: |
|
1919 fixes h :: "real ^ _ \<Rightarrow> real ^ _ \<Rightarrow> real ^ _" |
|
1920 shows "bilinear h \<longleftrightarrow> bounded_bilinear h" |
|
1921 proof |
|
1922 assume "bilinear h" |
|
1923 show "bounded_bilinear h" |
|
1924 proof |
|
1925 fix x y z show "h (x + y) z = h x z + h y z" |
|
1926 using `bilinear h` unfolding bilinear_def linear_def by simp |
|
1927 next |
|
1928 fix x y z show "h x (y + z) = h x y + h x z" |
|
1929 using `bilinear h` unfolding bilinear_def linear_def by simp |
|
1930 next |
|
1931 fix r x y show "h (scaleR r x) y = scaleR r (h x y)" |
|
1932 using `bilinear h` unfolding bilinear_def linear_def |
|
1933 by (simp add: smult_conv_scaleR) |
|
1934 next |
|
1935 fix r x y show "h x (scaleR r y) = scaleR r (h x y)" |
|
1936 using `bilinear h` unfolding bilinear_def linear_def |
|
1937 by (simp add: smult_conv_scaleR) |
|
1938 next |
|
1939 have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y" |
|
1940 using `bilinear h` by (rule bilinear_bounded) |
|
1941 thus "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K" |
|
1942 by (simp add: mult_ac) |
|
1943 qed |
|
1944 next |
|
1945 assume "bounded_bilinear h" |
|
1946 then interpret h: bounded_bilinear h . |
|
1947 show "bilinear h" |
|
1948 unfolding bilinear_def linear_conv_bounded_linear |
|
1949 using h.bounded_linear_left h.bounded_linear_right |
|
1950 by simp |
|
1951 qed |
|
1952 |
|
1953 subsection{* Adjoints. *} |
|
1954 |
|
1955 definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)" |
|
1956 |
|
1957 lemma choice_iff: "(\<forall>x. \<exists>y. P x y) \<longleftrightarrow> (\<exists>f. \<forall>x. P x (f x))" by metis |
|
1958 |
|
1959 lemma adjoint_works_lemma: |
|
1960 fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite" |
|
1961 assumes lf: "linear f" |
|
1962 shows "\<forall>x y. f x \<bullet> y = x \<bullet> adjoint f y" |
|
1963 proof- |
|
1964 let ?N = "UNIV :: 'n set" |
|
1965 let ?M = "UNIV :: 'm set" |
|
1966 have fN: "finite ?N" by simp |
|
1967 have fM: "finite ?M" by simp |
|
1968 {fix y:: "'a ^ 'm" |
|
1969 let ?w = "(\<chi> i. (f (basis i) \<bullet> y)) :: 'a ^ 'n" |
|
1970 {fix x |
|
1971 have "f x \<bullet> y = f (setsum (\<lambda>i. (x$i) *s basis i) ?N) \<bullet> y" |
|
1972 by (simp only: basis_expansion) |
|
1973 also have "\<dots> = (setsum (\<lambda>i. (x$i) *s f (basis i)) ?N) \<bullet> y" |
|
1974 unfolding linear_setsum[OF lf fN] |
|
1975 by (simp add: linear_cmul[OF lf]) |
|
1976 finally have "f x \<bullet> y = x \<bullet> ?w" |
|
1977 apply (simp only: ) |
|
1978 apply (simp add: dot_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] ring_simps) |
|
1979 done} |
|
1980 } |
|
1981 then show ?thesis unfolding adjoint_def |
|
1982 some_eq_ex[of "\<lambda>f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y"] |
|
1983 using choice_iff[of "\<lambda>a b. \<forall>x. f x \<bullet> a = x \<bullet> b "] |
|
1984 by metis |
|
1985 qed |
|
1986 |
|
1987 lemma adjoint_works: |
|
1988 fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite" |
|
1989 assumes lf: "linear f" |
|
1990 shows "x \<bullet> adjoint f y = f x \<bullet> y" |
|
1991 using adjoint_works_lemma[OF lf] by metis |
|
1992 |
|
1993 |
|
1994 lemma adjoint_linear: |
|
1995 fixes f :: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite" |
|
1996 assumes lf: "linear f" |
|
1997 shows "linear (adjoint f)" |
|
1998 by (simp add: linear_def vector_eq_ldot[symmetric] dot_radd dot_rmult adjoint_works[OF lf]) |
|
1999 |
|
2000 lemma adjoint_clauses: |
|
2001 fixes f:: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite" |
|
2002 assumes lf: "linear f" |
|
2003 shows "x \<bullet> adjoint f y = f x \<bullet> y" |
|
2004 and "adjoint f y \<bullet> x = y \<bullet> f x" |
|
2005 by (simp_all add: adjoint_works[OF lf] dot_sym ) |
|
2006 |
|
2007 lemma adjoint_adjoint: |
|
2008 fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite" |
|
2009 assumes lf: "linear f" |
|
2010 shows "adjoint (adjoint f) = f" |
|
2011 apply (rule ext) |
|
2012 by (simp add: vector_eq_ldot[symmetric] adjoint_clauses[OF adjoint_linear[OF lf]] adjoint_clauses[OF lf]) |
|
2013 |
|
2014 lemma adjoint_unique: |
|
2015 fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite" |
|
2016 assumes lf: "linear f" and u: "\<forall>x y. f' x \<bullet> y = x \<bullet> f y" |
|
2017 shows "f' = adjoint f" |
|
2018 apply (rule ext) |
|
2019 using u |
|
2020 by (simp add: vector_eq_rdot[symmetric] adjoint_clauses[OF lf]) |
|
2021 |
|
2022 text{* Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"} *} |
|
2023 |
|
2024 consts generic_mult :: "'a \<Rightarrow> 'b \<Rightarrow> 'c" (infixr "\<star>" 75) |
|
2025 |
|
2026 defs (overloaded) |
|
2027 matrix_matrix_mult_def: "(m:: ('a::semiring_1) ^'n^'m) \<star> (m' :: 'a ^'p^'n) \<equiv> (\<chi> i j. setsum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m" |
|
2028 |
|
2029 abbreviation |
|
2030 matrix_matrix_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m" (infixl "**" 70) |
|
2031 where "m ** m' == m\<star> m'" |
|
2032 |
|
2033 defs (overloaded) |
|
2034 matrix_vector_mult_def: "(m::('a::semiring_1) ^'n^'m) \<star> (x::'a ^'n) \<equiv> (\<chi> i. setsum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m" |
|
2035 |
|
2036 abbreviation |
|
2037 matrix_vector_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm" (infixl "*v" 70) |
|
2038 where |
|
2039 "m *v v == m \<star> v" |
|
2040 |
|
2041 defs (overloaded) |
|
2042 vector_matrix_mult_def: "(x::'a^'m) \<star> (m::('a::semiring_1) ^'n^'m) \<equiv> (\<chi> j. setsum (\<lambda>i. ((m$i)$j) * (x$i)) (UNIV :: 'm set)) :: 'a^'n" |
|
2043 |
|
2044 abbreviation |
|
2045 vactor_matrix_mult' :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n " (infixl "v*" 70) |
|
2046 where |
|
2047 "v v* m == v \<star> m" |
|
2048 |
|
2049 definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)" |
|
2050 definition "(transp::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))" |
|
2051 definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))" |
|
2052 definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))" |
|
2053 definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}" |
|
2054 definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}" |
|
2055 |
|
2056 lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def) |
|
2057 lemma matrix_add_ldistrib: "(A ** (B + C)) = (A \<star> B) + (A \<star> C)" |
|
2058 by (vector matrix_matrix_mult_def setsum_addf[symmetric] ring_simps) |
|
2059 |
|
2060 lemma matrix_mul_lid: |
|
2061 fixes A :: "'a::semiring_1 ^ 'm ^ 'n::finite" |
|
2062 shows "mat 1 ** A = A" |
|
2063 apply (simp add: matrix_matrix_mult_def mat_def) |
|
2064 apply vector |
|
2065 by (auto simp only: cond_value_iff cond_application_beta setsum_delta'[OF finite] mult_1_left mult_zero_left if_True UNIV_I) |
|
2066 |
|
2067 |
|
2068 lemma matrix_mul_rid: |
|
2069 fixes A :: "'a::semiring_1 ^ 'm::finite ^ 'n" |
|
2070 shows "A ** mat 1 = A" |
|
2071 apply (simp add: matrix_matrix_mult_def mat_def) |
|
2072 apply vector |
|
2073 by (auto simp only: cond_value_iff cond_application_beta setsum_delta[OF finite] mult_1_right mult_zero_right if_True UNIV_I cong: if_cong) |
|
2074 |
|
2075 lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C" |
|
2076 apply (vector matrix_matrix_mult_def setsum_right_distrib setsum_left_distrib mult_assoc) |
|
2077 apply (subst setsum_commute) |
|
2078 apply simp |
|
2079 done |
|
2080 |
|
2081 lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x" |
|
2082 apply (vector matrix_matrix_mult_def matrix_vector_mult_def setsum_right_distrib setsum_left_distrib mult_assoc) |
|
2083 apply (subst setsum_commute) |
|
2084 apply simp |
|
2085 done |
|
2086 |
|
2087 lemma matrix_vector_mul_lid: "mat 1 *v x = (x::'a::semiring_1 ^ 'n::finite)" |
|
2088 apply (vector matrix_vector_mult_def mat_def) |
|
2089 by (simp add: cond_value_iff cond_application_beta |
|
2090 setsum_delta' cong del: if_weak_cong) |
|
2091 |
|
2092 lemma matrix_transp_mul: "transp(A ** B) = transp B ** transp (A::'a::comm_semiring_1^'m^'n)" |
|
2093 by (simp add: matrix_matrix_mult_def transp_def Cart_eq mult_commute) |
|
2094 |
|
2095 lemma matrix_eq: |
|
2096 fixes A B :: "'a::semiring_1 ^ 'n::finite ^ 'm" |
|
2097 shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs") |
|
2098 apply auto |
|
2099 apply (subst Cart_eq) |
|
2100 apply clarify |
|
2101 apply (clarsimp simp add: matrix_vector_mult_def basis_def cond_value_iff cond_application_beta Cart_eq cong del: if_weak_cong) |
|
2102 apply (erule_tac x="basis ia" in allE) |
|
2103 apply (erule_tac x="i" in allE) |
|
2104 by (auto simp add: basis_def cond_value_iff cond_application_beta setsum_delta[OF finite] cong del: if_weak_cong) |
|
2105 |
|
2106 lemma matrix_vector_mul_component: |
|
2107 shows "((A::'a::semiring_1^'n'^'m) *v x)$k = (A$k) \<bullet> x" |
|
2108 by (simp add: matrix_vector_mult_def dot_def) |
|
2109 |
|
2110 lemma dot_lmul_matrix: "((x::'a::comm_semiring_1 ^'n) v* A) \<bullet> y = x \<bullet> (A *v y)" |
|
2111 apply (simp add: dot_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac) |
|
2112 apply (subst setsum_commute) |
|
2113 by simp |
|
2114 |
|
2115 lemma transp_mat: "transp (mat n) = mat n" |
|
2116 by (vector transp_def mat_def) |
|
2117 |
|
2118 lemma transp_transp: "transp(transp A) = A" |
|
2119 by (vector transp_def) |
|
2120 |
|
2121 lemma row_transp: |
|
2122 fixes A:: "'a::semiring_1^'n^'m" |
|
2123 shows "row i (transp A) = column i A" |
|
2124 by (simp add: row_def column_def transp_def Cart_eq) |
|
2125 |
|
2126 lemma column_transp: |
|
2127 fixes A:: "'a::semiring_1^'n^'m" |
|
2128 shows "column i (transp A) = row i A" |
|
2129 by (simp add: row_def column_def transp_def Cart_eq) |
|
2130 |
|
2131 lemma rows_transp: "rows(transp (A::'a::semiring_1^'n^'m)) = columns A" |
|
2132 by (auto simp add: rows_def columns_def row_transp intro: set_ext) |
|
2133 |
|
2134 lemma columns_transp: "columns(transp (A::'a::semiring_1^'n^'m)) = rows A" by (metis transp_transp rows_transp) |
|
2135 |
|
2136 text{* Two sometimes fruitful ways of looking at matrix-vector multiplication. *} |
|
2137 |
|
2138 lemma matrix_mult_dot: "A *v x = (\<chi> i. A$i \<bullet> x)" |
|
2139 by (simp add: matrix_vector_mult_def dot_def) |
|
2140 |
|
2141 lemma matrix_mult_vsum: "(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)" |
|
2142 by (simp add: matrix_vector_mult_def Cart_eq column_def mult_commute) |
|
2143 |
|
2144 lemma vector_componentwise: |
|
2145 "(x::'a::ring_1^'n::finite) = (\<chi> j. setsum (\<lambda>i. (x$i) * (basis i :: 'a^'n)$j) (UNIV :: 'n set))" |
|
2146 apply (subst basis_expansion[symmetric]) |
|
2147 by (vector Cart_eq setsum_component) |
|
2148 |
|
2149 lemma linear_componentwise: |
|
2150 fixes f:: "'a::ring_1 ^ 'm::finite \<Rightarrow> 'a ^ 'n" |
|
2151 assumes lf: "linear f" |
|
2152 shows "(f x)$j = setsum (\<lambda>i. (x$i) * (f (basis i)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs") |
|
2153 proof- |
|
2154 let ?M = "(UNIV :: 'm set)" |
|
2155 let ?N = "(UNIV :: 'n set)" |
|
2156 have fM: "finite ?M" by simp |
|
2157 have "?rhs = (setsum (\<lambda>i.(x$i) *s f (basis i) ) ?M)$j" |
|
2158 unfolding vector_smult_component[symmetric] |
|
2159 unfolding setsum_component[of "(\<lambda>i.(x$i) *s f (basis i :: 'a^'m))" ?M] |
|
2160 .. |
|
2161 then show ?thesis unfolding linear_setsum_mul[OF lf fM, symmetric] basis_expansion .. |
|
2162 qed |
|
2163 |
|
2164 text{* Inverse matrices (not necessarily square) *} |
|
2165 |
|
2166 definition "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)" |
|
2167 |
|
2168 definition "matrix_inv(A:: 'a::semiring_1^'n^'m) = |
|
2169 (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)" |
|
2170 |
|
2171 text{* Correspondence between matrices and linear operators. *} |
|
2172 |
|
2173 definition matrix:: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n" |
|
2174 where "matrix f = (\<chi> i j. (f(basis j))$i)" |
|
2175 |
|
2176 lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::'a::comm_semiring_1 ^ 'n))" |
|
2177 by (simp add: linear_def matrix_vector_mult_def Cart_eq ring_simps setsum_right_distrib setsum_addf) |
|
2178 |
|
2179 lemma matrix_works: assumes lf: "linear f" shows "matrix f *v x = f (x::'a::comm_ring_1 ^ 'n::finite)" |
|
2180 apply (simp add: matrix_def matrix_vector_mult_def Cart_eq mult_commute) |
|
2181 apply clarify |
|
2182 apply (rule linear_componentwise[OF lf, symmetric]) |
|
2183 done |
|
2184 |
|
2185 lemma matrix_vector_mul: "linear f ==> f = (\<lambda>x. matrix f *v (x::'a::comm_ring_1 ^ 'n::finite))" by (simp add: ext matrix_works) |
|
2186 |
|
2187 lemma matrix_of_matrix_vector_mul: "matrix(\<lambda>x. A *v (x :: 'a:: comm_ring_1 ^ 'n::finite)) = A" |
|
2188 by (simp add: matrix_eq matrix_vector_mul_linear matrix_works) |
|
2189 |
|
2190 lemma matrix_compose: |
|
2191 assumes lf: "linear (f::'a::comm_ring_1^'n::finite \<Rightarrow> 'a^'m::finite)" |
|
2192 and lg: "linear (g::'a::comm_ring_1^'m::finite \<Rightarrow> 'a^'k)" |
|
2193 shows "matrix (g o f) = matrix g ** matrix f" |
|
2194 using lf lg linear_compose[OF lf lg] matrix_works[OF linear_compose[OF lf lg]] |
|
2195 by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def) |
|
2196 |
|
2197 lemma matrix_vector_column:"(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\<lambda>i. (x$i) *s ((transp A)$i)) (UNIV:: 'n set)" |
|
2198 by (simp add: matrix_vector_mult_def transp_def Cart_eq mult_commute) |
|
2199 |
|
2200 lemma adjoint_matrix: "adjoint(\<lambda>x. (A::'a::comm_ring_1^'n::finite^'m::finite) *v x) = (\<lambda>x. transp A *v x)" |
|
2201 apply (rule adjoint_unique[symmetric]) |
|
2202 apply (rule matrix_vector_mul_linear) |
|
2203 apply (simp add: transp_def dot_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib) |
|
2204 apply (subst setsum_commute) |
|
2205 apply (auto simp add: mult_ac) |
|
2206 done |
|
2207 |
|
2208 lemma matrix_adjoint: assumes lf: "linear (f :: 'a::comm_ring_1^'n::finite \<Rightarrow> 'a ^ 'm::finite)" |
|
2209 shows "matrix(adjoint f) = transp(matrix f)" |
|
2210 apply (subst matrix_vector_mul[OF lf]) |
|
2211 unfolding adjoint_matrix matrix_of_matrix_vector_mul .. |
|
2212 |
|
2213 subsection{* Interlude: Some properties of real sets *} |
|
2214 |
|
2215 lemma seq_mono_lemma: assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n" and "\<forall>n \<ge> m. e n <= e m" |
|
2216 shows "\<forall>n \<ge> m. d n < e m" |
|
2217 using prems apply auto |
|
2218 apply (erule_tac x="n" in allE) |
|
2219 apply (erule_tac x="n" in allE) |
|
2220 apply auto |
|
2221 done |
|
2222 |
|
2223 |
|
2224 lemma real_convex_bound_lt: |
|
2225 assumes xa: "(x::real) < a" and ya: "y < a" and u: "0 <= u" and v: "0 <= v" |
|
2226 and uv: "u + v = 1" |
|
2227 shows "u * x + v * y < a" |
|
2228 proof- |
|
2229 have uv': "u = 0 \<longrightarrow> v \<noteq> 0" using u v uv by arith |
|
2230 have "a = a * (u + v)" unfolding uv by simp |
|
2231 hence th: "u * a + v * a = a" by (simp add: ring_simps) |
|
2232 from xa u have "u \<noteq> 0 \<Longrightarrow> u*x < u*a" by (simp add: mult_compare_simps) |
|
2233 from ya v have "v \<noteq> 0 \<Longrightarrow> v * y < v * a" by (simp add: mult_compare_simps) |
|
2234 from xa ya u v have "u * x + v * y < u * a + v * a" |
|
2235 apply (cases "u = 0", simp_all add: uv') |
|
2236 apply(rule mult_strict_left_mono) |
|
2237 using uv' apply simp_all |
|
2238 |
|
2239 apply (rule add_less_le_mono) |
|
2240 apply(rule mult_strict_left_mono) |
|
2241 apply simp_all |
|
2242 apply (rule mult_left_mono) |
|
2243 apply simp_all |
|
2244 done |
|
2245 thus ?thesis unfolding th . |
|
2246 qed |
|
2247 |
|
2248 lemma real_convex_bound_le: |
|
2249 assumes xa: "(x::real) \<le> a" and ya: "y \<le> a" and u: "0 <= u" and v: "0 <= v" |
|
2250 and uv: "u + v = 1" |
|
2251 shows "u * x + v * y \<le> a" |
|
2252 proof- |
|
2253 from xa ya u v have "u * x + v * y \<le> u * a + v * a" by (simp add: add_mono mult_left_mono) |
|
2254 also have "\<dots> \<le> (u + v) * a" by (simp add: ring_simps) |
|
2255 finally show ?thesis unfolding uv by simp |
|
2256 qed |
|
2257 |
|
2258 lemma infinite_enumerate: assumes fS: "infinite S" |
|
2259 shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)" |
|
2260 unfolding subseq_def |
|
2261 using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto |
|
2262 |
|
2263 lemma approachable_lt_le: "(\<exists>(d::real)>0. \<forall>x. f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> P x)" |
|
2264 apply auto |
|
2265 apply (rule_tac x="d/2" in exI) |
|
2266 apply auto |
|
2267 done |
|
2268 |
|
2269 |
|
2270 lemma triangle_lemma: |
|
2271 assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x^2 <= y^2 + z^2" |
|
2272 shows "x <= y + z" |
|
2273 proof- |
|
2274 have "y^2 + z^2 \<le> y^2 + 2*y*z + z^2" using z y by (simp add: zero_compare_simps) |
|
2275 with xy have th: "x ^2 \<le> (y+z)^2" by (simp add: power2_eq_square ring_simps) |
|
2276 from y z have yz: "y + z \<ge> 0" by arith |
|
2277 from power2_le_imp_le[OF th yz] show ?thesis . |
|
2278 qed |
|
2279 |
|
2280 |
|
2281 lemma lambda_skolem: "(\<forall>i. \<exists>x. P i x) \<longleftrightarrow> |
|
2282 (\<exists>x::'a ^ 'n. \<forall>i. P i (x$i))" (is "?lhs \<longleftrightarrow> ?rhs") |
|
2283 proof- |
|
2284 let ?S = "(UNIV :: 'n set)" |
|
2285 {assume H: "?rhs" |
|
2286 then have ?lhs by auto} |
|
2287 moreover |
|
2288 {assume H: "?lhs" |
|
2289 then obtain f where f:"\<forall>i. P i (f i)" unfolding choice_iff by metis |
|
2290 let ?x = "(\<chi> i. (f i)) :: 'a ^ 'n" |
|
2291 {fix i |
|
2292 from f have "P i (f i)" by metis |
|
2293 then have "P i (?x$i)" by auto |
|
2294 } |
|
2295 hence "\<forall>i. P i (?x$i)" by metis |
|
2296 hence ?rhs by metis } |
|
2297 ultimately show ?thesis by metis |
|
2298 qed |
|
2299 |
|
2300 (* Supremum and infimum of real sets *) |
|
2301 |
|
2302 |
|
2303 definition rsup:: "real set \<Rightarrow> real" where |
|
2304 "rsup S = (SOME a. isLub UNIV S a)" |
|
2305 |
|
2306 lemma rsup_alt: "rsup S = (SOME a. (\<forall>x \<in> S. x \<le> a) \<and> (\<forall>b. (\<forall>x \<in> S. x \<le> b) \<longrightarrow> a \<le> b))" by (auto simp add: isLub_def rsup_def leastP_def isUb_def setle_def setge_def) |
|
2307 |
|
2308 lemma rsup: assumes Se: "S \<noteq> {}" and b: "\<exists>b. S *<= b" |
|
2309 shows "isLub UNIV S (rsup S)" |
|
2310 using Se b |
|
2311 unfolding rsup_def |
|
2312 apply clarify |
|
2313 apply (rule someI_ex) |
|
2314 apply (rule reals_complete) |
|
2315 by (auto simp add: isUb_def setle_def) |
|
2316 |
|
2317 lemma rsup_le: assumes Se: "S \<noteq> {}" and Sb: "S *<= b" shows "rsup S \<le> b" |
|
2318 proof- |
|
2319 from Sb have bu: "isUb UNIV S b" by (simp add: isUb_def setle_def) |
|
2320 from rsup[OF Se] Sb have "isLub UNIV S (rsup S)" by blast |
|
2321 then show ?thesis using bu by (auto simp add: isLub_def leastP_def setle_def setge_def) |
|
2322 qed |
|
2323 |
|
2324 lemma rsup_finite_Max: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2325 shows "rsup S = Max S" |
|
2326 using fS Se |
|
2327 proof- |
|
2328 let ?m = "Max S" |
|
2329 from Max_ge[OF fS] have Sm: "\<forall> x\<in> S. x \<le> ?m" by metis |
|
2330 with rsup[OF Se] have lub: "isLub UNIV S (rsup S)" by (metis setle_def) |
|
2331 from Max_in[OF fS Se] lub have mrS: "?m \<le> rsup S" |
|
2332 by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def) |
|
2333 moreover |
|
2334 have "rsup S \<le> ?m" using Sm lub |
|
2335 by (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def) |
|
2336 ultimately show ?thesis by arith |
|
2337 qed |
|
2338 |
|
2339 lemma rsup_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2340 shows "rsup S \<in> S" |
|
2341 using rsup_finite_Max[OF fS Se] Max_in[OF fS Se] by metis |
|
2342 |
|
2343 lemma rsup_finite_Ub: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2344 shows "isUb S S (rsup S)" |
|
2345 using rsup_finite_Max[OF fS Se] rsup_finite_in[OF fS Se] Max_ge[OF fS] |
|
2346 unfolding isUb_def setle_def by metis |
|
2347 |
|
2348 lemma rsup_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2349 shows "a \<le> rsup S \<longleftrightarrow> (\<exists> x \<in> S. a \<le> x)" |
|
2350 using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def) |
|
2351 |
|
2352 lemma rsup_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2353 shows "a \<ge> rsup S \<longleftrightarrow> (\<forall> x \<in> S. a \<ge> x)" |
|
2354 using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def) |
|
2355 |
|
2356 lemma rsup_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2357 shows "a < rsup S \<longleftrightarrow> (\<exists> x \<in> S. a < x)" |
|
2358 using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def) |
|
2359 |
|
2360 lemma rsup_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2361 shows "a > rsup S \<longleftrightarrow> (\<forall> x \<in> S. a > x)" |
|
2362 using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def) |
|
2363 |
|
2364 lemma rsup_unique: assumes b: "S *<= b" and S: "\<forall>b' < b. \<exists>x \<in> S. b' < x" |
|
2365 shows "rsup S = b" |
|
2366 using b S |
|
2367 unfolding setle_def rsup_alt |
|
2368 apply - |
|
2369 apply (rule some_equality) |
|
2370 apply (metis linorder_not_le order_eq_iff[symmetric])+ |
|
2371 done |
|
2372 |
|
2373 lemma rsup_le_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. T *<= b) \<Longrightarrow> rsup S \<le> rsup T" |
|
2374 apply (rule rsup_le) |
|
2375 apply simp |
|
2376 using rsup[of T] by (auto simp add: isLub_def leastP_def setge_def setle_def isUb_def) |
|
2377 |
|
2378 lemma isUb_def': "isUb R S = (\<lambda>x. S *<= x \<and> x \<in> R)" |
|
2379 apply (rule ext) |
|
2380 by (metis isUb_def) |
|
2381 |
|
2382 lemma UNIV_trivial: "UNIV x" using UNIV_I[of x] by (metis mem_def) |
|
2383 lemma rsup_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b" |
|
2384 shows "a \<le> rsup S \<and> rsup S \<le> b" |
|
2385 proof- |
|
2386 from rsup[OF Se] u have lub: "isLub UNIV S (rsup S)" by blast |
|
2387 hence b: "rsup S \<le> b" using u by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def') |
|
2388 from Se obtain y where y: "y \<in> S" by blast |
|
2389 from lub l have "a \<le> rsup S" apply (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def') |
|
2390 apply (erule ballE[where x=y]) |
|
2391 apply (erule ballE[where x=y]) |
|
2392 apply arith |
|
2393 using y apply auto |
|
2394 done |
|
2395 with b show ?thesis by blast |
|
2396 qed |
|
2397 |
|
2398 lemma rsup_abs_le: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rsup S\<bar> \<le> a" |
|
2399 unfolding abs_le_interval_iff using rsup_bounds[of S "-a" a] |
|
2400 by (auto simp add: setge_def setle_def) |
|
2401 |
|
2402 lemma rsup_asclose: assumes S:"S \<noteq> {}" and b: "\<forall>x\<in>S. \<bar>x - l\<bar> \<le> e" shows "\<bar>rsup S - l\<bar> \<le> e" |
|
2403 proof- |
|
2404 have th: "\<And>(x::real) l e. \<bar>x - l\<bar> \<le> e \<longleftrightarrow> l - e \<le> x \<and> x \<le> l + e" by arith |
|
2405 show ?thesis using S b rsup_bounds[of S "l - e" "l+e"] unfolding th |
|
2406 by (auto simp add: setge_def setle_def) |
|
2407 qed |
|
2408 |
|
2409 definition rinf:: "real set \<Rightarrow> real" where |
|
2410 "rinf S = (SOME a. isGlb UNIV S a)" |
|
2411 |
|
2412 lemma rinf_alt: "rinf S = (SOME a. (\<forall>x \<in> S. x \<ge> a) \<and> (\<forall>b. (\<forall>x \<in> S. x \<ge> b) \<longrightarrow> a \<ge> b))" by (auto simp add: isGlb_def rinf_def greatestP_def isLb_def setle_def setge_def) |
|
2413 |
|
2414 lemma reals_complete_Glb: assumes Se: "\<exists>x. x \<in> S" and lb: "\<exists> y. isLb UNIV S y" |
|
2415 shows "\<exists>(t::real). isGlb UNIV S t" |
|
2416 proof- |
|
2417 let ?M = "uminus ` S" |
|
2418 from lb have th: "\<exists>y. isUb UNIV ?M y" apply (auto simp add: isUb_def isLb_def setle_def setge_def) |
|
2419 by (rule_tac x="-y" in exI, auto) |
|
2420 from Se have Me: "\<exists>x. x \<in> ?M" by blast |
|
2421 from reals_complete[OF Me th] obtain t where t: "isLub UNIV ?M t" by blast |
|
2422 have "isGlb UNIV S (- t)" using t |
|
2423 apply (auto simp add: isLub_def isGlb_def leastP_def greatestP_def setle_def setge_def isUb_def isLb_def) |
|
2424 apply (erule_tac x="-y" in allE) |
|
2425 apply auto |
|
2426 done |
|
2427 then show ?thesis by metis |
|
2428 qed |
|
2429 |
|
2430 lemma rinf: assumes Se: "S \<noteq> {}" and b: "\<exists>b. b <=* S" |
|
2431 shows "isGlb UNIV S (rinf S)" |
|
2432 using Se b |
|
2433 unfolding rinf_def |
|
2434 apply clarify |
|
2435 apply (rule someI_ex) |
|
2436 apply (rule reals_complete_Glb) |
|
2437 apply (auto simp add: isLb_def setle_def setge_def) |
|
2438 done |
|
2439 |
|
2440 lemma rinf_ge: assumes Se: "S \<noteq> {}" and Sb: "b <=* S" shows "rinf S \<ge> b" |
|
2441 proof- |
|
2442 from Sb have bu: "isLb UNIV S b" by (simp add: isLb_def setge_def) |
|
2443 from rinf[OF Se] Sb have "isGlb UNIV S (rinf S)" by blast |
|
2444 then show ?thesis using bu by (auto simp add: isGlb_def greatestP_def setle_def setge_def) |
|
2445 qed |
|
2446 |
|
2447 lemma rinf_finite_Min: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2448 shows "rinf S = Min S" |
|
2449 using fS Se |
|
2450 proof- |
|
2451 let ?m = "Min S" |
|
2452 from Min_le[OF fS] have Sm: "\<forall> x\<in> S. x \<ge> ?m" by metis |
|
2453 with rinf[OF Se] have glb: "isGlb UNIV S (rinf S)" by (metis setge_def) |
|
2454 from Min_in[OF fS Se] glb have mrS: "?m \<ge> rinf S" |
|
2455 by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def) |
|
2456 moreover |
|
2457 have "rinf S \<ge> ?m" using Sm glb |
|
2458 by (auto simp add: isGlb_def greatestP_def isLb_def setle_def setge_def) |
|
2459 ultimately show ?thesis by arith |
|
2460 qed |
|
2461 |
|
2462 lemma rinf_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2463 shows "rinf S \<in> S" |
|
2464 using rinf_finite_Min[OF fS Se] Min_in[OF fS Se] by metis |
|
2465 |
|
2466 lemma rinf_finite_Lb: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2467 shows "isLb S S (rinf S)" |
|
2468 using rinf_finite_Min[OF fS Se] rinf_finite_in[OF fS Se] Min_le[OF fS] |
|
2469 unfolding isLb_def setge_def by metis |
|
2470 |
|
2471 lemma rinf_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2472 shows "a \<le> rinf S \<longleftrightarrow> (\<forall> x \<in> S. a \<le> x)" |
|
2473 using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def) |
|
2474 |
|
2475 lemma rinf_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2476 shows "a \<ge> rinf S \<longleftrightarrow> (\<exists> x \<in> S. a \<ge> x)" |
|
2477 using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def) |
|
2478 |
|
2479 lemma rinf_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2480 shows "a < rinf S \<longleftrightarrow> (\<forall> x \<in> S. a < x)" |
|
2481 using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def) |
|
2482 |
|
2483 lemma rinf_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}" |
|
2484 shows "a > rinf S \<longleftrightarrow> (\<exists> x \<in> S. a > x)" |
|
2485 using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def) |
|
2486 |
|
2487 lemma rinf_unique: assumes b: "b <=* S" and S: "\<forall>b' > b. \<exists>x \<in> S. b' > x" |
|
2488 shows "rinf S = b" |
|
2489 using b S |
|
2490 unfolding setge_def rinf_alt |
|
2491 apply - |
|
2492 apply (rule some_equality) |
|
2493 apply (metis linorder_not_le order_eq_iff[symmetric])+ |
|
2494 done |
|
2495 |
|
2496 lemma rinf_ge_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. b <=* T) \<Longrightarrow> rinf S >= rinf T" |
|
2497 apply (rule rinf_ge) |
|
2498 apply simp |
|
2499 using rinf[of T] by (auto simp add: isGlb_def greatestP_def setge_def setle_def isLb_def) |
|
2500 |
|
2501 lemma isLb_def': "isLb R S = (\<lambda>x. x <=* S \<and> x \<in> R)" |
|
2502 apply (rule ext) |
|
2503 by (metis isLb_def) |
|
2504 |
|
2505 lemma rinf_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b" |
|
2506 shows "a \<le> rinf S \<and> rinf S \<le> b" |
|
2507 proof- |
|
2508 from rinf[OF Se] l have lub: "isGlb UNIV S (rinf S)" by blast |
|
2509 hence b: "a \<le> rinf S" using l by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def') |
|
2510 from Se obtain y where y: "y \<in> S" by blast |
|
2511 from lub u have "b \<ge> rinf S" apply (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def') |
|
2512 apply (erule ballE[where x=y]) |
|
2513 apply (erule ballE[where x=y]) |
|
2514 apply arith |
|
2515 using y apply auto |
|
2516 done |
|
2517 with b show ?thesis by blast |
|
2518 qed |
|
2519 |
|
2520 lemma rinf_abs_ge: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rinf S\<bar> \<le> a" |
|
2521 unfolding abs_le_interval_iff using rinf_bounds[of S "-a" a] |
|
2522 by (auto simp add: setge_def setle_def) |
|
2523 |
|
2524 lemma rinf_asclose: assumes S:"S \<noteq> {}" and b: "\<forall>x\<in>S. \<bar>x - l\<bar> \<le> e" shows "\<bar>rinf S - l\<bar> \<le> e" |
|
2525 proof- |
|
2526 have th: "\<And>(x::real) l e. \<bar>x - l\<bar> \<le> e \<longleftrightarrow> l - e \<le> x \<and> x \<le> l + e" by arith |
|
2527 show ?thesis using S b rinf_bounds[of S "l - e" "l+e"] unfolding th |
|
2528 by (auto simp add: setge_def setle_def) |
|
2529 qed |
|
2530 |
|
2531 |
|
2532 |
|
2533 subsection{* Operator norm. *} |
|
2534 |
|
2535 definition "onorm f = rsup {norm (f x)| x. norm x = 1}" |
|
2536 |
|
2537 lemma norm_bound_generalize: |
|
2538 fixes f:: "real ^'n::finite \<Rightarrow> real^'m::finite" |
|
2539 assumes lf: "linear f" |
|
2540 shows "(\<forall>x. norm x = 1 \<longrightarrow> norm (f x) \<le> b) \<longleftrightarrow> (\<forall>x. norm (f x) \<le> b * norm x)" (is "?lhs \<longleftrightarrow> ?rhs") |
|
2541 proof- |
|
2542 {assume H: ?rhs |
|
2543 {fix x :: "real^'n" assume x: "norm x = 1" |
|
2544 from H[rule_format, of x] x have "norm (f x) \<le> b" by simp} |
|
2545 then have ?lhs by blast } |
|
2546 |
|
2547 moreover |
|
2548 {assume H: ?lhs |
|
2549 from H[rule_format, of "basis arbitrary"] |
|
2550 have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis arbitrary)"] |
|
2551 by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero]) |
|
2552 {fix x :: "real ^'n" |
|
2553 {assume "x = 0" |
|
2554 then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)} |
|
2555 moreover |
|
2556 {assume x0: "x \<noteq> 0" |
|
2557 hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero) |
|
2558 let ?c = "1/ norm x" |
|
2559 have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul) |
|
2560 with H have "norm (f(?c*s x)) \<le> b" by blast |
|
2561 hence "?c * norm (f x) \<le> b" |
|
2562 by (simp add: linear_cmul[OF lf] norm_mul) |
|
2563 hence "norm (f x) \<le> b * norm x" |
|
2564 using n0 norm_ge_zero[of x] by (auto simp add: field_simps)} |
|
2565 ultimately have "norm (f x) \<le> b * norm x" by blast} |
|
2566 then have ?rhs by blast} |
|
2567 ultimately show ?thesis by blast |
|
2568 qed |
|
2569 |
|
2570 lemma onorm: |
|
2571 fixes f:: "real ^'n::finite \<Rightarrow> real ^'m::finite" |
|
2572 assumes lf: "linear f" |
|
2573 shows "norm (f x) <= onorm f * norm x" |
|
2574 and "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b" |
|
2575 proof- |
|
2576 { |
|
2577 let ?S = "{norm (f x) |x. norm x = 1}" |
|
2578 have Se: "?S \<noteq> {}" using norm_basis by auto |
|
2579 from linear_bounded[OF lf] have b: "\<exists> b. ?S *<= b" |
|
2580 unfolding norm_bound_generalize[OF lf, symmetric] by (auto simp add: setle_def) |
|
2581 {from rsup[OF Se b, unfolded onorm_def[symmetric]] |
|
2582 show "norm (f x) <= onorm f * norm x" |
|
2583 apply - |
|
2584 apply (rule spec[where x = x]) |
|
2585 unfolding norm_bound_generalize[OF lf, symmetric] |
|
2586 by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)} |
|
2587 { |
|
2588 show "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b" |
|
2589 using rsup[OF Se b, unfolded onorm_def[symmetric]] |
|
2590 unfolding norm_bound_generalize[OF lf, symmetric] |
|
2591 by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)} |
|
2592 } |
|
2593 qed |
|
2594 |
|
2595 lemma onorm_pos_le: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" shows "0 <= onorm f" |
|
2596 using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis arbitrary"], unfolded norm_basis] by simp |
|
2597 |
|
2598 lemma onorm_eq_0: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" |
|
2599 shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)" |
|
2600 using onorm[OF lf] |
|
2601 apply (auto simp add: onorm_pos_le) |
|
2602 apply atomize |
|
2603 apply (erule allE[where x="0::real"]) |
|
2604 using onorm_pos_le[OF lf] |
|
2605 apply arith |
|
2606 done |
|
2607 |
|
2608 lemma onorm_const: "onorm(\<lambda>x::real^'n::finite. (y::real ^ 'm::finite)) = norm y" |
|
2609 proof- |
|
2610 let ?f = "\<lambda>x::real^'n. (y::real ^ 'm)" |
|
2611 have th: "{norm (?f x)| x. norm x = 1} = {norm y}" |
|
2612 by(auto intro: vector_choose_size set_ext) |
|
2613 show ?thesis |
|
2614 unfolding onorm_def th |
|
2615 apply (rule rsup_unique) by (simp_all add: setle_def) |
|
2616 qed |
|
2617 |
|
2618 lemma onorm_pos_lt: assumes lf: "linear (f::real ^ 'n::finite \<Rightarrow> real ^'m::finite)" |
|
2619 shows "0 < onorm f \<longleftrightarrow> ~(\<forall>x. f x = 0)" |
|
2620 unfolding onorm_eq_0[OF lf, symmetric] |
|
2621 using onorm_pos_le[OF lf] by arith |
|
2622 |
|
2623 lemma onorm_compose: |
|
2624 assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" |
|
2625 and lg: "linear (g::real^'k::finite \<Rightarrow> real^'n::finite)" |
|
2626 shows "onorm (f o g) <= onorm f * onorm g" |
|
2627 apply (rule onorm(2)[OF linear_compose[OF lg lf], rule_format]) |
|
2628 unfolding o_def |
|
2629 apply (subst mult_assoc) |
|
2630 apply (rule order_trans) |
|
2631 apply (rule onorm(1)[OF lf]) |
|
2632 apply (rule mult_mono1) |
|
2633 apply (rule onorm(1)[OF lg]) |
|
2634 apply (rule onorm_pos_le[OF lf]) |
|
2635 done |
|
2636 |
|
2637 lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)" |
|
2638 shows "onorm (\<lambda>x. - f x) \<le> onorm f" |
|
2639 using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf] |
|
2640 unfolding norm_minus_cancel by metis |
|
2641 |
|
2642 lemma onorm_neg: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)" |
|
2643 shows "onorm (\<lambda>x. - f x) = onorm f" |
|
2644 using onorm_neg_lemma[OF lf] onorm_neg_lemma[OF linear_compose_neg[OF lf]] |
|
2645 by simp |
|
2646 |
|
2647 lemma onorm_triangle: |
|
2648 assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and lg: "linear g" |
|
2649 shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g" |
|
2650 apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format]) |
|
2651 apply (rule order_trans) |
|
2652 apply (rule norm_triangle_ineq) |
|
2653 apply (simp add: distrib) |
|
2654 apply (rule add_mono) |
|
2655 apply (rule onorm(1)[OF lf]) |
|
2656 apply (rule onorm(1)[OF lg]) |
|
2657 done |
|
2658 |
|
2659 lemma onorm_triangle_le: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) <= e |
|
2660 \<Longrightarrow> onorm(\<lambda>x. f x + g x) <= e" |
|
2661 apply (rule order_trans) |
|
2662 apply (rule onorm_triangle) |
|
2663 apply assumption+ |
|
2664 done |
|
2665 |
|
2666 lemma onorm_triangle_lt: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) < e |
|
2667 ==> onorm(\<lambda>x. f x + g x) < e" |
|
2668 apply (rule order_le_less_trans) |
|
2669 apply (rule onorm_triangle) |
|
2670 by assumption+ |
|
2671 |
|
2672 (* "lift" from 'a to 'a^1 and "drop" from 'a^1 to 'a -- FIXME: potential use of transfer *) |
|
2673 |
|
2674 definition vec1:: "'a \<Rightarrow> 'a ^ 1" where "vec1 x = (\<chi> i. x)" |
|
2675 |
|
2676 definition dest_vec1:: "'a ^1 \<Rightarrow> 'a" |
|
2677 where "dest_vec1 x = (x$1)" |
|
2678 |
|
2679 lemma vec1_component[simp]: "(vec1 x)$1 = x" |
|
2680 by (simp add: vec1_def) |
|
2681 |
|
2682 lemma vec1_dest_vec1[simp]: "vec1(dest_vec1 x) = x" "dest_vec1(vec1 y) = y" |
|
2683 by (simp_all add: vec1_def dest_vec1_def Cart_eq forall_1) |
|
2684 |
|
2685 lemma forall_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P (vec1 x))" by (metis vec1_dest_vec1) |
|
2686 |
|
2687 lemma exists_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(vec1 x))" by (metis vec1_dest_vec1) |
|
2688 |
|
2689 lemma forall_dest_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P(dest_vec1 x))" by (metis vec1_dest_vec1) |
|
2690 |
|
2691 lemma exists_dest_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(dest_vec1 x))"by (metis vec1_dest_vec1) |
|
2692 |
|
2693 lemma vec1_eq[simp]: "vec1 x = vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1) |
|
2694 |
|
2695 lemma dest_vec1_eq[simp]: "dest_vec1 x = dest_vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1) |
|
2696 |
|
2697 lemma vec1_in_image_vec1: "vec1 x \<in> (vec1 ` S) \<longleftrightarrow> x \<in> S" by auto |
|
2698 |
|
2699 lemma vec1_vec: "vec1 x = vec x" by (vector vec1_def) |
|
2700 |
|
2701 lemma vec1_add: "vec1(x + y) = vec1 x + vec1 y" by (vector vec1_def) |
|
2702 lemma vec1_sub: "vec1(x - y) = vec1 x - vec1 y" by (vector vec1_def) |
|
2703 lemma vec1_cmul: "vec1(c* x) = c *s vec1 x " by (vector vec1_def) |
|
2704 lemma vec1_neg: "vec1(- x) = - vec1 x " by (vector vec1_def) |
|
2705 |
|
2706 lemma vec1_setsum: assumes fS: "finite S" |
|
2707 shows "vec1(setsum f S) = setsum (vec1 o f) S" |
|
2708 apply (induct rule: finite_induct[OF fS]) |
|
2709 apply (simp add: vec1_vec) |
|
2710 apply (auto simp add: vec1_add) |
|
2711 done |
|
2712 |
|
2713 lemma dest_vec1_lambda: "dest_vec1(\<chi> i. x i) = x 1" |
|
2714 by (simp add: dest_vec1_def) |
|
2715 |
|
2716 lemma dest_vec1_vec: "dest_vec1(vec x) = x" |
|
2717 by (simp add: vec1_vec[symmetric]) |
|
2718 |
|
2719 lemma dest_vec1_add: "dest_vec1(x + y) = dest_vec1 x + dest_vec1 y" |
|
2720 by (metis vec1_dest_vec1 vec1_add) |
|
2721 |
|
2722 lemma dest_vec1_sub: "dest_vec1(x - y) = dest_vec1 x - dest_vec1 y" |
|
2723 by (metis vec1_dest_vec1 vec1_sub) |
|
2724 |
|
2725 lemma dest_vec1_cmul: "dest_vec1(c*sx) = c * dest_vec1 x" |
|
2726 by (metis vec1_dest_vec1 vec1_cmul) |
|
2727 |
|
2728 lemma dest_vec1_neg: "dest_vec1(- x) = - dest_vec1 x" |
|
2729 by (metis vec1_dest_vec1 vec1_neg) |
|
2730 |
|
2731 lemma dest_vec1_0[simp]: "dest_vec1 0 = 0" by (metis vec_0 dest_vec1_vec) |
|
2732 |
|
2733 lemma dest_vec1_sum: assumes fS: "finite S" |
|
2734 shows "dest_vec1(setsum f S) = setsum (dest_vec1 o f) S" |
|
2735 apply (induct rule: finite_induct[OF fS]) |
|
2736 apply (simp add: dest_vec1_vec) |
|
2737 apply (auto simp add: dest_vec1_add) |
|
2738 done |
|
2739 |
|
2740 lemma norm_vec1: "norm(vec1 x) = abs(x)" |
|
2741 by (simp add: vec1_def norm_real) |
|
2742 |
|
2743 lemma dist_vec1: "dist(vec1 x) (vec1 y) = abs(x - y)" |
|
2744 by (simp only: dist_real vec1_component) |
|
2745 lemma abs_dest_vec1: "norm x = \<bar>dest_vec1 x\<bar>" |
|
2746 by (metis vec1_dest_vec1 norm_vec1) |
|
2747 |
|
2748 lemma linear_vmul_dest_vec1: |
|
2749 fixes f:: "'a::semiring_1^'n \<Rightarrow> 'a^1" |
|
2750 shows "linear f \<Longrightarrow> linear (\<lambda>x. dest_vec1(f x) *s v)" |
|
2751 unfolding dest_vec1_def |
|
2752 apply (rule linear_vmul_component) |
|
2753 by auto |
|
2754 |
|
2755 lemma linear_from_scalars: |
|
2756 assumes lf: "linear (f::'a::comm_ring_1 ^1 \<Rightarrow> 'a^'n)" |
|
2757 shows "f = (\<lambda>x. dest_vec1 x *s column 1 (matrix f))" |
|
2758 apply (rule ext) |
|
2759 apply (subst matrix_works[OF lf, symmetric]) |
|
2760 apply (auto simp add: Cart_eq matrix_vector_mult_def dest_vec1_def column_def mult_commute UNIV_1) |
|
2761 done |
|
2762 |
|
2763 lemma linear_to_scalars: assumes lf: "linear (f::'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a^1)" |
|
2764 shows "f = (\<lambda>x. vec1(row 1 (matrix f) \<bullet> x))" |
|
2765 apply (rule ext) |
|
2766 apply (subst matrix_works[OF lf, symmetric]) |
|
2767 apply (simp add: Cart_eq matrix_vector_mult_def vec1_def row_def dot_def mult_commute forall_1) |
|
2768 done |
|
2769 |
|
2770 lemma dest_vec1_eq_0: "dest_vec1 x = 0 \<longleftrightarrow> x = 0" |
|
2771 by (simp add: dest_vec1_eq[symmetric]) |
|
2772 |
|
2773 lemma setsum_scalars: assumes fS: "finite S" |
|
2774 shows "setsum f S = vec1 (setsum (dest_vec1 o f) S)" |
|
2775 unfolding vec1_setsum[OF fS] by simp |
|
2776 |
|
2777 lemma dest_vec1_wlog_le: "(\<And>(x::'a::linorder ^ 1) y. P x y \<longleftrightarrow> P y x) \<Longrightarrow> (\<And>x y. dest_vec1 x <= dest_vec1 y ==> P x y) \<Longrightarrow> P x y" |
|
2778 apply (cases "dest_vec1 x \<le> dest_vec1 y") |
|
2779 apply simp |
|
2780 apply (subgoal_tac "dest_vec1 y \<le> dest_vec1 x") |
|
2781 apply (auto) |
|
2782 done |
|
2783 |
|
2784 text{* Pasting vectors. *} |
|
2785 |
|
2786 lemma linear_fstcart: "linear fstcart" |
|
2787 by (auto simp add: linear_def Cart_eq) |
|
2788 |
|
2789 lemma linear_sndcart: "linear sndcart" |
|
2790 by (auto simp add: linear_def Cart_eq) |
|
2791 |
|
2792 lemma fstcart_vec[simp]: "fstcart(vec x) = vec x" |
|
2793 by (simp add: Cart_eq) |
|
2794 |
|
2795 lemma fstcart_add[simp]:"fstcart(x + y) = fstcart (x::'a::{plus,times}^('b + 'c)) + fstcart y" |
|
2796 by (simp add: Cart_eq) |
|
2797 |
|
2798 lemma fstcart_cmul[simp]:"fstcart(c*s x) = c*s fstcart (x::'a::{plus,times}^('b + 'c))" |
|
2799 by (simp add: Cart_eq) |
|
2800 |
|
2801 lemma fstcart_neg[simp]:"fstcart(- x) = - fstcart (x::'a::ring_1^('b + 'c))" |
|
2802 by (simp add: Cart_eq) |
|
2803 |
|
2804 lemma fstcart_sub[simp]:"fstcart(x - y) = fstcart (x::'a::ring_1^('b + 'c)) - fstcart y" |
|
2805 by (simp add: Cart_eq) |
|
2806 |
|
2807 lemma fstcart_setsum: |
|
2808 fixes f:: "'d \<Rightarrow> 'a::semiring_1^_" |
|
2809 assumes fS: "finite S" |
|
2810 shows "fstcart (setsum f S) = setsum (\<lambda>i. fstcart (f i)) S" |
|
2811 by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0) |
|
2812 |
|
2813 lemma sndcart_vec[simp]: "sndcart(vec x) = vec x" |
|
2814 by (simp add: Cart_eq) |
|
2815 |
|
2816 lemma sndcart_add[simp]:"sndcart(x + y) = sndcart (x::'a::{plus,times}^('b + 'c)) + sndcart y" |
|
2817 by (simp add: Cart_eq) |
|
2818 |
|
2819 lemma sndcart_cmul[simp]:"sndcart(c*s x) = c*s sndcart (x::'a::{plus,times}^('b + 'c))" |
|
2820 by (simp add: Cart_eq) |
|
2821 |
|
2822 lemma sndcart_neg[simp]:"sndcart(- x) = - sndcart (x::'a::ring_1^('b + 'c))" |
|
2823 by (simp add: Cart_eq) |
|
2824 |
|
2825 lemma sndcart_sub[simp]:"sndcart(x - y) = sndcart (x::'a::ring_1^('b + 'c)) - sndcart y" |
|
2826 by (simp add: Cart_eq) |
|
2827 |
|
2828 lemma sndcart_setsum: |
|
2829 fixes f:: "'d \<Rightarrow> 'a::semiring_1^_" |
|
2830 assumes fS: "finite S" |
|
2831 shows "sndcart (setsum f S) = setsum (\<lambda>i. sndcart (f i)) S" |
|
2832 by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0) |
|
2833 |
|
2834 lemma pastecart_vec[simp]: "pastecart (vec x) (vec x) = vec x" |
|
2835 by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart) |
|
2836 |
|
2837 lemma pastecart_add[simp]:"pastecart (x1::'a::{plus,times}^_) y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)" |
|
2838 by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart) |
|
2839 |
|
2840 lemma pastecart_cmul[simp]: "pastecart (c *s (x1::'a::{plus,times}^_)) (c *s y1) = c *s pastecart x1 y1" |
|
2841 by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart) |
|
2842 |
|
2843 lemma pastecart_neg[simp]: "pastecart (- (x::'a::ring_1^_)) (- y) = - pastecart x y" |
|
2844 unfolding vector_sneg_minus1 pastecart_cmul .. |
|
2845 |
|
2846 lemma pastecart_sub: "pastecart (x1::'a::ring_1^_) y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)" |
|
2847 by (simp add: diff_def pastecart_neg[symmetric] del: pastecart_neg) |
|
2848 |
|
2849 lemma pastecart_setsum: |
|
2850 fixes f:: "'d \<Rightarrow> 'a::semiring_1^_" |
|
2851 assumes fS: "finite S" |
|
2852 shows "pastecart (setsum f S) (setsum g S) = setsum (\<lambda>i. pastecart (f i) (g i)) S" |
|
2853 by (simp add: pastecart_eq fstcart_setsum[OF fS] sndcart_setsum[OF fS] fstcart_pastecart sndcart_pastecart) |
|
2854 |
|
2855 lemma setsum_Plus: |
|
2856 "\<lbrakk>finite A; finite B\<rbrakk> \<Longrightarrow> |
|
2857 (\<Sum>x\<in>A <+> B. g x) = (\<Sum>x\<in>A. g (Inl x)) + (\<Sum>x\<in>B. g (Inr x))" |
|
2858 unfolding Plus_def |
|
2859 by (subst setsum_Un_disjoint, auto simp add: setsum_reindex) |
|
2860 |
|
2861 lemma setsum_UNIV_sum: |
|
2862 fixes g :: "'a::finite + 'b::finite \<Rightarrow> _" |
|
2863 shows "(\<Sum>x\<in>UNIV. g x) = (\<Sum>x\<in>UNIV. g (Inl x)) + (\<Sum>x\<in>UNIV. g (Inr x))" |
|
2864 apply (subst UNIV_Plus_UNIV [symmetric]) |
|
2865 apply (rule setsum_Plus [OF finite finite]) |
|
2866 done |
|
2867 |
|
2868 lemma norm_fstcart: "norm(fstcart x) <= norm (x::real ^('n::finite + 'm::finite))" |
|
2869 proof- |
|
2870 have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))" |
|
2871 by (simp add: pastecart_fst_snd) |
|
2872 have th1: "fstcart x \<bullet> fstcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)" |
|
2873 by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg) |
|
2874 then show ?thesis |
|
2875 unfolding th0 |
|
2876 unfolding real_vector_norm_def real_sqrt_le_iff id_def |
|
2877 by (simp add: dot_def) |
|
2878 qed |
|
2879 |
|
2880 lemma dist_fstcart: "dist(fstcart (x::real^_)) (fstcart y) <= dist x y" |
|
2881 unfolding dist_norm by (metis fstcart_sub[symmetric] norm_fstcart) |
|
2882 |
|
2883 lemma norm_sndcart: "norm(sndcart x) <= norm (x::real ^('n::finite + 'm::finite))" |
|
2884 proof- |
|
2885 have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))" |
|
2886 by (simp add: pastecart_fst_snd) |
|
2887 have th1: "sndcart x \<bullet> sndcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)" |
|
2888 by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg) |
|
2889 then show ?thesis |
|
2890 unfolding th0 |
|
2891 unfolding real_vector_norm_def real_sqrt_le_iff id_def |
|
2892 by (simp add: dot_def) |
|
2893 qed |
|
2894 |
|
2895 lemma dist_sndcart: "dist(sndcart (x::real^_)) (sndcart y) <= dist x y" |
|
2896 unfolding dist_norm by (metis sndcart_sub[symmetric] norm_sndcart) |
|
2897 |
|
2898 lemma dot_pastecart: "(pastecart (x1::'a::{times,comm_monoid_add}^'n::finite) (x2::'a::{times,comm_monoid_add}^'m::finite)) \<bullet> (pastecart y1 y2) = x1 \<bullet> y1 + x2 \<bullet> y2" |
|
2899 by (simp add: dot_def setsum_UNIV_sum pastecart_def) |
|
2900 |
|
2901 text {* TODO: move to NthRoot *} |
|
2902 lemma sqrt_add_le_add_sqrt: |
|
2903 assumes x: "0 \<le> x" and y: "0 \<le> y" |
|
2904 shows "sqrt (x + y) \<le> sqrt x + sqrt y" |
|
2905 apply (rule power2_le_imp_le) |
|
2906 apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y) |
|
2907 apply (simp add: mult_nonneg_nonneg x y) |
|
2908 apply (simp add: add_nonneg_nonneg x y) |
|
2909 done |
|
2910 |
|
2911 lemma norm_pastecart: "norm (pastecart x y) <= norm x + norm y" |
|
2912 unfolding norm_vector_def setL2_def setsum_UNIV_sum |
|
2913 by (simp add: sqrt_add_le_add_sqrt setsum_nonneg) |
|
2914 |
|
2915 subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *} |
|
2916 |
|
2917 definition hull :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75) where |
|
2918 "S hull s = Inter {t. t \<in> S \<and> s \<subseteq> t}" |
|
2919 |
|
2920 lemma hull_same: "s \<in> S \<Longrightarrow> S hull s = s" |
|
2921 unfolding hull_def by auto |
|
2922 |
|
2923 lemma hull_in: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) \<in> S" |
|
2924 unfolding hull_def subset_iff by auto |
|
2925 |
|
2926 lemma hull_eq: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) = s \<longleftrightarrow> s \<in> S" |
|
2927 using hull_same[of s S] hull_in[of S s] by metis |
|
2928 |
|
2929 |
|
2930 lemma hull_hull: "S hull (S hull s) = S hull s" |
|
2931 unfolding hull_def by blast |
|
2932 |
|
2933 lemma hull_subset: "s \<subseteq> (S hull s)" |
|
2934 unfolding hull_def by blast |
|
2935 |
|
2936 lemma hull_mono: " s \<subseteq> t ==> (S hull s) \<subseteq> (S hull t)" |
|
2937 unfolding hull_def by blast |
|
2938 |
|
2939 lemma hull_antimono: "S \<subseteq> T ==> (T hull s) \<subseteq> (S hull s)" |
|
2940 unfolding hull_def by blast |
|
2941 |
|
2942 lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> t \<in> S ==> (S hull s) \<subseteq> t" |
|
2943 unfolding hull_def by blast |
|
2944 |
|
2945 lemma subset_hull: "t \<in> S ==> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t" |
|
2946 unfolding hull_def by blast |
|
2947 |
|
2948 lemma hull_unique: "s \<subseteq> t \<Longrightarrow> t \<in> S \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> t' \<in> S ==> t \<subseteq> t') |
|
2949 ==> (S hull s = t)" |
|
2950 unfolding hull_def by auto |
|
2951 |
|
2952 lemma hull_induct: "(\<And>x. x\<in> S \<Longrightarrow> P x) \<Longrightarrow> Q {x. P x} \<Longrightarrow> \<forall>x\<in> Q hull S. P x" |
|
2953 using hull_minimal[of S "{x. P x}" Q] |
|
2954 by (auto simp add: subset_eq Collect_def mem_def) |
|
2955 |
|
2956 lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S" by (metis hull_subset subset_eq) |
|
2957 |
|
2958 lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))" |
|
2959 unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2) |
|
2960 |
|
2961 lemma hull_union: assumes T: "\<And>T. T \<subseteq> S ==> Inter T \<in> S" |
|
2962 shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)" |
|
2963 apply rule |
|
2964 apply (rule hull_mono) |
|
2965 unfolding Un_subset_iff |
|
2966 apply (metis hull_subset Un_upper1 Un_upper2 subset_trans) |
|
2967 apply (rule hull_minimal) |
|
2968 apply (metis hull_union_subset) |
|
2969 apply (metis hull_in T) |
|
2970 done |
|
2971 |
|
2972 lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> (S hull (insert a s) = S hull s)" |
|
2973 unfolding hull_def by blast |
|
2974 |
|
2975 lemma hull_redundant: "a \<in> (S hull s) ==> (S hull (insert a s) = S hull s)" |
|
2976 by (metis hull_redundant_eq) |
|
2977 |
|
2978 text{* Archimedian properties and useful consequences. *} |
|
2979 |
|
2980 lemma real_arch_simple: "\<exists>n. x <= real (n::nat)" |
|
2981 using reals_Archimedean2[of x] apply auto by (rule_tac x="Suc n" in exI, auto) |
|
2982 lemmas real_arch_lt = reals_Archimedean2 |
|
2983 |
|
2984 lemmas real_arch = reals_Archimedean3 |
|
2985 |
|
2986 lemma real_arch_inv: "0 < e \<longleftrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)" |
|
2987 using reals_Archimedean |
|
2988 apply (auto simp add: field_simps inverse_positive_iff_positive) |
|
2989 apply (subgoal_tac "inverse (real n) > 0") |
|
2990 apply arith |
|
2991 apply simp |
|
2992 done |
|
2993 |
|
2994 lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n" |
|
2995 proof(induct n) |
|
2996 case 0 thus ?case by simp |
|
2997 next |
|
2998 case (Suc n) |
|
2999 hence h: "1 + real n * x \<le> (1 + x) ^ n" by simp |
|
3000 from h have p: "1 \<le> (1 + x) ^ n" using Suc.prems by simp |
|
3001 from h have "1 + real n * x + x \<le> (1 + x) ^ n + x" by simp |
|
3002 also have "\<dots> \<le> (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric]) |
|
3003 apply (simp add: ring_simps) |
|
3004 using mult_left_mono[OF p Suc.prems] by simp |
|
3005 finally show ?case by (simp add: real_of_nat_Suc ring_simps) |
|
3006 qed |
|
3007 |
|
3008 lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\<exists>n. y < x^n" |
|
3009 proof- |
|
3010 from x have x0: "x - 1 > 0" by arith |
|
3011 from real_arch[OF x0, rule_format, of y] |
|
3012 obtain n::nat where n:"y < real n * (x - 1)" by metis |
|
3013 from x0 have x00: "x- 1 \<ge> 0" by arith |
|
3014 from real_pow_lbound[OF x00, of n] n |
|
3015 have "y < x^n" by auto |
|
3016 then show ?thesis by metis |
|
3017 qed |
|
3018 |
|
3019 lemma real_arch_pow2: "\<exists>n. (x::real) < 2^ n" |
|
3020 using real_arch_pow[of 2 x] by simp |
|
3021 |
|
3022 lemma real_arch_pow_inv: assumes y: "(y::real) > 0" and x1: "x < 1" |
|
3023 shows "\<exists>n. x^n < y" |
|
3024 proof- |
|
3025 {assume x0: "x > 0" |
|
3026 from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps) |
|
3027 from real_arch_pow[OF ix, of "1/y"] |
|
3028 obtain n where n: "1/y < (1/x)^n" by blast |
|
3029 then |
|
3030 have ?thesis using y x0 by (auto simp add: field_simps power_divide) } |
|
3031 moreover |
|
3032 {assume "\<not> x > 0" with y x1 have ?thesis apply auto by (rule exI[where x=1], auto)} |
|
3033 ultimately show ?thesis by metis |
|
3034 qed |
|
3035 |
|
3036 lemma forall_pos_mono: "(\<And>d e::real. d < e \<Longrightarrow> P d ==> P e) \<Longrightarrow> (\<And>n::nat. n \<noteq> 0 ==> P(inverse(real n))) \<Longrightarrow> (\<And>e. 0 < e ==> P e)" |
|
3037 by (metis real_arch_inv) |
|
3038 |
|
3039 lemma forall_pos_mono_1: "(\<And>d e::real. d < e \<Longrightarrow> P d ==> P e) \<Longrightarrow> (\<And>n. P(inverse(real (Suc n)))) ==> 0 < e ==> P e" |
|
3040 apply (rule forall_pos_mono) |
|
3041 apply auto |
|
3042 apply (atomize) |
|
3043 apply (erule_tac x="n - 1" in allE) |
|
3044 apply auto |
|
3045 done |
|
3046 |
|
3047 lemma real_archimedian_rdiv_eq_0: assumes x0: "x \<ge> 0" and c: "c \<ge> 0" and xc: "\<forall>(m::nat)>0. real m * x \<le> c" |
|
3048 shows "x = 0" |
|
3049 proof- |
|
3050 {assume "x \<noteq> 0" with x0 have xp: "x > 0" by arith |
|
3051 from real_arch[OF xp, rule_format, of c] obtain n::nat where n: "c < real n * x" by blast |
|
3052 with xc[rule_format, of n] have "n = 0" by arith |
|
3053 with n c have False by simp} |
|
3054 then show ?thesis by blast |
|
3055 qed |
|
3056 |
|
3057 (* ------------------------------------------------------------------------- *) |
|
3058 (* Relate max and min to sup and inf. *) |
|
3059 (* ------------------------------------------------------------------------- *) |
|
3060 |
|
3061 lemma real_max_rsup: "max x y = rsup {x,y}" |
|
3062 proof- |
|
3063 have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all |
|
3064 from rsup_finite_le_iff[OF f, of "max x y"] have "rsup {x,y} \<le> max x y" by simp |
|
3065 moreover |
|
3066 have "max x y \<le> rsup {x,y}" using rsup_finite_ge_iff[OF f, of "max x y"] |
|
3067 by (simp add: linorder_linear) |
|
3068 ultimately show ?thesis by arith |
|
3069 qed |
|
3070 |
|
3071 lemma real_min_rinf: "min x y = rinf {x,y}" |
|
3072 proof- |
|
3073 have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all |
|
3074 from rinf_finite_le_iff[OF f, of "min x y"] have "rinf {x,y} \<le> min x y" |
|
3075 by (simp add: linorder_linear) |
|
3076 moreover |
|
3077 have "min x y \<le> rinf {x,y}" using rinf_finite_ge_iff[OF f, of "min x y"] |
|
3078 by simp |
|
3079 ultimately show ?thesis by arith |
|
3080 qed |
|
3081 |
|
3082 (* ------------------------------------------------------------------------- *) |
|
3083 (* Geometric progression. *) |
|
3084 (* ------------------------------------------------------------------------- *) |
|
3085 |
|
3086 lemma sum_gp_basic: "((1::'a::{field}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))" |
|
3087 (is "?lhs = ?rhs") |
|
3088 proof- |
|
3089 {assume x1: "x = 1" hence ?thesis by simp} |
|
3090 moreover |
|
3091 {assume x1: "x\<noteq>1" |
|
3092 hence x1': "x - 1 \<noteq> 0" "1 - x \<noteq> 0" "x - 1 = - (1 - x)" "- (1 - x) \<noteq> 0" by auto |
|
3093 from geometric_sum[OF x1, of "Suc n", unfolded x1'] |
|
3094 have "(- (1 - x)) * setsum (\<lambda>i. x^i) {0 .. n} = - (1 - x^(Suc n))" |
|
3095 unfolding atLeastLessThanSuc_atLeastAtMost |
|
3096 using x1' apply (auto simp only: field_simps) |
|
3097 apply (simp add: ring_simps) |
|
3098 done |
|
3099 then have ?thesis by (simp add: ring_simps) } |
|
3100 ultimately show ?thesis by metis |
|
3101 qed |
|
3102 |
|
3103 lemma sum_gp_multiplied: assumes mn: "m <= n" |
|
3104 shows "((1::'a::{field}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n" |
|
3105 (is "?lhs = ?rhs") |
|
3106 proof- |
|
3107 let ?S = "{0..(n - m)}" |
|
3108 from mn have mn': "n - m \<ge> 0" by arith |
|
3109 let ?f = "op + m" |
|
3110 have i: "inj_on ?f ?S" unfolding inj_on_def by auto |
|
3111 have f: "?f ` ?S = {m..n}" |
|
3112 using mn apply (auto simp add: image_iff Bex_def) by arith |
|
3113 have th: "op ^ x o op + m = (\<lambda>i. x^m * x^i)" |
|
3114 by (rule ext, simp add: power_add power_mult) |
|
3115 from setsum_reindex[OF i, of "op ^ x", unfolded f th setsum_right_distrib[symmetric]] |
|
3116 have "?lhs = x^m * ((1 - x) * setsum (op ^ x) {0..n - m})" by simp |
|
3117 then show ?thesis unfolding sum_gp_basic using mn |
|
3118 by (simp add: ring_simps power_add[symmetric]) |
|
3119 qed |
|
3120 |
|
3121 lemma sum_gp: "setsum (op ^ (x::'a::{field})) {m .. n} = |
|
3122 (if n < m then 0 else if x = 1 then of_nat ((n + 1) - m) |
|
3123 else (x^ m - x^ (Suc n)) / (1 - x))" |
|
3124 proof- |
|
3125 {assume nm: "n < m" hence ?thesis by simp} |
|
3126 moreover |
|
3127 {assume "\<not> n < m" hence nm: "m \<le> n" by arith |
|
3128 {assume x: "x = 1" hence ?thesis by simp} |
|
3129 moreover |
|
3130 {assume x: "x \<noteq> 1" hence nz: "1 - x \<noteq> 0" by simp |
|
3131 from sum_gp_multiplied[OF nm, of x] nz have ?thesis by (simp add: field_simps)} |
|
3132 ultimately have ?thesis by metis |
|
3133 } |
|
3134 ultimately show ?thesis by metis |
|
3135 qed |
|
3136 |
|
3137 lemma sum_gp_offset: "setsum (op ^ (x::'a::{field})) {m .. m+n} = |
|
3138 (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))" |
|
3139 unfolding sum_gp[of x m "m + n"] power_Suc |
|
3140 by (simp add: ring_simps power_add) |
|
3141 |
|
3142 |
|
3143 subsection{* A bit of linear algebra. *} |
|
3144 |
|
3145 definition "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x\<in> S. \<forall>y \<in>S. x + y \<in> S) \<and> (\<forall>c. \<forall>x \<in>S. c *s x \<in>S )" |
|
3146 definition "span S = (subspace hull S)" |
|
3147 definition "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span(S - {a}))" |
|
3148 abbreviation "independent s == ~(dependent s)" |
|
3149 |
|
3150 (* Closure properties of subspaces. *) |
|
3151 |
|
3152 lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def) |
|
3153 |
|
3154 lemma subspace_0: "subspace S ==> 0 \<in> S" by (metis subspace_def) |
|
3155 |
|
3156 lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S ==> x + y \<in> S" |
|
3157 by (metis subspace_def) |
|
3158 |
|
3159 lemma subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S" |
|
3160 by (metis subspace_def) |
|
3161 |
|
3162 lemma subspace_neg: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> - x \<in> S" |
|
3163 by (metis vector_sneg_minus1 subspace_mul) |
|
3164 |
|
3165 lemma subspace_sub: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S" |
|
3166 by (metis diff_def subspace_add subspace_neg) |
|
3167 |
|
3168 lemma subspace_setsum: |
|
3169 assumes sA: "subspace A" and fB: "finite B" |
|
3170 and f: "\<forall>x\<in> B. f x \<in> A" |
|
3171 shows "setsum f B \<in> A" |
|
3172 using fB f sA |
|
3173 apply(induct rule: finite_induct[OF fB]) |
|
3174 by (simp add: subspace_def sA, auto simp add: sA subspace_add) |
|
3175 |
|
3176 lemma subspace_linear_image: |
|
3177 assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and sS: "subspace S" |
|
3178 shows "subspace(f ` S)" |
|
3179 using lf sS linear_0[OF lf] |
|
3180 unfolding linear_def subspace_def |
|
3181 apply (auto simp add: image_iff) |
|
3182 apply (rule_tac x="x + y" in bexI, auto) |
|
3183 apply (rule_tac x="c*s x" in bexI, auto) |
|
3184 done |
|
3185 |
|
3186 lemma subspace_linear_preimage: "linear (f::'a::semiring_1^'n \<Rightarrow> _) ==> subspace S ==> subspace {x. f x \<in> S}" |
|
3187 by (auto simp add: subspace_def linear_def linear_0[of f]) |
|
3188 |
|
3189 lemma subspace_trivial: "subspace {0::'a::semiring_1 ^_}" |
|
3190 by (simp add: subspace_def) |
|
3191 |
|
3192 lemma subspace_inter: "subspace A \<Longrightarrow> subspace B ==> subspace (A \<inter> B)" |
|
3193 by (simp add: subspace_def) |
|
3194 |
|
3195 |
|
3196 lemma span_mono: "A \<subseteq> B ==> span A \<subseteq> span B" |
|
3197 by (metis span_def hull_mono) |
|
3198 |
|
3199 lemma subspace_span: "subspace(span S)" |
|
3200 unfolding span_def |
|
3201 apply (rule hull_in[unfolded mem_def]) |
|
3202 apply (simp only: subspace_def Inter_iff Int_iff subset_eq) |
|
3203 apply auto |
|
3204 apply (erule_tac x="X" in ballE) |
|
3205 apply (simp add: mem_def) |
|
3206 apply blast |
|
3207 apply (erule_tac x="X" in ballE) |
|
3208 apply (erule_tac x="X" in ballE) |
|
3209 apply (erule_tac x="X" in ballE) |
|
3210 apply (clarsimp simp add: mem_def) |
|
3211 apply simp |
|
3212 apply simp |
|
3213 apply simp |
|
3214 apply (erule_tac x="X" in ballE) |
|
3215 apply (erule_tac x="X" in ballE) |
|
3216 apply (simp add: mem_def) |
|
3217 apply simp |
|
3218 apply simp |
|
3219 done |
|
3220 |
|
3221 lemma span_clauses: |
|
3222 "a \<in> S ==> a \<in> span S" |
|
3223 "0 \<in> span S" |
|
3224 "x\<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S" |
|
3225 "x \<in> span S \<Longrightarrow> c *s x \<in> span S" |
|
3226 by (metis span_def hull_subset subset_eq subspace_span subspace_def)+ |
|
3227 |
|
3228 lemma span_induct: assumes SP: "\<And>x. x \<in> S ==> P x" |
|
3229 and P: "subspace P" and x: "x \<in> span S" shows "P x" |
|
3230 proof- |
|
3231 from SP have SP': "S \<subseteq> P" by (simp add: mem_def subset_eq) |
|
3232 from P have P': "P \<in> subspace" by (simp add: mem_def) |
|
3233 from x hull_minimal[OF SP' P', unfolded span_def[symmetric]] |
|
3234 show "P x" by (metis mem_def subset_eq) |
|
3235 qed |
|
3236 |
|
3237 lemma span_empty: "span {} = {(0::'a::semiring_0 ^ 'n)}" |
|
3238 apply (simp add: span_def) |
|
3239 apply (rule hull_unique) |
|
3240 apply (auto simp add: mem_def subspace_def) |
|
3241 unfolding mem_def[of "0::'a^'n", symmetric] |
|
3242 apply simp |
|
3243 done |
|
3244 |
|
3245 lemma independent_empty: "independent {}" |
|
3246 by (simp add: dependent_def) |
|
3247 |
|
3248 lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A ==> independent B" |
|
3249 apply (clarsimp simp add: dependent_def span_mono) |
|
3250 apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})") |
|
3251 apply force |
|
3252 apply (rule span_mono) |
|
3253 apply auto |
|
3254 done |
|
3255 |
|
3256 lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B" |
|
3257 by (metis order_antisym span_def hull_minimal mem_def) |
|
3258 |
|
3259 lemma span_induct': assumes SP: "\<forall>x \<in> S. P x" |
|
3260 and P: "subspace P" shows "\<forall>x \<in> span S. P x" |
|
3261 using span_induct SP P by blast |
|
3262 |
|
3263 inductive span_induct_alt_help for S:: "'a::semiring_1^'n \<Rightarrow> bool" |
|
3264 where |
|
3265 span_induct_alt_help_0: "span_induct_alt_help S 0" |
|
3266 | span_induct_alt_help_S: "x \<in> S \<Longrightarrow> span_induct_alt_help S z \<Longrightarrow> span_induct_alt_help S (c *s x + z)" |
|
3267 |
|
3268 lemma span_induct_alt': |
|
3269 assumes h0: "h (0::'a::semiring_1^'n)" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c*s x + y)" shows "\<forall>x \<in> span S. h x" |
|
3270 proof- |
|
3271 {fix x:: "'a^'n" assume x: "span_induct_alt_help S x" |
|
3272 have "h x" |
|
3273 apply (rule span_induct_alt_help.induct[OF x]) |
|
3274 apply (rule h0) |
|
3275 apply (rule hS, assumption, assumption) |
|
3276 done} |
|
3277 note th0 = this |
|
3278 {fix x assume x: "x \<in> span S" |
|
3279 |
|
3280 have "span_induct_alt_help S x" |
|
3281 proof(rule span_induct[where x=x and S=S]) |
|
3282 show "x \<in> span S" using x . |
|
3283 next |
|
3284 fix x assume xS : "x \<in> S" |
|
3285 from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1] |
|
3286 show "span_induct_alt_help S x" by simp |
|
3287 next |
|
3288 have "span_induct_alt_help S 0" by (rule span_induct_alt_help_0) |
|
3289 moreover |
|
3290 {fix x y assume h: "span_induct_alt_help S x" "span_induct_alt_help S y" |
|
3291 from h |
|
3292 have "span_induct_alt_help S (x + y)" |
|
3293 apply (induct rule: span_induct_alt_help.induct) |
|
3294 apply simp |
|
3295 unfolding add_assoc |
|
3296 apply (rule span_induct_alt_help_S) |
|
3297 apply assumption |
|
3298 apply simp |
|
3299 done} |
|
3300 moreover |
|
3301 {fix c x assume xt: "span_induct_alt_help S x" |
|
3302 then have "span_induct_alt_help S (c*s x)" |
|
3303 apply (induct rule: span_induct_alt_help.induct) |
|
3304 apply (simp add: span_induct_alt_help_0) |
|
3305 apply (simp add: vector_smult_assoc vector_add_ldistrib) |
|
3306 apply (rule span_induct_alt_help_S) |
|
3307 apply assumption |
|
3308 apply simp |
|
3309 done |
|
3310 } |
|
3311 ultimately show "subspace (span_induct_alt_help S)" |
|
3312 unfolding subspace_def mem_def Ball_def by blast |
|
3313 qed} |
|
3314 with th0 show ?thesis by blast |
|
3315 qed |
|
3316 |
|
3317 lemma span_induct_alt: |
|
3318 assumes h0: "h (0::'a::semiring_1^'n)" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c*s x + y)" and x: "x \<in> span S" |
|
3319 shows "h x" |
|
3320 using span_induct_alt'[of h S] h0 hS x by blast |
|
3321 |
|
3322 (* Individual closure properties. *) |
|
3323 |
|
3324 lemma span_superset: "x \<in> S ==> x \<in> span S" by (metis span_clauses) |
|
3325 |
|
3326 lemma span_0: "0 \<in> span S" by (metis subspace_span subspace_0) |
|
3327 |
|
3328 lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S" |
|
3329 by (metis subspace_add subspace_span) |
|
3330 |
|
3331 lemma span_mul: "x \<in> span S ==> (c *s x) \<in> span S" |
|
3332 by (metis subspace_span subspace_mul) |
|
3333 |
|
3334 lemma span_neg: "x \<in> span S ==> - (x::'a::ring_1^'n) \<in> span S" |
|
3335 by (metis subspace_neg subspace_span) |
|
3336 |
|
3337 lemma span_sub: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> y \<in> span S ==> x - y \<in> span S" |
|
3338 by (metis subspace_span subspace_sub) |
|
3339 |
|
3340 lemma span_setsum: "finite A \<Longrightarrow> \<forall>x \<in> A. f x \<in> span S ==> setsum f A \<in> span S" |
|
3341 apply (rule subspace_setsum) |
|
3342 by (metis subspace_span subspace_setsum)+ |
|
3343 |
|
3344 lemma span_add_eq: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S" |
|
3345 apply (auto simp only: span_add span_sub) |
|
3346 apply (subgoal_tac "(x + y) - x \<in> span S", simp) |
|
3347 by (simp only: span_add span_sub) |
|
3348 |
|
3349 (* Mapping under linear image. *) |
|
3350 |
|
3351 lemma span_linear_image: assumes lf: "linear (f::'a::semiring_1 ^ 'n => _)" |
|
3352 shows "span (f ` S) = f ` (span S)" |
|
3353 proof- |
|
3354 {fix x |
|
3355 assume x: "x \<in> span (f ` S)" |
|
3356 have "x \<in> f ` span S" |
|
3357 apply (rule span_induct[where x=x and S = "f ` S"]) |
|
3358 apply (clarsimp simp add: image_iff) |
|
3359 apply (frule span_superset) |
|
3360 apply blast |
|
3361 apply (simp only: mem_def) |
|
3362 apply (rule subspace_linear_image[OF lf]) |
|
3363 apply (rule subspace_span) |
|
3364 apply (rule x) |
|
3365 done} |
|
3366 moreover |
|
3367 {fix x assume x: "x \<in> span S" |
|
3368 have th0:"(\<lambda>a. f a \<in> span (f ` S)) = {x. f x \<in> span (f ` S)}" apply (rule set_ext) |
|
3369 unfolding mem_def Collect_def .. |
|
3370 have "f x \<in> span (f ` S)" |
|
3371 apply (rule span_induct[where S=S]) |
|
3372 apply (rule span_superset) |
|
3373 apply simp |
|
3374 apply (subst th0) |
|
3375 apply (rule subspace_linear_preimage[OF lf subspace_span, of "f ` S"]) |
|
3376 apply (rule x) |
|
3377 done} |
|
3378 ultimately show ?thesis by blast |
|
3379 qed |
|
3380 |
|
3381 (* The key breakdown property. *) |
|
3382 |
|
3383 lemma span_breakdown: |
|
3384 assumes bS: "(b::'a::ring_1 ^ 'n) \<in> S" and aS: "a \<in> span S" |
|
3385 shows "\<exists>k. a - k*s b \<in> span (S - {b})" (is "?P a") |
|
3386 proof- |
|
3387 {fix x assume xS: "x \<in> S" |
|
3388 {assume ab: "x = b" |
|
3389 then have "?P x" |
|
3390 apply simp |
|
3391 apply (rule exI[where x="1"], simp) |
|
3392 by (rule span_0)} |
|
3393 moreover |
|
3394 {assume ab: "x \<noteq> b" |
|
3395 then have "?P x" using xS |
|
3396 apply - |
|
3397 apply (rule exI[where x=0]) |
|
3398 apply (rule span_superset) |
|
3399 by simp} |
|
3400 ultimately have "?P x" by blast} |
|
3401 moreover have "subspace ?P" |
|
3402 unfolding subspace_def |
|
3403 apply auto |
|
3404 apply (simp add: mem_def) |
|
3405 apply (rule exI[where x=0]) |
|
3406 using span_0[of "S - {b}"] |
|
3407 apply (simp add: mem_def) |
|
3408 apply (clarsimp simp add: mem_def) |
|
3409 apply (rule_tac x="k + ka" in exI) |
|
3410 apply (subgoal_tac "x + y - (k + ka) *s b = (x - k*s b) + (y - ka *s b)") |
|
3411 apply (simp only: ) |
|
3412 apply (rule span_add[unfolded mem_def]) |
|
3413 apply assumption+ |
|
3414 apply (vector ring_simps) |
|
3415 apply (clarsimp simp add: mem_def) |
|
3416 apply (rule_tac x= "c*k" in exI) |
|
3417 apply (subgoal_tac "c *s x - (c * k) *s b = c*s (x - k*s b)") |
|
3418 apply (simp only: ) |
|
3419 apply (rule span_mul[unfolded mem_def]) |
|
3420 apply assumption |
|
3421 by (vector ring_simps) |
|
3422 ultimately show "?P a" using aS span_induct[where S=S and P= "?P"] by metis |
|
3423 qed |
|
3424 |
|
3425 lemma span_breakdown_eq: |
|
3426 "(x::'a::ring_1^'n) \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. (x - k *s a) \<in> span S)" (is "?lhs \<longleftrightarrow> ?rhs") |
|
3427 proof- |
|
3428 {assume x: "x \<in> span (insert a S)" |
|
3429 from x span_breakdown[of "a" "insert a S" "x"] |
|
3430 have ?rhs apply clarsimp |
|
3431 apply (rule_tac x= "k" in exI) |
|
3432 apply (rule set_rev_mp[of _ "span (S - {a})" _]) |
|
3433 apply assumption |
|
3434 apply (rule span_mono) |
|
3435 apply blast |
|
3436 done} |
|
3437 moreover |
|
3438 { fix k assume k: "x - k *s a \<in> span S" |
|
3439 have eq: "x = (x - k *s a) + k *s a" by vector |
|
3440 have "(x - k *s a) + k *s a \<in> span (insert a S)" |
|
3441 apply (rule span_add) |
|
3442 apply (rule set_rev_mp[of _ "span S" _]) |
|
3443 apply (rule k) |
|
3444 apply (rule span_mono) |
|
3445 apply blast |
|
3446 apply (rule span_mul) |
|
3447 apply (rule span_superset) |
|
3448 apply blast |
|
3449 done |
|
3450 then have ?lhs using eq by metis} |
|
3451 ultimately show ?thesis by blast |
|
3452 qed |
|
3453 |
|
3454 (* Hence some "reversal" results.*) |
|
3455 |
|
3456 lemma in_span_insert: |
|
3457 assumes a: "(a::'a::field^'n) \<in> span (insert b S)" and na: "a \<notin> span S" |
|
3458 shows "b \<in> span (insert a S)" |
|
3459 proof- |
|
3460 from span_breakdown[of b "insert b S" a, OF insertI1 a] |
|
3461 obtain k where k: "a - k*s b \<in> span (S - {b})" by auto |
|
3462 {assume k0: "k = 0" |
|
3463 with k have "a \<in> span S" |
|
3464 apply (simp) |
|
3465 apply (rule set_rev_mp) |
|
3466 apply assumption |
|
3467 apply (rule span_mono) |
|
3468 apply blast |
|
3469 done |
|
3470 with na have ?thesis by blast} |
|
3471 moreover |
|
3472 {assume k0: "k \<noteq> 0" |
|
3473 have eq: "b = (1/k) *s a - ((1/k) *s a - b)" by vector |
|
3474 from k0 have eq': "(1/k) *s (a - k*s b) = (1/k) *s a - b" |
|
3475 by (vector field_simps) |
|
3476 from k have "(1/k) *s (a - k*s b) \<in> span (S - {b})" |
|
3477 by (rule span_mul) |
|
3478 hence th: "(1/k) *s a - b \<in> span (S - {b})" |
|
3479 unfolding eq' . |
|
3480 |
|
3481 from k |
|
3482 have ?thesis |
|
3483 apply (subst eq) |
|
3484 apply (rule span_sub) |
|
3485 apply (rule span_mul) |
|
3486 apply (rule span_superset) |
|
3487 apply blast |
|
3488 apply (rule set_rev_mp) |
|
3489 apply (rule th) |
|
3490 apply (rule span_mono) |
|
3491 using na by blast} |
|
3492 ultimately show ?thesis by blast |
|
3493 qed |
|
3494 |
|
3495 lemma in_span_delete: |
|
3496 assumes a: "(a::'a::field^'n) \<in> span S" |
|
3497 and na: "a \<notin> span (S-{b})" |
|
3498 shows "b \<in> span (insert a (S - {b}))" |
|
3499 apply (rule in_span_insert) |
|
3500 apply (rule set_rev_mp) |
|
3501 apply (rule a) |
|
3502 apply (rule span_mono) |
|
3503 apply blast |
|
3504 apply (rule na) |
|
3505 done |
|
3506 |
|
3507 (* Transitivity property. *) |
|
3508 |
|
3509 lemma span_trans: |
|
3510 assumes x: "(x::'a::ring_1^'n) \<in> span S" and y: "y \<in> span (insert x S)" |
|
3511 shows "y \<in> span S" |
|
3512 proof- |
|
3513 from span_breakdown[of x "insert x S" y, OF insertI1 y] |
|
3514 obtain k where k: "y -k*s x \<in> span (S - {x})" by auto |
|
3515 have eq: "y = (y - k *s x) + k *s x" by vector |
|
3516 show ?thesis |
|
3517 apply (subst eq) |
|
3518 apply (rule span_add) |
|
3519 apply (rule set_rev_mp) |
|
3520 apply (rule k) |
|
3521 apply (rule span_mono) |
|
3522 apply blast |
|
3523 apply (rule span_mul) |
|
3524 by (rule x) |
|
3525 qed |
|
3526 |
|
3527 (* ------------------------------------------------------------------------- *) |
|
3528 (* An explicit expansion is sometimes needed. *) |
|
3529 (* ------------------------------------------------------------------------- *) |
|
3530 |
|
3531 lemma span_explicit: |
|
3532 "span P = {y::'a::semiring_1^'n. \<exists>S u. finite S \<and> S \<subseteq> P \<and> setsum (\<lambda>v. u v *s v) S = y}" |
|
3533 (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}") |
|
3534 proof- |
|
3535 {fix x assume x: "x \<in> ?E" |
|
3536 then obtain S u where fS: "finite S" and SP: "S\<subseteq>P" and u: "setsum (\<lambda>v. u v *s v) S = x" |
|
3537 by blast |
|
3538 have "x \<in> span P" |
|
3539 unfolding u[symmetric] |
|
3540 apply (rule span_setsum[OF fS]) |
|
3541 using span_mono[OF SP] |
|
3542 by (auto intro: span_superset span_mul)} |
|
3543 moreover |
|
3544 have "\<forall>x \<in> span P. x \<in> ?E" |
|
3545 unfolding mem_def Collect_def |
|
3546 proof(rule span_induct_alt') |
|
3547 show "?h 0" |
|
3548 apply (rule exI[where x="{}"]) by simp |
|
3549 next |
|
3550 fix c x y |
|
3551 assume x: "x \<in> P" and hy: "?h y" |
|
3552 from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P" |
|
3553 and u: "setsum (\<lambda>v. u v *s v) S = y" by blast |
|
3554 let ?S = "insert x S" |
|
3555 let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c) |
|
3556 else u y" |
|
3557 from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P" by blast+ |
|
3558 {assume xS: "x \<in> S" |
|
3559 have S1: "S = (S - {x}) \<union> {x}" |
|
3560 and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \<inter> {x} = {}" using xS fS by auto |
|
3561 have "setsum (\<lambda>v. ?u v *s v) ?S =(\<Sum>v\<in>S - {x}. u v *s v) + (u x + c) *s x" |
|
3562 using xS |
|
3563 by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]] |
|
3564 setsum_clauses(2)[OF fS] cong del: if_weak_cong) |
|
3565 also have "\<dots> = (\<Sum>v\<in>S. u v *s v) + c *s x" |
|
3566 apply (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]]) |
|
3567 by (vector ring_simps) |
|
3568 also have "\<dots> = c*s x + y" |
|
3569 by (simp add: add_commute u) |
|
3570 finally have "setsum (\<lambda>v. ?u v *s v) ?S = c*s x + y" . |
|
3571 then have "?Q ?S ?u (c*s x + y)" using th0 by blast} |
|
3572 moreover |
|
3573 {assume xS: "x \<notin> S" |
|
3574 have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *s v) = y" |
|
3575 unfolding u[symmetric] |
|
3576 apply (rule setsum_cong2) |
|
3577 using xS by auto |
|
3578 have "?Q ?S ?u (c*s x + y)" using fS xS th0 |
|
3579 by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong)} |
|
3580 ultimately have "?Q ?S ?u (c*s x + y)" |
|
3581 by (cases "x \<in> S", simp, simp) |
|
3582 then show "?h (c*s x + y)" |
|
3583 apply - |
|
3584 apply (rule exI[where x="?S"]) |
|
3585 apply (rule exI[where x="?u"]) by metis |
|
3586 qed |
|
3587 ultimately show ?thesis by blast |
|
3588 qed |
|
3589 |
|
3590 lemma dependent_explicit: |
|
3591 "dependent P \<longleftrightarrow> (\<exists>S u. finite S \<and> S \<subseteq> P \<and> (\<exists>(v::'a::{idom,field}^'n) \<in>S. u v \<noteq> 0 \<and> setsum (\<lambda>v. u v *s v) S = 0))" (is "?lhs = ?rhs") |
|
3592 proof- |
|
3593 {assume dP: "dependent P" |
|
3594 then obtain a S u where aP: "a \<in> P" and fS: "finite S" |
|
3595 and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *s v) S = a" |
|
3596 unfolding dependent_def span_explicit by blast |
|
3597 let ?S = "insert a S" |
|
3598 let ?u = "\<lambda>y. if y = a then - 1 else u y" |
|
3599 let ?v = a |
|
3600 from aP SP have aS: "a \<notin> S" by blast |
|
3601 from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0" by auto |
|
3602 have s0: "setsum (\<lambda>v. ?u v *s v) ?S = 0" |
|
3603 using fS aS |
|
3604 apply (simp add: vector_smult_lneg vector_smult_lid setsum_clauses ring_simps ) |
|
3605 apply (subst (2) ua[symmetric]) |
|
3606 apply (rule setsum_cong2) |
|
3607 by auto |
|
3608 with th0 have ?rhs |
|
3609 apply - |
|
3610 apply (rule exI[where x= "?S"]) |
|
3611 apply (rule exI[where x= "?u"]) |
|
3612 by clarsimp} |
|
3613 moreover |
|
3614 {fix S u v assume fS: "finite S" |
|
3615 and SP: "S \<subseteq> P" and vS: "v \<in> S" and uv: "u v \<noteq> 0" |
|
3616 and u: "setsum (\<lambda>v. u v *s v) S = 0" |
|
3617 let ?a = v |
|
3618 let ?S = "S - {v}" |
|
3619 let ?u = "\<lambda>i. (- u i) / u v" |
|
3620 have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P" using fS SP vS by auto |
|
3621 have "setsum (\<lambda>v. ?u v *s v) ?S = setsum (\<lambda>v. (- (inverse (u ?a))) *s (u v *s v)) S - ?u v *s v" |
|
3622 using fS vS uv |
|
3623 by (simp add: setsum_diff1 vector_smult_lneg divide_inverse |
|
3624 vector_smult_assoc field_simps) |
|
3625 also have "\<dots> = ?a" |
|
3626 unfolding setsum_cmul u |
|
3627 using uv by (simp add: vector_smult_lneg) |
|
3628 finally have "setsum (\<lambda>v. ?u v *s v) ?S = ?a" . |
|
3629 with th0 have ?lhs |
|
3630 unfolding dependent_def span_explicit |
|
3631 apply - |
|
3632 apply (rule bexI[where x= "?a"]) |
|
3633 apply simp_all |
|
3634 apply (rule exI[where x= "?S"]) |
|
3635 by auto} |
|
3636 ultimately show ?thesis by blast |
|
3637 qed |
|
3638 |
|
3639 |
|
3640 lemma span_finite: |
|
3641 assumes fS: "finite S" |
|
3642 shows "span S = {(y::'a::semiring_1^'n). \<exists>u. setsum (\<lambda>v. u v *s v) S = y}" |
|
3643 (is "_ = ?rhs") |
|
3644 proof- |
|
3645 {fix y assume y: "y \<in> span S" |
|
3646 from y obtain S' u where fS': "finite S'" and SS': "S' \<subseteq> S" and |
|
3647 u: "setsum (\<lambda>v. u v *s v) S' = y" unfolding span_explicit by blast |
|
3648 let ?u = "\<lambda>x. if x \<in> S' then u x else 0" |
|
3649 from setsum_restrict_set[OF fS, of "\<lambda>v. u v *s v" S', symmetric] SS' |
|
3650 have "setsum (\<lambda>v. ?u v *s v) S = setsum (\<lambda>v. u v *s v) S'" |
|
3651 unfolding cond_value_iff cond_application_beta |
|
3652 by (simp add: cond_value_iff inf_absorb2 cong del: if_weak_cong) |
|
3653 hence "setsum (\<lambda>v. ?u v *s v) S = y" by (metis u) |
|
3654 hence "y \<in> ?rhs" by auto} |
|
3655 moreover |
|
3656 {fix y u assume u: "setsum (\<lambda>v. u v *s v) S = y" |
|
3657 then have "y \<in> span S" using fS unfolding span_explicit by auto} |
|
3658 ultimately show ?thesis by blast |
|
3659 qed |
|
3660 |
|
3661 |
|
3662 (* Standard bases are a spanning set, and obviously finite. *) |
|
3663 |
|
3664 lemma span_stdbasis:"span {basis i :: 'a::ring_1^'n::finite | i. i \<in> (UNIV :: 'n set)} = UNIV" |
|
3665 apply (rule set_ext) |
|
3666 apply auto |
|
3667 apply (subst basis_expansion[symmetric]) |
|
3668 apply (rule span_setsum) |
|
3669 apply simp |
|
3670 apply auto |
|
3671 apply (rule span_mul) |
|
3672 apply (rule span_superset) |
|
3673 apply (auto simp add: Collect_def mem_def) |
|
3674 done |
|
3675 |
|
3676 lemma has_size_stdbasis: "{basis i ::real ^'n::finite | i. i \<in> (UNIV :: 'n set)} hassize CARD('n)" (is "?S hassize ?n") |
|
3677 proof- |
|
3678 have eq: "?S = basis ` UNIV" by blast |
|
3679 show ?thesis unfolding eq |
|
3680 apply (rule hassize_image_inj[OF basis_inj]) |
|
3681 by (simp add: hassize_def) |
|
3682 qed |
|
3683 |
|
3684 lemma finite_stdbasis: "finite {basis i ::real^'n::finite |i. i\<in> (UNIV:: 'n set)}" |
|
3685 using has_size_stdbasis[unfolded hassize_def] |
|
3686 .. |
|
3687 |
|
3688 lemma card_stdbasis: "card {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)} = CARD('n)" |
|
3689 using has_size_stdbasis[unfolded hassize_def] |
|
3690 .. |
|
3691 |
|
3692 lemma independent_stdbasis_lemma: |
|
3693 assumes x: "(x::'a::semiring_1 ^ 'n) \<in> span (basis ` S)" |
|
3694 and iS: "i \<notin> S" |
|
3695 shows "(x$i) = 0" |
|
3696 proof- |
|
3697 let ?U = "UNIV :: 'n set" |
|
3698 let ?B = "basis ` S" |
|
3699 let ?P = "\<lambda>(x::'a^'n). \<forall>i\<in> ?U. i \<notin> S \<longrightarrow> x$i =0" |
|
3700 {fix x::"'a^'n" assume xS: "x\<in> ?B" |
|
3701 from xS have "?P x" by auto} |
|
3702 moreover |
|
3703 have "subspace ?P" |
|
3704 by (auto simp add: subspace_def Collect_def mem_def) |
|
3705 ultimately show ?thesis |
|
3706 using x span_induct[of ?B ?P x] iS by blast |
|
3707 qed |
|
3708 |
|
3709 lemma independent_stdbasis: "independent {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)}" |
|
3710 proof- |
|
3711 let ?I = "UNIV :: 'n set" |
|
3712 let ?b = "basis :: _ \<Rightarrow> real ^'n" |
|
3713 let ?B = "?b ` ?I" |
|
3714 have eq: "{?b i|i. i \<in> ?I} = ?B" |
|
3715 by auto |
|
3716 {assume d: "dependent ?B" |
|
3717 then obtain k where k: "k \<in> ?I" "?b k \<in> span (?B - {?b k})" |
|
3718 unfolding dependent_def by auto |
|
3719 have eq1: "?B - {?b k} = ?B - ?b ` {k}" by simp |
|
3720 have eq2: "?B - {?b k} = ?b ` (?I - {k})" |
|
3721 unfolding eq1 |
|
3722 apply (rule inj_on_image_set_diff[symmetric]) |
|
3723 apply (rule basis_inj) using k(1) by auto |
|
3724 from k(2) have th0: "?b k \<in> span (?b ` (?I - {k}))" unfolding eq2 . |
|
3725 from independent_stdbasis_lemma[OF th0, of k, simplified] |
|
3726 have False by simp} |
|
3727 then show ?thesis unfolding eq dependent_def .. |
|
3728 qed |
|
3729 |
|
3730 (* This is useful for building a basis step-by-step. *) |
|
3731 |
|
3732 lemma independent_insert: |
|
3733 "independent(insert (a::'a::field ^'n) S) \<longleftrightarrow> |
|
3734 (if a \<in> S then independent S |
|
3735 else independent S \<and> a \<notin> span S)" (is "?lhs \<longleftrightarrow> ?rhs") |
|
3736 proof- |
|
3737 {assume aS: "a \<in> S" |
|
3738 hence ?thesis using insert_absorb[OF aS] by simp} |
|
3739 moreover |
|
3740 {assume aS: "a \<notin> S" |
|
3741 {assume i: ?lhs |
|
3742 then have ?rhs using aS |
|
3743 apply simp |
|
3744 apply (rule conjI) |
|
3745 apply (rule independent_mono) |
|
3746 apply assumption |
|
3747 apply blast |
|
3748 by (simp add: dependent_def)} |
|
3749 moreover |
|
3750 {assume i: ?rhs |
|
3751 have ?lhs using i aS |
|
3752 apply simp |
|
3753 apply (auto simp add: dependent_def) |
|
3754 apply (case_tac "aa = a", auto) |
|
3755 apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})") |
|
3756 apply simp |
|
3757 apply (subgoal_tac "a \<in> span (insert aa (S - {aa}))") |
|
3758 apply (subgoal_tac "insert aa (S - {aa}) = S") |
|
3759 apply simp |
|
3760 apply blast |
|
3761 apply (rule in_span_insert) |
|
3762 apply assumption |
|
3763 apply blast |
|
3764 apply blast |
|
3765 done} |
|
3766 ultimately have ?thesis by blast} |
|
3767 ultimately show ?thesis by blast |
|
3768 qed |
|
3769 |
|
3770 (* The degenerate case of the Exchange Lemma. *) |
|
3771 |
|
3772 lemma mem_delete: "x \<in> (A - {a}) \<longleftrightarrow> x \<noteq> a \<and> x \<in> A" |
|
3773 by blast |
|
3774 |
|
3775 lemma span_span: "span (span A) = span A" |
|
3776 unfolding span_def hull_hull .. |
|
3777 |
|
3778 lemma span_inc: "S \<subseteq> span S" |
|
3779 by (metis subset_eq span_superset) |
|
3780 |
|
3781 lemma spanning_subset_independent: |
|
3782 assumes BA: "B \<subseteq> A" and iA: "independent (A::('a::field ^'n) set)" |
|
3783 and AsB: "A \<subseteq> span B" |
|
3784 shows "A = B" |
|
3785 proof |
|
3786 from BA show "B \<subseteq> A" . |
|
3787 next |
|
3788 from span_mono[OF BA] span_mono[OF AsB] |
|
3789 have sAB: "span A = span B" unfolding span_span by blast |
|
3790 |
|
3791 {fix x assume x: "x \<in> A" |
|
3792 from iA have th0: "x \<notin> span (A - {x})" |
|
3793 unfolding dependent_def using x by blast |
|
3794 from x have xsA: "x \<in> span A" by (blast intro: span_superset) |
|
3795 have "A - {x} \<subseteq> A" by blast |
|
3796 hence th1:"span (A - {x}) \<subseteq> span A" by (metis span_mono) |
|
3797 {assume xB: "x \<notin> B" |
|
3798 from xB BA have "B \<subseteq> A -{x}" by blast |
|
3799 hence "span B \<subseteq> span (A - {x})" by (metis span_mono) |
|
3800 with th1 th0 sAB have "x \<notin> span A" by blast |
|
3801 with x have False by (metis span_superset)} |
|
3802 then have "x \<in> B" by blast} |
|
3803 then show "A \<subseteq> B" by blast |
|
3804 qed |
|
3805 |
|
3806 (* The general case of the Exchange Lemma, the key to what follows. *) |
|
3807 |
|
3808 lemma exchange_lemma: |
|
3809 assumes f:"finite (t:: ('a::field^'n) set)" and i: "independent s" |
|
3810 and sp:"s \<subseteq> span t" |
|
3811 shows "\<exists>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'" |
|
3812 using f i sp |
|
3813 proof(induct c\<equiv>"card(t - s)" arbitrary: s t rule: nat_less_induct) |
|
3814 fix n:: nat and s t :: "('a ^'n) set" |
|
3815 assume H: " \<forall>m<n. \<forall>(x:: ('a ^'n) set) xa. |
|
3816 finite xa \<longrightarrow> |
|
3817 independent x \<longrightarrow> |
|
3818 x \<subseteq> span xa \<longrightarrow> |
|
3819 m = card (xa - x) \<longrightarrow> |
|
3820 (\<exists>t'. (t' hassize card xa) \<and> |
|
3821 x \<subseteq> t' \<and> t' \<subseteq> x \<union> xa \<and> x \<subseteq> span t')" |
|
3822 and ft: "finite t" and s: "independent s" and sp: "s \<subseteq> span t" |
|
3823 and n: "n = card (t - s)" |
|
3824 let ?P = "\<lambda>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'" |
|
3825 let ?ths = "\<exists>t'. ?P t'" |
|
3826 {assume st: "s \<subseteq> t" |
|
3827 from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t]) |
|
3828 by (auto simp add: hassize_def intro: span_superset)} |
|
3829 moreover |
|
3830 {assume st: "t \<subseteq> s" |
|
3831 |
|
3832 from spanning_subset_independent[OF st s sp] |
|
3833 st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t]) |
|
3834 by (auto simp add: hassize_def intro: span_superset)} |
|
3835 moreover |
|
3836 {assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s" |
|
3837 from st(2) obtain b where b: "b \<in> t" "b \<notin> s" by blast |
|
3838 from b have "t - {b} - s \<subset> t - s" by blast |
|
3839 then have cardlt: "card (t - {b} - s) < n" using n ft |
|
3840 by (auto intro: psubset_card_mono) |
|
3841 from b ft have ct0: "card t \<noteq> 0" by auto |
|
3842 {assume stb: "s \<subseteq> span(t -{b})" |
|
3843 from ft have ftb: "finite (t -{b})" by auto |
|
3844 from H[rule_format, OF cardlt ftb s stb] |
|
3845 obtain u where u: "u hassize card (t-{b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u" by blast |
|
3846 let ?w = "insert b u" |
|
3847 have th0: "s \<subseteq> insert b u" using u by blast |
|
3848 from u(3) b have "u \<subseteq> s \<union> t" by blast |
|
3849 then have th1: "insert b u \<subseteq> s \<union> t" using u b by blast |
|
3850 have bu: "b \<notin> u" using b u by blast |
|
3851 from u(1) have fu: "finite u" by (simp add: hassize_def) |
|
3852 from u(1) ft b have "u hassize (card t - 1)" by auto |
|
3853 then |
|
3854 have th2: "insert b u hassize card t" |
|
3855 using card_insert_disjoint[OF fu bu] ct0 by (auto simp add: hassize_def) |
|
3856 from u(4) have "s \<subseteq> span u" . |
|
3857 also have "\<dots> \<subseteq> span (insert b u)" apply (rule span_mono) by blast |
|
3858 finally have th3: "s \<subseteq> span (insert b u)" . from th0 th1 th2 th3 have th: "?P ?w" by blast |
|
3859 from th have ?ths by blast} |
|
3860 moreover |
|
3861 {assume stb: "\<not> s \<subseteq> span(t -{b})" |
|
3862 from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})" by blast |
|
3863 have ab: "a \<noteq> b" using a b by blast |
|
3864 have at: "a \<notin> t" using a ab span_superset[of a "t- {b}"] by auto |
|
3865 have mlt: "card ((insert a (t - {b})) - s) < n" |
|
3866 using cardlt ft n a b by auto |
|
3867 have ft': "finite (insert a (t - {b}))" using ft by auto |
|
3868 {fix x assume xs: "x \<in> s" |
|
3869 have t: "t \<subseteq> (insert b (insert a (t -{b})))" using b by auto |
|
3870 from b(1) have "b \<in> span t" by (simp add: span_superset) |
|
3871 have bs: "b \<in> span (insert a (t - {b}))" |
|
3872 by (metis in_span_delete a sp mem_def subset_eq) |
|
3873 from xs sp have "x \<in> span t" by blast |
|
3874 with span_mono[OF t] |
|
3875 have x: "x \<in> span (insert b (insert a (t - {b})))" .. |
|
3876 from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .} |
|
3877 then have sp': "s \<subseteq> span (insert a (t - {b}))" by blast |
|
3878 |
|
3879 from H[rule_format, OF mlt ft' s sp' refl] obtain u where |
|
3880 u: "u hassize card (insert a (t -{b}))" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t -{b})" |
|
3881 "s \<subseteq> span u" by blast |
|
3882 from u a b ft at ct0 have "?P u" by (auto simp add: hassize_def) |
|
3883 then have ?ths by blast } |
|
3884 ultimately have ?ths by blast |
|
3885 } |
|
3886 ultimately |
|
3887 show ?ths by blast |
|
3888 qed |
|
3889 |
|
3890 (* This implies corresponding size bounds. *) |
|
3891 |
|
3892 lemma independent_span_bound: |
|
3893 assumes f: "finite t" and i: "independent (s::('a::field^'n) set)" and sp:"s \<subseteq> span t" |
|
3894 shows "finite s \<and> card s \<le> card t" |
|
3895 by (metis exchange_lemma[OF f i sp] hassize_def finite_subset card_mono) |
|
3896 |
|
3897 |
|
3898 lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}" |
|
3899 proof- |
|
3900 have eq: "{f x |x. x\<in> UNIV} = f ` UNIV" by auto |
|
3901 show ?thesis unfolding eq |
|
3902 apply (rule finite_imageI) |
|
3903 apply (rule finite) |
|
3904 done |
|
3905 qed |
|
3906 |
|
3907 |
|
3908 lemma independent_bound: |
|
3909 fixes S:: "(real^'n::finite) set" |
|
3910 shows "independent S \<Longrightarrow> finite S \<and> card S <= CARD('n)" |
|
3911 apply (subst card_stdbasis[symmetric]) |
|
3912 apply (rule independent_span_bound) |
|
3913 apply (rule finite_Atleast_Atmost_nat) |
|
3914 apply assumption |
|
3915 unfolding span_stdbasis |
|
3916 apply (rule subset_UNIV) |
|
3917 done |
|
3918 |
|
3919 lemma dependent_biggerset: "(finite (S::(real ^'n::finite) set) ==> card S > CARD('n)) ==> dependent S" |
|
3920 by (metis independent_bound not_less) |
|
3921 |
|
3922 (* Hence we can create a maximal independent subset. *) |
|
3923 |
|
3924 lemma maximal_independent_subset_extend: |
|
3925 assumes sv: "(S::(real^'n::finite) set) \<subseteq> V" and iS: "independent S" |
|
3926 shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B" |
|
3927 using sv iS |
|
3928 proof(induct d\<equiv> "CARD('n) - card S" arbitrary: S rule: nat_less_induct) |
|
3929 fix n and S:: "(real^'n) set" |
|
3930 assume H: "\<forall>m<n. \<forall>S \<subseteq> V. independent S \<longrightarrow> m = CARD('n) - card S \<longrightarrow> |
|
3931 (\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B)" |
|
3932 and sv: "S \<subseteq> V" and i: "independent S" and n: "n = CARD('n) - card S" |
|
3933 let ?P = "\<lambda>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B" |
|
3934 let ?ths = "\<exists>x. ?P x" |
|
3935 let ?d = "CARD('n)" |
|
3936 {assume "V \<subseteq> span S" |
|
3937 then have ?ths using sv i by blast } |
|
3938 moreover |
|
3939 {assume VS: "\<not> V \<subseteq> span S" |
|
3940 from VS obtain a where a: "a \<in> V" "a \<notin> span S" by blast |
|
3941 from a have aS: "a \<notin> S" by (auto simp add: span_superset) |
|
3942 have th0: "insert a S \<subseteq> V" using a sv by blast |
|
3943 from independent_insert[of a S] i a |
|
3944 have th1: "independent (insert a S)" by auto |
|
3945 have mlt: "?d - card (insert a S) < n" |
|
3946 using aS a n independent_bound[OF th1] |
|
3947 by auto |
|
3948 |
|
3949 from H[rule_format, OF mlt th0 th1 refl] |
|
3950 obtain B where B: "insert a S \<subseteq> B" "B \<subseteq> V" "independent B" " V \<subseteq> span B" |
|
3951 by blast |
|
3952 from B have "?P B" by auto |
|
3953 then have ?ths by blast} |
|
3954 ultimately show ?ths by blast |
|
3955 qed |
|
3956 |
|
3957 lemma maximal_independent_subset: |
|
3958 "\<exists>(B:: (real ^'n::finite) set). B\<subseteq> V \<and> independent B \<and> V \<subseteq> span B" |
|
3959 by (metis maximal_independent_subset_extend[of "{}:: (real ^'n) set"] empty_subsetI independent_empty) |
|
3960 |
|
3961 (* Notion of dimension. *) |
|
3962 |
|
3963 definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n))" |
|
3964 |
|
3965 lemma basis_exists: "\<exists>B. (B :: (real ^'n::finite) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize dim V)" |
|
3966 unfolding dim_def some_eq_ex[of "\<lambda>n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n)"] |
|
3967 unfolding hassize_def |
|
3968 using maximal_independent_subset[of V] independent_bound |
|
3969 by auto |
|
3970 |
|
3971 (* Consequences of independence or spanning for cardinality. *) |
|
3972 |
|
3973 lemma independent_card_le_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B \<le> dim V" |
|
3974 by (metis basis_exists[of V] independent_span_bound[where ?'a=real] hassize_def subset_trans) |
|
3975 |
|
3976 lemma span_card_ge_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B" |
|
3977 by (metis basis_exists[of V] independent_span_bound hassize_def subset_trans) |
|
3978 |
|
3979 lemma basis_card_eq_dim: |
|
3980 "B \<subseteq> (V:: (real ^'n::finite) set) \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V" |
|
3981 by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_mono) |
|
3982 |
|
3983 lemma dim_unique: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> B hassize n \<Longrightarrow> dim V = n" |
|
3984 by (metis basis_card_eq_dim hassize_def) |
|
3985 |
|
3986 (* More lemmas about dimension. *) |
|
3987 |
|
3988 lemma dim_univ: "dim (UNIV :: (real^'n::finite) set) = CARD('n)" |
|
3989 apply (rule dim_unique[of "{basis i |i. i\<in> (UNIV :: 'n set)}"]) |
|
3990 by (auto simp only: span_stdbasis has_size_stdbasis independent_stdbasis) |
|
3991 |
|
3992 lemma dim_subset: |
|
3993 "(S:: (real ^'n::finite) set) \<subseteq> T \<Longrightarrow> dim S \<le> dim T" |
|
3994 using basis_exists[of T] basis_exists[of S] |
|
3995 by (metis independent_span_bound[where ?'a = real and ?'n = 'n] subset_eq hassize_def) |
|
3996 |
|
3997 lemma dim_subset_univ: "dim (S:: (real^'n::finite) set) \<le> CARD('n)" |
|
3998 by (metis dim_subset subset_UNIV dim_univ) |
|
3999 |
|
4000 (* Converses to those. *) |
|
4001 |
|
4002 lemma card_ge_dim_independent: |
|
4003 assumes BV:"(B::(real ^'n::finite) set) \<subseteq> V" and iB:"independent B" and dVB:"dim V \<le> card B" |
|
4004 shows "V \<subseteq> span B" |
|
4005 proof- |
|
4006 {fix a assume aV: "a \<in> V" |
|
4007 {assume aB: "a \<notin> span B" |
|
4008 then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert) |
|
4009 from aV BV have th0: "insert a B \<subseteq> V" by blast |
|
4010 from aB have "a \<notin>B" by (auto simp add: span_superset) |
|
4011 with independent_card_le_dim[OF th0 iaB] dVB have False by auto} |
|
4012 then have "a \<in> span B" by blast} |
|
4013 then show ?thesis by blast |
|
4014 qed |
|
4015 |
|
4016 lemma card_le_dim_spanning: |
|
4017 assumes BV: "(B:: (real ^'n::finite) set) \<subseteq> V" and VB: "V \<subseteq> span B" |
|
4018 and fB: "finite B" and dVB: "dim V \<ge> card B" |
|
4019 shows "independent B" |
|
4020 proof- |
|
4021 {fix a assume a: "a \<in> B" "a \<in> span (B -{a})" |
|
4022 from a fB have c0: "card B \<noteq> 0" by auto |
|
4023 from a fB have cb: "card (B -{a}) = card B - 1" by auto |
|
4024 from BV a have th0: "B -{a} \<subseteq> V" by blast |
|
4025 {fix x assume x: "x \<in> V" |
|
4026 from a have eq: "insert a (B -{a}) = B" by blast |
|
4027 from x VB have x': "x \<in> span B" by blast |
|
4028 from span_trans[OF a(2), unfolded eq, OF x'] |
|
4029 have "x \<in> span (B -{a})" . } |
|
4030 then have th1: "V \<subseteq> span (B -{a})" by blast |
|
4031 have th2: "finite (B -{a})" using fB by auto |
|
4032 from span_card_ge_dim[OF th0 th1 th2] |
|
4033 have c: "dim V \<le> card (B -{a})" . |
|
4034 from c c0 dVB cb have False by simp} |
|
4035 then show ?thesis unfolding dependent_def by blast |
|
4036 qed |
|
4037 |
|
4038 lemma card_eq_dim: "(B:: (real ^'n::finite) set) \<subseteq> V \<Longrightarrow> B hassize dim V \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B" |
|
4039 by (metis hassize_def order_eq_iff card_le_dim_spanning |
|
4040 card_ge_dim_independent) |
|
4041 |
|
4042 (* ------------------------------------------------------------------------- *) |
|
4043 (* More general size bound lemmas. *) |
|
4044 (* ------------------------------------------------------------------------- *) |
|
4045 |
|
4046 lemma independent_bound_general: |
|
4047 "independent (S:: (real^'n::finite) set) \<Longrightarrow> finite S \<and> card S \<le> dim S" |
|
4048 by (metis independent_card_le_dim independent_bound subset_refl) |
|
4049 |
|
4050 lemma dependent_biggerset_general: "(finite (S:: (real^'n::finite) set) \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S" |
|
4051 using independent_bound_general[of S] by (metis linorder_not_le) |
|
4052 |
|
4053 lemma dim_span: "dim (span (S:: (real ^'n::finite) set)) = dim S" |
|
4054 proof- |
|
4055 have th0: "dim S \<le> dim (span S)" |
|
4056 by (auto simp add: subset_eq intro: dim_subset span_superset) |
|
4057 from basis_exists[of S] |
|
4058 obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast |
|
4059 from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+ |
|
4060 have bSS: "B \<subseteq> span S" using B(1) by (metis subset_eq span_inc) |
|
4061 have sssB: "span S \<subseteq> span B" using span_mono[OF B(3)] by (simp add: span_span) |
|
4062 from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis |
|
4063 using fB(2) by arith |
|
4064 qed |
|
4065 |
|
4066 lemma subset_le_dim: "(S:: (real ^'n::finite) set) \<subseteq> span T \<Longrightarrow> dim S \<le> dim T" |
|
4067 by (metis dim_span dim_subset) |
|
4068 |
|
4069 lemma span_eq_dim: "span (S:: (real ^'n::finite) set) = span T ==> dim S = dim T" |
|
4070 by (metis dim_span) |
|
4071 |
|
4072 lemma spans_image: |
|
4073 assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and VB: "V \<subseteq> span B" |
|
4074 shows "f ` V \<subseteq> span (f ` B)" |
|
4075 unfolding span_linear_image[OF lf] |
|
4076 by (metis VB image_mono) |
|
4077 |
|
4078 lemma dim_image_le: |
|
4079 fixes f :: "real^'n::finite \<Rightarrow> real^'m::finite" |
|
4080 assumes lf: "linear f" shows "dim (f ` S) \<le> dim (S:: (real ^'n::finite) set)" |
|
4081 proof- |
|
4082 from basis_exists[of S] obtain B where |
|
4083 B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast |
|
4084 from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+ |
|
4085 have "dim (f ` S) \<le> card (f ` B)" |
|
4086 apply (rule span_card_ge_dim) |
|
4087 using lf B fB by (auto simp add: span_linear_image spans_image subset_image_iff) |
|
4088 also have "\<dots> \<le> dim S" using card_image_le[OF fB(1)] fB by simp |
|
4089 finally show ?thesis . |
|
4090 qed |
|
4091 |
|
4092 (* Relation between bases and injectivity/surjectivity of map. *) |
|
4093 |
|
4094 lemma spanning_surjective_image: |
|
4095 assumes us: "UNIV \<subseteq> span (S:: ('a::semiring_1 ^'n) set)" |
|
4096 and lf: "linear f" and sf: "surj f" |
|
4097 shows "UNIV \<subseteq> span (f ` S)" |
|
4098 proof- |
|
4099 have "UNIV \<subseteq> f ` UNIV" using sf by (auto simp add: surj_def) |
|
4100 also have " \<dots> \<subseteq> span (f ` S)" using spans_image[OF lf us] . |
|
4101 finally show ?thesis . |
|
4102 qed |
|
4103 |
|
4104 lemma independent_injective_image: |
|
4105 assumes iS: "independent (S::('a::semiring_1^'n) set)" and lf: "linear f" and fi: "inj f" |
|
4106 shows "independent (f ` S)" |
|
4107 proof- |
|
4108 {fix a assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})" |
|
4109 have eq: "f ` S - {f a} = f ` (S - {a})" using fi |
|
4110 by (auto simp add: inj_on_def) |
|
4111 from a have "f a \<in> f ` span (S -{a})" |
|
4112 unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast |
|
4113 hence "a \<in> span (S -{a})" using fi by (auto simp add: inj_on_def) |
|
4114 with a(1) iS have False by (simp add: dependent_def) } |
|
4115 then show ?thesis unfolding dependent_def by blast |
|
4116 qed |
|
4117 |
|
4118 (* ------------------------------------------------------------------------- *) |
|
4119 (* Picking an orthogonal replacement for a spanning set. *) |
|
4120 (* ------------------------------------------------------------------------- *) |
|
4121 (* FIXME : Move to some general theory ?*) |
|
4122 definition "pairwise R S \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y\<in> S. x\<noteq>y \<longrightarrow> R x y)" |
|
4123 |
|
4124 lemma vector_sub_project_orthogonal: "(b::'a::ordered_field^'n::finite) \<bullet> (x - ((b \<bullet> x) / (b\<bullet>b)) *s b) = 0" |
|
4125 apply (cases "b = 0", simp) |
|
4126 apply (simp add: dot_rsub dot_rmult) |
|
4127 unfolding times_divide_eq_right[symmetric] |
|
4128 by (simp add: field_simps dot_eq_0) |
|
4129 |
|
4130 lemma basis_orthogonal: |
|
4131 fixes B :: "(real ^'n::finite) set" |
|
4132 assumes fB: "finite B" |
|
4133 shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C" |
|
4134 (is " \<exists>C. ?P B C") |
|
4135 proof(induct rule: finite_induct[OF fB]) |
|
4136 case 1 thus ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def) |
|
4137 next |
|
4138 case (2 a B) |
|
4139 note fB = `finite B` and aB = `a \<notin> B` |
|
4140 from `\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C` |
|
4141 obtain C where C: "finite C" "card C \<le> card B" |
|
4142 "span C = span B" "pairwise orthogonal C" by blast |
|
4143 let ?a = "a - setsum (\<lambda>x. (x\<bullet>a / (x\<bullet>x)) *s x) C" |
|
4144 let ?C = "insert ?a C" |
|
4145 from C(1) have fC: "finite ?C" by simp |
|
4146 from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)" by (simp add: card_insert_if) |
|
4147 {fix x k |
|
4148 have th0: "\<And>(a::'b::comm_ring) b c. a - (b - c) = c + (a - b)" by (simp add: ring_simps) |
|
4149 have "x - k *s (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *s x)) \<in> span C \<longleftrightarrow> x - k *s a \<in> span C" |
|
4150 apply (simp only: vector_ssub_ldistrib th0) |
|
4151 apply (rule span_add_eq) |
|
4152 apply (rule span_mul) |
|
4153 apply (rule span_setsum[OF C(1)]) |
|
4154 apply clarify |
|
4155 apply (rule span_mul) |
|
4156 by (rule span_superset)} |
|
4157 then have SC: "span ?C = span (insert a B)" |
|
4158 unfolding expand_set_eq span_breakdown_eq C(3)[symmetric] by auto |
|
4159 thm pairwise_def |
|
4160 {fix x y assume xC: "x \<in> ?C" and yC: "y \<in> ?C" and xy: "x \<noteq> y" |
|
4161 {assume xa: "x = ?a" and ya: "y = ?a" |
|
4162 have "orthogonal x y" using xa ya xy by blast} |
|
4163 moreover |
|
4164 {assume xa: "x = ?a" and ya: "y \<noteq> ?a" "y \<in> C" |
|
4165 from ya have Cy: "C = insert y (C - {y})" by blast |
|
4166 have fth: "finite (C - {y})" using C by simp |
|
4167 have "orthogonal x y" |
|
4168 using xa ya |
|
4169 unfolding orthogonal_def xa dot_lsub dot_rsub diff_eq_0_iff_eq |
|
4170 apply simp |
|
4171 apply (subst Cy) |
|
4172 using C(1) fth |
|
4173 apply (simp only: setsum_clauses) |
|
4174 thm dot_ladd |
|
4175 apply (auto simp add: dot_ladd dot_radd dot_lmult dot_rmult dot_eq_0 dot_sym[of y a] dot_lsum[OF fth]) |
|
4176 apply (rule setsum_0') |
|
4177 apply clarsimp |
|
4178 apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format]) |
|
4179 by auto} |
|
4180 moreover |
|
4181 {assume xa: "x \<noteq> ?a" "x \<in> C" and ya: "y = ?a" |
|
4182 from xa have Cx: "C = insert x (C - {x})" by blast |
|
4183 have fth: "finite (C - {x})" using C by simp |
|
4184 have "orthogonal x y" |
|
4185 using xa ya |
|
4186 unfolding orthogonal_def ya dot_rsub dot_lsub diff_eq_0_iff_eq |
|
4187 apply simp |
|
4188 apply (subst Cx) |
|
4189 using C(1) fth |
|
4190 apply (simp only: setsum_clauses) |
|
4191 apply (subst dot_sym[of x]) |
|
4192 apply (auto simp add: dot_radd dot_rmult dot_eq_0 dot_sym[of x a] dot_rsum[OF fth]) |
|
4193 apply (rule setsum_0') |
|
4194 apply clarsimp |
|
4195 apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format]) |
|
4196 by auto} |
|
4197 moreover |
|
4198 {assume xa: "x \<in> C" and ya: "y \<in> C" |
|
4199 have "orthogonal x y" using xa ya xy C(4) unfolding pairwise_def by blast} |
|
4200 ultimately have "orthogonal x y" using xC yC by blast} |
|
4201 then have CPO: "pairwise orthogonal ?C" unfolding pairwise_def by blast |
|
4202 from fC cC SC CPO have "?P (insert a B) ?C" by blast |
|
4203 then show ?case by blast |
|
4204 qed |
|
4205 |
|
4206 lemma orthogonal_basis_exists: |
|
4207 fixes V :: "(real ^'n::finite) set" |
|
4208 shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (B hassize dim V) \<and> pairwise orthogonal B" |
|
4209 proof- |
|
4210 from basis_exists[of V] obtain B where B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "B hassize dim V" by blast |
|
4211 from B have fB: "finite B" "card B = dim V" by (simp_all add: hassize_def) |
|
4212 from basis_orthogonal[OF fB(1)] obtain C where |
|
4213 C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C" by blast |
|
4214 from C B |
|
4215 have CSV: "C \<subseteq> span V" by (metis span_inc span_mono subset_trans) |
|
4216 from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C" by (simp add: span_span) |
|
4217 from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB |
|
4218 have iC: "independent C" by (simp add: dim_span) |
|
4219 from C fB have "card C \<le> dim V" by simp |
|
4220 moreover have "dim V \<le> card C" using span_card_ge_dim[OF CSV SVC C(1)] |
|
4221 by (simp add: dim_span) |
|
4222 ultimately have CdV: "C hassize dim V" unfolding hassize_def using C(1) by simp |
|
4223 from C B CSV CdV iC show ?thesis by auto |
|
4224 qed |
|
4225 |
|
4226 lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S" |
|
4227 by (metis set_eq_subset span_mono span_span span_inc) (* FIXME: slow *) |
|
4228 |
|
4229 (* ------------------------------------------------------------------------- *) |
|
4230 (* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *) |
|
4231 (* ------------------------------------------------------------------------- *) |
|
4232 |
|
4233 lemma span_not_univ_orthogonal: |
|
4234 assumes sU: "span S \<noteq> UNIV" |
|
4235 shows "\<exists>(a:: real ^'n::finite). a \<noteq>0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)" |
|
4236 proof- |
|
4237 from sU obtain a where a: "a \<notin> span S" by blast |
|
4238 from orthogonal_basis_exists obtain B where |
|
4239 B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "B hassize dim S" "pairwise orthogonal B" |
|
4240 by blast |
|
4241 from B have fB: "finite B" "card B = dim S" by (simp_all add: hassize_def) |
|
4242 from span_mono[OF B(2)] span_mono[OF B(3)] |
|
4243 have sSB: "span S = span B" by (simp add: span_span) |
|
4244 let ?a = "a - setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B" |
|
4245 have "setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B \<in> span S" |
|
4246 unfolding sSB |
|
4247 apply (rule span_setsum[OF fB(1)]) |
|
4248 apply clarsimp |
|
4249 apply (rule span_mul) |
|
4250 by (rule span_superset) |
|
4251 with a have a0:"?a \<noteq> 0" by auto |
|
4252 have "\<forall>x\<in>span B. ?a \<bullet> x = 0" |
|
4253 proof(rule span_induct') |
|
4254 show "subspace (\<lambda>x. ?a \<bullet> x = 0)" |
|
4255 by (auto simp add: subspace_def mem_def dot_radd dot_rmult) |
|
4256 next |
|
4257 {fix x assume x: "x \<in> B" |
|
4258 from x have B': "B = insert x (B - {x})" by blast |
|
4259 have fth: "finite (B - {x})" using fB by simp |
|
4260 have "?a \<bullet> x = 0" |
|
4261 apply (subst B') using fB fth |
|
4262 unfolding setsum_clauses(2)[OF fth] |
|
4263 apply simp |
|
4264 apply (clarsimp simp add: dot_lsub dot_ladd dot_lmult dot_lsum dot_eq_0) |
|
4265 apply (rule setsum_0', rule ballI) |
|
4266 unfolding dot_sym |
|
4267 by (auto simp add: x field_simps dot_eq_0 intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])} |
|
4268 then show "\<forall>x \<in> B. ?a \<bullet> x = 0" by blast |
|
4269 qed |
|
4270 with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"]) |
|
4271 qed |
|
4272 |
|
4273 lemma span_not_univ_subset_hyperplane: |
|
4274 assumes SU: "span S \<noteq> (UNIV ::(real^'n::finite) set)" |
|
4275 shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}" |
|
4276 using span_not_univ_orthogonal[OF SU] by auto |
|
4277 |
|
4278 lemma lowdim_subset_hyperplane: |
|
4279 assumes d: "dim S < CARD('n::finite)" |
|
4280 shows "\<exists>(a::real ^'n::finite). a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}" |
|
4281 proof- |
|
4282 {assume "span S = UNIV" |
|
4283 hence "dim (span S) = dim (UNIV :: (real ^'n) set)" by simp |
|
4284 hence "dim S = CARD('n)" by (simp add: dim_span dim_univ) |
|
4285 with d have False by arith} |
|
4286 hence th: "span S \<noteq> UNIV" by blast |
|
4287 from span_not_univ_subset_hyperplane[OF th] show ?thesis . |
|
4288 qed |
|
4289 |
|
4290 (* We can extend a linear basis-basis injection to the whole set. *) |
|
4291 |
|
4292 lemma linear_indep_image_lemma: |
|
4293 assumes lf: "linear f" and fB: "finite B" |
|
4294 and ifB: "independent (f ` B)" |
|
4295 and fi: "inj_on f B" and xsB: "x \<in> span B" |
|
4296 and fx: "f (x::'a::field^'n) = 0" |
|
4297 shows "x = 0" |
|
4298 using fB ifB fi xsB fx |
|
4299 proof(induct arbitrary: x rule: finite_induct[OF fB]) |
|
4300 case 1 thus ?case by (auto simp add: span_empty) |
|
4301 next |
|
4302 case (2 a b x) |
|
4303 have fb: "finite b" using "2.prems" by simp |
|
4304 have th0: "f ` b \<subseteq> f ` (insert a b)" |
|
4305 apply (rule image_mono) by blast |
|
4306 from independent_mono[ OF "2.prems"(2) th0] |
|
4307 have ifb: "independent (f ` b)" . |
|
4308 have fib: "inj_on f b" |
|
4309 apply (rule subset_inj_on [OF "2.prems"(3)]) |
|
4310 by blast |
|
4311 from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)] |
|
4312 obtain k where k: "x - k*s a \<in> span (b -{a})" by blast |
|
4313 have "f (x - k*s a) \<in> span (f ` b)" |
|
4314 unfolding span_linear_image[OF lf] |
|
4315 apply (rule imageI) |
|
4316 using k span_mono[of "b-{a}" b] by blast |
|
4317 hence "f x - k*s f a \<in> span (f ` b)" |
|
4318 by (simp add: linear_sub[OF lf] linear_cmul[OF lf]) |
|
4319 hence th: "-k *s f a \<in> span (f ` b)" |
|
4320 using "2.prems"(5) by (simp add: vector_smult_lneg) |
|
4321 {assume k0: "k = 0" |
|
4322 from k0 k have "x \<in> span (b -{a})" by simp |
|
4323 then have "x \<in> span b" using span_mono[of "b-{a}" b] |
|
4324 by blast} |
|
4325 moreover |
|
4326 {assume k0: "k \<noteq> 0" |
|
4327 from span_mul[OF th, of "- 1/ k"] k0 |
|
4328 have th1: "f a \<in> span (f ` b)" |
|
4329 by (auto simp add: vector_smult_assoc) |
|
4330 from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric] |
|
4331 have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast |
|
4332 from "2.prems"(2)[unfolded dependent_def bex_simps(10), rule_format, of "f a"] |
|
4333 have "f a \<notin> span (f ` b)" using tha |
|
4334 using "2.hyps"(2) |
|
4335 "2.prems"(3) by auto |
|
4336 with th1 have False by blast |
|
4337 then have "x \<in> span b" by blast} |
|
4338 ultimately have xsb: "x \<in> span b" by blast |
|
4339 from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] |
|
4340 show "x = 0" . |
|
4341 qed |
|
4342 |
|
4343 (* We can extend a linear mapping from basis. *) |
|
4344 |
|
4345 lemma linear_independent_extend_lemma: |
|
4346 assumes fi: "finite B" and ib: "independent B" |
|
4347 shows "\<exists>g. (\<forall>x\<in> span B. \<forall>y\<in> span B. g ((x::'a::field^'n) + y) = g x + g y) |
|
4348 \<and> (\<forall>x\<in> span B. \<forall>c. g (c*s x) = c *s g x) |
|
4349 \<and> (\<forall>x\<in> B. g x = f x)" |
|
4350 using ib fi |
|
4351 proof(induct rule: finite_induct[OF fi]) |
|
4352 case 1 thus ?case by (auto simp add: span_empty) |
|
4353 next |
|
4354 case (2 a b) |
|
4355 from "2.prems" "2.hyps" have ibf: "independent b" "finite b" |
|
4356 by (simp_all add: independent_insert) |
|
4357 from "2.hyps"(3)[OF ibf] obtain g where |
|
4358 g: "\<forall>x\<in>span b. \<forall>y\<in>span b. g (x + y) = g x + g y" |
|
4359 "\<forall>x\<in>span b. \<forall>c. g (c *s x) = c *s g x" "\<forall>x\<in>b. g x = f x" by blast |
|
4360 let ?h = "\<lambda>z. SOME k. (z - k *s a) \<in> span b" |
|
4361 {fix z assume z: "z \<in> span (insert a b)" |
|
4362 have th0: "z - ?h z *s a \<in> span b" |
|
4363 apply (rule someI_ex) |
|
4364 unfolding span_breakdown_eq[symmetric] |
|
4365 using z . |
|
4366 {fix k assume k: "z - k *s a \<in> span b" |
|
4367 have eq: "z - ?h z *s a - (z - k*s a) = (k - ?h z) *s a" |
|
4368 by (simp add: ring_simps vector_sadd_rdistrib[symmetric]) |
|
4369 from span_sub[OF th0 k] |
|
4370 have khz: "(k - ?h z) *s a \<in> span b" by (simp add: eq) |
|
4371 {assume "k \<noteq> ?h z" hence k0: "k - ?h z \<noteq> 0" by simp |
|
4372 from k0 span_mul[OF khz, of "1 /(k - ?h z)"] |
|
4373 have "a \<in> span b" by (simp add: vector_smult_assoc) |
|
4374 with "2.prems"(1) "2.hyps"(2) have False |
|
4375 by (auto simp add: dependent_def)} |
|
4376 then have "k = ?h z" by blast} |
|
4377 with th0 have "z - ?h z *s a \<in> span b \<and> (\<forall>k. z - k *s a \<in> span b \<longrightarrow> k = ?h z)" by blast} |
|
4378 note h = this |
|
4379 let ?g = "\<lambda>z. ?h z *s f a + g (z - ?h z *s a)" |
|
4380 {fix x y assume x: "x \<in> span (insert a b)" and y: "y \<in> span (insert a b)" |
|
4381 have tha: "\<And>(x::'a^'n) y a k l. (x + y) - (k + l) *s a = (x - k *s a) + (y - l *s a)" |
|
4382 by (vector ring_simps) |
|
4383 have addh: "?h (x + y) = ?h x + ?h y" |
|
4384 apply (rule conjunct2[OF h, rule_format, symmetric]) |
|
4385 apply (rule span_add[OF x y]) |
|
4386 unfolding tha |
|
4387 by (metis span_add x y conjunct1[OF h, rule_format]) |
|
4388 have "?g (x + y) = ?g x + ?g y" |
|
4389 unfolding addh tha |
|
4390 g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]] |
|
4391 by (simp add: vector_sadd_rdistrib)} |
|
4392 moreover |
|
4393 {fix x:: "'a^'n" and c:: 'a assume x: "x \<in> span (insert a b)" |
|
4394 have tha: "\<And>(x::'a^'n) c k a. c *s x - (c * k) *s a = c *s (x - k *s a)" |
|
4395 by (vector ring_simps) |
|
4396 have hc: "?h (c *s x) = c * ?h x" |
|
4397 apply (rule conjunct2[OF h, rule_format, symmetric]) |
|
4398 apply (metis span_mul x) |
|
4399 by (metis tha span_mul x conjunct1[OF h]) |
|
4400 have "?g (c *s x) = c*s ?g x" |
|
4401 unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]] |
|
4402 by (vector ring_simps)} |
|
4403 moreover |
|
4404 {fix x assume x: "x \<in> (insert a b)" |
|
4405 {assume xa: "x = a" |
|
4406 have ha1: "1 = ?h a" |
|
4407 apply (rule conjunct2[OF h, rule_format]) |
|
4408 apply (metis span_superset insertI1) |
|
4409 using conjunct1[OF h, OF span_superset, OF insertI1] |
|
4410 by (auto simp add: span_0) |
|
4411 |
|
4412 from xa ha1[symmetric] have "?g x = f x" |
|
4413 apply simp |
|
4414 using g(2)[rule_format, OF span_0, of 0] |
|
4415 by simp} |
|
4416 moreover |
|
4417 {assume xb: "x \<in> b" |
|
4418 have h0: "0 = ?h x" |
|
4419 apply (rule conjunct2[OF h, rule_format]) |
|
4420 apply (metis span_superset insertI1 xb x) |
|
4421 apply simp |
|
4422 apply (metis span_superset xb) |
|
4423 done |
|
4424 have "?g x = f x" |
|
4425 by (simp add: h0[symmetric] g(3)[rule_format, OF xb])} |
|
4426 ultimately have "?g x = f x" using x by blast } |
|
4427 ultimately show ?case apply - apply (rule exI[where x="?g"]) by blast |
|
4428 qed |
|
4429 |
|
4430 lemma linear_independent_extend: |
|
4431 assumes iB: "independent (B:: (real ^'n::finite) set)" |
|
4432 shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)" |
|
4433 proof- |
|
4434 from maximal_independent_subset_extend[of B UNIV] iB |
|
4435 obtain C where C: "B \<subseteq> C" "independent C" "\<And>x. x \<in> span C" by auto |
|
4436 |
|
4437 from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f] |
|
4438 obtain g where g: "(\<forall>x\<in> span C. \<forall>y\<in> span C. g (x + y) = g x + g y) |
|
4439 \<and> (\<forall>x\<in> span C. \<forall>c. g (c*s x) = c *s g x) |
|
4440 \<and> (\<forall>x\<in> C. g x = f x)" by blast |
|
4441 from g show ?thesis unfolding linear_def using C |
|
4442 apply clarsimp by blast |
|
4443 qed |
|
4444 |
|
4445 (* Can construct an isomorphism between spaces of same dimension. *) |
|
4446 |
|
4447 lemma card_le_inj: assumes fA: "finite A" and fB: "finite B" |
|
4448 and c: "card A \<le> card B" shows "(\<exists>f. f ` A \<subseteq> B \<and> inj_on f A)" |
|
4449 using fB c |
|
4450 proof(induct arbitrary: B rule: finite_induct[OF fA]) |
|
4451 case 1 thus ?case by simp |
|
4452 next |
|
4453 case (2 x s t) |
|
4454 thus ?case |
|
4455 proof(induct rule: finite_induct[OF "2.prems"(1)]) |
|
4456 case 1 then show ?case by simp |
|
4457 next |
|
4458 case (2 y t) |
|
4459 from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \<le> card t" by simp |
|
4460 from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where |
|
4461 f: "f ` s \<subseteq> t \<and> inj_on f s" by blast |
|
4462 from f "2.prems"(2) "2.hyps"(2) show ?case |
|
4463 apply - |
|
4464 apply (rule exI[where x = "\<lambda>z. if z = x then y else f z"]) |
|
4465 by (auto simp add: inj_on_def) |
|
4466 qed |
|
4467 qed |
|
4468 |
|
4469 lemma card_subset_eq: assumes fB: "finite B" and AB: "A \<subseteq> B" and |
|
4470 c: "card A = card B" |
|
4471 shows "A = B" |
|
4472 proof- |
|
4473 from fB AB have fA: "finite A" by (auto intro: finite_subset) |
|
4474 from fA fB have fBA: "finite (B - A)" by auto |
|
4475 have e: "A \<inter> (B - A) = {}" by blast |
|
4476 have eq: "A \<union> (B - A) = B" using AB by blast |
|
4477 from card_Un_disjoint[OF fA fBA e, unfolded eq c] |
|
4478 have "card (B - A) = 0" by arith |
|
4479 hence "B - A = {}" unfolding card_eq_0_iff using fA fB by simp |
|
4480 with AB show "A = B" by blast |
|
4481 qed |
|
4482 |
|
4483 lemma subspace_isomorphism: |
|
4484 assumes s: "subspace (S:: (real ^'n::finite) set)" |
|
4485 and t: "subspace (T :: (real ^ 'm::finite) set)" |
|
4486 and d: "dim S = dim T" |
|
4487 shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S" |
|
4488 proof- |
|
4489 from basis_exists[of S] obtain B where |
|
4490 B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast |
|
4491 from basis_exists[of T] obtain C where |
|
4492 C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "C hassize dim T" by blast |
|
4493 from B(4) C(4) card_le_inj[of B C] d obtain f where |
|
4494 f: "f ` B \<subseteq> C" "inj_on f B" unfolding hassize_def by auto |
|
4495 from linear_independent_extend[OF B(2)] obtain g where |
|
4496 g: "linear g" "\<forall>x\<in> B. g x = f x" by blast |
|
4497 from B(4) have fB: "finite B" by (simp add: hassize_def) |
|
4498 from C(4) have fC: "finite C" by (simp add: hassize_def) |
|
4499 from inj_on_iff_eq_card[OF fB, of f] f(2) |
|
4500 have "card (f ` B) = card B" by simp |
|
4501 with B(4) C(4) have ceq: "card (f ` B) = card C" using d |
|
4502 by (simp add: hassize_def) |
|
4503 have "g ` B = f ` B" using g(2) |
|
4504 by (auto simp add: image_iff) |
|
4505 also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] . |
|
4506 finally have gBC: "g ` B = C" . |
|
4507 have gi: "inj_on g B" using f(2) g(2) |
|
4508 by (auto simp add: inj_on_def) |
|
4509 note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi] |
|
4510 {fix x y assume x: "x \<in> S" and y: "y \<in> S" and gxy:"g x = g y" |
|
4511 from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+ |
|
4512 from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)]) |
|
4513 have th1: "x - y \<in> span B" using x' y' by (metis span_sub) |
|
4514 have "x=y" using g0[OF th1 th0] by simp } |
|
4515 then have giS: "inj_on g S" |
|
4516 unfolding inj_on_def by blast |
|
4517 from span_subspace[OF B(1,3) s] |
|
4518 have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)]) |
|
4519 also have "\<dots> = span C" unfolding gBC .. |
|
4520 also have "\<dots> = T" using span_subspace[OF C(1,3) t] . |
|
4521 finally have gS: "g ` S = T" . |
|
4522 from g(1) gS giS show ?thesis by blast |
|
4523 qed |
|
4524 |
|
4525 (* linear functions are equal on a subspace if they are on a spanning set. *) |
|
4526 |
|
4527 lemma subspace_kernel: |
|
4528 assumes lf: "linear (f::'a::semiring_1 ^'n \<Rightarrow> _)" |
|
4529 shows "subspace {x. f x = 0}" |
|
4530 apply (simp add: subspace_def) |
|
4531 by (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf]) |
|
4532 |
|
4533 lemma linear_eq_0_span: |
|
4534 assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0" |
|
4535 shows "\<forall>x \<in> span B. f x = (0::'a::semiring_1 ^'n)" |
|
4536 proof |
|
4537 fix x assume x: "x \<in> span B" |
|
4538 let ?P = "\<lambda>x. f x = 0" |
|
4539 from subspace_kernel[OF lf] have "subspace ?P" unfolding Collect_def . |
|
4540 with x f0 span_induct[of B "?P" x] show "f x = 0" by blast |
|
4541 qed |
|
4542 |
|
4543 lemma linear_eq_0: |
|
4544 assumes lf: "linear f" and SB: "S \<subseteq> span B" and f0: "\<forall>x\<in>B. f x = 0" |
|
4545 shows "\<forall>x \<in> S. f x = (0::'a::semiring_1^'n)" |
|
4546 by (metis linear_eq_0_span[OF lf] subset_eq SB f0) |
|
4547 |
|
4548 lemma linear_eq: |
|
4549 assumes lf: "linear (f::'a::ring_1^'n \<Rightarrow> _)" and lg: "linear g" and S: "S \<subseteq> span B" |
|
4550 and fg: "\<forall> x\<in> B. f x = g x" |
|
4551 shows "\<forall>x\<in> S. f x = g x" |
|
4552 proof- |
|
4553 let ?h = "\<lambda>x. f x - g x" |
|
4554 from fg have fg': "\<forall>x\<in> B. ?h x = 0" by simp |
|
4555 from linear_eq_0[OF linear_compose_sub[OF lf lg] S fg'] |
|
4556 show ?thesis by simp |
|
4557 qed |
|
4558 |
|
4559 lemma linear_eq_stdbasis: |
|
4560 assumes lf: "linear (f::'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite)" and lg: "linear g" |
|
4561 and fg: "\<forall>i. f (basis i) = g(basis i)" |
|
4562 shows "f = g" |
|
4563 proof- |
|
4564 let ?U = "UNIV :: 'm set" |
|
4565 let ?I = "{basis i:: 'a^'m|i. i \<in> ?U}" |
|
4566 {fix x assume x: "x \<in> (UNIV :: ('a^'m) set)" |
|
4567 from equalityD2[OF span_stdbasis] |
|
4568 have IU: " (UNIV :: ('a^'m) set) \<subseteq> span ?I" by blast |
|
4569 from linear_eq[OF lf lg IU] fg x |
|
4570 have "f x = g x" unfolding Collect_def Ball_def mem_def by metis} |
|
4571 then show ?thesis by (auto intro: ext) |
|
4572 qed |
|
4573 |
|
4574 (* Similar results for bilinear functions. *) |
|
4575 |
|
4576 lemma bilinear_eq: |
|
4577 assumes bf: "bilinear (f:: 'a::ring^'m \<Rightarrow> 'a^'n \<Rightarrow> 'a^'p)" |
|
4578 and bg: "bilinear g" |
|
4579 and SB: "S \<subseteq> span B" and TC: "T \<subseteq> span C" |
|
4580 and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y" |
|
4581 shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y " |
|
4582 proof- |
|
4583 let ?P = "\<lambda>x. \<forall>y\<in> span C. f x y = g x y" |
|
4584 from bf bg have sp: "subspace ?P" |
|
4585 unfolding bilinear_def linear_def subspace_def bf bg |
|
4586 by(auto simp add: span_0 mem_def bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf]) |
|
4587 |
|
4588 have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y" |
|
4589 apply - |
|
4590 apply (rule ballI) |
|
4591 apply (rule span_induct[of B ?P]) |
|
4592 defer |
|
4593 apply (rule sp) |
|
4594 apply assumption |
|
4595 apply (clarsimp simp add: Ball_def) |
|
4596 apply (rule_tac P="\<lambda>y. f xa y = g xa y" and S=C in span_induct) |
|
4597 using fg |
|
4598 apply (auto simp add: subspace_def) |
|
4599 using bf bg unfolding bilinear_def linear_def |
|
4600 by(auto simp add: span_0 mem_def bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf]) |
|
4601 then show ?thesis using SB TC by (auto intro: ext) |
|
4602 qed |
|
4603 |
|
4604 lemma bilinear_eq_stdbasis: |
|
4605 assumes bf: "bilinear (f:: 'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite \<Rightarrow> 'a^'p)" |
|
4606 and bg: "bilinear g" |
|
4607 and fg: "\<forall>i j. f (basis i) (basis j) = g (basis i) (basis j)" |
|
4608 shows "f = g" |
|
4609 proof- |
|
4610 from fg have th: "\<forall>x \<in> {basis i| i. i\<in> (UNIV :: 'm set)}. \<forall>y\<in> {basis j |j. j \<in> (UNIV :: 'n set)}. f x y = g x y" by blast |
|
4611 from bilinear_eq[OF bf bg equalityD2[OF span_stdbasis] equalityD2[OF span_stdbasis] th] show ?thesis by (blast intro: ext) |
|
4612 qed |
|
4613 |
|
4614 (* Detailed theorems about left and right invertibility in general case. *) |
|
4615 |
|
4616 lemma left_invertible_transp: |
|
4617 "(\<exists>(B::'a^'n^'m). B ** transp (A::'a^'n^'m) = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B::'a^'m^'n). A ** B = mat 1)" |
|
4618 by (metis matrix_transp_mul transp_mat transp_transp) |
|
4619 |
|
4620 lemma right_invertible_transp: |
|
4621 "(\<exists>(B::'a^'n^'m). transp (A::'a^'n^'m) ** B = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B::'a^'m^'n). B ** A = mat 1)" |
|
4622 by (metis matrix_transp_mul transp_mat transp_transp) |
|
4623 |
|
4624 lemma linear_injective_left_inverse: |
|
4625 assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and fi: "inj f" |
|
4626 shows "\<exists>g. linear g \<and> g o f = id" |
|
4627 proof- |
|
4628 from linear_independent_extend[OF independent_injective_image, OF independent_stdbasis, OF lf fi] |
|
4629 obtain h:: "real ^'m \<Rightarrow> real ^'n" where h: "linear h" " \<forall>x \<in> f ` {basis i|i. i \<in> (UNIV::'n set)}. h x = inv f x" by blast |
|
4630 from h(2) |
|
4631 have th: "\<forall>i. (h \<circ> f) (basis i) = id (basis i)" |
|
4632 using inv_o_cancel[OF fi, unfolded stupid_ext[symmetric] id_def o_def] |
|
4633 by auto |
|
4634 |
|
4635 from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th] |
|
4636 have "h o f = id" . |
|
4637 then show ?thesis using h(1) by blast |
|
4638 qed |
|
4639 |
|
4640 lemma linear_surjective_right_inverse: |
|
4641 assumes lf: "linear (f:: real ^'m::finite \<Rightarrow> real ^'n::finite)" and sf: "surj f" |
|
4642 shows "\<exists>g. linear g \<and> f o g = id" |
|
4643 proof- |
|
4644 from linear_independent_extend[OF independent_stdbasis] |
|
4645 obtain h:: "real ^'n \<Rightarrow> real ^'m" where |
|
4646 h: "linear h" "\<forall> x\<in> {basis i| i. i\<in> (UNIV :: 'n set)}. h x = inv f x" by blast |
|
4647 from h(2) |
|
4648 have th: "\<forall>i. (f o h) (basis i) = id (basis i)" |
|
4649 using sf |
|
4650 apply (auto simp add: surj_iff o_def stupid_ext[symmetric]) |
|
4651 apply (erule_tac x="basis i" in allE) |
|
4652 by auto |
|
4653 |
|
4654 from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th] |
|
4655 have "f o h = id" . |
|
4656 then show ?thesis using h(1) by blast |
|
4657 qed |
|
4658 |
|
4659 lemma matrix_left_invertible_injective: |
|
4660 "(\<exists>B. (B::real^'m^'n) ** (A::real^'n::finite^'m::finite) = mat 1) \<longleftrightarrow> (\<forall>x y. A *v x = A *v y \<longrightarrow> x = y)" |
|
4661 proof- |
|
4662 {fix B:: "real^'m^'n" and x y assume B: "B ** A = mat 1" and xy: "A *v x = A*v y" |
|
4663 from xy have "B*v (A *v x) = B *v (A*v y)" by simp |
|
4664 hence "x = y" |
|
4665 unfolding matrix_vector_mul_assoc B matrix_vector_mul_lid .} |
|
4666 moreover |
|
4667 {assume A: "\<forall>x y. A *v x = A *v y \<longrightarrow> x = y" |
|
4668 hence i: "inj (op *v A)" unfolding inj_on_def by auto |
|
4669 from linear_injective_left_inverse[OF matrix_vector_mul_linear i] |
|
4670 obtain g where g: "linear g" "g o op *v A = id" by blast |
|
4671 have "matrix g ** A = mat 1" |
|
4672 unfolding matrix_eq matrix_vector_mul_lid matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)] |
|
4673 using g(2) by (simp add: o_def id_def stupid_ext) |
|
4674 then have "\<exists>B. (B::real ^'m^'n) ** A = mat 1" by blast} |
|
4675 ultimately show ?thesis by blast |
|
4676 qed |
|
4677 |
|
4678 lemma matrix_left_invertible_ker: |
|
4679 "(\<exists>B. (B::real ^'m::finite^'n::finite) ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)" |
|
4680 unfolding matrix_left_invertible_injective |
|
4681 using linear_injective_0[OF matrix_vector_mul_linear, of A] |
|
4682 by (simp add: inj_on_def) |
|
4683 |
|
4684 lemma matrix_right_invertible_surjective: |
|
4685 "(\<exists>B. (A::real^'n::finite^'m::finite) ** (B::real^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)" |
|
4686 proof- |
|
4687 {fix B :: "real ^'m^'n" assume AB: "A ** B = mat 1" |
|
4688 {fix x :: "real ^ 'm" |
|
4689 have "A *v (B *v x) = x" |
|
4690 by (simp add: matrix_vector_mul_lid matrix_vector_mul_assoc AB)} |
|
4691 hence "surj (op *v A)" unfolding surj_def by metis } |
|
4692 moreover |
|
4693 {assume sf: "surj (op *v A)" |
|
4694 from linear_surjective_right_inverse[OF matrix_vector_mul_linear sf] |
|
4695 obtain g:: "real ^'m \<Rightarrow> real ^'n" where g: "linear g" "op *v A o g = id" |
|
4696 by blast |
|
4697 |
|
4698 have "A ** (matrix g) = mat 1" |
|
4699 unfolding matrix_eq matrix_vector_mul_lid |
|
4700 matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)] |
|
4701 using g(2) unfolding o_def stupid_ext[symmetric] id_def |
|
4702 . |
|
4703 hence "\<exists>B. A ** (B::real^'m^'n) = mat 1" by blast |
|
4704 } |
|
4705 ultimately show ?thesis unfolding surj_def by blast |
|
4706 qed |
|
4707 |
|
4708 lemma matrix_left_invertible_independent_columns: |
|
4709 fixes A :: "real^'n::finite^'m::finite" |
|
4710 shows "(\<exists>(B::real ^'m^'n). B ** A = mat 1) \<longleftrightarrow> (\<forall>c. setsum (\<lambda>i. c i *s column i A) (UNIV :: 'n set) = 0 \<longrightarrow> (\<forall>i. c i = 0))" |
|
4711 (is "?lhs \<longleftrightarrow> ?rhs") |
|
4712 proof- |
|
4713 let ?U = "UNIV :: 'n set" |
|
4714 {assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0" |
|
4715 {fix c i assume c: "setsum (\<lambda>i. c i *s column i A) ?U = 0" |
|
4716 and i: "i \<in> ?U" |
|
4717 let ?x = "\<chi> i. c i" |
|
4718 have th0:"A *v ?x = 0" |
|
4719 using c |
|
4720 unfolding matrix_mult_vsum Cart_eq |
|
4721 by auto |
|
4722 from k[rule_format, OF th0] i |
|
4723 have "c i = 0" by (vector Cart_eq)} |
|
4724 hence ?rhs by blast} |
|
4725 moreover |
|
4726 {assume H: ?rhs |
|
4727 {fix x assume x: "A *v x = 0" |
|
4728 let ?c = "\<lambda>i. ((x$i ):: real)" |
|
4729 from H[rule_format, of ?c, unfolded matrix_mult_vsum[symmetric], OF x] |
|
4730 have "x = 0" by vector}} |
|
4731 ultimately show ?thesis unfolding matrix_left_invertible_ker by blast |
|
4732 qed |
|
4733 |
|
4734 lemma matrix_right_invertible_independent_rows: |
|
4735 fixes A :: "real^'n::finite^'m::finite" |
|
4736 shows "(\<exists>(B::real^'m^'n). A ** B = mat 1) \<longleftrightarrow> (\<forall>c. setsum (\<lambda>i. c i *s row i A) (UNIV :: 'm set) = 0 \<longrightarrow> (\<forall>i. c i = 0))" |
|
4737 unfolding left_invertible_transp[symmetric] |
|
4738 matrix_left_invertible_independent_columns |
|
4739 by (simp add: column_transp) |
|
4740 |
|
4741 lemma matrix_right_invertible_span_columns: |
|
4742 "(\<exists>(B::real ^'n::finite^'m::finite). (A::real ^'m^'n) ** B = mat 1) \<longleftrightarrow> span (columns A) = UNIV" (is "?lhs = ?rhs") |
|
4743 proof- |
|
4744 let ?U = "UNIV :: 'm set" |
|
4745 have fU: "finite ?U" by simp |
|
4746 have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y)" |
|
4747 unfolding matrix_right_invertible_surjective matrix_mult_vsum surj_def |
|
4748 apply (subst eq_commute) .. |
|
4749 have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> span (columns A))" by blast |
|
4750 {assume h: ?lhs |
|
4751 {fix x:: "real ^'n" |
|
4752 from h[unfolded lhseq, rule_format, of x] obtain y:: "real ^'m" |
|
4753 where y: "setsum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast |
|
4754 have "x \<in> span (columns A)" |
|
4755 unfolding y[symmetric] |
|
4756 apply (rule span_setsum[OF fU]) |
|
4757 apply clarify |
|
4758 apply (rule span_mul) |
|
4759 apply (rule span_superset) |
|
4760 unfolding columns_def |
|
4761 by blast} |
|
4762 then have ?rhs unfolding rhseq by blast} |
|
4763 moreover |
|
4764 {assume h:?rhs |
|
4765 let ?P = "\<lambda>(y::real ^'n). \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y" |
|
4766 {fix y have "?P y" |
|
4767 proof(rule span_induct_alt[of ?P "columns A"]) |
|
4768 show "\<exists>x\<Colon>real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0" |
|
4769 apply (rule exI[where x=0]) |
|
4770 by (simp add: zero_index vector_smult_lzero) |
|
4771 next |
|
4772 fix c y1 y2 assume y1: "y1 \<in> columns A" and y2: "?P y2" |
|
4773 from y1 obtain i where i: "i \<in> ?U" "y1 = column i A" |
|
4774 unfolding columns_def by blast |
|
4775 from y2 obtain x:: "real ^'m" where |
|
4776 x: "setsum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast |
|
4777 let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::real^'m" |
|
4778 show "?P (c*s y1 + y2)" |
|
4779 proof(rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] cond_value_iff right_distrib cond_application_beta cong del: if_weak_cong) |
|
4780 fix j |
|
4781 have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j) |
|
4782 else (x$xa) * ((column xa A$j))) = (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))" using i(1) |
|
4783 by (simp add: ring_simps) |
|
4784 have "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j) |
|
4785 else (x$xa) * ((column xa A$j))) ?U = setsum (\<lambda>xa. (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))) ?U" |
|
4786 apply (rule setsum_cong[OF refl]) |
|
4787 using th by blast |
|
4788 also have "\<dots> = setsum (\<lambda>xa. if xa = i then c * ((column i A)$j) else 0) ?U + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" |
|
4789 by (simp add: setsum_addf) |
|
4790 also have "\<dots> = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" |
|
4791 unfolding setsum_delta[OF fU] |
|
4792 using i(1) by simp |
|
4793 finally show "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j) |
|
4794 else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" . |
|
4795 qed |
|
4796 next |
|
4797 show "y \<in> span (columns A)" unfolding h by blast |
|
4798 qed} |
|
4799 then have ?lhs unfolding lhseq ..} |
|
4800 ultimately show ?thesis by blast |
|
4801 qed |
|
4802 |
|
4803 lemma matrix_left_invertible_span_rows: |
|
4804 "(\<exists>(B::real^'m::finite^'n::finite). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV" |
|
4805 unfolding right_invertible_transp[symmetric] |
|
4806 unfolding columns_transp[symmetric] |
|
4807 unfolding matrix_right_invertible_span_columns |
|
4808 .. |
|
4809 |
|
4810 (* An injective map real^'n->real^'n is also surjective. *) |
|
4811 |
|
4812 lemma linear_injective_imp_surjective: |
|
4813 assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f" |
|
4814 shows "surj f" |
|
4815 proof- |
|
4816 let ?U = "UNIV :: (real ^'n) set" |
|
4817 from basis_exists[of ?U] obtain B |
|
4818 where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U" |
|
4819 by blast |
|
4820 from B(4) have d: "dim ?U = card B" by (simp add: hassize_def) |
|
4821 have th: "?U \<subseteq> span (f ` B)" |
|
4822 apply (rule card_ge_dim_independent) |
|
4823 apply blast |
|
4824 apply (rule independent_injective_image[OF B(2) lf fi]) |
|
4825 apply (rule order_eq_refl) |
|
4826 apply (rule sym) |
|
4827 unfolding d |
|
4828 apply (rule card_image) |
|
4829 apply (rule subset_inj_on[OF fi]) |
|
4830 by blast |
|
4831 from th show ?thesis |
|
4832 unfolding span_linear_image[OF lf] surj_def |
|
4833 using B(3) by blast |
|
4834 qed |
|
4835 |
|
4836 (* And vice versa. *) |
|
4837 |
|
4838 lemma surjective_iff_injective_gen: |
|
4839 assumes fS: "finite S" and fT: "finite T" and c: "card S = card T" |
|
4840 and ST: "f ` S \<subseteq> T" |
|
4841 shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S" (is "?lhs \<longleftrightarrow> ?rhs") |
|
4842 proof- |
|
4843 {assume h: "?lhs" |
|
4844 {fix x y assume x: "x \<in> S" and y: "y \<in> S" and f: "f x = f y" |
|
4845 from x fS have S0: "card S \<noteq> 0" by auto |
|
4846 {assume xy: "x \<noteq> y" |
|
4847 have th: "card S \<le> card (f ` (S - {y}))" |
|
4848 unfolding c |
|
4849 apply (rule card_mono) |
|
4850 apply (rule finite_imageI) |
|
4851 using fS apply simp |
|
4852 using h xy x y f unfolding subset_eq image_iff |
|
4853 apply auto |
|
4854 apply (case_tac "xa = f x") |
|
4855 apply (rule bexI[where x=x]) |
|
4856 apply auto |
|
4857 done |
|
4858 also have " \<dots> \<le> card (S -{y})" |
|
4859 apply (rule card_image_le) |
|
4860 using fS by simp |
|
4861 also have "\<dots> \<le> card S - 1" using y fS by simp |
|
4862 finally have False using S0 by arith } |
|
4863 then have "x = y" by blast} |
|
4864 then have ?rhs unfolding inj_on_def by blast} |
|
4865 moreover |
|
4866 {assume h: ?rhs |
|
4867 have "f ` S = T" |
|
4868 apply (rule card_subset_eq[OF fT ST]) |
|
4869 unfolding card_image[OF h] using c . |
|
4870 then have ?lhs by blast} |
|
4871 ultimately show ?thesis by blast |
|
4872 qed |
|
4873 |
|
4874 lemma linear_surjective_imp_injective: |
|
4875 assumes lf: "linear (f::real ^'n::finite => real ^'n)" and sf: "surj f" |
|
4876 shows "inj f" |
|
4877 proof- |
|
4878 let ?U = "UNIV :: (real ^'n) set" |
|
4879 from basis_exists[of ?U] obtain B |
|
4880 where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U" |
|
4881 by blast |
|
4882 {fix x assume x: "x \<in> span B" and fx: "f x = 0" |
|
4883 from B(4) have fB: "finite B" by (simp add: hassize_def) |
|
4884 from B(4) have d: "dim ?U = card B" by (simp add: hassize_def) |
|
4885 have fBi: "independent (f ` B)" |
|
4886 apply (rule card_le_dim_spanning[of "f ` B" ?U]) |
|
4887 apply blast |
|
4888 using sf B(3) |
|
4889 unfolding span_linear_image[OF lf] surj_def subset_eq image_iff |
|
4890 apply blast |
|
4891 using fB apply (blast intro: finite_imageI) |
|
4892 unfolding d |
|
4893 apply (rule card_image_le) |
|
4894 apply (rule fB) |
|
4895 done |
|
4896 have th0: "dim ?U \<le> card (f ` B)" |
|
4897 apply (rule span_card_ge_dim) |
|
4898 apply blast |
|
4899 unfolding span_linear_image[OF lf] |
|
4900 apply (rule subset_trans[where B = "f ` UNIV"]) |
|
4901 using sf unfolding surj_def apply blast |
|
4902 apply (rule image_mono) |
|
4903 apply (rule B(3)) |
|
4904 apply (metis finite_imageI fB) |
|
4905 done |
|
4906 |
|
4907 moreover have "card (f ` B) \<le> card B" |
|
4908 by (rule card_image_le, rule fB) |
|
4909 ultimately have th1: "card B = card (f ` B)" unfolding d by arith |
|
4910 have fiB: "inj_on f B" |
|
4911 unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast |
|
4912 from linear_indep_image_lemma[OF lf fB fBi fiB x] fx |
|
4913 have "x = 0" by blast} |
|
4914 note th = this |
|
4915 from th show ?thesis unfolding linear_injective_0[OF lf] |
|
4916 using B(3) by blast |
|
4917 qed |
|
4918 |
|
4919 (* Hence either is enough for isomorphism. *) |
|
4920 |
|
4921 lemma left_right_inverse_eq: |
|
4922 assumes fg: "f o g = id" and gh: "g o h = id" |
|
4923 shows "f = h" |
|
4924 proof- |
|
4925 have "f = f o (g o h)" unfolding gh by simp |
|
4926 also have "\<dots> = (f o g) o h" by (simp add: o_assoc) |
|
4927 finally show "f = h" unfolding fg by simp |
|
4928 qed |
|
4929 |
|
4930 lemma isomorphism_expand: |
|
4931 "f o g = id \<and> g o f = id \<longleftrightarrow> (\<forall>x. f(g x) = x) \<and> (\<forall>x. g(f x) = x)" |
|
4932 by (simp add: expand_fun_eq o_def id_def) |
|
4933 |
|
4934 lemma linear_injective_isomorphism: |
|
4935 assumes lf: "linear (f :: real^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f" |
|
4936 shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)" |
|
4937 unfolding isomorphism_expand[symmetric] |
|
4938 using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi] |
|
4939 by (metis left_right_inverse_eq) |
|
4940 |
|
4941 lemma linear_surjective_isomorphism: |
|
4942 assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and sf: "surj f" |
|
4943 shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)" |
|
4944 unfolding isomorphism_expand[symmetric] |
|
4945 using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]] |
|
4946 by (metis left_right_inverse_eq) |
|
4947 |
|
4948 (* Left and right inverses are the same for R^N->R^N. *) |
|
4949 |
|
4950 lemma linear_inverse_left: |
|
4951 assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and lf': "linear f'" |
|
4952 shows "f o f' = id \<longleftrightarrow> f' o f = id" |
|
4953 proof- |
|
4954 {fix f f':: "real ^'n \<Rightarrow> real ^'n" |
|
4955 assume lf: "linear f" "linear f'" and f: "f o f' = id" |
|
4956 from f have sf: "surj f" |
|
4957 |
|
4958 apply (auto simp add: o_def stupid_ext[symmetric] id_def surj_def) |
|
4959 by metis |
|
4960 from linear_surjective_isomorphism[OF lf(1) sf] lf f |
|
4961 have "f' o f = id" unfolding stupid_ext[symmetric] o_def id_def |
|
4962 by metis} |
|
4963 then show ?thesis using lf lf' by metis |
|
4964 qed |
|
4965 |
|
4966 (* Moreover, a one-sided inverse is automatically linear. *) |
|
4967 |
|
4968 lemma left_inverse_linear: |
|
4969 assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and gf: "g o f = id" |
|
4970 shows "linear g" |
|
4971 proof- |
|
4972 from gf have fi: "inj f" apply (auto simp add: inj_on_def o_def id_def stupid_ext[symmetric]) |
|
4973 by metis |
|
4974 from linear_injective_isomorphism[OF lf fi] |
|
4975 obtain h:: "real ^'n \<Rightarrow> real ^'n" where |
|
4976 h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast |
|
4977 have "h = g" apply (rule ext) using gf h(2,3) |
|
4978 apply (simp add: o_def id_def stupid_ext[symmetric]) |
|
4979 by metis |
|
4980 with h(1) show ?thesis by blast |
|
4981 qed |
|
4982 |
|
4983 lemma right_inverse_linear: |
|
4984 assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and gf: "f o g = id" |
|
4985 shows "linear g" |
|
4986 proof- |
|
4987 from gf have fi: "surj f" apply (auto simp add: surj_def o_def id_def stupid_ext[symmetric]) |
|
4988 by metis |
|
4989 from linear_surjective_isomorphism[OF lf fi] |
|
4990 obtain h:: "real ^'n \<Rightarrow> real ^'n" where |
|
4991 h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast |
|
4992 have "h = g" apply (rule ext) using gf h(2,3) |
|
4993 apply (simp add: o_def id_def stupid_ext[symmetric]) |
|
4994 by metis |
|
4995 with h(1) show ?thesis by blast |
|
4996 qed |
|
4997 |
|
4998 (* The same result in terms of square matrices. *) |
|
4999 |
|
5000 lemma matrix_left_right_inverse: |
|
5001 fixes A A' :: "real ^'n::finite^'n" |
|
5002 shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1" |
|
5003 proof- |
|
5004 {fix A A' :: "real ^'n^'n" assume AA': "A ** A' = mat 1" |
|
5005 have sA: "surj (op *v A)" |
|
5006 unfolding surj_def |
|
5007 apply clarify |
|
5008 apply (rule_tac x="(A' *v y)" in exI) |
|
5009 by (simp add: matrix_vector_mul_assoc AA' matrix_vector_mul_lid) |
|
5010 from linear_surjective_isomorphism[OF matrix_vector_mul_linear sA] |
|
5011 obtain f' :: "real ^'n \<Rightarrow> real ^'n" |
|
5012 where f': "linear f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast |
|
5013 have th: "matrix f' ** A = mat 1" |
|
5014 by (simp add: matrix_eq matrix_works[OF f'(1)] matrix_vector_mul_assoc[symmetric] matrix_vector_mul_lid f'(2)[rule_format]) |
|
5015 hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp |
|
5016 hence "matrix f' = A'" by (simp add: matrix_mul_assoc[symmetric] AA' matrix_mul_rid matrix_mul_lid) |
|
5017 hence "matrix f' ** A = A' ** A" by simp |
|
5018 hence "A' ** A = mat 1" by (simp add: th)} |
|
5019 then show ?thesis by blast |
|
5020 qed |
|
5021 |
|
5022 (* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *) |
|
5023 |
|
5024 definition "rowvector v = (\<chi> i j. (v$j))" |
|
5025 |
|
5026 definition "columnvector v = (\<chi> i j. (v$i))" |
|
5027 |
|
5028 lemma transp_columnvector: |
|
5029 "transp(columnvector v) = rowvector v" |
|
5030 by (simp add: transp_def rowvector_def columnvector_def Cart_eq) |
|
5031 |
|
5032 lemma transp_rowvector: "transp(rowvector v) = columnvector v" |
|
5033 by (simp add: transp_def columnvector_def rowvector_def Cart_eq) |
|
5034 |
|
5035 lemma dot_rowvector_columnvector: |
|
5036 "columnvector (A *v v) = A ** columnvector v" |
|
5037 by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def) |
|
5038 |
|
5039 lemma dot_matrix_product: "(x::'a::semiring_1^'n::finite) \<bullet> y = (((rowvector x ::'a^'n^1) ** (columnvector y :: 'a^1^'n))$1)$1" |
|
5040 by (vector matrix_matrix_mult_def rowvector_def columnvector_def dot_def) |
|
5041 |
|
5042 lemma dot_matrix_vector_mul: |
|
5043 fixes A B :: "real ^'n::finite ^'n" and x y :: "real ^'n" |
|
5044 shows "(A *v x) \<bullet> (B *v y) = |
|
5045 (((rowvector x :: real^'n^1) ** ((transp A ** B) ** (columnvector y :: real ^1^'n)))$1)$1" |
|
5046 unfolding dot_matrix_product transp_columnvector[symmetric] |
|
5047 dot_rowvector_columnvector matrix_transp_mul matrix_mul_assoc .. |
|
5048 |
|
5049 (* Infinity norm. *) |
|
5050 |
|
5051 definition "infnorm (x::real^'n::finite) = rsup {abs(x$i) |i. i\<in> (UNIV :: 'n set)}" |
|
5052 |
|
5053 lemma numseg_dimindex_nonempty: "\<exists>i. i \<in> (UNIV :: 'n set)" |
|
5054 by auto |
|
5055 |
|
5056 lemma infnorm_set_image: |
|
5057 "{abs(x$i) |i. i\<in> (UNIV :: 'n set)} = |
|
5058 (\<lambda>i. abs(x$i)) ` (UNIV :: 'n set)" by blast |
|
5059 |
|
5060 lemma infnorm_set_lemma: |
|
5061 shows "finite {abs((x::'a::abs ^'n::finite)$i) |i. i\<in> (UNIV :: 'n set)}" |
|
5062 and "{abs(x$i) |i. i\<in> (UNIV :: 'n::finite set)} \<noteq> {}" |
|
5063 unfolding infnorm_set_image |
|
5064 by (auto intro: finite_imageI) |
|
5065 |
|
5066 lemma infnorm_pos_le: "0 \<le> infnorm (x::real^'n::finite)" |
|
5067 unfolding infnorm_def |
|
5068 unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma] |
|
5069 unfolding infnorm_set_image |
|
5070 by auto |
|
5071 |
|
5072 lemma infnorm_triangle: "infnorm ((x::real^'n::finite) + y) \<le> infnorm x + infnorm y" |
|
5073 proof- |
|
5074 have th: "\<And>x y (z::real). x - y <= z \<longleftrightarrow> x - z <= y" by arith |
|
5075 have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast |
|
5076 have th2: "\<And>x (y::real). abs(x + y) - abs(x) <= abs(y)" by arith |
|
5077 show ?thesis |
|
5078 unfolding infnorm_def |
|
5079 unfolding rsup_finite_le_iff[ OF infnorm_set_lemma] |
|
5080 apply (subst diff_le_eq[symmetric]) |
|
5081 unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma] |
|
5082 unfolding infnorm_set_image bex_simps |
|
5083 apply (subst th) |
|
5084 unfolding th1 |
|
5085 unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma] |
|
5086 |
|
5087 unfolding infnorm_set_image ball_simps bex_simps |
|
5088 apply simp |
|
5089 apply (metis th2) |
|
5090 done |
|
5091 qed |
|
5092 |
|
5093 lemma infnorm_eq_0: "infnorm x = 0 \<longleftrightarrow> (x::real ^'n::finite) = 0" |
|
5094 proof- |
|
5095 have "infnorm x <= 0 \<longleftrightarrow> x = 0" |
|
5096 unfolding infnorm_def |
|
5097 unfolding rsup_finite_le_iff[OF infnorm_set_lemma] |
|
5098 unfolding infnorm_set_image ball_simps |
|
5099 by vector |
|
5100 then show ?thesis using infnorm_pos_le[of x] by simp |
|
5101 qed |
|
5102 |
|
5103 lemma infnorm_0: "infnorm 0 = 0" |
|
5104 by (simp add: infnorm_eq_0) |
|
5105 |
|
5106 lemma infnorm_neg: "infnorm (- x) = infnorm x" |
|
5107 unfolding infnorm_def |
|
5108 apply (rule cong[of "rsup" "rsup"]) |
|
5109 apply blast |
|
5110 apply (rule set_ext) |
|
5111 apply auto |
|
5112 done |
|
5113 |
|
5114 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)" |
|
5115 proof- |
|
5116 have "y - x = - (x - y)" by simp |
|
5117 then show ?thesis by (metis infnorm_neg) |
|
5118 qed |
|
5119 |
|
5120 lemma real_abs_sub_infnorm: "\<bar> infnorm x - infnorm y\<bar> \<le> infnorm (x - y)" |
|
5121 proof- |
|
5122 have th: "\<And>(nx::real) n ny. nx <= n + ny \<Longrightarrow> ny <= n + nx ==> \<bar>nx - ny\<bar> <= n" |
|
5123 by arith |
|
5124 from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"] |
|
5125 have ths: "infnorm x \<le> infnorm (x - y) + infnorm y" |
|
5126 "infnorm y \<le> infnorm (x - y) + infnorm x" |
|
5127 by (simp_all add: ring_simps infnorm_neg diff_def[symmetric]) |
|
5128 from th[OF ths] show ?thesis . |
|
5129 qed |
|
5130 |
|
5131 lemma real_abs_infnorm: " \<bar>infnorm x\<bar> = infnorm x" |
|
5132 using infnorm_pos_le[of x] by arith |
|
5133 |
|
5134 lemma component_le_infnorm: |
|
5135 shows "\<bar>x$i\<bar> \<le> infnorm (x::real^'n::finite)" |
|
5136 proof- |
|
5137 let ?U = "UNIV :: 'n set" |
|
5138 let ?S = "{\<bar>x$i\<bar> |i. i\<in> ?U}" |
|
5139 have fS: "finite ?S" unfolding image_Collect[symmetric] |
|
5140 apply (rule finite_imageI) unfolding Collect_def mem_def by simp |
|
5141 have S0: "?S \<noteq> {}" by blast |
|
5142 have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast |
|
5143 from rsup_finite_in[OF fS S0] rsup_finite_Ub[OF fS S0] |
|
5144 show ?thesis unfolding infnorm_def isUb_def setle_def |
|
5145 unfolding infnorm_set_image ball_simps by auto |
|
5146 qed |
|
5147 |
|
5148 lemma infnorm_mul_lemma: "infnorm(a *s x) <= \<bar>a\<bar> * infnorm x" |
|
5149 apply (subst infnorm_def) |
|
5150 unfolding rsup_finite_le_iff[OF infnorm_set_lemma] |
|
5151 unfolding infnorm_set_image ball_simps |
|
5152 apply (simp add: abs_mult) |
|
5153 apply (rule allI) |
|
5154 apply (cut_tac component_le_infnorm[of x]) |
|
5155 apply (rule mult_mono) |
|
5156 apply auto |
|
5157 done |
|
5158 |
|
5159 lemma infnorm_mul: "infnorm(a *s x) = abs a * infnorm x" |
|
5160 proof- |
|
5161 {assume a0: "a = 0" hence ?thesis by (simp add: infnorm_0) } |
|
5162 moreover |
|
5163 {assume a0: "a \<noteq> 0" |
|
5164 from a0 have th: "(1/a) *s (a *s x) = x" |
|
5165 by (simp add: vector_smult_assoc) |
|
5166 from a0 have ap: "\<bar>a\<bar> > 0" by arith |
|
5167 from infnorm_mul_lemma[of "1/a" "a *s x"] |
|
5168 have "infnorm x \<le> 1/\<bar>a\<bar> * infnorm (a*s x)" |
|
5169 unfolding th by simp |
|
5170 with ap have "\<bar>a\<bar> * infnorm x \<le> \<bar>a\<bar> * (1/\<bar>a\<bar> * infnorm (a *s x))" by (simp add: field_simps) |
|
5171 then have "\<bar>a\<bar> * infnorm x \<le> infnorm (a*s x)" |
|
5172 using ap by (simp add: field_simps) |
|
5173 with infnorm_mul_lemma[of a x] have ?thesis by arith } |
|
5174 ultimately show ?thesis by blast |
|
5175 qed |
|
5176 |
|
5177 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0" |
|
5178 using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith |
|
5179 |
|
5180 (* Prove that it differs only up to a bound from Euclidean norm. *) |
|
5181 |
|
5182 lemma infnorm_le_norm: "infnorm x \<le> norm x" |
|
5183 unfolding infnorm_def rsup_finite_le_iff[OF infnorm_set_lemma] |
|
5184 unfolding infnorm_set_image ball_simps |
|
5185 by (metis component_le_norm) |
|
5186 lemma card_enum: "card {1 .. n} = n" by auto |
|
5187 lemma norm_le_infnorm: "norm(x) <= sqrt(real CARD('n)) * infnorm(x::real ^'n::finite)" |
|
5188 proof- |
|
5189 let ?d = "CARD('n)" |
|
5190 have "real ?d \<ge> 0" by simp |
|
5191 hence d2: "(sqrt (real ?d))^2 = real ?d" |
|
5192 by (auto intro: real_sqrt_pow2) |
|
5193 have th: "sqrt (real ?d) * infnorm x \<ge> 0" |
|
5194 by (simp add: zero_le_mult_iff real_sqrt_ge_0_iff infnorm_pos_le) |
|
5195 have th1: "x\<bullet>x \<le> (sqrt (real ?d) * infnorm x)^2" |
|
5196 unfolding power_mult_distrib d2 |
|
5197 apply (subst power2_abs[symmetric]) |
|
5198 unfolding real_of_nat_def dot_def power2_eq_square[symmetric] |
|
5199 apply (subst power2_abs[symmetric]) |
|
5200 apply (rule setsum_bounded) |
|
5201 apply (rule power_mono) |
|
5202 unfolding abs_of_nonneg[OF infnorm_pos_le] |
|
5203 unfolding infnorm_def rsup_finite_ge_iff[OF infnorm_set_lemma] |
|
5204 unfolding infnorm_set_image bex_simps |
|
5205 apply blast |
|
5206 by (rule abs_ge_zero) |
|
5207 from real_le_lsqrt[OF dot_pos_le th th1] |
|
5208 show ?thesis unfolding real_vector_norm_def id_def . |
|
5209 qed |
|
5210 |
|
5211 (* Equality in Cauchy-Schwarz and triangle inequalities. *) |
|
5212 |
|
5213 lemma norm_cauchy_schwarz_eq: "(x::real ^'n::finite) \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *s y = norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs") |
|
5214 proof- |
|
5215 {assume h: "x = 0" |
|
5216 hence ?thesis by simp} |
|
5217 moreover |
|
5218 {assume h: "y = 0" |
|
5219 hence ?thesis by simp} |
|
5220 moreover |
|
5221 {assume x: "x \<noteq> 0" and y: "y \<noteq> 0" |
|
5222 from dot_eq_0[of "norm y *s x - norm x *s y"] |
|
5223 have "?rhs \<longleftrightarrow> (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) - norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) = 0)" |
|
5224 using x y |
|
5225 unfolding dot_rsub dot_lsub dot_lmult dot_rmult |
|
5226 unfolding norm_pow_2[symmetric] power2_eq_square diff_eq_0_iff_eq apply (simp add: dot_sym) |
|
5227 apply (simp add: ring_simps) |
|
5228 apply metis |
|
5229 done |
|
5230 also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y |
|
5231 by (simp add: ring_simps dot_sym) |
|
5232 also have "\<dots> \<longleftrightarrow> ?lhs" using x y |
|
5233 apply simp |
|
5234 by metis |
|
5235 finally have ?thesis by blast} |
|
5236 ultimately show ?thesis by blast |
|
5237 qed |
|
5238 |
|
5239 lemma norm_cauchy_schwarz_abs_eq: |
|
5240 fixes x y :: "real ^ 'n::finite" |
|
5241 shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> |
|
5242 norm x *s y = norm y *s x \<or> norm(x) *s y = - norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs") |
|
5243 proof- |
|
5244 have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith |
|
5245 have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)" |
|
5246 apply simp by vector |
|
5247 also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or> |
|
5248 (-x) \<bullet> y = norm x * norm y)" |
|
5249 unfolding norm_cauchy_schwarz_eq[symmetric] |
|
5250 unfolding norm_minus_cancel |
|
5251 norm_mul by blast |
|
5252 also have "\<dots> \<longleftrightarrow> ?lhs" |
|
5253 unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg |
|
5254 by arith |
|
5255 finally show ?thesis .. |
|
5256 qed |
|
5257 |
|
5258 lemma norm_triangle_eq: |
|
5259 fixes x y :: "real ^ 'n::finite" |
|
5260 shows "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x" |
|
5261 proof- |
|
5262 {assume x: "x =0 \<or> y =0" |
|
5263 hence ?thesis by (cases "x=0", simp_all)} |
|
5264 moreover |
|
5265 {assume x: "x \<noteq> 0" and y: "y \<noteq> 0" |
|
5266 hence "norm x \<noteq> 0" "norm y \<noteq> 0" |
|
5267 by simp_all |
|
5268 hence n: "norm x > 0" "norm y > 0" |
|
5269 using norm_ge_zero[of x] norm_ge_zero[of y] |
|
5270 by arith+ |
|
5271 have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra |
|
5272 have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2" |
|
5273 apply (rule th) using n norm_ge_zero[of "x + y"] |
|
5274 by arith |
|
5275 also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x" |
|
5276 unfolding norm_cauchy_schwarz_eq[symmetric] |
|
5277 unfolding norm_pow_2 dot_ladd dot_radd |
|
5278 by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym ring_simps) |
|
5279 finally have ?thesis .} |
|
5280 ultimately show ?thesis by blast |
|
5281 qed |
|
5282 |
|
5283 (* Collinearity.*) |
|
5284 |
|
5285 definition "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *s u)" |
|
5286 |
|
5287 lemma collinear_empty: "collinear {}" by (simp add: collinear_def) |
|
5288 |
|
5289 lemma collinear_sing: "collinear {(x::'a::ring_1^'n)}" |
|
5290 apply (simp add: collinear_def) |
|
5291 apply (rule exI[where x=0]) |
|
5292 by simp |
|
5293 |
|
5294 lemma collinear_2: "collinear {(x::'a::ring_1^'n),y}" |
|
5295 apply (simp add: collinear_def) |
|
5296 apply (rule exI[where x="x - y"]) |
|
5297 apply auto |
|
5298 apply (rule exI[where x=0], simp) |
|
5299 apply (rule exI[where x=1], simp) |
|
5300 apply (rule exI[where x="- 1"], simp add: vector_sneg_minus1[symmetric]) |
|
5301 apply (rule exI[where x=0], simp) |
|
5302 done |
|
5303 |
|
5304 lemma collinear_lemma: "collinear {(0::real^'n),x,y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *s x)" (is "?lhs \<longleftrightarrow> ?rhs") |
|
5305 proof- |
|
5306 {assume "x=0 \<or> y = 0" hence ?thesis |
|
5307 by (cases "x = 0", simp_all add: collinear_2 insert_commute)} |
|
5308 moreover |
|
5309 {assume x: "x \<noteq> 0" and y: "y \<noteq> 0" |
|
5310 {assume h: "?lhs" |
|
5311 then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *s u" unfolding collinear_def by blast |
|
5312 from u[rule_format, of x 0] u[rule_format, of y 0] |
|
5313 obtain cx and cy where |
|
5314 cx: "x = cx*s u" and cy: "y = cy*s u" |
|
5315 by auto |
|
5316 from cx x have cx0: "cx \<noteq> 0" by auto |
|
5317 from cy y have cy0: "cy \<noteq> 0" by auto |
|
5318 let ?d = "cy / cx" |
|
5319 from cx cy cx0 have "y = ?d *s x" |
|
5320 by (simp add: vector_smult_assoc) |
|
5321 hence ?rhs using x y by blast} |
|
5322 moreover |
|
5323 {assume h: "?rhs" |
|
5324 then obtain c where c: "y = c*s x" using x y by blast |
|
5325 have ?lhs unfolding collinear_def c |
|
5326 apply (rule exI[where x=x]) |
|
5327 apply auto |
|
5328 apply (rule exI[where x="- 1"], simp only: vector_smult_lneg vector_smult_lid) |
|
5329 apply (rule exI[where x= "-c"], simp only: vector_smult_lneg) |
|
5330 apply (rule exI[where x=1], simp) |
|
5331 apply (rule exI[where x="1 - c"], simp add: vector_smult_lneg vector_sub_rdistrib) |
|
5332 apply (rule exI[where x="c - 1"], simp add: vector_smult_lneg vector_sub_rdistrib) |
|
5333 done} |
|
5334 ultimately have ?thesis by blast} |
|
5335 ultimately show ?thesis by blast |
|
5336 qed |
|
5337 |
|
5338 lemma norm_cauchy_schwarz_equal: |
|
5339 fixes x y :: "real ^ 'n::finite" |
|
5340 shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}" |
|
5341 unfolding norm_cauchy_schwarz_abs_eq |
|
5342 apply (cases "x=0", simp_all add: collinear_2) |
|
5343 apply (cases "y=0", simp_all add: collinear_2 insert_commute) |
|
5344 unfolding collinear_lemma |
|
5345 apply simp |
|
5346 apply (subgoal_tac "norm x \<noteq> 0") |
|
5347 apply (subgoal_tac "norm y \<noteq> 0") |
|
5348 apply (rule iffI) |
|
5349 apply (cases "norm x *s y = norm y *s x") |
|
5350 apply (rule exI[where x="(1/norm x) * norm y"]) |
|
5351 apply (drule sym) |
|
5352 unfolding vector_smult_assoc[symmetric] |
|
5353 apply (simp add: vector_smult_assoc field_simps) |
|
5354 apply (rule exI[where x="(1/norm x) * - norm y"]) |
|
5355 apply clarify |
|
5356 apply (drule sym) |
|
5357 unfolding vector_smult_assoc[symmetric] |
|
5358 apply (simp add: vector_smult_assoc field_simps) |
|
5359 apply (erule exE) |
|
5360 apply (erule ssubst) |
|
5361 unfolding vector_smult_assoc |
|
5362 unfolding norm_mul |
|
5363 apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x") |
|
5364 apply (case_tac "c <= 0", simp add: ring_simps) |
|
5365 apply (simp add: ring_simps) |
|
5366 apply (case_tac "c <= 0", simp add: ring_simps) |
|
5367 apply (simp add: ring_simps) |
|
5368 apply simp |
|
5369 apply simp |
|
5370 done |
|
5371 |
|
5372 end |