# HG changeset patch # User huffman # Date 1313024852 25200 # Node ID d282b3c5df7cc6e072d69c3492c97de746e4d052 # Parent 8e27e0177518022490bf5011fcf0d7a48cf905f1# Parent fa98623f1006e6d80fed503eb64a583bd5855934 merged diff -r fa98623f1006 -r d282b3c5df7c NEWS --- a/NEWS Wed Aug 10 21:24:26 2011 +0200 +++ b/NEWS Wed Aug 10 18:07:32 2011 -0700 @@ -183,6 +183,19 @@ * Limits.thy: Type "'a net" has been renamed to "'a filter", in accordance with standard mathematical terminology. INCOMPATIBILITY. +* Session Multivariate_Analysis: Type "('a, 'b) cart" has been renamed +to "('a, 'b) vec" (the syntax "'a ^ 'b" remains unaffected). Constants +"Cart_nth" and "Cart_lambda" have been respectively renamed to +"vec_nth" and "vec_lambda"; theorems mentioning those names have +changed to match. Definition theorems for overloaded constants now use +the standard "foo_vec_def" naming scheme. A few other theorems have +been renamed as follows (INCOMPATIBILITY): + + Cart_eq ~> vec_eq_iff + dist_nth_le_cart ~> dist_vec_nth_le + tendsto_vector ~> vec_tendstoI + Cauchy_vector ~> vec_CauchyI + *** Document preparation *** diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Library/Cardinality.thy --- a/src/HOL/Library/Cardinality.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Library/Cardinality.thy Wed Aug 10 18:07:32 2011 -0700 @@ -62,7 +62,7 @@ by (simp only: card_Pow finite numeral_2_eq_2) lemma card_nat [simp]: "CARD(nat) = 0" - by (simp add: infinite_UNIV_nat card_eq_0_iff) + by (simp add: card_eq_0_iff) subsection {* Classes with at least 1 and 2 *} diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Library/Convex.thy --- a/src/HOL/Library/Convex.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Library/Convex.thy Wed Aug 10 18:07:32 2011 -0700 @@ -49,7 +49,7 @@ lemma convex_halfspace_le: "convex {x. inner a x \ b}" unfolding convex_def - by (auto simp: inner_add inner_scaleR intro!: convex_bound_le) + by (auto simp: inner_add intro!: convex_bound_le) lemma convex_halfspace_ge: "convex {x. inner a x \ b}" proof - @@ -209,7 +209,7 @@ shows "convex s \ (\u. (\x\s. 0 \ u x) \ setsum u s = 1 \ setsum (\x. u x *\<^sub>R x) s \ s)" unfolding convex_explicit -proof (safe elim!: conjE) +proof (safe) fix t u assume sum: "\u. (\x\s. 0 \ u x) \ setsum u s = 1 \ (\x\s. u x *\<^sub>R x) \ s" and as: "finite t" "t \ s" "\x\t. 0 \ u x" "setsum u t = (1::real)" have *:"s \ t = t" using as(2) by auto @@ -480,9 +480,9 @@ also have "\ = a * (f x - f y) + f y" by (simp add: field_simps) finally have "f t - f y \ a * (f x - f y)" by simp with t show "(f x - f t) / (x - t) \ (f x - f y) / (x - y)" - by (simp add: times_divide_eq le_divide_eq divide_le_eq field_simps a_def) + by (simp add: le_divide_eq divide_le_eq field_simps a_def) with t show "(f x - f y) / (x - y) \ (f t - f y) / (t - y)" - by (simp add: times_divide_eq le_divide_eq divide_le_eq field_simps) + by (simp add: le_divide_eq divide_le_eq field_simps) qed lemma pos_convex_function: diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Library/Extended_Real.thy --- a/src/HOL/Library/Extended_Real.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Library/Extended_Real.thy Wed Aug 10 18:07:32 2011 -0700 @@ -608,7 +608,7 @@ shows "a * c < b * c" using assms by (cases rule: ereal3_cases[of a b c]) - (auto simp: zero_le_mult_iff ereal_less_PInfty) + (auto simp: zero_le_mult_iff) lemma ereal_mult_strict_left_mono: "\ a < b ; 0 < c ; c < (\::ereal)\ \ c * a < c * b" @@ -619,7 +619,7 @@ using assms apply (cases "c = 0") apply simp by (cases rule: ereal3_cases[of a b c]) - (auto simp: zero_le_mult_iff ereal_less_PInfty) + (auto simp: zero_le_mult_iff) lemma ereal_mult_left_mono: fixes a b c :: ereal shows "\a \ b; 0 \ c\ \ c * a \ c * b" @@ -710,7 +710,7 @@ fixes x y :: ereal assumes "ALL z. x <= ereal z --> y <= ereal z" shows "y <= x" -by (metis assms ereal_bot ereal_cases ereal_infty_less_eq ereal_less_eq linorder_le_cases) +by (metis assms ereal_bot ereal_cases ereal_infty_less_eq(2) ereal_less_eq(1) linorder_le_cases) lemma ereal_le_ereal: fixes x y :: ereal @@ -2037,7 +2037,7 @@ with `x \ 0` have "open (S - {0})" "x \ S - {0}" by auto from tendsto[THEN topological_tendstoD, OF this] show "eventually (\x. f x \ S) net" - by (rule eventually_rev_mp) (auto simp: ereal_real real_of_ereal_0) + by (rule eventually_rev_mp) (auto simp: ereal_real) qed lemma tendsto_ereal_realI: diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Library/Set_Algebras.thy --- a/src/HOL/Library/Set_Algebras.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Library/Set_Algebras.thy Wed Aug 10 18:07:32 2011 -0700 @@ -153,7 +153,7 @@ theorem set_plus_rearrange4: "C \ ((a::'a::comm_monoid_add) +o D) = a +o (C \ D)" - apply (auto intro!: subsetI simp add: elt_set_plus_def set_plus_def add_ac) + apply (auto simp add: elt_set_plus_def set_plus_def add_ac) apply (rule_tac x = "aa + ba" in exI) apply (auto simp add: add_ac) done @@ -211,7 +211,7 @@ by (auto simp add: elt_set_plus_def) lemma set_zero_plus2: "(0::'a::comm_monoid_add) : A ==> B <= A \ B" - apply (auto intro!: subsetI simp add: set_plus_def) + apply (auto simp add: set_plus_def) apply (rule_tac x = 0 in bexI) apply (rule_tac x = x in bexI) apply (auto simp add: add_ac) @@ -264,7 +264,7 @@ theorem set_times_rearrange4: "C \ ((a::'a::comm_monoid_mult) *o D) = a *o (C \ D)" - apply (auto intro!: subsetI simp add: elt_set_times_def set_times_def + apply (auto simp add: elt_set_times_def set_times_def mult_ac) apply (rule_tac x = "aa * ba" in exI) apply (auto simp add: mult_ac) @@ -336,7 +336,7 @@ lemma set_times_plus_distrib3: "((a::'a::semiring) +o C) \ D <= a *o D \ C \ D" - apply (auto intro!: subsetI simp add: + apply (auto simp add: elt_set_plus_def elt_set_times_def set_times_def set_plus_def ring_distribs) apply auto diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Wed Aug 10 18:07:32 2011 -0700 @@ -36,24 +36,23 @@ subsection{* Basic componentwise operations on vectors. *} -instantiation cart :: (times,finite) times +instantiation vec :: (times, finite) times begin - definition vector_mult_def : "op * \ (\ x y. (\ i. (x$i) * (y$i)))" + definition "op * \ (\ x y. (\ i. (x$i) * (y$i)))" instance .. end -instantiation cart :: (one,finite) one +instantiation vec :: (one, finite) one begin - definition vector_one_def : "1 \ (\ i. 1)" + definition "1 \ (\ i. 1)" instance .. end -instantiation cart :: (ord,finite) ord +instantiation vec :: (ord, finite) ord begin - definition vector_le_def: - "less_eq (x :: 'a ^'b) y = (ALL i. x$i <= y$i)" - definition vector_less_def: "less (x :: 'a ^'b) y = (ALL i. x$i < y$i)" - instance by (intro_classes) + definition "x \ y \ (\i. x$i \ y$i)" + definition "x < y \ (\i. x$i < y$i)" + instance .. end text{* The ordering on one-dimensional vectors is linear. *} @@ -65,12 +64,12 @@ by (auto intro!: card_ge_0_finite) qed end -instantiation cart :: (linorder,cart_one) linorder begin +instantiation vec :: (linorder,cart_one) linorder begin instance proof guess a B using UNIV_one[where 'a='b] unfolding card_Suc_eq apply- by(erule exE)+ hence *:"UNIV = {a}" by auto have "\P. (\i\UNIV. P i) \ P a" unfolding * by auto hence all:"\P. (\i. P i) \ P a" by auto - fix x y z::"'a^'b::cart_one" note * = vector_le_def vector_less_def all Cart_eq + fix x y z::"'a^'b::cart_one" note * = less_eq_vec_def less_vec_def all vec_eq_iff show "x\x" "(x < y) = (x \ y \ \ y \ x)" "x\y \ y\x" unfolding * by(auto simp only:field_simps) { assume "x\y" "y\z" thus "x\z" unfolding * by(auto simp only:field_simps) } { assume "x\y" "y\x" thus "x=y" unfolding * by(auto simp only:field_simps) } @@ -93,16 +92,16 @@ @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib}, @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym] val ss2 = @{simpset} addsimps - [@{thm vector_add_def}, @{thm vector_mult_def}, - @{thm vector_minus_def}, @{thm vector_uminus_def}, - @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def}, - @{thm vector_scaleR_def}, - @{thm Cart_lambda_beta}, @{thm vector_scalar_mult_def}] + [@{thm plus_vec_def}, @{thm times_vec_def}, + @{thm minus_vec_def}, @{thm uminus_vec_def}, + @{thm one_vec_def}, @{thm zero_vec_def}, @{thm vec_def}, + @{thm scaleR_vec_def}, + @{thm vec_lambda_beta}, @{thm vector_scalar_mult_def}] fun vector_arith_tac ths = simp_tac ss1 THEN' (fn i => rtac @{thm setsum_cong2} i ORELSE rtac @{thm setsum_0'} i - ORELSE simp_tac (HOL_basic_ss addsimps [@{thm "Cart_eq"}]) i) + ORELSE simp_tac (HOL_basic_ss addsimps [@{thm vec_eq_iff}]) i) (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *) THEN' asm_full_simp_tac (ss2 addsimps ths) in @@ -110,8 +109,8 @@ end *} "lift trivial vector statements to real arith statements" -lemma vec_0[simp]: "vec 0 = 0" by (vector vector_zero_def) -lemma vec_1[simp]: "vec 1 = 1" by (vector vector_one_def) +lemma vec_0[simp]: "vec 0 = 0" by (vector zero_vec_def) +lemma vec_1[simp]: "vec 1 = 1" by (vector one_vec_def) lemma vec_inj[simp]: "vec x = vec y \ x = y" by vector @@ -149,49 +148,47 @@ subsection {* Some frequently useful arithmetic lemmas over vectors. *} -instance cart :: (semigroup_mult,finite) semigroup_mult - apply (intro_classes) by (vector mult_assoc) +instance vec :: (semigroup_mult, finite) semigroup_mult + by default (vector mult_assoc) -instance cart :: (monoid_mult,finite) monoid_mult - apply (intro_classes) by vector+ +instance vec :: (monoid_mult, finite) monoid_mult + by default vector+ -instance cart :: (ab_semigroup_mult,finite) ab_semigroup_mult - apply (intro_classes) by (vector mult_commute) +instance vec :: (ab_semigroup_mult, finite) ab_semigroup_mult + by default (vector mult_commute) -instance cart :: (ab_semigroup_idem_mult,finite) ab_semigroup_idem_mult - apply (intro_classes) by (vector mult_idem) +instance vec :: (ab_semigroup_idem_mult, finite) ab_semigroup_idem_mult + by default (vector mult_idem) -instance cart :: (comm_monoid_mult,finite) comm_monoid_mult - apply (intro_classes) by vector +instance vec :: (comm_monoid_mult, finite) comm_monoid_mult + by default vector -instance cart :: (semiring,finite) semiring - apply (intro_classes) by (vector field_simps)+ +instance vec :: (semiring, finite) semiring + by default (vector field_simps)+ -instance cart :: (semiring_0,finite) semiring_0 - apply (intro_classes) by (vector field_simps)+ -instance cart :: (semiring_1,finite) semiring_1 - apply (intro_classes) by vector -instance cart :: (comm_semiring,finite) comm_semiring - apply (intro_classes) by (vector field_simps)+ +instance vec :: (semiring_0, finite) semiring_0 + by default (vector field_simps)+ +instance vec :: (semiring_1, finite) semiring_1 + by default vector +instance vec :: (comm_semiring, finite) comm_semiring + by default (vector field_simps)+ -instance cart :: (comm_semiring_0,finite) comm_semiring_0 by (intro_classes) -instance cart :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add .. -instance cart :: (semiring_0_cancel,finite) semiring_0_cancel by (intro_classes) -instance cart :: (comm_semiring_0_cancel,finite) comm_semiring_0_cancel by (intro_classes) -instance cart :: (ring,finite) ring by (intro_classes) -instance cart :: (semiring_1_cancel,finite) semiring_1_cancel by (intro_classes) -instance cart :: (comm_semiring_1,finite) comm_semiring_1 by (intro_classes) +instance vec :: (comm_semiring_0, finite) comm_semiring_0 .. +instance vec :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add .. +instance vec :: (semiring_0_cancel, finite) semiring_0_cancel .. +instance vec :: (comm_semiring_0_cancel, finite) comm_semiring_0_cancel .. +instance vec :: (ring, finite) ring .. +instance vec :: (semiring_1_cancel, finite) semiring_1_cancel .. +instance vec :: (comm_semiring_1, finite) comm_semiring_1 .. -instance cart :: (ring_1,finite) ring_1 .. +instance vec :: (ring_1, finite) ring_1 .. -instance cart :: (real_algebra,finite) real_algebra +instance vec :: (real_algebra, finite) real_algebra apply intro_classes - apply (simp_all add: vector_scaleR_def field_simps) - apply vector - apply vector + apply (simp_all add: vec_eq_iff) done -instance cart :: (real_algebra_1,finite) real_algebra_1 .. +instance vec :: (real_algebra_1, finite) real_algebra_1 .. lemma of_nat_index: "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n" @@ -203,17 +200,15 @@ lemma one_index[simp]: "(1 :: 'a::one ^'n)$i = 1" by vector -instance cart :: (semiring_char_0, finite) semiring_char_0 +instance vec :: (semiring_char_0, finite) semiring_char_0 proof fix m n :: nat show "inj (of_nat :: nat \ 'a ^ 'b)" - by (auto intro!: injI simp add: Cart_eq of_nat_index) + by (auto intro!: injI simp add: vec_eq_iff of_nat_index) qed -instance cart :: (comm_ring_1,finite) comm_ring_1 .. -instance cart :: (ring_char_0,finite) ring_char_0 .. - -instance cart :: (real_vector,finite) real_vector .. +instance vec :: (comm_ring_1, finite) comm_ring_1 .. +instance vec :: (ring_char_0, finite) ring_char_0 .. lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x" by (vector mult_assoc) @@ -233,7 +228,7 @@ by (vector field_simps) lemma vec_eq[simp]: "(vec m = vec n) \ (m = n)" - by (simp add: Cart_eq) + by (simp add: vec_eq_iff) lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_zero) lemma vector_mul_eq_0[simp]: "(a *s x = 0) \ a = (0::'a::idom) \ x = 0" @@ -248,7 +243,7 @@ by (metis vector_mul_rcancel) lemma component_le_norm_cart: "\x$i\ <= norm x" - apply (simp add: norm_vector_def) + apply (simp add: norm_vec_def) apply (rule member_le_setL2, simp_all) done @@ -259,10 +254,10 @@ by (metis component_le_norm_cart basic_trans_rules(21)) lemma norm_le_l1_cart: "norm x <= setsum(\i. \x$i\) UNIV" - by (simp add: norm_vector_def setL2_le_setsum) + by (simp add: norm_vec_def setL2_le_setsum) lemma scalar_mult_eq_scaleR: "c *s x = c *\<^sub>R x" - unfolding vector_scaleR_def vector_scalar_mult_def by simp + unfolding scaleR_vec_def vector_scalar_mult_def by simp lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \c\ * dist x y" unfolding dist_norm scalar_mult_eq_scaleR @@ -274,12 +269,12 @@ by (cases "finite S", induct S set: finite, simp_all) lemma setsum_eq: "setsum f S = (\ i. setsum (\x. (f x)$i ) S)" - by (simp add: Cart_eq) + by (simp add: vec_eq_iff) lemma setsum_cmul: fixes f:: "'c \ ('a::semiring_1)^'n" shows "setsum (\x. c *s f x) S = c *s setsum f S" - by (simp add: Cart_eq setsum_right_distrib) + by (simp add: vec_eq_iff setsum_right_distrib) (* TODO: use setsum_norm_allsubsets_bound *) lemma setsum_norm_allsubsets_bound_cart: @@ -320,170 +315,6 @@ finally show ?thesis . qed -subsection {* A bijection between 'n::finite and {.. ('n::finite)" where - "cart_bij_nat = (SOME p. bij_betw p {.. \ cart_bij_nat" -definition "\' = inv_into {..::nat \ ('n::finite))" - -lemma bij_betw_pi: - "bij_betw \ {..x. bij_betw x {..' (UNIV::'n set) {..'_def by auto - -lemma pi'_inj[intro]: "inj \'" - using bij_betw_pi' unfolding bij_betw_def by auto - -lemma pi'_range[intro]: "\i::'n. \' i < CARD('n::finite)" - using bij_betw_pi' unfolding bij_betw_def by auto - -lemma \\'[simp]: "\i::'n::finite. \ (\' i) = i" - using bij_betw_pi by (auto intro!: f_inv_into_f simp: \'_def bij_betw_def) - -lemma \'\[simp]: "\i. i\{.. \' (\ i::'n) = i" - using bij_betw_pi by (auto intro!: inv_into_f_eq simp: \'_def bij_betw_def) - -lemma \\'_alt[simp]: "\i. i \' (\ i::'n) = i" - by auto - -lemma \_inj_on: "inj_on (\::nat\'n::finite) {.. j::'b. if j = \(i div DIM('a)) then basis (i mod DIM('a)) else 0) - 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)" -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 - finally show ?thesis - unfolding basis_cart_def using assms by (auto simp: Cart_eq not_less field_simps) -qed - -lemma basis_eq_pi': - 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 - -lemma split_times_into_modulo[consumes 1]: - fixes k :: nat - assumes "k < A * B" - obtains i j where "i < A" and "j < B" and "k = j + i * B" -proof - have "A * B \ 0" - proof assume "A * B = 0" with assms show False by simp qed - hence "0 < B" by auto - thus "k mod B < B" using `0 < B` by auto -next - have "k div B * B \ k div B * B + k mod B" by (rule le_add1) - also have "... < A * B" using assms by simp - 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" -proof - - have "i * A + j < (Suc i)*A" using `j < A` by simp - also have "\ \ B * A" using `i < B` unfolding mult_le_cancel2 by simp - finally show ?thesis by simp -qed - -lemma DIM_cart[simp]: "DIM('a^'b) = CARD('b) * DIM('a)" - by (rule dimension_cart_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 i" thus "basis i = (0::'a^'b)" - unfolding dimension_cart_def basis_cart_def - by simp -next - show "\ij basis j = (if i = j then 1 else 0)" - apply (simp add: inner_vector_def) - apply safe - apply (erule split_CARD_DIM, simp add: basis_eq_pi') - apply (simp add: inner_if setsum_delta cong: if_cong) - apply (simp add: basis_orthonormal) - apply (elim split_CARD_DIM, simp add: basis_eq_pi') - apply (simp add: inner_if setsum_delta cong: if_cong) - apply (clarsimp simp add: basis_orthonormal) - done -next - fix x :: "'a ^ 'b" - show "(\i x = 0" - unfolding all_less_DIM_cart - unfolding inner_vector_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) - done -qed - -end - lemma if_distr: "(if P then f else g) $ i = (if P then f $ i else g $ i)" by simp lemma split_dimensions'[consumes 1]: @@ -525,10 +356,10 @@ lemmas cart_simps = forall_CARD_DIM exists_CARD_DIM forall_CARD exists_CARD lemma cart_euclidean_nth[simp]: - fixes x :: "('a::euclidean_space, 'b::finite) cart" + fixes x :: "('a::euclidean_space, 'b::finite) vec" assumes j:"j < DIM('a)" shows "x $$ (j + \' i * DIM('a)) = x $ i $$ j" - unfolding euclidean_component_def inner_vector_def basis_eq_pi'[OF j] if_distrib cond_application_beta + unfolding euclidean_component_def inner_vec_def basis_eq_pi'[OF j] if_distrib cond_application_beta by (simp add: setsum_cases) lemma real_euclidean_nth: @@ -559,13 +390,13 @@ thus "x = y \ i = j" using * by simp qed simp -instance cart :: (ordered_euclidean_space,finite) ordered_euclidean_space +instance vec :: (ordered_euclidean_space, finite) ordered_euclidean_space proof fix x y::"'a^'b" - show "(x \ y) = (\i y $$ i)" - unfolding vector_le_def apply(subst eucl_le) by (simp add: cart_simps) - show"(x < y) = (\i y) = (\i y $$ i)" + unfolding less_eq_vec_def apply(subst eucl_le) by (simp add: cart_simps) + show"(x < y) = (\ik. 1::real"] by auto @@ -597,14 +428,14 @@ qed lemma basis_inj[intro]: "inj (cart_basis :: 'n \ real ^'n)" - by (simp add: inj_on_def Cart_eq) + by (simp add: inj_on_def vec_eq_iff) lemma basis_expansion: "setsum (\i. (x$i) *s cart_basis i) UNIV = (x::('a::ring_1) ^'n)" (is "?lhs = ?rhs" is "setsum ?f ?S = _") - by (auto simp add: Cart_eq if_distrib setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong) + by (auto simp add: vec_eq_iff if_distrib setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong) lemma smult_conv_scaleR: "c *s x = scaleR c x" - unfolding vector_scalar_mult_def vector_scaleR_def by simp + unfolding vector_scalar_mult_def scaleR_vec_def by simp lemma basis_expansion': "setsum (\i. (x$i) *\<^sub>R cart_basis i) UNIV = x" @@ -612,22 +443,22 @@ lemma basis_expansion_unique: "setsum (\i. f i *s cart_basis i) UNIV = (x::('a::comm_ring_1) ^'n) \ (\i. f i = x$i)" - by (simp add: Cart_eq setsum_delta if_distrib cong del: if_weak_cong) + by (simp add: vec_eq_iff setsum_delta if_distrib cong del: if_weak_cong) lemma dot_basis: shows "cart_basis i \ x = x$i" "x \ (cart_basis i) = (x$i)" - by (auto simp add: inner_vector_def cart_basis_def cond_application_beta if_distrib setsum_delta + by (auto simp add: inner_vec_def cart_basis_def cond_application_beta if_distrib setsum_delta cong del: if_weak_cong) lemma inner_basis: fixes x :: "'a::{real_inner, real_algebra_1} ^ 'n" shows "inner (cart_basis i) x = inner 1 (x $ i)" and "inner x (cart_basis i) = inner (x $ i) 1" - unfolding inner_vector_def cart_basis_def + unfolding inner_vec_def cart_basis_def by (auto simp add: cond_application_beta if_distrib setsum_delta cong del: if_weak_cong) lemma basis_eq_0: "cart_basis i = (0::'a::semiring_1^'n) \ False" - by (auto simp add: Cart_eq) + by (auto simp add: vec_eq_iff) lemma basis_nonzero: shows "cart_basis k \ (0:: 'a::semiring_1 ^'n)" @@ -635,14 +466,14 @@ text {* some lemmas to map between Eucl and Cart *} lemma basis_real_n[simp]:"(basis (\' i)::real^'a) = cart_basis i" - unfolding basis_cart_def using pi'_range[where 'n='a] - by (auto simp: Cart_eq Cart_lambda_beta) + unfolding basis_vec_def using pi'_range[where 'n='a] + by (auto simp: vec_eq_iff) subsection {* Orthogonality on cartesian products *} lemma orthogonal_basis: shows "orthogonal (cart_basis i) x \ x$i = (0::real)" - by (auto simp add: orthogonal_def inner_vector_def cart_basis_def if_distrib + by (auto simp add: orthogonal_def inner_vec_def cart_basis_def if_distrib cond_application_beta setsum_delta cong del: if_weak_cong) lemma orthogonal_basis_basis: @@ -684,7 +515,7 @@ by (simp add: linear_cmul[OF lf]) finally have "f x \ y = x \ ?w" apply (simp only: ) - apply (simp add: inner_vector_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] field_simps) + apply (simp add: inner_vec_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] field_simps) done} } then show ?thesis unfolding adjoint_def @@ -778,25 +609,25 @@ setsum_delta' cong del: if_weak_cong) lemma matrix_transpose_mul: "transpose(A ** B) = transpose B ** transpose (A::'a::comm_semiring_1^_^_)" - by (simp add: matrix_matrix_mult_def transpose_def Cart_eq mult_commute) + by (simp add: matrix_matrix_mult_def transpose_def vec_eq_iff mult_commute) lemma matrix_eq: fixes A B :: "'a::semiring_1 ^ 'n ^ 'm" shows "A = B \ (\x. A *v x = B *v x)" (is "?lhs \ ?rhs") apply auto - apply (subst Cart_eq) + apply (subst vec_eq_iff) apply clarify - apply (clarsimp simp add: matrix_vector_mult_def cart_basis_def if_distrib cond_application_beta Cart_eq cong del: if_weak_cong) + apply (clarsimp simp add: matrix_vector_mult_def cart_basis_def if_distrib cond_application_beta vec_eq_iff cong del: if_weak_cong) apply (erule_tac x="cart_basis ia" in allE) apply (erule_tac x="i" in allE) by (auto simp add: cart_basis_def if_distrib cond_application_beta setsum_delta[OF finite] cong del: if_weak_cong) lemma matrix_vector_mul_component: shows "((A::real^_^_) *v x)$k = (A$k) \ x" - by (simp add: matrix_vector_mult_def inner_vector_def) + by (simp add: matrix_vector_mult_def inner_vec_def) lemma dot_lmul_matrix: "((x::real ^_) v* A) \ y = x \ (A *v y)" - apply (simp add: inner_vector_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac) + apply (simp add: inner_vec_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac) apply (subst setsum_commute) by simp @@ -809,12 +640,12 @@ lemma row_transpose: fixes A:: "'a::semiring_1^_^_" shows "row i (transpose A) = column i A" - by (simp add: row_def column_def transpose_def Cart_eq) + by (simp add: row_def column_def transpose_def vec_eq_iff) lemma column_transpose: fixes A:: "'a::semiring_1^_^_" shows "column i (transpose A) = row i A" - by (simp add: row_def column_def transpose_def Cart_eq) + by (simp add: row_def column_def transpose_def vec_eq_iff) lemma rows_transpose: "rows(transpose (A::'a::semiring_1^_^_)) = columns A" by (auto simp add: rows_def columns_def row_transpose intro: set_eqI) @@ -824,15 +655,15 @@ text{* Two sometimes fruitful ways of looking at matrix-vector multiplication. *} lemma matrix_mult_dot: "A *v x = (\ i. A$i \ x)" - by (simp add: matrix_vector_mult_def inner_vector_def) + by (simp add: matrix_vector_mult_def inner_vec_def) lemma matrix_mult_vsum: "(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\i. (x$i) *s column i A) (UNIV:: 'n set)" - by (simp add: matrix_vector_mult_def Cart_eq column_def mult_commute) + by (simp add: matrix_vector_mult_def vec_eq_iff column_def mult_commute) lemma vector_componentwise: "(x::'a::ring_1^'n) = (\ j. setsum (\i. (x$i) * (cart_basis i :: 'a^'n)$j) (UNIV :: 'n set))" apply (subst basis_expansion[symmetric]) - by (vector Cart_eq setsum_component) + by (vector vec_eq_iff setsum_component) lemma linear_componentwise: fixes f:: "real ^'m \ real ^ _" @@ -862,10 +693,10 @@ where "matrix f = (\ i j. (f(cart_basis j))$i)" lemma matrix_vector_mul_linear: "linear(\x. A *v (x::real ^ _))" - by (simp add: linear_def matrix_vector_mult_def Cart_eq field_simps setsum_right_distrib setsum_addf) + by (simp add: linear_def matrix_vector_mult_def vec_eq_iff field_simps setsum_right_distrib setsum_addf) lemma matrix_works: assumes lf: "linear f" shows "matrix f *v x = f (x::real ^ 'n)" -apply (simp add: matrix_def matrix_vector_mult_def Cart_eq mult_commute) +apply (simp add: matrix_def matrix_vector_mult_def vec_eq_iff mult_commute) apply clarify apply (rule linear_componentwise[OF lf, symmetric]) done @@ -883,11 +714,11 @@ by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def) lemma matrix_vector_column:"(A::'a::comm_semiring_1^'n^_) *v x = setsum (\i. (x$i) *s ((transpose A)$i)) (UNIV:: 'n set)" - by (simp add: matrix_vector_mult_def transpose_def Cart_eq mult_commute) + by (simp add: matrix_vector_mult_def transpose_def vec_eq_iff mult_commute) lemma adjoint_matrix: "adjoint(\x. (A::real^'n^'m) *v x) = (\x. transpose A *v x)" apply (rule adjoint_unique) - apply (simp add: transpose_def inner_vector_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib) + apply (simp add: transpose_def inner_vec_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib) apply (subst setsum_commute) apply (auto simp add: mult_ac) done @@ -1082,10 +913,10 @@ let ?x = "\ i. c i" have th0:"A *v ?x = 0" using c - unfolding matrix_mult_vsum Cart_eq + unfolding matrix_mult_vsum vec_eq_iff by auto from k[rule_format, OF th0] i - have "c i = 0" by (vector Cart_eq)} + have "c i = 0" by (vector vec_eq_iff)} hence ?rhs by blast} moreover {assume H: ?rhs @@ -1204,17 +1035,17 @@ lemma transpose_columnvector: "transpose(columnvector v) = rowvector v" - by (simp add: transpose_def rowvector_def columnvector_def Cart_eq) + by (simp add: transpose_def rowvector_def columnvector_def vec_eq_iff) lemma transpose_rowvector: "transpose(rowvector v) = columnvector v" - by (simp add: transpose_def columnvector_def rowvector_def Cart_eq) + by (simp add: transpose_def columnvector_def rowvector_def vec_eq_iff) lemma dot_rowvector_columnvector: "columnvector (A *v v) = A ** columnvector v" by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def) lemma dot_matrix_product: "(x::real^'n) \ y = (((rowvector x ::real^'n^1) ** (columnvector y :: real^1^'n))$1)$1" - by (vector matrix_matrix_mult_def rowvector_def columnvector_def inner_vector_def) + by (vector matrix_matrix_mult_def rowvector_def columnvector_def inner_vec_def) lemma dot_matrix_vector_mul: fixes A B :: "real ^'n ^'n" and x y :: "real ^'n" @@ -1244,18 +1075,18 @@ unfolding nth_conv_component using component_le_infnorm[of x] . -instance cart :: (perfect_space, finite) perfect_space +instance vec :: (perfect_space, finite) perfect_space proof fix x :: "'a ^ 'b" show "x islimpt UNIV" apply (rule islimptI) - apply (unfold open_vector_def) + apply (unfold open_vec_def) apply (drule (1) bspec) apply clarsimp apply (subgoal_tac "\i\UNIV. \y. y \ A i \ y \ x $ i") apply (drule finite_choice [OF finite_UNIV], erule exE) - apply (rule_tac x="Cart_lambda f" in exI) - apply (simp add: Cart_eq) + apply (rule_tac x="vec_lambda f" in exI) + apply (simp add: vec_eq_iff) apply (rule ballI, drule_tac x=i in spec, clarify) apply (cut_tac x="x $ i" in islimpt_UNIV) apply (simp add: islimpt_def) @@ -1288,7 +1119,7 @@ apply (clarify) apply (drule spec, drule (1) mp) apply (erule eventually_elim1) - apply (erule le_less_trans [OF dist_nth_le_cart]) + apply (erule le_less_trans [OF dist_vec_nth_le]) done lemma bounded_component_cart: "bounded s \ bounded ((\x. x $ i) ` s)" @@ -1297,7 +1128,7 @@ apply (rule_tac x="x $ i" in exI) apply (rule_tac x="e" in exI) apply clarify -apply (rule order_trans [OF dist_nth_le_cart], simp) +apply (rule order_trans [OF dist_vec_nth_le], simp) done lemma compact_lemma_cart: @@ -1334,7 +1165,7 @@ qed qed -instance cart :: (heine_borel, finite) heine_borel +instance vec :: (heine_borel, finite) heine_borel proof fix s :: "('a ^ 'b) set" and f :: "nat \ 'a ^ 'b" assume s: "bounded s" and f: "\n. f n \ s" @@ -1350,7 +1181,7 @@ moreover { fix n assume n: "\i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))" have "dist (f (r n)) l \ (\i\?d. dist (f (r n) $ i) (l $ i))" - unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum) + unfolding dist_vec_def using zero_le_dist by (rule setL2_le_setsum) also have "\ < (\i\?d. e / (real_of_nat (card ?d)))" by (rule setsum_strict_mono) (simp_all add: n) finally have "dist (f (r n)) l < e" by simp @@ -1371,12 +1202,12 @@ lemma interval_cart: fixes a :: "'a::ord^'n" shows "{a <..< b} = {x::'a^'n. \i. a$i < x$i \ x$i < b$i}" and "{a .. b} = {x::'a^'n. \i. a$i \ x$i \ x$i \ b$i}" - by (auto simp add: set_eq_iff vector_less_def vector_le_def) + by (auto simp add: set_eq_iff less_vec_def less_eq_vec_def) lemma mem_interval_cart: fixes a :: "'a::ord^'n" shows "x \ {a<.. (\i. a$i < x$i \ x$i < b$i)" "x \ {a .. b} \ (\i. a$i \ x$i \ x$i \ b$i)" - using interval_cart[of a b] by(auto simp add: set_eq_iff vector_less_def vector_le_def) + using interval_cart[of a b] by(auto simp add: set_eq_iff less_vec_def less_eq_vec_def) lemma interval_eq_empty_cart: fixes a :: "real^'n" shows "({a <..< b} = {} \ (\i. b$i \ a$i))" (is ?th1) and @@ -1429,7 +1260,7 @@ lemma interval_sing: fixes a :: "'a::linorder^'n" shows "{a .. a} = {a} \ {a<.. x $ i" using x order_less_imp_le[of "a$i" "x$i"] - by(simp add: set_eq_iff vector_less_def vector_le_def Cart_eq) + by(simp add: set_eq_iff less_vec_def less_eq_vec_def vec_eq_iff) } moreover { fix i have "x $ i \ b $ i" using x order_less_imp_le[of "x$i" "b$i"] - by(simp add: set_eq_iff vector_less_def vector_le_def Cart_eq) + by(simp add: set_eq_iff less_vec_def less_eq_vec_def vec_eq_iff) } ultimately show "a \ x \ x \ b" - by(simp add: set_eq_iff vector_less_def vector_le_def Cart_eq) + by(simp add: set_eq_iff less_vec_def less_eq_vec_def vec_eq_iff) qed lemma subset_interval_cart: fixes a :: "real^'n" shows @@ -1572,12 +1403,12 @@ lemma dim_substandard_cart: shows "dim {x::real^'n. \i. i \ d \ x$i = 0} = card d" (is "dim ?A = _") -proof- have *:"{x. \i \' ` d \ x $$ i = 0} = +proof- have *:"{x. \i \' ` d \ x $$ i = 0} = {x::real^'n. \i. i \ d \ x$i = 0}"apply safe apply(erule_tac x="\' i" in allE) defer apply(erule_tac x="\ i" in allE) unfolding image_iff real_euclidean_nth[symmetric] by (auto simp: pi'_inj[THEN inj_eq]) - have " \' ` d \ {.. {..'" d] using pi'_inj unfolding inj_on_def by auto qed @@ -1630,7 +1461,7 @@ declare vector_add_ldistrib[simp] vector_ssub_ldistrib[simp] vector_smult_assoc[simp] vector_smult_rneg[simp] declare vector_sadd_rdistrib[simp] vector_sub_rdistrib[simp] -lemmas vector_component_simps = vector_minus_component vector_smult_component vector_add_component vector_le_def Cart_lambda_beta basis_component vector_uminus_component +lemmas vector_component_simps = vector_minus_component vector_smult_component vector_add_component less_eq_vec_def vec_lambda_beta basis_component vector_uminus_component lemma convex_box_cart: assumes "\i. convex {x. P i x}" @@ -1655,7 +1486,7 @@ lemma std_simplex_cart: "(insert (0::real^'n) { cart_basis i | i. i\UNIV}) = - (insert 0 { basis i | i. i (a,b) (u,v) (x::real^'n). (\ i. u$i + (x$i - a$i) / (b$i - a$i) * (v$i - u$i))::real^'n)" unfolding interval_bij_def apply(rule ext)+ apply safe - unfolding Cart_eq Cart_lambda_beta unfolding nth_conv_component + unfolding vec_eq_iff vec_lambda_beta unfolding nth_conv_component apply rule apply(subst euclidean_lambda_beta) using pi'_range by auto lemma interval_bij_affine_cart: "interval_bij (a,b) (u,v) = (\x. (\ i. (v$i - u$i) / (b$i - a$i) * x$i) + (\ i. u$i - (v$i - u$i) / (b$i - a$i) * a$i)::real^'n)" - apply rule unfolding Cart_eq interval_bij_cart vector_component_simps + apply rule unfolding vec_eq_iff interval_bij_cart vector_component_simps by(auto simp add: field_simps add_divide_distrib[THEN sym]) subsection "Derivative" lemma has_derivative_vmul_component_cart: fixes c::"real^'a \ real^'b" and v::"real^'c" assumes "(c has_derivative c') net" - shows "((\x. c(x)$k *\<^sub>R v) has_derivative (\x. (c' x)$k *\<^sub>R v)) net" - using has_derivative_vmul_component[OF assms] - unfolding nth_conv_component . + shows "((\x. c(x)$k *\<^sub>R v) has_derivative (\x. (c' x)$k *\<^sub>R v)) net" + unfolding nth_conv_component + by (intro has_derivative_intros assms) lemma differentiable_at_imp_differentiable_on: "(\x\(s::(real^'n) set). f differentiable at x) \ f differentiable_on s" unfolding differentiable_on_def by(auto intro!: differentiable_at_withinI) @@ -1718,7 +1549,7 @@ proof(rule ccontr) def D \ "jacobian f (at x)" assume "jacobian f (at x) $ k \ 0" - then obtain j where j:"D$k$j \ 0" unfolding Cart_eq D_def by auto + then obtain j where j:"D$k$j \ 0" unfolding vec_eq_iff D_def by auto hence *:"abs (jacobian f (at x) $ k $ j) / 2 > 0" unfolding D_def by auto note as = assms(3)[unfolded jacobian_works has_derivative_at_alt] guess e' using as[THEN conjunct2,rule_format,OF *] .. note e' = this @@ -1805,12 +1636,10 @@ where "dest_vec1 x \ (x$1)" lemma vec1_dest_vec1[simp]: "vec1(dest_vec1 x) = x" "dest_vec1(vec1 y) = y" - by (simp_all add: Cart_eq) + by (simp_all add: vec_eq_iff) lemma vec1_component[simp]: "(vec1 x)$1 = x" - by (simp_all add: Cart_eq) - -declare vec1_dest_vec1(1) [simp] + by (simp_all add: vec_eq_iff) lemma forall_vec1: "(\x. P x) \ (\x. P (vec1 x))" by (metis vec1_dest_vec1(1)) @@ -1827,7 +1656,7 @@ subsection{* The collapse of the general concepts to dimension one. *} lemma vector_one: "(x::'a ^1) = (\ i. (x$1))" - by (simp add: Cart_eq) + by (simp add: vec_eq_iff) lemma forall_one: "(\(x::'a ^1). P x) \ (\x. P(\ i. x))" apply auto @@ -1836,7 +1665,7 @@ done lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)" - by (simp add: norm_vector_def) + by (simp add: norm_vec_def) lemma norm_real: "norm(x::real ^ 1) = abs(x$1)" by (simp add: norm_vector_1) @@ -1917,7 +1746,7 @@ by (metis vec1_dest_vec1(1) norm_vec1) lemmas vec1_dest_vec1_simps = forall_vec1 vec_add[THEN sym] dist_vec1 vec_sub[THEN sym] vec1_dest_vec1 norm_vec1 vector_smult_component - vec1_eq vec_cmul[THEN sym] smult_conv_scaleR[THEN sym] o_def dist_real_def norm_vec1 real_norm_def + vec1_eq vec_cmul[THEN sym] smult_conv_scaleR[THEN sym] o_def dist_real_def real_norm_def lemma bounded_linear_vec1:"bounded_linear (vec1::real\real^1)" unfolding bounded_linear_def additive_def bounded_linear_axioms_def @@ -1936,14 +1765,14 @@ unfolding smult_conv_scaleR apply (rule ext) apply (subst matrix_works[OF lf, symmetric]) - apply (auto simp add: Cart_eq matrix_vector_mult_def column_def mult_commute) + apply (auto simp add: vec_eq_iff matrix_vector_mult_def column_def mult_commute) done lemma linear_to_scalars: assumes lf: "linear (f::real ^'n \ real^1)" shows "f = (\x. vec1(row 1 (matrix f) \ x))" apply (rule ext) apply (subst matrix_works[OF lf, symmetric]) - apply (simp add: Cart_eq matrix_vector_mult_def row_def inner_vector_def mult_commute) + apply (simp add: vec_eq_iff matrix_vector_mult_def row_def inner_vec_def mult_commute) done lemma dest_vec1_eq_0: "dest_vec1 x = 0 \ x = 0" @@ -1967,14 +1796,14 @@ using assms unfolding continuous_on_iff apply safe apply(erule_tac x="x$1" in ballE,erule_tac x=e in allE) apply safe apply(rule_tac x=d in exI) apply safe unfolding o_def dist_real_def dist_real - apply(erule_tac x="dest_vec1 x'" in ballE) by(auto simp add:vector_le_def) + apply(erule_tac x="dest_vec1 x'" in ballE) by(auto simp add:less_eq_vec_def) lemma continuous_on_o_vec1: fixes f::"real^1 \ 'a::real_normed_vector" assumes "continuous_on {a..b} f" shows "continuous_on {dest_vec1 a..dest_vec1 b} (f o vec1)" using assms unfolding continuous_on_iff apply safe apply(erule_tac x="vec x" in ballE,erule_tac x=e in allE) apply safe apply(rule_tac x=d in exI) apply safe unfolding o_def dist_real_def dist_real - apply(erule_tac x="vec1 x'" in ballE) by(auto simp add:vector_le_def) + apply(erule_tac x="vec1 x'" in ballE) by(auto simp add:less_eq_vec_def) lemma continuous_on_vec1:"continuous_on A (vec1::real\real^1)" by(rule linear_continuous_on[OF bounded_linear_vec1]) @@ -1982,12 +1811,12 @@ lemma mem_interval_1: fixes x :: "real^1" shows "(x \ {a .. b} \ dest_vec1 a \ dest_vec1 x \ dest_vec1 x \ dest_vec1 b)" "(x \ {a<.. dest_vec1 a < dest_vec1 x \ dest_vec1 x < dest_vec1 b)" -by(simp_all add: Cart_eq vector_less_def vector_le_def) +by(simp_all add: vec_eq_iff less_vec_def less_eq_vec_def) lemma vec1_interval:fixes a::"real" shows "vec1 ` {a .. b} = {vec1 a .. vec1 b}" "vec1 ` {a<.. {a .. b} ==> x \ {a<.. (x = a) \ (x = b)" - unfolding Cart_eq vector_less_def vector_le_def mem_interval_cart by(auto simp del:dest_vec1_eq) + unfolding vec_eq_iff less_vec_def less_eq_vec_def mem_interval_cart by(auto simp del:dest_vec1_eq) lemma in_interval_1: fixes x :: "real^1" shows "(x \ {a .. b} \ dest_vec1 a \ dest_vec1 x \ dest_vec1 x \ dest_vec1 b) \ (x \ {a<.. dest_vec1 a < dest_vec1 x \ dest_vec1 x < dest_vec1 b)" - unfolding Cart_eq vector_less_def vector_le_def mem_interval_cart by(auto simp del:dest_vec1_eq) + unfolding vec_eq_iff less_vec_def less_eq_vec_def mem_interval_cart by(auto simp del:dest_vec1_eq) lemma interval_eq_empty_1: fixes a :: "real^1" shows "{a .. b} = {} \ dest_vec1 b < dest_vec1 a" @@ -2037,10 +1866,10 @@ lemma open_closed_interval_1: fixes a :: "real^1" shows "{a<.. dest_vec1 b ==> {a .. b} = {a<.. {a,b}" - unfolding set_eq_iff apply simp unfolding vector_less_def and vector_le_def and forall_1 and dest_vec1_eq[THEN sym] by(auto simp del:dest_vec1_eq) + unfolding set_eq_iff apply simp unfolding less_vec_def and less_eq_vec_def and forall_1 and dest_vec1_eq[THEN sym] by(auto simp del:dest_vec1_eq) lemma Lim_drop_le: fixes f :: "'a \ real^1" shows "(f ---> l) net \ ~(trivial_limit net) \ eventually (\x. dest_vec1 (f x) \ b) net ==> dest_vec1 l \ b" @@ -2069,7 +1898,7 @@ lemma dest_vec1_simps[simp]: fixes a::"real^1" shows "a$1 = 0 \ a = 0" (*"a \ 1 \ dest_vec1 a \ 1" "0 \ a \ 0 \ dest_vec1 a"*) "a \ b \ dest_vec1 a \ dest_vec1 b" "dest_vec1 (1::real^1) = 1" - by(auto simp add: vector_le_def Cart_eq) + by(auto simp add: less_eq_vec_def vec_eq_iff) lemma dest_vec1_inverval: "dest_vec1 ` {a .. b} = {dest_vec1 a .. dest_vec1 b}" @@ -2081,18 +1910,18 @@ apply(rule_tac [!] allI)apply(rule_tac [!] impI) apply(rule_tac[2] x="vec1 x" in exI)apply(rule_tac[4] x="vec1 x" in exI) apply(rule_tac[6] x="vec1 x" in exI)apply(rule_tac[8] x="vec1 x" in exI) - by (auto simp add: vector_less_def vector_le_def) + by (auto simp add: less_vec_def less_eq_vec_def) lemma dest_vec1_setsum: assumes "finite S" shows " dest_vec1 (setsum f S) = setsum (\x. dest_vec1 (f x)) S" using dest_vec1_sum[OF assms] by auto lemma open_dest_vec1_vimage: "open S \ open (dest_vec1 -` S)" -unfolding open_vector_def forall_1 by auto +unfolding open_vec_def forall_1 by auto lemma tendsto_dest_vec1 [tendsto_intros]: "(f ---> l) net \ ((\x. dest_vec1 (f x)) ---> dest_vec1 l) net" -by(rule tendsto_Cart_nth) +by(rule tendsto_vec_nth) lemma continuous_dest_vec1: "continuous net f \ continuous net (\x. dest_vec1 (f x))" unfolding continuous_def by (rule tendsto_dest_vec1) @@ -2118,9 +1947,9 @@ unfolding vec1_dest_vec1_simps by auto qed lemma vec1_le[simp]:fixes a::real shows "vec1 a \ vec1 b \ a \ b" - unfolding vector_le_def by auto + unfolding less_eq_vec_def by auto lemma vec1_less[simp]:fixes a::real shows "vec1 a < vec1 b \ a < b" - unfolding vector_less_def by auto + unfolding less_vec_def by auto subsection {* Derivatives on real = Derivatives on @{typ "real^1"} *} @@ -2164,7 +1993,7 @@ lemma onorm_vec1: fixes f::"real \ real" shows "onorm (\x. vec1 (f (dest_vec1 x))) = onorm f" proof- - have "\x::real^1. norm x = 1 \ x\{vec1 -1, vec1 (1::real)}" unfolding forall_vec1 by(auto simp add:Cart_eq) + have "\x::real^1. norm x = 1 \ x\{vec1 -1, vec1 (1::real)}" unfolding forall_vec1 by(auto simp add:vec_eq_iff) hence 1:"{x. norm x = 1} = {vec1 -1, vec1 (1::real)}" by auto have 2:"{norm (vec1 (f (dest_vec1 x))) |x. norm x = 1} = (\x. norm (vec1 (f (dest_vec1 x)))) ` {x. norm x=1}" by auto have "\x::real. norm x = 1 \ x\{-1, 1}" by auto hence 3:"{x. norm x = 1} = {-1, (1::real)}" by auto @@ -2203,11 +2032,11 @@ "{a..b::real^'n} \ {x. x$k \ c} = {a .. (\ i. if i = k then min (b$k) c else b$i)}" "{a..b} \ {x. x$k \ c} = {(\ i. if i = k then max (a$k) c else a$i) .. b}" apply(rule_tac[!] set_eqI) unfolding Int_iff mem_interval_cart mem_Collect_eq - unfolding Cart_lambda_beta by auto + unfolding vec_lambda_beta by auto (*lemma content_split_cart: "content {a..b::real^'n} = content({a..b} \ {x. x$k \ c}) + content({a..b} \ {x. x$k >= c})" -proof- note simps = interval_split_cart content_closed_interval_cases_cart Cart_lambda_beta vector_le_def +proof- note simps = interval_split_cart content_closed_interval_cases_cart vec_lambda_beta less_eq_vec_def { presume "a\b \ ?thesis" thus ?thesis apply(cases "a\b") unfolding simps by auto } have *:"UNIV = insert k (UNIV - {k})" "\x. finite (UNIV-{x::'n})" "\x. x\UNIV-{x}" by auto have *:"\X Y Z. (\i\UNIV. Z i (if i = k then X else Y i)) = Z k X * (\i\UNIV-{k}. Z i (Y i))" @@ -2217,7 +2046,7 @@ \ x* (b$k - a$k) = x*(max (a $ k) c - a $ k) + x*(b $ k - max (a $ k) c)" by (auto simp add:field_simps) moreover have "\ a $ k \ c \ \ c \ b $ k \ False" - unfolding not_le using as[unfolded vector_le_def,rule_format,of k] by auto + unfolding not_le using as[unfolded less_eq_vec_def,rule_format,of k] by auto ultimately show ?thesis unfolding simps unfolding *(1)[of "\i x. b$i - x"] *(1)[of "\i x. x - a$i"] *(2) by(auto) qed*) @@ -2225,7 +2054,7 @@ lemma has_integral_vec1: assumes "(f has_integral k) {a..b}" shows "((\x. vec1 (f x)) has_integral (vec1 k)) {a..b}" proof- have *:"\p. (\(x, k)\p. content k *\<^sub>R vec1 (f x)) - vec1 k = vec1 ((\(x, k)\p. content k *\<^sub>R f x) - k)" - unfolding vec_sub Cart_eq by(auto simp add: split_beta) + unfolding vec_sub vec_eq_iff by(auto simp add: split_beta) show ?thesis using assms unfolding has_integral apply safe apply(erule_tac x=e in allE,safe) apply(rule_tac x=d in exI,safe) apply(erule_tac x=p in allE,safe) unfolding * norm_vector_1 by auto qed diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Wed Aug 10 18:07:32 2011 -0700 @@ -198,9 +198,6 @@ from this show ?thesis by auto qed -lemma basis_0[simp]:"(basis i::'a::euclidean_space) = 0 \ i\DIM('a)" - using norm_basis[of i, where 'a='a] unfolding norm_eq_zero[where 'a='a,THEN sym] by auto - lemma basis_to_basis_subspace_isomorphism: assumes s: "subspace (S:: ('n::euclidean_space) set)" and t: "subspace (T :: ('m::euclidean_space) set)" @@ -2142,7 +2139,7 @@ apply (simp add: rel_interior, safe) apply (force simp add: open_contains_ball) apply (rule_tac x="ball x e" in exI) - apply (simp add: open_ball centre_in_ball) + apply (simp add: centre_in_ball) done lemma rel_interior_ball: diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Derivative.thy --- a/src/HOL/Multivariate_Analysis/Derivative.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Derivative.thy Wed Aug 10 18:07:32 2011 -0700 @@ -23,23 +23,12 @@ "(f has_derivative f') net \ bounded_linear f' \ ((\y. (1 / (norm (y - netlimit net))) *\<^sub>R (f y - (f (netlimit net) + f'(y - netlimit net)))) ---> 0) net" -lemma derivative_linear[dest]:"(f has_derivative f') net \ bounded_linear f'" +lemma derivative_linear[dest]: + "(f has_derivative f') net \ bounded_linear f'" unfolding has_derivative_def by auto -lemma DERIV_conv_has_derivative:"(DERIV f x :> f') = (f has_derivative op * f') (at (x::real))" (is "?l = ?r") proof - assume ?l note as = this[unfolded deriv_def LIM_def,rule_format] - show ?r unfolding has_derivative_def Lim_at apply- apply(rule,rule mult.bounded_linear_right) - apply safe apply(drule as,safe) apply(rule_tac x=s in exI) apply safe - apply(erule_tac x="xa - x" in allE) unfolding dist_norm netlimit_at[of x] unfolding diff_0_right norm_scaleR - by(auto simp add:field_simps) -next assume ?r note this[unfolded has_derivative_def Lim_at] note as=conjunct2[OF this,rule_format] - have *:"\x xa f'. xa \ 0 \ \(f (xa + x) - f x) / xa - f'\ = \(f (xa + x) - f x) - xa * f'\ / \xa\" by(auto simp add:field_simps) - show ?l unfolding deriv_def LIM_def apply safe apply(drule as,safe) - apply(rule_tac x=d in exI,safe) apply(erule_tac x="xa + x" in allE) - unfolding dist_norm diff_0_right norm_scaleR - unfolding dist_norm netlimit_at[of x] by(auto simp add:algebra_simps *) qed - lemma netlimit_at_vector: + (* TODO: move *) fixes a :: "'a::real_normed_vector" shows "netlimit (at a) = a" proof (cases "\x. x \ a") @@ -55,23 +44,15 @@ qed simp lemma FDERIV_conv_has_derivative: - shows "FDERIV f x :> f' = (f has_derivative f') (at x)" (is "?l = ?r") -proof - assume ?l note as = this[unfolded fderiv_def] - show ?r unfolding has_derivative_def Lim_at apply-apply(rule,rule as[THEN conjunct1]) proof(rule,rule) - fix e::real assume "e>0" - guess d using as[THEN conjunct2,unfolded LIM_def,rule_format,OF`e>0`] .. - thus "\d>0. \xa. 0 < dist xa x \ dist xa x < d \ - dist ((1 / norm (xa - netlimit (at x))) *\<^sub>R (f xa - (f (netlimit (at x)) + f' (xa - netlimit (at x))))) (0) < e" - apply(rule_tac x=d in exI) apply(erule conjE,rule,assumption) apply rule apply(erule_tac x="xa - x" in allE) - unfolding dist_norm netlimit_at_vector[of x] by (auto simp add: diff_diff_eq) qed next - assume ?r note as = this[unfolded has_derivative_def] - show ?l unfolding fderiv_def LIM_def apply-apply(rule,rule as[THEN conjunct1]) proof(rule,rule) - fix e::real assume "e>0" - guess d using as[THEN conjunct2,unfolded Lim_at,rule_format,OF`e>0`] .. - thus "\s>0. \xa. xa \ 0 \ dist xa 0 < s \ dist (norm (f (x + xa) - f x - f' xa) / norm xa) 0 < e" apply- - apply(rule_tac x=d in exI) apply(erule conjE,rule,assumption) apply rule apply(erule_tac x="xa + x" in allE) - unfolding dist_norm netlimit_at_vector[of x] by (auto simp add: diff_diff_eq add.commute) qed qed + shows "FDERIV f x :> f' = (f has_derivative f') (at x)" + unfolding fderiv_def has_derivative_def netlimit_at_vector + by (simp add: diff_diff_eq Lim_at_zero [where a=x] + LIM_norm_zero_iff [where 'b='b, symmetric]) + +lemma DERIV_conv_has_derivative: + "(DERIV f x :> f') = (f has_derivative op * f') (at x)" + unfolding deriv_fderiv FDERIV_conv_has_derivative + by (subst mult_commute, rule refl) text {* These are the only cases we'll care about, probably. *} @@ -116,7 +97,7 @@ also have "\ \ ((\t. (f t - f x) / (t - x)) ---> y) (at x within ({x<..} \ I))" by (simp add: Lim_null[symmetric]) also have "\ \ ((\t. (f x - f t) / (x - t)) ---> y) (at x within ({x<..} \ I))" - by (intro Lim_cong_within) (simp_all add: times_divide_eq field_simps) + by (intro Lim_cong_within) (simp_all add: field_simps) finally show ?thesis by (simp add: mult.bounded_linear_right has_derivative_within) qed @@ -135,43 +116,34 @@ subsubsection {* Combining theorems. *} -lemma (in bounded_linear) has_derivative: "(f has_derivative f) net" - unfolding has_derivative_def apply(rule,rule bounded_linear_axioms) - unfolding diff by (simp add: tendsto_const) - lemma has_derivative_id: "((\x. x) has_derivative (\h. h)) net" - apply(rule bounded_linear.has_derivative) using bounded_linear_ident[unfolded id_def] by simp + unfolding has_derivative_def + by (simp add: bounded_linear_ident tendsto_const) lemma has_derivative_const: "((\x. c) has_derivative (\h. 0)) net" unfolding has_derivative_def - by (rule, rule bounded_linear_zero, simp add: tendsto_const) + by (simp add: bounded_linear_zero tendsto_const) -lemma (in bounded_linear) cmul: shows "bounded_linear (\x. (c::real) *\<^sub>R f x)" -proof - - have "bounded_linear (\x. c *\<^sub>R x)" - by (rule scaleR.bounded_linear_right) - moreover have "bounded_linear f" .. - ultimately show ?thesis - by (rule bounded_linear_compose) -qed +lemma (in bounded_linear) has_derivative': "(f has_derivative f) net" + unfolding has_derivative_def apply(rule,rule bounded_linear_axioms) + unfolding diff by (simp add: tendsto_const) + +lemma (in bounded_linear) bounded_linear: "bounded_linear f" .. -lemma has_derivative_cmul: assumes "(f has_derivative f') net" shows "((\x. c *\<^sub>R f(x)) has_derivative (\h. c *\<^sub>R f'(h))) net" - unfolding has_derivative_def apply(rule,rule bounded_linear.cmul) - using assms[unfolded has_derivative_def] - using scaleR.tendsto[OF tendsto_const assms[unfolded has_derivative_def,THEN conjunct2]] - unfolding scaleR_right_diff_distrib scaleR_right_distrib by auto - -lemma has_derivative_cmul_eq: assumes "c \ 0" - shows "(((\x. c *\<^sub>R f(x)) has_derivative (\h. c *\<^sub>R f'(h))) net \ (f has_derivative f') net)" - apply(rule) defer apply(rule has_derivative_cmul,assumption) - apply(drule has_derivative_cmul[where c="1/c"]) using assms by auto +lemma (in bounded_linear) has_derivative: + assumes "((\x. g x) has_derivative (\h. g' h)) net" + shows "((\x. f (g x)) has_derivative (\h. f (g' h))) net" + using assms unfolding has_derivative_def + apply safe + apply (erule bounded_linear_compose [OF local.bounded_linear]) + apply (drule local.tendsto) + apply (simp add: local.scaleR local.diff local.add local.zero) + done lemma has_derivative_neg: - "(f has_derivative f') net \ ((\x. -(f x)) has_derivative (\h. -(f' h))) net" - apply(drule has_derivative_cmul[where c="-1"]) by auto - -lemma has_derivative_neg_eq: "((\x. -(f x)) has_derivative (\h. -(f' h))) net \ (f has_derivative f') net" - apply(rule, drule_tac[!] has_derivative_neg) by auto + assumes "(f has_derivative f') net" + shows "((\x. -(f x)) has_derivative (\h. -(f' h))) net" + using scaleR_right.has_derivative [where r="-1", OF assms] by auto lemma has_derivative_add: assumes "(f has_derivative f') net" and "(g has_derivative g') net" @@ -180,11 +152,12 @@ note as = assms[unfolded has_derivative_def] show ?thesis unfolding has_derivative_def apply(rule,rule bounded_linear_add) using tendsto_add[OF as(1)[THEN conjunct2] as(2)[THEN conjunct2]] and as - by (auto simp add:algebra_simps scaleR_right_diff_distrib scaleR_right_distrib) + by (auto simp add: algebra_simps) qed -lemma has_derivative_add_const:"(f has_derivative f') net \ ((\x. f x + c) has_derivative f') net" - apply(drule has_derivative_add) apply(rule has_derivative_const) by auto +lemma has_derivative_add_const: + "(f has_derivative f') net \ ((\x. f x + c) has_derivative f') net" + by (drule has_derivative_add, rule has_derivative_const, auto) lemma has_derivative_sub: assumes "(f has_derivative f') net" and "(g has_derivative g') net" @@ -195,82 +168,22 @@ assumes "finite s" and "\a\s. ((f a) has_derivative (f' a)) net" shows "((\x. setsum (\a. f a x) s) has_derivative (\h. setsum (\a. f' a h) s)) net" using assms by (induct, simp_all add: has_derivative_const has_derivative_add) - -lemma has_derivative_setsum_numseg: - "\i. m \ i \ i \ n \ ((f i) has_derivative (f' i)) net \ - ((\x. setsum (\i. f i x) {m..n::nat}) has_derivative (\h. setsum (\i. f' i h) {m..n})) net" - by (rule has_derivative_setsum) simp_all - text {* Somewhat different results for derivative of scalar multiplier. *} (** move **) -lemma linear_vmul_component: +lemma linear_vmul_component: (* TODO: delete *) assumes lf: "linear f" shows "linear (\x. f x $$ k *\<^sub>R v)" using lf by (auto simp add: linear_def algebra_simps) -lemma bounded_linear_euclidean_component: "bounded_linear (\x. x $$ k)" - unfolding euclidean_component_def - by (rule inner.bounded_linear_right) - -lemma has_derivative_vmul_component: - fixes c::"'a::real_normed_vector \ 'b::euclidean_space" and v::"'c::real_normed_vector" - assumes "(c has_derivative c') net" - shows "((\x. c(x)$$k *\<^sub>R v) has_derivative (\x. (c' x)$$k *\<^sub>R v)) net" proof- - have *:"\y. (c y $$ k *\<^sub>R v - (c (netlimit net) $$ k *\<^sub>R v + c' (y - netlimit net) $$ k *\<^sub>R v)) = - (c y $$ k - (c (netlimit net) $$ k + c' (y - netlimit net) $$ k)) *\<^sub>R v" - unfolding scaleR_left_diff_distrib scaleR_left_distrib by auto - show ?thesis unfolding has_derivative_def and * - apply (rule conjI) - apply (rule bounded_linear_compose [OF scaleR.bounded_linear_left]) - apply (rule bounded_linear_compose [OF bounded_linear_euclidean_component]) - apply (rule derivative_linear [OF assms]) - apply(subst scaleR_zero_left[THEN sym, of v]) unfolding scaleR_scaleR - apply (intro tendsto_intros) - using assms[unfolded has_derivative_def] unfolding Lim o_def apply- apply(cases "trivial_limit net") - apply(rule,assumption,rule disjI2,rule,rule) proof- - have *:"\x. x - 0 = (x::'a)" by auto - have **:"\d x. d * (c x $$ k - (c (netlimit net) $$ k + c' (x - netlimit net) $$ k)) = - (d *\<^sub>R (c x - (c (netlimit net) + c' (x - netlimit net) ))) $$k" by(auto simp add:field_simps) - fix e assume "\ trivial_limit net" "0 < (e::real)" - then have "eventually (\x. dist ((1 / norm (x - netlimit net)) *\<^sub>R - (c x - (c (netlimit net) + c' (x - netlimit net)))) 0 < e) net" - using assms[unfolded has_derivative_def Lim] by auto - thus "eventually (\x. dist (1 / norm (x - netlimit net) * - (c x $$ k - (c (netlimit net) $$ k + c' (x - netlimit net) $$ k))) 0 < e) net" - proof (rule eventually_elim1) - case goal1 thus ?case apply - unfolding dist_norm apply(rule le_less_trans) - prefer 2 apply assumption unfolding * ** - using component_le_norm[of "(1 / norm (x - netlimit net)) *\<^sub>R - (c x - (c (netlimit net) + c' (x - netlimit net))) - 0" k] by auto - qed - qed -qed - -lemma has_derivative_vmul_within: fixes c::"real \ real" - assumes "(c has_derivative c') (at x within s)" - shows "((\x. (c x) *\<^sub>R v) has_derivative (\x. (c' x) *\<^sub>R v)) (at x within s)" - using has_derivative_vmul_component[OF assms, of 0 v] by auto - -lemma has_derivative_vmul_at: fixes c::"real \ real" - assumes "(c has_derivative c') (at x)" - shows "((\x. (c x) *\<^sub>R v) has_derivative (\x. (c' x) *\<^sub>R v)) (at x)" - using has_derivative_vmul_within[where s=UNIV] and assms by(auto simp add: within_UNIV) - -lemma has_derivative_lift_dot: - assumes "(f has_derivative f') net" - shows "((\x. inner v (f x)) has_derivative (\t. inner v (f' t))) net" proof- - show ?thesis using assms unfolding has_derivative_def apply- apply(erule conjE,rule) - apply(rule bounded_linear_compose[of _ f']) apply(rule inner.bounded_linear_right,assumption) - apply(drule Lim_inner[where a=v]) unfolding o_def - by(auto simp add:inner.scaleR_right inner.add_right inner.diff_right) qed - lemmas has_derivative_intros = - has_derivative_sub has_derivative_add has_derivative_cmul has_derivative_id - has_derivative_const has_derivative_neg has_derivative_vmul_component - has_derivative_vmul_at has_derivative_vmul_within has_derivative_cmul - bounded_linear.has_derivative has_derivative_lift_dot + has_derivative_id has_derivative_const + has_derivative_add has_derivative_sub has_derivative_neg + has_derivative_add_const + scaleR_left.has_derivative scaleR_right.has_derivative + inner_left.has_derivative inner_right.has_derivative + euclidean_component.has_derivative subsubsection {* Limit transformation for derivatives *} @@ -378,7 +291,7 @@ apply (erule_tac x=e in allE) apply (erule impE | assumption)+ apply (erule exE, rule_tac x=d in exI) - by (auto simp add: zero * elim!: allE) + by (auto simp add: zero *) qed lemma differentiable_imp_continuous_at: @@ -546,7 +459,7 @@ "f differentiable net \ (\x. c *\<^sub>R f(x)) differentiable (net::'a::real_normed_vector filter)" unfolding differentiable_def - apply(erule exE, drule has_derivative_cmul) by auto + apply(erule exE, drule scaleR_right.has_derivative) by auto lemma differentiable_neg [intro]: "f differentiable net \ @@ -855,8 +768,8 @@ proof fix x assume x:"x \ {a<..x. f x - (f b - f a) / (b - a) * x) has_derivative (\xa. f' x xa - (f b - f a) / (b - a) * xa)) (at x)" - by(rule has_derivative_intros assms(3)[rule_format,OF x] - has_derivative_cmul[where 'b=real, unfolded real_scaleR_def])+ + by (intro has_derivative_intros assms(3)[rule_format,OF x] + mult_right.has_derivative) qed(insert assms(1), auto simp add:field_simps) then guess x .. thus ?thesis apply(rule_tac x=x in bexI) @@ -901,7 +814,7 @@ have "\x\{a<.. (f b - f a) \ f) b - (op \ (f b - f a) \ f) a = (f b - f a) \ f' x (b - a)" apply(rule mvt) apply(rule assms(1)) apply(rule continuous_on_inner continuous_on_intros assms(2))+ - unfolding o_def apply(rule,rule has_derivative_lift_dot) + unfolding o_def apply(rule,rule has_derivative_intros) using assms(3) by auto then guess x .. note x=this show ?thesis proof(cases "f a = f b") @@ -1380,12 +1293,12 @@ unfolding o_def and diff using f'g' by auto show "(ph has_derivative (\v. v - g' (f' u v))) (at u within ball a d)" unfolding ph' * apply(rule diff_chain_within) defer - apply(rule bounded_linear.has_derivative[OF assms(3)]) + apply(rule bounded_linear.has_derivative'[OF assms(3)]) apply(rule has_derivative_intros) defer apply(rule has_derivative_sub[where g'="\x.0",unfolded diff_0_right]) apply(rule has_derivative_at_within) using assms(5) and `u\s` `a\s` - by(auto intro!: has_derivative_intros derivative_linear) + by(auto intro!: has_derivative_intros bounded_linear.has_derivative' derivative_linear) have **:"bounded_linear (\x. f' u x - f' a x)" "bounded_linear (\x. f' a x - f' u x)" apply(rule_tac[!] bounded_linear_sub) @@ -1826,7 +1739,8 @@ lemma has_vector_derivative_cmul: "(f has_vector_derivative f') net \ ((\x. c *\<^sub>R f x) has_vector_derivative (c *\<^sub>R f')) net" - unfolding has_vector_derivative_def apply(drule has_derivative_cmul) + unfolding has_vector_derivative_def + apply (drule scaleR_right.has_derivative) by (auto simp add: algebra_simps) lemma has_vector_derivative_cmul_eq: diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy --- a/src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy Wed Aug 10 18:07:32 2011 -0700 @@ -420,7 +420,7 @@ using ereal_open_cont_interval2[of S f0] real lim by auto then have "eventually (\x. f x \ {a<.. S` show "eventually (%x. f x : S) net" by (rule_tac eventually_mono) auto qed @@ -1036,7 +1036,7 @@ proof (rule ccontr) assume "\ ?thesis" then have "\i\A. \r. f i = ereal r" by auto from bchoice[OF this] guess r .. - with * show False by (auto simp: setsum_ereal) + with * show False by auto qed ultimately show "finite A \ (\i\A. \f i\ = \)" by auto next diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Fashoda.thy --- a/src/HOL/Multivariate_Analysis/Fashoda.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Fashoda.thy Wed Aug 10 18:07:32 2011 -0700 @@ -46,7 +46,7 @@ apply(rule assms)+ apply(rule continuous_on_compose,subst sqprojection_def) apply(rule continuous_on_mul ) apply(rule continuous_at_imp_continuous_on,rule) apply(rule continuous_at_inv[unfolded o_def]) apply(rule continuous_at_infnorm) unfolding infnorm_eq_0 defer apply(rule continuous_on_id) apply(rule linear_continuous_on) proof- - show "bounded_linear negatex" apply(rule bounded_linearI') unfolding Cart_eq proof(rule_tac[!] allI) fix i::2 and x y::"real^2" and c::real + show "bounded_linear negatex" apply(rule bounded_linearI') unfolding vec_eq_iff proof(rule_tac[!] allI) fix i::2 and x y::"real^2" and c::real show "negatex (x + y) $ i = (negatex x + negatex y) $ i" "negatex (c *\<^sub>R x) $ i = (c *\<^sub>R negatex x) $ i" apply-apply(case_tac[!] "i\1") prefer 3 apply(drule_tac[1-2] 21) unfolding negatex_def by(auto simp add:vector_2 ) qed qed(insert x0, auto) @@ -66,7 +66,7 @@ apply- apply(rule_tac[!] allI impI)+ proof- fix x::"real^2" and i::2 assume x:"x\0" have "inverse (infnorm x) > 0" using x[unfolded infnorm_pos_lt[THEN sym]] by auto thus "(0 < sqprojection x $ i) = (0 < x $ i)" "(sqprojection x $ i < 0) = (x $ i < 0)" - unfolding sqprojection_def vector_component_simps Cart_nth.scaleR real_scaleR_def + unfolding sqprojection_def vector_component_simps vec_nth.scaleR real_scaleR_def unfolding zero_less_mult_iff mult_less_0_iff by(auto simp add:field_simps) qed note lem3 = this[rule_format] have x1:"x $ 1 \ {- 1..1::real}" "x $ 2 \ {- 1..1::real}" using x(1) unfolding mem_interval_cart by auto @@ -77,7 +77,7 @@ next assume as:"x$1 = 1" hence *:"f (x $ 1) $ 1 = 1" using assms(6) by auto have "sqprojection (f (x$1) - g (x$2)) $ 1 < 0" - using x(2)[unfolded o_def Cart_eq,THEN spec[where x=1]] + using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=1]] unfolding as negatex_def vector_2 by auto moreover from x1 have "g (x $ 2) \ {- 1..1}" apply-apply(rule assms(2)[unfolded subset_eq,rule_format]) by auto ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart @@ -85,7 +85,7 @@ next assume as:"x$1 = -1" hence *:"f (x $ 1) $ 1 = - 1" using assms(5) by auto have "sqprojection (f (x$1) - g (x$2)) $ 1 > 0" - using x(2)[unfolded o_def Cart_eq,THEN spec[where x=1]] + using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=1]] unfolding as negatex_def vector_2 by auto moreover from x1 have "g (x $ 2) \ {- 1..1}" apply-apply(rule assms(2)[unfolded subset_eq,rule_format]) by auto ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart @@ -93,7 +93,7 @@ next assume as:"x$2 = 1" hence *:"g (x $ 2) $ 2 = 1" using assms(8) by auto have "sqprojection (f (x$1) - g (x$2)) $ 2 > 0" - using x(2)[unfolded o_def Cart_eq,THEN spec[where x=2]] + using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=2]] unfolding as negatex_def vector_2 by auto moreover from x1 have "f (x $ 1) \ {- 1..1}" apply-apply(rule assms(1)[unfolded subset_eq,rule_format]) by auto ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart @@ -101,7 +101,7 @@ next assume as:"x$2 = -1" hence *:"g (x $ 2) $ 2 = - 1" using assms(7) by auto have "sqprojection (f (x$1) - g (x$2)) $ 2 < 0" - using x(2)[unfolded o_def Cart_eq,THEN spec[where x=2]] + using x(2)[unfolded o_def vec_eq_iff,THEN spec[where x=2]] unfolding as negatex_def vector_2 by auto moreover from x1 have "f (x $ 1) \ {- 1..1}" apply-apply(rule assms(1)[unfolded subset_eq,rule_format]) by auto ultimately show False unfolding lem3[OF nz] vector_component_simps * mem_interval_cart @@ -120,7 +120,7 @@ have *:"continuous_on {- 1..1} iscale" unfolding iscale_def by(rule continuous_on_intros)+ show "continuous_on {- 1..1} (f \ iscale)" "continuous_on {- 1..1} (g \ iscale)" apply-apply(rule_tac[!] continuous_on_compose[OF *]) apply(rule_tac[!] continuous_on_subset[OF _ isc]) - by(rule assms)+ have *:"(1 / 2) *\<^sub>R (1 + (1::real^1)) = 1" unfolding Cart_eq by auto + by(rule assms)+ have *:"(1 / 2) *\<^sub>R (1 + (1::real^1)) = 1" unfolding vec_eq_iff by auto show "(f \ iscale) (- 1) $ 1 = - 1" "(f \ iscale) 1 $ 1 = 1" "(g \ iscale) (- 1) $ 2 = -1" "(g \ iscale) 1 $ 2 = 1" unfolding o_def iscale_def using assms by(auto simp add:*) qed then guess s .. from this(2) guess t .. note st=this @@ -132,7 +132,7 @@ (* move *) lemma interval_bij_bij_cart: fixes x::"real^'n" assumes "\i. a$i < b$i \ u$i < v$i" shows "interval_bij (a,b) (u,v) (interval_bij (u,v) (a,b) x) = x" - unfolding interval_bij_cart split_conv Cart_eq Cart_lambda_beta + unfolding interval_bij_cart split_conv vec_eq_iff vec_lambda_beta apply(rule,insert assms,erule_tac x=i in allE) by auto lemma fashoda: fixes b::"real^2" @@ -142,23 +142,23 @@ obtains z where "z \ path_image f" "z \ path_image g" proof- fix P Q S presume "P \ Q \ S" "P \ thesis" "Q \ thesis" "S \ thesis" thus thesis by auto next have "{a..b} \ {}" using assms(3) using path_image_nonempty by auto - hence "a \ b" unfolding interval_eq_empty_cart vector_le_def by(auto simp add: not_less) - thus "a$1 = b$1 \ a$2 = b$2 \ (a$1 < b$1 \ a$2 < b$2)" unfolding vector_le_def forall_2 by auto + hence "a \ b" unfolding interval_eq_empty_cart less_eq_vec_def by(auto simp add: not_less) + thus "a$1 = b$1 \ a$2 = b$2 \ (a$1 < b$1 \ a$2 < b$2)" unfolding less_eq_vec_def forall_2 by auto next assume as:"a$1 = b$1" have "\z\path_image g. z$2 = (pathstart f)$2" apply(rule connected_ivt_component_cart) apply(rule connected_path_image assms)+apply(rule pathstart_in_path_image,rule pathfinish_in_path_image) unfolding assms using assms(3)[unfolded path_image_def subset_eq,rule_format,of "f 0"] - unfolding pathstart_def by(auto simp add: vector_le_def) then guess z .. note z=this + unfolding pathstart_def by(auto simp add: less_eq_vec_def) then guess z .. note z=this have "z \ {a..b}" using z(1) assms(4) unfolding path_image_def by blast - hence "z = f 0" unfolding Cart_eq forall_2 unfolding z(2) pathstart_def + hence "z = f 0" unfolding vec_eq_iff forall_2 unfolding z(2) pathstart_def using assms(3)[unfolded path_image_def subset_eq mem_interval_cart,rule_format,of "f 0" 1] unfolding mem_interval_cart apply(erule_tac x=1 in allE) using as by auto thus thesis apply-apply(rule that[OF _ z(1)]) unfolding path_image_def by auto next assume as:"a$2 = b$2" have "\z\path_image f. z$1 = (pathstart g)$1" apply(rule connected_ivt_component_cart) apply(rule connected_path_image assms)+apply(rule pathstart_in_path_image,rule pathfinish_in_path_image) unfolding assms using assms(4)[unfolded path_image_def subset_eq,rule_format,of "g 0"] - unfolding pathstart_def by(auto simp add: vector_le_def) then guess z .. note z=this + unfolding pathstart_def by(auto simp add: less_eq_vec_def) then guess z .. note z=this have "z \ {a..b}" using z(1) assms(3) unfolding path_image_def by blast - hence "z = g 0" unfolding Cart_eq forall_2 unfolding z(2) pathstart_def + hence "z = g 0" unfolding vec_eq_iff forall_2 unfolding z(2) pathstart_def using assms(4)[unfolded path_image_def subset_eq mem_interval_cart,rule_format,of "g 0" 2] unfolding mem_interval_cart apply(erule_tac x=2 in allE) using as by auto thus thesis apply-apply(rule that[OF z(1)]) unfolding path_image_def by auto @@ -180,7 +180,7 @@ "(interval_bij (a, b) (- 1, 1) \ f) 1 $ 1 = 1" "(interval_bij (a, b) (- 1, 1) \ g) 0 $ 2 = -1" "(interval_bij (a, b) (- 1, 1) \ g) 1 $ 2 = 1" - unfolding interval_bij_cart Cart_lambda_beta vector_component_simps o_def split_conv + unfolding interval_bij_cart vec_lambda_beta vector_component_simps o_def split_conv unfolding assms[unfolded pathstart_def pathfinish_def] using as by auto qed note z=this from z(1) guess zf unfolding image_iff .. note zf=this from z(2) guess zg unfolding image_iff .. note zg=this @@ -197,7 +197,7 @@ proof- let ?L = "\u. (x $ 1 = (1 - u) * a $ 1 + u * b $ 1 \ x $ 2 = (1 - u) * a $ 2 + u * b $ 2) \ 0 \ u \ u \ 1" { presume "?L \ ?R" "?R \ ?L" thus ?thesis unfolding closed_segment_def mem_Collect_eq - unfolding Cart_eq forall_2 smult_conv_scaleR[THEN sym] vector_component_simps by blast } + unfolding vec_eq_iff forall_2 smult_conv_scaleR[THEN sym] vector_component_simps by blast } { assume ?L then guess u apply-apply(erule exE)apply(erule conjE)+ . note u=this { fix b a assume "b + u * a > a + u * b" hence "(1 - u) * b > (1 - u) * a" by(auto simp add:field_simps) @@ -221,7 +221,7 @@ proof- let ?L = "\u. (x $ 1 = (1 - u) * a $ 1 + u * b $ 1 \ x $ 2 = (1 - u) * a $ 2 + u * b $ 2) \ 0 \ u \ u \ 1" { presume "?L \ ?R" "?R \ ?L" thus ?thesis unfolding closed_segment_def mem_Collect_eq - unfolding Cart_eq forall_2 smult_conv_scaleR[THEN sym] vector_component_simps by blast } + unfolding vec_eq_iff forall_2 smult_conv_scaleR[THEN sym] vector_component_simps by blast } { assume ?L then guess u apply-apply(erule exE)apply(erule conjE)+ . note u=this { fix b a assume "b + u * a > a + u * b" hence "(1 - u) * b > (1 - u) * a" by(auto simp add:field_simps) @@ -274,7 +274,7 @@ path_image(linepath(vector[(pathfinish g)$1,a$2 - 1])(vector[b$1 + 1,a$2 - 1])) \ path_image(linepath(vector[b$1 + 1,a$2 - 1])(vector[b$1 + 1,b$2 + 3]))" using assms(1-2) by(auto simp add: path_image_join path_linepath) - have abab: "{a..b} \ {?a..?b}" by(auto simp add:vector_le_def forall_2 vector_2) + have abab: "{a..b} \ {?a..?b}" by(auto simp add:less_eq_vec_def forall_2 vector_2) guess z apply(rule fashoda[of ?P1 ?P2 ?a ?b]) unfolding pathstart_join pathfinish_join pathstart_linepath pathfinish_linepath vector_2 proof- show "path ?P1" "path ?P2" using assms by auto @@ -318,11 +318,11 @@ qed hence "z \ path_image f \ z \ path_image g" using z unfolding Un_iff by blast hence z':"z\{a..b}" using assms(3-4) by auto have "a $ 2 = z $ 2 \ (z $ 1 = pathstart f $ 1 \ z $ 1 = pathfinish f $ 1) \ (z = pathstart f \ z = pathfinish f)" - unfolding Cart_eq forall_2 assms by auto + unfolding vec_eq_iff forall_2 assms by auto with z' show "z\path_image f" using z(1) unfolding Un_iff mem_interval_cart forall_2 apply- apply(simp only: segment_vertical segment_horizontal vector_2) unfolding assms by auto have "a $ 2 = z $ 2 \ (z $ 1 = pathstart g $ 1 \ z $ 1 = pathfinish g $ 1) \ (z = pathstart g \ z = pathfinish g)" - unfolding Cart_eq forall_2 assms by auto + unfolding vec_eq_iff forall_2 assms by auto with z' show "z\path_image g" using z(2) unfolding Un_iff mem_interval_cart forall_2 apply- apply(simp only: segment_vertical segment_horizontal vector_2) unfolding assms by auto qed qed diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy --- a/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Wed Aug 10 18:07:32 2011 -0700 @@ -6,155 +6,155 @@ theory Finite_Cartesian_Product imports - "~~/src/HOL/Library/Inner_Product" + Euclidean_Space L2_Norm "~~/src/HOL/Library/Numeral_Type" begin 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) + by auto -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,84 +368,247 @@ 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" +definition "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 + 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) + by (rule sgn_vec_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 end +subsection {* Euclidean space *} + +text {* A bijection between @{text "'n::finite"} and @{text "{.. ('n::finite)" where + "vec_bij_nat = (SOME p. bij_betw p {.. \ vec_bij_nat" +definition "\' = inv_into {..::nat \ ('n::finite))" + +lemma bij_betw_pi: + "bij_betw \ {..x. bij_betw x {..' (UNIV::'n set) {..'_def by auto + +lemma pi'_inj[intro]: "inj \'" + using bij_betw_pi' unfolding bij_betw_def by auto + +lemma pi'_range[intro]: "\i::'n. \' i < CARD('n::finite)" + using bij_betw_pi' unfolding bij_betw_def by auto + +lemma \\'[simp]: "\i::'n::finite. \ (\' i) = i" + using bij_betw_pi by (auto intro!: f_inv_into_f simp: \'_def bij_betw_def) + +lemma \'\[simp]: "\i. i\{.. \' (\ i::'n) = i" + using bij_betw_pi by (auto intro!: inv_into_f_eq simp: \'_def bij_betw_def) + +lemma \\'_alt[simp]: "\i. i \' (\ i::'n) = i" + by auto + +lemma \_inj_on: "inj_on (\::nat\'n::finite) {.. j::'b. if j = \(i div DIM('a)) then basis (i mod DIM('a)) else 0) + 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)" +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 + finally show ?thesis + unfolding basis_vec_def using assms by (auto simp: vec_eq_iff not_less field_simps) +qed + +lemma basis_eq_pi': + 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 + +lemma split_times_into_modulo[consumes 1]: + fixes k :: nat + assumes "k < A * B" + obtains i j where "i < A" and "j < B" and "k = j + i * B" +proof + have "A * B \ 0" + proof assume "A * B = 0" with assms show False by simp qed + hence "0 < B" by auto + thus "k mod B < B" using `0 < B` by auto +next + have "k div B * B \ k div B * B + k mod B" by (rule le_add1) + also have "... < A * B" using assms by simp + 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" +proof - + have "i * A + j < (Suc i)*A" using `j < A` by simp + also have "\ \ B * A" using `i < B` unfolding mult_le_cancel2 by simp + finally show ?thesis by simp +qed + +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 i" thus "basis i = (0::'a^'b)" + unfolding dimension_vec_def basis_vec_def + by simp +next + show "\iji 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 +qed + end + +end diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Integration.thy --- a/src/HOL/Multivariate_Analysis/Integration.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Integration.thy Wed Aug 10 18:07:32 2011 -0700 @@ -3763,8 +3763,9 @@ using `x\s` `c\s` as by(auto simp add: algebra_simps) have "(f \ (\t. (1 - t) *\<^sub>R c + t *\<^sub>R x) has_derivative (\x. 0) \ (\z. (0 - z *\<^sub>R c) + z *\<^sub>R x)) (at t within {0..1})" apply(rule diff_chain_within) apply(rule has_derivative_add) - unfolding scaleR_simps apply(rule has_derivative_sub) apply(rule has_derivative_const) - apply(rule has_derivative_vmul_within,rule has_derivative_id)+ + unfolding scaleR_simps + apply(intro has_derivative_intros) + apply(intro has_derivative_intros) apply(rule has_derivative_within_subset,rule assms(6)[rule_format]) apply(rule *) apply safe apply(rule conv[unfolded scaleR_simps]) using `x\s` `c\s` by auto thus "((\xa. f ((1 - xa) *\<^sub>R c + xa *\<^sub>R x)) has_derivative (\h. 0)) (at t within {0..1})" unfolding o_def . diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/L2_Norm.thy --- a/src/HOL/Multivariate_Analysis/L2_Norm.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/L2_Norm.thy Wed Aug 10 18:07:32 2011 -0700 @@ -109,9 +109,8 @@ lemma sqrt_sum_squares_le_sum: "\0 \ x; 0 \ y\ \ sqrt (x\ + y\) \ x + y" apply (rule power2_le_imp_le) - apply (simp add: power2_sum) - apply (simp add: mult_nonneg_nonneg) - apply (simp add: add_nonneg_nonneg) + apply (simp add: power2_sum mult_nonneg_nonneg) + apply simp done lemma setL2_le_setsum [rule_format]: @@ -128,9 +127,8 @@ lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\ + y\) \ \x\ + \y\" apply (rule power2_le_imp_le) - apply (simp add: power2_sum) - apply (simp add: mult_nonneg_nonneg) - apply (simp add: add_nonneg_nonneg) + apply (simp add: power2_sum mult_nonneg_nonneg) + apply simp done lemma setL2_le_setsum_abs: "setL2 f A \ (\i\A. \f i\)" @@ -164,7 +162,7 @@ apply (rule order_trans) apply (rule power_mono) apply (erule add_left_mono) - apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg) + apply (simp add: mult_nonneg_nonneg setsum_nonneg) apply (simp add: power2_sum) apply (simp add: power_mult_distrib) apply (simp add: right_distrib left_distrib) diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Linear_Algebra.thy --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Wed Aug 10 18:07:32 2011 -0700 @@ -641,9 +641,9 @@ assumes x: "0 \ x" and y: "0 \ y" shows "sqrt (x + y) \ sqrt x + sqrt y" apply (rule power2_le_imp_le) -apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y) +apply (simp add: real_sum_squared_expand x y) apply (simp add: mult_nonneg_nonneg x y) -apply (simp add: add_nonneg_nonneg x y) +apply (simp add: x y) done subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *} @@ -2319,7 +2319,7 @@ shows "x = 0" using fB ifB fi xsB fx proof(induct arbitrary: x rule: finite_induct[OF fB]) - case 1 thus ?case by (auto simp add: span_empty) + case 1 thus ?case by auto next case (2 a b x) have fb: "finite b" using "2.prems" by simp @@ -2372,7 +2372,7 @@ \ (\x\ B. g x = f x)" using ib fi proof(induct rule: finite_induct[OF fi]) - case 1 thus ?case by (auto simp add: span_empty) + case 1 thus ?case by auto next case (2 a b) from "2.prems" "2.hyps" have ibf: "independent b" "finite b" diff -r fa98623f1006 -r d282b3c5df7c src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Wed Aug 10 21:24:26 2011 +0200 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Wed Aug 10 18:07:32 2011 -0700 @@ -1031,9 +1031,6 @@ (\e>0. \N. \n\N. dist (S n) l < e)" by (auto simp add: tendsto_iff eventually_sequentially) -lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \ S ----> l" - unfolding Lim_sequentially LIMSEQ_def .. - lemma Lim_eventually: "eventually (\x. f x = l) net \ (f ---> l) net" by (rule topological_tendstoI, auto elim: eventually_rev_mono) @@ -2228,15 +2225,10 @@ by auto qed -lemma bounded_component: "bounded s \ - bounded ((\x. x $$ i) ` (s::'a::euclidean_space set))" -unfolding bounded_def -apply clarify -apply (rule_tac x="x $$ i" in exI) -apply (rule_tac x="e" in exI) -apply clarify -apply (rule order_trans[OF dist_nth_le],simp) -done +lemma bounded_component: "bounded s \ bounded ((\x. x $$ i) ` s)" + apply (erule bounded_linear_image) + apply (rule bounded_linear_euclidean_component) + done lemma compact_lemma: fixes f :: "nat \ 'a::euclidean_space"