author | paulson <lp15@cam.ac.uk> |
Thu, 17 Apr 2025 22:57:26 +0100 | |
changeset 82522 | 62afd98e3f3e |
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:
71028
diff
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:
71028
diff
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:
71028
diff
changeset
|
28 |
also have "... \<in> S" |
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
paulson <lp15@cam.ac.uk>
parents:
71028
diff
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:
71028
diff
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:
71028
diff
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:
71028
diff
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:
78477
diff
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:
78477
diff
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:
71028
diff
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:
71028
diff
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:
71028
diff
changeset
|
457 |
next |
df1d96114754
Fixed a few messy proofs and adjusted inconsistent section headings
paulson <lp15@cam.ac.uk>
parents:
71028
diff
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:
71028
diff
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:
71028
diff
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:
71028
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
changeset
|
480 |
proof safe |
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
changeset
|
487 |
next |
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
changeset
|
493 |
qed |
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
changeset
|
494 |
|
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
changeset
|
498 |
proof safe |
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
changeset
|
505 |
next |
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
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:
71169
diff
changeset
|
511 |
qed |
954ee5acaae0
Split off new HOL-Complex_Analysis session from HOL-Analysis
Manuel Eberl <eberlm@in.tum.de>
parents:
71169
diff
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:
73932
diff
changeset
|
803 |
lemma closed_segment_same_fst: |
9a60c1759543
Lots more new material thanks to Manuel Eberl
paulson <lp15@cam.ac.uk>
parents:
73932
diff
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:
73932
diff
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:
73932
diff
changeset
|
806 |
|
9a60c1759543
Lots more new material thanks to Manuel Eberl
paulson <lp15@cam.ac.uk>
parents:
73932
diff
changeset
|
807 |
lemma closed_segment_same_snd: |
9a60c1759543
Lots more new material thanks to Manuel Eberl
paulson <lp15@cam.ac.uk>
parents:
73932
diff
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:
73932
diff
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:
73932
diff
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 |