# HG changeset patch # User huffman # Date 1313093156 25200 # Node ID d12d89a66742b578db817d276c8b3ee3de33e159 # Parent d26a45f3c8357981184f739a14d81c8673fb5bb0 modify euclidean_space class to include basis set diff -r d26a45f3c835 -r d12d89a66742 src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Thu Aug 11 09:11:15 2011 -0700 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Thu Aug 11 13:05:56 2011 -0700 @@ -467,7 +467,7 @@ text {* some lemmas to map between Eucl and Cart *} lemma basis_real_n[simp]:"(basis (\' i)::real^'a) = cart_basis i" unfolding basis_vec_def using pi'_range[where 'n='a] - by (auto simp: vec_eq_iff) + by (auto simp: vec_eq_iff axis_def) subsection {* Orthogonality on cartesian products *} diff -r d26a45f3c835 -r d12d89a66742 src/HOL/Multivariate_Analysis/Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Thu Aug 11 09:11:15 2011 -0700 +++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Thu Aug 11 13:05:56 2011 -0700 @@ -15,22 +15,75 @@ subsection {* Type class of Euclidean spaces *} class euclidean_space = real_inner + + fixes Basis :: "'a set" + assumes nonempty_Basis [simp]: "Basis \ {}" + assumes finite_Basis [simp]: "finite Basis" + assumes inner_Basis: + "\u \ Basis; v \ Basis\ \ inner u v = (if u = v then 1 else 0)" + assumes euclidean_all_zero_iff: + "(\u\Basis. inner x u = 0) \ (x = 0)" + + -- "FIXME: make this a separate definition" fixes dimension :: "'a itself \ nat" + assumes dimension_def: "dimension TYPE('a) = card Basis" + + -- "FIXME: eventually basis function can be removed" fixes basis :: "nat \ 'a" - assumes DIM_positive [intro]: - "0 < dimension TYPE('a)" - assumes basis_zero [simp]: - "dimension TYPE('a) \ i \ basis i = 0" - assumes basis_orthonormal: - "\iji (x = 0)" + assumes image_basis: "basis ` {.. nat" ("(1DIM/(1'(_')))") translations "DIM('t)" == "CONST dimension (TYPE('t))" +lemma (in euclidean_space) norm_Basis: "u \ Basis \ norm u = 1" + unfolding norm_eq_sqrt_inner by (simp add: inner_Basis) + +lemma (in euclidean_space) sgn_Basis: "u \ Basis \ sgn u = u" + unfolding sgn_div_norm by (simp add: norm_Basis scaleR_one) + +lemma (in euclidean_space) Basis_zero [simp]: "0 \ Basis" +proof + assume "0 \ Basis" thus "False" + using inner_Basis [of 0 0] by simp +qed + +lemma (in euclidean_space) nonzero_Basis: "u \ Basis \ u \ 0" + by clarsimp + +text {* Lemmas related to @{text basis} function. *} + +lemma (in euclidean_space) euclidean_all_zero: + "(\i (x = 0)" + using euclidean_all_zero_iff [of x, folded image_basis] + unfolding ball_simps by (simp add: Ball_def inner_commute) + +lemma (in euclidean_space) basis_zero [simp]: + "DIM('a) \ i \ basis i = 0" + using basis_finite by auto + +lemma (in euclidean_space) DIM_positive [intro]: "0 < DIM('a)" + unfolding dimension_def by (simp add: card_gt_0_iff) + +lemma (in euclidean_space) basis_inj [simp, intro]: "inj_on basis {.. Basis \ i < DIM('a)" + by (cases "i < DIM('a)", simp add: image_basis [symmetric], simp) + +lemma (in euclidean_space) Basis_elim: + assumes "u \ Basis" obtains i where "i < DIM('a)" and "u = basis i" + using assms unfolding image_basis [symmetric] by fast + +lemma (in euclidean_space) basis_orthonormal: + "\ij i < DIM('a) then 1 else 0)" proof (cases "(i < DIM('a) \ j < DIM('a))") @@ -161,6 +214,9 @@ begin definition + "Basis = {1::real}" + +definition "dimension (t::real itself) = 1" definition [simp]: @@ -170,42 +226,44 @@ by (rule dimension_real_def) instance - by default simp+ + by default (auto simp add: Basis_real_def) end subsubsection {* Type @{typ complex} *} + (* TODO: move these to Complex.thy/Inner_Product.thy *) + +lemma norm_ii [simp]: "norm ii = 1" + unfolding i_def by simp + +lemma complex_inner_1 [simp]: "inner 1 x = Re x" + unfolding inner_complex_def by simp + +lemma complex_inner_1_right [simp]: "inner x 1 = Re x" + unfolding inner_complex_def by simp + +lemma complex_inner_ii_left [simp]: "inner ii x = Im x" + unfolding inner_complex_def by simp + +lemma complex_inner_ii_right [simp]: "inner x ii = Im x" + unfolding inner_complex_def by simp + instantiation complex :: euclidean_space begin +definition Basis_complex_def: + "Basis = {1, ii}" + definition "dimension (t::complex itself) = 2" definition "basis i = (if i = 0 then 1 else if i = 1 then ii else 0)" -lemma all_less_Suc: "(\i (\i P n" - by (auto simp add: less_Suc_eq) - -instance proof - show "0 < DIM(complex)" - unfolding dimension_complex_def by simp -next - fix i :: nat - assume "DIM(complex) \ i" thus "basis i = (0::complex)" - unfolding dimension_complex_def basis_complex_def by simp -next - show "\iji x = 0" - unfolding dimension_complex_def basis_complex_def inner_complex_def - by (simp add: numeral_2_eq_2 all_less_Suc complex_eq_iff) -qed +instance + by default (auto simp add: Basis_complex_def dimension_complex_def + basis_complex_def intro: complex_eqI split: split_if_asm) end @@ -214,40 +272,50 @@ subsubsection {* Type @{typ "'a \ 'b"} *} +lemma disjoint_iff: "A \ B = {} \ (\x\A. \y\B. x \ y)" + by auto (* TODO: move elsewhere *) + instantiation prod :: (euclidean_space, euclidean_space) euclidean_space begin definition + "Basis = (\u. (u, 0)) ` Basis \ (\v. (0, v)) ` Basis" + +definition "dimension (t::('a \ 'b) itself) = DIM('a) + DIM('b)" definition "basis i = (if i < DIM('a) then (basis i, 0) else (0, basis (i - DIM('a))))" -lemma all_less_sum: - fixes m n :: nat - shows "(\i<(m + n). P i) \ (\i (\i 'b)" - unfolding dimension_prod_def by (intro add_pos_pos DIM_positive) + show "(Basis :: ('a \ 'b) set) \ {}" + unfolding Basis_prod_def by simp next - fix i :: nat - assume "DIM('a \ 'b) \ i" thus "basis i = (0::'a \ 'b)" - unfolding dimension_prod_def basis_prod_def zero_prod_def - by simp + show "finite (Basis :: ('a \ 'b) set)" + unfolding Basis_prod_def by simp next - show "\i 'b). \j 'b). - inner (basis i::'a \ 'b) (basis j) = (if i = j then 1 else 0)" - unfolding dimension_prod_def basis_prod_def inner_prod_def - unfolding all_less_sum prod_eq_iff - by (simp add: basis_orthonormal) + fix u v :: "'a \ 'b" + assume "u \ Basis" and "v \ Basis" + thus "inner u v = (if u = v then 1 else 0)" + unfolding Basis_prod_def inner_prod_def + by (auto simp add: inner_Basis split: split_if_asm) next fix x :: "'a \ 'b" - show "(\i 'b). inner (basis i) x = 0) \ x = 0" - unfolding dimension_prod_def basis_prod_def inner_prod_def - unfolding all_less_sum prod_eq_iff - by (simp add: euclidean_all_zero) + show "(\u\Basis. inner x u = 0) \ x = 0" + unfolding Basis_prod_def ball_Un ball_simps + by (simp add: inner_prod_def prod_eq_iff euclidean_all_zero_iff) +next + show "DIM('a \ 'b) = card (Basis :: ('a \ 'b) set)" + unfolding dimension_prod_def Basis_prod_def + by (simp add: card_Un_disjoint disjoint_iff + card_image inj_on_def dimension_def) +next + show "basis ` {.. 'b)} = (Basis :: ('a \ 'b) set)" + by (auto simp add: Basis_prod_def dimension_prod_def basis_prod_def + image_def elim!: Basis_elim) +next + show "basis ` {DIM('a \ 'b)..} = {0::('a \ 'b)}" + by (auto simp add: dimension_prod_def basis_prod_def prod_eq_iff image_def) qed end diff -r d26a45f3c835 -r d12d89a66742 src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy --- a/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Thu Aug 11 09:11:15 2011 -0700 +++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Thu Aug 11 13:05:56 2011 -0700 @@ -442,8 +442,44 @@ end + subsection {* Euclidean space *} +text {* Vectors pointing along a single axis. *} + +definition "axis k x = (\ i. if i = k then x else 0)" + +lemma axis_nth [simp]: "axis i x $ i = x" + unfolding axis_def by simp + +lemma axis_eq_axis: "axis i x = axis j y \ x = y \ i = j \ x = 0 \ y = 0" + unfolding axis_def vec_eq_iff by auto + +lemma inner_axis_axis: + "inner (axis i x) (axis j y) = (if i = j then inner x y else 0)" + unfolding inner_vec_def + apply (cases "i = j") + apply clarsimp + apply (subst setsum_diff1' [where a=j], simp_all) + apply (rule setsum_0', simp add: axis_def) + apply (rule setsum_0', simp add: axis_def) + done + +lemma setsum_single: + assumes "finite A" and "k \ A" and "f k = y" + assumes "\i. i \ A \ i \ k \ f i = 0" + shows "(\i\A. f i) = y" + apply (subst setsum_diff1' [OF assms(1,2)]) + apply (simp add: setsum_0' assms(3,4)) + done + +lemma inner_axis: "inner x (axis i y) = inner (x $ i) y" + unfolding inner_vec_def + apply (rule_tac k=i in setsum_single) + apply simp_all + apply (simp add: axis_def) + done + text {* A bijection between @{text "'n::finite"} and @{text "{.. ('n::finite)" where @@ -482,16 +518,18 @@ instantiation vec :: (euclidean_space, finite) euclidean_space begin +definition "Basis = (\i. \u\Basis. {axis i u})" + definition "dimension (t :: ('a ^ 'b) itself) = CARD('b) * DIM('a)" -definition "(basis i::'a^'b) = +definition "basis i = (if i < (CARD('b) * DIM('a)) - then (\ j::'b. if j = \(i div DIM('a)) then basis (i mod DIM('a)) else 0) + then axis (\(i div DIM('a))) (basis (i mod DIM('a))) else 0)" lemma basis_eq: assumes "i < CARD('b)" and "j < DIM('a)" - shows "basis (j + i * DIM('a)) = (\ k. if k = \ i then basis j else 0)" + shows "basis (j + i * DIM('a)) = axis (\ i) (basis j)" proof - have "j + i * DIM('a) < DIM('a) * (i + 1)" using assms by (auto simp: field_simps) also have "\ \ DIM('a) * CARD('b)" using assms unfolding mult_le_cancel1 by auto @@ -503,7 +541,7 @@ assumes "j < DIM('a)" shows "basis (j + \' i * DIM('a)) $ k = (if k = i then basis j else 0)" apply (subst basis_eq) - using pi'_range assms by simp_all + using pi'_range assms by (simp_all add: axis_def) lemma split_times_into_modulo[consumes 1]: fixes k :: nat @@ -520,20 +558,6 @@ finally show "k div B < A" by auto qed simp -lemma split_CARD_DIM[consumes 1]: - fixes k :: nat - assumes k: "k < CARD('b) * DIM('a)" - obtains i and j::'b where "i < DIM('a)" "k = i + \' j * DIM('a)" -proof - - from split_times_into_modulo[OF k] guess i j . note ij = this - show thesis - proof - show "j < DIM('a)" using ij by simp - show "k = j + \' (\ i :: 'b) * DIM('a)" - using ij by simp - qed -qed - lemma linear_less_than_times: fixes i j A B :: nat assumes "i < B" "j < A" shows "j + i * A < B * A" @@ -546,64 +570,43 @@ lemma DIM_cart[simp]: "DIM('a^'b) = CARD('b) * DIM('a)" by (rule dimension_vec_def) -lemma all_less_DIM_cart: - fixes m n :: nat - shows "(\i (\x::'b. \i' x * DIM('a)))" -unfolding DIM_cart -apply safe -apply (drule spec, erule mp, erule linear_less_than_times [OF pi'_range]) -apply (erule split_CARD_DIM, simp) -done - -lemma eq_pi_iff: - fixes x :: "'c::finite" - shows "i < CARD('c::finite) \ x = \ i \ \' x = i" - by auto - -lemma all_less_mult: - fixes m n :: nat - shows "(\i<(m * n). P i) \ (\ij {}" + unfolding Basis_vec_def by simp +next + show "finite (Basis :: ('a ^ 'b) set)" + unfolding Basis_vec_def by simp next - fix i :: nat - assume "DIM('a ^ 'b) \ i" thus "basis i = (0::'a^'b)" - unfolding dimension_vec_def basis_vec_def - by simp + fix u v :: "'a ^ 'b" + assume "u \ Basis" and "v \ Basis" + thus "inner u v = (if u = v then 1 else 0)" + unfolding Basis_vec_def + by (auto simp add: inner_axis_axis axis_eq_axis inner_Basis) next - show "\iju\Basis. inner x u = 0) \ x = 0" + unfolding Basis_vec_def + by (simp add: inner_axis euclidean_all_zero_iff vec_eq_iff) +next + show "DIM('a ^ 'b) = card (Basis :: ('a ^ 'b) set)" + unfolding Basis_vec_def dimension_vec_def dimension_def + by (simp add: card_UN_disjoint [unfolded disjoint_iff] + axis_eq_axis nonzero_Basis) +next + show "basis ` {..i x = 0" - unfolding all_less_DIM_cart - unfolding inner_vec_def - apply (simp add: basis_eq_pi') - apply (simp add: inner_if setsum_delta cong: if_cong) - apply (simp add: euclidean_all_zero) - apply (simp add: vec_eq_iff) - done + show "basis ` {DIM('a ^ 'b)..} = {0::'a ^ 'b}" + by (auto simp add: image_def basis_vec_def) qed end diff -r d26a45f3c835 -r d12d89a66742 src/HOL/Multivariate_Analysis/Linear_Algebra.thy --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Thu Aug 11 09:11:15 2011 -0700 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Thu Aug 11 13:05:56 2011 -0700 @@ -1581,12 +1581,6 @@ subsection{* Euclidean Spaces as Typeclass*} -lemma (in euclidean_space) basis_inj[simp, intro]: "inj_on basis {.. 'c::real_vector" assumes *: "inj_on f {.. (\a u. a < D \ (\i\{..R f i) \ f a)"