| author | Fabian Huch <huch@in.tum.de> | 
| Tue, 11 Jun 2024 14:27:04 +0200 | |
| changeset 80347 | 613ac8c77a84 | 
| parent 79582 | 7822b55b26ce | 
| permissions | -rw-r--r-- | 
| 71028 | 1 | (* Title: HOL/Analysis/Line_Segment.thy | 
| 2 | Author: L C Paulson, University of Cambridge | |
| 3 | Author: Robert Himmelmann, TU Muenchen | |
| 4 | Author: Bogdan Grechuk, University of Edinburgh | |
| 5 | Author: Armin Heller, TU Muenchen | |
| 6 | Author: Johannes Hoelzl, TU Muenchen | |
| 7 | *) | |
| 8 | ||
| 9 | section \<open>Line Segment\<close> | |
| 10 | ||
| 11 | theory Line_Segment | |
| 12 | imports | |
| 13 | Convex | |
| 14 | Topology_Euclidean_Space | |
| 15 | begin | |
| 16 | ||
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 17 | subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological Properties of Convex Sets, Metric Spaces and Functions\<close> | 
| 71028 | 18 | |
| 19 | lemma convex_supp_sum: | |
| 20 | assumes "convex S" and 1: "supp_sum u I = 1" | |
| 21 | and "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> u i \<and> (u i = 0 \<or> f i \<in> S)" | |
| 22 | shows "supp_sum (\<lambda>i. u i *\<^sub>R f i) I \<in> S" | |
| 23 | proof - | |
| 24 |   have fin: "finite {i \<in> I. u i \<noteq> 0}"
 | |
| 25 | using 1 sum.infinite by (force simp: supp_sum_def support_on_def) | |
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 26 |   then have "supp_sum (\<lambda>i. u i *\<^sub>R f i) I = sum (\<lambda>i. u i *\<^sub>R f i) {i \<in> I. u i \<noteq> 0}"
 | 
| 71028 | 27 | by (force intro: sum.mono_neutral_left simp: supp_sum_def support_on_def) | 
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 28 | also have "... \<in> S" | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 29 | using 1 assms by (force simp: supp_sum_def support_on_def intro: convex_sum [OF fin \<open>convex S\<close>]) | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 30 | finally show ?thesis . | 
| 71028 | 31 | qed | 
| 32 | ||
| 33 | lemma sphere_eq_empty [simp]: | |
| 34 |   fixes a :: "'a::{real_normed_vector, perfect_space}"
 | |
| 35 |   shows "sphere a r = {} \<longleftrightarrow> r < 0"
 | |
| 78477 | 36 | by (metis empty_iff linorder_not_less mem_sphere sphere_empty vector_choose_dist) | 
| 71028 | 37 | |
| 38 | lemma cone_closure: | |
| 39 | fixes S :: "'a::real_normed_vector set" | |
| 40 | assumes "cone S" | |
| 41 | shows "cone (closure S)" | |
| 78477 | 42 | by (metis UnCI assms closure_Un_frontier closure_eq_empty closure_scaleR cone_iff) | 
| 71028 | 43 | |
| 44 | ||
| 45 | corollary component_complement_connected: | |
| 46 | fixes S :: "'a::real_normed_vector set" | |
| 47 | assumes "connected S" "C \<in> components (-S)" | |
| 48 | shows "connected(-C)" | |
| 49 | using component_diff_connected [of S UNIV] assms | |
| 50 | by (auto simp: Compl_eq_Diff_UNIV) | |
| 51 | ||
| 52 | proposition clopen: | |
| 53 | fixes S :: "'a :: real_normed_vector set" | |
| 54 |   shows "closed S \<and> open S \<longleftrightarrow> S = {} \<or> S = UNIV"
 | |
| 78477 | 55 | using connected_UNIV by (force simp add: connected_clopen) | 
| 71028 | 56 | |
| 57 | corollary compact_open: | |
| 58 | fixes S :: "'a :: euclidean_space set" | |
| 59 |   shows "compact S \<and> open S \<longleftrightarrow> S = {}"
 | |
| 60 | by (auto simp: compact_eq_bounded_closed clopen) | |
| 61 | ||
| 62 | corollary finite_imp_not_open: | |
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 63 |   fixes S :: "'a::{real_normed_vector, perfect_space} set"
 | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 64 |   shows "\<lbrakk>finite S; open S\<rbrakk> \<Longrightarrow> S={}"
 | 
| 71028 | 65 | using clopen [of S] finite_imp_closed not_bounded_UNIV by blast | 
| 66 | ||
| 67 | corollary empty_interior_finite: | |
| 68 |     fixes S :: "'a::{real_normed_vector, perfect_space} set"
 | |
| 69 |     shows "finite S \<Longrightarrow> interior S = {}"
 | |
