diff -r 18b4ab6854f1 -r e63ad7d5158d src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy --- a/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Wed Aug 10 10:13:16 2011 -0700 +++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Wed Aug 10 13:13:37 2011 -0700 @@ -13,148 +13,148 @@ subsection {* Finite Cartesian products, with indexing and lambdas. *} -typedef (open Cart) - ('a, 'b) cart = "UNIV :: (('b::finite) \ 'a) set" - morphisms Cart_nth Cart_lambda .. +typedef (open) + ('a, 'b) vec = "UNIV :: (('b::finite) \ 'a) set" + morphisms vec_nth vec_lambda .. notation - Cart_nth (infixl "$" 90) and - Cart_lambda (binder "\" 10) + vec_nth (infixl "$" 90) and + vec_lambda (binder "\" 10) (* Translate "'b ^ 'n" into "'b ^ ('n :: finite)". When 'n has already more than - the finite type class write "cart 'b 'n" + the finite type class write "vec 'b 'n" *) -syntax "_finite_cart" :: "type \ type \ type" ("(_ ^/ _)" [15, 16] 15) +syntax "_finite_vec" :: "type \ type \ type" ("(_ ^/ _)" [15, 16] 15) parse_translation {* let - fun cart t u = Syntax.const @{type_syntax cart} $ t $ u; - fun finite_cart_tr [t, u as Free (x, _)] = + fun vec t u = Syntax.const @{type_syntax vec} $ t $ u; + fun finite_vec_tr [t, u as Free (x, _)] = if Lexicon.is_tid x then - cart t (Syntax.const @{syntax_const "_ofsort"} $ u $ Syntax.const @{class_syntax finite}) - else cart t u - | finite_cart_tr [t, u] = cart t u + vec t (Syntax.const @{syntax_const "_ofsort"} $ u $ Syntax.const @{class_syntax finite}) + else vec t u + | finite_vec_tr [t, u] = vec t u in - [(@{syntax_const "_finite_cart"}, finite_cart_tr)] + [(@{syntax_const "_finite_vec"}, finite_vec_tr)] end *} lemma stupid_ext: "(\x. f x = g x) \ (f = g)" by (auto intro: ext) -lemma Cart_eq: "(x = y) \ (\i. x$i = y$i)" - by (simp add: Cart_nth_inject [symmetric] fun_eq_iff) +lemma vec_eq_iff: "(x = y) \ (\i. x$i = y$i)" + by (simp add: vec_nth_inject [symmetric] fun_eq_iff) -lemma Cart_lambda_beta [simp]: "Cart_lambda g $ i = g i" - by (simp add: Cart_lambda_inverse) +lemma vec_lambda_beta [simp]: "vec_lambda g $ i = g i" + by (simp add: vec_lambda_inverse) -lemma Cart_lambda_unique: "(\i. f$i = g i) \ Cart_lambda g = f" - by (auto simp add: Cart_eq) +lemma vec_lambda_unique: "(\i. f$i = g i) \ vec_lambda g = f" + by (auto simp add: vec_eq_iff) -lemma Cart_lambda_eta: "(\ i. (g$i)) = g" - by (simp add: Cart_eq) +lemma vec_lambda_eta: "(\ i. (g$i)) = g" + by (simp add: vec_eq_iff) subsection {* Group operations and class instances *} -instantiation cart :: (zero,finite) zero +instantiation vec :: (zero, finite) zero begin - definition vector_zero_def : "0 \ (\ i. 0)" + definition "0 \ (\ i. 0)" instance .. end -instantiation cart :: (plus,finite) plus +instantiation vec :: (plus, finite) plus begin - definition vector_add_def : "op + \ (\ x y. (\ i. (x$i) + (y$i)))" + definition "op + \ (\ x y. (\ i. x$i + y$i))" instance .. end -instantiation cart :: (minus,finite) minus +instantiation vec :: (minus, finite) minus begin - definition vector_minus_def : "op - \ (\ x y. (\ i. (x$i) - (y$i)))" + definition "op - \ (\ x y. (\ i. x$i - y$i))" instance .. end -instantiation cart :: (uminus,finite) uminus +instantiation vec :: (uminus, finite) uminus begin - definition vector_uminus_def : "uminus \ (\ x. (\ i. - (x$i)))" + definition "uminus \ (\ x. (\ i. - (x$i)))" instance .. end lemma zero_index [simp]: "0 $ i = 0" - unfolding vector_zero_def by simp + unfolding zero_vec_def by simp lemma vector_add_component [simp]: "(x + y)$i = x$i + y$i" - unfolding vector_add_def by simp + unfolding plus_vec_def by simp lemma vector_minus_component [simp]: "(x - y)$i = x$i - y$i" - unfolding vector_minus_def by simp + unfolding minus_vec_def by simp lemma vector_uminus_component [simp]: "(- x)$i = - (x$i)" - unfolding vector_uminus_def by simp + unfolding uminus_vec_def by simp -instance cart :: (semigroup_add, finite) semigroup_add - by default (simp add: Cart_eq add_assoc) +instance vec :: (semigroup_add, finite) semigroup_add + by default (simp add: vec_eq_iff add_assoc) -instance cart :: (ab_semigroup_add, finite) ab_semigroup_add - by default (simp add: Cart_eq add_commute) +instance vec :: (ab_semigroup_add, finite) ab_semigroup_add + by default (simp add: vec_eq_iff add_commute) -instance cart :: (monoid_add, finite) monoid_add - by default (simp_all add: Cart_eq) +instance vec :: (monoid_add, finite) monoid_add + by default (simp_all add: vec_eq_iff) -instance cart :: (comm_monoid_add, finite) comm_monoid_add - by default (simp add: Cart_eq) +instance vec :: (comm_monoid_add, finite) comm_monoid_add + by default (simp add: vec_eq_iff) -instance cart :: (cancel_semigroup_add, finite) cancel_semigroup_add - by default (simp_all add: Cart_eq) +instance vec :: (cancel_semigroup_add, finite) cancel_semigroup_add + by default (simp_all add: vec_eq_iff) -instance cart :: (cancel_ab_semigroup_add, finite) cancel_ab_semigroup_add - by default (simp add: Cart_eq) +instance vec :: (cancel_ab_semigroup_add, finite) cancel_ab_semigroup_add + by default (simp add: vec_eq_iff) -instance cart :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add .. +instance vec :: (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 vec :: (group_add, finite) group_add + by default (simp_all add: vec_eq_iff diff_minus) -instance cart :: (ab_group_add, finite) ab_group_add - by default (simp_all add: Cart_eq) +instance vec :: (ab_group_add, finite) ab_group_add + by default (simp_all add: vec_eq_iff) subsection {* Real vector space *} -instantiation cart :: (real_vector, finite) real_vector +instantiation vec :: (real_vector, finite) real_vector begin -definition vector_scaleR_def: "scaleR = (\ r x. (\ i. scaleR r (x$i)))" +definition "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 + unfolding scaleR_vec_def by simp instance - by default (simp_all add: Cart_eq scaleR_left_distrib scaleR_right_distrib) + by default (simp_all add: vec_eq_iff scaleR_left_distrib scaleR_right_distrib) end subsection {* Topological space *} -instantiation cart :: (topological_space, finite) topological_space +instantiation vec :: (topological_space, finite) topological_space begin -definition open_vector_def: +definition "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 + unfolding open_vec_def by auto next fix S T :: "('a ^ 'b) set" assume "open S" "open T" thus "open (S \ T)" - unfolding open_vector_def + unfolding open_vec_def apply clarify apply (drule (1) bspec)+ apply (clarify, rename_tac Sa Ta) @@ -164,7 +164,7 @@ next fix K :: "('a ^ 'b) set set" assume "\S\K. open S" thus "open (\K)" - unfolding open_vector_def + unfolding open_vec_def apply clarify apply (drule (1) bspec) apply (drule (1) bspec) @@ -177,32 +177,32 @@ end lemma open_vector_box: "\i. open (S i) \ open {x. \i. x $ i \ S i}" -unfolding open_vector_def by auto + unfolding open_vec_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 open_vimage_vec_nth: "open S \ open ((\x. x $ i) -` S)" + unfolding open_vec_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_vimage_vec_nth: "closed S \ closed ((\x. x $ i) -` S)" + unfolding closed_open vimage_Compl [symmetric] + by (rule open_vimage_vec_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) + by (simp add: closed_INT closed_vimage_vec_nth) qed -lemma tendsto_Cart_nth [tendsto_intros]: +lemma tendsto_vec_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) + by (simp_all add: open_vimage_vec_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" @@ -220,14 +220,14 @@ shows "eventually (\x. \y. P x y) net" using eventually_Ball_finite [of UNIV P] assms by simp -lemma tendsto_vector: +lemma vec_tendstoI: 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 + unfolding open_vec_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" @@ -236,10 +236,10 @@ by (rule eventually_elim1, simp add: S) qed -lemma tendsto_Cart_lambda [tendsto_intros]: +lemma tendsto_vec_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) + using assms by (simp add: vec_tendstoI) subsection {* Metric *} @@ -251,25 +251,24 @@ apply (rule_tac x="f(x:=y)" in exI, simp) done -instantiation cart :: (metric_space, finite) metric_space +instantiation vec :: (metric_space, finite) metric_space begin -definition dist_vector_def: +definition "dist x y = setL2 (\i. dist (x$i) (y$i)) UNIV" -lemma dist_nth_le_cart: "dist (x $ i) (y $ i) \ dist x y" -unfolding dist_vector_def -by (rule member_le_setL2) simp_all +lemma dist_vec_nth_le: "dist (x $ i) (y $ i) \ dist x y" + unfolding dist_vec_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) + unfolding dist_vec_def + by (simp add: setL2_eq_0_iff vec_eq_iff) next fix x y z :: "'a ^ 'b" show "dist x y \ dist x z + dist y z" - unfolding dist_vector_def + unfolding dist_vec_def apply (rule order_trans [OF _ setL2_triangle_ineq]) apply (simp add: setL2_mono dist_triangle2) done @@ -277,7 +276,7 @@ (* 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 + unfolding open_vec_def open_dist apply safe apply (drule (1) bspec) apply clarify @@ -286,7 +285,7 @@ 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_cart]) + apply (erule le_less_trans [OF dist_vec_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) @@ -308,7 +307,7 @@ apply simp apply clarify apply (drule spec, erule mp) - apply (simp add: dist_vector_def setL2_strict_mono) + apply (simp add: dist_vec_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 @@ -316,11 +315,11 @@ end -lemma Cauchy_Cart_nth: +lemma Cauchy_vec_nth: "Cauchy (\n. X n) \ Cauchy (\n. X n $ i)" -unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le_cart]) + unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_vec_nth_le]) -lemma Cauchy_vector: +lemma vec_CauchyI: fixes X :: "nat \ 'a::metric_space ^ 'n" assumes X: "\i. Cauchy (\n. X n $ i)" shows "Cauchy (\n. X n)" @@ -340,7 +339,7 @@ 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 .. + unfolding dist_vec_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" @@ -354,14 +353,14 @@ then show "\M. \m\M. \n\M. dist (X m) (X n) < r" .. qed -instance cart :: (complete_space, finite) complete_space +instance vec :: (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`] + using Cauchy_vec_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: tendsto_vector) + hence "X ----> vec_lambda (\i. lim (\n. X n $ i))" + by (simp add: vec_tendstoI) then show "convergent X" by (rule convergentI) qed @@ -369,11 +368,10 @@ subsection {* Normed vector space *} -instantiation cart :: (real_normed_vector, finite) real_normed_vector +instantiation vec :: (real_normed_vector, finite) real_normed_vector begin -definition norm_vector_def: - "norm x = setL2 (\i. norm (x$i)) UNIV" +definition "norm x = setL2 (\i. norm (x$i)) UNIV" definition vector_sgn_def: "sgn (x::'a^'b) = scaleR (inverse (norm x)) x" @@ -381,69 +379,68 @@ instance proof fix a :: real and x y :: "'a ^ 'b" show "0 \ norm x" - unfolding norm_vector_def + unfolding norm_vec_def by (rule setL2_nonneg) show "norm x = 0 \ x = 0" - unfolding norm_vector_def - by (simp add: setL2_eq_0_iff Cart_eq) + unfolding norm_vec_def + by (simp add: setL2_eq_0_iff vec_eq_iff) show "norm (x + y) \ norm x + norm y" - unfolding norm_vector_def + unfolding norm_vec_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 + unfolding norm_vec_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 + unfolding dist_vec_def norm_vec_def by (simp add: dist_norm) qed end lemma norm_nth_le: "norm (x $ i) \ norm x" -unfolding norm_vector_def +unfolding norm_vec_def by (rule member_le_setL2) simp_all -interpretation Cart_nth: bounded_linear "\x. x $ i" +interpretation vec_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 .. +instance vec :: (banach, finite) banach .. subsection {* Inner product space *} -instantiation cart :: (real_inner, finite) real_inner +instantiation vec :: (real_inner, finite) real_inner begin -definition inner_vector_def: - "inner x y = setsum (\i. inner (x$i) (y$i)) UNIV" +definition "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 + unfolding inner_vec_def by (simp add: inner_commute) show "inner (x + y) z = inner x z + inner y z" - unfolding inner_vector_def + unfolding inner_vec_def by (simp add: inner_add_left setsum_addf) show "inner (scaleR r x) y = r * inner x y" - unfolding inner_vector_def + unfolding inner_vec_def by (simp add: setsum_right_distrib) show "0 \ inner x x" - unfolding inner_vector_def + unfolding inner_vec_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) + unfolding inner_vec_def + by (simp add: vec_eq_iff setsum_nonneg_eq_0_iff) show "norm x = sqrt (inner x x)" - unfolding inner_vector_def norm_vector_def setL2_def + unfolding inner_vec_def norm_vec_def setL2_def by (simp add: power2_norm_eq_inner) qed @@ -453,16 +450,16 @@ text {* A bijection between @{text "'n::finite"} and @{text "{.. ('n::finite)" where - "cart_bij_nat = (SOME p. bij_betw p {.. ('n::finite)" where + "vec_bij_nat = (SOME p. bij_betw p {.. \ cart_bij_nat" +abbreviation "\ \ vec_bij_nat" definition "\' = inv_into {..::nat \ ('n::finite))" lemma bij_betw_pi: "bij_betw \ {..x. bij_betw x {..' (UNIV::'n set) {.._inj_on: "inj_on (\::nat\'n::finite) {.. \ DIM('a) * CARD('b)" using assms unfolding mult_le_cancel1 by auto finally show ?thesis - unfolding basis_cart_def using assms by (auto simp: Cart_eq not_less field_simps) + unfolding basis_vec_def using assms by (auto simp: vec_eq_iff not_less field_simps) qed lemma basis_eq_pi': @@ -551,7 +548,7 @@ qed lemma DIM_cart[simp]: "DIM('a^'b) = CARD('b) * DIM('a)" - by (rule dimension_cart_def) + by (rule dimension_vec_def) lemma all_less_DIM_cart: fixes m n :: nat @@ -582,17 +579,17 @@ instance proof show "0 < DIM('a ^ 'b)" - unfolding dimension_cart_def + unfolding dimension_vec_def by (intro mult_pos_pos zero_less_card_finite DIM_positive) next fix i :: nat assume "DIM('a ^ 'b) \ i" thus "basis i = (0::'a^'b)" - unfolding dimension_cart_def basis_cart_def + unfolding dimension_vec_def basis_vec_def by simp next show "\iji x = 0" unfolding all_less_DIM_cart - unfolding inner_vector_def + 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: Cart_eq) + apply (simp add: vec_eq_iff) done qed