diff -r 46be26e02456 -r 899c9c4e4a4c src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Fri Dec 14 14:46:01 2012 +0100 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Fri Dec 14 15:46:01 2012 +0100 @@ -101,56 +101,22 @@ lemma span_eq[simp]: "(span s = s) <-> subspace s" unfolding span_def by (rule hull_eq, rule subspace_Inter) -lemma basis_inj_on: "d \ {.. inj_on (basis :: nat => 'n::euclidean_space) d" - by (auto simp add: inj_on_def euclidean_eq[where 'a='n]) - -lemma finite_substdbasis: "finite {basis i ::'n::euclidean_space |i. i : (d:: nat set)}" (is "finite ?S") -proof - - have eq: "?S = basis ` d" by blast - show ?thesis - unfolding eq - apply (rule finite_subset[OF _ range_basis_finite]) - apply auto - done -qed - -lemma card_substdbasis: - assumes "d \ {..{..R basis i) d = (x::'a::euclidean_space) - <-> (!i f i = x$$i) & (i ~: d --> x $$ i = 0))" + assumes d: "d \ Basis" + shows "(\i\d. f i *\<^sub>R i) = (x::'a::euclidean_space) + \ (\i\Basis. (i \ d \ f i = x \ i) \ (i \ d \ x \ i = 0))" proof - have *: "\x a b P. x * (if P then a else b) = (if P then x*a else x*b)" by auto - have **: "finite d" apply(rule finite_subset[OF assms]) by fastforce - have ***: "\i. (setsum (%i. f i *\<^sub>R ((basis i)::'a)) d) $$ i = (\x\d. if x = i then f x else 0)" - unfolding euclidean_component_setsum euclidean_component_scaleR basis_component * - apply (rule setsum_cong2) - using assms apply auto - done + have **: "finite d" by (auto intro: finite_subset[OF assms]) + have ***: "\i. i \ Basis \ (\i\d. f i *\<^sub>R i) \ i = (\x\d. if x = i then f x else 0)" + using d + by (auto intro!: setsum_cong simp: inner_Basis inner_setsum_left) show ?thesis - unfolding euclidean_eq[where 'a='a] *** setsum_delta[OF **] using assms by auto -qed - -lemma independent_substdbasis: - assumes "d \ {..i. i convex {x. P i x}" - shows "convex {x. \ii x$$i)}" + assumes "\i. i\Basis \ convex {x. P i x}" + shows "convex {x. \i\Basis. P i (x\i)}" + using assms unfolding convex_def + by (auto simp: inner_add_left) + +lemma convex_positive_orthant: "convex {x::'a::euclidean_space. (\i\Basis. 0 \ x\i)}" by (rule convex_box) (simp add: atLeast_def[symmetric] convex_real_interval) lemma convex_local_global_minimum: @@ -2073,40 +2040,39 @@ from this show ?thesis using assms `span B=S` by auto qed -lemma span_substd_basis: assumes "d\{.. x$$i = 0)}" - (is "span ?A = ?B") +lemma span_substd_basis: + assumes d: "d \ Basis" + shows "span d = {x. \i\Basis. i \ d \ x\i = 0}" (is "_ = ?B") proof- -have "?A <= ?B" by auto +have "d <= ?B" using d by (auto simp: inner_Basis) moreover have s: "subspace ?B" using subspace_substandard[of "%i. i ~: d"] . -ultimately have "span ?A <= ?B" using span_mono[of "?A" "?B"] span_eq[of "?B"] by blast -moreover have "card d <= dim (span ?A)" using independent_card_le_dim[of "?A" "span ?A"] - independent_substdbasis[OF assms] card_substdbasis[OF assms] span_inc[of "?A"] by auto -moreover hence "dim ?B <= dim (span ?A)" using dim_substandard[OF assms] by auto -ultimately show ?thesis using s subspace_dim_equal[of "span ?A" "?B"] - subspace_span[of "?A"] by auto +ultimately have "span d <= ?B" using span_mono[of d "?B"] span_eq[of "?B"] by blast +moreover have "card d <= dim (span d)" using independent_card_le_dim[of d "span d"] + independent_substdbasis[OF assms] span_inc[of d] by auto +moreover hence "dim ?B <= dim (span d)" using dim_substandard[OF assms] by auto +ultimately show ?thesis using s subspace_dim_equal[of "span d" "?B"] + subspace_span[of d] by auto qed lemma basis_to_substdbasis_subspace_isomorphism: fixes B :: "('a::euclidean_space) set" assumes "independent B" -shows "EX f d. card d = card B & linear f & f ` B = {basis i::'a |i. i : (d :: nat set)} & - f ` span B = {x. ALL i x $$ i = (0::real)} & inj_on f (span B) \ d\{.. linear f \ f ` B = d \ + f ` span B = {x. \i\Basis. i \ d \ x \ i = 0} \ inj_on f (span B) \ d \ Basis" proof- have B:"card B=dim B" using dim_unique[of B B "card B"] assms span_inc[of B] by auto - def d \ "{..{.. card (Basis :: 'a set)" using dim_subset_UNIV[of B] by simp + from ex_card[OF this] obtain d :: "'a set" where d: "d \ Basis" and t: "card d = dim B" by auto + let ?t = "{x::'a::euclidean_space. \i\Basis. i ~: d --> x\i = 0}" + have "EX f. linear f & f ` B = d & f ` span B = ?t & inj_on f (span B)" + apply (rule basis_to_basis_subspace_isomorphism[of "span B" ?t B "d"]) apply(rule subspace_span) apply(rule subspace_substandard) defer apply(rule span_inc) apply(rule assms) defer unfolding dim_span[of B] apply(rule B) - unfolding span_substd_basis[OF d,symmetric] card_substdbasis[OF d] apply(rule span_inc) + unfolding span_substd_basis[OF d, symmetric] + apply(rule span_inc) apply(rule independent_substdbasis[OF d]) apply(rule,assumption) unfolding t[symmetric] span_substd_basis[OF d] dim_substandard[OF d] by auto - from this t `card B=dim B` show ?thesis using d by auto + with t `card B = dim B` d show ?thesis by auto qed lemma aff_dim_empty: @@ -2492,7 +2458,7 @@ using as affine_affine_hull[of S] mem_affine[of "affine hull S" y x "(1 / e)" "-((1 - e) / e)"] by (simp add: algebra_simps) have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = abs(1/e) * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)" unfolding dist_norm unfolding norm_scaleR[symmetric] apply(rule arg_cong[where f=norm]) using `e>0` - by(auto simp add:euclidean_eq[where 'a='a] field_simps) + by(auto simp add:euclidean_eq_iff[where 'a='a] field_simps inner_simps) also have "... = abs(1/e) * norm (x - e *\<^sub>R (x - c) - y)" by(auto intro!:arg_cong[where f=norm] simp add: algebra_simps) also have "... < d" using as[unfolded dist_norm] and `e>0` by(auto simp add:pos_divide_less_eq[OF `e>0`] mult_commute) @@ -2770,9 +2736,9 @@ subsection{* Some Properties of subset of standard basis *} -lemma affine_hull_substd_basis: assumes "d\{.. x$$i = 0)}" +lemma affine_hull_substd_basis: assumes "d\Basis" + shows "affine hull (insert 0 d) = + {x::'a::euclidean_space. (\i\Basis. i ~: d --> x\i = 0)}" (is "affine hull (insert 0 ?A) = ?B") proof- have *:"\A. op + (0\'a) ` A = A" "\A. op + (- (0\'a)) ` A = A" by auto show ?thesis unfolding affine_hull_insert_span_gen span_substd_basis[OF assms,symmetric] * .. @@ -3230,10 +3196,10 @@ assumes "convex (s::('a::euclidean_space) set)" "closed s" "0 \ s" shows "\a b. a \ 0 \ 0 < b \ (\x\s. inner a x > b)" proof(cases "s={}") - case True have "norm ((basis 0)::'a) = 1" by auto - hence "norm ((basis 0)::'a) = 1" "basis 0 \ (0::'a)" defer - apply(subst norm_le_zero_iff[symmetric]) by auto - thus ?thesis apply(rule_tac x="basis 0" in exI, rule_tac x=1 in exI) + case True + have "norm ((SOME i. i\Basis)::'a) = 1" "(SOME i. i\Basis) \ (0::'a)" defer + apply(subst norm_le_zero_iff[symmetric]) by (auto simp: SOME_Basis) + thus ?thesis apply(rule_tac x="SOME i. i\Basis" in exI, rule_tac x=1 in exI) using True using DIM_positive[where 'a='a] by auto next case False thus ?thesis using False using separating_hyperplane_closed_point[OF assms] apply - apply(erule exE)+ unfolding inner_zero_right apply(rule_tac x=a in exI, rule_tac x=b in exI) by auto qed @@ -3703,10 +3669,10 @@ case False thus ?thesis apply (intro continuous_intros) using cont_surfpi unfolding continuous_on_eq_continuous_at[OF open_delete[OF open_UNIV]] o_def by auto next obtain B where B:"\x\s. norm x \ B" using compact_imp_bounded[OF assms(1)] unfolding bounded_iff by auto - hence "B > 0" using assms(2) unfolding subset_eq apply(erule_tac x="basis 0" in ballE) defer - apply(erule_tac x="basis 0" in ballE) + hence "B > 0" using assms(2) unfolding subset_eq apply(erule_tac x="SOME i. i\Basis" in ballE) defer + apply(erule_tac x="SOME i. i\Basis" in ballE) unfolding Ball_def mem_cball dist_norm using DIM_positive[where 'a='a] - by auto + by (auto simp: SOME_Basis) case True show ?thesis unfolding True continuous_at Lim_at apply(rule,rule) apply(rule_tac x="e / B" in exI) apply(rule) apply(rule divide_pos_pos) prefer 3 apply(rule,rule,erule conjE) unfolding norm_zero scaleR_zero_left dist_norm diff_0_right norm_scaleR abs_norm_cancel proof- @@ -3849,7 +3815,8 @@ hence "a < b" unfolding * using as(4) apply(rule_tac mult_left_less_imp_less) by(auto simp add: field_simps) hence "u * a + v * b \ b" unfolding ** using **(2) as(3) by(auto simp add: field_simps intro!:mult_right_mono) } ultimately show "u *\<^sub>R x + v *\<^sub>R y \ s" apply- apply(rule assms[unfolded is_interval_def, rule_format, OF as(1,2)]) - using as(3-) DIM_positive[where 'a='a] by auto qed + using as(3-) DIM_positive[where 'a='a] by (auto simp: inner_simps) +qed lemma is_interval_connected: fixes s :: "('a::euclidean_space) set" @@ -3892,8 +3859,8 @@ subsection {* Another intermediate value theorem formulation *} lemma ivt_increasing_component_on_1: fixes f::"real \ 'a::euclidean_space" - assumes "a \ b" "continuous_on {a .. b} f" "(f a)$$k \ y" "y \ (f b)$$k" - shows "\x\{a..b}. (f x)$$k = y" + assumes "a \ b" "continuous_on {a .. b} f" "(f a)\k \ y" "y \ (f b)\k" + shows "\x\{a..b}. (f x)\k = y" proof- have "f a \ f ` {a..b}" "f b \ f ` {a..b}" apply(rule_tac[!] imageI) using assms(1) by auto thus ?thesis using connected_ivt_component[of "f ` {a..b}" "f a" "f b" k y] @@ -3902,20 +3869,20 @@ lemma ivt_increasing_component_1: fixes f::"real \ 'a::euclidean_space" shows "a \ b \ \x\{a .. b}. continuous (at x) f - \ f a$$k \ y \ y \ f b$$k \ \x\{a..b}. (f x)$$k = y" + \ f a\k \ y \ y \ f b\k \ \x\{a..b}. (f x)\k = y" by(rule ivt_increasing_component_on_1) (auto simp add: continuous_at_imp_continuous_on) lemma ivt_decreasing_component_on_1: fixes f::"real \ 'a::euclidean_space" - assumes "a \ b" "continuous_on {a .. b} f" "(f b)$$k \ y" "y \ (f a)$$k" - shows "\x\{a..b}. (f x)$$k = y" + assumes "a \ b" "continuous_on {a .. b} f" "(f b)\k \ y" "y \ (f a)\k" + shows "\x\{a..b}. (f x)\k = y" apply(subst neg_equal_iff_equal[symmetric]) using ivt_increasing_component_on_1[of a b "\x. - f x" k "- y"] using assms using continuous_on_minus by auto lemma ivt_decreasing_component_1: fixes f::"real \ 'a::euclidean_space" shows "a \ b \ \x\{a .. b}. continuous (at x) f - \ f b$$k \ y \ y \ f a$$k \ \x\{a..b}. (f x)$$k = y" + \ f b\k \ y \ y \ f a\k \ \x\{a..b}. (f x)\k = y" by(rule ivt_decreasing_component_on_1) (auto simp: continuous_at_imp_continuous_on) @@ -3933,104 +3900,127 @@ thus "f x \ b" using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v] unfolding obt(2-3) using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s] by auto qed +lemma inner_setsum_Basis[simp]: "\i. i \ Basis \ (\Basis) \ i = 1" + by (simp add: One_def inner_setsum_left setsum_cases inner_Basis) + lemma unit_interval_convex_hull: - "{0::'a::ordered_euclidean_space .. (\\ i. 1)} = convex hull {x. \i (x$$i = 1)}" + defines "One \ (\Basis)" + shows "{0::'a::ordered_euclidean_space .. One} = + convex hull {x. \i\Basis. (x\i = 0) \ (x\i = 1)}" (is "?int = convex hull ?points") -proof- have 01:"{0,(\\ i. 1)} \ convex hull ?points" apply rule apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto - { fix n x assume "x\{0::'a::ordered_euclidean_space .. \\ i. 1}" "n \ DIM('a)" "card {i. i x$$i \ 0} \ n" +proof - + have One[simp]: "\i. i \ Basis \ One \ i = 1" + by (simp add: One_def inner_setsum_left setsum_cases inner_Basis) + have 01:"{0,One} \ convex hull ?points" + apply rule apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto + { fix n x assume "x\{0::'a::ordered_euclidean_space .. One}" "n \ DIM('a)" "card {i. i\Basis \ x\i \ 0} \ n" hence "x\convex hull ?points" proof(induct n arbitrary: x) - case 0 hence "x = 0" apply(subst euclidean_eq) apply rule by auto + case 0 hence "x = 0" apply(subst euclidean_eq_iff) apply rule by auto thus "x\convex hull ?points" using 01 by auto next - case (Suc n) show "x\convex hull ?points" proof(cases "{i. i x$$i \ 0} = {}") - case True hence "x = 0" apply(subst euclidean_eq) by auto + case (Suc n) show "x\convex hull ?points" proof(cases "{i. i\Basis \ x\i \ 0} = {}") + case True hence "x = 0" apply(subst euclidean_eq_iff) by auto thus "x\convex hull ?points" using 01 by auto next - case False def xi \ "Min ((\i. x$$i) ` {i. i x$$i \ 0})" - have "xi \ (\i. x$$i) ` {i. i x$$i \ 0}" unfolding xi_def apply(rule Min_in) using False by auto - then obtain i where i':"x$$i = xi" "x$$i \ 0" "ij. j x$$j > 0 \ x$$i \ x$$j" + case False def xi \ "Min ((\i. x\i) ` {i. i\Basis \ x\i \ 0})" + have "xi \ (\i. x\i) ` {i. i\Basis \ x\i \ 0}" unfolding xi_def apply(rule Min_in) using False by auto + then obtain i where i':"x\i = xi" "x\i \ 0" "i\Basis" by auto + have i:"\j. j\Basis \ x\j > 0 \ x\i \ x\j" unfolding i'(1) xi_def apply(rule_tac Min_le) unfolding image_iff defer apply(rule_tac x=j in bexI) using i' by auto - have i01:"x$$i \ 1" "x$$i > 0" using Suc(2)[unfolded mem_interval,rule_format,of i] - using i'(2-) `x$$i \ 0` by auto - show ?thesis proof(cases "x$$i=1") - case True have "\j\{i. i x$$i \ 0}. x$$j = 1" apply(rule, rule ccontr) unfolding mem_Collect_eq - proof(erule conjE) fix j assume as:"x $$ j \ 0" "x $$ j \ 1" "j {0<..<1}" using Suc(2) by(auto simp add: eucl_le[where 'a='a] elim!:allE[where x=j]) - hence "x$$j \ op $$ x ` {i. i x $$ i \ 0}" using as(3) by auto - hence "x$$j \ x$$i" unfolding i'(1) xi_def apply(rule_tac Min_le) by auto + have i01:"x\i \ 1" "x\i > 0" using Suc(2)[unfolded mem_interval,rule_format,of i] + using i'(2-) `x\i \ 0` by auto + show ?thesis proof(cases "x\i=1") + case True have "\j\{i. i\Basis \ x\i \ 0}. x\j = 1" apply(rule, rule ccontr) unfolding mem_Collect_eq + proof(erule conjE) fix j assume as:"x \ j \ 0" "x \ j \ 1" "j\Basis" + hence j:"x\j \ {0<..<1}" using Suc(2) + by (auto simp add: eucl_le[where 'a='a] elim!:allE[where x=j]) + hence "x\j \ op \ x ` {i. i\Basis \ x \ i \ 0}" using as(3) by auto + hence "x\j \ x\i" unfolding i'(1) xi_def apply(rule_tac Min_le) by auto thus False using True Suc(2) j by(auto simp add: elim!:ballE[where x=j]) qed thus "x\convex hull ?points" apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto - next let ?y = "\j. if x$$j = 0 then 0 else (x$$j - x$$i) / (1 - x$$i)" - case False hence *:"x = x$$i *\<^sub>R (\\ j. if x$$j = 0 then 0 else 1) + (1 - x$$i) *\<^sub>R (\\ j. ?y j)" - apply(subst euclidean_eq) by(auto simp add: field_simps) - { fix j assume j:"j 0 \ 0 \ (x $$ j - x $$ i) / (1 - x $$ i)" "(x $$ j - x $$ i) / (1 - x $$ i) \ 1" + next + let ?y = "\j\Basis. (if x\j = 0 then 0 else (x\j - x\i) / (1 - x\i)) *\<^sub>R j" + case False + then have *: "x = (x\i) *\<^sub>R (\j\Basis. (if x\j = 0 then 0 else 1) *\<^sub>R j) + (1 - x\i) *\<^sub>R ?y" + by (subst euclidean_eq_iff) (simp add: inner_simps) + { fix j :: 'a assume j:"j\Basis" + have "x\j \ 0 \ 0 \ (x \ j - x \ i) / (1 - x \ i)" "(x \ j - x \ i) / (1 - x \ i) \ 1" apply(rule_tac divide_nonneg_pos) using i(1)[of j] using False i01 using Suc(2)[unfolded mem_interval, rule_format, of j] using j - by(auto simp add:field_simps) - hence "0 \ ?y j \ ?y j \ 1" by auto } - moreover have "i\{j. j x$$j \ 0} - {j. j ((\\ j. ?y j)::'a) $$ j \ 0}" + by(auto simp add: field_simps) + with j have "0 \ ?y \ j \ ?y \ j \ 1" by (auto simp: inner_simps) } + moreover have "i\{j. j\Basis \ x\j \ 0} - {j. j\Basis \ ?y \ j \ 0}" using i01 using i'(3) by auto - hence "{j. j x$$j \ 0} \ {j. j ((\\ j. ?y j)::'a) $$ j \ 0}" using i'(3) by blast - hence **:"{j. j ((\\ j. ?y j)::'a) $$ j \ 0} \ {j. j x$$j \ 0}" apply - apply rule + hence "{j. j\Basis \ x\j \ 0} \ {j. j\Basis \ ?y \ j \ 0}" using i'(3) by blast + hence **:"{j. j\Basis \ ?y \ j \ 0} \ {j. j\Basis \ x\j \ 0}" by auto - have "card {j. j ((\\ j. ?y j)::'a) $$ j \ 0} \ n" + have "card {j. j\Basis \ ?y \ j \ 0} \ n" using less_le_trans[OF psubset_card_mono[OF _ **] Suc(4)] by auto - ultimately show ?thesis apply(subst *) apply(rule convex_convex_hull[unfolded convex_def, rule_format]) - apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) defer apply(rule Suc(1)) - unfolding mem_interval using i01 Suc(3) by auto - qed qed qed } note * = this - have **:"DIM('a) = card {..\ i. 1)::'a::ordered_euclidean_space} = convex hull s" - apply(rule that[of "{x::'a. \i x$$i=1}"]) - apply(rule finite_subset[of _ "(\s. (\\ i. if i\s then 1::real else 0)::'a) ` Pow {..Basis} = convex hull s" + apply(rule that[of "{x::'a. \i\Basis. x\i=0 \ x\i=1}"]) + apply(rule finite_subset[of _ "(\s. (\i\Basis. (if i\s then 1 else 0) *\<^sub>R i)::'a) ` Pow Basis"]) prefer 3 apply(rule unit_interval_convex_hull) apply rule unfolding mem_Collect_eq proof- - fix x::"'a" assume as:"\i x $$ i = 1" - show "x \ (\s. \\ i. if i \ s then 1 else 0) ` Pow {..i\Basis. x \ i = 0 \ x \ i = 1" + show "x \ (\s. \i\Basis. (if i\s then 1 else 0) *\<^sub>R i) ` Pow Basis" + apply(rule image_eqI[where x="{i. i\Basis \ x\i = 1}"]) + using as apply(subst euclidean_eq_iff) by (auto simp: inner_setsum_left_Basis) +qed auto text {* Hence any cube (could do any nonempty interval). *} lemma cube_convex_hull: assumes "0 < d" obtains s::"('a::ordered_euclidean_space) set" where - "finite s" "{x - (\\ i. d) .. x + (\\ i. d)} = convex hull s" proof- - let ?d = "(\\ i. d)::'a" - have *:"{x - ?d .. x + ?d} = (\y. x - ?d + (2 * d) *\<^sub>R y) ` {0 .. \\ i. 1}" apply(rule set_eqI, rule) + "finite s" "{x - (\i\Basis. d*\<^sub>Ri) .. x + (\i\Basis. d*\<^sub>Ri)} = convex hull s" proof- + let ?d = "(\i\Basis. d*\<^sub>Ri)::'a" + have *:"{x - ?d .. x + ?d} = (\y. x - ?d + (2 * d) *\<^sub>R y) ` {0 .. \Basis}" apply(rule set_eqI, rule) unfolding image_iff defer apply(erule bexE) proof- fix y assume as:"y\{x - ?d .. x + ?d}" - { fix i assume i:"i d + y $$ i" "y $$ i \ d + x $$ i" - using as[unfolded mem_interval, THEN spec[where x=i]] i - by auto - hence "1 \ inverse d * (x $$ i - y $$ i)" "1 \ inverse d * (y $$ i - x $$ i)" + { fix i :: 'a assume i:"i\Basis" have "x \ i \ d + y \ i" "y \ i \ d + x \ i" + using as[unfolded mem_interval, THEN bspec[where x=i]] i + by (auto simp: inner_simps) + hence "1 \ inverse d * (x \ i - y \ i)" "1 \ inverse d * (y \ i - x \ i)" apply(rule_tac[!] mult_left_le_imp_le[OF _ assms]) unfolding mult_assoc[symmetric] using assms by(auto simp add: field_simps) - hence "inverse d * (x $$ i * 2) \ 2 + inverse d * (y $$ i * 2)" - "inverse d * (y $$ i * 2) \ 2 + inverse d * (x $$ i * 2)" by(auto simp add:field_simps) } - hence "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \ {0..\\ i.1}" unfolding mem_interval using assms - by(auto simp add: field_simps) - thus "\z\{0..\\ i.1}. y = x - ?d + (2 * d) *\<^sub>R z" apply- apply(rule_tac x="inverse (2 * d) *\<^sub>R (y - (x - ?d))" in bexI) + hence "inverse d * (x \ i * 2) \ 2 + inverse d * (y \ i * 2)" + "inverse d * (y \ i * 2) \ 2 + inverse d * (x \ i * 2)" by(auto simp add:field_simps) } + hence "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \ {0..\Basis}" unfolding mem_interval using assms + by(auto simp add: field_simps inner_simps) + thus "\z\{0..\Basis}. y = x - ?d + (2 * d) *\<^sub>R z" apply- apply(rule_tac x="inverse (2 * d) *\<^sub>R (y - (x - ?d))" in bexI) using assms by auto next - fix y z assume as:"z\{0..\\ i.1}" "y = x - ?d + (2*d) *\<^sub>R z" - have "\i. i 0 \ d * z $$ i \ d * z $$ i \ d" - using assms as(1)[unfolded mem_interval] apply(erule_tac x=i in allE) + fix y z assume as:"z\{0..\Basis}" "y = x - ?d + (2*d) *\<^sub>R z" + have "\i. i\Basis \ 0 \ d * (z \ i) \ d * (z \ i) \ d" + using assms as(1)[unfolded mem_interval] apply(erule_tac x=i in ballE) apply rule apply(rule mult_nonneg_nonneg) prefer 3 apply(rule mult_right_le_one_le) using assms by auto thus "y \ {x - ?d..x + ?d}" unfolding as(2) mem_interval apply- apply rule using as(1)[unfolded mem_interval] - apply(erule_tac x=i in allE) using assms by auto qed - obtain s where "finite s" "{0::'a..\\ i.1} = convex hull s" using unit_cube_convex_hull by auto + apply(erule_tac x=i in ballE) using assms by (auto simp: inner_simps) qed + obtain s where "finite s" "{0::'a..\Basis} = convex hull s" using unit_cube_convex_hull by auto thus ?thesis apply(rule_tac that[of "(\y. x - ?d + (2 * d) *\<^sub>R y)` s"]) unfolding * and convex_hull_affinity by auto qed subsection {* Bounded convex function on open set is continuous *} @@ -4103,6 +4093,9 @@ subsubsection {* Hence a convex function on an open set is continuous *} +lemma real_of_nat_ge_one_iff: "1 \ real (n::nat) \ 1 \ n" + by auto + lemma convex_on_continuous: assumes "open (s::('a::ordered_euclidean_space) set)" "convex_on s f" (* FIXME: generalize to euclidean_space *) @@ -4113,29 +4106,40 @@ then obtain e where e:"cball x e \ s" "e>0" using assms(1) unfolding open_contains_cball by auto def d \ "e / real DIM('a)" have "0 < d" unfolding d_def using `e>0` dimge1 by(rule_tac divide_pos_pos, auto) - let ?d = "(\\ i. d)::'a" + let ?d = "(\i\Basis. d *\<^sub>R i)::'a" obtain c where c:"finite c" "{x - ?d..x + ?d} = convex hull c" using cube_convex_hull[OF `d>0`, of x] by auto - have "x\{x - ?d..x + ?d}" using `d>0` unfolding mem_interval by auto + have "x\{x - ?d..x + ?d}" using `d>0` unfolding mem_interval by (auto simp: inner_setsum_left_Basis inner_simps) hence "c\{}" using c by auto def k \ "Max (f ` c)" - have "convex_on {x - ?d..x + ?d} f" apply(rule convex_on_subset[OF assms(2)]) - apply(rule subset_trans[OF _ e(1)]) unfolding subset_eq mem_cball proof + have "convex_on {x - ?d..x + ?d} f" + apply(rule convex_on_subset[OF assms(2)]) + apply(rule subset_trans[OF _ e(1)]) + unfolding subset_eq mem_cball + proof fix z assume z:"z\{x - ?d..x + ?d}" - have e:"e = setsum (\i. d) {..i::'a. d) Basis" unfolding setsum_constant d_def using dimge1 unfolding real_eq_of_nat by auto show "dist x z \ e" unfolding dist_norm e apply(rule_tac order_trans[OF norm_le_l1], rule setsum_mono) - using z[unfolded mem_interval] apply(erule_tac x=i in allE) by auto qed + using z[unfolded mem_interval] apply(erule_tac x=b in ballE) by (auto simp: inner_simps) + qed hence k:"\y\{x - ?d..x + ?d}. f y \ k" unfolding c(2) apply(rule_tac convex_on_convex_hull_bound) apply assumption unfolding k_def apply(rule, rule Max_ge) using c(1) by auto - have "d \ e" unfolding d_def apply(rule mult_imp_div_pos_le) using `e>0` dimge1 unfolding mult_le_cancel_left1 by auto + have "d \ e" + unfolding d_def + apply(rule mult_imp_div_pos_le) + using `e>0` + unfolding mult_le_cancel_left1 + apply (auto simp: real_of_nat_ge_one_iff Suc_le_eq DIM_positive) + done hence dsube:"cball x d \ cball x e" unfolding subset_eq Ball_def mem_cball by auto have conv:"convex_on (cball x d) f" apply(rule convex_on_subset, rule convex_on_subset[OF assms(2)]) apply(rule e(1)) using dsube by auto hence "\y\cball x d. abs (f y) \ k + 2 * abs (f x)" apply(rule_tac convex_bounds_lemma) apply assumption proof fix y assume y:"y\cball x d" - { fix i assume "i y $$ i" "y $$ i \ x $$ i + d" - using order_trans[OF component_le_norm y[unfolded mem_cball dist_norm], of i] by auto } + { fix i :: 'a assume "i\Basis" hence "x \ i - d \ y \ i" "y \ i \ x \ i + d" + using order_trans[OF Basis_le_norm y[unfolded mem_cball dist_norm], of i] by (auto simp: inner_diff_left) } thus "f y \ k" apply(rule_tac k[rule_format]) unfolding mem_cball mem_interval dist_norm - by auto qed + by (auto simp: inner_simps) + qed hence "continuous_on (ball x d) f" apply(rule_tac convex_on_bounded_continuous) apply(rule open_ball, rule convex_on_subset[OF conv], rule ball_subset_cball) apply force @@ -4266,25 +4270,26 @@ have "norm (a - x) / norm (a - b) \ 1" unfolding divide_le_eq_1_pos[OF Fal2] unfolding as[unfolded dist_norm] norm_ge_zero by auto thus "\u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \ 0 \ u \ u \ 1" apply(rule_tac x="dist a x / dist a b" in exI) - unfolding dist_norm apply(subst euclidean_eq) apply rule defer apply(rule, rule divide_nonneg_pos) prefer 4 - proof(rule,rule) fix i assume i:"iR a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $$ i = - ((norm (a - b) - norm (a - x)) * (a $$ i) + norm (a - x) * (b $$ i)) / norm (a - b)" - using Fal by(auto simp add: field_simps) - also have "\ = x$$i" apply(rule divide_eq_imp[OF Fal]) + unfolding dist_norm apply(subst euclidean_eq_iff) apply rule defer apply(rule, rule divide_nonneg_pos) prefer 4 + proof(rule) fix i :: 'a assume i:"i\Basis" + have "((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) \ i = + ((norm (a - b) - norm (a - x)) * (a \ i) + norm (a - x) * (b \ i)) / norm (a - b)" + using Fal by(auto simp add: field_simps inner_simps) + also have "\ = x\i" apply(rule divide_eq_imp[OF Fal]) unfolding as[unfolded dist_norm] using as[unfolded dist_triangle_eq] apply- - apply(subst (asm) euclidean_eq) using i apply(erule_tac x=i in allE) by(auto simp add:field_simps) - finally show "x $$ i = ((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $$ i" + apply(subst (asm) euclidean_eq_iff) using i apply(erule_tac x=i in ballE) by(auto simp add:field_simps inner_simps) + finally show "x \ i = ((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) \ i" by auto - qed(insert Fal2, auto) qed qed + qed(insert Fal2, auto) qed +qed lemma between_midpoint: fixes a::"'a::euclidean_space" shows "between (a,b) (midpoint a b)" (is ?t1) "between (b,a) (midpoint a b)" (is ?t2) proof- have *:"\x y z. x = (1/2::real) *\<^sub>R z \ y = (1/2) *\<^sub>R z \ norm z = norm x + norm y" by auto show ?t1 ?t2 unfolding between midpoint_def dist_norm apply(rule_tac[!] *) - unfolding euclidean_eq[where 'a='a] - by(auto simp add:field_simps) qed + unfolding euclidean_eq_iff[where 'a='a] + by(auto simp add:field_simps inner_simps) qed lemma between_mem_convex_hull: "between (a,b) x \ x \ convex hull {a,b}" @@ -4303,7 +4308,7 @@ have *:"y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x" using `e>0` by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib) have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = abs(1/e) * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)" unfolding dist_norm unfolding norm_scaleR[symmetric] apply(rule arg_cong[where f=norm]) using `e>0` - by(auto simp add: euclidean_eq[where 'a='a] field_simps) + by(auto simp add: euclidean_eq_iff[where 'a='a] field_simps inner_simps) also have "\ = abs(1/e) * norm (x - e *\<^sub>R (x - c) - y)" by(auto intro!:arg_cong[where f=norm] simp add: algebra_simps) also have "\ < d" using as[unfolded dist_norm] and `e>0` by(auto simp add:pos_divide_less_eq[OF `e>0`] mult_commute) @@ -4347,236 +4352,237 @@ apply(rule_tac x=u in exI) defer apply(rule_tac x="\x. if x = 0 then 1 - setsum u s else u x" in exI) using assms(2) unfolding if_smult and setsum_delta_notmem[OF assms(2)] by auto -lemma substd_simplex: assumes "d\{.. x$$i = 0)}" +lemma substd_simplex: + assumes d: "d \ Basis" + shows "convex hull (insert 0 d) = {x. (\i\Basis. 0 \ x\i) \ (\i\d. x\i) \ 1 \ (\i\Basis. i \ d --> x\i = 0)}" (is "convex hull (insert 0 ?p) = ?s") -(* Proof is a modified copy of the proof of similar lemma std_simplex in Convex_Euclidean_Space.thy *) -proof- let ?D = d (*"{.. ?D} = basis ` ?D" by auto - note sumbas = this setsum_reindex[OF basis_inj_on[of d], unfolded o_def, OF assms] - show ?thesis unfolding simplex[OF finite_substdbasis `0 ~: ?p`] + from d have "finite d" by (blast intro: finite_subset finite_Basis) + show ?thesis unfolding simplex[OF `finite d` `0 ~: ?p`] apply(rule set_eqI) unfolding mem_Collect_eq apply rule apply(erule exE, (erule conjE)+) apply(erule_tac[2] conjE)+ proof- - fix x::"'a::euclidean_space" and u assume as: "\x\{basis i |i. i \?D}. 0 \ u x" - "setsum u {basis i |i. i \ ?D} \ 1" "(\x\{basis i |i. i \?D}. u x *\<^sub>R x) = x" - have *:"\i u (basis i) = x$$i" and "(!i x $$ i = 0)" using as(3) - unfolding sumbas unfolding substdbasis_expansion_unique[OF assms] by auto - hence **:"setsum u {basis i |i. i \ ?D} = setsum (op $$ x) ?D" unfolding sumbas + fix x::"'a::euclidean_space" and u assume as: "\x\?D. 0 \ u x" + "setsum u ?D \ 1" "(\x\?D. u x *\<^sub>R x) = x" + have *:"\i\Basis. i:d --> u i = x\i" and "(\i\Basis. i ~: d --> x \ i = 0)" using as(3) + unfolding substdbasis_expansion_unique[OF assms] by auto + hence **:"setsum u ?D = setsum (op \ x) ?D" apply-apply(rule setsum_cong2) using assms by auto - have " (\i x$$i) \ setsum (op $$ x) ?D \ 1" - apply - proof(rule,rule,rule) - fix i assume i:"i 0 \ x$$i" unfolding *[rule_format,OF i,symmetric] + have " (\i\Basis. 0 \ x\i) \ setsum (op \ x) ?D \ 1" + apply - proof(rule,rule) + fix i :: 'a assume i:"i\Basis" have "i : d ==> 0 \ x\i" unfolding *[rule_format,OF i,symmetric] apply(rule_tac as(1)[rule_format]) by auto - moreover have "i ~: d ==> 0 \ x$$i" - using `(!i x $$ i = 0)`[rule_format, OF i] by auto - ultimately show "0 \ x$$i" by auto + moreover have "i ~: d ==> 0 \ x\i" + using `(\i\Basis. i ~: d --> x \ i = 0)`[rule_format, OF i] by auto + ultimately show "0 \ x\i" by auto qed(insert as(2)[unfolded **], auto) - from this show " (\i x$$i) \ setsum (op $$ x) ?D \ 1 & (!i x $$ i = 0)" - using `(!i x $$ i = 0)` by auto - next fix x::"'a::euclidean_space" assume as:"\i x $$ i" "setsum (op $$ x) ?D \ 1" - "(!i x $$ i = 0)" - show "\u. (\x\{basis i |i. i \ ?D}. 0 \ u x) \ - setsum u {basis i |i. i \ ?D} \ 1 \ (\x\{basis i |i. i \ ?D}. u x *\<^sub>R x) = x" - apply(rule_tac x="\y. inner y x" in exI) apply(rule,rule) unfolding mem_Collect_eq apply(erule exE) - using as(1) apply(erule_tac x=i in allE) unfolding sumbas apply safe unfolding not_less basis_zero - unfolding substdbasis_expansion_unique[OF assms] euclidean_component_def[symmetric] - using as(2,3) by(auto simp add:dot_basis not_less) - qed qed + from this show " (\i\Basis. 0 \ x\i) \ setsum (op \ x) ?D \ 1 & (\i\Basis. i ~: d --> x \ i = 0)" + using `(\i\Basis. i ~: d --> x \ i = 0)` by auto + next fix x::"'a::euclidean_space" assume as:"\i\Basis. 0 \ x \ i" "setsum (op \ x) ?D \ 1" + "(\i\Basis. i ~: d --> x \ i = 0)" + show "\u. (\x\?D. 0 \ u x) \ setsum u ?D \ 1 \ (\x\?D. u x *\<^sub>R x) = x" + using as d unfolding substdbasis_expansion_unique[OF assms] + by (rule_tac x="inner x" in exI) auto + qed +qed lemma std_simplex: - "convex hull (insert 0 { basis i | i. ii x$$i) \ setsum (\i. x$$i) {.. 1 }" - using substd_simplex[of "{..i\Basis. 0 \ x\i) \ setsum (\i. x\i) Basis \ 1 }" + using substd_simplex[of Basis] by auto lemma interior_std_simplex: - "interior (convex hull (insert 0 { basis i| i. ii setsum (\i. x$$i) {..i\Basis. 0 < x\i) \ setsum (\i. x\i) Basis < 1 }" apply(rule set_eqI) unfolding mem_interior std_simplex unfolding subset_eq mem_Collect_eq Ball_def mem_ball unfolding Ball_def[symmetric] apply rule apply(erule exE, (erule conjE)+) defer apply(erule conjE) proof- - fix x::"'a" and e assume "0xa. dist x xa < e \ (\x xa $$ x) \ setsum (op $$ xa) {.. 1" - show "(\xa setsum (op $$ x) {..0` - unfolding dist_norm by (auto elim!:allE[where x=i]) - next have **:"dist x (x + (e / 2) *\<^sub>R basis 0) < e" using `e>0` - unfolding dist_norm by(auto intro!: mult_strict_left_mono) - have "\i. i (x + (e / 2) *\<^sub>R basis 0) $$ i = x$$i + (if i = 0 then e/2 else 0)" - by auto - hence *:"setsum (op $$ (x + (e / 2) *\<^sub>R basis 0)) {..i. x$$i + (if 0 = i then e/2 else 0)) {..xa. dist x xa < e \ (\x\Basis. 0 \ xa \ x) \ setsum (op \ xa) Basis \ 1" + show "(\xa\Basis. 0 < x \ xa) \ setsum (op \ x) Basis < 1" apply(safe) proof- + fix i :: 'a assume i:"i\Basis" thus "0 < x \ i" using as[THEN spec[where x="x - (e / 2) *\<^sub>R i"]] and `e>0` + unfolding dist_norm + by (auto elim!:ballE[where x=i] simp: inner_simps) + next have **:"dist x (x + (e / 2) *\<^sub>R (SOME i. i\Basis)) < e" using `e>0` + unfolding dist_norm by(auto intro!: mult_strict_left_mono simp: SOME_Basis) + have "\i. i\Basis \ (x + (e / 2) *\<^sub>R (SOME i. i\Basis)) \ i = x\i + (if i = (SOME i. i\Basis) then e/2 else 0)" + by (auto simp: SOME_Basis inner_Basis inner_simps) + hence *:"setsum (op \ (x + (e / 2) *\<^sub>R (SOME i. i\Basis))) Basis = setsum (\i. x\i + (if (SOME i. i\Basis) = i then e/2 else 0)) Basis" apply(rule_tac setsum_cong) by auto - have "setsum (op $$ x) {..R basis 0)) {.. x) Basis < setsum (op \ (x + (e / 2) *\<^sub>R (SOME i. i\Basis))) Basis" unfolding * setsum_addf + using `0 \ 1" using ** apply(drule_tac as[rule_format]) by auto - finally show "setsum (op $$ x) {..i x) Basis < 1" by auto qed +next fix x::"'a" assume as:"\i\Basis. 0 < x \ i" "setsum (op \ x) Basis < 1" guess a using UNIV_witness[where 'a='b] .. - let ?d = "(1 - setsum (op $$ x) {.. 0" apply(rule Min_grI) using as(1) by auto - moreover have"?d > 0" apply(rule divide_pos_pos) using as(2) by(auto simp add: Suc_le_eq) - ultimately show "\e>0. \y. dist x y < e \ (\i y $$ i) \ setsum (op $$ y) {.. 1" - apply(rule_tac x="min (Min ((op $$ x) ` {.. setsum (\i. x$$i + ?d) {..{.. x $$ i + ?d" by auto qed + let ?d = "(1 - setsum (op \ x) Basis) / real (DIM('a))" + have "Min ((op \ x) ` Basis) > 0" apply(rule Min_grI) using as(1) by auto + moreover have"?d > 0" apply(rule divide_pos_pos) using as(2) by (auto simp add: Suc_le_eq DIM_positive) + ultimately show "\e>0. \y. dist x y < e \ (\i\Basis. 0 \ y \ i) \ setsum (op \ y) Basis \ 1" + apply(rule_tac x="min (Min ((op \ x) ` Basis)) ?D" in exI) apply rule defer apply(rule,rule) proof- + fix y assume y:"dist x y < min (Min (op \ x ` Basis)) ?d" + have "setsum (op \ y) Basis \ setsum (\i. x\i + ?d) Basis" proof(rule setsum_mono) + fix i :: 'a assume i: "i\Basis" hence "abs (y\i - x\i) < ?d" apply-apply(rule le_less_trans) + using Basis_le_norm[OF i, of "y - x"] + using y[unfolded min_less_iff_conj dist_norm, THEN conjunct2] by(auto simp add: norm_minus_commute inner_diff_left) + thus "y \ i \ x \ i + ?d" by auto qed also have "\ \ 1" unfolding setsum_addf setsum_constant real_eq_of_nat by(auto simp add: Suc_le_eq) - finally show "(\i y $$ i) \ setsum (op $$ y) {.. 1" - proof safe fix i assume i:"ii\Basis. 0 \ y \ i) \ setsum (op \ y) Basis \ 1" + proof safe fix i :: 'a assume i:"i\Basis" + have "norm (x - y) < x\i" apply(rule less_le_trans) apply(rule y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]) using i by auto - thus "0 \ y$$i" using component_le_norm[of "x - y" i] and as(1)[rule_format, of i] by auto + thus "0 \ y\i" using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format, OF i] + by (auto simp: inner_simps) qed qed auto qed lemma interior_std_simplex_nonempty: obtains a::"'a::euclidean_space" where - "a \ interior(convex hull (insert 0 {basis i | i . ij. if i = j then inverse (2 * real DIM('a)) else 0) ?D"]) apply(rule setsum_cong2) - defer apply(subst setsum_delta') unfolding euclidean_component_def using i by(auto simp add:dot_basis) } + "a \ interior(convex hull (insert 0 Basis))" proof- + let ?D = "Basis :: 'a set" let ?a = "setsum (\b::'a. inverse (2 * real DIM('a)) *\<^sub>R b) Basis" + { fix i :: 'a assume i:"i\Basis" have "?a \ i = inverse (2 * real DIM('a))" + by (rule trans[of _ "setsum (\j. if i = j then inverse (2 * real DIM('a)) else 0) ?D"]) + (simp_all add: setsum_cases i) } note ** = this show ?thesis apply(rule that[of ?a]) unfolding interior_std_simplex mem_Collect_eq proof safe - fix i assume i:"ii. inverse (2 * real DIM('a))) ?D" apply(rule setsum_cong2, rule **) by auto + fix i :: 'a assume i:"i\Basis" show "0 < ?a \ i" unfolding **[OF i] by(auto simp add: Suc_le_eq DIM_positive) + next have "setsum (op \ ?a) ?D = setsum (\i. inverse (2 * real DIM('a))) ?D" apply(rule setsum_cong2, rule **) by auto also have "\ < 1" unfolding setsum_constant real_eq_of_nat divide_inverse[symmetric] by (auto simp add:field_simps) - finally show "setsum (op $$ ?a) ?D < 1" by auto qed qed - -lemma rel_interior_substd_simplex: assumes "d\{..i\d. 0 < x$$i) & setsum (%i. x$$i) d < 1 & (!i x$$i = 0)}" + finally show "setsum (op \ ?a) ?D < 1" by auto qed qed + +lemma rel_interior_substd_simplex: assumes d: "d\Basis" + shows "rel_interior (convex hull (insert 0 d)) = + {x::'a::euclidean_space. (\i\d. 0 < x\i) \ (\i\d. x\i) < 1 \ (\i\Basis. i ~: d --> x\i = 0)}" (is "rel_interior (convex hull (insert 0 ?p)) = ?s") (* Proof is a modified copy of the proof of similar lemma interior_std_simplex in Convex_Euclidean_Space.thy *) proof- have "finite d" apply(rule finite_subset) using assms by auto -{ assume "d={}" hence ?thesis using rel_interior_sing using euclidean_eq[of _ 0] by auto } +{ assume "d={}" hence ?thesis using rel_interior_sing using euclidean_eq_iff[of _ 0] by auto } moreover { assume "d~={}" -have h0: "affine hull (convex hull (insert 0 ?p))={x::'a::euclidean_space. (!i x$$i = 0)}" +have h0: "affine hull (convex hull (insert 0 ?p))={x::'a::euclidean_space. (\i\Basis. i ~: d --> x\i = 0)}" using affine_hull_convex_hull affine_hull_substd_basis assms by auto -have aux: "!x::'n::euclidean_space. !i. ((! i:d. 0 <= x$$i) & (!i. i ~: d --> x$$i = 0))--> 0 <= x$$i" by auto +have aux: "!!x::'a. \i\Basis. ((\i\d. 0 \ x\i) \ (\i\Basis. i \ d \ x\i = 0)) \ 0 \ x\i" + by auto { fix x::"'a::euclidean_space" assume x_def: "x : rel_interior (convex hull (insert 0 ?p))" from this obtain e where e0: "e>0" and - "ball x e Int {xa. (!i xa$$i = 0)} <= convex hull (insert 0 ?p)" + "ball x e Int {xa. (\i\Basis. i ~: d --> xa\i = 0)} <= convex hull (insert 0 ?p)" using mem_rel_interior_ball[of x "convex hull (insert 0 ?p)"] h0 by auto - hence as: "ALL xa. (dist x xa < e & (!i xa$$i = 0)) --> - (!i : d. 0 <= xa $$ i) & setsum (op $$ xa) d <= 1" + hence as: "ALL xa. (dist x xa < e & (\i\Basis. i ~: d --> xa\i = 0)) --> + (!i : d. 0 <= xa \ i) & setsum (op \ xa) d <= 1" unfolding ball_def unfolding substd_simplex[OF assms] using assms by auto - have x0: "(!i x$$i = 0)" + have x0: "(\i\Basis. i ~: d --> x\i = 0)" using x_def rel_interior_subset substd_simplex[OF assms] by auto - have "(!i : d. 0 < x $$ i) & setsum (op $$ x) d < 1 & (!i x$$i = 0)" apply(rule,rule) + have "(\i\d. 0 < x \ i) & setsum (op \ x) d < 1 & (\i\Basis. i ~: d --> x\i = 0)" apply(rule,rule) proof- - fix i::nat assume "i:d" - hence "\ia\d. 0 \ (x - (e / 2) *\<^sub>R basis i) $$ ia" apply-apply(rule as[rule_format,THEN conjunct1]) - unfolding dist_norm using assms `e>0` x0 by auto - thus "0 < x $$ i" apply(erule_tac x=i in ballE) using `e>0` `i\d` assms by auto + fix i::'a assume "i\d" + hence "\ia\d. 0 \ (x - (e / 2) *\<^sub>R i) \ ia" apply-apply(rule as[rule_format,THEN conjunct1]) + unfolding dist_norm using d `e>0` x0 by (auto simp: inner_simps inner_Basis) + thus "0 < x \ i" apply(erule_tac x=i in ballE) using `e>0` `i\d` d + by (auto simp: inner_simps inner_Basis) next obtain a where a:"a:d" using `d ~= {}` by auto - have **:"dist x (x + (e / 2) *\<^sub>R basis a) < e" - using `e>0` and Euclidean_Space.norm_basis[of a] + then have **:"dist x (x + (e / 2) *\<^sub>R a) < e" + using `e>0` norm_Basis[of a] d unfolding dist_norm by auto - have "\i. (x + (e / 2) *\<^sub>R basis a) $$ i = x$$i + (if i = a then e/2 else 0)" - unfolding euclidean_simps using a assms by auto - hence *:"setsum (op $$ (x + (e / 2) *\<^sub>R basis a)) d = - setsum (\i. x$$i + (if a = i then e/2 else 0)) d" by(rule_tac setsum_cong, auto) - have h1: "(ALL i (x + (e / 2) *\<^sub>R basis a) $$ i = 0)" - using as[THEN spec[where x="x + (e / 2) *\<^sub>R basis a"]] `a:d` using x0 - by(auto elim:allE[where x=a]) - have "setsum (op $$ x) d < setsum (op $$ (x + (e / 2) *\<^sub>R basis a)) d" unfolding * setsum_addf + have "\i. i\Basis \ (x + (e / 2) *\<^sub>R a) \ i = x\i + (if i = a then e/2 else 0)" + using a d by (auto simp: inner_simps inner_Basis) + hence *:"setsum (op \ (x + (e / 2) *\<^sub>R a)) d = + setsum (\i. x\i + (if a = i then e/2 else 0)) d" using d by (intro setsum_cong) auto + have "a \ Basis" using `a \ d` d by auto + then have h1: "(\i\Basis. i ~: d --> (x + (e / 2) *\<^sub>R a) \ i = 0)" + using x0 d `a\d` by (auto simp add: inner_add_left inner_Basis) + have "setsum (op \ x) d < setsum (op \ (x + (e / 2) *\<^sub>R a)) d" unfolding * setsum_addf using `0 \ 1" using ** h1 as[rule_format, of "x + (e / 2) *\<^sub>R basis a"] by auto - finally show "setsum (op $$ x) d < 1 & (!i x$$i = 0)" using x0 by auto + also have "\ \ 1" using ** h1 as[rule_format, of "x + (e / 2) *\<^sub>R a"] by auto + finally show "setsum (op \ x) d < 1 & (\i\Basis. i ~: d --> x\i = 0)" using x0 by auto qed } moreover { fix x::"'a::euclidean_space" assume as: "x : ?s" - have "!i. ((0 0<=x$$i)" by auto + have "!i. ((0i) | (0=x\i) --> 0<=x\i)" by auto moreover have "!i. (i:d) | (i ~: d)" by auto ultimately - have "!i. ( (ALL i:d. 0 < x$$i) & (ALL i. i ~: d --> x$$i = 0) ) --> 0 <= x$$i" by metis + have "!i. ( (ALL i:d. 0 < x\i) & (ALL i. i ~: d --> x\i = 0) ) --> 0 <= x\i" by metis hence h2: "x : convex hull (insert 0 ?p)" using as assms unfolding substd_simplex[OF assms] by fastforce obtain a where a:"a:d" using `d ~= {}` by auto - let ?d = "(1 - setsum (op $$ x) d) / real (card d)" + let ?d = "(1 - setsum (op \ x) d) / real (card d)" have "0 < card d" using `d ~={}` `finite d` by (simp add: card_gt_0_iff) - have "Min ((op $$ x) ` d) > 0" using as `d \ {}` `finite d` by (simp add: Min_grI) + have "Min ((op \ x) ` d) > 0" using as `d \ {}` `finite d` by (simp add: Min_grI) moreover have "?d > 0" apply(rule divide_pos_pos) using as using `0 < card d` by auto - ultimately have h3: "min (Min ((op $$ x) ` d)) ?d > 0" by auto + ultimately have h3: "min (Min ((op \ x) ` d)) ?d > 0" by auto have "x : rel_interior (convex hull (insert 0 ?p))" unfolding rel_interior_ball mem_Collect_eq h0 apply(rule,rule h2) unfolding substd_simplex[OF assms] - apply(rule_tac x="min (Min ((op $$ x) ` d)) ?d" in exI) apply(rule,rule h3) apply safe unfolding mem_ball - proof- fix y::'a assume y:"dist x y < min (Min (op $$ x ` d)) ?d" and y2:"(!i y$$i = 0)" - have "setsum (op $$ y) d \ setsum (\i. x$$i + ?d) d" proof(rule setsum_mono) - fix i assume i:"i\d" - have "abs (y$$i - x$$i) < ?d" apply(rule le_less_trans) using component_le_norm[of "y - x" i] + apply(rule_tac x="min (Min ((op \ x) ` d)) ?d" in exI) apply(rule,rule h3) apply safe unfolding mem_ball + proof- + fix y::'a assume y:"dist x y < min (Min (op \ x ` d)) ?d" and y2: "\i\Basis. i \ d \ y\i = 0" + have "setsum (op \ y) d \ setsum (\i. x\i + ?d) d" + proof(rule setsum_mono) + fix i assume "i \ d" + with d have i: "i \ Basis" by auto + have "abs (y\i - x\i) < ?d" apply(rule le_less_trans) using Basis_le_norm[OF i, of "y - x"] using y[unfolded min_less_iff_conj dist_norm, THEN conjunct2] - by(auto simp add: norm_minus_commute) - thus "y $$ i \ x $$ i + ?d" by auto qed + by (auto simp add: norm_minus_commute inner_simps) + thus "y \ i \ x \ i + ?d" by auto + qed also have "\ \ 1" unfolding setsum_addf setsum_constant real_eq_of_nat using `0 < card d` by auto - finally show "setsum (op $$ y) d \ 1" . - - fix i assume "i y$$i" + finally show "setsum (op \ y) d \ 1" . + + fix i :: 'a assume i: "i \ Basis" thus "0 \ y\i" proof(cases "i\d") case True - have "norm (x - y) < x$$i" using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1] - using Min_gr_iff[of "op $$ x ` d" "norm (x - y)"] `0 < card d` `i:d` + have "norm (x - y) < x\i" using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1] + using Min_gr_iff[of "op \ x ` d" "norm (x - y)"] `0 < card d` `i:d` by (simp add: card_gt_0_iff) - thus "0 \ y$$i" using component_le_norm[of "x - y" i] and as(1)[rule_format] by auto + thus "0 \ y\i" using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format] + by (auto simp: inner_simps) qed(insert y2, auto) qed } ultimately have - "!!x :: 'a::euclidean_space. (x : rel_interior (convex hull insert 0 {basis i |i. i : d})) = - (x : {x. (ALL i:d. 0 < x $$ i) & - setsum (op $$ x) d < 1 & (ALL i x $$ i = 0)})" by blast + "\x. (x : rel_interior (convex hull insert 0 d)) = (x \ {x. (ALL i:d. 0 < x \ i) & + setsum (op \ x) d < 1 & (\i\Basis. i ~: d --> x \ i = 0)})" by blast from this have ?thesis by (rule set_eqI) } ultimately show ?thesis by blast qed -lemma rel_interior_substd_simplex_nonempty: assumes "d ~={}" "d\{..Basis" obtains a::"'a::euclidean_space" where - "a : rel_interior(convex hull (insert 0 {basis i | i . i : d}))" proof- + "a : rel_interior(convex hull (insert 0 d))" proof- (* Proof is a modified copy of the proof of similar lemma interior_std_simplex_nonempty in Convex_Euclidean_Space.thy *) - let ?D = d let ?a = "setsum (\b::'a::euclidean_space. inverse (2 * real (card d)) *\<^sub>R b) {(basis i) | i. i \ ?D}" - have *:"{basis i :: 'a | i. i \ ?D} = basis ` ?D" by auto + let ?D = d let ?a = "setsum (\b::'a::euclidean_space. inverse (2 * real (card d)) *\<^sub>R b) ?D" have "finite d" apply(rule finite_subset) using assms(2) by auto hence d1: "0 < real(card d)" using `d ~={}` by auto - { fix i assume "i:d" have "?a $$ i = inverse (2 * real (card d))" - unfolding * setsum_reindex[OF basis_inj_on, OF assms(2)] o_def + { fix i assume "i:d" + have "?a \ i = inverse (2 * real (card d))" apply(rule trans[of _ "setsum (\j. if i = j then inverse (2 * real (card d)) else 0) ?D"]) - unfolding euclidean_component_setsum + unfolding inner_setsum_left apply(rule setsum_cong2) using `i:d` `finite d` setsum_delta'[of d i "(%k. inverse (2 * real (card d)))"] d1 assms(2) - by (auto simp add: Euclidean_Space.basis_component[of i])} + by (auto simp: inner_simps inner_Basis set_rev_mp[OF _ assms(2)]) } note ** = this show ?thesis apply(rule that[of ?a]) unfolding rel_interior_substd_simplex[OF assms(2)] mem_Collect_eq proof safe fix i assume "i:d" have "0 < inverse (2 * real (card d))" using d1 by auto - also have "...=?a $$ i" using **[of i] `i:d` by auto - finally show "0 < ?a $$ i" by auto - next have "setsum (op $$ ?a) ?D = setsum (\i. inverse (2 * real (card d))) ?D" + also have "...=?a \ i" using **[of i] `i:d` by auto + finally show "0 < ?a \ i" by auto + next have "setsum (op \ ?a) ?D = setsum (\i. inverse (2 * real (card d))) ?D" by(rule setsum_cong2, rule **) also have "\ < 1" unfolding setsum_constant real_eq_of_nat divide_real_def[symmetric] by (auto simp add:field_simps) - finally show "setsum (op $$ ?a) ?D < 1" by auto - next fix i assume "iR (2 * real (card d)))" "{basis i |i. i : d}"]) - using finite_substdbasis[of d] apply blast + finally show "setsum (op \ ?a) ?D < 1" by auto + next fix i assume "i\Basis" and "i~:d" + have "?a : (span d)" + apply (rule span_setsum[of d "(%b. b /\<^sub>R (2 * real (card d)))" d]) + using finite_subset[OF assms(2) finite_Basis] + apply blast proof- - { fix x assume "(x :: 'a::euclidean_space): {basis i |i. i : d}" - hence "x : span {basis i |i. i : d}" - using span_superset[of _ "{basis i |i. i : d}"] by auto - hence "(x /\<^sub>R (2 * real (card d))) : (span {basis i |i. i : d})" - using span_mul[of x "{basis i |i. i : d}" "(inverse (real (card d)) / 2)"] by auto - } thus "\x\{basis i |i. i \ d}. x /\<^sub>R (2 * real (card d)) \ span {basis i ::'a |i. i \ d}" by auto + { fix x assume "(x :: 'a::euclidean_space): d" + hence "x : span d" + using span_superset[of _ "d"] by auto + hence "(x /\<^sub>R (2 * real (card d))) : (span d)" + using span_mul[of x "d" "(inverse (real (card d)) / 2)"] by auto + } thus "\x\d. x /\<^sub>R (2 * real (card d)) \ span d" by auto qed - thus "?a $$ i = 0 " using `i~:d` unfolding span_substd_basis[OF assms(2)] using `i i = 0 " using `i~:d` unfolding span_substd_basis[OF assms(2)] using `i\Basis` by auto qed qed @@ -4608,14 +4614,14 @@ ultimately have **: "affine hull (convex hull insert 0 B) = affine hull S" using affine_hull_span_0[of "convex hull insert 0 B"] affine_hull_span_0[of "S"] assms hull_subset[of S] by auto -obtain d and f::"'n=>'n" where fd: "card d = card B & linear f & f ` B = {basis i |i. i : (d :: nat set)} & - f ` span B = {x. ALL i x $$ i = (0::real)} & inj_on f (span B)" and d:"d\{..'n" where fd: "card d = card B & linear f & f ` B = d & + f ` span B = {x. \i\Basis. i ~: d --> x \ i = (0::real)} & inj_on f (span B)" and d:"d\Basis" using basis_to_substdbasis_subspace_isomorphism[of B,OF _ ] B_def by auto hence "bounded_linear f" using linear_conv_bounded_linear by auto have "d ~={}" using fd B_def `B ~={}` by auto -have "(insert 0 {basis i |i. i : d}) = f ` (insert 0 B)" using fd linear_0 by auto -hence "(convex hull (insert 0 {basis i |i. i : d})) = f ` (convex hull (insert 0 B))" - using convex_hull_linear_image[of f "(insert 0 {basis i |i. i : d})"] +have "(insert 0 d) = f ` (insert 0 B)" using fd linear_0 by auto +hence "(convex hull (insert 0 d)) = f ` (convex hull (insert 0 B))" + using convex_hull_linear_image[of f "(insert 0 d)"] convex_hull_linear_image[of f "(insert 0 B)"] `bounded_linear f` by auto moreover have "rel_interior (f ` (convex hull insert 0 B)) = f ` rel_interior (convex hull insert 0 B)"