| 70 | by (metis interior_subset finite_subset open_interior [of S] finite_imp_not_open) | |
| 71 | ||
| 72 | text \<open>Balls, being convex, are connected.\<close> | |
| 73 | ||
| 74 | lemma convex_local_global_minimum: | |
| 75 | fixes s :: "'a::real_normed_vector set" | |
| 76 | assumes "e > 0" | |
| 77 | and "convex_on s f" | |
| 78 | and "ball x e \<subseteq> s" | |
| 79 | and "\<forall>y\<in>ball x e. f x \<le> f y" | |
| 80 | shows "\<forall>y\<in>s. f x \<le> f y" | |
| 81 | proof (rule ccontr) | |
| 82 | have "x \<in> s" using assms(1,3) by auto | |
| 83 | assume "\<not> ?thesis" | |
| 84 | then obtain y where "y\<in>s" and y: "f x > f y" by auto | |
| 85 | then have xy: "0 < dist x y" by auto | |
| 86 | then obtain u where "0 < u" "u \<le> 1" and u: "u < e / dist x y" | |
| 87 | using field_lbound_gt_zero[of 1 "e / dist x y"] xy \<open>e>0\<close> by auto | |
| 88 | then have "f ((1-u) *\<^sub>R x + u *\<^sub>R y) \<le> (1-u) * f x + u * f y" | |
| 78477 | 89 | using \<open>x\<in>s\<close> \<open>y\<in>s\<close> by (smt (verit) assms(2) convex_on_def) | 
| 71028 | 90 | moreover | 
| 91 | have *: "x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" | |
| 92 | by (simp add: algebra_simps) | |
| 93 | have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> ball x e" | |
| 78477 | 94 | by (smt (verit) "*" \<open>0 < u\<close> dist_norm mem_ball norm_scaleR pos_less_divide_eq u xy) | 
| 71028 | 95 | then have "f x \<le> f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" | 
| 96 | using assms(4) by auto | |
| 97 | ultimately show False | |
| 98 | using mult_strict_left_mono[OF y \<open>u>0\<close>] | |
| 99 | unfolding left_diff_distrib | |
| 100 | by auto | |
| 101 | qed | |
| 102 | ||
| 103 | lemma convex_ball [iff]: | |
| 104 | fixes x :: "'a::real_normed_vector" | |
| 105 | shows "convex (ball x e)" | |
| 106 | proof (auto simp: convex_def) | |
| 107 | fix y z | |
| 108 | assume yz: "dist x y < e" "dist x z < e" | |
| 109 | fix u v :: real | |
| 110 | assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1" | |
| 111 | have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" | |
| 79582 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 paulson <lp15@cam.ac.uk> parents: 
78477diff
changeset | 112 | using uv yz by (meson UNIV_I convex_def convex_on_def convex_on_dist) | 
| 71028 | 113 | then show "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" | 
| 114 | using convex_bound_lt[OF yz uv] by auto | |
| 115 | qed | |
| 116 | ||
| 117 | lemma convex_cball [iff]: | |
| 118 | fixes x :: "'a::real_normed_vector" | |
| 119 | shows "convex (cball x e)" | |
| 120 | proof - | |
| 121 |   {
 | |
| 122 | fix y z | |
| 123 | assume yz: "dist x y \<le> e" "dist x z \<le> e" | |
| 124 | fix u v :: real | |
| 125 | assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1" | |
| 126 | have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" | |
| 79582 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 paulson <lp15@cam.ac.uk> parents: 
78477diff
changeset | 127 | using uv yz by (meson UNIV_I convex_def convex_on_def convex_on_dist) | 
| 71028 | 128 | then have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e" | 
| 129 | using convex_bound_le[OF yz uv] by auto | |
| 130 | } | |
| 131 | then show ?thesis by (auto simp: convex_def Ball_def) | |
| 132 | qed | |
| 133 | ||
| 134 | lemma connected_ball [iff]: | |
| 135 | fixes x :: "'a::real_normed_vector" | |
| 136 | shows "connected (ball x e)" | |
| 137 | using convex_connected convex_ball by auto | |
| 138 | ||
| 139 | lemma connected_cball [iff]: | |
| 140 | fixes x :: "'a::real_normed_vector" | |
| 141 | shows "connected (cball x e)" | |
| 142 | using convex_connected convex_cball by auto | |
| 143 | ||
| 144 | lemma bounded_convex_hull: | |
| 145 | fixes s :: "'a::real_normed_vector set" | |
| 146 | assumes "bounded s" | |
| 147 | shows "bounded (convex hull s)" | |
| 148 | proof - | |
| 149 | from assms obtain B where B: "\<forall>x\<in>s. norm x \<le> B" | |
| 150 | unfolding bounded_iff by auto | |
| 151 | show ?thesis | |
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 152 | by (simp add: bounded_subset[OF bounded_cball, of _ 0 B] B subsetI subset_hull) | 
| 71028 | 153 | qed | 
| 154 | ||
| 155 | lemma finite_imp_bounded_convex_hull: | |
| 156 | fixes s :: "'a::real_normed_vector set" | |
| 157 | shows "finite s \<Longrightarrow> bounded (convex hull s)" | |
| 158 | using bounded_convex_hull finite_imp_bounded | |
| 159 | by auto | |
| 160 | ||
| 161 | ||
| 162 | subsection \<open>Midpoint\<close> | |
| 163 | ||
| 164 | definition\<^marker>\<open>tag important\<close> midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a" | |
| 165 | where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)" | |
| 166 | ||
| 167 | lemma midpoint_idem [simp]: "midpoint x x = x" | |
| 168 | unfolding midpoint_def by simp | |
| 169 | ||
| 170 | lemma midpoint_sym: "midpoint a b = midpoint b a" | |
| 171 | unfolding midpoint_def by (auto simp add: scaleR_right_distrib) | |
| 172 | ||
| 173 | lemma midpoint_eq_iff: "midpoint a b = c \<longleftrightarrow> a + b = c + c" | |
| 174 | proof - | |
| 175 | have "midpoint a b = c \<longleftrightarrow> scaleR 2 (midpoint a b) = scaleR 2 c" | |
| 176 | by simp | |
| 177 | then show ?thesis | |
| 178 | unfolding midpoint_def scaleR_2 [symmetric] by simp | |
| 179 | qed | |
| 180 | ||
| 181 | lemma | |
| 182 | fixes a::real | |
| 183 | assumes "a \<le> b" shows ge_midpoint_1: "a \<le> midpoint a b" | |
| 184 | and le_midpoint_1: "midpoint a b \<le> b" | |
| 185 | by (simp_all add: midpoint_def assms) | |
| 186 | ||
| 187 | lemma dist_midpoint: | |
| 188 | fixes a b :: "'a::real_normed_vector" shows | |
| 189 | "dist a (midpoint a b) = (dist a b) / 2" (is ?t1) | |
| 190 | "dist b (midpoint a b) = (dist a b) / 2" (is ?t2) | |
| 191 | "dist (midpoint a b) a = (dist a b) / 2" (is ?t3) | |
| 192 | "dist (midpoint a b) b = (dist a b) / 2" (is ?t4) | |
| 193 | proof - | |
| 194 | have *: "\<And>x y::'a. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2" | |
| 195 | unfolding equation_minus_iff by auto | |
| 196 | have **: "\<And>x y::'a. 2 *\<^sub>R x = y \<Longrightarrow> norm x = (norm y) / 2" | |
| 197 | by auto | |
| 198 | note scaleR_right_distrib [simp] | |
| 199 | show ?t1 | |
| 200 | unfolding midpoint_def dist_norm | |
| 201 | apply (rule **) | |
| 202 | apply (simp add: scaleR_right_diff_distrib) | |
| 203 | apply (simp add: scaleR_2) | |
| 204 | done | |
| 205 | show ?t2 | |
| 206 | unfolding midpoint_def dist_norm | |
| 207 | apply (rule *) | |
| 208 | apply (simp add: scaleR_right_diff_distrib) | |
| 209 | apply (simp add: scaleR_2) | |
| 210 | done | |
| 211 | show ?t3 | |
| 212 | unfolding midpoint_def dist_norm | |
| 213 | apply (rule *) | |
| 214 | apply (simp add: scaleR_right_diff_distrib) | |
| 215 | apply (simp add: scaleR_2) | |
| 216 | done | |
| 217 | show ?t4 | |
| 218 | unfolding midpoint_def dist_norm | |
| 219 | apply (rule **) | |
| 220 | apply (simp add: scaleR_right_diff_distrib) | |
| 221 | apply (simp add: scaleR_2) | |
| 222 | done | |
| 223 | qed | |
| 224 | ||
| 225 | lemma midpoint_eq_endpoint [simp]: | |
| 226 | "midpoint a b = a \<longleftrightarrow> a = b" | |
| 227 | "midpoint a b = b \<longleftrightarrow> a = b" | |
| 228 | unfolding midpoint_eq_iff by auto | |
| 229 | ||
| 230 | lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b" | |
| 231 | using midpoint_eq_iff by metis | |
| 232 | ||
| 233 | lemma midpoint_linear_image: | |
| 78477 | 234 | "linear f \<Longrightarrow> midpoint(f a)(f b) = f(midpoint a b)" | 
| 235 | by (simp add: linear_iff midpoint_def) | |
| 71028 | 236 | |
| 237 | ||
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 238 | subsection \<open>Open and closed segments\<close> | 
| 71028 | 239 | |
| 240 | definition\<^marker>\<open>tag important\<close> closed_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" | |
| 241 |   where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
 | |
| 242 | ||
| 243 | definition\<^marker>\<open>tag important\<close> open_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where | |
| 244 |   "open_segment a b \<equiv> closed_segment a b - {a,b}"
 | |
