# HG changeset patch # User huffman # Date 1272557845 25200 # Node ID df38e0c5c12372e5130b0d87e5887670782c6dfd # Parent 2cdaae32b682fb58035008c1647211498af77282 move class instantiations from Euclidean_Space.thy to Finite_Cartesian_Product.thy diff -r 2cdaae32b682 -r df38e0c5c123 src/HOL/Multivariate_Analysis/Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Thu Apr 29 07:22:01 2010 -0700 +++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Thu Apr 29 09:17:25 2010 -0700 @@ -14,48 +14,18 @@ subsection{* Basic componentwise operations on vectors. *} -instantiation cart :: (plus,finite) plus -begin - definition vector_add_def : "op + \ (\ x y. (\ i. (x$i) + (y$i)))" - instance .. -end - instantiation cart :: (times,finite) times begin definition vector_mult_def : "op * \ (\ x y. (\ i. (x$i) * (y$i)))" instance .. end -instantiation cart :: (minus,finite) minus -begin - definition vector_minus_def : "op - \ (\ x y. (\ i. (x$i) - (y$i)))" - instance .. -end - -instantiation cart :: (uminus,finite) uminus -begin - definition vector_uminus_def : "uminus \ (\ x. (\ i. - (x$i)))" - instance .. -end - -instantiation cart :: (zero,finite) zero -begin - definition vector_zero_def : "0 \ (\ i. 0)" - instance .. -end - instantiation cart :: (one,finite) one begin definition vector_one_def : "1 \ (\ i. 1)" instance .. end -instantiation cart :: (scaleR, finite) scaleR -begin - definition vector_scaleR_def: "scaleR = (\ r x. (\ i. scaleR r (x$i)))" - instance .. -end - instantiation cart :: (ord,finite) ord begin definition vector_le_def: @@ -126,24 +96,12 @@ lemma vec_component [simp]: "vec x $ i = x" by (vector vec_def) -lemma vector_add_component [simp]: "(x + y)$i = x$i + y$i" - by vector - -lemma vector_minus_component [simp]: "(x - y)$i = x$i - y$i" - by vector - lemma vector_mult_component [simp]: "(x * y)$i = x$i * y$i" by vector lemma vector_smult_component [simp]: "(c *s y)$i = c * (y$i)" by vector -lemma vector_uminus_component [simp]: "(- x)$i = - (x$i)" - by vector - -lemma vector_scaleR_component [simp]: "(scaleR r x)$i = scaleR r (x$i)" - by vector - lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector lemmas vector_component = @@ -153,35 +111,6 @@ subsection {* Some frequently useful arithmetic lemmas over vectors. *} -instance cart :: (semigroup_add,finite) semigroup_add - apply (intro_classes) by (vector add_assoc) - -instance cart :: (monoid_add,finite) monoid_add - apply (intro_classes) by vector+ - -instance cart :: (group_add,finite) group_add - apply (intro_classes) by (vector algebra_simps)+ - -instance cart :: (ab_semigroup_add,finite) ab_semigroup_add - apply (intro_classes) by (vector add_commute) - -instance cart :: (comm_monoid_add,finite) comm_monoid_add - apply (intro_classes) by vector - -instance cart :: (ab_group_add,finite) ab_group_add - apply (intro_classes) by vector+ - -instance cart :: (cancel_semigroup_add,finite) cancel_semigroup_add - apply (intro_classes) - by (vector Cart_eq)+ - -instance cart :: (cancel_ab_semigroup_add,finite) cancel_ab_semigroup_add - apply (intro_classes) - by (vector Cart_eq) - -instance cart :: (real_vector, finite) real_vector - by default (vector scaleR_left_distrib scaleR_right_distrib)+ - instance cart :: (semigroup_mult,finite) semigroup_mult apply (intro_classes) by (vector mult_assoc) @@ -237,9 +166,6 @@ apply vector done -lemma zero_index[simp]: - "(0 :: 'a::zero ^'n)$i = 0" by vector - lemma one_index[simp]: "(1 :: 'a::one ^'n)$i = 1" by vector @@ -280,329 +206,8 @@ lemma vec_eq[simp]: "(vec m = vec n) \ (m = n)" by (simp add: Cart_eq) -subsection {* Topological space *} - -instantiation cart :: (topological_space, finite) topological_space -begin - -definition open_vector_def: - "open (S :: ('a ^ 'b) set) \ - (\x\S. \A. (\i. open (A i) \ x$i \ A i) \ - (\y. (\i. y$i \ A i) \ y \ S))" - -instance proof - show "open (UNIV :: ('a ^ 'b) set)" - unfolding open_vector_def by auto -next - fix S T :: "('a ^ 'b) set" - assume "open S" "open T" thus "open (S \ T)" - unfolding open_vector_def - apply clarify - apply (drule (1) bspec)+ - apply (clarify, rename_tac Sa Ta) - apply (rule_tac x="\i. Sa i \ Ta i" in exI) - apply (simp add: open_Int) - done -next - fix K :: "('a ^ 'b) set set" - assume "\S\K. open S" thus "open (\K)" - unfolding open_vector_def - apply clarify - apply (drule (1) bspec) - apply (drule (1) bspec) - apply clarify - apply (rule_tac x=A in exI) - apply fast - done -qed - -end - -lemma open_vector_box: "\i. open (S i) \ open {x. \i. x $ i \ S i}" -unfolding open_vector_def by auto - -lemma open_vimage_Cart_nth: "open S \ open ((\x. x $ i) -` S)" -unfolding open_vector_def -apply clarify -apply (rule_tac x="\k. if k = i then S else UNIV" in exI, simp) -done - -lemma closed_vimage_Cart_nth: "closed S \ closed ((\x. x $ i) -` S)" -unfolding closed_open vimage_Compl [symmetric] -by (rule open_vimage_Cart_nth) - -lemma closed_vector_box: "\i. closed (S i) \ closed {x. \i. x $ i \ S i}" -proof - - have "{x. \i. x $ i \ S i} = (\i. (\x. x $ i) -` S i)" by auto - thus "\i. closed (S i) \ closed {x. \i. x $ i \ S i}" - by (simp add: closed_INT closed_vimage_Cart_nth) -qed - -lemma tendsto_Cart_nth [tendsto_intros]: - assumes "((\x. f x) ---> a) net" - shows "((\x. f x $ i) ---> a $ i) net" -proof (rule topological_tendstoI) - fix S assume "open S" "a $ i \ S" - then have "open ((\y. y $ i) -` S)" "a \ ((\y. y $ i) -` S)" - by (simp_all add: open_vimage_Cart_nth) - with assms have "eventually (\x. f x \ (\y. y $ i) -` S) net" - by (rule topological_tendstoD) - then show "eventually (\x. f x $ i \ S) net" - by simp -qed - -lemma eventually_Ball_finite: (* TODO: move *) - assumes "finite A" and "\y\A. eventually (\x. P x y) net" - shows "eventually (\x. \y\A. P x y) net" -using assms by (induct set: finite, simp, simp add: eventually_conj) - -lemma eventually_all_finite: (* TODO: move *) - fixes P :: "'a \ 'b::finite \ bool" - assumes "\y. eventually (\x. P x y) net" - shows "eventually (\x. \y. P x y) net" -using eventually_Ball_finite [of UNIV P] assms by simp - -lemma tendsto_vector: - assumes "\i. ((\x. f x $ i) ---> a $ i) net" - shows "((\x. f x) ---> a) net" -proof (rule topological_tendstoI) - fix S assume "open S" and "a \ S" - then obtain A where A: "\i. open (A i)" "\i. a $ i \ A i" - and S: "\y. \i. y $ i \ A i \ y \ S" - unfolding open_vector_def by metis - have "\i. eventually (\x. f x $ i \ A i) net" - using assms A by (rule topological_tendstoD) - hence "eventually (\x. \i. f x $ i \ A i) net" - by (rule eventually_all_finite) - thus "eventually (\x. f x \ S) net" - by (rule eventually_elim1, simp add: S) -qed - -lemma tendsto_Cart_lambda [tendsto_intros]: - assumes "\i. ((\x. f x i) ---> a i) net" - shows "((\x. \ i. f x i) ---> (\ i. a i)) net" -using assms by (simp add: tendsto_vector) - -subsection {* Metric *} - -(* TODO: move somewhere else *) -lemma finite_choice: "finite A \ \x\A. \y. P x y \ \f. \x\A. P x (f x)" -apply (induct set: finite, simp_all) -apply (clarify, rename_tac y) -apply (rule_tac x="f(x:=y)" in exI, simp) -done - -instantiation cart :: (metric_space, finite) metric_space -begin - -definition dist_vector_def: - "dist (x::'a^'b) (y::'a^'b) = setL2 (\i. dist (x$i) (y$i)) UNIV" - -lemma dist_nth_le: "dist (x $ i) (y $ i) \ dist x y" -unfolding dist_vector_def -by (rule member_le_setL2) simp_all - -instance proof - fix x y :: "'a ^ 'b" - show "dist x y = 0 \ x = y" - unfolding dist_vector_def - by (simp add: setL2_eq_0_iff Cart_eq) -next - fix x y z :: "'a ^ 'b" - show "dist x y \ dist x z + dist y z" - unfolding dist_vector_def - apply (rule order_trans [OF _ setL2_triangle_ineq]) - apply (simp add: setL2_mono dist_triangle2) - done -next - (* FIXME: long proof! *) - fix S :: "('a ^ 'b) set" - show "open S \ (\x\S. \e>0. \y. dist y x < e \ y \ S)" - unfolding open_vector_def open_dist - apply safe - apply (drule (1) bspec) - apply clarify - apply (subgoal_tac "\e>0. \i y. dist y (x$i) < e \ y \ A i") - apply clarify - apply (rule_tac x=e in exI, clarify) - apply (drule spec, erule mp, clarify) - apply (drule spec, drule spec, erule mp) - apply (erule le_less_trans [OF dist_nth_le]) - apply (subgoal_tac "\i\UNIV. \e>0. \y. dist y (x$i) < e \ y \ A i") - apply (drule finite_choice [OF finite], clarify) - apply (rule_tac x="Min (range f)" in exI, simp) - apply clarify - apply (drule_tac x=i in spec, clarify) - apply (erule (1) bspec) - apply (drule (1) bspec, clarify) - apply (subgoal_tac "\r. (\i::'b. 0 < r i) \ e = setL2 r UNIV") - apply clarify - apply (rule_tac x="\i. {y. dist y (x$i) < r i}" in exI) - apply (rule conjI) - apply clarify - apply (rule conjI) - apply (clarify, rename_tac y) - apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp) - apply clarify - apply (simp only: less_diff_eq) - apply (erule le_less_trans [OF dist_triangle]) - apply simp - apply clarify - apply (drule spec, erule mp) - apply (simp add: dist_vector_def setL2_strict_mono) - apply (rule_tac x="\i. e / sqrt (of_nat CARD('b))" in exI) - apply (simp add: divide_pos_pos setL2_constant) - done -qed - -end - -lemma LIMSEQ_Cart_nth: - "(X ----> a) \ (\n. X n $ i) ----> a $ i" -unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth) - -lemma LIM_Cart_nth: - "(f -- x --> y) \ (\x. f x $ i) -- x --> y $ i" -unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth) - -lemma Cauchy_Cart_nth: - "Cauchy (\n. X n) \ Cauchy (\n. X n $ i)" -unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le]) - -lemma LIMSEQ_vector: - assumes "\i. (\n. X n $ i) ----> (a $ i)" - shows "X ----> a" -using assms unfolding LIMSEQ_conv_tendsto by (rule tendsto_vector) - -lemma Cauchy_vector: - fixes X :: "nat \ 'a::metric_space ^ 'n" - assumes X: "\i. Cauchy (\n. X n $ i)" - shows "Cauchy (\n. X n)" -proof (rule metric_CauchyI) - fix r :: real assume "0 < r" - then have "0 < r / of_nat CARD('n)" (is "0 < ?s") - by (simp add: divide_pos_pos) - def N \ "\i. LEAST N. \m\N. \n\N. dist (X m $ i) (X n $ i) < ?s" - def M \ "Max (range N)" - have "\i. \N. \m\N. \n\N. dist (X m $ i) (X n $ i) < ?s" - using X `0 < ?s` by (rule metric_CauchyD) - hence "\i. \m\N i. \n\N i. dist (X m $ i) (X n $ i) < ?s" - unfolding N_def by (rule LeastI_ex) - hence M: "\i. \m\M. \n\M. dist (X m $ i) (X n $ i) < ?s" - unfolding M_def by simp - { - fix m n :: nat - assume "M \ m" "M \ n" - have "dist (X m) (X n) = setL2 (\i. dist (X m $ i) (X n $ i)) UNIV" - unfolding dist_vector_def .. - also have "\ \ setsum (\i. dist (X m $ i) (X n $ i)) UNIV" - by (rule setL2_le_setsum [OF zero_le_dist]) - also have "\ < setsum (\i::'n. ?s) UNIV" - by (rule setsum_strict_mono, simp_all add: M `M \ m` `M \ n`) - also have "\ = r" - by simp - finally have "dist (X m) (X n) < r" . - } - hence "\m\M. \n\M. dist (X m) (X n) < r" - by simp - then show "\M. \m\M. \n\M. dist (X m) (X n) < r" .. -qed - -instance cart :: (complete_space, finite) complete_space -proof - fix X :: "nat \ 'a ^ 'b" assume "Cauchy X" - have "\i. (\n. X n $ i) ----> lim (\n. X n $ i)" - using Cauchy_Cart_nth [OF `Cauchy X`] - by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff) - hence "X ----> Cart_lambda (\i. lim (\n. X n $ i))" - by (simp add: LIMSEQ_vector) - then show "convergent X" - by (rule convergentI) -qed - -subsection {* Norms *} - -instantiation cart :: (real_normed_vector, finite) real_normed_vector -begin - -definition norm_vector_def: - "norm (x::'a^'b) = setL2 (\i. norm (x$i)) UNIV" - -definition vector_sgn_def: - "sgn (x::'a^'b) = scaleR (inverse (norm x)) x" - -instance proof - fix a :: real and x y :: "'a ^ 'b" - show "0 \ norm x" - unfolding norm_vector_def - by (rule setL2_nonneg) - show "norm x = 0 \ x = 0" - unfolding norm_vector_def - by (simp add: setL2_eq_0_iff Cart_eq) - show "norm (x + y) \ norm x + norm y" - unfolding norm_vector_def - apply (rule order_trans [OF _ setL2_triangle_ineq]) - apply (simp add: setL2_mono norm_triangle_ineq) - done - show "norm (scaleR a x) = \a\ * norm x" - unfolding norm_vector_def - by (simp add: setL2_right_distrib) - show "sgn x = scaleR (inverse (norm x)) x" - by (rule vector_sgn_def) - show "dist x y = norm (x - y)" - unfolding dist_vector_def norm_vector_def - by (simp add: dist_norm) -qed - -end - -lemma norm_nth_le: "norm (x $ i) \ norm x" -unfolding norm_vector_def -by (rule member_le_setL2) simp_all - -interpretation Cart_nth: bounded_linear "\x. x $ i" -apply default -apply (rule vector_add_component) -apply (rule vector_scaleR_component) -apply (rule_tac x="1" in exI, simp add: norm_nth_le) -done - -instance cart :: (banach, finite) banach .. - -subsection {* Inner products *} - abbreviation inner_bullet (infix "\" 70) where "x \ y \ inner x y" -instantiation cart :: (real_inner, finite) real_inner -begin - -definition inner_vector_def: - "inner x y = setsum (\i. inner (x$i) (y$i)) UNIV" - -instance proof - fix r :: real and x y z :: "'a ^ 'b" - show "inner x y = inner y x" - unfolding inner_vector_def - by (simp add: inner_commute) - show "inner (x + y) z = inner x z + inner y z" - unfolding inner_vector_def - by (simp add: inner_add_left setsum_addf) - show "inner (scaleR r x) y = r * inner x y" - unfolding inner_vector_def - by (simp add: setsum_right_distrib) - show "0 \ inner x x" - unfolding inner_vector_def - by (simp add: setsum_nonneg) - show "inner x x = 0 \ x = 0" - unfolding inner_vector_def - by (simp add: Cart_eq setsum_nonneg_eq_0_iff) - show "norm x = sqrt (inner x x)" - unfolding inner_vector_def norm_vector_def setL2_def - by (simp add: power2_norm_eq_inner) -qed - -end - subsection {* A connectedness or intermediate value lemma with several applications. *} lemma connected_real_lemma: diff -r 2cdaae32b682 -r df38e0c5c123 src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy --- a/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Thu Apr 29 07:22:01 2010 -0700 +++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Thu Apr 29 09:17:25 2010 -0700 @@ -5,7 +5,7 @@ header {* Definition of finite Cartesian product types. *} theory Finite_Cartesian_Product -imports Main +imports Inner_Product L2_Norm Numeral_Type begin subsection {* Finite Cartesian products, with indexing and lambdas. *} @@ -53,4 +53,410 @@ lemma Cart_lambda_eta: "(\ i. (g$i)) = g" by (simp add: Cart_eq) + +subsection {* Group operations and class instances *} + +instantiation cart :: (zero,finite) zero +begin + definition vector_zero_def : "0 \ (\ i. 0)" + instance .. end + +instantiation cart :: (plus,finite) plus +begin + definition vector_add_def : "op + \ (\ x y. (\ i. (x$i) + (y$i)))" + instance .. +end + +instantiation cart :: (minus,finite) minus +begin + definition vector_minus_def : "op - \ (\ x y. (\ i. (x$i) - (y$i)))" + instance .. +end + +instantiation cart :: (uminus,finite) uminus +begin + definition vector_uminus_def : "uminus \ (\ x. (\ i. - (x$i)))" + instance .. +end + +lemma zero_index [simp]: "0 $ i = 0" + unfolding vector_zero_def by simp + +lemma vector_add_component [simp]: "(x + y)$i = x$i + y$i" + unfolding vector_add_def by simp + +lemma vector_minus_component [simp]: "(x - y)$i = x$i - y$i" + unfolding vector_minus_def by simp + +lemma vector_uminus_component [simp]: "(- x)$i = - (x$i)" + unfolding vector_uminus_def by simp + +instance cart :: (semigroup_add, finite) semigroup_add + by default (simp add: Cart_eq add_assoc) + +instance cart :: (ab_semigroup_add, finite) ab_semigroup_add + by default (simp add: Cart_eq add_commute) + +instance cart :: (monoid_add, finite) monoid_add + by default (simp_all add: Cart_eq) + +instance cart :: (comm_monoid_add, finite) comm_monoid_add + by default (simp add: Cart_eq) + +instance cart :: (cancel_semigroup_add, finite) cancel_semigroup_add + by default (simp_all add: Cart_eq) + +instance cart :: (cancel_ab_semigroup_add, finite) cancel_ab_semigroup_add + by default (simp add: Cart_eq) + +instance cart :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add .. + +instance cart :: (group_add, finite) group_add + by default (simp_all add: Cart_eq diff_minus) + +instance cart :: (ab_group_add, finite) ab_group_add + by default (simp_all add: Cart_eq) + + +subsection {* Real vector space *} + +instantiation cart :: (real_vector, finite) real_vector +begin + +definition vector_scaleR_def: "scaleR = (\ r x. (\ i. scaleR r (x$i)))" + +lemma vector_scaleR_component [simp]: "(scaleR r x)$i = scaleR r (x$i)" + unfolding vector_scaleR_def by simp + +instance + by default (simp_all add: Cart_eq scaleR_left_distrib scaleR_right_distrib) + +end + + +subsection {* Topological space *} + +instantiation cart :: (topological_space, finite) topological_space +begin + +definition open_vector_def: + "open (S :: ('a ^ 'b) set) \ + (\x\S. \A. (\i. open (A i) \ x$i \ A i) \ + (\y. (\i. y$i \ A i) \ y \ S))" + +instance proof + show "open (UNIV :: ('a ^ 'b) set)" + unfolding open_vector_def by auto +next + fix S T :: "('a ^ 'b) set" + assume "open S" "open T" thus "open (S \ T)" + unfolding open_vector_def + apply clarify + apply (drule (1) bspec)+ + apply (clarify, rename_tac Sa Ta) + apply (rule_tac x="\i. Sa i \ Ta i" in exI) + apply (simp add: open_Int) + done +next + fix K :: "('a ^ 'b) set set" + assume "\S\K. open S" thus "open (\K)" + unfolding open_vector_def + apply clarify + apply (drule (1) bspec) + apply (drule (1) bspec) + apply clarify + apply (rule_tac x=A in exI) + apply fast + done +qed + +end + +lemma open_vector_box: "\i. open (S i) \ open {x. \i. x $ i \ S i}" +unfolding open_vector_def by auto + +lemma open_vimage_Cart_nth: "open S \ open ((\x. x $ i) -` S)" +unfolding open_vector_def +apply clarify +apply (rule_tac x="\k. if k = i then S else UNIV" in exI, simp) +done + +lemma closed_vimage_Cart_nth: "closed S \ closed ((\x. x $ i) -` S)" +unfolding closed_open vimage_Compl [symmetric] +by (rule open_vimage_Cart_nth) + +lemma closed_vector_box: "\i. closed (S i) \ closed {x. \i. x $ i \ S i}" +proof - + have "{x. \i. x $ i \ S i} = (\i. (\x. x $ i) -` S i)" by auto + thus "\i. closed (S i) \ closed {x. \i. x $ i \ S i}" + by (simp add: closed_INT closed_vimage_Cart_nth) +qed + +lemma tendsto_Cart_nth [tendsto_intros]: + assumes "((\x. f x) ---> a) net" + shows "((\x. f x $ i) ---> a $ i) net" +proof (rule topological_tendstoI) + fix S assume "open S" "a $ i \ S" + then have "open ((\y. y $ i) -` S)" "a \ ((\y. y $ i) -` S)" + by (simp_all add: open_vimage_Cart_nth) + with assms have "eventually (\x. f x \ (\y. y $ i) -` S) net" + by (rule topological_tendstoD) + then show "eventually (\x. f x $ i \ S) net" + by simp +qed + +lemma eventually_Ball_finite: (* TODO: move *) + assumes "finite A" and "\y\A. eventually (\x. P x y) net" + shows "eventually (\x. \y\A. P x y) net" +using assms by (induct set: finite, simp, simp add: eventually_conj) + +lemma eventually_all_finite: (* TODO: move *) + fixes P :: "'a \ 'b::finite \ bool" + assumes "\y. eventually (\x. P x y) net" + shows "eventually (\x. \y. P x y) net" +using eventually_Ball_finite [of UNIV P] assms by simp + +lemma tendsto_vector: + assumes "\i. ((\x. f x $ i) ---> a $ i) net" + shows "((\x. f x) ---> a) net" +proof (rule topological_tendstoI) + fix S assume "open S" and "a \ S" + then obtain A where A: "\i. open (A i)" "\i. a $ i \ A i" + and S: "\y. \i. y $ i \ A i \ y \ S" + unfolding open_vector_def by metis + have "\i. eventually (\x. f x $ i \ A i) net" + using assms A by (rule topological_tendstoD) + hence "eventually (\x. \i. f x $ i \ A i) net" + by (rule eventually_all_finite) + thus "eventually (\x. f x \ S) net" + by (rule eventually_elim1, simp add: S) +qed + +lemma tendsto_Cart_lambda [tendsto_intros]: + assumes "\i. ((\x. f x i) ---> a i) net" + shows "((\x. \ i. f x i) ---> (\ i. a i)) net" +using assms by (simp add: tendsto_vector) + + +subsection {* Metric *} + +(* TODO: move somewhere else *) +lemma finite_choice: "finite A \ \x\A. \y. P x y \ \f. \x\A. P x (f x)" +apply (induct set: finite, simp_all) +apply (clarify, rename_tac y) +apply (rule_tac x="f(x:=y)" in exI, simp) +done + +instantiation cart :: (metric_space, finite) metric_space +begin + +definition dist_vector_def: + "dist x y = setL2 (\i. dist (x$i) (y$i)) UNIV" + +lemma dist_nth_le: "dist (x $ i) (y $ i) \ dist x y" +unfolding dist_vector_def +by (rule member_le_setL2) simp_all + +instance proof + fix x y :: "'a ^ 'b" + show "dist x y = 0 \ x = y" + unfolding dist_vector_def + by (simp add: setL2_eq_0_iff Cart_eq) +next + fix x y z :: "'a ^ 'b" + show "dist x y \ dist x z + dist y z" + unfolding dist_vector_def + apply (rule order_trans [OF _ setL2_triangle_ineq]) + apply (simp add: setL2_mono dist_triangle2) + done +next + (* FIXME: long proof! *) + fix S :: "('a ^ 'b) set" + show "open S \ (\x\S. \e>0. \y. dist y x < e \ y \ S)" + unfolding open_vector_def open_dist + apply safe + apply (drule (1) bspec) + apply clarify + apply (subgoal_tac "\e>0. \i y. dist y (x$i) < e \ y \ A i") + apply clarify + apply (rule_tac x=e in exI, clarify) + apply (drule spec, erule mp, clarify) + apply (drule spec, drule spec, erule mp) + apply (erule le_less_trans [OF dist_nth_le]) + apply (subgoal_tac "\i\UNIV. \e>0. \y. dist y (x$i) < e \ y \ A i") + apply (drule finite_choice [OF finite], clarify) + apply (rule_tac x="Min (range f)" in exI, simp) + apply clarify + apply (drule_tac x=i in spec, clarify) + apply (erule (1) bspec) + apply (drule (1) bspec, clarify) + apply (subgoal_tac "\r. (\i::'b. 0 < r i) \ e = setL2 r UNIV") + apply clarify + apply (rule_tac x="\i. {y. dist y (x$i) < r i}" in exI) + apply (rule conjI) + apply clarify + apply (rule conjI) + apply (clarify, rename_tac y) + apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp) + apply clarify + apply (simp only: less_diff_eq) + apply (erule le_less_trans [OF dist_triangle]) + apply simp + apply clarify + apply (drule spec, erule mp) + apply (simp add: dist_vector_def setL2_strict_mono) + apply (rule_tac x="\i. e / sqrt (of_nat CARD('b))" in exI) + apply (simp add: divide_pos_pos setL2_constant) + done +qed + +end + +lemma LIMSEQ_Cart_nth: + "(X ----> a) \ (\n. X n $ i) ----> a $ i" +unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth) + +lemma LIM_Cart_nth: + "(f -- x --> y) \ (\x. f x $ i) -- x --> y $ i" +unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth) + +lemma Cauchy_Cart_nth: + "Cauchy (\n. X n) \ Cauchy (\n. X n $ i)" +unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le]) + +lemma LIMSEQ_vector: + assumes "\i. (\n. X n $ i) ----> (a $ i)" + shows "X ----> a" +using assms unfolding LIMSEQ_conv_tendsto by (rule tendsto_vector) + +lemma Cauchy_vector: + fixes X :: "nat \ 'a::metric_space ^ 'n" + assumes X: "\i. Cauchy (\n. X n $ i)" + shows "Cauchy (\n. X n)" +proof (rule metric_CauchyI) + fix r :: real assume "0 < r" + then have "0 < r / of_nat CARD('n)" (is "0 < ?s") + by (simp add: divide_pos_pos) + def N \ "\i. LEAST N. \m\N. \n\N. dist (X m $ i) (X n $ i) < ?s" + def M \ "Max (range N)" + have "\i. \N. \m\N. \n\N. dist (X m $ i) (X n $ i) < ?s" + using X `0 < ?s` by (rule metric_CauchyD) + hence "\i. \m\N i. \n\N i. dist (X m $ i) (X n $ i) < ?s" + unfolding N_def by (rule LeastI_ex) + hence M: "\i. \m\M. \n\M. dist (X m $ i) (X n $ i) < ?s" + unfolding M_def by simp + { + fix m n :: nat + assume "M \ m" "M \ n" + have "dist (X m) (X n) = setL2 (\i. dist (X m $ i) (X n $ i)) UNIV" + unfolding dist_vector_def .. + also have "\ \ setsum (\i. dist (X m $ i) (X n $ i)) UNIV" + by (rule setL2_le_setsum [OF zero_le_dist]) + also have "\ < setsum (\i::'n. ?s) UNIV" + by (rule setsum_strict_mono, simp_all add: M `M \ m` `M \ n`) + also have "\ = r" + by simp + finally have "dist (X m) (X n) < r" . + } + hence "\m\M. \n\M. dist (X m) (X n) < r" + by simp + then show "\M. \m\M. \n\M. dist (X m) (X n) < r" .. +qed + +instance cart :: (complete_space, finite) complete_space +proof + fix X :: "nat \ 'a ^ 'b" assume "Cauchy X" + have "\i. (\n. X n $ i) ----> lim (\n. X n $ i)" + using Cauchy_Cart_nth [OF `Cauchy X`] + by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff) + hence "X ----> Cart_lambda (\i. lim (\n. X n $ i))" + by (simp add: LIMSEQ_vector) + then show "convergent X" + by (rule convergentI) +qed + + +subsection {* Normed vector space *} + +instantiation cart :: (real_normed_vector, finite) real_normed_vector +begin + +definition norm_vector_def: + "norm x = setL2 (\i. norm (x$i)) UNIV" + +definition vector_sgn_def: + "sgn (x::'a^'b) = scaleR (inverse (norm x)) x" + +instance proof + fix a :: real and x y :: "'a ^ 'b" + show "0 \ norm x" + unfolding norm_vector_def + by (rule setL2_nonneg) + show "norm x = 0 \ x = 0" + unfolding norm_vector_def + by (simp add: setL2_eq_0_iff Cart_eq) + show "norm (x + y) \ norm x + norm y" + unfolding norm_vector_def + apply (rule order_trans [OF _ setL2_triangle_ineq]) + apply (simp add: setL2_mono norm_triangle_ineq) + done + show "norm (scaleR a x) = \a\ * norm x" + unfolding norm_vector_def + by (simp add: setL2_right_distrib) + show "sgn x = scaleR (inverse (norm x)) x" + by (rule vector_sgn_def) + show "dist x y = norm (x - y)" + unfolding dist_vector_def norm_vector_def + by (simp add: dist_norm) +qed + +end + +lemma norm_nth_le: "norm (x $ i) \ norm x" +unfolding norm_vector_def +by (rule member_le_setL2) simp_all + +interpretation Cart_nth: bounded_linear "\x. x $ i" +apply default +apply (rule vector_add_component) +apply (rule vector_scaleR_component) +apply (rule_tac x="1" in exI, simp add: norm_nth_le) +done + +instance cart :: (banach, finite) banach .. + + +subsection {* Inner product space *} + +instantiation cart :: (real_inner, finite) real_inner +begin + +definition inner_vector_def: + "inner x y = setsum (\i. inner (x$i) (y$i)) UNIV" + +instance proof + fix r :: real and x y z :: "'a ^ 'b" + show "inner x y = inner y x" + unfolding inner_vector_def + by (simp add: inner_commute) + show "inner (x + y) z = inner x z + inner y z" + unfolding inner_vector_def + by (simp add: inner_add_left setsum_addf) + show "inner (scaleR r x) y = r * inner x y" + unfolding inner_vector_def + by (simp add: setsum_right_distrib) + show "0 \ inner x x" + unfolding inner_vector_def + by (simp add: setsum_nonneg) + show "inner x x = 0 \ x = 0" + unfolding inner_vector_def + by (simp add: Cart_eq setsum_nonneg_eq_0_iff) + show "norm x = sqrt (inner x x)" + unfolding inner_vector_def norm_vector_def setL2_def + by (simp add: power2_norm_eq_inner) +qed + +end + +end