# HG changeset patch # User immler # Date 1572915223 18000 # Node ID c2465b429e6e06f60fa36bf319a7a0a34419eb51 # Parent b212ee44f87c0228502968d5e223261471284fc2 Line_Segment is independent of Convex_Euclidean_Space diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Arcwise_Connected.thy --- a/src/HOL/Analysis/Arcwise_Connected.thy Mon Nov 04 17:59:32 2019 -0500 +++ b/src/HOL/Analysis/Arcwise_Connected.thy Mon Nov 04 19:53:43 2019 -0500 @@ -13,6 +13,20 @@ shows "path_connected {a..b}" using is_interval_cc is_interval_path_connected by blast +lemma segment_to_closest_point: + fixes S :: "'a :: euclidean_space set" + shows "\closed S; S \ {}\ \ open_segment a (closest_point S a) \ S = {}" + apply (subst disjoint_iff_not_equal) + apply (clarify dest!: dist_in_open_segment) + by (metis closest_point_le dist_commute le_less_trans less_irrefl) + +lemma segment_to_point_exists: + fixes S :: "'a :: euclidean_space set" + assumes "closed S" "S \ {}" + obtains b where "b \ S" "open_segment a b \ S = {}" + by (metis assms segment_to_closest_point closest_point_exists that) + + subsection \The Brouwer reduction theorem\ theorem Brouwer_reduction_theorem_gen: diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Analysis/Convex_Euclidean_Space.thy Mon Nov 04 17:59:32 2019 -0500 +++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy Mon Nov 04 19:53:43 2019 -0500 @@ -16,249 +16,6 @@ subsection\<^marker>\tag unimportant\ \Topological Properties of Convex Sets and Functions\ -lemma convex_supp_sum: - assumes "convex S" and 1: "supp_sum u I = 1" - and "\i. i \ I \ 0 \ u i \ (u i = 0 \ f i \ S)" - shows "supp_sum (\i. u i *\<^sub>R f i) I \ S" -proof - - have fin: "finite {i \ I. u i \ 0}" - using 1 sum.infinite by (force simp: supp_sum_def support_on_def) - then have eq: "supp_sum (\i. u i *\<^sub>R f i) I = sum (\i. u i *\<^sub>R f i) {i \ I. u i \ 0}" - by (force intro: sum.mono_neutral_left simp: supp_sum_def support_on_def) - show ?thesis - apply (simp add: eq) - apply (rule convex_sum [OF fin \convex S\]) - using 1 assms apply (auto simp: supp_sum_def support_on_def) - done -qed - -lemma closure_bounded_linear_image_subset: - assumes f: "bounded_linear f" - shows "f ` closure S \ closure (f ` S)" - using linear_continuous_on [OF f] closed_closure closure_subset - by (rule image_closure_subset) - -lemma closure_linear_image_subset: - fixes f :: "'m::euclidean_space \ 'n::real_normed_vector" - assumes "linear f" - shows "f ` (closure S) \ closure (f ` S)" - using assms unfolding linear_conv_bounded_linear - by (rule closure_bounded_linear_image_subset) - -lemma closed_injective_linear_image: - fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - assumes S: "closed S" and f: "linear f" "inj f" - shows "closed (f ` S)" -proof - - obtain g where g: "linear g" "g \ f = id" - using linear_injective_left_inverse [OF f] by blast - then have confg: "continuous_on (range f) g" - using linear_continuous_on linear_conv_bounded_linear by blast - have [simp]: "g ` f ` S = S" - using g by (simp add: image_comp) - have cgf: "closed (g ` f ` S)" - by (simp add: \g \ f = id\ S image_comp) - have [simp]: "(range f \ g -` S) = f ` S" - using g unfolding o_def id_def image_def by auto metis+ - show ?thesis - proof (rule closedin_closed_trans [of "range f"]) - show "closedin (top_of_set (range f)) (f ` S)" - using continuous_closedin_preimage [OF confg cgf] by simp - show "closed (range f)" - apply (rule closed_injective_image_subspace) - using f apply (auto simp: linear_linear linear_injective_0) - done - qed -qed - -lemma closed_injective_linear_image_eq: - fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - assumes f: "linear f" "inj f" - shows "(closed(image f s) \ closed s)" - by (metis closed_injective_linear_image closure_eq closure_linear_image_subset closure_subset_eq f(1) f(2) inj_image_subset_iff) - -lemma closure_injective_linear_image: - fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - shows "\linear f; inj f\ \ f ` (closure S) = closure (f ` S)" - apply (rule subset_antisym) - apply (simp add: closure_linear_image_subset) - by (simp add: closure_minimal closed_injective_linear_image closure_subset image_mono) - -lemma closure_bounded_linear_image: - fixes f :: "'a::euclidean_space \ 'b::euclidean_space" - shows "\linear f; bounded S\ \ f ` (closure S) = closure (f ` S)" - apply (rule subset_antisym, simp add: closure_linear_image_subset) - apply (rule closure_minimal, simp add: closure_subset image_mono) - by (meson bounded_closure closed_closure compact_continuous_image compact_eq_bounded_closed linear_continuous_on linear_conv_bounded_linear) - -lemma closure_scaleR: - fixes S :: "'a::real_normed_vector set" - shows "((*\<^sub>R) c) ` (closure S) = closure (((*\<^sub>R) c) ` S)" -proof - show "((*\<^sub>R) c) ` (closure S) \ closure (((*\<^sub>R) c) ` S)" - using bounded_linear_scaleR_right - by (rule closure_bounded_linear_image_subset) - show "closure (((*\<^sub>R) c) ` S) \ ((*\<^sub>R) c) ` (closure S)" - by (intro closure_minimal image_mono closure_subset closed_scaling closed_closure) -qed - -lemma sphere_eq_empty [simp]: - fixes a :: "'a::{real_normed_vector, perfect_space}" - shows "sphere a r = {} \ r < 0" -by (auto simp: sphere_def dist_norm) (metis dist_norm le_less_linear vector_choose_dist) - -lemma cone_closure: - fixes S :: "'a::real_normed_vector set" - assumes "cone S" - shows "cone (closure S)" -proof (cases "S = {}") - case True - then show ?thesis by auto -next - case False - then have "0 \ S \ (\c. c > 0 \ (*\<^sub>R) c ` S = S)" - using cone_iff[of S] assms by auto - then have "0 \ closure S \ (\c. c > 0 \ (*\<^sub>R) c ` closure S = closure S)" - using closure_subset by (auto simp: closure_scaleR) - then show ?thesis - using False cone_iff[of "closure S"] by auto -qed - -corollary component_complement_connected: - fixes S :: "'a::real_normed_vector set" - assumes "connected S" "C \ components (-S)" - shows "connected(-C)" - using component_diff_connected [of S UNIV] assms - by (auto simp: Compl_eq_Diff_UNIV) - -proposition clopen: - fixes S :: "'a :: real_normed_vector set" - shows "closed S \ open S \ S = {} \ S = UNIV" - by (force intro!: connected_UNIV [unfolded connected_clopen, rule_format]) - -corollary compact_open: - fixes S :: "'a :: euclidean_space set" - shows "compact S \ open S \ S = {}" - by (auto simp: compact_eq_bounded_closed clopen) - -corollary finite_imp_not_open: - fixes S :: "'a::{real_normed_vector, perfect_space} set" - shows "\finite S; open S\ \ S={}" - using clopen [of S] finite_imp_closed not_bounded_UNIV by blast - -corollary empty_interior_finite: - fixes S :: "'a::{real_normed_vector, perfect_space} set" - shows "finite S \ interior S = {}" - by (metis interior_subset finite_subset open_interior [of S] finite_imp_not_open) - -text \Balls, being convex, are connected.\ - -lemma convex_local_global_minimum: - fixes s :: "'a::real_normed_vector set" - assumes "e > 0" - and "convex_on s f" - and "ball x e \ s" - and "\y\ball x e. f x \ f y" - shows "\y\s. f x \ f y" -proof (rule ccontr) - have "x \ s" using assms(1,3) by auto - assume "\ ?thesis" - then obtain y where "y\s" and y: "f x > f y" by auto - then have xy: "0 < dist x y" by auto - then obtain u where "0 < u" "u \ 1" and u: "u < e / dist x y" - using field_lbound_gt_zero[of 1 "e / dist x y"] xy \e>0\ by auto - then have "f ((1-u) *\<^sub>R x + u *\<^sub>R y) \ (1-u) * f x + u * f y" - using \x\s\ \y\s\ - using assms(2)[unfolded convex_on_def, - THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x="1-u"]] - by auto - moreover - have *: "x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" - by (simp add: algebra_simps) - have "(1 - u) *\<^sub>R x + u *\<^sub>R y \ ball x e" - unfolding mem_ball dist_norm - unfolding * and norm_scaleR and abs_of_pos[OF \0] - unfolding dist_norm[symmetric] - using u - unfolding pos_less_divide_eq[OF xy] - by auto - then have "f x \ f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" - using assms(4) by auto - ultimately show False - using mult_strict_left_mono[OF y \u>0\] - unfolding left_diff_distrib - by auto -qed - -lemma convex_ball [iff]: - fixes x :: "'a::real_normed_vector" - shows "convex (ball x e)" -proof (auto simp: convex_def) - fix y z - assume yz: "dist x y < e" "dist x z < e" - fix u v :: real - assume uv: "0 \ u" "0 \ v" "u + v = 1" - have "dist x (u *\<^sub>R y + v *\<^sub>R z) \ u * dist x y + v * dist x z" - using uv yz - using convex_on_dist [of "ball x e" x, unfolded convex_on_def, - THEN bspec[where x=y], THEN bspec[where x=z]] - by auto - then show "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" - using convex_bound_lt[OF yz uv] by auto -qed - -lemma convex_cball [iff]: - fixes x :: "'a::real_normed_vector" - shows "convex (cball x e)" -proof - - { - fix y z - assume yz: "dist x y \ e" "dist x z \ e" - fix u v :: real - assume uv: "0 \ u" "0 \ v" "u + v = 1" - have "dist x (u *\<^sub>R y + v *\<^sub>R z) \ u * dist x y + v * dist x z" - using uv yz - using convex_on_dist [of "cball x e" x, unfolded convex_on_def, - THEN bspec[where x=y], THEN bspec[where x=z]] - by auto - then have "dist x (u *\<^sub>R y + v *\<^sub>R z) \ e" - using convex_bound_le[OF yz uv] by auto - } - then show ?thesis by (auto simp: convex_def Ball_def) -qed - -lemma connected_ball [iff]: - fixes x :: "'a::real_normed_vector" - shows "connected (ball x e)" - using convex_connected convex_ball by auto - -lemma connected_cball [iff]: - fixes x :: "'a::real_normed_vector" - shows "connected (cball x e)" - using convex_connected convex_cball by auto - - -lemma bounded_convex_hull: - fixes s :: "'a::real_normed_vector set" - assumes "bounded s" - shows "bounded (convex hull s)" -proof - - from assms obtain B where B: "\x\s. norm x \ B" - unfolding bounded_iff by auto - show ?thesis - apply (rule bounded_subset[OF bounded_cball, of _ 0 B]) - unfolding subset_hull[of convex, OF convex_cball] - unfolding subset_eq mem_cball dist_norm using B - apply auto - done -qed - -lemma finite_imp_bounded_convex_hull: - fixes s :: "'a::real_normed_vector set" - shows "finite s \ bounded (convex hull s)" - using bounded_convex_hull finite_imp_bounded - by auto - lemma aff_dim_cball: fixes a :: "'n::euclidean_space" assumes "e > 0" @@ -2059,9 +1816,6 @@ shows "is_interval s \ convex s" by (metis is_interval_convex convex_connected is_interval_connected_1) -lemma is_interval_ball_real: "is_interval (ball a b)" for a b::real - by (metis connected_ball is_interval_connected_1) - lemma connected_compact_interval_1: "connected S \ compact S \ (\a b. S = {a..b::real})" by (auto simp: is_interval_connected_1 [symmetric] is_interval_compact) @@ -2087,9 +1841,6 @@ by (metis connected_convex_1 convex_linear_vimage linf convex_connected connected_linear_image) qed -lemma is_interval_cball_1[intro, simp]: "is_interval (cball a b)" for a b::real - by (simp add: is_interval_convex_1) - lemma [simp]: fixes r s::real shows is_interval_io: "is_interval {..d > 0\ by auto qed - -section \Line Segments\ - -subsection \Midpoint\ - -definition\<^marker>\tag important\ midpoint :: "'a::real_vector \ 'a \ 'a" - where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)" - -lemma midpoint_idem [simp]: "midpoint x x = x" - unfolding midpoint_def by simp - -lemma midpoint_sym: "midpoint a b = midpoint b a" - unfolding midpoint_def by (auto simp add: scaleR_right_distrib) - -lemma midpoint_eq_iff: "midpoint a b = c \ a + b = c + c" -proof - - have "midpoint a b = c \ scaleR 2 (midpoint a b) = scaleR 2 c" - by simp - then show ?thesis - unfolding midpoint_def scaleR_2 [symmetric] by simp -qed - -lemma - fixes a::real - assumes "a \ b" shows ge_midpoint_1: "a \ midpoint a b" - and le_midpoint_1: "midpoint a b \ b" - by (simp_all add: midpoint_def assms) - -lemma dist_midpoint: - fixes a b :: "'a::real_normed_vector" shows - "dist a (midpoint a b) = (dist a b) / 2" (is ?t1) - "dist b (midpoint a b) = (dist a b) / 2" (is ?t2) - "dist (midpoint a b) a = (dist a b) / 2" (is ?t3) - "dist (midpoint a b) b = (dist a b) / 2" (is ?t4) -proof - - have *: "\x y::'a. 2 *\<^sub>R x = - y \ norm x = (norm y) / 2" - unfolding equation_minus_iff by auto - have **: "\x y::'a. 2 *\<^sub>R x = y \ norm x = (norm y) / 2" - by auto - note scaleR_right_distrib [simp] - show ?t1 - unfolding midpoint_def dist_norm - apply (rule **) - apply (simp add: scaleR_right_diff_distrib) - apply (simp add: scaleR_2) - done - show ?t2 - unfolding midpoint_def dist_norm - apply (rule *) - apply (simp add: scaleR_right_diff_distrib) - apply (simp add: scaleR_2) - done - show ?t3 - unfolding midpoint_def dist_norm - apply (rule *) - apply (simp add: scaleR_right_diff_distrib) - apply (simp add: scaleR_2) - done - show ?t4 - unfolding midpoint_def dist_norm - apply (rule **) - apply (simp add: scaleR_right_diff_distrib) - apply (simp add: scaleR_2) - done -qed - -lemma midpoint_eq_endpoint [simp]: - "midpoint a b = a \ a = b" - "midpoint a b = b \ a = b" - unfolding midpoint_eq_iff by auto - -lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b" - using midpoint_eq_iff by metis - -lemma midpoint_linear_image: - "linear f \ midpoint(f a)(f b) = f(midpoint a b)" -by (simp add: linear_iff midpoint_def) - - -subsection \Line segments\ - -definition\<^marker>\tag important\ closed_segment :: "'a::real_vector \ 'a \ 'a set" - where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \ u \ u \ 1}" - -definition\<^marker>\tag important\ open_segment :: "'a::real_vector \ 'a \ 'a set" where - "open_segment a b \ closed_segment a b - {a,b}" - -lemmas segment = open_segment_def closed_segment_def - -lemma in_segment: - "x \ closed_segment a b \ (\u. 0 \ u \ u \ 1 \ x = (1 - u) *\<^sub>R a + u *\<^sub>R b)" - "x \ open_segment a b \ a \ b \ (\u. 0 < u \ u < 1 \ x = (1 - u) *\<^sub>R a + u *\<^sub>R b)" - using less_eq_real_def by (auto simp: segment algebra_simps) - -lemma closed_segment_linear_image: - "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f" -proof - - interpret linear f by fact - show ?thesis - by (force simp add: in_segment add scale) -qed - -lemma open_segment_linear_image: - "\linear f; inj f\ \ open_segment (f a) (f b) = f ` (open_segment a b)" - by (force simp: open_segment_def closed_segment_linear_image inj_on_def) - -lemma closed_segment_translation: - "closed_segment (c + a) (c + b) = image (\x. c + x) (closed_segment a b)" -apply safe -apply (rule_tac x="x-c" in image_eqI) -apply (auto simp: in_segment algebra_simps) -done - -lemma open_segment_translation: - "open_segment (c + a) (c + b) = image (\x. c + x) (open_segment a b)" -by (simp add: open_segment_def closed_segment_translation translation_diff) - -lemma closed_segment_of_real: - "closed_segment (of_real x) (of_real y) = of_real ` closed_segment x y" - apply (auto simp: image_iff in_segment scaleR_conv_of_real) - apply (rule_tac x="(1-u)*x + u*y" in bexI) - apply (auto simp: in_segment) - done - -lemma open_segment_of_real: - "open_segment (of_real x) (of_real y) = of_real ` open_segment x y" - apply (auto simp: image_iff in_segment scaleR_conv_of_real) - apply (rule_tac x="(1-u)*x + u*y" in bexI) - apply (auto simp: in_segment) - done - -lemma closed_segment_Reals: - "\x \ Reals; y \ Reals\ \ closed_segment x y = of_real ` closed_segment (Re x) (Re y)" - by (metis closed_segment_of_real of_real_Re) - -lemma open_segment_Reals: - "\x \ Reals; y \ Reals\ \ open_segment x y = of_real ` open_segment (Re x) (Re y)" - by (metis open_segment_of_real of_real_Re) - -lemma open_segment_PairD: - "(x, x') \ open_segment (a, a') (b, b') - \ (x \ open_segment a b \ a = b) \ (x' \ open_segment a' b' \ a' = b')" - by (auto simp: in_segment) - -lemma closed_segment_PairD: - "(x, x') \ closed_segment (a, a') (b, b') \ x \ closed_segment a b \ x' \ closed_segment a' b'" - by (auto simp: closed_segment_def) - -lemma closed_segment_translation_eq [simp]: - "d + x \ closed_segment (d + a) (d + b) \ x \ closed_segment a b" -proof - - have *: "\d x a b. x \ closed_segment a b \ d + x \ closed_segment (d + a) (d + b)" - apply (simp add: closed_segment_def) - apply (erule ex_forward) - apply (simp add: algebra_simps) - done - show ?thesis - using * [where d = "-d"] * - by (fastforce simp add:) -qed - -lemma open_segment_translation_eq [simp]: - "d + x \ open_segment (d + a) (d + b) \ x \ open_segment a b" - by (simp add: open_segment_def) - -lemma of_real_closed_segment [simp]: - "of_real x \ closed_segment (of_real a) (of_real b) \ x \ closed_segment a b" - apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward) - using of_real_eq_iff by fastforce - -lemma of_real_open_segment [simp]: - "of_real x \ open_segment (of_real a) (of_real b) \ x \ open_segment a b" - apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward del: exE) - using of_real_eq_iff by fastforce - -lemma convex_contains_segment: - "convex S \ (\a\S. \b\S. closed_segment a b \ S)" - unfolding convex_alt closed_segment_def by auto - -lemma closed_segment_in_Reals: - "\x \ closed_segment a b; a \ Reals; b \ Reals\ \ x \ Reals" - by (meson subsetD convex_Reals convex_contains_segment) - -lemma open_segment_in_Reals: - "\x \ open_segment a b; a \ Reals; b \ Reals\ \ x \ Reals" - by (metis Diff_iff closed_segment_in_Reals open_segment_def) - -lemma closed_segment_subset: "\x \ S; y \ S; convex S\ \ closed_segment x y \ S" - by (simp add: convex_contains_segment) - -lemma closed_segment_subset_convex_hull: - "\x \ convex hull S; y \ convex hull S\ \ closed_segment x y \ convex hull S" - using convex_contains_segment by blast - -lemma segment_convex_hull: - "closed_segment a b = convex hull {a,b}" -proof - - have *: "\x. {x} \ {}" by auto - show ?thesis - unfolding segment convex_hull_insert[OF *] convex_hull_singleton - by (safe; rule_tac x="1 - u" in exI; force) -qed - -lemma open_closed_segment: "u \ open_segment w z \ u \ closed_segment w z" - by (auto simp add: closed_segment_def open_segment_def) - -lemma segment_open_subset_closed: - "open_segment a b \ closed_segment a b" - by (auto simp: closed_segment_def open_segment_def) - -lemma bounded_closed_segment: - fixes a :: "'a::euclidean_space" shows "bounded (closed_segment a b)" - by (simp add: segment_convex_hull compact_convex_hull compact_imp_bounded) - -lemma bounded_open_segment: - fixes a :: "'a::euclidean_space" shows "bounded (open_segment a b)" - by (rule bounded_subset [OF bounded_closed_segment segment_open_subset_closed]) - -lemmas bounded_segment = bounded_closed_segment open_closed_segment - -lemma ends_in_segment [iff]: "a \ closed_segment a b" "b \ closed_segment a b" - unfolding segment_convex_hull - by (auto intro!: hull_subset[unfolded subset_eq, rule_format]) - -lemma eventually_closed_segment: - fixes x0::"'a::real_normed_vector" - assumes "open X0" "x0 \ X0" - shows "\\<^sub>F x in at x0 within U. closed_segment x0 x \ X0" -proof - - from openE[OF assms] - obtain e where e: "0 < e" "ball x0 e \ X0" . - then have "\\<^sub>F x in at x0 within U. x \ ball x0 e" - by (auto simp: dist_commute eventually_at) - then show ?thesis - proof eventually_elim - case (elim x) - have "x0 \ ball x0 e" using \e > 0\ by simp - from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim] - have "closed_segment x0 x \ ball x0 e" . - also note \\ \ X0\ - finally show ?case . - qed -qed - -lemma segment_furthest_le: - fixes a b x y :: "'a::euclidean_space" - assumes "x \ closed_segment a b" - shows "norm (y - x) \ norm (y - a) \ norm (y - x) \ norm (y - b)" -proof - - obtain z where "z \ {a, b}" "norm (x - y) \ norm (z - y)" - using simplex_furthest_le[of "{a, b}" y] - using assms[unfolded segment_convex_hull] - by auto - then show ?thesis - by (auto simp add:norm_minus_commute) -qed - -lemma closed_segment_commute: "closed_segment a b = closed_segment b a" -proof - - have "{a, b} = {b, a}" by auto - thus ?thesis - by (simp add: segment_convex_hull) -qed - -lemma segment_bound1: - assumes "x \ closed_segment a b" - shows "norm (x - a) \ norm (b - a)" -proof - - obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \ u" "u \ 1" - using assms by (auto simp add: closed_segment_def) - then show "norm (x - a) \ norm (b - a)" - apply clarify - apply (auto simp: algebra_simps) - apply (simp add: scaleR_diff_right [symmetric] mult_left_le_one_le) - done -qed - -lemma segment_bound: - assumes "x \ closed_segment a b" - shows "norm (x - a) \ norm (b - a)" "norm (x - b) \ norm (b - a)" -apply (simp add: assms segment_bound1) -by (metis assms closed_segment_commute dist_commute dist_norm segment_bound1) - -lemma open_segment_commute: "open_segment a b = open_segment b a" -proof - - have "{a, b} = {b, a}" by auto - thus ?thesis - by (simp add: closed_segment_commute open_segment_def) -qed - -lemma closed_segment_idem [simp]: "closed_segment a a = {a}" - unfolding segment by (auto simp add: algebra_simps) - -lemma open_segment_idem [simp]: "open_segment a a = {}" - by (simp add: open_segment_def) - -lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \ {a,b}" - using open_segment_def by auto - -lemma convex_contains_open_segment: - "convex s \ (\a\s. \b\s. open_segment a b \ s)" - by (simp add: convex_contains_segment closed_segment_eq_open) - -lemma closed_segment_eq_real_ivl: - fixes a b::real - shows "closed_segment a b = (if a \ b then {a .. b} else {b .. a})" -proof - - have "b \ a \ closed_segment b a = {b .. a}" - and "a \ b \ closed_segment a b = {a .. b}" - by (auto simp: convex_hull_eq_real_cbox segment_convex_hull) - thus ?thesis - by (auto simp: closed_segment_commute) -qed - -lemma open_segment_eq_real_ivl: - fixes a b::real - shows "open_segment a b = (if a \ b then {a<..x. (v - u) * x + u) ` {0..1}" - by (simp add: add.commute [of u] image_affinity_atLeastAtMost [where c=u] closed_segment_eq_real_ivl) - -lemma dist_in_closed_segment: - fixes a :: "'a :: euclidean_space" - assumes "x \ closed_segment a b" - shows "dist x a \ dist a b \ dist x b \ dist a b" -proof (intro conjI) - obtain u where u: "0 \ u" "u \ 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" - using assms by (force simp: in_segment algebra_simps) - have "dist x a = u * dist a b" - apply (simp add: dist_norm algebra_simps x) - by (metis \0 \ u\ abs_of_nonneg norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib) - also have "... \ dist a b" - by (simp add: mult_left_le_one_le u) - finally show "dist x a \ dist a b" . - have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)" - by (simp add: dist_norm algebra_simps x) - also have "... = (1-u) * dist a b" - proof - - have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)" - using \u \ 1\ by force - then show ?thesis - by (simp add: dist_norm real_vector.scale_right_diff_distrib) - qed - also have "... \ dist a b" - by (simp add: mult_left_le_one_le u) - finally show "dist x b \ dist a b" . -qed - -lemma dist_in_open_segment: - fixes a :: "'a :: euclidean_space" - assumes "x \ open_segment a b" - shows "dist x a < dist a b \ dist x b < dist a b" -proof (intro conjI) - obtain u where u: "0 < u" "u < 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" - using assms by (force simp: in_segment algebra_simps) - have "dist x a = u * dist a b" - apply (simp add: dist_norm algebra_simps x) - by (metis abs_of_nonneg less_eq_real_def norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib \0 < u\) - also have *: "... < dist a b" - by (metis (no_types) assms dist_eq_0_iff dist_not_less_zero in_segment(2) linorder_neqE_linordered_idom mult.left_neutral real_mult_less_iff1 \u < 1\) - finally show "dist x a < dist a b" . - have ab_ne0: "dist a b \ 0" - using * by fastforce - have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)" - by (simp add: dist_norm algebra_simps x) - also have "... = (1-u) * dist a b" - proof - - have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)" - using \u < 1\ by force - then show ?thesis - by (simp add: dist_norm real_vector.scale_right_diff_distrib) - qed - also have "... < dist a b" - using ab_ne0 \0 < u\ by simp - finally show "dist x b < dist a b" . -qed - -lemma dist_decreases_open_segment_0: - fixes x :: "'a :: euclidean_space" - assumes "x \ open_segment 0 b" - shows "dist c x < dist c 0 \ dist c x < dist c b" -proof (rule ccontr, clarsimp simp: not_less) - obtain u where u: "0 \ b" "0 < u" "u < 1" and x: "x = u *\<^sub>R b" - using assms by (auto simp: in_segment) - have xb: "x \ b < b \ b" - using u x by auto - assume "norm c \ dist c x" - then have "c \ c \ (c - x) \ (c - x)" - by (simp add: dist_norm norm_le) - moreover have "0 < x \ b" - using u x by auto - ultimately have less: "c \ b < x \ b" - by (simp add: x algebra_simps inner_commute u) - assume "dist c b \ dist c x" - then have "(c - b) \ (c - b) \ (c - x) \ (c - x)" - by (simp add: dist_norm norm_le) - then have "(b \ b) * (1 - u*u) \ 2 * (b \ c) * (1-u)" - by (simp add: x algebra_simps inner_commute) - then have "(1+u) * (b \ b) * (1-u) \ 2 * (b \ c) * (1-u)" - by (simp add: algebra_simps) - then have "(1+u) * (b \ b) \ 2 * (b \ c)" - using \u < 1\ by auto - with xb have "c \ b \ x \ b" - by (auto simp: x algebra_simps inner_commute) - with less show False by auto -qed - -proposition dist_decreases_open_segment: - fixes a :: "'a :: euclidean_space" - assumes "x \ open_segment a b" - shows "dist c x < dist c a \ dist c x < dist c b" -proof - - have *: "x - a \ open_segment 0 (b - a)" using assms - by (metis diff_self open_segment_translation_eq uminus_add_conv_diff) - show ?thesis - using dist_decreases_open_segment_0 [OF *, of "c-a"] assms - by (simp add: dist_norm) -qed - -corollary open_segment_furthest_le: - fixes a b x y :: "'a::euclidean_space" - assumes "x \ open_segment a b" - shows "norm (y - x) < norm (y - a) \ norm (y - x) < norm (y - b)" - by (metis assms dist_decreases_open_segment dist_norm) - -corollary dist_decreases_closed_segment: - fixes a :: "'a :: euclidean_space" - assumes "x \ closed_segment a b" - shows "dist c x \ dist c a \ dist c x \ dist c b" -apply (cases "x \ open_segment a b") - using dist_decreases_open_segment less_eq_real_def apply blast -by (metis DiffI assms empty_iff insertE open_segment_def order_refl) - -lemma convex_intermediate_ball: - fixes a :: "'a :: euclidean_space" - shows "\ball a r \ T; T \ cball a r\ \ convex T" -apply (simp add: convex_contains_open_segment, clarify) -by (metis (no_types, hide_lams) less_le_trans mem_ball mem_cball subsetCE dist_decreases_open_segment) - -lemma csegment_midpoint_subset: "closed_segment (midpoint a b) b \ closed_segment a b" - apply (clarsimp simp: midpoint_def in_segment) - apply (rule_tac x="(1 + u) / 2" in exI) - apply (auto simp: algebra_simps add_divide_distrib diff_divide_distrib) - by (metis field_sum_of_halves scaleR_left.add) - -lemma notin_segment_midpoint: - fixes a :: "'a :: euclidean_space" - shows "a \ b \ a \ closed_segment (midpoint a b) b" -by (auto simp: dist_midpoint dest!: dist_in_closed_segment) - -lemma segment_to_closest_point: - fixes S :: "'a :: euclidean_space set" - shows "\closed S; S \ {}\ \ open_segment a (closest_point S a) \ S = {}" - apply (subst disjoint_iff_not_equal) - apply (clarify dest!: dist_in_open_segment) - by (metis closest_point_le dist_commute le_less_trans less_irrefl) - -lemma segment_to_point_exists: - fixes S :: "'a :: euclidean_space set" - assumes "closed S" "S \ {}" - obtains b where "b \ S" "open_segment a b \ S = {}" - by (metis assms segment_to_closest_point closest_point_exists that) - -subsubsection\More lemmas, especially for working with the underlying formula\ - -lemma segment_eq_compose: - fixes a :: "'a :: real_vector" - shows "(\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) = (\x. a + x) o (\u. u *\<^sub>R (b - a))" - by (simp add: o_def algebra_simps) - -lemma segment_degen_1: - fixes a :: "'a :: real_vector" - shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = b \ a=b \ u=1" -proof - - { assume "(1 - u) *\<^sub>R a + u *\<^sub>R b = b" - then have "(1 - u) *\<^sub>R a = (1 - u) *\<^sub>R b" - by (simp add: algebra_simps) - then have "a=b \ u=1" - by simp - } then show ?thesis - by (auto simp: algebra_simps) -qed - -lemma segment_degen_0: - fixes a :: "'a :: real_vector" - shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = a \ a=b \ u=0" - using segment_degen_1 [of "1-u" b a] - by (auto simp: algebra_simps) - -lemma add_scaleR_degen: - fixes a b ::"'a::real_vector" - assumes "(u *\<^sub>R b + v *\<^sub>R a) = (u *\<^sub>R a + v *\<^sub>R b)" "u \ v" - shows "a=b" - by (metis (no_types, hide_lams) add.commute add_diff_eq diff_add_cancel real_vector.scale_cancel_left real_vector.scale_left_diff_distrib assms) - -lemma closed_segment_image_interval: - "closed_segment a b = (\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0..1}" - by (auto simp: set_eq_iff image_iff closed_segment_def) - -lemma open_segment_image_interval: - "open_segment a b = (if a=b then {} else (\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1})" - by (auto simp: open_segment_def closed_segment_def segment_degen_0 segment_degen_1) - -lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval - -lemma open_segment_bound1: - assumes "x \ open_segment a b" - shows "norm (x - a) < norm (b - a)" -proof - - obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 < u" "u < 1" "a \ b" - using assms by (auto simp add: open_segment_image_interval split: if_split_asm) - then show "norm (x - a) < norm (b - a)" - apply clarify - apply (auto simp: algebra_simps) - apply (simp add: scaleR_diff_right [symmetric]) - done -qed - -lemma compact_segment [simp]: - fixes a :: "'a::real_normed_vector" - shows "compact (closed_segment a b)" - by (auto simp: segment_image_interval intro!: compact_continuous_image continuous_intros) - -lemma closed_segment [simp]: - fixes a :: "'a::real_normed_vector" - shows "closed (closed_segment a b)" - by (simp add: compact_imp_closed) - -lemma closure_closed_segment [simp]: - fixes a :: "'a::real_normed_vector" - shows "closure(closed_segment a b) = closed_segment a b" - by simp - -lemma open_segment_bound: - assumes "x \ open_segment a b" - shows "norm (x - a) < norm (b - a)" "norm (x - b) < norm (b - a)" -apply (simp add: assms open_segment_bound1) -by (metis assms norm_minus_commute open_segment_bound1 open_segment_commute) - -lemma closure_open_segment [simp]: - "closure (open_segment a b) = (if a = b then {} else closed_segment a b)" - for a :: "'a::euclidean_space" -proof (cases "a = b") - case True - then show ?thesis - by simp -next - case False - have "closure ((\u. u *\<^sub>R (b - a)) ` {0<..<1}) = (\u. u *\<^sub>R (b - a)) ` closure {0<..<1}" - apply (rule closure_injective_linear_image [symmetric]) - apply (use False in \auto intro!: injI\) - done - then have "closure - ((\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1}) = - (\x. (1 - x) *\<^sub>R a + x *\<^sub>R b) ` closure {0<..<1}" - using closure_translation [of a "((\x. x *\<^sub>R b - x *\<^sub>R a) ` {0<..<1})"] - by (simp add: segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right image_image) - then show ?thesis - by (simp add: segment_image_interval closure_greaterThanLessThan [symmetric] del: closure_greaterThanLessThan) -qed - -lemma closed_open_segment_iff [simp]: - fixes a :: "'a::euclidean_space" shows "closed(open_segment a b) \ a = b" - by (metis open_segment_def DiffE closure_eq closure_open_segment ends_in_segment(1) insert_iff segment_image_interval(2)) - -lemma compact_open_segment_iff [simp]: - fixes a :: "'a::euclidean_space" shows "compact(open_segment a b) \ a = b" - by (simp add: bounded_open_segment compact_eq_bounded_closed) - -lemma convex_closed_segment [iff]: "convex (closed_segment a b)" - unfolding segment_convex_hull by(rule convex_convex_hull) - -lemma convex_open_segment [iff]: "convex (open_segment a b)" -proof - - have "convex ((\u. u *\<^sub>R (b - a)) ` {0<..<1})" - by (rule convex_linear_image) auto - then have "convex ((+) a ` (\u. u *\<^sub>R (b - a)) ` {0<..<1})" - by (rule convex_translation) - then show ?thesis - by (simp add: image_image open_segment_image_interval segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right) -qed - -lemmas convex_segment = convex_closed_segment convex_open_segment - -lemma connected_segment [iff]: - fixes x :: "'a :: real_normed_vector" - shows "connected (closed_segment x y)" - by (simp add: convex_connected) - -lemma is_interval_closed_segment_1[intro, simp]: "is_interval (closed_segment a b)" for a b::real - by (auto simp: is_interval_convex_1) - -lemma IVT'_closed_segment_real: - fixes f :: "real \ real" - assumes "y \ closed_segment (f a) (f b)" - assumes "continuous_on (closed_segment a b) f" - shows "\x \ closed_segment a b. f x = y" - using IVT'[of f a y b] - IVT'[of "-f" a "-y" b] - IVT'[of f b y a] - IVT'[of "-f" b "-y" a] assms - by (cases "a \ b"; cases "f b \ f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus) - -subsection \Betweenness\ - -definition\<^marker>\tag important\ "between = (\(a,b) x. x \ closed_segment a b)" - -lemma betweenI: - assumes "0 \ u" "u \ 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" - shows "between (a, b) x" -using assms unfolding between_def closed_segment_def by auto - -lemma betweenE: - assumes "between (a, b) x" - obtains u where "0 \ u" "u \ 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" -using assms unfolding between_def closed_segment_def by auto - -lemma between_implies_scaled_diff: - assumes "between (S, T) X" "between (S, T) Y" "S \ Y" - obtains c where "(X - Y) = c *\<^sub>R (S - Y)" -proof - - from \between (S, T) X\ obtain u\<^sub>X where X: "X = u\<^sub>X *\<^sub>R S + (1 - u\<^sub>X) *\<^sub>R T" - by (metis add.commute betweenE eq_diff_eq) - from \between (S, T) Y\ obtain u\<^sub>Y where Y: "Y = u\<^sub>Y *\<^sub>R S + (1 - u\<^sub>Y) *\<^sub>R T" - by (metis add.commute betweenE eq_diff_eq) - have "X - Y = (u\<^sub>X - u\<^sub>Y) *\<^sub>R (S - T)" - proof - - from X Y have "X - Y = u\<^sub>X *\<^sub>R S - u\<^sub>Y *\<^sub>R S + ((1 - u\<^sub>X) *\<^sub>R T - (1 - u\<^sub>Y) *\<^sub>R T)" by simp - also have "\ = (u\<^sub>X - u\<^sub>Y) *\<^sub>R S - (u\<^sub>X - u\<^sub>Y) *\<^sub>R T" by (simp add: scaleR_left.diff) - finally show ?thesis by (simp add: real_vector.scale_right_diff_distrib) - qed - moreover from Y have "S - Y = (1 - u\<^sub>Y) *\<^sub>R (S - T)" - by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib) - moreover note \S \ Y\ - ultimately have "(X - Y) = ((u\<^sub>X - u\<^sub>Y) / (1 - u\<^sub>Y)) *\<^sub>R (S - Y)" by auto - from this that show thesis by blast -qed - -lemma between_mem_segment: "between (a,b) x \ x \ closed_segment a b" - unfolding between_def by auto - -lemma between: "between (a, b) (x::'a::euclidean_space) \ dist a b = (dist a x) + (dist x b)" -proof (cases "a = b") - case True - then show ?thesis - by (auto simp add: between_def dist_commute) -next - case False - then have Fal: "norm (a - b) \ 0" and Fal2: "norm (a - b) > 0" - by auto - have *: "\u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" - by (auto simp add: algebra_simps) - have "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)" if "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \ u" "u \ 1" for u - proof - - have *: "a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)" - unfolding that(1) by (auto simp add:algebra_simps) - show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)" - unfolding norm_minus_commute[of x a] * using \0 \ u\ \u \ 1\ - by simp - qed - moreover have "\u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \ 0 \ u \ u \ 1" if "dist a b = dist a x + dist x b" - proof - - let ?\ = "norm (a - x) / norm (a - b)" - show "\u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \ 0 \ u \ u \ 1" - proof (intro exI conjI) - show "?\ \ 1" - using Fal2 unfolding that[unfolded dist_norm] norm_ge_zero by auto - show "x = (1 - ?\) *\<^sub>R a + (?\) *\<^sub>R b" - proof (subst euclidean_eq_iff; intro ballI) - fix i :: 'a - assume i: "i \ Basis" - have "((1 - ?\) *\<^sub>R a + (?\) *\<^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 that[unfolded dist_norm] - using that[unfolded dist_triangle_eq] i - apply (subst (asm) euclidean_eq_iff) - apply (auto simp add: field_simps inner_simps) - done - finally show "x \ i = ((1 - ?\) *\<^sub>R a + (?\) *\<^sub>R b) \ i" - by auto - qed - qed (use Fal2 in auto) - qed - ultimately show ?thesis - by (force simp add: between_def closed_segment_def dist_triangle_eq) -qed - -lemma between_midpoint: - fixes a :: "'a::euclidean_space" - shows "between (a,b) (midpoint a b)" (is ?t1) - and "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 - by (auto simp add: field_simps inner_simps euclidean_eq_iff[where 'a='a] intro!: *) -qed - -lemma between_mem_convex_hull: - "between (a,b) x \ x \ convex hull {a,b}" - unfolding between_mem_segment segment_convex_hull .. - -lemma between_triv_iff [simp]: "between (a,a) b \ a=b" - by (auto simp: between_def) - -lemma between_triv1 [simp]: "between (a,b) a" - by (auto simp: between_def) - -lemma between_triv2 [simp]: "between (a,b) b" - by (auto simp: between_def) - -lemma between_commute: - "between (a,b) = between (b,a)" -by (auto simp: between_def closed_segment_commute) - -lemma between_antisym: - fixes a :: "'a :: euclidean_space" - shows "\between (b,c) a; between (a,c) b\ \ a = b" -by (auto simp: between dist_commute) - -lemma between_trans: - fixes a :: "'a :: euclidean_space" - shows "\between (b,c) a; between (a,c) d\ \ between (b,c) d" - using dist_triangle2 [of b c d] dist_triangle3 [of b d a] - by (auto simp: between dist_commute) - -lemma between_norm: - fixes a :: "'a :: euclidean_space" - shows "between (a,b) x \ norm(x - a) *\<^sub>R (b - x) = norm(b - x) *\<^sub>R (x - a)" - by (auto simp: between dist_triangle_eq norm_minus_commute algebra_simps) - -lemma between_swap: - fixes A B X Y :: "'a::euclidean_space" - assumes "between (A, B) X" - assumes "between (A, B) Y" - shows "between (X, B) Y \ between (A, Y) X" -using assms by (auto simp add: between) - -lemma between_translation [simp]: "between (a + y,a + z) (a + x) \ between (y,z) x" - by (auto simp: between_def) - -lemma between_trans_2: - fixes a :: "'a :: euclidean_space" - shows "\between (b,c) a; between (a,b) d\ \ between (c,d) a" - by (metis between_commute between_swap between_trans) - -lemma between_scaleR_lift [simp]: - fixes v :: "'a::euclidean_space" - shows "between (a *\<^sub>R v, b *\<^sub>R v) (c *\<^sub>R v) \ v = 0 \ between (a, b) c" - by (simp add: between dist_norm scaleR_left_diff_distrib [symmetric] distrib_right [symmetric]) - -lemma between_1: - fixes x::real - shows "between (a,b) x \ (a \ x \ x \ b) \ (b \ x \ x \ a)" - by (auto simp: between_mem_segment closed_segment_eq_real_ivl) - - end diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Derivative.thy --- a/src/HOL/Analysis/Derivative.thy Mon Nov 04 17:59:32 2019 -0500 +++ b/src/HOL/Analysis/Derivative.thy Mon Nov 04 19:53:43 2019 -0500 @@ -7,11 +7,12 @@ theory Derivative imports - Convex_Euclidean_Space + Convex_Euclidean_Space Abstract_Limits Operator_Norm Uniform_Limit Bounded_Linear_Function + Line_Segment begin declare bounded_linear_inner_left [intro] diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Elementary_Metric_Spaces.thy --- a/src/HOL/Analysis/Elementary_Metric_Spaces.thy Mon Nov 04 17:59:32 2019 -0500 +++ b/src/HOL/Analysis/Elementary_Metric_Spaces.thy Mon Nov 04 19:53:43 2019 -0500 @@ -179,11 +179,21 @@ shows "{a .. b} = cball ((a + b)/2) ((b - a)/2)" by (auto simp: dist_real_def field_simps mem_cball) +lemma cball_eq_atLeastAtMost: + fixes a b::real + shows "cball a b = {a - b .. a + b}" + by (auto simp: dist_real_def) + lemma greaterThanLessThan_eq_ball: fixes a b::real shows "{a <..< b} = ball ((a + b)/2) ((b - a)/2)" by (auto simp: dist_real_def field_simps mem_ball) +lemma ball_eq_greaterThanLessThan: + fixes a b::real + shows "ball a b = {a - b <..< a + b}" + by (auto simp: dist_real_def) + lemma interior_ball [simp]: "interior (ball x e) = ball x e" by (simp add: interior_open) diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Line_Segment.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Analysis/Line_Segment.thy Mon Nov 04 19:53:43 2019 -0500 @@ -0,0 +1,1018 @@ +(* Title: HOL/Analysis/Line_Segment.thy + Author: L C Paulson, University of Cambridge + Author: Robert Himmelmann, TU Muenchen + Author: Bogdan Grechuk, University of Edinburgh + Author: Armin Heller, TU Muenchen + Author: Johannes Hoelzl, TU Muenchen +*) + +section \Line Segment\ + +theory Line_Segment +imports + Convex + Topology_Euclidean_Space +begin + +subsection\<^marker>\tag unimportant\ \Topological Properties of Convex Sets and Functions\ + +lemma convex_supp_sum: + assumes "convex S" and 1: "supp_sum u I = 1" + and "\i. i \ I \ 0 \ u i \ (u i = 0 \ f i \ S)" + shows "supp_sum (\i. u i *\<^sub>R f i) I \ S" +proof - + have fin: "finite {i \ I. u i \ 0}" + using 1 sum.infinite by (force simp: supp_sum_def support_on_def) + then have eq: "supp_sum (\i. u i *\<^sub>R f i) I = sum (\i. u i *\<^sub>R f i) {i \ I. u i \ 0}" + by (force intro: sum.mono_neutral_left simp: supp_sum_def support_on_def) + show ?thesis + apply (simp add: eq) + apply (rule convex_sum [OF fin \convex S\]) + using 1 assms apply (auto simp: supp_sum_def support_on_def) + done +qed + +lemma closure_bounded_linear_image_subset: + assumes f: "bounded_linear f" + shows "f ` closure S \ closure (f ` S)" + using linear_continuous_on [OF f] closed_closure closure_subset + by (rule image_closure_subset) + +lemma closure_linear_image_subset: + fixes f :: "'m::euclidean_space \ 'n::real_normed_vector" + assumes "linear f" + shows "f ` (closure S) \ closure (f ` S)" + using assms unfolding linear_conv_bounded_linear + by (rule closure_bounded_linear_image_subset) + +lemma closed_injective_linear_image: + fixes f :: "'a::euclidean_space \ 'b::euclidean_space" + assumes S: "closed S" and f: "linear f" "inj f" + shows "closed (f ` S)" +proof - + obtain g where g: "linear g" "g \ f = id" + using linear_injective_left_inverse [OF f] by blast + then have confg: "continuous_on (range f) g" + using linear_continuous_on linear_conv_bounded_linear by blast + have [simp]: "g ` f ` S = S" + using g by (simp add: image_comp) + have cgf: "closed (g ` f ` S)" + by (simp add: \g \ f = id\ S image_comp) + have [simp]: "(range f \ g -` S) = f ` S" + using g unfolding o_def id_def image_def by auto metis+ + show ?thesis + proof (rule closedin_closed_trans [of "range f"]) + show "closedin (top_of_set (range f)) (f ` S)" + using continuous_closedin_preimage [OF confg cgf] by simp + show "closed (range f)" + apply (rule closed_injective_image_subspace) + using f apply (auto simp: linear_linear linear_injective_0) + done + qed +qed + +lemma closed_injective_linear_image_eq: + fixes f :: "'a::euclidean_space \ 'b::euclidean_space" + assumes f: "linear f" "inj f" + shows "(closed(image f s) \ closed s)" + by (metis closed_injective_linear_image closure_eq closure_linear_image_subset closure_subset_eq f(1) f(2) inj_image_subset_iff) + +lemma closure_injective_linear_image: + fixes f :: "'a::euclidean_space \ 'b::euclidean_space" + shows "\linear f; inj f\ \ f ` (closure S) = closure (f ` S)" + apply (rule subset_antisym) + apply (simp add: closure_linear_image_subset) + by (simp add: closure_minimal closed_injective_linear_image closure_subset image_mono) + +lemma closure_bounded_linear_image: + fixes f :: "'a::euclidean_space \ 'b::euclidean_space" + shows "\linear f; bounded S\ \ f ` (closure S) = closure (f ` S)" + apply (rule subset_antisym, simp add: closure_linear_image_subset) + apply (rule closure_minimal, simp add: closure_subset image_mono) + by (meson bounded_closure closed_closure compact_continuous_image compact_eq_bounded_closed linear_continuous_on linear_conv_bounded_linear) + +lemma closure_scaleR: + fixes S :: "'a::real_normed_vector set" + shows "((*\<^sub>R) c) ` (closure S) = closure (((*\<^sub>R) c) ` S)" +proof + show "((*\<^sub>R) c) ` (closure S) \ closure (((*\<^sub>R) c) ` S)" + using bounded_linear_scaleR_right + by (rule closure_bounded_linear_image_subset) + show "closure (((*\<^sub>R) c) ` S) \ ((*\<^sub>R) c) ` (closure S)" + by (intro closure_minimal image_mono closure_subset closed_scaling closed_closure) +qed + +lemma sphere_eq_empty [simp]: + fixes a :: "'a::{real_normed_vector, perfect_space}" + shows "sphere a r = {} \ r < 0" +by (auto simp: sphere_def dist_norm) (metis dist_norm le_less_linear vector_choose_dist) + +lemma cone_closure: + fixes S :: "'a::real_normed_vector set" + assumes "cone S" + shows "cone (closure S)" +proof (cases "S = {}") + case True + then show ?thesis by auto +next + case False + then have "0 \ S \ (\c. c > 0 \ (*\<^sub>R) c ` S = S)" + using cone_iff[of S] assms by auto + then have "0 \ closure S \ (\c. c > 0 \ (*\<^sub>R) c ` closure S = closure S)" + using closure_subset by (auto simp: closure_scaleR) + then show ?thesis + using False cone_iff[of "closure S"] by auto +qed + + +corollary component_complement_connected: + fixes S :: "'a::real_normed_vector set" + assumes "connected S" "C \ components (-S)" + shows "connected(-C)" + using component_diff_connected [of S UNIV] assms + by (auto simp: Compl_eq_Diff_UNIV) + +proposition clopen: + fixes S :: "'a :: real_normed_vector set" + shows "closed S \ open S \ S = {} \ S = UNIV" + by (force intro!: connected_UNIV [unfolded connected_clopen, rule_format]) + +corollary compact_open: + fixes S :: "'a :: euclidean_space set" + shows "compact S \ open S \ S = {}" + by (auto simp: compact_eq_bounded_closed clopen) + +corollary finite_imp_not_open: + fixes S :: "'a::{real_normed_vector, perfect_space} set" + shows "\finite S; open S\ \ S={}" + using clopen [of S] finite_imp_closed not_bounded_UNIV by blast + +corollary empty_interior_finite: + fixes S :: "'a::{real_normed_vector, perfect_space} set" + shows "finite S \ interior S = {}" + by (metis interior_subset finite_subset open_interior [of S] finite_imp_not_open) + +text \Balls, being convex, are connected.\ + +lemma convex_local_global_minimum: + fixes s :: "'a::real_normed_vector set" + assumes "e > 0" + and "convex_on s f" + and "ball x e \ s" + and "\y\ball x e. f x \ f y" + shows "\y\s. f x \ f y" +proof (rule ccontr) + have "x \ s" using assms(1,3) by auto + assume "\ ?thesis" + then obtain y where "y\s" and y: "f x > f y" by auto + then have xy: "0 < dist x y" by auto + then obtain u where "0 < u" "u \ 1" and u: "u < e / dist x y" + using field_lbound_gt_zero[of 1 "e / dist x y"] xy \e>0\ by auto + then have "f ((1-u) *\<^sub>R x + u *\<^sub>R y) \ (1-u) * f x + u * f y" + using \x\s\ \y\s\ + using assms(2)[unfolded convex_on_def, + THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x="1-u"]] + by auto + moreover + have *: "x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" + by (simp add: algebra_simps) + have "(1 - u) *\<^sub>R x + u *\<^sub>R y \ ball x e" + unfolding mem_ball dist_norm + unfolding * and norm_scaleR and abs_of_pos[OF \0] + unfolding dist_norm[symmetric] + using u + unfolding pos_less_divide_eq[OF xy] + by auto + then have "f x \ f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" + using assms(4) by auto + ultimately show False + using mult_strict_left_mono[OF y \u>0\] + unfolding left_diff_distrib + by auto +qed + +lemma convex_ball [iff]: + fixes x :: "'a::real_normed_vector" + shows "convex (ball x e)" +proof (auto simp: convex_def) + fix y z + assume yz: "dist x y < e" "dist x z < e" + fix u v :: real + assume uv: "0 \ u" "0 \ v" "u + v = 1" + have "dist x (u *\<^sub>R y + v *\<^sub>R z) \ u * dist x y + v * dist x z" + using uv yz + using convex_on_dist [of "ball x e" x, unfolded convex_on_def, + THEN bspec[where x=y], THEN bspec[where x=z]] + by auto + then show "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" + using convex_bound_lt[OF yz uv] by auto +qed + +lemma convex_cball [iff]: + fixes x :: "'a::real_normed_vector" + shows "convex (cball x e)" +proof - + { + fix y z + assume yz: "dist x y \ e" "dist x z \ e" + fix u v :: real + assume uv: "0 \ u" "0 \ v" "u + v = 1" + have "dist x (u *\<^sub>R y + v *\<^sub>R z) \ u * dist x y + v * dist x z" + using uv yz + using convex_on_dist [of "cball x e" x, unfolded convex_on_def, + THEN bspec[where x=y], THEN bspec[where x=z]] + by auto + then have "dist x (u *\<^sub>R y + v *\<^sub>R z) \ e" + using convex_bound_le[OF yz uv] by auto + } + then show ?thesis by (auto simp: convex_def Ball_def) +qed + +lemma connected_ball [iff]: + fixes x :: "'a::real_normed_vector" + shows "connected (ball x e)" + using convex_connected convex_ball by auto + +lemma connected_cball [iff]: + fixes x :: "'a::real_normed_vector" + shows "connected (cball x e)" + using convex_connected convex_cball by auto + +lemma bounded_convex_hull: + fixes s :: "'a::real_normed_vector set" + assumes "bounded s" + shows "bounded (convex hull s)" +proof - + from assms obtain B where B: "\x\s. norm x \ B" + unfolding bounded_iff by auto + show ?thesis + apply (rule bounded_subset[OF bounded_cball, of _ 0 B]) + unfolding subset_hull[of convex, OF convex_cball] + unfolding subset_eq mem_cball dist_norm using B + apply auto + done +qed + +lemma finite_imp_bounded_convex_hull: + fixes s :: "'a::real_normed_vector set" + shows "finite s \ bounded (convex hull s)" + using bounded_convex_hull finite_imp_bounded + by auto + + +section \Line Segments\ + +subsection \Midpoint\ + +definition\<^marker>\tag important\ midpoint :: "'a::real_vector \ 'a \ 'a" + where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)" + +lemma midpoint_idem [simp]: "midpoint x x = x" + unfolding midpoint_def by simp + +lemma midpoint_sym: "midpoint a b = midpoint b a" + unfolding midpoint_def by (auto simp add: scaleR_right_distrib) + +lemma midpoint_eq_iff: "midpoint a b = c \ a + b = c + c" +proof - + have "midpoint a b = c \ scaleR 2 (midpoint a b) = scaleR 2 c" + by simp + then show ?thesis + unfolding midpoint_def scaleR_2 [symmetric] by simp +qed + +lemma + fixes a::real + assumes "a \ b" shows ge_midpoint_1: "a \ midpoint a b" + and le_midpoint_1: "midpoint a b \ b" + by (simp_all add: midpoint_def assms) + +lemma dist_midpoint: + fixes a b :: "'a::real_normed_vector" shows + "dist a (midpoint a b) = (dist a b) / 2" (is ?t1) + "dist b (midpoint a b) = (dist a b) / 2" (is ?t2) + "dist (midpoint a b) a = (dist a b) / 2" (is ?t3) + "dist (midpoint a b) b = (dist a b) / 2" (is ?t4) +proof - + have *: "\x y::'a. 2 *\<^sub>R x = - y \ norm x = (norm y) / 2" + unfolding equation_minus_iff by auto + have **: "\x y::'a. 2 *\<^sub>R x = y \ norm x = (norm y) / 2" + by auto + note scaleR_right_distrib [simp] + show ?t1 + unfolding midpoint_def dist_norm + apply (rule **) + apply (simp add: scaleR_right_diff_distrib) + apply (simp add: scaleR_2) + done + show ?t2 + unfolding midpoint_def dist_norm + apply (rule *) + apply (simp add: scaleR_right_diff_distrib) + apply (simp add: scaleR_2) + done + show ?t3 + unfolding midpoint_def dist_norm + apply (rule *) + apply (simp add: scaleR_right_diff_distrib) + apply (simp add: scaleR_2) + done + show ?t4 + unfolding midpoint_def dist_norm + apply (rule **) + apply (simp add: scaleR_right_diff_distrib) + apply (simp add: scaleR_2) + done +qed + +lemma midpoint_eq_endpoint [simp]: + "midpoint a b = a \ a = b" + "midpoint a b = b \ a = b" + unfolding midpoint_eq_iff by auto + +lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b" + using midpoint_eq_iff by metis + +lemma midpoint_linear_image: + "linear f \ midpoint(f a)(f b) = f(midpoint a b)" +by (simp add: linear_iff midpoint_def) + + +subsection \Line segments\ + +definition\<^marker>\tag important\ closed_segment :: "'a::real_vector \ 'a \ 'a set" + where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \ u \ u \ 1}" + +definition\<^marker>\tag important\ open_segment :: "'a::real_vector \ 'a \ 'a set" where + "open_segment a b \ closed_segment a b - {a,b}" + +lemmas segment = open_segment_def closed_segment_def + +lemma in_segment: + "x \ closed_segment a b \ (\u. 0 \ u \ u \ 1 \ x = (1 - u) *\<^sub>R a + u *\<^sub>R b)" + "x \ open_segment a b \ a \ b \ (\u. 0 < u \ u < 1 \ x = (1 - u) *\<^sub>R a + u *\<^sub>R b)" + using less_eq_real_def by (auto simp: segment algebra_simps) + +lemma closed_segment_linear_image: + "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f" +proof - + interpret linear f by fact + show ?thesis + by (force simp add: in_segment add scale) +qed + +lemma open_segment_linear_image: + "\linear f; inj f\ \ open_segment (f a) (f b) = f ` (open_segment a b)" + by (force simp: open_segment_def closed_segment_linear_image inj_on_def) + +lemma closed_segment_translation: + "closed_segment (c + a) (c + b) = image (\x. c + x) (closed_segment a b)" +apply safe +apply (rule_tac x="x-c" in image_eqI) +apply (auto simp: in_segment algebra_simps) +done + +lemma open_segment_translation: + "open_segment (c + a) (c + b) = image (\x. c + x) (open_segment a b)" +by (simp add: open_segment_def closed_segment_translation translation_diff) + +lemma closed_segment_of_real: + "closed_segment (of_real x) (of_real y) = of_real ` closed_segment x y" + apply (auto simp: image_iff in_segment scaleR_conv_of_real) + apply (rule_tac x="(1-u)*x + u*y" in bexI) + apply (auto simp: in_segment) + done + +lemma open_segment_of_real: + "open_segment (of_real x) (of_real y) = of_real ` open_segment x y" + apply (auto simp: image_iff in_segment scaleR_conv_of_real) + apply (rule_tac x="(1-u)*x + u*y" in bexI) + apply (auto simp: in_segment) + done + +lemma closed_segment_Reals: + "\x \ Reals; y \ Reals\ \ closed_segment x y = of_real ` closed_segment (Re x) (Re y)" + by (metis closed_segment_of_real of_real_Re) + +lemma open_segment_Reals: + "\x \ Reals; y \ Reals\ \ open_segment x y = of_real ` open_segment (Re x) (Re y)" + by (metis open_segment_of_real of_real_Re) + +lemma open_segment_PairD: + "(x, x') \ open_segment (a, a') (b, b') + \ (x \ open_segment a b \ a = b) \ (x' \ open_segment a' b' \ a' = b')" + by (auto simp: in_segment) + +lemma closed_segment_PairD: + "(x, x') \ closed_segment (a, a') (b, b') \ x \ closed_segment a b \ x' \ closed_segment a' b'" + by (auto simp: closed_segment_def) + +lemma closed_segment_translation_eq [simp]: + "d + x \ closed_segment (d + a) (d + b) \ x \ closed_segment a b" +proof - + have *: "\d x a b. x \ closed_segment a b \ d + x \ closed_segment (d + a) (d + b)" + apply (simp add: closed_segment_def) + apply (erule ex_forward) + apply (simp add: algebra_simps) + done + show ?thesis + using * [where d = "-d"] * + by (fastforce simp add:) +qed + +lemma open_segment_translation_eq [simp]: + "d + x \ open_segment (d + a) (d + b) \ x \ open_segment a b" + by (simp add: open_segment_def) + +lemma of_real_closed_segment [simp]: + "of_real x \ closed_segment (of_real a) (of_real b) \ x \ closed_segment a b" + apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward) + using of_real_eq_iff by fastforce + +lemma of_real_open_segment [simp]: + "of_real x \ open_segment (of_real a) (of_real b) \ x \ open_segment a b" + apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward del: exE) + using of_real_eq_iff by fastforce + +lemma convex_contains_segment: + "convex S \ (\a\S. \b\S. closed_segment a b \ S)" + unfolding convex_alt closed_segment_def by auto + +lemma closed_segment_in_Reals: + "\x \ closed_segment a b; a \ Reals; b \ Reals\ \ x \ Reals" + by (meson subsetD convex_Reals convex_contains_segment) + +lemma open_segment_in_Reals: + "\x \ open_segment a b; a \ Reals; b \ Reals\ \ x \ Reals" + by (metis Diff_iff closed_segment_in_Reals open_segment_def) + +lemma closed_segment_subset: "\x \ S; y \ S; convex S\ \ closed_segment x y \ S" + by (simp add: convex_contains_segment) + +lemma closed_segment_subset_convex_hull: + "\x \ convex hull S; y \ convex hull S\ \ closed_segment x y \ convex hull S" + using convex_contains_segment by blast + +lemma segment_convex_hull: + "closed_segment a b = convex hull {a,b}" +proof - + have *: "\x. {x} \ {}" by auto + show ?thesis + unfolding segment convex_hull_insert[OF *] convex_hull_singleton + by (safe; rule_tac x="1 - u" in exI; force) +qed + +lemma open_closed_segment: "u \ open_segment w z \ u \ closed_segment w z" + by (auto simp add: closed_segment_def open_segment_def) + +lemma segment_open_subset_closed: + "open_segment a b \ closed_segment a b" + by (auto simp: closed_segment_def open_segment_def) + +lemma bounded_closed_segment: + fixes a :: "'a::real_normed_vector" shows "bounded (closed_segment a b)" + by (rule boundedI[where B="max (norm a) (norm b)"]) + (auto simp: closed_segment_def max_def convex_bound_le intro!: norm_triangle_le) + +lemma bounded_open_segment: + fixes a :: "'a::real_normed_vector" shows "bounded (open_segment a b)" + by (rule bounded_subset [OF bounded_closed_segment segment_open_subset_closed]) + +lemmas bounded_segment = bounded_closed_segment open_closed_segment + +lemma ends_in_segment [iff]: "a \ closed_segment a b" "b \ closed_segment a b" + unfolding segment_convex_hull + by (auto intro!: hull_subset[unfolded subset_eq, rule_format]) + + +lemma eventually_closed_segment: + fixes x0::"'a::real_normed_vector" + assumes "open X0" "x0 \ X0" + shows "\\<^sub>F x in at x0 within U. closed_segment x0 x \ X0" +proof - + from openE[OF assms] + obtain e where e: "0 < e" "ball x0 e \ X0" . + then have "\\<^sub>F x in at x0 within U. x \ ball x0 e" + by (auto simp: dist_commute eventually_at) + then show ?thesis + proof eventually_elim + case (elim x) + have "x0 \ ball x0 e" using \e > 0\ by simp + from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim] + have "closed_segment x0 x \ ball x0 e" . + also note \\ \ X0\ + finally show ?case . + qed +qed + +lemma closed_segment_commute: "closed_segment a b = closed_segment b a" +proof - + have "{a, b} = {b, a}" by auto + thus ?thesis + by (simp add: segment_convex_hull) +qed + +lemma segment_bound1: + assumes "x \ closed_segment a b" + shows "norm (x - a) \ norm (b - a)" +proof - + obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \ u" "u \ 1" + using assms by (auto simp add: closed_segment_def) + then show "norm (x - a) \ norm (b - a)" + apply clarify + apply (auto simp: algebra_simps) + apply (simp add: scaleR_diff_right [symmetric] mult_left_le_one_le) + done +qed + +lemma segment_bound: + assumes "x \ closed_segment a b" + shows "norm (x - a) \ norm (b - a)" "norm (x - b) \ norm (b - a)" +apply (simp add: assms segment_bound1) +by (metis assms closed_segment_commute dist_commute dist_norm segment_bound1) + +lemma open_segment_commute: "open_segment a b = open_segment b a" +proof - + have "{a, b} = {b, a}" by auto + thus ?thesis + by (simp add: closed_segment_commute open_segment_def) +qed + +lemma closed_segment_idem [simp]: "closed_segment a a = {a}" + unfolding segment by (auto simp add: algebra_simps) + +lemma open_segment_idem [simp]: "open_segment a a = {}" + by (simp add: open_segment_def) + +lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \ {a,b}" + using open_segment_def by auto + +lemma convex_contains_open_segment: + "convex s \ (\a\s. \b\s. open_segment a b \ s)" + by (simp add: convex_contains_segment closed_segment_eq_open) + +lemma closed_segment_eq_real_ivl1: + fixes a b::real + assumes "a \ b" + shows "closed_segment a b = {a .. b}" +proof safe + fix x + assume "x \ closed_segment a b" + then obtain u where u: "0 \ u" "u \ 1" and x_def: "x = (1 - u) * a + u * b" + by (auto simp: closed_segment_def) + have "u * a \ u * b" "(1 - u) * a \ (1 - u) * b" + by (auto intro!: mult_left_mono u assms) + then show "x \ {a .. b}" + unfolding x_def by (auto simp: algebra_simps) +qed (auto simp: closed_segment_def divide_simps algebra_simps + intro!: exI[where x="(x - a) / (b - a)" for x]) + +lemma closed_segment_eq_real_ivl: + fixes a b::real + shows "closed_segment a b = (if a \ b then {a .. b} else {b .. a})" + using closed_segment_eq_real_ivl1[of a b] closed_segment_eq_real_ivl1[of b a] + by (auto simp: closed_segment_commute) + +lemma open_segment_eq_real_ivl: + fixes a b::real + shows "open_segment a b = (if a \ b then {a<..x. (v - u) * x + u) ` {0..1}" + by (simp add: add.commute [of u] image_affinity_atLeastAtMost [where c=u] closed_segment_eq_real_ivl) + +lemma dist_in_closed_segment: + fixes a :: "'a :: euclidean_space" + assumes "x \ closed_segment a b" + shows "dist x a \ dist a b \ dist x b \ dist a b" +proof (intro conjI) + obtain u where u: "0 \ u" "u \ 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" + using assms by (force simp: in_segment algebra_simps) + have "dist x a = u * dist a b" + apply (simp add: dist_norm algebra_simps x) + by (metis \0 \ u\ abs_of_nonneg norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib) + also have "... \ dist a b" + by (simp add: mult_left_le_one_le u) + finally show "dist x a \ dist a b" . + have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)" + by (simp add: dist_norm algebra_simps x) + also have "... = (1-u) * dist a b" + proof - + have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)" + using \u \ 1\ by force + then show ?thesis + by (simp add: dist_norm real_vector.scale_right_diff_distrib) + qed + also have "... \ dist a b" + by (simp add: mult_left_le_one_le u) + finally show "dist x b \ dist a b" . +qed + +lemma dist_in_open_segment: + fixes a :: "'a :: euclidean_space" + assumes "x \ open_segment a b" + shows "dist x a < dist a b \ dist x b < dist a b" +proof (intro conjI) + obtain u where u: "0 < u" "u < 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" + using assms by (force simp: in_segment algebra_simps) + have "dist x a = u * dist a b" + apply (simp add: dist_norm algebra_simps x) + by (metis abs_of_nonneg less_eq_real_def norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib \0 < u\) + also have *: "... < dist a b" + by (metis (no_types) assms dist_eq_0_iff dist_not_less_zero in_segment(2) linorder_neqE_linordered_idom mult.left_neutral real_mult_less_iff1 \u < 1\) + finally show "dist x a < dist a b" . + have ab_ne0: "dist a b \ 0" + using * by fastforce + have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)" + by (simp add: dist_norm algebra_simps x) + also have "... = (1-u) * dist a b" + proof - + have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)" + using \u < 1\ by force + then show ?thesis + by (simp add: dist_norm real_vector.scale_right_diff_distrib) + qed + also have "... < dist a b" + using ab_ne0 \0 < u\ by simp + finally show "dist x b < dist a b" . +qed + +lemma dist_decreases_open_segment_0: + fixes x :: "'a :: euclidean_space" + assumes "x \ open_segment 0 b" + shows "dist c x < dist c 0 \ dist c x < dist c b" +proof (rule ccontr, clarsimp simp: not_less) + obtain u where u: "0 \ b" "0 < u" "u < 1" and x: "x = u *\<^sub>R b" + using assms by (auto simp: in_segment) + have xb: "x \ b < b \ b" + using u x by auto + assume "norm c \ dist c x" + then have "c \ c \ (c - x) \ (c - x)" + by (simp add: dist_norm norm_le) + moreover have "0 < x \ b" + using u x by auto + ultimately have less: "c \ b < x \ b" + by (simp add: x algebra_simps inner_commute u) + assume "dist c b \ dist c x" + then have "(c - b) \ (c - b) \ (c - x) \ (c - x)" + by (simp add: dist_norm norm_le) + then have "(b \ b) * (1 - u*u) \ 2 * (b \ c) * (1-u)" + by (simp add: x algebra_simps inner_commute) + then have "(1+u) * (b \ b) * (1-u) \ 2 * (b \ c) * (1-u)" + by (simp add: algebra_simps) + then have "(1+u) * (b \ b) \ 2 * (b \ c)" + using \u < 1\ by auto + with xb have "c \ b \ x \ b" + by (auto simp: x algebra_simps inner_commute) + with less show False by auto +qed + +proposition dist_decreases_open_segment: + fixes a :: "'a :: euclidean_space" + assumes "x \ open_segment a b" + shows "dist c x < dist c a \ dist c x < dist c b" +proof - + have *: "x - a \ open_segment 0 (b - a)" using assms + by (metis diff_self open_segment_translation_eq uminus_add_conv_diff) + show ?thesis + using dist_decreases_open_segment_0 [OF *, of "c-a"] assms + by (simp add: dist_norm) +qed + +corollary open_segment_furthest_le: + fixes a b x y :: "'a::euclidean_space" + assumes "x \ open_segment a b" + shows "norm (y - x) < norm (y - a) \ norm (y - x) < norm (y - b)" + by (metis assms dist_decreases_open_segment dist_norm) + +corollary dist_decreases_closed_segment: + fixes a :: "'a :: euclidean_space" + assumes "x \ closed_segment a b" + shows "dist c x \ dist c a \ dist c x \ dist c b" +apply (cases "x \ open_segment a b") + using dist_decreases_open_segment less_eq_real_def apply blast +by (metis DiffI assms empty_iff insertE open_segment_def order_refl) + +corollary segment_furthest_le: + fixes a b x y :: "'a::euclidean_space" + assumes "x \ closed_segment a b" + shows "norm (y - x) \ norm (y - a) \ norm (y - x) \ norm (y - b)" + by (metis assms dist_decreases_closed_segment dist_norm) + +lemma convex_intermediate_ball: + fixes a :: "'a :: euclidean_space" + shows "\ball a r \ T; T \ cball a r\ \ convex T" +apply (simp add: convex_contains_open_segment, clarify) +by (metis (no_types, hide_lams) less_le_trans mem_ball mem_cball subsetCE dist_decreases_open_segment) + +lemma csegment_midpoint_subset: "closed_segment (midpoint a b) b \ closed_segment a b" + apply (clarsimp simp: midpoint_def in_segment) + apply (rule_tac x="(1 + u) / 2" in exI) + apply (auto simp: algebra_simps add_divide_distrib diff_divide_distrib) + by (metis field_sum_of_halves scaleR_left.add) + +lemma notin_segment_midpoint: + fixes a :: "'a :: euclidean_space" + shows "a \ b \ a \ closed_segment (midpoint a b) b" +by (auto simp: dist_midpoint dest!: dist_in_closed_segment) + +subsubsection\More lemmas, especially for working with the underlying formula\ + +lemma segment_eq_compose: + fixes a :: "'a :: real_vector" + shows "(\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) = (\x. a + x) o (\u. u *\<^sub>R (b - a))" + by (simp add: o_def algebra_simps) + +lemma segment_degen_1: + fixes a :: "'a :: real_vector" + shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = b \ a=b \ u=1" +proof - + { assume "(1 - u) *\<^sub>R a + u *\<^sub>R b = b" + then have "(1 - u) *\<^sub>R a = (1 - u) *\<^sub>R b" + by (simp add: algebra_simps) + then have "a=b \ u=1" + by simp + } then show ?thesis + by (auto simp: algebra_simps) +qed + +lemma segment_degen_0: + fixes a :: "'a :: real_vector" + shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = a \ a=b \ u=0" + using segment_degen_1 [of "1-u" b a] + by (auto simp: algebra_simps) + +lemma add_scaleR_degen: + fixes a b ::"'a::real_vector" + assumes "(u *\<^sub>R b + v *\<^sub>R a) = (u *\<^sub>R a + v *\<^sub>R b)" "u \ v" + shows "a=b" + by (metis (no_types, hide_lams) add.commute add_diff_eq diff_add_cancel real_vector.scale_cancel_left real_vector.scale_left_diff_distrib assms) + +lemma closed_segment_image_interval: + "closed_segment a b = (\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0..1}" + by (auto simp: set_eq_iff image_iff closed_segment_def) + +lemma open_segment_image_interval: + "open_segment a b = (if a=b then {} else (\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1})" + by (auto simp: open_segment_def closed_segment_def segment_degen_0 segment_degen_1) + +lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval + +lemma open_segment_bound1: + assumes "x \ open_segment a b" + shows "norm (x - a) < norm (b - a)" +proof - + obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 < u" "u < 1" "a \ b" + using assms by (auto simp add: open_segment_image_interval split: if_split_asm) + then show "norm (x - a) < norm (b - a)" + apply clarify + apply (auto simp: algebra_simps) + apply (simp add: scaleR_diff_right [symmetric]) + done +qed + +lemma compact_segment [simp]: + fixes a :: "'a::real_normed_vector" + shows "compact (closed_segment a b)" + by (auto simp: segment_image_interval intro!: compact_continuous_image continuous_intros) + +lemma closed_segment [simp]: + fixes a :: "'a::real_normed_vector" + shows "closed (closed_segment a b)" + by (simp add: compact_imp_closed) + +lemma closure_closed_segment [simp]: + fixes a :: "'a::real_normed_vector" + shows "closure(closed_segment a b) = closed_segment a b" + by simp + +lemma open_segment_bound: + assumes "x \ open_segment a b" + shows "norm (x - a) < norm (b - a)" "norm (x - b) < norm (b - a)" +apply (simp add: assms open_segment_bound1) +by (metis assms norm_minus_commute open_segment_bound1 open_segment_commute) + +lemma closure_open_segment [simp]: + "closure (open_segment a b) = (if a = b then {} else closed_segment a b)" + for a :: "'a::euclidean_space" +proof (cases "a = b") + case True + then show ?thesis + by simp +next + case False + have "closure ((\u. u *\<^sub>R (b - a)) ` {0<..<1}) = (\u. u *\<^sub>R (b - a)) ` closure {0<..<1}" + apply (rule closure_injective_linear_image [symmetric]) + apply (use False in \auto intro!: injI\) + done + then have "closure + ((\u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1}) = + (\x. (1 - x) *\<^sub>R a + x *\<^sub>R b) ` closure {0<..<1}" + using closure_translation [of a "((\x. x *\<^sub>R b - x *\<^sub>R a) ` {0<..<1})"] + by (simp add: segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right image_image) + then show ?thesis + by (simp add: segment_image_interval closure_greaterThanLessThan [symmetric] del: closure_greaterThanLessThan) +qed + +lemma closed_open_segment_iff [simp]: + fixes a :: "'a::euclidean_space" shows "closed(open_segment a b) \ a = b" + by (metis open_segment_def DiffE closure_eq closure_open_segment ends_in_segment(1) insert_iff segment_image_interval(2)) + +lemma compact_open_segment_iff [simp]: + fixes a :: "'a::euclidean_space" shows "compact(open_segment a b) \ a = b" + by (simp add: bounded_open_segment compact_eq_bounded_closed) + +lemma convex_closed_segment [iff]: "convex (closed_segment a b)" + unfolding segment_convex_hull by(rule convex_convex_hull) + +lemma convex_open_segment [iff]: "convex (open_segment a b)" +proof - + have "convex ((\u. u *\<^sub>R (b - a)) ` {0<..<1})" + by (rule convex_linear_image) auto + then have "convex ((+) a ` (\u. u *\<^sub>R (b - a)) ` {0<..<1})" + by (rule convex_translation) + then show ?thesis + by (simp add: image_image open_segment_image_interval segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right) +qed + +lemmas convex_segment = convex_closed_segment convex_open_segment + +lemma connected_segment [iff]: + fixes x :: "'a :: real_normed_vector" + shows "connected (closed_segment x y)" + by (simp add: convex_connected) + +lemma is_interval_closed_segment_1[intro, simp]: "is_interval (closed_segment a b)" for a b::real + unfolding closed_segment_eq_real_ivl + by (auto simp: is_interval_def) + +lemma IVT'_closed_segment_real: + fixes f :: "real \ real" + assumes "y \ closed_segment (f a) (f b)" + assumes "continuous_on (closed_segment a b) f" + shows "\x \ closed_segment a b. f x = y" + using IVT'[of f a y b] + IVT'[of "-f" a "-y" b] + IVT'[of f b y a] + IVT'[of "-f" b "-y" a] assms + by (cases "a \ b"; cases "f b \ f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus) + +subsection \Betweenness\ + +definition\<^marker>\tag important\ "between = (\(a,b) x. x \ closed_segment a b)" + +lemma betweenI: + assumes "0 \ u" "u \ 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" + shows "between (a, b) x" +using assms unfolding between_def closed_segment_def by auto + +lemma betweenE: + assumes "between (a, b) x" + obtains u where "0 \ u" "u \ 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" +using assms unfolding between_def closed_segment_def by auto + +lemma between_implies_scaled_diff: + assumes "between (S, T) X" "between (S, T) Y" "S \ Y" + obtains c where "(X - Y) = c *\<^sub>R (S - Y)" +proof - + from \between (S, T) X\ obtain u\<^sub>X where X: "X = u\<^sub>X *\<^sub>R S + (1 - u\<^sub>X) *\<^sub>R T" + by (metis add.commute betweenE eq_diff_eq) + from \between (S, T) Y\ obtain u\<^sub>Y where Y: "Y = u\<^sub>Y *\<^sub>R S + (1 - u\<^sub>Y) *\<^sub>R T" + by (metis add.commute betweenE eq_diff_eq) + have "X - Y = (u\<^sub>X - u\<^sub>Y) *\<^sub>R (S - T)" + proof - + from X Y have "X - Y = u\<^sub>X *\<^sub>R S - u\<^sub>Y *\<^sub>R S + ((1 - u\<^sub>X) *\<^sub>R T - (1 - u\<^sub>Y) *\<^sub>R T)" by simp + also have "\ = (u\<^sub>X - u\<^sub>Y) *\<^sub>R S - (u\<^sub>X - u\<^sub>Y) *\<^sub>R T" by (simp add: scaleR_left.diff) + finally show ?thesis by (simp add: real_vector.scale_right_diff_distrib) + qed + moreover from Y have "S - Y = (1 - u\<^sub>Y) *\<^sub>R (S - T)" + by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib) + moreover note \S \ Y\ + ultimately have "(X - Y) = ((u\<^sub>X - u\<^sub>Y) / (1 - u\<^sub>Y)) *\<^sub>R (S - Y)" by auto + from this that show thesis by blast +qed + +lemma between_mem_segment: "between (a,b) x \ x \ closed_segment a b" + unfolding between_def by auto + +lemma between: "between (a, b) (x::'a::euclidean_space) \ dist a b = (dist a x) + (dist x b)" +proof (cases "a = b") + case True + then show ?thesis + by (auto simp add: between_def dist_commute) +next + case False + then have Fal: "norm (a - b) \ 0" and Fal2: "norm (a - b) > 0" + by auto + have *: "\u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" + by (auto simp add: algebra_simps) + have "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)" if "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \ u" "u \ 1" for u + proof - + have *: "a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)" + unfolding that(1) by (auto simp add:algebra_simps) + show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)" + unfolding norm_minus_commute[of x a] * using \0 \ u\ \u \ 1\ + by simp + qed + moreover have "\u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \ 0 \ u \ u \ 1" if "dist a b = dist a x + dist x b" + proof - + let ?\ = "norm (a - x) / norm (a - b)" + show "\u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \ 0 \ u \ u \ 1" + proof (intro exI conjI) + show "?\ \ 1" + using Fal2 unfolding that[unfolded dist_norm] norm_ge_zero by auto + show "x = (1 - ?\) *\<^sub>R a + (?\) *\<^sub>R b" + proof (subst euclidean_eq_iff; intro ballI) + fix i :: 'a + assume i: "i \ Basis" + have "((1 - ?\) *\<^sub>R a + (?\) *\<^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 that[unfolded dist_norm] + using that[unfolded dist_triangle_eq] i + apply (subst (asm) euclidean_eq_iff) + apply (auto simp add: field_simps inner_simps) + done + finally show "x \ i = ((1 - ?\) *\<^sub>R a + (?\) *\<^sub>R b) \ i" + by auto + qed + qed (use Fal2 in auto) + qed + ultimately show ?thesis + by (force simp add: between_def closed_segment_def dist_triangle_eq) +qed + +lemma between_midpoint: + fixes a :: "'a::euclidean_space" + shows "between (a,b) (midpoint a b)" (is ?t1) + and "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 + by (auto simp add: field_simps inner_simps euclidean_eq_iff[where 'a='a] intro!: *) +qed + +lemma between_mem_convex_hull: + "between (a,b) x \ x \ convex hull {a,b}" + unfolding between_mem_segment segment_convex_hull .. + +lemma between_triv_iff [simp]: "between (a,a) b \ a=b" + by (auto simp: between_def) + +lemma between_triv1 [simp]: "between (a,b) a" + by (auto simp: between_def) + +lemma between_triv2 [simp]: "between (a,b) b" + by (auto simp: between_def) + +lemma between_commute: + "between (a,b) = between (b,a)" +by (auto simp: between_def closed_segment_commute) + +lemma between_antisym: + fixes a :: "'a :: euclidean_space" + shows "\between (b,c) a; between (a,c) b\ \ a = b" +by (auto simp: between dist_commute) + +lemma between_trans: + fixes a :: "'a :: euclidean_space" + shows "\between (b,c) a; between (a,c) d\ \ between (b,c) d" + using dist_triangle2 [of b c d] dist_triangle3 [of b d a] + by (auto simp: between dist_commute) + +lemma between_norm: + fixes a :: "'a :: euclidean_space" + shows "between (a,b) x \ norm(x - a) *\<^sub>R (b - x) = norm(b - x) *\<^sub>R (x - a)" + by (auto simp: between dist_triangle_eq norm_minus_commute algebra_simps) + +lemma between_swap: + fixes A B X Y :: "'a::euclidean_space" + assumes "between (A, B) X" + assumes "between (A, B) Y" + shows "between (X, B) Y \ between (A, Y) X" +using assms by (auto simp add: between) + +lemma between_translation [simp]: "between (a + y,a + z) (a + x) \ between (y,z) x" + by (auto simp: between_def) + +lemma between_trans_2: + fixes a :: "'a :: euclidean_space" + shows "\between (b,c) a; between (a,b) d\ \ between (c,d) a" + by (metis between_commute between_swap between_trans) + +lemma between_scaleR_lift [simp]: + fixes v :: "'a::euclidean_space" + shows "between (a *\<^sub>R v, b *\<^sub>R v) (c *\<^sub>R v) \ v = 0 \ between (a, b) c" + by (simp add: between dist_norm scaleR_left_diff_distrib [symmetric] distrib_right [symmetric]) + +lemma between_1: + fixes x::real + shows "between (a,b) x \ (a \ x \ x \ b) \ (b \ x \ x \ a)" + by (auto simp: between_mem_segment closed_segment_eq_real_ivl) + +end \ No newline at end of file diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Starlike.thy --- a/src/HOL/Analysis/Starlike.thy Mon Nov 04 17:59:32 2019 -0500 +++ b/src/HOL/Analysis/Starlike.thy Mon Nov 04 19:53:43 2019 -0500 @@ -8,7 +8,10 @@ chapter \Unsorted\ theory Starlike -imports Convex_Euclidean_Space Abstract_Limits + imports + Convex_Euclidean_Space + Abstract_Limits + Line_Segment begin subsection\Starlike sets\ diff -r b212ee44f87c -r c2465b429e6e src/HOL/Analysis/Topology_Euclidean_Space.thy --- a/src/HOL/Analysis/Topology_Euclidean_Space.thy Mon Nov 04 17:59:32 2019 -0500 +++ b/src/HOL/Analysis/Topology_Euclidean_Space.thy Mon Nov 04 19:53:43 2019 -0500 @@ -1108,6 +1108,12 @@ using is_interval_translation[of "-c" X] by (metis image_cong uminus_add_conv_diff) +lemma is_interval_cball_1[intro, simp]: "is_interval (cball a b)" for a b::real + by (simp add: cball_eq_atLeastAtMost is_interval_def) + +lemma is_interval_ball_real: "is_interval (ball a b)" for a b::real + by (simp add: ball_eq_greaterThanLessThan is_interval_def) + subsection\<^marker>\tag unimportant\ \Bounded Projections\