| 245 | ||
| 246 | lemmas segment = open_segment_def closed_segment_def | |
| 247 | ||
| 248 | lemma in_segment: | |
| 249 | "x \<in> closed_segment a b \<longleftrightarrow> (\<exists>u. 0 \<le> u \<and> u \<le> 1 \<and> x = (1 - u) *\<^sub>R a + u *\<^sub>R b)" | |
| 250 | "x \<in> open_segment a b \<longleftrightarrow> a \<noteq> b \<and> (\<exists>u. 0 < u \<and> u < 1 \<and> x = (1 - u) *\<^sub>R a + u *\<^sub>R b)" | |
| 251 | using less_eq_real_def by (auto simp: segment algebra_simps) | |
| 252 | ||
| 253 | lemma closed_segment_linear_image: | |
| 254 | "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f" | |
| 255 | proof - | |
| 256 | interpret linear f by fact | |
| 257 | show ?thesis | |
| 258 | by (force simp add: in_segment add scale) | |
| 259 | qed | |
| 260 | ||
| 261 | lemma open_segment_linear_image: | |
| 262 | "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> open_segment (f a) (f b) = f ` (open_segment a b)" | |
| 263 | by (force simp: open_segment_def closed_segment_linear_image inj_on_def) | |
| 264 | ||
| 265 | lemma closed_segment_translation: | |
| 78477 | 266 | "closed_segment (c + a) (c + b) = (\<lambda>x. c + x) ` (closed_segment a b)" (is "?L = _ ` ?R") | 
| 267 | proof - | |
| 268 | have "\<And>x. x \<in> ?L \<Longrightarrow> x - c \<in> ?R" "\<And>x. \<lbrakk>x \<in> ?R\<rbrakk> \<Longrightarrow> c + x \<in> ?L" | |
| 269 | by (auto simp: in_segment algebra_simps) | |
| 270 | then show ?thesis by force | |
| 271 | qed | |
| 71028 | 272 | |
| 273 | lemma open_segment_translation: | |
| 78477 | 274 | "open_segment (c + a) (c + b) = image (\<lambda>x. c + x) (open_segment a b)" | 
| 275 | by (simp add: open_segment_def closed_segment_translation translation_diff) | |
| 71028 | 276 | |
| 277 | lemma closed_segment_of_real: | |
| 278 | "closed_segment (of_real x) (of_real y) = of_real ` closed_segment x y" | |
| 78477 | 279 | by (simp add: closed_segment_linear_image linearI scaleR_conv_of_real) | 
| 71028 | 280 | |
| 281 | lemma open_segment_of_real: | |
| 282 | "open_segment (of_real x) (of_real y) = of_real ` open_segment x y" | |
| 78477 | 283 | by (simp add: closed_segment_of_real image_set_diff inj_of_real open_segment_def) | 
| 71028 | 284 | |
| 285 | lemma closed_segment_Reals: | |
| 286 | "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> closed_segment x y = of_real ` closed_segment (Re x) (Re y)" | |
| 287 | by (metis closed_segment_of_real of_real_Re) | |
| 288 | ||
| 289 | lemma open_segment_Reals: | |
| 290 | "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> open_segment x y = of_real ` open_segment (Re x) (Re y)" | |
| 291 | by (metis open_segment_of_real of_real_Re) | |
| 292 | ||
| 293 | lemma open_segment_PairD: | |
| 294 | "(x, x') \<in> open_segment (a, a') (b, b') | |
| 295 | \<Longrightarrow> (x \<in> open_segment a b \<or> a = b) \<and> (x' \<in> open_segment a' b' \<or> a' = b')" | |
| 296 | by (auto simp: in_segment) | |
| 297 | ||
| 298 | lemma closed_segment_PairD: | |
| 299 | "(x, x') \<in> closed_segment (a, a') (b, b') \<Longrightarrow> x \<in> closed_segment a b \<and> x' \<in> closed_segment a' b'" | |
| 300 | by (auto simp: closed_segment_def) | |
| 301 | ||
| 302 | lemma closed_segment_translation_eq [simp]: | |
| 303 | "d + x \<in> closed_segment (d + a) (d + b) \<longleftrightarrow> x \<in> closed_segment a b" | |
| 304 | proof - | |
| 305 | have *: "\<And>d x a b. x \<in> closed_segment a b \<Longrightarrow> d + x \<in> closed_segment (d + a) (d + b)" | |
| 78477 | 306 | using closed_segment_translation by blast | 
| 71028 | 307 | show ?thesis | 
| 78477 | 308 | using * [where d = "-d"] * by fastforce | 
| 71028 | 309 | qed | 
| 310 | ||
| 311 | lemma open_segment_translation_eq [simp]: | |
| 312 | "d + x \<in> open_segment (d + a) (d + b) \<longleftrightarrow> x \<in> open_segment a b" | |
| 313 | by (simp add: open_segment_def) | |
| 314 | ||
| 315 | lemma of_real_closed_segment [simp]: | |
| 316 | "of_real x \<in> closed_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> closed_segment a b" | |
| 78477 | 317 | by (simp add: closed_segment_of_real image_iff) | 
| 71028 | 318 | |
| 319 | lemma of_real_open_segment [simp]: | |
| 320 | "of_real x \<in> open_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> open_segment a b" | |
| 78477 | 321 | by (simp add: image_iff open_segment_of_real) | 
| 71028 | 322 | |
| 323 | lemma convex_contains_segment: | |
| 324 | "convex S \<longleftrightarrow> (\<forall>a\<in>S. \<forall>b\<in>S. closed_segment a b \<subseteq> S)" | |
| 325 | unfolding convex_alt closed_segment_def by auto | |
| 326 | ||
| 327 | lemma closed_segment_in_Reals: | |
| 328 | "\<lbrakk>x \<in> closed_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals" | |
| 329 | by (meson subsetD convex_Reals convex_contains_segment) | |
| 330 | ||
| 331 | lemma open_segment_in_Reals: | |
| 332 | "\<lbrakk>x \<in> open_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals" | |
| 333 | by (metis Diff_iff closed_segment_in_Reals open_segment_def) | |
| 334 | ||
| 335 | lemma closed_segment_subset: "\<lbrakk>x \<in> S; y \<in> S; convex S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> S" | |
| 336 | by (simp add: convex_contains_segment) | |
| 337 | ||
| 338 | lemma closed_segment_subset_convex_hull: | |
| 339 | "\<lbrakk>x \<in> convex hull S; y \<in> convex hull S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> convex hull S" | |
| 340 | using convex_contains_segment by blast | |
| 341 | ||
| 342 | lemma segment_convex_hull: | |
| 343 |   "closed_segment a b = convex hull {a,b}"
 | |
| 344 | proof - | |
| 345 |   have *: "\<And>x. {x} \<noteq> {}" by auto
 | |
| 346 | show ?thesis | |
| 347 | unfolding segment convex_hull_insert[OF *] convex_hull_singleton | |
| 348 | by (safe; rule_tac x="1 - u" in exI; force) | |
| 349 | qed | |
| 350 | ||
| 351 | lemma open_closed_segment: "u \<in> open_segment w z \<Longrightarrow> u \<in> closed_segment w z" | |
| 352 | by (auto simp add: closed_segment_def open_segment_def) | |
| 353 | ||
| 354 | lemma segment_open_subset_closed: | |
| 355 | "open_segment a b \<subseteq> closed_segment a b" | |
| 78477 | 356 | by (simp add: open_closed_segment subsetI) | 
| 71028 | 357 | |
| 358 | lemma bounded_closed_segment: | |
| 359 | fixes a :: "'a::real_normed_vector" shows "bounded (closed_segment a b)" | |
| 78477 | 360 | by (simp add: bounded_convex_hull segment_convex_hull) | 
| 71028 | 361 | |
| 362 | lemma bounded_open_segment: | |
| 363 | fixes a :: "'a::real_normed_vector" shows "bounded (open_segment a b)" | |
| 364 | by (rule bounded_subset [OF bounded_closed_segment segment_open_subset_closed]) | |
| 365 | ||
| 366 | lemmas bounded_segment = bounded_closed_segment open_closed_segment | |
| 367 | ||
| 368 | lemma ends_in_segment [iff]: "a \<in> closed_segment a b" "b \<in> closed_segment a b" | |
| 78477 | 369 | by (simp_all add: hull_inc segment_convex_hull) | 
| 71028 | 370 | |
| 371 | ||
| 372 | lemma eventually_closed_segment: | |
| 373 | fixes x0::"'a::real_normed_vector" | |
| 374 | assumes "open X0" "x0 \<in> X0" | |
| 375 | shows "\<forall>\<^sub>F x in at x0 within U. closed_segment x0 x \<subseteq> X0" | |
| 376 | proof - | |
| 377 | from openE[OF assms] | |
| 378 | obtain e where e: "0 < e" "ball x0 e \<subseteq> X0" . | |
| 379 | then have "\<forall>\<^sub>F x in at x0 within U. x \<in> ball x0 e" | |
| 380 | by (auto simp: dist_commute eventually_at) | |
| 381 | then show ?thesis | |
| 382 | proof eventually_elim | |
| 383 | case (elim x) | |
| 384 | have "x0 \<in> ball x0 e" using \<open>e > 0\<close> by simp | |
| 78477 | 385 | then have "closed_segment x0 x \<subseteq> ball x0 e" | 
| 386 | using closed_segment_subset elim by blast | |
| 387 | then show ?case | |
| 388 | using e(2) by auto | |
| 71028 | 389 | qed | 
| 390 | qed | |
| 391 | ||
| 392 | lemma closed_segment_commute: "closed_segment a b = closed_segment b a" | |
| 393 | proof - | |
| 394 |   have "{a, b} = {b, a}" by auto
 | |
| 395 | thus ?thesis | |
| 396 | by (simp add: segment_convex_hull) | |
| 397 | qed | |
| 398 | ||
| 399 | lemma segment_bound1: | |
| 400 | assumes "x \<in> closed_segment a b" | |
| 401 | shows "norm (x - a) \<le> norm (b - a)" | |
| 402 | proof - | |
| 78477 | 403 | obtain u where u: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1" | 
| 71028 | 404 | using assms by (auto simp add: closed_segment_def) | 
| 78477 | 405 | then have "norm (u *\<^sub>R b - u *\<^sub>R a) \<le> norm (b - a)" | 
| 406 | by (simp add: mult_left_le_one_le flip: scaleR_diff_right) | |
| 407 | with u show ?thesis | |
| 408 | by (metis add_diff_cancel_left scaleR_collapse) | |
| 71028 | 409 | qed | 
| 410 | ||
| 411 | lemma segment_bound: | |
| 412 | assumes "x \<in> closed_segment a b" | |
| 413 | shows "norm (x - a) \<le> norm (b - a)" "norm (x - b) \<le> norm (b - a)" | |
| 78477 | 414 | by (metis assms closed_segment_commute dist_commute dist_norm segment_bound1)+ | 
| 415 | ||
| 416 | lemma open_segment_bound1: | |
| 417 | assumes "x \<in> open_segment a b" | |
| 418 | shows "norm (x - a) < norm (b - a)" | |
| 419 | proof - | |
| 420 | obtain u where u: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 < u" "u < 1" | |
| 421 | by (meson assms in_segment) | |
| 422 | then have "norm (u *\<^sub>R b - u *\<^sub>R a) < norm (b - a)" | |
| 423 | using assms in_segment(2) less_eq_real_def by (fastforce simp flip: scaleR_diff_right) | |
| 424 | with u show ?thesis | |
| 425 | by (metis add_diff_cancel_left scaleR_collapse) | |
| 426 | qed | |
| 71028 | 427 | |
| 428 | lemma open_segment_commute: "open_segment a b = open_segment b a" | |
| 78477 | 429 | by (simp add: closed_segment_commute insert_commute open_segment_def) | 
| 71028 | 430 | |
| 431 | lemma closed_segment_idem [simp]: "closed_segment a a = {a}"
 | |
| 432 | unfolding segment by (auto simp add: algebra_simps) | |
| 433 | ||
| 434 | lemma open_segment_idem [simp]: "open_segment a a = {}"
 | |
| 435 | by (simp add: open_segment_def) | |
| 436 | ||
| 437 | lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
 | |
| 438 | using open_segment_def by auto | |
| 439 | ||
| 440 | lemma convex_contains_open_segment: | |
| 441 | "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. open_segment a b \<subseteq> s)" | |
| 442 | by (simp add: convex_contains_segment closed_segment_eq_open) | |
| 443 | ||
| 444 | lemma closed_segment_eq_real_ivl1: | |
| 445 | fixes a b::real | |
| 446 | assumes "a \<le> b" | |
| 447 |   shows "closed_segment a b = {a .. b}"
 | |
| 448 | proof safe | |
| 449 | fix x | |
| 450 | assume "x \<in> closed_segment a b" | |
| 451 | then obtain u where u: "0 \<le> u" "u \<le> 1" and x_def: "x = (1 - u) * a + u * b" | |
| 452 | by (auto simp: closed_segment_def) | |
| 453 | have "u * a \<le> u * b" "(1 - u) * a \<le> (1 - u) * b" | |
| 454 | by (auto intro!: mult_left_mono u assms) | |
| 455 |   then show "x \<in> {a .. b}"
 | |
| 456 | unfolding x_def by (auto simp: algebra_simps) | |
| 71169 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 457 | next | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 458 |   show "\<And>x. x \<in> {a..b} \<Longrightarrow> x \<in> closed_segment a b"
 | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 459 | by (force simp: closed_segment_def divide_simps algebra_simps | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 460 | intro: exI[where x="(x - a) / (b - a)" for x]) | 
| 
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
 paulson <lp15@cam.ac.uk> parents: 
71028diff
changeset | 461 | qed | 
| 71028 | 462 | |
| 463 | lemma closed_segment_eq_real_ivl: | |
| 464 | fixes a b::real | |
| 465 |   shows "closed_segment a b = (if a \<le> b then {a .. b} else {b .. a})"
 | |
| 78477 | 466 | by (metis closed_segment_commute closed_segment_eq_real_ivl1 nle_le) | 
| 71028 | 467 | |
| 468 | lemma open_segment_eq_real_ivl: | |
| 469 | fixes a b::real | |
| 470 |   shows "open_segment a b = (if a \<le> b then {a<..<b} else {b<..<a})"
 | |
| 471 | by (auto simp: closed_segment_eq_real_ivl open_segment_def split: if_split_asm) | |
| 472 | ||
| 473 | lemma closed_segment_real_eq: | |
| 474 |   fixes u::real shows "closed_segment u v = (\<lambda>x. (v - u) * x + u) ` {0..1}"
 | |
| 78477 | 475 | by (simp add: closed_segment_eq_real_ivl image_affinity_atLeastAtMost) | 
| 71028 | 476 | |
| 71189 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 477 | lemma closed_segment_same_Re: | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 478 | assumes "Re a = Re b" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 479 |   shows   "closed_segment a b = {z. Re z = Re a \<and> Im z \<in> closed_segment (Im a) (Im b)}"
 | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 480 | proof safe | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 481 | fix z assume "z \<in> closed_segment a b" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 482 |   then obtain u where u: "u \<in> {0..1}" "z = a + of_real u * (b - a)"
 | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 483 | by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 484 | from assms show "Re z = Re a" by (auto simp: u) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 485 | from u(1) show "Im z \<in> closed_segment (Im a) (Im b)" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 486 | by (force simp: u closed_segment_def algebra_simps) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 487 | next | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 488 | fix z assume [simp]: "Re z = Re a" and "Im z \<in> closed_segment (Im a) (Im b)" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 489 |   then obtain u where u: "u \<in> {0..1}" "Im z = Im a + of_real u * (Im b - Im a)"
 | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 490 | by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 491 | from u(1) show "z \<in> closed_segment a b" using assms | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 492 | by (force simp: u closed_segment_def algebra_simps scaleR_conv_of_real complex_eq_iff) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 493 | qed | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 494 | |
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 495 | lemma closed_segment_same_Im: | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 496 | assumes "Im a = Im b" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 497 |   shows   "closed_segment a b = {z. Im z = Im a \<and> Re z \<in> closed_segment (Re a) (Re b)}"
 | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 498 | proof safe | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 499 | fix z assume "z \<in> closed_segment a b" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 500 |   then obtain u where u: "u \<in> {0..1}" "z = a + of_real u * (b - a)"
 | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 501 | by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 502 | from assms show "Im z = Im a" by (auto simp: u) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 503 | from u(1) show "Re z \<in> closed_segment (Re a) (Re b)" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 504 | by (force simp: u closed_segment_def algebra_simps) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 505 | next | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 506 | fix z assume [simp]: "Im z = Im a" and "Re z \<in> closed_segment (Re a) (Re b)" | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 507 |   then obtain u where u: "u \<in> {0..1}" "Re z = Re a + of_real u * (Re b - Re a)"
 | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 508 | by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 509 | from u(1) show "z \<in> closed_segment a b" using assms | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 510 | by (force simp: u closed_segment_def algebra_simps scaleR_conv_of_real complex_eq_iff) | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 511 | qed | 
| 
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
 Manuel Eberl <eberlm@in.tum.de> parents: 
71169diff
changeset | 512 | |
| 71028 | 513 | lemma dist_in_closed_segment: | 
| 514 | fixes a :: "'a :: euclidean_space" | |
| 515 | assumes "x \<in> closed_segment a b" | |
| 516 | shows "dist x a \<le> dist a b \<and> dist x b \<le> dist a b" | |
| 78477 | 517 | by (metis assms dist_commute dist_norm segment_bound(2) segment_bound1) | 
| 71028 | 518 | |
| 519 | lemma dist_in_open_segment: | |
| 520 | fixes a :: "'a :: euclidean_space" | |
| 521 | assumes "x \<in> open_segment a b" | |
| 78477 | 522 | shows "dist x a < dist a b \<and> dist x b < dist a b" | 
| 523 | by (metis assms dist_commute dist_norm open_segment_bound1 open_segment_commute) | |
| 71028 | 524 | |
| 525 | lemma dist_decreases_open_segment_0: | |
| 526 | fixes x :: "'a :: euclidean_space" | |
| 527 | assumes "x \<in> open_segment 0 b" | |
| 528 | shows "dist c x < dist c 0 \<or> dist c x < dist c b" | |
| 529 | proof (rule ccontr, clarsimp simp: not_less) | |
| 530 | obtain u where u: "0 \<noteq> b" "0 < u" "u < 1" and x: "x = u *\<^sub>R b" | |
| 531 | using assms by (auto simp: in_segment) | |
| 532 | have xb: "x \<bullet> b < b \<bullet> b" | |
| 533 | using u x by auto | |
| 534 | assume "norm c \<le> dist c x" | |
| 535 | then have "c \<bullet> c \<le> (c - x) \<bullet> (c - x)" | |
| 536 | by (simp add: dist_norm norm_le) | |
| 537 | moreover have "0 < x \<bullet> b" | |
| 538 | using u x by auto | |
| 539 | ultimately have less: "c \<bullet> b < x \<bullet> b" | |
| 540 | by (simp add: x algebra_simps inner_commute u) | |
| 541 | assume "dist c b \<le> dist c x" | |
| 542 | then have "(c - b) \<bullet> (c - b) \<le> (c - x) \<bullet> (c - x)" | |
| 543 | by (simp add: dist_norm norm_le) | |
| 544 | then have "(b \<bullet> b) * (1 - u*u) \<le> 2 * (b \<bullet> c) * (1-u)" | |
| 545 | by (simp add: x algebra_simps inner_commute) | |
| 546 | then have "(1+u) * (b \<bullet> b) * (1-u) \<le> 2 * (b \<bullet> c) * (1-u)" | |
| 547 | by (simp add: algebra_simps) | |
| 548 | then have "(1+u) * (b \<bullet> b) \<le> 2 * (b \<bullet> c)" | |
| 549 | using \<open>u < 1\<close> by auto | |
| 550 | with xb have "c \<bullet> b \<ge> x \<bullet> b" | |
| 551 | by (auto simp: x algebra_simps inner_commute) | |
| 552 | with less show False by auto | |
| 553 | qed | |
| 554 | ||
| 555 | proposition dist_decreases_open_segment: | |
| 556 | fixes a :: "'a :: euclidean_space" | |
| 557 | assumes "x \<in> open_segment a b" | |
| 558 | shows "dist c x < dist c a \<or> dist c x < dist c b" | |
| 559 | proof - | |
| 560 | have *: "x - a \<in> open_segment 0 (b - a)" using assms | |
| 561 | by (metis diff_self open_segment_translation_eq uminus_add_conv_diff) | |
| 562 | show ?thesis | |
| 563 | using dist_decreases_open_segment_0 [OF *, of "c-a"] assms | |
| 564 | by (simp add: dist_norm) | |
| 565 | qed | |
| 566 | ||
| 567 | corollary open_segment_furthest_le: | |
| 568 | fixes a b x y :: "'a::euclidean_space" | |
| 569 | assumes "x \<in> open_segment a b" | |
| 570 | shows "norm (y - x) < norm (y - a) \<or> norm (y - x) < norm (y - b)" | |
| 571 | by (metis assms dist_decreases_open_segment dist_norm) | |
| 572 | ||
| 573 | corollary dist_decreases_closed_segment: | |
| 574 | fixes a :: "'a :: euclidean_space" | |
| 575 | assumes "x \<in> closed_segment a b" | |
| 576 | shows "dist c x \<le> dist c a \<or> dist c x \<le> dist c b" | |
| 78477 | 577 | by (smt (verit, ccfv_threshold) Un_iff assms closed_segment_eq_open dist_norm empty_iff insertE open_segment_furthest_le) | 
| 71028 | 578 | |
| 579 | corollary segment_furthest_le: | |
| 580 | fixes a b x y :: "'a::euclidean_space" | |
| 581 | assumes "x \<in> closed_segment a b" | |
| 582 | shows "norm (y - x) \<le> norm (y - a) \<or> norm (y - x) \<le> norm (y - b)" | |
| 583 | by (metis assms dist_decreases_closed_segment dist_norm) | |
| 584 | ||
| 585 | lemma convex_intermediate_ball: | |
| 586 | fixes a :: "'a :: euclidean_space" | |
| 587 | shows "\<lbrakk>ball a r \<subseteq> T; T \<subseteq> cball a r\<rbrakk> \<Longrightarrow> convex T" | |
| 78477 | 588 | by (smt (verit) convex_contains_open_segment dist_decreases_open_segment mem_ball mem_cball subset_eq) | 
| 71028 | 589 | |
| 590 | lemma csegment_midpoint_subset: "closed_segment (midpoint a b) b \<subseteq> closed_segment a b" | |
| 591 | apply (clarsimp simp: midpoint_def in_segment) | |
| 592 | apply (rule_tac x="(1 + u) / 2" in exI) | |
| 78477 | 593 | apply (simp add: algebra_simps add_divide_distrib diff_divide_distrib) | 
| 71028 | 594 | by (metis field_sum_of_halves scaleR_left.add) | 
| 595 | ||
| 596 | lemma notin_segment_midpoint: | |
| 597 | fixes a :: "'a :: euclidean_space" | |
| 598 | shows "a \<noteq> b \<Longrightarrow> a \<notin> closed_segment (midpoint a b) b" | |
| 78477 | 599 | by (auto simp: dist_midpoint dest!: dist_in_closed_segment) | 
| 71028 | 600 | |
| 601 | subsubsection\<open>More lemmas, especially for working with the underlying formula\<close> | |
| 602 | ||
| 603 | lemma segment_eq_compose: | |
| 604 | fixes a :: "'a :: real_vector" | |
| 605 | shows "(\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) = (\<lambda>x. a + x) o (\<lambda>u. u *\<^sub>R (b - a))" | |
| 606 | by (simp add: o_def algebra_simps) | |
| 607 | ||
| 608 | lemma segment_degen_1: | |
| 609 | fixes a :: "'a :: real_vector" | |
| 610 | shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = b \<longleftrightarrow> a=b \<or> u=1" | |
| 78477 | 611 | by (smt (verit, best) add_right_cancel scaleR_cancel_left scaleR_collapse) | 
| 71028 | 612 | |
| 613 | lemma segment_degen_0: | |
| 614 | fixes a :: "'a :: real_vector" | |
| 615 | shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = a \<longleftrightarrow> a=b \<or> u=0" | |
| 78477 | 616 | using segment_degen_1 [of "1-u" b a] by (auto simp: algebra_simps) | 
| 71028 | 617 | |
| 618 | lemma add_scaleR_degen: | |
| 619 | fixes a b ::"'a::real_vector" | |
| 620 | assumes "(u *\<^sub>R b + v *\<^sub>R a) = (u *\<^sub>R a + v *\<^sub>R b)" "u \<noteq> v" | |
| 621 | shows "a=b" | |
| 78477 | 622 | by (smt (verit) add_diff_cancel_left' add_diff_eq assms scaleR_cancel_left scaleR_left.diff) | 
| 71028 | 623 | |
| 624 | lemma closed_segment_image_interval: | |
| 625 |      "closed_segment a b = (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0..1}"
 | |
| 626 | by (auto simp: set_eq_iff image_iff closed_segment_def) | |
| 627 | ||
| 628 | lemma open_segment_image_interval: | |
| 629 |      "open_segment a b = (if a=b then {} else (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1})"
 | |
| 630 | by (auto simp: open_segment_def closed_segment_def segment_degen_0 segment_degen_1) | |
| 631 | ||
| 632 | lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval | |
| 633 | ||
| 71230 | 634 | lemma closed_segment_neq_empty [simp]: "closed_segment a b \<noteq> {}"
 | 
| 635 | by auto | |
| 636 | ||
| 637 | lemma open_segment_eq_empty [simp]: "open_segment a b = {} \<longleftrightarrow> a = b"
 | |
| 78477 | 638 | by (simp add: segment_image_interval(2)) | 
| 71230 | 639 | |
| 640 | lemma open_segment_eq_empty' [simp]: "{} = open_segment a b \<longleftrightarrow> a = b"
 | |
| 641 | using open_segment_eq_empty by blast | |
| 642 | ||
| 643 | lemmas segment_eq_empty = closed_segment_neq_empty open_segment_eq_empty | |
| 644 | ||
| 645 | lemma inj_segment: | |
| 646 | fixes a :: "'a :: real_vector" | |
| 647 | assumes "a \<noteq> b" | |
| 648 | shows "inj_on (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) I" | |
| 649 | proof | |
| 650 | fix x y | |
| 651 | assume "(1 - x) *\<^sub>R a + x *\<^sub>R b = (1 - y) *\<^sub>R a + y *\<^sub>R b" | |
| 652 | then have "x *\<^sub>R (b - a) = y *\<^sub>R (b - a)" | |
| 653 | by (simp add: algebra_simps) | |
| 654 | with assms show "x = y" | |
| 655 | by (simp add: real_vector.scale_right_imp_eq) | |
| 656 | qed | |
| 657 | ||
| 658 | lemma finite_closed_segment [simp]: "finite(closed_segment a b) \<longleftrightarrow> a = b" | |
| 78477 | 659 | using infinite_Icc [OF zero_less_one] finite_imageD [OF _ inj_segment [of a b]] | 
| 660 | unfolding segment_image_interval | |
| 661 | by (smt (verit, del_insts) finite.emptyI finite_insert finite_subset image_subset_iff insertCI segment_degen_0) | |
| 71230 | 662 | |
| 663 | lemma finite_open_segment [simp]: "finite(open_segment a b) \<longleftrightarrow> a = b" | |
| 664 | by (auto simp: open_segment_def) | |
| 665 | ||
| 666 | lemmas finite_segment = finite_closed_segment finite_open_segment | |
| 667 | ||
| 668 | lemma closed_segment_eq_sing: "closed_segment a b = {c} \<longleftrightarrow> a = c \<and> b = c"
 | |
| 669 | by auto | |
| 670 | ||
| 671 | lemma open_segment_eq_sing: "open_segment a b \<noteq> {c}"
 | |
| 672 | by (metis finite_insert finite_open_segment insert_not_empty open_segment_image_interval) | |
| 673 | ||
| 674 | lemmas segment_eq_sing = closed_segment_eq_sing open_segment_eq_sing | |
| 675 | ||
| 71028 | 676 | lemma compact_segment [simp]: | 
| 677 | fixes a :: "'a::real_normed_vector" | |
| 678 | shows "compact (closed_segment a b)" | |
| 679 | by (auto simp: segment_image_interval intro!: compact_continuous_image continuous_intros) | |
| 680 | ||
| 681 | lemma closed_segment [simp]: | |
| 682 | fixes a :: "'a::real_normed_vector" | |
| 683 | shows "closed (closed_segment a b)" | |
| 684 | by (simp add: compact_imp_closed) | |
| 685 | ||
| 686 | lemma closure_closed_segment [simp]: | |
| 687 | fixes a :: "'a::real_normed_vector" | |
| 688 | shows "closure(closed_segment a b) = closed_segment a b" | |
| 689 | by simp | |
| 690 | ||
| 691 | lemma open_segment_bound: | |
| 692 | assumes "x \<in> open_segment a b" | |
| 693 | shows "norm (x - a) < norm (b - a)" "norm (x - b) < norm (b - a)" | |
| 78477 | 694 | by (metis assms norm_minus_commute open_segment_bound1 open_segment_commute)+ | 
| 71028 | 695 | |
| 696 | lemma closure_open_segment [simp]: | |
| 697 |   "closure (open_segment a b) = (if a = b then {} else closed_segment a b)"
 | |
| 698 | for a :: "'a::euclidean_space" | |
| 699 | proof (cases "a = b") | |
| 700 | case True | |
| 701 | then show ?thesis | |
| 702 | by simp | |
| 703 | next | |
| 704 | case False | |
| 705 |   have "closure ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1}) = (\<lambda>u. u *\<^sub>R (b - a)) ` closure {0<..<1}"
 | |
| 78477 | 706 | proof (rule closure_injective_linear_image [symmetric]) | 
| 707 | qed (use False in \<open>auto intro!: injI\<close>) | |
| 71028 | 708 | then have "closure | 
| 78477 | 709 |      ((\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1}) = (\<lambda>x. (1 - x) *\<^sub>R a + x *\<^sub>R b) ` closure {0<..<1}"
 | 
| 71028 | 710 |     using closure_translation [of a "((\<lambda>x. x *\<^sub>R b - x *\<^sub>R a) ` {0<..<1})"]
 | 
| 711 | by (simp add: segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right image_image) | |
| 712 | then show ?thesis | |
| 713 | by (simp add: segment_image_interval closure_greaterThanLessThan [symmetric] del: closure_greaterThanLessThan) | |
| 714 | qed | |
| 715 | ||
| 716 | lemma closed_open_segment_iff [simp]: | |
| 717 | fixes a :: "'a::euclidean_space" shows "closed(open_segment a b) \<longleftrightarrow> a = b" | |
| 718 | by (metis open_segment_def DiffE closure_eq closure_open_segment ends_in_segment(1) insert_iff segment_image_interval(2)) | |
| 719 | ||
| 720 | lemma compact_open_segment_iff [simp]: | |
| 721 | fixes a :: "'a::euclidean_space" shows "compact(open_segment a b) \<longleftrightarrow> a = b" | |
| 722 | by (simp add: bounded_open_segment compact_eq_bounded_closed) | |
| 723 | ||
| 724 | lemma convex_closed_segment [iff]: "convex (closed_segment a b)" | |
| 725 | unfolding segment_convex_hull by(rule convex_convex_hull) | |
| 726 | ||
| 727 | lemma convex_open_segment [iff]: "convex (open_segment a b)" | |
| 728 | proof - | |
| 729 |   have "convex ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
 | |
| 730 | by (rule convex_linear_image) auto | |
| 731 |   then have "convex ((+) a ` (\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
 | |
| 732 | by (rule convex_translation) | |
| 733 | then show ?thesis | |
| 734 | by (simp add: image_image open_segment_image_interval segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right) | |
| 735 | qed | |
| 736 | ||
| 737 | lemmas convex_segment = convex_closed_segment convex_open_segment | |
| 738 | ||
| 71230 | 739 | lemma subset_closed_segment: | 
| 740 | "closed_segment a b \<subseteq> closed_segment c d \<longleftrightarrow> | |
| 741 | a \<in> closed_segment c d \<and> b \<in> closed_segment c d" | |
| 78477 | 742 | using closed_segment_subset convex_closed_segment ends_in_segment in_mono by blast | 
| 71230 | 743 | |
| 744 | lemma subset_co_segment: | |
| 78477 | 745 | "closed_segment a b \<subseteq> open_segment c d \<longleftrightarrow> | 
| 71230 | 746 | a \<in> open_segment c d \<and> b \<in> open_segment c d" | 
| 78477 | 747 | using closed_segment_subset by blast | 
| 71230 | 748 | |
| 749 | lemma subset_open_segment: | |
| 750 | fixes a :: "'a::euclidean_space" | |
| 751 | shows "open_segment a b \<subseteq> open_segment c d \<longleftrightarrow> | |
| 752 | a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d" | |
| 753 | (is "?lhs = ?rhs") | |
| 754 | proof (cases "a = b") | |
| 755 | case True then show ?thesis by simp | |
| 756 | next | |
| 757 | case False show ?thesis | |
| 758 | proof | |
| 759 | assume rhs: ?rhs | |
| 760 | with \<open>a \<noteq> b\<close> have "c \<noteq> d" | |
| 761 | using closed_segment_idem singleton_iff by auto | |
| 762 | have "\<exists>uc. (1 - u) *\<^sub>R ((1 - ua) *\<^sub>R c + ua *\<^sub>R d) + u *\<^sub>R ((1 - ub) *\<^sub>R c + ub *\<^sub>R d) = | |
| 763 | (1 - uc) *\<^sub>R c + uc *\<^sub>R d \<and> 0 < uc \<and> uc < 1" | |
| 764 | if neq: "(1 - ua) *\<^sub>R c + ua *\<^sub>R d \<noteq> (1 - ub) *\<^sub>R c + ub *\<^sub>R d" "c \<noteq> d" | |
| 765 | and "a = (1 - ua) *\<^sub>R c + ua *\<^sub>R d" "b = (1 - ub) *\<^sub>R c + ub *\<^sub>R d" | |
| 766 | and u: "0 < u" "u < 1" and uab: "0 \<le> ua" "ua \<le> 1" "0 \<le> ub" "ub \<le> 1" | |
| 767 | for u ua ub | |
| 768 | proof - | |
| 769 | have "ua \<noteq> ub" | |
| 770 | using neq by auto | |
| 771 | moreover have "(u - 1) * ua \<le> 0" using u uab | |
| 772 | by (simp add: mult_nonpos_nonneg) | |
| 773 | ultimately have lt: "(u - 1) * ua < u * ub" using u uab | |
| 774 | by (metis antisym_conv diff_ge_0_iff_ge le_less_trans mult_eq_0_iff mult_le_0_iff not_less) | |
| 775 | have "p * ua + q * ub < p+q" if p: "0 < p" and q: "0 < q" for p q | |
| 776 | proof - | |
| 777 | have "\<not> p \<le> 0" "\<not> q \<le> 0" | |
| 778 | using p q not_less by blast+ | |
| 779 | then show ?thesis | |
| 78477 | 780 | by (smt (verit) \<open>ua \<noteq> ub\<close> mult_cancel_left1 mult_left_le uab(2) uab(4)) | 
| 71230 | 781 | qed | 
| 782 | then have "(1 - u) * ua + u * ub < 1" using u \<open>ua \<noteq> ub\<close> | |
| 783 | by (metis diff_add_cancel diff_gt_0_iff_gt) | |
| 784 | with lt show ?thesis | |
| 785 | by (rule_tac x="ua + u*(ub-ua)" in exI) (simp add: algebra_simps) | |
| 786 | qed | |
| 787 | with rhs \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close> show ?lhs | |
| 788 | unfolding open_segment_image_interval closed_segment_def | |
| 789 | by (fastforce simp add:) | |
| 790 | next | |
| 791 | assume lhs: ?lhs | |
| 792 | with \<open>a \<noteq> b\<close> have "c \<noteq> d" | |
| 793 | by (meson finite_open_segment rev_finite_subset) | |
| 794 | have "closure (open_segment a b) \<subseteq> closure (open_segment c d)" | |
| 795 | using lhs closure_mono by blast | |
| 796 | then have "closed_segment a b \<subseteq> closed_segment c d" | |
| 797 | by (simp add: \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close>) | |
| 798 | then show ?rhs | |
| 799 | by (force simp: \<open>a \<noteq> b\<close>) | |
| 800 | qed | |
| 801 | qed | |
| 802 | ||
| 77140 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 803 | lemma closed_segment_same_fst: | 
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 804 |   "fst a = fst b \<Longrightarrow> closed_segment a b = {fst a} \<times> closed_segment (snd a) (snd b)"
 | 
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 805 | by (auto simp: closed_segment_def scaleR_prod_def) | 
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 806 | |
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 807 | lemma closed_segment_same_snd: | 
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 808 |   "snd a = snd b \<Longrightarrow> closed_segment a b = closed_segment (fst a) (fst b) \<times> {snd a}"
 | 
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 809 | by (auto simp: closed_segment_def scaleR_prod_def) | 
| 
9a60c1759543
Lots more new material thanks to Manuel Eberl
 paulson <lp15@cam.ac.uk> parents: 
73932diff
changeset | 810 | |
| 71230 | 811 | lemma subset_oc_segment: | 
| 812 | fixes a :: "'a::euclidean_space" | |
| 813 | shows "open_segment a b \<subseteq> closed_segment c d \<longleftrightarrow> | |
| 78477 | 814 | a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d" | 
| 815 | (is "?lhs = ?rhs") | |
| 816 | proof | |
| 817 | show "?lhs \<Longrightarrow> ?rhs" | |
| 818 | by (metis closure_closed_segment closure_mono closure_open_segment subset_closed_segment) | |
| 819 | show "?rhs \<Longrightarrow> ?lhs" | |
| 820 | by (meson dual_order.trans segment_open_subset_closed subset_open_segment) | |
| 821 | qed | |
| 71230 | 822 | |
| 823 | lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment | |
| 824 | ||
| 825 | lemma dist_half_times2: | |
| 826 | fixes a :: "'a :: real_normed_vector" | |
| 827 | shows "dist ((1 / 2) *\<^sub>R (a + b)) x * 2 = dist (a+b) (2 *\<^sub>R x)" | |
| 828 | proof - | |
| 829 | have "norm ((1 / 2) *\<^sub>R (a + b) - x) * 2 = norm (2 *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x))" | |
| 830 | by simp | |
| 831 | also have "... = norm ((a + b) - 2 *\<^sub>R x)" | |
| 832 | by (simp add: real_vector.scale_right_diff_distrib) | |
| 833 | finally show ?thesis | |
| 834 | by (simp only: dist_norm) | |
| 835 | qed | |
| 836 | ||
| 837 | lemma closed_segment_as_ball: | |
| 838 |     "closed_segment a b = affine hull {a,b} \<inter> cball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
 | |
| 839 | proof (cases "b = a") | |
| 840 | case True then show ?thesis by (auto simp: hull_inc) | |
| 841 | next | |
| 842 | case False | |
| 843 | then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and> | |
| 844 | dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) = | |
| 845 | (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)" for x | |
| 846 | proof - | |
| 847 | have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and> | |
| 848 | dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) = | |
| 849 | ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and> | |
| 850 | dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a))" | |
| 851 | unfolding eq_diff_eq [symmetric] by simp | |
| 852 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 853 | norm ((a+b) - (2 *\<^sub>R x)) \<le> norm (b - a))" | |
| 854 | by (simp add: dist_half_times2) (simp add: dist_norm) | |
| 855 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 856 | norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) \<le> norm (b - a))" | |
| 857 | by auto | |
| 858 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 859 | norm ((1 - u * 2) *\<^sub>R (b - a)) \<le> norm (b - a))" | |
| 860 | by (simp add: algebra_simps scaleR_2) | |
| 861 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 862 | \<bar>1 - u * 2\<bar> * norm (b - a) \<le> norm (b - a))" | |
| 863 | by simp | |
| 864 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> \<le> 1)" | |
| 865 | by (simp add: mult_le_cancel_right2 False) | |
| 866 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)" | |
| 867 | by auto | |
| 868 | finally show ?thesis . | |
| 869 | qed | |
| 870 | show ?thesis | |
| 871 | by (simp add: affine_hull_2 Set.set_eq_iff closed_segment_def *) | |
| 872 | qed | |
| 873 | ||
| 874 | lemma open_segment_as_ball: | |
| 875 | "open_segment a b = | |
| 876 |      affine hull {a,b} \<inter> ball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
 | |
