diff -r 46be26e02456 -r 899c9c4e4a4c src/HOL/Multivariate_Analysis/Linear_Algebra.thy --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Fri Dec 14 14:46:01 2012 +0100 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Fri Dec 14 15:46:01 2012 +0100 @@ -398,6 +398,53 @@ then show "h = g" by (simp add: ext) qed +text {* TODO: The following lemmas about adjoints should hold for any +Hilbert space (i.e. complete inner product space). +(see \url{http://en.wikipedia.org/wiki/Hermitian_adjoint}) +*} + +lemma adjoint_works: + fixes f:: "'n::euclidean_space \ 'm::euclidean_space" + assumes lf: "linear f" + shows "x \ adjoint f y = f x \ y" +proof - + have "\y. \w. \x. f x \ y = x \ w" + proof (intro allI exI) + fix y :: "'m" and x + let ?w = "(\i\Basis. (f i \ y) *\<^sub>R i) :: 'n" + have "f x \ y = f (\i\Basis. (x \ i) *\<^sub>R i) \ y" + by (simp add: euclidean_representation) + also have "\ = (\i\Basis. (x \ i) *\<^sub>R f i) \ y" + unfolding linear_setsum[OF lf finite_Basis] + by (simp add: linear_cmul[OF lf]) + finally show "f x \ y = x \ ?w" + by (simp add: inner_setsum_left inner_setsum_right mult_commute) + qed + then show ?thesis + unfolding adjoint_def choice_iff + by (intro someI2_ex[where Q="\f'. x \ f' y = f x \ y"]) auto +qed + +lemma adjoint_clauses: + fixes f:: "'n::euclidean_space \ 'm::euclidean_space" + assumes lf: "linear f" + shows "x \ adjoint f y = f x \ y" + and "adjoint f y \ x = y \ f x" + by (simp_all add: adjoint_works[OF lf] inner_commute) + +lemma adjoint_linear: + fixes f:: "'n::euclidean_space \ 'm::euclidean_space" + assumes lf: "linear f" + shows "linear (adjoint f)" + by (simp add: lf linear_def euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m] + adjoint_clauses[OF lf] inner_simps) + +lemma adjoint_adjoint: + fixes f:: "'n::euclidean_space \ 'm::euclidean_space" + assumes lf: "linear f" + shows "adjoint (adjoint f) = f" + by (rule adjoint_unique, simp add: adjoint_clauses [OF lf]) + subsection {* Interlude: Some properties of real sets *} lemma seq_mono_lemma: assumes "\(n::nat) \ m. (d n :: real) < e n" and "\n \ m. e n <= e m" @@ -1261,77 +1308,37 @@ subsection{* Euclidean Spaces as Typeclass*} -lemma independent_eq_inj_on: - fixes D :: nat - and f :: "nat \ 'c::real_vector" - assumes "inj_on f {.. (\a u. a < D \ (\i\{..R f i) \ f a)" -proof - - from assms have eq: "\i. i < D \ f ` {..i. inj_on f ({..i. finite (f ` {.. {DIM('a)..}" by auto - show ?thesis unfolding * image_Un basis_finite by auto -qed - -lemma (in euclidean_space) range_basis_finite[intro]: "finite (range basis)" - unfolding range_basis by auto - -lemma span_basis: "span (range basis) = (UNIV :: 'a::euclidean_space set)" -proof - - { fix x :: 'a - have "(\iR basis i) \ span (range basis :: 'a set)" - by (simp add: span_setsum span_mul span_superset) - then have "x \ span (range basis)" - by (simp only: euclidean_representation [symmetric]) - } then show ?thesis by auto -qed - -lemma basis_representation: - "\u. x = (\v\basis ` {..R (v\'a\euclidean_space))" -proof - - have "x\UNIV" by auto from this[unfolded span_basis[THEN sym]] - have "\u. (\v\basis ` {..R v) = x" - unfolding range_basis span_insert_0 apply(subst (asm) span_finite) by auto - then show ?thesis by fastforce -qed - -lemma span_basis'[simp]:"span ((basis::nat=>'a) ` {..'a) ` {.. span (basis ` {.. e \ \x$$i\ <= e" - by (metis component_le_norm order_trans) - -lemma norm_bound_component_lt: "norm (x::'a::euclidean_space) < e \ \x$$i\ < e" - by (metis component_le_norm basic_trans_rules(21)) - -lemma norm_le_l1: "norm (x::'a::euclidean_space) \ (\ix $$ i\)" - apply (subst euclidean_representation[of x]) +lemma in_span_Basis: "x \ span Basis" + unfolding span_Basis .. + +lemma Basis_le_norm: "b \ Basis \ \x \ b\ \ norm x" + by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp + +lemma norm_bound_Basis_le: "b \ Basis \ norm x \ e \ \x \ b\ \ e" + by (metis Basis_le_norm order_trans) + +lemma norm_bound_Basis_lt: "b \ Basis \ norm x < e \ \x \ b\ < e" + by (metis Basis_le_norm basic_trans_rules(21)) + +lemma norm_le_l1: "norm x \ (\b\Basis. \x \ b\)" + apply (subst euclidean_representation[of x, symmetric]) apply (rule order_trans[OF norm_setsum]) apply (auto intro!: setsum_mono) done @@ -1339,61 +1346,29 @@ lemma setsum_norm_allsubsets_bound: fixes f:: "'a \ 'n::euclidean_space" assumes fP: "finite P" and fPs: "\Q. Q \ P \ norm (setsum f Q) \ e" - shows "setsum (\x. norm (f x)) P \ 2 * real DIM('n) * e" + shows "(\x\P. norm (f x)) \ 2 * real DIM('n) * e" proof - - let ?d = "real DIM('n)" - let ?nf = "\x. norm (f x)" - let ?U = "{..x. setsum (\i. \f x $$ i\) ?U) P = setsum (\i. setsum (\x. \f x $$ i\) P) ?U" + have "(\x\P. norm (f x)) \ (\x\P. \b\Basis. \f x \ b\)" + by (rule setsum_mono) (rule norm_le_l1) + also have "(\x\P. \b\Basis. \f x \ b\) = (\b\Basis. \x\P. \f x \ b\)" by (rule setsum_commute) - have th1: "2 * ?d * e = of_nat (card ?U) * (2 * e)" by (simp add: real_of_nat_def) - have "setsum ?nf P \ setsum (\x. setsum (\i. \f x $$ i\) ?U) P" - by (rule setsum_mono) (rule norm_le_l1) - also have "\ \ 2 * ?d * e" - unfolding th0 th1 + also have "\ \ of_nat (card (Basis :: 'n set)) * (2 * e)" proof (rule setsum_bounded) - fix i assume i: "i \ ?U" - let ?Pp = "{x. x\ P \ f x $$ i \ 0}" - let ?Pn = "{x. x \ P \ f x $$ i < 0}" - have thp: "P = ?Pp \ ?Pn" by auto - have thp0: "?Pp \ ?Pn ={}" by auto - have PpP: "?Pp \ P" and PnP: "?Pn \ P" by blast+ - have Ppe:"setsum (\x. \f x $$ i\) ?Pp \ e" - using component_le_norm[of "setsum (\x. f x) ?Pp" i] fPs[OF PpP] - by(auto intro: abs_le_D1) - have Pne: "setsum (\x. \f x $$ i\) ?Pn \ e" - using component_le_norm[of "setsum (\x. - f x) ?Pn" i] fPs[OF PnP] - by(auto simp add: setsum_negf intro: abs_le_D1) - have "setsum (\x. \f x $$ i\) P = setsum (\x. \f x $$ i\) ?Pp + setsum (\x. \f x $$ i\) ?Pn" - apply (subst thp) - apply (rule setsum_Un_zero) - using fP thp0 apply auto - done - also have "\ \ 2*e" using Pne Ppe by arith - finally show "setsum (\x. \f x $$ i\) P \ 2*e" . + fix i :: 'n assume i: "i \ Basis" + have "norm (\x\P. \f x \ i\) \ + norm ((\x\P \ - {x. f x \ i < 0}. f x) \ i) + norm ((\x\P \ {x. f x \ i < 0}. f x) \ i)" + by (simp add: abs_real_def setsum_cases[OF fP] setsum_negf uminus_add_conv_diff + norm_triangle_ineq4 inner_setsum_left + del: real_norm_def) + also have "\ \ e + e" unfolding real_norm_def + by (intro add_mono norm_bound_Basis_le i fPs) auto + finally show "(\x\P. \f x \ i\) \ 2*e" by simp qed + also have "\ = 2 * real DIM('n) * e" + by (simp add: real_of_nat_def) finally show ?thesis . qed -lemma lambda_skolem': "(\ix. P i x) \ - (\x::'a. \i ?rhs") -proof - - let ?S = "{..iiB. \x. norm (f x) \ B * norm x" proof - - let ?S = "{..i. (x$$i) *\<^sub>R (basis i)) ?S))" - apply (subst euclidean_representation[of x]) - apply rule - done - also have "\ = norm (setsum (\ i. (x$$i) *\<^sub>R f (basis i)) ?S)" - using linear_setsum[OF lf fS, of ?g, unfolded o_def] linear_cmul[OF lf] by auto - finally have th0: "norm (f x) = norm (setsum (\i. (x$$i) *\<^sub>R f (basis i))?S)" . - { fix i assume i: "i \ ?S" - from component_le_norm[of x i] - have "norm ((x$$i) *\<^sub>R f (basis i :: 'a)) \ norm (f (basis i)) * norm x" + let ?g = "\b. (x \ b) *\<^sub>R f b" + have "norm (f x) = norm (f (\b\Basis. (x \ b) *\<^sub>R b))" + unfolding euclidean_representation .. + also have "\ = norm (setsum ?g Basis)" + using linear_setsum[OF lf finite_Basis, of "\b. (x \ b) *\<^sub>R b", unfolded o_def] linear_cmul[OF lf] by auto + finally have th0: "norm (f x) = norm (setsum ?g Basis)" . + { fix i :: 'a assume i: "i \ Basis" + from Basis_le_norm[OF i, of x] + have "norm (?g i) \ norm (f i) * norm x" unfolding norm_scaleR - apply (simp only: mult_commute) + apply (subst mult_commute) apply (rule mult_mono) apply (auto simp add: field_simps) done } - then have th: "\i\ ?S. norm ((x$$i) *\<^sub>R f (basis i :: 'a)) \ norm (f (basis i)) * norm x" + then have th: "\b\Basis. norm (?g b) \ norm (f b) * norm x" by metis - from setsum_norm_le[of _ "\i. (x$$i) *\<^sub>R (f (basis i))", OF th] + from setsum_norm_le[of _ ?g, OF th] have "norm (f x) \ ?B * norm x" unfolding th0 setsum_left_distrib by metis} then show ?thesis by blast qed @@ -1438,12 +1409,15 @@ let ?K = "\B\ + 1" have Kp: "?K > 0" by arith { assume C: "B < 0" - have "((\\ i. 1)::'a) \ 0" unfolding euclidean_eq[where 'a='a] - by(auto intro!:exI[where x=0]) - then have "norm ((\\ i. 1)::'a) > 0" by auto - with C have "B * norm ((\\ i. 1)::'a) < 0" + def One \ "\Basis ::'a" + then have "One \ 0" + unfolding euclidean_eq_iff[where 'a='a] + by (simp add: inner_setsum_left inner_Basis setsum_cases) + then have "norm One > 0" by auto + with C have "B * norm One < 0" by (simp add: mult_less_0_iff) - with B[rule_format, of "(\\ i. 1)::'a"] norm_ge_zero[of "f ((\\ i. 1)::'a)"] have False by simp + with B[rule_format, of One] norm_ge_zero[of "f One"] + have False by simp } then have Bp: "B \ 0" by (metis not_leE) { fix x::"'a" @@ -1492,33 +1466,27 @@ fixes h:: "'m::euclidean_space \ 'n::euclidean_space \ 'k::real_normed_vector" assumes bh: "bilinear h" shows "\B. \x y. norm (h x y) \ B * norm x * norm y" -proof - - let ?M = "{..i. (x$$i) *\<^sub>R basis i) ?M) (setsum (\i. (y$$i) *\<^sub>R basis i) ?N))" - apply(subst euclidean_representation[where 'a='m]) - apply(subst euclidean_representation[where 'a='n]) - apply rule - done - also have "\ = norm (setsum (\ (i,j). h ((x$$i) *\<^sub>R basis i) ((y$$j) *\<^sub>R basis j)) (?M \ ?N))" - unfolding bilinear_setsum[OF bh fM fN] .. - finally have th: "norm (h x y) = \" . - have "norm (h x y) \ ?B * norm x * norm y" - apply (simp add: setsum_left_distrib th) +proof (clarify intro!: exI[of _ "\i\Basis. \j\Basis. norm (h i j)"]) + fix x:: "'m" and y :: "'n" + have "norm (h x y) = norm (h (setsum (\i. (x \ i) *\<^sub>R i) Basis) (setsum (\i. (y \ i) *\<^sub>R i) Basis))" + apply(subst euclidean_representation[where 'a='m]) + apply(subst euclidean_representation[where 'a='n]) + apply rule + done + also have "\ = norm (setsum (\ (i,j). h ((x \ i) *\<^sub>R i) ((y \ j) *\<^sub>R j)) (Basis \ Basis))" + unfolding bilinear_setsum[OF bh finite_Basis finite_Basis] .. + finally have th: "norm (h x y) = \" . + show "norm (h x y) \ (\i\Basis. \j\Basis. norm (h i j)) * norm x * norm y" + apply (auto simp add: setsum_left_distrib th setsum_cartesian_product) apply (rule setsum_norm_le) - using fN fM apply simp apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] field_simps simp del: scaleR_scaleR) apply (rule mult_mono) - apply (auto simp add: zero_le_mult_iff component_le_norm) + apply (auto simp add: zero_le_mult_iff Basis_le_norm) apply (rule mult_mono) - apply (auto simp add: zero_le_mult_iff component_le_norm) - done } - then show ?thesis by metis + apply (auto simp add: zero_le_mult_iff Basis_le_norm) + done qed lemma bilinear_bounded_pos: @@ -1582,8 +1550,8 @@ lemma independent_bound: fixes S:: "('a::euclidean_space) set" - shows "independent S \ finite S \ card S <= DIM('a::euclidean_space)" - using independent_span_bound[of "(basis::nat=>'a) ` {.. finite S \ card S \ DIM('a::euclidean_space)" + using independent_span_bound[OF finite_Basis, of S] by auto lemma dependent_biggerset: "(finite (S::('a::euclidean_space) set) ==> card S > DIM('a)) ==> dependent S" @@ -1666,9 +1634,8 @@ text {* More lemmas about dimension. *} lemma dim_UNIV: "dim (UNIV :: ('a::euclidean_space) set) = DIM('a)" - apply (rule dim_unique[of "(basis::nat=>'a) ` {.. T \ dim S \ dim T" @@ -2256,20 +2223,9 @@ lemma linear_eq_stdbasis: assumes lf: "linear (f::'a::euclidean_space \ _)" and lg: "linear g" - and fg: "\ib\Basis. f b = g b" shows "f = g" -proof - - let ?U = "{.. (UNIV :: 'a set)" - from equalityD2[OF span_basis'[where 'a='a]] - have IU: " (UNIV :: 'a set) \ span ?I" by blast - have "f x = g x" - apply (rule linear_eq[OF lf lg IU,rule_format]) - using fg x apply auto - done - } then show ?thesis by auto -qed + using linear_eq[OF lf lg, of _ Basis] fg by auto text {* Similar results for bilinear functions. *} @@ -2303,14 +2259,9 @@ fixes f::"'a::euclidean_space \ 'b::euclidean_space \ _" assumes bf: "bilinear f" and bg: "bilinear g" - and fg: "\iji\Basis. \j\Basis. f i j = g i j" shows "f = g" -proof - - from fg have th: "\x \ (basis ` {..y\ (basis ` {..g. linear g \ g o f = id" proof - - from linear_independent_extend[OF independent_injective_image, OF independent_basis, OF lf fi] + from linear_independent_extend[OF independent_injective_image, OF independent_Basis, OF lf fi] obtain h:: "'b => 'a" where - h: "linear h" "\x \ f ` basis ` {..i f) (basis i) = id (basis i)" + h: "linear h" "\x \ f ` Basis. h x = inv f x" by blast + from h(2) have th: "\i\Basis. (h \ f) i = id i" using inv_o_cancel[OF fi, unfolded fun_eq_iff id_def o_def] by auto @@ -2336,12 +2287,12 @@ assumes lf: "linear f" and sf: "surj f" shows "\g. linear g \ f o g = id" proof - - from linear_independent_extend[OF independent_basis[where 'a='b],of "inv f"] + from linear_independent_extend[OF independent_Basis[where 'a='b],of "inv f"] obtain h:: "'b \ 'a" where - h: "linear h" "\ x\ basis ` {..x\Basis. h x = inv f x" by blast from h(2) - have th: "\ii\Basis. (f o h) i = id i" + using sf by (auto simp add: surj_iff_all) from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th] have "f o h = id" . then show ?thesis using h(1) by blast @@ -2538,18 +2489,18 @@ subsection {* Infinity norm *} -definition "infnorm (x::'a::euclidean_space) = Sup {abs(x$$i) |i. i b) |b. b \ Basis}" lemma numseg_dimindex_nonempty: "\i. i \ (UNIV :: 'n set)" by auto lemma infnorm_set_image: - "{abs((x::'a::euclidean_space)$$i) |i. ii. abs(x$$i)) ` {.. i) |i. i \ Basis} = (\i. abs(x \ i)) ` Basis" + by blast lemma infnorm_set_lemma: - shows "finite {abs((x::'a::euclidean_space)$$i) |i. i {}" + shows "finite {abs((x::'a::euclidean_space) \ i) |i. i \ Basis}" + and "{abs(x \ i) |i. i \ Basis} \ {}" unfolding infnorm_set_image by auto @@ -2557,25 +2508,26 @@ unfolding infnorm_def unfolding Sup_finite_ge_iff[ OF infnorm_set_lemma] unfolding infnorm_set_image - by auto + by (auto simp: ex_in_conv) lemma infnorm_triangle: "infnorm ((x::'a::euclidean_space) + y) \ infnorm x + infnorm y" proof - have th: "\x y (z::real). x - y <= z \ x - z <= y" by arith have th1: "\S f. f ` S = { f i| i. i \ S}" by blast have th2: "\x (y::real). abs(x + y) - abs(x) <= abs(y)" by arith - have *:"\i. i \ {.. i {}" by blast - have th1: "\S f. f ` S = { f i| i. i \ S}" by blast - show ?thesis unfolding infnorm_def - apply(subst Sup_finite_ge_iff) using Sup_finite_in[OF fS S0] - using infnorm_set_image using True apply auto - done +lemma Basis_le_infnorm: + assumes b: "b \ Basis" shows "\x \ b\ \ infnorm (x::'a::euclidean_space)" + unfolding infnorm_def +proof (subst Sup_finite_ge_iff) + let ?S = "{\x \ i\ |i. i \ Basis}" + show "finite ?S" by (rule infnorm_set_lemma) + show "?S \ {}" by auto + show "Bex ?S (op \ \x \ b\)" + using b by (auto intro!: exI[of _ b]) qed lemma infnorm_mul_lemma: "infnorm(a *\<^sub>R x) <= \a\ * infnorm x" apply (subst infnorm_def) unfolding Sup_finite_le_iff[OF infnorm_set_lemma] - unfolding infnorm_set_image ball_simps euclidean_component_scaleR abs_mult - using component_le_infnorm[of x] + unfolding infnorm_set_image ball_simps inner_scaleR abs_mult + using Basis_le_infnorm[of _ x] apply (auto intro: mult_mono) done @@ -2671,9 +2616,13 @@ lemma infnorm_le_norm: "infnorm x \ norm x" unfolding infnorm_def Sup_finite_le_iff[OF infnorm_set_lemma] unfolding infnorm_set_image ball_simps - by (metis component_le_norm) - -lemma norm_le_infnorm: "norm(x) <= sqrt(real DIM('a)) * infnorm(x::'a::euclidean_space)" + by (metis Basis_le_norm) + +lemma euclidean_inner: "inner x y = (\b\Basis. (x \ b) * (y \ b))" + by (subst (1 2) euclidean_representation[symmetric, where 'a='a]) + (simp add: inner_setsum_left inner_setsum_right setsum_cases inner_Basis ac_simps if_distrib) + +lemma norm_le_infnorm: "norm(x) <= sqrt DIM('a) * infnorm(x::'a::euclidean_space)" proof - let ?d = "DIM('a)" have "real ?d \ 0" by simp @@ -2683,13 +2632,14 @@ by (simp add: zero_le_mult_iff infnorm_pos_le) have th1: "x \ x \ (sqrt (real ?d) * infnorm x)^2" unfolding power_mult_distrib d2 - unfolding real_of_nat_def apply(subst euclidean_inner) + unfolding real_of_nat_def + apply(subst euclidean_inner) apply (subst power2_abs[symmetric]) apply (rule order_trans[OF setsum_bounded[where K="\infnorm x\\"]]) apply (auto simp add: power2_eq_square[symmetric]) apply (subst power2_abs[symmetric]) apply (rule power_mono) - unfolding infnorm_def Sup_finite_ge_iff[OF infnorm_set_lemma] + unfolding infnorm_def Sup_finite_ge_iff[OF infnorm_set_lemma] unfolding infnorm_set_image bex_simps apply (rule_tac x=i in bexI) apply auto @@ -2872,8 +2822,8 @@ subsection {* An ordering on euclidean spaces that will allow us to talk about intervals *} class ordered_euclidean_space = ord + euclidean_space + - assumes eucl_le: "x \ y \ (\i < DIM('a). x $$ i \ y $$ i)" - and eucl_less: "x < y \ (\i < DIM('a). x $$ i < y $$ i)" + assumes eucl_le: "x \ y \ (\i\Basis. x \ i \ y \ i)" + and eucl_less: "x < y \ (\i\Basis. x \ i < y \ i)" lemma eucl_less_not_refl[simp, intro!]: "\ x < (x::'a::ordered_euclidean_space)" unfolding eucl_less[where 'a='a] by auto @@ -2889,35 +2839,16 @@ lemma atLeastAtMost_singleton_euclidean[simp]: fixes a :: "'a::ordered_euclidean_space" shows "{a .. a} = {a}" - by (force simp: eucl_le[where 'a='a] euclidean_eq[where 'a='a]) - -lemma basis_real_range: "basis ` {..<1} = {1::real}" by auto - -instance real::ordered_euclidean_space - by default (auto simp add: euclidean_component_def) - -lemma Eucl_real_simps[simp]: - "(x::real) $$ 0 = x" - "(\\ i. f i) = ((f 0)::real)" - "\i. i > 0 \ x $$ i = 0" - defer apply(subst euclidean_eq) apply safe - unfolding euclidean_lambda_beta' - unfolding euclidean_component_def apply auto - done - -lemma complex_basis[simp]: - shows "basis 0 = (1::complex)" and "basis 1 = ii" and "basis (Suc 0) = ii" - unfolding basis_complex_def by auto - -lemma DIM_prod[simp]: "DIM('a \ 'b) = DIM('b::euclidean_space) + DIM('a::euclidean_space)" - (* FIXME: why this orientation? Why not "DIM('a) + DIM('b)" ? *) - unfolding dimension_prod_def by (rule add_commute) + by (force simp: eucl_le[where 'a='a] euclidean_eq_iff[where 'a='a]) + +instance real :: ordered_euclidean_space + by default (auto simp add: Basis_real_def) instantiation prod :: (ordered_euclidean_space, ordered_euclidean_space) ordered_euclidean_space begin -definition "x \ (y::('a\'b)) \ (\i'b). x $$ i \ y $$ i)" -definition "x < (y::('a\'b)) \ (\i'b). x $$ i < y $$ i)" +definition "x \ (y::('a\'b)) \ (\i\Basis. x \ i \ y \ i)" +definition "x < (y::('a\'b)) \ (\i\Basis. x \ i < y \ i)" instance by default (auto simp: less_prod_def less_eq_prod_def)