diff -r 191bb458b95c -r f95193669ad7 src/HOL/Analysis/Starlike.thy --- a/src/HOL/Analysis/Starlike.thy Tue Aug 27 23:12:28 2019 +0200 +++ b/src/HOL/Analysis/Starlike.thy Wed Aug 28 00:08:14 2019 +0200 @@ -3357,6 +3357,246 @@ then show "?lhs \ ?rhs" by blast qed +proposition ray_to_rel_frontier: + fixes a :: "'a::real_inner" + assumes "bounded S" + and a: "a \ rel_interior S" + and aff: "(a + l) \ affine hull S" + and "l \ 0" + obtains d where "0 < d" "(a + d *\<^sub>R l) \ rel_frontier S" + "\e. \0 \ e; e < d\ \ (a + e *\<^sub>R l) \ rel_interior S" +proof - + have aaff: "a \ affine hull S" + by (meson a hull_subset rel_interior_subset rev_subsetD) + let ?D = "{d. 0 < d \ a + d *\<^sub>R l \ rel_interior S}" + obtain B where "B > 0" and B: "S \ ball a B" + using bounded_subset_ballD [OF \bounded S\] by blast + have "a + (B / norm l) *\<^sub>R l \ ball a B" + by (simp add: dist_norm \l \ 0\) + with B have "a + (B / norm l) *\<^sub>R l \ rel_interior S" + using rel_interior_subset subsetCE by blast + with \B > 0\ \l \ 0\ have nonMT: "?D \ {}" + using divide_pos_pos zero_less_norm_iff by fastforce + have bdd: "bdd_below ?D" + by (metis (no_types, lifting) bdd_belowI le_less mem_Collect_eq) + have relin_Ex: "\x. x \ rel_interior S \ + \e>0. \x'\affine hull S. dist x' x < e \ x' \ rel_interior S" + using openin_rel_interior [of S] by (simp add: openin_euclidean_subtopology_iff) + define d where "d = Inf ?D" + obtain \ where "0 < \" and \: "\\. \0 \ \; \ < \\ \ (a + \ *\<^sub>R l) \ rel_interior S" + proof - + obtain e where "e>0" + and e: "\x'. x' \ affine hull S \ dist x' a < e \ x' \ rel_interior S" + using relin_Ex a by blast + show thesis + proof (rule_tac \ = "e / norm l" in that) + show "0 < e / norm l" by (simp add: \0 < e\ \l \ 0\) + next + show "a + \ *\<^sub>R l \ rel_interior S" if "0 \ \" "\ < e / norm l" for \ + proof (rule e) + show "a + \ *\<^sub>R l \ affine hull S" + by (metis (no_types) add_diff_cancel_left' aff affine_affine_hull mem_affine_3_minus aaff) + show "dist (a + \ *\<^sub>R l) a < e" + using that by (simp add: \l \ 0\ dist_norm pos_less_divide_eq) + qed + qed + qed + have inint: "\e. \0 \ e; e < d\ \ a + e *\<^sub>R l \ rel_interior S" + unfolding d_def using cInf_lower [OF _ bdd] + by (metis (no_types, lifting) a add.right_neutral le_less mem_Collect_eq not_less real_vector.scale_zero_left) + have "\ \ d" + unfolding d_def + apply (rule cInf_greatest [OF nonMT]) + using \ dual_order.strict_implies_order le_less_linear by blast + with \0 < \\ have "0 < d" by simp + have "a + d *\<^sub>R l \ rel_interior S" + proof + assume adl: "a + d *\<^sub>R l \ rel_interior S" + obtain e where "e > 0" + and e: "\x'. x' \ affine hull S \ dist x' (a + d *\<^sub>R l) < e \ x' \ rel_interior S" + using relin_Ex adl by blast + have "d + e / norm l \ Inf {d. 0 < d \ a + d *\<^sub>R l \ rel_interior S}" + proof (rule cInf_greatest [OF nonMT], clarsimp) + fix x::real + assume "0 < x" and nonrel: "a + x *\<^sub>R l \ rel_interior S" + show "d + e / norm l \ x" + proof (cases "x < d") + case True with inint nonrel \0 < x\ + show ?thesis by auto + next + case False + then have dle: "x < d + e / norm l \ dist (a + x *\<^sub>R l) (a + d *\<^sub>R l) < e" + by (simp add: field_simps \l \ 0\) + have ain: "a + x *\<^sub>R l \ affine hull S" + by (metis add_diff_cancel_left' aff affine_affine_hull mem_affine_3_minus aaff) + show ?thesis + using e [OF ain] nonrel dle by force + qed + qed + then show False + using \0 < e\ \l \ 0\ by (simp add: d_def [symmetric] divide_simps) + qed + moreover have "a + d *\<^sub>R l \ closure S" + proof (clarsimp simp: closure_approachable) + fix \::real assume "0 < \" + have 1: "a + (d - min d (\ / 2 / norm l)) *\<^sub>R l \ S" + apply (rule subsetD [OF rel_interior_subset inint]) + using \l \ 0\ \0 < d\ \0 < \\ by auto + have "norm l * min d (\ / (norm l * 2)) \ norm l * (\ / (norm l * 2))" + by (metis min_def mult_left_mono norm_ge_zero order_refl) + also have "... < \" + using \l \ 0\ \0 < \\ by (simp add: divide_simps) + finally have 2: "norm l * min d (\ / (norm l * 2)) < \" . + show "\y\S. dist y (a + d *\<^sub>R l) < \" + apply (rule_tac x="a + (d - min d (\ / 2 / norm l)) *\<^sub>R l" in bexI) + using 1 2 \0 < d\ \0 < \\ apply (auto simp: algebra_simps) + done + qed + ultimately have infront: "a + d *\<^sub>R l \ rel_frontier S" + by (simp add: rel_frontier_def) + show ?thesis + by (rule that [OF \0 < d\ infront inint]) +qed + +corollary ray_to_frontier: + fixes a :: "'a::euclidean_space" + assumes "bounded S" + and a: "a \ interior S" + and "l \ 0" + obtains d where "0 < d" "(a + d *\<^sub>R l) \ frontier S" + "\e. \0 \ e; e < d\ \ (a + e *\<^sub>R l) \ interior S" +proof - + have "interior S = rel_interior S" + using a rel_interior_nonempty_interior by auto + then have "a \ rel_interior S" + using a by simp + then show ?thesis + apply (rule ray_to_rel_frontier [OF \bounded S\ _ _ \l \ 0\]) + using a affine_hull_nonempty_interior apply blast + by (simp add: \interior S = rel_interior S\ frontier_def rel_frontier_def that) +qed + + +lemma segment_to_rel_frontier_aux: + fixes x :: "'a::euclidean_space" + assumes "convex S" "bounded S" and x: "x \ rel_interior S" and y: "y \ S" and xy: "x \ y" + obtains z where "z \ rel_frontier S" "y \ closed_segment x z" + "open_segment x z \ rel_interior S" +proof - + have "x + (y - x) \ affine hull S" + using hull_inc [OF y] by auto + then obtain d where "0 < d" and df: "(x + d *\<^sub>R (y-x)) \ rel_frontier S" + and di: "\e. \0 \ e; e < d\ \ (x + e *\<^sub>R (y-x)) \ rel_interior S" + by (rule ray_to_rel_frontier [OF \bounded S\ x]) (use xy in auto) + show ?thesis + proof + show "x + d *\<^sub>R (y - x) \ rel_frontier S" + by (simp add: df) + next + have "open_segment x y \ rel_interior S" + using rel_interior_closure_convex_segment [OF \convex S\ x] closure_subset y by blast + moreover have "x + d *\<^sub>R (y - x) \ open_segment x y" if "d < 1" + using xy + apply (auto simp: in_segment) + apply (rule_tac x="d" in exI) + using \0 < d\ that apply (auto simp: divide_simps algebra_simps) + done + ultimately have "1 \ d" + using df rel_frontier_def by fastforce + moreover have "x = (1 / d) *\<^sub>R x + ((d - 1) / d) *\<^sub>R x" + by (metis \0 < d\ add.commute add_divide_distrib diff_add_cancel divide_self_if less_irrefl scaleR_add_left scaleR_one) + ultimately show "y \ closed_segment x (x + d *\<^sub>R (y - x))" + apply (auto simp: in_segment) + apply (rule_tac x="1/d" in exI) + apply (auto simp: divide_simps algebra_simps) + done + next + show "open_segment x (x + d *\<^sub>R (y - x)) \ rel_interior S" + apply (rule rel_interior_closure_convex_segment [OF \convex S\ x]) + using df rel_frontier_def by auto + qed +qed + +lemma segment_to_rel_frontier: + fixes x :: "'a::euclidean_space" + assumes S: "convex S" "bounded S" and x: "x \ rel_interior S" + and y: "y \ S" and xy: "\(x = y \ S = {x})" + obtains z where "z \ rel_frontier S" "y \ closed_segment x z" + "open_segment x z \ rel_interior S" +proof (cases "x=y") + case True + with xy have "S \ {x}" + by blast + with True show ?thesis + by (metis Set.set_insert all_not_in_conv ends_in_segment(1) insert_iff segment_to_rel_frontier_aux[OF S x] that y) +next + case False + then show ?thesis + using segment_to_rel_frontier_aux [OF S x y] that by blast +qed + +proposition rel_frontier_not_sing: + fixes a :: "'a::euclidean_space" + assumes "bounded S" + shows "rel_frontier S \ {a}" +proof (cases "S = {}") + case True then show ?thesis by simp +next + case False + then obtain z where "z \ S" + by blast + then show ?thesis + proof (cases "S = {z}") + case True then show ?thesis by simp + next + case False + then obtain w where "w \ S" "w \ z" + using \z \ S\ by blast + show ?thesis + proof + assume "rel_frontier S = {a}" + then consider "w \ rel_frontier S" | "z \ rel_frontier S" + using \w \ z\ by auto + then show False + proof cases + case 1 + then have w: "w \ rel_interior S" + using \w \ S\ closure_subset rel_frontier_def by fastforce + have "w + (w - z) \ affine hull S" + by (metis \w \ S\ \z \ S\ affine_affine_hull hull_inc mem_affine_3_minus scaleR_one) + then obtain e where "0 < e" "(w + e *\<^sub>R (w - z)) \ rel_frontier S" + using \w \ z\ \z \ S\ by (metis assms ray_to_rel_frontier right_minus_eq w) + moreover obtain d where "0 < d" "(w + d *\<^sub>R (z - w)) \ rel_frontier S" + using ray_to_rel_frontier [OF \bounded S\ w, of "1 *\<^sub>R (z - w)"] \w \ z\ \z \ S\ + by (metis add.commute add.right_neutral diff_add_cancel hull_inc scaleR_one) + ultimately have "d *\<^sub>R (z - w) = e *\<^sub>R (w - z)" + using \rel_frontier S = {a}\ by force + moreover have "e \ -d " + using \0 < e\ \0 < d\ by force + ultimately show False + by (metis (no_types, lifting) \w \ z\ eq_iff_diff_eq_0 minus_diff_eq real_vector.scale_cancel_right real_vector.scale_minus_right scaleR_left.minus) + next + case 2 + then have z: "z \ rel_interior S" + using \z \ S\ closure_subset rel_frontier_def by fastforce + have "z + (z - w) \ affine hull S" + by (metis \z \ S\ \w \ S\ affine_affine_hull hull_inc mem_affine_3_minus scaleR_one) + then obtain e where "0 < e" "(z + e *\<^sub>R (z - w)) \ rel_frontier S" + using \w \ z\ \w \ S\ by (metis assms ray_to_rel_frontier right_minus_eq z) + moreover obtain d where "0 < d" "(z + d *\<^sub>R (w - z)) \ rel_frontier S" + using ray_to_rel_frontier [OF \bounded S\ z, of "1 *\<^sub>R (w - z)"] \w \ z\ \w \ S\ + by (metis add.commute add.right_neutral diff_add_cancel hull_inc scaleR_one) + ultimately have "d *\<^sub>R (w - z) = e *\<^sub>R (z - w)" + using \rel_frontier S = {a}\ by force + moreover have "e \ -d " + using \0 < e\ \0 < d\ by force + ultimately show False + by (metis (no_types, lifting) \w \ z\ eq_iff_diff_eq_0 minus_diff_eq real_vector.scale_cancel_right real_vector.scale_minus_right scaleR_left.minus) + qed + qed + qed +qed + subsection\<^marker>\tag unimportant\ \Convexity on direct sums\