| 877 | proof (cases "b = a") | |
| 878 | case True then show ?thesis by (auto simp: hull_inc) | |
| 879 | next | |
| 880 | case False | |
| 881 | then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and> | |
| 882 | dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) = | |
| 883 | (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)" for x | |
| 884 | proof - | |
| 885 | have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and> | |
| 886 | dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) = | |
| 887 | ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and> | |
| 888 | dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a))" | |
| 889 | unfolding eq_diff_eq [symmetric] by simp | |
| 890 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 891 | norm ((a+b) - (2 *\<^sub>R x)) < norm (b - a))" | |
| 892 | by (simp add: dist_half_times2) (simp add: dist_norm) | |
| 893 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 894 | norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) < norm (b - a))" | |
| 895 | by auto | |
| 896 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 897 | norm ((1 - u * 2) *\<^sub>R (b - a)) < norm (b - a))" | |
| 898 | by (simp add: algebra_simps scaleR_2) | |
| 899 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> | |
| 900 | \<bar>1 - u * 2\<bar> * norm (b - a) < norm (b - a))" | |
| 901 | by simp | |
| 902 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> < 1)" | |
| 903 | by (simp add: mult_le_cancel_right2 False) | |
| 904 | also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)" | |
| 905 | by auto | |
| 906 | finally show ?thesis . | |
| 907 | qed | |
| 908 | show ?thesis | |
| 909 | using False by (force simp: affine_hull_2 Set.set_eq_iff open_segment_image_interval *) | |
| 910 | qed | |
| 911 | ||
| 912 | lemmas segment_as_ball = closed_segment_as_ball open_segment_as_ball | |
| 913 | ||
| 71028 | 914 | lemma connected_segment [iff]: | 
| 915 | fixes x :: "'a :: real_normed_vector" | |
| 916 | shows "connected (closed_segment x y)" | |
| 917 | by (simp add: convex_connected) | |
| 918 | ||
| 919 | lemma is_interval_closed_segment_1[intro, simp]: "is_interval (closed_segment a b)" for a b::real | |
| 920 | unfolding closed_segment_eq_real_ivl | |
| 921 | by (auto simp: is_interval_def) | |
| 922 | ||
| 923 | lemma IVT'_closed_segment_real: | |
| 924 | fixes f :: "real \<Rightarrow> real" | |
| 925 | assumes "y \<in> closed_segment (f a) (f b)" | |
| 926 | assumes "continuous_on (closed_segment a b) f" | |
| 927 | shows "\<exists>x \<in> closed_segment a b. f x = y" | |
| 928 | using IVT'[of f a y b] | |
| 929 | IVT'[of "-f" a "-y" b] | |
| 930 | IVT'[of f b y a] | |
| 931 | IVT'[of "-f" b "-y" a] assms | |
| 932 | by (cases "a \<le> b"; cases "f b \<ge> f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus) | |
| 933 | ||
| 934 | subsection \<open>Betweenness\<close> | |
| 935 | ||
| 936 | definition\<^marker>\<open>tag important\<close> "between = (\<lambda>(a,b) x. x \<in> closed_segment a b)" | |
| 937 | ||
| 938 | lemma betweenI: | |
| 939 | assumes "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" | |
| 940 | shows "between (a, b) x" | |
| 78477 | 941 | using assms unfolding between_def closed_segment_def by auto | 
| 71028 | 942 | |
| 943 | lemma betweenE: | |
| 944 | assumes "between (a, b) x" | |
| 945 | obtains u where "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" | |
| 78477 | 946 | using assms unfolding between_def closed_segment_def by auto | 
| 71028 | 947 | |
| 948 | lemma between_implies_scaled_diff: | |
| 949 | assumes "between (S, T) X" "between (S, T) Y" "S \<noteq> Y" | |
| 950 | obtains c where "(X - Y) = c *\<^sub>R (S - Y)" | |
| 951 | proof - | |
| 952 | from \<open>between (S, T) X\<close> obtain u\<^sub>X where X: "X = u\<^sub>X *\<^sub>R S + (1 - u\<^sub>X) *\<^sub>R T" | |
| 953 | by (metis add.commute betweenE eq_diff_eq) | |
| 954 | from \<open>between (S, T) Y\<close> obtain u\<^sub>Y where Y: "Y = u\<^sub>Y *\<^sub>R S + (1 - u\<^sub>Y) *\<^sub>R T" | |
| 955 | by (metis add.commute betweenE eq_diff_eq) | |
| 956 | have "X - Y = (u\<^sub>X - u\<^sub>Y) *\<^sub>R (S - T)" | |
| 78477 | 957 | by (simp add: X Y scaleR_left.diff scaleR_right_diff_distrib) | 
| 71028 | 958 | moreover from Y have "S - Y = (1 - u\<^sub>Y) *\<^sub>R (S - T)" | 
| 959 | by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib) | |
| 960 | moreover note \<open>S \<noteq> Y\<close> | |
| 961 | ultimately have "(X - Y) = ((u\<^sub>X - u\<^sub>Y) / (1 - u\<^sub>Y)) *\<^sub>R (S - Y)" by auto | |
| 962 | from this that show thesis by blast | |
| 963 | qed | |
| 964 | ||
| 965 | lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b" | |
| 966 | unfolding between_def by auto | |
| 967 | ||
| 968 | lemma between: "between (a, b) (x::'a::euclidean_space) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)" | |
| 969 | proof (cases "a = b") | |
| 970 | case True | |
| 971 | then show ?thesis | |
| 972 | by (auto simp add: between_def dist_commute) | |
| 973 | next | |
| 974 | case False | |
| 975 | then have Fal: "norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0" | |
| 976 | by auto | |
| 977 | have *: "\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" | |
| 978 | by (auto simp add: algebra_simps) | |
| 979 | 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 \<le> u" "u \<le> 1" for u | |
| 980 | proof - | |
| 981 | have *: "a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)" | |
| 982 | unfolding that(1) by (auto simp add:algebra_simps) | |
| 983 | show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)" | |
| 984 | unfolding norm_minus_commute[of x a] * using \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> | |
| 985 | by simp | |
| 986 | qed | |
| 987 | moreover have "\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1" if "dist a b = dist a x + dist x b" | |
| 988 | proof - | |
| 989 | let ?\<beta> = "norm (a - x) / norm (a - b)" | |
| 990 | show "\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1" | |
| 991 | proof (intro exI conjI) | |
| 992 | show "?\<beta> \<le> 1" | |
| 993 | using Fal2 unfolding that[unfolded dist_norm] norm_ge_zero by auto | |
| 994 | show "x = (1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b" | |
| 995 | proof (subst euclidean_eq_iff; intro ballI) | |
| 996 | fix i :: 'a | |
| 997 | assume i: "i \<in> Basis" | |
| 998 | have "((1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b) \<bullet> i | |
| 999 | = ((norm (a - b) - norm (a - x)) * (a \<bullet> i) + norm (a - x) * (b \<bullet> i)) / norm (a - b)" | |
| 1000 | using Fal by (auto simp add: field_simps inner_simps) | |
| 1001 | also have "\<dots> = x\<bullet>i" | |
| 1002 | apply (rule divide_eq_imp[OF Fal]) | |
| 1003 | unfolding that[unfolded dist_norm] | |
| 1004 | using that[unfolded dist_triangle_eq] i | |
| 1005 | apply (subst (asm) euclidean_eq_iff) | |
| 1006 | apply (auto simp add: field_simps inner_simps) | |
| 1007 | done | |
| 1008 | finally show "x \<bullet> i = ((1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b) \<bullet> i" | |
| 1009 | by auto | |
| 1010 | qed | |
| 1011 | qed (use Fal2 in auto) | |
| 1012 | qed | |
| 1013 | ultimately show ?thesis | |
| 1014 | by (force simp add: between_def closed_segment_def dist_triangle_eq) | |
| 1015 | qed | |
| 1016 | ||
| 1017 | lemma between_midpoint: | |
| 1018 | fixes a :: "'a::euclidean_space" | |
| 1019 | shows "between (a,b) (midpoint a b)" (is ?t1) | |
| 1020 | and "between (b,a) (midpoint a b)" (is ?t2) | |
| 1021 | proof - | |
| 1022 | have *: "\<And>x y z. x = (1/2::real) *\<^sub>R z \<Longrightarrow> y = (1/2) *\<^sub>R z \<Longrightarrow> norm z = norm x + norm y" | |
| 1023 | by auto | |
| 1024 | show ?t1 ?t2 | |
| 1025 | unfolding between midpoint_def dist_norm | |
| 1026 | by (auto simp add: field_simps inner_simps euclidean_eq_iff[where 'a='a] intro!: *) | |
| 1027 | qed | |
| 1028 | ||
| 1029 | lemma between_mem_convex_hull: | |
| 1030 |   "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
 | |
