# HG changeset patch # User Angeliki KoutsoukouArgyraki # Date 1547741321 0 # Node ID a8faf6f15da7a6cff61c47595bbe4c0a9f0cf9b1 # Parent 0f4d4a13dc16459e71a81d1465e328db9b6754fb# Parent 56acd449da41acb13ce5e71ea4f01dbe037c2077 merge diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Analysis.thy --- a/src/HOL/Analysis/Analysis.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Analysis.thy Thu Jan 17 16:08:41 2019 +0000 @@ -1,5 +1,20 @@ theory Analysis -imports + imports + (* Linear Algebra *) + Convex + Determinants + (* Topology *) + Connected + (* Functional Analysis *) + Elementary_Normed_Spaces + Norm_Arith + (* Vector Analysis *) + Convex_Euclidean_Space + (* Measure and Integration Theory *) + Ball_Volume + Integral_Test + Improper_Integral + (* Unsorted *) Lebesgue_Integral_Substitution Improper_Integral Embed_Measure diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Cartesian_Space.thy --- a/src/HOL/Analysis/Cartesian_Space.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Cartesian_Space.thy Thu Jan 17 16:08:41 2019 +0000 @@ -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 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Change_Of_Vars.thy --- a/src/HOL/Analysis/Change_Of_Vars.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Change_Of_Vars.thy Thu Jan 17 16:08:41 2019 +0000 @@ -9,258 +9,51 @@ begin -subsection%important\Induction on matrix row operations\ -(*FIX move first 3 lemmas of subsection to linear algebra, contain technical tools on matrix operations. -Keep the rest of the subsection contents in this theory but rename the subsection, they refer -to lebesgue measure -*) -lemma 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 +subsection%unimportant \Orthogonal Transformation of Balls\ + +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 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 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 matrix_vector_mult_matrix_matrix_mult_compose: - "(*v) (A ** B) = (*v) A \ (*v) B" - by (auto simp: matrix_vector_mul_assoc) - -lemma 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) +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 -proposition (*FIX needs name *) +subsection \Measurable Shear and Stretch\ + +proposition%important fixes a :: "real^'n" assumes "m \ n" and ab_ne: "cbox a b \ {}" and an: "0 \ a$n" shows measurable_shear_interval: "(\x. \ i. if i = m then x$m + x$n else x$i) ` (cbox a b) \ lmeasurable" (is "?f ` _ \ _") and measure_shear_interval: "measure lebesgue ((\x. \ i. if i = m then x$m + x$n else x$i) ` cbox a b) = measure lebesgue (cbox a b)" (is "?Q") -proof - +proof%unimportant - have lin: "linear ?f" by (rule linearI) (auto simp: plus_vec_def scaleR_vec_def algebra_simps) show fab: "?f ` cbox a b \ lmeasurable" @@ -362,13 +155,13 @@ qed -proposition (*FIX needs name *) +proposition%important fixes S :: "(real^'n) set" assumes "S \ lmeasurable" shows measurable_stretch: "((\x. \ k. m k * x$k) ` S) \ lmeasurable" (is "?f ` S \ _") and measure_stretch: "measure lebesgue ((\x. \ k. m k * x$k) ` S) = \prod m UNIV\ * measure lebesgue S" (is "?MEQ") -proof - +proof%unimportant - have "(?f ` S) \ lmeasurable \ ?MEQ" proof (cases "\k. m k \ 0") case True @@ -466,12 +259,12 @@ qed -proposition (*FIX needs name *) +proposition%important fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes "linear f" "S \ lmeasurable" shows measurable_linear_image: "(f ` S) \ lmeasurable" and measure_linear_image: "measure lebesgue (f ` S) = \det (matrix f)\ * measure lebesgue S" (is "?Q f S") -proof - +proof%unimportant - have "\S \ lmeasurable. (f ` S) \ lmeasurable \ ?Q f S" proof (rule induct_linear_elementary [OF \linear f\]; intro ballI) fix f g and S :: "(real,'n) vec set" @@ -614,7 +407,7 @@ qed -lemma (* needs name *) +lemma%unimportant fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes f: "orthogonal_transformation f" and S: "S \ lmeasurable" shows measurable_orthogonal_image: "f ` S \ lmeasurable" @@ -637,10 +430,10 @@ inductive%important gdelta :: "'a::topological_space set \ bool" where "(\n::nat. open (F n)) \ gdelta (\(F ` UNIV))" -proposition fsigma_Union_compact: +lemma%important fsigma_Union_compact: fixes S :: "'a::{real_normed_vector,heine_borel} set" shows "fsigma S \ (\F::nat \ 'a set. range F \ Collect compact \ S = \(F ` UNIV))" -proof safe +proof%unimportant safe assume "fsigma S" then obtain F :: "nat \ 'a set" where F: "range F \ Collect closed" "S = \(F ` UNIV)" by (meson fsigma.cases image_subsetI mem_Collect_eq) @@ -671,7 +464,7 @@ by (simp add: compact_imp_closed fsigma.intros image_subset_iff) qed -lemma gdelta_imp_fsigma: "gdelta S \ fsigma (- S)" +lemma%unimportant gdelta_imp_fsigma: "gdelta S \ fsigma (- S)" proof (induction rule: gdelta.induct) case (1 F) have "- \(F ` UNIV) = (\i. -(F i))" @@ -680,7 +473,7 @@ by (simp add: fsigma.intros closed_Compl 1) qed -lemma fsigma_imp_gdelta: "fsigma S \ gdelta (- S)" +lemma%unimportant fsigma_imp_gdelta: "fsigma S \ gdelta (- S)" proof (induction rule: fsigma.induct) case (1 F) have "- \(F ` UNIV) = (\i. -(F i))" @@ -689,11 +482,11 @@ by (simp add: 1 gdelta.intros open_closed) qed -lemma gdelta_complement: "gdelta(- S) \ fsigma S" +lemma%unimportant gdelta_complement: "gdelta(- S) \ fsigma S" using fsigma_imp_gdelta gdelta_imp_fsigma by force text\A Lebesgue set is almost an \F_sigma\ or \G_delta\.\ -lemma lebesgue_set_almost_fsigma: +lemma%unimportant lebesgue_set_almost_fsigma: assumes "S \ sets lebesgue" obtains C T where "fsigma C" "negligible T" "C \ T = S" "disjnt C T" proof - @@ -728,7 +521,7 @@ qed qed -lemma lebesgue_set_almost_gdelta: +lemma%unimportant lebesgue_set_almost_gdelta: assumes "S \ sets lebesgue" obtains C T where "gdelta C" "negligible T" "S \ T = C" "disjnt S T" proof - @@ -746,12 +539,12 @@ qed -proposition measure_semicontinuous_with_hausdist_explicit: +proposition%important measure_semicontinuous_with_hausdist_explicit: assumes "bounded S" and neg: "negligible(frontier S)" and "e > 0" obtains d where "d > 0" "\T. \T \ lmeasurable; \y. y \ T \ \x. x \ S \ dist x y < d\ \ measure lebesgue T < measure lebesgue S + e" -proof (cases "S = {}") +proof%unimportant (cases "S = {}") case True with that \e > 0\ show ?thesis by force next @@ -815,10 +608,10 @@ qed qed -proposition lebesgue_regular_inner: +proposition%important lebesgue_regular_inner: assumes "S \ sets lebesgue" obtains K C where "negligible K" "\n::nat. compact(C n)" "S = (\n. C n) \ K" -proof - +proof%unimportant - have "\T. closed T \ T \ S \ (S - T) \ lmeasurable \ measure lebesgue (S - T) < (1/2)^n" for n using sets_lebesgue_inner_closed assms by (metis sets_lebesgue_inner_closed zero_less_divide_1_iff zero_less_numeral zero_less_power) @@ -868,7 +661,7 @@ qed -lemma sets_lebesgue_continuous_image: +lemma%unimportant sets_lebesgue_continuous_image: assumes T: "T \ sets lebesgue" and contf: "continuous_on S f" and negim: "\T. \negligible T; T \ S\ \ negligible(f ` T)" and "T \ S" shows "f ` T \ sets lebesgue" @@ -893,7 +686,7 @@ by (simp add: Teq image_Un image_Union) qed -lemma differentiable_image_in_sets_lebesgue: +lemma%unimportant differentiable_image_in_sets_lebesgue: fixes f :: "'m::euclidean_space \ 'n::euclidean_space" assumes S: "S \ sets lebesgue" and dim: "DIM('m) \ DIM('n)" and f: "f differentiable_on S" shows "f`S \ sets lebesgue" @@ -905,7 +698,7 @@ by (auto simp: intro!: negligible_differentiable_image_negligible [OF dim]) qed auto -lemma sets_lebesgue_on_continuous_image: +lemma%unimportant sets_lebesgue_on_continuous_image: assumes S: "S \ sets lebesgue" and X: "X \ sets (lebesgue_on S)" and contf: "continuous_on S f" and negim: "\T. \negligible T; T \ S\ \ negligible(f ` T)" shows "f ` X \ sets (lebesgue_on (f ` S))" @@ -920,7 +713,7 @@ by (auto simp: sets_restrict_space_iff) qed -lemma differentiable_image_in_sets_lebesgue_on: +lemma%unimportant differentiable_image_in_sets_lebesgue_on: fixes f :: "'m::euclidean_space \ 'n::euclidean_space" assumes S: "S \ sets lebesgue" and X: "X \ sets (lebesgue_on S)" and dim: "DIM('m) \ DIM('n)" and f: "f differentiable_on S" @@ -934,7 +727,7 @@ qed -proposition (*FIX needs name *) +proposition%important fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes S: "S \ lmeasurable" and deriv: "\x. x \ S \ (f has_derivative f' x) (at x within S)" @@ -944,7 +737,7 @@ "f ` S \ lmeasurable" and measure_bounded_differentiable_image: "measure lebesgue (f ` S) \ B * measure lebesgue S" (is "?M") -proof - +proof%unimportant - have "f ` S \ lmeasurable \ measure lebesgue (f ` S) \ B * measure lebesgue S" proof (cases "B < 0") case True @@ -1170,13 +963,13 @@ then show "f ` S \ lmeasurable" ?M by blast+ qed -proposition (*FIX needs name *) +lemma%important fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes S: "S \ lmeasurable" and deriv: "\x. x \ S \ (f has_derivative f' x) (at x within S)" and int: "(\x. \det (matrix (f' x))\) integrable_on S" shows m_diff_image_weak: "f ` S \ lmeasurable \ measure lebesgue (f ` S) \ integral S (\x. \det (matrix (f' x))\)" -proof - +proof%unimportant - let ?\ = "measure lebesgue" have aint_S: "(\x. \det (matrix (f' x))\) absolutely_integrable_on S" using int unfolding absolutely_integrable_on_def by auto @@ -1368,7 +1161,7 @@ qed -theorem (*FIX needs name *) +theorem%important fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes S: "S \ sets lebesgue" and deriv: "\x. x \ S \ (f has_derivative f' x) (at x within S)" @@ -1376,7 +1169,7 @@ shows measurable_differentiable_image: "f ` S \ lmeasurable" and measure_differentiable_image: "measure lebesgue (f ` S) \ integral S (\x. \det (matrix (f' x))\)" (is "?M") -proof - +proof%unimportant - let ?I = "\n::nat. cbox (vec (-n)) (vec n) \ S" let ?\ = "measure lebesgue" have "x \ cbox (vec (- real (nat \norm x\))) (vec (real (nat \norm x\)))" for x :: "real^'n::_" @@ -1421,7 +1214,7 @@ qed -lemma borel_measurable_simple_function_limit_increasing: +lemma%unimportant borel_measurable_simple_function_limit_increasing: fixes f :: "'a::euclidean_space \ real" shows "(f \ borel_measurable lebesgue \ (\x. 0 \ f x)) \ (\g. (\n x. 0 \ g n x \ g n x \ f x) \ (\n x. g n x \ (g(Suc n) x)) \ @@ -1620,7 +1413,7 @@ subsection%important\Borel measurable Jacobian determinant\ -lemma lemma_partial_derivatives0: +lemma%unimportant lemma_partial_derivatives0: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes "linear f" and lim0: "((\x. f x /\<^sub>R norm x) \ 0) (at 0 within S)" and lb: "\v. v \ 0 \ (\k>0. \e>0. \x. x \ S - {0} \ norm x < e \ k * norm x \ \v \ x\)" @@ -1693,7 +1486,7 @@ mem_Collect_eq module_hom_zero span_base span_raw_def) qed -lemma lemma_partial_derivatives: +lemma%unimportant lemma_partial_derivatives: fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes "linear f" and lim: "((\x. f (x - a) /\<^sub>R norm (x - a)) \ 0) (at a within S)" and lb: "\v. v \ 0 \ (\k>0. \e>0. \x \ S - {a}. norm(a - x) < e \ k * norm(a - x) \ \v \ (x - a)\)" @@ -1711,12 +1504,12 @@ qed -proposition borel_measurable_partial_derivatives: +proposition%important borel_measurable_partial_derivatives: fixes f :: "real^'m::{finite,wellorder} \ real^'n" assumes S: "S \ sets lebesgue" and f: "\x. x \ S \ (f has_derivative f' x) (at x within S)" shows "(\x. (matrix(f' x)$m$n)) \ borel_measurable (lebesgue_on S)" -proof - +proof%unimportant - have contf: "continuous_on S f" using continuous_on_eq_continuous_within f has_derivative_continuous by blast have "{x \ S. (matrix (f' x)$m$n) \ b} \ sets lebesgue" for b @@ -2302,7 +2095,7 @@ qed -theorem borel_measurable_det_Jacobian: +theorem%important borel_measurable_det_Jacobian: fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes S: "S \ sets lebesgue" and f: "\x. x \ S \ (f has_derivative f' x) (at x within S)" shows "(\x. det(matrix(f' x))) \ borel_measurable (lebesgue_on S)" @@ -2316,7 +2109,7 @@ assumes "S \ sets lebesgue" shows "f \ borel_measurable (lebesgue_on S) \ (\T. T \ sets borel \ {x \ S. f x \ T} \ sets lebesgue)" -proof - +proof%unimportant - have "{x. (if x \ S then f x else 0) \ T} \ sets lebesgue \ {x \ S. f x \ T} \ sets lebesgue" if "T \ sets borel" for T proof (cases "0 \ T") @@ -2338,7 +2131,7 @@ by blast qed -lemma sets_lebesgue_almost_borel: +lemma%unimportant sets_lebesgue_almost_borel: assumes "S \ sets lebesgue" obtains B N where "B \ sets borel" "negligible N" "B \ N = S" proof - @@ -2348,7 +2141,7 @@ by (metis negligible_iff_null_sets negligible_subset null_sets_completionI that) qed -lemma double_lebesgue_sets: +lemma%unimportant double_lebesgue_sets: assumes S: "S \ sets lebesgue" and T: "T \ sets lebesgue" and fim: "f ` S \ T" shows "(\U. U \ sets lebesgue \ U \ T \ {x \ S. f x \ U} \ sets lebesgue) \ f \ borel_measurable (lebesgue_on S) \ @@ -2393,7 +2186,7 @@ subsection%important\Simplest case of Sard's theorem (we don't need continuity of derivative)\ -lemma Sard_lemma00: +lemma%important Sard_lemma00: fixes P :: "'b::euclidean_space set" assumes "a \ 0" and a: "a *\<^sub>R i \ 0" and i: "i \ Basis" and P: "P \ {x. a *\<^sub>R i \ x = 0}" @@ -2401,7 +2194,7 @@ obtains S where "S \ lmeasurable" and "{z. norm z \ m \ (\t \ P. norm(z - t) \ e)} \ S" and "measure lebesgue S \ (2 * e) * (2 * m) ^ (DIM('b) - 1)" -proof - +proof%unimportant - have "a > 0" using assms by simp let ?v = "(\j\Basis. (if j = i then e else m) *\<^sub>R j)" @@ -2429,7 +2222,7 @@ qed text\As above, but reorienting the vector (HOL Light's @text{GEOM\_BASIS\_MULTIPLE\_TAC})\ -lemma Sard_lemma0: +lemma%unimportant Sard_lemma0: fixes P :: "(real^'n::{finite,wellorder}) set" assumes "a \ 0" and P: "P \ {x. a \ x = 0}" and "0 \ m" "0 \ e" @@ -2489,13 +2282,13 @@ qed text\As above, but translating the sets (HOL Light's @text{GEN\_GEOM\_ORIGIN\_TAC})\ -lemma Sard_lemma1: +lemma%important Sard_lemma1: fixes P :: "(real^'n::{finite,wellorder}) set" assumes P: "dim P < CARD('n)" and "0 \ m" "0 \ e" obtains S where "S \ lmeasurable" and "{z. norm(z - w) \ m \ (\t \ P. norm(z - w - t) \ e)} \ S" and "measure lebesgue S \ (2 * e) * (2 * m) ^ (CARD('n) - 1)" -proof - +proof%unimportant - obtain a where "a \ 0" "P \ {x. a \ x = 0}" using lowdim_subset_hyperplane [of P] P span_base by auto then obtain S where S: "S \ lmeasurable" @@ -2513,7 +2306,7 @@ qed qed -lemma Sard_lemma2: +lemma%important Sard_lemma2: fixes f :: "real^'m::{finite,wellorder} \ real^'n::{finite,wellorder}" assumes mlen: "CARD('m) \ CARD('n)" (is "?m \ ?n") and "B > 0" "bounded S" @@ -2521,7 +2314,7 @@ and rank: "\x. x \ S \ rank(matrix(f' x)) < CARD('n)" and B: "\x. x \ S \ onorm(f' x) \ B" shows "negligible(f ` S)" -proof - +proof%unimportant - have lin_f': "\x. x \ S \ linear(f' x)" using derS has_derivative_linear by blast show ?thesis @@ -2728,13 +2521,13 @@ qed -theorem baby_Sard: +theorem%important baby_Sard: fixes f :: "real^'m::{finite,wellorder} \ real^'n::{finite,wellorder}" assumes mlen: "CARD('m) \ CARD('n)" and der: "\x. x \ S \ (f has_derivative f' x) (at x within S)" and rank: "\x. x \ S \ rank(matrix(f' x)) < CARD('n)" shows "negligible(f ` S)" -proof - +proof%unimportant - let ?U = "\n. {x \ S. norm(x) \ n \ onorm(f' x) \ real n}" have "\x. x \ S \ \n. norm x \ real n \ onorm (f' x) \ real n" by (meson linear order_trans real_arch_simple) @@ -2756,7 +2549,7 @@ subsection%important\A one-way version of change-of-variables not assuming injectivity. \ -lemma integral_on_image_ubound_weak: +lemma%important integral_on_image_ubound_weak: fixes f :: "real^'n::{finite,wellorder} \ real" assumes S: "S \ sets lebesgue" and f: "f \ borel_measurable (lebesgue_on (g ` S))" @@ -2767,7 +2560,7 @@ shows "f integrable_on (g ` S) \ integral (g ` S) f \ integral S (\x. \det (matrix (g' x))\ * f(g x))" (is "_ \ _ \ ?b") -proof - +proof%unimportant - let ?D = "\x. \det (matrix (g' x))\" have cont_g: "continuous_on S g" using der_g has_derivative_continuous_on by blast @@ -2945,14 +2738,14 @@ qed -lemma integral_on_image_ubound_nonneg: +lemma%important integral_on_image_ubound_nonneg: fixes f :: "real^'n::{finite,wellorder} \ real" assumes nonneg_fg: "\x. x \ S \ 0 \ f(g x)" and der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and intS: "(\x. \det (matrix (g' x))\ * f(g x)) integrable_on S" shows "f integrable_on (g ` S) \ integral (g ` S) f \ integral S (\x. \det (matrix (g' x))\ * f(g x))" (is "_ \ _ \ ?b") -proof - +proof%unimportant - let ?D = "\x. det (matrix (g' x))" define S' where "S' \ {x \ S. ?D x * f(g x) \ 0}" then have der_gS': "\x. x \ S' \ (g has_derivative g' x) (at x within S')" @@ -3075,7 +2868,7 @@ qed -proposition absolutely_integrable_on_image_real: +lemma%unimportant absolutely_integrable_on_image_real: fixes f :: "real^'n::{finite,wellorder} \ real" and g :: "real^'n::_ \ real^'n::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and intS: "(\x. \det (matrix (g' x))\ * f(g x)) absolutely_integrable_on S" @@ -3150,7 +2943,7 @@ qed -proposition absolutely_integrable_on_image: +proposition%important absolutely_integrable_on_image: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and intS: "(\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) absolutely_integrable_on S" @@ -3158,7 +2951,7 @@ apply (rule absolutely_integrable_componentwise [OF absolutely_integrable_on_image_real [OF der_g]]) using%unimportant absolutely_integrable_component [OF intS] by%unimportant auto -proposition integral_on_image_ubound: +proposition%important integral_on_image_ubound: fixes f :: "real^'n::{finite,wellorder} \ real" and g :: "real^'n::_ \ real^'n::_" assumes"\x. x \ S \ 0 \ f(g x)" and "\x. x \ S \ (g has_derivative g' x) (at x within S)" @@ -3172,7 +2965,7 @@ text\The classic change-of-variables theorem. We have two versions with quite general hypotheses, the first that the transforming function has a continuous inverse, the second that the base set is Lebesgue measurable.\ -lemma cov_invertible_nonneg_le: +lemma%unimportant cov_invertible_nonneg_le: fixes f :: "real^'n::{finite,wellorder} \ real" and g :: "real^'n::_ \ real^'n::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and der_h: "\y. y \ T \ (h has_derivative h' y) (at y within T)" @@ -3243,7 +3036,7 @@ qed -lemma cov_invertible_nonneg_eq: +lemma%unimportant cov_invertible_nonneg_eq: fixes f :: "real^'n::{finite,wellorder} \ real" and g :: "real^'n::_ \ real^'n::_" assumes "\x. x \ S \ (g has_derivative g' x) (at x within S)" and "\y. y \ T \ (h has_derivative h' y) (at y within T)" @@ -3256,7 +3049,7 @@ by (simp add: has_integral_iff) (meson eq_iff) -lemma cov_invertible_real: +lemma%unimportant cov_invertible_real: fixes f :: "real^'n::{finite,wellorder} \ real" and g :: "real^'n::_ \ real^'n::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and der_h: "\y. y \ T \ (h has_derivative h' y) (at y within T)" @@ -3422,7 +3215,7 @@ qed -lemma cv_inv_version3: +lemma%unimportant cv_inv_version3: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and der_h: "\y. y \ T \ (h has_derivative h' y) (at y within T)" @@ -3448,7 +3241,7 @@ qed -lemma cv_inv_version4: +lemma%unimportant cv_inv_version4: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S) \ invertible(matrix(g' x))" and hg: "\x. x \ S \ continuous_on (g ` S) h \ h(g x) = x" @@ -3473,7 +3266,7 @@ qed -proposition has_absolute_integral_change_of_variables_invertible: +proposition%important has_absolute_integral_change_of_variables_invertible: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" and hg: "\x. x \ S \ h(g x) = x" @@ -3481,7 +3274,7 @@ shows "(\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) absolutely_integrable_on S \ integral S (\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) = b \ f absolutely_integrable_on (g ` S) \ integral (g ` S) f = b" (is "?lhs = ?rhs") -proof - +proof%unimportant - let ?S = "{x \ S. invertible (matrix (g' x))}" and ?D = "\x. \det (matrix (g' x))\ *\<^sub>R f(g x)" have *: "?D absolutely_integrable_on ?S \ integral ?S ?D = b \ f absolutely_integrable_on (g ` ?S) \ integral (g ` ?S) f = b" @@ -3517,7 +3310,7 @@ -proposition has_absolute_integral_change_of_variables_compact: +lemma%unimportant has_absolute_integral_change_of_variables_compact: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes "compact S" and der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" @@ -3535,7 +3328,7 @@ qed -lemma has_absolute_integral_change_of_variables_compact_family: +lemma%unimportant has_absolute_integral_change_of_variables_compact_family: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes compact: "\n::nat. compact (F n)" and der_g: "\x. x \ (\n. F n) \ (g has_derivative g' x) (at x within (\n. F n))" @@ -3714,7 +3507,7 @@ qed -proposition has_absolute_integral_change_of_variables: +proposition%important has_absolute_integral_change_of_variables: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes S: "S \ sets lebesgue" and der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" @@ -3722,7 +3515,7 @@ shows "(\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) absolutely_integrable_on S \ integral S (\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) = b \ f absolutely_integrable_on (g ` S) \ integral (g ` S) f = b" -proof - +proof%unimportant - obtain C N where "fsigma C" "negligible N" and CNS: "C \ N = S" and "disjnt C N" using lebesgue_set_almost_fsigma [OF S] . then obtain F :: "nat \ (real^'m::_) set" @@ -3776,16 +3569,16 @@ qed -corollary absolutely_integrable_change_of_variables: +corollary%important absolutely_integrable_change_of_variables: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes "S \ sets lebesgue" and "\x. x \ S \ (g has_derivative g' x) (at x within S)" and "inj_on g S" shows "f absolutely_integrable_on (g ` S) \ (\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) absolutely_integrable_on S" - using assms has_absolute_integral_change_of_variables by blast + using%unimportant assms has_absolute_integral_change_of_variables by%unimportant blast -corollary integral_change_of_variables: +corollary%important integral_change_of_variables: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes S: "S \ sets lebesgue" and der_g: "\x. x \ S \ (g has_derivative g' x) (at x within S)" @@ -3793,10 +3586,10 @@ and disj: "(f absolutely_integrable_on (g ` S) \ (\x. \det (matrix (g' x))\ *\<^sub>R f(g x)) absolutely_integrable_on S)" shows "integral (g ` S) f = integral S (\x. \det (matrix (g' x))\ *\<^sub>R f(g x))" - using has_absolute_integral_change_of_variables [OF S der_g inj] disj - by blast + using%unimportant has_absolute_integral_change_of_variables [OF S der_g inj] disj + by%unimportant blast -lemma has_absolute_integral_change_of_variables_1: +lemma%unimportant has_absolute_integral_change_of_variables_1: fixes f :: "real \ real^'n::{finite,wellorder}" and g :: "real \ real" assumes S: "S \ sets lebesgue" and der_g: "\x. x \ S \ (g has_vector_derivative g' x) (at x within S)" @@ -3835,19 +3628,19 @@ qed -corollary absolutely_integrable_change_of_variables_1: +corollary%important absolutely_integrable_change_of_variables_1: fixes f :: "real \ real^'n::{finite,wellorder}" and g :: "real \ real" assumes S: "S \ sets lebesgue" and der_g: "\x. x \ S \ (g has_vector_derivative g' x) (at x within S)" and inj: "inj_on g S" shows "(f absolutely_integrable_on g ` S \ (\x. \g' x\ *\<^sub>R f(g x)) absolutely_integrable_on S)" - using has_absolute_integral_change_of_variables_1 [OF assms] by auto + using%unimportant has_absolute_integral_change_of_variables_1 [OF assms] by%unimportant auto subsection%important\Change of variables for integrals: special case of linear function\ -lemma has_absolute_integral_change_of_variables_linear: +lemma%unimportant has_absolute_integral_change_of_variables_linear: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes "linear g" shows "(\x. \det (matrix g)\ *\<^sub>R f(g x)) absolutely_integrable_on S \ @@ -3872,14 +3665,14 @@ qed (use h in auto) qed -lemma absolutely_integrable_change_of_variables_linear: +lemma%unimportant absolutely_integrable_change_of_variables_linear: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes "linear g" shows "(\x. \det (matrix g)\ *\<^sub>R f(g x)) absolutely_integrable_on S \ f absolutely_integrable_on (g ` S)" using assms has_absolute_integral_change_of_variables_linear by blast -lemma absolutely_integrable_on_linear_image: +lemma%unimportant absolutely_integrable_on_linear_image: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes "linear g" shows "f absolutely_integrable_on (g ` S) @@ -3887,12 +3680,12 @@ unfolding assms absolutely_integrable_change_of_variables_linear [OF assms, symmetric] absolutely_integrable_on_scaleR_iff by (auto simp: set_integrable_def) -lemma integral_change_of_variables_linear: +lemma%important integral_change_of_variables_linear: fixes f :: "real^'m::{finite,wellorder} \ real^'n" and g :: "real^'m::_ \ real^'m::_" assumes "linear g" and "f absolutely_integrable_on (g ` S) \ (f \ g) absolutely_integrable_on S" shows "integral (g ` S) f = \det (matrix g)\ *\<^sub>R integral S (f \ g)" -proof - +proof%unimportant - have "((\x. \det (matrix g)\ *\<^sub>R f (g x)) absolutely_integrable_on S) \ (f absolutely_integrable_on g ` S)" using absolutely_integrable_on_linear_image assms by blast moreover @@ -3906,18 +3699,18 @@ subsection%important\Change of variable for measure\ -lemma has_measure_differentiable_image: +lemma%unimportant has_measure_differentiable_image: fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes "S \ sets lebesgue" and "\x. x \ S \ (f has_derivative f' x) (at x within S)" and "inj_on f S" shows "f ` S \ lmeasurable \ measure lebesgue (f ` S) = m \ ((\x. \det (matrix (f' x))\) has_integral m) S" - using has_absolute_integral_change_of_variables [OF assms, of "\x. (1::real^1)" "vec m"] - unfolding absolutely_integrable_on_1_iff integral_on_1_eq integrable_on_1_iff absolutely_integrable_on_def - by (auto simp: has_integral_iff lmeasurable_iff_integrable_on lmeasure_integral) + using%unimportant has_absolute_integral_change_of_variables [OF assms, of "\x. (1::real^1)" "vec m"] + unfolding%unimportant absolutely_integrable_on_1_iff integral_on_1_eq integrable_on_1_iff absolutely_integrable_on_def + by%unimportant (auto simp: has_integral_iff lmeasurable_iff_integrable_on lmeasure_integral) -lemma measurable_differentiable_image_eq: +lemma%unimportant measurable_differentiable_image_eq: fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes "S \ sets lebesgue" and "\x. x \ S \ (f has_derivative f' x) (at x within S)" @@ -3926,23 +3719,23 @@ using has_measure_differentiable_image [OF assms] by blast -lemma measurable_differentiable_image_alt: +lemma%important measurable_differentiable_image_alt: fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes "S \ sets lebesgue" and "\x. x \ S \ (f has_derivative f' x) (at x within S)" and "inj_on f S" shows "f ` S \ lmeasurable \ (\x. \det (matrix (f' x))\) absolutely_integrable_on S" - using measurable_differentiable_image_eq [OF assms] - by (simp only: absolutely_integrable_on_iff_nonneg) + using%unimportant measurable_differentiable_image_eq [OF assms] + by%unimportant (simp only: absolutely_integrable_on_iff_nonneg) -lemma measure_differentiable_image_eq: +lemma%important measure_differentiable_image_eq: fixes f :: "real^'n::{finite,wellorder} \ real^'n::_" assumes S: "S \ sets lebesgue" and der_f: "\x. x \ S \ (f has_derivative f' x) (at x within S)" and inj: "inj_on f S" and intS: "(\x. \det (matrix (f' x))\) integrable_on S" shows "measure lebesgue (f ` S) = integral S (\x. \det (matrix (f' x))\)" - using measurable_differentiable_image_eq [OF S der_f inj] + using%unimportant measurable_differentiable_image_eq [OF S der_f inj] assms has_measure_differentiable_image by%unimportant blast end diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Convex.thy --- a/src/HOL/Analysis/Convex.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Convex.thy Thu Jan 17 16:08:41 2019 +0000 @@ -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 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Cross3.thy --- a/src/HOL/Analysis/Cross3.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Cross3.thy Thu Jan 17 16:08:41 2019 +0000 @@ -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 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Determinants.thy --- a/src/HOL/Analysis/Determinants.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Determinants.thy Thu Jan 17 16:08:41 2019 +0000 @@ -15,19 +15,19 @@ definition%important trace :: "'a::semiring_1^'n^'n \ 'a" where "trace A = sum (\i. ((A$i)$i)) (UNIV::'n set)" -lemma trace_0: "trace (mat 0) = 0" +lemma%unimportant trace_0: "trace (mat 0) = 0" by (simp add: trace_def mat_def) -lemma trace_I: "trace (mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))" +lemma%unimportant trace_I: "trace (mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))" by (simp add: trace_def mat_def) -lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B" +lemma%unimportant trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B" by (simp add: trace_def sum.distrib) -lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B" +lemma%unimportant trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B" by (simp add: trace_def sum_subtractf) -lemma trace_mul_sym: "trace ((A::'a::comm_semiring_1^'n^'m) ** B) = trace (B**A)" +lemma%important trace_mul_sym: "trace ((A::'a::comm_semiring_1^'n^'m) ** B) = trace (B**A)" apply (simp add: trace_def matrix_matrix_mult_def) apply (subst sum.swap) apply (simp add: mult.commute) @@ -42,8 +42,8 @@ text \Basic determinant properties\ -proposition det_transpose [simp]: "det (transpose A) = det (A::'a::comm_ring_1 ^'n^'n)" -proof - +lemma%important det_transpose [simp]: "det (transpose A) = det (A::'a::comm_ring_1 ^'n^'n)" +proof%unimportant - let ?di = "\A i j. A$i$j" let ?U = "(UNIV :: 'n set)" have fU: "finite ?U" by simp @@ -80,7 +80,7 @@ by (subst sum_permutations_inverse) (blast intro: sum.cong) qed -lemma det_lowerdiagonal: +lemma%unimportant det_lowerdiagonal: fixes A :: "'a::comm_ring_1^('n::{finite,wellorder})^('n::{finite,wellorder})" assumes ld: "\i j. i < j \ A$i$j = 0" shows "det A = prod (\i. A$i$i) (UNIV:: 'n set)" @@ -107,11 +107,11 @@ unfolding det_def by (simp add: sign_id) qed -lemma det_upperdiagonal: +lemma%important det_upperdiagonal: fixes A :: "'a::comm_ring_1^'n::{finite,wellorder}^'n::{finite,wellorder}" assumes ld: "\i j. i > j \ A$i$j = 0" shows "det A = prod (\i. A$i$i) (UNIV:: 'n set)" -proof - +proof%unimportant - let ?U = "UNIV:: 'n set" let ?PU = "{p. p permutes ?U}" let ?pp = "(\p. of_int (sign p) * prod (\i. A$i$p i) (UNIV :: 'n set))" @@ -134,11 +134,11 @@ unfolding det_def by (simp add: sign_id) qed -proposition det_diagonal: +lemma%important det_diagonal: fixes A :: "'a::comm_ring_1^'n^'n" assumes ld: "\i j. i \ j \ A$i$j = 0" shows "det A = prod (\i. A$i$i) (UNIV::'n set)" -proof - +proof%unimportant - let ?U = "UNIV:: 'n set" let ?PU = "{p. p permutes ?U}" let ?pp = "\p. of_int (sign p) * prod (\i. A$i$p i) (UNIV :: 'n set)" @@ -161,13 +161,13 @@ unfolding det_def by (simp add: sign_id) qed -lemma det_I [simp]: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1" +lemma%unimportant det_I [simp]: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1" by (simp add: det_diagonal mat_def) -lemma det_0 [simp]: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0" +lemma%unimportant det_0 [simp]: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0" by (simp add: det_def prod_zero power_0_left) -lemma det_permute_rows: +lemma%unimportant det_permute_rows: fixes A :: "'a::comm_ring_1^'n^'n" assumes p: "p permutes (UNIV :: 'n::finite set)" shows "det (\ i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A" @@ -204,11 +204,11 @@ done qed -lemma det_permute_columns: +lemma%important det_permute_columns: fixes A :: "'a::comm_ring_1^'n^'n" assumes p: "p permutes (UNIV :: 'n set)" shows "det(\ i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A" -proof - +proof%unimportant - let ?Ap = "\ i j. A$i$ p j :: 'a^'n^'n" let ?At = "transpose A" have "of_int (sign p) * det A = det (transpose (\ i. transpose A $ p i))" @@ -220,7 +220,7 @@ by simp qed -lemma det_identical_columns: +lemma%unimportant det_identical_columns: fixes A :: "'a::comm_ring_1^'n^'n" assumes jk: "j \ k" and r: "column j A = column k A" @@ -300,24 +300,24 @@ finally show "det A = 0" by simp qed -lemma det_identical_rows: +lemma%unimportant det_identical_rows: fixes A :: "'a::comm_ring_1^'n^'n" assumes ij: "i \ j" and r: "row i A = row j A" shows "det A = 0" by (metis column_transpose det_identical_columns det_transpose ij r) -lemma det_zero_row: +lemma%unimportant det_zero_row: fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m" shows "row i A = 0 \ det A = 0" and "row j F = 0 \ det F = 0" by (force simp: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+ -lemma det_zero_column: +lemma%unimportant det_zero_column: fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m" shows "column i A = 0 \ det A = 0" and "column j F = 0 \ det F = 0" unfolding atomize_conj atomize_imp by (metis det_transpose det_zero_row row_transpose) -lemma det_row_add: +lemma%unimportant det_row_add: fixes a b c :: "'n::finite \ _ ^ 'n" shows "det((\ i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) = det((\ i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) + @@ -358,7 +358,7 @@ by (simp add: field_simps) qed auto -lemma det_row_mul: +lemma%unimportant det_row_mul: fixes a b :: "'n::finite \ _ ^ 'n" shows "det((\ i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) = c * det((\ i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)" @@ -395,7 +395,7 @@ by (simp add: field_simps) qed auto -lemma det_row_0: +lemma%unimportant det_row_0: fixes b :: "'n::finite \ _ ^ 'n" shows "det((\ i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0" using det_row_mul[of k 0 "\i. 1" b] @@ -403,11 +403,11 @@ apply (simp only: vector_smult_lzero) done -lemma det_row_operation: +lemma%important det_row_operation: fixes A :: "'a::{comm_ring_1}^'n^'n" assumes ij: "i \ j" shows "det (\ k. if k = i then row i A + c *s row j A else row k A) = det A" -proof - +proof%unimportant - let ?Z = "(\ k. if k = i then row j A else row k A) :: 'a ^'n^'n" have th: "row i ?Z = row j ?Z" by (vector row_def) have th2: "((\ k. if k = i then row i A else row k A) :: 'a^'n^'n) = A" @@ -417,7 +417,7 @@ by simp qed -lemma det_row_span: +lemma%unimportant det_row_span: fixes A :: "'a::{field}^'n^'n" assumes x: "x \ vec.span {row j A |j. j \ i}" shows "det (\ k. if k = i then row i A + x else row k A) = det A" @@ -449,10 +449,10 @@ unfolding scalar_mult_eq_scaleR . qed -lemma matrix_id [simp]: "det (matrix id) = 1" +lemma%unimportant matrix_id [simp]: "det (matrix id) = 1" by (simp add: matrix_id_mat_1) -lemma det_matrix_scaleR [simp]: "det (matrix (((*\<^sub>R) r)) :: real^'n^'n) = r ^ CARD('n::finite)" +lemma%important det_matrix_scaleR [simp]: "det (matrix (((*\<^sub>R) r)) :: real^'n^'n) = r ^ CARD('n::finite)" apply (subst det_diagonal) apply (auto simp: matrix_def mat_def) apply (simp add: cart_eq_inner_axis inner_axis_axis) @@ -463,7 +463,7 @@ exact duplicates by considering the rows/columns as a set. \ -lemma det_dependent_rows: +lemma%unimportant det_dependent_rows: fixes A:: "'a::{field}^'n^'n" assumes d: "vec.dependent (rows A)" shows "det A = 0" @@ -491,23 +491,23 @@ qed qed -lemma det_dependent_columns: +lemma%unimportant det_dependent_columns: assumes d: "vec.dependent (columns (A::real^'n^'n))" shows "det A = 0" by (metis d det_dependent_rows rows_transpose det_transpose) text \Multilinearity and the multiplication formula\ -lemma Cart_lambda_cong: "(\x. f x = g x) \ (vec_lambda f::'a^'n) = (vec_lambda g :: 'a^'n)" +lemma%unimportant Cart_lambda_cong: "(\x. f x = g x) \ (vec_lambda f::'a^'n) = (vec_lambda g :: 'a^'n)" by auto -lemma det_linear_row_sum: +lemma%unimportant det_linear_row_sum: assumes fS: "finite S" shows "det ((\ i. if i = k then sum (a i) S else c i)::'a::comm_ring_1^'n^'n) = sum (\j. det ((\ i. if i = k then a i j else c i)::'a^'n^'n)) S" using fS by (induct rule: finite_induct; simp add: det_row_0 det_row_add cong: if_cong) -lemma finite_bounded_functions: +lemma%unimportant finite_bounded_functions: assumes fS: "finite S" shows "finite {f. (\i \ {1.. (k::nat)}. f i \ S) \ (\i. i \ {1 .. k} \ f i = i)}" proof (induct k) @@ -532,14 +532,14 @@ qed -lemma det_linear_rows_sum_lemma: +lemma%important det_linear_rows_sum_lemma: assumes fS: "finite S" and fT: "finite T" shows "det ((\ i. if i \ T then sum (a i) S else c i):: 'a::comm_ring_1^'n^'n) = sum (\f. det((\ i. if i \ T then a i (f i) else c i)::'a^'n^'n)) {f. (\i \ T. f i \ S) \ (\i. i \ T \ f i = i)}" using fT -proof (induct T arbitrary: a c set: finite) +proof%unimportant (induct T arbitrary: a c set: finite) case empty have th0: "\x y. (\ i. if i \ {} then x i else y i) = (\ i. y i)" by vector @@ -577,7 +577,7 @@ (auto intro!: cong[OF refl[of det]] simp: vec_eq_iff) qed -lemma det_linear_rows_sum: +lemma%unimportant det_linear_rows_sum: fixes S :: "'n::finite set" assumes fS: "finite S" shows "det (\ i. sum (a i) S) = @@ -589,12 +589,12 @@ show ?thesis by simp qed -lemma matrix_mul_sum_alt: +lemma%unimportant matrix_mul_sum_alt: fixes A B :: "'a::comm_ring_1^'n^'n" shows "A ** B = (\ i. sum (\k. A$i$k *s B $ k) (UNIV :: 'n set))" by (vector matrix_matrix_mult_def sum_component) -lemma det_rows_mul: +lemma%unimportant det_rows_mul: "det((\ i. c i *s a i)::'a::comm_ring_1^'n^'n) = prod (\i. c i) (UNIV:: 'n set) * det((\ i. a i)::'a^'n^'n)" proof (simp add: det_def sum_distrib_left cong add: prod.cong, rule sum.cong) @@ -612,10 +612,10 @@ by (simp add: field_simps) qed rule -proposition det_mul: +lemma%important det_mul: fixes A B :: "'a::comm_ring_1^'n^'n" shows "det (A ** B) = det A * det B" -proof - +proof%unimportant - let ?U = "UNIV :: 'n set" let ?F = "{f. (\i \ ?U. f i \ ?U) \ (\i. i \ ?U \ f i = i)}" let ?PU = "{p. p permutes ?U}" @@ -714,10 +714,10 @@ subsection%important \Relation to invertibility\ -proposition invertible_det_nz: +lemma%important invertible_det_nz: fixes A::"'a::{field}^'n^'n" shows "invertible A \ det A \ 0" -proof (cases "invertible A") +proof%unimportant (cases "invertible A") case True then obtain B :: "'a^'n^'n" where B: "A ** B = mat 1" unfolding invertible_right_inverse by blast @@ -748,7 +748,7 @@ qed -lemma det_nz_iff_inj_gen: +lemma%unimportant det_nz_iff_inj_gen: fixes f :: "'a::field^'n \ 'a::field^'n" assumes "Vector_Spaces.linear (*s) (*s) f" shows "det (matrix f) \ 0 \ inj f" @@ -763,14 +763,14 @@ by (metis assms invertible_det_nz invertible_left_inverse matrix_compose_gen matrix_id_mat_1) qed -lemma det_nz_iff_inj: +lemma%unimportant det_nz_iff_inj: fixes f :: "real^'n \ real^'n" assumes "linear f" shows "det (matrix f) \ 0 \ inj f" using det_nz_iff_inj_gen[of f] assms unfolding linear_matrix_vector_mul_eq . -lemma det_eq_0_rank: +lemma%unimportant det_eq_0_rank: fixes A :: "real^'n^'n" shows "det A = 0 \ rank A < CARD('n)" using invertible_det_nz [of A] @@ -778,11 +778,11 @@ subsubsection%important \Invertibility of matrices and corresponding linear functions\ -proposition matrix_left_invertible_gen: +lemma%important matrix_left_invertible_gen: fixes f :: "'a::field^'m \ 'a::field^'n" assumes "Vector_Spaces.linear (*s) (*s) f" shows "((\B. B ** matrix f = mat 1) \ (\g. Vector_Spaces.linear (*s) (*s) g \ g \ f = id))" -proof safe +proof%unimportant safe fix B assume 1: "B ** matrix f = mat 1" show "\g. Vector_Spaces.linear (*s) (*s) g \ g \ f = id" @@ -801,12 +801,12 @@ then show "\B. B ** matrix f = mat 1" .. qed -lemma matrix_left_invertible: +lemma%unimportant matrix_left_invertible: "linear f \ ((\B. B ** matrix f = mat 1) \ (\g. linear g \ g \ f = id))" for f::"real^'m \ real^'n" using matrix_left_invertible_gen[of f] by (auto simp: linear_matrix_vector_mul_eq) -lemma matrix_right_invertible_gen: +lemma%unimportant matrix_right_invertible_gen: fixes f :: "'a::field^'m \ 'a^'n" assumes "Vector_Spaces.linear (*s) (*s) f" shows "((\B. matrix f ** B = mat 1) \ (\g. Vector_Spaces.linear (*s) (*s) g \ f \ g = id))" @@ -829,12 +829,12 @@ then show "\B. matrix f ** B = mat 1" .. qed -lemma matrix_right_invertible: +lemma%unimportant matrix_right_invertible: "linear f \ ((\B. matrix f ** B = mat 1) \ (\g. linear g \ f \ g = id))" for f::"real^'m \ real^'n" using matrix_right_invertible_gen[of f] by (auto simp: linear_matrix_vector_mul_eq) -lemma matrix_invertible_gen: +lemma%unimportant matrix_invertible_gen: fixes f :: "'a::field^'m \ 'a::field^'n" assumes "Vector_Spaces.linear (*s) (*s) f" shows "invertible (matrix f) \ (\g. Vector_Spaces.linear (*s) (*s) g \ f \ g = id \ g \ f = id)" @@ -847,13 +847,13 @@ by (metis assms invertible_def matrix_compose_gen matrix_id_mat_1) qed -lemma matrix_invertible: +lemma%unimportant matrix_invertible: "linear f \ invertible (matrix f) \ (\g. linear g \ f \ g = id \ g \ f = id)" for f::"real^'m \ real^'n" using matrix_invertible_gen[of f] by (auto simp: linear_matrix_vector_mul_eq) -lemma invertible_eq_bij: +lemma%unimportant invertible_eq_bij: fixes m :: "'a::field^'m^'n" shows "invertible m \ bij ((*v) m)" using matrix_invertible_gen[OF matrix_vector_mul_linear_gen, of m, simplified matrix_of_matrix_vector_mul] @@ -863,13 +863,13 @@ subsection%important \Cramer's rule\ -proposition cramer_lemma_transpose: +lemma%important cramer_lemma_transpose: fixes A:: "'a::{field}^'n^'n" and x :: "'a::{field}^'n" shows "det ((\ i. if i = k then sum (\i. x$i *s row i A) (UNIV::'n set) else row i A)::'a::{field}^'n^'n) = x$k * det A" (is "?lhs = ?rhs") -proof - +proof%unimportant - let ?U = "UNIV :: 'n set" let ?Uk = "?U - {k}" have U: "?U = insert k ?Uk" @@ -899,10 +899,10 @@ done qed -proposition cramer_lemma: +lemma%important cramer_lemma: fixes A :: "'a::{field}^'n^'n" shows "det((\ i j. if j = k then (A *v x)$i else A$i$j):: 'a::{field}^'n^'n) = x$k * det A" -proof - +proof%unimportant - let ?U = "UNIV :: 'n set" have *: "\c. sum (\i. c i *s row i (transpose A)) ?U = sum (\i. c i *s column i A) ?U" by (auto intro: sum.cong) @@ -916,11 +916,11 @@ done qed -theorem cramer: +lemma%important cramer: fixes A ::"'a::{field}^'n^'n" assumes d0: "det A \ 0" shows "A *v x = b \ x = (\ k. det(\ i j. if j=k then b$i else A$i$j) / det A)" -proof - +proof%unimportant - from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1" unfolding invertible_det_nz[symmetric] invertible_def by blast @@ -941,376 +941,10 @@ 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 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 orthogonal_transformation_id [simp]: "orthogonal_transformation (\x. x)" - by (simp add: linear_iff orthogonal_transformation_def) - -lemma orthogonal_orthogonal_transformation: - "orthogonal_transformation f \ orthogonal (f x) (f y) \ orthogonal x y" - by (simp add: orthogonal_def orthogonal_transformation_def) - -lemma orthogonal_transformation_compose: - "\orthogonal_transformation f; orthogonal_transformation g\ \ orthogonal_transformation(f \ g)" - by (auto simp: orthogonal_transformation_def linear_compose) - -lemma orthogonal_transformation_neg: - "orthogonal_transformation(\x. -(f x)) \ orthogonal_transformation f" - by (auto simp: orthogonal_transformation_def dest: linear_compose_neg) - -lemma 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 orthogonal_transformation_linear: - "orthogonal_transformation f \ linear f" - by (simp add: orthogonal_transformation_def) - -lemma orthogonal_transformation_inj: - "orthogonal_transformation f \ inj f" - unfolding orthogonal_transformation_def inj_on_def - by (metis vector_eq) - -lemma 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 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 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 orthogonal_transformation_norm: - "orthogonal_transformation f \ norm (f x) = norm x" - by (metis orthogonal_transformation) - -lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n) \ transpose Q ** Q = mat 1" - by (metis matrix_left_right_inverse orthogonal_matrix_def) - -lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n)" - by (simp add: orthogonal_matrix_def) - -lemma 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) - -proposition orthogonal_transformation_matrix: - fixes f:: "real^'n \ real^'n" - shows "orthogonal_transformation f \ linear f \ orthogonal_matrix(matrix f)" - (is "?lhs \ ?rhs") -proof - - 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 - -theorem det_orthogonal_matrix: - fixes Q:: "'a::linordered_idom^'n^'n" - assumes oQ: "orthogonal_matrix Q" - shows "det Q = 1 \ det Q = - 1" -proof - - 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 orthogonal_transformation_det [simp]: - fixes f :: "real^'n \ real^'n" - shows "orthogonal_transformation f \ \det (matrix f)\ = 1" - using det_orthogonal_matrix orthogonal_transformation_matrix by fastforce - - -subsection%important \Linearity of scaling, and hence isometry, that preserves origin\ - -lemma 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 - - { - 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 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 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 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 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 orthogonal_matrix_transpose [simp]: - "orthogonal_matrix(transpose A) \ orthogonal_matrix A" - by (auto simp: orthogonal_matrix_def) - -lemma 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 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 - -theorem 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 - - 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 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 - - 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 - -theorem orthogonal_transformation_exists: - fixes a b :: "real^'n" - assumes "norm a = norm b" - obtains f where "orthogonal_transformation f" "f a = b" -proof (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 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 - - { - 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 orthogonal_rotation_or_rotoinversion: - fixes Q :: "'a::linordered_idom^'n^'n" - shows " orthogonal_matrix Q \ rotation_matrix Q \ rotoinversion_matrix Q" - by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix) - -text \Explicit formulas for low dimensions\ - -lemma prod_neutral_const: "prod f {(1::nat)..1} = f 1" - by simp - -lemma prod_2: "prod f {(1::nat)..2} = f 1 * f 2" - by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute) - -lemma prod_3: "prod f {(1::nat)..3} = f 1 * f 2 * f 3" - by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute) - -lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1" +lemma%unimportant det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1" by (simp add: det_def sign_id) -lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1" +lemma%unimportant det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1" proof - have f12: "finite {2::2}" "1 \ {2::2}" by auto show ?thesis @@ -1320,7 +954,7 @@ by (simp add: sign_swap_id sign_id swap_id_eq) qed -lemma det_3: +lemma%unimportant det_3: "det (A::'a::comm_ring_1^3^3) = A$1$1 * A$2$2 * A$3$3 + A$1$2 * A$2$3 * A$3$1 + @@ -1344,7 +978,7 @@ text\ Slightly stronger results giving rotation, but only in two or more dimensions\ -lemma rotation_matrix_exists_basis: +lemma%unimportant rotation_matrix_exists_basis: fixes a :: "real^'n" assumes 2: "2 \ CARD('n)" and "norm a = 1" obtains A where "rotation_matrix A" "A *v (axis k 1) = a" @@ -1383,7 +1017,7 @@ qed qed -lemma rotation_exists_1: +lemma%unimportant rotation_exists_1: fixes a :: "real^'n" assumes "2 \ CARD('n)" "norm a = 1" "norm b = 1" obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b" @@ -1406,7 +1040,7 @@ qed qed -lemma rotation_exists: +lemma%unimportant rotation_exists: fixes a :: "real^'n" assumes 2: "2 \ CARD('n)" and eq: "norm a = norm b" obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b" @@ -1428,7 +1062,7 @@ with f show thesis .. qed -lemma rotation_rightward_line: +lemma%unimportant rotation_rightward_line: fixes a :: "real^'n" obtains f where "orthogonal_transformation f" "2 \ CARD('n) \ det(matrix f) = 1" "f(norm a *\<^sub>R axis k 1) = a" diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Elementary_Metric_Spaces.thy --- a/src/HOL/Analysis/Elementary_Metric_Spaces.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Elementary_Metric_Spaces.thy Thu Jan 17 16:08:41 2019 +0000 @@ -4,13 +4,15 @@ Author: Brian Huffman, Portland State University *) -section \Elementary Metric Spaces\ +chapter \Functional Analysis\ theory Elementary_Metric_Spaces imports Abstract_Topology_2 begin +section \Elementary Metric Spaces\ + subsection \Open and closed balls\ definition%important ball :: "'a::metric_space \ real \ 'a set" diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Elementary_Topology.thy --- a/src/HOL/Analysis/Elementary_Topology.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Elementary_Topology.thy Thu Jan 17 16:08:41 2019 +0000 @@ -4,7 +4,7 @@ Author: Brian Huffman, Portland State University *) -section \Elementary Topology\ +chapter \Topology\ theory Elementary_Topology imports @@ -14,6 +14,8 @@ begin +section \Elementary Topology\ + subsection \TODO: move?\ lemma open_subopen: "open S \ (\x\S. \T. open T \ x \ T \ T \ S)" diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Inner_Product.thy --- a/src/HOL/Analysis/Inner_Product.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Inner_Product.thy Thu Jan 17 16:08:41 2019 +0000 @@ -462,4 +462,12 @@ lemmas has_derivative_norm = GDERIV_norm [unfolded gderiv_def] +bundle inner_syntax begin +notation inner (infix "\" 70) end + +bundle no_inner_syntax begin +no_notation inner (infix "\" 70) +end + +end diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/L2_Norm.thy --- a/src/HOL/Analysis/L2_Norm.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/L2_Norm.thy Thu Jan 17 16:08:41 2019 +0000 @@ -2,12 +2,14 @@ Author: Brian Huffman, Portland State University *) -section \L2 Norm\ +chapter \Linear Algebra\ theory L2_Norm imports Complex_Main begin +section \L2 Norm\ + definition%important L2_set :: "('a \ real) \ 'a set \ real" where "L2_set f A = sqrt (\i\A. (f i)\<^sup>2)" diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Linear_Algebra.thy --- a/src/HOL/Analysis/Linear_Algebra.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Linear_Algebra.thy Thu Jan 17 16:08:41 2019 +0000 @@ -30,10 +30,83 @@ 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\ -notation inner (infix "\" 70) +unbundle inner_syntax text\Equality of vectors in terms of \<^term>\(\)\ products.\ @@ -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 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Sigma_Algebra.thy --- a/src/HOL/Analysis/Sigma_Algebra.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Sigma_Algebra.thy Thu Jan 17 16:08:41 2019 +0000 @@ -5,7 +5,7 @@ translated by Lawrence Paulson. *) -section \Sigma Algebra\ +chapter \Measure and Integration Theory\ theory Sigma_Algebra imports @@ -17,6 +17,9 @@ "HOL-Library.Disjoint_Sets" begin + +section \Sigma Algebra\ + text \Sigma algebras are an elementary concept in measure theory. To measure --- that is to integrate --- functions, we first have to measure sets. Unfortunately, when dealing with a large universe, diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Starlike.thy --- a/src/HOL/Analysis/Starlike.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Starlike.thy Thu Jan 17 16:08:41 2019 +0000 @@ -5,13 +5,14 @@ Author: Armin Heller, TU Muenchen Author: Johannes Hoelzl, TU Muenchen *) - -section \Line Segments\ +chapter \Unsorted\ theory Starlike imports Convex_Euclidean_Space begin +section \Line Segments\ + subsection \Midpoint\ definition%important midpoint :: "'a::real_vector \ 'a \ 'a" @@ -5469,103 +5470,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 +6340,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 \ {}" diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/Topology_Euclidean_Space.thy --- a/src/HOL/Analysis/Topology_Euclidean_Space.thy Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/Topology_Euclidean_Space.thy Thu Jan 17 16:08:41 2019 +0000 @@ -4,7 +4,7 @@ Author: Brian Huffman, Portland State University *) -section \Elementary Topology in Euclidean Space\ +chapter \Vector Analysis\ theory Topology_Euclidean_Space imports @@ -13,6 +13,8 @@ Norm_Arith begin +section \Elementary Topology in Euclidean Space\ + lemma euclidean_dist_l2: fixes x y :: "'a :: euclidean_space" shows "dist x y = L2_set (\i. dist (x \ i) (y \ i)) Basis" diff -r 0f4d4a13dc16 -r a8faf6f15da7 src/HOL/Analysis/document/root.tex --- a/src/HOL/Analysis/document/root.tex Thu Jan 17 15:50:28 2019 +0000 +++ b/src/HOL/Analysis/document/root.tex Thu Jan 17 16:08:41 2019 +0000 @@ -1,4 +1,4 @@ -\documentclass[11pt,a4paper]{article} +\documentclass[11pt,a4paper]{book} \usepackage{graphicx} \usepackage{isabelle} \usepackage{isabellesym}