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