# HG changeset patch # User immler # Date 1547680442 18000 # Node ID 880ab0f27ddf62cd666a9f557274b6ab32282968 # Parent fc252acb7100312664eb3230d6de03fbb3a318d5 Reorg, in particular Determinants as well as some linear algebra from Starlike and Change_Of_Vars diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Cartesian_Space.thy --- a/src/HOL/Analysis/Cartesian_Space.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Cartesian_Space.thy Wed Jan 16 18:14:02 2019 -0500 @@ -930,4 +930,492 @@ lemma%unimportant const_vector_cart:"((\ i. d)::real^'n) = (\i\Basis. d *\<^sub>R i)" by (rule vector_cart) +subsection%unimportant \Explicit formulas for low dimensions\ + +lemma%unimportant prod_neutral_const: "prod f {(1::nat)..1} = f 1" + by simp + +lemma%unimportant prod_2: "prod f {(1::nat)..2} = f 1 * f 2" + by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute) + +lemma%unimportant prod_3: "prod f {(1::nat)..3} = f 1 * f 2 * f 3" + by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute) + + +subsection%important \Orthogonality of a matrix\ + +definition%important "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \ + transpose Q ** Q = mat 1 \ Q ** transpose Q = mat 1" + +lemma%unimportant orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n) \ transpose Q ** Q = mat 1" + by (metis matrix_left_right_inverse orthogonal_matrix_def) + +lemma%unimportant orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n)" + by (simp add: orthogonal_matrix_def) + +lemma%unimportant orthogonal_matrix_mul: + fixes A :: "real ^'n^'n" + assumes "orthogonal_matrix A" "orthogonal_matrix B" + shows "orthogonal_matrix(A ** B)" + using assms + by (simp add: orthogonal_matrix matrix_transpose_mul matrix_left_right_inverse matrix_mul_assoc) + +lemma%important orthogonal_transformation_matrix: + fixes f:: "real^'n \ real^'n" + shows "orthogonal_transformation f \ linear f \ orthogonal_matrix(matrix f)" + (is "?lhs \ ?rhs") +proof%unimportant - + let ?mf = "matrix f" + let ?ot = "orthogonal_transformation f" + let ?U = "UNIV :: 'n set" + have fU: "finite ?U" by simp + let ?m1 = "mat 1 :: real ^'n^'n" + { + assume ot: ?ot + from ot have lf: "Vector_Spaces.linear (*s) (*s) f" and fd: "\v w. f v \ f w = v \ w" + unfolding orthogonal_transformation_def orthogonal_matrix linear_def scalar_mult_eq_scaleR + by blast+ + { + fix i j + let ?A = "transpose ?mf ** ?mf" + have th0: "\b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)" + "\b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)" + by simp_all + from fd[of "axis i 1" "axis j 1", + simplified matrix_works[OF lf, symmetric] dot_matrix_vector_mul] + have "?A$i$j = ?m1 $ i $ j" + by (simp add: inner_vec_def matrix_matrix_mult_def columnvector_def rowvector_def + th0 sum.delta[OF fU] mat_def axis_def) + } + then have "orthogonal_matrix ?mf" + unfolding orthogonal_matrix + by vector + with lf have ?rhs + unfolding linear_def scalar_mult_eq_scaleR + by blast + } + moreover + { + assume lf: "Vector_Spaces.linear (*s) (*s) f" and om: "orthogonal_matrix ?mf" + from lf om have ?lhs + unfolding orthogonal_matrix_def norm_eq orthogonal_transformation + apply (simp only: matrix_works[OF lf, symmetric] dot_matrix_vector_mul) + apply (simp add: dot_matrix_product linear_def scalar_mult_eq_scaleR) + done + } + ultimately show ?thesis + by (auto simp: linear_def scalar_mult_eq_scaleR) +qed + + +subsection%important \ We can find an orthogonal matrix taking any unit vector to any other\ + +lemma%unimportant orthogonal_matrix_transpose [simp]: + "orthogonal_matrix(transpose A) \ orthogonal_matrix A" + by (auto simp: orthogonal_matrix_def) + +lemma%unimportant orthogonal_matrix_orthonormal_columns: + fixes A :: "real^'n^'n" + shows "orthogonal_matrix A \ + (\i. norm(column i A) = 1) \ + (\i j. i \ j \ orthogonal (column i A) (column j A))" + by (auto simp: orthogonal_matrix matrix_mult_transpose_dot_column vec_eq_iff mat_def norm_eq_1 orthogonal_def) + +lemma%unimportant orthogonal_matrix_orthonormal_rows: + fixes A :: "real^'n^'n" + shows "orthogonal_matrix A \ + (\i. norm(row i A) = 1) \ + (\i j. i \ j \ orthogonal (row i A) (row j A))" + using orthogonal_matrix_orthonormal_columns [of "transpose A"] by simp + +lemma%important orthogonal_matrix_exists_basis: + fixes a :: "real^'n" + assumes "norm a = 1" + obtains A where "orthogonal_matrix A" "A *v (axis k 1) = a" +proof%unimportant - + obtain S where "a \ S" "pairwise orthogonal S" and noS: "\x. x \ S \ norm x = 1" + and "independent S" "card S = CARD('n)" "span S = UNIV" + using vector_in_orthonormal_basis assms by force + then obtain f0 where "bij_betw f0 (UNIV::'n set) S" + by (metis finite_class.finite_UNIV finite_same_card_bij finiteI_independent) + then obtain f where f: "bij_betw f (UNIV::'n set) S" and a: "a = f k" + using bij_swap_iff [of k "inv f0 a" f0] + by (metis UNIV_I \a \ S\ bij_betw_inv_into_right bij_betw_swap_iff swap_apply(1)) + show thesis + proof + have [simp]: "\i. norm (f i) = 1" + using bij_betwE [OF \bij_betw f UNIV S\] by (blast intro: noS) + have [simp]: "\i j. i \ j \ orthogonal (f i) (f j)" + using \pairwise orthogonal S\ \bij_betw f UNIV S\ + by (auto simp: pairwise_def bij_betw_def inj_on_def) + show "orthogonal_matrix (\ i j. f j $ i)" + by (simp add: orthogonal_matrix_orthonormal_columns column_def) + show "(\ i j. f j $ i) *v axis k 1 = a" + by (simp add: matrix_vector_mult_def axis_def a if_distrib cong: if_cong) + qed +qed + +lemma%unimportant orthogonal_transformation_exists_1: + fixes a b :: "real^'n" + assumes "norm a = 1" "norm b = 1" + obtains f where "orthogonal_transformation f" "f a = b" +proof%unimportant - + obtain k::'n where True + by simp + obtain A B where AB: "orthogonal_matrix A" "orthogonal_matrix B" and eq: "A *v (axis k 1) = a" "B *v (axis k 1) = b" + using orthogonal_matrix_exists_basis assms by metis + let ?f = "\x. (B ** transpose A) *v x" + show thesis + proof + show "orthogonal_transformation ?f" + by (subst orthogonal_transformation_matrix) + (auto simp: AB orthogonal_matrix_mul) + next + show "?f a = b" + using \orthogonal_matrix A\ unfolding orthogonal_matrix_def + by (metis eq matrix_mul_rid matrix_vector_mul_assoc) + qed +qed + +lemma%important orthogonal_transformation_exists: + fixes a b :: "real^'n" + assumes "norm a = norm b" + obtains f where "orthogonal_transformation f" "f a = b" +proof%unimportant (cases "a = 0 \ b = 0") + case True + with assms show ?thesis + using that by force +next + case False + then obtain f where f: "orthogonal_transformation f" and eq: "f (a /\<^sub>R norm a) = (b /\<^sub>R norm b)" + by (auto intro: orthogonal_transformation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b"]) + show ?thesis + proof + interpret linear f + using f by (simp add: orthogonal_transformation_linear) + have "f a /\<^sub>R norm a = f (a /\<^sub>R norm a)" + by (simp add: scale) + also have "\ = b /\<^sub>R norm a" + by (simp add: eq assms [symmetric]) + finally show "f a = b" + using False by auto + qed (use f in auto) +qed + + +subsection%important \Linearity of scaling, and hence isometry, that preserves origin\ + +lemma%important scaling_linear: + fixes f :: "'a::real_inner \ 'a::real_inner" + assumes f0: "f 0 = 0" + and fd: "\x y. dist (f x) (f y) = c * dist x y" + shows "linear f" +proof%unimportant - + { + fix v w + have "norm (f x) = c * norm x" for x + by (metis dist_0_norm f0 fd) + then have "f v \ f w = c\<^sup>2 * (v \ w)" + unfolding dot_norm_neg dist_norm[symmetric] + by (simp add: fd power2_eq_square field_simps) + } + then show ?thesis + unfolding linear_iff vector_eq[where 'a="'a"] scalar_mult_eq_scaleR + by (simp add: inner_add field_simps) +qed + +lemma%unimportant isometry_linear: + "f (0::'a::real_inner) = (0::'a) \ \x y. dist(f x) (f y) = dist x y \ linear f" + by (rule scaling_linear[where c=1]) simp_all + +text \Hence another formulation of orthogonal transformation\ + +lemma%important orthogonal_transformation_isometry: + "orthogonal_transformation f \ f(0::'a::real_inner) = (0::'a) \ (\x y. dist(f x) (f y) = dist x y)" + unfolding orthogonal_transformation + apply (auto simp: linear_0 isometry_linear) + apply (metis (no_types, hide_lams) dist_norm linear_diff) + by (metis dist_0_norm) + + +subsection%important \Can extend an isometry from unit sphere\ + +lemma%important isometry_sphere_extend: + fixes f:: "'a::real_inner \ 'a" + assumes f1: "\x. norm x = 1 \ norm (f x) = 1" + and fd1: "\x y. \norm x = 1; norm y = 1\ \ dist (f x) (f y) = dist x y" + shows "\g. orthogonal_transformation g \ (\x. norm x = 1 \ g x = f x)" +proof%unimportant - + { + fix x y x' y' u v u' v' :: "'a" + assume H: "x = norm x *\<^sub>R u" "y = norm y *\<^sub>R v" + "x' = norm x *\<^sub>R u'" "y' = norm y *\<^sub>R v'" + and J: "norm u = 1" "norm u' = 1" "norm v = 1" "norm v' = 1" "norm(u' - v') = norm(u - v)" + then have *: "u \ v = u' \ v' + v' \ u' - v \ u " + by (simp add: norm_eq norm_eq_1 inner_add inner_diff) + have "norm (norm x *\<^sub>R u' - norm y *\<^sub>R v') = norm (norm x *\<^sub>R u - norm y *\<^sub>R v)" + using J by (simp add: norm_eq norm_eq_1 inner_diff * field_simps) + then have "norm(x' - y') = norm(x - y)" + using H by metis + } + note norm_eq = this + let ?g = "\x. if x = 0 then 0 else norm x *\<^sub>R f (x /\<^sub>R norm x)" + have thfg: "?g x = f x" if "norm x = 1" for x + using that by auto + have thd: "dist (?g x) (?g y) = dist x y" for x y + proof (cases "x=0 \ y=0") + case False + show "dist (?g x) (?g y) = dist x y" + unfolding dist_norm + proof (rule norm_eq) + show "x = norm x *\<^sub>R (x /\<^sub>R norm x)" "y = norm y *\<^sub>R (y /\<^sub>R norm y)" + "norm (f (x /\<^sub>R norm x)) = 1" "norm (f (y /\<^sub>R norm y)) = 1" + using False f1 by auto + qed (use False in \auto simp: field_simps intro: f1 fd1[unfolded dist_norm]\) + qed (auto simp: f1) + show ?thesis + unfolding orthogonal_transformation_isometry + by (rule exI[where x= ?g]) (metis thfg thd) +qed + +subsection%important\Induction on matrix row operations\ + +lemma%unimportant induct_matrix_row_operations: + fixes P :: "real^'n^'n \ bool" + assumes zero_row: "\A i. row i A = 0 \ P A" + and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" + and swap_cols: "\A m n. \P A; m \ n\ \ P(\ i j. A $ i $ Fun.swap m n id j)" + and row_op: "\A m n c. \P A; m \ n\ + \ P(\ i. if i = m then row m A + c *\<^sub>R row n A else row i A)" + shows "P A" +proof - + have "P A" if "(\i j. \j \ -K; i \ j\ \ A$i$j = 0)" for A K + proof - + have "finite K" + by simp + then show ?thesis using that + proof (induction arbitrary: A rule: finite_induct) + case empty + with diagonal show ?case + by simp + next + case (insert k K) + note insertK = insert + have "P A" if kk: "A$k$k \ 0" + and 0: "\i j. \j \ - insert k K; i \ j\ \ A$i$j = 0" + "\i. \i \ -L; i \ k\ \ A$i$k = 0" for A L + proof - + have "finite L" + by simp + then show ?thesis using 0 kk + proof (induction arbitrary: A rule: finite_induct) + case (empty B) + show ?case + proof (rule insertK) + fix i j + assume "i \ - K" "j \ i" + show "B $ j $ i = 0" + using \j \ i\ \i \ - K\ empty + by (metis ComplD ComplI Compl_eq_Diff_UNIV Diff_empty UNIV_I insert_iff) + qed + next + case (insert l L B) + show ?case + proof (cases "k = l") + case True + with insert show ?thesis + by auto + next + case False + let ?C = "\ i. if i = l then row l B - (B $ l $ k / B $ k $ k) *\<^sub>R row k B else row i B" + have 1: "\j \ - insert k K; i \ j\ \ ?C $ i $ j = 0" for j i + by (auto simp: insert.prems(1) row_def) + have 2: "?C $ i $ k = 0" + if "i \ - L" "i \ k" for i + proof (cases "i=l") + case True + with that insert.prems show ?thesis + by (simp add: row_def) + next + case False + with that show ?thesis + by (simp add: insert.prems(2) row_def) + qed + have 3: "?C $ k $ k \ 0" + by (auto simp: insert.prems row_def \k \ l\) + have PC: "P ?C" + using insert.IH [OF 1 2 3] by auto + have eqB: "(\ i. if i = l then row l ?C + (B $ l $ k / B $ k $ k) *\<^sub>R row k ?C else row i ?C) = B" + using \k \ l\ by (simp add: vec_eq_iff row_def) + show ?thesis + using row_op [OF PC, of l k, where c = "B$l$k / B$k$k"] eqB \k \ l\ + by (simp add: cong: if_cong) + qed + qed + qed + then have nonzero_hyp: "P A" + if kk: "A$k$k \ 0" and zeroes: "\i j. j \ - insert k K \ i\j \ A$i$j = 0" for A + by (auto simp: intro!: kk zeroes) + show ?case + proof (cases "row k A = 0") + case True + with zero_row show ?thesis by auto + next + case False + then obtain l where l: "A$k$l \ 0" + by (auto simp: row_def zero_vec_def vec_eq_iff) + show ?thesis + proof (cases "k = l") + case True + with l nonzero_hyp insert.prems show ?thesis + by blast + next + case False + have *: "A $ i $ Fun.swap k l id j = 0" if "j \ k" "j \ K" "i \ j" for i j + using False l insert.prems that + by (auto simp: swap_def insert split: if_split_asm) + have "P (\ i j. (\ i j. A $ i $ Fun.swap k l id j) $ i $ Fun.swap k l id j)" + by (rule swap_cols [OF nonzero_hyp False]) (auto simp: l *) + moreover + have "(\ i j. (\ i j. A $ i $ Fun.swap k l id j) $ i $ Fun.swap k l id j) = A" + by (vector Fun.swap_def) + ultimately show ?thesis + by simp + qed + qed + qed + qed + then show ?thesis + by blast +qed + +lemma%unimportant induct_matrix_elementary: + fixes P :: "real^'n^'n \ bool" + assumes mult: "\A B. \P A; P B\ \ P(A ** B)" + and zero_row: "\A i. row i A = 0 \ P A" + and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" + and swap1: "\m n. m \ n \ P(\ i j. mat 1 $ i $ Fun.swap m n id j)" + and idplus: "\m n c. m \ n \ P(\ i j. if i = m \ j = n then c else of_bool (i = j))" + shows "P A" +proof - + have swap: "P (\ i j. A $ i $ Fun.swap m n id j)" (is "P ?C") + if "P A" "m \ n" for A m n + proof - + have "A ** (\ i j. mat 1 $ i $ Fun.swap m n id j) = ?C" + by (simp add: matrix_matrix_mult_def mat_def vec_eq_iff if_distrib sum.delta_remove) + then show ?thesis + using mult swap1 that by metis + qed + have row: "P (\ i. if i = m then row m A + c *\<^sub>R row n A else row i A)" (is "P ?C") + if "P A" "m \ n" for A m n c + proof - + let ?B = "\ i j. if i = m \ j = n then c else of_bool (i = j)" + have "?B ** A = ?C" + using \m \ n\ unfolding matrix_matrix_mult_def row_def of_bool_def + by (auto simp: vec_eq_iff if_distrib [of "\x. x * y" for y] sum.remove cong: if_cong) + then show ?thesis + by (rule subst) (auto simp: that mult idplus) + qed + show ?thesis + by (rule induct_matrix_row_operations [OF zero_row diagonal swap row]) +qed + +lemma%unimportant induct_matrix_elementary_alt: + fixes P :: "real^'n^'n \ bool" + assumes mult: "\A B. \P A; P B\ \ P(A ** B)" + and zero_row: "\A i. row i A = 0 \ P A" + and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" + and swap1: "\m n. m \ n \ P(\ i j. mat 1 $ i $ Fun.swap m n id j)" + and idplus: "\m n. m \ n \ P(\ i j. of_bool (i = m \ j = n \ i = j))" + shows "P A" +proof - + have *: "P (\ i j. if i = m \ j = n then c else of_bool (i = j))" + if "m \ n" for m n c + proof (cases "c = 0") + case True + with diagonal show ?thesis by auto + next + case False + then have eq: "(\ i j. if i = m \ j = n then c else of_bool (i = j)) = + (\ i j. if i = j then (if j = n then inverse c else 1) else 0) ** + (\ i j. of_bool (i = m \ j = n \ i = j)) ** + (\ i j. if i = j then if j = n then c else 1 else 0)" + using \m \ n\ + apply (simp add: matrix_matrix_mult_def vec_eq_iff of_bool_def if_distrib [of "\x. y * x" for y] cong: if_cong) + apply (simp add: if_if_eq_conj sum.neutral conj_commute cong: conj_cong) + done + show ?thesis + apply (subst eq) + apply (intro mult idplus that) + apply (auto intro: diagonal) + done + qed + show ?thesis + by (rule induct_matrix_elementary) (auto intro: assms *) +qed + +lemma%unimportant matrix_vector_mult_matrix_matrix_mult_compose: + "(*v) (A ** B) = (*v) A \ (*v) B" + by (auto simp: matrix_vector_mul_assoc) + +lemma%unimportant induct_linear_elementary: + fixes f :: "real^'n \ real^'n" + assumes "linear f" + and comp: "\f g. \linear f; linear g; P f; P g\ \ P(f \ g)" + and zeroes: "\f i. \linear f; \x. (f x) $ i = 0\ \ P f" + and const: "\c. P(\x. \ i. c i * x$i)" + and swap: "\m n::'n. m \ n \ P(\x. \ i. x $ Fun.swap m n id i)" + and idplus: "\m n::'n. m \ n \ P(\x. \ i. if i = m then x$m + x$n else x$i)" + shows "P f" +proof - + have "P ((*v) A)" for A + proof (rule induct_matrix_elementary_alt) + fix A B + assume "P ((*v) A)" and "P ((*v) B)" + then show "P ((*v) (A ** B))" + by (auto simp add: matrix_vector_mult_matrix_matrix_mult_compose matrix_vector_mul_linear + intro!: comp) + next + fix A :: "real^'n^'n" and i + assume "row i A = 0" + show "P ((*v) A)" + using matrix_vector_mul_linear + by (rule zeroes[where i=i]) + (metis \row i A = 0\ inner_zero_left matrix_vector_mul_component row_def vec_lambda_eta) + next + fix A :: "real^'n^'n" + assume 0: "\i j. i \ j \ A $ i $ j = 0" + have "A $ i $ i * x $ i = (\j\UNIV. A $ i $ j * x $ j)" for x and i :: "'n" + by (simp add: 0 comm_monoid_add_class.sum.remove [where x=i]) + then have "(\x. \ i. A $ i $ i * x $ i) = ((*v) A)" + by (auto simp: 0 matrix_vector_mult_def) + then show "P ((*v) A)" + using const [of "\i. A $ i $ i"] by simp + next + fix m n :: "'n" + assume "m \ n" + have eq: "(\j\UNIV. if i = Fun.swap m n id j then x $ j else 0) = + (\j\UNIV. if j = Fun.swap m n id i then x $ j else 0)" + for i and x :: "real^'n" + unfolding swap_def by (rule sum.cong) auto + have "(\x::real^'n. \ i. x $ Fun.swap m n id i) = ((*v) (\ i j. if i = Fun.swap m n id j then 1 else 0))" + by (auto simp: mat_def matrix_vector_mult_def eq if_distrib [of "\x. x * y" for y] cong: if_cong) + with swap [OF \m \ n\] show "P ((*v) (\ i j. mat 1 $ i $ Fun.swap m n id j))" + by (simp add: mat_def matrix_vector_mult_def) + next + fix m n :: "'n" + assume "m \ n" + then have "x $ m + x $ n = (\j\UNIV. of_bool (j = n \ m = j) * x $ j)" for x :: "real^'n" + by (auto simp: of_bool_def if_distrib [of "\x. x * y" for y] sum.remove cong: if_cong) + then have "(\x::real^'n. \ i. if i = m then x $ m + x $ n else x $ i) = + ((*v) (\ i j. of_bool (i = m \ j = n \ i = j)))" + unfolding matrix_vector_mult_def of_bool_def + by (auto simp: vec_eq_iff if_distrib [of "\x. x * y" for y] cong: if_cong) + then show "P ((*v) (\ i j. of_bool (i = m \ j = n \ i = j)))" + using idplus [OF \m \ n\] by simp + qed + then show ?thesis + by (metis \linear f\ matrix_vector_mul) +qed + end \ No newline at end of file diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Change_Of_Vars.thy --- a/src/HOL/Analysis/Change_Of_Vars.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Change_Of_Vars.thy Wed Jan 16 18:14:02 2019 -0500 @@ -9,246 +9,42 @@ begin -subsection%important\Induction on matrix row operations\ +subsection%unimportant \Orthogonal Transformation of Balls\ -lemma%unimportant induct_matrix_row_operations: - fixes P :: "real^'n^'n \ bool" - assumes zero_row: "\A i. row i A = 0 \ P A" - and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" - and swap_cols: "\A m n. \P A; m \ n\ \ P(\ i j. A $ i $ Fun.swap m n id j)" - and row_op: "\A m n c. \P A; m \ n\ - \ P(\ i. if i = m then row m A + c *\<^sub>R row n A else row i A)" - shows "P A" -proof - - have "P A" if "(\i j. \j \ -K; i \ j\ \ A$i$j = 0)" for A K - proof - - have "finite K" - by simp - then show ?thesis using that - proof (induction arbitrary: A rule: finite_induct) - case empty - with diagonal show ?case - by simp - next - case (insert k K) - note insertK = insert - have "P A" if kk: "A$k$k \ 0" - and 0: "\i j. \j \ - insert k K; i \ j\ \ A$i$j = 0" - "\i. \i \ -L; i \ k\ \ A$i$k = 0" for A L - proof - - have "finite L" - by simp - then show ?thesis using 0 kk - proof (induction arbitrary: A rule: finite_induct) - case (empty B) - show ?case - proof (rule insertK) - fix i j - assume "i \ - K" "j \ i" - show "B $ j $ i = 0" - using \j \ i\ \i \ - K\ empty - by (metis ComplD ComplI Compl_eq_Diff_UNIV Diff_empty UNIV_I insert_iff) - qed - next - case (insert l L B) - show ?case - proof (cases "k = l") - case True - with insert show ?thesis - by auto - next - case False - let ?C = "\ i. if i = l then row l B - (B $ l $ k / B $ k $ k) *\<^sub>R row k B else row i B" - have 1: "\j \ - insert k K; i \ j\ \ ?C $ i $ j = 0" for j i - by (auto simp: insert.prems(1) row_def) - have 2: "?C $ i $ k = 0" - if "i \ - L" "i \ k" for i - proof (cases "i=l") - case True - with that insert.prems show ?thesis - by (simp add: row_def) - next - case False - with that show ?thesis - by (simp add: insert.prems(2) row_def) - qed - have 3: "?C $ k $ k \ 0" - by (auto simp: insert.prems row_def \k \ l\) - have PC: "P ?C" - using insert.IH [OF 1 2 3] by auto - have eqB: "(\ i. if i = l then row l ?C + (B $ l $ k / B $ k $ k) *\<^sub>R row k ?C else row i ?C) = B" - using \k \ l\ by (simp add: vec_eq_iff row_def) - show ?thesis - using row_op [OF PC, of l k, where c = "B$l$k / B$k$k"] eqB \k \ l\ - by (simp add: cong: if_cong) - qed - qed - qed - then have nonzero_hyp: "P A" - if kk: "A$k$k \ 0" and zeroes: "\i j. j \ - insert k K \ i\j \ A$i$j = 0" for A - by (auto simp: intro!: kk zeroes) - show ?case - proof (cases "row k A = 0") - case True - with zero_row show ?thesis by auto - next - case False - then obtain l where l: "A$k$l \ 0" - by (auto simp: row_def zero_vec_def vec_eq_iff) - show ?thesis - proof (cases "k = l") - case True - with l nonzero_hyp insert.prems show ?thesis - by blast - next - case False - have *: "A $ i $ Fun.swap k l id j = 0" if "j \ k" "j \ K" "i \ j" for i j - using False l insert.prems that - by (auto simp: swap_def insert split: if_split_asm) - have "P (\ i j. (\ i j. A $ i $ Fun.swap k l id j) $ i $ Fun.swap k l id j)" - by (rule swap_cols [OF nonzero_hyp False]) (auto simp: l *) - moreover - have "(\ i j. (\ i j. A $ i $ Fun.swap k l id j) $ i $ Fun.swap k l id j) = A" - by (metis (no_types, lifting) id_apply o_apply swap_id_idempotent vec_lambda_unique vec_lambda_unique) - ultimately show ?thesis - by simp - qed - qed - qed - qed - then show ?thesis - by blast +lemma%unimportant image_orthogonal_transformation_ball: + fixes f :: "'a::euclidean_space \ 'a" + assumes "orthogonal_transformation f" + shows "f ` ball x r = ball (f x) r" +proof (intro equalityI subsetI) + fix y assume "y \ f ` ball x r" + with assms show "y \ ball (f x) r" + by (auto simp: orthogonal_transformation_isometry) +next + fix y assume y: "y \ ball (f x) r" + then obtain z where z: "y = f z" + using assms orthogonal_transformation_surj by blast + with y assms show "y \ f ` ball x r" + by (auto simp: orthogonal_transformation_isometry) qed -lemma%unimportant induct_matrix_elementary: - fixes P :: "real^'n^'n \ bool" - assumes mult: "\A B. \P A; P B\ \ P(A ** B)" - and zero_row: "\A i. row i A = 0 \ P A" - and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" - and swap1: "\m n. m \ n \ P(\ i j. mat 1 $ i $ Fun.swap m n id j)" - and idplus: "\m n c. m \ n \ P(\ i j. if i = m \ j = n then c else of_bool (i = j))" - shows "P A" -proof - - have swap: "P (\ i j. A $ i $ Fun.swap m n id j)" (is "P ?C") - if "P A" "m \ n" for A m n - proof - - have "A ** (\ i j. mat 1 $ i $ Fun.swap m n id j) = ?C" - by (simp add: matrix_matrix_mult_def mat_def vec_eq_iff if_distrib sum.delta_remove) - then show ?thesis - using mult swap1 that by metis - qed - have row: "P (\ i. if i = m then row m A + c *\<^sub>R row n A else row i A)" (is "P ?C") - if "P A" "m \ n" for A m n c - proof - - let ?B = "\ i j. if i = m \ j = n then c else of_bool (i = j)" - have "?B ** A = ?C" - using \m \ n\ unfolding matrix_matrix_mult_def row_def of_bool_def - by (auto simp: vec_eq_iff if_distrib [of "\x. x * y" for y] sum.remove cong: if_cong) - then show ?thesis - by (rule subst) (auto simp: that mult idplus) - qed - show ?thesis - by (rule induct_matrix_row_operations [OF zero_row diagonal swap row]) -qed - -lemma%unimportant induct_matrix_elementary_alt: - fixes P :: "real^'n^'n \ bool" - assumes mult: "\A B. \P A; P B\ \ P(A ** B)" - and zero_row: "\A i. row i A = 0 \ P A" - and diagonal: "\A. (\i j. i \ j \ A$i$j = 0) \ P A" - and swap1: "\m n. m \ n \ P(\ i j. mat 1 $ i $ Fun.swap m n id j)" - and idplus: "\m n. m \ n \ P(\ i j. of_bool (i = m \ j = n \ i = j))" - shows "P A" -proof - - have *: "P (\ i j. if i = m \ j = n then c else of_bool (i = j))" - if "m \ n" for m n c - proof (cases "c = 0") - case True - with diagonal show ?thesis by auto - next - case False - then have eq: "(\ i j. if i = m \ j = n then c else of_bool (i = j)) = - (\ i j. if i = j then (if j = n then inverse c else 1) else 0) ** - (\ i j. of_bool (i = m \ j = n \ i = j)) ** - (\ i j. if i = j then if j = n then c else 1 else 0)" - using \m \ n\ - apply (simp add: matrix_matrix_mult_def vec_eq_iff of_bool_def if_distrib [of "\x. y * x" for y] cong: if_cong) - apply (simp add: if_if_eq_conj sum.neutral conj_commute cong: conj_cong) - done - show ?thesis - apply (subst eq) - apply (intro mult idplus that) - apply (auto intro: diagonal) - done - qed - show ?thesis - by (rule induct_matrix_elementary) (auto intro: assms *) +lemma%unimportant image_orthogonal_transformation_cball: + fixes f :: "'a::euclidean_space \ 'a" + assumes "orthogonal_transformation f" + shows "f ` cball x r = cball (f x) r" +proof (intro equalityI subsetI) + fix y assume "y \ f ` cball x r" + with assms show "y \ cball (f x) r" + by (auto simp: orthogonal_transformation_isometry) +next + fix y assume y: "y \ cball (f x) r" + then obtain z where z: "y = f z" + using assms orthogonal_transformation_surj by blast + with y assms show "y \ f ` cball x r" + by (auto simp: orthogonal_transformation_isometry) qed -lemma%unimportant matrix_vector_mult_matrix_matrix_mult_compose: - "(*v) (A ** B) = (*v) A \ (*v) B" - by (auto simp: matrix_vector_mul_assoc) -lemma%unimportant induct_linear_elementary: - fixes f :: "real^'n \ real^'n" - assumes "linear f" - and comp: "\f g. \linear f; linear g; P f; P g\ \ P(f \ g)" - and zeroes: "\f i. \linear f; \x. (f x) $ i = 0\ \ P f" - and const: "\c. P(\x. \ i. c i * x$i)" - and swap: "\m n::'n. m \ n \ P(\x. \ i. x $ Fun.swap m n id i)" - and idplus: "\m n::'n. m \ n \ P(\x. \ i. if i = m then x$m + x$n else x$i)" - shows "P f" -proof - - have "P ((*v) A)" for A - proof (rule induct_matrix_elementary_alt) - fix A B - assume "P ((*v) A)" and "P ((*v) B)" - then show "P ((*v) (A ** B))" - by (auto simp add: matrix_vector_mult_matrix_matrix_mult_compose matrix_vector_mul_linear - intro!: comp) - next - fix A :: "real^'n^'n" and i - assume "row i A = 0" - show "P ((*v) A)" - using matrix_vector_mul_linear - by (rule zeroes[where i=i]) - (metis \row i A = 0\ inner_zero_left matrix_vector_mul_component row_def vec_lambda_eta) - next - fix A :: "real^'n^'n" - assume 0: "\i j. i \ j \ A $ i $ j = 0" - have "A $ i $ i * x $ i = (\j\UNIV. A $ i $ j * x $ j)" for x and i :: "'n" - by (simp add: 0 comm_monoid_add_class.sum.remove [where x=i]) - then have "(\x. \ i. A $ i $ i * x $ i) = ((*v) A)" - by (auto simp: 0 matrix_vector_mult_def) - then show "P ((*v) A)" - using const [of "\i. A $ i $ i"] by simp - next - fix m n :: "'n" - assume "m \ n" - have eq: "(\j\UNIV. if i = Fun.swap m n id j then x $ j else 0) = - (\j\UNIV. if j = Fun.swap m n id i then x $ j else 0)" - for i and x :: "real^'n" - unfolding swap_def by (rule sum.cong) auto - have "(\x::real^'n. \ i. x $ Fun.swap m n id i) = ((*v) (\ i j. if i = Fun.swap m n id j then 1 else 0))" - by (auto simp: mat_def matrix_vector_mult_def eq if_distrib [of "\x. x * y" for y] cong: if_cong) - with swap [OF \m \ n\] show "P ((*v) (\ i j. mat 1 $ i $ Fun.swap m n id j))" - by (simp add: mat_def matrix_vector_mult_def) - next - fix m n :: "'n" - assume "m \ n" - then have "x $ m + x $ n = (\j\UNIV. of_bool (j = n \ m = j) * x $ j)" for x :: "real^'n" - by (auto simp: of_bool_def if_distrib [of "\x. x * y" for y] sum.remove cong: if_cong) - then have "(\x::real^'n. \ i. if i = m then x $ m + x $ n else x $ i) = - ((*v) (\ i j. of_bool (i = m \ j = n \ i = j)))" - unfolding matrix_vector_mult_def of_bool_def - by (auto simp: vec_eq_iff if_distrib [of "\x. x * y" for y] cong: if_cong) - then show "P ((*v) (\ i j. of_bool (i = m \ j = n \ i = j)))" - using idplus [OF \m \ n\] by simp - qed - then show ?thesis - by (metis \linear f\ matrix_vector_mul) -qed - +subsection \Measurable Shear and Stretch\ proposition%important fixes a :: "real^'n" diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Convex.thy --- a/src/HOL/Analysis/Convex.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Convex.thy Wed Jan 16 18:14:02 2019 -0500 @@ -14,79 +14,6 @@ "HOL-Library.Set_Algebras" begin -lemma substdbasis_expansion_unique: - assumes d: "d \ Basis" - shows "(\i\d. f i *\<^sub>R i) = (x::'a::euclidean_space) \ - (\i\Basis. (i \ d \ f i = x \ i) \ (i \ d \ x \ i = 0))" -proof - - have *: "\x a b P. x * (if P then a else b) = (if P then x * a else x * b)" - by auto - have **: "finite d" - by (auto intro: finite_subset[OF assms]) - have ***: "\i. i \ Basis \ (\i\d. f i *\<^sub>R i) \ i = (\x\d. if x = i then f x else 0)" - using d - by (auto intro!: sum.cong simp: inner_Basis inner_sum_left) - show ?thesis - unfolding euclidean_eq_iff[where 'a='a] by (auto simp: sum.delta[OF **] ***) -qed - -lemma independent_substdbasis: "d \ Basis \ independent d" - by (rule independent_mono[OF independent_Basis]) - -lemma sum_not_0: "sum f A \ 0 \ \a \ A. f a \ 0" - by (rule ccontr) auto - -lemma subset_translation_eq [simp]: - fixes a :: "'a::real_vector" shows "(+) a ` s \ (+) a ` t \ s \ t" - by auto - -lemma translate_inj_on: - fixes A :: "'a::ab_group_add set" - shows "inj_on (\x. a + x) A" - unfolding inj_on_def by auto - -lemma translation_assoc: - fixes a b :: "'a::ab_group_add" - shows "(\x. b + x) ` ((\x. a + x) ` S) = (\x. (a + b) + x) ` S" - by auto - -lemma translation_invert: - fixes a :: "'a::ab_group_add" - assumes "(\x. a + x) ` A = (\x. a + x) ` B" - shows "A = B" -proof - - have "(\x. -a + x) ` ((\x. a + x) ` A) = (\x. - a + x) ` ((\x. a + x) ` B)" - using assms by auto - then show ?thesis - using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto -qed - -lemma translation_galois: - fixes a :: "'a::ab_group_add" - shows "T = ((\x. a + x) ` S) \ S = ((\x. (- a) + x) ` T)" - using translation_assoc[of "-a" a S] - apply auto - using translation_assoc[of a "-a" T] - apply auto - done - -lemma translation_inverse_subset: - assumes "((\x. - a + x) ` V) \ (S :: 'n::ab_group_add set)" - shows "V \ ((\x. a + x) ` S)" -proof - - { - fix x - assume "x \ V" - then have "x-a \ S" using assms by auto - then have "x \ {a + v |v. v \ S}" - apply auto - apply (rule exI[of _ "x-a"], simp) - done - then have "x \ ((\x. a+x) ` S)" by auto - } - then show ?thesis by auto -qed - subsection \Convexity\ definition%important convex :: "'a::real_vector set \ bool" diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Cross3.thy --- a/src/HOL/Analysis/Cross3.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Cross3.thy Wed Jan 16 18:14:02 2019 -0500 @@ -7,7 +7,7 @@ section\Vector Cross Products in 3 Dimensions\ theory "Cross3" - imports Determinants + imports Determinants Cartesian_Euclidean_Space begin context includes no_Set_Product_syntax diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Determinants.thy --- a/src/HOL/Analysis/Determinants.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Determinants.thy Wed Jan 16 18:14:02 2019 -0500 @@ -6,7 +6,7 @@ theory Determinants imports - Cartesian_Euclidean_Space + Cartesian_Space "HOL-Library.Permutations" begin @@ -941,372 +941,6 @@ by auto qed -subsection%important \Orthogonality of a transformation and matrix\ - -definition%important "orthogonal_transformation f \ linear f \ (\v w. f v \ f w = v \ w)" - -definition%important "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \ - transpose Q ** Q = mat 1 \ Q ** transpose Q = mat 1" - -lemma%unimportant orthogonal_transformation: - "orthogonal_transformation f \ linear f \ (\v. norm (f v) = norm v)" - unfolding orthogonal_transformation_def - apply auto - apply (erule_tac x=v in allE)+ - apply (simp add: norm_eq_sqrt_inner) - apply (simp add: dot_norm linear_add[symmetric]) - done - -lemma%unimportant orthogonal_transformation_id [simp]: "orthogonal_transformation (\x. x)" - by (simp add: linear_iff orthogonal_transformation_def) - -lemma%unimportant orthogonal_orthogonal_transformation: - "orthogonal_transformation f \ orthogonal (f x) (f y) \ orthogonal x y" - by (simp add: orthogonal_def orthogonal_transformation_def) - -lemma%unimportant orthogonal_transformation_compose: - "\orthogonal_transformation f; orthogonal_transformation g\ \ orthogonal_transformation(f \ g)" - by (auto simp: orthogonal_transformation_def linear_compose) - -lemma%unimportant orthogonal_transformation_neg: - "orthogonal_transformation(\x. -(f x)) \ orthogonal_transformation f" - by (auto simp: orthogonal_transformation_def dest: linear_compose_neg) - -lemma%unimportant orthogonal_transformation_scaleR: "orthogonal_transformation f \ f (c *\<^sub>R v) = c *\<^sub>R f v" - by (simp add: linear_iff orthogonal_transformation_def) - -lemma%unimportant orthogonal_transformation_linear: - "orthogonal_transformation f \ linear f" - by (simp add: orthogonal_transformation_def) - -lemma%unimportant orthogonal_transformation_inj: - "orthogonal_transformation f \ inj f" - unfolding orthogonal_transformation_def inj_on_def - by (metis vector_eq) - -lemma%unimportant orthogonal_transformation_surj: - "orthogonal_transformation f \ surj f" - for f :: "'a::euclidean_space \ 'a::euclidean_space" - by (simp add: linear_injective_imp_surjective orthogonal_transformation_inj orthogonal_transformation_linear) - -lemma%unimportant orthogonal_transformation_bij: - "orthogonal_transformation f \ bij f" - for f :: "'a::euclidean_space \ 'a::euclidean_space" - by (simp add: bij_def orthogonal_transformation_inj orthogonal_transformation_surj) - -lemma%unimportant orthogonal_transformation_inv: - "orthogonal_transformation f \ orthogonal_transformation (inv f)" - for f :: "'a::euclidean_space \ 'a::euclidean_space" - by (metis (no_types, hide_lams) bijection.inv_right bijection_def inj_linear_imp_inv_linear orthogonal_transformation orthogonal_transformation_bij orthogonal_transformation_inj) - -lemma%unimportant orthogonal_transformation_norm: - "orthogonal_transformation f \ norm (f x) = norm x" - by (metis orthogonal_transformation) - -lemma%unimportant orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n) \ transpose Q ** Q = mat 1" - by (metis matrix_left_right_inverse orthogonal_matrix_def) - -lemma%unimportant orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n)" - by (simp add: orthogonal_matrix_def) - -lemma%unimportant orthogonal_matrix_mul: - fixes A :: "real ^'n^'n" - assumes "orthogonal_matrix A" "orthogonal_matrix B" - shows "orthogonal_matrix(A ** B)" - using assms - by (simp add: orthogonal_matrix matrix_transpose_mul matrix_left_right_inverse matrix_mul_assoc) - -lemma%important orthogonal_transformation_matrix: - fixes f:: "real^'n \ real^'n" - shows "orthogonal_transformation f \ linear f \ orthogonal_matrix(matrix f)" - (is "?lhs \ ?rhs") -proof%unimportant - - let ?mf = "matrix f" - let ?ot = "orthogonal_transformation f" - let ?U = "UNIV :: 'n set" - have fU: "finite ?U" by simp - let ?m1 = "mat 1 :: real ^'n^'n" - { - assume ot: ?ot - from ot have lf: "Vector_Spaces.linear (*s) (*s) f" and fd: "\v w. f v \ f w = v \ w" - unfolding orthogonal_transformation_def orthogonal_matrix linear_def scalar_mult_eq_scaleR - by blast+ - { - fix i j - let ?A = "transpose ?mf ** ?mf" - have th0: "\b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)" - "\b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)" - by simp_all - from fd[of "axis i 1" "axis j 1", - simplified matrix_works[OF lf, symmetric] dot_matrix_vector_mul] - have "?A$i$j = ?m1 $ i $ j" - by (simp add: inner_vec_def matrix_matrix_mult_def columnvector_def rowvector_def - th0 sum.delta[OF fU] mat_def axis_def) - } - then have "orthogonal_matrix ?mf" - unfolding orthogonal_matrix - by vector - with lf have ?rhs - unfolding linear_def scalar_mult_eq_scaleR - by blast - } - moreover - { - assume lf: "Vector_Spaces.linear (*s) (*s) f" and om: "orthogonal_matrix ?mf" - from lf om have ?lhs - unfolding orthogonal_matrix_def norm_eq orthogonal_transformation - apply (simp only: matrix_works[OF lf, symmetric] dot_matrix_vector_mul) - apply (simp add: dot_matrix_product linear_def scalar_mult_eq_scaleR) - done - } - ultimately show ?thesis - by (auto simp: linear_def scalar_mult_eq_scaleR) -qed - -lemma%important det_orthogonal_matrix: - fixes Q:: "'a::linordered_idom^'n^'n" - assumes oQ: "orthogonal_matrix Q" - shows "det Q = 1 \ det Q = - 1" -proof%unimportant - - have "Q ** transpose Q = mat 1" - by (metis oQ orthogonal_matrix_def) - then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)" - by simp - then have "det Q * det Q = 1" - by (simp add: det_mul) - then show ?thesis - by (simp add: square_eq_1_iff) -qed - -lemma%important orthogonal_transformation_det [simp]: - fixes f :: "real^'n \ real^'n" - shows "orthogonal_transformation f \ \det (matrix f)\ = 1" - using%unimportant det_orthogonal_matrix orthogonal_transformation_matrix by fastforce - - -subsection%important \Linearity of scaling, and hence isometry, that preserves origin\ - -lemma%important scaling_linear: - fixes f :: "'a::real_inner \ 'a::real_inner" - assumes f0: "f 0 = 0" - and fd: "\x y. dist (f x) (f y) = c * dist x y" - shows "linear f" -proof%unimportant - - { - fix v w - have "norm (f x) = c * norm x" for x - by (metis dist_0_norm f0 fd) - then have "f v \ f w = c\<^sup>2 * (v \ w)" - unfolding dot_norm_neg dist_norm[symmetric] - by (simp add: fd power2_eq_square field_simps) - } - then show ?thesis - unfolding linear_iff vector_eq[where 'a="'a"] scalar_mult_eq_scaleR - by (simp add: inner_add field_simps) -qed - -lemma%unimportant isometry_linear: - "f (0::'a::real_inner) = (0::'a) \ \x y. dist(f x) (f y) = dist x y \ linear f" - by (rule scaling_linear[where c=1]) simp_all - -text \Hence another formulation of orthogonal transformation\ - -lemma%important orthogonal_transformation_isometry: - "orthogonal_transformation f \ f(0::'a::real_inner) = (0::'a) \ (\x y. dist(f x) (f y) = dist x y)" - unfolding orthogonal_transformation - apply (auto simp: linear_0 isometry_linear) - apply (metis (no_types, hide_lams) dist_norm linear_diff) - by (metis dist_0_norm) - - -lemma%unimportant image_orthogonal_transformation_ball: - fixes f :: "'a::euclidean_space \ 'a" - assumes "orthogonal_transformation f" - shows "f ` ball x r = ball (f x) r" -proof (intro equalityI subsetI) - fix y assume "y \ f ` ball x r" - with assms show "y \ ball (f x) r" - by (auto simp: orthogonal_transformation_isometry) -next - fix y assume y: "y \ ball (f x) r" - then obtain z where z: "y = f z" - using assms orthogonal_transformation_surj by blast - with y assms show "y \ f ` ball x r" - by (auto simp: orthogonal_transformation_isometry) -qed - -lemma%unimportant image_orthogonal_transformation_cball: - fixes f :: "'a::euclidean_space \ 'a" - assumes "orthogonal_transformation f" - shows "f ` cball x r = cball (f x) r" -proof (intro equalityI subsetI) - fix y assume "y \ f ` cball x r" - with assms show "y \ cball (f x) r" - by (auto simp: orthogonal_transformation_isometry) -next - fix y assume y: "y \ cball (f x) r" - then obtain z where z: "y = f z" - using assms orthogonal_transformation_surj by blast - with y assms show "y \ f ` cball x r" - by (auto simp: orthogonal_transformation_isometry) -qed - -subsection%important \ We can find an orthogonal matrix taking any unit vector to any other\ - -lemma%unimportant orthogonal_matrix_transpose [simp]: - "orthogonal_matrix(transpose A) \ orthogonal_matrix A" - by (auto simp: orthogonal_matrix_def) - -lemma%unimportant orthogonal_matrix_orthonormal_columns: - fixes A :: "real^'n^'n" - shows "orthogonal_matrix A \ - (\i. norm(column i A) = 1) \ - (\i j. i \ j \ orthogonal (column i A) (column j A))" - by (auto simp: orthogonal_matrix matrix_mult_transpose_dot_column vec_eq_iff mat_def norm_eq_1 orthogonal_def) - -lemma%unimportant orthogonal_matrix_orthonormal_rows: - fixes A :: "real^'n^'n" - shows "orthogonal_matrix A \ - (\i. norm(row i A) = 1) \ - (\i j. i \ j \ orthogonal (row i A) (row j A))" - using orthogonal_matrix_orthonormal_columns [of "transpose A"] by simp - -lemma%important orthogonal_matrix_exists_basis: - fixes a :: "real^'n" - assumes "norm a = 1" - obtains A where "orthogonal_matrix A" "A *v (axis k 1) = a" -proof%unimportant - - obtain S where "a \ S" "pairwise orthogonal S" and noS: "\x. x \ S \ norm x = 1" - and "independent S" "card S = CARD('n)" "span S = UNIV" - using vector_in_orthonormal_basis assms by force - then obtain f0 where "bij_betw f0 (UNIV::'n set) S" - by (metis finite_class.finite_UNIV finite_same_card_bij finiteI_independent) - then obtain f where f: "bij_betw f (UNIV::'n set) S" and a: "a = f k" - using bij_swap_iff [of k "inv f0 a" f0] - by (metis UNIV_I \a \ S\ bij_betw_inv_into_right bij_betw_swap_iff swap_apply1) - show thesis - proof - have [simp]: "\i. norm (f i) = 1" - using bij_betwE [OF \bij_betw f UNIV S\] by (blast intro: noS) - have [simp]: "\i j. i \ j \ orthogonal (f i) (f j)" - using \pairwise orthogonal S\ \bij_betw f UNIV S\ - by (auto simp: pairwise_def bij_betw_def inj_on_def) - show "orthogonal_matrix (\ i j. f j $ i)" - by (simp add: orthogonal_matrix_orthonormal_columns column_def) - show "(\ i j. f j $ i) *v axis k 1 = a" - by (simp add: matrix_vector_mult_def axis_def a if_distrib cong: if_cong) - qed -qed - -lemma%unimportant orthogonal_transformation_exists_1: - fixes a b :: "real^'n" - assumes "norm a = 1" "norm b = 1" - obtains f where "orthogonal_transformation f" "f a = b" -proof%unimportant - - obtain k::'n where True - by simp - obtain A B where AB: "orthogonal_matrix A" "orthogonal_matrix B" and eq: "A *v (axis k 1) = a" "B *v (axis k 1) = b" - using orthogonal_matrix_exists_basis assms by metis - let ?f = "\x. (B ** transpose A) *v x" - show thesis - proof - show "orthogonal_transformation ?f" - by (subst orthogonal_transformation_matrix) - (auto simp: AB orthogonal_matrix_mul) - next - show "?f a = b" - using \orthogonal_matrix A\ unfolding orthogonal_matrix_def - by (metis eq matrix_mul_rid matrix_vector_mul_assoc) - qed -qed - -lemma%important orthogonal_transformation_exists: - fixes a b :: "real^'n" - assumes "norm a = norm b" - obtains f where "orthogonal_transformation f" "f a = b" -proof%unimportant (cases "a = 0 \ b = 0") - case True - with assms show ?thesis - using that by force -next - case False - then obtain f where f: "orthogonal_transformation f" and eq: "f (a /\<^sub>R norm a) = (b /\<^sub>R norm b)" - by (auto intro: orthogonal_transformation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b"]) - show ?thesis - proof - interpret linear f - using f by (simp add: orthogonal_transformation_linear) - have "f a /\<^sub>R norm a = f (a /\<^sub>R norm a)" - by (simp add: scale) - also have "\ = b /\<^sub>R norm a" - by (simp add: eq assms [symmetric]) - finally show "f a = b" - using False by auto - qed (use f in auto) -qed - - -subsection%important \Can extend an isometry from unit sphere\ - -lemma%important isometry_sphere_extend: - fixes f:: "'a::real_inner \ 'a" - assumes f1: "\x. norm x = 1 \ norm (f x) = 1" - and fd1: "\x y. \norm x = 1; norm y = 1\ \ dist (f x) (f y) = dist x y" - shows "\g. orthogonal_transformation g \ (\x. norm x = 1 \ g x = f x)" -proof%unimportant - - { - fix x y x' y' u v u' v' :: "'a" - assume H: "x = norm x *\<^sub>R u" "y = norm y *\<^sub>R v" - "x' = norm x *\<^sub>R u'" "y' = norm y *\<^sub>R v'" - and J: "norm u = 1" "norm u' = 1" "norm v = 1" "norm v' = 1" "norm(u' - v') = norm(u - v)" - then have *: "u \ v = u' \ v' + v' \ u' - v \ u " - by (simp add: norm_eq norm_eq_1 inner_add inner_diff) - have "norm (norm x *\<^sub>R u' - norm y *\<^sub>R v') = norm (norm x *\<^sub>R u - norm y *\<^sub>R v)" - using J by (simp add: norm_eq norm_eq_1 inner_diff * field_simps) - then have "norm(x' - y') = norm(x - y)" - using H by metis - } - note norm_eq = this - let ?g = "\x. if x = 0 then 0 else norm x *\<^sub>R f (x /\<^sub>R norm x)" - have thfg: "?g x = f x" if "norm x = 1" for x - using that by auto - have thd: "dist (?g x) (?g y) = dist x y" for x y - proof (cases "x=0 \ y=0") - case False - show "dist (?g x) (?g y) = dist x y" - unfolding dist_norm - proof (rule norm_eq) - show "x = norm x *\<^sub>R (x /\<^sub>R norm x)" "y = norm y *\<^sub>R (y /\<^sub>R norm y)" - "norm (f (x /\<^sub>R norm x)) = 1" "norm (f (y /\<^sub>R norm y)) = 1" - using False f1 by auto - qed (use False in \auto simp: field_simps intro: f1 fd1[unfolded dist_norm]\) - qed (auto simp: f1) - show ?thesis - unfolding orthogonal_transformation_isometry - by (rule exI[where x= ?g]) (metis thfg thd) -qed - -subsection%important \Rotation, reflection, rotoinversion\ - -definition%important "rotation_matrix Q \ orthogonal_matrix Q \ det Q = 1" -definition%important "rotoinversion_matrix Q \ orthogonal_matrix Q \ det Q = - 1" - -lemma%important orthogonal_rotation_or_rotoinversion: - fixes Q :: "'a::linordered_idom^'n^'n" - shows " orthogonal_matrix Q \ rotation_matrix Q \ rotoinversion_matrix Q" - by%unimportant (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix) - -text \Explicit formulas for low dimensions\ - -lemma%unimportant prod_neutral_const: "prod f {(1::nat)..1} = f 1" - by simp - -lemma%unimportant prod_2: "prod f {(1::nat)..2} = f 1 * f 2" - by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute) - -lemma%unimportant prod_3: "prod f {(1::nat)..3} = f 1 * f 2 * f 3" - by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute) - lemma%unimportant det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1" by (simp add: det_def sign_id) @@ -1342,6 +976,36 @@ by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq) qed +lemma%important det_orthogonal_matrix: + fixes Q:: "'a::linordered_idom^'n^'n" + assumes oQ: "orthogonal_matrix Q" + shows "det Q = 1 \ det Q = - 1" +proof%unimportant - + have "Q ** transpose Q = mat 1" + by (metis oQ orthogonal_matrix_def) + then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)" + by simp + then have "det Q * det Q = 1" + by (simp add: det_mul) + then show ?thesis + by (simp add: square_eq_1_iff) +qed + +lemma%important orthogonal_transformation_det [simp]: + fixes f :: "real^'n \ real^'n" + shows "orthogonal_transformation f \ \det (matrix f)\ = 1" + using%unimportant det_orthogonal_matrix orthogonal_transformation_matrix by fastforce + +subsection%important \Rotation, reflection, rotoinversion\ + +definition%important "rotation_matrix Q \ orthogonal_matrix Q \ det Q = 1" +definition%important "rotoinversion_matrix Q \ orthogonal_matrix Q \ det Q = - 1" + +lemma%important orthogonal_rotation_or_rotoinversion: + fixes Q :: "'a::linordered_idom^'n^'n" + shows " orthogonal_matrix Q \ rotation_matrix Q \ rotoinversion_matrix Q" + by%unimportant (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix) + text\ Slightly stronger results giving rotation, but only in two or more dimensions\ lemma%unimportant rotation_matrix_exists_basis: @@ -1360,8 +1024,10 @@ then show ?thesis using \A *v axis k 1 = a\ that by auto next - obtain j where "j \ k" - by (metis (full_types) 2 card_2_exists ex_card) + from ex_card[OF 2] obtain h i::'n where "h \ i" + by (auto simp add: eval_nat_numeral card_Suc_eq) + then obtain j where "j \ k" + by (metis (full_types)) let ?TA = "transpose A" let ?A = "\ i. if i = j then - 1 *\<^sub>R (?TA $ i) else ?TA $i" assume "rotoinversion_matrix A" diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Linear_Algebra.thy --- a/src/HOL/Analysis/Linear_Algebra.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Linear_Algebra.thy Wed Jan 16 18:14:02 2019 -0500 @@ -30,6 +30,79 @@ lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x \ (UNIV::'a::finite set)}" using finite finite_image_set by blast +lemma substdbasis_expansion_unique: + includes inner_syntax + assumes d: "d \ Basis" + shows "(\i\d. f i *\<^sub>R i) = (x::'a::euclidean_space) \ + (\i\Basis. (i \ d \ f i = x \ i) \ (i \ d \ x \ i = 0))" +proof - + have *: "\x a b P. x * (if P then a else b) = (if P then x * a else x * b)" + by auto + have **: "finite d" + by (auto intro: finite_subset[OF assms]) + have ***: "\i. i \ Basis \ (\i\d. f i *\<^sub>R i) \ i = (\x\d. if x = i then f x else 0)" + using d + by (auto intro!: sum.cong simp: inner_Basis inner_sum_left) + show ?thesis + unfolding euclidean_eq_iff[where 'a='a] by (auto simp: sum.delta[OF **] ***) +qed + +lemma independent_substdbasis: "d \ Basis \ independent d" + by (rule independent_mono[OF independent_Basis]) + +lemma sum_not_0: "sum f A \ 0 \ \a \ A. f a \ 0" + by (rule ccontr) auto + +lemma subset_translation_eq [simp]: + fixes a :: "'a::real_vector" shows "(+) a ` s \ (+) a ` t \ s \ t" + by auto + +lemma translate_inj_on: + fixes A :: "'a::ab_group_add set" + shows "inj_on (\x. a + x) A" + unfolding inj_on_def by auto + +lemma translation_assoc: + fixes a b :: "'a::ab_group_add" + shows "(\x. b + x) ` ((\x. a + x) ` S) = (\x. (a + b) + x) ` S" + by auto + +lemma translation_invert: + fixes a :: "'a::ab_group_add" + assumes "(\x. a + x) ` A = (\x. a + x) ` B" + shows "A = B" +proof - + have "(\x. -a + x) ` ((\x. a + x) ` A) = (\x. - a + x) ` ((\x. a + x) ` B)" + using assms by auto + then show ?thesis + using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto +qed + +lemma translation_galois: + fixes a :: "'a::ab_group_add" + shows "T = ((\x. a + x) ` S) \ S = ((\x. (- a) + x) ` T)" + using translation_assoc[of "-a" a S] + apply auto + using translation_assoc[of a "-a" T] + apply auto + done + +lemma translation_inverse_subset: + assumes "((\x. - a + x) ` V) \ (S :: 'n::ab_group_add set)" + shows "V \ ((\x. a + x) ` S)" +proof - + { + fix x + assume "x \ V" + then have "x-a \ S" using assms by auto + then have "x \ {a + v |v. v \ S}" + apply auto + apply (rule exI[of _ "x-a"], simp) + done + then have "x \ ((\x. a+x) ` S)" by auto + } + then show ?thesis by auto +qed subsection%unimportant \More interesting properties of the norm\ @@ -224,6 +297,66 @@ qed +subsection%important \Orthogonality of a transformation\ + +definition%important "orthogonal_transformation f \ linear f \ (\v w. f v \ f w = v \ w)" + +lemma%unimportant orthogonal_transformation: + "orthogonal_transformation f \ linear f \ (\v. norm (f v) = norm v)" + unfolding orthogonal_transformation_def + apply auto + apply (erule_tac x=v in allE)+ + apply (simp add: norm_eq_sqrt_inner) + apply (simp add: dot_norm linear_add[symmetric]) + done + +lemma%unimportant orthogonal_transformation_id [simp]: "orthogonal_transformation (\x. x)" + by (simp add: linear_iff orthogonal_transformation_def) + +lemma%unimportant orthogonal_orthogonal_transformation: + "orthogonal_transformation f \ orthogonal (f x) (f y) \ orthogonal x y" + by (simp add: orthogonal_def orthogonal_transformation_def) + +lemma%unimportant orthogonal_transformation_compose: + "\orthogonal_transformation f; orthogonal_transformation g\ \ orthogonal_transformation(f \ g)" + by (auto simp: orthogonal_transformation_def linear_compose) + +lemma%unimportant orthogonal_transformation_neg: + "orthogonal_transformation(\x. -(f x)) \ orthogonal_transformation f" + by (auto simp: orthogonal_transformation_def dest: linear_compose_neg) + +lemma%unimportant orthogonal_transformation_scaleR: "orthogonal_transformation f \ f (c *\<^sub>R v) = c *\<^sub>R f v" + by (simp add: linear_iff orthogonal_transformation_def) + +lemma%unimportant orthogonal_transformation_linear: + "orthogonal_transformation f \ linear f" + by (simp add: orthogonal_transformation_def) + +lemma%unimportant orthogonal_transformation_inj: + "orthogonal_transformation f \ inj f" + unfolding orthogonal_transformation_def inj_on_def + by (metis vector_eq) + +lemma%unimportant orthogonal_transformation_surj: + "orthogonal_transformation f \ surj f" + for f :: "'a::euclidean_space \ 'a::euclidean_space" + by (simp add: linear_injective_imp_surjective orthogonal_transformation_inj orthogonal_transformation_linear) + +lemma%unimportant orthogonal_transformation_bij: + "orthogonal_transformation f \ bij f" + for f :: "'a::euclidean_space \ 'a::euclidean_space" + by (simp add: bij_def orthogonal_transformation_inj orthogonal_transformation_surj) + +lemma%unimportant orthogonal_transformation_inv: + "orthogonal_transformation f \ orthogonal_transformation (inv f)" + for f :: "'a::euclidean_space \ 'a::euclidean_space" + by (metis (no_types, hide_lams) bijection.inv_right bijection_def inj_linear_imp_inv_linear orthogonal_transformation orthogonal_transformation_bij orthogonal_transformation_inj) + +lemma%unimportant orthogonal_transformation_norm: + "orthogonal_transformation f \ norm (f x) = norm x" + by (metis orthogonal_transformation) + + subsection \Bilinear functions\ definition%important @@ -1210,4 +1343,540 @@ qed qed + +subsection\Properties of special hyperplanes\ + +lemma subspace_hyperplane: "subspace {x. a \ x = 0}" + by (simp add: subspace_def inner_right_distrib) + +lemma subspace_hyperplane2: "subspace {x. x \ a = 0}" + by (simp add: inner_commute inner_right_distrib subspace_def) + +lemma special_hyperplane_span: + fixes S :: "'n::euclidean_space set" + assumes "k \ Basis" + shows "{x. k \ x = 0} = span (Basis - {k})" +proof - + have *: "x \ span (Basis - {k})" if "k \ x = 0" for x + proof - + have "x = (\b\Basis. (x \ b) *\<^sub>R b)" + by (simp add: euclidean_representation) + also have "... = (\b \ Basis - {k}. (x \ b) *\<^sub>R b)" + by (auto simp: sum.remove [of _ k] inner_commute assms that) + finally have "x = (\b\Basis - {k}. (x \ b) *\<^sub>R b)" . + then show ?thesis + by (simp add: span_finite) + qed + show ?thesis + apply (rule span_subspace [symmetric]) + using assms + apply (auto simp: inner_not_same_Basis intro: * subspace_hyperplane) + done +qed + +lemma dim_special_hyperplane: + fixes k :: "'n::euclidean_space" + shows "k \ Basis \ dim {x. k \ x = 0} = DIM('n) - 1" +apply (simp add: special_hyperplane_span) +apply (rule dim_unique [OF subset_refl]) +apply (auto simp: independent_substdbasis) +apply (metis member_remove remove_def span_base) +done + +proposition dim_hyperplane: + fixes a :: "'a::euclidean_space" + assumes "a \ 0" + shows "dim {x. a \ x = 0} = DIM('a) - 1" +proof - + have span0: "span {x. a \ x = 0} = {x. a \ x = 0}" + by (rule span_unique) (auto simp: subspace_hyperplane) + then obtain B where "independent B" + and Bsub: "B \ {x. a \ x = 0}" + and subspB: "{x. a \ x = 0} \ span B" + and card0: "(card B = dim {x. a \ x = 0})" + and ortho: "pairwise orthogonal B" + using orthogonal_basis_exists by metis + with assms have "a \ span B" + by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0) + then have ind: "independent (insert a B)" + by (simp add: \independent B\ independent_insert) + have "finite B" + using \independent B\ independent_bound by blast + have "UNIV \ span (insert a B)" + proof fix y::'a + obtain r z where z: "y = r *\<^sub>R a + z" "a \ z = 0" + apply (rule_tac r="(a \ y) / (a \ a)" and z = "y - ((a \ y) / (a \ a)) *\<^sub>R a" in that) + using assms + by (auto simp: algebra_simps) + show "y \ span (insert a B)" + by (metis (mono_tags, lifting) z Bsub span_eq_iff + add_diff_cancel_left' mem_Collect_eq span0 span_breakdown_eq span_subspace subspB) + qed + then have dima: "DIM('a) = dim(insert a B)" + by (metis independent_Basis span_Basis dim_eq_card top.extremum_uniqueI) + then show ?thesis + by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \a \ span B\ ind card0 + card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE + subspB) +qed + +lemma lowdim_eq_hyperplane: + fixes S :: "'a::euclidean_space set" + assumes "dim S = DIM('a) - 1" + obtains a where "a \ 0" and "span S = {x. a \ x = 0}" +proof - + have dimS: "dim S < DIM('a)" + by (simp add: assms) + then obtain b where b: "b \ 0" "span S \ {a. b \ a = 0}" + using lowdim_subset_hyperplane [of S] by fastforce + show ?thesis + apply (rule that[OF b(1)]) + apply (rule subspace_dim_equal) + by (auto simp: assms b dim_hyperplane dim_span subspace_hyperplane + subspace_span) +qed + +lemma dim_eq_hyperplane: + fixes S :: "'n::euclidean_space set" + shows "dim S = DIM('n) - 1 \ (\a. a \ 0 \ span S = {x. a \ x = 0})" +by (metis One_nat_def dim_hyperplane dim_span lowdim_eq_hyperplane) + + +subsection\ Orthogonal bases, Gram-Schmidt process, and related theorems\ + +lemma pairwise_orthogonal_independent: + assumes "pairwise orthogonal S" and "0 \ S" + shows "independent S" +proof - + have 0: "\x y. \x \ y; x \ S; y \ S\ \ x \ y = 0" + using assms by (simp add: pairwise_def orthogonal_def) + have "False" if "a \ S" and a: "a \ span (S - {a})" for a + proof - + obtain T U where "T \ S - {a}" "a = (\v\T. U v *\<^sub>R v)" + using a by (force simp: span_explicit) + then have "a \ a = a \ (\v\T. U v *\<^sub>R v)" + by simp + also have "... = 0" + apply (simp add: inner_sum_right) + apply (rule comm_monoid_add_class.sum.neutral) + by (metis "0" DiffE \T \ S - {a}\ mult_not_zero singletonI subsetCE \a \ S\) + finally show ?thesis + using \0 \ S\ \a \ S\ by auto + qed + then show ?thesis + by (force simp: dependent_def) +qed + +lemma pairwise_orthogonal_imp_finite: + fixes S :: "'a::euclidean_space set" + assumes "pairwise orthogonal S" + shows "finite S" +proof - + have "independent (S - {0})" + apply (rule pairwise_orthogonal_independent) + apply (metis Diff_iff assms pairwise_def) + by blast + then show ?thesis + by (meson independent_imp_finite infinite_remove) +qed + +lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}" + by (simp add: subspace_def orthogonal_clauses) + +lemma subspace_orthogonal_to_vectors: "subspace {y. \x \ S. orthogonal x y}" + by (simp add: subspace_def orthogonal_clauses) + +lemma orthogonal_to_span: + assumes a: "a \ span S" and x: "\y. y \ S \ orthogonal x y" + shows "orthogonal x a" + by (metis a orthogonal_clauses(1,2,4) + span_induct_alt x) + +proposition Gram_Schmidt_step: + fixes S :: "'a::euclidean_space set" + assumes S: "pairwise orthogonal S" and x: "x \ span S" + shows "orthogonal x (a - (\b\S. (b \ a / (b \ b)) *\<^sub>R b))" +proof - + have "finite S" + by (simp add: S pairwise_orthogonal_imp_finite) + have "orthogonal (a - (\b\S. (b \ a / (b \ b)) *\<^sub>R b)) x" + if "x \ S" for x + proof - + have "a \ x = (\y\S. if y = x then y \ a else 0)" + by (simp add: \finite S\ inner_commute sum.delta that) + also have "... = (\b\S. b \ a * (b \ x) / (b \ b))" + apply (rule sum.cong [OF refl], simp) + by (meson S orthogonal_def pairwise_def that) + finally show ?thesis + by (simp add: orthogonal_def algebra_simps inner_sum_left) + qed + then show ?thesis + using orthogonal_to_span orthogonal_commute x by blast +qed + + +lemma orthogonal_extension_aux: + fixes S :: "'a::euclidean_space set" + assumes "finite T" "finite S" "pairwise orthogonal S" + shows "\U. pairwise orthogonal (S \ U) \ span (S \ U) = span (S \ T)" +using assms +proof (induction arbitrary: S) + case empty then show ?case + by simp (metis sup_bot_right) +next + case (insert a T) + have 0: "\x y. \x \ y; x \ S; y \ S\ \ x \ y = 0" + using insert by (simp add: pairwise_def orthogonal_def) + define a' where "a' = a - (\b\S. (b \ a / (b \ b)) *\<^sub>R b)" + obtain U where orthU: "pairwise orthogonal (S \ insert a' U)" + and spanU: "span (insert a' S \ U) = span (insert a' S \ T)" + by (rule exE [OF insert.IH [of "insert a' S"]]) + (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute + pairwise_orthogonal_insert span_clauses) + have orthS: "\x. x \ S \ a' \ x = 0" + apply (simp add: a'_def) + using Gram_Schmidt_step [OF \pairwise orthogonal S\] + apply (force simp: orthogonal_def inner_commute span_superset [THEN subsetD]) + done + have "span (S \ insert a' U) = span (insert a' (S \ T))" + using spanU by simp + also have "... = span (insert a (S \ T))" + apply (rule eq_span_insert_eq) + apply (simp add: a'_def span_neg span_sum span_base span_mul) + done + also have "... = span (S \ insert a T)" + by simp + finally show ?case + by (rule_tac x="insert a' U" in exI) (use orthU in auto) +qed + + +proposition orthogonal_extension: + fixes S :: "'a::euclidean_space set" + assumes S: "pairwise orthogonal S" + obtains U where "pairwise orthogonal (S \ U)" "span (S \ U) = span (S \ T)" +proof - + obtain B where "finite B" "span B = span T" + using basis_subspace_exists [of "span T"] subspace_span by metis + with orthogonal_extension_aux [of B S] + obtain U where "pairwise orthogonal (S \ U)" "span (S \ U) = span (S \ B)" + using assms pairwise_orthogonal_imp_finite by auto + with \span B = span T\ show ?thesis + by (rule_tac U=U in that) (auto simp: span_Un) +qed + +corollary%unimportant orthogonal_extension_strong: + fixes S :: "'a::euclidean_space set" + assumes S: "pairwise orthogonal S" + obtains U where "U \ (insert 0 S) = {}" "pairwise orthogonal (S \ U)" + "span (S \ U) = span (S \ T)" +proof - + obtain U where "pairwise orthogonal (S \ U)" "span (S \ U) = span (S \ T)" + using orthogonal_extension assms by blast + then show ?thesis + apply (rule_tac U = "U - (insert 0 S)" in that) + apply blast + apply (force simp: pairwise_def) + apply (metis Un_Diff_cancel Un_insert_left span_redundant span_zero) + done +qed + +subsection\Decomposing a vector into parts in orthogonal subspaces\ + +text\existence of orthonormal basis for a subspace.\ + +lemma orthogonal_spanningset_subspace: + fixes S :: "'a :: euclidean_space set" + assumes "subspace S" + obtains B where "B \ S" "pairwise orthogonal B" "span B = S" +proof - + obtain B where "B \ S" "independent B" "S \ span B" "card B = dim S" + using basis_exists by blast + with orthogonal_extension [of "{}" B] + show ?thesis + by (metis Un_empty_left assms pairwise_empty span_superset span_subspace that) +qed + +lemma orthogonal_basis_subspace: + fixes S :: "'a :: euclidean_space set" + assumes "subspace S" + obtains B where "0 \ B" "B \ S" "pairwise orthogonal B" "independent B" + "card B = dim S" "span B = S" +proof - + obtain B where "B \ S" "pairwise orthogonal B" "span B = S" + using assms orthogonal_spanningset_subspace by blast + then show ?thesis + apply (rule_tac B = "B - {0}" in that) + apply (auto simp: indep_card_eq_dim_span pairwise_subset pairwise_orthogonal_independent elim: pairwise_subset) + done +qed + +proposition orthonormal_basis_subspace: + fixes S :: "'a :: euclidean_space set" + assumes "subspace S" + obtains B where "B \ S" "pairwise orthogonal B" + and "\x. x \ B \ norm x = 1" + and "independent B" "card B = dim S" "span B = S" +proof - + obtain B where "0 \ B" "B \ S" + and orth: "pairwise orthogonal B" + and "independent B" "card B = dim S" "span B = S" + by (blast intro: orthogonal_basis_subspace [OF assms]) + have 1: "(\x. x /\<^sub>R norm x) ` B \ S" + using \span B = S\ span_superset span_mul by fastforce + have 2: "pairwise orthogonal ((\x. x /\<^sub>R norm x) ` B)" + using orth by (force simp: pairwise_def orthogonal_clauses) + have 3: "\x. x \ (\x. x /\<^sub>R norm x) ` B \ norm x = 1" + by (metis (no_types, lifting) \0 \ B\ image_iff norm_sgn sgn_div_norm) + have 4: "independent ((\x. x /\<^sub>R norm x) ` B)" + by (metis "2" "3" norm_zero pairwise_orthogonal_independent zero_neq_one) + have "inj_on (\x. x /\<^sub>R norm x) B" + proof + fix x y + assume "x \ B" "y \ B" "x /\<^sub>R norm x = y /\<^sub>R norm y" + moreover have "\i. i \ B \ norm (i /\<^sub>R norm i) = 1" + using 3 by blast + ultimately show "x = y" + by (metis norm_eq_1 orth orthogonal_clauses(7) orthogonal_commute orthogonal_def pairwise_def zero_neq_one) + qed + then have 5: "card ((\x. x /\<^sub>R norm x) ` B) = dim S" + by (metis \card B = dim S\ card_image) + have 6: "span ((\x. x /\<^sub>R norm x) ` B) = S" + by (metis "1" "4" "5" assms card_eq_dim independent_imp_finite span_subspace) + show ?thesis + by (rule that [OF 1 2 3 4 5 6]) +qed + + +proposition%unimportant orthogonal_to_subspace_exists_gen: + fixes S :: "'a :: euclidean_space set" + assumes "span S \ span T" + obtains x where "x \ 0" "x \ span T" "\y. y \ span S \ orthogonal x y" +proof - + obtain B where "B \ span S" and orthB: "pairwise orthogonal B" + and "\x. x \ B \ norm x = 1" + and "independent B" "card B = dim S" "span B = span S" + by (rule orthonormal_basis_subspace [of "span S", OF subspace_span]) + (auto simp: dim_span) + with assms obtain u where spanBT: "span B \ span T" and "u \ span B" "u \ span T" + by auto + obtain C where orthBC: "pairwise orthogonal (B \ C)" and spanBC: "span (B \ C) = span (B \ {u})" + by (blast intro: orthogonal_extension [OF orthB]) + show thesis + proof (cases "C \ insert 0 B") + case True + then have "C \ span B" + using span_eq + by (metis span_insert_0 subset_trans) + moreover have "u \ span (B \ C)" + using \span (B \ C) = span (B \ {u})\ span_superset by force + ultimately show ?thesis + using True \u \ span B\ + by (metis Un_insert_left span_insert_0 sup.orderE) + next + case False + then obtain x where "x \ C" "x \ 0" "x \ B" + by blast + then have "x \ span T" + by (metis (no_types, lifting) Un_insert_right Un_upper2 \u \ span T\ spanBT spanBC + \u \ span T\ insert_subset span_superset span_mono + span_span subsetCE subset_trans sup_bot.comm_neutral) + moreover have "orthogonal x y" if "y \ span B" for y + using that + proof (rule span_induct) + show "subspace {a. orthogonal x a}" + by (simp add: subspace_orthogonal_to_vector) + show "\b. b \ B \ orthogonal x b" + by (metis Un_iff \x \ C\ \x \ B\ orthBC pairwise_def) + qed + ultimately show ?thesis + using \x \ 0\ that \span B = span S\ by auto + qed +qed + +corollary%unimportant orthogonal_to_subspace_exists: + fixes S :: "'a :: euclidean_space set" + assumes "dim S < DIM('a)" + obtains x where "x \ 0" "\y. y \ span S \ orthogonal x y" +proof - +have "span S \ UNIV" + by (metis (mono_tags) UNIV_I assms inner_eq_zero_iff less_le lowdim_subset_hyperplane + mem_Collect_eq top.extremum_strict top.not_eq_extremum) + with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis + by (auto simp: span_UNIV) +qed + +corollary%unimportant orthogonal_to_vector_exists: + fixes x :: "'a :: euclidean_space" + assumes "2 \ DIM('a)" + obtains y where "y \ 0" "orthogonal x y" +proof - + have "dim {x} < DIM('a)" + using assms by auto + then show thesis + by (rule orthogonal_to_subspace_exists) (simp add: orthogonal_commute span_base that) +qed + +proposition%unimportant orthogonal_subspace_decomp_exists: + fixes S :: "'a :: euclidean_space set" + obtains y z + where "y \ span S" + and "\w. w \ span S \ orthogonal z w" + and "x = y + z" +proof - + obtain T where "0 \ T" "T \ span S" "pairwise orthogonal T" "independent T" + "card T = dim (span S)" "span T = span S" + using orthogonal_basis_subspace subspace_span by blast + let ?a = "\b\T. (b \ x / (b \ b)) *\<^sub>R b" + have orth: "orthogonal (x - ?a) w" if "w \ span S" for w + by (simp add: Gram_Schmidt_step \pairwise orthogonal T\ \span T = span S\ + orthogonal_commute that) + show ?thesis + apply (rule_tac y = "?a" and z = "x - ?a" in that) + apply (meson \T \ span S\ span_scale span_sum subsetCE) + apply (fact orth, simp) + done +qed + +lemma orthogonal_subspace_decomp_unique: + fixes S :: "'a :: euclidean_space set" + assumes "x + y = x' + y'" + and ST: "x \ span S" "x' \ span S" "y \ span T" "y' \ span T" + and orth: "\a b. \a \ S; b \ T\ \ orthogonal a b" + shows "x = x' \ y = y'" +proof - + have "x + y - y' = x'" + by (simp add: assms) + moreover have "\a b. \a \ span S; b \ span T\ \ orthogonal a b" + by (meson orth orthogonal_commute orthogonal_to_span) + ultimately have "0 = x' - x" + by (metis (full_types) add_diff_cancel_left' ST diff_right_commute orthogonal_clauses(10) orthogonal_clauses(5) orthogonal_self) + with assms show ?thesis by auto +qed + +lemma vector_in_orthogonal_spanningset: + fixes a :: "'a::euclidean_space" + obtains S where "a \ S" "pairwise orthogonal S" "span S = UNIV" + by (metis UNIV_I Un_iff empty_iff insert_subset orthogonal_extension pairwise_def + pairwise_orthogonal_insert span_UNIV subsetI subset_antisym) + +lemma vector_in_orthogonal_basis: + fixes a :: "'a::euclidean_space" + assumes "a \ 0" + obtains S where "a \ S" "0 \ S" "pairwise orthogonal S" "independent S" "finite S" + "span S = UNIV" "card S = DIM('a)" +proof - + obtain S where S: "a \ S" "pairwise orthogonal S" "span S = UNIV" + using vector_in_orthogonal_spanningset . + show thesis + proof + show "pairwise orthogonal (S - {0})" + using pairwise_mono S(2) by blast + show "independent (S - {0})" + by (simp add: \pairwise orthogonal (S - {0})\ pairwise_orthogonal_independent) + show "finite (S - {0})" + using \independent (S - {0})\ independent_imp_finite by blast + show "card (S - {0}) = DIM('a)" + using span_delete_0 [of S] S + by (simp add: \independent (S - {0})\ indep_card_eq_dim_span dim_UNIV) + qed (use S \a \ 0\ in auto) +qed + +lemma vector_in_orthonormal_basis: + fixes a :: "'a::euclidean_space" + assumes "norm a = 1" + obtains S where "a \ S" "pairwise orthogonal S" "\x. x \ S \ norm x = 1" + "independent S" "card S = DIM('a)" "span S = UNIV" +proof - + have "a \ 0" + using assms by auto + then obtain S where "a \ S" "0 \ S" "finite S" + and S: "pairwise orthogonal S" "independent S" "span S = UNIV" "card S = DIM('a)" + by (metis vector_in_orthogonal_basis) + let ?S = "(\x. x /\<^sub>R norm x) ` S" + show thesis + proof + show "a \ ?S" + using \a \ S\ assms image_iff by fastforce + next + show "pairwise orthogonal ?S" + using \pairwise orthogonal S\ by (auto simp: pairwise_def orthogonal_def) + show "\x. x \ (\x. x /\<^sub>R norm x) ` S \ norm x = 1" + using \0 \ S\ by (auto simp: divide_simps) + then show "independent ?S" + by (metis \pairwise orthogonal ((\x. x /\<^sub>R norm x) ` S)\ norm_zero pairwise_orthogonal_independent zero_neq_one) + have "inj_on (\x. x /\<^sub>R norm x) S" + unfolding inj_on_def + by (metis (full_types) S(1) \0 \ S\ inverse_nonzero_iff_nonzero norm_eq_zero orthogonal_scaleR orthogonal_self pairwise_def) + then show "card ?S = DIM('a)" + by (simp add: card_image S) + show "span ?S = UNIV" + by (metis (no_types) \0 \ S\ \finite S\ \span S = UNIV\ + field_class.field_inverse_zero inverse_inverse_eq less_irrefl span_image_scale + zero_less_norm_iff) + qed +qed + +proposition dim_orthogonal_sum: + fixes A :: "'a::euclidean_space set" + assumes "\x y. \x \ A; y \ B\ \ x \ y = 0" + shows "dim(A \ B) = dim A + dim B" +proof - + have 1: "\x y. \x \ span A; y \ B\ \ x \ y = 0" + by (erule span_induct [OF _ subspace_hyperplane2]; simp add: assms) + have "\x y. \x \ span A; y \ span B\ \ x \ y = 0" + using 1 by (simp add: span_induct [OF _ subspace_hyperplane]) + then have 0: "\x y. \x \ span A; y \ span B\ \ x \ y = 0" + by simp + have "dim(A \ B) = dim (span (A \ B))" + by (simp add: dim_span) + also have "span (A \ B) = ((\(a, b). a + b) ` (span A \ span B))" + by (auto simp add: span_Un image_def) + also have "dim \ = dim {x + y |x y. x \ span A \ y \ span B}" + by (auto intro!: arg_cong [where f=dim]) + also have "... = dim {x + y |x y. x \ span A \ y \ span B} + dim(span A \ span B)" + by (auto simp: dest: 0) + also have "... = dim (span A) + dim (span B)" + by (rule dim_sums_Int) (auto simp: subspace_span) + also have "... = dim A + dim B" + by (simp add: dim_span) + finally show ?thesis . +qed + +lemma dim_subspace_orthogonal_to_vectors: + fixes A :: "'a::euclidean_space set" + assumes "subspace A" "subspace B" "A \ B" + shows "dim {y \ B. \x \ A. orthogonal x y} + dim A = dim B" +proof - + have "dim (span ({y \ B. \x\A. orthogonal x y} \ A)) = dim (span B)" + proof (rule arg_cong [where f=dim, OF subset_antisym]) + show "span ({y \ B. \x\A. orthogonal x y} \ A) \ span B" + by (simp add: \A \ B\ Collect_restrict span_mono) + next + have *: "x \ span ({y \ B. \x\A. orthogonal x y} \ A)" + if "x \ B" for x + proof - + obtain y z where "x = y + z" "y \ span A" and orth: "\w. w \ span A \ orthogonal z w" + using orthogonal_subspace_decomp_exists [of A x] that by auto + have "y \ span B" + using \y \ span A\ assms(3) span_mono by blast + then have "z \ {a \ B. \x. x \ A \ orthogonal x a}" + apply simp + using \x = y + z\ assms(1) assms(2) orth orthogonal_commute span_add_eq + span_eq_iff that by blast + then have z: "z \ span {y \ B. \x\A. orthogonal x y}" + by (meson span_superset subset_iff) + then show ?thesis + apply (auto simp: span_Un image_def \x = y + z\ \y \ span A\) + using \y \ span A\ add.commute by blast + qed + show "span B \ span ({y \ B. \x\A. orthogonal x y} \ A)" + by (rule span_minimal) + (auto intro: * span_minimal simp: subspace_span) + qed + then show ?thesis + by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq + orthogonal_commute orthogonal_def) +qed + end diff -r fc252acb7100 -r 880ab0f27ddf src/HOL/Analysis/Starlike.thy --- a/src/HOL/Analysis/Starlike.thy Wed Jan 16 16:50:35 2019 -0500 +++ b/src/HOL/Analysis/Starlike.thy Wed Jan 16 18:14:02 2019 -0500 @@ -5469,103 +5469,6 @@ (if a = 0 \ r > 0 then -1 else DIM('a))" using aff_dim_halfspace_le [of "-a" "-r"] by simp -subsection\Properties of special hyperplanes\ - -lemma subspace_hyperplane: "subspace {x. a \ x = 0}" - by (simp add: subspace_def inner_right_distrib) - -lemma subspace_hyperplane2: "subspace {x. x \ a = 0}" - by (simp add: inner_commute inner_right_distrib subspace_def) - -lemma special_hyperplane_span: - fixes S :: "'n::euclidean_space set" - assumes "k \ Basis" - shows "{x. k \ x = 0} = span (Basis - {k})" -proof - - have *: "x \ span (Basis - {k})" if "k \ x = 0" for x - proof - - have "x = (\b\Basis. (x \ b) *\<^sub>R b)" - by (simp add: euclidean_representation) - also have "... = (\b \ Basis - {k}. (x \ b) *\<^sub>R b)" - by (auto simp: sum.remove [of _ k] inner_commute assms that) - finally have "x = (\b\Basis - {k}. (x \ b) *\<^sub>R b)" . - then show ?thesis - by (simp add: span_finite) - qed - show ?thesis - apply (rule span_subspace [symmetric]) - using assms - apply (auto simp: inner_not_same_Basis intro: * subspace_hyperplane) - done -qed - -lemma dim_special_hyperplane: - fixes k :: "'n::euclidean_space" - shows "k \ Basis \ dim {x. k \ x = 0} = DIM('n) - 1" -apply (simp add: special_hyperplane_span) -apply (rule dim_unique [OF subset_refl]) -apply (auto simp: independent_substdbasis) -apply (metis member_remove remove_def span_base) -done - -proposition dim_hyperplane: - fixes a :: "'a::euclidean_space" - assumes "a \ 0" - shows "dim {x. a \ x = 0} = DIM('a) - 1" -proof - - have span0: "span {x. a \ x = 0} = {x. a \ x = 0}" - by (rule span_unique) (auto simp: subspace_hyperplane) - then obtain B where "independent B" - and Bsub: "B \ {x. a \ x = 0}" - and subspB: "{x. a \ x = 0} \ span B" - and card0: "(card B = dim {x. a \ x = 0})" - and ortho: "pairwise orthogonal B" - using orthogonal_basis_exists by metis - with assms have "a \ span B" - by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0) - then have ind: "independent (insert a B)" - by (simp add: \independent B\ independent_insert) - have "finite B" - using \independent B\ independent_bound by blast - have "UNIV \ span (insert a B)" - proof fix y::'a - obtain r z where z: "y = r *\<^sub>R a + z" "a \ z = 0" - apply (rule_tac r="(a \ y) / (a \ a)" and z = "y - ((a \ y) / (a \ a)) *\<^sub>R a" in that) - using assms - by (auto simp: algebra_simps) - show "y \ span (insert a B)" - by (metis (mono_tags, lifting) z Bsub span_eq_iff - add_diff_cancel_left' mem_Collect_eq span0 span_breakdown_eq span_subspace subspB) - qed - then have dima: "DIM('a) = dim(insert a B)" - by (metis independent_Basis span_Basis dim_eq_card top.extremum_uniqueI) - then show ?thesis - by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \a \ span B\ ind card0 - card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE - subspB) -qed - -lemma lowdim_eq_hyperplane: - fixes S :: "'a::euclidean_space set" - assumes "dim S = DIM('a) - 1" - obtains a where "a \ 0" and "span S = {x. a \ x = 0}" -proof - - have dimS: "dim S < DIM('a)" - by (simp add: assms) - then obtain b where b: "b \ 0" "span S \ {a. b \ a = 0}" - using lowdim_subset_hyperplane [of S] by fastforce - show ?thesis - apply (rule that[OF b(1)]) - apply (rule subspace_dim_equal) - by (auto simp: assms b dim_hyperplane dim_span subspace_hyperplane - subspace_span) -qed - -lemma dim_eq_hyperplane: - fixes S :: "'n::euclidean_space set" - shows "dim S = DIM('n) - 1 \ (\a. a \ 0 \ span S = {x. a \ x = 0})" -by (metis One_nat_def dim_hyperplane dim_span lowdim_eq_hyperplane) - proposition aff_dim_eq_hyperplane: fixes S :: "'a::euclidean_space set" shows "aff_dim S = DIM('a) - 1 \ (\a b. a \ 0 \ affine hull S = {x. a \ x = b})" @@ -6436,444 +6339,6 @@ shows "aff_dim S < DIM('a) \ (affine hull S \ UNIV)" by (metis (no_types) aff_dim_affine_hull aff_dim_le_DIM aff_dim_UNIV affine_hull_UNIV less_le) - -subsection\ Orthogonal bases, Gram-Schmidt process, and related theorems\ - -lemma pairwise_orthogonal_independent: - assumes "pairwise orthogonal S" and "0 \ S" - shows "independent S" -proof - - have 0: "\x y. \x \ y; x \ S; y \ S\ \ x \ y = 0" - using assms by (simp add: pairwise_def orthogonal_def) - have "False" if "a \ S" and a: "a \ span (S - {a})" for a - proof - - obtain T U where "T \ S - {a}" "a = (\v\T. U v *\<^sub>R v)" - using a by (force simp: span_explicit) - then have "a \ a = a \ (\v\T. U v *\<^sub>R v)" - by simp - also have "... = 0" - apply (simp add: inner_sum_right) - apply (rule comm_monoid_add_class.sum.neutral) - by (metis "0" DiffE \T \ S - {a}\ mult_not_zero singletonI subsetCE \a \ S\) - finally show ?thesis - using \0 \ S\ \a \ S\ by auto - qed - then show ?thesis - by (force simp: dependent_def) -qed - -lemma pairwise_orthogonal_imp_finite: - fixes S :: "'a::euclidean_space set" - assumes "pairwise orthogonal S" - shows "finite S" -proof - - have "independent (S - {0})" - apply (rule pairwise_orthogonal_independent) - apply (metis Diff_iff assms pairwise_def) - by blast - then show ?thesis - by (meson independent_imp_finite infinite_remove) -qed - -lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}" - by (simp add: subspace_def orthogonal_clauses) - -lemma subspace_orthogonal_to_vectors: "subspace {y. \x \ S. orthogonal x y}" - by (simp add: subspace_def orthogonal_clauses) - -lemma orthogonal_to_span: - assumes a: "a \ span S" and x: "\y. y \ S \ orthogonal x y" - shows "orthogonal x a" - by (metis a orthogonal_clauses(1,2,4) - span_induct_alt x) - -proposition Gram_Schmidt_step: - fixes S :: "'a::euclidean_space set" - assumes S: "pairwise orthogonal S" and x: "x \ span S" - shows "orthogonal x (a - (\b\S. (b \ a / (b \ b)) *\<^sub>R b))" -proof - - have "finite S" - by (simp add: S pairwise_orthogonal_imp_finite) - have "orthogonal (a - (\b\S. (b \ a / (b \ b)) *\<^sub>R b)) x" - if "x \ S" for x - proof - - have "a \ x = (\y\S. if y = x then y \ a else 0)" - by (simp add: \finite S\ inner_commute sum.delta that) - also have "... = (\b\S. b \ a * (b \ x) / (b \ b))" - apply (rule sum.cong [OF refl], simp) - by (meson S orthogonal_def pairwise_def that) - finally show ?thesis - by (simp add: orthogonal_def algebra_simps inner_sum_left) - qed - then show ?thesis - using orthogonal_to_span orthogonal_commute x by blast -qed - - -lemma orthogonal_extension_aux: - fixes S :: "'a::euclidean_space set" - assumes "finite T" "finite S" "pairwise orthogonal S" - shows "\U. pairwise orthogonal (S \ U) \ span (S \ U) = span (S \ T)" -using assms -proof (induction arbitrary: S) - case empty then show ?case - by simp (metis sup_bot_right) -next - case (insert a T) - have 0: "\x y. \x \ y; x \ S; y \ S\ \ x \ y = 0" - using insert by (simp add: pairwise_def orthogonal_def) - define a' where "a' = a - (\b\S. (b \ a / (b \ b)) *\<^sub>R b)" - obtain U where orthU: "pairwise orthogonal (S \ insert a' U)" - and spanU: "span (insert a' S \ U) = span (insert a' S \ T)" - by (rule exE [OF insert.IH [of "insert a' S"]]) - (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute - pairwise_orthogonal_insert span_clauses) - have orthS: "\x. x \ S \ a' \ x = 0" - apply (simp add: a'_def) - using Gram_Schmidt_step [OF \pairwise orthogonal S\] - apply (force simp: orthogonal_def inner_commute span_superset [THEN subsetD]) - done - have "span (S \ insert a' U) = span (insert a' (S \ T))" - using spanU by simp - also have "... = span (insert a (S \ T))" - apply (rule eq_span_insert_eq) - apply (simp add: a'_def span_neg span_sum span_base span_mul) - done - also have "... = span (S \ insert a T)" - by simp - finally show ?case - by (rule_tac x="insert a' U" in exI) (use orthU in auto) -qed - - -proposition orthogonal_extension: - fixes S :: "'a::euclidean_space set" - assumes S: "pairwise orthogonal S" - obtains U where "pairwise orthogonal (S \ U)" "span (S \ U) = span (S \ T)" -proof - - obtain B where "finite B" "span B = span T" - using basis_subspace_exists [of "span T"] subspace_span by metis - with orthogonal_extension_aux [of B S] - obtain U where "pairwise orthogonal (S \ U)" "span (S \ U) = span (S \ B)" - using assms pairwise_orthogonal_imp_finite by auto - with \span B = span T\ show ?thesis - by (rule_tac U=U in that) (auto simp: span_Un) -qed - -corollary%unimportant orthogonal_extension_strong: - fixes S :: "'a::euclidean_space set" - assumes S: "pairwise orthogonal S" - obtains U where "U \ (insert 0 S) = {}" "pairwise orthogonal (S \ U)" - "span (S \ U) = span (S \ T)" -proof - - obtain U where "pairwise orthogonal (S \ U)" "span (S \ U) = span (S \ T)" - using orthogonal_extension assms by blast - then show ?thesis - apply (rule_tac U = "U - (insert 0 S)" in that) - apply blast - apply (force simp: pairwise_def) - apply (metis Un_Diff_cancel Un_insert_left span_redundant span_zero) - done -qed - -subsection\Decomposing a vector into parts in orthogonal subspaces\ - -text\existence of orthonormal basis for a subspace.\ - -lemma orthogonal_spanningset_subspace: - fixes S :: "'a :: euclidean_space set" - assumes "subspace S" - obtains B where "B \ S" "pairwise orthogonal B" "span B = S" -proof - - obtain B where "B \ S" "independent B" "S \ span B" "card B = dim S" - using basis_exists by blast - with orthogonal_extension [of "{}" B] - show ?thesis - by (metis Un_empty_left assms pairwise_empty span_superset span_subspace that) -qed - -lemma orthogonal_basis_subspace: - fixes S :: "'a :: euclidean_space set" - assumes "subspace S" - obtains B where "0 \ B" "B \ S" "pairwise orthogonal B" "independent B" - "card B = dim S" "span B = S" -proof - - obtain B where "B \ S" "pairwise orthogonal B" "span B = S" - using assms orthogonal_spanningset_subspace by blast - then show ?thesis - apply (rule_tac B = "B - {0}" in that) - apply (auto simp: indep_card_eq_dim_span pairwise_subset pairwise_orthogonal_independent elim: pairwise_subset) - done -qed - -proposition orthonormal_basis_subspace: - fixes S :: "'a :: euclidean_space set" - assumes "subspace S" - obtains B where "B \ S" "pairwise orthogonal B" - and "\x. x \ B \ norm x = 1" - and "independent B" "card B = dim S" "span B = S" -proof - - obtain B where "0 \ B" "B \ S" - and orth: "pairwise orthogonal B" - and "independent B" "card B = dim S" "span B = S" - by (blast intro: orthogonal_basis_subspace [OF assms]) - have 1: "(\x. x /\<^sub>R norm x) ` B \ S" - using \span B = S\ span_superset span_mul by fastforce - have 2: "pairwise orthogonal ((\x. x /\<^sub>R norm x) ` B)" - using orth by (force simp: pairwise_def orthogonal_clauses) - have 3: "\x. x \ (\x. x /\<^sub>R norm x) ` B \ norm x = 1" - by (metis (no_types, lifting) \0 \ B\ image_iff norm_sgn sgn_div_norm) - have 4: "independent ((\x. x /\<^sub>R norm x) ` B)" - by (metis "2" "3" norm_zero pairwise_orthogonal_independent zero_neq_one) - have "inj_on (\x. x /\<^sub>R norm x) B" - proof - fix x y - assume "x \ B" "y \ B" "x /\<^sub>R norm x = y /\<^sub>R norm y" - moreover have "\i. i \ B \ norm (i /\<^sub>R norm i) = 1" - using 3 by blast - ultimately show "x = y" - by (metis norm_eq_1 orth orthogonal_clauses(7) orthogonal_commute orthogonal_def pairwise_def zero_neq_one) - qed - then have 5: "card ((\x. x /\<^sub>R norm x) ` B) = dim S" - by (metis \card B = dim S\ card_image) - have 6: "span ((\x. x /\<^sub>R norm x) ` B) = S" - by (metis "1" "4" "5" assms card_eq_dim independent_finite span_subspace) - show ?thesis - by (rule that [OF 1 2 3 4 5 6]) -qed - - -proposition%unimportant orthogonal_to_subspace_exists_gen: - fixes S :: "'a :: euclidean_space set" - assumes "span S \ span T" - obtains x where "x \ 0" "x \ span T" "\y. y \ span S \ orthogonal x y" -proof - - obtain B where "B \ span S" and orthB: "pairwise orthogonal B" - and "\x. x \ B \ norm x = 1" - and "independent B" "card B = dim S" "span B = span S" - by (rule orthonormal_basis_subspace [of "span S", OF subspace_span]) - (auto simp: dim_span) - with assms obtain u where spanBT: "span B \ span T" and "u \ span B" "u \ span T" - by auto - obtain C where orthBC: "pairwise orthogonal (B \ C)" and spanBC: "span (B \ C) = span (B \ {u})" - by (blast intro: orthogonal_extension [OF orthB]) - show thesis - proof (cases "C \ insert 0 B") - case True - then have "C \ span B" - using span_eq - by (metis span_insert_0 subset_trans) - moreover have "u \ span (B \ C)" - using \span (B \ C) = span (B \ {u})\ span_superset by force - ultimately show ?thesis - using True \u \ span B\ - by (metis Un_insert_left span_insert_0 sup.orderE) - next - case False - then obtain x where "x \ C" "x \ 0" "x \ B" - by blast - then have "x \ span T" - by (metis (no_types, lifting) Un_insert_right Un_upper2 \u \ span T\ spanBT spanBC - \u \ span T\ insert_subset span_superset span_mono - span_span subsetCE subset_trans sup_bot.comm_neutral) - moreover have "orthogonal x y" if "y \ span B" for y - using that - proof (rule span_induct) - show "subspace {a. orthogonal x a}" - by (simp add: subspace_orthogonal_to_vector) - show "\b. b \ B \ orthogonal x b" - by (metis Un_iff \x \ C\ \x \ B\ orthBC pairwise_def) - qed - ultimately show ?thesis - using \x \ 0\ that \span B = span S\ by auto - qed -qed - -corollary%unimportant orthogonal_to_subspace_exists: - fixes S :: "'a :: euclidean_space set" - assumes "dim S < DIM('a)" - obtains x where "x \ 0" "\y. y \ span S \ orthogonal x y" -proof - -have "span S \ UNIV" - by (metis (mono_tags) UNIV_I assms inner_eq_zero_iff less_le lowdim_subset_hyperplane - mem_Collect_eq top.extremum_strict top.not_eq_extremum) - with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis - by (auto simp: span_UNIV) -qed - -corollary%unimportant orthogonal_to_vector_exists: - fixes x :: "'a :: euclidean_space" - assumes "2 \ DIM('a)" - obtains y where "y \ 0" "orthogonal x y" -proof - - have "dim {x} < DIM('a)" - using assms by auto - then show thesis - by (rule orthogonal_to_subspace_exists) (simp add: orthogonal_commute span_base that) -qed - -proposition%unimportant orthogonal_subspace_decomp_exists: - fixes S :: "'a :: euclidean_space set" - obtains y z - where "y \ span S" - and "\w. w \ span S \ orthogonal z w" - and "x = y + z" -proof - - obtain T where "0 \ T" "T \ span S" "pairwise orthogonal T" "independent T" - "card T = dim (span S)" "span T = span S" - using orthogonal_basis_subspace subspace_span by blast - let ?a = "\b\T. (b \ x / (b \ b)) *\<^sub>R b" - have orth: "orthogonal (x - ?a) w" if "w \ span S" for w - by (simp add: Gram_Schmidt_step \pairwise orthogonal T\ \span T = span S\ - orthogonal_commute that) - show ?thesis - apply (rule_tac y = "?a" and z = "x - ?a" in that) - apply (meson \T \ span S\ span_scale span_sum subsetCE) - apply (fact orth, simp) - done -qed - -lemma orthogonal_subspace_decomp_unique: - fixes S :: "'a :: euclidean_space set" - assumes "x + y = x' + y'" - and ST: "x \ span S" "x' \ span S" "y \ span T" "y' \ span T" - and orth: "\a b. \a \ S; b \ T\ \ orthogonal a b" - shows "x = x' \ y = y'" -proof - - have "x + y - y' = x'" - by (simp add: assms) - moreover have "\a b. \a \ span S; b \ span T\ \ orthogonal a b" - by (meson orth orthogonal_commute orthogonal_to_span) - ultimately have "0 = x' - x" - by (metis (full_types) add_diff_cancel_left' ST diff_right_commute orthogonal_clauses(10) orthogonal_clauses(5) orthogonal_self) - with assms show ?thesis by auto -qed - -lemma vector_in_orthogonal_spanningset: - fixes a :: "'a::euclidean_space" - obtains S where "a \ S" "pairwise orthogonal S" "span S = UNIV" - by (metis UNIV_I Un_iff empty_iff insert_subset orthogonal_extension pairwise_def - pairwise_orthogonal_insert span_UNIV subsetI subset_antisym) - -lemma vector_in_orthogonal_basis: - fixes a :: "'a::euclidean_space" - assumes "a \ 0" - obtains S where "a \ S" "0 \ S" "pairwise orthogonal S" "independent S" "finite S" - "span S = UNIV" "card S = DIM('a)" -proof - - obtain S where S: "a \ S" "pairwise orthogonal S" "span S = UNIV" - using vector_in_orthogonal_spanningset . - show thesis - proof - show "pairwise orthogonal (S - {0})" - using pairwise_mono S(2) by blast - show "independent (S - {0})" - by (simp add: \pairwise orthogonal (S - {0})\ pairwise_orthogonal_independent) - show "finite (S - {0})" - using \independent (S - {0})\ independent_finite by blast - show "card (S - {0}) = DIM('a)" - using span_delete_0 [of S] S - by (simp add: \independent (S - {0})\ indep_card_eq_dim_span dim_UNIV) - qed (use S \a \ 0\ in auto) -qed - -lemma vector_in_orthonormal_basis: - fixes a :: "'a::euclidean_space" - assumes "norm a = 1" - obtains S where "a \ S" "pairwise orthogonal S" "\x. x \ S \ norm x = 1" - "independent S" "card S = DIM('a)" "span S = UNIV" -proof - - have "a \ 0" - using assms by auto - then obtain S where "a \ S" "0 \ S" "finite S" - and S: "pairwise orthogonal S" "independent S" "span S = UNIV" "card S = DIM('a)" - by (metis vector_in_orthogonal_basis) - let ?S = "(\x. x /\<^sub>R norm x) ` S" - show thesis - proof - show "a \ ?S" - using \a \ S\ assms image_iff by fastforce - next - show "pairwise orthogonal ?S" - using \pairwise orthogonal S\ by (auto simp: pairwise_def orthogonal_def) - show "\x. x \ (\x. x /\<^sub>R norm x) ` S \ norm x = 1" - using \0 \ S\ by (auto simp: divide_simps) - then show "independent ?S" - by (metis \pairwise orthogonal ((\x. x /\<^sub>R norm x) ` S)\ norm_zero pairwise_orthogonal_independent zero_neq_one) - have "inj_on (\x. x /\<^sub>R norm x) S" - unfolding inj_on_def - by (metis (full_types) S(1) \0 \ S\ inverse_nonzero_iff_nonzero norm_eq_zero orthogonal_scaleR orthogonal_self pairwise_def) - then show "card ?S = DIM('a)" - by (simp add: card_image S) - show "span ?S = UNIV" - by (metis (no_types) \0 \ S\ \finite S\ \span S = UNIV\ - field_class.field_inverse_zero inverse_inverse_eq less_irrefl span_image_scale - zero_less_norm_iff) - qed -qed - -proposition dim_orthogonal_sum: - fixes A :: "'a::euclidean_space set" - assumes "\x y. \x \ A; y \ B\ \ x \ y = 0" - shows "dim(A \ B) = dim A + dim B" -proof - - have 1: "\x y. \x \ span A; y \ B\ \ x \ y = 0" - by (erule span_induct [OF _ subspace_hyperplane2]; simp add: assms) - have "\x y. \x \ span A; y \ span B\ \ x \ y = 0" - using 1 by (simp add: span_induct [OF _ subspace_hyperplane]) - then have 0: "\x y. \x \ span A; y \ span B\ \ x \ y = 0" - by simp - have "dim(A \ B) = dim (span (A \ B))" - by (simp add: dim_span) - also have "span (A \ B) = ((\(a, b). a + b) ` (span A \ span B))" - by (auto simp add: span_Un image_def) - also have "dim \ = dim {x + y |x y. x \ span A \ y \ span B}" - by (auto intro!: arg_cong [where f=dim]) - also have "... = dim {x + y |x y. x \ span A \ y \ span B} + dim(span A \ span B)" - by (auto simp: dest: 0) - also have "... = dim (span A) + dim (span B)" - by (rule dim_sums_Int) (auto simp: subspace_span) - also have "... = dim A + dim B" - by (simp add: dim_span) - finally show ?thesis . -qed - -lemma dim_subspace_orthogonal_to_vectors: - fixes A :: "'a::euclidean_space set" - assumes "subspace A" "subspace B" "A \ B" - shows "dim {y \ B. \x \ A. orthogonal x y} + dim A = dim B" -proof - - have "dim (span ({y \ B. \x\A. orthogonal x y} \ A)) = dim (span B)" - proof (rule arg_cong [where f=dim, OF subset_antisym]) - show "span ({y \ B. \x\A. orthogonal x y} \ A) \ span B" - by (simp add: \A \ B\ Collect_restrict span_mono) - next - have *: "x \ span ({y \ B. \x\A. orthogonal x y} \ A)" - if "x \ B" for x - proof - - obtain y z where "x = y + z" "y \ span A" and orth: "\w. w \ span A \ orthogonal z w" - using orthogonal_subspace_decomp_exists [of A x] that by auto - have "y \ span B" - using \y \ span A\ assms(3) span_mono by blast - then have "z \ {a \ B. \x. x \ A \ orthogonal x a}" - apply simp - using \x = y + z\ assms(1) assms(2) orth orthogonal_commute span_add_eq - span_eq_iff that by blast - then have z: "z \ span {y \ B. \x\A. orthogonal x y}" - by (meson span_superset subset_iff) - then show ?thesis - apply (auto simp: span_Un image_def \x = y + z\ \y \ span A\) - using \y \ span A\ add.commute by blast - qed - show "span B \ span ({y \ B. \x\A. orthogonal x y} \ A)" - by (rule span_minimal) - (auto intro: * span_minimal simp: subspace_span) - qed - then show ?thesis - by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq - orthogonal_commute orthogonal_def) -qed - lemma aff_dim_openin: fixes S :: "'a::euclidean_space set" assumes ope: "openin (subtopology euclidean T) S" and "affine T" "S \ {}"