src/HOL/Analysis/Starlike.thy
 author wenzelm Mon Mar 25 17:21:26 2019 +0100 (2 months ago) changeset 69981 3dced198b9ec parent 69922 4a9167f377b0 child 70136 f03a01a18c6e permissions -rw-r--r--
more strict AFP properties;
1 (* Title:      HOL/Analysis/Starlike.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 chapter \<open>Unsorted\<close>
10 theory Starlike
11 imports Convex_Euclidean_Space Abstract_Limits
12 begin
14 section \<open>Line Segments\<close>
16 subsection \<open>Midpoint\<close>
18 definition%important midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a"
19   where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
21 lemma midpoint_idem [simp]: "midpoint x x = x"
22   unfolding midpoint_def  by simp
24 lemma midpoint_sym: "midpoint a b = midpoint b a"
25   unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
27 lemma midpoint_eq_iff: "midpoint a b = c \<longleftrightarrow> a + b = c + c"
28 proof -
29   have "midpoint a b = c \<longleftrightarrow> scaleR 2 (midpoint a b) = scaleR 2 c"
30     by simp
31   then show ?thesis
32     unfolding midpoint_def scaleR_2 [symmetric] by simp
33 qed
35 lemma
36   fixes a::real
37   assumes "a \<le> b" shows ge_midpoint_1: "a \<le> midpoint a b"
38                     and le_midpoint_1: "midpoint a b \<le> b"
39   by (simp_all add: midpoint_def assms)
41 lemma dist_midpoint:
42   fixes a b :: "'a::real_normed_vector" shows
43   "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
44   "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
45   "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
46   "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
47 proof -
48   have *: "\<And>x y::'a. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2"
49     unfolding equation_minus_iff by auto
50   have **: "\<And>x y::'a. 2 *\<^sub>R x =   y \<Longrightarrow> norm x = (norm y) / 2"
51     by auto
52   note scaleR_right_distrib [simp]
53   show ?t1
54     unfolding midpoint_def dist_norm
55     apply (rule **)
58     done
59   show ?t2
60     unfolding midpoint_def dist_norm
61     apply (rule *)
64     done
65   show ?t3
66     unfolding midpoint_def dist_norm
67     apply (rule *)
70     done
71   show ?t4
72     unfolding midpoint_def dist_norm
73     apply (rule **)
76     done
77 qed
79 lemma midpoint_eq_endpoint [simp]:
80   "midpoint a b = a \<longleftrightarrow> a = b"
81   "midpoint a b = b \<longleftrightarrow> a = b"
82   unfolding midpoint_eq_iff by auto
84 lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b"
85   using midpoint_eq_iff by metis
87 lemma midpoint_linear_image:
88    "linear f \<Longrightarrow> midpoint(f a)(f b) = f(midpoint a b)"
89 by (simp add: linear_iff midpoint_def)
92 subsection \<open>Line segments\<close>
94 definition%important closed_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set"
95   where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
97 definition%important open_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where
98   "open_segment a b \<equiv> closed_segment a b - {a,b}"
100 lemmas segment = open_segment_def closed_segment_def
102 lemma in_segment:
103     "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)"
104     "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)"
105   using less_eq_real_def by (auto simp: segment algebra_simps)
107 lemma closed_segment_linear_image:
108   "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f"
109 proof -
110   interpret linear f by fact
111   show ?thesis
113 qed
115 lemma open_segment_linear_image:
116     "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> open_segment (f a) (f b) = f ` (open_segment a b)"
117   by (force simp: open_segment_def closed_segment_linear_image inj_on_def)
119 lemma closed_segment_translation:
120     "closed_segment (c + a) (c + b) = image (\<lambda>x. c + x) (closed_segment a b)"
121 apply safe
122 apply (rule_tac x="x-c" in image_eqI)
123 apply (auto simp: in_segment algebra_simps)
124 done
126 lemma open_segment_translation:
127     "open_segment (c + a) (c + b) = image (\<lambda>x. c + x) (open_segment a b)"
128 by (simp add: open_segment_def closed_segment_translation translation_diff)
130 lemma closed_segment_of_real:
131     "closed_segment (of_real x) (of_real y) = of_real ` closed_segment x y"
132   apply (auto simp: image_iff in_segment scaleR_conv_of_real)
133     apply (rule_tac x="(1-u)*x + u*y" in bexI)
134   apply (auto simp: in_segment)
135   done
137 lemma open_segment_of_real:
138     "open_segment (of_real x) (of_real y) = of_real ` open_segment x y"
139   apply (auto simp: image_iff in_segment scaleR_conv_of_real)
140     apply (rule_tac x="(1-u)*x + u*y" in bexI)
141   apply (auto simp: in_segment)
142   done
144 lemma closed_segment_Reals:
145     "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> closed_segment x y = of_real ` closed_segment (Re x) (Re y)"
146   by (metis closed_segment_of_real of_real_Re)
148 lemma open_segment_Reals:
149     "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> open_segment x y = of_real ` open_segment (Re x) (Re y)"
150   by (metis open_segment_of_real of_real_Re)
152 lemma open_segment_PairD:
153     "(x, x') \<in> open_segment (a, a') (b, b')
154      \<Longrightarrow> (x \<in> open_segment a b \<or> a = b) \<and> (x' \<in> open_segment a' b' \<or> a' = b')"
155   by (auto simp: in_segment)
157 lemma closed_segment_PairD:
158   "(x, x') \<in> closed_segment (a, a') (b, b') \<Longrightarrow> x \<in> closed_segment a b \<and> x' \<in> closed_segment a' b'"
159   by (auto simp: closed_segment_def)
161 lemma closed_segment_translation_eq [simp]:
162     "d + x \<in> closed_segment (d + a) (d + b) \<longleftrightarrow> x \<in> closed_segment a b"
163 proof -
164   have *: "\<And>d x a b. x \<in> closed_segment a b \<Longrightarrow> d + x \<in> closed_segment (d + a) (d + b)"
166     apply (erule ex_forward)
168     done
169   show ?thesis
170   using * [where d = "-d"] *
172 qed
174 lemma open_segment_translation_eq [simp]:
175     "d + x \<in> open_segment (d + a) (d + b) \<longleftrightarrow> x \<in> open_segment a b"
178 lemma of_real_closed_segment [simp]:
179   "of_real x \<in> closed_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> closed_segment a b"
180   apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward)
181   using of_real_eq_iff by fastforce
183 lemma of_real_open_segment [simp]:
184   "of_real x \<in> open_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> open_segment a b"
185   apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward del: exE)
186   using of_real_eq_iff by fastforce
188 lemma convex_contains_segment:
189   "convex S \<longleftrightarrow> (\<forall>a\<in>S. \<forall>b\<in>S. closed_segment a b \<subseteq> S)"
190   unfolding convex_alt closed_segment_def by auto
192 lemma closed_segment_in_Reals:
193    "\<lbrakk>x \<in> closed_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
194   by (meson subsetD convex_Reals convex_contains_segment)
196 lemma open_segment_in_Reals:
197    "\<lbrakk>x \<in> open_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
198   by (metis Diff_iff closed_segment_in_Reals open_segment_def)
200 lemma closed_segment_subset: "\<lbrakk>x \<in> S; y \<in> S; convex S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> S"
203 lemma closed_segment_subset_convex_hull:
204     "\<lbrakk>x \<in> convex hull S; y \<in> convex hull S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> convex hull S"
205   using convex_contains_segment by blast
207 lemma segment_convex_hull:
208   "closed_segment a b = convex hull {a,b}"
209 proof -
210   have *: "\<And>x. {x} \<noteq> {}" by auto
211   show ?thesis
212     unfolding segment convex_hull_insert[OF *] convex_hull_singleton
213     by (safe; rule_tac x="1 - u" in exI; force)
214 qed
216 lemma open_closed_segment: "u \<in> open_segment w z \<Longrightarrow> u \<in> closed_segment w z"
217   by (auto simp add: closed_segment_def open_segment_def)
219 lemma segment_open_subset_closed:
220    "open_segment a b \<subseteq> closed_segment a b"
221   by (auto simp: closed_segment_def open_segment_def)
223 lemma bounded_closed_segment:
224     fixes a :: "'a::euclidean_space" shows "bounded (closed_segment a b)"
225   by (simp add: segment_convex_hull compact_convex_hull compact_imp_bounded)
227 lemma bounded_open_segment:
228     fixes a :: "'a::euclidean_space" shows "bounded (open_segment a b)"
229   by (rule bounded_subset [OF bounded_closed_segment segment_open_subset_closed])
231 lemmas bounded_segment = bounded_closed_segment open_closed_segment
233 lemma ends_in_segment [iff]: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
234   unfolding segment_convex_hull
235   by (auto intro!: hull_subset[unfolded subset_eq, rule_format])
237 lemma eventually_closed_segment:
238   fixes x0::"'a::real_normed_vector"
239   assumes "open X0" "x0 \<in> X0"
240   shows "\<forall>\<^sub>F x in at x0 within U. closed_segment x0 x \<subseteq> X0"
241 proof -
242   from openE[OF assms]
243   obtain e where e: "0 < e" "ball x0 e \<subseteq> X0" .
244   then have "\<forall>\<^sub>F x in at x0 within U. x \<in> ball x0 e"
245     by (auto simp: dist_commute eventually_at)
246   then show ?thesis
247   proof eventually_elim
248     case (elim x)
249     have "x0 \<in> ball x0 e" using \<open>e > 0\<close> by simp
250     from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim]
251     have "closed_segment x0 x \<subseteq> ball x0 e" .
252     also note \<open>\<dots> \<subseteq> X0\<close>
253     finally show ?case .
254   qed
255 qed
257 lemma segment_furthest_le:
258   fixes a b x y :: "'a::euclidean_space"
259   assumes "x \<in> closed_segment a b"
260   shows "norm (y - x) \<le> norm (y - a) \<or>  norm (y - x) \<le> norm (y - b)"
261 proof -
262   obtain z where "z \<in> {a, b}" "norm (x - y) \<le> norm (z - y)"
263     using simplex_furthest_le[of "{a, b}" y]
264     using assms[unfolded segment_convex_hull]
265     by auto
266   then show ?thesis
268 qed
270 lemma closed_segment_commute: "closed_segment a b = closed_segment b a"
271 proof -
272   have "{a, b} = {b, a}" by auto
273   thus ?thesis
275 qed
277 lemma segment_bound1:
278   assumes "x \<in> closed_segment a b"
279   shows "norm (x - a) \<le> norm (b - a)"
280 proof -
281   obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
282     using assms by (auto simp add: closed_segment_def)
283   then show "norm (x - a) \<le> norm (b - a)"
284     apply clarify
285     apply (auto simp: algebra_simps)
286     apply (simp add: scaleR_diff_right [symmetric] mult_left_le_one_le)
287     done
288 qed
290 lemma segment_bound:
291   assumes "x \<in> closed_segment a b"
292   shows "norm (x - a) \<le> norm (b - a)" "norm (x - b) \<le> norm (b - a)"
293 apply (simp add: assms segment_bound1)
294 by (metis assms closed_segment_commute dist_commute dist_norm segment_bound1)
296 lemma open_segment_commute: "open_segment a b = open_segment b a"
297 proof -
298   have "{a, b} = {b, a}" by auto
299   thus ?thesis
300     by (simp add: closed_segment_commute open_segment_def)
301 qed
303 lemma closed_segment_idem [simp]: "closed_segment a a = {a}"
304   unfolding segment by (auto simp add: algebra_simps)
306 lemma open_segment_idem [simp]: "open_segment a a = {}"
309 lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
310   using open_segment_def by auto
312 lemma convex_contains_open_segment:
313   "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. open_segment a b \<subseteq> s)"
314   by (simp add: convex_contains_segment closed_segment_eq_open)
316 lemma closed_segment_eq_real_ivl:
317   fixes a b::real
318   shows "closed_segment a b = (if a \<le> b then {a .. b} else {b .. a})"
319 proof -
320   have "b \<le> a \<Longrightarrow> closed_segment b a = {b .. a}"
321     and "a \<le> b \<Longrightarrow> closed_segment a b = {a .. b}"
322     by (auto simp: convex_hull_eq_real_cbox segment_convex_hull)
323   thus ?thesis
324     by (auto simp: closed_segment_commute)
325 qed
327 lemma open_segment_eq_real_ivl:
328   fixes a b::real
329   shows "open_segment a b = (if a \<le> b then {a<..<b} else {b<..<a})"
330 by (auto simp: closed_segment_eq_real_ivl open_segment_def split: if_split_asm)
332 lemma closed_segment_real_eq:
333   fixes u::real shows "closed_segment u v = (\<lambda>x. (v - u) * x + u) ` {0..1}"
336 lemma dist_in_closed_segment:
337   fixes a :: "'a :: euclidean_space"
338   assumes "x \<in> closed_segment a b"
339     shows "dist x a \<le> dist a b \<and> dist x b \<le> dist a b"
340 proof (intro conjI)
341   obtain u where u: "0 \<le> u" "u \<le> 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
342     using assms by (force simp: in_segment algebra_simps)
343   have "dist x a = u * dist a b"
344     apply (simp add: dist_norm algebra_simps x)
345     by (metis \<open>0 \<le> u\<close> abs_of_nonneg norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib)
346   also have "...  \<le> dist a b"
347     by (simp add: mult_left_le_one_le u)
348   finally show "dist x a \<le> dist a b" .
349   have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)"
350     by (simp add: dist_norm algebra_simps x)
351   also have "... = (1-u) * dist a b"
352   proof -
353     have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)"
354       using \<open>u \<le> 1\<close> by force
355     then show ?thesis
356       by (simp add: dist_norm real_vector.scale_right_diff_distrib)
357   qed
358   also have "... \<le> dist a b"
359     by (simp add: mult_left_le_one_le u)
360   finally show "dist x b \<le> dist a b" .
361 qed
363 lemma dist_in_open_segment:
364   fixes a :: "'a :: euclidean_space"
365   assumes "x \<in> open_segment a b"
366     shows "dist x a < dist a b \<and> dist x b < dist a b"
367 proof (intro conjI)
368   obtain u where u: "0 < u" "u < 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
369     using assms by (force simp: in_segment algebra_simps)
370   have "dist x a = u * dist a b"
371     apply (simp add: dist_norm algebra_simps x)
372     by (metis abs_of_nonneg less_eq_real_def norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib \<open>0 < u\<close>)
373   also have *: "...  < dist a b"
374     by (metis (no_types) assms dist_eq_0_iff dist_not_less_zero in_segment(2) linorder_neqE_linordered_idom mult.left_neutral real_mult_less_iff1 \<open>u < 1\<close>)
375   finally show "dist x a < dist a b" .
376   have ab_ne0: "dist a b \<noteq> 0"
377     using * by fastforce
378   have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)"
379     by (simp add: dist_norm algebra_simps x)
380   also have "... = (1-u) * dist a b"
381   proof -
382     have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)"
383       using \<open>u < 1\<close> by force
384     then show ?thesis
385       by (simp add: dist_norm real_vector.scale_right_diff_distrib)
386   qed
387   also have "... < dist a b"
388     using ab_ne0 \<open>0 < u\<close> by simp
389   finally show "dist x b < dist a b" .
390 qed
392 lemma dist_decreases_open_segment_0:
393   fixes x :: "'a :: euclidean_space"
394   assumes "x \<in> open_segment 0 b"
395     shows "dist c x < dist c 0 \<or> dist c x < dist c b"
396 proof (rule ccontr, clarsimp simp: not_less)
397   obtain u where u: "0 \<noteq> b" "0 < u" "u < 1" and x: "x = u *\<^sub>R b"
398     using assms by (auto simp: in_segment)
399   have xb: "x \<bullet> b < b \<bullet> b"
400     using u x by auto
401   assume "norm c \<le> dist c x"
402   then have "c \<bullet> c \<le> (c - x) \<bullet> (c - x)"
403     by (simp add: dist_norm norm_le)
404   moreover have "0 < x \<bullet> b"
405     using u x by auto
406   ultimately have less: "c \<bullet> b < x \<bullet> b"
407     by (simp add: x algebra_simps inner_commute u)
408   assume "dist c b \<le> dist c x"
409   then have "(c - b) \<bullet> (c - b) \<le> (c - x) \<bullet> (c - x)"
410     by (simp add: dist_norm norm_le)
411   then have "(b \<bullet> b) * (1 - u*u) \<le> 2 * (b \<bullet> c) * (1-u)"
412     by (simp add: x algebra_simps inner_commute)
413   then have "(1+u) * (b \<bullet> b) * (1-u) \<le> 2 * (b \<bullet> c) * (1-u)"
415   then have "(1+u) * (b \<bullet> b) \<le> 2 * (b \<bullet> c)"
416     using \<open>u < 1\<close> by auto
417   with xb have "c \<bullet> b \<ge> x \<bullet> b"
418     by (auto simp: x algebra_simps inner_commute)
419   with less show False by auto
420 qed
422 proposition dist_decreases_open_segment:
423   fixes a :: "'a :: euclidean_space"
424   assumes "x \<in> open_segment a b"
425     shows "dist c x < dist c a \<or> dist c x < dist c b"
426 proof -
427   have *: "x - a \<in> open_segment 0 (b - a)" using assms
428     by (metis diff_self open_segment_translation_eq uminus_add_conv_diff)
429   show ?thesis
430     using dist_decreases_open_segment_0 [OF *, of "c-a"] assms
432 qed
434 corollary open_segment_furthest_le:
435   fixes a b x y :: "'a::euclidean_space"
436   assumes "x \<in> open_segment a b"
437   shows "norm (y - x) < norm (y - a) \<or>  norm (y - x) < norm (y - b)"
438   by (metis assms dist_decreases_open_segment dist_norm)
440 corollary dist_decreases_closed_segment:
441   fixes a :: "'a :: euclidean_space"
442   assumes "x \<in> closed_segment a b"
443     shows "dist c x \<le> dist c a \<or> dist c x \<le> dist c b"
444 apply (cases "x \<in> open_segment a b")
445  using dist_decreases_open_segment less_eq_real_def apply blast
446 by (metis DiffI assms empty_iff insertE open_segment_def order_refl)
448 lemma convex_intermediate_ball:
449   fixes a :: "'a :: euclidean_space"
450   shows "\<lbrakk>ball a r \<subseteq> T; T \<subseteq> cball a r\<rbrakk> \<Longrightarrow> convex T"
451 apply (simp add: convex_contains_open_segment, clarify)
452 by (metis (no_types, hide_lams) less_le_trans mem_ball mem_cball subsetCE dist_decreases_open_segment)
454 lemma csegment_midpoint_subset: "closed_segment (midpoint a b) b \<subseteq> closed_segment a b"
455   apply (clarsimp simp: midpoint_def in_segment)
456   apply (rule_tac x="(1 + u) / 2" in exI)
457   apply (auto simp: algebra_simps add_divide_distrib diff_divide_distrib)
460 lemma notin_segment_midpoint:
461   fixes a :: "'a :: euclidean_space"
462   shows "a \<noteq> b \<Longrightarrow> a \<notin> closed_segment (midpoint a b) b"
463 by (auto simp: dist_midpoint dest!: dist_in_closed_segment)
465 lemma segment_to_closest_point:
466   fixes S :: "'a :: euclidean_space set"
467   shows "\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> open_segment a (closest_point S a) \<inter> S = {}"
468   apply (subst disjoint_iff_not_equal)
469   apply (clarify dest!: dist_in_open_segment)
470   by (metis closest_point_le dist_commute le_less_trans less_irrefl)
472 lemma segment_to_point_exists:
473   fixes S :: "'a :: euclidean_space set"
474     assumes "closed S" "S \<noteq> {}"
475     obtains b where "b \<in> S" "open_segment a b \<inter> S = {}"
476   by (metis assms segment_to_closest_point closest_point_exists that)
478 subsubsection\<open>More lemmas, especially for working with the underlying formula\<close>
480 lemma segment_eq_compose:
481   fixes a :: "'a :: real_vector"
482   shows "(\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) = (\<lambda>x. a + x) o (\<lambda>u. u *\<^sub>R (b - a))"
483     by (simp add: o_def algebra_simps)
485 lemma segment_degen_1:
486   fixes a :: "'a :: real_vector"
487   shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = b \<longleftrightarrow> a=b \<or> u=1"
488 proof -
489   { assume "(1 - u) *\<^sub>R a + u *\<^sub>R b = b"
490     then have "(1 - u) *\<^sub>R a = (1 - u) *\<^sub>R b"
492     then have "a=b \<or> u=1"
493       by simp
494   } then show ?thesis
495       by (auto simp: algebra_simps)
496 qed
498 lemma segment_degen_0:
499     fixes a :: "'a :: real_vector"
500     shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = a \<longleftrightarrow> a=b \<or> u=0"
501   using segment_degen_1 [of "1-u" b a]
502   by (auto simp: algebra_simps)
505   fixes a b ::"'a::real_vector"
506   assumes  "(u *\<^sub>R b + v *\<^sub>R a) = (u *\<^sub>R a + v *\<^sub>R b)"  "u \<noteq> v"
507   shows "a=b"
510 lemma closed_segment_image_interval:
511      "closed_segment a b = (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0..1}"
512   by (auto simp: set_eq_iff image_iff closed_segment_def)
514 lemma open_segment_image_interval:
515      "open_segment a b = (if a=b then {} else (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1})"
516   by (auto simp:  open_segment_def closed_segment_def segment_degen_0 segment_degen_1)
518 lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval
520 lemma open_segment_bound1:
521   assumes "x \<in> open_segment a b"
522   shows "norm (x - a) < norm (b - a)"
523 proof -
524   obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 < u" "u < 1" "a \<noteq> b"
525     using assms by (auto simp add: open_segment_image_interval split: if_split_asm)
526   then show "norm (x - a) < norm (b - a)"
527     apply clarify
528     apply (auto simp: algebra_simps)
529     apply (simp add: scaleR_diff_right [symmetric])
530     done
531 qed
533 lemma compact_segment [simp]:
534   fixes a :: "'a::real_normed_vector"
535   shows "compact (closed_segment a b)"
536   by (auto simp: segment_image_interval intro!: compact_continuous_image continuous_intros)
538 lemma closed_segment [simp]:
539   fixes a :: "'a::real_normed_vector"
540   shows "closed (closed_segment a b)"
543 lemma closure_closed_segment [simp]:
544   fixes a :: "'a::real_normed_vector"
545   shows "closure(closed_segment a b) = closed_segment a b"
546   by simp
548 lemma open_segment_bound:
549   assumes "x \<in> open_segment a b"
550   shows "norm (x - a) < norm (b - a)" "norm (x - b) < norm (b - a)"
551 apply (simp add: assms open_segment_bound1)
552 by (metis assms norm_minus_commute open_segment_bound1 open_segment_commute)
554 lemma closure_open_segment [simp]:
555   "closure (open_segment a b) = (if a = b then {} else closed_segment a b)"
556     for a :: "'a::euclidean_space"
557 proof (cases "a = b")
558   case True
559   then show ?thesis
560     by simp
561 next
562   case False
563   have "closure ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1}) = (\<lambda>u. u *\<^sub>R (b - a)) ` closure {0<..<1}"
564     apply (rule closure_injective_linear_image [symmetric])
565      apply (use False in \<open>auto intro!: injI\<close>)
566     done
567   then have "closure
568      ((\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1}) =
569     (\<lambda>x. (1 - x) *\<^sub>R a + x *\<^sub>R b) ` closure {0<..<1}"
570     using closure_translation [of a "((\<lambda>x. x *\<^sub>R b - x *\<^sub>R a) ` {0<..<1})"]
571     by (simp add: segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right image_image)
572   then show ?thesis
573     by (simp add: segment_image_interval closure_greaterThanLessThan [symmetric] del: closure_greaterThanLessThan)
574 qed
576 lemma closed_open_segment_iff [simp]:
577     fixes a :: "'a::euclidean_space"  shows "closed(open_segment a b) \<longleftrightarrow> a = b"
578   by (metis open_segment_def DiffE closure_eq closure_open_segment ends_in_segment(1) insert_iff segment_image_interval(2))
580 lemma compact_open_segment_iff [simp]:
581     fixes a :: "'a::euclidean_space"  shows "compact(open_segment a b) \<longleftrightarrow> a = b"
582   by (simp add: bounded_open_segment compact_eq_bounded_closed)
584 lemma convex_closed_segment [iff]: "convex (closed_segment a b)"
585   unfolding segment_convex_hull by(rule convex_convex_hull)
587 lemma convex_open_segment [iff]: "convex (open_segment a b)"
588 proof -
589   have "convex ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
590     by (rule convex_linear_image) auto
591   then have "convex ((+) a ` (\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
592     by (rule convex_translation)
593   then show ?thesis
594     by (simp add: image_image open_segment_image_interval segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right)
595 qed
597 lemmas convex_segment = convex_closed_segment convex_open_segment
599 lemma connected_segment [iff]:
600   fixes x :: "'a :: real_normed_vector"
601   shows "connected (closed_segment x y)"
604 lemma is_interval_closed_segment_1[intro, simp]: "is_interval (closed_segment a b)" for a b::real
605   by (auto simp: is_interval_convex_1)
607 lemma IVT'_closed_segment_real:
608   fixes f :: "real \<Rightarrow> real"
609   assumes "y \<in> closed_segment (f a) (f b)"
610   assumes "continuous_on (closed_segment a b) f"
611   shows "\<exists>x \<in> closed_segment a b. f x = y"
612   using IVT'[of f a y b]
613     IVT'[of "-f" a "-y" b]
614     IVT'[of f b y a]
615     IVT'[of "-f" b "-y" a] assms
616   by (cases "a \<le> b"; cases "f b \<ge> f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus)
619 subsection\<open>Starlike sets\<close>
621 definition%important "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
623 lemma starlike_UNIV [simp]: "starlike UNIV"
626 lemma convex_imp_starlike:
627   "convex S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> starlike S"
628   unfolding convex_contains_segment starlike_def by auto
631 lemma affine_hull_closed_segment [simp]:
632      "affine hull (closed_segment a b) = affine hull {a,b}"
635 lemma affine_hull_open_segment [simp]:
636     fixes a :: "'a::euclidean_space"
637     shows "affine hull (open_segment a b) = (if a = b then {} else affine hull {a,b})"
638 by (metis affine_hull_convex_hull affine_hull_empty closure_open_segment closure_same_affine_hull segment_convex_hull)
640 lemma rel_interior_closure_convex_segment:
641   fixes S :: "_::euclidean_space set"
642   assumes "convex S" "a \<in> rel_interior S" "b \<in> closure S"
643     shows "open_segment a b \<subseteq> rel_interior S"
644 proof
645   fix x
646   have [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R b = b - (1 - u) *\<^sub>R (b - a)" for u
648   assume "x \<in> open_segment a b"
649   then show "x \<in> rel_interior S"
650     unfolding closed_segment_def open_segment_def  using assms
651     by (auto intro: rel_interior_closure_convex_shrink)
652 qed
654 lemma convex_hull_insert_segments:
655    "convex hull (insert a S) =
656     (if S = {} then {a} else  \<Union>x \<in> convex hull S. closed_segment a x)"
657   by (force simp add: convex_hull_insert_alt in_segment)
659 lemma Int_convex_hull_insert_rel_exterior:
660   fixes z :: "'a::euclidean_space"
661   assumes "convex C" "T \<subseteq> C" and z: "z \<in> rel_interior C" and dis: "disjnt S (rel_interior C)"
662   shows "S \<inter> (convex hull (insert z T)) = S \<inter> (convex hull T)" (is "?lhs = ?rhs")
663 proof
664   have "T = {} \<Longrightarrow> z \<notin> S"
665     using dis z by (auto simp add: disjnt_def)
666   then show "?lhs \<subseteq> ?rhs"
667   proof (clarsimp simp add: convex_hull_insert_segments)
668     fix x y
669     assume "x \<in> S" and y: "y \<in> convex hull T" and "x \<in> closed_segment z y"
670     have "y \<in> closure C"
671       by (metis y \<open>convex C\<close> \<open>T \<subseteq> C\<close> closure_subset contra_subsetD convex_hull_eq hull_mono)
672     moreover have "x \<notin> rel_interior C"
673       by (meson \<open>x \<in> S\<close> dis disjnt_iff)
674     moreover have "x \<in> open_segment z y \<union> {z, y}"
675       using \<open>x \<in> closed_segment z y\<close> closed_segment_eq_open by blast
676     ultimately show "x \<in> convex hull T"
677       using rel_interior_closure_convex_segment [OF \<open>convex C\<close> z]
678       using y z by blast
679   qed
680   show "?rhs \<subseteq> ?lhs"
681     by (meson hull_mono inf_mono subset_insertI subset_refl)
682 qed
686 lemma dist_half_times2:
687   fixes a :: "'a :: real_normed_vector"
688   shows "dist ((1 / 2) *\<^sub>R (a + b)) x * 2 = dist (a+b) (2 *\<^sub>R x)"
689 proof -
690   have "norm ((1 / 2) *\<^sub>R (a + b) - x) * 2 = norm (2 *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x))"
691     by simp
692   also have "... = norm ((a + b) - 2 *\<^sub>R x)"
694   finally show ?thesis
695     by (simp only: dist_norm)
696 qed
698 lemma closed_segment_as_ball:
699     "closed_segment a b = affine hull {a,b} \<inter> cball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
700 proof (cases "b = a")
701   case True then show ?thesis by (auto simp: hull_inc)
702 next
703   case False
704   then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
705                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) =
706                  (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)" for x
707   proof -
708     have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
709                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) =
710           ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and>
711                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a))"
712       unfolding eq_diff_eq [symmetric] by simp
713     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
714                           norm ((a+b) - (2 *\<^sub>R x)) \<le> norm (b - a))"
716     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
717             norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) \<le> norm (b - a))"
718       by auto
719     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
720                 norm ((1 - u * 2) *\<^sub>R (b - a)) \<le> norm (b - a))"
721       by (simp add: algebra_simps scaleR_2)
722     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
723                           \<bar>1 - u * 2\<bar> * norm (b - a) \<le> norm (b - a))"
724       by simp
725     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> \<le> 1)"
726       by (simp add: mult_le_cancel_right2 False)
727     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)"
728       by auto
729     finally show ?thesis .
730   qed
731   show ?thesis
732     by (simp add: affine_hull_2 Set.set_eq_iff closed_segment_def *)
733 qed
735 lemma open_segment_as_ball:
736     "open_segment a b =
737      affine hull {a,b} \<inter> ball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
738 proof (cases "b = a")
739   case True then show ?thesis by (auto simp: hull_inc)
740 next
741   case False
742   then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
743                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) =
744                  (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)" for x
745   proof -
746     have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
747                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) =
748           ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and>
749                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a))"
750       unfolding eq_diff_eq [symmetric] by simp
751     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
752                           norm ((a+b) - (2 *\<^sub>R x)) < norm (b - a))"
754     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
755             norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) < norm (b - a))"
756       by auto
757     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
758                 norm ((1 - u * 2) *\<^sub>R (b - a)) < norm (b - a))"
759       by (simp add: algebra_simps scaleR_2)
760     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
761                           \<bar>1 - u * 2\<bar> * norm (b - a) < norm (b - a))"
762       by simp
763     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> < 1)"
764       by (simp add: mult_le_cancel_right2 False)
765     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)"
766       by auto
767     finally show ?thesis .
768   qed
769   show ?thesis
770     using False by (force simp: affine_hull_2 Set.set_eq_iff open_segment_image_interval *)
771 qed
773 lemmas segment_as_ball = closed_segment_as_ball open_segment_as_ball
775 lemma closed_segment_neq_empty [simp]: "closed_segment a b \<noteq> {}"
776   by auto
778 lemma open_segment_eq_empty [simp]: "open_segment a b = {} \<longleftrightarrow> a = b"
779 proof -
780   { assume a1: "open_segment a b = {}"
781     have "{} \<noteq> {0::real<..<1}"
782       by simp
783     then have "a = b"
784       using a1 open_segment_image_interval by fastforce
785   } then show ?thesis by auto
786 qed
788 lemma open_segment_eq_empty' [simp]: "{} = open_segment a b \<longleftrightarrow> a = b"
789   using open_segment_eq_empty by blast
791 lemmas segment_eq_empty = closed_segment_neq_empty open_segment_eq_empty
793 lemma inj_segment:
794   fixes a :: "'a :: real_vector"
795   assumes "a \<noteq> b"
796     shows "inj_on (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) I"
797 proof
798   fix x y
799   assume "(1 - x) *\<^sub>R a + x *\<^sub>R b = (1 - y) *\<^sub>R a + y *\<^sub>R b"
800   then have "x *\<^sub>R (b - a) = y *\<^sub>R (b - a)"
802   with assms show "x = y"
804 qed
806 lemma finite_closed_segment [simp]: "finite(closed_segment a b) \<longleftrightarrow> a = b"
807   apply auto
808   apply (rule ccontr)
810   using infinite_Icc [OF zero_less_one] finite_imageD [OF _ inj_segment] apply blast
811   done
813 lemma finite_open_segment [simp]: "finite(open_segment a b) \<longleftrightarrow> a = b"
814   by (auto simp: open_segment_def)
816 lemmas finite_segment = finite_closed_segment finite_open_segment
818 lemma closed_segment_eq_sing: "closed_segment a b = {c} \<longleftrightarrow> a = c \<and> b = c"
819   by auto
821 lemma open_segment_eq_sing: "open_segment a b \<noteq> {c}"
822   by (metis finite_insert finite_open_segment insert_not_empty open_segment_image_interval)
824 lemmas segment_eq_sing = closed_segment_eq_sing open_segment_eq_sing
826 lemma subset_closed_segment:
827     "closed_segment a b \<subseteq> closed_segment c d \<longleftrightarrow>
828      a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
829   by auto (meson contra_subsetD convex_closed_segment convex_contains_segment)
831 lemma subset_co_segment:
832     "closed_segment a b \<subseteq> open_segment c d \<longleftrightarrow>
833      a \<in> open_segment c d \<and> b \<in> open_segment c d"
834 using closed_segment_subset by blast
836 lemma subset_open_segment:
837   fixes a :: "'a::euclidean_space"
838   shows "open_segment a b \<subseteq> open_segment c d \<longleftrightarrow>
839          a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
840         (is "?lhs = ?rhs")
841 proof (cases "a = b")
842   case True then show ?thesis by simp
843 next
844   case False show ?thesis
845   proof
846     assume rhs: ?rhs
847     with \<open>a \<noteq> b\<close> have "c \<noteq> d"
848       using closed_segment_idem singleton_iff by auto
849     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) =
850                (1 - uc) *\<^sub>R c + uc *\<^sub>R d \<and> 0 < uc \<and> uc < 1"
851         if neq: "(1 - ua) *\<^sub>R c + ua *\<^sub>R d \<noteq> (1 - ub) *\<^sub>R c + ub *\<^sub>R d" "c \<noteq> d"
852            and "a = (1 - ua) *\<^sub>R c + ua *\<^sub>R d" "b = (1 - ub) *\<^sub>R c + ub *\<^sub>R d"
853            and u: "0 < u" "u < 1" and uab: "0 \<le> ua" "ua \<le> 1" "0 \<le> ub" "ub \<le> 1"
854         for u ua ub
855     proof -
856       have "ua \<noteq> ub"
857         using neq by auto
858       moreover have "(u - 1) * ua \<le> 0" using u uab
860       ultimately have lt: "(u - 1) * ua < u * ub" using u uab
861         by (metis antisym_conv diff_ge_0_iff_ge le_less_trans mult_eq_0_iff mult_le_0_iff not_less)
862       have "p * ua + q * ub < p+q" if p: "0 < p" and  q: "0 < q" for p q
863       proof -
864         have "\<not> p \<le> 0" "\<not> q \<le> 0"
865           using p q not_less by blast+
866         then show ?thesis
868                     less_eq_real_def mult_cancel_left1 mult_less_cancel_left2 uab(2) uab(4))
869       qed
870       then have "(1 - u) * ua + u * ub < 1" using u \<open>ua \<noteq> ub\<close>
872       with lt show ?thesis
873         by (rule_tac x="ua + u*(ub-ua)" in exI) (simp add: algebra_simps)
874     qed
875     with rhs \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close> show ?lhs
876       unfolding open_segment_image_interval closed_segment_def
878   next
879     assume lhs: ?lhs
880     with \<open>a \<noteq> b\<close> have "c \<noteq> d"
881       by (meson finite_open_segment rev_finite_subset)
882     have "closure (open_segment a b) \<subseteq> closure (open_segment c d)"
883       using lhs closure_mono by blast
884     then have "closed_segment a b \<subseteq> closed_segment c d"
885       by (simp add: \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close>)
886     then show ?rhs
887       by (force simp: \<open>a \<noteq> b\<close>)
888   qed
889 qed
891 lemma subset_oc_segment:
892   fixes a :: "'a::euclidean_space"
893   shows "open_segment a b \<subseteq> closed_segment c d \<longleftrightarrow>
894          a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
895 apply (simp add: subset_open_segment [symmetric])
896 apply (rule iffI)
897  apply (metis closure_closed_segment closure_mono closure_open_segment subset_closed_segment subset_open_segment)
898 apply (meson dual_order.trans segment_open_subset_closed)
899 done
901 lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment
904 subsection\<open>Betweenness\<close>
906 definition%important "between = (\<lambda>(a,b) x. x \<in> closed_segment a b)"
908 lemma betweenI:
909   assumes "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
910   shows "between (a, b) x"
911 using assms unfolding between_def closed_segment_def by auto
913 lemma betweenE:
914   assumes "between (a, b) x"
915   obtains u where "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
916 using assms unfolding between_def closed_segment_def by auto
918 lemma between_implies_scaled_diff:
919   assumes "between (S, T) X" "between (S, T) Y" "S \<noteq> Y"
920   obtains c where "(X - Y) = c *\<^sub>R (S - Y)"
921 proof -
922   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"
923     by (metis add.commute betweenE eq_diff_eq)
924   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"
925     by (metis add.commute betweenE eq_diff_eq)
926   have "X - Y = (u\<^sub>X - u\<^sub>Y) *\<^sub>R (S - T)"
927   proof -
928     from X Y have "X - Y =  u\<^sub>X *\<^sub>R S - u\<^sub>Y *\<^sub>R S + ((1 - u\<^sub>X) *\<^sub>R T - (1 - u\<^sub>Y) *\<^sub>R T)" by simp
929     also have "\<dots> = (u\<^sub>X - u\<^sub>Y) *\<^sub>R S - (u\<^sub>X - u\<^sub>Y) *\<^sub>R T" by (simp add: scaleR_left.diff)
930     finally show ?thesis by (simp add: real_vector.scale_right_diff_distrib)
931   qed
932   moreover from Y have "S - Y = (1 - u\<^sub>Y) *\<^sub>R (S - T)"
933     by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib)
934   moreover note \<open>S \<noteq> Y\<close>
935   ultimately have "(X - Y) = ((u\<^sub>X - u\<^sub>Y) / (1 - u\<^sub>Y)) *\<^sub>R (S - Y)" by auto
936   from this that show thesis by blast
937 qed
939 lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
940   unfolding between_def by auto
942 lemma between: "between (a, b) (x::'a::euclidean_space) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)"
943 proof (cases "a = b")
944   case True
945   then show ?thesis
946     by (auto simp add: between_def dist_commute)
947 next
948   case False
949   then have Fal: "norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0"
950     by auto
951   have *: "\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)"
952     by (auto simp add: algebra_simps)
953   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
954   proof -
955     have *: "a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)"
956       unfolding that(1) by (auto simp add:algebra_simps)
957     show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)"
958       unfolding norm_minus_commute[of x a] * using \<open>0 \<le> u\<close> \<open>u \<le> 1\<close>
959       by (auto simp add: field_simps)
960   qed
961   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"
962   proof -
963     let ?\<beta> = "norm (a - x) / norm (a - b)"
964     show "\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1"
965     proof (intro exI conjI)
966       show "?\<beta> \<le> 1"
967         using Fal2 unfolding that[unfolded dist_norm] norm_ge_zero by auto
968       show "x = (1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b"
969       proof (subst euclidean_eq_iff; intro ballI)
970         fix i :: 'a
971         assume i: "i \<in> Basis"
972         have "((1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b) \<bullet> i
973               = ((norm (a - b) - norm (a - x)) * (a \<bullet> i) + norm (a - x) * (b \<bullet> i)) / norm (a - b)"
974           using Fal by (auto simp add: field_simps inner_simps)
975         also have "\<dots> = x\<bullet>i"
976           apply (rule divide_eq_imp[OF Fal])
977           unfolding that[unfolded dist_norm]
978           using that[unfolded dist_triangle_eq] i
979           apply (subst (asm) euclidean_eq_iff)
980            apply (auto simp add: field_simps inner_simps)
981           done
982         finally show "x \<bullet> i = ((1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b) \<bullet> i"
983           by auto
984       qed
985     qed (use Fal2 in auto)
986   qed
987   ultimately show ?thesis
988     by (force simp add: between_def closed_segment_def dist_triangle_eq)
989 qed
991 lemma between_midpoint:
992   fixes a :: "'a::euclidean_space"
993   shows "between (a,b) (midpoint a b)" (is ?t1)
994     and "between (b,a) (midpoint a b)" (is ?t2)
995 proof -
996   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"
997     by auto
998   show ?t1 ?t2
999     unfolding between midpoint_def dist_norm
1000     by (auto simp add: field_simps inner_simps euclidean_eq_iff[where 'a='a] intro!: *)
1001 qed
1003 lemma between_mem_convex_hull:
1004   "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
1005   unfolding between_mem_segment segment_convex_hull ..
1007 lemma between_triv_iff [simp]: "between (a,a) b \<longleftrightarrow> a=b"
1008   by (auto simp: between_def)
1010 lemma between_triv1 [simp]: "between (a,b) a"
1011   by (auto simp: between_def)
1013 lemma between_triv2 [simp]: "between (a,b) b"
1014   by (auto simp: between_def)
1016 lemma between_commute:
1017    "between (a,b) = between (b,a)"
1018 by (auto simp: between_def closed_segment_commute)
1020 lemma between_antisym:
1021   fixes a :: "'a :: euclidean_space"
1022   shows "\<lbrakk>between (b,c) a; between (a,c) b\<rbrakk> \<Longrightarrow> a = b"
1023 by (auto simp: between dist_commute)
1025 lemma between_trans:
1026     fixes a :: "'a :: euclidean_space"
1027     shows "\<lbrakk>between (b,c) a; between (a,c) d\<rbrakk> \<Longrightarrow> between (b,c) d"
1028   using dist_triangle2 [of b c d] dist_triangle3 [of b d a]
1029   by (auto simp: between dist_commute)
1031 lemma between_norm:
1032     fixes a :: "'a :: euclidean_space"
1033     shows "between (a,b) x \<longleftrightarrow> norm(x - a) *\<^sub>R (b - x) = norm(b - x) *\<^sub>R (x - a)"
1034   by (auto simp: between dist_triangle_eq norm_minus_commute algebra_simps)
1036 lemma between_swap:
1037   fixes A B X Y :: "'a::euclidean_space"
1038   assumes "between (A, B) X"
1039   assumes "between (A, B) Y"
1040   shows "between (X, B) Y \<longleftrightarrow> between (A, Y) X"
1041 using assms by (auto simp add: between)
1043 lemma between_translation [simp]: "between (a + y,a + z) (a + x) \<longleftrightarrow> between (y,z) x"
1044   by (auto simp: between_def)
1046 lemma between_trans_2:
1047   fixes a :: "'a :: euclidean_space"
1048   shows "\<lbrakk>between (b,c) a; between (a,b) d\<rbrakk> \<Longrightarrow> between (c,d) a"
1049   by (metis between_commute between_swap between_trans)
1051 lemma between_scaleR_lift [simp]:
1052   fixes v :: "'a::euclidean_space"
1053   shows "between (a *\<^sub>R v, b *\<^sub>R v) (c *\<^sub>R v) \<longleftrightarrow> v = 0 \<or> between (a, b) c"
1054   by (simp add: between dist_norm scaleR_left_diff_distrib [symmetric] distrib_right [symmetric])
1056 lemma between_1:
1057   fixes x::real
1058   shows "between (a,b) x \<longleftrightarrow> (a \<le> x \<and> x \<le> b) \<or> (b \<le> x \<and> x \<le> a)"
1059   by (auto simp: between_mem_segment closed_segment_eq_real_ivl)
1062 subsection%unimportant \<open>Shrinking towards the interior of a convex set\<close>
1064 lemma mem_interior_convex_shrink:
1065   fixes S :: "'a::euclidean_space set"
1066   assumes "convex S"
1067     and "c \<in> interior S"
1068     and "x \<in> S"
1069     and "0 < e"
1070     and "e \<le> 1"
1071   shows "x - e *\<^sub>R (x - c) \<in> interior S"
1072 proof -
1073   obtain d where "d > 0" and d: "ball c d \<subseteq> S"
1074     using assms(2) unfolding mem_interior by auto
1075   show ?thesis
1076     unfolding mem_interior
1077   proof (intro exI subsetI conjI)
1078     fix y
1079     assume "y \<in> ball (x - e *\<^sub>R (x - c)) (e*d)"
1080     then have as: "dist (x - e *\<^sub>R (x - c)) y < e * d"
1081       by simp
1082     have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
1083       using \<open>e > 0\<close> by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib)
1084     have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = \<bar>1/e\<bar> * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
1085       unfolding dist_norm
1086       unfolding norm_scaleR[symmetric]
1087       apply (rule arg_cong[where f=norm])
1088       using \<open>e > 0\<close>
1089       by (auto simp add: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
1090     also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
1091       by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
1092     also have "\<dots> < d"
1093       using as[unfolded dist_norm] and \<open>e > 0\<close>
1094       by (auto simp add:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
1095     finally show "y \<in> S"
1096       apply (subst *)
1097       apply (rule assms(1)[unfolded convex_alt,rule_format])
1098       apply (rule d[unfolded subset_eq,rule_format])
1099       unfolding mem_ball
1100       using assms(3-5)
1101       apply auto
1102       done
1103   qed (insert \<open>e>0\<close> \<open>d>0\<close>, auto)
1104 qed
1106 lemma mem_interior_closure_convex_shrink:
1107   fixes S :: "'a::euclidean_space set"
1108   assumes "convex S"
1109     and "c \<in> interior S"
1110     and "x \<in> closure S"
1111     and "0 < e"
1112     and "e \<le> 1"
1113   shows "x - e *\<^sub>R (x - c) \<in> interior S"
1114 proof -
1115   obtain d where "d > 0" and d: "ball c d \<subseteq> S"
1116     using assms(2) unfolding mem_interior by auto
1117   have "\<exists>y\<in>S. norm (y - x) * (1 - e) < e * d"
1118   proof (cases "x \<in> S")
1119     case True
1120     then show ?thesis
1121       using \<open>e > 0\<close> \<open>d > 0\<close>
1122       apply (rule_tac bexI[where x=x])
1123       apply (auto)
1124       done
1125   next
1126     case False
1127     then have x: "x islimpt S"
1128       using assms(3)[unfolded closure_def] by auto
1129     show ?thesis
1130     proof (cases "e = 1")
1131       case True
1132       obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1"
1133         using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
1134       then show ?thesis
1135         apply (rule_tac x=y in bexI)
1136         unfolding True
1137         using \<open>d > 0\<close>
1138         apply auto
1139         done
1140     next
1141       case False
1142       then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
1143         using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
1144       then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
1145         using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
1146       then show ?thesis
1147         apply (rule_tac x=y in bexI)
1148         unfolding dist_norm
1149         using pos_less_divide_eq[OF *]
1150         apply auto
1151         done
1152     qed
1153   qed
1154   then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d"
1155     by auto
1156   define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
1157   have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
1158     unfolding z_def using \<open>e > 0\<close>
1159     by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
1160   have "z \<in> interior S"
1161     apply (rule interior_mono[OF d,unfolded subset_eq,rule_format])
1162     unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
1163     apply (auto simp add:field_simps norm_minus_commute)
1164     done
1165   then show ?thesis
1166     unfolding *
1167     using mem_interior_convex_shrink \<open>y \<in> S\<close> assms by blast
1168 qed
1170 lemma in_interior_closure_convex_segment:
1171   fixes S :: "'a::euclidean_space set"
1172   assumes "convex S" and a: "a \<in> interior S" and b: "b \<in> closure S"
1173     shows "open_segment a b \<subseteq> interior S"
1174 proof (clarsimp simp: in_segment)
1175   fix u::real
1176   assume u: "0 < u" "u < 1"
1177   have "(1 - u) *\<^sub>R a + u *\<^sub>R b = b - (1 - u) *\<^sub>R (b - a)"
1179   also have "... \<in> interior S" using mem_interior_closure_convex_shrink [OF assms] u
1180     by simp
1181   finally show "(1 - u) *\<^sub>R a + u *\<^sub>R b \<in> interior S" .
1182 qed
1184 lemma closure_open_Int_superset:
1185   assumes "open S" "S \<subseteq> closure T"
1186   shows "closure(S \<inter> T) = closure S"
1187 proof -
1188   have "closure S \<subseteq> closure(S \<inter> T)"
1189     by (metis assms closed_closure closure_minimal inf.orderE open_Int_closure_subset)
1190   then show ?thesis
1191     by (simp add: closure_mono dual_order.antisym)
1192 qed
1194 lemma convex_closure_interior:
1195   fixes S :: "'a::euclidean_space set"
1196   assumes "convex S" and int: "interior S \<noteq> {}"
1197   shows "closure(interior S) = closure S"
1198 proof -
1199   obtain a where a: "a \<in> interior S"
1200     using int by auto
1201   have "closure S \<subseteq> closure(interior S)"
1202   proof
1203     fix x
1204     assume x: "x \<in> closure S"
1205     show "x \<in> closure (interior S)"
1206     proof (cases "x=a")
1207       case True
1208       then show ?thesis
1209         using \<open>a \<in> interior S\<close> closure_subset by blast
1210     next
1211       case False
1212       show ?thesis
1213       proof (clarsimp simp add: closure_def islimpt_approachable)
1214         fix e::real
1215         assume xnotS: "x \<notin> interior S" and "0 < e"
1216         show "\<exists>x'\<in>interior S. x' \<noteq> x \<and> dist x' x < e"
1217         proof (intro bexI conjI)
1218           show "x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a) \<noteq> x"
1219             using False \<open>0 < e\<close> by (auto simp: algebra_simps min_def)
1220           show "dist (x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a)) x < e"
1221             using \<open>0 < e\<close> by (auto simp: dist_norm min_def)
1222           show "x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a) \<in> interior S"
1223             apply (clarsimp simp add: min_def a)
1224             apply (rule mem_interior_closure_convex_shrink [OF \<open>convex S\<close> a x])
1225             using \<open>0 < e\<close> False apply (auto simp: divide_simps)
1226             done
1227         qed
1228       qed
1229     qed
1230   qed
1231   then show ?thesis
1232     by (simp add: closure_mono interior_subset subset_antisym)
1233 qed
1235 lemma closure_convex_Int_superset:
1236   fixes S :: "'a::euclidean_space set"
1237   assumes "convex S" "interior S \<noteq> {}" "interior S \<subseteq> closure T"
1238   shows "closure(S \<inter> T) = closure S"
1239 proof -
1240   have "closure S \<subseteq> closure(interior S)"
1241     by (simp add: convex_closure_interior assms)
1242   also have "... \<subseteq> closure (S \<inter> T)"
1243     using interior_subset [of S] assms
1244     by (metis (no_types, lifting) Int_assoc Int_lower2 closure_mono closure_open_Int_superset inf.orderE open_interior)
1245   finally show ?thesis
1246     by (simp add: closure_mono dual_order.antisym)
1247 qed
1250 subsection%unimportant \<open>Some obvious but surprisingly hard simplex lemmas\<close>
1252 lemma simplex:
1253   assumes "finite S"
1254     and "0 \<notin> S"
1255   shows "convex hull (insert 0 S) = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S \<le> 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
1256 proof (simp add: convex_hull_finite set_eq_iff assms, safe)
1257   fix x and u :: "'a \<Rightarrow> real"
1258   assume "0 \<le> u 0" "\<forall>x\<in>S. 0 \<le> u x" "u 0 + sum u S = 1"
1259   then show "\<exists>v. (\<forall>x\<in>S. 0 \<le> v x) \<and> sum v S \<le> 1 \<and> (\<Sum>x\<in>S. v x *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
1260     by force
1261 next
1262   fix x and u :: "'a \<Rightarrow> real"
1263   assume "\<forall>x\<in>S. 0 \<le> u x" "sum u S \<le> 1"
1264   then show "\<exists>v. 0 \<le> v 0 \<and> (\<forall>x\<in>S. 0 \<le> v x) \<and> v 0 + sum v S = 1 \<and> (\<Sum>x\<in>S. v x *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
1265     by (rule_tac x="\<lambda>x. if x = 0 then 1 - sum u S else u x" in exI) (auto simp: sum_delta_notmem assms if_smult)
1266 qed
1268 lemma substd_simplex:
1269   assumes d: "d \<subseteq> Basis"
1270   shows "convex hull (insert 0 d) =
1271     {x. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i) \<and> (\<Sum>i\<in>d. x\<bullet>i) \<le> 1 \<and> (\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0)}"
1272   (is "convex hull (insert 0 ?p) = ?s")
1273 proof -
1274   let ?D = d
1275   have "0 \<notin> ?p"
1276     using assms by (auto simp: image_def)
1277   from d have "finite d"
1278     by (blast intro: finite_subset finite_Basis)
1279   show ?thesis
1280     unfolding simplex[OF \<open>finite d\<close> \<open>0 \<notin> ?p\<close>]
1281   proof (intro set_eqI; safe)
1282     fix u :: "'a \<Rightarrow> real"
1283     assume as: "\<forall>x\<in>?D. 0 \<le> u x" "sum u ?D \<le> 1"
1284     let ?x = "(\<Sum>x\<in>?D. u x *\<^sub>R x)"
1285     have ind: "\<forall>i\<in>Basis. i \<in> d \<longrightarrow> u i = ?x \<bullet> i"
1286       and notind: "(\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> ?x \<bullet> i = 0)"
1287       using substdbasis_expansion_unique[OF assms] by blast+
1288     then have **: "sum u ?D = sum ((\<bullet>) ?x) ?D"
1289       using assms by (auto intro!: sum.cong)
1290     show "0 \<le> ?x \<bullet> i" if "i \<in> Basis" for i
1291       using as(1) ind notind that by fastforce
1292     show "sum ((\<bullet>) ?x) ?D \<le> 1"
1293       using "**" as(2) by linarith
1294     show "?x \<bullet> i = 0" if "i \<in> Basis" "i \<notin> d" for i
1295       using notind that by blast
1296   next
1297     fix x
1298     assume "\<forall>i\<in>Basis. 0 \<le> x \<bullet> i" "sum ((\<bullet>) x) ?D \<le> 1" "(\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0)"
1299     with d show "\<exists>u. (\<forall>x\<in>?D. 0 \<le> u x) \<and> sum u ?D \<le> 1 \<and> (\<Sum>x\<in>?D. u x *\<^sub>R x) = x"
1300       unfolding substdbasis_expansion_unique[OF assms]
1301       by (rule_tac x="inner x" in exI) auto
1302   qed
1303 qed
1305 lemma std_simplex:
1306   "convex hull (insert 0 Basis) =
1307     {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i) \<and> sum (\<lambda>i. x\<bullet>i) Basis \<le> 1}"
1308   using substd_simplex[of Basis] by auto
1310 lemma interior_std_simplex:
1311   "interior (convex hull (insert 0 Basis)) =
1312     {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 < x\<bullet>i) \<and> sum (\<lambda>i. x\<bullet>i) Basis < 1}"
1313   unfolding set_eq_iff mem_interior std_simplex
1314 proof (intro allI iffI CollectI; clarify)
1315   fix x :: 'a
1316   fix e
1317   assume "e > 0" and as: "ball x e \<subseteq> {x. (\<forall>i\<in>Basis. 0 \<le> x \<bullet> i) \<and> sum ((\<bullet>) x) Basis \<le> 1}"
1318   show "(\<forall>i\<in>Basis. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) Basis < 1"
1319   proof safe
1320     fix i :: 'a
1321     assume i: "i \<in> Basis"
1322     then show "0 < x \<bullet> i"
1323       using as[THEN subsetD[where c="x - (e / 2) *\<^sub>R i"]] and \<open>e > 0\<close>
1324       by (force simp add: inner_simps)
1325   next
1326     have **: "dist x (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis)) < e" using \<open>e > 0\<close>
1327       unfolding dist_norm
1328       by (auto intro!: mult_strict_left_mono simp: SOME_Basis)
1329     have "\<And>i. i \<in> Basis \<Longrightarrow> (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis)) \<bullet> i =
1330       x\<bullet>i + (if i = (SOME i. i\<in>Basis) then e/2 else 0)"
1331       by (auto simp: SOME_Basis inner_Basis inner_simps)
1332     then have *: "sum ((\<bullet>) (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis))) Basis =
1333       sum (\<lambda>i. x\<bullet>i + (if (SOME i. i\<in>Basis) = i then e/2 else 0)) Basis"
1334       by (auto simp: intro!: sum.cong)
1335     have "sum ((\<bullet>) x) Basis < sum ((\<bullet>) (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis))) Basis"
1336       using \<open>e > 0\<close> DIM_positive by (auto simp: SOME_Basis sum.distrib *)
1337     also have "\<dots> \<le> 1"
1338       using ** as by force
1339     finally show "sum ((\<bullet>) x) Basis < 1" by auto
1340   qed
1341 next
1342   fix x :: 'a
1343   assume as: "\<forall>i\<in>Basis. 0 < x \<bullet> i" "sum ((\<bullet>) x) Basis < 1"
1344   obtain a :: 'b where "a \<in> UNIV" using UNIV_witness ..
1345   let ?d = "(1 - sum ((\<bullet>) x) Basis) / real (DIM('a))"
1346   show "\<exists>e>0. ball x e \<subseteq> {x. (\<forall>i\<in>Basis. 0 \<le> x \<bullet> i) \<and> sum ((\<bullet>) x) Basis \<le> 1}"
1347   proof (rule_tac x="min (Min (((\<bullet>) x) ` Basis)) D" for D in exI, intro conjI subsetI CollectI)
1348     fix y
1349     assume y: "y \<in> ball x (min (Min ((\<bullet>) x ` Basis)) ?d)"
1350     have "sum ((\<bullet>) y) Basis \<le> sum (\<lambda>i. x\<bullet>i + ?d) Basis"
1351     proof (rule sum_mono)
1352       fix i :: 'a
1353       assume i: "i \<in> Basis"
1354       have "\<bar>y\<bullet>i - x\<bullet>i\<bar> \<le> norm (y - x)"
1355         by (metis Basis_le_norm i inner_commute inner_diff_right)
1356       also have "... < ?d"
1357         using y by (simp add: dist_norm norm_minus_commute)
1358       finally have "\<bar>y\<bullet>i - x\<bullet>i\<bar> < ?d" .
1359       then show "y \<bullet> i \<le> x \<bullet> i + ?d" by auto
1360     qed
1361     also have "\<dots> \<le> 1"
1362       unfolding sum.distrib sum_constant
1363       by (auto simp add: Suc_le_eq)
1364     finally show "sum ((\<bullet>) y) Basis \<le> 1" .
1365     show "(\<forall>i\<in>Basis. 0 \<le> y \<bullet> i)"
1366     proof safe
1367       fix i :: 'a
1368       assume i: "i \<in> Basis"
1369       have "norm (x - y) < Min (((\<bullet>) x) ` Basis)"
1370         using y by (auto simp: dist_norm less_eq_real_def)
1371       also have "... \<le> x\<bullet>i"
1372         using i by auto
1373       finally have "norm (x - y) < x\<bullet>i" .
1374       then show "0 \<le> y\<bullet>i"
1375         using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format, OF i]
1376         by (auto simp: inner_simps)
1377     qed
1378   next
1379     have "Min (((\<bullet>) x) ` Basis) > 0"
1380       using as by simp
1381     moreover have "?d > 0"
1382       using as by (auto simp: Suc_le_eq)
1383     ultimately show "0 < min (Min ((\<bullet>) x ` Basis)) ((1 - sum ((\<bullet>) x) Basis) / real DIM('a))"
1384       by linarith
1385   qed
1386 qed
1388 lemma interior_std_simplex_nonempty:
1389   obtains a :: "'a::euclidean_space" where
1390     "a \<in> interior(convex hull (insert 0 Basis))"
1391 proof -
1392   let ?D = "Basis :: 'a set"
1393   let ?a = "sum (\<lambda>b::'a. inverse (2 * real DIM('a)) *\<^sub>R b) Basis"
1394   {
1395     fix i :: 'a
1396     assume i: "i \<in> Basis"
1397     have "?a \<bullet> i = inverse (2 * real DIM('a))"
1398       by (rule trans[of _ "sum (\<lambda>j. if i = j then inverse (2 * real DIM('a)) else 0) ?D"])
1399          (simp_all add: sum.If_cases i) }
1400   note ** = this
1401   show ?thesis
1402     apply (rule that[of ?a])
1403     unfolding interior_std_simplex mem_Collect_eq
1404   proof safe
1405     fix i :: 'a
1406     assume i: "i \<in> Basis"
1407     show "0 < ?a \<bullet> i"
1408       unfolding **[OF i] by (auto simp add: Suc_le_eq DIM_positive)
1409   next
1410     have "sum ((\<bullet>) ?a) ?D = sum (\<lambda>i. inverse (2 * real DIM('a))) ?D"
1411       apply (rule sum.cong)
1412       apply rule
1413       apply auto
1414       done
1415     also have "\<dots> < 1"
1416       unfolding sum_constant divide_inverse[symmetric]
1417       by (auto simp add: field_simps)
1418     finally show "sum ((\<bullet>) ?a) ?D < 1" by auto
1419   qed
1420 qed
1422 lemma rel_interior_substd_simplex:
1423   assumes D: "D \<subseteq> Basis"
1424   shows "rel_interior (convex hull (insert 0 D)) =
1425     {x::'a::euclidean_space. (\<forall>i\<in>D. 0 < x\<bullet>i) \<and> (\<Sum>i\<in>D. x\<bullet>i) < 1 \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)}"
1426   (is "rel_interior (convex hull (insert 0 ?p)) = ?s")
1427 proof -
1428   have "finite D"
1429     using D finite_Basis finite_subset by blast
1430   show ?thesis
1431   proof (cases "D = {}")
1432     case True
1433     then show ?thesis
1434       using rel_interior_sing using euclidean_eq_iff[of _ 0] by auto
1435   next
1436     case False
1437     have h0: "affine hull (convex hull (insert 0 ?p)) =
1438       {x::'a::euclidean_space. (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)}"
1439       using affine_hull_convex_hull affine_hull_substd_basis assms by auto
1440     have aux: "\<And>x::'a. \<forall>i\<in>Basis. (\<forall>i\<in>D. 0 \<le> x\<bullet>i) \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0) \<longrightarrow> 0 \<le> x\<bullet>i"
1441       by auto
1442     {
1443       fix x :: "'a::euclidean_space"
1444       assume x: "x \<in> rel_interior (convex hull (insert 0 ?p))"
1445       then obtain e where "e > 0" and
1446         "ball x e \<inter> {xa. (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> xa\<bullet>i = 0)} \<subseteq> convex hull (insert 0 ?p)"
1447         using mem_rel_interior_ball[of x "convex hull (insert 0 ?p)"] h0 by auto
1448       then have as [rule_format]: "\<And>y. dist x y < e \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> y\<bullet>i = 0) \<longrightarrow>
1449         (\<forall>i\<in>D. 0 \<le> y \<bullet> i) \<and> sum ((\<bullet>) y) D \<le> 1"
1450         unfolding ball_def unfolding substd_simplex[OF assms] using assms by auto
1451       have x0: "(\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)"
1452         using x rel_interior_subset  substd_simplex[OF assms] by auto
1453       have "(\<forall>i\<in>D. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) D < 1 \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)"
1454       proof (intro conjI ballI)
1455         fix i :: 'a
1456         assume "i \<in> D"
1457         then have "\<forall>j\<in>D. 0 \<le> (x - (e / 2) *\<^sub>R i) \<bullet> j"
1458           apply -
1459           apply (rule as[THEN conjunct1])
1460           using D \<open>e > 0\<close> x0
1461           apply (auto simp: dist_norm inner_simps inner_Basis)
1462           done
1463         then show "0 < x \<bullet> i"
1464           using \<open>e > 0\<close> \<open>i \<in> D\<close> D  by (force simp: inner_simps inner_Basis)
1465       next
1466         obtain a where a: "a \<in> D"
1467           using \<open>D \<noteq> {}\<close> by auto
1468         then have **: "dist x (x + (e / 2) *\<^sub>R a) < e"
1469           using \<open>e > 0\<close> norm_Basis[of a] D
1470           unfolding dist_norm
1471           by auto
1472         have "\<And>i. i \<in> Basis \<Longrightarrow> (x + (e / 2) *\<^sub>R a) \<bullet> i = x\<bullet>i + (if i = a then e/2 else 0)"
1473           using a D by (auto simp: inner_simps inner_Basis)
1474         then have *: "sum ((\<bullet>) (x + (e / 2) *\<^sub>R a)) D =
1475           sum (\<lambda>i. x\<bullet>i + (if a = i then e/2 else 0)) D"
1476           using D by (intro sum.cong) auto
1477         have "a \<in> Basis"
1478           using \<open>a \<in> D\<close> D by auto
1479         then have h1: "(\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> (x + (e / 2) *\<^sub>R a) \<bullet> i = 0)"
1481         have "sum ((\<bullet>) x) D < sum ((\<bullet>) (x + (e / 2) *\<^sub>R a)) D"
1482           using \<open>e > 0\<close> \<open>a \<in> D\<close> \<open>finite D\<close> by (auto simp add: * sum.distrib)
1483         also have "\<dots> \<le> 1"
1484           using ** h1 as[rule_format, of "x + (e / 2) *\<^sub>R a"]
1485           by auto
1486         finally show "sum ((\<bullet>) x) D < 1" "\<And>i. i\<in>Basis \<Longrightarrow> i \<notin> D \<longrightarrow> x\<bullet>i = 0"
1487           using x0 by auto
1488       qed
1489     }
1490     moreover
1491     {
1492       fix x :: "'a::euclidean_space"
1493       assume as: "x \<in> ?s"
1494       have "\<forall>i. 0 < x\<bullet>i \<or> 0 = x\<bullet>i \<longrightarrow> 0 \<le> x\<bullet>i"
1495         by auto
1496       moreover have "\<forall>i. i \<in> D \<or> i \<notin> D" by auto
1497       ultimately
1498       have "\<forall>i. (\<forall>i\<in>D. 0 < x\<bullet>i) \<and> (\<forall>i. i \<notin> D \<longrightarrow> x\<bullet>i = 0) \<longrightarrow> 0 \<le> x\<bullet>i"
1499         by metis
1500       then have h2: "x \<in> convex hull (insert 0 ?p)"
1501         using as assms
1502         unfolding substd_simplex[OF assms] by fastforce
1503       obtain a where a: "a \<in> D"
1504         using \<open>D \<noteq> {}\<close> by auto
1505       let ?d = "(1 - sum ((\<bullet>) x) D) / real (card D)"
1506       have "0 < card D" using \<open>D \<noteq> {}\<close> \<open>finite D\<close>
1508       have "Min (((\<bullet>) x) ` D) > 0"
1509         using as \<open>D \<noteq> {}\<close> \<open>finite D\<close> by (simp add: Min_gr_iff)
1510       moreover have "?d > 0" using as using \<open>0 < card D\<close> by auto
1511       ultimately have h3: "min (Min (((\<bullet>) x) ` D)) ?d > 0"
1512         by auto
1514       have "x \<in> rel_interior (convex hull (insert 0 ?p))"
1515         unfolding rel_interior_ball mem_Collect_eq h0
1516         apply (rule,rule h2)
1517         unfolding substd_simplex[OF assms]
1518         apply (rule_tac x="min (Min (((\<bullet>) x) ` D)) ?d" in exI)
1519         apply (rule, rule h3)
1520         apply safe
1521         unfolding mem_ball
1522       proof -
1523         fix y :: 'a
1524         assume y: "dist x y < min (Min ((\<bullet>) x ` D)) ?d"
1525         assume y2: "\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> y\<bullet>i = 0"
1526         have "sum ((\<bullet>) y) D \<le> sum (\<lambda>i. x\<bullet>i + ?d) D"
1527         proof (rule sum_mono)
1528           fix i
1529           assume "i \<in> D"
1530           with D have i: "i \<in> Basis"
1531             by auto
1532           have "\<bar>y\<bullet>i - x\<bullet>i\<bar> \<le> norm (y - x)"
1533             by (metis i inner_commute inner_diff_right norm_bound_Basis_le order_refl)
1534           also have "... < ?d"
1535             by (metis dist_norm min_less_iff_conj norm_minus_commute y)
1536           finally have "\<bar>y\<bullet>i - x\<bullet>i\<bar> < ?d" .
1537           then show "y \<bullet> i \<le> x \<bullet> i + ?d" by auto
1538         qed
1539         also have "\<dots> \<le> 1"
1540           unfolding sum.distrib sum_constant  using \<open>0 < card D\<close>
1541           by auto
1542         finally show "sum ((\<bullet>) y) D \<le> 1" .
1544         fix i :: 'a
1545         assume i: "i \<in> Basis"
1546         then show "0 \<le> y\<bullet>i"
1547         proof (cases "i\<in>D")
1548           case True
1549           have "norm (x - y) < x\<bullet>i"
1550             using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
1551             using Min_gr_iff[of "(\<bullet>) x ` D" "norm (x - y)"] \<open>0 < card D\<close> \<open>i \<in> D\<close>
1553           then show "0 \<le> y\<bullet>i"
1554             using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format]
1555             by (auto simp: inner_simps)
1556         qed (insert y2, auto)
1557       qed
1558     }
1559     ultimately have
1560       "\<And>x. x \<in> rel_interior (convex hull insert 0 D) \<longleftrightarrow>
1561         x \<in> {x. (\<forall>i\<in>D. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) D < 1 \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x \<bullet> i = 0)}"
1562       by blast
1563     then show ?thesis by (rule set_eqI)
1564   qed
1565 qed
1567 lemma rel_interior_substd_simplex_nonempty:
1568   assumes "D \<noteq> {}"
1569     and "D \<subseteq> Basis"
1570   obtains a :: "'a::euclidean_space"
1571     where "a \<in> rel_interior (convex hull (insert 0 D))"
1572 proof -
1573   let ?D = D
1574   let ?a = "sum (\<lambda>b::'a::euclidean_space. inverse (2 * real (card D)) *\<^sub>R b) ?D"
1575   have "finite D"
1576     apply (rule finite_subset)
1577     using assms(2)
1578     apply auto
1579     done
1580   then have d1: "0 < real (card D)"
1581     using \<open>D \<noteq> {}\<close> by auto
1582   {
1583     fix i
1584     assume "i \<in> D"
1585     have "?a \<bullet> i = inverse (2 * real (card D))"
1586       apply (rule trans[of _ "sum (\<lambda>j. if i = j then inverse (2 * real (card D)) else 0) ?D"])
1587       unfolding inner_sum_left
1588       apply (rule sum.cong)
1589       using \<open>i \<in> D\<close> \<open>finite D\<close> sum.delta'[of D i "(\<lambda>k. inverse (2 * real (card D)))"]
1590         d1 assms(2)
1591       by (auto simp: inner_Basis rev_subsetD[OF _ assms(2)])
1592   }
1593   note ** = this
1594   show ?thesis
1595     apply (rule that[of ?a])
1596     unfolding rel_interior_substd_simplex[OF assms(2)] mem_Collect_eq
1597   proof safe
1598     fix i
1599     assume "i \<in> D"
1600     have "0 < inverse (2 * real (card D))"
1601       using d1 by auto
1602     also have "\<dots> = ?a \<bullet> i" using **[of i] \<open>i \<in> D\<close>
1603       by auto
1604     finally show "0 < ?a \<bullet> i" by auto
1605   next
1606     have "sum ((\<bullet>) ?a) ?D = sum (\<lambda>i. inverse (2 * real (card D))) ?D"
1607       by (rule sum.cong) (rule refl, rule **)
1608     also have "\<dots> < 1"
1609       unfolding sum_constant divide_real_def[symmetric]
1610       by (auto simp add: field_simps)
1611     finally show "sum ((\<bullet>) ?a) ?D < 1" by auto
1612   next
1613     fix i
1614     assume "i \<in> Basis" and "i \<notin> D"
1615     have "?a \<in> span D"
1616     proof (rule span_sum[of D "(\<lambda>b. b /\<^sub>R (2 * real (card D)))" D])
1617       {
1618         fix x :: "'a::euclidean_space"
1619         assume "x \<in> D"
1620         then have "x \<in> span D"
1621           using span_base[of _ "D"] by auto
1622         then have "x /\<^sub>R (2 * real (card D)) \<in> span D"
1623           using span_mul[of x "D" "(inverse (real (card D)) / 2)"] by auto
1624       }
1625       then show "\<And>x. x\<in>D \<Longrightarrow> x /\<^sub>R (2 * real (card D)) \<in> span D"
1626         by auto
1627     qed
1628     then show "?a \<bullet> i = 0 "
1629       using \<open>i \<notin> D\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
1630   qed
1631 qed
1634 subsection%unimportant \<open>Relative interior of convex set\<close>
1636 lemma rel_interior_convex_nonempty_aux:
1637   fixes S :: "'n::euclidean_space set"
1638   assumes "convex S"
1639     and "0 \<in> S"
1640   shows "rel_interior S \<noteq> {}"
1641 proof (cases "S = {0}")
1642   case True
1643   then show ?thesis using rel_interior_sing by auto
1644 next
1645   case False
1646   obtain B where B: "independent B \<and> B \<le> S \<and> S \<le> span B \<and> card B = dim S"
1647     using basis_exists[of S] by metis
1648   then have "B \<noteq> {}"
1649     using B assms \<open>S \<noteq> {0}\<close> span_empty by auto
1650   have "insert 0 B \<le> span B"
1651     using subspace_span[of B] subspace_0[of "span B"]
1652       span_superset by auto
1653   then have "span (insert 0 B) \<le> span B"
1654     using span_span[of B] span_mono[of "insert 0 B" "span B"] by blast
1655   then have "convex hull insert 0 B \<le> span B"
1656     using convex_hull_subset_span[of "insert 0 B"] by auto
1657   then have "span (convex hull insert 0 B) \<le> span B"
1658     using span_span[of B]
1659       span_mono[of "convex hull insert 0 B" "span B"] by blast
1660   then have *: "span (convex hull insert 0 B) = span B"
1661     using span_mono[of B "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
1662   then have "span (convex hull insert 0 B) = span S"
1663     using B span_mono[of B S] span_mono[of S "span B"]
1664       span_span[of B] by auto
1665   moreover have "0 \<in> affine hull (convex hull insert 0 B)"
1666     using hull_subset[of "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
1667   ultimately have **: "affine hull (convex hull insert 0 B) = affine hull S"
1668     using affine_hull_span_0[of "convex hull insert 0 B"] affine_hull_span_0[of "S"]
1669       assms hull_subset[of S]
1670     by auto
1671   obtain d and f :: "'n \<Rightarrow> 'n" where
1672     fd: "card d = card B" "linear f" "f ` B = d"
1673       "f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = (0::real)} \<and> inj_on f (span B)"
1674     and d: "d \<subseteq> Basis"
1675     using basis_to_substdbasis_subspace_isomorphism[of B,OF _ ] B by auto
1676   then have "bounded_linear f"
1677     using linear_conv_bounded_linear by auto
1678   have "d \<noteq> {}"
1679     using fd B \<open>B \<noteq> {}\<close> by auto
1680   have "insert 0 d = f ` (insert 0 B)"
1681     using fd linear_0 by auto
1682   then have "(convex hull (insert 0 d)) = f ` (convex hull (insert 0 B))"
1683     using convex_hull_linear_image[of f "(insert 0 d)"]
1684       convex_hull_linear_image[of f "(insert 0 B)"] \<open>linear f\<close>
1685     by auto
1686   moreover have "rel_interior (f ` (convex hull insert 0 B)) =
1687     f ` rel_interior (convex hull insert 0 B)"
1688     apply (rule  rel_interior_injective_on_span_linear_image[of f "(convex hull insert 0 B)"])
1689     using \<open>bounded_linear f\<close> fd *
1690     apply auto
1691     done
1692   ultimately have "rel_interior (convex hull insert 0 B) \<noteq> {}"
1693     using rel_interior_substd_simplex_nonempty[OF \<open>d \<noteq> {}\<close> d]
1694     apply auto
1695     apply blast
1696     done
1697   moreover have "convex hull (insert 0 B) \<subseteq> S"
1698     using B assms hull_mono[of "insert 0 B" "S" "convex"] convex_hull_eq
1699     by auto
1700   ultimately show ?thesis
1701     using subset_rel_interior[of "convex hull insert 0 B" S] ** by auto
1702 qed
1704 lemma rel_interior_eq_empty:
1705   fixes S :: "'n::euclidean_space set"
1706   assumes "convex S"
1707   shows "rel_interior S = {} \<longleftrightarrow> S = {}"
1708 proof -
1709   {
1710     assume "S \<noteq> {}"
1711     then obtain a where "a \<in> S" by auto
1712     then have "0 \<in> (+) (-a) ` S"
1713       using assms exI[of "(\<lambda>x. x \<in> S \<and> - a + x = 0)" a] by auto
1714     then have "rel_interior ((+) (-a) ` S) \<noteq> {}"
1715       using rel_interior_convex_nonempty_aux[of "(+) (-a) ` S"]
1716         convex_translation[of S "-a"] assms
1717       by auto
1718     then have "rel_interior S \<noteq> {}"
1719       using rel_interior_translation [of "- a"] by simp
1720   }
1721   then show ?thesis
1722     using rel_interior_empty by auto
1723 qed
1725 lemma interior_simplex_nonempty:
1726   fixes S :: "'N :: euclidean_space set"
1727   assumes "independent S" "finite S" "card S = DIM('N)"
1728   obtains a where "a \<in> interior (convex hull (insert 0 S))"
1729 proof -
1730   have "affine hull (insert 0 S) = UNIV"
1731     by (simp add: hull_inc affine_hull_span_0 dim_eq_full[symmetric]
1732          assms(1) assms(3) dim_eq_card_independent)
1733   moreover have "rel_interior (convex hull insert 0 S) \<noteq> {}"
1734     using rel_interior_eq_empty [of "convex hull (insert 0 S)"] by auto
1735   ultimately have "interior (convex hull insert 0 S) \<noteq> {}"
1737   with that show ?thesis
1738     by auto
1739 qed
1741 lemma convex_rel_interior:
1742   fixes S :: "'n::euclidean_space set"
1743   assumes "convex S"
1744   shows "convex (rel_interior S)"
1745 proof -
1746   {
1747     fix x y and u :: real
1748     assume assm: "x \<in> rel_interior S" "y \<in> rel_interior S" "0 \<le> u" "u \<le> 1"
1749     then have "x \<in> S"
1750       using rel_interior_subset by auto
1751     have "x - u *\<^sub>R (x-y) \<in> rel_interior S"
1752     proof (cases "0 = u")
1753       case False
1754       then have "0 < u" using assm by auto
1755       then show ?thesis
1756         using assm rel_interior_convex_shrink[of S y x u] assms \<open>x \<in> S\<close> by auto
1757     next
1758       case True
1759       then show ?thesis using assm by auto
1760     qed
1761     then have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> rel_interior S"
1763   }
1764   then show ?thesis
1765     unfolding convex_alt by auto
1766 qed
1768 lemma convex_closure_rel_interior:
1769   fixes S :: "'n::euclidean_space set"
1770   assumes "convex S"
1771   shows "closure (rel_interior S) = closure S"
1772 proof -
1773   have h1: "closure (rel_interior S) \<le> closure S"
1774     using closure_mono[of "rel_interior S" S] rel_interior_subset[of S] by auto
1775   show ?thesis
1776   proof (cases "S = {}")
1777     case False
1778     then obtain a where a: "a \<in> rel_interior S"
1779       using rel_interior_eq_empty assms by auto
1780     { fix x
1781       assume x: "x \<in> closure S"
1782       {
1783         assume "x = a"
1784         then have "x \<in> closure (rel_interior S)"
1785           using a unfolding closure_def by auto
1786       }
1787       moreover
1788       {
1789         assume "x \<noteq> a"
1790          {
1791            fix e :: real
1792            assume "e > 0"
1793            define e1 where "e1 = min 1 (e/norm (x - a))"
1794            then have e1: "e1 > 0" "e1 \<le> 1" "e1 * norm (x - a) \<le> e"
1795              using \<open>x \<noteq> a\<close> \<open>e > 0\<close> le_divide_eq[of e1 e "norm (x - a)"]
1796              by simp_all
1797            then have *: "x - e1 *\<^sub>R (x - a) \<in> rel_interior S"
1798              using rel_interior_closure_convex_shrink[of S a x e1] assms x a e1_def
1799              by auto
1800            have "\<exists>y. y \<in> rel_interior S \<and> y \<noteq> x \<and> dist y x \<le> e"
1801               apply (rule_tac x="x - e1 *\<^sub>R (x - a)" in exI)
1802               using * e1 dist_norm[of "x - e1 *\<^sub>R (x - a)" x] \<open>x \<noteq> a\<close>
1803               apply simp
1804               done
1805         }
1806         then have "x islimpt rel_interior S"
1807           unfolding islimpt_approachable_le by auto
1808         then have "x \<in> closure(rel_interior S)"
1809           unfolding closure_def by auto
1810       }
1811       ultimately have "x \<in> closure(rel_interior S)" by auto
1812     }
1813     then show ?thesis using h1 by auto
1814   next
1815     case True
1816     then have "rel_interior S = {}"
1817       using rel_interior_empty by auto
1818     then have "closure (rel_interior S) = {}"
1819       using closure_empty by auto
1820     with True show ?thesis by auto
1821   qed
1822 qed
1824 lemma rel_interior_same_affine_hull:
1825   fixes S :: "'n::euclidean_space set"
1826   assumes "convex S"
1827   shows "affine hull (rel_interior S) = affine hull S"
1828   by (metis assms closure_same_affine_hull convex_closure_rel_interior)
1830 lemma rel_interior_aff_dim:
1831   fixes S :: "'n::euclidean_space set"
1832   assumes "convex S"
1833   shows "aff_dim (rel_interior S) = aff_dim S"
1834   by (metis aff_dim_affine_hull2 assms rel_interior_same_affine_hull)
1836 lemma rel_interior_rel_interior:
1837   fixes S :: "'n::euclidean_space set"
1838   assumes "convex S"
1839   shows "rel_interior (rel_interior S) = rel_interior S"
1840 proof -
1841   have "openin (top_of_set (affine hull (rel_interior S))) (rel_interior S)"
1842     using openin_rel_interior[of S] rel_interior_same_affine_hull[of S] assms by auto
1843   then show ?thesis
1844     using rel_interior_def by auto
1845 qed
1847 lemma rel_interior_rel_open:
1848   fixes S :: "'n::euclidean_space set"
1849   assumes "convex S"
1850   shows "rel_open (rel_interior S)"
1851   unfolding rel_open_def using rel_interior_rel_interior assms by auto
1853 lemma convex_rel_interior_closure_aux:
1854   fixes x y z :: "'n::euclidean_space"
1855   assumes "0 < a" "0 < b" "(a + b) *\<^sub>R z = a *\<^sub>R x + b *\<^sub>R y"
1856   obtains e where "0 < e" "e \<le> 1" "z = y - e *\<^sub>R (y - x)"
1857 proof -
1858   define e where "e = a / (a + b)"
1859   have "z = (1 / (a + b)) *\<^sub>R ((a + b) *\<^sub>R z)"
1860     using assms  by (simp add: eq_vector_fraction_iff)
1861   also have "\<dots> = (1 / (a + b)) *\<^sub>R (a *\<^sub>R x + b *\<^sub>R y)"
1862     using assms scaleR_cancel_left[of "1/(a+b)" "(a + b) *\<^sub>R z" "a *\<^sub>R x + b *\<^sub>R y"]
1863     by auto
1864   also have "\<dots> = y - e *\<^sub>R (y-x)"
1865     using e_def
1867     using scaleR_left_distrib[of "a/(a+b)" "b/(a+b)" y] assms add_divide_distrib[of a b "a+b"]
1868     apply auto
1869     done
1870   finally have "z = y - e *\<^sub>R (y-x)"
1871     by auto
1872   moreover have "e > 0" using e_def assms by auto
1873   moreover have "e \<le> 1" using e_def assms by auto
1874   ultimately show ?thesis using that[of e] by auto
1875 qed
1877 lemma convex_rel_interior_closure:
1878   fixes S :: "'n::euclidean_space set"
1879   assumes "convex S"
1880   shows "rel_interior (closure S) = rel_interior S"
1881 proof (cases "S = {}")
1882   case True
1883   then show ?thesis
1884     using assms rel_interior_eq_empty by auto
1885 next
1886   case False
1887   have "rel_interior (closure S) \<supseteq> rel_interior S"
1888     using subset_rel_interior[of S "closure S"] closure_same_affine_hull closure_subset
1889     by auto
1890   moreover
1891   {
1892     fix z
1893     assume z: "z \<in> rel_interior (closure S)"
1894     obtain x where x: "x \<in> rel_interior S"
1895       using \<open>S \<noteq> {}\<close> assms rel_interior_eq_empty by auto
1896     have "z \<in> rel_interior S"
1897     proof (cases "x = z")
1898       case True
1899       then show ?thesis using x by auto
1900     next
1901       case False
1902       obtain e where e: "e > 0" "cball z e \<inter> affine hull closure S \<le> closure S"
1903         using z rel_interior_cball[of "closure S"] by auto
1904       hence *: "0 < e/norm(z-x)" using e False by auto
1905       define y where "y = z + (e/norm(z-x)) *\<^sub>R (z-x)"
1906       have yball: "y \<in> cball z e"
1907         using mem_cball y_def dist_norm[of z y] e by auto
1908       have "x \<in> affine hull closure S"
1909         using x rel_interior_subset_closure hull_inc[of x "closure S"] by blast
1910       moreover have "z \<in> affine hull closure S"
1911         using z rel_interior_subset hull_subset[of "closure S"] by blast
1912       ultimately have "y \<in> affine hull closure S"
1913         using y_def affine_affine_hull[of "closure S"]
1914           mem_affine_3_minus [of "affine hull closure S" z z x "e/norm(z-x)"] by auto
1915       then have "y \<in> closure S" using e yball by auto
1916       have "(1 + (e/norm(z-x))) *\<^sub>R z = (e/norm(z-x)) *\<^sub>R x + y"
1917         using y_def by (simp add: algebra_simps)
1918       then obtain e1 where "0 < e1" "e1 \<le> 1" "z = y - e1 *\<^sub>R (y - x)"
1919         using * convex_rel_interior_closure_aux[of "e / norm (z - x)" 1 z x y]
1920         by (auto simp add: algebra_simps)
1921       then show ?thesis
1922         using rel_interior_closure_convex_shrink assms x \<open>y \<in> closure S\<close>
1923         by auto
1924     qed
1925   }
1926   ultimately show ?thesis by auto
1927 qed
1929 lemma convex_interior_closure:
1930   fixes S :: "'n::euclidean_space set"
1931   assumes "convex S"
1932   shows "interior (closure S) = interior S"
1933   using closure_aff_dim[of S] interior_rel_interior_gen[of S]
1934     interior_rel_interior_gen[of "closure S"]
1935     convex_rel_interior_closure[of S] assms
1936   by auto
1938 lemma closure_eq_rel_interior_eq:
1939   fixes S1 S2 :: "'n::euclidean_space set"
1940   assumes "convex S1"
1941     and "convex S2"
1942   shows "closure S1 = closure S2 \<longleftrightarrow> rel_interior S1 = rel_interior S2"
1943   by (metis convex_rel_interior_closure convex_closure_rel_interior assms)
1945 lemma closure_eq_between:
1946   fixes S1 S2 :: "'n::euclidean_space set"
1947   assumes "convex S1"
1948     and "convex S2"
1949   shows "closure S1 = closure S2 \<longleftrightarrow> rel_interior S1 \<le> S2 \<and> S2 \<subseteq> closure S1"
1950   (is "?A \<longleftrightarrow> ?B")
1951 proof
1952   assume ?A
1953   then show ?B
1954     by (metis assms closure_subset convex_rel_interior_closure rel_interior_subset)
1955 next
1956   assume ?B
1957   then have "closure S1 \<subseteq> closure S2"
1958     by (metis assms(1) convex_closure_rel_interior closure_mono)
1959   moreover from \<open>?B\<close> have "closure S1 \<supseteq> closure S2"
1960     by (metis closed_closure closure_minimal)
1961   ultimately show ?A ..
1962 qed
1964 lemma open_inter_closure_rel_interior:
1965   fixes S A :: "'n::euclidean_space set"
1966   assumes "convex S"
1967     and "open A"
1968   shows "A \<inter> closure S = {} \<longleftrightarrow> A \<inter> rel_interior S = {}"
1969   by (metis assms convex_closure_rel_interior open_Int_closure_eq_empty)
1971 lemma rel_interior_open_segment:
1972   fixes a :: "'a :: euclidean_space"
1973   shows "rel_interior(open_segment a b) = open_segment a b"
1974 proof (cases "a = b")
1975   case True then show ?thesis by auto
1976 next
1977   case False then show ?thesis
1978     apply (simp add: rel_interior_eq openin_open)
1979     apply (rule_tac x="ball (inverse 2 *\<^sub>R (a + b)) (norm(b - a) / 2)" in exI)
1981     done
1982 qed
1984 lemma rel_interior_closed_segment:
1985   fixes a :: "'a :: euclidean_space"
1986   shows "rel_interior(closed_segment a b) =
1987          (if a = b then {a} else open_segment a b)"
1988 proof (cases "a = b")
1989   case True then show ?thesis by auto
1990 next
1991   case False then show ?thesis
1992     by simp
1993        (metis closure_open_segment convex_open_segment convex_rel_interior_closure
1994               rel_interior_open_segment)
1995 qed
1997 lemmas rel_interior_segment = rel_interior_closed_segment rel_interior_open_segment
1999 lemma starlike_convex_tweak_boundary_points:
2000   fixes S :: "'a::euclidean_space set"
2001   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
2002   shows "starlike T"
2003 proof -
2004   have "rel_interior S \<noteq> {}"
2005     by (simp add: assms rel_interior_eq_empty)
2006   then obtain a where a: "a \<in> rel_interior S"  by blast
2007   with ST have "a \<in> T"  by blast
2008   have *: "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
2009     apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
2010     using assms by blast
2011   show ?thesis
2012     unfolding starlike_def
2013     apply (rule bexI [OF _ \<open>a \<in> T\<close>])
2015     apply (intro conjI ballI a \<open>a \<in> T\<close> rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
2016     apply (simp add: order_trans [OF * ST])
2017     done
2018 qed
2020 subsection\<open>The relative frontier of a set\<close>
2022 definition%important "rel_frontier S = closure S - rel_interior S"
2024 lemma rel_frontier_empty [simp]: "rel_frontier {} = {}"
2027 lemma rel_frontier_eq_empty:
2028     fixes S :: "'n::euclidean_space set"
2029     shows "rel_frontier S = {} \<longleftrightarrow> affine S"
2030   unfolding rel_frontier_def
2031   using rel_interior_subset_closure  by (auto simp add: rel_interior_eq_closure [symmetric])
2033 lemma rel_frontier_sing [simp]:
2034     fixes a :: "'n::euclidean_space"
2035     shows "rel_frontier {a} = {}"
2038 lemma rel_frontier_affine_hull:
2039   fixes S :: "'a::euclidean_space set"
2040   shows "rel_frontier S \<subseteq> affine hull S"
2041 using closure_affine_hull rel_frontier_def by fastforce
2043 lemma rel_frontier_cball [simp]:
2044     fixes a :: "'n::euclidean_space"
2045     shows "rel_frontier(cball a r) = (if r = 0 then {} else sphere a r)"
2046 proof (cases rule: linorder_cases [of r 0])
2047   case less then show ?thesis
2048     by (force simp: sphere_def)
2049 next
2050   case equal then show ?thesis by simp
2051 next
2052   case greater then show ?thesis
2053     apply simp
2054     by (metis centre_in_ball empty_iff frontier_cball frontier_def interior_cball interior_rel_interior_gen rel_frontier_def)
2055 qed
2057 lemma rel_frontier_translation:
2058   fixes a :: "'a::euclidean_space"
2059   shows "rel_frontier((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (rel_frontier S)"
2060 by (simp add: rel_frontier_def translation_diff rel_interior_translation closure_translation)
2062 lemma closed_affine_hull [iff]:
2063   fixes S :: "'n::euclidean_space set"
2064   shows "closed (affine hull S)"
2065   by (metis affine_affine_hull affine_closed)
2067 lemma rel_frontier_nonempty_interior:
2068   fixes S :: "'n::euclidean_space set"
2069   shows "interior S \<noteq> {} \<Longrightarrow> rel_frontier S = frontier S"
2070 by (metis frontier_def interior_rel_interior_gen rel_frontier_def)
2072 lemma rel_frontier_frontier:
2073   fixes S :: "'n::euclidean_space set"
2074   shows "affine hull S = UNIV \<Longrightarrow> rel_frontier S = frontier S"
2075 by (simp add: frontier_def rel_frontier_def rel_interior_interior)
2077 lemma closest_point_in_rel_frontier:
2078    "\<lbrakk>closed S; S \<noteq> {}; x \<in> affine hull S - rel_interior S\<rbrakk>
2079    \<Longrightarrow> closest_point S x \<in> rel_frontier S"
2080   by (simp add: closest_point_in_rel_interior closest_point_in_set rel_frontier_def)
2082 lemma closed_rel_frontier [iff]:
2083   fixes S :: "'n::euclidean_space set"
2084   shows "closed (rel_frontier S)"
2085 proof -
2086   have *: "closedin (top_of_set (affine hull S)) (closure S - rel_interior S)"
2087     by (simp add: closed_subset closedin_diff closure_affine_hull openin_rel_interior)
2088   show ?thesis
2089     apply (rule closedin_closed_trans[of "affine hull S" "rel_frontier S"])
2090     unfolding rel_frontier_def
2091     using * closed_affine_hull
2092     apply auto
2093     done
2094 qed
2096 lemma closed_rel_boundary:
2097   fixes S :: "'n::euclidean_space set"
2098   shows "closed S \<Longrightarrow> closed(S - rel_interior S)"
2099 by (metis closed_rel_frontier closure_closed rel_frontier_def)
2101 lemma compact_rel_boundary:
2102   fixes S :: "'n::euclidean_space set"
2103   shows "compact S \<Longrightarrow> compact(S - rel_interior S)"
2104 by (metis bounded_diff closed_rel_boundary closure_eq compact_closure compact_imp_closed)
2106 lemma bounded_rel_frontier:
2107   fixes S :: "'n::euclidean_space set"
2108   shows "bounded S \<Longrightarrow> bounded(rel_frontier S)"
2109 by (simp add: bounded_closure bounded_diff rel_frontier_def)
2111 lemma compact_rel_frontier_bounded:
2112   fixes S :: "'n::euclidean_space set"
2113   shows "bounded S \<Longrightarrow> compact(rel_frontier S)"
2114 using bounded_rel_frontier closed_rel_frontier compact_eq_bounded_closed by blast
2116 lemma compact_rel_frontier:
2117   fixes S :: "'n::euclidean_space set"
2118   shows "compact S \<Longrightarrow> compact(rel_frontier S)"
2119 by (meson compact_eq_bounded_closed compact_rel_frontier_bounded)
2121 lemma convex_same_rel_interior_closure:
2122   fixes S :: "'n::euclidean_space set"
2123   shows "\<lbrakk>convex S; convex T\<rbrakk>
2124          \<Longrightarrow> rel_interior S = rel_interior T \<longleftrightarrow> closure S = closure T"
2128   fixes S :: "'n::euclidean_space set"
2129   shows "\<lbrakk>convex S; convex T\<rbrakk>
2130          \<Longrightarrow> rel_interior S = rel_interior T \<longleftrightarrow>
2131              rel_interior S \<subseteq> T \<and> T \<subseteq> closure S"
2132 by (simp add: closure_eq_between convex_same_rel_interior_closure)
2134 lemma convex_rel_frontier_aff_dim:
2135   fixes S1 S2 :: "'n::euclidean_space set"
2136   assumes "convex S1"
2137     and "convex S2"
2138     and "S2 \<noteq> {}"
2139     and "S1 \<le> rel_frontier S2"
2140   shows "aff_dim S1 < aff_dim S2"
2141 proof -
2142   have "S1 \<subseteq> closure S2"
2143     using assms unfolding rel_frontier_def by auto
2144   then have *: "affine hull S1 \<subseteq> affine hull S2"
2145     using hull_mono[of "S1" "closure S2"] closure_same_affine_hull[of S2] by blast
2146   then have "aff_dim S1 \<le> aff_dim S2"
2147     using * aff_dim_affine_hull[of S1] aff_dim_affine_hull[of S2]
2148       aff_dim_subset[of "affine hull S1" "affine hull S2"]
2149     by auto
2150   moreover
2151   {
2152     assume eq: "aff_dim S1 = aff_dim S2"
2153     then have "S1 \<noteq> {}"
2154       using aff_dim_empty[of S1] aff_dim_empty[of S2] \<open>S2 \<noteq> {}\<close> by auto
2155     have **: "affine hull S1 = affine hull S2"
2156        apply (rule affine_dim_equal)
2157        using * affine_affine_hull
2158        apply auto
2159        using \<open>S1 \<noteq> {}\<close> hull_subset[of S1]
2160        apply auto
2161        using eq aff_dim_affine_hull[of S1] aff_dim_affine_hull[of S2]
2162        apply auto
2163        done
2164     obtain a where a: "a \<in> rel_interior S1"
2165       using \<open>S1 \<noteq> {}\<close> rel_interior_eq_empty assms by auto
2166     obtain T where T: "open T" "a \<in> T \<inter> S1" "T \<inter> affine hull S1 \<subseteq> S1"
2167        using mem_rel_interior[of a S1] a by auto
2168     then have "a \<in> T \<inter> closure S2"
2169       using a assms unfolding rel_frontier_def by auto
2170     then obtain b where b: "b \<in> T \<inter> rel_interior S2"
2171       using open_inter_closure_rel_interior[of S2 T] assms T by auto
2172     then have "b \<in> affine hull S1"
2173       using rel_interior_subset hull_subset[of S2] ** by auto
2174     then have "b \<in> S1"
2175       using T b by auto
2176     then have False
2177       using b assms unfolding rel_frontier_def by auto
2178   }
2179   ultimately show ?thesis
2180     using less_le by auto
2181 qed
2183 lemma convex_rel_interior_if:
2184   fixes S ::  "'n::euclidean_space set"
2185   assumes "convex S"
2186     and "z \<in> rel_interior S"
2187   shows "\<forall>x\<in>affine hull S. \<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
2188 proof -
2189   obtain e1 where e1: "e1 > 0 \<and> cball z e1 \<inter> affine hull S \<subseteq> S"
2190     using mem_rel_interior_cball[of z S] assms by auto
2191   {
2192     fix x
2193     assume x: "x \<in> affine hull S"
2194     {
2195       assume "x \<noteq> z"
2196       define m where "m = 1 + e1/norm(x-z)"
2197       hence "m > 1" using e1 \<open>x \<noteq> z\<close> by auto
2198       {
2199         fix e
2200         assume e: "e > 1 \<and> e \<le> m"
2201         have "z \<in> affine hull S"
2202           using assms rel_interior_subset hull_subset[of S] by auto
2203         then have *: "(1 - e)*\<^sub>R x + e *\<^sub>R z \<in> affine hull S"
2204           using mem_affine[of "affine hull S" x z "(1-e)" e] affine_affine_hull[of S] x
2205           by auto
2206         have "norm (z + e *\<^sub>R x - (x + e *\<^sub>R z)) = norm ((e - 1) *\<^sub>R (x - z))"
2208         also have "\<dots> = (e - 1) * norm (x-z)"
2209           using norm_scaleR e by auto
2210         also have "\<dots> \<le> (m - 1) * norm (x - z)"
2211           using e mult_right_mono[of _ _ "norm(x-z)"] by auto
2212         also have "\<dots> = (e1 / norm (x - z)) * norm (x - z)"
2213           using m_def by auto
2214         also have "\<dots> = e1"
2215           using \<open>x \<noteq> z\<close> e1 by simp
2216         finally have **: "norm (z + e *\<^sub>R x - (x + e *\<^sub>R z)) \<le> e1"
2217           by auto
2218         have "(1 - e)*\<^sub>R x+ e *\<^sub>R z \<in> cball z e1"
2219           using m_def **
2220           unfolding cball_def dist_norm
2221           by (auto simp add: algebra_simps)
2222         then have "(1 - e) *\<^sub>R x+ e *\<^sub>R z \<in> S"
2223           using e * e1 by auto
2224       }
2225       then have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S )"
2226         using \<open>m> 1 \<close> by auto
2227     }
2228     moreover
2229     {
2230       assume "x = z"
2231       define m where "m = 1 + e1"
2232       then have "m > 1"
2233         using e1 by auto
2234       {
2235         fix e
2236         assume e: "e > 1 \<and> e \<le> m"
2237         then have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
2238           using e1 x \<open>x = z\<close> by (auto simp add: algebra_simps)
2239         then have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
2240           using e by auto
2241       }
2242       then have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
2243         using \<open>m > 1\<close> by auto
2244     }
2245     ultimately have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S )"
2246       by blast
2247   }
2248   then show ?thesis by auto
2249 qed
2251 lemma convex_rel_interior_if2:
2252   fixes S :: "'n::euclidean_space set"
2253   assumes "convex S"
2254   assumes "z \<in> rel_interior S"
2255   shows "\<forall>x\<in>affine hull S. \<exists>e. e > 1 \<and> (1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S"
2256   using convex_rel_interior_if[of S z] assms by auto
2258 lemma convex_rel_interior_only_if:
2259   fixes S :: "'n::euclidean_space set"
2260   assumes "convex S"
2261     and "S \<noteq> {}"
2262   assumes "\<forall>x\<in>S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
2263   shows "z \<in> rel_interior S"
2264 proof -
2265   obtain x where x: "x \<in> rel_interior S"
2266     using rel_interior_eq_empty assms by auto
2267   then have "x \<in> S"
2268     using rel_interior_subset by auto
2269   then obtain e where e: "e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
2270     using assms by auto
2271   define y where [abs_def]: "y = (1 - e) *\<^sub>R x + e *\<^sub>R z"
2272   then have "y \<in> S" using e by auto
2273   define e1 where "e1 = 1/e"
2274   then have "0 < e1 \<and> e1 < 1" using e by auto
2275   then have "z  =y - (1 - e1) *\<^sub>R (y - x)"
2276     using e1_def y_def by (auto simp add: algebra_simps)
2277   then show ?thesis
2278     using rel_interior_convex_shrink[of S x y "1-e1"] \<open>0 < e1 \<and> e1 < 1\<close> \<open>y \<in> S\<close> x assms
2279     by auto
2280 qed
2282 lemma convex_rel_interior_iff:
2283   fixes S :: "'n::euclidean_space set"
2284   assumes "convex S"
2285     and "S \<noteq> {}"
2286   shows "z \<in> rel_interior S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
2287   using assms hull_subset[of S "affine"]
2288     convex_rel_interior_if[of S z] convex_rel_interior_only_if[of S z]
2289   by auto
2291 lemma convex_rel_interior_iff2:
2292   fixes S :: "'n::euclidean_space set"
2293   assumes "convex S"
2294     and "S \<noteq> {}"
2295   shows "z \<in> rel_interior S \<longleftrightarrow> (\<forall>x\<in>affine hull S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
2296   using assms hull_subset[of S] convex_rel_interior_if2[of S z] convex_rel_interior_only_if[of S z]
2297   by auto
2299 lemma convex_interior_iff:
2300   fixes S :: "'n::euclidean_space set"
2301   assumes "convex S"
2302   shows "z \<in> interior S \<longleftrightarrow> (\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S)"
2303 proof (cases "aff_dim S = int DIM('n)")
2304   case False
2305   { assume "z \<in> interior S"
2306     then have False
2307       using False interior_rel_interior_gen[of S] by auto }
2308   moreover
2309   { assume r: "\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
2310     { fix x
2311       obtain e1 where e1: "e1 > 0 \<and> z + e1 *\<^sub>R (x - z) \<in> S"
2312         using r by auto
2313       obtain e2 where e2: "e2 > 0 \<and> z + e2 *\<^sub>R (z - x) \<in> S"
2314         using r by auto
2315       define x1 where [abs_def]: "x1 = z + e1 *\<^sub>R (x - z)"
2316       then have x1: "x1 \<in> affine hull S"
2317         using e1 hull_subset[of S] by auto
2318       define x2 where [abs_def]: "x2 = z + e2 *\<^sub>R (z - x)"
2319       then have x2: "x2 \<in> affine hull S"
2320         using e2 hull_subset[of S] by auto
2321       have *: "e1/(e1+e2) + e2/(e1+e2) = 1"
2322         using add_divide_distrib[of e1 e2 "e1+e2"] e1 e2 by simp
2323       then have "z = (e2/(e1+e2)) *\<^sub>R x1 + (e1/(e1+e2)) *\<^sub>R x2"
2324         using x1_def x2_def
2325         apply (auto simp add: algebra_simps)
2326         using scaleR_left_distrib[of "e1/(e1+e2)" "e2/(e1+e2)" z]
2327         apply auto
2328         done
2329       then have z: "z \<in> affine hull S"
2330         using mem_affine[of "affine hull S" x1 x2 "e2/(e1+e2)" "e1/(e1+e2)"]
2331           x1 x2 affine_affine_hull[of S] *
2332         by auto
2333       have "x1 - x2 = (e1 + e2) *\<^sub>R (x - z)"
2334         using x1_def x2_def by (auto simp add: algebra_simps)
2335       then have "x = z+(1/(e1+e2)) *\<^sub>R (x1-x2)"
2336         using e1 e2 by simp
2337       then have "x \<in> affine hull S"
2338         using mem_affine_3_minus[of "affine hull S" z x1 x2 "1/(e1+e2)"]
2339           x1 x2 z affine_affine_hull[of S]
2340         by auto
2341     }
2342     then have "affine hull S = UNIV"
2343       by auto
2344     then have "aff_dim S = int DIM('n)"
2345       using aff_dim_affine_hull[of S] by (simp add: aff_dim_UNIV)
2346     then have False
2347       using False by auto
2348   }
2349   ultimately show ?thesis by auto
2350 next
2351   case True
2352   then have "S \<noteq> {}"
2353     using aff_dim_empty[of S] by auto
2354   have *: "affine hull S = UNIV"
2355     using True affine_hull_UNIV by auto
2356   {
2357     assume "z \<in> interior S"
2358     then have "z \<in> rel_interior S"
2359       using True interior_rel_interior_gen[of S] by auto
2360     then have **: "\<forall>x. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
2361       using convex_rel_interior_iff2[of S z] assms \<open>S \<noteq> {}\<close> * by auto
2362     fix x
2363     obtain e1 where e1: "e1 > 1" "(1 - e1) *\<^sub>R (z - x) + e1 *\<^sub>R z \<in> S"
2364       using **[rule_format, of "z-x"] by auto
2365     define e where [abs_def]: "e = e1 - 1"
2366     then have "(1 - e1) *\<^sub>R (z - x) + e1 *\<^sub>R z = z + e *\<^sub>R x"
2368     then have "e > 0" "z + e *\<^sub>R x \<in> S"
2369       using e1 e_def by auto
2370     then have "\<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
2371       by auto
2372   }
2373   moreover
2374   {
2375     assume r: "\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
2376     {
2377       fix x
2378       obtain e1 where e1: "e1 > 0" "z + e1 *\<^sub>R (z - x) \<in> S"
2379         using r[rule_format, of "z-x"] by auto
2380       define e where "e = e1 + 1"
2381       then have "z + e1 *\<^sub>R (z - x) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
2383       then have "e > 1" "(1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S"
2384         using e1 e_def by auto
2385       then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S" by auto
2386     }
2387     then have "z \<in> rel_interior S"
2388       using convex_rel_interior_iff2[of S z] assms \<open>S \<noteq> {}\<close> by auto
2389     then have "z \<in> interior S"
2390       using True interior_rel_interior_gen[of S] by auto
2391   }
2392   ultimately show ?thesis by auto
2393 qed
2396 subsubsection%unimportant \<open>Relative interior and closure under common operations\<close>
2398 lemma rel_interior_inter_aux: "\<Inter>{rel_interior S |S. S \<in> I} \<subseteq> \<Inter>I"
2399 proof -
2400   {
2401     fix y
2402     assume "y \<in> \<Inter>{rel_interior S |S. S \<in> I}"
2403     then have y: "\<forall>S \<in> I. y \<in> rel_interior S"
2404       by auto
2405     {
2406       fix S
2407       assume "S \<in> I"
2408       then have "y \<in> S"
2409         using rel_interior_subset y by auto
2410     }
2411     then have "y \<in> \<Inter>I" by auto
2412   }
2413   then show ?thesis by auto
2414 qed
2416 lemma closure_Int: "closure (\<Inter>I) \<le> \<Inter>{closure S |S. S \<in> I}"
2417 proof -
2418   {
2419     fix y
2420     assume "y \<in> \<Inter>I"
2421     then have y: "\<forall>S \<in> I. y \<in> S" by auto
2422     {
2423       fix S
2424       assume "S \<in> I"
2425       then have "y \<in> closure S"
2426         using closure_subset y by auto
2427     }
2428     then have "y \<in> \<Inter>{closure S |S. S \<in> I}"
2429       by auto
2430   }
2431   then have "\<Inter>I \<subseteq> \<Inter>{closure S |S. S \<in> I}"
2432     by auto
2433   moreover have "closed (\<Inter>{closure S |S. S \<in> I})"
2434     unfolding closed_Inter closed_closure by auto
2435   ultimately show ?thesis using closure_hull[of "\<Inter>I"]
2436     hull_minimal[of "\<Inter>I" "\<Inter>{closure S |S. S \<in> I}" "closed"] by auto
2437 qed
2439 lemma convex_closure_rel_interior_inter:
2440   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
2441     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
2442   shows "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
2443 proof -
2444   obtain x where x: "\<forall>S\<in>I. x \<in> rel_interior S"
2445     using assms by auto
2446   {
2447     fix y
2448     assume "y \<in> \<Inter>{closure S |S. S \<in> I}"
2449     then have y: "\<forall>S \<in> I. y \<in> closure S"
2450       by auto
2451     {
2452       assume "y = x"
2453       then have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
2454         using x closure_subset[of "\<Inter>{rel_interior S |S. S \<in> I}"] by auto
2455     }
2456     moreover
2457     {
2458       assume "y \<noteq> x"
2459       { fix e :: real
2460         assume e: "e > 0"
2461         define e1 where "e1 = min 1 (e/norm (y - x))"
2462         then have e1: "e1 > 0" "e1 \<le> 1" "e1 * norm (y - x) \<le> e"
2463           using \<open>y \<noteq> x\<close> \<open>e > 0\<close> le_divide_eq[of e1 e "norm (y - x)"]
2464           by simp_all
2465         define z where "z = y - e1 *\<^sub>R (y - x)"
2466         {
2467           fix S
2468           assume "S \<in> I"
2469           then have "z \<in> rel_interior S"
2470             using rel_interior_closure_convex_shrink[of S x y e1] assms x y e1 z_def
2471             by auto
2472         }
2473         then have *: "z \<in> \<Inter>{rel_interior S |S. S \<in> I}"
2474           by auto
2475         have "\<exists>z. z \<in> \<Inter>{rel_interior S |S. S \<in> I} \<and> z \<noteq> y \<and> dist z y \<le> e"
2476           apply (rule_tac x="z" in exI)
2477           using \<open>y \<noteq> x\<close> z_def * e1 e dist_norm[of z y]
2478           apply simp
2479           done
2480       }
2481       then have "y islimpt \<Inter>{rel_interior S |S. S \<in> I}"
2482         unfolding islimpt_approachable_le by blast
2483       then have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
2484         unfolding closure_def by auto
2485     }
2486     ultimately have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
2487       by auto
2488   }
2489   then show ?thesis by auto
2490 qed
2492 lemma convex_closure_inter:
2493   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
2494     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
2495   shows "closure (\<Inter>I) = \<Inter>{closure S |S. S \<in> I}"
2496 proof -
2497   have "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
2498     using convex_closure_rel_interior_inter assms by auto
2499   moreover
2500   have "closure (\<Inter>{rel_interior S |S. S \<in> I}) \<le> closure (\<Inter>I)"
2501     using rel_interior_inter_aux closure_mono[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
2502     by auto
2503   ultimately show ?thesis
2504     using closure_Int[of I] by auto
2505 qed
2507 lemma convex_inter_rel_interior_same_closure:
2508   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
2509     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
2510   shows "closure (\<Inter>{rel_interior S |S. S \<in> I}) = closure (\<Inter>I)"
2511 proof -
2512   have "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
2513     using convex_closure_rel_interior_inter assms by auto
2514   moreover
2515   have "closure (\<Inter>{rel_interior S |S. S \<in> I}) \<le> closure (\<Inter>I)"
2516     using rel_interior_inter_aux closure_mono[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
2517     by auto
2518   ultimately show ?thesis
2519     using closure_Int[of I] by auto
2520 qed
2522 lemma convex_rel_interior_inter:
2523   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
2524     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
2525   shows "rel_interior (\<Inter>I) \<subseteq> \<Inter>{rel_interior S |S. S \<in> I}"
2526 proof -
2527   have "convex (\<Inter>I)"
2528     using assms convex_Inter by auto
2529   moreover
2530   have "convex (\<Inter>{rel_interior S |S. S \<in> I})"
2531     apply (rule convex_Inter)
2532     using assms convex_rel_interior
2533     apply auto
2534     done
2535   ultimately
2536   have "rel_interior (\<Inter>{rel_interior S |S. S \<in> I}) = rel_interior (\<Inter>I)"
2537     using convex_inter_rel_interior_same_closure assms
2538       closure_eq_rel_interior_eq[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
2539     by blast
2540   then show ?thesis
2541     using rel_interior_subset[of "\<Inter>{rel_interior S |S. S \<in> I}"] by auto
2542 qed
2544 lemma convex_rel_interior_finite_inter:
2545   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
2546     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
2547     and "finite I"
2548   shows "rel_interior (\<Inter>I) = \<Inter>{rel_interior S |S. S \<in> I}"
2549 proof -
2550   have "\<Inter>I \<noteq> {}"
2551     using assms rel_interior_inter_aux[of I] by auto
2552   have "convex (\<Inter>I)"
2553     using convex_Inter assms by auto
2554   show ?thesis
2555   proof (cases "I = {}")
2556     case True
2557     then show ?thesis
2558       using Inter_empty rel_interior_UNIV by auto
2559   next
2560     case False
2561     {
2562       fix z
2563       assume z: "z \<in> \<Inter>{rel_interior S |S. S \<in> I}"
2564       {
2565         fix x
2566         assume x: "x \<in> \<Inter>I"
2567         {
2568           fix S
2569           assume S: "S \<in> I"
2570           then have "z \<in> rel_interior S" "x \<in> S"
2571             using z x by auto
2572           then have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S)"
2573             using convex_rel_interior_if[of S z] S assms hull_subset[of S] by auto
2574         }
2575         then obtain mS where
2576           mS: "\<forall>S\<in>I. mS S > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> mS S \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)" by metis
2577         define e where "e = Min (mS ` I)"
2578         then have "e \<in> mS ` I" using assms \<open>I \<noteq> {}\<close> by simp
2579         then have "e > 1" using mS by auto
2580         moreover have "\<forall>S\<in>I. e \<le> mS S"
2581           using e_def assms by auto
2582         ultimately have "\<exists>e > 1. (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> \<Inter>I"
2583           using mS by auto
2584       }
2585       then have "z \<in> rel_interior (\<Inter>I)"
2586         using convex_rel_interior_iff[of "\<Inter>I" z] \<open>\<Inter>I \<noteq> {}\<close> \<open>convex (\<Inter>I)\<close> by auto
2587     }
2588     then show ?thesis
2589       using convex_rel_interior_inter[of I] assms by auto
2590   qed
2591 qed
2593 lemma convex_closure_inter_two:
2594   fixes S T :: "'n::euclidean_space set"
2595   assumes "convex S"
2596     and "convex T"
2597   assumes "rel_interior S \<inter> rel_interior T \<noteq> {}"
2598   shows "closure (S \<inter> T) = closure S \<inter> closure T"
2599   using convex_closure_inter[of "{S,T}"] assms by auto
2601 lemma convex_rel_interior_inter_two:
2602   fixes S T :: "'n::euclidean_space set"
2603   assumes "convex S"
2604     and "convex T"
2605     and "rel_interior S \<inter> rel_interior T \<noteq> {}"
2606   shows "rel_interior (S \<inter> T) = rel_interior S \<inter> rel_interior T"
2607   using convex_rel_interior_finite_inter[of "{S,T}"] assms by auto
2609 lemma convex_affine_closure_Int:
2610   fixes S T :: "'n::euclidean_space set"
2611   assumes "convex S"
2612     and "affine T"
2613     and "rel_interior S \<inter> T \<noteq> {}"
2614   shows "closure (S \<inter> T) = closure S \<inter> T"
2615 proof -
2616   have "affine hull T = T"
2617     using assms by auto
2618   then have "rel_interior T = T"
2619     using rel_interior_affine_hull[of T] by metis
2620   moreover have "closure T = T"
2621     using assms affine_closed[of T] by auto
2622   ultimately show ?thesis
2623     using convex_closure_inter_two[of S T] assms affine_imp_convex by auto
2624 qed
2626 lemma connected_component_1_gen:
2627   fixes S :: "'a :: euclidean_space set"
2628   assumes "DIM('a) = 1"
2629   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
2630 unfolding connected_component_def
2631 by (metis (no_types, lifting) assms subsetD subsetI convex_contains_segment convex_segment(1)
2632             ends_in_segment connected_convex_1_gen)
2634 lemma connected_component_1:
2635   fixes S :: "real set"
2636   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
2639 lemma convex_affine_rel_interior_Int:
2640   fixes S T :: "'n::euclidean_space set"
2641   assumes "convex S"
2642     and "affine T"
2643     and "rel_interior S \<inter> T \<noteq> {}"
2644   shows "rel_interior (S \<inter> T) = rel_interior S \<inter> T"
2645 proof -
2646   have "affine hull T = T"
2647     using assms by auto
2648   then have "rel_interior T = T"
2649     using rel_interior_affine_hull[of T] by metis
2650   moreover have "closure T = T"
2651     using assms affine_closed[of T] by auto
2652   ultimately show ?thesis
2653     using convex_rel_interior_inter_two[of S T] assms affine_imp_convex by auto
2654 qed
2656 lemma convex_affine_rel_frontier_Int:
2657    fixes S T :: "'n::euclidean_space set"
2658   assumes "convex S"
2659     and "affine T"
2660     and "interior S \<inter> T \<noteq> {}"
2661   shows "rel_frontier(S \<inter> T) = frontier S \<inter> T"
2662 using assms
2663 apply (simp add: rel_frontier_def convex_affine_closure_Int frontier_def)
2664 by (metis Diff_Int_distrib2 Int_emptyI convex_affine_closure_Int convex_affine_rel_interior_Int empty_iff interior_rel_interior_gen)
2666 lemma rel_interior_convex_Int_affine:
2667   fixes S :: "'a::euclidean_space set"
2668   assumes "convex S" "affine T" "interior S \<inter> T \<noteq> {}"
2669     shows "rel_interior(S \<inter> T) = interior S \<inter> T"
2670 proof -
2671   obtain a where aS: "a \<in> interior S" and aT:"a \<in> T"
2672     using assms by force
2673   have "rel_interior S = interior S"
2674     by (metis (no_types) aS affine_hull_nonempty_interior equals0D rel_interior_interior)
2675   then show ?thesis
2676     by (metis (no_types) affine_imp_convex assms convex_rel_interior_inter_two hull_same rel_interior_affine_hull)
2677 qed
2679 lemma closure_convex_Int_affine:
2680   fixes S :: "'a::euclidean_space set"
2681   assumes "convex S" "affine T" "rel_interior S \<inter> T \<noteq> {}"
2682   shows "closure(S \<inter> T) = closure S \<inter> T"
2683 proof
2684   have "closure (S \<inter> T) \<subseteq> closure T"
2686   also have "... \<subseteq> T"
2687     by (simp add: affine_closed assms)
2688   finally show "closure(S \<inter> T) \<subseteq> closure S \<inter> T"
2690 next
2691   obtain a where "a \<in> rel_interior S" "a \<in> T"
2692     using assms by auto
2693   then have ssT: "subspace ((\<lambda>x. (-a)+x) ` T)" and "a \<in> S"
2694     using affine_diffs_subspace rel_interior_subset assms by blast+
2695   show "closure S \<inter> T \<subseteq> closure (S \<inter> T)"
2696   proof
2697     fix x  assume "x \<in> closure S \<inter> T"
2698     show "x \<in> closure (S \<inter> T)"
2699     proof (cases "x = a")
2700       case True
2701       then show ?thesis
2702         using \<open>a \<in> S\<close> \<open>a \<in> T\<close> closure_subset by fastforce
2703     next
2704       case False
2705       then have "x \<in> closure(open_segment a x)"
2706         by auto
2707       then show ?thesis
2708         using \<open>x \<in> closure S \<inter> T\<close> assms convex_affine_closure_Int by blast
2709     qed
2710   qed
2711 qed
2713 lemma subset_rel_interior_convex:
2714   fixes S T :: "'n::euclidean_space set"
2715   assumes "convex S"
2716     and "convex T"
2717     and "S \<le> closure T"
2718     and "\<not> S \<subseteq> rel_frontier T"
2719   shows "rel_interior S \<subseteq> rel_interior T"
2720 proof -
2721   have *: "S \<inter> closure T = S"
2722     using assms by auto
2723   have "\<not> rel_interior S \<subseteq> rel_frontier T"
2724     using closure_mono[of "rel_interior S" "rel_frontier T"] closed_rel_frontier[of T]
2725       closure_closed[of S] convex_closure_rel_interior[of S] closure_subset[of S] assms
2726     by auto
2727   then have "rel_interior S \<inter> rel_interior (closure T) \<noteq> {}"
2728     using assms rel_frontier_def[of T] rel_interior_subset convex_rel_interior_closure[of T]
2729     by auto
2730   then have "rel_interior S \<inter> rel_interior T = rel_interior (S \<inter> closure T)"
2731     using assms convex_closure convex_rel_interior_inter_two[of S "closure T"]
2732       convex_rel_interior_closure[of T]
2733     by auto
2734   also have "\<dots> = rel_interior S"
2735     using * by auto
2736   finally show ?thesis
2737     by auto
2738 qed
2740 lemma rel_interior_convex_linear_image:
2741   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
2742   assumes "linear f"
2743     and "convex S"
2744   shows "f ` (rel_interior S) = rel_interior (f ` S)"
2745 proof (cases "S = {}")
2746   case True
2747   then show ?thesis
2748     using assms rel_interior_empty rel_interior_eq_empty by auto
2749 next
2750   case False
2751   interpret linear f by fact
2752   have *: "f ` (rel_interior S) \<subseteq> f ` S"
2753     unfolding image_mono using rel_interior_subset by auto
2754   have "f ` S \<subseteq> f ` (closure S)"
2755     unfolding image_mono using closure_subset by auto
2756   also have "\<dots> = f ` (closure (rel_interior S))"
2757     using convex_closure_rel_interior assms by auto
2758   also have "\<dots> \<subseteq> closure (f ` (rel_interior S))"
2759     using closure_linear_image_subset assms by auto
2760   finally have "closure (f ` S) = closure (f ` rel_interior S)"
2761     using closure_mono[of "f ` S" "closure (f ` rel_interior S)"] closure_closure
2762       closure_mono[of "f ` rel_interior S" "f ` S"] *
2763     by auto
2764   then have "rel_interior (f ` S) = rel_interior (f ` rel_interior S)"
2765     using assms convex_rel_interior
2766       linear_conv_bounded_linear[of f] convex_linear_image[of _ S]
2767       convex_linear_image[of _ "rel_interior S"]
2768       closure_eq_rel_interior_eq[of "f ` S" "f ` rel_interior S"]
2769     by auto
2770   then have "rel_interior (f ` S) \<subseteq> f ` rel_interior S"
2771     using rel_interior_subset by auto
2772   moreover
2773   {
2774     fix z
2775     assume "z \<in> f ` rel_interior S"
2776     then obtain z1 where z1: "z1 \<in> rel_interior S" "f z1 = z" by auto
2777     {
2778       fix x
2779       assume "x \<in> f ` S"
2780       then obtain x1 where x1: "x1 \<in> S" "f x1 = x" by auto
2781       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1 \<in> S"
2782         using convex_rel_interior_iff[of S z1] \<open>convex S\<close> x1 z1 by auto
2783       moreover have "f ((1 - e) *\<^sub>R x1 + e *\<^sub>R z1) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
2785       ultimately have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
2786         using imageI[of "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1" S f] by auto
2787       then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
2788         using e by auto
2789     }
2790     then have "z \<in> rel_interior (f ` S)"
2791       using convex_rel_interior_iff[of "f ` S" z] \<open>convex S\<close> \<open>linear f\<close>
2792         \<open>S \<noteq> {}\<close> convex_linear_image[of f S]  linear_conv_bounded_linear[of f]
2793       by auto
2794   }
2795   ultimately show ?thesis by auto
2796 qed
2798 lemma rel_interior_convex_linear_preimage:
2799   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
2800   assumes "linear f"
2801     and "convex S"
2802     and "f -` (rel_interior S) \<noteq> {}"
2803   shows "rel_interior (f -` S) = f -` (rel_interior S)"
2804 proof -
2805   interpret linear f by fact
2806   have "S \<noteq> {}"
2807     using assms rel_interior_empty by auto
2808   have nonemp: "f -` S \<noteq> {}"
2809     by (metis assms(3) rel_interior_subset subset_empty vimage_mono)
2810   then have "S \<inter> (range f) \<noteq> {}"
2811     by auto
2812   have conv: "convex (f -` S)"
2813     using convex_linear_vimage assms by auto
2814   then have "convex (S \<inter> range f)"
2815     by (simp add: assms(2) convex_Int convex_linear_image linear_axioms)
2816   {
2817     fix z
2818     assume "z \<in> f -` (rel_interior S)"
2819     then have z: "f z \<in> rel_interior S"
2820       by auto
2821     {
2822       fix x
2823       assume "x \<in> f -` S"
2824       then have "f x \<in> S" by auto
2825       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R f x + e *\<^sub>R f z \<in> S"
2826         using convex_rel_interior_iff[of S "f z"] z assms \<open>S \<noteq> {}\<close> by auto
2827       moreover have "(1 - e) *\<^sub>R f x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R x + e *\<^sub>R z)"
2828         using \<open>linear f\<close> by (simp add: linear_iff)
2829       ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f -` S"
2830         using e by auto
2831     }
2832     then have "z \<in> rel_interior (f -` S)"
2833       using convex_rel_interior_iff[of "f -` S" z] conv nonemp by auto
2834   }
2835   moreover
2836   {
2837     fix z
2838     assume z: "z \<in> rel_interior (f -` S)"
2839     {
2840       fix x
2841       assume "x \<in> S \<inter> range f"
2842       then obtain y where y: "f y = x" "y \<in> f -` S" by auto
2843       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R y + e *\<^sub>R z \<in> f -` S"
2844         using convex_rel_interior_iff[of "f -` S" z] z conv by auto
2845       moreover have "(1 - e) *\<^sub>R x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R y + e *\<^sub>R z)"
2846         using \<open>linear f\<close> y by (simp add: linear_iff)
2847       ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R f z \<in> S \<inter> range f"
2848         using e by auto
2849     }
2850     then have "f z \<in> rel_interior (S \<inter> range f)"
2851       using \<open>convex (S \<inter> (range f))\<close> \<open>S \<inter> range f \<noteq> {}\<close>
2852         convex_rel_interior_iff[of "S \<inter> (range f)" "f z"]
2853       by auto
2854     moreover have "affine (range f)"
2855       by (simp add: linear_axioms linear_subspace_image subspace_imp_affine)
2856     ultimately have "f z \<in> rel_interior S"
2857       using convex_affine_rel_interior_Int[of S "range f"] assms by auto
2858     then have "z \<in> f -` (rel_interior S)"
2859       by auto
2860   }
2861   ultimately show ?thesis by auto
2862 qed
2864 lemma rel_interior_Times:
2865   fixes S :: "'n::euclidean_space set"
2866     and T :: "'m::euclidean_space set"
2867   assumes "convex S"
2868     and "convex T"
2869   shows "rel_interior (S \<times> T) = rel_interior S \<times> rel_interior T"
2870 proof -
2871   { assume "S = {}"
2872     then have ?thesis
2873       by auto
2874   }
2875   moreover
2876   { assume "T = {}"
2877     then have ?thesis
2878        by auto
2879   }
2880   moreover
2881   {
2882     assume "S \<noteq> {}" "T \<noteq> {}"
2883     then have ri: "rel_interior S \<noteq> {}" "rel_interior T \<noteq> {}"
2884       using rel_interior_eq_empty assms by auto
2885     then have "fst -` rel_interior S \<noteq> {}"
2886       using fst_vimage_eq_Times[of "rel_interior S"] by auto
2887     then have "rel_interior ((fst :: 'n * 'm \<Rightarrow> 'n) -` S) = fst -` rel_interior S"
2888       using fst_linear \<open>convex S\<close> rel_interior_convex_linear_preimage[of fst S] by auto
2889     then have s: "rel_interior (S \<times> (UNIV :: 'm set)) = rel_interior S \<times> UNIV"
2891     from ri have "snd -` rel_interior T \<noteq> {}"
2892       using snd_vimage_eq_Times[of "rel_interior T"] by auto
2893     then have "rel_interior ((snd :: 'n * 'm \<Rightarrow> 'm) -` T) = snd -` rel_interior T"
2894       using snd_linear \<open>convex T\<close> rel_interior_convex_linear_preimage[of snd T] by auto
2895     then have t: "rel_interior ((UNIV :: 'n set) \<times> T) = UNIV \<times> rel_interior T"
2897     from s t have *: "rel_interior (S \<times> (UNIV :: 'm set)) \<inter> rel_interior ((UNIV :: 'n set) \<times> T) =
2898       rel_interior S \<times> rel_interior T" by auto
2899     have "S \<times> T = S \<times> (UNIV :: 'm set) \<inter> (UNIV :: 'n set) \<times> T"
2900       by auto
2901     then have "rel_interior (S \<times> T) = rel_interior ((S \<times> (UNIV :: 'm set)) \<inter> ((UNIV :: 'n set) \<times> T))"
2902       by auto
2903     also have "\<dots> = rel_interior (S \<times> (UNIV :: 'm set)) \<inter> rel_interior ((UNIV :: 'n set) \<times> T)"
2904        apply (subst convex_rel_interior_inter_two[of "S \<times> (UNIV :: 'm set)" "(UNIV :: 'n set) \<times> T"])
2905        using * ri assms convex_Times
2906        apply auto
2907        done
2908     finally have ?thesis using * by auto
2909   }
2910   ultimately show ?thesis by blast
2911 qed
2913 lemma rel_interior_scaleR:
2914   fixes S :: "'n::euclidean_space set"
2915   assumes "c \<noteq> 0"
2916   shows "((*\<^sub>R) c) ` (rel_interior S) = rel_interior (((*\<^sub>R) c) ` S)"
2917   using rel_interior_injective_linear_image[of "((*\<^sub>R) c)" S]
2918     linear_conv_bounded_linear[of "(*\<^sub>R) c"] linear_scaleR injective_scaleR[of c] assms
2919   by auto
2921 lemma rel_interior_convex_scaleR:
2922   fixes S :: "'n::euclidean_space set"
2923   assumes "convex S"
2924   shows "((*\<^sub>R) c) ` (rel_interior S) = rel_interior (((*\<^sub>R) c) ` S)"
2925   by (metis assms linear_scaleR rel_interior_convex_linear_image)
2927 lemma convex_rel_open_scaleR:
2928   fixes S :: "'n::euclidean_space set"
2929   assumes "convex S"
2930     and "rel_open S"
2931   shows "convex (((*\<^sub>R) c) ` S) \<and> rel_open (((*\<^sub>R) c) ` S)"
2932   by (metis assms convex_scaling rel_interior_convex_scaleR rel_open_def)
2934 lemma convex_rel_open_finite_inter:
2935   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set) \<and> rel_open S"
2936     and "finite I"
2937   shows "convex (\<Inter>I) \<and> rel_open (\<Inter>I)"
2938 proof (cases "\<Inter>{rel_interior S |S. S \<in> I} = {}")
2939   case True
2940   then have "\<Inter>I = {}"
2941     using assms unfolding rel_open_def by auto
2942   then show ?thesis
2943     unfolding rel_open_def using rel_interior_empty by auto
2944 next
2945   case False
2946   then have "rel_open (\<Inter>I)"
2947     using assms unfolding rel_open_def
2948     using convex_rel_interior_finite_inter[of I]
2949     by auto
2950   then show ?thesis
2951     using convex_Inter assms by auto
2952 qed
2954 lemma convex_rel_open_linear_image:
2955   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
2956   assumes "linear f"
2957     and "convex S"
2958     and "rel_open S"
2959   shows "convex (f ` S) \<and> rel_open (f ` S)"
2960   by (metis assms convex_linear_image rel_interior_convex_linear_image rel_open_def)
2962 lemma convex_rel_open_linear_preimage:
2963   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
2964   assumes "linear f"
2965     and "convex S"
2966     and "rel_open S"
2967   shows "convex (f -` S) \<and> rel_open (f -` S)"
2968 proof (cases "f -` (rel_interior S) = {}")
2969   case True
2970   then have "f -` S = {}"
2971     using assms unfolding rel_open_def by auto
2972   then show ?thesis
2973     unfolding rel_open_def using rel_interior_empty by auto
2974 next
2975   case False
2976   then have "rel_open (f -` S)"
2977     using assms unfolding rel_open_def
2978     using rel_interior_convex_linear_preimage[of f S]
2979     by auto
2980   then show ?thesis
2981     using convex_linear_vimage assms
2982     by auto
2983 qed
2985 lemma rel_interior_projection:
2986   fixes S :: "('m::euclidean_space \<times> 'n::euclidean_space) set"
2987     and f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space set"
2988   assumes "convex S"
2989     and "f = (\<lambda>y. {z. (y, z) \<in> S})"
2990   shows "(y, z) \<in> rel_interior S \<longleftrightarrow> (y \<in> rel_interior {y. (f y \<noteq> {})} \<and> z \<in> rel_interior (f y))"
2991 proof -
2992   {
2993     fix y
2994     assume "y \<in> {y. f y \<noteq> {}}"
2995     then obtain z where "(y, z) \<in> S"
2996       using assms by auto
2997     then have "\<exists>x. x \<in> S \<and> y = fst x"
2998       apply (rule_tac x="(y, z)" in exI)
2999       apply auto
3000       done
3001     then obtain x where "x \<in> S" "y = fst x"
3002       by blast
3003     then have "y \<in> fst ` S"
3004       unfolding image_def by auto
3005   }
3006   then have "fst ` S = {y. f y \<noteq> {}}"
3007     unfolding fst_def using assms by auto
3008   then have h1: "fst ` rel_interior S = rel_interior {y. f y \<noteq> {}}"
3009     using rel_interior_convex_linear_image[of fst S] assms fst_linear by auto
3010   {
3011     fix y
3012     assume "y \<in> rel_interior {y. f y \<noteq> {}}"
3013     then have "y \<in> fst ` rel_interior S"
3014       using h1 by auto
3015     then have *: "rel_interior S \<inter> fst -` {y} \<noteq> {}"
3016       by auto
3017     moreover have aff: "affine (fst -` {y})"
3018       unfolding affine_alt by (simp add: algebra_simps)
3019     ultimately have **: "rel_interior (S \<inter> fst -` {y}) = rel_interior S \<inter> fst -` {y}"
3020       using convex_affine_rel_interior_Int[of S "fst -` {y}"] assms by auto
3021     have conv: "convex (S \<inter> fst -` {y})"
3022       using convex_Int assms aff affine_imp_convex by auto
3023     {
3024       fix x
3025       assume "x \<in> f y"
3026       then have "(y, x) \<in> S \<inter> (fst -` {y})"
3027         using assms by auto
3028       moreover have "x = snd (y, x)" by auto
3029       ultimately have "x \<in> snd ` (S \<inter> fst -` {y})"
3030         by blast
3031     }
3032     then have "snd ` (S \<inter> fst -` {y}) = f y"
3033       using assms by auto
3034     then have ***: "rel_interior (f y) = snd ` rel_interior (S \<inter> fst -` {y})"
3035       using rel_interior_convex_linear_image[of snd "S \<inter> fst -` {y}"] snd_linear conv
3036       by auto
3037     {
3038       fix z
3039       assume "z \<in> rel_interior (f y)"
3040       then have "z \<in> snd ` rel_interior (S \<inter> fst -` {y})"
3041         using *** by auto
3042       moreover have "{y} = fst ` rel_interior (S \<inter> fst -` {y})"
3043         using * ** rel_interior_subset by auto
3044       ultimately have "(y, z) \<in> rel_interior (S \<inter> fst -` {y})"
3045         by force
3046       then have "(y,z) \<in> rel_interior S"
3047         using ** by auto
3048     }
3049     moreover
3050     {
3051       fix z
3052       assume "(y, z) \<in> rel_interior S"
3053       then have "(y, z) \<in> rel_interior (S \<inter> fst -` {y})"
3054         using ** by auto
3055       then have "z \<in> snd ` rel_interior (S \<inter> fst -` {y})"
3056         by (metis Range_iff snd_eq_Range)
3057       then have "z \<in> rel_interior (f y)"
3058         using *** by auto
3059     }
3060     ultimately have "\<And>z. (y, z) \<in> rel_interior S \<longleftrightarrow> z \<in> rel_interior (f y)"
3061       by auto
3062   }
3063   then have h2: "\<And>y z. y \<in> rel_interior {t. f t \<noteq> {}} \<Longrightarrow>
3064     (y, z) \<in> rel_interior S \<longleftrightarrow> z \<in> rel_interior (f y)"
3065     by auto
3066   {
3067     fix y z
3068     assume asm: "(y, z) \<in> rel_interior S"
3069     then have "y \<in> fst ` rel_interior S"
3070       by (metis Domain_iff fst_eq_Domain)
3071     then have "y \<in> rel_interior {t. f t \<noteq> {}}"
3072       using h1 by auto
3073     then have "y \<in> rel_interior {t. f t \<noteq> {}}" and "(z \<in> rel_interior (f y))"
3074       using h2 asm by auto
3075   }
3076   then show ?thesis using h2 by blast
3077 qed
3079 lemma rel_frontier_Times:
3080   fixes S :: "'n::euclidean_space set"
3081     and T :: "'m::euclidean_space set"
3082   assumes "convex S"
3083     and "convex T"
3084   shows "rel_frontier S \<times> rel_frontier T \<subseteq> rel_frontier (S \<times> T)"
3085     by (force simp: rel_frontier_def rel_interior_Times assms closure_Times)
3088 subsubsection%unimportant \<open>Relative interior of convex cone\<close>
3090 lemma cone_rel_interior:
3091   fixes S :: "'m::euclidean_space set"
3092   assumes "cone S"
3093   shows "cone ({0} \<union> rel_interior S)"
3094 proof (cases "S = {}")
3095   case True
3096   then show ?thesis
3097     by (simp add: rel_interior_empty cone_0)
3098 next
3099   case False
3100   then have *: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` S = S)"
3101     using cone_iff[of S] assms by auto
3102   then have *: "0 \<in> ({0} \<union> rel_interior S)"
3103     and "\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` ({0} \<union> rel_interior S) = ({0} \<union> rel_interior S)"
3104     by (auto simp add: rel_interior_scaleR)
3105   then show ?thesis
3106     using cone_iff[of "{0} \<union> rel_interior S"] by auto
3107 qed
3109 lemma rel_interior_convex_cone_aux:
3110   fixes S :: "'m::euclidean_space set"
3111   assumes "convex S"
3112   shows "(c, x) \<in> rel_interior (cone hull ({(1 :: real)} \<times> S)) \<longleftrightarrow>
3113     c > 0 \<and> x \<in> (((*\<^sub>R) c) ` (rel_interior S))"
3114 proof (cases "S = {}")
3115   case True
3116   then show ?thesis
3117     by (simp add: rel_interior_empty cone_hull_empty)
3118 next
3119   case False
3120   then obtain s where "s \<in> S" by auto
3121   have conv: "convex ({(1 :: real)} \<times> S)"
3122     using convex_Times[of "{(1 :: real)}" S] assms convex_singleton[of "1 :: real"]
3123     by auto
3124   define f where "f y = {z. (y, z) \<in> cone hull ({1 :: real} \<times> S)}" for y
3125   then have *: "(c, x) \<in> rel_interior (cone hull ({(1 :: real)} \<times> S)) =
3126     (c \<in> rel_interior {y. f y \<noteq> {}} \<and> x \<in> rel_interior (f c))"
3127     apply (subst rel_interior_projection[of "cone hull ({(1 :: real)} \<times> S)" f c x])
3128     using convex_cone_hull[of "{(1 :: real)} \<times> S"] conv
3129     apply auto
3130     done
3131   {
3132     fix y :: real
3133     assume "y \<ge> 0"
3134     then have "y *\<^sub>R (1,s) \<in> cone hull ({1 :: real} \<times> S)"
3135       using cone_hull_expl[of "{(1 :: real)} \<times> S"] \<open>s \<in> S\<close> by auto
3136     then have "f y \<noteq> {}"
3137       using f_def by auto
3138   }
3139   then have "{y. f y \<noteq> {}} = {0..}"
3140     using f_def cone_hull_expl[of "{1 :: real} \<times> S"] by auto
3141   then have **: "rel_interior {y. f y \<noteq> {}} = {0<..}"
3142     using rel_interior_real_semiline by auto
3143   {
3144     fix c :: real
3145     assume "c > 0"
3146     then have "f c = ((*\<^sub>R) c ` S)"
3147       using f_def cone_hull_expl[of "{1 :: real} \<times> S"] by auto
3148     then have "rel_interior (f c) = (*\<^sub>R) c ` rel_interior S"
3149       using rel_interior_convex_scaleR[of S c] assms by auto
3150   }
3151   then show ?thesis using * ** by auto
3152 qed
3154 lemma rel_interior_convex_cone:
3155   fixes S :: "'m::euclidean_space set"
3156   assumes "convex S"
3157   shows "rel_interior (cone hull ({1 :: real} \<times> S)) =
3158     {(c, c *\<^sub>R x) | c x. c > 0 \<and> x \<in> rel_interior S}"
3159   (is "?lhs = ?rhs")
3160 proof -
3161   {
3162     fix z
3163     assume "z \<in> ?lhs"
3164     have *: "z = (fst z, snd z)"
3165       by auto
3166     have "z \<in> ?rhs"
3167       using rel_interior_convex_cone_aux[of S "fst z" "snd z"] assms \<open>z \<in> ?lhs\<close>
3168       apply auto
3169       apply (rule_tac x = "fst z" in exI)
3170       apply (rule_tac x = x in exI)
3171       using *
3172       apply auto
3173       done
3174   }
3175   moreover
3176   {
3177     fix z
3178     assume "z \<in> ?rhs"
3179     then have "z \<in> ?lhs"
3180       using rel_interior_convex_cone_aux[of S "fst z" "snd z"] assms
3181       by auto
3182   }
3183   ultimately show ?thesis by blast
3184 qed
3186 lemma convex_hull_finite_union:
3187   assumes "finite I"
3188   assumes "\<forall>i\<in>I. convex (S i) \<and> (S i) \<noteq> {}"
3189   shows "convex hull (\<Union>(S ` I)) =
3190     {sum (\<lambda>i. c i *\<^sub>R s i) I | c s. (\<forall>i\<in>I. c i \<ge> 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> S i)}"
3191   (is "?lhs = ?rhs")
3192 proof -
3193   have "?lhs \<supseteq> ?rhs"
3194   proof
3195     fix x
3196     assume "x \<in> ?rhs"
3197     then obtain c s where *: "sum (\<lambda>i. c i *\<^sub>R s i) I = x" "sum c I = 1"
3198       "(\<forall>i\<in>I. c i \<ge> 0) \<and> (\<forall>i\<in>I. s i \<in> S i)" by auto
3199     then have "\<forall>i\<in>I. s i \<in> convex hull (\<Union>(S ` I))"
3200       using hull_subset[of "\<Union>(S ` I)" convex] by auto
3201     then show "x \<in> ?lhs"
3202       unfolding *(1)[symmetric]
3203       apply (subst convex_sum[of I "convex hull \<Union>(S ` I)" c s])
3204       using * assms convex_convex_hull
3205       apply auto
3206       done
3207   qed
3209   {
3210     fix i
3211     assume "i \<in> I"
3212     with assms have "\<exists>p. p \<in> S i" by auto
3213   }
3214   then obtain p where p: "\<forall>i\<in>I. p i \<in> S i" by metis
3216   {
3217     fix i
3218     assume "i \<in> I"
3219     {
3220       fix x
3221       assume "x \<in> S i"
3222       define c where "c j = (if j = i then 1::real else 0)" for j
3223       then have *: "sum c I = 1"
3224         using \<open>finite I\<close> \<open>i \<in> I\<close> sum.delta[of I i "\<lambda>j::'a. 1::real"]
3225         by auto
3226       define s where "s j = (if j = i then x else p j)" for j
3227       then have "\<forall>j. c j *\<^sub>R s j = (if j = i then x else 0)"
3228         using c_def by (auto simp add: algebra_simps)
3229       then have "x = sum (\<lambda>i. c i *\<^sub>R s i) I"
3230         using s_def c_def \<open>finite I\<close> \<open>i \<in> I\<close> sum.delta[of I i "\<lambda>j::'a. x"]
3231         by auto
3232       then have "x \<in> ?rhs"
3233         apply auto
3234         apply (rule_tac x = c in exI)
3235         apply (rule_tac x = s in exI)
3236         using * c_def s_def p \<open>x \<in> S i\<close>
3237         apply auto
3238         done
3239     }
3240     then have "?rhs \<supseteq> S i" by auto
3241   }
3242   then have *: "?rhs \<supseteq> \<Union>(S ` I)" by auto
3244   {
3245     fix u v :: real
3246     assume uv: "u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1"
3247     fix x y
3248     assume xy: "x \<in> ?rhs \<and> y \<in> ?rhs"
3249     from xy obtain c s where
3250       xc: "x = sum (\<lambda>i. c i *\<^sub>R s i) I \<and> (\<forall>i\<in>I. c i \<ge> 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> S i)"
3251       by auto
3252     from xy obtain d t where
3253       yc: "y = sum (\<lambda>i. d i *\<^sub>R t i) I \<and> (\<forall>i\<in>I. d i \<ge> 0) \<and> sum d I = 1 \<and> (\<forall>i\<in>I. t i \<in> S i)"
3254       by auto
3255     define e where "e i = u * c i + v * d i" for i
3256     have ge0: "\<forall>i\<in>I. e i \<ge> 0"
3257       using e_def xc yc uv by simp
3258     have "sum (\<lambda>i. u * c i) I = u * sum c I"
3260     moreover have "sum (\<lambda>i. v * d i) I = v * sum d I"
3262     ultimately have sum1: "sum e I = 1"
3263       using e_def xc yc uv by (simp add: sum.distrib)
3264     define q where "q i = (if e i = 0 then p i else (u * c i / e i) *\<^sub>R s i + (v * d i / e i) *\<^sub>R t i)"
3265       for i
3266     {
3267       fix i
3268       assume i: "i \<in> I"
3269       have "q i \<in> S i"
3270       proof (cases "e i = 0")
3271         case True
3272         then show ?thesis using i p q_def by auto
3273       next
3274         case False
3275         then show ?thesis
3276           using mem_convex_alt[of "S i" "s i" "t i" "u * (c i)" "v * (d i)"]
3277             mult_nonneg_nonneg[of u "c i"] mult_nonneg_nonneg[of v "d i"]
3278             assms q_def e_def i False xc yc uv
3279           by (auto simp del: mult_nonneg_nonneg)
3280       qed
3281     }
3282     then have qs: "\<forall>i\<in>I. q i \<in> S i" by auto
3283     {
3284       fix i
3285       assume i: "i \<in> I"
3286       have "(u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i = e i *\<^sub>R q i"
3287       proof (cases "e i = 0")
3288         case True
3289         have ge: "u * (c i) \<ge> 0 \<and> v * d i \<ge> 0"
3290           using xc yc uv i by simp
3291         moreover from ge have "u * c i \<le> 0 \<and> v * d i \<le> 0"
3292           using True e_def i by simp
3293         ultimately have "u * c i = 0 \<and> v * d i = 0" by auto
3294         with True show ?thesis by auto
3295       next
3296         case False
3297         then have "(u * (c i)/(e i))*\<^sub>R (s i)+(v * (d i)/(e i))*\<^sub>R (t i) = q i"
3298           using q_def by auto
3299         then have "e i *\<^sub>R ((u * (c i)/(e i))*\<^sub>R (s i)+(v * (d i)/(e i))*\<^sub>R (t i))
3300                = (e i) *\<^sub>R (q i)" by auto
3301         with False show ?thesis by (simp add: algebra_simps)
3302       qed
3303     }
3304     then have *: "\<forall>i\<in>I. (u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i = e i *\<^sub>R q i"
3305       by auto
3306     have "u *\<^sub>R x + v *\<^sub>R y = sum (\<lambda>i. (u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i) I"
3307       using xc yc by (simp add: algebra_simps scaleR_right.sum sum.distrib)
3308     also have "\<dots> = sum (\<lambda>i. e i *\<^sub>R q i) I"
3309       using * by auto
3310     finally have "u *\<^sub>R x + v *\<^sub>R y = sum (\<lambda>i. (e i) *\<^sub>R (q i)) I"
3311       by auto
3312     then have "u *\<^sub>R x + v *\<^sub>R y \<in> ?rhs"
3313       using ge0 sum1 qs by auto
3314   }
3315   then have "convex ?rhs" unfolding convex_def by auto
3316   then show ?thesis
3317     using \<open>?lhs \<supseteq> ?rhs\<close> * hull_minimal[of "\<Union>(S ` I)" ?rhs convex]
3318     by blast
3319 qed
3321 lemma convex_hull_union_two:
3322   fixes S T :: "'m::euclidean_space set"
3323   assumes "convex S"
3324     and "S \<noteq> {}"
3325     and "convex T"
3326     and "T \<noteq> {}"
3327   shows "convex hull (S \<union> T) =
3328     {u *\<^sub>R s + v *\<^sub>R t | u v s t. u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1 \<and> s \<in> S \<and> t \<in> T}"
3329   (is "?lhs = ?rhs")
3330 proof
3331   define I :: "nat set" where "I = {1, 2}"
3332   define s where "s i = (if i = (1::nat) then S else T)" for i
3333   have "\<Union>(s ` I) = S \<union> T"
3334     using s_def I_def by auto
3335   then have "convex hull (\<Union>(s ` I)) = convex hull (S \<union> T)"
3336     by auto
3337   moreover have "convex hull \<Union>(s ` I) =
3338     {\<Sum> i\<in>I. c i *\<^sub>R sa i | c sa. (\<forall>i\<in>I. 0 \<le> c i) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. sa i \<in> s i)}"
3339       apply (subst convex_hull_finite_union[of I s])
3340       using assms s_def I_def
3341       apply auto
3342       done
3343   moreover have
3344     "{\<Sum>i\<in>I. c i *\<^sub>R sa i | c sa. (\<forall>i\<in>I. 0 \<le> c i) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. sa i \<in> s i)} \<le> ?rhs"
3345     using s_def I_def by auto
3346   ultimately show "?lhs \<subseteq> ?rhs" by auto
3347   {
3348     fix x
3349     assume "x \<in> ?rhs"
3350     then obtain u v s t where *: "x = u *\<^sub>R s + v *\<^sub>R t \<and> u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1 \<and> s \<in> S \<and> t \<in> T"
3351       by auto
3352     then have "x \<in> convex hull {s, t}"
3353       using convex_hull_2[of s t] by auto
3354     then have "x \<in> convex hull (S \<union> T)"
3355       using * hull_mono[of "{s, t}" "S \<union> T"] by auto
3356   }
3357   then show "?lhs \<supseteq> ?rhs" by blast
3358 qed
3361 subsection%unimportant \<open>Convexity on direct sums\<close>
3363 lemma closure_sum:
3364   fixes S T :: "'a::real_normed_vector set"
3365   shows "closure S + closure T \<subseteq> closure (S + T)"
3366   unfolding set_plus_image closure_Times [symmetric] split_def
3368     bounded_linear_fst bounded_linear_snd)
3370 lemma rel_interior_sum:
3371   fixes S T :: "'n::euclidean_space set"
3372   assumes "convex S"
3373     and "convex T"
3374   shows "rel_interior (S + T) = rel_interior S + rel_interior T"
3375 proof -
3376   have "rel_interior S + rel_interior T = (\<lambda>(x,y). x + y) ` (rel_interior S \<times> rel_interior T)"
3378   also have "\<dots> = (\<lambda>(x,y). x + y) ` rel_interior (S \<times> T)"
3379     using rel_interior_Times assms by auto
3380   also have "\<dots> = rel_interior (S + T)"
3381     using fst_snd_linear convex_Times assms
3382       rel_interior_convex_linear_image[of "(\<lambda>(x,y). x + y)" "S \<times> T"]
3383     by (auto simp add: set_plus_image)
3384   finally show ?thesis ..
3385 qed
3387 lemma rel_interior_sum_gen:
3388   fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
3389   assumes "\<forall>i\<in>I. convex (S i)"
3390   shows "rel_interior (sum S I) = sum (\<lambda>i. rel_interior (S i)) I"
3391   apply (subst sum_set_cond_linear[of convex])
3392   using rel_interior_sum rel_interior_sing[of "0"] assms
3393   apply (auto simp add: convex_set_plus)
3394   done
3396 lemma convex_rel_open_direct_sum:
3397   fixes S T :: "'n::euclidean_space set"
3398   assumes "convex S"
3399     and "rel_open S"
3400     and "convex T"
3401     and "rel_open T"
3402   shows "convex (S \<times> T) \<and> rel_open (S \<times> T)"
3403   by (metis assms convex_Times rel_interior_Times rel_open_def)
3405 lemma convex_rel_open_sum:
3406   fixes S T :: "'n::euclidean_space set"
3407   assumes "convex S"
3408     and "rel_open S"
3409     and "convex T"
3410     and "rel_open T"
3411   shows "convex (S + T) \<and> rel_open (S + T)"
3412   by (metis assms convex_set_plus rel_interior_sum rel_open_def)
3414 lemma convex_hull_finite_union_cones:
3415   assumes "finite I"
3416     and "I \<noteq> {}"
3417   assumes "\<forall>i\<in>I. convex (S i) \<and> cone (S i) \<and> S i \<noteq> {}"
3418   shows "convex hull (\<Union>(S ` I)) = sum S I"
3419   (is "?lhs = ?rhs")
3420 proof -
3421   {
3422     fix x
3423     assume "x \<in> ?lhs"
3424     then obtain c xs where
3425       x: "x = sum (\<lambda>i. c i *\<^sub>R xs i) I \<and> (\<forall>i\<in>I. c i \<ge> 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. xs i \<in> S i)"
3426       using convex_hull_finite_union[of I S] assms by auto
3427     define s where "s i = c i *\<^sub>R xs i" for i
3428     {
3429       fix i
3430       assume "i \<in> I"
3431       then have "s i \<in> S i"
3432         using s_def x assms mem_cone[of "S i" "xs i" "c i"] by auto
3433     }
3434     then have "\<forall>i\<in>I. s i \<in> S i" by auto
3435     moreover have "x = sum s I" using x s_def by auto
3436     ultimately have "x \<in> ?rhs"
3437       using set_sum_alt[of I S] assms by auto
3438   }
3439   moreover
3440   {
3441     fix x
3442     assume "x \<in> ?rhs"
3443     then obtain s where x: "x = sum s I \<and> (\<forall>i\<in>I. s i \<in> S i)"
3444       using set_sum_alt[of I S] assms by auto
3445     define xs where "xs i = of_nat(card I) *\<^sub>R s i" for i
3446     then have "x = sum (\<lambda>i. ((1 :: real) / of_nat(card I)) *\<^sub>R xs i) I"
3447       using x assms by auto
3448     moreover have "\<forall>i\<in>I. xs i \<in> S i"
3449       using x xs_def assms by (simp add: cone_def)
3450     moreover have "\<forall>i\<in>I. (1 :: real) / of_nat (card I) \<ge> 0"
3451       by auto
3452     moreover have "sum (\<lambda>i. (1 :: real) / of_nat (card I)) I = 1"
3453       using assms by auto
3454     ultimately have "x \<in> ?lhs"
3455       apply (subst convex_hull_finite_union[of I S])
3456       using assms
3457       apply blast
3458       using assms
3459       apply blast
3460       apply rule
3461       apply (rule_tac x = "(\<lambda>i. (1 :: real) / of_nat (card I))" in exI)
3462       apply auto
3463       done
3464   }
3465   ultimately show ?thesis by auto
3466 qed
3468 lemma convex_hull_union_cones_two:
3469   fixes S T :: "'m::euclidean_space set"
3470   assumes "convex S"
3471     and "cone S"
3472     and "S \<noteq> {}"
3473   assumes "convex T"
3474     and "cone T"
3475     and "T \<noteq> {}"
3476   shows "convex hull (S \<union> T) = S + T"
3477 proof -
3478   define I :: "nat set" where "I = {1, 2}"
3479   define A where "A i = (if i = (1::nat) then S else T)" for i
3480   have "\<Union>(A ` I) = S \<union> T"
3481     using A_def I_def by auto
3482   then have "convex hull (\<Union>(A ` I)) = convex hull (S \<union> T)"
3483     by auto
3484   moreover have "convex hull \<Union>(A ` I) = sum A I"
3485     apply (subst convex_hull_finite_union_cones[of I A])
3486     using assms A_def I_def
3487     apply auto
3488     done
3489   moreover have "sum A I = S + T"
3490     using A_def I_def
3491     unfolding set_plus_def
3492     apply auto
3493     unfolding set_plus_def
3494     apply auto
3495     done
3496   ultimately show ?thesis by auto
3497 qed
3499 lemma rel_interior_convex_hull_union:
3500   fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
3501   assumes "finite I"
3502     and "\<forall>i\<in>I. convex (S i) \<and> S i \<noteq> {}"
3503   shows "rel_interior (convex hull (\<Union>(S ` I))) =
3504     {sum (\<lambda>i. c i *\<^sub>R s i) I | c s. (\<forall>i\<in>I. c i > 0) \<and> sum c I = 1 \<and>
3505       (\<forall>i\<in>I. s i \<in> rel_interior(S i))}"
3506   (is "?lhs = ?rhs")
3507 proof (cases "I = {}")
3508   case True
3509   then show ?thesis
3510     using convex_hull_empty rel_interior_empty by auto
3511 next
3512   case False
3513   define C0 where "C0 = convex hull (\<Union>(S ` I))"
3514   have "\<forall>i\<in>I. C0 \<ge> S i"
3515     unfolding C0_def using hull_subset[of "\<Union>(S ` I)"] by auto
3516   define K0 where "K0 = cone hull ({1 :: real} \<times> C0)"
3517   define K where "K i = cone hull ({1 :: real} \<times> S i)" for i
3518   have "\<forall>i\<in>I. K i \<noteq> {}"
3519     unfolding K_def using assms
3521   {
3522     fix i
3523     assume "i \<in> I"
3524     then have "convex (K i)"
3525       unfolding K_def
3526       apply (subst convex_cone_hull)
3527       apply (subst convex_Times)
3528       using assms
3529       apply auto
3530       done
3531   }
3532   then have convK: "\<forall>i\<in>I. convex (K i)"
3533     by auto
3534   {
3535     fix i
3536     assume "i \<in> I"
3537     then have "K0 \<supseteq> K i"
3538       unfolding K0_def K_def
3539       apply (subst hull_mono)
3540       using \<open>\<forall>i\<in>I. C0 \<ge> S i\<close>
3541       apply auto
3542       done
3543   }
3544   then have "K0 \<supseteq> \<Union>(K ` I)" by auto
3545   moreover have "convex K0"
3546     unfolding K0_def
3547     apply (subst convex_cone_hull)
3548     apply (subst convex_Times)
3549     unfolding C0_def
3550     using convex_convex_hull
3551     apply auto
3552     done
3553   ultimately have geq: "K0 \<supseteq> convex hull (\<Union>(K ` I))"
3554     using hull_minimal[of _ "K0" "convex"] by blast
3555   have "\<forall>i\<in>I. K i \<supseteq> {1 :: real} \<times> S i"
3556     using K_def by (simp add: hull_subset)
3557   then have "\<Union>(K ` I) \<supseteq> {1 :: real} \<times> \<Union>(S ` I)"
3558     by auto
3559   then have "convex hull \<Union>(K ` I) \<supseteq> convex hull ({1 :: real} \<times> \<Union>(S ` I))"
3561   then have "convex hull \<Union>(K ` I) \<supseteq> {1 :: real} \<times> C0"
3562     unfolding C0_def
3563     using convex_hull_Times[of "{(1 :: real)}" "\<Union>(S ` I)"] convex_hull_singleton
3564     by auto
3565   moreover have "cone (convex hull (\<Union>(K ` I)))"
3566     apply (subst cone_convex_hull)
3567     using cone_Union[of "K ` I"]
3568     apply auto
3569     unfolding K_def
3570     using cone_cone_hull
3571     apply auto
3572     done
3573   ultimately have "convex hull (\<Union>(K ` I)) \<supseteq> K0"
3574     unfolding K0_def
3575     using hull_minimal[of _ "convex hull (\<Union>(K ` I))" "cone"]
3576     by blast
3577   then have "K0 = convex hull (\<Union>(K ` I))"
3578     using geq by auto
3579   also have "\<dots> = sum K I"
3580     apply (subst convex_hull_finite_union_cones[of I K])
3581     using assms
3582     apply blast
3583     using False
3584     apply blast
3585     unfolding K_def
3586     apply rule
3587     apply (subst convex_cone_hull)
3588     apply (subst convex_Times)
3589     using assms cone_cone_hull \<open>\<forall>i\<in>I. K i \<noteq> {}\<close> K_def
3590     apply auto
3591     done
3592   finally have "K0 = sum K I" by auto
3593   then have *: "rel_interior K0 = sum (\<lambda>i. (rel_interior (K i))) I"
3594     using rel_interior_sum_gen[of I K] convK by auto
3595   {
3596     fix x
3597     assume "x \<in> ?lhs"
3598     then have "(1::real, x) \<in> rel_interior K0"
3599       using K0_def C0_def rel_interior_convex_cone_aux[of C0 "1::real" x] convex_convex_hull
3600       by auto
3601     then obtain k where k: "(1::real, x) = sum k I \<and> (\<forall>i\<in>I. k i \<in> rel_interior (K i))"
3602       using \<open>finite I\<close> * set_sum_alt[of I "\<lambda>i. rel_interior (K i)"] by auto
3603     {
3604       fix i
3605       assume "i \<in> I"
3606       then have "convex (S i) \<and> k i \<in> rel_interior (cone hull {1} \<times> S i)"
3607         using k K_def assms by auto
3608       then have "\<exists>ci si. k i = (ci, ci *\<^sub>R si) \<and> 0 < ci \<and> si \<in> rel_interior (S i)"
3609         using rel_interior_convex_cone[of "S i"] by auto
3610     }
3611     then obtain c s where
3612       cs: "\<forall>i\<in>I. k i = (c i, c i *\<^sub>R s i) \<and> 0 < c i \<and> s i \<in> rel_interior (S i)"
3613       by metis
3614     then have "x = (\<Sum>i\<in>I. c i *\<^sub>R s i) \<and> sum c I = 1"
3615       using k by (simp add: sum_prod)
3616     then have "x \<in> ?rhs"
3617       using k cs by auto
3618   }
3619   moreover
3620   {
3621     fix x
3622     assume "x \<in> ?rhs"
3623     then obtain c s where cs: "x = sum (\<lambda>i. c i *\<^sub>R s i) I \<and>
3624         (\<forall>i\<in>I. c i > 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> rel_interior (S i))"
3625       by auto
3626     define k where "k i = (c i, c i *\<^sub>R s i)" for i
3627     {
3628       fix i assume "i \<in> I"
3629       then have "k i \<in> rel_interior (K i)"
3630         using k_def K_def assms cs rel_interior_convex_cone[of "S i"]
3631         by auto
3632     }
3633     then have "(1::real, x) \<in> rel_interior K0"
3634       using K0_def * set_sum_alt[of I "(\<lambda>i. rel_interior (K i))"] assms k_def cs
3635       apply auto
3636       apply (rule_tac x = k in exI)
3638       done
3639     then have "x \<in> ?lhs"
3640       using K0_def C0_def rel_interior_convex_cone_aux[of C0 1 x]
3641       by auto
3642   }
3643   ultimately show ?thesis by blast
3644 qed
3647 lemma convex_le_Inf_differential:
3648   fixes f :: "real \<Rightarrow> real"
3649   assumes "convex_on I f"
3650     and "x \<in> interior I"
3651     and "y \<in> I"
3652   shows "f y \<ge> f x + Inf ((\<lambda>t. (f x - f t) / (x - t)) ` ({x<..} \<inter> I)) * (y - x)"
3653   (is "_ \<ge> _ + Inf (?F x) * (y - x)")
3654 proof (cases rule: linorder_cases)
3655   assume "x < y"
3656   moreover
3657   have "open (interior I)" by auto
3658   from openE[OF this \<open>x \<in> interior I\<close>]
3659   obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
3660   moreover define t where "t = min (x + e / 2) ((x + y) / 2)"
3661   ultimately have "x < t" "t < y" "t \<in> ball x e"
3662     by (auto simp: dist_real_def field_simps split: split_min)
3663   with \<open>x \<in> interior I\<close> e interior_subset[of I] have "t \<in> I" "x \<in> I" by auto
3665   have "open (interior I)" by auto
3666   from openE[OF this \<open>x \<in> interior I\<close>]
3667   obtain e where "0 < e" "ball x e \<subseteq> interior I" .
3668   moreover define K where "K = x - e / 2"
3669   with \<open>0 < e\<close> have "K \<in> ball x e" "K < x"
3670     by (auto simp: dist_real_def)
3671   ultimately have "K \<in> I" "K < x" "x \<in> I"
3672     using interior_subset[of I] \<open>x \<in> interior I\<close> by auto
3674   have "Inf (?F x) \<le> (f x - f y) / (x - y)"
3675   proof (intro bdd_belowI cInf_lower2)
3676     show "(f x - f t) / (x - t) \<in> ?F x"
3677       using \<open>t \<in> I\<close> \<open>x < t\<close> by auto
3678     show "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
3679       using \<open>convex_on I f\<close> \<open>x \<in> I\<close> \<open>y \<in> I\<close> \<open>x < t\<close> \<open>t < y\<close>
3680       by (rule convex_on_diff)
3681   next
3682     fix y
3683     assume "y \<in> ?F x"
3684     with order_trans[OF convex_on_diff[OF \<open>convex_on I f\<close> \<open>K \<in> I\<close> _ \<open>K < x\<close> _]]
3685     show "(f K - f x) / (K - x) \<le> y" by auto
3686   qed
3687   then show ?thesis
3688     using \<open>x < y\<close> by (simp add: field_simps)
3689 next
3690   assume "y < x"
3691   moreover
3692   have "open (interior I)" by auto
3693   from openE[OF this \<open>x \<in> interior I\<close>]
3694   obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
3695   moreover define t where "t = x + e / 2"
3696   ultimately have "x < t" "t \<in> ball x e"
3697     by (auto simp: dist_real_def field_simps)
3698   with \<open>x \<in> interior I\<close> e interior_subset[of I] have "t \<in> I" "x \<in> I" by auto
3700   have "(f x - f y) / (x - y) \<le> Inf (?F x)"
3701   proof (rule cInf_greatest)
3702     have "(f x - f y) / (x - y) = (f y - f x) / (y - x)"
3703       using \<open>y < x\<close> by (auto simp: field_simps)
3704     also
3705     fix z
3706     assume "z \<in> ?F x"
3707     with order_trans[OF convex_on_diff[OF \<open>convex_on I f\<close> \<open>y \<in> I\<close> _ \<open>y < x\<close>]]
3708     have "(f y - f x) / (y - x) \<le> z"
3709       by auto
3710     finally show "(f x - f y) / (x - y) \<le> z" .
3711   next
3712     have "open (interior I)" by auto
3713     from openE[OF this \<open>x \<in> interior I\<close>]
3714     obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
3715     then have "x + e / 2 \<in> ball x e"
3716       by (auto simp: dist_real_def)
3717     with e interior_subset[of I] have "x + e / 2 \<in> {x<..} \<inter> I"
3718       by auto
3719     then show "?F x \<noteq> {}"
3720       by blast
3721   qed
3722   then show ?thesis
3723     using \<open>y < x\<close> by (simp add: field_simps)
3724 qed simp
3726 subsection%unimportant\<open>Explicit formulas for interior and relative interior of convex hull\<close>
3728 lemma at_within_cbox_finite:
3729   assumes "x \<in> box a b" "x \<notin> S" "finite S"
3730   shows "(at x within cbox a b - S) = at x"
3731 proof -
3732   have "interior (cbox a b - S) = box a b - S"
3733     using \<open>finite S\<close> by (simp add: interior_diff finite_imp_closed)
3734   then show ?thesis
3735     using at_within_interior assms by fastforce
3736 qed
3738 lemma affine_independent_convex_affine_hull:
3739   fixes s :: "'a::euclidean_space set"
3740   assumes "\<not> affine_dependent s" "t \<subseteq> s"
3741     shows "convex hull t = affine hull t \<inter> convex hull s"
3742 proof -
3743   have fin: "finite s" "finite t" using assms aff_independent_finite finite_subset by auto
3744     { fix u v x
3745       assume uv: "sum u t = 1" "\<forall>x\<in>s. 0 \<le> v x" "sum v s = 1"
3746                  "(\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>v\<in>t. u v *\<^sub>R v)" "x \<in> t"
3747       then have s: "s = (s - t) \<union> t" \<comment> \<open>split into separate cases\<close>
3748         using assms by auto
3749       have [simp]: "(\<Sum>x\<in>t. v x *\<^sub>R x) + (\<Sum>x\<in>s - t. v x *\<^sub>R x) = (\<Sum>x\<in>t. u x *\<^sub>R x)"
3750                    "sum v t + sum v (s - t) = 1"
3751         using uv fin s
3752         by (auto simp: sum.union_disjoint [symmetric] Un_commute)
3753       have "(\<Sum>x\<in>s. if x \<in> t then v x - u x else v x) = 0"
3754            "(\<Sum>x\<in>s. (if x \<in> t then v x - u x else v x) *\<^sub>R x) = 0"
3755         using uv fin
3756         by (subst s, subst sum.union_disjoint, auto simp: algebra_simps sum_subtractf)+
3757     } note [simp] = this
3758   have "convex hull t \<subseteq> affine hull t"
3759     using convex_hull_subset_affine_hull by blast
3760   moreover have "convex hull t \<subseteq> convex hull s"
3761     using assms hull_mono by blast
3762   moreover have "affine hull t \<inter> convex hull s \<subseteq> convex hull t"
3763     using assms
3764     apply (simp add: convex_hull_finite affine_hull_finite fin affine_dependent_explicit)
3765     apply (drule_tac x=s in spec)
3766     apply (auto simp: fin)
3767     apply (rule_tac x=u in exI)
3768     apply (rename_tac v)
3769     apply (drule_tac x="\<lambda>x. if x \<in> t then v x - u x else v x" in spec)
3770     apply (force)+
3771     done
3772   ultimately show ?thesis
3773     by blast
3774 qed
3776 lemma affine_independent_span_eq:
3777   fixes s :: "'a::euclidean_space set"
3778   assumes "\<not> affine_dependent s" "card s = Suc (DIM ('a))"
3779     shows "affine hull s = UNIV"
3780 proof (cases "s = {}")
3781   case True then show ?thesis
3782     using assms by simp
3783 next
3784   case False
3785     then obtain a t where t: "a \<notin> t" "s = insert a t"
3786       by blast
3787     then have fin: "finite t" using assms
3788       by (metis finite_insert aff_independent_finite)
3789     show ?thesis
3790     using assms t fin
3791       apply (simp add: affine_dependent_iff_dependent affine_hull_insert_span_gen)
3792       apply (rule subset_antisym)
3793       apply force
3794       apply (rule Fun.vimage_subsetD)
3796       apply (rule card_ge_dim_independent)
3797       apply (auto simp: card_image inj_on_def dim_subset_UNIV)
3798       done
3799 qed
3801 lemma affine_independent_span_gt:
3802   fixes s :: "'a::euclidean_space set"
3803   assumes ind: "\<not> affine_dependent s" and dim: "DIM ('a) < card s"
3804     shows "affine hull s = UNIV"
3805   apply (rule affine_independent_span_eq [OF ind])
3806   apply (rule antisym)
3807   using assms
3808   apply auto
3809   apply (metis add_2_eq_Suc' not_less_eq_eq affine_dependent_biggerset aff_independent_finite)
3810   done
3812 lemma empty_interior_affine_hull:
3813   fixes s :: "'a::euclidean_space set"
3814   assumes "finite s" and dim: "card s \<le> DIM ('a)"
3815     shows "interior(affine hull s) = {}"
3816   using assms
3817   apply (induct s rule: finite_induct)
3818   apply (simp_all add:  affine_dependent_iff_dependent affine_hull_insert_span_gen interior_translation)
3819   apply (rule empty_interior_lowdim)
3820   by (auto simp: Suc_le_lessD card_image_le dual_order.trans intro!: dim_le_card'[THEN le_less_trans])
3822 lemma empty_interior_convex_hull:
3823   fixes s :: "'a::euclidean_space set"
3824   assumes "finite s" and dim: "card s \<le> DIM ('a)"
3825     shows "interior(convex hull s) = {}"
3826   by (metis Diff_empty Diff_eq_empty_iff convex_hull_subset_affine_hull
3827             interior_mono empty_interior_affine_hull [OF assms])
3829 lemma explicit_subset_rel_interior_convex_hull:
3830   fixes s :: "'a::euclidean_space set"
3831   shows "finite s
3832          \<Longrightarrow> {y. \<exists>u. (\<forall>x \<in> s. 0 < u x \<and> u x < 1) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}
3833              \<subseteq> rel_interior (convex hull s)"
3834   by (force simp add:  rel_interior_convex_hull_union [where S="\<lambda>x. {x}" and I=s, simplified])
3836 lemma explicit_subset_rel_interior_convex_hull_minimal:
3837   fixes s :: "'a::euclidean_space set"
3838   shows "finite s
3839          \<Longrightarrow> {y. \<exists>u. (\<forall>x \<in> s. 0 < u x) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}
3840              \<subseteq> rel_interior (convex hull s)"
3841   by (force simp add:  rel_interior_convex_hull_union [where S="\<lambda>x. {x}" and I=s, simplified])
3843 lemma rel_interior_convex_hull_explicit:
3844   fixes s :: "'a::euclidean_space set"
3845   assumes "\<not> affine_dependent s"
3846   shows "rel_interior(convex hull s) =
3847          {y. \<exists>u. (\<forall>x \<in> s. 0 < u x) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
3848          (is "?lhs = ?rhs")
3849 proof
3850   show "?rhs \<le> ?lhs"
3851     by (simp add: aff_independent_finite explicit_subset_rel_interior_convex_hull_minimal assms)
3852 next
3853   show "?lhs \<le> ?rhs"
3854   proof (cases "\<exists>a. s = {a}")
3855     case True then show "?lhs \<le> ?rhs"
3856       by force
3857   next
3858     case False
3859     have fs: "finite s"
3860       using assms by (simp add: aff_independent_finite)
3861     { fix a b and d::real
3862       assume ab: "a \<in> s" "b \<in> s" "a \<noteq> b"
3863       then have s: "s = (s - {a,b}) \<union> {a,b}" \<comment> \<open>split into separate cases\<close>
3864         by auto
3865       have "(\<Sum>x\<in>s. if x = a then - d else if x = b then d else 0) = 0"
3866            "(\<Sum>x\<in>s. (if x = a then - d else if x = b then d else 0) *\<^sub>R x) = d *\<^sub>R b - d *\<^sub>R a"
3867         using ab fs
3868         by (subst s, subst sum.union_disjoint, auto)+
3869     } note [simp] = this
3870     { fix y
3871       assume y: "y \<in> convex hull s" "y \<notin> ?rhs"
3872       { fix u T a
3873         assume ua: "\<forall>x\<in>s. 0 \<le> u x" "sum u s = 1" "\<not> 0 < u a" "a \<in> s"
3874            and yT: "y = (\<Sum>x\<in>s. u x *\<^sub>R x)" "y \<in> T" "open T"
3875            and sb: "T \<inter> affine hull s \<subseteq> {w. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = w}"
3876         have ua0: "u a = 0"
3877           using ua by auto
3878         obtain b where b: "b\<in>s" "a \<noteq> b"
3879           using ua False by auto
3880         obtain e where e: "0 < e" "ball (\<Sum>x\<in>s. u x *\<^sub>R x) e \<subseteq> T"
3881           using yT by (auto elim: openE)
3882         with b obtain d where d: "0 < d" "norm(d *\<^sub>R (a-b)) < e"
3883           by (auto intro: that [of "e / 2 / norm(a-b)"])
3884         have "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> affine hull s"
3885           using yT y by (metis affine_hull_convex_hull hull_redundant_eq)
3886         then have "(\<Sum>x\<in>s. u x *\<^sub>R x) - d *\<^sub>R (a - b) \<in> affine hull s"
3887           using ua b by (auto simp: hull_inc intro: mem_affine_3_minus2)
3888         then have "y - d *\<^sub>R (a - b) \<in> T \<inter> affine hull s"
3889           using d e yT by auto
3890         then obtain v where "\<forall>x\<in>s. 0 \<le> v x"
3891                             "sum v s = 1"
3892                             "(\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x) - d *\<^sub>R (a - b)"
3893           using subsetD [OF sb] yT
3894           by auto
3895         then have False
3896           using assms
3897           apply (simp add: affine_dependent_explicit_finite fs)
3898           apply (drule_tac x="\<lambda>x. (v x - u x) - (if x = a then -d else if x = b then d else 0)" in spec)
3899           using ua b d
3900           apply (auto simp: algebra_simps sum_subtractf sum.distrib)
3901           done
3902       } note * = this
3903       have "y \<notin> rel_interior (convex hull s)"
3904         using y
3905         apply (simp add: mem_rel_interior affine_hull_convex_hull)
3906         apply (auto simp: convex_hull_finite [OF fs])
3907         apply (drule_tac x=u in spec)
3908         apply (auto intro: *)
3909         done
3910     } with rel_interior_subset show "?lhs \<le> ?rhs"
3911       by blast
3912   qed
3913 qed
3915 lemma interior_convex_hull_explicit_minimal:
3916   fixes s :: "'a::euclidean_space set"
3917   shows
3918    "\<not> affine_dependent s
3919         ==> interior(convex hull s) =
3920              (if card(s) \<le> DIM('a) then {}
3921               else {y. \<exists>u. (\<forall>x \<in> s. 0 < u x) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = y})"
3922   apply (simp add: aff_independent_finite empty_interior_convex_hull, clarify)
3923   apply (rule trans [of _ "rel_interior(convex hull s)"])
3924   apply (simp add: affine_independent_span_gt rel_interior_interior)
3927 lemma interior_convex_hull_explicit:
3928   fixes s :: "'a::euclidean_space set"
3929   assumes "\<not> affine_dependent s"
3930   shows
3931    "interior(convex hull s) =
3932              (if card(s) \<le> DIM('a) then {}
3933               else {y. \<exists>u. (\<forall>x \<in> s. 0 < u x \<and> u x < 1) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = y})"
3934 proof -
3935   { fix u :: "'a \<Rightarrow> real" and a
3936     assume "card Basis < card s" and u: "\<And>x. x\<in>s \<Longrightarrow> 0 < u x" "sum u s = 1" and a: "a \<in> s"
3937     then have cs: "Suc 0 < card s"
3938       by (metis DIM_positive less_trans_Suc)
3939     obtain b where b: "b \<in> s" "a \<noteq> b"
3940     proof (cases "s \<le> {a}")
3941       case True
3942       then show thesis
3943         using cs subset_singletonD by fastforce
3944     next
3945       case False
3946       then show thesis
3947       by (blast intro: that)
3948     qed
3949     have "u a + u b \<le> sum u {a,b}"
3950       using a b by simp
3951     also have "... \<le> sum u s"
3952       apply (rule Groups_Big.sum_mono2)
3953       using a b u
3954       apply (auto simp: less_imp_le aff_independent_finite assms)
3955       done
3956     finally have "u a < 1"
3957       using \<open>b \<in> s\<close> u by fastforce
3958   } note [simp] = this
3959   show ?thesis
3960     using assms
3961     apply (auto simp: interior_convex_hull_explicit_minimal)
3962     apply (rule_tac x=u in exI)
3963     apply (auto simp: not_le)
3964     done
3965 qed
3967 lemma interior_closed_segment_ge2:
3968   fixes a :: "'a::euclidean_space"
3969   assumes "2 \<le> DIM('a)"
3970     shows  "interior(closed_segment a b) = {}"
3971 using assms unfolding segment_convex_hull
3972 proof -
3973   have "card {a, b} \<le> DIM('a)"
3974     using assms
3975     by (simp add: card_insert_if linear not_less_eq_eq numeral_2_eq_2)
3976   then show "interior (convex hull {a, b}) = {}"
3977     by (metis empty_interior_convex_hull finite.insertI finite.emptyI)
3978 qed
3980 lemma interior_open_segment:
3981   fixes a :: "'a::euclidean_space"
3982   shows  "interior(open_segment a b) =
3983                  (if 2 \<le> DIM('a) then {} else open_segment a b)"
3984 proof (simp add: not_le, intro conjI impI)
3985   assume "2 \<le> DIM('a)"
3986   then show "interior (open_segment a b) = {}"
3987     apply (simp add: segment_convex_hull open_segment_def)
3988     apply (metis Diff_subset interior_mono segment_convex_hull subset_empty interior_closed_segment_ge2)
3989     done
3990 next
3991   assume le2: "DIM('a) < 2"
3992   show "interior (open_segment a b) = open_segment a b"
3993   proof (cases "a = b")
3994     case True then show ?thesis by auto
3995   next
3996     case False
3997     with le2 have "affine hull (open_segment a b) = UNIV"
3998       apply simp
3999       apply (rule affine_independent_span_gt)
4000       apply (simp_all add: affine_dependent_def insert_Diff_if)
4001       done
4002     then show "interior (open_segment a b) = open_segment a b"
4003       using rel_interior_interior rel_interior_open_segment by blast
4004   qed
4005 qed
4007 lemma interior_closed_segment:
4008   fixes a :: "'a::euclidean_space"
4009   shows "interior(closed_segment a b) =
4010                  (if 2 \<le> DIM('a) then {} else open_segment a b)"
4011 proof (cases "a = b")
4012   case True then show ?thesis by simp
4013 next
4014   case False
4015   then have "closure (open_segment a b) = closed_segment a b"
4016     by simp
4017   then show ?thesis
4018     by (metis (no_types) convex_interior_closure convex_open_segment interior_open_segment)
4019 qed
4021 lemmas interior_segment = interior_closed_segment interior_open_segment
4023 lemma closed_segment_eq [simp]:
4024   fixes a :: "'a::euclidean_space"
4025   shows "closed_segment a b = closed_segment c d \<longleftrightarrow> {a,b} = {c,d}"
4026 proof
4027   assume abcd: "closed_segment a b = closed_segment c d"
4028   show "{a,b} = {c,d}"
4029   proof (cases "a=b \<or> c=d")
4030     case True with abcd show ?thesis by force
4031   next
4032     case False
4033     then have neq: "a \<noteq> b \<and> c \<noteq> d" by force
4034     have *: "closed_segment c d - {a, b} = rel_interior (closed_segment c d)"
4035       using neq abcd by (metis (no_types) open_segment_def rel_interior_closed_segment)
4036     have "b \<in> {c, d}"
4037     proof -
4038       have "insert b (closed_segment c d) = closed_segment c d"
4039         using abcd by blast
4040       then show ?thesis
4041         by (metis DiffD2 Diff_insert2 False * insertI1 insert_Diff_if open_segment_def rel_interior_closed_segment)
4042     qed
4043     moreover have "a \<in> {c, d}"
4044       by (metis Diff_iff False * abcd ends_in_segment(1) insertI1 open_segment_def rel_interior_closed_segment)
4045     ultimately show "{a, b} = {c, d}"
4046       using neq by fastforce
4047   qed
4048 next
4049   assume "{a,b} = {c,d}"
4050   then show "closed_segment a b = closed_segment c d"
4052 qed
4054 lemma closed_open_segment_eq [simp]:
4055   fixes a :: "'a::euclidean_space"
4056   shows "closed_segment a b \<noteq> open_segment c d"
4057 by (metis DiffE closed_segment_neq_empty closure_closed_segment closure_open_segment ends_in_segment(1) insertI1 open_segment_def)
4059 lemma open_closed_segment_eq [simp]:
4060   fixes a :: "'a::euclidean_space"
4061   shows "open_segment a b \<noteq> closed_segment c d"
4062 using closed_open_segment_eq by blast
4064 lemma open_segment_eq [simp]:
4065   fixes a :: "'a::euclidean_space"
4066   shows "open_segment a b = open_segment c d \<longleftrightarrow> a = b \<and> c = d \<or> {a,b} = {c,d}"
4067         (is "?lhs = ?rhs")
4068 proof
4069   assume abcd: ?lhs
4070   show ?rhs
4071   proof (cases "a=b \<or> c=d")
4072     case True with abcd show ?thesis
4073       using finite_open_segment by fastforce
4074   next
4075     case False
4076     then have a2: "a \<noteq> b \<and> c \<noteq> d" by force
4077     with abcd show ?rhs
4078       unfolding open_segment_def
4079       by (metis (no_types) abcd closed_segment_eq closure_open_segment)
4080   qed
4081 next
4082   assume ?rhs
4083   then show ?lhs
4084     by (metis Diff_cancel convex_hull_singleton insert_absorb2 open_segment_def segment_convex_hull)
4085 qed
4087 subsection%unimportant\<open>Similar results for closure and (relative or absolute) frontier\<close>
4089 lemma closure_convex_hull [simp]:
4090   fixes s :: "'a::euclidean_space set"
4091   shows "compact s ==> closure(convex hull s) = convex hull s"
4092   by (simp add: compact_imp_closed compact_convex_hull)
4094 lemma rel_frontier_convex_hull_explicit:
4095   fixes s :: "'a::euclidean_space set"
4096   assumes "\<not> affine_dependent s"
4097   shows "rel_frontier(convex hull s) =
4098          {y. \<exists>u. (\<forall>x \<in> s. 0 \<le> u x) \<and> (\<exists>x \<in> s. u x = 0) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
4099 proof -
4100   have fs: "finite s"
4101     using assms by (simp add: aff_independent_finite)
4102   show ?thesis
4103     apply (simp add: rel_frontier_def finite_imp_compact rel_interior_convex_hull_explicit assms fs)
4104     apply (auto simp: convex_hull_finite fs)
4105     apply (drule_tac x=u in spec)
4106     apply (rule_tac x=u in exI)
4107     apply force
4108     apply (rename_tac v)
4109     apply (rule notE [OF assms])
4111     apply (rule_tac x=s in exI)
4112     apply (auto simp: fs)
4113     apply (rule_tac x = "\<lambda>x. u x - v x" in exI)
4114     apply (force simp: sum_subtractf scaleR_diff_left)
4115     done
4116 qed
4118 lemma frontier_convex_hull_explicit:
4119   fixes s :: "'a::euclidean_space set"
4120   assumes "\<not> affine_dependent s"
4121   shows "frontier(convex hull s) =
4122          {y. \<exists>u. (\<forall>x \<in> s. 0 \<le> u x) \<and> (DIM ('a) < card s \<longrightarrow> (\<exists>x \<in> s. u x = 0)) \<and>
4123              sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
4124 proof -
4125   have fs: "finite s"
4126     using assms by (simp add: aff_independent_finite)
4127   show ?thesis
4128   proof (cases "DIM ('a) < card s")
4129     case True
4130     with assms fs show ?thesis
4131       by (simp add: rel_frontier_def frontier_def rel_frontier_convex_hull_explicit [symmetric]
4132                     interior_convex_hull_explicit_minimal rel_interior_convex_hull_explicit)
4133   next
4134     case False
4135     then have "card s \<le> DIM ('a)"
4136       by linarith
4137     then show ?thesis
4138       using assms fs
4139       apply (simp add: frontier_def interior_convex_hull_explicit finite_imp_compact)
4141       done
4142   qed
4143 qed
4145 lemma rel_frontier_convex_hull_cases:
4146   fixes s :: "'a::euclidean_space set"
4147   assumes "\<not> affine_dependent s"
4148   shows "rel_frontier(convex hull s) = \<Union>{convex hull (s - {x}) |x. x \<in> s}"
4149 proof -
4150   have fs: "finite s"
4151     using assms by (simp add: aff_independent_finite)
4152   { fix u a
4153   have "\<forall>x\<in>s. 0 \<le> u x \<Longrightarrow> a \<in> s \<Longrightarrow> u a = 0 \<Longrightarrow> sum u s = 1 \<Longrightarrow>
4154             \<exists>x v. x \<in> s \<and>
4155                   (\<forall>x\<in>s - {x}. 0 \<le> v x) \<and>
4156                       sum v (s - {x}) = 1 \<and> (\<Sum>x\<in>s - {x}. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)"
4157     apply (rule_tac x=a in exI)
4158     apply (rule_tac x=u in exI)
4159     apply (simp add: Groups_Big.sum_diff1 fs)
4160     done }
4161   moreover
4162   { fix a u
4163     have "a \<in> s \<Longrightarrow> \<forall>x\<in>s - {a}. 0 \<le> u x \<Longrightarrow> sum u (s - {a}) = 1 \<Longrightarrow>
4164             \<exists>v. (\<forall>x\<in>s. 0 \<le> v x) \<and>
4165                  (\<exists>x\<in>s. v x = 0) \<and> sum v s = 1 \<and> (\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>x\<in>s - {a}. u x *\<^sub>R x)"
4166     apply (rule_tac x="\<lambda>x. if x = a then 0 else u x" in exI)
4167     apply (auto simp: sum.If_cases Diff_eq if_smult fs)
4168     done }
4169   ultimately show ?thesis
4170     using assms
4172     apply (simp add: convex_hull_finite fs Union_SetCompr_eq, auto)
4173     done
4174 qed
4176 lemma frontier_convex_hull_eq_rel_frontier:
4177   fixes s :: "'a::euclidean_space set"
4178   assumes "\<not> affine_dependent s"
4179   shows "frontier(convex hull s) =
4180            (if card s \<le> DIM ('a) then convex hull s else rel_frontier(convex hull s))"
4181   using assms
4182   unfolding rel_frontier_def frontier_def
4183   by (simp add: affine_independent_span_gt rel_interior_interior
4184                 finite_imp_compact empty_interior_convex_hull aff_independent_finite)
4186 lemma frontier_convex_hull_cases:
4187   fixes s :: "'a::euclidean_space set"
4188   assumes "\<not> affine_dependent s"
4189   shows "frontier(convex hull s) =
4190            (if card s \<le> DIM ('a) then convex hull s else \<Union>{convex hull (s - {x}) |x. x \<in> s})"
4191 by (simp add: assms frontier_convex_hull_eq_rel_frontier rel_frontier_convex_hull_cases)
4193 lemma in_frontier_convex_hull:
4194   fixes s :: "'a::euclidean_space set"
4195   assumes "finite s" "card s \<le> Suc (DIM ('a))" "x \<in> s"
4196   shows   "x \<in> frontier(convex hull s)"
4197 proof (cases "affine_dependent s")
4198   case True
4199   with assms show ?thesis
4200     apply (auto simp: affine_dependent_def frontier_def finite_imp_compact hull_inc)
4201     by (metis card.insert_remove convex_hull_subset_affine_hull empty_interior_affine_hull finite_Diff hull_redundant insert_Diff insert_Diff_single insert_not_empty interior_mono not_less_eq_eq subset_empty)
4202 next
4203   case False
4204   { assume "card s = Suc (card Basis)"
4205     then have cs: "Suc 0 < card s"
4207     with subset_singletonD have "\<exists>y \<in> s. y \<noteq> x"
4208       by (cases "s \<le> {x}") fastforce+
4209   } note [dest!] = this
4210   show ?thesis using assms
4211     unfolding frontier_convex_hull_cases [OF False] Union_SetCompr_eq
4212     by (auto simp: le_Suc_eq hull_inc)
4213 qed
4215 lemma not_in_interior_convex_hull:
4216   fixes s :: "'a::euclidean_space set"
4217   assumes "finite s" "card s \<le> Suc (DIM ('a))" "x \<in> s"
4218   shows   "x \<notin> interior(convex hull s)"
4219 using in_frontier_convex_hull [OF assms]
4220 by (metis Diff_iff frontier_def)
4222 lemma interior_convex_hull_eq_empty:
4223   fixes s :: "'a::euclidean_space set"
4224   assumes "card s = Suc (DIM ('a))"
4225   shows   "interior(convex hull s) = {} \<longleftrightarrow> affine_dependent s"
4226 proof -
4227   { fix a b
4228     assume ab: "a \<in> interior (convex hull s)" "b \<in> s" "b \<in> affine hull (s - {b})"
4229     then have "interior(affine hull s) = {}" using assms
4230       by (metis DIM_positive One_nat_def Suc_mono card.remove card_infinite empty_interior_affine_hull eq_iff hull_redundant insert_Diff not_less zero_le_one)
4231     then have False using ab
4232       by (metis convex_hull_subset_affine_hull equals0D interior_mono subset_eq)
4233   } then
4234   show ?thesis
4235     using assms
4236     apply auto
4237     apply (metis UNIV_I affine_hull_convex_hull affine_hull_empty affine_independent_span_eq convex_convex_hull empty_iff rel_interior_interior rel_interior_same_affine_hull)
4238     apply (auto simp: affine_dependent_def)
4239     done
4240 qed
4243 subsection \<open>Coplanarity, and collinearity in terms of affine hull\<close>
4245 definition%important coplanar  where
4246    "coplanar s \<equiv> \<exists>u v w. s \<subseteq> affine hull {u,v,w}"
4248 lemma collinear_affine_hull:
4249   "collinear s \<longleftrightarrow> (\<exists>u v. s \<subseteq> affine hull {u,v})"
4250 proof (cases "s={}")
4251   case True then show ?thesis
4252     by simp
4253 next
4254   case False
4255   then obtain x where x: "x \<in> s" by auto
4256   { fix u
4257     assume *: "\<And>x y. \<lbrakk>x\<in>s; y\<in>s\<rbrakk> \<Longrightarrow> \<exists>c. x - y = c *\<^sub>R u"
4258     have "\<exists>u v. s \<subseteq> {a *\<^sub>R u + b *\<^sub>R v |a b. a + b = 1}"
4259       apply (rule_tac x=x in exI)
4260       apply (rule_tac x="x+u" in exI, clarify)
4261       apply (erule exE [OF * [OF x]])
4262       apply (rename_tac c)
4263       apply (rule_tac x="1+c" in exI)
4264       apply (rule_tac x="-c" in exI)
4266       done
4267   } moreover
4268   { fix u v x y
4269     assume *: "s \<subseteq> {a *\<^sub>R u + b *\<^sub>R v |a b. a + b = 1}"
4270     have "x\<in>s \<Longrightarrow> y\<in>s \<Longrightarrow> \<exists>c. x - y = c *\<^sub>R (v-u)"
4271       apply (drule subsetD [OF *])+
4272       apply simp
4273       apply clarify
4274       apply (rename_tac r1 r2)
4275       apply (rule_tac x="r1-r2" in exI)
4278       done
4279   } ultimately
4280   show ?thesis
4281   unfolding collinear_def affine_hull_2
4282     by blast
4283 qed
4285 lemma collinear_closed_segment [simp]: "collinear (closed_segment a b)"
4286 by (metis affine_hull_convex_hull collinear_affine_hull hull_subset segment_convex_hull)
4288 lemma collinear_open_segment [simp]: "collinear (open_segment a b)"
4289   unfolding open_segment_def
4290   by (metis convex_hull_subset_affine_hull segment_convex_hull dual_order.trans
4291     convex_hull_subset_affine_hull Diff_subset collinear_affine_hull)
4293 lemma collinear_between_cases:
4294   fixes c :: "'a::euclidean_space"
4295   shows "collinear {a,b,c} \<longleftrightarrow> between (b,c) a \<or> between (c,a) b \<or> between (a,b) c"
4296          (is "?lhs = ?rhs")
4297 proof
4298   assume ?lhs
4299   then obtain u v where uv: "\<And>x. x \<in> {a, b, c} \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
4300     by (auto simp: collinear_alt)
4301   show ?rhs
4302     using uv [of a] uv [of b] uv [of c] by (auto simp: between_1)
4303 next
4304   assume ?rhs
4305   then show ?lhs
4306     unfolding between_mem_convex_hull
4307     by (metis (no_types, hide_lams) collinear_closed_segment collinear_subset hull_redundant hull_subset insert_commute segment_convex_hull)
4308 qed
4311 lemma subset_continuous_image_segment_1:
4312   fixes f :: "'a::euclidean_space \<Rightarrow> real"
4313   assumes "continuous_on (closed_segment a b) f"
4314   shows "closed_segment (f a) (f b) \<subseteq> image f (closed_segment a b)"
4315 by (metis connected_segment convex_contains_segment ends_in_segment imageI
4316            is_interval_connected_1 is_interval_convex connected_continuous_image [OF assms])
4318 lemma continuous_injective_image_segment_1:
4319   fixes f :: "'a::euclidean_space \<Rightarrow> real"
4320   assumes contf: "continuous_on (closed_segment a b) f"
4321       and injf: "inj_on f (closed_segment a b)"
4322   shows "f ` (closed_segment a b) = closed_segment (f a) (f b)"
4323 proof
4324   show "closed_segment (f a) (f b) \<subseteq> f ` closed_segment a b"
4325     by (metis subset_continuous_image_segment_1 contf)
4326   show "f ` closed_segment a b \<subseteq> closed_segment (f a) (f b)"
4327   proof (cases "a = b")
4328     case True
4329     then show ?thesis by auto
4330   next
4331     case False
4332     then have fnot: "f a \<noteq> f b"
4333       using inj_onD injf by fastforce
4334     moreover
4335     have "f a \<notin> open_segment (f c) (f b)" if c: "c \<in> closed_segment a b" for c
4336     proof (clarsimp simp add: open_segment_def)
4337       assume fa: "f a \<in> closed_segment (f c) (f b)"
4338       moreover have "closed_segment (f c) (f b) \<subseteq> f ` closed_segment c b"
4339         by (meson closed_segment_subset contf continuous_on_subset convex_closed_segment ends_in_segment(2) subset_continuous_image_segment_1 that)
4340       ultimately have "f a \<in> f ` closed_segment c b"
4341         by blast
4342       then have a: "a \<in> closed_segment c b"
4343         by (meson ends_in_segment inj_on_image_mem_iff_alt injf subset_closed_segment that)
4344       have cb: "closed_segment c b \<subseteq> closed_segment a b"
4345         by (simp add: closed_segment_subset that)
4346       show "f a = f c"
4347       proof (rule between_antisym)
4348         show "between (f c, f b) (f a)"
4349           by (simp add: between_mem_segment fa)
4350         show "between (f a, f b) (f c)"
4351           by (metis a cb between_antisym between_mem_segment between_triv1 subset_iff)
4352       qed
4353     qed
4354     moreover
4355     have "f b \<notin> open_segment (f a) (f c)" if c: "c \<in> closed_segment a b" for c
4356     proof (clarsimp simp add: open_segment_def fnot eq_commute)
4357       assume fb: "f b \<in> closed_segment (f a) (f c)"
4358       moreover have "closed_segment (f a) (f c) \<subseteq> f ` closed_segment a c"
4359         by (meson contf continuous_on_subset ends_in_segment(1) subset_closed_segment subset_continuous_image_segment_1 that)
4360       ultimately have "f b \<in> f ` closed_segment a c"
4361         by blast
4362       then have b: "b \<in> closed_segment a c"
4363         by (meson ends_in_segment inj_on_image_mem_iff_alt injf subset_closed_segment that)
4364       have ca: "closed_segment a c \<subseteq> closed_segment a b"
4365         by (simp add: closed_segment_subset that)
4366       show "f b = f c"
4367       proof (rule between_antisym)
4368         show "between (f c, f a) (f b)"
4369           by (simp add: between_commute between_mem_segment fb)
4370         show "between (f b, f a) (f c)"
4371           by (metis b between_antisym between_commute between_mem_segment between_triv2 that)
4372       qed
4373     qed
4374     ultimately show ?thesis
4375       by (force simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl split: if_split_asm)
4376   qed
4377 qed
4379 lemma continuous_injective_image_open_segment_1:
4380   fixes f :: "'a::euclidean_space \<Rightarrow> real"
4381   assumes contf: "continuous_on (closed_segment a b) f"
4382       and injf: "inj_on f (closed_segment a b)"
4383     shows "f ` (open_segment a b) = open_segment (f a) (f b)"
4384 proof -
4385   have "f ` (open_segment a b) = f ` (closed_segment a b) - {f a, f b}"
4386     by (metis (no_types, hide_lams) empty_subsetI ends_in_segment image_insert image_is_empty inj_on_image_set_diff injf insert_subset open_segment_def segment_open_subset_closed)
4387   also have "... = open_segment (f a) (f b)"
4388     using continuous_injective_image_segment_1 [OF assms]
4389     by (simp add: open_segment_def inj_on_image_set_diff [OF injf])
4390   finally show ?thesis .
4391 qed
4393 lemma collinear_imp_coplanar:
4394   "collinear s ==> coplanar s"
4395 by (metis collinear_affine_hull coplanar_def insert_absorb2)
4397 lemma collinear_small:
4398   assumes "finite s" "card s \<le> 2"
4399     shows "collinear s"
4400 proof -
4401   have "card s = 0 \<or> card s = 1 \<or> card s = 2"
4402     using assms by linarith
4403   then show ?thesis using assms
4404     using card_eq_SucD
4405     by auto (metis collinear_2 numeral_2_eq_2)
4406 qed
4408 lemma coplanar_small:
4409   assumes "finite s" "card s \<le> 3"
4410     shows "coplanar s"
4411 proof -
4412   have "card s \<le> 2 \<or> card s = Suc (Suc (Suc 0))"
4413     using assms by linarith
4414   then show ?thesis using assms
4415     apply safe
4416     apply (simp add: collinear_small collinear_imp_coplanar)
4417     apply (safe dest!: card_eq_SucD)
4418     apply (auto simp: coplanar_def)
4419     apply (metis hull_subset insert_subset)
4420     done
4421 qed
4423 lemma coplanar_empty: "coplanar {}"
4426 lemma coplanar_sing: "coplanar {a}"
4429 lemma coplanar_2: "coplanar {a,b}"
4430   by (auto simp: card_insert_if coplanar_small)
4432 lemma coplanar_3: "coplanar {a,b,c}"
4433   by (auto simp: card_insert_if coplanar_small)
4435 lemma collinear_affine_hull_collinear: "collinear(affine hull s) \<longleftrightarrow> collinear s"
4436   unfolding collinear_affine_hull
4437   by (metis affine_affine_hull subset_hull hull_hull hull_mono)
4439 lemma coplanar_affine_hull_coplanar: "coplanar(affine hull s) \<longleftrightarrow> coplanar s"
4440   unfolding coplanar_def
4441   by (metis affine_affine_hull subset_hull hull_hull hull_mono)
4443 lemma coplanar_linear_image:
4444   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
4445   assumes "coplanar s" "linear f" shows "coplanar(f ` s)"
4446 proof -
4447   { fix u v w
4448     assume "s \<subseteq> affine hull {u, v, w}"
4449     then have "f ` s \<subseteq> f ` (affine hull {u, v, w})"
4451     then have "f ` s \<subseteq> affine hull (f ` {u, v, w})"
4452       by (metis assms(2) linear_conv_bounded_linear affine_hull_linear_image)
4453   } then
4454   show ?thesis
4455     by auto (meson assms(1) coplanar_def)
4456 qed
4458 lemma coplanar_translation_imp: "coplanar s \<Longrightarrow> coplanar ((\<lambda>x. a + x) ` s)"
4459   unfolding coplanar_def
4460   apply clarify
4461   apply (rule_tac x="u+a" in exI)
4462   apply (rule_tac x="v+a" in exI)
4463   apply (rule_tac x="w+a" in exI)
4464   using affine_hull_translation [of a "{u,v,w}" for u v w]
4466   done
4468 lemma coplanar_translation_eq: "coplanar((\<lambda>x. a + x) ` s) \<longleftrightarrow> coplanar s"
4469     by (metis (no_types) coplanar_translation_imp translation_galois)
4471 lemma coplanar_linear_image_eq:
4472   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
4473   assumes "linear f" "inj f" shows "coplanar(f ` s) = coplanar s"
4474 proof
4475   assume "coplanar s"
4476   then show "coplanar (f ` s)"
4477     unfolding coplanar_def
4478     using affine_hull_linear_image [of f "{u,v,w}" for u v w]  assms
4479     by (meson coplanar_def coplanar_linear_image)
4480 next
4481   obtain g where g: "linear g" "g \<circ> f = id"
4482     using linear_injective_left_inverse [OF assms]
4483     by blast
4484   assume "coplanar (f ` s)"
4485   then obtain u v w where "f ` s \<subseteq> affine hull {u, v, w}"
4486     by (auto simp: coplanar_def)
4487   then have "g ` f ` s \<subseteq> g ` (affine hull {u, v, w})"
4488     by blast
4489   then have "s \<subseteq> g ` (affine hull {u, v, w})"
4490     using g by (simp add: Fun.image_comp)
4491   then show "coplanar s"
4492     unfolding coplanar_def
4493     using affine_hull_linear_image [of g "{u,v,w}" for u v w]  \<open>linear g\<close> linear_conv_bounded_linear
4494     by fastforce
4495 qed
4496 (*The HOL Light proof is simply
4497     MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COPLANAR_LINEAR_IMAGE));;
4498 *)
4500 lemma coplanar_subset: "\<lbrakk>coplanar t; s \<subseteq> t\<rbrakk> \<Longrightarrow> coplanar s"
4501   by (meson coplanar_def order_trans)
4503 lemma affine_hull_3_imp_collinear: "c \<in> affine hull {a,b} \<Longrightarrow> collinear {a,b,c}"
4504   by (metis collinear_2 collinear_affine_hull_collinear hull_redundant insert_commute)
4506 lemma collinear_3_imp_in_affine_hull: "\<lbrakk>collinear {a,b,c}; a \<noteq> b\<rbrakk> \<Longrightarrow> c \<in> affine hull {a,b}"
4507   unfolding collinear_def
4508   apply clarify
4509   apply (frule_tac x=b in bspec, blast, drule_tac x=a in bspec, blast, erule exE)
4510   apply (drule_tac x=c in bspec, blast, drule_tac x=a in bspec, blast, erule exE)
4511   apply (rename_tac y x)
4513   apply (rule_tac x="1 - x/y" in exI)
4515   done
4517 lemma collinear_3_affine_hull:
4518   assumes "a \<noteq> b"
4519     shows "collinear {a,b,c} \<longleftrightarrow> c \<in> affine hull {a,b}"
4520 using affine_hull_3_imp_collinear assms collinear_3_imp_in_affine_hull by blast
4522 lemma collinear_3_eq_affine_dependent:
4523   "collinear{a,b,c} \<longleftrightarrow> a = b \<or> a = c \<or> b = c \<or> affine_dependent {a,b,c}"
4524 apply (case_tac "a=b", simp)
4525 apply (case_tac "a=c")
4527 apply (case_tac "b=c")
4529 apply (auto simp: affine_dependent_def collinear_3_affine_hull insert_Diff_if)
4530 apply (metis collinear_3_affine_hull insert_commute)+
4531 done
4533 lemma affine_dependent_imp_collinear_3:
4534   "affine_dependent {a,b,c} \<Longrightarrow> collinear{a,b,c}"
4537 lemma collinear_3: "NO_MATCH 0 x \<Longrightarrow> collinear {x,y,z} \<longleftrightarrow> collinear {0, x-y, z-y}"
4538   by (auto simp add: collinear_def)
4540 lemma collinear_3_expand:
4541    "collinear{a,b,c} \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
4542 proof -
4543   have "collinear{a,b,c} = collinear{a,c,b}"
4545   also have "... = collinear {0, a - c, b - c}"
4547   also have "... \<longleftrightarrow> (a = c \<or> b = c \<or> (\<exists>ca. b - c = ca *\<^sub>R (a - c)))"
4549   also have "... \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
4550     by (cases "a = c \<or> b = c") (auto simp: algebra_simps)
4551   finally show ?thesis .
4552 qed
4554 lemma collinear_aff_dim: "collinear S \<longleftrightarrow> aff_dim S \<le> 1"
4555 proof
4556   assume "collinear S"
4557   then obtain u and v :: "'a" where "aff_dim S \<le> aff_dim {u,v}"
4558     by (metis \<open>collinear S\<close> aff_dim_affine_hull aff_dim_subset collinear_affine_hull)
4559   then show "aff_dim S \<le> 1"
4560     using order_trans by fastforce
4561 next
4562   assume "aff_dim S \<le> 1"
4563   then have le1: "aff_dim (affine hull S) \<le> 1"
4564     by simp
4565   obtain B where "B \<subseteq> S" and B: "\<not> affine_dependent B" "affine hull S = affine hull B"
4566     using affine_basis_exists [of S] by auto
4567   then have "finite B" "card B \<le> 2"
4568     using B le1 by (auto simp: affine_independent_iff_card)
4569   then have "collinear B"
4570     by (rule collinear_small)
4571   then show "collinear S"
4572     by (metis \<open>affine hull S = affine hull B\<close> collinear_affine_hull_collinear)
4573 qed
4575 lemma collinear_midpoint: "collinear{a,midpoint a b,b}"
4576   apply (auto simp: collinear_3 collinear_lemma)
4577   apply (drule_tac x="-1" in spec)
4579   done
4581 lemma midpoint_collinear:
4582   fixes a b c :: "'a::real_normed_vector"
4583   assumes "a \<noteq> c"
4584     shows "b = midpoint a c \<longleftrightarrow> collinear{a,b,c} \<and> dist a b = dist b c"
4585 proof -
4586   have *: "a - (u *\<^sub>R a + (1 - u) *\<^sub>R c) = (1 - u) *\<^sub>R (a - c)"
4587           "u *\<^sub>R a + (1 - u) *\<^sub>R c - c = u *\<^sub>R (a - c)"
4588           "\<bar>1 - u\<bar> = \<bar>u\<bar> \<longleftrightarrow> u = 1/2" for u::real
4589     by (auto simp: algebra_simps)
4590   have "b = midpoint a c \<Longrightarrow> collinear{a,b,c} "
4591     using collinear_midpoint by blast
4592   moreover have "collinear{a,b,c} \<Longrightarrow> b = midpoint a c \<longleftrightarrow> dist a b = dist b c"
4593     apply (auto simp: collinear_3_expand assms dist_midpoint)
4594     apply (simp add: dist_norm * assms midpoint_def del: divide_const_simps)
4596     done
4597   ultimately show ?thesis by blast
4598 qed
4600 lemma between_imp_collinear:
4601   fixes x :: "'a :: euclidean_space"
4602   assumes "between (a,b) x"
4603     shows "collinear {a,x,b}"
4604 proof (cases "x = a \<or> x = b \<or> a = b")
4605   case True with assms show ?thesis
4606     by (auto simp: dist_commute)
4607 next
4608   case False with assms show ?thesis
4609     apply (auto simp: collinear_3 collinear_lemma between_norm)
4610     apply (drule_tac x="-(norm(b - x) / norm(x - a))" in spec)
4612     done
4613 qed
4615 lemma midpoint_between:
4616   fixes a b :: "'a::euclidean_space"
4617   shows "b = midpoint a c \<longleftrightarrow> between (a,c) b \<and> dist a b = dist b c"
4618 proof (cases "a = c")
4619   case True then show ?thesis
4620     by (auto simp: dist_commute)
4621 next
4622   case False
4623   show ?thesis
4624     apply (rule iffI)
4625     apply (simp add: between_midpoint(1) dist_midpoint)
4626     using False between_imp_collinear midpoint_collinear by blast
4627 qed
4629 lemma collinear_triples:
4630   assumes "a \<noteq> b"
4631     shows "collinear(insert a (insert b S)) \<longleftrightarrow> (\<forall>x \<in> S. collinear{a,b,x})"
4632           (is "?lhs = ?rhs")
4633 proof safe
4634   fix x
4635   assume ?lhs and "x \<in> S"
4636   then show "collinear {a, b, x}"
4637     using collinear_subset by force
4638 next
4639   assume ?rhs
4640   then have "\<forall>x \<in> S. collinear{a,x,b}"
4642   then have *: "\<exists>u. x = u *\<^sub>R a + (1 - u) *\<^sub>R b" if "x \<in> (insert a (insert b S))" for x
4643     using that assms collinear_3_expand by fastforce+
4644   show ?lhs
4645     unfolding collinear_def
4646     apply (rule_tac x="b-a" in exI)
4647     apply (clarify dest!: *)
4649 qed
4651 lemma collinear_4_3:
4652   assumes "a \<noteq> b"
4653     shows "collinear {a,b,c,d} \<longleftrightarrow> collinear{a,b,c} \<and> collinear{a,b,d}"
4654   using collinear_triples [OF assms, of "{c,d}"] by (force simp:)
4656 lemma collinear_3_trans:
4657   assumes "collinear{a,b,c}" "collinear{b,c,d}" "b \<noteq> c"
4658     shows "collinear{a,b,d}"
4659 proof -
4660   have "collinear{b,c,a,d}"
4661     by (metis (full_types) assms collinear_4_3 insert_commute)
4662   then show ?thesis
4664 qed
4666 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
4667   using affine_hull_nonempty by blast
4669 lemma affine_hull_2_alt:
4670   fixes a b :: "'a::real_vector"
4671   shows "affine hull {a,b} = range (\<lambda>u. a + u *\<^sub>R (b - a))"
4672 apply (simp add: affine_hull_2, safe)
4673 apply (rule_tac x=v in image_eqI)
4675 apply (metis scaleR_add_left scaleR_one, simp)
4676 apply (rule_tac x="1-u" in exI)
4678 done
4680 lemma interior_convex_hull_3_minimal:
4681   fixes a :: "'a::euclidean_space"
4682   shows "\<lbrakk>\<not> collinear{a,b,c}; DIM('a) = 2\<rbrakk>
4683          \<Longrightarrow> interior(convex hull {a,b,c}) =
4684                 {v. \<exists>x y z. 0 < x \<and> 0 < y \<and> 0 < z \<and> x + y + z = 1 \<and>
4685                             x *\<^sub>R a + y *\<^sub>R b + z *\<^sub>R c = v}"
4686 apply (simp add: collinear_3_eq_affine_dependent interior_convex_hull_explicit_minimal, safe)
4687 apply (rule_tac x="u a" in exI, simp)
4688 apply (rule_tac x="u b" in exI, simp)
4689 apply (rule_tac x="u c" in exI, simp)
4690 apply (rename_tac uu x y z)
4691 apply (rule_tac x="\<lambda>r. (if r=a then x else if r=b then y else if r=c then z else 0)" in exI)
4692 apply simp
4693 done
4696 subsection%unimportant\<open>Basic lemmas about hyperplanes and halfspaces\<close>
4698 lemma halfspace_Int_eq:
4699      "{x. a \<bullet> x \<le> b} \<inter> {x. b \<le> a \<bullet> x} = {x. a \<bullet> x = b}"
4700      "{x. b \<le> a \<bullet> x} \<inter> {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
4701   by auto
4703 lemma hyperplane_eq_Ex:
4704   assumes "a \<noteq> 0" obtains x where "a \<bullet> x = b"
4705   by (rule_tac x = "(b / (a \<bullet> a)) *\<^sub>R a" in that) (simp add: assms)
4707 lemma hyperplane_eq_empty:
4708      "{x. a \<bullet> x = b} = {} \<longleftrightarrow> a = 0 \<and> b \<noteq> 0"
4709   using hyperplane_eq_Ex apply auto[1]
4710   using inner_zero_right by blast
4712 lemma hyperplane_eq_UNIV:
4713    "{x. a \<bullet> x = b} = UNIV \<longleftrightarrow> a = 0 \<and> b = 0"
4714 proof -
4715   have "UNIV \<subseteq> {x. a \<bullet> x = b} \<Longrightarrow> a = 0 \<and> b = 0"
4716     apply (drule_tac c = "((b+1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
4717     apply simp_all
4719   then show ?thesis by force
4720 qed
4722 lemma halfspace_eq_empty_lt:
4723    "{x. a \<bullet> x < b} = {} \<longleftrightarrow> a = 0 \<and> b \<le> 0"
4724 proof -
4725   have "{x. a \<bullet> x < b} \<subseteq> {} \<Longrightarrow> a = 0 \<and> b \<le> 0"
4726     apply (rule ccontr)
4727     apply (drule_tac c = "((b-1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
4728     apply force+
4729     done
4730   then show ?thesis by force
4731 qed
4733 lemma halfspace_eq_empty_gt:
4734    "{x. a \<bullet> x > b} = {} \<longleftrightarrow> a = 0 \<and> b \<ge> 0"
4735 using halfspace_eq_empty_lt [of "-a" "-b"]
4736 by simp
4738 lemma halfspace_eq_empty_le:
4739    "{x. a \<bullet> x \<le> b} = {} \<longleftrightarrow> a = 0 \<and> b < 0"
4740 proof -
4741   have "{x. a \<bullet> x \<le> b} \<subseteq> {} \<Longrightarrow> a = 0 \<and> b < 0"
4742     apply (rule ccontr)
4743     apply (drule_tac c = "((b-1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
4744     apply force+
4745     done
4746   then show ?thesis by force
4747 qed
4749 lemma halfspace_eq_empty_ge:
4750    "{x. a \<bullet> x \<ge> b} = {} \<longleftrightarrow> a = 0 \<and> b > 0"
4751 using halfspace_eq_empty_le [of "-a" "-b"]
4752 by simp
4754 subsection%unimportant\<open>Use set distance for an easy proof of separation properties\<close>
4756 proposition%unimportant separation_closures:
4757   fixes S :: "'a::euclidean_space set"
4758   assumes "S \<inter> closure T = {}" "T \<inter> closure S = {}"
4759   obtains U V where "U \<inter> V = {}" "open U" "open V" "S \<subseteq> U" "T \<subseteq> V"
4760 proof (cases "S = {} \<or> T = {}")
4761   case True with that show ?thesis by auto
4762 next
4763   case False
4764   define f where "f \<equiv> \<lambda>x. setdist {x} T - setdist {x} S"
4765   have contf: "continuous_on UNIV f"
4766     unfolding f_def by (intro continuous_intros continuous_on_setdist)
4767   show ?thesis
4768   proof (rule_tac U = "{x. f x > 0}" and V = "{x. f x < 0}" in that)
4769     show "{x. 0 < f x} \<inter> {x. f x < 0} = {}"
4770       by auto
4771     show "open {x. 0 < f x}"
4772       by (simp add: open_Collect_less contf continuous_on_const)
4773     show "open {x. f x < 0}"
4774       by (simp add: open_Collect_less contf continuous_on_const)
4775     show "S \<subseteq> {x. 0 < f x}"
4776       apply (clarsimp simp add: f_def setdist_sing_in_set)
4777       using assms
4778       by (metis False IntI empty_iff le_less setdist_eq_0_sing_2 setdist_pos_le setdist_sym)
4779     show "T \<subseteq> {x. f x < 0}"
4780       apply (clarsimp simp add: f_def setdist_sing_in_set)
4781       using assms
4782       by (metis False IntI empty_iff le_less setdist_eq_0_sing_2 setdist_pos_le setdist_sym)
4783   qed
4784 qed
4786 lemma separation_normal:
4787   fixes S :: "'a::euclidean_space set"
4788   assumes "closed S" "closed T" "S \<inter> T = {}"
4789   obtains U V where "open U" "open V" "S \<subseteq> U" "T \<subseteq> V" "U \<inter> V = {}"
4790 using separation_closures [of S T]
4791 by (metis assms closure_closed disjnt_def inf_commute)
4793 lemma separation_normal_local:
4794   fixes S :: "'a::euclidean_space set"
4795   assumes US: "closedin (top_of_set U) S"
4796       and UT: "closedin (top_of_set U) T"
4797       and "S \<inter> T = {}"
4798   obtains S' T' where "openin (top_of_set U) S'"
4799                       "openin (top_of_set U) T'"
4800                       "S \<subseteq> S'"  "T \<subseteq> T'"  "S' \<inter> T' = {}"
4801 proof (cases "S = {} \<or> T = {}")
4802   case True with that show ?thesis
4803     using UT US by (blast dest: closedin_subset)
4804 next
4805   case False
4806   define f where "f \<equiv> \<lambda>x. setdist {x} T - setdist {x} S"
4807   have contf: "continuous_on U f"
4808     unfolding f_def by (intro continuous_intros)
4809   show ?thesis
4810   proof (rule_tac S' = "(U \<inter> f -` {0<..})" and T' = "(U \<inter> f -` {..<0})" in that)
4811     show "(U \<inter> f -` {0<..}) \<inter> (U \<inter> f -` {..<0}) = {}"
4812       by auto
4813     show "openin (top_of_set U) (U \<inter> f -` {0<..})"
4814       by (rule continuous_openin_preimage [where T=UNIV]) (simp_all add: contf)
4815   next
4816     show "openin (top_of_set U) (U \<inter> f -` {..<0})"
4817       by (rule continuous_openin_preimage [where T=UNIV]) (simp_all add: contf)
4818   next
4819     have "S \<subseteq> U" "T \<subseteq> U"
4820       using closedin_imp_subset assms by blast+
4821     then show "S \<subseteq> U \<inter> f -` {0<..}" "T \<subseteq> U \<inter> f -` {..<0}"
4822       using assms False by (force simp add: f_def setdist_sing_in_set intro!: setdist_gt_0_closedin)+
4823   qed
4824 qed
4826 lemma separation_normal_compact:
4827   fixes S :: "'a::euclidean_space set"
4828   assumes "compact S" "closed T" "S \<inter> T = {}"
4829   obtains U V where "open U" "compact(closure U)" "open V" "S \<subseteq> U" "T \<subseteq> V" "U \<inter> V = {}"
4830 proof -
4831   have "closed S" "bounded S"
4832     using assms by (auto simp: compact_eq_bounded_closed)
4833   then obtain r where "r>0" and r: "S \<subseteq> ball 0 r"
4834     by (auto dest!: bounded_subset_ballD)
4835   have **: "closed (T \<union> - ball 0 r)" "S \<inter> (T \<union> - ball 0 r) = {}"
4836     using assms r by blast+
4837   then show ?thesis
4838     apply (rule separation_normal [OF \<open>closed S\<close>])
4839     apply (rule_tac U=U and V=V in that)
4840     by auto (meson bounded_ball bounded_subset compl_le_swap2 disjoint_eq_subset_Compl)
4841 qed
4843 subsection\<open>Connectedness of the intersection of a chain\<close>
4845 proposition connected_chain:
4846   fixes \<F> :: "'a :: euclidean_space set set"
4847   assumes cc: "\<And>S. S \<in> \<F> \<Longrightarrow> compact S \<and> connected S"
4848       and linear: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
4849   shows "connected(\<Inter>\<F>)"
4850 proof (cases "\<F> = {}")
4851   case True then show ?thesis
4852     by auto
4853 next
4854   case False
4855   then have cf: "compact(\<Inter>\<F>)"
4856     by (simp add: cc compact_Inter)
4857   have False if AB: "closed A" "closed B" "A \<inter> B = {}"
4858                 and ABeq: "A \<union> B = \<Inter>\<F>" and "A \<noteq> {}" "B \<noteq> {}" for A B
4859   proof -
4860     obtain U V where "open U" "open V" "A \<subseteq> U" "B \<subseteq> V" "U \<inter> V = {}"
4861       using separation_normal [OF AB] by metis
4862     obtain K where "K \<in> \<F>" "compact K"
4863       using cc False by blast
4864     then obtain N where "open N" and "K \<subseteq> N"
4865       by blast
4866     let ?\<C> = "insert (U \<union> V) ((\<lambda>S. N - S) ` \<F>)"
4867     obtain \<D> where "\<D> \<subseteq> ?\<C>" "finite \<D>" "K \<subseteq> \<Union>\<D>"
4868     proof (rule compactE [OF \<open>compact K\<close>])
4869       show "K \<subseteq> \<Union>(insert (U \<union> V) ((-) N ` \<F>))"
4870         using \<open>K \<subseteq> N\<close> ABeq \<open>A \<subseteq> U\<close> \<open>B \<subseteq> V\<close> by auto
4871       show "\<And>B. B \<in> insert (U \<union> V) ((-) N ` \<F>) \<Longrightarrow> open B"
4872         by (auto simp:  \<open>open U\<close> \<open>open V\<close> open_Un \<open>open N\<close> cc compact_imp_closed open_Diff)
4873     qed
4874     then have "finite(\<D> - {U \<union> V})"
4875       by blast
4876     moreover have "\<D> - {U \<union> V} \<subseteq> (\<lambda>S. N - S) ` \<F>"
4877       using \<open>\<D> \<subseteq> ?\<C>\<close> by blast
4878     ultimately obtain \<G> where "\<G> \<subseteq> \<F>" "finite \<G>" and Deq: "\<D> - {U \<union> V} = (\<lambda>S. N-S) ` \<G>"
4879       using finite_subset_image by metis
4880     obtain J where "J \<in> \<F>" and J: "(\<Union>S\<in>\<G>. N - S) \<subseteq> N - J"
4881     proof (cases "\<G> = {}")
4882       case True
4883       with \<open>\<F> \<noteq> {}\<close> that show ?thesis
4884         by auto
4885     next
4886       case False
4887       have "\<And>S T. \<lbrakk>S \<in> \<G>; T \<in> \<G>\<rbrakk> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
4888         by (meson \<open>\<G> \<subseteq> \<F>\<close> in_mono local.linear)
4889       with \<open>finite \<G>\<close> \<open>\<G> \<noteq> {}\<close>
4890       have "\<exists>J \<in> \<G>. (\<Union>S\<in>\<G>. N - S) \<subseteq> N - J"
4891       proof induction
4892         case (insert X \<H>)
4893         show ?case
4894         proof (cases "\<H> = {}")
4895           case True then show ?thesis by auto
4896         next
4897           case False
4898           then have "\<And>S T. \<lbrakk>S \<in> \<H>; T \<in> \<H>\<rbrakk> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
4900           with insert.IH False obtain J where "J \<in> \<H>" and J: "(\<Union>Y\<in>\<H>. N - Y) \<subseteq> N - J"
4901             by metis
4902           have "N - J \<subseteq> N - X \<or> N - X \<subseteq> N - J"
4903             by (meson Diff_mono \<open>J \<in> \<H>\<close> insert.prems(2) insert_iff order_refl)
4904           then show ?thesis
4905           proof
4906             assume "N - J \<subseteq> N - X" with J show ?thesis
4907               by auto
4908           next
4909             assume "N - X \<subseteq> N - J"
4910             with J have "N - X \<union> \<Union> ((-) N ` \<H>) \<subseteq> N - J"
4911               by auto
4912             with \<open>J \<in> \<H>\<close> show ?thesis
4913               by blast
4914           qed
4915         qed
4916       qed simp
4917       with \<open>\<G> \<subseteq> \<F>\<close> show ?thesis by (blast intro: that)
4918     qed
4919     have "K \<subseteq> \<Union>(insert (U \<union> V) (\<D> - {U \<union> V}))"
4920       using \<open>K \<subseteq> \<Union>\<D>\<close> by auto
4921     also have "... \<subseteq> (U \<union> V) \<union> (N - J)"
4922       by (metis (no_types, hide_lams) Deq Un_subset_iff Un_upper2 J Union_insert order_trans sup_ge1)
4923     finally have "J \<inter> K \<subseteq> U \<union> V"
4924       by blast
4925     moreover have "connected(J \<inter> K)"
4926       by (metis Int_absorb1 \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> cc inf.orderE local.linear)
4927     moreover have "U \<inter> (J \<inter> K) \<noteq> {}"
4928       using ABeq \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> \<open>A \<noteq> {}\<close> \<open>A \<subseteq> U\<close> by blast
4929     moreover have "V \<inter> (J \<inter> K) \<noteq> {}"
4930       using ABeq \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> \<open>B \<noteq> {}\<close> \<open>B \<subseteq> V\<close> by blast
4931     ultimately show False
4932         using connectedD [of "J \<inter> K" U V] \<open>open U\<close> \<open>open V\<close> \<open>U \<inter> V = {}\<close>  by auto
4933   qed
4934   with cf show ?thesis
4935     by (auto simp: connected_closed_set compact_imp_closed)
4936 qed
4938 lemma connected_chain_gen:
4939   fixes \<F> :: "'a :: euclidean_space set set"
4940   assumes X: "X \<in> \<F>" "compact X"
4941       and cc: "\<And>T. T \<in> \<F> \<Longrightarrow> closed T \<and> connected T"
4942       and linear: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
4943   shows "connected(\<Inter>\<F>)"
4944 proof -
4945   have "\<Inter>\<F> = (\<Inter>T\<in>\<F>. X \<inter> T)"
4946     using X by blast
4947   moreover have "connected (\<Inter>T\<in>\<F>. X \<inter> T)"
4948   proof (rule connected_chain)
4949     show "\<And>T. T \<in> (\<inter>) X ` \<F> \<Longrightarrow> compact T \<and> connected T"
4950       using cc X by auto (metis inf.absorb2 inf.orderE local.linear)
4951     show "\<And>S T. S \<in> (\<inter>) X ` \<F> \<and> T \<in> (\<inter>) X ` \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
4952       using local.linear by blast
4953   qed
4954   ultimately show ?thesis
4955     by metis
4956 qed
4958 lemma connected_nest:
4959   fixes S :: "'a::linorder \<Rightarrow> 'b::euclidean_space set"
4960   assumes S: "\<And>n. compact(S n)" "\<And>n. connected(S n)"
4961     and nest: "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
4962   shows "connected(\<Inter> (range S))"
4963   apply (rule connected_chain)
4964   using S apply blast
4965   by (metis image_iff le_cases nest)
4967 lemma connected_nest_gen:
4968   fixes S :: "'a::linorder \<Rightarrow> 'b::euclidean_space set"
4969   assumes S: "\<And>n. closed(S n)" "\<And>n. connected(S n)" "compact(S k)"
4970     and nest: "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
4971   shows "connected(\<Inter> (range S))"
4972   apply (rule connected_chain_gen [of "S k"])
4973   using S apply auto
4974   by (meson le_cases nest subsetCE)
4976 subsection\<open>Proper maps, including projections out of compact sets\<close>
4978 lemma finite_indexed_bound:
4979   assumes A: "finite A" "\<And>x. x \<in> A \<Longrightarrow> \<exists>n::'a::linorder. P x n"
4980     shows "\<exists>m. \<forall>x \<in> A. \<exists>k\<le>m. P x k"
4981 using A
4982 proof (induction A)
4983   case empty then show ?case by force
4984 next
4985   case (insert a A)
4986     then obtain m n where "\<forall>x \<in> A. \<exists>k\<le>m. P x k" "P a n"
4987       by force
4988     then show ?case
4989       apply (rule_tac x="max m n" in exI, safe)
4990       using max.cobounded2 apply blast
4991       by (meson le_max_iff_disj)
4992 qed
4994 proposition proper_map:
4995   fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
4996   assumes "closedin (top_of_set S) K"
4997       and com: "\<And>U. \<lbrakk>U \<subseteq> T; compact U\<rbrakk> \<Longrightarrow> compact (S \<inter> f -` U)"
4998       and "f ` S \<subseteq> T"
4999     shows "closedin (top_of_set T) (f ` K)"
5000 proof -
5001   have "K \<subseteq> S"
5002     using assms closedin_imp_subset by metis
5003   obtain C where "closed C" and Keq: "K = S \<inter> C"
5004     using assms by (auto simp: closedin_closed)
5005   have *: "y \<in> f ` K" if "y \<in> T" and y: "y islimpt f ` K" for y
5006   proof -
5007     obtain h where "\<forall>n. (\<exists>x\<in>K. h n = f x) \<and> h n \<noteq> y" "inj h" and hlim: "(h \<longlongrightarrow> y) sequentially"
5008       using \<open>y \<in> T\<close> y by (force simp: limpt_sequential_inj)
5009     then obtain X where X: "\<And>n. X n \<in> K \<and> h n = f (X n) \<and> h n \<noteq> y"
5010       by metis
5011     then have fX: "\<And>n. f (X n) = h n"
5012       by metis
5013     have "compact (C \<inter> (S \<inter> f -` insert y (range (\<lambda>i. f(X(n + i))))))" for n
5014       apply (rule closed_Int_compact [OF \<open>closed C\<close>])
5015       apply (rule com)
5016        using X \<open>K \<subseteq> S\<close> \<open>f ` S \<subseteq> T\<close> \<open>y \<in> T\<close> apply blast
5017       apply (rule compact_sequence_with_limit)
5019       done
5020     then have comf: "compact {a \<in> K. f a \<in> insert y (range (\<lambda>i. f(X(n + i))))}" for n
5021       by (simp add: Keq Int_def conj_commute)
5022     have ne: "\<Inter>\<F> \<noteq> {}"
5023              if "finite \<F>"
5024                 and \<F>: "\<And>t. t \<in> \<F> \<Longrightarrow>
5025                            (\<exists>n. t = {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (n + i))))})"
5026              for \<F>
5027     proof -
5028       obtain m where m: "\<And>t. t \<in> \<F> \<Longrightarrow> \<exists>k\<le>m. t = {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (k + i))))}"
5029         apply (rule exE)
5030         apply (rule finite_indexed_bound [OF \<open>finite \<F>\<close> \<F>], assumption, force)
5031         done
5032       have "X m \<in> \<Inter>\<F>"
5033         using X le_Suc_ex by (fastforce dest: m)
5034       then show ?thesis by blast
5035     qed
5036     have "\<Inter>{{a. a \<in> K \<and> f a \<in> insert y (range (\<lambda>i. f(X(n + i))))} |n. n \<in> UNIV}
5037                \<noteq> {}"
5038       apply (rule compact_fip_Heine_Borel)
5039        using comf apply force
5040       using ne  apply (simp add: subset_iff del: insert_iff)
5041       done
5042     then have "\<exists>x. x \<in> (\<Inter>n. {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (n + i))))})"
5043       by blast
5044     then show ?thesis
5045       apply (simp add: image_iff fX)
5046       by (metis \<open>inj h\<close> le_add1 not_less_eq_eq rangeI range_ex1_eq)
5047   qed
5048   with assms closedin_subset show ?thesis
5049     by (force simp: closedin_limpt)
5050 qed
5053 lemma compact_continuous_image_eq:
5054   fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
5055   assumes f: "inj_on f S"
5056   shows "continuous_on S f \<longleftrightarrow> (\<forall>T. compact T \<and> T \<subseteq> S \<longrightarrow> compact(f ` T))"
5057            (is "?lhs = ?rhs")
5058 proof
5059   assume ?lhs then show ?rhs
5060     by (metis continuous_on_subset compact_continuous_image)
5061 next
5062   assume RHS: ?rhs
5063   obtain g where gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
5064     by (metis inv_into_f_f f)
5065   then have *: "(S \<inter> f -` U) = g ` U" if "U \<subseteq> f ` S" for U
5066     using that by fastforce
5067   have gfim: "g ` f ` S \<subseteq> S" using gf by auto
5068   have **: "compact (f ` S \<inter> g -` C)" if C: "C \<subseteq> S" "compact C" for C
5069   proof -
5070     obtain h where "h C \<in> C \<and> h C \<notin> S \<or> compact (f ` C)"
5071       by (force simp: C RHS)
5072     moreover have "f ` C = (f ` S \<inter> g -` C)"
5073       using C gf by auto
5074     ultimately show ?thesis
5075       using C by auto
5076   qed
5077   show ?lhs
5078     using proper_map [OF _ _ gfim] **
5079     by (simp add: continuous_on_closed * closedin_imp_subset)
5080 qed
5082 subsection%unimportant\<open>Trivial fact: convexity equals connectedness for collinear sets\<close>
5084 lemma convex_connected_collinear:
5085   fixes S :: "'a::euclidean_space set"
5086   assumes "collinear S"
5087     shows "convex S \<longleftrightarrow> connected S"
5088 proof
5089   assume "convex S"
5090   then show "connected S"
5091     using convex_connected by blast
5092 next
5093   assume S: "connected S"
5094   show "convex S"
5095   proof (cases "S = {}")
5096     case True
5097     then show ?thesis by simp
5098   next
5099     case False
5100     then obtain a where "a \<in> S" by auto
5101     have "collinear (affine hull S)"
5102       by (simp add: assms collinear_affine_hull_collinear)
5103     then obtain z where "z \<noteq> 0" "\<And>x. x \<in> affine hull S \<Longrightarrow> \<exists>c. x - a = c *\<^sub>R z"
5104       by (meson \<open>a \<in> S\<close> collinear hull_inc)
5105     then obtain f where f: "\<And>x. x \<in> affine hull S \<Longrightarrow> x - a = f x *\<^sub>R z"
5106       by metis
5107     then have inj_f: "inj_on f (affine hull S)"
5109     have diff: "x - y = (f x - f y) *\<^sub>R z" if x: "x \<in> affine hull S" and y: "y \<in> affine hull S" for x y
5110     proof -
5111       have "f x *\<^sub>R z = x - a"
5112         by (simp add: f hull_inc x)
5113       moreover have "f y *\<^sub>R z = y - a"
5114         by (simp add: f hull_inc y)
5115       ultimately show ?thesis
5117     qed
5118     have cont_f: "continuous_on (affine hull S) f"
5119       apply (clarsimp simp: dist_norm continuous_on_iff diff)
5120       by (metis \<open>z \<noteq> 0\<close> mult.commute mult_less_cancel_left_pos norm_minus_commute real_norm_def zero_less_mult_iff zero_less_norm_iff)
5121     then have conn_fS: "connected (f ` S)"
5122       by (meson S connected_continuous_image continuous_on_subset hull_subset)
5123     show ?thesis
5124     proof (clarsimp simp: convex_contains_segment)
5125       fix x y z
5126       assume "x \<in> S" "y \<in> S" "z \<in> closed_segment x y"
5127       have False if "z \<notin> S"
5128       proof -
5129         have "f ` (closed_segment x y) = closed_segment (f x) (f y)"
5130           apply (rule continuous_injective_image_segment_1)
5131           apply (meson \<open>x \<in> S\<close> \<open>y \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc continuous_on_subset [OF cont_f])
5132           by (meson \<open>x \<in> S\<close> \<open>y \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc inj_on_subset [OF inj_f])
5133         then have fz: "f z \<in> closed_segment (f x) (f y)"
5134           using \<open>z \<in> closed_segment x y\<close> by blast
5135         have "z \<in> affine hull S"
5136           by (meson \<open>x \<in> S\<close> \<open>y \<in> S\<close> \<open>z \<in> closed_segment x y\<close> convex_affine_hull convex_contains_segment hull_inc subset_eq)
5137         then have fz_notin: "f z \<notin> f ` S"
5138           using hull_subset inj_f inj_onD that by fastforce
5139         moreover have "{..<f z} \<inter> f ` S \<noteq> {}" "{f z<..} \<inter> f ` S \<noteq> {}"
5140         proof -
5141           have "{..<f z} \<inter> f ` {x,y} \<noteq> {}"  "{f z<..} \<inter> f ` {x,y} \<noteq> {}"
5142             using fz fz_notin \<open>x \<in> S\<close> \<open>y \<in> S\<close>
5143              apply (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
5144              apply (metis image_eqI less_eq_real_def)+
5145             done
5146           then show "{..<f z} \<inter> f ` S \<noteq> {}" "{f z<..} \<inter> f ` S \<noteq> {}"
5147             using \<open>x \<in> S\<close> \<open>y \<in> S\<close> by blast+
5148         qed
5149         ultimately show False
5150           using connectedD [OF conn_fS, of "{..<f z}" "{f z<..}"] by force
5151       qed
5152       then show "z \<in> S" by meson
5153     qed
5154   qed
5155 qed
5157 lemma compact_convex_collinear_segment_alt:
5158   fixes S :: "'a::euclidean_space set"
5159   assumes "S \<noteq> {}" "compact S" "connected S" "collinear S"
5160   obtains a b where "S = closed_segment a b"
5161 proof -
5162   obtain \<xi> where "\<xi> \<in> S" using \<open>S \<noteq> {}\<close> by auto
5163   have "collinear (affine hull S)"
5164     by (simp add: assms collinear_affine_hull_collinear)
5165   then obtain z where "z \<noteq> 0" "\<And>x. x \<in> affine hull S \<Longrightarrow> \<exists>c. x - \<xi> = c *\<^sub>R z"
5166     by (meson \<open>\<xi> \<in> S\<close> collinear hull_inc)
5167   then obtain f where f: "\<And>x. x \<in> affine hull S \<Longrightarrow> x - \<xi> = f x *\<^sub>R z"
5168     by metis
5169   let ?g = "\<lambda>r. r *\<^sub>R z + \<xi>"
5170   have gf: "?g (f x) = x" if "x \<in> affine hull S" for x
5171     by (metis diff_add_cancel f that)
5172   then have inj_f: "inj_on f (affine hull S)"
5173     by (metis inj_onI)
5174   have diff: "x - y = (f x - f y) *\<^sub>R z" if x: "x \<in> affine hull S" and y: "y \<in> affine hull S" for x y
5175   proof -
5176     have "f x *\<^sub>R z = x - \<xi>"
5177       by (simp add: f hull_inc x)
5178     moreover have "f y *\<^sub>R z = y - \<xi>"
5179       by (simp add: f hull_inc y)
5180     ultimately show ?thesis
5182   qed
5183   have cont_f: "continuous_on (affine hull S) f"
5184     apply (clarsimp simp: dist_norm continuous_on_iff diff)
5185     by (metis \<open>z \<noteq> 0\<close> mult.commute mult_less_cancel_left_pos norm_minus_commute real_norm_def zero_less_mult_iff zero_less_norm_iff)
5186   then have "connected (f ` S)"
5187     by (meson \<open>connected S\<close> connected_continuous_image continuous_on_subset hull_subset)
5188   moreover have "compact (f ` S)"
5189     by (meson \<open>compact S\<close> compact_continuous_image_eq cont_f hull_subset inj_f)
5190   ultimately obtain x y where "f ` S = {x..y}"
5191     by (meson connected_compact_interval_1)
5192   then have fS_eq: "f ` S = closed_segment x y"
5193     using \<open>S \<noteq> {}\<close> closed_segment_eq_real_ivl by auto
5194   obtain a b where "a \<in> S" "f a = x" "b \<in> S" "f b = y"
5195     by (metis (full_types) ends_in_segment fS_eq imageE)
5196   have "f ` (closed_segment a b) = closed_segment (f a) (f b)"
5197     apply (rule continuous_injective_image_segment_1)
5198      apply (meson \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc continuous_on_subset [OF cont_f])
5199     by (meson \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc inj_on_subset [OF inj_f])
5200   then have "f ` (closed_segment a b) = f ` S"
5201     by (simp add: \<open>f a = x\<close> \<open>f b = y\<close> fS_eq)
5202   then have "?g ` f ` (closed_segment a b) = ?g ` f ` S"
5203     by simp
5204   moreover have "(\<lambda>x. f x *\<^sub>R z + \<xi>) ` closed_segment a b = closed_segment a b"
5205     apply safe
5206      apply (metis (mono_tags, hide_lams) \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment gf hull_inc subsetCE)
5207     by (metis (mono_tags, lifting) \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment gf hull_subset image_iff subsetCE)
5208   ultimately have "closed_segment a b = S"
5209     using gf by (simp add: image_comp o_def hull_inc cong: image_cong)
5210   then show ?thesis
5211     using that by blast
5212 qed
5214 lemma compact_convex_collinear_segment:
5215   fixes S :: "'a::euclidean_space set"
5216   assumes "S \<noteq> {}" "compact S" "convex S" "collinear S"
5217   obtains a b where "S = closed_segment a b"
5218   using assms convex_connected_collinear compact_convex_collinear_segment_alt by blast
5221 lemma proper_map_from_compact:
5222   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
5223   assumes contf: "continuous_on S f" and imf: "f ` S \<subseteq> T" and "compact S"
5224           "closedin (top_of_set T) K"
5225   shows "compact (S \<inter> f -` K)"
5226 by (rule closedin_compact [OF \<open>compact S\<close>] continuous_closedin_preimage_gen assms)+
5228 lemma proper_map_fst:
5229   assumes "compact T" "K \<subseteq> S" "compact K"
5230     shows "compact (S \<times> T \<inter> fst -` K)"
5231 proof -
5232   have "(S \<times> T \<inter> fst -` K) = K \<times> T"
5233     using assms by auto
5234   then show ?thesis by (simp add: assms compact_Times)
5235 qed
5237 lemma closed_map_fst:
5238   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
5239   assumes "compact T" "closedin (top_of_set (S \<times> T)) c"
5240    shows "closedin (top_of_set S) (fst ` c)"
5241 proof -
5242   have *: "fst ` (S \<times> T) \<subseteq> S"
5243     by auto
5244   show ?thesis
5245     using proper_map [OF _ _ *] by (simp add: proper_map_fst assms)
5246 qed
5248 lemma proper_map_snd:
5249   assumes "compact S" "K \<subseteq> T" "compact K"
5250     shows "compact (S \<times> T \<inter> snd -` K)"
5251 proof -
5252   have "(S \<times> T \<inter> snd -` K) = S \<times> K"
5253     using assms by auto
5254   then show ?thesis by (simp add: assms compact_Times)
5255 qed
5257 lemma closed_map_snd:
5258   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
5259   assumes "compact S" "closedin (top_of_set (S \<times> T)) c"
5260    shows "closedin (top_of_set T) (snd ` c)"
5261 proof -
5262   have *: "snd ` (S \<times> T) \<subseteq> T"
5263     by auto
5264   show ?thesis
5265     using proper_map [OF _ _ *] by (simp add: proper_map_snd assms)
5266 qed
5268 lemma closedin_compact_projection:
5269   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
5270   assumes "compact S" and clo: "closedin (top_of_set (S \<times> T)) U"
5271     shows "closedin (top_of_set T) {y. \<exists>x. x \<in> S \<and> (x, y) \<in> U}"
5272 proof -
5273   have "U \<subseteq> S \<times> T"
5274     by (metis clo closedin_imp_subset)
5275   then have "{y. \<exists>x. x \<in> S \<and> (x, y) \<in> U} = snd ` U"
5276     by force
5277   moreover have "closedin (top_of_set T) (snd ` U)"
5278     by (rule closed_map_snd [OF assms])
5279   ultimately show ?thesis
5280     by simp
5281 qed
5284 lemma closed_compact_projection:
5285   fixes S :: "'a::euclidean_space set"
5286     and T :: "('a * 'b::euclidean_space) set"
5287   assumes "compact S" and clo: "closed T"
5288     shows "closed {y. \<exists>x. x \<in> S \<and> (x, y) \<in> T}"
5289 proof -
5290   have *: "{y. \<exists>x. x \<in> S \<and> Pair x y \<in> T} =
5291         {y. \<exists>x. x \<in> S \<and> Pair x y \<in> ((S \<times> UNIV) \<inter> T)}"
5292     by auto
5293   show ?thesis
5294     apply (subst *)
5295     apply (rule closedin_closed_trans [OF _ closed_UNIV])
5296     apply (rule closedin_compact_projection [OF \<open>compact S\<close>])
5297     by (simp add: clo closedin_closed_Int)
5298 qed
5300 subsubsection%unimportant\<open>Representing affine hull as a finite intersection of hyperplanes\<close>
5302 proposition%unimportant affine_hull_convex_Int_nonempty_interior:
5303   fixes S :: "'a::real_normed_vector set"
5304   assumes "convex S" "S \<inter> interior T \<noteq> {}"
5305     shows "affine hull (S \<inter> T) = affine hull S"
5306 proof
5307   show "affine hull (S \<inter> T) \<subseteq> affine hull S"
5309 next
5310   obtain a where "a \<in> S" "a \<in> T" and at: "a \<in> interior T"
5311     using assms interior_subset by blast
5312   then obtain e where "e > 0" and e: "cball a e \<subseteq> T"
5313     using mem_interior_cball by blast
5314   have *: "x \<in> (+) a ` span ((\<lambda>x. x - a) ` (S \<inter> T))" if "x \<in> S" for x
5315   proof (cases "x = a")
5316     case True with that span_0 eq_add_iff image_def mem_Collect_eq show ?thesis
5317       by blast
5318   next
5319     case False
5320     define k where "k = min (1/2) (e / norm (x-a))"
5321     have k: "0 < k" "k < 1"
5322       using \<open>e > 0\<close> False by (auto simp: k_def)
5323     then have xa: "(x-a) = inverse k *\<^sub>R k *\<^sub>R (x-a)"
5324       by simp
5325     have "e / norm (x - a) \<ge> k"
5326       using k_def by linarith
5327     then have "a + k *\<^sub>R (x - a) \<in> cball a e"
5328       using \<open>0 < k\<close> False by (simp add: dist_norm field_simps)
5329     then have T: "a + k *\<^sub>R (x - a) \<in> T"
5330       using e by blast
5331     have S: "a + k *\<^sub>R (x - a) \<in> S"
5332       using k \<open>a \<in> S\<close> convexD [OF \<open>convex S\<close> \<open>a \<in> S\<close> \<open>x \<in> S\<close>, of "1-k" k]
5334     have "inverse k *\<^sub>R k *\<^sub>R (x-a) \<in> span ((\<lambda>x. x - a) ` (S \<inter> T))"
5335       apply (rule span_mul)
5336       apply (rule span_base)
5337       apply (rule image_eqI [where x = "a + k *\<^sub>R (x - a)"])
5338       apply (auto simp: S T)
5339       done
5340     with xa image_iff show ?thesis  by fastforce
5341   qed
5342   show "affine hull S \<subseteq> affine hull (S \<inter> T)"
5344     apply (simp add: \<open>a \<in> S\<close> \<open>a \<in> T\<close> hull_inc affine_hull_span_gen [of a])
5345     apply (force simp: *)
5346     done
5347 qed
5349 corollary affine_hull_convex_Int_open:
5350   fixes S :: "'a::real_normed_vector set"
5351   assumes "convex S" "open T" "S \<inter> T \<noteq> {}"
5352     shows "affine hull (S \<inter> T) = affine hull S"
5353 using affine_hull_convex_Int_nonempty_interior assms interior_eq by blast
5355 corollary affine_hull_affine_Int_nonempty_interior:
5356   fixes S :: "'a::real_normed_vector set"
5357   assumes "affine S" "S \<inter> interior T \<noteq> {}"
5358     shows "affine hull (S \<inter> T) = affine hull S"
5359 by (simp add: affine_hull_convex_Int_nonempty_interior affine_imp_convex assms)
5361 corollary affine_hull_affine_Int_open:
5362   fixes S :: "'a::real_normed_vector set"
5363   assumes "affine S" "open T" "S \<inter> T \<noteq> {}"
5364     shows "affine hull (S \<inter> T) = affine hull S"
5365 by (simp add: affine_hull_convex_Int_open affine_imp_convex assms)
5367 corollary affine_hull_convex_Int_openin:
5368   fixes S :: "'a::real_normed_vector set"
5369   assumes "convex S" "openin (top_of_set (affine hull S)) T" "S \<inter> T \<noteq> {}"
5370     shows "affine hull (S \<inter> T) = affine hull S"
5371 using assms unfolding openin_open
5372 by (metis affine_hull_convex_Int_open hull_subset inf.orderE inf_assoc)
5374 corollary affine_hull_openin:
5375   fixes S :: "'a::real_normed_vector set"
5376   assumes "openin (top_of_set (affine hull T)) S" "S \<noteq> {}"
5377     shows "affine hull S = affine hull T"
5378 using assms unfolding openin_open
5379 by (metis affine_affine_hull affine_hull_affine_Int_open hull_hull)
5381 corollary affine_hull_open:
5382   fixes S :: "'a::real_normed_vector set"
5383   assumes "open S" "S \<noteq> {}"
5384     shows "affine hull S = UNIV"
5385 by (metis affine_hull_convex_Int_nonempty_interior assms convex_UNIV hull_UNIV inf_top.left_neutral interior_open)
5387 lemma aff_dim_convex_Int_nonempty_interior:
5388   fixes S :: "'a::euclidean_space set"
5389   shows "\<lbrakk>convex S; S \<inter> interior T \<noteq> {}\<rbrakk> \<Longrightarrow> aff_dim(S \<inter> T) = aff_dim S"
5390 using aff_dim_affine_hull2 affine_hull_convex_Int_nonempty_interior by blast
5392 lemma aff_dim_convex_Int_open:
5393   fixes S :: "'a::euclidean_space set"
5394   shows "\<lbrakk>convex S; open T; S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow>  aff_dim(S \<inter> T) = aff_dim S"
5395 using aff_dim_convex_Int_nonempty_interior interior_eq by blast
5397 lemma affine_hull_Diff:
5398   fixes S:: "'a::real_normed_vector set"
5399   assumes ope: "openin (top_of_set (affine hull S)) S" and "finite F" "F \<subset> S"
5400     shows "affine hull (S - F) = affine hull S"
5401 proof -
5402   have clo: "closedin (top_of_set S) F"
5403     using assms finite_imp_closedin by auto
5404   moreover have "S - F \<noteq> {}"
5405     using assms by auto
5406   ultimately show ?thesis
5407     by (metis ope closedin_def topspace_euclidean_subtopology affine_hull_openin openin_trans)
5408 qed
5410 lemma affine_hull_halfspace_lt:
5411   fixes a :: "'a::euclidean_space"
5412   shows "affine hull {x. a \<bullet> x < r} = (if a = 0 \<and> r \<le> 0 then {} else UNIV)"
5413 using halfspace_eq_empty_lt [of a r]
5414 by (simp add: open_halfspace_lt affine_hull_open)
5416 lemma affine_hull_halfspace_le:
5417   fixes a :: "'a::euclidean_space"
5418   shows "affine hull {x. a \<bullet> x \<le> r} = (if a = 0 \<and> r < 0 then {} else UNIV)"
5419 proof (cases "a = 0")
5420   case True then show ?thesis by simp
5421 next
5422   case False
5423   then have "affine hull closure {x. a \<bullet> x < r} = UNIV"
5424     using affine_hull_halfspace_lt closure_same_affine_hull by fastforce
5425   moreover have "{x. a \<bullet> x < r} \<subseteq> {x. a \<bullet> x \<le> r}"
5427   ultimately show ?thesis using False antisym_conv hull_mono top_greatest
5428     by (metis affine_hull_halfspace_lt)
5429 qed
5431 lemma affine_hull_halfspace_gt:
5432   fixes a :: "'a::euclidean_space"
5433   shows "affine hull {x. a \<bullet> x > r} = (if a = 0 \<and> r \<ge> 0 then {} else UNIV)"
5434 using halfspace_eq_empty_gt [of r a]
5435 by (simp add: open_halfspace_gt affine_hull_open)
5437 lemma affine_hull_halfspace_ge:
5438   fixes a :: "'a::euclidean_space"
5439   shows "affine hull {x. a \<bullet> x \<ge> r} = (if a = 0 \<and> r > 0 then {} else UNIV)"
5440 using affine_hull_halfspace_le [of "-a" "-r"] by simp
5442 lemma aff_dim_halfspace_lt:
5443   fixes a :: "'a::euclidean_space"
5444   shows "aff_dim {x. a \<bullet> x < r} =
5445         (if a = 0 \<and> r \<le> 0 then -1 else DIM('a))"
5446 by simp (metis aff_dim_open halfspace_eq_empty_lt open_halfspace_lt)
5448 lemma aff_dim_halfspace_le:
5449   fixes a :: "'a::euclidean_space"
5450   shows "aff_dim {x. a \<bullet> x \<le> r} =
5451         (if a = 0 \<and> r < 0 then -1 else DIM('a))"
5452 proof -
5453   have "int (DIM('a)) = aff_dim (UNIV::'a set)"
5455   then have "aff_dim (affine hull {x. a \<bullet> x \<le> r}) = DIM('a)" if "(a = 0 \<longrightarrow> r \<ge> 0)"
5456     using that by (simp add: affine_hull_halfspace_le not_less)
5457   then show ?thesis
5458     by (force simp: aff_dim_affine_hull)
5459 qed
5461 lemma aff_dim_halfspace_gt:
5462   fixes a :: "'a::euclidean_space"
5463   shows "aff_dim {x. a \<bullet> x > r} =
5464         (if a = 0 \<and> r \<ge> 0 then -1 else DIM('a))"
5465 by simp (metis aff_dim_open halfspace_eq_empty_gt open_halfspace_gt)
5467 lemma aff_dim_halfspace_ge:
5468   fixes a :: "'a::euclidean_space"
5469   shows "aff_dim {x. a \<bullet> x \<ge> r} =
5470         (if a = 0 \<and> r > 0 then -1 else DIM('a))"
5471 using aff_dim_halfspace_le [of "-a" "-r"] by simp
5473 proposition aff_dim_eq_hyperplane:
5474   fixes S :: "'a::euclidean_space set"
5475   shows "aff_dim S = DIM('a) - 1 \<longleftrightarrow> (\<exists>a b. a \<noteq> 0 \<and> affine hull S = {x. a \<bullet> x = b})"
5476 proof (cases "S = {}")
5477   case True then show ?thesis
5478     by (auto simp: dest: hyperplane_eq_Ex)
5479 next
5480   case False
5481   then obtain c where "c \<in> S" by blast
5482   show ?thesis
5483   proof (cases "c = 0")
5484     case True show ?thesis
5485       using span_zero [of S]
5486         apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \<open>c \<in> S\<close> hull_inc dim_eq_hyperplane
5487           del: One_nat_def)
5488         apply (auto simp add: \<open>c = 0\<close>)
5489         done
5490   next
5491     case False
5492     have xc_im: "x \<in> (+) c ` {y. a \<bullet> y = 0}" if "a \<bullet> x = a \<bullet> c" for a x
5493     proof -
5494       have "\<exists>y. a \<bullet> y = 0 \<and> c + y = x"
5496       then show "x \<in> (+) c ` {y. a \<bullet> y = 0}"
5497         by blast
5498     qed
5499     have 2: "span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = 0}"
5500          if "(+) c ` span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = b}" for a b
5501     proof -
5502       have "b = a \<bullet> c"
5503         using span_0 that by fastforce
5504       with that have "(+) c ` span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = a \<bullet> c}"
5505         by simp
5506       then have "span ((\<lambda>x. x - c) ` S) = (\<lambda>x. x - c) ` {x. a \<bullet> x = a \<bullet> c}"
5507         by (metis (no_types) image_cong translation_galois uminus_add_conv_diff)
5508       also have "... = {x. a \<bullet> x = 0}"
5509         by (force simp: inner_distrib inner_diff_right
5510              intro: image_eqI [where x="x+c" for x])
5511       finally show ?thesis .
5512     qed
5513     show ?thesis
5514       apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \<open>c \<in> S\<close> hull_inc dim_eq_hyperplane
5515                   del: One_nat_def cong: image_cong_simp, safe)
5516       apply (fastforce simp add: inner_distrib intro: xc_im)
5517       apply (force simp: intro!: 2)
5518       done
5519   qed
5520 qed
5522 corollary aff_dim_hyperplane [simp]:
5523   fixes a :: "'a::euclidean_space"
5524   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
5525 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
5527 subsection%unimportant\<open>Some stepping theorems\<close>
5529 lemma aff_dim_insert:
5530   fixes a :: "'a::euclidean_space"
5531   shows "aff_dim (insert a S) = (if a \<in> affine hull S then aff_dim S else aff_dim S + 1)"
5532 proof (cases "S = {}")
5533   case True then show ?thesis
5534     by simp
5535 next
5536   case False
5537   then obtain x s' where S: "S = insert x s'" "x \<notin> s'"
5538     by (meson Set.set_insert all_not_in_conv)
5539   show ?thesis using S
5540     apply (simp add: hull_redundant cong: aff_dim_affine_hull2)
5541     apply (simp add: affine_hull_insert_span_gen hull_inc)
5542     by (force simp add: span_zero insert_commute [of a] hull_inc aff_dim_eq_dim [of x] dim_insert
5543       cong: image_cong_simp)
5544 qed
5546 lemma affine_dependent_choose:
5547   fixes a :: "'a :: euclidean_space"
5548   assumes "\<not>(affine_dependent S)"
5549   shows "affine_dependent(insert a S) \<longleftrightarrow> a \<notin> S \<and> a \<in> affine hull S"
5550         (is "?lhs = ?rhs")
5551 proof safe
5552   assume "affine_dependent (insert a S)" and "a \<in> S"
5553   then show "False"
5554     using \<open>a \<in> S\<close> assms insert_absorb by fastforce
5555 next
5556   assume lhs: "affine_dependent (insert a S)"
5557   then have "a \<notin> S"
5558     by (metis (no_types) assms insert_absorb)
5559   moreover have "finite S"
5560     using affine_independent_iff_card assms by blast
5561   moreover have "aff_dim (insert a S) \<noteq> int (card S)"
5562     using \<open>finite S\<close> affine_independent_iff_card \<open>a \<notin> S\<close> lhs by fastforce
5563   ultimately show "a \<in> affine hull S"
5564     by (metis aff_dim_affine_independent aff_dim_insert assms)
5565 next
5566   assume "a \<notin> S" and "a \<in> affine hull S"
5567   show "affine_dependent (insert a S)"
5568     by (simp add: \<open>a \<in> affine hull S\<close> \<open>a \<notin> S\<close> affine_dependent_def)
5569 qed
5571 lemma affine_independent_insert:
5572   fixes a :: "'a :: euclidean_space"
5573   shows "\<lbrakk>\<not> affine_dependent S; a \<notin> affine hull S\<rbrakk> \<Longrightarrow> \<not> affine_dependent(insert a S)"
5576 lemma subspace_bounded_eq_trivial:
5577   fixes S :: "'a::real_normed_vector set"
5578   assumes "subspace S"
5579     shows "bounded S \<longleftrightarrow> S = {0}"
5580 proof -
5581   have "False" if "bounded S" "x \<in> S" "x \<noteq> 0" for x
5582   proof -
5583     obtain B where B: "\<And>y. y \<in> S \<Longrightarrow> norm y < B" "B > 0"
5584       using \<open>bounded S\<close> by (force simp: bounded_pos_less)
5585     have "(B / norm x) *\<^sub>R x \<in> S"
5586       using assms subspace_mul \<open>x \<in> S\<close> by auto
5587     moreover have "norm ((B / norm x) *\<^sub>R x) = B"
5588       using that B by (simp add: algebra_simps)
5589     ultimately show False using B by force
5590   qed
5591   then have "bounded S \<Longrightarrow> S = {0}"
5592     using assms subspace_0 by fastforce
5593   then show ?thesis
5594     by blast
5595 qed
5597 lemma affine_bounded_eq_trivial:
5598   fixes S :: "'a::real_normed_vector set"
5599   assumes "affine S"
5600     shows "bounded S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})"
5601 proof (cases "S = {}")
5602   case True then show ?thesis
5603     by simp
5604 next
5605   case False
5606   then obtain b where "b \<in> S" by blast
5607   with False assms show ?thesis
5608     apply safe
5609     using affine_diffs_subspace [OF assms \<open>b \<in> S\<close>]
5610     apply (metis (no_types, lifting) subspace_bounded_eq_trivial ab_left_minus bounded_translation
5611                 image_empty image_insert translation_invert)
5612     apply force
5613     done
5614 qed
5616 lemma affine_bounded_eq_lowdim:
5617   fixes S :: "'a::euclidean_space set"
5618   assumes "affine S"
5619     shows "bounded S \<longleftrightarrow> aff_dim S \<le> 0"
5620 apply safe
5621 using affine_bounded_eq_trivial assms apply fastforce
5622 by (metis aff_dim_sing aff_dim_subset affine_dim_equal affine_sing all_not_in_conv assms bounded_empty bounded_insert dual_order.antisym empty_subsetI insert_subset)
5625 lemma bounded_hyperplane_eq_trivial_0:
5626   fixes a :: "'a::euclidean_space"
5627   assumes "a \<noteq> 0"
5628   shows "bounded {x. a \<bullet> x = 0} \<longleftrightarrow> DIM('a) = 1"
5629 proof
5630   assume "bounded {x. a \<bullet> x = 0}"
5631   then have "aff_dim {x. a \<bullet> x = 0} \<le> 0"
5632     by (simp add: affine_bounded_eq_lowdim affine_hyperplane)
5633   with assms show "DIM('a) = 1"
5634     by (simp add: le_Suc_eq aff_dim_hyperplane)
5635 next
5636   assume "DIM('a) = 1"
5637   then show "bounded {x. a \<bullet> x = 0}"
5638     by (simp add: aff_dim_hyperplane affine_bounded_eq_lowdim affine_hyperplane assms)
5639 qed
5641 lemma bounded_hyperplane_eq_trivial:
5642   fixes a :: "'a::euclidean_space"
5643   shows "bounded {x. a \<bullet> x = r} \<longleftrightarrow> (if a = 0 then r \<noteq> 0 else DIM('a) = 1)"
5644 proof (simp add: bounded_hyperplane_eq_trivial_0, clarify)
5645   assume "r \<noteq> 0" "a \<noteq> 0"
5646   have "aff_dim {x. y \<bullet> x = 0} = aff_dim {x. a \<bullet> x = r}" if "y \<noteq> 0" for y::'a
5647     by (metis that \<open>a \<noteq> 0\<close> aff_dim_hyperplane)
5648   then show "bounded {x. a \<bullet> x = r} = (DIM('a) = Suc 0)"
5649     by (metis One_nat_def \<open>a \<noteq> 0\<close> affine_bounded_eq_lowdim affine_hyperplane bounded_hyperplane_eq_trivial_0)
5650 qed
5652 subsection%unimportant\<open>General case without assuming closure and getting non-strict separation\<close>
5654 proposition%unimportant separating_hyperplane_closed_point_inset:
5655   fixes S :: "'a::euclidean_space set"
5656   assumes "convex S" "closed S" "S \<noteq> {}" "z \<notin> S"
5657   obtains a b where "a \<in> S" "(a - z) \<bullet> z < b" "\<And>x. x \<in> S \<Longrightarrow> b < (a - z) \<bullet> x"
5658 proof -
5659   obtain y where "y \<in> S" and y: "\<And>u. u \<in> S \<Longrightarrow> dist z y \<le> dist z u"
5660     using distance_attains_inf [of S z] assms by auto
5661   then have *: "(y - z) \<bullet> z < (y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2"
5662     using \<open>y \<in> S\<close> \<open>z \<notin> S\<close> by auto
5663   show ?thesis
5664   proof (rule that [OF \<open>y \<in> S\<close> *])
5665     fix x
5666     assume "x \<in> S"
5667     have yz: "0 < (y - z) \<bullet> (y - z)"
5668       using \<open>y \<in> S\<close> \<open>z \<notin> S\<close> by auto
5669     { assume 0: "0 < ((z - y) \<bullet> (x - y))"
5670       with any_closest_point_dot [OF \<open>convex S\<close> \<open>closed S\<close>]
5671       have False
5672         using y \<open>x \<in> S\<close> \<open>y \<in> S\<close> not_less by blast
5673     }
5674     then have "0 \<le> ((y - z) \<bullet> (x - y))"
5675       by (force simp: not_less inner_diff_left)
5676     with yz have "0 < 2 * ((y - z) \<bullet> (x - y)) + (y - z) \<bullet> (y - z)"
5678     then show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
5679       by (simp add: field_simps inner_diff_left inner_diff_right dot_square_norm [symmetric])
5680   qed
5681 qed
5683 lemma separating_hyperplane_closed_0_inset:
5684   fixes S :: "'a::euclidean_space set"
5685   assumes "convex S" "closed S" "S \<noteq> {}" "0 \<notin> S"
5686   obtains a b where "a \<in> S" "a \<noteq> 0" "0 < b" "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x > b"
5687 using separating_hyperplane_closed_point_inset [OF assms]
5688 by simp (metis \<open>0 \<notin> S\<close>)
5691 proposition%unimportant separating_hyperplane_set_0_inspan:
5692   fixes S :: "'a::euclidean_space set"
5693   assumes "convex S" "S \<noteq> {}" "0 \<notin> S"
5694   obtains a where "a \<in> span S" "a \<noteq> 0" "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> a \<bullet> x"
5695 proof -
5696   define k where [abs_def]: "k c = {x. 0 \<le> c \<bullet> x}" for c :: 'a
5697   have *: "span S \<inter> frontier (cball 0 1) \<inter> \<Inter>f' \<noteq> {}"
5698           if f': "finite f'" "f' \<subseteq> k ` S" for f'
5699   proof -
5700     obtain C where "C \<subseteq> S" "finite C" and C: "f' = k ` C"
5701       using finite_subset_image [OF f'] by blast
5702     obtain a where "a \<in> S" "a \<noteq> 0"
5703       using \<open>S \<noteq> {}\<close> \<open>0 \<notin> S\<close> ex_in_conv by blast
5704     then have "norm (a /\<^sub>R (norm a)) = 1"
5705       by simp
5706     moreover have "a /\<^sub>R (norm a) \<in> span S"
5707       by (simp add: \<open>a \<in> S\<close> span_scale span_base)
5708     ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
5709       by simp
5710     show ?thesis
5711     proof (cases "C = {}")
5712       case True with C ass show ?thesis
5713         by auto
5714     next
5715       case False
5716       have "closed (convex hull C)"
5717         using \<open>finite C\<close> compact_eq_bounded_closed finite_imp_compact_convex_hull by auto
5718       moreover have "convex hull C \<noteq> {}"
5720       moreover have "0 \<notin> convex hull C"
5721         by (metis \<open>C \<subseteq> S\<close> \<open>convex S\<close> \<open>0 \<notin> S\<close> convex_hull_subset hull_same insert_absorb insert_subset)
5722       ultimately obtain a b
5723             where "a \<in> convex hull C" "a \<noteq> 0" "0 < b"
5724                   and ab: "\<And>x. x \<in> convex hull C \<Longrightarrow> a \<bullet> x > b"
5725         using separating_hyperplane_closed_0_inset by blast
5726       then have "a \<in> S"
5727         by (metis \<open>C \<subseteq> S\<close> assms(1) subsetCE subset_hull)
5728       moreover have "norm (a /\<^sub>R (norm a)) = 1"
5729         using \<open>a \<noteq> 0\<close> by simp
5730       moreover have "a /\<^sub>R (norm a) \<in> span S"
5731         by (simp add: \<open>a \<in> S\<close> span_scale span_base)
5732       ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
5733         by simp
5734       have aa: "a /\<^sub>R (norm a) \<in> (\<Inter>c\<in>C. {x. 0 \<le> c \<bullet> x})"
5735         apply (clarsimp simp add: divide_simps)
5736         using ab \<open>0 < b\<close>
5737         by (metis hull_inc inner_commute less_eq_real_def less_trans)
5738       show ?thesis
5739         apply (simp add: C k_def)
5740         using ass aa Int_iff empty_iff by blast
5741     qed
5742   qed
5743   have "(span S \<inter> frontier(cball 0 1)) \<inter> (\<Inter> (k ` S)) \<noteq> {}"
5744     apply (rule compact_imp_fip)
5745     apply (blast intro: compact_cball)
5746     using closed_halfspace_ge k_def apply blast
5747     apply (metis *)
5748     done
5749   then show ?thesis
5750     unfolding set_eq_iff k_def
5751     by simp (metis inner_commute norm_eq_zero that zero_neq_one)
5752 qed
5755 lemma separating_hyperplane_set_point_inaff:
5756   fixes S :: "'a::euclidean_space set"
5757   assumes "convex S" "S \<noteq> {}" and zno: "z \<notin> S"
5758   obtains a b where "(z + a) \<in> affine hull (insert z S)"
5759                 and "a \<noteq> 0" and "a \<bullet> z \<le> b"
5760                 and "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b"
5761 proof -
5762   from separating_hyperplane_set_0_inspan [of "image (\<lambda>x. -z + x) S"]
5763   have "convex ((+) (- z) ` S)"
5764     using \<open>convex S\<close> by simp
5765   moreover have "(+) (- z) ` S \<noteq> {}"
5766     by (simp add: \<open>S \<noteq> {}\<close>)
5767   moreover have "0 \<notin> (+) (- z) ` S"
5768     using zno by auto
5769   ultimately obtain a where "a \<in> span ((+) (- z) ` S)" "a \<noteq> 0"
5770                   and a:  "\<And>x. x \<in> ((+) (- z) ` S) \<Longrightarrow> 0 \<le> a \<bullet> x"
5771     using separating_hyperplane_set_0_inspan [of "image (\<lambda>x. -z + x) S"]
5772     by blast
5773   then have szx: "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> z \<le> a \<bullet> x"
5774     by (metis (no_types, lifting) imageI inner_minus_right inner_right_distrib minus_add neg_le_0_iff_le neg_le_iff_le real_add_le_0_iff)
5775   show ?thesis
5776     apply (rule_tac a=a and b = "a  \<bullet> z" in that, simp_all)
5777     using \<open>a \<in> span ((+) (- z) ` S)\<close> affine_hull_insert_span_gen apply blast
5778     apply (simp_all add: \<open>a \<noteq> 0\<close> szx)
5779     done
5780 qed
5782 proposition%unimportant supporting_hyperplane_rel_boundary:
5783   fixes S :: "'a::euclidean_space set"
5784   assumes "convex S" "x \<in> S" and xno: "x \<notin> rel_interior S"
5785   obtains a where "a \<noteq> 0"
5786               and "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
5787               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
5788 proof -
5789   obtain a b where aff: "(x + a) \<in> affine hull (insert x (rel_interior S))"
5790                   and "a \<noteq> 0" and "a \<bullet> x \<le> b"
5791                   and ageb: "\<And>u. u \<in> (rel_interior S) \<Longrightarrow> a \<bullet> u \<ge> b"
5792     using separating_hyperplane_set_point_inaff [of "rel_interior S" x] assms
5793     by (auto simp: rel_interior_eq_empty convex_rel_interior)
5794   have le_ay: "a \<bullet> x \<le> a \<bullet> y" if "y \<in> S" for y
5795   proof -
5796     have con: "continuous_on (closure (rel_interior S)) ((\<bullet>) a)"
5797       by (rule continuous_intros continuous_on_subset | blast)+
5798     have y: "y \<in> closure (rel_interior S)"
5799       using \<open>convex S\<close> closure_def convex_closure_rel_interior \<open>y \<in> S\<close>
5800       by fastforce
5801     show ?thesis
5802       using continuous_ge_on_closure [OF con y] ageb \<open>a \<bullet> x \<le> b\<close>
5803       by fastforce
5804   qed
5805   have 3: "a \<bullet> x < a \<bullet> y" if "y \<in> rel_interior S" for y
5806   proof -
5807     obtain e where "0 < e" "y \<in> S" and e: "cball y e \<inter> affine hull S \<subseteq> S"
5808       using \<open>y \<in> rel_interior S\<close> by (force simp: rel_interior_cball)
5809     define y' where "y' = y - (e / norm a) *\<^sub>R ((x + a) - x)"
5810     have "y' \<in> cball y e"
5811       unfolding y'_def using \<open>0 < e\<close> by force
5812     moreover have "y' \<in> affine hull S"
5813       unfolding y'_def
5814       by (metis \<open>x \<in> S\<close> \<open>y \<in> S\<close> \<open>convex S\<close> aff affine_affine_hull hull_redundant
5815                 rel_interior_same_affine_hull hull_inc mem_affine_3_minus2)
5816     ultimately have "y' \<in> S"
5817       using e by auto
5818     have "a \<bullet> x \<le> a \<bullet> y"
5819       using le_ay \<open>a \<noteq> 0\<close> \<open>y \<in> S\<close> by blast
5820     moreover have "a \<bullet> x \<noteq> a \<bullet> y"
5821       using le_ay [OF \<open>y' \<in> S\<close>] \<open>a \<noteq> 0\<close>
5822       apply (simp add: y'_def inner_diff dot_square_norm power2_eq_square)
5823       by (metis \<open>0 < e\<close> add_le_same_cancel1 inner_commute inner_real_def inner_zero_left le_diff_eq norm_le_zero_iff real_mult_le_cancel_iff2)
5824     ultimately show ?thesis by force
5825   qed
5826   show ?thesis
5827     by (rule that [OF \<open>a \<noteq> 0\<close> le_ay 3])
5828 qed
5830 lemma supporting_hyperplane_relative_frontier:
5831   fixes S :: "'a::euclidean_space set"
5832   assumes "convex S" "x \<in> closure S" "x \<notin> rel_interior S"
5833   obtains a where "a \<noteq> 0"
5834               and "\<And>y. y \<in> closure S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
5835               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
5836 using supporting_hyperplane_rel_boundary [of "closure S" x]
5837 by (metis assms convex_closure convex_rel_interior_closure)
5840 subsection%unimportant\<open> Some results on decomposing convex hulls: intersections, simplicial subdivision\<close>
5842 lemma
5843   fixes s :: "'a::euclidean_space set"
5844   assumes "\<not> affine_dependent(s \<union> t)"
5845     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
5846       and affine_hull_Int_subset: "affine hull s \<inter> affine hull t \<subseteq> affine hull (s \<inter> t)" (is ?A)
5847 proof -
5848   have [simp]: "finite s" "finite t"
5849     using aff_independent_finite assms by blast+
5850     have "sum u (s \<inter> t) = 1 \<and>
5851           (\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
5852       if [simp]:  "sum u s = 1"
5853                  "sum v t = 1"
5854          and eq: "(\<Sum>x\<in>t. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)" for u v
5855     proof -
5856     define f where "f x = (if x \<in> s then u x else 0) - (if x \<in> t then v x else 0)" for x
5857     have "sum f (s \<union> t) = 0"
5858       apply (simp add: f_def sum_Un sum_subtractf)
5859       apply (simp add: sum.inter_restrict [symmetric] Int_commute)
5860       done
5861     moreover have "(\<Sum>x\<in>(s \<union> t). f x *\<^sub>R x) = 0"
5862       apply (simp add: f_def sum_Un scaleR_left_diff_distrib sum_subtractf)
5863       apply (simp add: if_smult sum.inter_restrict [symmetric] Int_commute eq
5864           cong del: if_weak_cong)
5865       done
5866     ultimately have "\<And>v. v \<in> s \<union> t \<Longrightarrow> f v = 0"
5867       using aff_independent_finite assms unfolding affine_dependent_explicit
5868       by blast
5869     then have u [simp]: "\<And>x. x \<in> s \<Longrightarrow> u x = (if x \<in> t then v x else 0)"
5870       by (simp add: f_def) presburger
5871     have "sum u (s \<inter> t) = sum u s"
5873     then have "sum u (s \<inter> t) = 1"
5874       using that by linarith
5875     moreover have "(\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
5876       by (auto simp: if_smult sum.inter_restrict intro: sum.cong)
5877     ultimately show ?thesis
5878       by force
5879     qed
5880     then show ?A ?C
5881       by (auto simp: convex_hull_finite affine_hull_finite)
5882 qed
5885 proposition%unimportant affine_hull_Int:
5886   fixes s :: "'a::euclidean_space set"
5887   assumes "\<not> affine_dependent(s \<union> t)"
5888     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
5889 apply (rule subset_antisym)
5891 by (simp add: affine_hull_Int_subset assms)
5893 proposition%unimportant convex_hull_Int:
5894   fixes s :: "'a::euclidean_space set"
5895   assumes "\<not> affine_dependent(s \<union> t)"
5896     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
5897 apply (rule subset_antisym)
5899 by (simp add: convex_hull_Int_subset assms)
5901 proposition%unimportant
5902   fixes s :: "'a::euclidean_space set set"
5903   assumes "\<not> affine_dependent (\<Union>s)"
5904     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
5905       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
5906 proof -
5907   have "finite s"
5908     using aff_independent_finite assms finite_UnionD by blast
5909   then have "?A \<and> ?C" using assms
5910   proof (induction s rule: finite_induct)
5911     case empty then show ?case by auto
5912   next
5913     case (insert t F)
5914     then show ?case
5915     proof (cases "F={}")
5916       case True then show ?thesis by simp
5917     next
5918       case False
5919       with "insert.prems" have [simp]: "\<not> affine_dependent (t \<union> \<Inter>F)"
5920         by (auto intro: affine_dependent_subset)
5921       have [simp]: "\<not> affine_dependent (\<Union>F)"
5922         using affine_independent_subset insert.prems by fastforce
5923       show ?thesis
5924         by (simp add: affine_hull_Int convex_hull_Int insert.IH)
5925     qed
5926   qed
5927   then show "?A" "?C"
5928     by auto
5929 qed
5931 proposition%unimportant in_convex_hull_exchange_unique:
5932   fixes S :: "'a::euclidean_space set"
5933   assumes naff: "\<not> affine_dependent S" and a: "a \<in> convex hull S"
5934       and S: "T \<subseteq> S" "T' \<subseteq> S"
5935       and x:  "x \<in> convex hull (insert a T)"
5936       and x': "x \<in> convex hull (insert a T')"
5937     shows "x \<in> convex hull (insert a (T \<inter> T'))"
5938 proof (cases "a \<in> S")
5939   case True
5940   then have "\<not> affine_dependent (insert a T \<union> insert a T')"
5941     using affine_dependent_subset assms by auto
5942   then have "x \<in> convex hull (insert a T \<inter> insert a T')"
5943     by (metis IntI convex_hull_Int x x')
5944   then show ?thesis
5945     by simp
5946 next
5947   case False
5948   then have anot: "a \<notin> T" "a \<notin> T'"
5949     using assms by auto
5950   have [simp]: "finite S"
5951     by (simp add: aff_independent_finite assms)
5952   then obtain b where b0: "\<And>s. s \<in> S \<Longrightarrow> 0 \<le> b s"
5953                   and b1: "sum b S = 1" and aeq: "a = (\<Sum>s\<in>S. b s *\<^sub>R s)"
5954     using a by (auto simp: convex_hull_finite)
5955   have fin [simp]: "finite T" "finite T'"
5956     using assms infinite_super \<open>finite S\<close> by blast+
<