src/HOL/Analysis/Starlike.thy
author wenzelm
Mon Mar 25 17:21:26 2019 +0100 (4 weeks 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>
     9 
    10 theory Starlike
    11 imports Convex_Euclidean_Space Abstract_Limits
    12 begin
    13 
    14 section \<open>Line Segments\<close>
    15 
    16 subsection \<open>Midpoint\<close>
    17 
    18 definition%important midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a"
    19   where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
    20 
    21 lemma midpoint_idem [simp]: "midpoint x x = x"
    22   unfolding midpoint_def  by simp
    23 
    24 lemma midpoint_sym: "midpoint a b = midpoint b a"
    25   unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
    26 
    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
    34 
    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)
    40 
    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 **)
    56     apply (simp add: scaleR_right_diff_distrib)
    57     apply (simp add: scaleR_2)
    58     done
    59   show ?t2
    60     unfolding midpoint_def dist_norm
    61     apply (rule *)
    62     apply (simp add: scaleR_right_diff_distrib)
    63     apply (simp add: scaleR_2)
    64     done
    65   show ?t3
    66     unfolding midpoint_def dist_norm
    67     apply (rule *)
    68     apply (simp add: scaleR_right_diff_distrib)
    69     apply (simp add: scaleR_2)
    70     done
    71   show ?t4
    72     unfolding midpoint_def dist_norm
    73     apply (rule **)
    74     apply (simp add: scaleR_right_diff_distrib)
    75     apply (simp add: scaleR_2)
    76     done
    77 qed
    78 
    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
    83 
    84 lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b"
    85   using midpoint_eq_iff by metis
    86 
    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)
    90 
    91 
    92 subsection \<open>Line segments\<close>
    93 
    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}"
    96 
    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}"
    99 
   100 lemmas segment = open_segment_def closed_segment_def
   101 
   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)
   106 
   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
   112     by (force simp add: in_segment add scale)
   113 qed
   114 
   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)
   118 
   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
   125 
   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)
   129 
   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
   136 
   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
   143 
   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)
   147 
   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)
   151 
   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)
   156 
   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)
   160 
   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)"
   165     apply (simp add: closed_segment_def)
   166     apply (erule ex_forward)
   167     apply (simp add: algebra_simps)
   168     done
   169   show ?thesis
   170   using * [where d = "-d"] *
   171   by (fastforce simp add:)
   172 qed
   173 
   174 lemma open_segment_translation_eq [simp]:
   175     "d + x \<in> open_segment (d + a) (d + b) \<longleftrightarrow> x \<in> open_segment a b"
   176   by (simp add: open_segment_def)
   177 
   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
   182 
   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
   187 
   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
   191 
   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)
   195 
   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)
   199 
   200 lemma closed_segment_subset: "\<lbrakk>x \<in> S; y \<in> S; convex S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> S"
   201   by (simp add: convex_contains_segment)
   202 
   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
   206 
   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
   215 
   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)
   218 
   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)
   222 
   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)
   226 
   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])
   230 
   231 lemmas bounded_segment = bounded_closed_segment open_closed_segment
   232 
   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])
   236 
   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
   256 
   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
   267     by (auto simp add:norm_minus_commute)
   268 qed
   269 
   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
   274     by (simp add: segment_convex_hull)
   275 qed
   276 
   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
   289 
   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)
   295 
   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
   302 
   303 lemma closed_segment_idem [simp]: "closed_segment a a = {a}"
   304   unfolding segment by (auto simp add: algebra_simps)
   305 
   306 lemma open_segment_idem [simp]: "open_segment a a = {}"
   307   by (simp add: open_segment_def)
   308 
   309 lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
   310   using open_segment_def by auto
   311 
   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)
   315 
   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
   326 
   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)
   331 
   332 lemma closed_segment_real_eq:
   333   fixes u::real shows "closed_segment u v = (\<lambda>x. (v - u) * x + u) ` {0..1}"
   334   by (simp add: add.commute [of u] image_affinity_atLeastAtMost [where c=u] closed_segment_eq_real_ivl)
   335 
   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
   362 
   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
   391 
   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)"
   414     by (simp add: algebra_simps)
   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
   421 
   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
   431     by (simp add: dist_norm)
   432 qed
   433 
   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)
   439 
   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)
   447 
   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)
   453 
   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)
   458   by (metis field_sum_of_halves scaleR_left.add)
   459 
   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)
   464 
   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)
   471 
   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)
   477 
   478 subsubsection\<open>More lemmas, especially for working with the underlying formula\<close>
   479 
   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)
   484 
   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"
   491       by (simp add: algebra_simps)
   492     then have "a=b \<or> u=1"
   493       by simp
   494   } then show ?thesis
   495       by (auto simp: algebra_simps)
   496 qed
   497 
   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)
   503 
   504 lemma add_scaleR_degen:
   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"
   508   by (metis (no_types, hide_lams) add.commute add_diff_eq diff_add_cancel real_vector.scale_cancel_left real_vector.scale_left_diff_distrib assms)
   509   
   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)
   513 
   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)
   517 
   518 lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval
   519 
   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
   532 
   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)
   537 
   538 lemma closed_segment [simp]:
   539   fixes a :: "'a::real_normed_vector"
   540   shows "closed (closed_segment a b)"
   541   by (simp add: compact_imp_closed)
   542 
   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
   547 
   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)
   553 
   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
   575 
   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))
   579 
   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)
   583 
   584 lemma convex_closed_segment [iff]: "convex (closed_segment a b)"
   585   unfolding segment_convex_hull by(rule convex_convex_hull)
   586 
   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
   596 
   597 lemmas convex_segment = convex_closed_segment convex_open_segment
   598 
   599 lemma connected_segment [iff]:
   600   fixes x :: "'a :: real_normed_vector"
   601   shows "connected (closed_segment x y)"
   602   by (simp add: convex_connected)
   603 
   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)
   606 
   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)
   617 
   618 
   619 subsection\<open>Starlike sets\<close>
   620 
   621 definition%important "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
   622 
   623 lemma starlike_UNIV [simp]: "starlike UNIV"
   624   by (simp add: starlike_def)
   625 
   626 lemma convex_imp_starlike:
   627   "convex S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> starlike S"
   628   unfolding convex_contains_segment starlike_def by auto
   629 
   630 
   631 lemma affine_hull_closed_segment [simp]:
   632      "affine hull (closed_segment a b) = affine hull {a,b}"
   633   by (simp add: segment_convex_hull)
   634 
   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)
   639 
   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
   647     by (simp add: algebra_simps)
   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
   653 
   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)
   658 
   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
   683 
   684 subsection%unimportant\<open>More results about segments\<close>
   685 
   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)"
   693     by (simp add: real_vector.scale_right_diff_distrib)
   694   finally show ?thesis
   695     by (simp only: dist_norm)
   696 qed
   697 
   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))"
   715       by (simp add: dist_half_times2) (simp add: dist_norm)
   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
   734 
   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))"
   753       by (simp add: dist_half_times2) (simp add: dist_norm)
   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
   772 
   773 lemmas segment_as_ball = closed_segment_as_ball open_segment_as_ball
   774 
   775 lemma closed_segment_neq_empty [simp]: "closed_segment a b \<noteq> {}"
   776   by auto
   777 
   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
   787 
   788 lemma open_segment_eq_empty' [simp]: "{} = open_segment a b \<longleftrightarrow> a = b"
   789   using open_segment_eq_empty by blast
   790 
   791 lemmas segment_eq_empty = closed_segment_neq_empty open_segment_eq_empty
   792 
   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)"
   801     by (simp add: algebra_simps)
   802   with assms show "x = y"
   803     by (simp add: real_vector.scale_right_imp_eq)
   804 qed
   805 
   806 lemma finite_closed_segment [simp]: "finite(closed_segment a b) \<longleftrightarrow> a = b"
   807   apply auto
   808   apply (rule ccontr)
   809   apply (simp add: segment_image_interval)
   810   using infinite_Icc [OF zero_less_one] finite_imageD [OF _ inj_segment] apply blast
   811   done
   812 
   813 lemma finite_open_segment [simp]: "finite(open_segment a b) \<longleftrightarrow> a = b"
   814   by (auto simp: open_segment_def)
   815 
   816 lemmas finite_segment = finite_closed_segment finite_open_segment
   817 
   818 lemma closed_segment_eq_sing: "closed_segment a b = {c} \<longleftrightarrow> a = c \<and> b = c"
   819   by auto
   820 
   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)
   823 
   824 lemmas segment_eq_sing = closed_segment_eq_sing open_segment_eq_sing
   825 
   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)
   830 
   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
   835 
   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
   859         by (simp add: mult_nonpos_nonneg)
   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
   867           by (metis \<open>ua \<noteq> ub\<close> add_less_cancel_left add_less_cancel_right add_mono_thms_linordered_field(5)
   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>
   871         by (metis diff_add_cancel diff_gt_0_iff_gt)
   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
   877       by (fastforce simp add:)
   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
   890 
   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
   900 
   901 lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment
   902 
   903 
   904 subsection\<open>Betweenness\<close>
   905 
   906 definition%important "between = (\<lambda>(a,b) x. x \<in> closed_segment a b)"
   907 
   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
   912 
   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
   917 
   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
   938 
   939 lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
   940   unfolding between_def by auto
   941 
   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
   990 
   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
  1002 
  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 ..
  1006 
  1007 lemma between_triv_iff [simp]: "between (a,a) b \<longleftrightarrow> a=b"
  1008   by (auto simp: between_def)
  1009 
  1010 lemma between_triv1 [simp]: "between (a,b) a"
  1011   by (auto simp: between_def)
  1012 
  1013 lemma between_triv2 [simp]: "between (a,b) b"
  1014   by (auto simp: between_def)
  1015 
  1016 lemma between_commute:
  1017    "between (a,b) = between (b,a)"
  1018 by (auto simp: between_def closed_segment_commute)
  1019 
  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)
  1024 
  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)
  1030 
  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)
  1035 
  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)
  1042 
  1043 lemma between_translation [simp]: "between (a + y,a + z) (a + x) \<longleftrightarrow> between (y,z) x"
  1044   by (auto simp: between_def)
  1045 
  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)
  1050 
  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])
  1055 
  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)
  1060 
  1061 
  1062 subsection%unimportant \<open>Shrinking towards the interior of a convex set\<close>
  1063 
  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
  1105 
  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
  1169 
  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)"
  1178     by (simp add: algebra_simps)
  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
  1183 
  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
  1193 
  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
  1234 
  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
  1248 
  1249 
  1250 subsection%unimportant \<open>Some obvious but surprisingly hard simplex lemmas\<close>
  1251 
  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
  1267 
  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
  1304 
  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
  1309 
  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
  1387 
  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
  1421 
  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)"
  1480           using x0 D \<open>a\<in>D\<close> by (auto simp add: inner_add_left inner_Basis)
  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>
  1507         by (simp add: card_gt_0_iff)
  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
  1513 
  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" .
  1543 
  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>
  1552             by (simp add: card_gt_0_iff)
  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
  1566 
  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
  1632 
  1633 
  1634 subsection%unimportant \<open>Relative interior of convex set\<close>
  1635 
  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
  1703 
  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
  1724 
  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> {}"
  1736     by (simp add: rel_interior_interior)
  1737   with that show ?thesis
  1738     by auto
  1739 qed
  1740 
  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"
  1762       by (simp add: algebra_simps)
  1763   }
  1764   then show ?thesis
  1765     unfolding convex_alt by auto
  1766 qed
  1767 
  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
  1823 
  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)
  1829 
  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)
  1835 
  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
  1846 
  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
  1852 
  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
  1866     apply (simp add: algebra_simps)
  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
  1876 
  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
  1928 
  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
  1937 
  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)
  1944 
  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
  1963 
  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)
  1970 
  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)
  1980     apply (simp add: open_segment_as_ball)
  1981     done
  1982 qed
  1983 
  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
  1996 
  1997 lemmas rel_interior_segment = rel_interior_closed_segment rel_interior_open_segment
  1998 
  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>])
  2014     apply (simp add: closed_segment_eq_open)
  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
  2019 
  2020 subsection\<open>The relative frontier of a set\<close>
  2021 
  2022 definition%important "rel_frontier S = closure S - rel_interior S"
  2023 
  2024 lemma rel_frontier_empty [simp]: "rel_frontier {} = {}"
  2025   by (simp add: rel_frontier_def)
  2026 
  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])
  2032 
  2033 lemma rel_frontier_sing [simp]:
  2034     fixes a :: "'n::euclidean_space"
  2035     shows "rel_frontier {a} = {}"
  2036   by (simp add: rel_frontier_def)
  2037 
  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
  2042 
  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
  2056 
  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)
  2061 
  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)
  2066 
  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)
  2071 
  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)
  2076 
  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)
  2081 
  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
  2095 
  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)
  2100 
  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)
  2105 
  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)
  2110 
  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
  2115 
  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)
  2120 
  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"
  2125 by (simp add: closure_eq_rel_interior_eq)
  2126 
  2127 lemma convex_same_rel_interior_closure_straddle:
  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)
  2133 
  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
  2182 
  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))"
  2207           by (simp add: algebra_simps)
  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
  2250 
  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
  2257 
  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
  2281 
  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
  2290 
  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
  2298 
  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"
  2367       by (simp add: algebra_simps)
  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"
  2382         by (simp add: algebra_simps)
  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
  2394 
  2395 
  2396 subsubsection%unimportant \<open>Relative interior and closure under common operations\<close>
  2397 
  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
  2415 
  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
  2438 
  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
  2491 
  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
  2506 
  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
  2521 
  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
  2543 
  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
  2592 
  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
  2600 
  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
  2608 
  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
  2625 
  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)
  2633 
  2634 lemma connected_component_1:
  2635   fixes S :: "real set"
  2636   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
  2637 by (simp add: connected_component_1_gen)
  2638 
  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
  2655 
  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)
  2665 
  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
  2678 
  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"
  2685     by (simp add: closure_mono)
  2686   also have "... \<subseteq> T"
  2687     by (simp add: affine_closed assms)
  2688   finally show "closure(S \<inter> T) \<subseteq> closure S \<inter> T"
  2689     by (simp add: closure_mono)
  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
  2712 
  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
  2739 
  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"
  2784         using x1 z1 by (simp add: linear_add linear_scale \<open>linear f\<close>)
  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
  2797 
  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
  2863 
  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"
  2890       by (simp add: fst_vimage_eq_Times)
  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"
  2896       by (simp add: snd_vimage_eq_Times)
  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
  2912 
  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
  2920 
  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)
  2926 
  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)
  2933 
  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
  2953 
  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)
  2961 
  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
  2984 
  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
  3078 
  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)
  3086 
  3087 
  3088 subsubsection%unimportant \<open>Relative interior of convex cone\<close>
  3089 
  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
  3108 
  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
  3153 
  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
  3185 
  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
  3208 
  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
  3215 
  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
  3243 
  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"
  3259       by (simp add: sum_distrib_left)
  3260     moreover have "sum (\<lambda>i. v * d i) I = v * sum d I"
  3261       by (simp add: sum_distrib_left)
  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
  3320 
  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
  3359 
  3360 
  3361 subsection%unimportant \<open>Convexity on direct sums\<close>
  3362 
  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
  3367   by (intro closure_bounded_linear_image_subset bounded_linear_add
  3368     bounded_linear_fst bounded_linear_snd)
  3369 
  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)"
  3377     by (simp add: set_plus_image)
  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
  3386 
  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
  3395 
  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)
  3404 
  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)
  3413 
  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
  3467 
  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
  3498 
  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
  3520     by (simp add: cone_hull_empty_iff[symmetric])
  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))"
  3560     by (simp add: hull_mono)
  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)
  3637       apply (simp add: sum_prod)
  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
  3645 
  3646 
  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
  3664 
  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
  3673 
  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
  3699 
  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
  3725 
  3726 subsection%unimportant\<open>Explicit formulas for interior and relative interior of convex hull\<close>
  3727 
  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
  3737 
  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
  3775 
  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)
  3795       apply (metis add.commute diff_add_cancel surj_def)
  3796       apply (rule card_ge_dim_independent)
  3797       apply (auto simp: card_image inj_on_def dim_subset_UNIV)
  3798       done
  3799 qed
  3800 
  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
  3811 
  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])
  3821 
  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])
  3828 
  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])
  3835 
  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])
  3842 
  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
  3914 
  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)
  3925   by (simp add: rel_interior_convex_hull_explicit)
  3926 
  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
  3966 
  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
  3979 
  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
  4006 
  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
  4020 
  4021 lemmas interior_segment = interior_closed_segment interior_open_segment
  4022 
  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"
  4051     by (simp add: segment_convex_hull)
  4052 qed
  4053 
  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)
  4058 
  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
  4063 
  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
  4086 
  4087 subsection%unimportant\<open>Similar results for closure and (relative or absolute) frontier\<close>
  4088 
  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)
  4093 
  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])
  4110     apply (simp add: affine_dependent_explicit)
  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
  4117 
  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)
  4140       apply (simp add: convex_hull_finite)
  4141       done
  4142   qed
  4143 qed
  4144 
  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
  4171     apply (simp add: rel_frontier_convex_hull_explicit)
  4172     apply (simp add: convex_hull_finite fs Union_SetCompr_eq, auto)
  4173     done
  4174 qed
  4175 
  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)
  4185 
  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)
  4192 
  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"
  4206       by (simp add: DIM_positive)
  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
  4214 
  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)
  4221 
  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
  4241 
  4242 
  4243 subsection \<open>Coplanarity, and collinearity in terms of affine hull\<close>
  4244 
  4245 definition%important coplanar  where
  4246    "coplanar s \<equiv> \<exists>u v w. s \<subseteq> affine hull {u,v,w}"
  4247 
  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)
  4265       apply (simp add: algebra_simps)
  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)
  4276       apply (simp add: algebra_simps)
  4277       apply (metis scaleR_left.add)
  4278       done
  4279   } ultimately
  4280   show ?thesis
  4281   unfolding collinear_def affine_hull_2
  4282     by blast
  4283 qed
  4284 
  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)
  4287 
  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)
  4292 
  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
  4309 
  4310 
  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])
  4317 
  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
  4378 
  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
  4392 
  4393 lemma collinear_imp_coplanar:
  4394   "collinear s ==> coplanar s"
  4395 by (metis collinear_affine_hull coplanar_def insert_absorb2)
  4396 
  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
  4407 
  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
  4422 
  4423 lemma coplanar_empty: "coplanar {}"
  4424   by (simp add: coplanar_small)
  4425 
  4426 lemma coplanar_sing: "coplanar {a}"
  4427   by (simp add: coplanar_small)
  4428 
  4429 lemma coplanar_2: "coplanar {a,b}"
  4430   by (auto simp: card_insert_if coplanar_small)
  4431 
  4432 lemma coplanar_3: "coplanar {a,b,c}"
  4433   by (auto simp: card_insert_if coplanar_small)
  4434 
  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)
  4438 
  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)
  4442 
  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})"
  4450       by (simp add: image_mono)
  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
  4457 
  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]
  4465   apply (force simp: add.commute)
  4466   done
  4467 
  4468 lemma coplanar_translation_eq: "coplanar((\<lambda>x. a + x) ` s) \<longleftrightarrow> coplanar s"
  4469     by (metis (no_types) coplanar_translation_imp translation_galois)
  4470 
  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 *)
  4499 
  4500 lemma coplanar_subset: "\<lbrakk>coplanar t; s \<subseteq> t\<rbrakk> \<Longrightarrow> coplanar s"
  4501   by (meson coplanar_def order_trans)
  4502 
  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)
  4505 
  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)
  4512   apply (simp add: affine_hull_2)
  4513   apply (rule_tac x="1 - x/y" in exI)
  4514   apply (simp add: algebra_simps)
  4515   done
  4516 
  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
  4521 
  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")
  4526 apply (simp add: insert_commute)
  4527 apply (case_tac "b=c")
  4528 apply (simp add: insert_commute)
  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
  4532 
  4533 lemma affine_dependent_imp_collinear_3:
  4534   "affine_dependent {a,b,c} \<Longrightarrow> collinear{a,b,c}"
  4535 by (simp add: collinear_3_eq_affine_dependent)
  4536 
  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)
  4539 
  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}"
  4544     by (simp add: insert_commute)
  4545   also have "... = collinear {0, a - c, b - c}"
  4546     by (simp add: collinear_3)
  4547   also have "... \<longleftrightarrow> (a = c \<or> b = c \<or> (\<exists>ca. b - c = ca *\<^sub>R (a - c)))"
  4548     by (simp add: collinear_lemma)
  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
  4553 
  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
  4574 
  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)
  4578   apply (simp add: algebra_simps)
  4579   done
  4580 
  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)
  4595     apply (simp add: algebra_simps)
  4596     done
  4597   ultimately show ?thesis by blast
  4598 qed
  4599 
  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)
  4611     apply (simp add: vector_add_divide_simps eq_vector_fraction_iff real_vector.scale_minus_right [symmetric])
  4612     done
  4613 qed
  4614 
  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
  4628 
  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}"
  4641     by (simp add: insert_commute)
  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!: *)
  4648     by (metis (no_types, hide_lams) add.commute diff_add_cancel diff_diff_eq2 real_vector.scale_right_diff_distrib scaleR_left.diff)
  4649 qed
  4650 
  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:)
  4655 
  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
  4663     by (simp add: collinear_subset)
  4664 qed
  4665 
  4666 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
  4667   using affine_hull_nonempty by blast
  4668 
  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)
  4674 apply (simp add: algebra_simps)
  4675 apply (metis scaleR_add_left scaleR_one, simp)
  4676 apply (rule_tac x="1-u" in exI)
  4677 apply (simp add: algebra_simps)
  4678 done
  4679 
  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
  4694 
  4695 
  4696 subsection%unimportant\<open>Basic lemmas about hyperplanes and halfspaces\<close>
  4697 
  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
  4702 
  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)
  4706 
  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
  4711 
  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
  4718     by (metis add_cancel_right_right zero_neq_one)
  4719   then show ?thesis by force
  4720 qed
  4721 
  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
  4732 
  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
  4737 
  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
  4748 
  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
  4753 
  4754 subsection%unimportant\<open>Use set distance for an easy proof of separation properties\<close>
  4755 
  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
  4785 
  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)
  4792 
  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
  4825 
  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
  4842 
  4843 subsection\<open>Connectedness of the intersection of a chain\<close>
  4844 
  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"
  4899             by (simp add: insert.prems)
  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
  4937 
  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
  4957 
  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)
  4966 
  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)
  4975 
  4976 subsection\<open>Proper maps, including projections out of compact sets\<close>
  4977 
  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
  4993 
  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)
  5018       apply (simp add: fX add.commute [of n] LIMSEQ_ignore_initial_segment [OF hlim])
  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
  5051 
  5052 
  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
  5081 
  5082 subsection%unimportant\<open>Trivial fact: convexity equals connectedness for collinear sets\<close>
  5083 
  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)"
  5108       by (metis diff_add_cancel inj_onI)
  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
  5116         by (simp add: scaleR_left.diff)
  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
  5156 
  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
  5181       by (simp add: scaleR_left.diff)
  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
  5213 
  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
  5219 
  5220 
  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)+
  5227 
  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
  5236 
  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
  5247 
  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
  5256 
  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
  5267 
  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
  5282 
  5283 
  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
  5299 
  5300 subsubsection%unimportant\<open>Representing affine hull as a finite intersection of hyperplanes\<close>
  5301 
  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"
  5308     by (simp add: hull_mono)
  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]
  5333       by (simp add: algebra_simps)
  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)"
  5343     apply (simp add: subset_hull)
  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
  5348 
  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
  5354 
  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)
  5360 
  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)
  5366 
  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)
  5373 
  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)
  5380 
  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)
  5386 
  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
  5391 
  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
  5396 
  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
  5409 
  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)
  5415 
  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}"
  5426     by (simp add: Collect_mono)
  5427   ultimately show ?thesis using False antisym_conv hull_mono top_greatest
  5428     by (metis affine_hull_halfspace_lt)
  5429 qed
  5430 
  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)
  5436 
  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
  5441 
  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)
  5447 
  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)"
  5454     by (simp add: aff_dim_UNIV)
  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
  5460 
  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)
  5466 
  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
  5472 
  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"
  5495         by (metis that add.commute diff_add_cancel inner_commute inner_diff_left right_minus_eq)
  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
  5521 
  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)
  5526 
  5527 subsection%unimportant\<open>Some stepping theorems\<close>
  5528 
  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
  5545 
  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
  5570 
  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)"
  5574   by (simp add: affine_dependent_choose)
  5575 
  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
  5596 
  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
  5615 
  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)
  5623 
  5624 
  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
  5640 
  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
  5651 
  5652 subsection%unimportant\<open>General case without assuming closure and getting non-strict separation\<close>
  5653 
  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)"
  5677       by (simp add: algebra_simps)
  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
  5682 
  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>)
  5689 
  5690 
  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> {}"
  5719         by (simp add: False)
  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
  5753 
  5754 
  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
  5781 
  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
  5829 
  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)
  5838 
  5839 
  5840 subsection%unimportant\<open> Some results on decomposing convex hulls: intersections, simplicial subdivision\<close>
  5841 
  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"
  5872       by (simp add: sum.inter_restrict)
  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
  5883 
  5884 
  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)
  5890 apply (simp add: hull_mono)
  5891 by (simp add: affine_hull_Int_subset assms)
  5892 
  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)
  5898 apply (simp add: hull_mono)
  5899 by (simp add: convex_hull_Int_subset assms)
  5900 
  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
  5930 
  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+