| 1031 | unfolding between_mem_segment segment_convex_hull .. | |
| 1032 | ||
| 1033 | lemma between_triv_iff [simp]: "between (a,a) b \<longleftrightarrow> a=b" | |
| 1034 | by (auto simp: between_def) | |
| 1035 | ||
| 1036 | lemma between_triv1 [simp]: "between (a,b) a" | |
| 1037 | by (auto simp: between_def) | |
| 1038 | ||
| 1039 | lemma between_triv2 [simp]: "between (a,b) b" | |
| 1040 | by (auto simp: between_def) | |
| 1041 | ||
| 1042 | lemma between_commute: | |
| 78477 | 1043 | "between (a,b) = between (b,a)" | 
| 1044 | by (auto simp: between_def closed_segment_commute) | |
| 71028 | 1045 | |
| 1046 | lemma between_antisym: | |
| 1047 | fixes a :: "'a :: euclidean_space" | |
| 1048 | shows "\<lbrakk>between (b,c) a; between (a,c) b\<rbrakk> \<Longrightarrow> a = b" | |
| 78477 | 1049 | by (auto simp: between dist_commute) | 
| 71028 | 1050 | |
| 1051 | lemma between_trans: | |
| 78477 | 1052 | fixes a :: "'a :: euclidean_space" | 
| 1053 | shows "\<lbrakk>between (b,c) a; between (a,c) d\<rbrakk> \<Longrightarrow> between (b,c) d" | |
| 71028 | 1054 | using dist_triangle2 [of b c d] dist_triangle3 [of b d a] | 
| 1055 | by (auto simp: between dist_commute) | |
| 1056 | ||
| 1057 | lemma between_norm: | |
| 1058 | fixes a :: "'a :: euclidean_space" | |
| 1059 | shows "between (a,b) x \<longleftrightarrow> norm(x - a) *\<^sub>R (b - x) = norm(b - x) *\<^sub>R (x - a)" | |
| 1060 | by (auto simp: between dist_triangle_eq norm_minus_commute algebra_simps) | |
| 1061 | ||
| 1062 | lemma between_swap: | |
| 1063 | fixes A B X Y :: "'a::euclidean_space" | |
| 1064 | assumes "between (A, B) X" | |
| 1065 | assumes "between (A, B) Y" | |
| 1066 | shows "between (X, B) Y \<longleftrightarrow> between (A, Y) X" | |
| 78477 | 1067 | using assms by (auto simp add: between) | 
| 71028 | 1068 | |
| 1069 | lemma between_translation [simp]: "between (a + y,a + z) (a + x) \<longleftrightarrow> between (y,z) x" | |
| 1070 | by (auto simp: between_def) | |
| 1071 | ||
| 1072 | lemma between_trans_2: | |
| 1073 | fixes a :: "'a :: euclidean_space" | |
| 1074 | shows "\<lbrakk>between (b,c) a; between (a,b) d\<rbrakk> \<Longrightarrow> between (c,d) a" | |
| 1075 | by (metis between_commute between_swap between_trans) | |
| 1076 | ||
| 1077 | lemma between_scaleR_lift [simp]: | |
| 1078 | fixes v :: "'a::euclidean_space" | |
| 1079 | shows "between (a *\<^sub>R v, b *\<^sub>R v) (c *\<^sub>R v) \<longleftrightarrow> v = 0 \<or> between (a, b) c" | |
| 78477 | 1080 | by (simp add: between dist_norm flip: scaleR_left_diff_distrib distrib_right) | 
| 71028 | 1081 | |
| 1082 | lemma between_1: | |
| 1083 | fixes x::real | |
| 1084 | shows "between (a,b) x \<longleftrightarrow> (a \<le> x \<and> x \<le> b) \<or> (b \<le> x \<and> x \<le> a)" | |
| 1085 | by (auto simp: between_mem_segment closed_segment_eq_real_ivl) | |
| 1086 | ||
| 1087 | end |