# HG changeset patch # User huffman # Date 1243616294 25200 # Node ID b4660351e8e7621ba83baf5a8dc530c985cd80b5 # Parent d41a8ba25b674ece945f773a9396c76c92f9949e instance * :: (metric_space, metric_space) metric_space; generalize lemmas to class metric_space diff -r d41a8ba25b67 -r b4660351e8e7 src/HOL/Library/Product_Vector.thy --- a/src/HOL/Library/Product_Vector.thy Fri May 29 09:22:56 2009 -0700 +++ b/src/HOL/Library/Product_Vector.thy Fri May 29 09:58:14 2009 -0700 @@ -39,6 +39,38 @@ end +subsection {* Product is a metric space *} + +instantiation + "*" :: (metric_space, metric_space) metric_space +begin + +definition dist_prod_def: + "dist (x::'a \ 'b) y = sqrt ((dist (fst x) (fst y))\ + (dist (snd x) (snd y))\)" + +lemma dist_Pair_Pair: "dist (a, b) (c, d) = sqrt ((dist a c)\ + (dist b d)\)" + unfolding dist_prod_def by simp + +instance proof + fix x y :: "'a \ 'b" + show "dist x y = 0 \ x = y" + unfolding dist_prod_def + by (simp add: expand_prod_eq) +next + fix x y z :: "'a \ 'b" + show "dist x y \ dist x z + dist y z" + unfolding dist_prod_def + apply (rule order_trans [OF _ real_sqrt_sum_squares_triangle_ineq]) + apply (rule real_sqrt_le_mono) + apply (rule order_trans [OF add_mono]) + apply (rule power_mono [OF dist_triangle2 [of _ _ "fst z"] zero_le_dist]) + apply (rule power_mono [OF dist_triangle2 [of _ _ "snd z"] zero_le_dist]) + apply (simp only: real_sum_squared_expand) + done +qed + +end + subsection {* Product is a normed vector space *} instantiation @@ -51,9 +83,6 @@ definition sgn_prod_def: "sgn (x::'a \ 'b) = scaleR (inverse (norm x)) x" -definition dist_prod_def: - "dist (x::'a \ 'b) y = norm (x - y)" - lemma norm_Pair: "norm (a, b) = sqrt ((norm a)\ + (norm b)\)" unfolding norm_prod_def by simp @@ -78,7 +107,8 @@ show "sgn x = scaleR (inverse (norm x)) x" by (rule sgn_prod_def) show "dist x y = norm (x - y)" - by (rule dist_prod_def) + unfolding dist_prod_def norm_prod_def + by (simp add: dist_norm) qed end @@ -179,53 +209,53 @@ lemma LIMSEQ_Pair: assumes "X ----> a" and "Y ----> b" shows "(\n. (X n, Y n)) ----> (a, b)" -proof (rule LIMSEQ_I) +proof (rule metric_LIMSEQ_I) fix r :: real assume "0 < r" then have "0 < r / sqrt 2" (is "0 < ?s") by (simp add: divide_pos_pos) - obtain M where M: "\n\M. norm (X n - a) < ?s" - using LIMSEQ_D [OF `X ----> a` `0 < ?s`] .. - obtain N where N: "\n\N. norm (Y n - b) < ?s" - using LIMSEQ_D [OF `Y ----> b` `0 < ?s`] .. - have "\n\max M N. norm ((X n, Y n) - (a, b)) < r" - using M N by (simp add: real_sqrt_sum_squares_less norm_Pair) - then show "\n0. \n\n0. norm ((X n, Y n) - (a, b)) < r" .. + obtain M where M: "\n\M. dist (X n) a < ?s" + using metric_LIMSEQ_D [OF `X ----> a` `0 < ?s`] .. + obtain N where N: "\n\N. dist (Y n) b < ?s" + using metric_LIMSEQ_D [OF `Y ----> b` `0 < ?s`] .. + have "\n\max M N. dist (X n, Y n) (a, b) < r" + using M N by (simp add: real_sqrt_sum_squares_less dist_Pair_Pair) + then show "\n0. \n\n0. dist (X n, Y n) (a, b) < r" .. qed lemma Cauchy_Pair: assumes "Cauchy X" and "Cauchy Y" shows "Cauchy (\n. (X n, Y n))" -proof (rule CauchyI) +proof (rule metric_CauchyI) fix r :: real assume "0 < r" then have "0 < r / sqrt 2" (is "0 < ?s") by (simp add: divide_pos_pos) - obtain M where M: "\m\M. \n\M. norm (X m - X n) < ?s" - using CauchyD [OF `Cauchy X` `0 < ?s`] .. - obtain N where N: "\m\N. \n\N. norm (Y m - Y n) < ?s" - using CauchyD [OF `Cauchy Y` `0 < ?s`] .. - have "\m\max M N. \n\max M N. norm ((X m, Y m) - (X n, Y n)) < r" - using M N by (simp add: real_sqrt_sum_squares_less norm_Pair) - then show "\n0. \m\n0. \n\n0. norm ((X m, Y m) - (X n, Y n)) < r" .. + obtain M where M: "\m\M. \n\M. dist (X m) (X n) < ?s" + using metric_CauchyD [OF `Cauchy X` `0 < ?s`] .. + obtain N where N: "\m\N. \n\N. dist (Y m) (Y n) < ?s" + using metric_CauchyD [OF `Cauchy Y` `0 < ?s`] .. + have "\m\max M N. \n\max M N. dist (X m, Y m) (X n, Y n) < r" + using M N by (simp add: real_sqrt_sum_squares_less dist_Pair_Pair) + then show "\n0. \m\n0. \n\n0. dist (X m, Y m) (X n, Y n) < r" .. qed lemma LIM_Pair: assumes "f -- x --> a" and "g -- x --> b" shows "(\x. (f x, g x)) -- x --> (a, b)" -proof (rule LIM_I) +proof (rule metric_LIM_I) fix r :: real assume "0 < r" then have "0 < r / sqrt 2" (is "0 < ?e") by (simp add: divide_pos_pos) obtain s where s: "0 < s" - "\z. z \ x \ norm (z - x) < s \ norm (f z - a) < ?e" - using LIM_D [OF `f -- x --> a` `0 < ?e`] by fast + "\z. z \ x \ dist z x < s \ dist (f z) a < ?e" + using metric_LIM_D [OF `f -- x --> a` `0 < ?e`] by fast obtain t where t: "0 < t" - "\z. z \ x \ norm (z - x) < t \ norm (g z - b) < ?e" - using LIM_D [OF `g -- x --> b` `0 < ?e`] by fast + "\z. z \ x \ dist z x < t \ dist (g z) b < ?e" + using metric_LIM_D [OF `g -- x --> b` `0 < ?e`] by fast have "0 < min s t \ - (\z. z \ x \ norm (z - x) < min s t \ norm ((f z, g z) - (a, b)) < r)" - using s t by (simp add: real_sqrt_sum_squares_less norm_Pair) + (\z. z \ x \ dist z x < min s t \ dist (f z, g z) (a, b) < r)" + using s t by (simp add: real_sqrt_sum_squares_less dist_Pair_Pair) then show - "\s>0. \z. z \ x \ norm (z - x) < s \ norm ((f z, g z) - (a, b)) < r" .. + "\s>0. \z. z \ x \ dist z x < s \ dist (f z, g z) (a, b) < r" .. qed lemma isCont_Pair [simp]: