# HG changeset patch # User wenzelm # Date 1378308997 -7200 # Node ID d4374a69ddff877c8140e832004563a9b195054a # Parent ed2b48af04d941cd6a526e5f24fc9d2dfa29bd8c tuned proofs; diff -r ed2b48af04d9 -r d4374a69ddff src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Wed Sep 04 17:35:47 2013 +0200 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Wed Sep 04 17:36:37 2013 +0200 @@ -34,8 +34,8 @@ using assms convex_def[of S] by auto lemma mem_convex_alt: - assumes "convex S" "x : S" "y : S" "u>=0" "v>=0" "u+v>0" - shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) : S" + assumes "convex S" "x \ S" "y \ S" "u \ 0" "v \ 0" "u + v > 0" + shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) \ S" apply (subst mem_convex_2) using assms apply (auto simp add: algebra_simps zero_le_divide_iff) @@ -74,20 +74,20 @@ fixes f :: "'n::euclidean_space \ 'm::euclidean_space" assumes lf: "linear f" and fi: "inj_on f (span S)" - shows "dim (f ` S) = dim (S:: 'n::euclidean_space set)" -proof - - obtain B where B_def: "B \ S \ independent B \ S \ span B \ card B = dim S" + shows "dim (f ` S) = dim (S::'n::euclidean_space set)" +proof - + obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" using basis_exists[of S] by auto then have "span S = span B" using span_mono[of B S] span_mono[of S "span B"] span_span[of B] by auto then have "independent (f ` B)" - using independent_injective_on_span_image[of B f] B_def assms by auto + using independent_injective_on_span_image[of B f] B assms by auto moreover have "card (f ` B) = card B" - using assms card_image[of f B] subset_inj_on[of f "span S" B] B_def span_inc by auto + using assms card_image[of f B] subset_inj_on[of f "span S" B] B span_inc by auto moreover have "(f ` B) \ (f ` S)" - using B_def by auto + using B by auto ultimately have "dim (f ` S) \ dim S" - using independent_card_le_dim[of "f ` B" "f ` S"] B_def by auto + using independent_card_le_dim[of "f ` B" "f ` S"] B by auto then show ?thesis using dim_image_le[of f S] assms by auto qed @@ -220,8 +220,6 @@ and C: "C \ T" "independent C" "T \ span C" "card C = dim T" shows "\f. linear f \ f ` B = C \ f ` S = T \ inj_on f S" proof - -(* Proof is a modified copy of the proof of similar lemma subspace_isomorphism -*) from B independent_bound have fB: "finite B" by blast from C independent_bound have fC: "finite C" @@ -293,9 +291,6 @@ then show ?thesis using closure_linear_image[of f S] assms by auto qed -lemma closure_direct_sum: "closure (S \ T) = closure S \ closure T" - by (rule closure_Times) - lemma closure_scaleR: fixes S :: "'a::real_normed_vector set" shows "(op *\<^sub>R c) ` (closure S) = closure ((op *\<^sub>R c) ` S)" @@ -367,7 +362,7 @@ by (auto simp add:norm_minus_commute) qed -lemma norm_minus_eqI:"x = - y \ norm x = norm y" by auto +lemma norm_minus_eqI: "x = - y \ norm x = norm y" by auto lemma Min_grI: assumes "finite A" "A \ {}" "\a\A. x < a" @@ -8668,7 +8663,7 @@ have "(closure S) + (closure T) = (\(x,y). x + y) ` (closure S \ closure T)" by (simp add: set_plus_image) also have "... = (\(x,y). x + y) ` closure (S \ T)" - using closure_direct_sum by auto + using closure_Times by auto also have "... \ closure (S + T)" using fst_snd_linear closure_linear_image[of "(\(x,y). x + y)" "S \ T"] by (auto simp: set_plus_image) diff -r ed2b48af04d9 -r d4374a69ddff src/HOL/Multivariate_Analysis/Linear_Algebra.thy --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Wed Sep 04 17:35:47 2013 +0200 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Wed Sep 04 17:36:37 2013 +0200 @@ -17,11 +17,15 @@ lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)" proof - - have "(x + 1/2)\<^sup>2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith - then show ?thesis by (simp add: field_simps power2_eq_square) + have "(x + 1/2)\<^sup>2 + 3/4 > 0" + using zero_le_power2[of "x+1/2"] by arith + then show ?thesis + by (simp add: field_simps power2_eq_square) qed -lemma square_continuous: "0 < (e::real) ==> \d. 0 < d \ (\y. abs(y - x) < d \ abs(y * y - x * x) < e)" +lemma square_continuous: + fixes e :: real + shows "e > 0 \ \d. 0 < d \ (\y. abs (y - x) < d \ abs (y * y - x * x) < e)" using isCont_power[OF isCont_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2] apply (auto simp add: power2_eq_square) apply (rule_tac x="s" in exI) @@ -30,7 +34,7 @@ apply auto done -lemma real_le_lsqrt: "0 <= x \ 0 <= y \ x <= y\<^sup>2 ==> sqrt x <= y" +lemma real_le_lsqrt: "0 \ x \ 0 \ y \ x \ y\<^sup>2 \ sqrt x \ y" using real_sqrt_le_iff[of x "y\<^sup>2"] by simp lemma real_le_rsqrt: "x\<^sup>2 \ y \ x \ sqrt y" @@ -41,46 +45,49 @@ lemma sqrt_even_pow2: assumes n: "even n" - shows "sqrt(2 ^ n) = 2 ^ (n div 2)" + shows "sqrt (2 ^ n) = 2 ^ (n div 2)" proof - - from n obtain m where m: "n = 2*m" unfolding even_mult_two_ex .. - from m have "sqrt(2 ^ n) = sqrt ((2 ^ m)\<^sup>2)" + from n obtain m where m: "n = 2 * m" + unfolding even_mult_two_ex .. + from m have "sqrt (2 ^ n) = sqrt ((2 ^ m)\<^sup>2)" by (simp only: power_mult[symmetric] mult_commute) - then show ?thesis using m by simp + then show ?thesis + using m by simp qed -lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)" - apply (cases "x = 0", simp_all) +lemma real_div_sqrt: "0 \ x \ x / sqrt x = sqrt x" + apply (cases "x = 0") + apply simp_all using sqrt_divide_self_eq[of x] apply (simp add: inverse_eq_divide field_simps) done text{* Hence derive more interesting properties of the norm. *} -lemma norm_eq_0_dot: "(norm x = 0) \ (inner x x = (0::real))" +lemma norm_eq_0_dot: "norm x = 0 \ x \ x = (0::real)" by simp (* TODO: delete *) -lemma norm_cauchy_schwarz: "inner x y <= norm x * norm y" +lemma norm_cauchy_schwarz: "x \ y \ norm x * norm y" (* TODO: move to Inner_Product.thy *) using Cauchy_Schwarz_ineq2[of x y] by auto lemma norm_triangle_sub: fixes x y :: "'a::real_normed_vector" - shows "norm x \ norm y + norm (x - y)" + shows "norm x \ norm y + norm (x - y)" using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps) -lemma norm_le: "norm(x) <= norm(y) \ x \ x <= y \ y" - by (simp add: norm_eq_sqrt_inner) - -lemma norm_lt: "norm(x) < norm(y) \ x \ x < y \ y" +lemma norm_le: "norm x \ norm y \ x \ x \ y \ y" by (simp add: norm_eq_sqrt_inner) -lemma norm_eq: "norm(x) = norm (y) \ x \ x = y \ y" +lemma norm_lt: "norm x < norm y \ x \ x < y \ y" + by (simp add: norm_eq_sqrt_inner) + +lemma norm_eq: "norm x = norm y \ x \ x = y \ y" apply (subst order_eq_iff) apply (auto simp: norm_le) done -lemma norm_eq_1: "norm(x) = 1 \ x \ x = 1" +lemma norm_eq_1: "norm x = 1 \ x \ x = 1" by (simp add: norm_eq_sqrt_inner) text{* Squaring equations and inequalities involving norms. *} @@ -88,7 +95,7 @@ lemma dot_square_norm: "x \ x = (norm x)\<^sup>2" by (simp only: power2_norm_eq_inner) (* TODO: move? *) -lemma norm_eq_square: "norm(x) = a \ 0 <= a \ x \ x = a\<^sup>2" +lemma norm_eq_square: "norm x = a \ 0 \ a \ x \ x = a\<^sup>2" by (auto simp add: norm_eq_sqrt_inner) lemma real_abs_le_square_iff: "\x\ \ \y\ \ (x::real)\<^sup>2 \ y\<^sup>2" @@ -102,13 +109,13 @@ then show "\x\ \ \y\" by simp qed -lemma norm_le_square: "norm(x) <= a \ 0 <= a \ x \ x <= a\<^sup>2" +lemma norm_le_square: "norm x \ a \ 0 \ a \ x \ x \ a\<^sup>2" apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric]) using norm_ge_zero[of x] apply arith done -lemma norm_ge_square: "norm(x) >= a \ a <= 0 \ x \ x >= a\<^sup>2" +lemma norm_ge_square: "norm x \ a \ a \ 0 \ x \ x \ a\<^sup>2" apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric]) using norm_ge_zero[of x] apply arith @@ -116,16 +123,17 @@ lemma norm_lt_square: "norm(x) < a \ 0 < a \ x \ x < a\<^sup>2" by (metis not_le norm_ge_square) + lemma norm_gt_square: "norm(x) > a \ a < 0 \ x \ x > a\<^sup>2" by (metis norm_le_square not_less) text{* Dot product in terms of the norm rather than conversely. *} -lemmas inner_simps = inner_add_left inner_add_right inner_diff_right inner_diff_left +lemmas inner_simps = inner_add_left inner_add_right inner_diff_right inner_diff_left inner_scaleR_left inner_scaleR_right lemma dot_norm: "x \ y = ((norm (x + y))\<^sup>2 - (norm x)\<^sup>2 - (norm y)\<^sup>2) / 2" - unfolding power2_norm_eq_inner inner_simps inner_commute by auto + unfolding power2_norm_eq_inner inner_simps inner_commute by auto lemma dot_norm_neg: "x \ y = (((norm x)\<^sup>2 + (norm y)\<^sup>2) - (norm (x - y))\<^sup>2) / 2" unfolding power2_norm_eq_inner inner_simps inner_commute @@ -133,32 +141,37 @@ text{* Equality of vectors in terms of @{term "op \"} products. *} -lemma vector_eq: "x = y \ x \ x = x \ y \ y \ y = x \ x" (is "?lhs \ ?rhs") +lemma vector_eq: "x = y \ x \ x = x \ y \ y \ y = x \ x" + (is "?lhs \ ?rhs") proof assume ?lhs then show ?rhs by simp next assume ?rhs - then have "x \ x - x \ y = 0 \ x \ y - y \ y = 0" by simp - then have "x \ (x - y) = 0 \ y \ (x - y) = 0" by (simp add: inner_diff inner_commute) - then have "(x - y) \ (x - y) = 0" by (simp add: field_simps inner_diff inner_commute) - then show "x = y" by (simp) + then have "x \ x - x \ y = 0 \ x \ y - y \ y = 0" + by simp + then have "x \ (x - y) = 0 \ y \ (x - y) = 0" + by (simp add: inner_diff inner_commute) + then have "(x - y) \ (x - y) = 0" + by (simp add: field_simps inner_diff inner_commute) + then show "x = y" by simp qed lemma norm_triangle_half_r: - shows "norm (y - x1) < e / 2 \ norm (y - x2) < e / 2 \ norm (x1 - x2) < e" - using dist_triangle_half_r unfolding dist_norm[THEN sym] by auto + "norm (y - x1) < e / 2 \ norm (y - x2) < e / 2 \ norm (x1 - x2) < e" + using dist_triangle_half_r unfolding dist_norm[symmetric] by auto lemma norm_triangle_half_l: - assumes "norm (x - y) < e / 2" "norm (x' - (y)) < e / 2" + assumes "norm (x - y) < e / 2" + and "norm (x' - (y)) < e / 2" shows "norm (x - x') < e" - using dist_triangle_half_l[OF assms[unfolded dist_norm[THEN sym]]] - unfolding dist_norm[THEN sym] . - -lemma norm_triangle_le: "norm(x) + norm y <= e ==> norm(x + y) <= e" + using dist_triangle_half_l[OF assms[unfolded dist_norm[symmetric]]] + unfolding dist_norm[symmetric] . + +lemma norm_triangle_le: "norm x + norm y \ e \ norm (x + y) \ e" by (rule norm_triangle_ineq [THEN order_trans]) -lemma norm_triangle_lt: "norm(x) + norm(y) < e ==> norm(x + y) < e" +lemma norm_triangle_lt: "norm x + norm y < e \ norm (x + y) < e" by (rule norm_triangle_ineq [THEN le_less_trans]) lemma setsum_clauses: @@ -191,7 +204,8 @@ lemma vector_eq_ldot: "(\x. x \ y = x \ z) \ y = z" proof assume "\x. x \ y = x \ z" - then have "\x. x \ (y - z) = 0" by (simp add: inner_diff) + then have "\x. x \ (y - z) = 0" + by (simp add: inner_diff) then have "(y - z) \ (y - z) = 0" .. then show "y = z" by simp qed simp @@ -199,7 +213,8 @@ lemma vector_eq_rdot: "(\z. x \ z = y \ z) \ x = y" proof assume "\z. x \ z = y \ z" - then have "\z. (x - y) \ z = 0" by (simp add: inner_diff) + then have "\z. (x - y) \ z = 0" + by (simp add: inner_diff) then have "(x - y) \ (x - y) = 0" .. then show "x = y" by simp qed simp @@ -237,31 +252,35 @@ where "linear f \ (\x y. f(x + y) = f x + f y) \ (\c x. f(c *\<^sub>R x) = c *\<^sub>R f x)" lemma linearI: - assumes "\x y. f (x + y) = f x + f y" "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" + assumes "\x y. f (x + y) = f x + f y" + and "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" shows "linear f" using assms unfolding linear_def by auto -lemma linear_compose_cmul: "linear f ==> linear (\x. c *\<^sub>R f x)" +lemma linear_compose_cmul: "linear f \ linear (\x. c *\<^sub>R f x)" by (simp add: linear_def algebra_simps) -lemma linear_compose_neg: "linear f ==> linear (\x. -(f(x)))" +lemma linear_compose_neg: "linear f \ linear (\x. - f x)" by (simp add: linear_def) -lemma linear_compose_add: "linear f \ linear g ==> linear (\x. f(x) + g(x))" +lemma linear_compose_add: "linear f \ linear g \ linear (\x. f x + g x)" by (simp add: linear_def algebra_simps) -lemma linear_compose_sub: "linear f \ linear g ==> linear (\x. f x - g x)" +lemma linear_compose_sub: "linear f \ linear g \ linear (\x. f x - g x)" by (simp add: linear_def algebra_simps) -lemma linear_compose: "linear f \ linear g ==> linear (g o f)" +lemma linear_compose: "linear f \ linear g \ linear (g \ f)" by (simp add: linear_def) -lemma linear_id: "linear id" by (simp add: linear_def id_def) - -lemma linear_zero: "linear (\x. 0)" by (simp add: linear_def) +lemma linear_id: "linear id" + by (simp add: linear_def id_def) + +lemma linear_zero: "linear (\x. 0)" + by (simp add: linear_def) lemma linear_compose_setsum: - assumes fS: "finite S" and lS: "\a \ S. linear (f a)" + assumes fS: "finite S" + and lS: "\a \ S. linear (f a)" shows "linear(\x. setsum (\a. f a x) S)" using lS apply (induct rule: finite_induct[OF fS]) @@ -275,88 +294,100 @@ apply simp done -lemma linear_cmul: "linear f ==> f(c *\<^sub>R x) = c *\<^sub>R f x" +lemma linear_cmul: "linear f \ f (c *\<^sub>R x) = c *\<^sub>R f x" by (simp add: linear_def) -lemma linear_neg: "linear f ==> f (-x) = - f x" +lemma linear_neg: "linear f \ f (- x) = - f x" using linear_cmul [where c="-1"] by simp -lemma linear_add: "linear f ==> f(x + y) = f x + f y" +lemma linear_add: "linear f \ f(x + y) = f x + f y" by (metis linear_def) -lemma linear_sub: "linear f ==> f(x - y) = f x - f y" +lemma linear_sub: "linear f \ f(x - y) = f x - f y" by (simp add: diff_minus linear_add linear_neg) lemma linear_setsum: - assumes lf: "linear f" and fS: "finite S" - shows "f (setsum g S) = setsum (f o g) S" - using fS -proof (induct rule: finite_induct) + assumes lin: "linear f" + and fin: "finite S" + shows "f (setsum g S) = setsum (f \ g) S" + using fin +proof induct case empty - then show ?case by (simp add: linear_0[OF lf]) + then show ?case + by (simp add: linear_0[OF lin]) next case (insert x F) - have "f (setsum g (insert x F)) = f (g x + setsum g F)" using insert.hyps - by simp - also have "\ = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp - also have "\ = setsum (f o g) (insert x F)" using insert.hyps by simp + have "f (setsum g (insert x F)) = f (g x + setsum g F)" + using insert.hyps by simp + also have "\ = f (g x) + f (setsum g F)" + using linear_add[OF lin] by simp + also have "\ = setsum (f \ g) (insert x F)" + using insert.hyps by simp finally show ?case . qed lemma linear_setsum_mul: - assumes lf: "linear f" and fS: "finite S" + assumes lin: "linear f" + and fin: "finite S" shows "f (setsum (\i. c i *\<^sub>R v i) S) = setsum (\i. c i *\<^sub>R f (v i)) S" - using linear_setsum[OF lf fS, of "\i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lf] + using linear_setsum[OF lin fin, of "\i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lin] by simp lemma linear_injective_0: - assumes lf: "linear f" + assumes lin: "linear f" shows "inj f \ (\x. f x = 0 \ x = 0)" proof - - have "inj f \ (\ x y. f x = f y \ x = y)" by (simp add: inj_on_def) - also have "\ \ (\ x y. f x - f y = 0 \ x - y = 0)" by simp + have "inj f \ (\ x y. f x = f y \ x = y)" + by (simp add: inj_on_def) + also have "\ \ (\ x y. f x - f y = 0 \ x - y = 0)" + by simp also have "\ \ (\ x y. f (x - y) = 0 \ x - y = 0)" - by (simp add: linear_sub[OF lf]) - also have "\ \ (\ x. f x = 0 \ x = 0)" by auto + by (simp add: linear_sub[OF lin]) + also have "\ \ (\ x. f x = 0 \ x = 0)" + by auto finally show ?thesis . qed subsection {* Bilinear functions. *} -definition "bilinear f \ (\x. linear(\y. f x y)) \ (\y. linear(\x. f x y))" - -lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)" +definition "bilinear f \ (\x. linear (\y. f x y)) \ (\y. linear (\x. f x y))" + +lemma bilinear_ladd: "bilinear h \ h (x + y) z = h x z + h y z" by (simp add: bilinear_def linear_def) -lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)" +lemma bilinear_radd: "bilinear h \ h x (y + z) = h x y + h x z" by (simp add: bilinear_def linear_def) -lemma bilinear_lmul: "bilinear h ==> h (c *\<^sub>R x) y = c *\<^sub>R (h x y)" +lemma bilinear_lmul: "bilinear h \ h (c *\<^sub>R x) y = c *\<^sub>R h x y" by (simp add: bilinear_def linear_def) -lemma bilinear_rmul: "bilinear h ==> h x (c *\<^sub>R y) = c *\<^sub>R (h x y)" +lemma bilinear_rmul: "bilinear h \ h x (c *\<^sub>R y) = c *\<^sub>R h x y" by (simp add: bilinear_def linear_def) -lemma bilinear_lneg: "bilinear h ==> h (- x) y = -(h x y)" +lemma bilinear_lneg: "bilinear h \ h (- x) y = - h x y" by (simp only: scaleR_minus1_left [symmetric] bilinear_lmul) -lemma bilinear_rneg: "bilinear h ==> h x (- y) = - h x y" +lemma bilinear_rneg: "bilinear h \ h x (- y) = - h x y" by (simp only: scaleR_minus1_left [symmetric] bilinear_rmul) -lemma (in ab_group_add) eq_add_iff: "x = x + y \ y = 0" +lemma (in ab_group_add) eq_add_iff: "x = x + y \ y = 0" using add_imp_eq[of x y 0] by auto -lemma bilinear_lzero: assumes "bilinear h" shows "h 0 x = 0" +lemma bilinear_lzero: + assumes "bilinear h" + shows "h 0 x = 0" using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps) -lemma bilinear_rzero: assumes "bilinear h" shows "h x 0 = 0" +lemma bilinear_rzero: + assumes "bilinear h" + shows "h x 0 = 0" using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps) -lemma bilinear_lsub: "bilinear h ==> h (x - y) z = h x z - h y z" +lemma bilinear_lsub: "bilinear h \ h (x - y) z = h x z - h y z" by (simp add: diff_minus bilinear_ladd bilinear_lneg) -lemma bilinear_rsub: "bilinear h ==> h z (x - y) = h z x - h z y" +lemma bilinear_rsub: "bilinear h \ h z (x - y) = h z x - h z y" by (simp add: diff_minus bilinear_radd bilinear_rneg) lemma bilinear_setsum: @@ -367,7 +398,8 @@ proof - have "h (setsum f S) (setsum g T) = setsum (\x. h (f x) (setsum g T)) S" apply (rule linear_setsum[unfolded o_def]) - using bh fS apply (auto simp add: bilinear_def) + using bh fS + apply (auto simp add: bilinear_def) done also have "\ = setsum (\x. setsum (\y. h (f x) (g y)) T) S" apply (rule setsum_cong, simp) @@ -375,7 +407,8 @@ using bh fT apply (auto simp add: bilinear_def) done - finally show ?thesis unfolding setsum_cartesian_product . + finally show ?thesis + unfolding setsum_cartesian_product . qed @@ -388,13 +421,19 @@ shows "adjoint f = g" unfolding adjoint_def proof (rule some_equality) - show "\x y. inner (f x) y = inner x (g y)" using assms . + show "\x y. inner (f x) y = inner x (g y)" + by (rule assms) next - fix h assume "\x y. inner (f x) y = inner x (h y)" - then have "\x y. inner x (g y) = inner x (h y)" using assms by simp - then have "\x y. inner x (g y - h y) = 0" by (simp add: inner_diff_right) - then have "\y. inner (g y - h y) (g y - h y) = 0" by simp - then have "\y. h y = g y" by simp + fix h + assume "\x y. inner (f x) y = inner x (h y)" + then have "\x y. inner x (g y) = inner x (h y)" + using assms by simp + then have "\x y. inner x (g y - h y) = 0" + by (simp add: inner_diff_right) + then have "\y. inner (g y - h y) (g y - h y) = 0" + by simp + then have "\y. h y = g y" + by simp then show "h = g" by (simp add: ext) qed @@ -418,7 +457,7 @@ 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) + by (simp add: inner_setsum_left inner_setsum_right mult_commute) qed then show ?thesis unfolding adjoint_def choice_iff @@ -445,18 +484,22 @@ 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" +lemma seq_mono_lemma: + assumes "\(n::nat) \ m. (d n :: real) < e n" + and "\n \ m. e n \ e m" shows "\n \ m. d n < e m" - using assms apply auto + using assms + apply auto apply (erule_tac x="n" in allE) apply (erule_tac x="n" in allE) apply auto done - -lemma infinite_enumerate: assumes fS: "infinite S" +lemma infinite_enumerate: + assumes fS: "infinite S" shows "\r. subseq r \ (\n. r n \ S)" unfolding subseq_def using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto @@ -467,53 +510,57 @@ apply auto done - lemma triangle_lemma: - assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x\<^sup>2 <= y\<^sup>2 + z\<^sup>2" - shows "x <= y + z" + fixes x y z :: real + assumes x: "0 \ x" + and y: "0 \ y" + and z: "0 \ z" + and xy: "x\<^sup>2 \ y\<^sup>2 + z\<^sup>2" + shows "x \ y + z" proof - - have "y\<^sup>2 + z\<^sup>2 \ y\<^sup>2 + 2*y*z + z\<^sup>2" using z y by (simp add: mult_nonneg_nonneg) - with xy have th: "x\<^sup>2 \ (y+z)\<^sup>2" by (simp add: power2_eq_square field_simps) - from y z have yz: "y + z \ 0" by arith + have "y\<^sup>2 + z\<^sup>2 \ y\<^sup>2 + 2 *y * z + z\<^sup>2" + using z y by (simp add: mult_nonneg_nonneg) + with xy have th: "x\<^sup>2 \ (y + z)\<^sup>2" + by (simp add: power2_eq_square field_simps) + from y z have yz: "y + z \ 0" + by arith from power2_le_imp_le[OF th yz] show ?thesis . qed subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *} -definition hull :: "('a set \ bool) \ 'a set \ 'a set" (infixl "hull" 75) - where "S hull s = Inter {t. S t \ s \ t}" +definition hull :: "('a set \ bool) \ 'a set \ 'a set" (infixl "hull" 75) + where "S hull s = \{t. S t \ s \ t}" lemma hull_same: "S s \ S hull s = s" unfolding hull_def by auto -lemma hull_in: "(\T. Ball T S ==> S (Inter T)) ==> S (S hull s)" +lemma hull_in: "(\T. Ball T S \ S (\T)) \ S (S hull s)" unfolding hull_def Ball_def by auto -lemma hull_eq: "(\T. Ball T S ==> S (Inter T)) ==> (S hull s) = s \ S s" +lemma hull_eq: "(\T. Ball T S \ S (\T)) \ (S hull s) = s \ S s" using hull_same[of S s] hull_in[of S s] by metis - lemma hull_hull: "S hull (S hull s) = S hull s" unfolding hull_def by blast lemma hull_subset[intro]: "s \ (S hull s)" unfolding hull_def by blast -lemma hull_mono: " s \ t ==> (S hull s) \ (S hull t)" +lemma hull_mono: "s \ t \ (S hull s) \ (S hull t)" unfolding hull_def by blast -lemma hull_antimono: "\x. S x \ T x ==> (T hull s) \ (S hull s)" +lemma hull_antimono: "\x. S x \ T x \ (T hull s) \ (S hull s)" unfolding hull_def by blast -lemma hull_minimal: "s \ t \ S t ==> (S hull s) \ t" +lemma hull_minimal: "s \ t \ S t \ (S hull s) \ t" unfolding hull_def by blast -lemma subset_hull: "S t ==> S hull s \ t \ s \ t" +lemma subset_hull: "S t \ S hull s \ t \ s \ t" unfolding hull_def by blast -lemma hull_unique: "s \ t \ S t \ - (\t'. s \ t' \ S t' \ t \ t') \ (S hull s = t)" +lemma hull_unique: "s \ t \ S t \ (\t'. s \ t' \ S t' \ t \ t') \ (S hull s = t)" unfolding hull_def by auto lemma hull_induct: "(\x. x\ S \ P x) \ Q {x. P x} \ \x\ Q hull S. P x" @@ -527,7 +574,7 @@ unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2) lemma hull_union: - assumes T: "\T. Ball T S ==> S (Inter T)" + assumes T: "\T. Ball T S \ S (\T)" shows "S hull (s \ t) = S hull (S hull s \ S hull t)" apply rule apply (rule hull_mono) @@ -541,13 +588,13 @@ lemma hull_redundant_eq: "a \ (S hull s) \ (S hull (insert a s) = S hull s)" unfolding hull_def by blast -lemma hull_redundant: "a \ (S hull s) ==> (S hull (insert a s) = S hull s)" +lemma hull_redundant: "a \ (S hull s) \ (S hull (insert a s) = S hull s)" by (metis hull_redundant_eq) subsection {* Archimedean properties and useful consequences *} -lemma real_arch_simple: "\n. x <= real (n::nat)" +lemma real_arch_simple: "\n. x \ real (n::nat)" unfolding real_of_nat_def by (rule ex_le_of_nat) lemma real_arch_inv: "0 < e \ (\n::nat. n \ 0 \ 0 < inverse (real n) \ inverse (real n) < e)" @@ -558,60 +605,77 @@ apply simp done -lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n" +lemma real_pow_lbound: "0 \ x \ 1 + real n * x \ (1 + x) ^ n" proof (induct n) case 0 then show ?case by simp next case (Suc n) - then have h: "1 + real n * x \ (1 + x) ^ n" by simp - from h have p: "1 \ (1 + x) ^ n" using Suc.prems by simp - from h have "1 + real n * x + x \ (1 + x) ^ n + x" by simp - also have "\ \ (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric]) + then have h: "1 + real n * x \ (1 + x) ^ n" + by simp + from h have p: "1 \ (1 + x) ^ n" + using Suc.prems by simp + from h have "1 + real n * x + x \ (1 + x) ^ n + x" + by simp + also have "\ \ (1 + x) ^ Suc n" + apply (subst diff_le_0_iff_le[symmetric]) apply (simp add: field_simps) - using mult_left_mono[OF p Suc.prems] apply simp + using mult_left_mono[OF p Suc.prems] + apply simp done - finally show ?case by (simp add: real_of_nat_Suc field_simps) + finally show ?case + by (simp add: real_of_nat_Suc field_simps) qed -lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\n. y < x^n" +lemma real_arch_pow: + fixes x :: real + assumes x: "1 < x" + shows "\n. y < x^n" proof - - from x have x0: "x - 1 > 0" by arith + from x have x0: "x - 1 > 0" + by arith from reals_Archimedean3[OF x0, rule_format, of y] - obtain n::nat where n:"y < real n * (x - 1)" by metis + obtain n :: nat where n: "y < real n * (x - 1)" by metis from x0 have x00: "x- 1 \ 0" by arith from real_pow_lbound[OF x00, of n] n have "y < x^n" by auto then show ?thesis by metis qed -lemma real_arch_pow2: "\n. (x::real) < 2^ n" +lemma real_arch_pow2: + fixes x :: real + shows "\n. x < 2^ n" using real_arch_pow[of 2 x] by simp lemma real_arch_pow_inv: - assumes y: "(y::real) > 0" and x1: "x < 1" + fixes x y :: real + assumes y: "y > 0" + and x1: "x < 1" shows "\n. x^n < y" -proof - - { assume x0: "x > 0" - from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps) - from real_arch_pow[OF ix, of "1/y"] - obtain n where n: "1/y < (1/x)^n" by blast - then have ?thesis using y x0 - by (auto simp add: field_simps power_divide) } - moreover - { assume "\ x > 0" - with y x1 have ?thesis apply auto by (rule exI[where x=1], auto) } - ultimately show ?thesis by metis +proof (cases "x > 0") + case True + with x1 have ix: "1 < 1/x" by (simp add: field_simps) + from real_arch_pow[OF ix, of "1/y"] + obtain n where n: "1/y < (1/x)^n" by blast + then show ?thesis using y `x > 0` + by (auto simp add: field_simps power_divide) +next + case False + with y x1 show ?thesis + apply auto + apply (rule exI[where x=1]) + apply auto + done qed lemma forall_pos_mono: - "(\d e::real. d < e \ P d ==> P e) \ - (\n::nat. n \ 0 ==> P(inverse(real n))) \ (\e. 0 < e ==> P e)" + "(\d e::real. d < e \ P d \ P e) \ + (\n::nat. n \ 0 \ P (inverse (real n))) \ (\e. 0 < e \ P e)" by (metis real_arch_inv) lemma forall_pos_mono_1: - "(\d e::real. d < e \ P d ==> P e) \ - (\n. P(inverse(real (Suc n)))) ==> 0 < e ==> P e" + "(\d e::real. d < e \ P d \ P e) \ + (\n. P(inverse(real (Suc n)))) \ 0 < e \ P e" apply (rule forall_pos_mono) apply auto apply (atomize) @@ -620,15 +684,20 @@ done lemma real_archimedian_rdiv_eq_0: - assumes x0: "x \ 0" and c: "c \ 0" and xc: "\(m::nat)>0. real m * x \ c" + assumes x0: "x \ 0" + and c: "c \ 0" + and xc: "\(m::nat)>0. real m * x \ c" shows "x = 0" -proof - - { assume "x \ 0" with x0 have xp: "x > 0" by arith - from reals_Archimedean3[OF xp, rule_format, of c] - obtain n::nat where n: "c < real n * x" by blast - with xc[rule_format, of n] have "n = 0" by arith - with n c have False by simp } - then show ?thesis by blast +proof (rule ccontr) + assume "x \ 0" + with x0 have xp: "x > 0" by arith + from reals_Archimedean3[OF xp, rule_format, of c] + obtain n :: nat where n: "c < real n * x" + by blast + with xc[rule_format, of n] have "n = 0" + by arith + with n c show False + by simp qed @@ -639,15 +708,17 @@ definition (in real_vector) "span S = (subspace hull S)" definition (in real_vector) "dependent S \ (\a \ S. a \ span(S - {a}))" -abbreviation (in real_vector) "independent s == ~(dependent s)" +abbreviation (in real_vector) "independent s \ \ dependent s" text {* Closure properties of subspaces. *} -lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def) - -lemma (in real_vector) subspace_0: "subspace S ==> 0 \ S" by (metis subspace_def) - -lemma (in real_vector) subspace_add: "subspace S \ x \ S \ y \ S ==> x + y \ S" +lemma subspace_UNIV[simp]: "subspace UNIV" + by (simp add: subspace_def) + +lemma (in real_vector) subspace_0: "subspace S \ 0 \ S" + by (metis subspace_def) + +lemma (in real_vector) subspace_add: "subspace S \ x \ S \ y \ S \ x + y \ S" by (metis subspace_def) lemma (in real_vector) subspace_mul: "subspace S \ x \ S \ c *\<^sub>R x \ S" @@ -660,7 +731,8 @@ by (metis diff_minus subspace_add subspace_neg) lemma (in real_vector) subspace_setsum: - assumes sA: "subspace A" and fB: "finite B" + assumes sA: "subspace A" + and fB: "finite B" and f: "\x\ B. f x \ A" shows "setsum f B \ A" using fB f sA @@ -668,36 +740,39 @@ (simp add: subspace_def sA, auto simp add: sA subspace_add) lemma subspace_linear_image: - assumes lf: "linear f" and sS: "subspace S" - shows "subspace(f ` S)" + assumes lf: "linear f" + and sS: "subspace S" + shows "subspace (f ` S)" using lf sS linear_0[OF lf] unfolding linear_def subspace_def apply (auto simp add: image_iff) - apply (rule_tac x="x + y" in bexI, auto) - apply (rule_tac x="c *\<^sub>R x" in bexI, auto) + apply (rule_tac x="x + y" in bexI) + apply auto + apply (rule_tac x="c *\<^sub>R x" in bexI) + apply auto done lemma subspace_linear_vimage: "linear f \ subspace S \ subspace (f -` S)" by (auto simp add: subspace_def linear_def linear_0[of f]) -lemma subspace_linear_preimage: "linear f ==> subspace S ==> subspace {x. f x \ S}" +lemma subspace_linear_preimage: "linear f \ subspace S \ subspace {x. f x \ S}" by (auto simp add: subspace_def linear_def linear_0[of f]) lemma subspace_trivial: "subspace {0}" by (simp add: subspace_def) -lemma (in real_vector) subspace_inter: "subspace A \ subspace B ==> subspace (A \ B)" +lemma (in real_vector) subspace_inter: "subspace A \ subspace B \ subspace (A \ B)" by (simp add: subspace_def) -lemma subspace_Times: "\subspace A; subspace B\ \ subspace (A \ B)" +lemma subspace_Times: "subspace A \ subspace B \ subspace (A \ B)" unfolding subspace_def zero_prod_def by simp text {* Properties of span. *} -lemma (in real_vector) span_mono: "A \ B ==> span A \ span B" +lemma (in real_vector) span_mono: "A \ B \ span A \ span B" by (metis span_def hull_mono) -lemma (in real_vector) subspace_span: "subspace(span S)" +lemma (in real_vector) subspace_span: "subspace (span S)" unfolding span_def apply (rule hull_in) apply (simp only: subspace_def Inter_iff Int_iff subset_eq) @@ -705,12 +780,11 @@ done lemma (in real_vector) span_clauses: - "a \ S ==> a \ span S" + "a \ S \ a \ span S" "0 \ span S" - "x\ span S \ y \ span S ==> x + y \ span S" + "x\ span S \ y \ span S \ x + y \ span S" "x \ span S \ c *\<^sub>R x \ span S" - by (metis span_def hull_subset subset_eq) - (metis subspace_span subspace_def)+ + by (metis span_def hull_subset subset_eq) (metis subspace_span subspace_def)+ lemma span_unique: "S \ T \ subspace T \ (\T'. S \ T' \ subspace T' \ T \ T') \ span S = T" @@ -722,12 +796,14 @@ lemma (in real_vector) span_induct: assumes x: "x \ span S" and P: "subspace P" - and SP: "\x. x \ S ==> x \ P" + and SP: "\x. x \ S \ x \ P" shows "x \ P" proof - - from SP have SP': "S \ P" by (simp add: subset_eq) + from SP have SP': "S \ P" + by (simp add: subset_eq) from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]] - show "x \ P" by (metis subset_eq) + show "x \ P" + by (metis subset_eq) qed lemma span_empty[simp]: "span {} = {0}" @@ -742,7 +818,7 @@ lemma dependent_single[simp]: "dependent {x} \ x = 0" unfolding dependent_def by auto -lemma (in real_vector) independent_mono: "independent A \ B \ A ==> independent B" +lemma (in real_vector) independent_mono: "independent A \ B \ A \ independent B" apply (clarsimp simp add: dependent_def span_mono) apply (subgoal_tac "span (B - {a}) \ span (A - {a})") apply force @@ -760,34 +836,46 @@ using span_induct SP P by blast inductive_set (in real_vector) span_induct_alt_help for S:: "'a set" - where +where span_induct_alt_help_0: "0 \ span_induct_alt_help S" | span_induct_alt_help_S: - "x \ S \ z \ span_induct_alt_help S \ (c *\<^sub>R x + z) \ span_induct_alt_help S" + "x \ S \ z \ span_induct_alt_help S \ + (c *\<^sub>R x + z) \ span_induct_alt_help S" lemma span_induct_alt': - assumes h0: "h 0" and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" + assumes h0: "h 0" + and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" shows "\x \ span S. h x" proof - - { fix x:: "'a" assume x: "x \ span_induct_alt_help S" + { + fix x :: 'a + assume x: "x \ span_induct_alt_help S" have "h x" apply (rule span_induct_alt_help.induct[OF x]) apply (rule h0) - apply (rule hS, assumption, assumption) - done } + apply (rule hS) + apply assumption + apply assumption + done + } note th0 = this - { fix x assume x: "x \ span S" + { + fix x + assume x: "x \ span S" have "x \ span_induct_alt_help S" proof (rule span_induct[where x=x and S=S]) - show "x \ span S" using x . + show "x \ span S" by (rule x) next - fix x assume xS : "x \ S" - from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1] - show "x \ span_induct_alt_help S" by simp + fix x + assume xS: "x \ S" + from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1] + show "x \ span_induct_alt_help S" + by simp next have "0 \ span_induct_alt_help S" by (rule span_induct_alt_help_0) moreover - { fix x y + { + fix x y assume h: "x \ span_induct_alt_help S" "y \ span_induct_alt_help S" from h have "(x + y) \ span_induct_alt_help S" apply (induct rule: span_induct_alt_help.induct) @@ -796,9 +884,11 @@ apply (rule span_induct_alt_help_S) apply assumption apply simp - done } + done + } moreover - { fix c x + { + fix c x assume xt: "x \ span_induct_alt_help S" then have "(c *\<^sub>R x) \ span_induct_alt_help S" apply (induct rule: span_induct_alt_help.induct) @@ -808,15 +898,17 @@ apply assumption apply simp done } - ultimately - show "subspace (span_induct_alt_help S)" + ultimately show "subspace (span_induct_alt_help S)" unfolding subspace_def Ball_def by blast - qed } + qed + } with th0 show ?thesis by blast qed lemma span_induct_alt: - assumes h0: "h 0" and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" and x: "x \ span S" + assumes h0: "h 0" + and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" + and x: "x \ span S" shows "h x" using span_induct_alt'[of h S] h0 hS x by blast @@ -825,35 +917,43 @@ lemma span_span: "span (span A) = span A" unfolding span_def hull_hull .. -lemma (in real_vector) span_superset: "x \ S ==> x \ span S" by (metis span_clauses(1)) - -lemma (in real_vector) span_0: "0 \ span S" by (metis subspace_span subspace_0) +lemma (in real_vector) span_superset: "x \ S \ x \ span S" + by (metis span_clauses(1)) + +lemma (in real_vector) span_0: "0 \ span S" + by (metis subspace_span subspace_0) lemma span_inc: "S \ span S" by (metis subset_eq span_superset) -lemma (in real_vector) dependent_0: assumes "0\A" shows "dependent A" - unfolding dependent_def apply(rule_tac x=0 in bexI) - using assms span_0 by auto - -lemma (in real_vector) span_add: "x \ span S \ y \ span S ==> x + y \ span S" +lemma (in real_vector) dependent_0: + assumes "0 \ A" + shows "dependent A" + unfolding dependent_def + apply (rule_tac x=0 in bexI) + using assms span_0 + apply auto + done + +lemma (in real_vector) span_add: "x \ span S \ y \ span S \ x + y \ span S" by (metis subspace_add subspace_span) -lemma (in real_vector) span_mul: "x \ span S ==> (c *\<^sub>R x) \ span S" +lemma (in real_vector) span_mul: "x \ span S \ c *\<^sub>R x \ span S" by (metis subspace_span subspace_mul) -lemma span_neg: "x \ span S ==> - x \ span S" +lemma span_neg: "x \ span S \ - x \ span S" by (metis subspace_neg subspace_span) -lemma span_sub: "x \ span S \ y \ span S ==> x - y \ span S" +lemma span_sub: "x \ span S \ y \ span S \ x - y \ span S" by (metis subspace_span subspace_sub) -lemma (in real_vector) span_setsum: "finite A \ \x \ A. f x \ span S ==> setsum f A \ span S" +lemma (in real_vector) span_setsum: "finite A \ \x \ A. f x \ span S \ setsum f A \ span S" by (rule subspace_setsum, rule subspace_span) lemma span_add_eq: "x \ span S \ x + y \ span S \ y \ span S" apply (auto simp only: span_add span_sub) - apply (subgoal_tac "(x + y) - x \ span S", simp) + apply (subgoal_tac "(x + y) - x \ span S") + apply simp apply (simp only: span_add span_sub) done @@ -871,7 +971,8 @@ show "subspace (f ` span S)" using lf subspace_span by (rule subspace_linear_image) next - fix T assume "f ` S \ T" and "subspace T" + fix T + assume "f ` S \ T" and "subspace T" then show "f ` span S \ T" unfolding image_subset_iff_subset_vimage by (intro span_minimal subspace_linear_vimage lf) @@ -904,7 +1005,10 @@ show "subspace (range (\k. k *\<^sub>R x))" unfolding subspace_def by (auto intro: scaleR_add_left [symmetric]) - fix T assume "{x} \ T" and "subspace T" then show "range (\k. k *\<^sub>R x) \ T" +next + fix T + assume "{x} \ T" and "subspace T" + then show "range (\k. k *\<^sub>R x) \ T" unfolding subspace_def by auto qed @@ -922,12 +1026,13 @@ qed lemma span_breakdown: - assumes bS: "b \ S" and aS: "a \ span S" + assumes bS: "b \ S" + and aS: "a \ span S" shows "\k. a - k *\<^sub>R b \ span (S - {b})" using assms span_insert [of b "S - {b}"] by (simp add: insert_absorb) -lemma span_breakdown_eq: "x \ span (insert a S) \ (\k. (x - k *\<^sub>R a) \ span S)" +lemma span_breakdown_eq: "x \ span (insert a S) \ (\k. x - k *\<^sub>R a \ span S)" by (simp add: span_insert) text {* Hence some "reversal" results. *} @@ -939,7 +1044,9 @@ proof - from span_breakdown[of b "insert b S" a, OF insertI1 a] obtain k where k: "a - k*\<^sub>R b \ span (S - {b})" by auto - { assume k0: "k = 0" + show ?thesis + proof (cases "k = 0") + case True with k have "a \ span S" apply (simp) apply (rule set_rev_mp) @@ -947,19 +1054,17 @@ apply (rule span_mono) apply blast done - with na have ?thesis by blast } - moreover - { assume k0: "k \ 0" + with na show ?thesis by blast + next + case False have eq: "b = (1/k) *\<^sub>R a - ((1/k) *\<^sub>R a - b)" by simp - from k0 have eq': "(1/k) *\<^sub>R (a - k*\<^sub>R b) = (1/k) *\<^sub>R a - b" + from False have eq': "(1/k) *\<^sub>R (a - k*\<^sub>R b) = (1/k) *\<^sub>R a - b" by (simp add: algebra_simps) from k have "(1/k) *\<^sub>R (a - k*\<^sub>R b) \ span (S - {b})" by (rule span_mul) then have th: "(1/k) *\<^sub>R a - b \ span (S - {b})" unfolding eq' . - - from k - have ?thesis + from k show ?thesis apply (subst eq) apply (rule span_sub) apply (rule span_mul) @@ -968,8 +1073,10 @@ apply (rule set_rev_mp) apply (rule th) apply (rule span_mono) - using na by blast } - ultimately show ?thesis by blast + using na + apply blast + done + qed qed lemma in_span_delete: @@ -990,7 +1097,8 @@ unfolding span_def by (rule hull_redundant) lemma span_trans: - assumes x: "x \ span S" and y: "y \ span (insert x S)" + assumes x: "x \ span S" + and y: "y \ span (insert x S)" shows "y \ span S" using assms by (simp only: span_redundant) @@ -1003,7 +1111,9 @@ "span P = {y. \S u. finite S \ S \ P \ setsum (\v. u v *\<^sub>R v) S = y}" (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \S u. ?Q S u y}") proof - - { fix x assume x: "x \ ?E" + { + fix x + assume x: "x \ ?E" then obtain S u where fS: "finite S" and SP: "S\P" and u: "setsum (\v. u v *\<^sub>R v) S = x" by blast have "x \ span P" @@ -1011,7 +1121,8 @@ apply (rule span_setsum[OF fS]) using span_mono[OF SP] apply (auto intro: span_superset span_mul) - done } + done + } moreover have "\x \ span P. x \ ?E" proof (rule span_induct_alt') @@ -1022,15 +1133,20 @@ done next fix c x y - assume x: "x \ P" and hy: "y \ Collect ?h" + assume x: "x \ P" + assume hy: "y \ Collect ?h" from hy obtain S u where fS: "finite S" and SP: "S\P" and u: "setsum (\v. u v *\<^sub>R v) S = y" by blast let ?S = "insert x S" let ?u = "\y. if y = x then (if x \ S then u y + c else c) else u y" - from fS SP x have th0: "finite (insert x S)" "insert x S \ P" by blast+ - { assume xS: "x \ S" + from fS SP x have th0: "finite (insert x S)" "insert x S \ P" + by blast+ + have "?Q ?S ?u (c*\<^sub>R x + y)" + proof cases + assume xS: "x \ S" have S1: "S = (S - {x}) \ {x}" - and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \ {x} = {}" using xS fS by auto + and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \ {x} = {}" + using xS fS by auto have "setsum (\v. ?u v *\<^sub>R v) ?S =(\v\S - {x}. u v *\<^sub>R v) + (u x + c) *\<^sub>R x" using xS by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]] @@ -1042,17 +1158,18 @@ also have "\ = c*\<^sub>R x + y" by (simp add: add_commute u) finally have "setsum (\v. ?u v *\<^sub>R v) ?S = c*\<^sub>R x + y" . - then have "?Q ?S ?u (c*\<^sub>R x + y)" using th0 by blast } - moreover - { assume xS: "x \ S" + then show ?thesis using th0 by blast + next + assume xS: "x \ S" have th00: "(\v\S. (if v = x then c else u v) *\<^sub>R v) = y" unfolding u[symmetric] apply (rule setsum_cong2) - using xS apply auto + using xS + apply auto done - have "?Q ?S ?u (c*\<^sub>R x + y)" using fS xS th0 - by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong) } - ultimately have "?Q ?S ?u (c*\<^sub>R x + y)" by (cases "x \ S") simp_all + show ?thesis using fS xS th0 + by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong) + qed then show "(c*\<^sub>R x + y) \ Collect ?h" unfolding mem_Collect_eq apply - @@ -1068,15 +1185,18 @@ "dependent P \ (\S u. finite S \ S \ P \ (\v\S. u v \ 0 \ setsum (\v. u v *\<^sub>R v) S = 0))" (is "?lhs = ?rhs") proof - - { assume dP: "dependent P" + { + assume dP: "dependent P" then obtain a S u where aP: "a \ P" and fS: "finite S" and SP: "S \ P - {a}" and ua: "setsum (\v. u v *\<^sub>R v) S = a" unfolding dependent_def span_explicit by blast let ?S = "insert a S" let ?u = "\y. if y = a then - 1 else u y" let ?v = a - from aP SP have aS: "a \ S" by blast - from fS SP aP have th0: "finite ?S" "?S \ P" "?v \ ?S" "?u ?v \ 0" by auto + from aP SP have aS: "a \ S" + by blast + from fS SP aP have th0: "finite ?S" "?S \ P" "?v \ ?S" "?u ?v \ 0" + by auto have s0: "setsum (\v. ?u v *\<^sub>R v) ?S = 0" using fS aS apply (simp add: setsum_clauses field_simps) @@ -1092,18 +1212,24 @@ done } moreover - { fix S u v + { + fix S u v assume fS: "finite S" - and SP: "S \ P" and vS: "v \ S" and uv: "u v \ 0" + and SP: "S \ P" + and vS: "v \ S" + and uv: "u v \ 0" and u: "setsum (\v. u v *\<^sub>R v) S = 0" let ?a = v let ?S = "S - {v}" let ?u = "\i. (- u i) / u v" - have th0: "?a \ P" "finite ?S" "?S \ P" using fS SP vS by auto - have "setsum (\v. ?u v *\<^sub>R v) ?S = setsum (\v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v" + have th0: "?a \ P" "finite ?S" "?S \ P" + using fS SP vS by auto + have "setsum (\v. ?u v *\<^sub>R v) ?S = + setsum (\v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v" using fS vS uv by (simp add: setsum_diff1 divide_inverse field_simps) - also have "\ = ?a" unfolding scaleR_right.setsum [symmetric] u using uv by simp - finally have "setsum (\v. ?u v *\<^sub>R v) ?S = ?a" . + also have "\ = ?a" + unfolding scaleR_right.setsum [symmetric] u using uv by simp + finally have "setsum (\v. ?u v *\<^sub>R v) ?S = ?a" . with th0 have ?lhs unfolding dependent_def span_explicit apply - @@ -1122,61 +1248,72 @@ shows "span S = {y. \u. setsum (\v. u v *\<^sub>R v) S = y}" (is "_ = ?rhs") proof - - { fix y + { + fix y assume y: "y \ span S" - from y obtain S' u where fS': "finite S'" and SS': "S' \ S" and - u: "setsum (\v. u v *\<^sub>R v) S' = y" unfolding span_explicit by blast + from y obtain S' u where fS': "finite S'" + and SS': "S' \ S" + and u: "setsum (\v. u v *\<^sub>R v) S' = y" + unfolding span_explicit by blast let ?u = "\x. if x \ S' then u x else 0" have "setsum (\v. ?u v *\<^sub>R v) S = setsum (\v. u v *\<^sub>R v) S'" using SS' fS by (auto intro!: setsum_mono_zero_cong_right) then have "setsum (\v. ?u v *\<^sub>R v) S = y" by (metis u) - then have "y \ ?rhs" by auto } + then have "y \ ?rhs" by auto + } moreover - { fix y u + { + fix y u assume u: "setsum (\v. u v *\<^sub>R v) S = y" - then have "y \ span S" using fS unfolding span_explicit by auto } + then have "y \ span S" using fS unfolding span_explicit by auto + } ultimately show ?thesis by blast qed text {* This is useful for building a basis step-by-step. *} lemma independent_insert: - "independent(insert a S) \ - (if a \ S then independent S - else independent S \ a \ span S)" (is "?lhs \ ?rhs") -proof - - { assume aS: "a \ S" - then have ?thesis using insert_absorb[OF aS] by simp } - moreover - { assume aS: "a \ S" - { assume i: ?lhs - then have ?rhs using aS - apply simp - apply (rule conjI) - apply (rule independent_mono) - apply assumption - apply blast - apply (simp add: dependent_def) - done } - moreover - { assume i: ?rhs - have ?lhs using i aS - apply simp - apply (auto simp add: dependent_def) - apply (case_tac "aa = a", auto) - apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})") - apply simp - apply (subgoal_tac "a \ span (insert aa (S - {aa}))") - apply (subgoal_tac "insert aa (S - {aa}) = S") - apply simp - apply blast - apply (rule in_span_insert) - apply assumption - apply blast - apply blast - done } - ultimately have ?thesis by blast } - ultimately show ?thesis by blast + "independent (insert a S) \ + (if a \ S then independent S else independent S \ a \ span S)" + (is "?lhs \ ?rhs") +proof (cases "a \ S") + case True + then show ?thesis + using insert_absorb[OF True] by simp +next + case False + show ?thesis + proof + assume i: ?lhs + then show ?rhs + using False + apply simp + apply (rule conjI) + apply (rule independent_mono) + apply assumption + apply blast + apply (simp add: dependent_def) + done + next + assume i: ?rhs + show ?lhs + using i False + apply simp + apply (auto simp add: dependent_def) + apply (case_tac "aa = a") + apply auto + apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})") + apply simp + apply (subgoal_tac "a \ span (insert aa (S - {aa}))") + apply (subgoal_tac "insert aa (S - {aa}) = S") + apply simp + apply blast + apply (rule in_span_insert) + apply assumption + apply blast + apply blast + done + qed qed text {* The degenerate case of the Exchange Lemma. *} @@ -1195,18 +1332,29 @@ from span_mono[OF BA] span_mono[OF AsB] have sAB: "span A = span B" unfolding span_span by blast - { fix x assume x: "x \ A" + { + fix x + assume x: "x \ A" from iA have th0: "x \ span (A - {x})" unfolding dependent_def using x by blast - from x have xsA: "x \ span A" by (blast intro: span_superset) + from x have xsA: "x \ span A" + by (blast intro: span_superset) have "A - {x} \ A" by blast - then have th1:"span (A - {x}) \ span A" by (metis span_mono) - { assume xB: "x \ B" - from xB BA have "B \ A -{x}" by blast - then have "span B \ span (A - {x})" by (metis span_mono) - with th1 th0 sAB have "x \ span A" by blast - with x have False by (metis span_superset) } - then have "x \ B" by blast } + then have th1: "span (A - {x}) \ span A" + by (metis span_mono) + { + assume xB: "x \ B" + from xB BA have "B \ A - {x}" + by blast + then have "span B \ span (A - {x})" + by (metis span_mono) + with th1 th0 sAB have "x \ span A" + by blast + with x have False + by (metis span_superset) + } + then have "x \ B" by blast + } then show "A \ B" by blast qed @@ -1216,75 +1364,110 @@ assumes f:"finite t" and i: "independent s" and sp: "s \ span t" - shows "\t'. (card t' = card t) \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" + shows "\t'. card t' = card t \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" using f i sp proof (induct "card (t - s)" arbitrary: s t rule: less_induct) case less note ft = `finite t` and s = `independent s` and sp = `s \ span t` - let ?P = "\t'. (card t' = card t) \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" + let ?P = "\t'. card t' = card t \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" let ?ths = "\t'. ?P t'" - { assume st: "s \ t" - from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t]) + { + assume st: "s \ t" + from st ft span_mono[OF st] + have ?ths + apply - + apply (rule exI[where x=t]) apply (auto intro: span_superset) - done } + done + } moreover - { assume st: "t \ s" - from spanning_subset_independent[OF st s sp] - st ft span_mono[OF st] have ?ths - apply - - apply (rule exI[where x=t]) - apply (auto intro: span_superset) - done } + { + assume st: "t \ s" + from spanning_subset_independent[OF st s sp] st ft span_mono[OF st] + have ?ths + apply - + apply (rule exI[where x=t]) + apply (auto intro: span_superset) + done + } moreover - { assume st: "\ s \ t" "\ t \ s" - from st(2) obtain b where b: "b \ t" "b \ s" by blast - from b have "t - {b} - s \ t - s" by blast - then have cardlt: "card (t - {b} - s) < card (t - s)" using ft - by (auto intro: psubset_card_mono) - from b ft have ct0: "card t \ 0" by auto - { assume stb: "s \ span(t -{b})" - from ft have ftb: "finite (t -{b})" by auto + { + assume st: "\ s \ t" "\ t \ s" + from st(2) obtain b where b: "b \ t" "b \ s" + by blast + from b have "t - {b} - s \ t - s" + by blast + then have cardlt: "card (t - {b} - s) < card (t - s)" + using ft by (auto intro: psubset_card_mono) + from b ft have ct0: "card t \ 0" + by auto + have ?ths + proof cases + assume stb: "s \ span(t - {b})" + from ft have ftb: "finite (t -{b})" + by auto from less(1)[OF cardlt ftb s stb] obtain u where u: "card u = card (t-{b})" "s \ u" "u \ s \ (t - {b})" "s \ span u" and fu: "finite u" by blast let ?w = "insert b u" - have th0: "s \ insert b u" using u by blast - from u(3) b have "u \ s \ t" by blast - then have th1: "insert b u \ s \ t" using u b by blast - have bu: "b \ u" using b u by blast - from u(1) ft b have "card u = (card t - 1)" by auto + have th0: "s \ insert b u" + using u by blast + from u(3) b have "u \ s \ t" + by blast + then have th1: "insert b u \ s \ t" + using u b by blast + have bu: "b \ u" + using b u by blast + from u(1) ft b have "card u = (card t - 1)" + by auto then have th2: "card (insert b u) = card t" using card_insert_disjoint[OF fu bu] ct0 by auto from u(4) have "s \ span u" . - also have "\ \ span (insert b u)" apply (rule span_mono) by blast + also have "\ \ span (insert b u)" + by (rule span_mono) blast finally have th3: "s \ span (insert b u)" . - from th0 th1 th2 th3 fu have th: "?P ?w" by blast - from th have ?ths by blast } - moreover - { assume stb: "\ s \ span(t -{b})" - from stb obtain a where a: "a \ s" "a \ span (t - {b})" by blast - have ab: "a \ b" using a b by blast - have at: "a \ t" using a ab span_superset[of a "t- {b}"] by auto + from th0 th1 th2 th3 fu have th: "?P ?w" + by blast + from th show ?thesis by blast + next + assume stb: "\ s \ span(t - {b})" + from stb obtain a where a: "a \ s" "a \ span (t - {b})" + by blast + have ab: "a \ b" + using a b by blast + have at: "a \ t" + using a ab span_superset[of a "t- {b}"] by auto have mlt: "card ((insert a (t - {b})) - s) < card (t - s)" using cardlt ft a b by auto - have ft': "finite (insert a (t - {b}))" using ft by auto - { fix x assume xs: "x \ s" - have t: "t \ (insert b (insert a (t -{b})))" using b by auto - from b(1) have "b \ span t" by (simp add: span_superset) - have bs: "b \ span (insert a (t - {b}))" apply(rule in_span_delete) - using a sp unfolding subset_eq apply auto done - from xs sp have "x \ span t" by blast - with span_mono[OF t] - have x: "x \ span (insert b (insert a (t - {b})))" .. - from span_trans[OF bs x] have "x \ span (insert a (t - {b}))" . } - then have sp': "s \ span (insert a (t - {b}))" by blast - - from less(1)[OF mlt ft' s sp'] obtain u where - u: "card u = card (insert a (t -{b}))" "finite u" "s \ u" "u \ s \ insert a (t -{b})" - "s \ span u" by blast - from u a b ft at ct0 have "?P u" by auto - then have ?ths by blast } - ultimately have ?ths by blast + have ft': "finite (insert a (t - {b}))" + using ft by auto + { + fix x + assume xs: "x \ s" + have t: "t \ insert b (insert a (t - {b}))" + using b by auto + from b(1) have "b \ span t" + by (simp add: span_superset) + have bs: "b \ span (insert a (t - {b}))" + apply (rule in_span_delete) + using a sp unfolding subset_eq + apply auto + done + from xs sp have "x \ span t" + by blast + with span_mono[OF t] have x: "x \ span (insert b (insert a (t - {b})))" .. + from span_trans[OF bs x] have "x \ span (insert a (t - {b}))" . + } + then have sp': "s \ span (insert a (t - {b}))" + by blast + from less(1)[OF mlt ft' s sp'] obtain u where u: + "card u = card (insert a (t -{b}))" + "finite u" "s \ u" "u \ s \ insert a (t -{b})" + "s \ span u" by blast + from u a b ft at ct0 have "?P u" + by auto + then show ?thesis by blast + qed } ultimately show ?ths by blast qed @@ -1292,21 +1475,24 @@ text {* This implies corresponding size bounds. *} lemma independent_span_bound: - assumes f: "finite t" and i: "independent s" and sp:"s \ span t" + assumes f: "finite t" + and i: "independent s" + and sp: "s \ span t" shows "finite s \ card s \ card t" by (metis exchange_lemma[OF f i sp] finite_subset card_mono) - lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\ (UNIV::'a::finite set)}" proof - - have eq: "{f x |x. x\ UNIV} = f ` UNIV" by auto + have eq: "{f x |x. x\ UNIV} = f ` UNIV" + by auto show ?thesis unfolding eq apply (rule finite_imageI) apply (rule finite) done qed -subsection{* Euclidean Spaces as Typeclass*} + +subsection {* Euclidean Spaces as Typeclass *} lemma independent_Basis: "independent Basis" unfolding dependent_def @@ -1345,7 +1531,8 @@ 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" + assumes fP: "finite P" + and fPs: "\Q. Q \ P \ norm (setsum f Q) \ e" shows "(\x\P. norm (f x)) \ 2 * real DIM('n) * e" proof - have "(\x\P. norm (f x)) \ (\x\P. \b\Basis. \f x \ b\)" @@ -1354,13 +1541,14 @@ by (rule setsum_commute) also have "\ \ of_nat (card (Basis :: 'n set)) * (2 * e)" proof (rule setsum_bounded) - fix i :: 'n assume i: "i \ Basis" - have "norm (\x\P. \f x \ i\) \ + 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 + 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 @@ -1369,6 +1557,7 @@ finally show ?thesis . qed + subsection {* Linearity and Bilinearity continued *} lemma linear_bounded: @@ -1377,25 +1566,32 @@ shows "\B. \x. norm (f x) \ B * norm x" proof - let ?B = "\b\Basis. norm (f b)" - { fix x:: "'a" + { + fix x :: 'a 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 + 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" + { + 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 (subst mult_commute) apply (rule mult_mono) apply (auto simp add: field_simps) - done } + done + } then have th: "\b\Basis. norm (?g b) \ norm (f b) * norm x" by metis from setsum_norm_le[of _ ?g, OF th] - have "norm (f x) \ ?B * norm x" unfolding th0 setsum_left_distrib by metis} + have "norm (f x) \ ?B * norm x" + unfolding th0 setsum_left_distrib by metis + } then show ?thesis by blast qed @@ -1408,7 +1604,8 @@ B: "\x. norm (f x) \ B * norm x" by blast let ?K = "\B\ + 1" have Kp: "?K > 0" by arith - { assume C: "B < 0" + { + assume C: "B < 0" def One \ "\Basis ::'a" then have "One \ 0" unfolding euclidean_eq_iff[where 'a='a] @@ -1419,14 +1616,18 @@ 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" + then have Bp: "B \ 0" + by (metis not_leE) + { + fix x::"'a" have "norm (f x) \ ?K * norm x" using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp apply (auto simp add: field_simps split add: abs_split) apply (erule order_trans, simp) done - } then show ?thesis using Kp by blast + } + then show ?thesis + using Kp by blast qed lemma linear_conv_bounded_linear: @@ -1436,10 +1637,12 @@ assume "linear f" show "bounded_linear f" proof - fix x y show "f (x + y) = f x + f y" + fix x y + show "f (x + y) = f x + f y" using `linear f` unfolding linear_def by simp next - fix r x show "f (scaleR r x) = scaleR r (f x)" + fix r x + show "f (scaleR r x) = scaleR r (f x)" using `linear f` unfolding linear_def by simp next have "\B. \x. norm (f x) \ B * norm x" @@ -1450,43 +1653,43 @@ next assume "bounded_linear f" then interpret f: bounded_linear f . - show "linear f" - by (simp add: f.add f.scaleR linear_def) + show "linear f" by (simp add: f.add f.scaleR linear_def) qed lemma bounded_linearI': fixes f::"'a::euclidean_space \ 'b::real_normed_vector" - assumes "\x y. f (x + y) = f x + f y" "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" + assumes "\x y. f (x + y) = f x + f y" + and "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" shows "bounded_linear f" - unfolding linear_conv_bounded_linear[THEN sym] + unfolding linear_conv_bounded_linear[symmetric] by (rule linearI[OF assms]) - lemma bilinear_bounded: 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 (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]) + fix x :: 'm + fix 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))" + 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) - 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 Basis_le_norm) - apply (rule mult_mono) - apply (auto simp add: zero_le_mult_iff Basis_le_norm) - done + apply (auto simp add: setsum_left_distrib th setsum_cartesian_product) + apply (rule setsum_norm_le) + 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 Basis_le_norm) + apply (rule mult_mono) + apply (auto simp add: zero_le_mult_iff Basis_le_norm) + done qed lemma bilinear_bounded_pos: @@ -1499,15 +1702,17 @@ let ?K = "\B\ + 1" have Kp: "?K > 0" by arith have KB: "B < ?K" by arith - { fix x::'a and y::'b - from KB Kp - have "B * norm x * norm y \ ?K * norm x * norm y" + { + fix x :: 'a + fix y :: 'b + from KB Kp have "B * norm x * norm y \ ?K * norm x * norm y" apply - apply (rule mult_right_mono, rule mult_right_mono) apply auto done then have "norm (h x y) \ ?K * norm x * norm y" - using B[rule_format, of x y] by simp } + using B[rule_format, of x y] by simp + } with Kp show ?thesis by blast qed @@ -1518,17 +1723,21 @@ assume "bilinear h" show "bounded_bilinear h" proof - fix x y z show "h (x + y) z = h x z + h y z" + fix x y z + show "h (x + y) z = h x z + h y z" using `bilinear h` unfolding bilinear_def linear_def by simp next - fix x y z show "h x (y + z) = h x y + h x z" + fix x y z + show "h x (y + z) = h x y + h x z" using `bilinear h` unfolding bilinear_def linear_def by simp next - fix r x y show "h (scaleR r x) y = scaleR r (h x y)" + fix r x y + show "h (scaleR r x) y = scaleR r (h x y)" using `bilinear h` unfolding bilinear_def linear_def by simp next - fix r x y show "h x (scaleR r y) = scaleR r (h x y)" + fix r x y + show "h x (scaleR r y) = scaleR r (h x y)" using `bilinear h` unfolding bilinear_def linear_def by simp next @@ -1554,13 +1763,14 @@ 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" + "(finite (S::('a::euclidean_space) set) \ card S > DIM('a)) \ dependent S" by (metis independent_bound not_less) text {* Hence we can create a maximal independent subset. *} lemma maximal_independent_subset_extend: - assumes sv: "(S::('a::euclidean_space) set) \ V" + fixes S :: "'a::euclidean_space set" + assumes sv: "S \ V" and iS: "independent S" shows "\B. S \ B \ B \ V \ independent B \ V \ span B" using sv iS @@ -1570,15 +1780,22 @@ let ?P = "\B. S \ B \ B \ V \ independent B \ V \ span B" let ?ths = "\x. ?P x" let ?d = "DIM('a)" - { assume "V \ span S" - then have ?ths using sv i by blast } - moreover - { assume VS: "\ V \ span S" - from VS obtain a where a: "a \ V" "a \ span S" by blast - from a have aS: "a \ S" by (auto simp add: span_superset) - have th0: "insert a S \ V" using a sv by blast + show ?ths + proof (cases "V \ span S") + case True + then show ?thesis + using sv i by blast + next + case False + then obtain a where a: "a \ V" "a \ span S" + by blast + from a have aS: "a \ S" + by (auto simp add: span_superset) + have th0: "insert a S \ V" + using a sv by blast from independent_insert[of a S] i a - have th1: "independent (insert a S)" by auto + have th1: "independent (insert a S)" + by auto have mlt: "?d - card (insert a S) < ?d - card S" using aS a independent_bound[OF th1] by auto @@ -1586,8 +1803,8 @@ obtain B where B: "insert a S \ B" "B \ V" "independent B" " V \ span B" by blast from B have "?P B" by auto - then have ?ths by blast } - ultimately show ?ths by blast + then show ?thesis by blast + qed qed lemma maximal_independent_subset: @@ -1598,7 +1815,7 @@ text {* Notion of dimension. *} -definition "dim V = (SOME n. \B. B \ V \ independent B \ V \ span B \ (card B = n))" +definition "dim V = (SOME n. \B. B \ V \ independent B \ V \ span B \ card B = n)" lemma basis_exists: "\B. (B :: ('a::euclidean_space) set) \ V \ independent B \ V \ span B \ (card B = dim V)" @@ -1608,58 +1825,76 @@ text {* Consequences of independence or spanning for cardinality. *} -lemma independent_card_le_dim: - assumes "(B::('a::euclidean_space) set) \ V" and "independent B" +lemma independent_card_le_dim: + fixes B :: "'a::euclidean_space set" + assumes "B \ V" + and "independent B" shows "card B \ dim V" proof - from basis_exists[of V] `B \ V` - obtain B' where "independent B'" and "B \ span B'" and "card B' = dim V" by blast + obtain B' where "independent B'" + and "B \ span B'" + and "card B' = dim V" + by blast with independent_span_bound[OF _ `independent B` `B \ span B'`] independent_bound[of B'] show ?thesis by auto qed lemma span_card_ge_dim: - "(B::('a::euclidean_space) set) \ V \ V \ span B \ finite B \ dim V \ card B" + fixes B :: "'a::euclidean_space set" + shows "B \ V \ V \ span B \ finite B \ dim V \ card B" by (metis basis_exists[of V] independent_span_bound subset_trans) lemma basis_card_eq_dim: - "B \ (V:: ('a::euclidean_space) set) \ V \ span B \ - independent B \ finite B \ card B = dim V" + fixes V :: "'a::euclidean_space set" + shows "B \ V \ V \ span B \ independent B \ finite B \ card B = dim V" by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound) -lemma dim_unique: "(B::('a::euclidean_space) set) \ V \ V \ span B \ - independent B \ card B = n \ dim V = n" +lemma dim_unique: + fixes B :: "'a::euclidean_space set" + shows "B \ V \ V \ span B \ independent B \ card B = n \ dim V = n" by (metis basis_card_eq_dim) text {* More lemmas about dimension. *} -lemma dim_UNIV: "dim (UNIV :: ('a::euclidean_space) set) = DIM('a)" +lemma dim_UNIV: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)" using independent_Basis by (intro dim_unique[of Basis]) auto lemma dim_subset: - "(S:: ('a::euclidean_space) set) \ T \ dim S \ dim T" + fixes S :: "'a::euclidean_space set" + shows "S \ T \ dim S \ dim T" using basis_exists[of T] basis_exists[of S] by (metis independent_card_le_dim subset_trans) -lemma dim_subset_UNIV: "dim (S:: ('a::euclidean_space) set) \ DIM('a)" +lemma dim_subset_UNIV: + fixes S :: "'a::euclidean_space set" + shows "dim S \ DIM('a)" by (metis dim_subset subset_UNIV dim_UNIV) text {* Converses to those. *} lemma card_ge_dim_independent: - assumes BV:"(B::('a::euclidean_space) set) \ V" - and iB:"independent B" and dVB:"dim V \ card B" + fixes B :: "'a::euclidean_space set" + assumes BV: "B \ V" + and iB: "independent B" + and dVB: "dim V \ card B" shows "V \ span B" -proof - - { fix a assume aV: "a \ V" - { assume aB: "a \ span B" - then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert) - from aV BV have th0: "insert a B \ V" by blast - from aB have "a \B" by (auto simp add: span_superset) - with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB] have False by auto } - then have "a \ span B" by blast } - then show ?thesis by blast +proof + fix a + assume aV: "a \ V" + { + assume aB: "a \ span B" + then have iaB: "independent (insert a B)" + using iB aV BV by (simp add: independent_insert) + from aV BV have th0: "insert a B \ V" + by blast + from aB have "a \B" + by (auto simp add: span_superset) + with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB] + have False by auto + } + then show "a \ span B" by blast qed lemma card_le_dim_spanning: @@ -1669,54 +1904,81 @@ and dVB: "dim V \ card B" shows "independent B" proof - - { fix a assume a: "a \ B" "a \ span (B -{a})" - from a fB have c0: "card B \ 0" by auto - from a fB have cb: "card (B -{a}) = card B - 1" by auto - from BV a have th0: "B -{a} \ V" by blast - { fix x assume x: "x \ V" - from a have eq: "insert a (B -{a}) = B" by blast - from x VB have x': "x \ span B" by blast + { + fix a + assume a: "a \ B" "a \ span (B -{a})" + from a fB have c0: "card B \ 0" + by auto + from a fB have cb: "card (B -{a}) = card B - 1" + by auto + from BV a have th0: "B -{a} \ V" + by blast + { + fix x + assume x: "x \ V" + from a have eq: "insert a (B -{a}) = B" + by blast + from x VB have x': "x \ span B" + by blast from span_trans[OF a(2), unfolded eq, OF x'] - have "x \ span (B -{a})" . } - then have th1: "V \ span (B -{a})" by blast - have th2: "finite (B -{a})" using fB by auto + have "x \ span (B -{a})" . + } + then have th1: "V \ span (B -{a})" + by blast + have th2: "finite (B -{a})" + using fB by auto from span_card_ge_dim[OF th0 th1 th2] have c: "dim V \ card (B -{a})" . - from c c0 dVB cb have False by simp } - then show ?thesis unfolding dependent_def by blast + from c c0 dVB cb have False by simp + } + then show ?thesis + unfolding dependent_def by blast qed -lemma card_eq_dim: "(B:: ('a::euclidean_space) set) \ V \ - card B = dim V \ finite B \ independent B \ V \ span B" +lemma card_eq_dim: + fixes B :: "'a::euclidean_space set" + shows "B \ V \ card B = dim V \ finite B \ independent B \ V \ span B" by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent) text {* More general size bound lemmas. *} lemma independent_bound_general: - "independent (S:: ('a::euclidean_space) set) \ finite S \ card S \ dim S" + fixes S :: "'a::euclidean_space set" + shows "independent S \ finite S \ card S \ dim S" by (metis independent_card_le_dim independent_bound subset_refl) lemma dependent_biggerset_general: - "(finite (S:: ('a::euclidean_space) set) \ card S > dim S) \ dependent S" + fixes S :: "'a::euclidean_space set" + shows "(finite S \ card S > dim S) \ dependent S" using independent_bound_general[of S] by (metis linorder_not_le) -lemma dim_span: "dim (span (S:: ('a::euclidean_space) set)) = dim S" +lemma dim_span: + fixes S :: "'a::euclidean_space set" + shows "dim (span S) = dim S" proof - have th0: "dim S \ dim (span S)" by (auto simp add: subset_eq intro: dim_subset span_superset) from basis_exists[of S] - obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" by blast - from B have fB: "finite B" "card B = dim S" using independent_bound by blast+ - have bSS: "B \ span S" using B(1) by (metis subset_eq span_inc) - have sssB: "span S \ span B" using span_mono[OF B(3)] by (simp add: span_span) + obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" + by blast + from B have fB: "finite B" "card B = dim S" + using independent_bound by blast+ + have bSS: "B \ span S" + using B(1) by (metis subset_eq span_inc) + have sssB: "span S \ span B" + using span_mono[OF B(3)] by (simp add: span_span) from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis using fB(2) by arith qed -lemma subset_le_dim: "(S:: ('a::euclidean_space) set) \ span T \ dim S \ dim T" +lemma subset_le_dim: + fixes S :: "'a::euclidean_space set" + shows "S \ span T \ dim S \ dim T" by (metis dim_span dim_subset) -lemma span_eq_dim: "span (S:: ('a::euclidean_space) set) = span T ==> dim S = dim T" +lemma span_eq_dim: + fixes S:: "'a::euclidean_space set" + shows "span S = span T \ dim S = dim T" by (metis dim_span) lemma spans_image: @@ -1732,12 +1994,15 @@ proof - from basis_exists[of S] obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" by blast - from B have fB: "finite B" "card B = dim S" using independent_bound by blast+ + from B have fB: "finite B" "card B = dim S" + using independent_bound by blast+ have "dim (f ` S) \ card (f ` B)" apply (rule span_card_ge_dim) - using lf B fB apply (auto simp add: span_linear_image spans_image subset_image_iff) + using lf B fB + apply (auto simp add: span_linear_image spans_image subset_image_iff) done - also have "\ \ dim S" using card_image_le[OF fB(1)] fB by simp + also have "\ \ dim S" + using card_image_le[OF fB(1)] fB by simp finally show ?thesis . qed @@ -1745,12 +2010,15 @@ lemma spanning_surjective_image: assumes us: "UNIV \ span S" - and lf: "linear f" and sf: "surj f" + and lf: "linear f" + and sf: "surj f" shows "UNIV \ span (f ` S)" proof - - have "UNIV \ f ` UNIV" using sf by (auto simp add: surj_def) - also have " \ \ span (f ` S)" using spans_image[OF lf us] . -finally show ?thesis . + have "UNIV \ f ` UNIV" + using sf by (auto simp add: surj_def) + also have " \ \ span (f ` S)" + using spans_image[OF lf us] . + finally show ?thesis . qed lemma independent_injective_image: @@ -1759,23 +2027,30 @@ and fi: "inj f" shows "independent (f ` S)" proof - - { fix a + { + fix a assume a: "a \ S" "f a \ span (f ` S - {f a})" - have eq: "f ` S - {f a} = f ` (S - {a})" using fi - by (auto simp add: inj_on_def) + have eq: "f ` S - {f a} = f ` (S - {a})" + using fi by (auto simp add: inj_on_def) from a have "f a \ f ` span (S -{a})" - unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast - then have "a \ span (S -{a})" using fi by (auto simp add: inj_on_def) - with a(1) iS have False by (simp add: dependent_def) } - then show ?thesis unfolding dependent_def by blast + unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast + then have "a \ span (S -{a})" + using fi by (auto simp add: inj_on_def) + with a(1) iS have False + by (simp add: dependent_def) + } + then show ?thesis + unfolding dependent_def by blast qed text {* Picking an orthogonal replacement for a spanning set. *} - (* FIXME : Move to some general theory ?*) +(* FIXME : Move to some general theory ?*) definition "pairwise R S \ (\x \ S. \y\ S. x\y \ R x y)" -lemma vector_sub_project_orthogonal: "(b::'a::euclidean_space) \ (x - ((b \ x) / (b \ b)) *\<^sub>R b) = 0" +lemma vector_sub_project_orthogonal: + fixes b x :: "'a::euclidean_space" + shows "b \ (x - ((b \ x) / (b \ b)) *\<^sub>R b) = 0" unfolding inner_simps by auto lemma pairwise_orthogonal_insert: @@ -1786,14 +2061,17 @@ by (auto simp add: orthogonal_commute) lemma basis_orthogonal: - fixes B :: "('a::real_inner) set" + fixes B :: "'a::real_inner set" assumes fB: "finite B" shows "\C. finite C \ card C \ card B \ span C = span B \ pairwise orthogonal C" (is " \C. ?P B C") using fB proof (induct rule: finite_induct) case empty - then show ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def) + then show ?case + apply (rule exI[where x="{}"]) + apply (auto simp add: pairwise_def) + done next case (insert a B) note fB = `finite B` and aB = `a \ B` @@ -1802,10 +2080,12 @@ "span C = span B" "pairwise orthogonal C" by blast let ?a = "a - setsum (\x. (x \ a / (x \ x)) *\<^sub>R x) C" let ?C = "insert ?a C" - from C(1) have fC: "finite ?C" by simp + from C(1) have fC: "finite ?C" + by simp from fB aB C(1,2) have cC: "card ?C \ card (insert a B)" by (simp add: card_insert_if) - { fix x k + { + fix x k have th0: "\(a::'a) b c. a - (b - c) = c + (a - b)" by (simp add: field_simps) have "x - k *\<^sub>R (a - (\x\C. (x \ a / (x \ x)) *\<^sub>R x)) \ span C \ x - k *\<^sub>R a \ span C" @@ -1817,12 +2097,17 @@ apply (rule span_mul) apply (rule span_superset) apply assumption - done } + done + } then have SC: "span ?C = span (insert a B)" unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto - { fix y assume yC: "y \ C" - then have Cy: "C = insert y (C - {y})" by blast - have fth: "finite (C - {y})" using C by simp + { + fix y + assume yC: "y \ C" + then have Cy: "C = insert y (C - {y})" + by blast + have fth: "finite (C - {y})" + using C by simp have "orthogonal ?a y" unfolding orthogonal_def unfolding inner_diff inner_setsum_left diff_eq_0_iff_eq @@ -1831,10 +2116,12 @@ apply (rule setsum_0') apply clarsimp apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format]) - using `y \ C` by auto } + using `y \ C` by auto + } with `pairwise orthogonal C` have CPO: "pairwise orthogonal ?C" by (rule pairwise_orthogonal_insert) - from fC cC SC CPO have "?P (insert a B) ?C" by blast + from fC cC SC CPO have "?P (insert a B) ?C" + by blast then show ?case by blast qed @@ -1843,19 +2130,29 @@ shows "\B. independent B \ B \ span V \ V \ span B \ (card B = dim V) \ pairwise orthogonal B" proof - from basis_exists[of V] obtain B where - B: "B \ V" "independent B" "V \ span B" "card B = dim V" by blast - from B have fB: "finite B" "card B = dim V" using independent_bound by auto + B: "B \ V" "independent B" "V \ span B" "card B = dim V" + by blast + from B have fB: "finite B" "card B = dim V" + using independent_bound by auto from basis_orthogonal[OF fB(1)] obtain C where - C: "finite C" "card C \ card B" "span C = span B" "pairwise orthogonal C" by blast - from C B have CSV: "C \ span V" by (metis span_inc span_mono subset_trans) - from span_mono[OF B(3)] C have SVC: "span V \ span C" by (simp add: span_span) + C: "finite C" "card C \ card B" "span C = span B" "pairwise orthogonal C" + by blast + from C B have CSV: "C \ span V" + by (metis span_inc span_mono subset_trans) + from span_mono[OF B(3)] C have SVC: "span V \ span C" + by (simp add: span_span) from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB - have iC: "independent C" by (simp add: dim_span) - from C fB have "card C \ dim V" by simp - moreover have "dim V \ card C" using span_card_ge_dim[OF CSV SVC C(1)] + have iC: "independent C" by (simp add: dim_span) - ultimately have CdV: "card C = dim V" using C(1) by simp - from C B CSV CdV iC show ?thesis by auto + from C fB have "card C \ dim V" + by simp + moreover have "dim V \ card C" + using span_card_ge_dim[OF CSV SVC C(1)] + by (simp add: dim_span) + ultimately have CdV: "card C = dim V" + using C(1) by simp + from C B CSV CdV iC show ?thesis + by auto qed lemma span_eq: "span S = span T \ S \ span T \ T \ span S" @@ -1865,17 +2162,20 @@ text {* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *} lemma span_not_univ_orthogonal: - fixes S::"('a::euclidean_space) set" + fixes S :: "'a::euclidean_space set" assumes sU: "span S \ UNIV" shows "\(a::'a). a \0 \ (\x \ span S. a \ x = 0)" proof - - from sU obtain a where a: "a \ span S" by blast + from sU obtain a where a: "a \ span S" + by blast from orthogonal_basis_exists obtain B where B: "independent B" "B \ span S" "S \ span B" "card B = dim S" "pairwise orthogonal B" by blast - from B have fB: "finite B" "card B = dim S" using independent_bound by auto + from B have fB: "finite B" "card B = dim S" + using independent_bound by auto from span_mono[OF B(2)] span_mono[OF B(3)] - have sSB: "span S = span B" by (simp add: span_span) + have sSB: "span S = span B" + by (simp add: span_span) let ?a = "a - setsum (\b. (a \ b / (b \ b)) *\<^sub>R b) B" have "setsum (\b. (a \ b / (b \ b)) *\<^sub>R b) B \ span S" unfolding sSB @@ -1885,17 +2185,23 @@ apply (rule span_superset) apply assumption done - with a have a0:"?a \ 0" by auto + with a have a0:"?a \ 0" + by auto have "\x\span B. ?a \ x = 0" proof (rule span_induct') show "subspace {x. ?a \ x = 0}" by (auto simp add: subspace_def inner_add) next - { fix x assume x: "x \ B" - from x have B': "B = insert x (B - {x})" by blast - have fth: "finite (B - {x})" using fB by simp + { + fix x + assume x: "x \ B" + from x have B': "B = insert x (B - {x})" + by blast + have fth: "finite (B - {x})" + using fB by simp have "?a \ x = 0" - apply (subst B') using fB fth + apply (subst B') + using fB fth unfolding setsum_clauses(2)[OF fth] apply simp unfolding inner_simps apply (clarsimp simp add: inner_add inner_setsum_left) @@ -1903,27 +2209,36 @@ unfolding inner_commute apply (auto simp add: x field_simps intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format]) - done } - then show "\x \ B. ?a \ x = 0" by blast + done + } + then show "\x \ B. ?a \ x = 0" + by blast qed - with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"]) + with a0 show ?thesis + unfolding sSB by (auto intro: exI[where x="?a"]) qed lemma span_not_univ_subset_hyperplane: - assumes SU: "span S \ (UNIV ::('a::euclidean_space) set)" + fixes S :: "'a::euclidean_space set" + assumes SU: "span S \ UNIV" shows "\ a. a \0 \ span S \ {x. a \ x = 0}" using span_not_univ_orthogonal[OF SU] by auto lemma lowdim_subset_hyperplane: - fixes S::"('a::euclidean_space) set" + fixes S :: "'a::euclidean_space set" assumes d: "dim S < DIM('a)" shows "\(a::'a). a \ 0 \ span S \ {x. a \ x = 0}" proof - - { assume "span S = UNIV" - then have "dim (span S) = dim (UNIV :: ('a) set)" by simp - then have "dim S = DIM('a)" by (simp add: dim_span dim_UNIV) - with d have False by arith } - then have th: "span S \ UNIV" by blast + { + assume "span S = UNIV" + then have "dim (span S) = dim (UNIV :: ('a) set)" + by simp + then have "dim S = DIM('a)" + by (simp add: dim_span dim_UNIV) + with d have False by arith + } + then have th: "span S \ UNIV" + by blast from span_not_univ_subset_hyperplane[OF th] show ?thesis . qed @@ -1945,7 +2260,9 @@ case (2 a b x) have fb: "finite b" using "2.prems" by simp have th0: "f ` b \ f ` (insert a b)" - apply (rule image_mono) by blast + apply (rule image_mono) + apply blast + done from independent_mono[ OF "2.prems"(2) th0] have ifb: "independent (f ` b)" . have fib: "inj_on f b" @@ -1953,23 +2270,27 @@ apply blast done from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)] - obtain k where k: "x - k*\<^sub>R a \ span (b -{a})" by blast + obtain k where k: "x - k*\<^sub>R a \ span (b - {a})" + by blast have "f (x - k*\<^sub>R a) \ span (f ` b)" unfolding span_linear_image[OF lf] apply (rule imageI) - using k span_mono[of "b-{a}" b] apply blast + using k span_mono[of "b-{a}" b] + apply blast done then have "f x - k*\<^sub>R f a \ span (f ` b)" by (simp add: linear_sub[OF lf] linear_cmul[OF lf]) then have th: "-k *\<^sub>R f a \ span (f ` b)" using "2.prems"(5) by simp - { assume k0: "k = 0" - from k0 k have "x \ span (b -{a})" by simp - then have "x \ span b" using span_mono[of "b-{a}" b] - by blast } - moreover - { assume k0: "k \ 0" - from span_mul[OF th, of "- 1/ k"] k0 + have xsb: "x \ span b" + proof (cases "k = 0") + case True + with k have "x \ span (b -{a})" by simp + then show ?thesis using span_mono[of "b-{a}" b] + by blast + next + case False + with span_mul[OF th, of "- 1/ k"] have th1: "f a \ span (f ` b)" by auto from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric] @@ -1979,20 +2300,21 @@ using "2.hyps"(2) "2.prems"(3) by auto with th1 have False by blast - then have "x \ span b" by blast } - ultimately have xsb: "x \ span b" by blast - from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] - show "x = 0" . + then show ?thesis by blast + qed + from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" . qed text {* We can extend a linear mapping from basis. *} lemma linear_independent_extend_lemma: fixes f :: "'a::real_vector \ 'b::real_vector" - assumes fi: "finite B" and ib: "independent B" - shows "\g. (\x\ span B. \y\ span B. g (x + y) = g x + g y) - \ (\x\ span B. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) - \ (\x\ B. g x = f x)" + assumes fi: "finite B" + and ib: "independent B" + shows "\g. + (\x\ span B. \y\ span B. g (x + y) = g x + g y) \ + (\x\ span B. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) \ + (\x\ B. g x = f x)" using ib fi proof (induct rule: finite_induct[OF fi]) case 1 @@ -2005,39 +2327,56 @@ g: "\x\span b. \y\span b. g (x + y) = g x + g y" "\x\span b. \c. g (c *\<^sub>R x) = c *\<^sub>R g x" "\x\b. g x = f x" by blast let ?h = "\z. SOME k. (z - k *\<^sub>R a) \ span b" - { fix z assume z: "z \ span (insert a b)" + { + fix z + assume z: "z \ span (insert a b)" have th0: "z - ?h z *\<^sub>R a \ span b" apply (rule someI_ex) unfolding span_breakdown_eq[symmetric] - using z . - { fix k assume k: "z - k *\<^sub>R a \ span b" + apply (rule z) + done + { + fix k + assume k: "z - k *\<^sub>R a \ span b" have eq: "z - ?h z *\<^sub>R a - (z - k*\<^sub>R a) = (k - ?h z) *\<^sub>R a" by (simp add: field_simps scaleR_left_distrib [symmetric]) - from span_sub[OF th0 k] - have khz: "(k - ?h z) *\<^sub>R a \ span b" by (simp add: eq) - { assume "k \ ?h z" then have k0: "k - ?h z \ 0" by simp + from span_sub[OF th0 k] have khz: "(k - ?h z) *\<^sub>R a \ span b" + by (simp add: eq) + { + assume "k \ ?h z" + then have k0: "k - ?h z \ 0" by simp from k0 span_mul[OF khz, of "1 /(k - ?h z)"] have "a \ span b" by simp with "2.prems"(1) "2.hyps"(2) have False - by (auto simp add: dependent_def)} - then have "k = ?h z" by blast} - with th0 have "z - ?h z *\<^sub>R a \ span b \ (\k. z - k *\<^sub>R a \ span b \ k = ?h z)" by blast} + by (auto simp add: dependent_def) + } + then have "k = ?h z" by blast + } + with th0 have "z - ?h z *\<^sub>R a \ span b \ (\k. z - k *\<^sub>R a \ span b \ k = ?h z)" + by blast + } note h = this let ?g = "\z. ?h z *\<^sub>R f a + g (z - ?h z *\<^sub>R a)" - { fix x y assume x: "x \ span (insert a b)" and y: "y \ span (insert a b)" + { + fix x y + assume x: "x \ span (insert a b)" + and y: "y \ span (insert a b)" have tha: "\(x::'a) y a k l. (x + y) - (k + l) *\<^sub>R a = (x - k *\<^sub>R a) + (y - l *\<^sub>R a)" by (simp add: algebra_simps) have addh: "?h (x + y) = ?h x + ?h y" apply (rule conjunct2[OF h, rule_format, symmetric]) apply (rule span_add[OF x y]) unfolding tha - by (metis span_add x y conjunct1[OF h, rule_format]) + apply (metis span_add x y conjunct1[OF h, rule_format]) + done have "?g (x + y) = ?g x + ?g y" unfolding addh tha g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]] by (simp add: scaleR_left_distrib)} moreover - { fix x:: "'a" and c:: real + { + fix x :: "'a" + fix c :: real assume x: "x \ span (insert a b)" have tha: "\(x::'a) c k a. c *\<^sub>R x - (c * k) *\<^sub>R a = c *\<^sub>R (x - k *\<^sub>R a)" by (simp add: algebra_simps) @@ -2048,24 +2387,29 @@ done have "?g (c *\<^sub>R x) = c*\<^sub>R ?g x" unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]] - by (simp add: algebra_simps) } + by (simp add: algebra_simps) + } moreover - { fix x assume x: "x \ (insert a b)" - { assume xa: "x = a" + { + fix x + assume x: "x \ insert a b" + { + assume xa: "x = a" have ha1: "1 = ?h a" apply (rule conjunct2[OF h, rule_format]) apply (metis span_superset insertI1) using conjunct1[OF h, OF span_superset, OF insertI1] apply (auto simp add: span_0) done - from xa ha1[symmetric] have "?g x = f x" apply simp using g(2)[rule_format, OF span_0, of 0] apply simp - done } + done + } moreover - { assume xb: "x \ b" + { + assume xb: "x \ b" have h0: "0 = ?h x" apply (rule conjunct2[OF h, rule_format]) apply (metis span_superset x) @@ -2073,8 +2417,11 @@ apply (metis span_superset xb) done have "?g x = f x" - by (simp add: h0[symmetric] g(3)[rule_format, OF xb]) } - ultimately have "?g x = f x" using x by blast } + by (simp add: h0[symmetric] g(3)[rule_format, OF xb]) + } + ultimately have "?g x = f x" + using x by blast + } ultimately show ?case apply - apply (rule exI[where x="?g"]) @@ -2083,17 +2430,22 @@ qed lemma linear_independent_extend: - assumes iB: "independent (B:: ('a::euclidean_space) set)" + fixes B :: "'a::euclidean_space set" + assumes iB: "independent B" shows "\g. linear g \ (\x\B. g x = f x)" proof - from maximal_independent_subset_extend[of B UNIV] iB - obtain C where C: "B \ C" "independent C" "\x. x \ span C" by auto + obtain C where C: "B \ C" "independent C" "\x. x \ span C" + by auto from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f] - obtain g where g: "(\x\ span C. \y\ span C. g (x + y) = g x + g y) - \ (\x\ span C. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) - \ (\x\ C. g x = f x)" by blast - from g show ?thesis unfolding linear_def using C + obtain g where g: + "(\x\ span C. \y\ span C. g (x + y) = g x + g y) \ + (\x\ span C. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) \ + (\x\ C. g x = f x)" by blast + from g show ?thesis + unfolding linear_def + using C apply clarsimp apply blast done @@ -2118,10 +2470,12 @@ then show ?case by simp next case (2 y t) - from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \ card t" by simp - from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where - f: "f ` s \ t \ inj_on f s" by blast - from f "2.prems"(2) "2.hyps"(2) show ?case + from "2.prems"(1,2,5) "2.hyps"(1,2) have cst: "card s \ card t" + by simp + from "2.prems"(3) [OF "2.hyps"(1) cst] + obtain f where "f ` s \ t" "inj_on f s" + by blast + with "2.prems"(2) "2.hyps"(2) show ?case apply - apply (rule exI[where x = "\z. if z = x then y else f z"]) apply (auto simp add: inj_on_def) @@ -2135,54 +2489,74 @@ and c: "card A = card B" shows "A = B" proof - - from fB AB have fA: "finite A" by (auto intro: finite_subset) - from fA fB have fBA: "finite (B - A)" by auto - have e: "A \ (B - A) = {}" by blast - have eq: "A \ (B - A) = B" using AB by blast - from card_Un_disjoint[OF fA fBA e, unfolded eq c] - have "card (B - A) = 0" by arith - then have "B - A = {}" unfolding card_eq_0_iff using fA fB by simp - with AB show "A = B" by blast + from fB AB have fA: "finite A" + by (auto intro: finite_subset) + from fA fB have fBA: "finite (B - A)" + by auto + have e: "A \ (B - A) = {}" + by blast + have eq: "A \ (B - A) = B" + using AB by blast + from card_Un_disjoint[OF fA fBA e, unfolded eq c] have "card (B - A) = 0" + by arith + then have "B - A = {}" + unfolding card_eq_0_iff using fA fB by simp + with AB show "A = B" + by blast qed lemma subspace_isomorphism: - assumes s: "subspace (S:: ('a::euclidean_space) set)" - and t: "subspace (T :: ('b::euclidean_space) set)" + fixes S :: "'a::euclidean_space set" + and T :: "'b::euclidean_space set" + assumes s: "subspace S" + and t: "subspace T" and d: "dim S = dim T" shows "\f. linear f \ f ` S = T \ inj_on f S" proof - - from basis_exists[of S] independent_bound obtain B where - B: "B \ S" "independent B" "S \ span B" "card B = dim S" and fB: "finite B" by blast - from basis_exists[of T] independent_bound obtain C where - C: "C \ T" "independent C" "T \ span C" "card C = dim T" and fC: "finite C" by blast - from B(4) C(4) card_le_inj[of B C] d obtain f where - f: "f ` B \ C" "inj_on f B" using `finite B` `finite C` by auto - from linear_independent_extend[OF B(2)] obtain g where - g: "linear g" "\x\ B. g x = f x" by blast - from inj_on_iff_eq_card[OF fB, of f] f(2) - have "card (f ` B) = card B" by simp - with B(4) C(4) have ceq: "card (f ` B) = card C" using d + from basis_exists[of S] independent_bound + obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" and fB: "finite B" + by blast + from basis_exists[of T] independent_bound + obtain C where C: "C \ T" "independent C" "T \ span C" "card C = dim T" and fC: "finite C" + by blast + from B(4) C(4) card_le_inj[of B C] d + obtain f where f: "f ` B \ C" "inj_on f B" using `finite B` `finite C` + by auto + from linear_independent_extend[OF B(2)] + obtain g where g: "linear g" "\x\ B. g x = f x" + by blast + from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B" by simp - have "g ` B = f ` B" using g(2) - by (auto simp add: image_iff) + with B(4) C(4) have ceq: "card (f ` B) = card C" + using d by simp + have "g ` B = f ` B" + using g(2) by (auto simp add: image_iff) also have "\ = C" using card_subset_eq[OF fC f(1) ceq] . finally have gBC: "g ` B = C" . - have gi: "inj_on g B" using f(2) g(2) - by (auto simp add: inj_on_def) + have gi: "inj_on g B" + using f(2) g(2) by (auto simp add: inj_on_def) note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi] - { fix x y assume x: "x \ S" and y: "y \ S" and gxy: "g x = g y" - from B(3) x y have x': "x \ span B" and y': "y \ span B" by blast+ - from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)]) - have th1: "x - y \ span B" using x' y' by (metis span_sub) - have "x=y" using g0[OF th1 th0] by simp } + { + fix x y + assume x: "x \ S" and y: "y \ S" and gxy: "g x = g y" + from B(3) x y have x': "x \ span B" and y': "y \ span B" + by blast+ + from gxy have th0: "g (x - y) = 0" + by (simp add: linear_sub[OF g(1)]) + have th1: "x - y \ span B" + using x' y' by (metis span_sub) + have "x = y" + using g0[OF th1 th0] by simp + } then have giS: "inj_on g S" unfolding inj_on_def by blast - from span_subspace[OF B(1,3) s] - have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)]) + from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)" + by (simp add: span_linear_image[OF g(1)]) also have "\ = span C" unfolding gBC .. also have "\ = T" using span_subspace[OF C(1,3) t] . finally have gS: "g ` S = T" . - from g(1) gS giS show ?thesis by blast + from g(1) gS giS show ?thesis + by blast qed text {* Linear functions are equal on a subspace if they are on a spanning set. *} @@ -2232,7 +2606,8 @@ lemma bilinear_eq: assumes bf: "bilinear f" and bg: "bilinear g" - and SB: "S \ span B" and TC: "T \ span C" + and SB: "S \ span B" + and TC: "T \ span C" and fg: "\x\ B. \y\ C. f x y = g x y" shows "\x\S. \y\T. f x y = g x y " proof - @@ -2252,11 +2627,12 @@ apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf]) done - then show ?thesis using SB TC by auto + then show ?thesis + using SB TC by auto qed lemma bilinear_eq_stdbasis: - fixes f::"'a::euclidean_space \ 'b::euclidean_space \ _" + fixes f :: "'a::euclidean_space \ 'b::euclidean_space \ _" assumes bf: "bilinear f" and bg: "bilinear g" and fg: "\i\Basis. \j\Basis. f i j = g i j" @@ -2266,50 +2642,53 @@ text {* Detailed theorems about left and right invertibility in general case. *} lemma linear_injective_left_inverse: - fixes f::"'a::euclidean_space => 'b::euclidean_space" + fixes f::"'a::euclidean_space \ 'b::euclidean_space" assumes lf: "linear f" and fi: "inj f" shows "\g. linear g \ g o f = id" proof - 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. h x = inv f x" by blast + obtain h:: "'b \ 'a" where 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 - from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th] have "h o f = id" . - then show ?thesis using h(1) by blast + then show ?thesis + using h(1) by blast qed lemma linear_surjective_right_inverse: - fixes f::"'a::euclidean_space => 'b::euclidean_space" - assumes lf: "linear f" and sf: "surj f" + fixes f :: "'a::euclidean_space \ 'b::euclidean_space" + 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"] - obtain h:: "'b \ 'a" where - h: "linear h" "\x\Basis. h x = inv f x" by blast - from h(2) - have th: "\i\Basis. (f o h) i = id i" + obtain h:: "'b \ 'a" where h: "linear h" "\x\Basis. h x = inv f x" + by blast + from h(2) have th: "\i\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 + then show ?thesis + using h(1) by blast qed text {* An injective map @{typ "'a::euclidean_space \ 'b::euclidean_space"} is also surjective. *} lemma linear_injective_imp_surjective: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and fi: "inj f" + fixes f::"'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and fi: "inj f" shows "surj f" proof - let ?U = "UNIV :: 'a set" from basis_exists[of ?U] obtain B where B: "B \ ?U" "independent B" "?U \ span B" "card B = dim ?U" by blast - from B(4) have d: "dim ?U = card B" by simp + from B(4) have d: "dim ?U = card B" + by simp have th: "?U \ span (f ` B)" apply (rule card_ge_dim_independent) apply blast @@ -2333,51 +2712,66 @@ and fT: "finite T" and c: "card S = card T" and ST: "f ` S \ T" - shows "(\y \ T. \x \ S. f x = y) \ inj_on f S" (is "?lhs \ ?rhs") -proof - - { assume h: "?lhs" - { fix x y - assume x: "x \ S" and y: "y \ S" and f: "f x = f y" - from x fS have S0: "card S \ 0" by auto - { assume xy: "x \ y" - have th: "card S \ card (f ` (S - {y}))" - unfolding c - apply (rule card_mono) - apply (rule finite_imageI) - using fS apply simp - using h xy x y f unfolding subset_eq image_iff - apply auto - apply (case_tac "xa = f x") - apply (rule bexI[where x=x]) - apply auto - done - also have " \ \ card (S -{y})" - apply (rule card_image_le) - using fS by simp - also have "\ \ card S - 1" using y fS by simp - finally have False using S0 by arith } - then have "x = y" by blast} - then have ?rhs unfolding inj_on_def by blast} - moreover - { assume h: ?rhs - have "f ` S = T" - apply (rule card_subset_eq[OF fT ST]) - unfolding card_image[OF h] using c . - then have ?lhs by blast} - ultimately show ?thesis by blast + shows "(\y \ T. \x \ S. f x = y) \ inj_on f S" + (is "?lhs \ ?rhs") +proof + assume h: "?lhs" + { + fix x y + assume x: "x \ S" + assume y: "y \ S" + assume f: "f x = f y" + from x fS have S0: "card S \ 0" + by auto + have "x = y" + proof (rule ccontr) + assume xy: "x \ y" + have th: "card S \ card (f ` (S - {y}))" + unfolding c + apply (rule card_mono) + apply (rule finite_imageI) + using fS apply simp + using h xy x y f unfolding subset_eq image_iff + apply auto + apply (case_tac "xa = f x") + apply (rule bexI[where x=x]) + apply auto + done + also have " \ \ card (S -{y})" + apply (rule card_image_le) + using fS by simp + also have "\ \ card S - 1" using y fS by simp + finally show False using S0 by arith + qed + } + then show ?rhs + unfolding inj_on_def by blast +next + assume h: ?rhs + have "f ` S = T" + apply (rule card_subset_eq[OF fT ST]) + unfolding card_image[OF h] + apply (rule c) + done + then show ?lhs by blast qed lemma linear_surjective_imp_injective: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and sf: "surj f" + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and sf: "surj f" shows "inj f" proof - let ?U = "UNIV :: 'a set" from basis_exists[of ?U] obtain B where B: "B \ ?U" "independent B" "?U \ span B" and d: "card B = dim ?U" by blast - { fix x assume x: "x \ span B" and fx: "f x = 0" - from B(2) have fB: "finite B" using independent_bound by auto + { + fix x + assume x: "x \ span B" + assume fx: "f x = 0" + from B(2) have fB: "finite B" + using independent_bound by auto have fBi: "independent (f ` B)" apply (rule card_le_dim_spanning[of "f ` B" ?U]) apply blast @@ -2394,81 +2788,98 @@ apply blast unfolding span_linear_image[OF lf] apply (rule subset_trans[where B = "f ` UNIV"]) - using sf unfolding surj_def apply blast + using sf unfolding surj_def + apply blast apply (rule image_mono) apply (rule B(3)) apply (metis finite_imageI fB) done - moreover have "card (f ` B) \ card B" by (rule card_image_le, rule fB) - ultimately have th1: "card B = card (f ` B)" unfolding d by arith + ultimately have th1: "card B = card (f ` B)" + unfolding d by arith have fiB: "inj_on f B" unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast from linear_indep_image_lemma[OF lf fB fBi fiB x] fx - have "x = 0" by blast} - note th = this - from th show ?thesis unfolding linear_injective_0[OF lf] - using B(3) by blast + have "x = 0" by blast + } + then show ?thesis + unfolding linear_injective_0[OF lf] + using B(3) + by blast qed text {* Hence either is enough for isomorphism. *} lemma left_right_inverse_eq: - assumes fg: "f o g = id" and gh: "g o h = id" + assumes fg: "f \ g = id" + and gh: "g \ h = id" shows "f = h" proof - - have "f = f o (g o h)" unfolding gh by simp - also have "\ = (f o g) o h" by (simp add: o_assoc) - finally show "f = h" unfolding fg by simp + have "f = f \ (g \ h)" + unfolding gh by simp + also have "\ = (f \ g) \ h" + by (simp add: o_assoc) + finally show "f = h" + unfolding fg by simp qed lemma isomorphism_expand: - "f o g = id \ g o f = id \ (\x. f(g x) = x) \ (\x. g(f x) = x)" + "f \ g = id \ g \ f = id \ (\x. f (g x) = x) \ (\x. g (f x) = x)" by (simp add: fun_eq_iff o_def id_def) lemma linear_injective_isomorphism: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and fi: "inj f" + fixes f::"'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and fi: "inj f" shows "\f'. linear f' \ (\x. f' (f x) = x) \ (\x. f (f' x) = x)" unfolding isomorphism_expand[symmetric] using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi] by (metis left_right_inverse_eq) -lemma linear_surjective_isomorphism: fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and sf: "surj f" +lemma linear_surjective_isomorphism: + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and sf: "surj f" shows "\f'. linear f' \ (\x. f' (f x) = x) \ (\x. f (f' x) = x)" unfolding isomorphism_expand[symmetric] using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]] by (metis left_right_inverse_eq) -text {* Left and right inverses are the same for @{typ "'a::euclidean_space => 'a::euclidean_space"}. *} +text {* Left and right inverses are the same for + @{typ "'a::euclidean_space \ 'a::euclidean_space"}. *} lemma linear_inverse_left: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and lf': "linear f'" - shows "f o f' = id \ f' o f = id" + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and lf': "linear f'" + shows "f \ f' = id \ f' \ f = id" proof - - { fix f f':: "'a => 'a" - assume lf: "linear f" "linear f'" and f: "f o f' = id" + { + fix f f':: "'a \ 'a" + assume lf: "linear f" "linear f'" + assume f: "f \ f' = id" from f have sf: "surj f" apply (auto simp add: o_def id_def surj_def) apply metis done from linear_surjective_isomorphism[OF lf(1) sf] lf f - have "f' o f = id" unfolding fun_eq_iff o_def id_def - by metis } - then show ?thesis using lf lf' by metis + have "f' \ f = id" + unfolding fun_eq_iff o_def id_def by metis + } + then show ?thesis + using lf lf' by metis qed text {* Moreover, a one-sided inverse is automatically linear. *} lemma left_inverse_linear: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and gf: "g o f = id" + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and gf: "g \ f = id" shows "linear g" proof - from gf have fi: "inj f" @@ -2476,8 +2887,8 @@ apply metis done from linear_injective_isomorphism[OF lf fi] - obtain h:: "'a \ 'a" where - h: "linear h" "\x. h (f x) = x" "\x. f (h x) = x" by blast + obtain h :: "'a \ 'a" where h: "linear h" "\x. h (f x) = x" "\x. f (h x) = x" + by blast have "h = g" apply (rule ext) using gf h(2,3) apply (simp add: o_def id_def fun_eq_iff) @@ -2495,22 +2906,26 @@ by auto lemma infnorm_set_image: - "{ abs ((x::'a::euclidean_space) \ i) |i. i \ Basis} = (\i. abs(x \ i)) ` Basis" + "{abs ((x::'a::euclidean_space) \ i) |i. i \ Basis} = (\i. abs(x \ i)) ` Basis" by blast lemma infnorm_Max: "infnorm (x::'a::euclidean_space) = Max ((\i. abs(x \ i)) ` Basis)" by (simp add: infnorm_def infnorm_set_image cSup_eq_Max) lemma infnorm_set_lemma: - shows "finite {abs((x::'a::euclidean_space) \ i) |i. i \ Basis}" - and "{abs(x \ i) |i. i \ Basis} \ {}" + "finite {abs((x::'a::euclidean_space) \ i) |i. i \ Basis}" + "{abs(x \ i) |i. i \ Basis} \ {}" unfolding infnorm_set_image by auto -lemma infnorm_pos_le: "0 \ infnorm (x::'a::euclidean_space)" +lemma infnorm_pos_le: + fixes x :: "'a::euclidean_space" + shows "0 \ infnorm x" by (simp add: infnorm_Max Max_ge_iff ex_in_conv) -lemma infnorm_triangle: "infnorm ((x::'a::euclidean_space) + y) \ infnorm x + infnorm y" +lemma infnorm_triangle: + fixes x :: "'a::euclidean_space" + shows "infnorm (x + y) \ infnorm x + infnorm y" proof - have *: "\a b c d :: real. \a\ \ c \ \b\ \ d \ \a + b\ \ c + d" by simp @@ -2518,7 +2933,9 @@ by (auto simp: infnorm_Max inner_add_left intro!: *) qed -lemma infnorm_eq_0: "infnorm x = 0 \ (x::_::euclidean_space) = 0" +lemma infnorm_eq_0: + fixes x :: "'a::euclidean_space" + shows "infnorm x = 0 \ x = 0" proof - have "infnorm x \ 0 \ x = 0" unfolding infnorm_Max by (simp add: euclidean_all_zero_iff) @@ -2539,41 +2956,47 @@ lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)" proof - have "y - x = - (x - y)" by simp - then show ?thesis by (metis infnorm_neg) + then show ?thesis + by (metis infnorm_neg) qed -lemma real_abs_sub_infnorm: "\ infnorm x - infnorm y\ \ infnorm (x - y)" +lemma real_abs_sub_infnorm: "\infnorm x - infnorm y\ \ infnorm (x - y)" proof - - have th: "\(nx::real) n ny. nx <= n + ny \ ny <= n + nx ==> \nx - ny\ <= n" + have th: "\(nx::real) n ny. nx \ n + ny \ ny <= n + nx \ \nx - ny\ \ n" by arith from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"] have ths: "infnorm x \ infnorm (x - y) + infnorm y" "infnorm y \ infnorm (x - y) + infnorm x" by (simp_all add: field_simps infnorm_neg) - from th[OF ths] show ?thesis . + from th[OF ths] show ?thesis . qed -lemma real_abs_infnorm: " \infnorm x\ = infnorm x" +lemma real_abs_infnorm: "\infnorm x\ = infnorm x" using infnorm_pos_le[of x] by arith lemma Basis_le_infnorm: - "b \ Basis \ \x \ b\ \ infnorm (x::'a::euclidean_space)" + fixes x :: "'a::euclidean_space" + shows "b \ Basis \ \x \ b\ \ infnorm x" by (simp add: infnorm_Max) lemma infnorm_mul: "infnorm(a *\<^sub>R x) = abs a * infnorm x" unfolding infnorm_Max proof (safe intro!: Max_eqI) let ?B = "(\i. \x \ i\) ` Basis" - show "\b :: 'a. b \ Basis \ \a *\<^sub>R x \ b\ \ \a\ * Max ?B" - by (simp add: abs_mult mult_left_mono) - - from Max_in[of ?B] obtain b where "b \ Basis" "Max ?B = \x \ b\" - by (auto simp del: Max_in) - then show "\a\ * Max ((\i. \x \ i\) ` Basis) \ (\i. \a *\<^sub>R x \ i\) ` Basis" - by (intro image_eqI[where x=b]) (auto simp: abs_mult) + { + fix b :: 'a + assume "b \ Basis" + then show "\a *\<^sub>R x \ b\ \ \a\ * Max ?B" + by (simp add: abs_mult mult_left_mono) + next + from Max_in[of ?B] obtain b where "b \ Basis" "Max ?B = \x \ b\" + by (auto simp del: Max_in) + then show "\a\ * Max ((\i. \x \ i\) ` Basis) \ (\i. \a *\<^sub>R x \ i\) ` Basis" + by (intro image_eqI[where x=b]) (auto simp: abs_mult) + } qed simp -lemma infnorm_mul_lemma: "infnorm(a *\<^sub>R x) \ \a\ * infnorm x" +lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \ \a\ * infnorm x" unfolding infnorm_mul .. lemma infnorm_pos_lt: "infnorm x > 0 \ x \ 0" @@ -2591,7 +3014,8 @@ 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 + have "real ?d \ 0" + by simp then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d" by (auto intro: real_sqrt_pow2) have th: "sqrt (real ?d) * infnorm x \ 0" @@ -2608,29 +3032,37 @@ apply (auto simp: infnorm_Max) done from real_le_lsqrt[OF inner_ge_zero th th1] - show ?thesis unfolding norm_eq_sqrt_inner id_def . + show ?thesis + unfolding norm_eq_sqrt_inner id_def . qed lemma tendsto_infnorm [tendsto_intros]: assumes "(f ---> a) F" shows "((\x. infnorm (f x)) ---> infnorm a) F" proof (rule tendsto_compose [OF LIM_I assms]) - fix r :: real assume "0 < r" + fix r :: real + assume "r > 0" then show "\s>0. \x. x \ a \ norm (x - a) < s \ norm (infnorm x - infnorm a) < r" by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm) qed text {* Equality in Cauchy-Schwarz and triangle inequalities. *} -lemma norm_cauchy_schwarz_eq: "x \ y = norm x * norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" (is "?lhs \ ?rhs") +lemma norm_cauchy_schwarz_eq: "x \ y = norm x * norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" + (is "?lhs \ ?rhs") proof - - { assume h: "x = 0" - then have ?thesis by simp } + { + assume h: "x = 0" + then have ?thesis by simp + } moreover - { assume h: "y = 0" - then have ?thesis by simp } + { + assume h: "y = 0" + then have ?thesis by simp + } moreover - { assume x: "x \ 0" and y: "y \ 0" + { + assume x: "x \ 0" and y: "y \ 0" from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"] have "?rhs \ (norm y * (norm y * norm x * norm x - norm x * (x \ y)) - @@ -2648,49 +3080,58 @@ apply simp apply metis done - finally have ?thesis by blast } + finally have ?thesis by blast + } ultimately show ?thesis by blast qed lemma norm_cauchy_schwarz_abs_eq: "abs(x \ y) = norm x * norm y \ - norm x *\<^sub>R y = norm y *\<^sub>R x \ norm(x) *\<^sub>R y = - norm y *\<^sub>R x" (is "?lhs \ ?rhs") + norm x *\<^sub>R y = norm y *\<^sub>R x \ norm(x) *\<^sub>R y = - norm y *\<^sub>R x" + (is "?lhs \ ?rhs") proof - - have th: "\(x::real) a. a \ 0 \ abs x = a \ x = a \ x = - a" by arith + have th: "\(x::real) a. a \ 0 \ abs x = a \ x = a \ x = - a" + by arith have "?rhs \ norm x *\<^sub>R y = norm y *\<^sub>R x \ norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)" by simp - also have "\ \(x \ y = norm x * norm y \ - (-x) \ y = norm x * norm y)" + also have "\ \(x \ y = norm x * norm y \ (- x) \ y = norm x * norm y)" unfolding norm_cauchy_schwarz_eq[symmetric] unfolding norm_minus_cancel norm_scaleR .. also have "\ \ ?lhs" - unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps by auto + unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps + by auto finally show ?thesis .. qed lemma norm_triangle_eq: fixes x y :: "'a::real_inner" - shows "norm(x + y) = norm x + norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" + shows "norm (x + y) = norm x + norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" proof - - { assume x: "x = 0 \ y = 0" - then have ?thesis by (cases "x = 0") simp_all } + { + assume x: "x = 0 \ y = 0" + then have ?thesis + by (cases "x = 0") simp_all + } moreover - { assume x: "x \ 0" and y: "y \ 0" + { + assume x: "x \ 0" and y: "y \ 0" then have "norm x \ 0" "norm y \ 0" by simp_all then have n: "norm x > 0" "norm y > 0" using norm_ge_zero[of x] norm_ge_zero[of y] by arith+ - have th: "\(a::real) b c. a + b + c \ 0 ==> (a = b + c \ a\<^sup>2 = (b + c)\<^sup>2)" + have th: "\(a::real) b c. a + b + c \ 0 \ a = b + c \ a\<^sup>2 = (b + c)\<^sup>2" by algebra have "norm (x + y) = norm x + norm y \ (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2" - apply (rule th) using n norm_ge_zero[of "x + y"] + apply (rule th) + using n norm_ge_zero[of "x + y"] apply arith done also have "\ \ norm x *\<^sub>R y = norm y *\<^sub>R x" unfolding norm_cauchy_schwarz_eq[symmetric] unfolding power2_norm_eq_inner inner_simps by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps) - finally have ?thesis .} + finally have ?thesis . + } ultimately show ?thesis by blast qed @@ -2700,7 +3141,8 @@ definition collinear :: "'a::real_vector set \ bool" where "collinear S \ (\u. \x \ S. \ y \ S. \c. x - y = c *\<^sub>R u)" -lemma collinear_empty: "collinear {}" by (simp add: collinear_def) +lemma collinear_empty: "collinear {}" + by (simp add: collinear_def) lemma collinear_sing: "collinear {x}" by (simp add: collinear_def) @@ -2713,14 +3155,20 @@ apply (rule exI[where x="- 1"], simp) done -lemma collinear_lemma: - "collinear {0,x,y} \ x = 0 \ y = 0 \ (\c. y = c *\<^sub>R x)" (is "?lhs \ ?rhs") +lemma collinear_lemma: "collinear {0,x,y} \ x = 0 \ y = 0 \ (\c. y = c *\<^sub>R x)" + (is "?lhs \ ?rhs") proof - - { assume "x=0 \ y = 0" - then have ?thesis by (cases "x = 0") (simp_all add: collinear_2 insert_commute) } + { + assume "x = 0 \ y = 0" + then have ?thesis + by (cases "x = 0") (simp_all add: collinear_2 insert_commute) + } moreover - { assume x: "x \ 0" and y: "y \ 0" - { assume h: "?lhs" + { + assume x: "x \ 0" and y: "y \ 0" + have ?thesis + proof + assume h: "?lhs" then obtain u where u: "\ x\ {0,x,y}. \y\ {0,x,y}. \c. x - y = c *\<^sub>R u" unfolding collinear_def by blast from u[rule_format, of x 0] u[rule_format, of y 0] @@ -2732,11 +3180,13 @@ let ?d = "cy / cx" from cx cy cx0 have "y = ?d *\<^sub>R x" by simp - then have ?rhs using x y by blast } - moreover - { assume h: "?rhs" - then obtain c where c: "y = c *\<^sub>R x" using x y by blast - have ?lhs unfolding collinear_def c + then show ?rhs using x y by blast + next + assume h: "?rhs" + then obtain c where c: "y = c *\<^sub>R x" + using x y by blast + show ?lhs + unfolding collinear_def c apply (rule exI[where x=x]) apply auto apply (rule exI[where x="- 1"], simp) @@ -2744,12 +3194,13 @@ apply (rule exI[where x=1], simp) apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib) apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib) - done } - ultimately have ?thesis by blast } + done + qed + } ultimately show ?thesis by blast qed -lemma norm_cauchy_schwarz_equal: "abs(x \ y) = norm x * norm y \ collinear {0,x,y}" +lemma norm_cauchy_schwarz_equal: "abs (x \ y) = norm x * norm y \ collinear {0, x, y}" unfolding norm_cauchy_schwarz_abs_eq apply (cases "x=0", simp_all add: collinear_2) apply (cases "y=0", simp_all add: collinear_2 insert_commute) @@ -2773,9 +3224,9 @@ unfolding scaleR_scaleR unfolding norm_scaleR apply (subgoal_tac "norm x * c = \c\ * norm x \ norm x * c = - \c\ * norm x") - apply (case_tac "c <= 0", simp add: field_simps) + apply (case_tac "c \ 0", simp add: field_simps) apply (simp add: field_simps) - apply (case_tac "c <= 0", simp add: field_simps) + apply (case_tac "c \ 0", simp add: field_simps) apply (simp add: field_simps) apply simp apply simp @@ -2801,11 +3252,12 @@ fast intro: order_trans) lemma atLeastAtMost_singleton_euclidean[simp]: - fixes a :: "'a::ordered_euclidean_space" shows "{a .. a} = {a}" + fixes a :: "'a::ordered_euclidean_space" + shows "{a .. a} = {a}" 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) + by default auto instantiation prod :: (ordered_euclidean_space, ordered_euclidean_space) ordered_euclidean_space begin